prvieweh.pas

一个功能强大的DBGRID控件

end;

procedure TPrinterPreview.Abort;
begin
  FAborted := True;
end;

procedure TPrinterPreview.BeginDoc;
var i: Integer;
  FontSize: Integer;
begin
  for i := 0 to FMetafileList.Count - 1 do TMetaFile(FMetafileList[i]).Free;
  FMetafileList.Clear;

  FMetafileList.Add(TMetaFile.Create());
  if Printer.Printers.Count > 0
    then FMetafileCanvas := TMetafileCanvas.Create(
      TMetafile(FMetafileList[FMetafileList.Count - 1]), Printer.Handle {0})
  else FMetafileCanvas := TMetafileCanvas.Create(
      TMetafile(FMetafileList[FMetafileList.Count - 1]), 0);
  FontSize := FMetafileCanvas.Font.Size;

  if Printer.Printers.Count > 0 then
  begin
    FMetafileCanvas.Font.PixelsPerInch := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
    if FMetafileCanvas.Font.PixelsPerInch > GetDeviceCaps(Printer.Handle, LOGPIXELSY) then
      FMetafileCanvas.Font.PixelsPerInch := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
  end
  else
    FMetafileCanvas.Font.PixelsPerInch := DefaultPrinterPixelsPerInchX;

  FMetafileCanvas.Font.Size := FontSize;
  FPageNumber := 1;
  FAborted := False;
  FPrinting := True;
  Previewer.FPageCount := 1;
  Previewer.FPageIndex := 1;
  if Assigned(Previewer.OnPrinterPreviewChanged)
    then Previewer.OnPrinterPreviewChanged(Self);
end;

procedure TPrinterPreview.NewPage;
var FontSize: Integer;
begin
  FMetafileList.Add(TMetaFile.Create());
  FMetafileCanvas.Free;
  if FMetafileList.Count = 2 then
    Previewer.UpdatePageSetup; //UpdatePreview;
  if Printer.Printers.Count > 0 then
    FMetafileCanvas := TMetafileCanvas.Create(
      TMetafile(FMetafileList[FMetafileList.Count - 1]), Printer.Handle {0})
  else
    FMetafileCanvas := TMetafileCanvas.Create(
      TMetafile(FMetafileList[FMetafileList.Count - 1]), 0);
  FontSize := FMetafileCanvas.Font.Size;
  if Printer.Printers.Count > 0 then
  begin
    FMetafileCanvas.Font.PixelsPerInch := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
    if FMetafileCanvas.Font.PixelsPerInch > GetDeviceCaps(Printer.Handle, LOGPIXELSY) then
      FMetafileCanvas.Font.PixelsPerInch := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
  end
  else
    FMetafileCanvas.Font.PixelsPerInch := DefaultPrinterPixelsPerInchX;
  FMetafileCanvas.Font.Size := FontSize;
  Inc(FPageNumber);
  Previewer.FPageCount := FMetafileList.Count - 1;
  //if Assigned(Previewer.OnNeedOpenPreview) then Previewer.OnNeedOpenPreview(Self);
  OpenPreview;
  if Assigned(Previewer.OnPrinterPreviewChanged)
    then Previewer.OnPrinterPreviewChanged(Self);
end;

procedure TPrinterPreview.EndDoc;
begin
  FreeAndNil(FMetafileCanvas);
  Previewer.FPageCount := FMetafileList.Count;
  if FMetafileList.Count = 1 then Previewer.UpdatePageSetup; // UpdatePreview;
  FPageNumber := -1;
  FPrinting := False;
  Previewer.FOnPrinterSetupDialog := OnPrinterSetupDialog;
  OnPrinterSetupDialog := nil;
  Previewer.FOnPrinterSetupChanged := OnPrinterSetupChanged;
  OnPrinterSetupChanged := nil;
  Previewer.PrinterSetupOwner := PrinterSetupOwner;
  PrinterSetupOwner := nil;
  //if Assigned(Previewer.OnNeedOpenPreview) then Previewer.OnNeedOpenPreview(Self);
  OpenPreview;
  if Assigned(Previewer.OnPrinterPreviewChanged)
    then Previewer.OnPrinterPreviewChanged(Self);
end;

function TPrinterPreview.GetAborted: Boolean;
begin
  Result := FAborted;
end;

function TPrinterPreview.GetCanvas: TCanvas;
begin
  Result := FMetafileCanvas;
end;

function TPrinterPreview.GetFonts: TStrings;
begin
  Result := Printer.Fonts;
end;

function TPrinterPreview.GetNumCopies: Integer;
begin
  Result := Printer.Copies;
end;

function TPrinterPreview.GetOrientation: TPrinterOrientation;
begin
  Result := Printer.Orientation;
end;

function TPrinterPreview.GetPageHeight: Integer;
begin
  if Printer.Printers.Count > 0
    then Result := Printer.PageHeight
    else Result := DefaultPrinterPageHeight;
end;

function TPrinterPreview.GetPageNumber: Integer;
begin
  Result := FPageNumber;
end;

function TPrinterPreview.GetPageWidth: Integer;
begin
  if Printer.Printers.Count > 0
    then Result := Printer.PageWidth
    else Result := DefaultPrinterPageWidth;
end;

function TPrinterPreview.GetPrinting: Boolean;
begin
  Result := FPrinting;
end;

function TPrinterPreview.GetTitle: String;
begin
  Result := Printer.Title;
end;

procedure TPrinterPreview.DrawPage(Sender: TObject;
  Canvas: TCanvas; PageNumber: Integer);
begin
  Canvas.Draw(0, 0, TMetafile(FMetafileList[PageNumber - 1]));
end;

procedure TPrinterPreview.SetNumCopies(const Value: Integer);
begin
  Printer.Copies := Value;
end;

procedure TPrinterPreview.SetOnPrinterSetupDialog(const Value: TNotifyEvent);
begin
  FOnPrinterSetupDialog := Value;
end;

procedure TPrinterPreview.SetOrientation(const Value: TPrinterOrientation);
begin
  Printer.Orientation := Value;
end;

procedure TPrinterPreview.SetTitle(const Value: string);
begin
  Printer.Title := Value;
end;

procedure TPrinterPreview.ShowProgress(Percent: Integer);
begin
end;

function TPrinterPreview.GetPropPrinter: TPrinter;
begin
  Result := FPrinter;
end;

function TPrinterPreview.GetFullPageHeight: Integer;
begin
  if Printer.Printers.Count > 0 then
    Result := Printer.PageHeight + GetDeviceCaps(Printer.Handle, PHYSICALOFFSETY) * 2
  else
    Result := DefaultPrinterPageHeight + DefaultPrinterPhysicalOffSetY * 2;
end;

function TPrinterPreview.GetFullPageWidth: Integer;
begin
  if Printer.Printers.Count > 0 then
    Result := Printer.PageWidth + GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX) * 2
  else
    Result := DefaultPrinterPageWidth + DefaultPrinterPhysicalOffSetX * 2;
end;

function TPrinterPreview.GetHandle: HDC;
begin
  Result := Printer.Handle;
end;

function TPrinterPreview.GetPixelsPerInchX: Integer;
begin
  if Printer.Printers.Count > 0 then
    Result := GetDeviceCaps(Printer.Handle, LOGPIXELSX)
  else
    Result := DefaultPrinterPixelsPerInchX;
end;

function TPrinterPreview.GetPixelsPerInchY: Integer;
begin
  if Printer.Printers.Count > 0 then
    Result := GetDeviceCaps(Printer.Handle, LOGPIXELSY)
  else
    Result := DefaultPrinterPixelsPerInchY;
end;

{$IFDEF CIL}
procedure TPrinterPreview.GetPrinter(ADevice, ADriver, APort: String; var ADeviceMode: IntPtr);
{$ELSE}
procedure TPrinterPreview.GetPrinter(ADevice, ADriver, APort: PChar; var ADeviceMode: THandle);
{$ENDIF}
begin
  Printer.GetPrinter(ADevice, ADriver, APort, ADeviceMode);
end;

{$IFDEF CIL}
procedure TPrinterPreview.SetPrinter(ADevice, ADriver, APort: String; ADeviceMode: IntPtr);
{$ELSE}
procedure TPrinterPreview.SetPrinter(ADevice, ADriver, APort: PChar; ADeviceMode: THandle);
{$ENDIF}
begin
  Printer.SetPrinter(ADevice, ADriver, APort, ADeviceMode);
end;

function TPrinterPreview.GetCapabilities: TPrinterCapabilities;
begin
  Result := Printer.Capabilities;
end;

function TPrinterPreview.GetPrinterIndex: Integer;
begin
  Result := Printer.PrinterIndex;
end;

function TPrinterPreview.GetPrinters: TStrings;
begin
  Result := Printer.Printers;
end;

procedure TPrinterPreview.SetPrinterIndex(const Value: Integer);
begin
  Printer.PrinterIndex := Value;
end;

{
function TPrinterPreview.Previewer: TPreviewBox;
begin
  Result := nil;
  if Assigned(OnGetPreviewer) then Result := OnGetPreviewer(Self);
  if not Assigned(Result) then
  begin
    if not Assigned(PreviewFormEh) then PreviewFormEh := TPreviewFormEh.Create(Application.MainForm);
    Result := PreviewFormEh.PreviewEh1;
  end;
end;
}

procedure TPrinterPreview.OpenPreview;
begin
  if Assigned(Previewer.OnOpenPreviewer) then Previewer.OnOpenPreviewer(Self);

{  if Assigned(OnOpenPreviewer) then OnOpenPreviewer(Self)
  else if not Assigned(PreviewFormEh) then
  begin
    PreviewFormEh := PreviewFormEh.Create(Application.MainForm);
    PreviewFormEh.Show;
  end
  else
  begin
    if IsIconic(PreviewFormEh.Handle) then ShowWindow(PreviewFormEh.Handle,sw_Restore);
    BringWindowToTop(PreviewFormEh.Handle);
    if not PreviewFormEh.Visible then PreviewFormEh.Show;
  end;}
end;

procedure TPrinterPreview.Print;
var
  Page: Integer;
  OldPrinter: TPrinter;
begin
  if FMetafileList.Count = 0 then Exit;
  OldPrinter := PrintersSetPrinter(Printer);
  try
    with PrintersPrinter do
    begin
      BeginDoc;
      for Page := 0 to FMetafileList.Count - 1 do
      begin
        DrawPage(Self, Canvas, Page + 1);
        if Page < FMetafileList.Count - 1 then NewPage;
      end;
      EndDoc;
    end;
  finally
    PrintersSetPrinter(OldPrinter);
  end;
end;

function PrinterPreview: TPrinterPreview;
begin
  if FPrinterPreview = nil then
  begin
    PreviewFormEh := TPreviewFormEh.Create(Application);
    FPrinterPreview := PreviewFormEh.PreviewEh1.Printer;
  end;
  Result := FPrinterPreview;
end;

function SetPrinterPreview(NewPrinterPreview: TPrinterPreview): TPrinterPreview;
begin
  Result := FPrinterPreview;
  FPrinterPreview := NewPrinterPreview;
end;

procedure TPrinterPreview.SetPreviewer(const Value: TPreviewBox);
begin
  FPreviewer := Value;
end;

function DefineCursor(Identifier: String): TCursor;
var
  Handle: HCursor;
begin
{$IFDEF CIL}
  Handle := LoadCursor(hInstance, Identifier);
{$ELSE}
  Handle := LoadCursor(hInstance, PChar(Identifier));
{$ENDIF}
  if Handle = 0 then raise EOutOfResources.Create('Cannot load cursor resource');
  for Result := 1 to High(TCursor) do
    if Screen.Cursors[Result] = Screen.Cursors[crArrow] then
    begin
      Screen.Cursors[Result] := Handle;
      Exit;
    end;
  raise EOutOfResources.Create('Too many user-defined cursors');
end;

initialization
  crMagnifier := DefineCursor('MAGNIFIEREH');
  crHand := DefineCursor('HANDEH');
end.