?? prvieweh.pas
字號(hào):
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.
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -