Add a button to the caption bar of your form

Add a button to the caption bar of the form

I have created a component that allows you to add buttons to the caption bar of your form. Here is the code.



____________Code______________



unit TitleButton;



interface



uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;



const

 WM_MOUSELEAVE=$B014;



type

 TChangedProperty=(cpdown,cpallowallup,cpgroupindex);

type

  TTitleButton = class(Tcomponent)

  private

   fbuttonrect:trect;

   fpressed,ffocused:boolean;

   fbuttoncaption:string;

   fwidth:integer;

   fleft:integer;

   fvisible:boolean;

   fhintshow:boolean;

   fhint:thintwindow;

   fhinttext:string;

   fgroupindex:integer;

   fdown:boolean;

   fallowallup:boolean;

   fparent:Tform;

   fparentwidth:integer;

   ficonwidth:integer;

   fcallinheritedevent:boolean;

   fdefaultwidth:integer;

   fdefaultheight:integer;

   ffont:Tfont;

   ficon:Ticon;

   fborder3d,fborderthickness:integer;

   fbuttondown:tnotifyevent;

   fbuttonmove:tmousemoveevent;

   fbuttonup:tnotifyevent;

   pmsghandler:Twndmethod;

   ppaint:Tnotifyevent;

   presize:tnotifyevent;

   gtmp1,gtmp2,gtmp3:boolean;

   procedure initializevariables;

   procedure IconChange(Sender:tobject);

   procedure setbuttonwidth(awidth:integer);

   procedure setbuttonleft(aleft:integer);

   procedure setbuttoncaption(acaption:string);

   procedure setbuttonfont(afont:tfont);

   procedure setbuttonvisible(avisible:boolean);

   procedure seticon(aicon:ticon);

   procedure setdown(adown:boolean);

   procedure setallowallup(aallowallup:boolean);

   procedure setgroupindex(agroupindex:integer);

   procedure UpdateProperties(achangedproperty:TChangedProperty);

  protected

   procedure messagehandler(var msg:tmessage);

   procedure CaptionPaint(var msg:tmessage);

   procedure CaptionMouseMove(var msg:tmessage);

   procedure CaptionMouseDown(var msg:tmessage);

   procedure CaptionMouseUp(var msg:tmessage);

   procedure CaptionRightMouseDown(var msg:tmessage);

   procedure CaptionDoubleClick(var msg:tmessage);

   procedure CaptionActivate(var msg:tmessage);

   procedure CaptionHitTest(var msg:Tmessage);

   procedure CaptionChange(var msg:Tmessage);

   procedure ParentMouseMove(var msg:tmessage);

   procedure ParentMouseUp(var msg:tmessage);

   procedure ButtonUp(var msg:tmessage);

   procedure ParentPaint(sender:tobject);

   procedure ParentResize(sender:tobject);

   procedure DisplaySettingChange(var msg:tmessage);

   procedure loaded;override;

  public

   constructor create(aowner:tcomponent);override;

   destructor destroy;override;

  published

   property Width:integer read fwidth write setbuttonwidth;

   property Position:integer read fleft write setbuttonleft;

   property Caption:string read fbuttoncaption write setbuttoncaption;

   property Font:Tfont read ffont write SetButtonFont;

   property Icon:Ticon read ficon write seticon;

   property TipText:string read fhinttext write fhinttext;

   property Visible:boolean read fvisible write setbuttonvisible;

   property AllowAllUp:boolean read fallowallup write setallowallup;

   property Down:boolean read fdown write setdown;

   property GroupIndex:integer read fgroupindex write setgroupindex;

   property OnMouseDown:tnotifyevent read fbuttondown write fbuttondown;

   property OnMouseMove:tmousemoveevent read fbuttonmove write fbuttonmove;

   property OnMouseUp:tnotifyevent read fbuttonup write fbuttonup;

  end;



const

 TTB_SETBUTTONUP=WM_USER+1;

procedure Register;



implementation



constructor TTitleButton.create(aowner:tcomponent);

begin

 inherited;

  fparent:=(owner as tform);

  ffont:=tfont.create;

  fhint:=thintwindow.create(self);

  ficon:=ticon.create;

end;



destructor TTitleButton.destroy;

begin

 if assigned(ficon) then

  ficon.free;

 if assigned(ffont) then

  ffont.free;

 if assigned(fhint) then

  fhint.free;

 inherited;

end;



procedure TTitleButton.loaded;

begin

 inherited;

 initializevariables;

end;



procedure TTitleButton.UpdateProperties(achangedproperty:TChangedProperty);

var

 amsg:tmessage;

begin

 amsg.Msg:=TTB_SETBUTTONUP;

 amsg.WParam:=integer(self);

 amsg.LParamlo:=fgroupindex;

 amsg.LParamHi:=word(achangedproperty);

 amsg.Result:=0;

 fparent.perform(amsg.msg,amsg.wparam,amsg.lparam);

end;



procedure TTitleButton.initializevariables;

begin

 if assigned(fparent.WindowProc) then

  pmsghandler:=fparent.WindowProc;

 fparent.WindowProc:=messagehandler;

 if not(csdesigning in componentstate) then

  begin

   if assigned(fparent.onpaint) then

    ppaint:=fparent.onpaint;

   if assigned(fparent.onresize) then

    presize:=fparent.onresize;

   fparent.onpaint:=parentpaint;

   fparent.onresize:=parentresize;

 end;

 fparentwidth:=fparent.width;

 zeromemory(@fbuttonrect,sizeof(fbuttonrect));

 fpressed:=false;

 ffocused:=false;

 fhintshow:=false;

 ficonwidth:=16;

 ficon.Transparent:=true;

 ficon.OnChange:=IconChange;

 fhint.Color:=clInfoBk;

 fcallinheritedevent:=false;

 fdefaultwidth:=GetSystemMetrics(SM_CXSIZE);

 if fwidth
  fwidth:=fdefaultwidth;

 fdefaultheight:=GetSystemMetrics(SM_CYSIZE);

 fborder3d:=GetSystemMetrics(SM_CYEDGE);

 fborderthickness:=GetSystemMetrics(SM_CYSIZEFRAME);

 gtmp3:=false;

end;



procedure TTitleButton.IconChange(Sender:tobject);

begin

 parentpaint(fparent);

end;



procedure TTitleButton.messagehandler(var msg:tmessage);

begin

 if csdesigning in componentstate then

  begin

   if msg.Msg=TTB_SETBUTTONUP then

    begin

     ButtonUp(msg);

     if (assigned(pmsghandler)) and (fcallinheritedevent) then

      pmsghandler(msg);

    end

   else

    pmsghandler(msg);

  end

 else

  begin

   if msg.Msg=WM_NCPAINT then

    begin

     CaptionPaint(msg);

     if (assigned(pmsghandler)) and (fcallinheritedevent) then

      pmsghandler(msg);

    end

   else if msg.Msg=WM_NCLBUTTONDOWN then

    begin

     CaptionMouseDown(msg);

     if (assigned(pmsghandler)) and (fcallinheritedevent) then

      pmsghandler(msg);

    end

   else if msg.Msg=WM_NCMOUSEMOVE then

    begin

     CaptionMouseMove(msg);

     if (assigned(pmsghandler)) and (fcallinheritedevent) then

      pmsghandler(msg);

    end

   else if msg.Msg=WM_NCLBUTTONUP then

    begin

     CaptionMouseUp(msg);

     if (assigned(pmsghandler)) and (fcallinheritedevent) then

      pmsghandler(msg);

    end

   else if msg.Msg=WM_NCACTIVATE then

    begin

     CaptionActivate(msg);

     if (assigned(pmsghandler)) and (fcallinheritedevent) then

      pmsghandler(msg);

    end

   else if msg.Msg=WM_NCHITTEST then

    begin

     CaptionHitTest(msg);

     if (assigned(pmsghandler)) and (fcallinheritedevent) then

      pmsghandler(msg);

    end

   else if msg.Msg=WM_LBUTTONUP then

    begin

     ParentMouseUp(msg);

     if (assigned(pmsghandler)) and (fcallinheritedevent) then

      pmsghandler(msg);

    end

   else if msg.Msg=WM_MOUSEMOVE then

    begin

     ParentMouseMove(msg);

     if (assigned(pmsghandler)) and (fcallinheritedevent) then

      pmsghandler(msg);

    end

   else if msg.Msg=WM_NCRBUTTONDOWN then

    begin

     CaptionRightMouseDown(msg);

     if (assigned(pmsghandler)) and (fcallinheritedevent) then

      pmsghandler(msg);

    end

   else if msg.Msg=WM_NCLBUTTONDBLCLK then

    begin

     CaptionDoubleClick(msg);

     if (assigned(pmsghandler)) and (fcallinheritedevent) then

      pmsghandler(msg);

    end

   else if msg.Msg=WM_NCLBUTTONDBLCLK then

    begin

     CaptionDoubleClick(msg);

     if (assigned(pmsghandler)) and (fcallinheritedevent) then

      pmsghandler(msg);

    end

   else if msg.Msg=WM_SETTEXT then

    begin

     CaptionChange(msg);

     if (assigned(pmsghandler)) and (fcallinheritedevent) then

      pmsghandler(msg);

    end

   else if msg.Msg=WM_SETTINGCHANGE then

    begin

     DisplaySettingChange(msg);

     if (assigned(pmsghandler)) and (fcallinheritedevent) then

      pmsghandler(msg);

    end

   else if msg.Msg=TTB_SETBUTTONUP then

    begin

     ButtonUp(msg);

     if (assigned(pmsghandler)) and (fcallinheritedevent) then

      pmsghandler(msg);

    end

   else if msg.Msg=WM_MOUSELEAVE then

    begin

      fhint.ReleaseHandle;

      pmsghandler(msg);

    end

   else

    pmsghandler(msg);

 end;

end;



procedure TTitleButton.CaptionPaint(var msg:tmessage);

begin

 fcallinheritedevent:=true;

 if fvisible=false then

  exit;

 invalidaterect(fparent.handle,@fbuttonrect,false);

end;



procedure TTitleButton.CaptionMouseMove(var msg:tmessage);

var

 pt:tpoint;

 tmpstate:tshiftstate;

 fhintwidth:integer;

begin

 fcallinheritedevent:=true;

 if fvisible=false then

  exit;

 gtmp1:=fpressed;

 gtmp2:=ffocused;

 pt.x:=msg.LParamLo-fparent.left;

 pt.y:=msg.LParamHi-fparent.top;

 if PtInRect(fbuttonrect,pt) then

  begin

   ffocused:=true;

   fhintwidth:=fhint.Canvas.TextWidth(fhinttext);

   if (fhintshow=false) and (length(trim(fhinttext))<>0) then

    fhint.ActivateHint(rect(mouse.cursorpos.x,mouse.cursorpos.y+10,mouse.cursorpos.x+fhintwidth+7,mouse.cursorpos.y+25),fhinttext);

   fhintshow:=true;

   if assigned(fbuttonmove) then

    fbuttonmove(fparent,tmpstate,pt.x,pt.y);

  end

 else

  begin

   ffocused:=false;

   fhint.ReleaseHandle;

   fhintshow:=false;

  end;

 fcallinheritedevent:=true;

end;



procedure TTitleButton.CaptionMouseDown(var msg:tmessage);

var

 pt:tpoint;

 tmp1:boolean;

 callevent:boolean;

begin

 callevent:=false;

 fcallinheritedevent:=true;

 if fvisible=false then

  exit;

 fhintshow:=false;

 fhint.releasehandle;

 setforegroundwindow(fparent.handle);

 tmp1:=fpressed;

 pt.x:=msg.LParamLo-fparent.left;

 pt.y:=msg.LParamhi-fparent.top;

 if ptinrect(fbuttonrect,pt) then

  begin

   gtmp3:=true;

   if fgroupindex=0 then

    begin

     callevent:=true;

    end

   else

    begin

     if not(fdown) then

      if assigned(fbuttondown) then

       fbuttondown(fparent);

    end;

   fpressed:=true;

   ffocused:=true;

   setcapture(fparent.handle);

  end

 else

  begin

   fpressed:=false;

   ffocused:=false;

  end;

 if (tmp1<>fpressed) then

  fcallinheritedevent:=false;

 gtmp1:=fpressed;

 gtmp2:=ffocused;

  parentpaint(fparent);


 if (callevent) and assigned(fbuttondown) then

  fbuttondown(fparent);

end;



procedure TTitleButton.CaptionMouseUp(var msg:tmessage);

var

 pt:Tpoint;

 tmp1,tmp2:boolean;

begin

 fcallinheritedevent:=true;

 if fvisible=false then

  exit;

 releasecapture;

 tmp1:=fpressed;

 tmp2:=ffocused;

 pt.x:=msg.LParamLo-fparent.left;

 pt.y:=msg.LParamhi-fparent.top;

 if (ptinrect(fbuttonrect,pt)) and (ffocused = true) then

  fpressed:=false

 else

  ffocused:=false;

 if ((tmp1<>fpressed) or (tmp2<>ffocused)) and (fallowallup and fdown) then

  invalidaterect(fparent.handle,@fbuttonrect,true);

 fcallinheritedevent:=true;

end;



procedure TTitleButton.CaptionRightMouseDown(var msg:tmessage);

var

 pt:tpoint;

begin

 fcallinheritedevent:=true;

 if fvisible=false then

  exit;

 fhint.releasehandle;

 pt.x:=msg.LParamlo-fparent.left;

 pt.y:=msg.LParamHi-fparent.top;

 if not ptinrect(fbuttonrect,pt) then

  fcallinheritedevent:=true

 else

  fcallinheritedevent:=false;

end;



procedure TTitleButton.CaptionDoubleClick(var msg:tmessage);

var

 pt:tpoint;

begin

 fcallinheritedevent:=true;

 if fvisible=false then

  exit;

 pt.x:=msg.LParamlo-fparent.left;

 pt.y:=msg.LParamhi-fparent.top;

 if not(ptinrect(fbuttonrect,pt)) then

  fcallinheritedevent:=true

 else

  begin

   fcallinheritedevent:=false;

   fparent.perform(WM_NCLBUTTONDOWN,msg.wparam,msg.LParam);

  end;

end;





procedure TTitleButton.CaptionActivate(var msg:tmessage);

begin

 fcallinheritedevent:=true;

 if not visible then

  exit;

 invalidaterect(fparent.handle,@fbuttonrect,false);

end;



procedure TTitleButton.CaptionHitTest(var msg:Tmessage);

var

 tmp:boolean;

 pt:tpoint;

begin

 fcallinheritedevent:=true;

 if fvisible=false then

  exit;

 if fpressed then

  begin

   tmp:=ffocused;

   pt.x:=msg.LParamlo-fparent.left;

   pt.y:=msg.LParamhi-fparent.top;

   if ptinrect(fbuttonrect,pt) then

    begin

     ffocused:=true

    end

   else

    ffocused:=false;

    if ffocused<>tmp then

     invalidaterect(fparent.handle,@fbuttonrect,false);

  end;

 if ffocused=false then

  fhint.releasehandle;

 gtmp1:=fpressed;

 gtmp2:=ffocused;

 fcallinheritedevent:=true;

end;



procedure TTitleButton.CaptionChange(var msg:Tmessage);

begin

 fcallinheritedevent:=true;

 if not fvisible then

  exit;

 invalidaterect(fparent.handle,@fbuttonrect,false);

end;



procedure TTitleButton.ButtonUp(var msg:tmessage);

var

 sender:ttitlebutton;

 tmp:boolean;

begin

 tmp:=fdown;

 fcallinheritedevent:=true;

 sender:=(tcomponent(msg.WParam) as ttitlebutton);

 if (sender<>self) and (msg.LParamLo=fgroupindex) then

  begin

   if tchangedproperty(msg.lparamhi)=cpdown then

    fdown:=false;

   fallowallup:=sender.fallowallup;

   if tmp<>fdown then

    invalidaterect(fparent.handle,@fbuttonrect,false);

  end;

end;



procedure TTitleButton.ParentMouseMove(var msg:tmessage);

var

 pt:tpoint;

 tmppt:tpoint;

 tmprect:trect;

 tmpstate:Tshiftstate;

begin

 fcallinheritedevent:=true;

 if fvisible=false then

  exit;

 ffocused:=false;

 pt.x:=msg.lparamlo;

 pt.y:=msg.lparamhi-fparent.top;

 tmppt:=pt;

 tmppt.x:=tmppt.x+4;

 tmppt.y:=65536-tmppt.y-fparent.top;

 tmprect:=fbuttonrect;

 inflaterect(tmprect,1,1);

 if ptinrect(tmprect,tmppt) then

  begin

   ffocused:=true;

   if assigned(fbuttonmove) then

    fbuttonmove(fparent,tmpstate,tmppt.x,tmppt.y);

   if (gtmp1<>fpressed) or (gtmp2<>ffocused) then// if fpressed then

    begin

     invalidaterect(fparent.handle,@fbuttonrect,false);

     gtmp1:=fpressed;

     gtmp2:=ffocused;

    end;

  end;

 if (gtmp1<>fpressed) or (gtmp2<>ffocused) then

  begin

   invalidaterect(fparent.handle,@fbuttonrect,false);

   gtmp1:=fpressed;

   gtmp2:=ffocused;

  end;

 fhintshow:=false;

 fhint.releasehandle;

end;





procedure TTitleButton.ParentMouseUp(var msg:tmessage);

var

 pt:tpoint;

 tmp:tpoint;

 tmprect:trect;

 tmpcallevent:boolean;

begin

 fcallinheritedevent:=true;

 if fvisible=false then

  exit;

 tmpcallevent:=false;

 fhint.ReleaseHandle;

 fhintshow:=true;

 ReleaseCapture;

 fpressed:=false;

 pt.x:=msg.lParamlo;

 pt.y:=msg.lParamhi-fparent.top;

 tmp:=pt;

 tmp.x:=tmp.x+4;

 tmp.y:=65536-tmp.y;

 tmp.y:=tmp.y-fparent.top;

 tmprect:=fbuttonrect;

 inflaterect(tmprect,0,2);

 if tmp.y<(fparent.top+fparent.Height) then

  pt:=tmp;

 if (ptinrect(tmprect,pt)) and (ffocused) and (gtmp3) then

  begin

   if fgroupindex<>0 then

    begin

     if fallowallup=true then

      fdown:=not(fdown)

     else

      fdown:=true;

     gtmp3:=false;

     updateproperties(cpdown);

     if not(fdown) then

      tmpcallevent:=true;

    end

   else

    tmpcallevent:=true;

   parentpaint(fparent);

   if (tmpcallevent=true) and assigned(fbuttonup) then

    fbuttonup(fparent);

  end

 else

  gtmp3:=false;

 fcallinheritedevent:=true;

end;



procedure TTitleButton.parentpaint(sender:tobject);

var

 ButtonCanvas:TCanvas;

 textrect:trect;

 iconrect:trect;

 tmpwidth:integer;

begin

 if fvisible=false then

  begin

   if assigned(ppaint)then

    ppaint(sender);

   exit;

  end;

 if not(csdesigning in componentstate) then

  begin

   if fwidth
    fwidth:=fdefaultwidth;

   if fleft=0 then

    fleft:=fwidth+1;

   fbuttonrect.left:=fparent.width-fleft-(3*fdefaultwidth)-(fborder3d+fborderthickness);

   fbuttonrect.right:=fbuttonrect.left+fwidth;

   fbuttonrect.top:=fborder3d+fborderthickness;

   fbuttonrect.bottom:=fbuttonrect.top+fdefaultheight-(2*fborder3d);

   ButtonCanvas:=tcanvas.Create;

   ButtonCanvas.Handle:=getwindowdc(fparent.handle);

   fillrect(buttoncanvas.Handle,fbuttonrect,HBRUSH(COLOR_BTNFACE+1));

   tmpwidth:=fdefaultheight-2;

   iconrect.left:=fbuttonrect.left;

   iconrect.top:=fbuttonrect.top;

   iconrect.right:=iconrect.left+tmpwidth;

   iconrect.bottom:=fbuttonrect.top+fdefaultheight-2*fborder3d;

   if ficon.handle<>0 then

    subtractrect(textrect,fbuttonrect,iconrect)

   else

    textrect:=fbuttonrect;

   if (ffocused and fpressed) or fdown then

    begin

     drawedge(ButtonCanvas.Handle,fbuttonrect,EDGE_SUNKEN,BF_SOFT or BF_RECT);

     textrect.left:=textrect.left+2;

     textrect.Top:=textrect.Top+1;

     textrect.right:=textrect.right-1;

     iconrect.left:=iconrect.left+3;

     iconrect.top:=iconrect.top+2;

    end;

   if (not(fpressed) or not(ffocused)) and not(fdown) then

    begin

     drawedge(ButtonCanvas.Handle,fbuttonrect,EDGE_RAISED,BF_SOFT or BF_RECT);

     textrect.left:=textrect.left+1;

     textrect.right:=textrect.right-1;

     iconrect.top:=iconrect.top+1;

     iconrect.left:=iconrect.left+2;

   end;

   ButtonCanvas.Brush.Style:=bsclear;

   ButtonCanvas.Font.assign(ffont);

   if ficon.Handle<>0 then

    begin

     drawiconex(buttoncanvas.handle,iconrect.left+1,iconrect.top+1,ficon.handle,tmpwidth-5,fdefaultheight-8,0,0,DI_NORMAL);

     if length(trim(fbuttoncaption))>0 then

      DrawTextEx(ButtonCanvas.Handle,PChar(fButtonCaption),Length(fbuttoncaption),textrect,DT_LEFT or DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS or DT_PATH_ELLIPSIS or DT_MODIFYSTRING,nil);

    end

   else

    DrawText(ButtonCanvas.Handle,PChar(fButtonCaption),Length(fbuttoncaption),textrect,DT_CENTER or DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS or DT_PATH_ELLIPSIS or DT_MODIFYSTRING);

   ButtonCanvas.Free;

   if assigned(ppaint) then

    ppaint(sender);

  end;

end;



procedure TTitleButton.parentresize(sender:tobject);

begin

 fcallinheritedevent:=true;

 if fvisible=false then

  begin

   if assigned(presize) then

    presize(sender);

   exit;

  end;

 parentpaint(sender);

 if assigned(presize) then

  presize(self);

end;





procedure TTitleButton.DisplaySettingChange(var msg:tmessage);

begin

 fcallinheritedevent:=true;

 if fvisible=false then

  exit;

 fdefaultwidth:=GetSystemMetrics(SM_CXSIZE);

 if fwidth
  fwidth:=fdefaultwidth;

 fdefaultheight:=GetSystemMetrics(SM_CYSIZE);

 fborder3d:=GetSystemMetrics(SM_CYEDGE);

 fborderthickness:=GetSystemMetrics(SM_CYSIZEFRAME);

 parentpaint(fparent);

 msg.result:=0;

end;



procedure TTitleButton.setbuttonwidth(awidth:integer);

begin

 if awidth>0 then

  fwidth:=awidth

 else

  fwidth:=fdefaultwidth;

 parentpaint(fparent);

end;



procedure TTitleButton.setbuttonleft(aleft:integer);

begin

 if (aleft
  fleft:=aleft;

 parentpaint(fparent);

end;



procedure TTitleButton.setbuttoncaption(acaption:string);

begin

 fbuttoncaption:=acaption;

 parentpaint(fparent);

end;



procedure TTitleButton.setbuttonfont(afont:tfont);

begin

 ffont.assign(afont);

 parentpaint(fparent);

end;



procedure TTitleButton.seticon(aicon:ticon);

begin

 ficon.assign(aicon);

 parentpaint(fparent);

end;



procedure TTitleButton.setbuttonvisible(avisible:boolean);

begin

 fvisible:=avisible;

 fparent.perform(WM_NCACTIVATE,integer(true),0);

end;





procedure TTitleButton.setdown(adown:boolean);

var

 tmp:boolean;

begin

 tmp:=fdown;

 if csloading in componentstate then

  fdown:=adown

 else

  begin

   if fdown<>adown then

    begin

     if fgroupindex=0 then

      fdown:=false

     else

      begin

       if fallowallup=true then

        fdown:=adown

       else

        fdown:=true;

      end;

    end;

  end;

 if tmp<>fdown then

  updateproperties(cpdown);



end;



procedure TTitleButton.setallowallup(aallowallup:boolean);

var

 tmp:boolean;

begin

 fcallinheritedevent:=true;

 tmp:=fallowallup;

 if csloading in componentstate then

  fallowallup:=aallowallup

 else

  begin

   if fgroupindex<>0 then

    fallowallup:=aallowallup;

   if tmp<>fallowallup then

    updateproperties(cpallowallup);

  end;

end;





procedure TTitleButton.setgroupindex(agroupindex:integer);

var

 tmp:integer;

begin

 tmp:=fgroupindex;

 if csloading in componentstate then

  fgroupindex:=agroupindex

 else

  begin

   if agroupindex >=65535 then

    agroupindex:=0;

   if (agroupindex>=0) then

    fgroupindex:=agroupindex;

   if fgroupindex=0 then

    begin

     fallowallup:=false;

     fdown:=false;

    end;

   if tmp<>fgroupindex then

    updateproperties(cpgroupindex);

  end;

end;



procedure Register;

begin

  RegisterComponents('My Components', [TTitleButton]);

end;



end.

_____________End of code_____________



Copy the code to a pas file and then register it.

 

Share this article!

Follow us!

Find more helpful articles: