[MDM]

Добрый день!
Помогите с GUI. Как повесить свое событие на нажатие кнопки?
Есть отдельный модуль, в котором я определил элементарный класс кнопки

Код:

TBaseObject = class (TObject)
    private
      X,Y,Width,Height: integer;

      Down, Focus, Visible: boolean;
    protected
      fMouseState: TMouseState;
      fOnMouseClick: TOnMouseClick;
      fOnMouseMove: TOnMouseMove;
    public
      Name : string;
      PathEnadle,
      PathDisable,
      PathFocuse: string;
      Constructor Create(AOwner: TComponent); //override;
      property OnMouseClick: TOnMouseClick read fOnMouseClick write fOnMouseClick;
      property OnMouseMove: TOnMouseMove read fOnMouseMove write fOnMouseMove;
      property OnClick: TNotifyEvent read FOnClick write FOnClick;

      Procedure SetMouseState(aMouseX, aMouseY: Single; aIsButtonDown: Boolean);
      procedure SetMouseMove(aMouseX, aMouseY: Single);
      procedure Draw(Canvas: TCanvas);
  end;

  TMyButton = class (TBaseObject)
    private

    public
      procedure Click;
      procedure SetPos(aX,aY, aW,aH:integer); virtual;
  end;

Полностью код расписывать не буду, для того чтобы понять суть вопроса, этого должно хватить.

В основном модуле приложения я создаю переменную кнопки, задаю ей необходимые параметры и т.п. По таймеру я ее отрисовываю.
Мне нужно определить событие нажатия/отжатия и др. Так как это сделано в делфи , на форму ставишь кнопку и в ее событие пишешь код,
procedure TForm1.Button1Click(Sender: TObject);
так вот, мне нужно сделать по аналогии, но без визуализации компонента.
Я не хочу писать код для еще не созданных кнопок в отдельном модуле, где идут определения классов.

Основной модуль примерно такой:

Код:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Timer1.Enabled:=true;
  btn1 := TMyButton.Create(Self);
  btn1.SetPos(20,20,128,32);
  btn1.Name:='Button1';
  btn1. PathEnadle:='..\mygui\textures\down.bmp';
  btn1. PathDisable:='..\mygui\textures\up.bmp';
  btn1. PathFocuse:='..\mygui\textures\focus.bmp';
  btn1.Draw(image1.Picture.Bitmap.Canvas);
  //btn1.onClick:=clickbtn;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then MousLeftDown:=true;
  btn1.SetMouseState(x, y, MousLeftDown);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  pos:TPoint;
begin
  btn1.Draw(Image1.Canvas);
end;

Нужно чтобы код процедур кнопок был в Маин юните, и именно тот который напишет пользователь для каждой кнопки свой. Копался в модулях StdCtrls, Controls, в Интернет ресурсах, но то что нужно не нашел или нашел, но знаний понять и переделать не хватает. Сначала подумал, что как-то можно присвоить событию нажатия свою процедуру, примерно так //btn1.onClick:=clickbtn;
Но не тут то было, я что-то совсем запутался, помогите разобраться, желательно с коротким примером, как это реализовать.
Спасибо!

[Alegun]

Сообщение от MDM

...Как повесить свое событие на нажатие кнопки?..Нужно чтобы код процедур кнопок был в Маин юните, и именно тот который напишет пользователь для каждой кнопки свой...

Так в чём проблема, правильное решение вы сами показали : btn1.onClick:= clickbtn; Всё дело в объявлении т.е. юзер будет делать так

Код:

...
var
btn1: TMyButton;
begin
 btn1 := TMyButton.Create(Self);
 btn1.SetPos(20,20,128,32);
 btn1.Name:='Button1';
 btn1. PathEnadle:='..\mygui\textures\down.bmp';
 btn1. PathDisable:='..\mygui\textures\up.bmp';
 btn1. PathFocuse:='..\mygui\textures\focus.bmp';
 btn1.Draw(image1.Picture.Bitmap.Canvas);
 btn1.onClick:= clickbtn;
end;

Но до этого в секции private нужно обявить процедуру клика

Код:

...
 private
        procedure clickbtn(Sender: TObject);
   end;
...

т.к. TNotifyEvent прописана как procedure(Sender: TObject) of object, а of object означает что она должна быть членом какого-нибудь класса, поэтому юзеру её и надо объявить в классе формы. Ну и сам код в Маин юните

Код:

procedure TForm1.clickbtn(Sender: TObject);
begin
ShowMessage('Я нажалась!');
end; 

И всё.

[MDM]

Я понимаю, что нужно делать как вы говорите, но топчусь на месте...
Посмотрите код, где я наврал?
Также, наверняка у меня будут проблемы с событиями leave и move, до них я еще не добрался...

Код:

unit gui;

interface

uses Graphics, Classes;

type
  TBaseObject = class;

  TMouseState = (ms_MouseOut, ms_MouseIn);
  TOnMouseClick = Procedure (aSender: TBaseObject) of object;
  TOnMouseMove = Procedure (aSender: TBaseObject) of object;

  TBaseObject = class (TObject)
    private
      X,Y,Width,Height: integer;
      Down, Focus, Visible: boolean;

      function IsHit(aMouseX, aMouseY: Single): boolean;
    protected
      fMouseState: TMouseState;
      fOnMouseClick: TOnMouseClick;
      fOnMouseMove: TOnMouseMove;
      FOnClick: TNotifyEvent;
    public
      Name : string;
      SpritePathEnadle,
      SpritePathDisable,
      SpritePathFocuse: string;
      Constructor Create(AOwner: TComponent); //override;
      property OnMouseClick: TOnMouseClick read fOnMouseClick write fOnMouseClick;
      property OnMouseMove: TOnMouseMove read fOnMouseMove write fOnMouseMove;
      property OnClick: TNotifyEvent read FOnClick write FOnClick;

      Procedure SetMouseState(aMouseX, aMouseY: Single; aIsButtonDown: Boolean);
      procedure SetMouseMove(aMouseX, aMouseY: Single);
      procedure Draw(Canvas: TCanvas);
  end;

  TMyButton = class (TBaseObject)
    private
      procedure ButtonClick(sender: TObject);
    public
      procedure SetPos(aX,aY, aW,aH:integer); virtual;
  end;


implementation


constructor TBaseObject.Create(AOwner: TComponent);
begin
  fMouseState := ms_MouseOut;
  Visible:=true;
  Down:=false;
  Focus:=false;
  fOnMouseClick := nil;
  fOnMouseMove:= nil;
end;

procedure TBaseObject.Draw(Canvas: TCanvas);
var
  bmp: TBitmap;
  path: string;
begin
  bmp:= TBitmap.Create;
  if not Down then
  begin
    if Focus then
      path:=SpritePathFocuse
    else
      path:=SpritePathDisable;
  end
  else
    path:=SpritePathEnadle;
    
  bmp.LoadFromFile(path);
  Canvas.Draw(X,Y,bmp);
  bmp.Free;
end;

function TBaseObject.IsHit(aMouseX, aMouseY: Single): boolean;
begin
  result := (aMouseX >= X) and (aMouseX <= Width) and (aMouseY >= Y) and (aMouseY <= Height);
end;

procedure TBaseObject.SetMouseMove(aMouseX, aMouseY: Single);
begin
  Focus:=IsHit(aMouseX,aMouseY);
  if Focus and Assigned(fOnMouseMove) then
    fOnMouseMove(self);
end;

procedure TBaseObject.SetMouseState(aMouseX, aMouseY: Single;  aIsButtonDown: Boolean);
begin
  Down:=aIsButtonDown;
  if IsHit(aMouseX, aMouseY) then
  begin
    if Assigned(fOnMouseClick) then
      fOnMouseClick(self);
  end;
end;


{ TMyButton }


procedure TMyButton.ButtonClick(sender: TObject);
begin
  inherited;
  Name:=Name+'Hi';

end;

procedure TMyButton.SetPos(aX, aY, aW,aH: integer);
begin
  X:=aX;  Y:=aY;
  Width:=aW;  Height:=aH;
end;


end.

маин

Код:

unit Unit1;

interface

uses
  ...,
  gui;

type
  TForm1 = class(TForm)
  //...
  private
    { Private declarations }
  public
    procedure ButtonClick;
  end;

var
  Form1: TForm1;
  btn1: TMyButton;
  MousLeftDown: boolean=false;

implementation

{$R *.dfm}


procedure TForm1.ButtonClick;
begin
   ShowMessage('hello world');
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  Timer1.Enabled:=true;
  btn1 := TMyButton.Create(Self);
  btn1.SetPos(20,20,128,32);
  btn1.Name:='Button1';
  btn1.SpritePathEnadle:='..\mygui\textures\down.bmp';
  btn1.SpritePathDisable:='..\mygui\textures\up.bmp';
  btn1.SpritePathFocuse:='..\mygui\textures\focus.bmp';
  btn1.Draw(image1.Picture.Bitmap.Canvas);
  //btn1.OnClick:=ButtonClick;//ошибка
//[Error] Unit1.pas(57): Incompatible types: 'Parameter lists differ'
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then MousLeftDown:=true;
  btn1.SetMouseState(x, y, MousLeftDown);
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    MousLeftDown:=false;
  btn1.SetMouseState(x, y, MousLeftDown);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  pos:TPoint;
begin
  btn1.Draw(Image1.Canvas);
  GetCursorPos(pos);
  Label1.Caption:='X= '+IntToStr(pos.X)+' Y= '+IntToStr(pos.Y);
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,  Y: Integer);
begin
  btn1.SetMouseMove(x,y);
end;

end.

[Alegun]

Сообщение от MDM

...Посмотрите код, где я наврал?...

Извнт, копаться в коде нету желания, проще рабочий пример привести. Вот исходник кнопки из image`й

Код:

{*******************************************************}
{                                                       }
{       Sprite Button                                   }
{                                                       }
{       Copyright (c) 2004-2005, Михаил Мостовой        }
{                                (s-mike)               }
{       http://forum.sources.ru                         }
{       http://mikesoft.front.ru                        }
{                                                       }
{*******************************************************}
unit SpriteBtn;

interface

uses Windows, SysUtils, Classes, Controls, Graphics, Types, Messages;
type
TSpriteButton = class(TGraphicControl)
private
   FPicturePressed: TPicture;
   FPictureFocused: TPicture;
   FPictureNormal: TPicture;
   FPictureDisabled: TPicture;
   FEnabled: Boolean;
   FPressed: Boolean;
   FFocused: Boolean;
   FDrawing: Boolean;
   FTransparent: Boolean;
   procedure SetPictureFocused(const Value: TPicture);
   procedure SetPicturePressed(const Value: TPicture);
   procedure SetPictureNormal(const Value: TPicture);
   procedure SetPictureDisabled(const Value: TPicture);
   procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
   procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
   procedure OnPictureChange(Sender: TObject);
   procedure UpdateButtonState;
   procedure SetTransparent(const Value: Boolean);
protected
   procedure Paint; override;
   procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
   procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
published
   property Action;
   property Anchors;
   property Caption;
   property Enabled;
   property Font;
   property ShowHint;
   property ParentShowHint;
   property OnClick;
   property OnMouseDown;
   property PictureNormal: TPicture read FPictureNormal write SetPictureNormal;
   property PictureFocused: TPicture read FPictureFocused write SetPictureFocused;
   property PicturePressed: TPicture read FPicturePressed write SetPicturePressed;
   property PictureDisabled: TPicture read FPictureDisabled write SetPictureDisabled;
   property Transparent: Boolean read FTransparent write SetTransparent;
end;

procedure Register;
implementation

uses Consts;

procedure Register;
begin
RegisterComponents('MSX Controls', [TSpriteButton]);
end;

{ TSpriteButton }
constructor TSpriteButton.Create(AOwner: TComponent);
begin
inherited;
FEnabled := True;
FPictureNormal := TPicture.Create;
FPictureNormal.OnChange := OnPictureChange;
FPictureFocused := TPicture.Create;
FPicturePressed := TPicture.Create;
FPictureDisabled := TPicture.Create;
FPressed := False;
FFocused := False;
FDrawing := False;
end;

destructor TSpriteButton.Destroy;
begin
FPictureNormal.Free;
FPictureFocused.Free;
FPicturePressed.Free;
FPictureDisabled.Free;
inherited;
end;

procedure TSpriteButton.SetPictureNormal(const Value: TPicture);
begin
PictureNormal.Assign(Value);
if Assigned(Value) then
begin
   Width := Value.Width;
   Height := Value.Height;
end;
if not FDrawing then Invalidate;
end;

procedure TSpriteButton.SetPictureFocused(const Value: TPicture);
begin
FPictureFocused.Assign(Value);
end;

procedure TSpriteButton.SetPicturePressed(const Value: TPicture);
begin
FPicturePressed.Assign(Value);
end;

procedure TSpriteButton.SetPictureDisabled(const Value: TPicture);
begin
FPictureDisabled.Assign(Value);
end;

procedure TSpriteButton.CMMouseEnter(var Message: TMessage);
begin
if Enabled = False then Exit;
FFocused := True;
if not FDrawing then Invalidate;
end;

procedure TSpriteButton.CMMouseLeave(var Message: TMessage);
begin
if Enabled = False then Exit;
FFocused := False;
if not FDrawing then Invalidate;
end;

procedure TSpriteButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if Enabled = False then Exit;
if Button = mbLeft then
begin
   FPressed := True;
   FFocused := True;
   if not FDrawing then Invalidate;
end;
end;

procedure TSpriteButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if Enabled = False then Exit;
if Button = mbLeft then
begin
   FPressed := False;
   if not FDrawing then Invalidate;
end;
inherited;
end;

procedure TSpriteButton.OnPictureChange(Sender: TObject);
begin
Width := PictureNormal.Width;
Height := PictureNormal.Height;
if not FDrawing then Invalidate;
end;

procedure TSpriteButton.UpdateButtonState;
var
Picture: TPicture;
begin
if Enabled then
begin
   if not (csDesigning in ComponentState) then
   begin
     if (FPressed and FFocused) then Picture := PicturePressed
     else
       if (not FPressed and FFocused) then Picture := PictureFocused
         else
              Picture := PictureNormal;
        end else Picture := PictureNormal;
end else begin
   FFocused := False;
   FPressed := False;
   Picture := PictureDisabled;
end;
if (Picture <> PictureNormal) and
((Picture.Width = 0) or (Picture.Height = 0)) then Picture := PictureNormal;
if (csDesigning in ComponentState) and
((not Assigned(Picture.Graphic)) or (Picture.Width = 0) or (Picture.Height = 0))
then begin
   with Canvas do
   begin
     Pen.Style := psDash;
     Pen.Color := clBlack;
     Brush.Color := Color;
     Brush.Style := bsSolid;
     Rectangle(0, 0, Width, Height);
   end;
   Exit;
end;
if Assigned(Picture.Graphic) then
begin
   if not ((Picture.Graphic is TMetaFile) or (Picture.Graphic is TIcon)) then
     Picture.Graphic.Transparent := FTransparent;
   Canvas.Draw(0, 0, Picture.Graphic);
end;
end;

procedure TSpriteButton.Paint;
var
R: TRect;
begin
if FDrawing then Exit;
FDrawing := True;
try
   UpdateButtonState;
   if Caption <> '' then
   begin
     R := ClientRect;
     Canvas.Font.Assign(Font);
     Canvas.Brush.Style := bsClear;
     R := ClientRect;
     R.Top := 0;
     R.Bottom := 0;
     Inc(R.Left, 14);
     Dec(R.Right, 14);
     DrawText(Canvas.Handle,PChar(Caption), -1, R, DT_WORDBREAK or DT_CALCRECT);
     R.Right := ClientWidth - 14;
     R.Top := (ClientHeight - (R.Bottom - R.Top)) div 2;
     R.Bottom := ClientHeight;
     DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_WORDBREAK or DT_CENTER);
   end;
finally
   FDrawing := False;
end;
end;

procedure TSpriteButton.SetTransparent(const Value: Boolean);
begin
if Value <> FTransparent then
begin
   FTransparent := Value;
   if not FDrawing then Invalidate;
end;
end;

end.  //©Drkb::01242

Здесь кстати, реализованы события leave и move...

[MDM]

А пример использования?

примерно так //btn1.onClick:=clickbtn;

[Alegun]

Сообщение от MDM

А пример использования?..

Да всё тоже самое. Раскрыто полностью во 2м посте.