Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Потрепаться";
Текущий архив: 2003.05.22;
Скачать: [xml.tar.bz2];

Вниз

Моя кнопка   Найти похожие ветки 

 
tytus   (2003-05-01 19:26) [0]

Мастера - HELP! (Код прилагается). Трабл ---> Когда я кладу на форму мою кнопку, то при движении мыши она (кнопка...) меняет цвет, а когда запускаю прогу - то все нормально. Попробуйте в действии и разъясните пожалуйста, что я упустил.
P.S. И подскажите, как мне сделать для нее CAPTION??????
Я делаю так

var mb:TMButton;
procedure TForm1.FormCreate(Sender: TObject);
begin
mb:=TMButton.Create(self);
mb.Parent:=self;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
mb.Destroy;
end;

end.

А вот и код моей кнопки

unit MB;

interface

uses
SysUtils, Windows, Messages, Classes, Controls, Forms, Graphics, StdCtrls,
ExtCtrls, CommCtrl;

type
TMButton = class(TGraphicControl)
private
{ Private declarations }
MouseOnControl:Boolean;
FOnMouseEnter:TNotifyEvent;
FOnMouseLeave:TNotifyEvent;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
protected
{ Protected declarations }
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure Paint; override;

public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Click; override;
property OnMouseEnter:TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave:TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
published
{ Published declarations }
property OnClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;

property ParentShowHint;
property ShowHint;
end;

procedure Register;

implementation
var PaintRect:TRect;
procedure Register;
begin
RegisterComponents("MaPage", [TMButton]);
end;

constructor TMButton.Create(AOwner:TCOmponent);
begin inherited Create(AOwner);
MouseOnControl:=False;
setbounds(10,10,75,25);
Color:=$00efd3c6;

end;
destructor TMButton.Destroy;
begin

inherited Destroy;
end;

procedure TMButton.Paint;
var i:integer;tb:TRect;
begin
PaintRect:=ClientRect;
canvas.Pen.Color:=color;
with canvas do begin
for i:=paintrect.Top to (paintrect.Top+paintrect.Bottom) do begin
MoveTo(paintrect.Left,i);
LineTo(paintrect.Right,i);
Pen.Color:=canvas.Pen.Color-$6ff;
end; end;
frame3d(canvas,paintrect,$00efd3c6,$00c66931,2);
tb:=Rect(0,0,paintrect.Right-paintrect.Left,0);
setbkMode(canvas.Handle,transparent);
DrawText(canvas.Handle,"My Button",9,PaintRect,dt_Center + dt_VCenter);

end;

procedure TMButton.Click;
begin

inherited click;
end;

procedure TMButton.CMMouseEnter(var Message:TMessage);
begin
MouseOnControl:=True;
color:=color+$2eff;
repaint;

end;

procedure TMButton.CMMouseLeave(var Message:TMessage);
begin MouseOnControl:=False;
color:=$00efd3c6;
repaint;

end;

procedure TMButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin if MouseOnControl=true then begin
paintrect:=clientrect;
Frame3d(canvas,paintrect,$00c66931,$00efd3c6,2);
inherited MouseDown(Button, Shift, X, Y);end;
{ invalidate;}
end;

procedure TMButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
repaint;
inherited MouseUp(Button, Shift, X, Y);
{ invalidate;}
end;

procedure TMButton.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited MouseMove(Shift, X, Y);
{invalidate; }
end;


end.


 
Fenik   (2003-05-02 00:23) [1]

Посмотри код для TSpeedButton и сделай по аналогии.



Страницы: 1 вся ветка

Форум: "Потрепаться";
Текущий архив: 2003.05.22;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.46 MB
Время: 0.006 c
1-70378
OpoloXAI
2003-05-10 17:46
2003.05.22
mainForm.Hide


1-70314
chuvak
2003-05-08 15:14
2003.05.22
Как получить путь к каталогу из которого запущена программа?


3-70115
vick_pvm
2003-04-28 16:49
2003.05.22
BDE почему-то держит директорию после закрытия таблицы.


1-70283
Deus
2003-05-11 16:55
2003.05.22
Ошибка Internal Error: L594.


14-70450
sorry
2003-04-30 20:17
2003.05.22
Атипичная пневмония ?! Что скрывают ?!





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский