Delphi控件源码

开发平台：
Delphi

MMForm.pas：源码内容
							{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Tel.: +0351-8012255                   =}
{=  Loewenstr.7a                = info@swiftsoft.de                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 19.02.98 - 16:04:37 $                                        =}
{========================================================================}
unit MMForm;
{$I COMPILER.INC}
{$D+,L+}
interface
uses
    Windows,
    Messages,
    SysUtils,
    Classes,
    Graphics,
    Controls,
    Forms,
    Dialogs,
    StdCtrls,
    ExtCtrls,
    ShellApi,
    MMObj,
    MMUtils,
    MMHook;
type
  TMMFormStyler = class;
  TMMFontKind    = (fkCustom, fkSystem, fkSystemI, fkSystemB, fkSystemBI, fkAutoHeight);
  {== TMMCompanyText ==========================================================}
  TMMCompanyText = class(TPersistent)
  private
    FCaption      : String;
    FColorActive  : TColor;
    FColorInactive: TColor;
    FFont         : TFont;
    FFontKind     : TMMFontKind;
    FOwner        : TMMFormStyler;
    FVisible      : Boolean;
    function  StoreFont: Boolean;
    procedure SetColorActive(Value: TColor);
    procedure SetColorInactive(Value: TColor);
    procedure SetCaption(Value: String); virtual;
    procedure SetFont(Value: TFont);
    procedure SetFontKind(Value: TMMFontKind);
    procedure SetVisible(Value: Boolean);
    procedure SetFontKind_NoRedraw(Value: TMMFontKind);
  public
    constructor Create(AOwner: TMMFormStyler); virtual;
    destructor  Destroy; override;
  published
    property Caption: String read FCaption write SetCaption;
    property ColorActive: TColor read FColorActive write SetColorActive default clCaptionText;
    property ColorInactive: TColor read FColorInactive write SetColorInactive default clInactiveCaptionText;
    property Font: TFont read FFont write SetFont stored StoreFont;
    property FontKind: TMMFontKind read FFontKind write SetFontKind;
    property Visible: Boolean read FVisible write SetVisible;
  end;
  TMMAppNameText = class(TMMCompanyText)
  end;
  TMMCaptionText = class(TMMCompanyText)
  protected
    function  GetCaption: String; virtual;
  published
    property Caption : String read GetCaption write SetCaption;
  end;
  {== TMMFormStyler ===========================================================}
  TMMGradientColors  = 2..236;
  TMMGradientOptions = (goAlways, goNever, goActive, goSmart);
  TMMFormStyler = class(TMMWndProcComponent)
  private
    FHandle           : THandle;
    FAppNameText      : TMMAppNameText;
    FCaptionText      : TMMCaptionText;
    FCompanyText      : TMMCompanyText;
    FClrLeftActive    : TColor;
    FClrLeftInActive  : TColor;
    FClrRightActive   : TColor;
    FClrRightInActive : TColor;
    FOptions          : TMMGradientOptions;
    FNumColors        : TMMGradientColors;
    FAlignment        : TAlignment;
    FSystemFont       : TFont;
    FWindowActive     : Boolean;
    FActiveDefined    : Boolean;
    FRecreating       : Boolean;
    procedure SetColors(index: integer; aValue: TColor);
    procedure SetAlignment(aValue: TAlignment);
    procedure SetNumColors(aValue: TMMGradientColors);
    procedure SetOptions(aValue: TMMGradientOptions);
    function  GetVisibleButtons: TBorderIcons;
    procedure ExcludeBtnRgn (var R: TRect);
    procedure GetSystemFont(Font: TFont);
    function  GetTextRect: TRect;
    function  GetTitleBarRect: TRect;
    function  MeasureText(DC: HDC; R: TRect; Text: TMMCompanyText): integer;
    procedure NewCaptionText;
    procedure PaintMenuIcon(DC: HDC; var R: TRect);
    procedure PaintCaptionText(DC: HDC; var R: TRect; Text: TMMCompanyText; Active: Boolean);
    procedure PaintCaptionButtons(DC: HDC; var Rect: TRect);
    procedure PerformNCPaint(var AMsg: TMessage);
    procedure PerformNCActivate(var AMsg: TMessage);
    function  HandleWMSetCursor(var Msg: TWMSetCursor): Boolean;
    procedure SetAutoFontHeight(Font: TFont);
    function  WindowIsActive: Boolean;
  protected
    procedure Loaded; override;
    procedure HookWndProc(var Message: TMessage); override;
    procedure HookAppWndProc(var AMsg: TMessage);
{$IFDEF BUILD_ACTIVEX}
    procedure ChangeDesigning(Value: Boolean); override;
    function GetOwnerCaption: string;
    procedure HookOwner; override;
    procedure UnhookOwner; override;
    procedure CMEnabledChanged(var M: TMessage); message CM_ENABLEDCHANGED;
{$ELSE}
    procedure ChangeDesigning(Value: Boolean);
{$ENDIF}
  public
    constructor Create(AOwner: TComponent);  override;
    destructor  Destroy; override;
    procedure   UpdateCaption;
    function    DrawCaption(Active: Boolean): TRect;
  published
{$IFDEF BUILD_ACTIVEX}
    property Enabled;
{$ENDIF}
    property AppNameText: TMMAppNameText read FAppNameText write FAppNameText;
    property CaptionText: TMMCaptionText read FCaptionText write FCaptionText;
    property CompanyText: TMMCompanyText read FCompanyText write FCompanyText;
    property ClrLeftActive   : TColor index 0 read FClrLeftActive write SetColors default clBlack;
    property ClrLeftInActive : TColor index 1 read FClrLeftInActive write SetColors default clBlack;
    property ClrRightActive  : TColor index 2 read FClrRightActive write SetColors default clActiveCaption;
    property ClrRightInActive: TColor index 3 read FClrRightInActive write SetColors default clInActiveCaption;
    property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
    property Options  : TMMGradientOptions read FOptions write SetOptions default goSmart;
    property NumColors: TMMGradientColors read FNumColors write SetNumColors default 64;
  end;
implementation
{$IFDEF DELPHI3} resourcestring {$ELSE} const {$ENDIF}
  SSecondStyler = 'Only one FormStyler is allowed per Form';
const
   ControlList: TList = nil;
   WordSpacing        = 3;
   MM_RecreateNotify  = WM_USER + 12621;
{== TMMCompanyText ============================================================}
constructor TMMCompanyText.Create(AOwner: TMMFormStyler);
begin
   inherited Create;
   FOwner := AOwner;
   FColorActive := (clCaptionText);
   FColorInactive := (clInactiveCaptionText);
   FFont := TFont.Create;
   FFontKind := fkSystem;
   FFont.Assign(FOwner.FSystemFont);
   FVisible := true;
   FCaption := '';
end;
{-- TMMCompanyText ------------------------------------------------------------}
destructor TMMCompanyText.Destroy;
begin
   FFont.Free;
   inherited destroy;
end;
{-- TMMCompanyText ------------------------------------------------------------}
procedure TMMCompanyText.SetColorActive(Value: TColor);
begin
   FColorActive := value;
   if csDesigning in FOwner.ComponentState then FOwner.UpdateCaption;
end;
{-- TMMCompanyText ------------------------------------------------------------}
procedure TMMCompanyText.SetColorInactive(Value: TColor);
begin
   FColorInactive := value;
   if csDesigning in FOwner.ComponentState then FOwner.UpdateCaption;
end;
{-- TMMCompanyText ------------------------------------------------------------}
procedure TMMCompanyText.SetCaption(Value: String);
begin
   if FCaption = Value then exit;
   FCaption := Value;
   FOwner.NewCaptionText;
   if csDesigning in FOwner.ComponentState then FOwner.UpdateCaption;
end;
{-- TMMCompanyText ------------------------------------------------------------}
procedure TMMCompanyText.SetFont(Value: TFont);
begin
   FFont.Assign(Value);
   if FFontKind = fkAutoHeight then
      FOwner.SetAutoFontHeight(FFont)
   else
      FFontKind := fkCustom;
   if csDesigning in FOwner.ComponentState then FOwner.UpdateCaption;
end;
{-- TMMCompanyText ------------------------------------------------------------}
function TMMCompanyText.Storefont : Boolean;
begin
   Result := not (FFontKind in [fkSystem, fkSystemB, fkSystemBI, fkSystemI]);
end;
{-- TMMCompanyText ------------------------------------------------------------}
procedure TMMCompanyText.SetFontKind(Value: TMMFontKind);
begin
   SetFontKind_NoRedraw(Value);
   if csDesigning in FOwner.ComponentState then FOwner.UpdateCaption;
end;
{-- TMMCompanyText ------------------------------------------------------------}
procedure TMMCompanyText.SetFontKind_NoRedraw(Value: TMMFontKind);
begin
   FFontKind := Value;
   case FFontKind of
      fkCustom : { do nothing special };
      fkSystem : FFont.Assign(FOwner.FSystemFont);
      fkSystemI:
      begin
         FFont.Assign(FOwner.FSystemFont);
         FFont.Style := FFont.Style + [fsItalic];
      end;
      fkSystemB:
      begin
         FFont.Assign(FOwner.FSystemFont);
         FFont.Style := FFont.Style + [fsBold];
      end;
      fkSystemBI:
      begin
         FFont.Assign(FOwner.FSystemFont);
         FFont.Style := FFont.Style + [fsItalic, fsBold];
      end;
      fkAutoHeight: FOwner.SetAutoFontHeight(FFont);
   end;
end;
{-- TMMCompanyText ------------------------------------------------------------}
procedure TMMCompanyText.SetVisible(Value: Boolean);
begin
   if FVisible = Value then exit;
   FVisible := Value;
   FOwner.NewCaptionText;
   if csDesigning in FOwner.ComponentState then FOwner.UpdateCaption;
end;
{== TMMCaptionText ============================================================}
function TMMCaptionText.GetCaption: String;
var
   temp : string;
   found: integer;
begin
   try
{$IFNDEF BUILD_ACTIVEX}
      if FOwner.OwnerForm = nil then
      begin
         Result := '';
         exit;
      end;
      temp := FOwner.OwnerForm.Caption;
{$ELSE}
      if FOwner.HookWnd = 0 then
      begin
        Result := '';
        exit;
      end;
      temp := FOwner.GetOwnerCaption;
{$ENDIF}
      if FOwner.FCompanyText.Visible then
      begin
         Found := Pos(FOwner.FCompanyText.Caption, Temp);
         if found <> 0 then temp := Copy(temp, found + length(FOwner.FCompanyText.Caption), maxint);
         if length(temp) > 0 then if temp[1] = ' ' then temp := Copy(temp, 2, maxint);
      end;
      if FOwner.FAppNameText.Visible then
      begin
         found := Pos(FOwner.FAppNameText.Caption, Temp);
         if found <> 0 then temp := Copy(temp, found + length(FOwner.FAppNameText.Caption), maxint);
         if length(temp) > 0 then if temp[1] = ' ' then temp := Copy(temp, 2, maxint);
      end;
      Result := temp;
   except
      Result := '';
   end;
end;
{------------------------------------------------------------------------}
procedure AddStyler(Comp: TMMFormStyler);
begin
   if (ControlList = nil) then ControlList := TList.Create;
   ControlList.Add(Comp);
end;
{------------------------------------------------------------------------}
procedure RemoveStyler(Comp: TMMFormStyler);
begin
   ControlList.Remove(Comp);
   if (ControlList.Count = 0) then
   begin
      ControlList.Free;
      ControlList := nil;
   end;
end;
{------------------------------------------------------------------------}
function FindStylerForWindow(Wnd: HWND): TMMFormStyler;
var
   i: Integer;
begin
   { It is no sense to have multiple different designers for one window }
   if (ControlList <> nil) and (ControlList.Count > 0) then
   for i := 0 to ControlList.Count-1 do
   begin
      with TMMFormStyler(ControlList[i]) do
{$IFNDEF BUILD_ACTIVEX}
      if ((OwnerForm.Handle = Wnd) or IsChild(OwnerForm.Handle, Wnd)) then
{$ELSE}
      if ((HookWnd = Wnd) or IsChild(HookWnd, Wnd)) then
{$ENDIF}
      begin
         Result := TMMFormStyler(ControlList[i]);
         Exit;
      end;
   end;
   Result := nil;
end;
{== TMMFormStyler =============================================================}
constructor TMMFormStyler.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
{$IFNDEF BUILD_ACTIVEX}
   if (FindStylerForWindow(TForm(Owner).Handle) <> nil) then
      raise Exception.Create(SSecondStyler);
{$ELSE}
  // Oops! it's an early place to check for the neighbor...
{$ENDIF}
   FWindowActive  := True;  { assumption }
   FActiveDefined := False;
   FSystemFont := TFont.Create;
   try
      GetSystemFont(FSystemFont);
   except
      FSystemFont.Free;
      FSystemFont := nil;
      raise;
   end;
   FCompanyText := TMMCompanyText.Create(self);
   FAppNameText := TMMAppNameText.Create(self);
   FCaptionText := TMMCaptionText.Create(self);
   FClrLeftActive    := clBlack;
   FClrLeftInActive  := clBlack;
   FClrRightActive   := clActiveCaption;
   FClrRightInActive := clInActiveCaption;
   FAlignment        := taLeftJustify;
   FOptions          := goSmart;
   FNumColors        := 64;
   FHandle           := AllocateHwnd(HookAppWndProc);
   FRecreating       := False;
   HookOwner;
   AddStyler(Self);
{$IFNDEF BUILD_ACTIVEX}
   if (csdesigning in ComponentState) and not
      (csReadingState in OwnerForm.ControlState) then
     ChangeDesigning(True);
{$ENDIF}
end;
{-- TMMFormStyler -------------------------------------------------------------}
destructor TMMFormStyler.Destroy;
begin
   if FormOK then
     UnHookOwner;
   RemoveStyler(Self);
{$IFNDEF BUILD_ACTIVEX}
   { update caption if the parent form is not being destroyed }
   if (FCaptionText <> nil) and not
      (csDestroying in OwnerForm.ComponentState) then
   begin
      OwnerForm.Caption := FCaptionText.Caption;
      UpdateCaption;
   end;
{$ENDIF}
   if FAppNameText <> nil then FAppNameText.Free;
   if FCaptionText <> nil then FCaptionText.Free;
   if FCompanyText <> nil then FCompanyText.Free;
   if FSystemFont <> nil then FSystemFont.Free;
   if (FHandle <> 0) then DeallocateHwnd(FHandle);
   inherited Destroy;
end;
{$IFDEF BUILD_ACTIVEX}
function TMMFormStyler.GetOwnerCaption: string;
begin
  if HookWnd <> 0 then
  begin
    SetLength(Result, 255);
    GetWindowText(HookWnd, PChar(Result), 255);
    SetLength(Result, StrLen(PChar(Result)));
  end else
    Result := '';
end;
{$ENDIF}
procedure TMMFormStyler.ChangeDesigning(Value: Boolean);
begin
  if Value then
  begin
    { Set default fonts unless stored user settings are being loaded }
    FCompanyText.FCaption := 'SwiftSoft';
    FAppNameText.FCaption := 'MMTools -';
{$IFDEF BUILD_ACTIVEX}
    FCaptionText.FCaption := GetOwnerCaption;
{$ELSE}
    FCaptionText.FCaption := OwnerForm.Caption;
{$ENDIF}
    NewCaptionText;
    FCaptionText.SetFontKind_noRedraw(fkSystem);
    FAppNameText.SetFontkind_noRedraw(fkSystemB);  { system + bold }
    FCompanyText.SetFontkind_noRedraw(fkSystemBI); { system + bold + italic }
    DrawCaption(WindowIsActive);   { do the first-time draw }
  end;
  inherited;
end;
{-- TMMFormStyler -------------------------------------------------------------}
procedure TMMFormStyler.Loaded;
begin
  inherited Loaded;
  { some people have reported problems with TForm's position being poScreenCenter.
    this removes the problem (I believe - I've never replicated the problem so I
    can't test it). }
{$IFNDEF BUILD_ACTIVEX}
  if (HookWnd <> OwnerForm.Handle) then
  begin
     UnhookOwner;
     HookOwner;
  end;
{$ENDIF}
end;
{-- TMMFormStyler -------------------------------------------------------------}
function TMMFormStyler.WindowIsActive: Boolean;
begin
   if FActiveDefined then
   begin
      Result := FWindowActive;
      exit;
   end;
   Result := (HookWnd = GetActiveWindow);
   if Assigned(OwnerForm) and (OwnerForm.FormStyle = fsMDIChild) then
       if Application <> nil then
          if Application.Mainform <> nil then
             if OwnerForm = Application.Mainform.ActiveMDIChild then
                if Application.Mainform.HandleAllocated then
                   if Application.Mainform.Handle = GetActiveWindow then Result := True;
end;
{-- TMMFormStyler -------------------------------------------------------------}
procedure TMMFormStyler.PerformNCPaint(var AMsg: TMessage);
var
  R, WR : TRect;
  MyRgn : HRgn;
  DC : HDC;
begin
   R := DrawCaption(WindowIsActive);
   DC := GetWindowDC(HookWnd);
   GetWindowRect(HookWnd, WR);
   MyRgn := CreateRectRgnIndirect(WR);
   try
      if SelectClipRgn(DC, AMsg.wParam) = ERROR then
         SelectClipRgn(DC, MyRgn);
      OffsetClipRgn(DC, -WR.Left, -WR.Top);
      ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
      OffsetClipRgn(DC, WR.Left, WR.Top);
      GetClipRgn(DC, MyRgn);
      AMsg.Result := CallPrevWndProc(AMsg.Msg, MyRgn, AMsg.lParam);
   finally
      DeleteObject(MyRgn);
      ReleaseDC(HookWnd, DC);
   end;
end;
{-- TMMFormStyler -------------------------------------------------------------}
procedure TMMFormStyler.PerformNCActivate(var AMsg: TMessage);
var
   R: TRect;
begin
   FWindowActive := TWMNCActivate(AMsg).Active;
   FActiveDefined := true;
   if (not NewStyleControls) then
       AMsg.Result := CallPrevWndProc(AMsg.Msg, AMsg.wParam, AMsg.lParam)
   else if Assigned(OwnerForm) and (OwnerForm.FormStyle = fsMDIChild) then { cover up hassles with minimized MDI children borders and button redrawing }
            AMsg.Result := CallPrevWndProc(AMsg.Msg, AMsg.wParam, AMsg.lParam);
   if Assigned(OwnerForm) and (OwnerForm.FormStyle = fsMDIForm) then
      if Application <> nil then
         if Application.Mainform <> nil then
            if Application.Mainform.ActiveMDIChild <> nil then
               PostMessage(Application.Mainform.ActiveMDIChild.Handle, WM_NCACTIVATE, longint(TWMNCActivate(AMsg).Active), 0);
   R := GetTitleBarRect;
   { cause a nc_Paint message to occur (immediately) }
   ReDrawWindow(HookWnd,@R,0,RDW_FRAME or RDW_INVALIDATE or RDW_UPDATENOW);
   AMsg.Result := 1;
   AMsg.wParam := 1;   { Tell windows that we have handled the message }
end;
{-- TMMFormStyler -------------------------------------------------------------}
procedure TMMFormStyler.HookWndProc(var Message: TMessage);
begin
   if Message.Msg = WM_NCPAINT then
   begin
      PerformNCPaint(Message);
      exit;
   end; { NCPaint is handled for win32 }
   if Message.Msg = WM_NCACTIVATE then
   begin
      PerformNCActivate(Message);
      exit;
   end; { NCActivate is handled for win32 }
   if Message.Msg = WM_SETCURSOR then
   begin
      if HandleWMSetCursor(TWMSetCursor(Message)) then
      exit;
   end; { SetCursor is handled for win32 }
   if Message.Msg = WM_DESTROY then
   begin
      {Note: WM_DESTROY is trapped here when the form itself is destroyed,
       and whenever the RecreateWnd method of the form is called }
      if not (csDestroying in ComponentState) then
      begin
         { We must unhook the WindowProc, and then rehook it later }
         FRecreating := True;
         UnHookOwner;
         { Notify WordCap to rehook the form. A message must be posted so that this
           can be done once the form has completed the recreation process. }
         PostMessage(FHandle, MM_RecreateNotify, 0, Longint(Self));
         { don't exit.  Allow default processing to still occur }
      end;
   end;
   { now handle all other calls }
   inherited;
   if Message.Msg = WM_SETICON then DrawCaption(WindowIsActive);
   if ((Message.Msg = WM_DISPLAYCHANGE)  or
       (Message.Msg = WM_SysColorChange) or
       (Message.Msg = WM_WININICHANGE) or
       (Message.Msg = WM_SETTINGCHANGE)) then
   begin
      GetSystemFont(FSystemFont);  { update systemfont }
      FAppNameText.SetFontkind_noRedraw(FAppNameText.FFontkind);
      FCaptionText.SetFontKind_noRedraw(FCaptionText.FFontKind);
      FCompanyText.SetFontkind_noRedraw(FCompanyText.FFontkind);
      UpdateCaption;  {force a NC region redraw};
   end;
end;
{-- TMMFormStyler -------------------------------------------------------------}
procedure TMMFormStyler.HookAppWndProc(var AMsg: TMessage);
begin
   if AMsg.Msg = MM_RecreateNotify then
   begin
      if AMsg.LParam <> longint(self) then exit;    { did the message come from this instance or another instance? }
      HookOwner;  { Rehook the form }
      if GetActiveWindow = HookWnd then FWindowActive := True;
      UpdateCaption;
   end;
end;
{-- TMMFormStyler -------------------------------------------------------------}
procedure TMMFormStyler.UpdateCaption;
begin
   if FormOK then
   begin
      SetWindowPos(HookWnd, 0, 0, 0, 0, 0,
                   SWP_FRAMECHANGED or SWP_DRAWFRAME or
                   SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
   end;
end;
{-- TMMFormStyler -------------------------------------------------------------}
procedure TMMFormStyler.GetSystemFont(Font: TFont);
var
  FNONCLIENTMETRICS : TNONCLIENTMETRICS;
begin
   Font.Handle := GetStockObject(SYSTEM_FONT);
   FNONCLIENTMETRICS.cbSize := Sizeof(TNONCLIENTMETRICS);
   if Boolean(SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0,
                                   @FNONCLIENTMETRICS, 0)) then
   begin
      { work now with FNonClientMetrics.lfCaptionFont }
      Font.Name := FNonClientMetrics.lfCaptionFont.lfFacename;
      if FNonClientMetrics.lfCaptionFont.lfHeight > 0 then
         Font.Size := FNonClientMetrics.lfCaptionFont.lfHeight
      else
         Font.Height := FNonClientMetrics.lfCaptionFont.lfHeight;
      Font.Style := [];
      if FNonClientMetrics.lfCaptionFont.lfItalic <> 0 then
         Font.Style := Font.Style + [fsItalic];
      if FNonClientMetrics.lfCaptionFont.lfWeight > FW_MEDIUM then
         Font.Style := Font.Style + [fsBold];
      Font.Pitch := fpDefault;
   end;
end;
{-- TMMFormStyler -------------------------------------------------------------}
procedure TMMFormStyler.NewCaptionText;
var
   temp: string;
begin
   LockWindowUpdate(HookWnd);
   temp := '';
   if FCompanyText.Visible then temp := temp + FCompanyText.FCaption;
   if FCompanyText.Visible and (FCompanyText.Caption <> '') and
      (FAppNameText.Visible or FCaptionText.Visible) then temp := temp + ' ';
   if FAppNameText.Visible then temp := temp + FAppNameText.FCaption;
   if FAppNameText.Visible and (FAppNameText.Caption <> '') and FCaptionText.Visible then temp := temp + ' ';
   if FCaptionText.Visible then temp := temp + FCaptionText.FCaption;
{$IFNDEF BUILD_ACTIVEX}
   OwnerForm.Caption := temp;
{$ELSE}
   SetWindowText(HookWnd, PChar(temp));
{$ENDIF}
   LockWindowUpdate(0);
end;
const
   // depends upon WS_EX_TOOLWINDOW
  smcCaptionY: array[Boolean] of Integer = (SM_CYCAPTION, SM_CYSMCAPTION);
  smcButtonX: array[Boolean] of Integer = (SM_CXSIZE, SM_CXSMSIZE);
  smcButtonY: array[Boolean] of Integer = (SM_CYSIZE, SM_CYSMSIZE);
   // depends upon WS_THICKFRAME
  smcFrameX: array[Boolean] of Integer = (SM_CXFIXEDFRAME, SM_CXSIZEFRAME);
  smcFrameY: array[Boolean] of Integer = (SM_CYFIXEDFRAME, SM_CYSIZEFRAME);
{-- TMMFormStyler -------------------------------------------------------------}
function TMMFormStyler.GetTitleBarRect: TRect;
var
  Style, ExStyle: Integer;
  SizeFrame, ToolWindow: Boolean;
begin
  Style := GetWindowLong(HookWnd, GWL_STYLE);
  ExStyle := GetWindowLong(HookWnd, GWL_EXSTYLE);
{$IFNDEF BUILD_ACTIVEX}
  if csDesigning in ComponentState then
  begin
    Style := WS_CAPTION or WS_THICKFRAME;
    ExStyle := 0;
  end;
{$ENDIF}
   { if we have no border style, then just set the rectangle empty. }
  if Style and WS_BORDER = 0 then
  begin
    SetRectEmpty(Result);
    exit;
  end;
  GetWindowRect(HookWnd, Result);
   { Convert rect from screen (absolute) to client (0 based) coordinates. }
  OffsetRect(Result, -Result.Left, -Result.Top);
   { Shrink rectangle to allow for window border.  We let Windows paint the border. }
   { this catches drawing MDI minimised windows caption bars in Win95 }
  if IsIconic(HookWnd) then
  begin
    InflateRect(Result, -GetSystemMetrics(SM_CXFIXEDFRAME),
                        -GetSystemMetrics(SM_CYFIXEDFRAME));
    if not NewStyleControls then
      InflateRect(Result, -GetSystemMetrics(SM_CYBORDER),
                          -GetSystemMetrics(SM_CYBORDER));
  end else
  begin
    SizeFrame := Style and WS_THICKFRAME <> 0;
    InflateRect(Result, -GetSystemMetrics(smcFrameX[SizeFrame]),
                        -GetSystemMetrics(smcFrameY[SizeFrame]));
  end;
  { Set the appropriate height of caption bar. }
  ToolWindow := ExStyle and WS_EX_TOOLWINDOW <> 0;
  with Result do
    Bottom := Top + GetSystemMetrics(smcCaptionY[ToolWindow]) - 1;
end;
{-- TMMFormStyler -------------------------------------------------------------}
function TMMFormStyler.GetVisibleButtons: TBorderIcons;
{$IFNDEF BUILD_ACTIVEX}
var
   BS: TFormBorderStyle;
begin
   Result := [];
   if csDesigning in ComponentState then
   begin
      Result := [biSystemMenu, biMaximize, biMinimize];
      exit;
   end;
   BS:= OwnerForm.BorderStyle;
   if BS = bsNone then exit;
   if not (biSystemMenu in OwnerForm.BorderIcons) then exit;  { none will be visible }
   if BS in [bsToolWindow, bsSizeToolWin] then
   begin
      Result := [biSystemMenu];  { close icon only }
      exit;
   end;
   if (NewStyleControls and (biSystemMenu in OwnerForm.BorderIcons)) then
       Result := [biSystemMenu];  { close icon - this is OS dependant }
   if ((BS = bsDialog) and (biHelp in OwnerForm.BorderIcons) and
       (biSystemMenu in OwnerForm.BorderIcons)) then
      Result := Result + [biHelp];  { help icon }
   if ((BS = bsSingle) and (biHelp in OwnerForm.BorderIcons) and
       (not(biMinimize in OwnerForm.BorderIcons)) and
       (not(biMaximize in OwnerForm.BorderIcons))) then
      Result := Result + [biHelp];  { help icon }
   if ((BS = bsSizeable) and (biHelp in OwnerForm.BorderIcons) and
       (not(biMinimize in OwnerForm.BorderIcons)) and
       (not(biMaximize in OwnerForm.BorderIcons))) then
      Result := Result + [biHelp];  { help icon }
   if BS = bsDialog then exit;  { no chance of Min&Max buttons }
   if NewStyleControls then
   begin
      if ((biMinimize in OwnerForm.BorderIcons) or (biMaximize in OwnerForm.BorderIcons)) then
         Result := Result + [biMinimize, biMaximize];  { minimise and maximise button }
   end
   else
   begin
      if (biMinimize in OwnerForm.BorderIcons) then
         Result := Result + [biMinimize];  { minimise button }
      if (biMaximize in OwnerForm.BorderIcons) then
         Result := Result + [biMaximize];  { maximise button }
   end;
{$ELSE}
var
  Style, ExStyle: Integer;
begin
  Style := GetWindowLong(HookWnd, GWL_STYLE);
  ExStyle := GetWindowLong(HookWnd, GWL_EXSTYLE);
  Result := [];
  if not Style and (WS_BORDER or WS_SYSMENU) = 0 then
    if ExStyle and WS_EX_TOOLWINDOW = 0 then
    begin
      if NewStyleControls then
        Include(Result, biSystemMenu); { close icon - this is OS dependant }
      if ExStyle and WS_EX_CONTEXTHELP <> 0 then
        Include(Result, biHelp);
      if (Style and DS_MODALFRAME = 0) and (ExStyle and WS_EX_DLGMODALFRAME = 0) then
      begin
        if Style and WS_MINIMIZEBOX <> 0 then
          Include(Result, biMinimize);
        if Style and WS_MAXIMIZEBOX <> 0 then
          Include(Result, biMaximize);
        if NewStyleControls and (Result * [biMinimize, biMaximize] <> []) then
          Result := Result + [biMinimize, biMaximize];
      end
    end else
      Result := [biSystemMenu]; { close icon only }
{$ENDIF}
end;
{-- TMMFormStyler -------------------------------------------------------------}
procedure TMMFormStyler.ExcludeBtnRgn (var R: TRect);
{$IFNDEF BUILD_ACTIVEX}
var
   BtnWidth: integer;
   BI: TBorderIcons;
begin
   if ((OwnerForm.BorderStyle = bsNone) and
       (not(csDesigning in ComponentState))) then exit;
   if ((OwnerForm.BorderStyle in [bsToolWindow, bsSizeToolWin]) and
      (not(csDesigning in ComponentState))) then
      BtnWidth := GetSystemMetrics(SM_CXSMSIZE)
   else
      BtnWidth := GetSystemMetrics(SM_CXSIZE);
  BI := GetVisibleButtons;
  if (biSystemMenu in BI) then R.Right := R.Right - BtnWidth - 2; { close icon }
  if (biMinimize in BI) then R.Right := R.Right - BtnWidth;  { minimize icon }
  if (biMaximize in BI) then R.Right := R.Right - BtnWidth;  { maximize icon }
  if (biHelp in BI) then R.Right := R.Right - BtnWidth - 2;  { help icon }
  if not NewStyleControls then
     if (((biSystemMenu in OwnerForm.BorderIcons) and
          (OwnerForm.BorderStyle in [bsSingle, bsSizeable])) or
          (csDesigning in ComponentState)) then
        R.Left := R.Left + BtnWidth;  { let windows do the system icon in win3 style }
{$ELSE}
var
  BtnWidth,
  Style, ExStyle: Integer;
  BI: TBorderIcons;
begin
  Style := GetWindowLong(HookWnd, GWL_STYLE);
  ExStyle := GetWindowLong(HookWnd, GWL_EXSTYLE);
  if Style and WS_BORDER <> 0 then
  begin
    BtnWidth := GetSystemMetrics(smcButtonX[ExStyle and WS_EX_TOOLWINDOW <> 0]);
    BI := GetVisibleButtons;
    if (biSystemMenu in BI) then
      if NewStyleControls
        then Dec(R.Right, BtnWidth + 2) { close icon }
        else Inc(R.Left, BtnWidth);  { let windows do the system icon in win3 style }
    if (biMinimize in BI)   then Dec(R.Right, BtnWidth);     { minimize icon }
    if (biMaximize in BI)   then Dec(R.Right, BtnWidth);     { maximize icon }
    if (biHelp in BI)       then Dec(R.Right, BtnWidth + 2); { help icon }
  end;
{$ENDIF}
end;
{-- TMMFormStyler -------------------------------------------------------------}
function TMMFormStyler.GetTextRect: TRect;
begin
   Result := GetTitleBarRect;
   ExcludeBtnRgn(result);
   if Result.Right <= Result.Left then {error}
      Result.Right := Result.Left+2;  { right must be greater than left- otherwise system resources get lost }
end;
{-- TMMFormStyler -------------------------------------------------------------}
procedure TMMFormStyler.PaintMenuIcon(DC: HDC; var R: TRect);
const
  LR_COPYFROMRESOURCE = $4000; { Missing from WINDOWS.PAS! }
var
  IconHandle: HIcon;
  NewIconHandle: HIcon;
  IconNeedsDestroying : Boolean;
  IconX, IconY : integer;
begin
   if not NewStyleControls then exit;  { a safety catch - shouldn't be needed }
   Inc(R.Left, 1);
   IconNeedsDestroying := False;
   { Does the form (or application) have an icon assigned to it? }
{$IFDEF BUILD_ACTIVEX}
   if HookWnd <> 0 then
     IconHandle := GetClassLong(HookWnd, GCL_HICON);
   if IconHandle = 0 then
{$ELSE}
   if OwnerForm.Icon.Handle <> 0 then
      IconHandle := OwnerForm.Icon.Handle
   else
{$ENDIF}
     if Application.Icon.Handle <> 0 then
       IconHandle := Application.Icon.Handle
   else
   begin
      IconHandle := LoadIcon(0, IDI_APPLICATION);  { system defined application icon. }
      IconNeedsDestroying := True;
   end;
   IconX := GetSystemMetrics(SM_CXSMICON);
   if IconX = 0 then IconX := GetSystemMetrics(SM_CXSIZE);
   IconY := GetSystemMetrics(SM_CYSMICON);
   if IconY = 0 then IconY := GetSystemMetrics(SM_CYSIZE);
   NewIconHandle := CopyImage(IconHandle,
                              IMAGE_ICON,  { what is it's value??? }
                              IconX, IconY,
                              LR_COPYFROMRESOURCE);
   DrawIconEx(DC, R.Left+1, R.Top+1,
              NewIconHandle,
              0, 0, 0, 0, DI_NORMAL);
   DestroyIcon(NewIconHandle);
   if IconNeedsDestroying then DestroyIcon(IconHandle);
   Inc(R.Left, GetSystemMetrics(SM_CXSMICON)+1);
end;
{-- TMMFormStyler -------------------------------------------------------------}
procedure TMMFormStyler.PaintCaptionText(DC: HDC; var R: TRect; Text: TMMCompanyText; Active: Boolean);
var
   OldColor: TColorRef;
   OldBkMode: integer;
   OldFont: HFont;
   P: ^string;
   S:String;
   RTemp: TRect;
begin
   Inc(R.Left, WordSpacing);
   RTemp:= R;
   if Active then
      OldColor := SetTextColor(DC, ColorToRGB(Text.FColorActive))
   else
      OldColor := SetTextColor(DC, ColorToRGB(Text.FColorInActive));
   OldBkMode := SetBkMode(DC, TRANSPARENT);  { paint text transparently - so gradient can show through }
   { Select in the required font for this text. }
   if Text.FFont.Handle <> 0 then
      OldFont := SelectObject(DC, Text.FFont.Handle)
   else
      OldFont := 0;
   try
      { Draw the text making it left aligned, centered vertically, allowing no line breaks. }
      S := Text.FCaption + #0;
      P := @S[1];
      DrawText(DC, PChar(P), -1, RTemp, DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_CALCRECT);
      DrawText(DC, PChar(P), -1, R, DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_END_ELLIPSIS);
      R.Left := RTemp.Right;
   finally
      { Clean up all the drawing objects. }
      if OldFont <> 0 then
         SelectObject(DC, OldFont);
      SetBkMode(DC, OldBkMode);
      SetTextColor(DC, OldColor);
   end;
end;
{-- TMMFormStyler -------------------------------------------------------------}
procedure TMMFormStyler.PaintCaptionButtons(DC: HDC; var Rect: TRect);
{$IFNDEF BUILD_ACTIVEX}
var
  BtnWidth: integer;
  Flag    : UINT;
  SrcRect : TRect;
  Btns    : TBorderIcons;
begin
   SrcRect := Rect;
   InflateRect(SrcRect, -2, -2);
   Btns := GetVisibleButtons;
   BtnWidth := GetSystemMetrics(SM_CXSIZE)-2;
   if ((OwnerForm.BorderStyle in [bsToolWindow, bsSizeToolWin]) and
       (not (csDesigning in ComponentState))) then
      BtnWidth := GetSystemMetrics(SM_CXSMSIZE)-2;
   SrcRect.Left := SrcRect.Right - BtnWidth;
   { Close button }
   if biSystemMenu in Btns then
   begin
      DrawFrameControl(DC, SrcRect, DFC_CAPTION, DFCS_CAPTIONCLOSE);
      OffsetRect(SrcRect, -BtnWidth-2, 0);
      Dec(Rect.Right,BtnWidth+2);
   end;
   { Maximize button }
   if biMaximize in Btns then
   begin
      if IsZoomed(HookWnd) then
         Flag := DFCS_CAPTIONRESTORE
      else
         Flag := DFCS_CAPTIONMAX;
      { if it doesn't have max in style, then it shows up disabled }
      if not (biMaximize in OwnerForm.BorderIcons) then
         Flag := Flag or DFCS_INACTIVE;
      DrawFrameControl(DC, SrcRect, DFC_CAPTION, Flag);
      OffsetRect(SrcRect, -BtnWidth, 0);
      Dec(Rect.Right,BtnWidth);
   end;
   { Minimize button }
   if biMinimize in Btns then
   begin
      if IsIconic(HookWnd) then
         Flag := DFCS_CAPTIONRESTORE
      else
         Flag := DFCS_CAPTIONMIN;
      { if it doesn't have min in style, then it shows up disabled }
      if not (biMinimize in OwnerForm.BorderIcons) then
         Flag := Flag or DFCS_INACTIVE;
      DrawFrameControl(DC, SrcRect, DFC_CAPTION, Flag);
      OffsetRect(SrcRect, -BtnWidth, 0);
      Dec(Rect.Right,BtnWidth);
   end;
   { Help button }
   if (biHelp in Btns) then
   begin
      DrawFrameControl(DC, SrcRect, DFC_CAPTION, DFCS_CAPTIONHELP);
      Dec(Rect.Right,BtnWidth);
   end;
   Dec(Rect.Right, 3);
{$ELSE}
var
  BtnWidth: integer;
  Flag: UINT;
  SrcRect: TRect;
  Style, ExStyle: Integer;
  BI: TBorderIcons;
begin
  Style := GetWindowLong(HookWnd, GWL_STYLE);
  ExStyle := GetWindowLong(HookWnd, GWL_EXSTYLE);
  SrcRect := Rect;
  InflateRect(SrcRect, -2, -2);
  BI := GetVisibleButtons;
  BtnWidth := GetSystemMetrics(smcButtonX[ExStyle and WS_EX_TOOLWINDOW <> 0]) - 2;
  SrcRect.Left := SrcRect.Right - BtnWidth;
   { Close button }
  if biSystemMenu in BI then
  begin
    DrawFrameControl(DC, SrcRect, DFC_CAPTION, DFCS_CAPTIONCLOSE);
    OffsetRect(SrcRect, -BtnWidth-2, 0);
    Dec(Rect.Right, BtnWidth+2);
  end;
   { Maximize button }
  if biMaximize in BI then
  begin
    if IsZoomed(HookWnd)
      then Flag := DFCS_CAPTIONRESTORE
      else Flag := DFCS_CAPTIONMAX;
     { if it doesn't have max in style, then it shows up disabled }
    if Style and WS_MAXIMIZEBOX = 0 then
      Flag := Flag or DFCS_INACTIVE;
    DrawFrameControl(DC, SrcRect, DFC_CAPTION, Flag);
    OffsetRect(SrcRect, -BtnWidth, 0);
    Dec(Rect.Right,BtnWidth);
  end;
   { Minimize button }
  if biMinimize in BI then
  begin
    if IsIconic(HookWnd)
      then Flag := DFCS_CAPTIONRESTORE
      else Flag := DFCS_CAPTIONMIN;
     { if it doesn't have min in style, then it shows up disabled }
    if Style and WS_MINIMIZEBOX = 0 then
      Flag := Flag or DFCS_INACTIVE;
    DrawFrameControl(DC, SrcRect, DFC_CAPTION, Flag);
    OffsetRect(SrcRect, -BtnWidth, 0);
    Dec(Rect.Right,BtnWidth);
  end;
   { Help button }
  if (biHelp in BI) then
  begin
    DrawFrameControl(DC, SrcRect, DFC_CAPTION, DFCS_CAPTIONHELP);
    Dec(Rect.Right,BtnWidth);
  end;
  Dec(Rect.Right, 3);
{$ENDIF}
end;
{-- TMMFormStyler -------------------------------------------------------------}
function TMMFormStyler.MeasureText(DC: HDC; R: TRect; Text: TMMCompanyText): integer;
var
  OldFont: HFont;
  P: ^string;
  S: String;
begin
   { Select in the required font for this text. }
   if Text.FFont.Handle <> 0 then
      OldFont := SelectObject(DC, Text.FFont.Handle)
   else
      OldFont := 0;
   try     { Measure the text making it left aligned, centered vertically, allowing no line breaks. }
      S := Text.FCaption + #0;
      P := @S[1];
      DrawText(DC, PChar(P), -1, R, DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_CALCRECT);
      Result := R.Right + WordSpacing - R.Left {-1};
   finally
      { Clean up all the drawing objects. }
      if OldFont <> 0 then SelectObject(DC, OldFont);
   end;
end;
{-- TMMFormStyler -------------------------------------------------------------}
function TMMFormStyler.DrawCaption(Active: Boolean): TRect;
var
   DC,OrigDC     : HDC;
   rcText        : TRect;
   rcCaption     : TRect;
   rgbColorLeft  : TColor;
   rgbColorRight : TColor;
   rgbColorPlain : TColor;
   OldBmp        : HBitmap;
   Bmp           : HBitmap;
   TotalTextWidth: longint;
   SpaceForCompanyText : Boolean;
   SpaceForAppNameText : Boolean;
   NumColors     : longint;
   Shaded        : Boolean;
begin
   Result := Rect(0,0,0,0);
{$IFNDEF BUILD_ACTIVEX}
   if ((OwnerForm.BorderStyle = bsNone) and (not (csdesigning in ComponentState))) then
{$ELSE}
   if GetWindowLong(HookWnd, GWL_STYLE) and WS_BORDER = 0 then
{$ENDIF}
        exit;
   OrigDC := GetWindowDC(HookWnd);
   if OrigDC = 0 then exit;
   DC := CreateCompatibleDC(OrigDC);
   if DC = 0 then
   begin
      ReleaseDC(HookWnd, OrigDC);
      exit;
   end;
   rcText := GetTextRect;
   rcCaption := GetTextRect;
   if NewStyleControls then rcCaption := GetTitleBarRect;
   Bmp := CreateCompatibleBitmap(OrigDC, rcCaption.Right, rcCaption.Bottom);
   if Bmp = 0 then
   begin
      ReleaseDC(HookWnd, OrigDC);
      DeleteDC(DC);
      exit;
   end;
   OldBmp := SelectObject(DC, Bmp);
   try
      Result := rcCaption;
      if Active then
         rgbColorPlain := ColorToRGB(clActiveCaption)
      else
         rgbColorPlain := ColorToRGB(clInActiveCaption);
      if Active then
         rgbColorRight := ColorToRGB(ClrRightActive)
      else
         rgbColorRight := ColorToRGB(ClrRightInactive);
      if Active then
         rgbColorLeft  := ColorToRGB(ClrLeftActive)
      else
         rgbColorLeft  := ColorToRGB(ClrLeftInactive);
      case FOptions of
          goAlways : Shaded := True;
          goNever  : Shaded := False;
          goActive : Shaded := Active;
          goSmart  :
          begin
             NumColors := GetDeviceCaps(DC, BITSPIXEL);
             if Active then
                Shaded := NumColors >= 8
             else
                Shaded := NumColors > 8;
          end;
          else Shaded := False;
      end;
      if NewStyleControls then
      begin
         if Shaded then
            FillSolid(DC, rgbColorRight, rcCaption)
         else
            FillSolid(DC, rgbColorPlain, rcCaption);
      end;
      if Shaded then
         FillGradient(DC, rgbColorLeft, rgbColorRight, FNumColors, rcText)
      else
         FillSolid(DC, rgbColorPlain, rcText);
{$IFNDEF BUILD_ACTIVEX}
      if NewStyleControls then
         if (((biSystemMenu in OwnerForm.BorderIcons) and
             (OwnerForm.BorderStyle in [bsSingle, bsSizeable])) or
             (csDesigning in ComponentState)) then
{$ELSE}
      if NewStyleControls then
         if (GetWindowLong(HookWnd, GWL_STYLE) and WS_SYSMENU <> 0) and
            (GetWindowLong(HookWnd, GWL_EXSTYLE) and WS_EX_TOOLWINDOW = 0) then
{$ENDIF}
            PaintMenuIcon(DC, rcText);
      if NewStyleControls then
         PaintCaptionButtons(DC, rcCaption);
      {------------------------------------------------------------------------}
      {Determine if there is sufficient space for the CompanyName text and the }
      {CompanyName text and the standard caption text to be all drawn onto the }
      {working Bitmap (i.e. the caption).  If not, is there enough room for    }
      {the AppName text and the standard caption?                              }
      {------------------------------------------------------------------------}
      FCaptionText.FCaption := FCaptionText.Caption; { safety - catches MDI changes }
      TotalTextWidth := MeasureText(DC,rcText,FCompanyText)*Ord(FCompanyText.Visible)
                                    + MeasureText(dc,rcText,FAppNameText) * ord(FAppNameText.Visible)
                                    + MeasureText(dc,rcText,FCaptionText) * ord(FCaptionText.Visible);
      SpaceForCompanyText := (TotalTextWidth < (rcText.Right - rcText.Left));
      if SpaceForCompanyText then
         SpaceForAppNameText := True { space for company ==> space for appname }
      else
      begin
         TotalTextWidth := MeasureText(DC,rcText,FAppNameText) * ord(FAppNameText.Visible)
                                       + MeasureText(dc,rcText,FCaptionText) * ord(FCaptionText.Visible);
         SpaceForAppNameText := (TotalTextWidth < (rcText.Right - rcText.Left));
      end;
      if not SpaceForAppNameText then
         TotalTextWidth := MeasureText(DC,rcText,FCaptionText);
      case FAlignment of
        taLeftJustify  : { do nothing at all - it is already setup for this default };
        taCenter       : if (TotalTextWidth < rcText.right - rcText.left) then
                             rcText.Left := rcText.left + ((rcText.right - rcText.left - TotalTextWidth) div 2);
        taRightJustify : if (TotalTextWidth < rcText.right - rcText.left) then
                             rcText.Left := rcText.left + (rcText.right - rcText.left - TotalTextWidth);
      end;
      {------------------------------------------------------------------------}
      { Actually draw the CompanyText, AppNameText, and CaptionText.           }
      {------------------------------------------------------------------------}
      if (SpaceForCompanyText and (FCompanyText.FCaption <> '') and (FCompanyText.FVisible)) then
          PaintCaptionText(DC, rcText, FCompanyText, Active);
      if ((SpaceForAppNameText) and (FAppNameText.FCaption <> '') and (FAppNameText.FVisible)) then
           PaintCaptionText(DC, rcText, FAppNameText, Active);
      { Truncate the window caption text, until it will fit into the caption bar.}
      if FCaptionText.FVisible then
         PaintCaptionText(DC, rcText, FCaptionText, Active);
      { copy from temp DC, onto the actual window Caption }
      BitBlt(OrigDC, Result.Left, Result.Top, Result.Right-Result.Left,
                     Result.Bottom-Result.Top,
             DC, Result.Left, Result.Top, SRCCOPY);
   finally
      { Clean up device context & free memory}{ Release the working bitmap resources }
      Bmp := SelectObject(DC, OldBmp);
      DeleteObject(Bmp);
      DeleteDC(DC);
      ReleaseDC(HookWnd, OrigDC);
   end;
end;
{-- TMMFormStyler -------------------------------------------------------------}
procedure TMMFormStyler.SetAutoFontHeight(Font: TFont);
var
   FTextHeight    : longint;
   FSysTextHeight : longint;
   FTextMetrics   : TTextMetric;
   FSysTextMetrics: TTextMetric;
   WrkBMP         : TBitmap;
begin
   WrkBmp := TBitmap.Create;
   try
      WrkBmp.Width := 10;
      WrkBmp.Height := 10;
      WrkBMP.Canvas.Font.Assign(Font);
      GetTextMetrics(WrkBmp.Canvas.Handle, FTextMetrics);
      WrkBMP.Canvas.Font.Assign(FSystemFont);
      GetTextMetrics(WrkBmp.Canvas.Handle, FSysTextMetrics);
      FTextHeight := FTextMetrics.tmHeight - FTextMetrics.tmInternalLeading;
      FSysTextHeight := FSysTextMetrics.tmHeight - FSysTextMetrics.tmInternalLeading;
      Font.Height:= Font.Height + FTextHeight - FSysTextHeight;
      WrkBMP.Canvas.Font.Assign(Font);
      GetTextMetrics(WrkBmp.Canvas.Handle, FTextMetrics);
      FTextHeight := FTextMetrics.tmHeight - FTextMetrics.tmInternalLeading;
      if (FTextHeight > FSysTextHeight) then
          Font.Height := Font.Height + FTextHeight - FSysTextHeight;
   finally
       Wrkbmp.Free;
   end;
end;
{-- TMMFormStyler -------------------------------------------------------------}
procedure TMMFormStyler.SetColors(index: integer; aValue: TColor);
begin
   case index of
       0: if (aValue = FClrLeftActive) then exit else FClrLeftActive := aValue;
       1: if (aValue = FClrLeftInActive) then exit else FClrLeftInActive := aValue;
       2: if (aValue = FClrRightActive) then exit else FClrRightActive := aValue;
       3: if (aValue = FClrRightInActive) then exit else FClrRightInActive := aValue;
   end;
   if csDesigning in ComponentState then UpdateCaption;
end;
{-- TMMFormStyler -------------------------------------------------------------}
procedure TMMFormStyler.SetOptions(aValue: TMMGradientOptions);
begin
   if (aValue <> FOptions) then
   begin
      FOptions := aValue;
      if csDesigning in ComponentState then UpdateCaption;
   end;
end;
{-- TMMFormStyler -------------------------------------------------------------}
procedure TMMFormStyler.SetAlignment(aValue: TAlignment);
begin
   if (aValue <> FAlignment) then
   begin
      FAlignment := aValue;
      if csDesigning in ComponentState then UpdateCaption;
   end;
end;
{-- TMMFormStyler -------------------------------------------------------------}
procedure TMMFormStyler.SetNumColors(aValue: TMMGradientColors);
begin
   if (aValue <> FNumColors) then
   begin
      FNumColors := aValue;
      if csDesigning in ComponentState then UpdateCaption;
   end;
end;
{-- TMMFormStyler -------------------------------------------------------------}
function TMMFormStyler.HandleWMSetCursor(var Msg: TWMSetCursor): Boolean;
begin
   Msg.Result := 1;
   { Load and display the correct cursor for the border area being hit }
   case Msg.HitTest of
       HTTOP,
       HTBOTTOM     : SetCursor(LoadCursor(0, MakeIntResource(IDC_SIZENS)));
       HTLEFT,
       HTRIGHT      : SetCursor(LoadCursor(0, MakeIntResource(IDC_SIZEWE)));
       HTTOPRIGHT,
       HTBOTTOMLEFT : SetCursor(LoadCursor(0, MakeIntResource(IDC_SIZENESW)));
       HTTOPLEFT,
       HTBOTTOMRIGHT: SetCursor(LoadCursor(0, MakeIntResource(IDC_SIZENWSE)));
     else
     begin
        Msg.Result := 0;
        inherited;
     end;
   end;
   Result := (Msg.Result = 1);
end;
{$IFDEF BUILD_ACTIVEX}
procedure TMMFormStyler.HookOwner;
var
  Styler: TMMFormStyler;
begin
  if Enabled and not (csDestroying in ComponentState) then
  begin
    Styler := FindStylerForWindow(HookWnd);
    if (Styler <> Self) and (Styler <> nil) then
    begin
      Enabled := False;
      exit; // raise Exception.Create(SSecondStyler);
    end;
    inherited;
    UpdateCaption;
  end;
end;
procedure TMMFormStyler.UnhookOwner;
var
  H: HWnd;
begin
  if FormOK then
  begin
    H := HookWnd;
    inherited;
    SetWindowText(H, PChar(FCaptionText.Caption));
    InvalidateRect(H, nil, False);
  end else
    inherited;
end;
procedure TMMFormStyler.CMEnabledChanged(var M: TMessage);
begin
  inherited;
  if Enabled then HookOwner else UnhookOwner;
  UpdateCaption;
end;
{$ENDIF}
end.

						