pascal/kolmck
1
0
Fork 0
Code Issues Releases Activity

git-svn-id: https://svn.code.sf.net/p/kolmck/code@65 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07

Browse Source
This commit is contained in:
dkolmck
2010-06-04 11:16:23 +00:00
parent 741ce16e1e
commit 13cfe98302
1 changed files with 312 additions and 349 deletions
Download Patch File Download Diff File Expand all files Collapse all files

377
Addons/KOLPrinters.pas
View File

@@ -69,46 +69,46 @@ Still missing (I suppose):
interface interface
uses Windows,Messages,KOL,KOLPrintCommon; uses Windows, Messages, KOL, KOLPrintCommon;
type type
TPrinterState = (psNeedHandle,psHandle,psOtherHandle); TPrinterState = (psNeedHandle, psHandle, psOtherHandle);
TPrinterOrientation = (poPortrait,poLandscape); TPrinterOrientation = (poPortrait, poLandscape);
{* Paper orientation} {* Paper orientation}
TMarginOption = (mgInches,mgMillimeters); TMarginOption = (mgInches, mgMillimeters);
{* Margin option} {* Margin option}
PPrinter =^TPrinter; PPrinter = ^TPrinter;
TKOLPrinter = PPrinter; TKOLPrinter = PPrinter;
TPrinter = object(TObj) TPrinter = object(TObj)
{*} {*}
private private
{ Private declarations } { Private declarations }
fDevice,fDriver,fPort : String; fDevice, fDriver, fPort: string;
fDevMode : THandle; fDevMode: THandle;
fDeviceMode : PDeviceMode; fDeviceMode: PDeviceMode;
fCanvas : PCanvas; // KOL canvas fCanvas: PCanvas; // KOL canvas
fTitle : String; fTitle: string;
fState : TPrinterState; // DC is allocated or need new DC becouse params were changed fState: TPrinterState; // DC is allocated or need new DC becouse params were changed
fAborted : Boolean; fAborted: Boolean;
fPrinting : Boolean; fPrinting: Boolean;
fPageNumber : Integer; fPageNumber: Integer;
fOutput : String; fOutput: string;
PrinterInfo : TPrinterInfo; PrinterInfo: TPrinterInfo;
fRec : TRect; fRec: TRect;
fMargins : TRect; //Margins (in pixels) fMargins: TRect; //Margins (in pixels)
fAssigned : Boolean; //if TRUE ,there is a printer with correctly assigned information fAssigned: Boolean; //if TRUE ,there is a printer with correctly assigned information
protected protected
function GetHandle : HDC; function GetHandle: HDC;
procedure SetHandle(Value : HDC); procedure SetHandle(Value: HDC);
function GetCanvas : PCanvas; function GetCanvas: PCanvas;
function GetCopies : Integer; function GetCopies: Integer;
procedure SetCopies(const Value : Integer); procedure SetCopies(const Value: Integer);
function GetOrientation : TPrinterOrientation; function GetOrientation: TPrinterOrientation;
procedure SetOrientation(const Value : TPrinterOrientation); procedure SetOrientation(const Value: TPrinterOrientation);
function GetPageHeight : Integer; function GetPageHeight: Integer;
function GetPageWidth : Integer; function GetPageWidth: Integer;
function Scale : Integer; function Scale: Integer;
procedure Prepare; procedure Prepare;
procedure DefPrinter; procedure DefPrinter;
public public
@@ -122,66 +122,64 @@ TMarginOption = (mgInches,mgMillimeters);
{* End print process end send it to print spooler} {* End print process end send it to print spooler}
procedure NewPage; procedure NewPage;
{* Request new page} {* Request new page}
procedure Assign(Source : PPrinterInfo); procedure Assign(Source: PPrinterInfo);
{* Assign information about selected printer for example from Print/Page dialogs} {* Assign information about selected printer for example from Print/Page dialogs}
procedure AssignMargins(cMargins : TRect; Option : TMarginOption); procedure AssignMargins(cMargins: TRect; Option: TMarginOption);
{* Assign information about paper margins for example from TKOLPageSetupDialog {* Assign information about paper margins for example from TKOLPageSetupDialog
(in thousands of inches scale)} (in thousands of inches scale)}
procedure WriteLn(const Text : String); procedure WriteLn(const Text: string);
{* Print tekst with TKOLPrinter selected font.Note: can be invoked more than once, but currently {* Print tekst with TKOLPrinter selected font.Note: can be invoked more than once, but currently
only for text ended with #10#13 (other is not properly wraped around right page corner ;-( )} only for text ended with #10#13 (other is not properly wraped around right page corner ;-( )}
procedure RE_Print(RichEdit : PControl); procedure RE_Print(RichEdit: PControl);
{* Print content of TKOLRichEdit (if Rich is not TKOLRichEdit nothing happens) {* Print content of TKOLRichEdit (if Rich is not TKOLRichEdit nothing happens)
with full formating of course :-)} with full formating of course :-)}
property Assigned : Boolean read fAssigned; property Assigned: Boolean read fAssigned;
{* If TRUE, there is a default or assigned previoulsy printer (by Assign).Always check {* If TRUE, there is a default or assigned previoulsy printer (by Assign).Always check
this property to avoid access violation when there is no printer in system} this property to avoid access violation when there is no printer in system}
property Title : String read fTitle write fTitle; property Title: string read fTitle write fTitle;
{* Title of print process in print manager window} {* Title of print process in print manager window}
function Info : PPrinterInfo; function Info: PPrinterInfo;
{* Returns info of selected print} {* Returns info of selected print}
property Output : String read fOutput write fOutput; property Output: string read fOutput write fOutput;
{* Let print to the file.Assign file path to this property.} {* Let print to the file.Assign file path to this property.}
property Handle : HDC read GetHandle write SetHandle; property Handle: HDC read GetHandle write SetHandle;
{*} {*}
property Canvas : PCanvas read GetCanvas; property Canvas: PCanvas read GetCanvas;
{*} {*}
property Copies : Integer read GetCopies write SetCopies; property Copies: Integer read GetCopies write SetCopies;
{* Number of copies} {* Number of copies}
property Orientation : TPrinterOrientation read GetOrientation write SetOrientation; property Orientation: TPrinterOrientation read GetOrientation write SetOrientation;
{* Page orientation} {* Page orientation}
property Margins : TRect read fMargins write fMargins; property Margins: TRect read fMargins write fMargins;
{* Page margins (in pixels)} {* Page margins (in pixels)}
property PageHeight : Integer read GetPageHeight; property PageHeight: Integer read GetPageHeight;
{* Page height in logical pixels} {* Page height in logical pixels}
property PageWidth : Integer read GetPageWidth; property PageWidth: Integer read GetPageWidth;
{* Page width in logical pixels} {* Page width in logical pixels}
property PageNumber : Integer read fPageNumber; property PageNumber: Integer read fPageNumber;
{* Currently printed page number} {* Currently printed page number}
property Printing : Boolean read fPrinting; property Printing: Boolean read fPrinting;
{* Indicate printing process} {* Indicate printing process}
property Aborted : Boolean read fAborted; property Aborted: Boolean read fAborted;
{* Indicate abort of printing process} {* Indicate abort of printing process}
end; end;
function Printer: PPrinter;
function Printer : PPrinter;
{* Returns pointer to global TKOLPrinter object} {* Returns pointer to global TKOLPrinter object}
procedure RecreatePrinter; procedure RecreatePrinter;
{* Recreates global Printer pbject } {* Recreates global Printer pbject }
function NewPrinter(PrinterInfo : PPrinterInfo) : PPrinter; function NewPrinter(PrinterInfo: PPrinterInfo): PPrinter;
{* Global function for creating TKOLPrinter instance.Usually not needed, becouse {* Global function for creating TKOLPrinter instance.Usually not needed, becouse
inluding KOLPrinters causes creating of global TKOLPrinter instance.} inluding KOLPrinters causes creating of global TKOLPrinter instance.}
implementation implementation
uses RichEdit;
uses
RichEdit;
type type
PtagPD = ^tagPD; PtagPD = ^tagPD;
tagPD = packed record tagPD = packed record
lStructSize: DWORD; lStructSize: DWORD;
@@ -209,26 +207,19 @@ const
PD_RETURNDC = $00000100; PD_RETURNDC = $00000100;
PD_RETURNDEFAULT = $00000400; PD_RETURNDEFAULT = $00000400;
var var
FPrinter : PPrinter = nil; FPrinter : PPrinter = nil;
function PrintDlg(var PrintDlg: tagPD): BOOL; stdcall;external 'comdlg32.dll' name 'PrintDlgA'; function PrintDlg(var PrintDlg: tagPD): BOOL; stdcall; external 'comdlg32.dll' name 'PrintDlgA';
function AbortProc(Handle: HDC; Error: Integer): Bool; stdcall;
function AbortProc(Handle : HDC; Error : Integer) : Bool ; stdcall;
begin begin
Result := not fPrinter.Aborted; Result := not fPrinter.Aborted;
end; end;
function NewPrinter(PrinterInfo : PPrinterInfo) : PPrinter; function NewPrinter(PrinterInfo: PPrinterInfo): PPrinter;
begin begin
New(Result,Create); New(Result, Create);
Result.fTitle := ''; Result.fTitle := '';
Result.fOutput := ''; Result.fOutput := '';
Result.fAborted := False; Result.fAborted := False;
@@ -239,15 +230,14 @@ begin
Result.fMargins.Left := 10; Result.fMargins.Left := 10;
Result.fMargins.Bottom := 10; Result.fMargins.Bottom := 10;
Result.fMargins.Right := 10; Result.fMargins.Right := 10;
FillChar(Result.fRec,sizeof(Result.fRec),0); FillChar(Result.fRec, sizeof(Result.fRec), 0);
if PrinterInfo = nil then Result.DefPrinter if PrinterInfo = nil then
Result.DefPrinter
else else
Result.Assign(PrinterInfo); Result.Assign(PrinterInfo);
end; end;
function Printer: PPrinter;
function Printer : PPrinter;
begin begin
if FPrinter = nil then if FPrinter = nil then
FPrinter := NewPrinter(nil); FPrinter := NewPrinter(nil);
@@ -256,12 +246,10 @@ end;
procedure RecreatePrinter; procedure RecreatePrinter;
begin begin
Free_And_Nil( FPrinter ); Free_And_Nil(FPrinter);
FPrinter := NewPrinter(nil); FPrinter := NewPrinter(nil);
end; end;
destructor TPrinter.Destroy; destructor TPrinter.Destroy;
begin begin
Prepare; Prepare;
@@ -277,56 +265,52 @@ end;
procedure TPrinter.Prepare; procedure TPrinter.Prepare;
begin begin
{ Free previously used resources } { Free previously used resources }
if (fState <> psOtherHandle) and (fCanvas <> nil) then if (fState <> psOtherHandle) and (fCanvas <> nil) then begin
begin
fCanvas.Free; fCanvas.Free;
fCanvas := nil; {+++} fCanvas := nil; {+++}
end; end;
if fDevMode <> 0 then if fDevMode <> 0 then begin
begin
GlobalUnlock(fDevMode); GlobalUnlock(fDevMode);
GlobalFree(fDevMode); GlobalFree(fDevMode);
end; end;
end; end;
function TPrinter.Scale : Integer; function TPrinter.Scale: Integer;
var var
DC : HDC; DC : HDC;
ScreenH,PrinterH : Integer; ScreenH, PrinterH : Integer;
begin begin
DC := GetDC(0); DC := GetDC(0);
ScreenH := GetDeviceCaps(DC,LOGPIXELSY); ScreenH := GetDeviceCaps(DC, LOGPIXELSY);
PrinterH := GetDeviceCaps(fCanvas.Handle,LOGPIXELSY); PrinterH := GetDeviceCaps(fCanvas.Handle, LOGPIXELSY);
ReleaseDC(0,DC); ReleaseDC(0, DC);
Result := PrinterH div ScreenH; Result := PrinterH div ScreenH;
end; end;
procedure TPrinter.WriteLn(const Text : String); procedure TPrinter.WriteLn(const Text: string);
var var
OldFontSize,PageH,Size,Len : Integer; OldFontSize, PageH, Size, Len: Integer;
pC : PChar; pC : PChar;
Rect : TRect; Rect : TRect;
Metrics : TTextMetric; Metrics : TTextMetric;
NewText : String; NewText : string;
procedure ComputeRect; procedure ComputeRect;
{ Start from new line.Rect is the rest of page from current new line to the bottom. First probe { Start from new line.Rect is the rest of page from current new line to the bottom. First probe
how many characters do not fit on this rect.} how many characters do not fit on this rect.}
begin
Len := 1;
while Windows.DrawText(fCanvas.Handle,pC,Len,Rect,DT_CALCRECT + DT_WORDBREAK + DT_NOCLIP + DT_NOPREFIX + DT_EXPANDTABS) < PageH do
begin begin
Len := 1;
while Windows.DrawText(fCanvas.Handle, pC, Len, Rect, DT_CALCRECT + DT_WORDBREAK + DT_NOCLIP + DT_NOPREFIX + DT_EXPANDTABS) < PageH do begin
Rect.Right := fRec.Right; //must be, becouse DrawText shorten right corner Rect.Right := fRec.Right; //must be, becouse DrawText shorten right corner
Len := Len + 100; Len := Len + 100;
if Len > Size then if Len > Size then begin
begin
Len := Size; Len := Size;
Break; Break;
end; end;
end; end;
{ Next : Count backwards to find exact characters which fit on required page rect.} { Next : Count backwards to find exact characters which fit on required page rect.}
while Windows.DrawText(fCanvas.Handle,pC,Len,Rect,DT_CALCRECT + DT_WORDBREAK + DT_NOCLIP + DT_NOPREFIX + DT_EXPANDTABS) > PageH do while Windows.DrawText(fCanvas.Handle, pC, Len, Rect, DT_CALCRECT + DT_WORDBREAK + DT_NOCLIP + DT_NOPREFIX + DT_EXPANDTABS) > PageH do
Len := Len - 1; Len := Len - 1;
{ Find position of last space or line end (#13#10) to not break word { Find position of last space or line end (#13#10) to not break word
@@ -340,31 +324,28 @@ begin
} }
{ Finally draw it!} { Finally draw it!}
Windows.DrawText(fCanvas.Handle,pC,Len,Rect,DT_WORDBREAK + DT_NOCLIP + DT_NOPREFIX + DT_EXPANDTABS); Windows.DrawText(fCanvas.Handle, pC, Len, Rect, DT_WORDBREAK + DT_NOCLIP + DT_NOPREFIX + DT_EXPANDTABS);
end;
end;
begin begin
if Length(Text) <=0 then Exit; if Length(Text) <= 0 then Exit;
if Text[Length(Text)] <> #10 then NewText := Text + #13#10 if Text[Length(Text)] <> #10 then NewText := Text + #13#10
else else
NewText := Text; NewText := Text;
pC := PChar(NewText); pC := PChar(NewText);
Size := Length(NewText); Size := Length(NewText);
SetMapMode(fCanvas.Handle,MM_TEXT); SetMapMode(fCanvas.Handle, MM_TEXT);
OldFontSize := fCanvas.Font.FontHeight; OldFontSize := fCanvas.Font.FontHeight;
fCanvas.Font.FontHeight := fCanvas.Font.FontHeight * Scale; fCanvas.Font.FontHeight := fCanvas.Font.FontHeight * Scale;
SelectObject(fCanvas.Handle,fCanvas.Font.Handle); SelectObject(fCanvas.Handle, fCanvas.Font.Handle);
PageH := GetPageHeight - fMargins.Bottom; PageH := GetPageHeight - fMargins.Bottom;
GetTextMetrics(fCanvas.Handle,Metrics); GetTextMetrics(fCanvas.Handle, Metrics);
while Size > 0 do while Size > 0 do begin
begin
Rect := fRec; Rect := fRec;
ComputeRect; ComputeRect;
Inc(pC,Len + 1); Inc(pC, Len + 1);
Dec(Size,Len + 1); Dec(Size, Len + 1);
if (Size > 0) and (fRec.Left <= fMargins.Left) then NewPage; if (Size > 0) and (fRec.Left <= fMargins.Left) then NewPage;
end; end;
if (Rect.Bottom > PageH) then begin if (Rect.Bottom > PageH) then begin
@@ -378,17 +359,16 @@ while Size > 0 do
NewText := ''; NewText := '';
end; end;
procedure TPrinter.DefPrinter; procedure TPrinter.DefPrinter;
var var
ftagPD : tagPD; ftagPD : tagPD;
DevNames : PDevNames; DevNames : PDevNames;
begin begin
fAssigned := false; fAssigned := false;
fState := psHandle; fState := psHandle;
Prepare; Prepare;
{ Get DC of default printer } { Get DC of default printer }
FillChar(ftagPD,sizeof(tagPD),0); FillChar(ftagPD, sizeof(tagPD), 0);
ftagPD.Flags := PD_RETURNDC + PD_RETURNDEFAULT; ftagPD.Flags := PD_RETURNDC + PD_RETURNDEFAULT;
ftagPD.lStructSize := sizeof(ftagPD); ftagPD.lStructSize := sizeof(ftagPD);
if not PrintDlg(ftagPD) then Exit; if not PrintDlg(ftagPD) then Exit;
@@ -397,9 +377,9 @@ begin
fDevMode := ftagPD.hDevMode; fDevMode := ftagPD.hDevMode;
fDeviceMode := PDevMode(GlobalLock(fDevMode)); fDeviceMode := PDevMode(GlobalLock(fDevMode));
try try
fDriver := String(PChar(DevNames) + DevNames^.wDriverOffset); fDriver := string(PChar(DevNames) + DevNames^.wDriverOffset);
fDevice := String(PChar(DevNames) + DevNames^.wDeviceOffset); fDevice := string(PChar(DevNames) + DevNames^.wDeviceOffset);
fPort := String(PChar(DevNames) + DevNames^.wOutputOffset); fPort := string(PChar(DevNames) + DevNames^.wOutputOffset);
finally finally
GlobalUnlock(ftagPD.hDevNames); GlobalUnlock(ftagPD.hDevNames);
GlobalFree(ftagPD.hDevNames); GlobalFree(ftagPD.hDevNames);
@@ -407,11 +387,11 @@ begin
fCanvas := NewCanvas(ftagPD.hDC); fCanvas := NewCanvas(ftagPD.hDC);
end; end;
procedure TPrinter.Assign(Source : PPrinterInfo); procedure TPrinter.Assign(Source: PPrinterInfo);
var var
Size : Integer; Size : Integer;
DevMode : PDevMode; DevMode : PDevMode;
fhDC : HDC; fhDC : HDC;
begin begin
fAssigned := false; fAssigned := false;
if (Source = nil) or if (Source = nil) or
@@ -419,19 +399,18 @@ begin
(Source^.ADevice = nil) and (Source^.ADevice = nil) and
(Source^.APort = nil) and (Source^.APort = nil) and
(Source^.ADevMode = 0) then DefPrinter (Source^.ADevMode = 0) then DefPrinter
else else begin
begin
Prepare; Prepare;
fDriver := String(Source^.ADriver); fDriver := string(Source^.ADriver);
fDevice := String(Source^.ADevice); fDevice := string(Source^.ADevice);
fPort := String(Source^.APort); fPort := string(Source^.APort);
DevMode := PDevMode(GlobalLock(Source^.ADevMode)); DevMode := PDevMode(GlobalLock(Source^.ADevMode));
try try
Size := sizeof(DevMode^); Size := sizeof(DevMode^);
fDevMode := GlobalAlloc(GHND,Size); fDevMode := GlobalAlloc(GHND, Size);
fDeviceMode := PDevMode(GlobalLock(fDevMode)); fDeviceMode := PDevMode(GlobalLock(fDevMode));
CopyMemory(fDeviceMode,DevMode,Size); CopyMemory(fDeviceMode, DevMode, Size);
fhDC := CreateDC(PChar(fDriver),PChar(fDevice),PChar(fPort),fDeviceMode); fhDC := CreateDC(PChar(fDriver), PChar(fDevice), PChar(fPort), fDeviceMode);
finally finally
GlobalUnlock(Source^.ADevMode); GlobalUnlock(Source^.ADevMode);
end; end;
@@ -440,27 +419,24 @@ begin
end; end;
end; end;
procedure TPrinter.AssignMargins(cMargins: TRect; Option: TMarginOption);
procedure TPrinter.AssignMargins(cMargins : TRect;Option : TMarginOption);
var var
PH,PW : Integer; PH, PW : Integer;
begin begin
PH := GetDeviceCaps(fCanvas.Handle,LOGPIXELSY); PH := GetDeviceCaps(fCanvas.Handle, LOGPIXELSY);
PW := GetDeviceCaps(fCanvas.Handle,LOGPIXELSX); PW := GetDeviceCaps(fCanvas.Handle, LOGPIXELSX);
case Option of case Option of
mgInches: mgInches: begin
begin fMargins.Top := round((cMargins.Top * PH) / 1000);
fMargins.Top := round((cMargins.Top*PH)/1000); fMargins.Left := round((cMargins.Left * PW) / 1000);
fMargins.Left := round((cMargins.Left*PW)/1000); fMargins.Bottom := round((cMargins.Bottom * PH) / 1000);
fMargins.Bottom := round((cMargins.Bottom*PH)/1000); fMargins.Right := round((cMargins.Right * PW) / 1000);
fMargins.Right := round((cMargins.Right*PW)/1000);
end; end;
mgMillimeters: mgMillimeters: begin
begin fMargins.Top := round((cMargins.Top * PH) / 2540);
fMargins.Top := round((cMargins.Top*PH)/2540); fMargins.Left := round((cMargins.Left * PW) / 2540);
fMargins.Left := round((cMargins.Left*PW)/2540); fMargins.Bottom := round((cMargins.Bottom * PH) / 2540);
fMargins.Bottom := round((cMargins.Bottom*PH)/2540); fMargins.Right := round((cMargins.Right * PW) / 2540);
fMargins.Right := round((cMargins.Right*PW)/2540);
end; end;
end; end;
end; end;
@@ -472,24 +448,23 @@ begin
EndDoc; EndDoc;
end; end;
procedure TPrinter.BeginDoc; procedure TPrinter.BeginDoc;
var var
doc : DOCINFOA; doc : DOCINFOA;
begin begin
fRec.Top := fMargins.Top; fRec.Top := fMargins.Top;
fRec.Left := fMargins.Left; fRec.Left := fMargins.Left;
fRec.Right := GetPageWidth - fMargins.Right ; fRec.Right := GetPageWidth - fMargins.Right;
fRec.Bottom := GetPageHeight - fMargins.Bottom; fRec.Bottom := GetPageHeight - fMargins.Bottom;
fAborted := False; fAborted := False;
fPageNumber :=1; fPageNumber := 1;
fPrinting := True; fPrinting := True;
FillChar(doc,sizeof(DOCINFOA),0); FillChar(doc, sizeof(DOCINFOA), 0);
doc.lpszDocName := PChar(fTitle); doc.lpszDocName := PChar(fTitle);
if (fOutput <> '') then doc.lpszOutput := PChar(fOutput); if (fOutput <> '') then doc.lpszOutput := PChar(fOutput);
doc.cbSize := sizeof(doc); doc.cbSize := sizeof(doc);
SetAbortProc(fCanvas.Handle,AbortProc); SetAbortProc(fCanvas.Handle, AbortProc);
StartDoc(fCanvas.Handle,doc); StartDoc(fCanvas.Handle, doc);
StartPage(fCanvas.Handle); StartPage(fCanvas.Handle);
end; end;
@@ -503,42 +478,35 @@ begin
fPrinting := False; fPrinting := False;
end; end;
function TPrinter.GetHandle: HDC;
function TPrinter.GetHandle : HDC;
var var
fhDC : HDC; fhDC : HDC;
begin begin
if (fState = psNeedHandle) and (fCanvas <> nil) then if (fState = psNeedHandle) and (fCanvas <> nil) then begin
begin
fCanvas.Free; fCanvas.Free;
fhDC := CreateDC(PChar(fDriver),PChar(fDevice),PChar(fPort),fDeviceMode); fhDC := CreateDC(PChar(fDriver), PChar(fDevice), PChar(fPort), fDeviceMode);
fCanvas := NewCanvas(fhDC); fCanvas := NewCanvas(fhDC);
fState := psHandle; fState := psHandle;
end; end;
Result := fCanvas.Handle; Result := fCanvas.Handle;
end; end;
procedure TPrinter.SetHandle(Value : HDC); procedure TPrinter.SetHandle(Value: HDC);
begin begin
if Value <> fCanvas.Handle then if Value <> fCanvas.Handle then begin
begin
if fCanvas <> nil then fCanvas.Free; if fCanvas <> nil then fCanvas.Free;
fCanvas := NewCanvas(Value); fCanvas := NewCanvas(Value);
fState := psOtherHandle; fState := psOtherHandle;
end; end;
end; end;
function TPrinter.GetCanvas: PCanvas;
function TPrinter.GetCanvas : PCanvas;
begin begin
GetHandle; GetHandle;
Result := fCanvas; Result := fCanvas;
end; end;
function TPrinter.Info: PPrinterInfo;
function TPrinter.Info : PPrinterInfo;
begin begin
with PrinterInfo do begin with PrinterInfo do begin
ADevice := PChar(fDevice); ADevice := PChar(fDevice);
@@ -549,19 +517,17 @@ begin
Result := @PrinterInfo; Result := @PrinterInfo;
end; end;
function TPrinter.GetCopies : Integer; function TPrinter.GetCopies: Integer;
begin begin
Result := fDeviceMode^.dmCopies; Result := fDeviceMode^.dmCopies;
end; end;
procedure TPrinter.SetCopies(const Value: Integer);
procedure TPrinter.SetCopies(const Value : Integer);
begin begin
fDeviceMode^.dmCopies := Value; fDeviceMode^.dmCopies := Value;
end; end;
function TPrinter.GetOrientation: TPrinterOrientation;
function TPrinter.GetOrientation : TPrinterOrientation;
begin begin
if System.Assigned(fDeviceMode) and (fDeviceMode^.dmOrientation = DMORIENT_PORTRAIT) then if System.Assigned(fDeviceMode) and (fDeviceMode^.dmOrientation = DMORIENT_PORTRAIT) then
Result := poPortrait Result := poPortrait
@@ -569,24 +535,24 @@ begin
Result := poLandscape; Result := poLandscape;
end; end;
procedure TPrinter.SetOrientation(const Value : TPrinterOrientation); procedure TPrinter.SetOrientation(const Value: TPrinterOrientation);
const const
Orientations : array [TPrinterOrientation] of Integer = (DMORIENT_PORTRAIT,DMORIENT_LANDSCAPE); Orientations : array[TPrinterOrientation] of Integer = (DMORIENT_PORTRAIT, DMORIENT_LANDSCAPE);
begin begin
fDeviceMode^.dmOrientation := Orientations[Value]; fDeviceMode^.dmOrientation := Orientations[Value];
end; end;
function TPrinter.GetPageHeight : Integer; function TPrinter.GetPageHeight: Integer;
begin begin
if fCanvas <> nil then if fCanvas <> nil then
Result := GetDeviceCaps(fCanvas.Handle,VERTRES) Result := GetDeviceCaps(fCanvas.Handle, VERTRES)
else Result := 0; else Result := 0;
end; end;
function TPrinter.GetPageWidth : Integer; function TPrinter.GetPageWidth: Integer;
begin begin
if fCanvas <> nil then if fCanvas <> nil then
Result := GetDeviceCaps(fCanvas.Handle,HORZRES) Result := GetDeviceCaps(fCanvas.Handle, HORZRES)
else Result := 0; else Result := 0;
end; end;
@@ -598,19 +564,18 @@ begin
fRec.Bottom := GetPageHeight - fMargins.Bottom; fRec.Bottom := GetPageHeight - fMargins.Bottom;
EndPage(fCanvas.Handle); EndPage(fCanvas.Handle);
StartPage(fCanvas.Handle); StartPage(fCanvas.Handle);
SelectObject(fCanvas.Handle,fCanvas.Font.Handle); SelectObject(fCanvas.Handle, fCanvas.Font.Handle);
Inc(fPageNumber); Inc(fPageNumber);
end; end;
procedure TPrinter.RE_Print(RichEdit: PControl);
procedure TPrinter.RE_Print(RichEdit : PControl);
var var
Range: TFormatRange; Range : TFormatRange;
LastChar, MaxLen, LogX, LogY, OldMap: Integer; LastChar, MaxLen, LogX, LogY, OldMap: Integer;
SaveRect: TRect; SaveRect : TRect;
TextLenEx: TGetTextLengthEx; TextLenEx : TGetTextLengthEx;
begin begin
if IndexOfStr(RichEdit.SubClassName,'obj_RichEdit') = -1 then Exit; if IndexOfStr(RichEdit.SubClassName, 'obj_RichEdit') = -1 then Exit;
FillChar(Range, SizeOf(TFormatRange), 0); FillChar(Range, SizeOf(TFormatRange), 0);
with Range do begin with Range do begin
BeginDoc; BeginDoc;
@@ -618,22 +583,22 @@ begin
hdcTarget := hdc; hdcTarget := hdc;
LogX := GetDeviceCaps(Handle, LOGPIXELSX); LogX := GetDeviceCaps(Handle, LOGPIXELSX);
LogY := GetDeviceCaps(Handle, LOGPIXELSY); LogY := GetDeviceCaps(Handle, LOGPIXELSY);
rc.Top := fMargins.Top*1440 div LogY; rc.Top := fMargins.Top * 1440 div LogY;
rc.Left := fMargins.Left*1440 div LogX; rc.Left := fMargins.Left * 1440 div LogX;
rc.Right := (GetPageWidth - fMargins.Right) * 1440 div LogX ; rc.Right := (GetPageWidth - fMargins.Right) * 1440 div LogX;
rc.Bottom := (GetPageHeight - fMargins.Bottom) * 1440 div LogY; rc.Bottom := (GetPageHeight - fMargins.Bottom) * 1440 div LogY;
rcPage := rc; rcPage := rc;
SaveRect := rc; SaveRect := rc;
LastChar := 0; LastChar := 0;
// if RichEdit.Version >= 2 then begin // if RichEdit.Version >= 2 then begin
with TextLenEx do begin with TextLenEx do begin
flags := GTL_DEFAULT; flags := GTL_DEFAULT;
codepage := CP_ACP; codepage := CP_ACP;
end; end;
MaxLen := RichEdit.Perform(EM_GETTEXTLENGTHEX, WParam(@TextLenEx), 0); MaxLen := RichEdit.Perform(EM_GETTEXTLENGTHEX, WParam(@TextLenEx), 0);
// end // end
// else // else
// MaxLen := Length(RichEdit.RE_Text[ reRTF, True ]); // MaxLen := Length(RichEdit.RE_Text[ reRTF, True ]);
chrg.cpMax := -1; chrg.cpMax := -1;
OldMap := SetMapMode(hdc, MM_TEXT); OldMap := SetMapMode(hdc, MM_TEXT);
SendMessage(RichEdit.Handle, EM_FORMATRANGE, 0, 0); { flush buffer } SendMessage(RichEdit.Handle, EM_FORMATRANGE, 0, 0); { flush buffer }
@@ -652,12 +617,10 @@ begin
end; end;
end; end;
initialization initialization
//FPrinter := NewPrinter(nil); //FPrinter := NewPrinter(nil);
finalization finalization
Free_And_Nil( FPrinter ); Free_And_Nil(FPrinter);
end. end.