Модераторы: Snowy, MetalFan, bems, Poseidon
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Многозадачное меню на основе компонента TPanel, Кнопки в виде компонентов Panel 
:(
    Опции темы
vctorusv
Дата 18.8.2017, 17:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 6
Регистрация: 18.8.2017

Репутация: нет
Всего: нет



Подскажите, пожалуйста, как корректно составить код для следующей задачи:
Три кнопки в виде компонентов Panel1, Panel2, Panel3.
Необходимо чтобы каждый компонент меню реагировал на мышь, на клавиатуру(стрелки Up, Down) и на курсор. И подсвечивался цветом.


PM MAIL   Вверх
v4v4n
Дата 30.8.2017, 14:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 45
Регистрация: 26.9.2008

Репутация: 1
Всего: 4



Код

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure PanelsMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
      );
    procedure SetValue(x:byte);
  private
    Value : byte;
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }
procedure TForm1.SetValue(x:byte);
begin
  Value:=x;
  if Value=1 then Panel1.Color:=clHighlight else Panel1.Color:=clDefault;
  if Value=2 then Panel2.Color:=clHighlight else Panel2.Color:=clDefault;
  if Value=3 then Panel3.Color:=clHighlight else Panel3.Color:=clDefault;
end;

procedure TForm1.PanelsMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Sender=Panel1 then SetValue(1);
  if Sender=Panel2 then SetValue(2);
  if Sender=Panel3 then SetValue(3);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
  );
begin
   case key of
   38:if Value>1 then SetValue(Value-1) else SetValue(3);
   40:if Value<3 then SetValue(Value+1) else SetValue(1);
   end;
end;

end.


PM MAIL   Вверх
vctorusv
Дата 31.8.2017, 20:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 6
Регистрация: 18.8.2017

Репутация: нет
Всего: нет



Цитата(v4v4n @ 30.8.2017,  14:21)
Код

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure PanelsMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
      );
    procedure SetValue(x:byte);
  private
    Value : byte;
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }
procedure TForm1.SetValue(x:byte);
begin
  Value:=x;
  if Value=1 then Panel1.Color:=clHighlight else Panel1.Color:=clDefault;
  if Value=2 then Panel2.Color:=clHighlight else Panel2.Color:=clDefault;
  if Value=3 then Panel3.Color:=clHighlight else Panel3.Color:=clDefault;
end;

procedure TForm1.PanelsMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Sender=Panel1 then SetValue(1);
  if Sender=Panel2 then SetValue(2);
  if Sender=Panel3 then SetValue(3);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
  );
begin
   case key of
   38:if Value>1 then SetValue(Value-1) else SetValue(3);
   40:if Value<3 then SetValue(Value+1) else SetValue(1);
   end;
end;

end.


SetValue устанавливается в Properties формы?
PM MAIL   Вверх
v4v4n
Дата 1.9.2017, 11:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 45
Регистрация: 26.9.2008

Репутация: 1
Всего: 4



SetValue вспомогательная процедура, с произвольным именем, которую и в класс-то можно было не добавлять (можно как глобальную оформить).
На форму нужно положить 3 панели и реакцией на событие OnMouseMove у всех панелей сделать PanelsMouseMove.
У формы OnKeyDown - FormKeyDown. И всё.

Или переписать так
Код

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
      );
    procedure Panel2MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
      );
    procedure Panel3MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
      );

  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  V :byte;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  V:=1;
  Panel1.Color:=clHighlight;
  Panel2.Color:=clDefault;
  Panel3.Color:=clDefault;
end;

procedure TForm1.Panel2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  V:=2;
  Panel1.Color:=clDefault;
  Panel2.Color:=clHighlight;
  Panel3.Color:=clDefault;
end;

procedure TForm1.Panel3MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  V:=3;
  Panel1.Color:=clDefault;
  Panel2.Color:=clDefault;
  Panel3.Color:=clHighlight;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
  );
begin
  case key of
  38:if V>1 then Dec(V) else V:=3;
  40:if V<3 then Inc(V) else V:=1;
  end;
  if V=1 then Panel1.Color:=clHighlight else Panel1.Color:=clDefault;
  if V=2 then Panel2.Color:=clHighlight else Panel2.Color:=clDefault;
  if V=3 then Panel3.Color:=clHighlight else Panel3.Color:=clDefault;
end;

end.    


Это сообщение отредактировал(а) v4v4n - 1.9.2017, 12:41
PM MAIL   Вверх
vctorusv
Дата 12.9.2017, 19:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 6
Регистрация: 18.8.2017

Репутация: нет
Всего: нет



Если для клавиши 40 нужно выполнить несколько условий?
PM MAIL   Вверх
v4v4n
Дата 18.9.2017, 12:10 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 45
Регистрация: 26.9.2008

Репутация: 1
Всего: 4



Цитата(vctorusv @  12.9.2017,  21:21 Найти цитируемый пост)
Если для клавиши 40 нужно выполнить несколько условий? 

Код

 40:begin
           if ... then ....;
           if ... then ....;

           if ... then ....;
        end;


PM MAIL   Вверх
Google
  Дата 22.11.2017, 13:59 (ссылка)  





  Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Для новичков"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.

 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Для новичков | Следующая тема »


 




[ Время генерации скрипта: 0.0700 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.