Текущий архив: 2006.06.25;
Скачать: CL | DM;

Вниз

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-ы тоже не в восторге.

---

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

> DVM ©   (01.06.06 17:40) [6]

Не орите.
Спасибо.Попробую.

---

← →
Gero ©   (2006-06-01 17:55) [10]

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

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

---

← →
StriderMan ©   (2006-06-01 18:35) [11]

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

---

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

Текущий архив: 2006.06.25;
Скачать: CL | DM;

Наверх

Память: 0.5 MB
Время: 0.026 c