setupform.pas

源代码

unit SetupForm;

{
  Inno Setup
  Copyright (C) 1997-2004 Jordan Russell
  Portions by Martijn Laan
  For conditions of distribution and use, see LICENSE.TXT.

  TSetupForm

  $jrsoftware: issrc/Projects/SetupForm.pas,v 1.4 2004/09/13 19:13:13 jr Exp $
}

interface

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

type
  TSetupForm = class(TUIStateForm)
  private
    FBaseUnitX, FBaseUnitY: Integer;
  public
    function CalculateButtonWidth(const ButtonCaptions: array of TSetupMessageID): Integer;
    procedure Center;
    procedure CenterInsideControl(const Ctl: TWinControl;
      const InsideClientArea: Boolean);
    procedure CenterInsideRect(const InsideRect: TRect);
    procedure InitializeFont;
    function ScalePixelsX(const N: Integer): Integer;
    function ScalePixelsY(const N: Integer): Integer;
    property BaseUnitX: Integer read FBaseUnitX;
    property BaseUnitY: Integer read FBaseUnitY;
  end;

procedure CalculateBaseUnitsFromFont(const Font: TFont; var X, Y: Integer);
function SetFontNameSize(const AFont: TFont; const AName: String;
  const ASize: Integer; const AFallbackName: String;
  const AFallbackSize: Integer): Boolean;

const
  OrigBaseUnitX = 6;
  OrigBaseUnitY = 13;

implementation

uses
  CmnFunc2, Main, Msgs;

function GetRectOfPrimaryMonitor: TRect;
begin
  if not SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0) then
    Result := Rect(0, 0, Screen.Width, Screen.Height);
end;

function GetRectOfMonitorContainingRect(const R: TRect): TRect;
{ Returns bounding rectangle of monitor containing or nearest to R }
type
  HMONITOR = type THandle;
  TMonitorInfo = record
    cbSize: DWORD;
    rcMonitor: TRect;
    rcWork: TRect;
    dwFlags: DWORD;
  end;
const
  MONITOR_DEFAULTTONEAREST = $00000002;
var
  Module: HMODULE;
  MonitorFromRect: function(const lprc: TRect; dwFlags: DWORD): HMONITOR; stdcall;
  GetMonitorInfo: function(hMonitor: HMONITOR; var lpmi: TMonitorInfo): BOOL; stdcall;
  M: HMONITOR;
  Info: TMonitorInfo;
begin
  Module := GetModuleHandle(user32);
  MonitorFromRect := GetProcAddress(Module, 'MonitorFromRect');
  GetMonitorInfo := GetProcAddress(Module, 'GetMonitorInfoA');
  if Assigned(MonitorFromRect) and Assigned(GetMonitorInfo) then begin
    M := MonitorFromRect(R, MONITOR_DEFAULTTONEAREST);
    Info.cbSize := SizeOf(Info);
    if GetMonitorInfo(M, Info) then begin
      Result := Info.rcWork;
      Exit;
    end;
  end;
  Result := GetRectOfPrimaryMonitor;
end;

function SetFontNameSize(const AFont: TFont; const AName: String;
  const ASize: Integer; const AFallbackName: String;
  const AFallbackSize: Integer): Boolean;
{ Returns True if AName <> '' and it used AName as the font name,
  False otherwise. }

  function SizeToHeight(const S: Integer): Integer;
  begin
    Result := MulDiv(-S, Screen.PixelsPerInch, 72);
  end;

begin
  Result := False;
  if AName <> '' then begin
    if FontExists(AName) then begin
      AFont.Name := AName;
      AFont.Height := SizeToHeight(ASize);
      Result := True;
      Exit;
    end;
    { Note: AFallbackName is not used if the user specified an empty string for
      AName because in that case they want the default font used always }
    if (AFallbackName <> '') and FontExists(AFallbackName) then begin
      AFont.Name := AFallbackName;
      AFont.Height := SizeToHeight(AFallbackSize);
      Exit;
    end;
  end;
  AFont.Name := GetPreferredUIFont;
  AFont.Height := SizeToHeight(AFallbackSize);
end;

procedure CalculateBaseUnitsFromFont(const Font: TFont; var X, Y: Integer);
var
  DC: HDC;
  Size: TSize;
  TM: TTextMetric;
begin
  DC := GetDC(0);
  try
    SelectObject(DC, Font.Handle);
    { Based on code from Q145994: }
    GetTextExtentPoint(DC,
      'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz', 52, Size);
    X := (Size.cx div 26 + 1) div 2;
    GetTextMetrics(DC, TM);
    Y := TM.tmHeight;
  finally
    ReleaseDC(0, DC);
  end;
end;

procedure NewChangeScale(const Ctl: TControl; const XM, XD, YM, YD: Integer);
var
  X, Y, W, H: Integer;
begin
  X := MulDiv(Ctl.Left, XM, XD);
  Y := MulDiv(Ctl.Top, YM, YD);
  if not(csFixedWidth in Ctl.ControlStyle) then
    W := MulDiv(Ctl.Left + Ctl.Width, XM, XD) - X
  else
    W := Ctl.Width;
  if not(csFixedHeight in Ctl.ControlStyle) then
    H := MulDiv(Ctl.Top + Ctl.Height, YM, YD) - Y
  else
    H := Ctl.Height;
  Ctl.SetBounds(X, Y, W, H);
end;

procedure NewScaleControls(const Ctl: TWinControl; const XM, XD, YM, YD: Integer);
{ This is like TControl.ScaleControls, except it allows the width and height
  to be scaled independently }
var
  I: Integer;
  C: TControl;
begin
  for I := 0 to Ctl.ControlCount-1 do begin
    C := Ctl.Controls[I];
    if C is TWinControl then begin
      TWinControl(C).DisableAlign;
      try
        NewScaleControls(TWinControl(C), XM, XD, YM, YD);
        NewChangeScale(C, XM, XD, YM, YD);
      finally
        TWinControl(C).EnableAlign;
      end;
    end
    else
      NewChangeScale(C, XM, XD, YM, YD);
  end;
end;

{ TSetupForm }

function TSetupForm.CalculateButtonWidth(const ButtonCaptions: array of TSetupMessageID): Integer;
var
  DC: HDC;
  I, W: Integer;
begin
  Result := ScalePixelsX(75);
  { Increase the button size if there are unusually long button captions }
  DC := GetDC(0);
  try
    SelectObject(DC, Font.Handle);
    for I := Low(ButtonCaptions) to High(ButtonCaptions) do begin
      W := GetTextWidth(DC, SetupMessages[ButtonCaptions[I]], True) + 20;
      if Result < W then
        Result := W;
    end;
  finally
    ReleaseDC(0, DC);
  end;
end;

procedure TSetupForm.CenterInsideControl(const Ctl: TWinControl;
  const InsideClientArea: Boolean);
var
  R: TRect;
begin
  if not InsideClientArea then begin
    if GetWindowRect(Ctl.Handle, R) then
      CenterInsideRect(R);
  end
  else begin
    R := Ctl.ClientRect;
    MapWindowPoints(Ctl.Handle, 0, R, 2);
    CenterInsideRect(R);
  end;
end;

procedure TSetupForm.CenterInsideRect(const InsideRect: TRect);
var
  R, MR: TRect;
begin
  R := Bounds(InsideRect.Left + ((InsideRect.Right - InsideRect.Left) - Width) div 2,
    InsideRect.Top + ((InsideRect.Bottom - InsideRect.Top) - Height) div 2,
    Width, Height);

  { Clip to nearest monitor }
  MR := GetRectOfMonitorContainingRect(R);
  if R.Right > MR.Right then
    OffsetRect(R, MR.Right - R.Right, 0);
  if R.Bottom > MR.Bottom then
    OffsetRect(R, 0, MR.Bottom - R.Bottom);
  if R.Left < MR.Left then
    OffsetRect(R, MR.Left - R.Left, 0);
  if R.Top < MR.Top then
    OffsetRect(R, 0, MR.Top - R.Top);

  BoundsRect := R;
end;

procedure TSetupForm.Center;
begin
  CenterInsideRect(GetRectOfPrimaryMonitor);
end;

procedure TSetupForm.InitializeFont;
var
  W, H: Integer;
  R: TRect;
begin
  { Note: Must keep the following lines in synch with ScriptFunc_R's
    InitializeScaleBaseUnits }
  SetFontNameSize(Font, LangOptions.DialogFontName, LangOptions.DialogFontSize,
    '', 8);
  CalculateBaseUnitsFromFont(Font, FBaseUnitX, FBaseUnitY);

  if (FBaseUnitX <> OrigBaseUnitX) or (FBaseUnitY <> OrigBaseUnitY) then begin
    { Loosely based on scaling code from TForm.ReadState: }
    NewScaleControls(Self, BaseUnitX, OrigBaseUnitX, BaseUnitY, OrigBaseUnitY);
    R := ClientRect;
    W := MulDiv(R.Right, FBaseUnitX, OrigBaseUnitX);
    H := MulDiv(R.Bottom, FBaseUnitY, OrigBaseUnitY);
    SetBounds(Left, Top, W + (Width - R.Right), H + (Height - R.Bottom));
  end;
end;

function TSetupForm.ScalePixelsX(const N: Integer): Integer;
begin
  Result := MulDiv(N, BaseUnitX, OrigBaseUnitX);
end;

function TSetupForm.ScalePixelsY(const N: Integer): Integer;
begin
  Result := MulDiv(N, BaseUnitY, OrigBaseUnitY);
end;

end.