utitlebutton.pas

A Component For Button

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,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
      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,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:=false;
    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<fDefaultWidth then 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:=FbuttonRect.Right+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<fdefaultWidth then 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>0) then 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.SetButtonVisible(aVisible:Boolean);
begin
FVisible:=avisible;
fParent.Perform(WM_NCACTIVATE,integer(true),0);
end;

Procedure TTitleButton.setIcon(aIcon:TIcon);
begin
ficon.Assign(aicon);
ParentPaint(fparent);
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 allowallUp=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 aGroupIndex=0 then
      Begin
        FallowAllUp:=false;
        Fdown:=false;
      end;
    If tmp<>FGroupIndex then
      updateProperties(cpGruopIndex);
  end;
end;

procedure Register;
begin
  RegisterComponents('Salar Softwares', [TTitleButton]);
end;

end.