jvpagesetup.pas

East make Tray Icon in delphi

    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);
    finally
      GlobalUnlock(Handle);
      GlobalUnlock(Result);
    end
  end
  else
    Result := 0;
end;

//=== { TJvPageSetupDialog } =================================================

constructor TJvPageSetupDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMargin := TJvMarginSize.Create;
  FMinMargin := TJvMarginSize.Create;
  Options := [poDefaultMinMargins, poHundredthsOfMillimeters];
end;

destructor TJvPageSetupDialog.Destroy;
begin
  FMargin.Free;
  FMinMargin.Free;
  inherited Destroy;
end;

// Determination of streamed properties

procedure TJvPageSetupDialog.DefineProperties(AFiler: TFiler);

  // Rule 1
  function DoWriteMargin1: Boolean;
  begin
    if AFiler.Ancestor <> nil then
      Result := not TJvPageSetupDialog(AFiler.Ancestor).FMargin.MarginsEqu(FMargin)
    else
      Result := (FMargin <> nil) and (not FMargin.IsNull);
  end;

  // Rule 2
  function DoWriteMargin2: Boolean;
  begin
    if AFiler.Ancestor <> nil then
      Result := not TJvPageSetupDialog(AFiler.Ancestor).FMinMargin.MarginsEqu(FMinMargin)
    else
      Result := (FMinMargin <> nil) and (not FMinMargin.IsNull);
  end;

begin
  inherited DefineProperties(AFiler);
  with AFiler do
  begin
    DefineProperty('MarginData', ReadValues, WriteValues, DoWriteMargin1);
    DefineProperty('MinMarginData', ReadMinValues, WriteMinValues, DoWriteMargin2);
  end;
end;

// Reading from stream

procedure TJvPageSetupDialog.ReadMargin(AMargin: TJvMarginSize; Reader: TReader);
begin
  with AMargin, Reader do
  begin
    ReadListBegin;
    Left := ReadInteger;
    Top := ReadInteger;
    Right := ReadInteger;
    Bottom := ReadInteger;
    ReadListEnd;
  end;
end;

// Writing to stream

procedure TJvPageSetupDialog.WriteMargin(AMargin: TJvMarginSize; Writer: TWriter);
begin
  with AMargin, Writer do
  begin
    WriteListBegin;
    WriteInteger(Left);
    WriteInteger(Top);
    WriteInteger(Right);
    WriteInteger(Bottom);
    WriteListEnd;
  end;
end;

procedure TJvPageSetupDialog.ReadValues(AReader: TReader);
begin
  ReadMargin(FMargin, AReader);
end;

procedure TJvPageSetupDialog.WriteValues(AWriter: TWriter);
begin
  WriteMargin(FMargin, AWriter);
end;

procedure TJvPageSetupDialog.ReadMinValues(AReader: TReader);
begin
  ReadMargin(FMinMargin, AReader);
end;

procedure TJvPageSetupDialog.WriteMinValues(AWriter: TWriter);
begin
  WriteMargin(FMinMargin, AWriter);
end;

// Processing Help commands

procedure TJvPageSetupDialog.WMHelp(var Msg: TWMHelp);
begin
  if HelpContext <> 0 then
    Application.HelpContext(HelpContext)
  else
    inherited;
end;

// Processing <Printer> button

procedure TJvPageSetupDialog.WMCommand(var Msg: TWMCommand);
const
  IDPRINTERBTN = $0402;
begin
  if not ((Msg.ItemID = IDPRINTERBTN) and
    (Msg.NotifyCode = BN_CLICKED) and DoPrinter) then
    inherited;
end;

procedure TJvPageSetupDialog.WMPaintInit(var Msg: TMessage);
begin
  FInitPaper := LoWord(Msg.WParam);
  FInitFlags := HiWord(Msg.WParam);
  FPageSetupRec := PPageSetupDlg(Msg.LParam)^;
  Msg.Result := Ord(not Assigned(FOnPaint));
end;

procedure TJvPageSetupDialog.WMPaintPage(var Msg: TMessage);
var
  PaintRect: TRect;
  Canvas: TCanvas;
begin
  if Msg.LParam <> 0 then
    PaintRect := PRect(Msg.LParam)^
  else
    PaintRect := Rect(0, 0, 0, 0);

  Canvas := TCanvas.Create;
  Canvas.Handle := HDC(Msg.WParam);
  try
    Msg.Result := Ord(DoPaint(FInitPaper, FInitFlags, FPageSetupRec,
      FPaintWhat, Canvas, PaintRect));
  finally
    Canvas.Free;
  end;
end;

function TJvPageSetupDialog.DoPrinter: Boolean;
begin
  Result := Assigned(FOnPrinter);
  if Result then
    FOnPrinter(Self);
end;

function TJvPageSetupDialog.DoPaint(InitPaper, InitFlags: Integer;
  PageSetupRec: TPageSetupDlg; PaintWhat: TJvPSPaintWhat; Canvas: TCanvas;
  Rect: TRect): Boolean;
begin
  Result := False;
  if Assigned(FOnPaint) then
    FOnPaint(Self, InitPaper, InitFlags, PageSetupRec, PaintWhat, Canvas, Rect, Result);
end;

// Show modal dialog

function TJvPageSetupDialog.TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool;
type
  TDialogFunc = function(var ADialogData): Bool; stdcall;
var
  ActiveWindow: HWND;
  WindowList: Pointer;
  FPUControlWord: Word;
begin
  ActiveWindow := GetActiveWindow;
  WindowList := DisableTaskWindows(0);
  try
    Application.HookMainWindow(MessageHook);
    asm
      // Avoid FPU control word change in NETRAP.dll, NETAPI32.dll, etc
      FNSTCW  FPUControlWord
    end;
    try
      CreationControl := Self;
      PageSetupControl := Self;
      Result := TDialogFunc(DialogFunc)(DialogData);
    finally
      PageSetupControl := nil;
      asm
        FNCLEX
        FLDCW FPUControlWord
      end;
      Application.UnhookMainWindow(MessageHook);
    end;
  finally
    EnableTaskWindows(WindowList);
    SetActiveWindow(ActiveWindow);
  end;
end;

function TJvPageSetupDialog.DoExecute(Show: Boolean): Boolean;
var
  PageDlgRec: TPageSetupDlg;
  DevHandle: THandle;
  Err: Integer;
begin
  // fill record
  FillChar(PageDlgRec, SizeOf(PageDlgRec), 0);
  with PageDlgRec do
  begin
    lStructSize := SizeOf(PageDlgRec);
    hwndOwner := Application.Handle;
    Flags := FFlags;
    rtMinMargin := Rect(FMinMargin.Left, FMinMargin.Top, FMinMargin.Right,
      FMinMargin.Bottom);
    rtMargin := Rect(FMargin.Left, FMargin.Top, FMargin.Right, FMargin.Bottom);
    hInstance := SysInit.HInstance;
    if Show then
    begin
      lpfnPageSetupHook := DialogHook;
      Flags := FFlags or PSD_ENABLEPAGESETUPHOOK;
      GetPrinter(DevHandle, hDevNames);
      hDevMode := CopyData(DevHandle);
    end
    else
      Flags := Flags or PSD_RETURNDEFAULT;
    if Template <> nil then
    begin
      Flags := Flags or PSD_ENABLEPAGESETUPTEMPLATE;
      lpPageSetupTemplateName := Template;
    end;
    if Assigned(FOnPaint) then
    begin
      Flags := Flags or PSD_ENABLEPAGEPAINTHOOK;
      lpfnPagePaintHook := PageDrawHook;
    end;

    if Show then
      Result := TaskModalDialog(@PageSetupDlg, PageDlgRec)
    else
      Result := PageSetupDlg(PageDlgRec);
    Err := CommDlgExtendedError;

    if Result then
      SetPrinter(hDevMode, hDevNames)
    else
    begin
      if hDevMode <> 0 then
        GlobalFree(hDevMode);
      if hDevNames <> 0 then
        GlobalFree(hDevNames);
    end;
    OSCheck(Err = 0);

    FMargin.AsRect := rtMargin;
    FPaperSize := ptPaperSize;
  end;
end;

function TJvPageSetupDialog.Execute: Boolean;
begin
  Result := DoExecute(True);
end;

// Get default margin values

procedure TJvPageSetupDialog.GetDefaults;
begin
  DoExecute(False);
end;

procedure TJvPageSetupDialog.SetOptions(Value: TJvPageOptions);
const
  WinFlags: array [TJvPageSetupFlags] of DWORD =
    (PSD_DEFAULTMINMARGINS, PSD_MARGINS, PSD_MINMARGINS,
    PSD_DISABLEMARGINS, PSD_DISABLEORIENTATION,
    PSD_DISABLEPAGEPAINTING, PSD_DISABLEPAPER, PSD_DISABLEPRINTER,
    PSD_INHUNDREDTHSOFMILLIMETERS, PSD_INTHOUSANDTHSOFINCHES,
    PSD_NOWARNING);
var
  I: TJvPageSetupFlags;
begin
  if (poDefaultMinMargins in Value) and not (poDefaultMinMargins in FOptions) then
    Value := Value - [poMinMargins];
  if (poMinMargins in Value) and not (poMinMargins in FOptions) then
    Value := Value - [poDefaultMinMargins];
  if (poHundredthsOfMillimeters in Value) and not (poHundredthsOfMillimeters in FOptions) then
    Value := Value - [poThousandthsOfInches];
  if (poThousandthsOfInches in Value) and not (poThousandthsOfInches in FOptions) then
    Value := Value - [poHundredthsOfMillimeters];
  FOptions := Value;

  // set flags
  FFlags := 0;
  for I := Low(TJvPageSetupFlags) to High(TJvPageSetupFlags) do
    if I in FOptions then
      FFlags := FFlags or WinFlags[I];
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.