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

Вниз

Овальные кнопки   Найти похожие ветки 

← →
Лешка   (2002-11-28 20:32) [0]

Здравствуйте. Подскажите новичку как сделать кнопку и другие компоненты (например TImage) нестандартной формы. Везде искал - так толком ничего и не нашел. Везде говорят про создание двух картинок - нажато не нажато, но это я уже делал. Мне нужно чтобы действие происходило не на прямоугольной области компонента, а прямо на его изображении.

---

← →
Mihey   (2002-11-28 23:20) [1]

Например, используя компоненты, такие, как ToxButton.

---

← →
Diamond Cat ©   (2002-11-28 23:20) [2]

могу слить пример, пиши

---

← →
Oleg_Gashev ©   (2002-11-29 00:32) [3]


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
FormRgn, btnrgn, resultrgn: hRgn;
procedure CreateParams(var Params: TCreateParams); override;

{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
Form1.Brush.Style := bsSolid;

GetWindowRgn(Form1.Handle, FormRgn);

DeleteObject(FormRgn);
Form1.Height := 300;
Form1.Width := 600;
FormRgn := CreateEllipticRgn(1,10,Form1.Width - 1,Form1.height - 1);
SetWindowRgn(Form1.Handle, FormRgn, TRUE);
end;

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);

Params.Style := Params.Style or ws_popup xor ws_dlgframe xor WS_SIZEBOX;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Form1.Brush.Style := bsSolid;


GetWindowRgn(Form1.Handle, FormRgn);

DeleteObject(FormRgn);
Form1.Height := 500;
Form1.Width := Form1.Height;
FormRgn := CreateRoundRectRgn(1, 1, Form1.Width - 1,
Form1.height - 1, Form1.width, Form1.height);

SetWindowRgn(Form1.Handle, FormRgn, TRUE);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Application.Terminate;
end;



procedure TForm1.Button4Click(Sender: TObject);
begin
Button4.Brush.Style := bsSolid;
GetWindowRgn(Button4.Handle, btnrgn);
DeleteObject(btnrgn);
button4.Height := 30;
Button4.Width := Button4.Height;
btnrgn := CreateRoundRectRgn(1, 1, Button4.Width - 1,
Button4.height - 1, Button4.width, Button4.height);
SetWindowRgn(Button4.Handle, btnrgn, TRUE);
end;

procedure TForm1.FormPaint(Sender: TObject);
var
k: int64;
begin
k:=50;
canvas.Pen.Color:=clblue;
canvas.Pen.Width:=2;
canvas.Ellipse(1,1,496,496);
canvas.Pen.Width:=1;
canvas.Pen.Color:=clwhite;
canvas.Ellipse(1+k,1+k,496-k,496-k);
end;

end.

© Alexander Bondarenko
http://gashev.com/Source.php?id=13

---

← →
vJet ©   (2002-12-03 08:04) [4]

Можно воспользоватся регионами crateregion combineregion.

---

← →
OlDemon ©   (2002-12-03 08:11) [5]

2 Diamond Cat> Закинь и мне пожалуста если не жалко :)
Заранее благодарен.

---

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

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

Наверх

Память: 0.47 MB
Время: 0.016 c