Содержание материала

Code:

type

TForm1 = class(TForm)

   procedure FormPaint(Sender: TObject);

   procedure FormResize(Sender: TObject);

   procedure FormCreate(Sender: TObject);

private

   { Private declarations }

public

   procedure WMNCPAINT(var msg:tmessage);message WM_NCPAINT;

   procedure WMNCACTIVATE(var msg:tmessage);message WM_NCACTIVATE;

   procedure WMNCMOUSEDOWN(var msg:tmessage);message WM_NCLBUTTONDOWN;

   procedure WMNCMOUSEMOVE(var msg:tmessage);message WM_NCMOUSEMOVE;

   procedure WMMOVE(var msg:tmessage);message WM_MOUSEMOVE;

   procedure WMLBUTTONUP(var msg:tmessage);message WM_LBUTTONUP;

   procedure WMNCMOUSEUP(var msg:tmessage);message WM_NCLBUTTONUP;

   procedure WNCLBUTTONDBLCLICK(var msg:tmessage);message WM_NCLBUTTONDBLCLK;

end;

 

var

Form1: TForm1;

h1:thandle;

pressed:boolean;

focuslost:boolean;

rec:trect;

implementation

 

{$R *.DFM}

 

procedure tform1.WMLBUTTONUP(var msg:tmessage);

begin

pressed:=false;

invalidaterect(form1.handle,@rec,true);

inherited;

end;

 

procedure tform1.WMMOVE(var msg:tmessage);

var tmp:boolean

begin

tmp:=focuslost;

focuslost:=true;

if tmp<>focuslost then

invalidaterect(form1.handle,@rec,true);

inherited;

end;

 

procedure tform1.WMNCMOUSEMOVE(var msg:tmessage);

var

pt1:tpoint;

tmp:boolean;

begin

tmp:=focuslost;

pt1.x:=msg.LParamLo-form1.left;

pt1.y:=msg.LParamHi-form1.top;

if not(ptinrect(rec,pt1)) then

focuslost:=true

else

focuslost:=false;

if tmp<>focuslost then

invalidaterect(form1.handle,@rec,true);

end;

 

procedure tform1.WNCLBUTTONDBLCLICK(var msg:tmessage);

var pt1:tpoint;

begin

pt1.x:=msg.LParamLo-form1.left;

pt1.y:=msg.LParamHi-form1.top;

if not(ptinrect(rec,pt1)) then

inherited;

end;

 

procedure tform1.WMNCMOUSEUP(var msg:tmessage);

var pt1:tpoint;

begin

pt1.x:=msg.LParamLo-form1.left;

pt1.y:=msg.LParamHi-form1.top;

if (ptinrect(rec,pt1)) and (focuslost=false) then

begin

  pressed:=false;

  {

    enter your code here when the button is clicked  

  }

  invalidaterect(form1.handle,@rec,true);

end

else

begin

  pressed:=false;

  focuslost:=true;

  inherited;

end;

end;

 

procedure tform1.WMNCMOUSEDOWN(var msg:tmessage);

var pt1:tpoint;

begin

pt1.x:=msg.LParamLo-form1.left;

pt1.y:=msg.LParamHi-form1.top;

if ptinrect(rec,pt1) then

begin

  pressed:=true;

  invalidaterect(form1.handle,@rec,true);

end

else

begin

  form1.paint;

  inherited;

end;

end;

 

procedure tform1.WMNCACTIVATE(var msg:tmessage);

begin

invalidaterect(form1.handle,@rec,true);

inherited;

end;

 

procedure tform1.WMNCPAINT(var msg:tmessage);

 

begin

invalidaterect(form1.handle,@rec,true);

inherited;

end;

 

 

procedure TForm1.FormPaint(Sender: TObject);

begin

h1:=getwindowdc(form1.handle);

rec.left:=form1.width-75;

rec.top:=6;

rec.right:=form1.width-60;

rec.bottom:=20;

selectobject(h1,getstockobject(ltgray_BRUSH));

rectangle(h1,rec.left,rec.top,rec.right,rec.bottom);

if (pressed=false) or (focuslost=true) then

drawedge(h1,rec,EDGE_RAISED,BF_RECT)

else if (pressed=true) and (focuslost=false) then

drawedge(h1,rec,EDGE_SUNKEN,BF_RECT);

releasedc(form1.handle,h1);

end;

 

procedure TForm1.FormResize(Sender: TObject);

begin

form1.paint;

end;

 

procedure TForm1.FormCreate(Sender: TObject);

begin

rec.left:=0;

rec.top:=0;

rec.bottom:=0;

rec.right:=0;

end;

 

Добавить комментарий

Не использовать не нормативную лексику.

Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.

ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!


Защитный код
Обновить