Button

← →
Der Nechk@ssoff © (2006-06-01 17:18) [0]

Здрасте!Подскажите где можно скачать круглую кнопку,как в PowerDVD или как в телефонах-"раскладушках"?

← →
Gero © (2006-06-01 17:19) [1]

Попробуй выковырять из телефона-раскладушки.

← →
tesseract © (2006-06-01 17:24) [2]

SetWindowRgn

← →
DVM © (2006-06-01 17:27) [3]

> Здрасте!

Не совсем круглая, но выглядит круглой с соответствующими битмапами.
unit MyButton; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TImageButton = class(TCustomControl) private MOver: TBitmap; MDown: TBitmap; MUp: TBitmap; Bmp: TBitmap; ActualBmp: TBitmap; BmpDAble: TBitmap; BtnClick: TNotifyEvent; OnMDown: TMouseEvent; OnMUp: TMouseEvent; OnMEnter: TNotifyEvent; OnMLeave: TNotifyEvent; procedure SetMOver(Value: TBitmap); procedure SetMDown(Value: TBitmap); procedure SetMUp(Value: TBitmap); procedure SetBmp(Value: TBitmap); procedure SetBmpDAble(Value: TBitmap); protected procedure Paint; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseEnter(var Message: TMessage); message CM_MOUSEENTER; procedure MouseLeave(var Message: TMessage); message CM_MOUSELEAVE; procedure Click; override; public constructor Create(AOwner: TComponent); override; published property BitmapOver: TBitmap read MOver write SetMOver; property BitmapDown: TBitmap read MDown write SetMDown; property BitmapUp: TBitmap read MUp write SetMUp; property BitmapDisabled: TBitmap read BmpDAble write SetBmpDAble; property Bitmap: TBitmap read Bmp write SetBmp; property OnClick: TNotifyEvent read BtnClick write BtnClick; property OnMouseDown: TMouseEvent read OnMDown write OnMDown; property OnMouseUp: TMouseEvent read OnMUp write OnMUp; property OnMouseEnter: TNotifyEvent read OnMEnter write OnMEnter; property OnMouseLeave: TNotifyEvent read OnMLeave write OnMLeave; property Enabled; property ShowHint; property ParentShowHint; end; procedure Register; implementation procedure Register; begin RegisterComponents("Buttons", [TImageButton]); end; constructor TImageButton.Create(AOwner: TComponent); begin inherited Create(AOwner); MOver := TBitmap.Create; MDown := TBitmap.Create; MUp := TBitmap.Create; Bmp := TBitmap.Create; BmpDAble := TBitmap.Create; ActualBmp := TBitmap.Create; Width := 50; Height := 50; Canvas.Brush.Color := clBtnFace; ShowHint := true; end; procedure TImageButton.Paint; begin inherited Paint; if ActualBmp.Width = 0 then ActualBmp.Assign(Bmp); // Canvas.FillRect(Rect(0,0,Width,Height)); if Enabled or (BmpDAble.Width = 0) then Canvas.Draw(0,0,ActualBmp) else begin Width := BmpDAble.Width; Height := BmpDAble.Height; Canvas.Draw(0,0,BmpDAble); end; end; procedure TImageButton.Click; begin inherited Click; Paint; if Enabled then if Assigned(BtnClick) then BtnClick(Self); end; procedure TImageButton.SetMOver(Value: TBitmap); begin MOver.Assign(Value); Paint; end; procedure TImageButton.SetMDown(Value: TBitmap); begin MDown.Assign(Value); Paint; end; procedure TImageButton.SetMUp(Value: TBitmap); begin MUp.Assign(Value); Paint; end; procedure TImageButton.SetBmp(Value: TBitmap); begin Bmp.Assign(Value); ActualBmp.Assign(Value); Width := Bmp.Width; Height := Bmp.Height; Paint; end; procedure TImageButton.SetBmpDAble(Value: TBitmap); begin BmpDAble.Assign(Value); paint; end; procedure TImageButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseDown(Button, Shift, X, Y); if (Button = mbLeft) and Enabled then begin if Assigned (OnMDown) then OnMDown(Self, Button, Shift, X, Y); if MDown.Width > 0 then begin ActualBmp.Assign(MDown); Width := MDown.Width; Height := MDown.Height; Paint; end; end; end; procedure TImageButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var MouseOverButton: Boolean; P: TPoint; begin inherited MouseUp(Button, Shift, X, Y); if (Button = mbLeft) and Enabled then begin if Assigned (OnMUp) then OnMUp(Self, Button, Shift, X, Y); if MUp.Width > 0 then begin GetCursorPos(P); MouseOverButton := (FindDragTarget(P, True) = Self); if MouseOverButton then begin Width := MUp.Width; Height := MUp.Height; Canvas.FillRect(Rect(0,0,Width,Height)); Canvas.Draw(0,0,MUp); end else begin Width := bmp.Width; Height := Bmp.Height; Canvas.FillRect(Rect(0,0,Width,Height)); Canvas.Draw(0,0,Bmp); end; end else begin if MouseOverButton = false then begin Width := MOver.Width; Height := MOver.Height; Canvas.FillRect(Rect(0,0,Width,Height)); Canvas.Draw(0,0,MOver); end else begin Width := bmp.Width; Height := Bmp.Height; Canvas.FillRect(Rect(0,0,Width,Height)); Canvas.Draw(0,0,Bmp); end; end; end; end; procedure TImageButton.MouseEnter(var Message: TMessage); begin if Enabled then begin if MOver.Width > 0 then begin ActualBmp.Assign(MOver); Width := MOver.Width; Height := MOver.Height; Paint; end; end; end; procedure TImageButton.MouseLeave(var Message: TMessage); begin if Enabled then begin if Bmp.Width > 0 then begin ActualBmp.Assign(Bmp); Width := Bmp.Width; Height := Bmp.Height; Paint; end; end; end; end.

← →
J_f_S (2006-06-01 17:30) [4]

Use da ActiveSkin

← →
Der Nechk@ssoff © (2006-06-01 17:35) [5]

> DVM © (01.06.06 17:27) [3]

жутковато.
А компонента нет такого?

← →
DVM © (2006-06-01 17:40) [6]

> А компонента нет такого?

А ПЕРЕД ТОБОЙ ЧТО??? ЭТО РАЗЬВЕ НЕ КОМПОНЕНТ????

← →
J_f_S (2006-06-01 17:42) [7]

Der Nechk@ssoff
жутковато.
А компонента нет такого?

Вот за такие фразы стандартный сионист ненавидит стандартного дельфина.

← →
tesseract © (2006-06-01 17:45) [8]

> Вот за такие фразы стандартный сионист ненавидит стандартного
> дельфина.

старые psacalist-ы тоже не в восторге.

> А ПЕРЕД ТОБОЙ ЧТО??? ЭТО РАЗЬВЕ НЕ КОМПОНЕНТ????

Это код какой-то, буков много. А компонент он квадратненький, с рисунком должен быть!

ИМХО круглые кнопки из лифтов лучше выковыривать, они с подсветочкой, и Caption на некоторых есть.

Button Найти похожие ветки