pgsetup.pas

动态提示控件

function PageSetupDialogHook(Wnd: HWnd; Msg: UINT; WParam: WPARAM;
                             LParam: LPARAM): UINT; stdcall;
const
  PagePaintWhat: array[WM_PSD_FULLPAGERECT..
                       WM_PSD_YAFULLPAGERECT] of TPSPaintWhat = (
    pwFullPage, pwMinimumMargins, pwMargins,
    pwGreekText, pwEnvStamp, pwYAFullPage
  );
  PRINTER_MASK = $00000002;
  ORIENT_MASK  = $00000004;
  PAPER_MASK   = $00000008;
var
  PaperData: word;
  Paper: TPSPaperType;
  Orient: TPSPaperOrientation;
  Printer: TPSPrinterType;
  PaintRect: TRect;
  PaintCanvas: TCanvas;
begin
  if (Msg = WM_COMMAND) and (LongRec(WParam).Lo = IDPRINTERBTN) and
     (LongRec(WParam).Hi = BN_CLICKED) then
  begin
    // if hander is assigned, use it.  If not, let system do it.
    Result := ord(PageSetupDialog.DoPrinter(Wnd));
  end else begin
    if assigned(PageSetupDialog.FOnInitPaintPage) and
       assigned(PageSetupDialog.FOnPaintPage) then
    begin
      case Msg of
        WM_PSD_PAGESETUPDLG:
          begin
            PaperData := HiWord(WParam);
            if (PaperData AND PAPER_MASK > 0) then
              Paper := ptEnvelope
            else
              Paper := ptPaper;
            if (PaperData AND ORIENT_MASK > 0) then
              Orient := poPortrait
            else
              Orient := poLandscape;
            if (PaperData AND PAPER_MASK > 0) then
              Printer := ptHPPCL
            else
              Printer := ptDotMatrix;
            Result := Ord(PageSetupDialog.FOnInitPaintPage(PageSetupDialog,
               LoWord(WParam), Paper, Orient, Printer, PPSDlgData(LParam)));
          end;
        WM_PSD_FULLPAGERECT,
        WM_PSD_MINMARGINRECT,
        WM_PSD_MARGINRECT,
        WM_PSD_GREEKTEXTRECT,
        WM_PSD_ENVSTAMPRECT,
        WM_PSD_YAFULLPAGERECT:
          begin
            if LParam <> 0 then
              PaintRect := PRect(LParam)^
            else
              PaintRect := Rect(0,0,0,0);
            PaintCanvas := TCanvas.Create;
            PaintCanvas.Handle := HDC(WParam);
            try
              Result := Ord(PageSetupDialog.FOnPaintPage(PageSetupDialog,
                 PagePaintWhat[Msg], PaintCanvas, PaintRect));
            finally
              PaintCanvas.Free;   { This better not be deleting the DC! }
            end;
          end;
      else
        Result := DialogHook(Wnd, Msg, wParam, lParam);
      end;
    end else
      Result := DialogHook(Wnd, Msg, wParam, lParam);
  end;
end;


{$IFDEF DFS_CPPB_4_UP}
function TPSRect.GetLeft: integer;
begin
  Result := FRect.Left;
end;

procedure TPSRect.SetLeft(Value: integer);
begin
  FRect.Left := Value;
end;

function TPSRect.GetRight: integer;
begin
  Result := FRect.Right;
end;

procedure TPSRect.SetRight(Value: integer);
begin
  FRect.Right := Value;
end;

function TPSRect.GetTop: integer;
begin
  Result := FRect.Top;
end;

procedure TPSRect.SetTop(Value: integer);
begin
  FRect.Top := Value;
end;

function TPSRect.GetBottom: integer;
begin
  Result := FRect.Bottom;
end;

procedure TPSRect.SetBottom(Value: integer);
begin
  FRect.Bottom := Value;
end;

{$ENDIF}

function TPSRect.Compare(Other: TPSRect): boolean;
begin
  Result := EqualRect(Rect, Other.Rect);
end;

function TPSPoint.Compare(Other: TPSPoint): boolean;
begin
  Result := (X = Other.X) and (Y = Other.Y);
end;

function TPSPoint.GetX: longint;
begin
  Result := FPoint.X;
end;

procedure TPSPoint.SetX(Val: longint);
begin
  FPoint.X := Val;
end;

function TPSPoint.GetY: longint;
begin
  Result := FPoint.Y;
end;

procedure TPSPoint.SetY(Val: longint);
begin
  FPoint.Y := Val;
end;



constructor TdfsPageSetupDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  InitGlobals;
  FCentered := TRUE;
  FOptions := [poDefaultMinMargins, poShowHelp];
  FOnPrinter := NIL;
  FOnInitPaintPage := NIL;
  FOnPaintPage := NIL;
  FCustomData := 0;
  FMeasurements := pmDefault;
  FPaperSize := TPSPoint.Create;
  FMinimumMargins := TPSRect.Create;
  FMargins := TPSRect.Create;
  if CurrentMeasurements = pmInches then
  begin
    FPaperSize.Point := DefPaperSizeI.Point;
    FMinimumMargins.Rect := DefMinimumMarginsI.Rect;
    FMargins.Rect := DefMarginsI.Rect;
  end else begin
    FPaperSize.Point := DefPaperSizeM.Point;
    FMinimumMargins.Rect := DefMinimumMarginsM.Rect;
    FMargins.Rect := DefMarginsM.Rect;
  end;
end;

destructor TdfsPageSetupDialog.Destroy;
begin
  FPaperSize.Free;
  FMinimumMargins.Free;
  FMargins.Free;

  inherited Destroy;
end;

procedure TdfsPageSetupDialog.SetName(const NewName: TComponentName);
begin
  inherited Setname(NewName);
  if not (csLoading in ComponentState) then
    ReadCurrentValues;
end;

procedure TdfsPageSetupDialog.SetPaperSize(const Val: TPSPoint);
begin
  FPaperSize.Point := Val.Point;
end;

function TdfsPageSetupDialog.StorePaperSize: boolean;
begin
  if CurrentMeasurements = pmInches then
    Result := not PaperSize.Compare(DefPaperSizeI)
  else
    Result := not PaperSize.Compare(DefPaperSizeM);
end;

procedure TdfsPageSetupDialog.SetMinimumMargins(const Val: TPSRect);
begin
  FMinimumMargins.Rect := Val.Rect;
end;

function TdfsPageSetupDialog.StoreMinimumMargins: boolean;
begin
  if CurrentMeasurements = pmInches then
    Result := not MinimumMargins.Compare(DefMinimumMarginsI)
  else
    Result := not MinimumMargins.Compare(DefMinimumMarginsM);
end;

procedure TdfsPageSetupDialog.SetMargins(const Val: TPSRect);
begin
  FMargins.Rect := Val.Rect;
end;

function TdfsPageSetupDialog.StoreMargins: boolean;
begin
  if CurrentMeasurements = pmInches then
    Result := not Margins.Compare(DefMarginsI)
  else
    Result := not Margins.Compare(DefMarginsM);
end;

procedure TdfsPageSetupDialog.SetMeasurements(Val: TPSMeasurements);
var
  TempVal: TPSMeasurements;
begin
  if Val = pmDefault then
    TempVal := DefaultMeasurements
  else
    TempVal := Val;
  if CurrentMeasurements <> TempVal then
  begin
    if TempVal = pmInches then
    begin
      // Convert to thousandths of an inch
      PaperSize.X := Round(PaperSize.X / 2.54);
      PaperSize.Y := Round(PaperSize.Y / 2.54);
      MinimumMargins.Top := Round(MinimumMargins.Top / 2.54);
      MinimumMargins.Left := Round(MinimumMargins.Left / 2.54);
      MinimumMargins.Right := Round(MinimumMargins.Right / 2.54);
      MinimumMargins.Bottom := Round(MinimumMargins.Bottom / 2.54);
      Margins.Top := Round(Margins.Top / 2.54);
      Margins.Left := Round(Margins.Left / 2.54);
      Margins.Right := Round(Margins.Right / 2.54);
      Margins.Bottom := Round(Margins.Bottom / 2.54);
    end else begin
      // Convert to millimeters
      PaperSize.X := Round(PaperSize.X * 2.54);
      PaperSize.Y := Round(PaperSize.Y * 2.54);
      MinimumMargins.Top := Round(MinimumMargins.Top * 2.54);
      MinimumMargins.Left := Round(MinimumMargins.Left * 2.54);
      MinimumMargins.Right := Round(MinimumMargins.Right * 2.54);
      MinimumMargins.Bottom := Round(MinimumMargins.Bottom * 2.54);
      Margins.Top := Round(Margins.Top * 2.54);
      Margins.Left := Round(Margins.Left * 2.54);
      Margins.Right := Round(Margins.Right * 2.54);
      Margins.Bottom := Round(Margins.Bottom * 2.54);
    end;
  end;
  FMeasurements := Val;
  if not (csLoading in ComponentState) then
    ReadCurrentValues;
end;

function TdfsPageSetupDialog.GetDefaultMeasurements: TPSMeasurements;
begin
  if GetLocaleChar(LOCALE_USER_DEFAULT,LOCALE_IMEASURE,'0') = '0' then
    Result:= pmMillimeters
  else
    Result:= pmInches;
end;

function TdfsPageSetupDialog.GetCurrentMeasurements: TPSMeasurements;
begin
  if FMeasurements = pmDefault then
    Result := DefaultMeasurements
  else
    Result := FMeasurements;
end;

procedure GetPrinter(var DeviceMode, DeviceNames: THandle);
var
  Device, Driver, Port: array[0..79] of char;
  DevNames: PDevNames;
  Offset: PChar;
begin
  Printer.GetPrinter(Device, Driver, Port, DeviceMode);
  if DeviceMode <> 0 then
  begin
    DeviceNames := GlobalAlloc(GHND, SizeOf(TDevNames) + StrLen(Device) +
       StrLen(Driver) + StrLen(Port) + 3);
    DevNames := PDevNames(GlobalLock(DeviceNames));
    try
      Offset := PChar(DevNames) + SizeOf(TDevnames);
      with DevNames^ do
      begin
        wDriverOffset := Longint(Offset) - Longint(DevNames);
        Offset := StrECopy(Offset, Driver) + 1;
        wDeviceOffset := Longint(Offset) - Longint(DevNames);
        Offset := StrECopy(Offset, Device) + 1;
        wOutputOffset := Longint(Offset) - Longint(DevNames);;
        StrCopy(Offset, Port);
      end;
    finally
      GlobalUnlock(DeviceNames);
    end;
  end;
end;

procedure SetPrinter(DeviceMode, DeviceNames: THandle);
var
  DevNames: PDevNames;
begin
  DevNames := PDevNames(GlobalLock(DeviceNames));
  try
    with DevNames^ do
      Printer.SetPrinter(PChar(DevNames) + wDeviceOffset, PChar(DevNames) +
         wDriverOffset, PChar(DevNames) + wOutputOffset, DeviceMode);
  finally
    GlobalUnlock(DeviceNames);
    GlobalFree(DeviceNames);
  end;
end;

function CopyData(Handle: THandle): THandle;
var
  Src, Dest: PChar;
  Size: Integer;
begin
  if Handle <> 0 then
  begin
    Size := GlobalSize(Handle);
    Result := GlobalAlloc(GHND, Size);
    if Result <> 0 then
      try
        Src := GlobalLock(Handle);
        Dest := GlobalLock(Result);
        if (Src <> nil) and (Dest <> nil) then
           Move(Src^, Dest^, Size);