git-svn-id: https://svn.code.sf.net/p/kolmck/code@65 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
dkolmck
@@ -69,48 +69,48 @@ Still missing (I suppose):
|
||||
|
||||
interface
|
||||
|
||||
uses Windows,Messages,KOL,KOLPrintCommon;
|
||||
uses Windows, Messages, KOL, KOLPrintCommon;
|
||||
|
||||
type
|
||||
TPrinterState = (psNeedHandle,psHandle,psOtherHandle);
|
||||
TPrinterOrientation = (poPortrait,poLandscape);
|
||||
{* Paper orientation}
|
||||
TMarginOption = (mgInches,mgMillimeters);
|
||||
{* Margin option}
|
||||
TPrinterState = (psNeedHandle, psHandle, psOtherHandle);
|
||||
TPrinterOrientation = (poPortrait, poLandscape);
|
||||
{* Paper orientation}
|
||||
TMarginOption = (mgInches, mgMillimeters);
|
||||
{* Margin option}
|
||||
|
||||
PPrinter =^TPrinter;
|
||||
PPrinter = ^TPrinter;
|
||||
TKOLPrinter = PPrinter;
|
||||
TPrinter = object(TObj)
|
||||
{*}
|
||||
{*}
|
||||
private
|
||||
{ Private declarations }
|
||||
fDevice,fDriver,fPort : String;
|
||||
fDevMode : THandle;
|
||||
fDeviceMode : PDeviceMode;
|
||||
fCanvas : PCanvas; // KOL canvas
|
||||
fTitle : String;
|
||||
fState : TPrinterState; // DC is allocated or need new DC becouse params were changed
|
||||
fAborted : Boolean;
|
||||
fPrinting : Boolean;
|
||||
fPageNumber : Integer;
|
||||
fOutput : String;
|
||||
PrinterInfo : TPrinterInfo;
|
||||
fRec : TRect;
|
||||
fMargins : TRect; //Margins (in pixels)
|
||||
fAssigned : Boolean; //if TRUE ,there is a printer with correctly assigned information
|
||||
fDevice, fDriver, fPort: string;
|
||||
fDevMode: THandle;
|
||||
fDeviceMode: PDeviceMode;
|
||||
fCanvas: PCanvas; // KOL canvas
|
||||
fTitle: string;
|
||||
fState: TPrinterState; // DC is allocated or need new DC becouse params were changed
|
||||
fAborted: Boolean;
|
||||
fPrinting: Boolean;
|
||||
fPageNumber: Integer;
|
||||
fOutput: string;
|
||||
PrinterInfo: TPrinterInfo;
|
||||
fRec: TRect;
|
||||
fMargins: TRect; //Margins (in pixels)
|
||||
fAssigned: Boolean; //if TRUE ,there is a printer with correctly assigned information
|
||||
protected
|
||||
function GetHandle : HDC;
|
||||
procedure SetHandle(Value : HDC);
|
||||
function GetCanvas : PCanvas;
|
||||
function GetCopies : Integer;
|
||||
procedure SetCopies(const Value : Integer);
|
||||
function GetOrientation : TPrinterOrientation;
|
||||
procedure SetOrientation(const Value : TPrinterOrientation);
|
||||
function GetPageHeight : Integer;
|
||||
function GetPageWidth : Integer;
|
||||
function Scale : Integer;
|
||||
procedure Prepare;
|
||||
procedure DefPrinter;
|
||||
function GetHandle: HDC;
|
||||
procedure SetHandle(Value: HDC);
|
||||
function GetCanvas: PCanvas;
|
||||
function GetCopies: Integer;
|
||||
procedure SetCopies(const Value: Integer);
|
||||
function GetOrientation: TPrinterOrientation;
|
||||
procedure SetOrientation(const Value: TPrinterOrientation);
|
||||
function GetPageHeight: Integer;
|
||||
function GetPageWidth: Integer;
|
||||
function Scale: Integer;
|
||||
procedure Prepare;
|
||||
procedure DefPrinter;
|
||||
public
|
||||
{ Public declarations }
|
||||
destructor Destroy; virtual;
|
||||
@@ -122,68 +122,66 @@ TMarginOption = (mgInches,mgMillimeters);
|
||||
{* End print process end send it to print spooler}
|
||||
procedure NewPage;
|
||||
{* Request new page}
|
||||
procedure Assign(Source : PPrinterInfo);
|
||||
procedure Assign(Source: PPrinterInfo);
|
||||
{* 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
|
||||
(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
|
||||
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)
|
||||
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
|
||||
this property to avoid access violation when there is no printer in system}
|
||||
property Title : String read fTitle write fTitle;
|
||||
this property to avoid access violation when there is no printer in system}
|
||||
property Title: string read fTitle write fTitle;
|
||||
{* Title of print process in print manager window}
|
||||
function Info : PPrinterInfo;
|
||||
function Info: PPrinterInfo;
|
||||
{* 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.}
|
||||
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}
|
||||
property Orientation : TPrinterOrientation read GetOrientation write SetOrientation;
|
||||
property Orientation: TPrinterOrientation read GetOrientation write SetOrientation;
|
||||
{* Page orientation}
|
||||
property Margins : TRect read fMargins write fMargins;
|
||||
property Margins: TRect read fMargins write fMargins;
|
||||
{* Page margins (in pixels)}
|
||||
property PageHeight : Integer read GetPageHeight;
|
||||
property PageHeight: Integer read GetPageHeight;
|
||||
{* Page height in logical pixels}
|
||||
property PageWidth : Integer read GetPageWidth;
|
||||
property PageWidth: Integer read GetPageWidth;
|
||||
{* Page width in logical pixels}
|
||||
property PageNumber : Integer read fPageNumber;
|
||||
property PageNumber: Integer read fPageNumber;
|
||||
{* Currently printed page number}
|
||||
property Printing : Boolean read fPrinting;
|
||||
property Printing: Boolean read fPrinting;
|
||||
{* Indicate printing process}
|
||||
property Aborted : Boolean read fAborted;
|
||||
property Aborted: Boolean read fAborted;
|
||||
{* Indicate abort of printing process}
|
||||
|
||||
end;
|
||||
|
||||
|
||||
function Printer : PPrinter;
|
||||
function Printer: PPrinter;
|
||||
{* Returns pointer to global TKOLPrinter object}
|
||||
procedure RecreatePrinter;
|
||||
{* Recreates global Printer pbject }
|
||||
|
||||
function NewPrinter(PrinterInfo : PPrinterInfo) : PPrinter;
|
||||
function NewPrinter(PrinterInfo: PPrinterInfo): PPrinter;
|
||||
{* Global function for creating TKOLPrinter instance.Usually not needed, becouse
|
||||
inluding KOLPrinters causes creating of global TKOLPrinter instance.}
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
uses RichEdit;
|
||||
|
||||
uses
|
||||
RichEdit;
|
||||
|
||||
type
|
||||
|
||||
PtagPD = ^tagPD;
|
||||
tagPD = packed record
|
||||
tagPD = packed record
|
||||
lStructSize: DWORD;
|
||||
hWndOwner: HWND;
|
||||
hDevMode: HGLOBAL;
|
||||
@@ -206,48 +204,40 @@ type
|
||||
end;
|
||||
|
||||
const
|
||||
PD_RETURNDC = $00000100;
|
||||
PD_RETURNDEFAULT = $00000400;
|
||||
|
||||
|
||||
PD_RETURNDC = $00000100;
|
||||
PD_RETURNDEFAULT = $00000400;
|
||||
|
||||
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
|
||||
Result := not fPrinter.Aborted;
|
||||
Result := not fPrinter.Aborted;
|
||||
end;
|
||||
|
||||
function NewPrinter(PrinterInfo : PPrinterInfo) : PPrinter;
|
||||
function NewPrinter(PrinterInfo: PPrinterInfo): PPrinter;
|
||||
begin
|
||||
New(Result,Create);
|
||||
Result.fTitle := '';
|
||||
Result.fOutput := '';
|
||||
Result.fAborted := False;
|
||||
Result.fPrinting := False;
|
||||
Result.fPageNumber := 0;
|
||||
Result.fCanvas := nil;
|
||||
Result.fMargins.Top := 10;
|
||||
Result.fMargins.Left := 10;
|
||||
Result.fMargins.Bottom := 10;
|
||||
Result.fMargins.Right := 10;
|
||||
FillChar(Result.fRec,sizeof(Result.fRec),0);
|
||||
if PrinterInfo = nil then Result.DefPrinter
|
||||
else
|
||||
Result.Assign(PrinterInfo);
|
||||
|
||||
New(Result, Create);
|
||||
Result.fTitle := '';
|
||||
Result.fOutput := '';
|
||||
Result.fAborted := False;
|
||||
Result.fPrinting := False;
|
||||
Result.fPageNumber := 0;
|
||||
Result.fCanvas := nil;
|
||||
Result.fMargins.Top := 10;
|
||||
Result.fMargins.Left := 10;
|
||||
Result.fMargins.Bottom := 10;
|
||||
Result.fMargins.Right := 10;
|
||||
FillChar(Result.fRec, sizeof(Result.fRec), 0);
|
||||
if PrinterInfo = nil then
|
||||
Result.DefPrinter
|
||||
else
|
||||
Result.Assign(PrinterInfo);
|
||||
end;
|
||||
|
||||
|
||||
function Printer : PPrinter;
|
||||
function Printer: PPrinter;
|
||||
begin
|
||||
if FPrinter = nil then
|
||||
FPrinter := NewPrinter(nil);
|
||||
@@ -256,78 +246,72 @@ end;
|
||||
|
||||
procedure RecreatePrinter;
|
||||
begin
|
||||
Free_And_Nil( FPrinter );
|
||||
Free_And_Nil(FPrinter);
|
||||
FPrinter := NewPrinter(nil);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
destructor TPrinter.Destroy;
|
||||
begin
|
||||
Prepare;
|
||||
fTitle := '';
|
||||
fDevice := '';
|
||||
fDriver := '';
|
||||
fPort := '';
|
||||
fOutput := '';
|
||||
inherited; {+++}
|
||||
FPrinter := nil;
|
||||
Prepare;
|
||||
fTitle := '';
|
||||
fDevice := '';
|
||||
fDriver := '';
|
||||
fPort := '';
|
||||
fOutput := '';
|
||||
inherited; {+++}
|
||||
FPrinter := nil;
|
||||
end;
|
||||
|
||||
procedure TPrinter.Prepare;
|
||||
begin
|
||||
{ Free previously used resources }
|
||||
if (fState <> psOtherHandle) and (fCanvas <> nil) then
|
||||
begin
|
||||
fCanvas.Free;
|
||||
fCanvas := nil; {+++}
|
||||
end;
|
||||
if fDevMode <> 0 then
|
||||
begin
|
||||
GlobalUnlock(fDevMode);
|
||||
GlobalFree(fDevMode);
|
||||
end;
|
||||
{ Free previously used resources }
|
||||
if (fState <> psOtherHandle) and (fCanvas <> nil) then begin
|
||||
fCanvas.Free;
|
||||
fCanvas := nil; {+++}
|
||||
end;
|
||||
if fDevMode <> 0 then begin
|
||||
GlobalUnlock(fDevMode);
|
||||
GlobalFree(fDevMode);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPrinter.Scale : Integer;
|
||||
function TPrinter.Scale: Integer;
|
||||
var
|
||||
DC : HDC;
|
||||
ScreenH,PrinterH : Integer;
|
||||
DC : HDC;
|
||||
ScreenH, PrinterH : Integer;
|
||||
begin
|
||||
DC := GetDC(0);
|
||||
ScreenH := GetDeviceCaps(DC,LOGPIXELSY);
|
||||
PrinterH := GetDeviceCaps(fCanvas.Handle,LOGPIXELSY);
|
||||
ReleaseDC(0,DC);
|
||||
ScreenH := GetDeviceCaps(DC, LOGPIXELSY);
|
||||
PrinterH := GetDeviceCaps(fCanvas.Handle, LOGPIXELSY);
|
||||
ReleaseDC(0, DC);
|
||||
Result := PrinterH div ScreenH;
|
||||
end;
|
||||
|
||||
procedure TPrinter.WriteLn(const Text : String);
|
||||
procedure TPrinter.WriteLn(const Text: string);
|
||||
var
|
||||
OldFontSize,PageH,Size,Len : Integer;
|
||||
pC : PChar;
|
||||
Rect : TRect;
|
||||
Metrics : TTextMetric;
|
||||
NewText : String;
|
||||
OldFontSize, PageH, Size, Len: Integer;
|
||||
pC : PChar;
|
||||
Rect : TRect;
|
||||
Metrics : TTextMetric;
|
||||
NewText : string;
|
||||
|
||||
procedure ComputeRect;
|
||||
{ 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.}
|
||||
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
|
||||
Len := Len + 100;
|
||||
if Len > Size then
|
||||
begin
|
||||
Len := Size;
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
procedure ComputeRect;
|
||||
{ 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.}
|
||||
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
|
||||
Len := Len + 100;
|
||||
if Len > Size then begin
|
||||
Len := Size;
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ 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
|
||||
Len := Len - 1;
|
||||
while Windows.DrawText(fCanvas.Handle, pC, Len, Rect, DT_CALCRECT + DT_WORDBREAK + DT_NOCLIP + DT_NOPREFIX + DT_EXPANDTABS) > PageH do
|
||||
Len := Len - 1;
|
||||
|
||||
{ Find position of last space or line end (#13#10) to not break word
|
||||
(if possible) on bottom-right corner of the page.Do it only for multipage text (Len<>Size) }
|
||||
@@ -340,34 +324,31 @@ begin
|
||||
}
|
||||
|
||||
{ Finally draw it!}
|
||||
Windows.DrawText(fCanvas.Handle,pC,Len,Rect,DT_WORDBREAK + DT_NOCLIP + DT_NOPREFIX + DT_EXPANDTABS);
|
||||
|
||||
|
||||
end;
|
||||
Windows.DrawText(fCanvas.Handle, pC, Len, Rect, DT_WORDBREAK + DT_NOCLIP + DT_NOPREFIX + DT_EXPANDTABS);
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
if Length(Text) <=0 then Exit;
|
||||
if Text[Length(Text)] <> #10 then NewText := Text + #13#10
|
||||
else
|
||||
NewText := Text;
|
||||
pC := PChar(NewText);
|
||||
Size := Length(NewText);
|
||||
SetMapMode(fCanvas.Handle,MM_TEXT);
|
||||
OldFontSize := fCanvas.Font.FontHeight;
|
||||
fCanvas.Font.FontHeight := fCanvas.Font.FontHeight * Scale;
|
||||
SelectObject(fCanvas.Handle,fCanvas.Font.Handle);
|
||||
PageH := GetPageHeight - fMargins.Bottom;
|
||||
GetTextMetrics(fCanvas.Handle,Metrics);
|
||||
while Size > 0 do
|
||||
begin
|
||||
if Length(Text) <= 0 then Exit;
|
||||
if Text[Length(Text)] <> #10 then NewText := Text + #13#10
|
||||
else
|
||||
NewText := Text;
|
||||
pC := PChar(NewText);
|
||||
Size := Length(NewText);
|
||||
SetMapMode(fCanvas.Handle, MM_TEXT);
|
||||
OldFontSize := fCanvas.Font.FontHeight;
|
||||
fCanvas.Font.FontHeight := fCanvas.Font.FontHeight * Scale;
|
||||
SelectObject(fCanvas.Handle, fCanvas.Font.Handle);
|
||||
PageH := GetPageHeight - fMargins.Bottom;
|
||||
GetTextMetrics(fCanvas.Handle, Metrics);
|
||||
while Size > 0 do begin
|
||||
Rect := fRec;
|
||||
ComputeRect;
|
||||
Inc(pC,Len + 1);
|
||||
Dec(Size,Len + 1);
|
||||
if (Size > 0) and (fRec.Left <= fMargins.Left) then NewPage;
|
||||
Inc(pC, Len + 1);
|
||||
Dec(Size, Len + 1);
|
||||
if (Size > 0) and (fRec.Left <= fMargins.Left) then NewPage;
|
||||
end;
|
||||
if (Rect.Bottom > PageH) then begin
|
||||
if (Rect.Bottom > PageH) then begin
|
||||
NewPage;
|
||||
Rect.Bottom := 0;
|
||||
end;
|
||||
@@ -378,265 +359,249 @@ while Size > 0 do
|
||||
NewText := '';
|
||||
end;
|
||||
|
||||
|
||||
procedure TPrinter.DefPrinter;
|
||||
var
|
||||
ftagPD : tagPD;
|
||||
DevNames : PDevNames;
|
||||
ftagPD : tagPD;
|
||||
DevNames : PDevNames;
|
||||
begin
|
||||
fAssigned := false;
|
||||
fState := psHandle;
|
||||
fAssigned := false;
|
||||
fState := psHandle;
|
||||
Prepare;
|
||||
{ Get DC of default printer }
|
||||
FillChar(ftagPD, sizeof(tagPD), 0);
|
||||
ftagPD.Flags := PD_RETURNDC + PD_RETURNDEFAULT;
|
||||
ftagPD.lStructSize := sizeof(ftagPD);
|
||||
if not PrintDlg(ftagPD) then Exit;
|
||||
fAssigned := true;
|
||||
DevNames := PDevNames(GlobalLock(ftagPD.hDevNames));
|
||||
fDevMode := ftagPD.hDevMode;
|
||||
fDeviceMode := PDevMode(GlobalLock(fDevMode));
|
||||
try
|
||||
fDriver := string(PChar(DevNames) + DevNames^.wDriverOffset);
|
||||
fDevice := string(PChar(DevNames) + DevNames^.wDeviceOffset);
|
||||
fPort := string(PChar(DevNames) + DevNames^.wOutputOffset);
|
||||
finally
|
||||
GlobalUnlock(ftagPD.hDevNames);
|
||||
GlobalFree(ftagPD.hDevNames);
|
||||
end;
|
||||
fCanvas := NewCanvas(ftagPD.hDC);
|
||||
end;
|
||||
|
||||
procedure TPrinter.Assign(Source: PPrinterInfo);
|
||||
var
|
||||
Size : Integer;
|
||||
DevMode : PDevMode;
|
||||
fhDC : HDC;
|
||||
begin
|
||||
fAssigned := false;
|
||||
if (Source = nil) or
|
||||
(Source^.ADriver = nil) and
|
||||
(Source^.ADevice = nil) and
|
||||
(Source^.APort = nil) and
|
||||
(Source^.ADevMode = 0) then DefPrinter
|
||||
else begin
|
||||
Prepare;
|
||||
{ Get DC of default printer }
|
||||
FillChar(ftagPD,sizeof(tagPD),0);
|
||||
ftagPD.Flags := PD_RETURNDC + PD_RETURNDEFAULT;
|
||||
ftagPD.lStructSize := sizeof(ftagPD);
|
||||
if not PrintDlg(ftagPD) then Exit;
|
||||
fAssigned := true;
|
||||
DevNames := PDevNames(GlobalLock(ftagPD.hDevNames));
|
||||
fDevMode := ftagPD.hDevMode;
|
||||
fDeviceMode := PDevMode(GlobalLock(fDevMode));
|
||||
fDriver := string(Source^.ADriver);
|
||||
fDevice := string(Source^.ADevice);
|
||||
fPort := string(Source^.APort);
|
||||
DevMode := PDevMode(GlobalLock(Source^.ADevMode));
|
||||
try
|
||||
fDriver := String(PChar(DevNames) + DevNames^.wDriverOffset);
|
||||
fDevice := String(PChar(DevNames) + DevNames^.wDeviceOffset);
|
||||
fPort := String(PChar(DevNames) + DevNames^.wOutputOffset);
|
||||
Size := sizeof(DevMode^);
|
||||
fDevMode := GlobalAlloc(GHND, Size);
|
||||
fDeviceMode := PDevMode(GlobalLock(fDevMode));
|
||||
CopyMemory(fDeviceMode, DevMode, Size);
|
||||
fhDC := CreateDC(PChar(fDriver), PChar(fDevice), PChar(fPort), fDeviceMode);
|
||||
finally
|
||||
GlobalUnlock(ftagPD.hDevNames);
|
||||
GlobalFree(ftagPD.hDevNames);
|
||||
GlobalUnlock(Source^.ADevMode);
|
||||
end;
|
||||
fCanvas := NewCanvas(ftagPD.hDC);
|
||||
fCanvas := NewCanvas(fhDC);
|
||||
fAssigned := true;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPrinter.Assign(Source : PPrinterInfo);
|
||||
procedure TPrinter.AssignMargins(cMargins: TRect; Option: TMarginOption);
|
||||
var
|
||||
Size : Integer;
|
||||
DevMode : PDevMode;
|
||||
fhDC : HDC;
|
||||
PH, PW : Integer;
|
||||
begin
|
||||
fAssigned := false;
|
||||
if (Source = nil) or
|
||||
(Source^.ADriver = nil) and
|
||||
(Source^.ADevice = nil) and
|
||||
(Source^.APort = nil) and
|
||||
(Source^.ADevMode = 0) then DefPrinter
|
||||
else
|
||||
begin
|
||||
Prepare;
|
||||
fDriver := String(Source^.ADriver);
|
||||
fDevice := String(Source^.ADevice);
|
||||
fPort := String(Source^.APort);
|
||||
DevMode := PDevMode(GlobalLock(Source^.ADevMode));
|
||||
try
|
||||
Size := sizeof(DevMode^);
|
||||
fDevMode := GlobalAlloc(GHND,Size);
|
||||
fDeviceMode := PDevMode(GlobalLock(fDevMode));
|
||||
CopyMemory(fDeviceMode,DevMode,Size);
|
||||
fhDC := CreateDC(PChar(fDriver),PChar(fDevice),PChar(fPort),fDeviceMode);
|
||||
finally
|
||||
GlobalUnlock(Source^.ADevMode);
|
||||
end;
|
||||
fCanvas := NewCanvas(fhDC);
|
||||
fAssigned := true;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TPrinter.AssignMargins(cMargins : TRect;Option : TMarginOption);
|
||||
var
|
||||
PH,PW : Integer;
|
||||
begin
|
||||
PH := GetDeviceCaps(fCanvas.Handle,LOGPIXELSY);
|
||||
PW := GetDeviceCaps(fCanvas.Handle,LOGPIXELSX);
|
||||
PH := GetDeviceCaps(fCanvas.Handle, LOGPIXELSY);
|
||||
PW := GetDeviceCaps(fCanvas.Handle, LOGPIXELSX);
|
||||
case Option of
|
||||
mgInches:
|
||||
begin
|
||||
fMargins.Top := round((cMargins.Top*PH)/1000);
|
||||
fMargins.Left := round((cMargins.Left*PW)/1000);
|
||||
fMargins.Bottom := round((cMargins.Bottom*PH)/1000);
|
||||
fMargins.Right := round((cMargins.Right*PW)/1000);
|
||||
end;
|
||||
mgMillimeters:
|
||||
begin
|
||||
fMargins.Top := round((cMargins.Top*PH)/2540);
|
||||
fMargins.Left := round((cMargins.Left*PW)/2540);
|
||||
fMargins.Bottom := round((cMargins.Bottom*PH)/2540);
|
||||
fMargins.Right := round((cMargins.Right*PW)/2540);
|
||||
end;
|
||||
end;
|
||||
mgInches: begin
|
||||
fMargins.Top := round((cMargins.Top * PH) / 1000);
|
||||
fMargins.Left := round((cMargins.Left * PW) / 1000);
|
||||
fMargins.Bottom := round((cMargins.Bottom * PH) / 1000);
|
||||
fMargins.Right := round((cMargins.Right * PW) / 1000);
|
||||
end;
|
||||
mgMillimeters: begin
|
||||
fMargins.Top := round((cMargins.Top * PH) / 2540);
|
||||
fMargins.Left := round((cMargins.Left * PW) / 2540);
|
||||
fMargins.Bottom := round((cMargins.Bottom * PH) / 2540);
|
||||
fMargins.Right := round((cMargins.Right * PW) / 2540);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPrinter.Abort;
|
||||
begin
|
||||
AbortDoc(fCanvas.Handle);
|
||||
fAborted := True;
|
||||
EndDoc;
|
||||
AbortDoc(fCanvas.Handle);
|
||||
fAborted := True;
|
||||
EndDoc;
|
||||
end;
|
||||
|
||||
|
||||
procedure TPrinter.BeginDoc;
|
||||
var
|
||||
doc : DOCINFOA;
|
||||
doc : DOCINFOA;
|
||||
begin
|
||||
fRec.Top := fMargins.Top;
|
||||
fRec.Left := fMargins.Left;
|
||||
fRec.Right := GetPageWidth - fMargins.Right ;
|
||||
fRec.Bottom := GetPageHeight - fMargins.Bottom;
|
||||
fAborted := False;
|
||||
fPageNumber :=1;
|
||||
fPrinting := True;
|
||||
FillChar(doc,sizeof(DOCINFOA),0);
|
||||
doc.lpszDocName := PChar(fTitle);
|
||||
if (fOutput <> '') then doc.lpszOutput := PChar(fOutput);
|
||||
doc.cbSize := sizeof(doc);
|
||||
SetAbortProc(fCanvas.Handle,AbortProc);
|
||||
StartDoc(fCanvas.Handle,doc);
|
||||
StartPage(fCanvas.Handle);
|
||||
fRec.Top := fMargins.Top;
|
||||
fRec.Left := fMargins.Left;
|
||||
fRec.Right := GetPageWidth - fMargins.Right;
|
||||
fRec.Bottom := GetPageHeight - fMargins.Bottom;
|
||||
fAborted := False;
|
||||
fPageNumber := 1;
|
||||
fPrinting := True;
|
||||
FillChar(doc, sizeof(DOCINFOA), 0);
|
||||
doc.lpszDocName := PChar(fTitle);
|
||||
if (fOutput <> '') then doc.lpszOutput := PChar(fOutput);
|
||||
doc.cbSize := sizeof(doc);
|
||||
SetAbortProc(fCanvas.Handle, AbortProc);
|
||||
StartDoc(fCanvas.Handle, doc);
|
||||
StartPage(fCanvas.Handle);
|
||||
end;
|
||||
|
||||
procedure TPrinter.EndDoc;
|
||||
begin
|
||||
EndPage(fCanvas.Handle);
|
||||
if not fAborted then Windows.EndDoc(fCanvas.Handle);
|
||||
fAborted := False;
|
||||
fPageNumber := 0;
|
||||
fOutPut := '';
|
||||
fPrinting := False;
|
||||
EndPage(fCanvas.Handle);
|
||||
if not fAborted then Windows.EndDoc(fCanvas.Handle);
|
||||
fAborted := False;
|
||||
fPageNumber := 0;
|
||||
fOutPut := '';
|
||||
fPrinting := False;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
function TPrinter.GetHandle : HDC;
|
||||
function TPrinter.GetHandle: HDC;
|
||||
var
|
||||
fhDC : HDC;
|
||||
fhDC : HDC;
|
||||
begin
|
||||
if (fState = psNeedHandle) and (fCanvas <> nil) then
|
||||
begin
|
||||
fCanvas.Free;
|
||||
fhDC := CreateDC(PChar(fDriver),PChar(fDevice),PChar(fPort),fDeviceMode);
|
||||
fCanvas := NewCanvas(fhDC);
|
||||
fState := psHandle;
|
||||
end;
|
||||
Result := fCanvas.Handle;
|
||||
if (fState = psNeedHandle) and (fCanvas <> nil) then begin
|
||||
fCanvas.Free;
|
||||
fhDC := CreateDC(PChar(fDriver), PChar(fDevice), PChar(fPort), fDeviceMode);
|
||||
fCanvas := NewCanvas(fhDC);
|
||||
fState := psHandle;
|
||||
end;
|
||||
Result := fCanvas.Handle;
|
||||
end;
|
||||
|
||||
procedure TPrinter.SetHandle(Value : HDC);
|
||||
procedure TPrinter.SetHandle(Value: HDC);
|
||||
begin
|
||||
if Value <> fCanvas.Handle then
|
||||
begin
|
||||
if fCanvas <> nil then fCanvas.Free;
|
||||
fCanvas := NewCanvas(Value);
|
||||
fState := psOtherHandle;
|
||||
end;
|
||||
if Value <> fCanvas.Handle then begin
|
||||
if fCanvas <> nil then fCanvas.Free;
|
||||
fCanvas := NewCanvas(Value);
|
||||
fState := psOtherHandle;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function TPrinter.GetCanvas : PCanvas;
|
||||
function TPrinter.GetCanvas: PCanvas;
|
||||
begin
|
||||
GetHandle;
|
||||
Result := fCanvas;
|
||||
GetHandle;
|
||||
Result := fCanvas;
|
||||
end;
|
||||
|
||||
|
||||
function TPrinter.Info : PPrinterInfo;
|
||||
function TPrinter.Info: PPrinterInfo;
|
||||
begin
|
||||
with PrinterInfo do begin
|
||||
ADevice := PChar(fDevice);
|
||||
ADriver := PChar(fDriver);
|
||||
APort := PChar(fPort);
|
||||
ADevMode := fDevMode;
|
||||
end;
|
||||
Result := @PrinterInfo;
|
||||
with PrinterInfo do begin
|
||||
ADevice := PChar(fDevice);
|
||||
ADriver := PChar(fDriver);
|
||||
APort := PChar(fPort);
|
||||
ADevMode := fDevMode;
|
||||
end;
|
||||
Result := @PrinterInfo;
|
||||
end;
|
||||
|
||||
function TPrinter.GetCopies : Integer;
|
||||
function TPrinter.GetCopies: Integer;
|
||||
begin
|
||||
Result := fDeviceMode^.dmCopies;
|
||||
Result := fDeviceMode^.dmCopies;
|
||||
end;
|
||||
|
||||
|
||||
procedure TPrinter.SetCopies(const Value : Integer);
|
||||
procedure TPrinter.SetCopies(const Value: Integer);
|
||||
begin
|
||||
fDeviceMode^.dmCopies := Value;
|
||||
fDeviceMode^.dmCopies := Value;
|
||||
end;
|
||||
|
||||
|
||||
function TPrinter.GetOrientation : TPrinterOrientation;
|
||||
function TPrinter.GetOrientation: TPrinterOrientation;
|
||||
begin
|
||||
if System.Assigned(fDeviceMode) and (fDeviceMode^.dmOrientation = DMORIENT_PORTRAIT) then
|
||||
Result := poPortrait
|
||||
else
|
||||
Result := poLandscape;
|
||||
if System.Assigned(fDeviceMode) and (fDeviceMode^.dmOrientation = DMORIENT_PORTRAIT) then
|
||||
Result := poPortrait
|
||||
else
|
||||
Result := poLandscape;
|
||||
end;
|
||||
|
||||
procedure TPrinter.SetOrientation(const Value : TPrinterOrientation);
|
||||
procedure TPrinter.SetOrientation(const Value: TPrinterOrientation);
|
||||
const
|
||||
Orientations : array [TPrinterOrientation] of Integer = (DMORIENT_PORTRAIT,DMORIENT_LANDSCAPE);
|
||||
Orientations : array[TPrinterOrientation] of Integer = (DMORIENT_PORTRAIT, DMORIENT_LANDSCAPE);
|
||||
begin
|
||||
fDeviceMode^.dmOrientation := Orientations[Value];
|
||||
fDeviceMode^.dmOrientation := Orientations[Value];
|
||||
end;
|
||||
|
||||
function TPrinter.GetPageHeight : Integer;
|
||||
function TPrinter.GetPageHeight: Integer;
|
||||
begin
|
||||
if fCanvas <> nil then
|
||||
Result := GetDeviceCaps(fCanvas.Handle,VERTRES)
|
||||
Result := GetDeviceCaps(fCanvas.Handle, VERTRES)
|
||||
else Result := 0;
|
||||
end;
|
||||
|
||||
function TPrinter.GetPageWidth : Integer;
|
||||
function TPrinter.GetPageWidth: Integer;
|
||||
begin
|
||||
if fCanvas <> nil then
|
||||
Result := GetDeviceCaps(fCanvas.Handle,HORZRES)
|
||||
Result := GetDeviceCaps(fCanvas.Handle, HORZRES)
|
||||
else Result := 0;
|
||||
end;
|
||||
|
||||
procedure TPrinter.NewPage;
|
||||
begin
|
||||
fRec.Top := fMargins.Top;
|
||||
fRec.Left := fMargins.Left;
|
||||
fRec.Right := GetPageWidth - fMargins.Right;
|
||||
fRec.Bottom := GetPageHeight - fMargins.Bottom;
|
||||
EndPage(fCanvas.Handle);
|
||||
StartPage(fCanvas.Handle);
|
||||
SelectObject(fCanvas.Handle,fCanvas.Font.Handle);
|
||||
Inc(fPageNumber);
|
||||
fRec.Top := fMargins.Top;
|
||||
fRec.Left := fMargins.Left;
|
||||
fRec.Right := GetPageWidth - fMargins.Right;
|
||||
fRec.Bottom := GetPageHeight - fMargins.Bottom;
|
||||
EndPage(fCanvas.Handle);
|
||||
StartPage(fCanvas.Handle);
|
||||
SelectObject(fCanvas.Handle, fCanvas.Font.Handle);
|
||||
Inc(fPageNumber);
|
||||
end;
|
||||
|
||||
|
||||
procedure TPrinter.RE_Print(RichEdit : PControl);
|
||||
procedure TPrinter.RE_Print(RichEdit: PControl);
|
||||
var
|
||||
Range: TFormatRange;
|
||||
Range : TFormatRange;
|
||||
LastChar, MaxLen, LogX, LogY, OldMap: Integer;
|
||||
SaveRect: TRect;
|
||||
TextLenEx: TGetTextLengthEx;
|
||||
SaveRect : TRect;
|
||||
TextLenEx : TGetTextLengthEx;
|
||||
begin
|
||||
if IndexOfStr(RichEdit.SubClassName,'obj_RichEdit') = -1 then Exit;
|
||||
if IndexOfStr(RichEdit.SubClassName, 'obj_RichEdit') = -1 then Exit;
|
||||
FillChar(Range, SizeOf(TFormatRange), 0);
|
||||
with Range do begin
|
||||
BeginDoc;
|
||||
hdc := GetHandle;
|
||||
hdc := GetHandle;
|
||||
hdcTarget := hdc;
|
||||
LogX := GetDeviceCaps(Handle, LOGPIXELSX);
|
||||
LogY := GetDeviceCaps(Handle, LOGPIXELSY);
|
||||
rc.Top := fMargins.Top*1440 div LogY;
|
||||
rc.Left := fMargins.Left*1440 div LogX;
|
||||
rc.Right := (GetPageWidth - fMargins.Right) * 1440 div LogX ;
|
||||
rc.Top := fMargins.Top * 1440 div LogY;
|
||||
rc.Left := fMargins.Left * 1440 div LogX;
|
||||
rc.Right := (GetPageWidth - fMargins.Right) * 1440 div LogX;
|
||||
rc.Bottom := (GetPageHeight - fMargins.Bottom) * 1440 div LogY;
|
||||
rcPage := rc;
|
||||
SaveRect := rc;
|
||||
LastChar := 0;
|
||||
// if RichEdit.Version >= 2 then begin
|
||||
with TextLenEx do begin
|
||||
flags := GTL_DEFAULT;
|
||||
codepage := CP_ACP;
|
||||
end;
|
||||
MaxLen := RichEdit.Perform(EM_GETTEXTLENGTHEX, WParam(@TextLenEx), 0);
|
||||
// end
|
||||
// else
|
||||
// MaxLen := Length(RichEdit.RE_Text[ reRTF, True ]);
|
||||
// if RichEdit.Version >= 2 then begin
|
||||
with TextLenEx do begin
|
||||
flags := GTL_DEFAULT;
|
||||
codepage := CP_ACP;
|
||||
end;
|
||||
MaxLen := RichEdit.Perform(EM_GETTEXTLENGTHEX, WParam(@TextLenEx), 0);
|
||||
// end
|
||||
// else
|
||||
// MaxLen := Length(RichEdit.RE_Text[ reRTF, True ]);
|
||||
chrg.cpMax := -1;
|
||||
OldMap := SetMapMode(hdc, MM_TEXT);
|
||||
SendMessage(RichEdit.Handle, EM_FORMATRANGE, 0, 0); { flush buffer }
|
||||
SendMessage(RichEdit.Handle, EM_FORMATRANGE, 0, 0); { flush buffer }
|
||||
try
|
||||
repeat
|
||||
rc := SaveRect;
|
||||
@@ -646,18 +611,16 @@ begin
|
||||
until (LastChar >= MaxLen) or (LastChar = -1);
|
||||
EndDoc;
|
||||
finally
|
||||
SendMessage(RichEdit.Handle, EM_FORMATRANGE, 0, 0); { flush buffer }
|
||||
SetMapMode(hdc, OldMap); { restore previous map mode }
|
||||
SendMessage(RichEdit.Handle, EM_FORMATRANGE, 0, 0); { flush buffer }
|
||||
SetMapMode(hdc, OldMap); { restore previous map mode }
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
//FPrinter := NewPrinter(nil);
|
||||
//FPrinter := NewPrinter(nil);
|
||||
|
||||
finalization
|
||||
Free_And_Nil( FPrinter );
|
||||
Free_And_Nil(FPrinter);
|
||||
end.
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user