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

95
Addons/KOLPrinters.pas
View File

@@ -84,16 +84,16 @@ TMarginOption = (mgInches,mgMillimeters);
{*}
private
{ Private declarations }
fDevice,fDriver,fPort : String;
fDevice, fDriver, fPort: string;
fDevMode: THandle;
fDeviceMode: PDeviceMode;
fCanvas: PCanvas; // KOL canvas
fTitle : String;
fTitle: string;
fState: TPrinterState; // DC is allocated or need new DC becouse params were changed
fAborted: Boolean;
fPrinting: Boolean;
fPageNumber: Integer;
fOutput : String;
fOutput: string;
PrinterInfo: TPrinterInfo;
fRec: TRect;
fMargins: TRect; //Margins (in pixels)
@@ -127,7 +127,7 @@ TMarginOption = (mgInches,mgMillimeters);
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);
@@ -136,11 +136,11 @@ TMarginOption = (mgInches,mgMillimeters);
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;
property Title: string read fTitle write fTitle;
{* Title of print process in print manager window}
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;
{*}
@@ -165,7 +165,6 @@ TMarginOption = (mgInches,mgMillimeters);
end;
function Printer: PPrinter;
{* Returns pointer to global TKOLPrinter object}
procedure RecreatePrinter;
@@ -175,13 +174,12 @@ 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
lStructSize: DWORD;
@@ -209,18 +207,11 @@ const
PD_RETURNDC = $00000100;
PD_RETURNDEFAULT = $00000400;
var
FPrinter : PPrinter = nil;
function PrintDlg(var PrintDlg: tagPD): BOOL; stdcall; external 'comdlg32.dll' name 'PrintDlgA';
function AbortProc(Handle: HDC; Error: Integer): Bool; stdcall;
begin
Result := not fPrinter.Aborted;
@@ -240,13 +231,12 @@ begin
Result.fMargins.Bottom := 10;
Result.fMargins.Right := 10;
FillChar(Result.fRec, sizeof(Result.fRec), 0);
if PrinterInfo = nil then Result.DefPrinter
if PrinterInfo = nil then
Result.DefPrinter
else
Result.Assign(PrinterInfo);
end;
function Printer: PPrinter;
begin
if FPrinter = nil then
@@ -260,8 +250,6 @@ begin
FPrinter := NewPrinter(nil);
end;
destructor TPrinter.Destroy;
begin
Prepare;
@@ -277,13 +265,11 @@ end;
procedure TPrinter.Prepare;
begin
{ Free previously used resources }
if (fState <> psOtherHandle) and (fCanvas <> nil) then
begin
if (fState <> psOtherHandle) and (fCanvas <> nil) then begin
fCanvas.Free;
fCanvas := nil; {+++}
end;
if fDevMode <> 0 then
begin
if fDevMode <> 0 then begin
GlobalUnlock(fDevMode);
GlobalFree(fDevMode);
end;
@@ -301,25 +287,23 @@ begin
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;
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
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
if Len > Size then begin
Len := Size;
Break;
end;
@@ -342,10 +326,8 @@ begin
{ Finally draw it!}
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
@@ -359,8 +341,7 @@ 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
while Size > 0 do begin
Rect := fRec;
ComputeRect;
Inc(pC, Len + 1);
@@ -378,7 +359,6 @@ while Size > 0 do
NewText := '';
end;
procedure TPrinter.DefPrinter;
var
ftagPD : tagPD;
@@ -397,9 +377,9 @@ begin
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);
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);
@@ -419,12 +399,11 @@ begin
(Source^.ADevice = nil) and
(Source^.APort = nil) and
(Source^.ADevMode = 0) then DefPrinter
else
begin
else begin
Prepare;
fDriver := String(Source^.ADriver);
fDevice := String(Source^.ADevice);
fPort := String(Source^.APort);
fDriver := string(Source^.ADriver);
fDevice := string(Source^.ADevice);
fPort := string(Source^.APort);
DevMode := PDevMode(GlobalLock(Source^.ADevMode));
try
Size := sizeof(DevMode^);
@@ -440,7 +419,6 @@ begin
end;
end;
procedure TPrinter.AssignMargins(cMargins: TRect; Option: TMarginOption);
var
PH, PW : Integer;
@@ -448,15 +426,13 @@ begin
PH := GetDeviceCaps(fCanvas.Handle, LOGPIXELSY);
PW := GetDeviceCaps(fCanvas.Handle, LOGPIXELSX);
case Option of
mgInches:
begin
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
mgMillimeters: begin
fMargins.Top := round((cMargins.Top * PH) / 2540);
fMargins.Left := round((cMargins.Left * PW) / 2540);
fMargins.Bottom := round((cMargins.Bottom * PH) / 2540);
@@ -472,7 +448,6 @@ begin
EndDoc;
end;
procedure TPrinter.BeginDoc;
var
doc : DOCINFOA;
@@ -503,15 +478,11 @@ begin
fPrinting := False;
end;
function TPrinter.GetHandle: HDC;
var
fhDC : HDC;
begin
if (fState = psNeedHandle) and (fCanvas <> nil) then
begin
if (fState = psNeedHandle) and (fCanvas <> nil) then begin
fCanvas.Free;
fhDC := CreateDC(PChar(fDriver), PChar(fDevice), PChar(fPort), fDeviceMode);
fCanvas := NewCanvas(fhDC);
@@ -522,22 +493,19 @@ end;
procedure TPrinter.SetHandle(Value: HDC);
begin
if Value <> fCanvas.Handle then
begin
if Value <> fCanvas.Handle then begin
if fCanvas <> nil then fCanvas.Free;
fCanvas := NewCanvas(Value);
fState := psOtherHandle;
end;
end;
function TPrinter.GetCanvas: PCanvas;
begin
GetHandle;
Result := fCanvas;
end;
function TPrinter.Info: PPrinterInfo;
begin
with PrinterInfo do begin
@@ -554,13 +522,11 @@ begin
Result := fDeviceMode^.dmCopies;
end;
procedure TPrinter.SetCopies(const Value: Integer);
begin
fDeviceMode^.dmCopies := Value;
end;
function TPrinter.GetOrientation: TPrinterOrientation;
begin
if System.Assigned(fDeviceMode) and (fDeviceMode^.dmOrientation = DMORIENT_PORTRAIT) then
@@ -602,7 +568,6 @@ begin
Inc(fPageNumber);
end;
procedure TPrinter.RE_Print(RichEdit: PControl);
var
Range : TFormatRange;
@@ -652,7 +617,6 @@ begin
end;
end;
initialization
//FPrinter := NewPrinter(nil);
@@ -660,4 +624,3 @@ finalization
Free_And_Nil(FPrinter);
end.