Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Компоненты и классы
Перезагрузить страницу

Cвое событие на нажатие кнопки

Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 06.04.2013, 13:40
MDM MDM вне форума
Прохожий
  
Регистрация: 06.04.2013
Сообщения: 3
Версия Delphi: D7
Репутация: 10
По умолчанию Cвое событие на нажатие кнопки
Добрый день!
Помогите с GUI. Как повесить свое событие на нажатие кнопки?
Есть отдельный модуль, в котором я определил элементарный класс кнопки

Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
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);
так вот, мне нужно сделать по аналогии, но без визуализации компонента.
Я не хочу писать код для еще не созданных кнопок в отдельном модуле, где идут определения классов.

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

Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
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;
Но не тут то было, я что-то совсем запутался, помогите разобраться, желательно с коротким примером, как это реализовать.
Спасибо!
Ответить с цитированием
  #2  
Старый 06.04.2013, 15:46
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
  
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию
Цитата:
Сообщение от MDM
...Как повесить свое событие на нажатие кнопки?..Нужно чтобы код процедур кнопок был в Маин юните, и именно тот который напишет пользователь для каждой кнопки свой...
Так в чём проблема, правильное решение вы сами показали : btn1.onClick:= clickbtn; Всё дело в объявлении т.е. юзер будет делать так
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
...
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 нужно обявить процедуру клика
Код:
1
2
3
4
5
...
 private
        procedure clickbtn(Sender: TObject);
   end;
...
т.к. TNotifyEvent прописана как procedure(Sender: TObject) of object, а of object означает что она должна быть членом какого-нибудь класса, поэтому юзеру её и надо объявить в классе формы. Ну и сам код в Маин юните
Код:
1
2
3
4
procedure TForm1.clickbtn(Sender: TObject);
begin
ShowMessage('Я нажалась!');
end;
И всё.
Ответить с цитированием
  #3  
Старый 06.04.2013, 16:36
MDM MDM вне форума
Прохожий
  
Регистрация: 06.04.2013
Сообщения: 3
Версия Delphi: D7
Репутация: 10
По умолчанию
Я понимаю, что нужно делать как вы говорите, но топчусь на месте...
Посмотрите код, где я наврал?
Также, наверняка у меня будут проблемы с событиями leave и move, до них я еще не добрался...

Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
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.

маин
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
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.
Ответить с цитированием
  #4  
Старый 06.04.2013, 18:55
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
  
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию
Цитата:
Сообщение от MDM
...Посмотрите код, где я наврал?...
Извнт, копаться в коде нету желания, проще рабочий пример привести. Вот исходник кнопки из image`й
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
{*******************************************************}
{                                                       }
{       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...
Ответить с цитированием
  #5  
Старый 06.04.2013, 19:24
MDM MDM вне форума
Прохожий
  
Регистрация: 06.04.2013
Сообщения: 3
Версия Delphi: D7
Репутация: 10
По умолчанию
А пример использования?
Цитата:
примерно так //btn1.onClick:=clickbtn;
Ответить с цитированием
  #6  
Старый 06.04.2013, 19:25
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
  
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию
Цитата:
Сообщение от MDM
А пример использования?..
Да всё тоже самое. Раскрыто полностью во 2м посте.
Ответить с цитированием
Ответ

« Предыдущая тема | Следующая тема »

Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра
Комбинированный вид Комбинированный вид

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения
BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 05:54.

Обратная связь - Главная страница сайта Delphi Sources - Вверх

 

Сайт

Форум

FAQ

Соглашения

Прочее
 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025