Форум: "Потрепаться";
Текущий архив: 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.45 MB
Время: 0.006 c