mmform.pas

一套及时通讯的原码

  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;