View \PRTCTRL.PAS

Component PrintControl: Preview and print any control

Submitted By: Unknown
Rating: (Not rated) (Rate It)

unit PrtCtrl;
(***************************************************************************)
(* *)
(* ##### ##### ##### ##### ##### #### ###### ####### *)
(* # # # # # # # # # # *)
(* # # # # ### # #### # # ### # *)
(* # # # # # # # # # # # *)
(* ##### ##### ##### ##### ##### #### # # *)
(* *)
(***************************************************************************)
{
(c) 1995 Cogisoft
This component is FREE distribution. Use it for your own utilization.
But you can't sell an application, using this component, without the
authorization of Cogisoft.

COGISOFT,H?tel de M?zi?res,19 rue Michel Le Comte,75003 PARIS,FRANCE
Tel:(33)(1)40-65-04-04, FAX:(33)(1)42-72-27-87

Jerome VOLLET, CompuServe : 100560,3342
}
interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Printers, ExtCtrls, DsgnIntf;

type
TPrintControl = class(TComponent)
private
{ Private declarations }
protected
{ Protected declarations }
FBlank : string;
FPixelsPerInch: Integer;
FPrintScale : TPrintScale;
procedure SetBlank( Value : string );
function GetPixelsPerInch: Integer;
procedure SetPixelsPerInch(Value: Integer);
public
{ Public declarations }
constructor Create( AOwner : TComponent ); override;
function GetImage( Control : TWinControl ): TBitmap;
procedure Print( Control : TWinControl );
procedure Preview( Control : TWinControl );
published
{ Published declarations }
property ResizeForm : string read FBlank write SetBlank;
property PixelsPerInch: Integer read GetPixelsPerInch write SetPixelsPerInch;
property PrintScale : TPrintScale read FPrintScale write FPrintScale;
end;

TPropertyResizeForm = class( TStringProperty )
public
procedure Edit; override;
function GetAttributes : TPropertyAttributes; override;
end;

TPrintControlEditor = class( TComponentEditor )
public
procedure Edit; override;
procedure ExecuteVerb( Index : Integer ); override;
function GetVerbCount : Integer; override;
function GetVerb( Index : Integer ) : string; override;
end;

procedure Register;

implementation

constructor TPrintControl.Create( AOwner : TComponent );
var
component : TComponent;
Form : TForm;
begin
inherited Create( AOwner );
component := AOwner;
while (component<>nil) and not (component is TForm) do
component := component.Owner;
if component<>nil then
begin
Form := component as TForm;
PrintScale := Form.PrintScale;
   PixelsPerInch := Form.PixelsPerInch;
end;
FBlank := '';
end;

procedure TPrintControl.SetBlank( Value : string );
begin
FBlank := '';
end;

function TPrintControl.GetPixelsPerInch: Integer;
begin
Result := FPixelsPerInch;
if Result = 0 then Result := Screen.PixelsPerInch;
end;

procedure TPrintControl.SetPixelsPerInch(Value: Integer);
begin
if (Value <> GetPixelsPerInch) and ((Value = 0) or (Value >= 36)) then
FPixelsPerInch := Value;
end;

function TPrintControl.GetImage( Control : TWinControl ): TBitmap;
var
ScreenDC, PrintDC: HDC;
OldBits, PrintBits: HBITMAP;
PaintLParam: Longint;
Form : TForm;
Width,
Height : Integer;

procedure PrintHandle(Handle: HWND);
var
R: TRect;
Child: HWND;
SavedIndex: Integer;
begin
if IsWindowVisible(Handle) then
begin
SavedIndex := SaveDC(PrintDC);
WinProcs.GetClientRect(Handle, R);
MapWindowPoints(Handle, Control.Handle, R, 2);
with R do
begin
SetWindowOrgEx(PrintDC, -Left, -Top, nil);
{ IntersectClipRect(PrintDC, 0, 0, Right - Left, Bottom - Top);}
end;
SendMessage(Handle, WM_ERASEBKGND, PrintDC, 0);
SendMessage(Handle, WM_PAINT, PrintDC, PaintLParam);
Child := GetWindow(Handle, GW_CHILD);
if Child <> 0 then
begin
Child := GetWindow(Child, GW_HWNDLAST);
while Child <> 0 do
begin
PrintHandle(Child);
Child := GetWindow(Child, GW_HWNDPREV);
end;
end;
RestoreDC(PrintDC, SavedIndex);
end;
end;

begin
Result := nil;
ScreenDC := GetDC(0);
PaintLParam := 0;
try
PrintDC := CreateCompatibleDC(ScreenDC);
try
Form := GetParentForm( Control );
if Control = Form then
begin
Form.HorzScrollBar.Position := 0;
Form.VertScrollBar.Position := 0;
   Width := Form.HorzScrollBar.Range;
Height := Form.VertScrollBar.Range;
end else begin
   Width := Control.Width;
   Height := Control.Height;
end;
PrintBits := CreateCompatibleBitmap(ScreenDC, Width, Height );
try
OldBits := SelectObject(PrintDC, PrintBits);
try
{ Clear the contents of the bitmap }
FillRect(PrintDC, Rect( 0, 0, Width, Height), Form.Brush.Handle);

{ Paint control into a bitmap }
PrintHandle(Control.Handle);
finally
SelectObject(PrintDC, OldBits);
end;
Result := TBitmap.Create;
Result.Handle := PrintBits;
PrintBits := 0;
except
Result.Free;
if PrintBits <> 0 then DeleteObject(PrintBits);
raise;
end;
finally
DeleteDC(PrintDC);
end;
finally
ReleaseDC(0, ScreenDC);
end;
end;

procedure TPrintControl.Print( Control : TWinControl );
var
ControlImage: TBitmap;
Info: PBitmapInfo;
InfoSize: Integer;
Image: Pointer;
ImageSize: Longint;
Bits: HBITMAP;
DIBWidth, DIBHeight: Longint;
PrintWidth, PrintHeight: Longint;

begin
Printer.BeginDoc;
try
ControlImage := GetImage( Control );
try
{ Paint bitmap to the printer }
with Printer do
begin
Bits := ControlImage.Handle;
GetDIBSizes(Bits, InfoSize, ImageSize);
Info := MemAlloc(InfoSize);
try
Image := MemAlloc(ImageSize);
try
GetDIB(Bits, 0, Info^, Image^);
with Info^.bmiHeader do
begin
DIBWidth := biWidth;
DIBHeight := biHeight;
end;
case PrintScale of
poProportional:
begin
PrintWidth := MulDiv(DIBWidth, GetDeviceCaps(Handle,
LOGPIXELSX), PixelsPerInch);
PrintHeight := MulDiv(DIBHeight, GetDeviceCaps(Handle,
LOGPIXELSY), PixelsPerInch);
end;
poPrintToFit:
begin
PrintWidth := MulDiv(DIBWidth, PageHeight, DIBHeight);
if PrintWidth < PageWidth then
PrintHeight := PageHeight
else
begin
PrintWidth := PageWidth;
PrintHeight := MulDiv(DIBHeight, PageWidth, DIBWidth);
end;
end;
else
PrintWidth := DIBWidth;
PrintHeight := DIBHeight;
end;
StretchDIBits(Canvas.Handle, 0, 0, PrintWidth, PrintHeight, 0, 0,
DIBWidth, DIBHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
finally
FreeMem(Image, ImageSize);
end;
finally
FreeMem(Info, InfoSize);
end;
end;
finally
ControlImage.Free;
end;
finally
Printer.EndDoc;
end;
end;

procedure TPrintControl.Preview( Control : TWinControl );
var
bitmap2,
bitmap : TBitmap;
image : TImage;
Form : TForm;
CW, CH,
PW, PH : LongInt;
DIBWidth,
DIBHeight,
PrintWidth,
PrintHeight : Integer;
begin
bitmap := GetImage( Control );
Application.CreateForm( TForm, Form );
Image := TImage.Create( Form );
PW := Printer.PageWidth;
CH := Screen.Height-40;
PH := Printer.PageHeight;
CW := PW*CH div PH;
Form.ClientWidth := CW;
Form.ClientHeight := CH;
bitmap2 := TBitmap.Create;
bitmap2.Width := CW;
bitmap2.Height := CH;
bitmap2.Canvas.Brush.Color := clWhite;
bitmap2.Canvas.FillRect( Rect(0,0,CW,CH) );
DIBWidth := bitmap.Width;
DIBHeight := bitmap.Height;
case PrintScale of
poProportional:
begin
PrintWidth := GetDeviceCaps( Printer.Handle,
LOGPIXELSX);
PrintWidth := MulDiv(DIBWidth, GetDeviceCaps( Printer.Handle,
LOGPIXELSX), PixelsPerInch);
PrintHeight := MulDiv(DIBHeight, GetDeviceCaps( Printer.Handle,
LOGPIXELSY), PixelsPerInch);
end;
poPrintToFit:
begin
PrintWidth := MulDiv(DIBWidth, PH, DIBHeight);
if PrintWidth < PW then
PrintHeight := PH
else
begin
PrintWidth := PW;
PrintHeight := MulDiv(DIBHeight, PW, DIBWidth);
end;
end;
else
PrintWidth := DIBWidth;
PrintHeight := DIBHeight;
end;
PrintWidth := Round(PrintWidth*(CW/PW));
PrintHeight := Round(PrintHeight*(CH/PH));
bitmap2.Canvas.StretchDraw( Rect(0,0,PrintWidth,PrintHeight), bitmap );
with Image do
begin
Parent := Form;
Align := alClient;
Stretch := True;
Picture.Assign( bitmap2 );
end;
bitmap.Free;
bitmap2.Free;
Form.Show;
end;

procedure TPropertyResizeForm.Edit;
var
PrintControl : TPrintControl;
Form      : TForm;
begin
PrintControl := GetComponent(0) as TPrintControl;
Form := GetParentForm( PrintControl.Owner as TControl );
if MessageDlg( 'It will resize '+Form.Name+' proportionnal to the Printer Device !!!'+#13#10+
'Are you sure ???', mtConfirmation, mbOkCancel, 0 ) <> mrOk
then Exit;

Form.HorzScrollBar.Range := MulDiv(Printer.PageWidth,
PrintControl.PixelsPerInch,
GetDeviceCaps( Printer.Handle, LOGPIXELSX));
Form.VertScrollBar.Range := MulDiv(Printer.PageHeight,
PrintControl.PixelsPerInch,
GetDeviceCaps( Printer.Handle, LOGPIXELSY));
end;

function TPropertyResizeForm.GetAttributes : TPropertyAttributes;
begin
Result := [ paDialog ];
end;

procedure TPrintControlEditor.Edit;
var
PrintControl : TPrintControl;
Form      : TForm;
begin
PrintControl := Component as TPrintControl;
Form := GetParentForm( PrintControl.Owner as TControl );
if MessageDlg( 'It will resize '+Form.Name+' proportionnal to the Printer Device !!!'+#13#10+
'Are you sure ???', mtConfirmation, mbOkCancel, 0 ) <> mrOk
then Exit;

Form.HorzScrollBar.Range := MulDiv(Printer.PageWidth,
PrintControl.PixelsPerInch,
GetDeviceCaps( Printer.Handle, LOGPIXELSX));
Form.VertScrollBar.Range := MulDiv(Printer.PageHeight,
PrintControl.PixelsPerInch,
GetDeviceCaps( Printer.Handle, LOGPIXELSY));
end;

procedure TPrintControlEditor.ExecuteVerb( Index : Integer );
begin
Edit;
end;

function TPrintControlEditor.GetVerbCount : Integer;
begin
Result := 1;
end;

function TPrintControlEditor.GetVerb( Index : Integer ) : string;
var
Form : TForm;
begin
Form := GetParentForm( Component.Owner as TControl );
Result := 'Resize '+Form.Name;
end;

procedure Register;
begin
RegisterComponents('Samples', [TPrintControl]);
RegisterPropertyEditor( TypeInfo(string), TPrintControl,
'ResizeForm', TPropertyResizeForm );
RegisterComponentEditor( TPrintControl, TPrintControlEditor );
end;

end.