Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Для новичков > Многозадачное меню на основе компонента TPanel


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

Автор: 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.

Автор: vctorusv 31.8.2017, 20:05
Цитата(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 формы?

Автор: v4v4n 1.9.2017, 11:52
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.    

Автор: vctorusv 12.9.2017, 19:21
Если для клавиши 40 нужно выполнить несколько условий?

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

Код

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

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

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)