utitlebutton.pas

A Component For Button

unit UTitleButton;
// Salar Softwares products
//Programmer: Salar Khalilzadeh
//CopyRight(c):2004
//Website: www.SalarSoft.owns1.com
//E-mail: [e-mail]
interface

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

type
  TChangedProperty=(cpDown,cpAllowAllUp,cpGruopIndex);

  TTitleButton = class(TComponent)
  private
    fbuttonrect:TRect;
    fpressed,ffocused:Boolean;
    fbuttoncaption:String;
    fwidth,
    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 DisplaySettingChange(var msg :tmessage);
    Procedure ParentPaint(Sender:TObject);
    Procedure ParentResize(Sender:TObject);
    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:=(AOwner 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
      PPaint:=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<FDefaultWidth THEN FWidth:=GetSystemMetrics(SM_CXSIZE);
  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_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
        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+16,mouse.CursorPos.x+fhintwidth+7,mouse.CursorPos.y+31),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,
  CallEvent:Boolean;
begin
CallEvent:=false;
FCallInheritedEvent:=true;
If fvisible=false then
  exit;
Fhintshow:=false;
Fhint.ReleaseHandle;
if Fhintshow=true then
  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;