pgsetup.pas

动态提示控件

      finally
        GlobalUnlock(Handle);
        GlobalUnlock(Result);
      end
  end else
    Result := 0;
end;

function TdfsPageSetupDialog.DoExecute(Func: pointer): boolean;
const
  PageSetupOptions: array [TPageSetupOption] of DWORD = (
     PSD_DEFAULTMINMARGINS, PSD_DISABLEMARGINS, PSD_DISABLEORIENTATION,
     PSD_DISABLEPAGEPAINTING, PSD_DISABLEPAPER, PSD_DISABLEPRINTER,
     PSD_NOWARNING, PSD_SHOWHELP
    );
  PageSetupMeasurements: array [TPSMeasurements] of DWORD = (
     0, PSD_INHUNDREDTHSOFMILLIMETERS, PSD_INTHOUSANDTHSOFINCHES
    );
var
  Option: TPageSetupOption;
  PageSetup: TPageSetupDlg;
  SavePageSetupDialog: TdfsPageSetupDialog;
  DevHandle: THandle;
begin
  FillChar(PageSetup, SizeOf(PageSetup), 0);
  with PageSetup do
  try
    // Make sure the user has a printer installed.  If not, calling PageSetupDlg
    // will cause an error message to be displayed, so we'll avoid that.
    if FGettingDefaults and (Printers.Printer.Printers.Count < 1) then
    begin
      // No printer installed, just fill with some semi-reasonable default values
      ptPaperSize := Point(8500, 11000); // 8 1/2" X 11" letter size
      rtMinMargin := Rect(250, 250, 250, 250); // 1/4"
      rtMargin := rtMinMargin; // 1/4"
      Result := TRUE;
    end else begin
      {$IFDEF DFS_COMPILER_2}
      hInstance := System.HInstance;
      {$ELSE}
      hInstance := SysInit.HInstance;
      {$ENDIF}
      lStructSize := SizeOf(TPageSetupDlg);

      if FGettingDefaults then
      begin
        // Using millimeters always fails to retreive margins and minimum margins.
        // Only inches seems to work so I use that and convert.
        Flags := PSD_MARGINS or PSD_DEFAULTMINMARGINS or PSD_RETURNDEFAULT or
           PSD_INTHOUSANDTHSOFINCHES;
      end else begin
        Flags := PSD_MARGINS;
        Flags := Flags OR PageSetupMeasurements[CurrentMeasurements];
        if not (poDefaultMinMargins in FOptions) then
          Flags := Flags or PSD_MINMARGINS;

        if assigned(FOnPrinter) or assigned(FOnInitPaintPage) or
           assigned(FOnPaintPage) or FCentered then
        begin
          Flags := Flags or PSD_ENABLEPAGESETUPHOOK;
          lpfnPageSetupHook := PageSetupDialogHook;
        end;

        for Option := Low(Option) to High(Option) do
          if Option in FOptions then
            Flags := Flags OR PageSetupOptions[Option];
    {    if not assigned(FOnPrinter) then
          Flags := Flags OR PSD_DISABLEPRINTER;}
        if assigned(FOnInitPaintPage) and assigned(FOnPaintPage) then
        begin
          Flags := Flags OR PSD_ENABLEPAGEPAINTHOOK;
          lpfnPagePaintHook := PageSetupDialogHook;
        end;
        HookCtl3D := Ctl3D;
        lCustData := FCustomData;

        GetPrinter(DevHandle, hDevNames);
        hDevMode := CopyData(DevHandle);

        // This appears to do nothing.
        ptPaperSize := FPaperSize.Point;
        rtMinMargin := FMinimumMargins.Rect;
        rtMargin := FMargins.Rect;
        if (Flags and PSD_MINMARGINS) <> 0 then
        begin
          // rtMargin can not be smaller than rtMinMargin or dialog call will fail!
          if rtMargin.Left < rtMinMargin.Left then
            rtMargin.Left := rtMinMargin.Left;
          if rtMargin.Right < rtMinMargin.Right then
            rtMargin.Right := rtMinMargin.Right;
          if rtMargin.Top < rtMinMargin.Top then
            rtMargin.Top := rtMinMargin.Top;
          if rtMargin.Bottom < rtMinMargin.Bottom then
            rtMargin.Bottom := rtMinMargin.Bottom;
        end;
      end;

      hWndOwner := Application.Handle;

      SavePageSetupDialog := PageSetupDialog;
      PageSetupDialog := Self;
      if FGettingDefaults then
        Result := PageSetupDlg(PageSetup)
      else
        Result := TaskModalDialog(Func, PageSetup);
      PageSetupDialog := SavePageSetupDialog;
    end;

    if Result then
    begin
      // don't stomp on values that don't match defaults!
      if FGettingDefaults and (CurrentMeasurements = pmMillimeters) then
      begin
        // Defaults are always retreived in inches because the API won't
        // cooperate with defaults in millimeters.  Have to convert by hand.
        if (csLoading in ComponentState) or
           (DefPaperSizeM.Compare(FPaperSize)) then
        begin
          FPaperSize.X := Round(ptPaperSize.X * 2.54);
          FPaperSize.Y := Round(ptPaperSize.Y * 2.54);
        end;
        if (csLoading in ComponentState) or
           (DefMinimumMarginsM.Compare(FMinimumMargins)) then
        begin
          FMinimumMargins.Left := Round(rtMinMargin.Left * 2.54);
          FMinimumMargins.Top := Round(rtMinMargin.Top * 2.54);
          FMinimumMargins.Right := Round(rtMinMargin.Right * 2.54);
          FMinimumMargins.Bottom := Round(rtMinMargin.Bottom * 2.54);
        end;
        if (csLoading in ComponentState) or
           (DefMarginsM.Compare(FMargins)) then
        begin
          FMargins.Left := Round(rtMargin.Left * 2.54);
          FMargins.Top := Round(rtMargin.Top * 2.54);
          FMargins.Right := Round(rtMargin.Right * 2.54);
          FMargins.Bottom := Round(rtMargin.Bottom * 2.54);
        end;
      end else begin
        FPaperSize.Point := ptPaperSize;
        FMinimumMargins.Rect := rtMinMargin;
        FMargins.Rect := rtMargin;
      end;

      // Only do this if not getting defaults
      if not FGettingDefaults then
        SetPrinter(hDevMode, hDevNames);
    end else begin
      if hDevMode <> 0 then GlobalFree(hDevMode);
      if hDevNames <> 0 then GlobalFree(hDevNames);
    end;
  finally
    { Nothing yet }
  end;
end;

function TdfsPageSetupDialog.ReadCurrentValues: boolean;
begin
  FGettingDefaults := TRUE;
  try
    Result := DoExecute(@PageSetupDlg)
  finally
    FGettingDefaults := FALSE;
  end;
end;

const
  MeasurementsDiv : array [pmMillimeters..pmInches] of TPSMeasureVal = (
     100.0,1000.0
  );

function TdfsPageSetupDialog.FromMeasurementVal(Val: integer): TPSMeasureVal;
begin
  Result := Val / MeasurementsDiv[CurrentMeasurements];
end;

function TdfsPageSetupDialog.ToMeasurementVal(Val: TPSMeasureVal): integer;
const
  MeasurementsDiv : array [pmMillimeters..pmInches] of TPSMeasureVal = (
     100.0,1000.0
  );
begin
  Result := Round(Val * MeasurementsDiv[CurrentMeasurements]);
end;

function TdfsPageSetupDialog.Execute: boolean;
begin
  FGettingDefaults := FALSE; // just in case
  Result := DoExecute(@PageSetupDlg);
end;

function TdfsPageSetupDialog.Printer(Wnd: HWND): boolean;
begin
  Result :=  assigned(FOnPrinter);
  if Result then
    FOnPrinter(Self, Wnd);
end;

function TdfsPageSetupDialog.DoPrinter(Wnd: HWND): boolean;
begin
  try
    Result := Printer(Wnd);
  except
    Result := FALSE;
    Application.HandleException(Self);
  end;
end;

function TdfsPageSetupDialog.GetPaperSizeType: SHORT;
var
  Device, Driver, Port: array[0..79] of char;
  HDevMode: THandle;
  PDevMode: PDeviceMode;
begin
  Result := 0;
  Printers.Printer.GetPrinter(Device, Driver, Port, HDevMode);
  if HDevMode <> 0 then
  begin
    try
      PDevMode := GlobalLock(HDevMode);
      Result := PDevMode.dmPaperSize;
    finally
      GlobalUnlock(HDevMode);
    end;
  end;
end;

procedure TdfsPageSetupDialog.SetPaperSizeType(Value: short);
var
  Device, Driver, Port: array[0..79] of char;
  HDevMode: THandle;
  PDevMode: PDeviceMode;
begin
  Printers.Printer.GetPrinter(Device, Driver, Port, HDevMode);
  if HDevMode <> 0 then
  begin
    try
      PDevMode := GlobalLock(HDevMode);
      PDevMode.dmPaperSize := Value;
    finally
      GlobalUnlock(HDevMode);
    end;
  end;
end;

function TdfsPageSetupDialog.GetVersion: string;
begin
  Result := DFS_COMPONENT_VERSION;
end;

procedure TdfsPageSetupDialog.SetVersion(const Val: string);
begin
  { empty write method, just needed to get it to show up in Object Inspector }
end;



{ Initialization and cleanup }

procedure InitGlobals;
var
  PageSetup: TPageSetupDlg;
begin
  if not NeedInitGlobals then exit;
  
  NeedInitGlobals := FALSE;
  HelpMsg := RegisterWindowMessage(HelpMsgString);

  DefPaperSizeI := TPSPoint.Create;
  DefMinimumMarginsI := TPSRect.Create;
  DefMarginsI := TPSRect.Create;

  // Make sure the user has a printer installed.  If not, calling PageSetupDlg
  // will cause an error message to be displayed, so we'll avoid that.
  if Printers.Printer.Printers.Count > 0 then
  begin
    FillChar(PageSetup, SizeOf(PageSetup), 0);
    PageSetup.hInstance := HInstance;
    with PageSetup do
    begin
      lStructSize := SizeOf(TPageSetupDlg);
      hWndOwner := Application.Handle;
      Flags := PSD_MARGINS or PSD_DEFAULTMINMARGINS or PSD_INTHOUSANDTHSOFINCHES
         or PSD_RETURNDEFAULT;
      if PageSetupDlg(PageSetup) then
      begin
        DefPaperSizeI.Point := ptPaperSize;
        DefMinimumMarginsI.Rect := rtMinMargin;
        DefMarginsI.Rect := rtMargin;
      end;
      if hDevMode <> 0 then GlobalFree(hDevMode);
      if hDevNames <> 0 then GlobalFree(hDevNames);
    end;
  end else begin
    // No printer installed, just fill with some semi-reasonable default values
    DefPaperSizeI.Point := Point(8500, 11000); // 8 1/2" X 11" letter size
    DefMinimumMarginsI.Rect := Rect(250, 250, 250, 250); // 1/4"
    DefMarginsI.Rect := DefMinimumMarginsI.Rect; // 1/4"
  end;

  DefPaperSizeM := TPSPoint.Create;
  DefMinimumMarginsM := TPSRect.Create;
  DefMarginsM := TPSRect.Create;

  // convert 1/1000 of inches to 1/100 of millimeters
  DefPaperSizeM.X := Round(DefPaperSizeI.X * 2.54);
  DefPaperSizeM.Y := Round(DefPaperSizeI.Y * 2.54);
  DefMinimumMarginsM.Top := Round(DefMinimumMarginsI.Top * 2.54);
  DefMinimumMarginsM.Left := Round(DefMinimumMarginsI.Left * 2.54);
  DefMinimumMarginsM.Right := Round(DefMinimumMarginsI.Right * 2.54);
  DefMinimumMarginsM.Bottom := Round(DefMinimumMarginsI.Bottom * 2.54);
  DefMarginsM.Top := Round(DefMarginsI.Top * 2.54);
  DefMarginsM.Left := Round(DefMarginsI.Left * 2.54);
  DefMarginsM.Right := Round(DefMarginsI.Right * 2.54);
  DefMarginsM.Bottom := Round(DefMarginsI.Bottom * 2.54);
end;

procedure DoneGlobals;
begin
  if not NeedInitGlobals then
  begin
    NeedInitGlobals := TRUE;
    DefPaperSizeI.Free;
    DefMinimumMarginsI.Free;
    DefMarginsI.Free;
    DefPaperSizeM.Free;
    DefMinimumMarginsM.Free;
    DefMarginsM.Free;
  end;
end;

{$IFDEF DFS_DEBUG}
var
  t: dword;
{$ENDIF}

initialization
{$IFDEF DFS_DEBUG}
  t := timegettime;
{$ENDIF}
  NeedInitGlobals := TRUE;
{$IFDEF DFS_DEBUG}
//  odm('Milliseconds: ', timegettime - t);
{$ENDIF}

finalization
  DoneGlobals;
end.