10.10.2012, 10:16
|
|
Let Me Show You
|
|
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
|
|
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TGraphicButton = class(TCustomControl)
private
ColorEnter: TColor;
ColorLeave: TColor;
Text: String;
protected
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure Paint; override;
end;
TForm1 = class(TForm)
Image1: TImage;
Label1: TLabel;
Label2: TLabel;
procedure FormPaint(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure WMNCHITTEST(var Msg: TMessage); message WM_NCHITTEST;
procedure ClickClose(Sender: TObject);
procedure ClickMinimize(Sender: TObject);
procedure ClickMaximize(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TGraphicButton }
procedure TGraphicButton.CMMouseEnter(var Message: TMessage);
begin
Color:=ColorEnter;
end;
procedure TGraphicButton.CMMouseLeave(var Message: TMessage);
begin
Color:=ColorLeave;
end;
procedure TGraphicButton.Paint;
var
r: TRect;
begin
Canvas.Brush.Color:=Color;
Canvas.Pen.Color:=Color;
Canvas.FillRect(ClientRect);
Canvas.Font.Style:=[fsBold];
Canvas.Font.Color:=clWhite;
r:=ClientRect;
DrawText(Canvas.Handle, PChar(Text), -1, r, DT_CENTER or DT_SINGLELINE or DT_VCENTER);
end;
{ TForm1 }
procedure TForm1.WMNCHITTEST(var Msg: TMessage);
const
n = 6;
var
x, y: Integer;
begin
x:=LOWORD(Msg.LParam);
y:=HIWORD(Msg.LParam);
if (Abs(Left+Width-x)<n) and (Abs(Top+Height-y)<n) then Msg.Result:=HTBOTTOMRIGHT
else if (Abs(Left-x)<n) and (Abs(Top+Height-y)<n) then Msg.Result:=HTBOTTOMLEFT
else if (Abs(Left+Width-x)<n) and (Abs(Top-y)<n) then Msg.Result:=HTTOPRIGHT
else if (Abs(Left-x)<n) and (Abs(Top-y)<n) then Msg.Result:=HTTOPLEFT
else if Abs(Left-x)<n then Msg.Result:=HTLEFT
else if Abs(Top-y)<n then Msg.Result:=HTTOP
else if Abs(Left+Width-x)<n then Msg.Result:=HTRIGHT
else if Abs(Top+Height-y)<n then Msg.Result:=HTBOTTOM
else if y-Top<48 then Msg.Result:=HTCAPTION
else Msg.Result:=HTCLIENT;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.Brush.Style:=bsClear;
Canvas.Pen.Color:=$404040;
Canvas.Rectangle(0, 0, Width, Height);
Canvas.Rectangle(1, 1, Width-1, Height-1);
Canvas.Rectangle(2, 2, Width-2, Height-2);
Canvas.Brush.Color:=$404040;
Canvas.Rectangle(Rect(0, 0, Width, 48));
end;
procedure TForm1.FormResize(Sender: TObject);
begin
Invalidate;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DoubleBuffered:=True;
with TGraphicButton.Create(Self) do
begin
Parent:=Self;
Width:=72;
Height:=24;
Top:=0;
Left:=Self.Width-Width-12;
ColorEnter:=$ff;
ColorLeave:=$e0;
Color:=$e0;
Anchors:=[akRight, akTop];
OnClick:=ClickClose;
Text:='Закрыть';
end;
with TGraphicButton.Create(Self) do
begin
Parent:=Self;
Width:=24;
Height:=24;
Top:=0;
Left:=Self.Width-4*Width-2*12;
ColorEnter:=$ff;
ColorLeave:=$e0;
Color:=$e0;
Anchors:=[akRight, akTop];
OnClick:=ClickMaximize;
Text:='|';
end;
with TGraphicButton.Create(Self) do
begin
Parent:=Self;
Width:=24;
Height:=24;
Top:=0;
Left:=Self.Width-5*Width-3*12;
ColorEnter:=$ff;
ColorLeave:=$e0;
Color:=$e0;
Anchors:=[akRight, akTop];
OnClick:=ClickMinimize;
Text:='_';
end;
end;
procedure TForm1.ClickClose(Sender: TObject);
begin
Close;
end;
procedure TForm1.ClickMinimize(Sender: TObject);
begin
Application.Minimize;
end;
procedure TForm1.ClickMaximize(Sender: TObject);
var
WindowPlacement: TWindowPlacement;
begin
GetWindowPlacement(Handle, @WindowPlacement);
if WindowPlacement.showCmd=SW_SHOWMAXIMIZED then
SendMessage(Handle, WM_SYSCOMMAND, SC_RESTORE, 0)
else
SendMessage(Handle, WM_SYSCOMMAND, SC_MAXIMIZE, 0);
end;
end.
http://zalil.ru/upload/33836534
__________________
Пишу программы за еду.
__________________
|