修改以下几处：
unit CanvasPanel;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, Printers,StdCtrls,Grids;
const
DefaultPrinterPhysicalOffSetX: Integer = 130;
DefaultPrinterPhysicalOffSetY: Integer = 150;
DefaultPrinterPageWidth: Integer = 4676;
DefaultPrinterPageHeight: Integer = 6744;
DefaultPrinterPixelsPerInchX: Integer = 600;
DefaultPrinterPixelsPerInchY: Integer = 600;
DefaultPrinterVerticalSizeMM: Integer = 285;
DefaultPrinterHorizontalSizeMM: Integer = 198;
DefaultPageSizeWidthMM: Integer = 210;
DefaultPageSizeHeightMM: Integer = 297;
DefaultPageLeftMM: Integer = 25;
DefaultPageTopMM: Integer = 30;
DefaultPageRightMM: Integer = 15;
DefaultPageBottomMM: Integer = 25;
DefaultPageXOffSetMM: Integer = 20;
DefaultPageYOffSetMM: Integer = 25;
type
TViewMode = (vm500, vm200, vm150, vm100, vm75, vm50, vm25, vm10, vmPageWidth, vmFullPage);
TPageType = (Prt,Scr);
[red] TMyPreviewBox = class;[/red]
{TPageSizeData}
TPageSizeData = class(TPersistent)
private
FPageSizeWidthMM:Integer;
FPageSizeHeightMM:Integer;
FPageLeftMM:Integer;
FPageTopMM:Integer;
FPageRightMM:Integer;
FPageBottomMM:Integer;
FPageXOffSetMM:Integer;
FPageYOffSetMM:Integer;
FPageType:TPageType;
FMyPreviewBox:TMyPreviewBox;
procedure SetPageSizeWidthMM(VarMM:Integer);
procedure SetPageSizeHeightMM(VarMM:Integer);
procedure SetPageLeftMM(VarMM:Integer);
procedure SetPageTopMM(VarMM:Integer);
procedure SetPageRightMM(VarMM:Integer);
procedure SetPageBottomMM(VarMM:Integer);
function GetPageValidWidthMM : integer;
function GetPageValidHeigthMM : integer;
public
constructor Create[red](AOwner: TMyPreviewBox)[/red];
destructor Destroy; override;
published
property PageSizeWidthMM: Integer Read FPageSizeWidthMM Write SetPageSizeWidthMM Stored True Default 210;
property PageSizeHeightMM: Integer Read FPageSizeHeightMM Write SetPageSizeHeightMM Stored True Default 297;
property PageLeftMM: Integer Read FPageLeftMM Write SetPageLeftMM Stored True Default 25;
property PageTopMM: Integer Read FPageTopMM Write SetPageTopMM Stored True Default 30;
property PageRightMM: Integer Read FPageRightMM Write SetPageRightMM Stored True Default 15;
property PageBottomMM: Integer Read FPageBottomMM Write SetPageBottomMM Stored True Default 25;
property PageValidWidthMM: Integer Read GetPageValidWidthMM;
property PageValidHeigthMM: Integer Read GetPageValidHeigthMM;
property PageType:TPageType read FPageType write FPageType Default Scr;
//property MyPreviewBox:TMyPreviewBox read FMyPreviewBox write FMyPreviewBox Default nil;
end;
{ TCanvasPanel }
TCanvasPanel = class(TCustomPanel)
private
FPageParamMM:TPageSizeData;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
property Canvas;
property DockManager;
published
property PageParam: TPageSizeData read FPageParamMM write FPageParamMM;
end;
{ TMyPreviewBox }
TFileName=string;
TMyPreviewBox = class(TScrollBox)
private
FCanvasPanel:TCanvasPanel;
FViewMode: TViewMode;
pnlShadow: TPanel;
FFileName:TFileName;
FPageParamMM:TPageSizeData;
FOnPaint: TNotifyEvent;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure SetViewMode(const Value: TViewMode);
function GetCanvas:TCanvas;
procedure SetPageParamMM(VarPageParamMM:TPageSizeData);
protected
FScalePercent: Integer;
procedure CreateParams(var Params: TCreateParams); override;
public
function AddLabel:TLabel;
property DockManager;
procedure UpdatePageSetup;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas:TCanvas Read GetCanvas;
published
property Visible;
property FileName:TFileName read FFileName write FFileName;
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
property ViewMode: TViewMode read FViewMode write SetViewMode;
property PageParam: TPageSizeData read FPageParamMM write SetPageParamMM;
end;
procedure Register;
implementation
{公共函数区}
function PrinterPos(iMM:double;XorY:integer):integer;
var
PointX,PointY:integer;
begin
PointX:=GetDeviceCaps(Printer.Handle,LOGPIXELSX);
PointY:=GetDeviceCaps(Printer.Handle,LOGPIXELSY);
if XorY=0 then Result:=Round(iMM/25.4 * PointX); //X
if XorY=1 then Result:=Round(iMM/25.4 * PointY); //Y
end;
function MMToPoint(MM:double;XorY:integer):integer;
var
PrinterXPerMM,PrinterYPerMM,ScreenXPerMM,ScreenYPerMM
ouble;
MerLeft,MerTop:Integer;
Const
PageType=Scr;
begin
//屏幕 点/毫米
ScreenXPerMM := GetDeviceCaps(GetDC(0),HORZRES) / GetDeviceCaps(GetDC(0),HORZSIZE);
ScreenYPerMM := GetDeviceCaps(GetDC(0),VERTRES) / GetDeviceCaps(GetDC(0),VERTSIZE);
//打印机 点/毫米
PrinterXPerMM := GetDeviceCaps(Printer.Handle,HORZRES) / GetDeviceCaps(Printer.Handle,HORZSIZE);
PrinterYPerMM := GetDeviceCaps(Printer.Handle,VERTRES) / GetDeviceCaps(Printer.Handle,VERTSIZE);
//纸张边距
MerLeft := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX);
MerTop := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETY);
if (PageType = Prt) then
begin
if XorY=0 then Result:=Round(MM * PrinterXPerMM); //X
if XorY=1 then Result:=Round(MM * PrinterYPerMM); //Y
end;
//
if (PageType = Scr) then
begin
if XorY=0 then Result:=Trunc((MerLeft / PrinterXPerMM + MM) * ScreenXPerMM); //X
if XorY=1 then Result:=Trunc((MerTop / PrinterYPerMM + MM) * ScreenYPerMM); //Y
end;
end;
procedure Register;
begin
RegisterComponents('Samples', [TMyPreviewBox]);
end;
{TPageSizeData}
procedure TPageSizeData.SetPageSizeWidthMM(VarMM:Integer);
begin
FPageSizeWidthMM := VarMM;
end;
procedure TPageSizeData.SetPageBottomMM(VarMM: Integer);
begin
FPageBottomMM := VarMM;
[red]FMyPreviewBox.UpdatePageSetup;[/red]
end;
procedure TPageSizeData.SetPageSizeHeightMM(VarMM: Integer);
begin
FPageSizeHeightMM := VarMM;
end;
procedure TPageSizeData.SetPageLeftMM(VarMM: Integer);
begin
FPageLeftMM := VarMM;
[red]FMyPreviewBox.UpdatePageSetup;[/red]
end;
procedure TPageSizeData.SetPageRightMM(VarMM: Integer);
begin
FPageRightMM := VarMM;
end;
procedure TPageSizeData.SetPageTopMM(VarMM: Integer);
begin
FPageTopMM := VarMM;
end;
constructor TPageSizeData.Create[red](AOwner: TMyPreviewBox)[/red];
begin
inherited Create;
[red] FMyPreviewBox := AOwner;[/red]
FPageSizeWidthMM := DefaultPageSizeWidthMM;
FPageSizeHeightMM := DefaultPageSizeHeightMM;
FPageLeftMM := DefaultPageLeftMM;
FPageTopMM := DefaultPageTopMM;
FPageRightMM := DefaultPageRightMM;
FPageBottomMM := DefaultPageBottomMM;
FPageType := Scr;
//这个地方能不能这样?
showmessage(GetParentForm(FMyPreviewBox).Caption);
end;
destructor TPageSizeData.Destroy;
begin
inherited;
end;
function TPageSizeData.GetPageValidHeigthMM: integer;
begin
result := FPageSizeHeightMM - FPageTopMM - FPageBottomMM;
end;
function TPageSizeData.GetPageValidWidthMM: integer;
begin
result := FPageSizeWidthMM - FPageLeftMM - FPageRightMM;
end;
{ TCanvasPanel }
constructor TCanvasPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FPageParamMM := Tpagesizedata.Create[red](TMyPreviewBox(AOwner))[/red];
Color := clWhite;
BevelWidth := 2;
Cursor := crIBeam;
ControlStyle := ControlStyle + [csCaptureMouse];
end;
procedure TCanvasPanel.Paint;
var FullWidth, FullHeight, XOffSet, YOffSet: Integer;
Parent: TMyPreviewBox;
begin
Parent := TMyPreviewBox(Self.Parent);
FullWidth := MMToPoint(FPageParamMM.PageSizeWidthMM,0);
FullHeight := MMToPoint(FPageParamMM.PageSizeHeightMM,1);
with Canvas do
begin
Brush.Color := clWhite;
Brush.Style := bsSolid;
FillRect(ClientRect);
SetMapMode(Canvas.Handle, mm_AnIsotropic);
SetWindowExtEx(Canvas.Handle, FullWidth, FullHeight, nil);
SetViewportExtEx(Canvas.Handle, Width, Height, nil);
SetViewportOrgEx(Canvas.Handle, Trunc(MMToPoint(FPageParamMM.PageLeftMM
* Width / FullWidth,0)), Trunc(MMToPoint(FPageParamMM.PageTopMM
* Height / FullHeight,1)), nil);
Font.PixelsPerInch := Screen.PixelsPerInch;
end;
//自画线,怎样使在不同比列显示的线都一样粗?
Canvas.Rectangle(0,0,MMToPoint(FPageParamMM.PageValidWidthMM,0),
MMToPoint(FPageParamMM.PageValidHeigthMM,1));
end;
procedure TCanvasPanel.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.WindowClass.style := Params.WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
end;
{ TPreviewBox }
constructor TMyPreviewBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle - [csAcceptsControls]; //clip_children
FViewMode := vmPageWidth;
pnlShadow := TPanel.Create(Self {AOwner});
with pnlShadow do
begin
ControlStyle := ControlStyle - [csAcceptsControls];
Parent := Self;
BevelOuter := bvNone;
Color := 4210752;
Enabled := False;
TabOrder := 0;
end;
FCanvasPanel := TCanvasPanel.Create(Self {AOwner});
with FCanvasPanel do
begin
ControlStyle := ControlStyle + [csAcceptsControls];
Parent := Self;
BevelOuter := bvNone;
ParentCtl3D := False;
Ctl3D := False;
BorderStyle := bsSingle;
Left := 8;
Top := 8;
end;
FPageParamMM := FCanvasPanel.FPageParamMM;
//<<同一Unit中的话,Delphi比之C++有个很特别的特性，我以前很讨厌，
//<<但后来喜欢了： 同一Unit中的所有类，都可以访问别的类中的所有成员，
//<<包括private
//下面这一行准备使用此特性
FCanvasPanel.PageParam.FMyPreviewBox := self;
HorzScrollBar.Tracking := True;
VertScrollBar.Tracking := True;
FScalePercent := 100;
end;
procedure TMyPreviewBox.CreateParams(var Params: TCreateParams);
const
BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or WS_CLIPCHILDREN or BS_OWNERDRAW;
end;
destructor TMyPreviewBox.Destroy;
begin
if Assigned(FCanvasPanel) then FCanvasPanel.free;
inherited destroy;
end;
procedure TMyPreviewBox.UpdatePageSetup;
var
Scaling: Integer;
ALeft, ATop, AWidth, AHeight: Integer;
begin
try
//with FCanvasPanel, Printer do
with FCanvasPanel do
begin
ALeft := Left; ATop := Top; AWidth := Width; AHeight := Height;
case FViewMode of
vm500: Scaling := 500;
vm200: Scaling := 200;
vm150: Scaling := 150;
vm100: Scaling := 100;
vm75: Scaling := 75;
vm50: Scaling := 50;
vm25: Scaling := 25;
vm10: Scaling := 10;
vmPageWidth:
begin
VertScrollBar.Position := 0;
HorzScrollBar.Position := 0;
Scaling := 1;
ALeft := 8;
ATop := 8;
AWidth := Self.Width - 20 - GetSystemMetrics(sm_CXVScroll);
AHeight := AWidth * FCanvasPanel.PageParam.PageSizeHeightMM div
FCanvasPanel.PageParam.PageSizeWidthMM;
FScalePercent := AWidth * 100 div (MMToPoint(FCanvasPanel.
PageParam.PageSizeWidthMM,0));
VertScrollBar.Range := AHeight + 16;
HorzScrollBar.Range := 0;
end;
vmFullPage:
begin
Scaling := 1;
VertScrollBar.Range := 0;
HorzScrollBar.Range := 0;
VertScrollBar.Position := 0;
HorzScrollBar.Position := 0;
AHeight := Self.ClientHeight - 16;
AWidth := AHeight * FCanvasPanel.PageParam.PageSizeWidthMM div
FCanvasPanel.PageParam.PageSizeHeightMM;
if AWidth > Self.ClientWidth - 16 then
begin
AWidth := Self.ClientWidth - 16;
AHeight := AWidth * FCanvasPanel.PageParam.PageSizeHeightMM div
FCanvasPanel.PageParam.PageSizeWidthMM;
end;
ALeft := (Self.ClientWidth - AWidth) div 2;
ATop := (Self.ClientHeight - AHeight) div 2;
FScalePercent := 100;
end;
else Scaling := 1;
end;
case FViewMode of
vm500..vm10:
begin
VertScrollBar.Position := 0;
HorzScrollBar.Position := 0;
ALeft := 8 + 8 ;
ATop := 8 + 8;
AWidth := Scaling * MMToPoint(FCanvasPanel.PageParam.
PageSizeWidthMM,0) div 100;
AHeight := AWidth * FCanvasPanel.PageParam.PageSizeHeightMM div
FCanvasPanel.PageParam.PageSizeWidthMM;
VertScrollBar.Range := AHeight + 16 +16;
HorzScrollBar.Range := AWidth + 16 +16;
if (AWidth + 16 +16) < Self.ClientWidth then
ALeft := (Self.ClientWidth - AWidth) div 2;
if (AHeight + 16 + 16) < Self.ClientHeight then
ATop := (Self.ClientHeight - AHeight) div 2;
FScalePercent := Scaling;
end;
end;
end;
FCanvasPanel.Invalidate;
FCanvasPanel.SetBounds(ALeft, ATop, AWidth, AHeight);
pnlShadow.SetBounds(FCanvasPanel.Left + 4, FCanvasPanel.Top + 4, FCanvasPanel.Width, FCanvasPanel.Height);
finally
end;
end;
procedure TMyPreviewBox.WMSize(var Message: TWMSize);
begin
inherited;
if (ViewMode in [vmPageWidth, vmFullPage]) or
((FCanvasPanel.Width + 16) < ClientWidth) or
((FCanvasPanel.Height + 16) < ClientHeight) then
UpdatePageSetup;
end;
procedure TMyPreviewBox.SetViewMode(const Value: TViewMode);
begin
if Value <> FViewMode then
begin
FViewMode := Value;
UpdatePageSetup;
end;
end;
function TMyPreviewBox.AddLabel:TLabel;
var
Lb:TLabel;
begin
if not Assigned(Lb) then
begin
Lb := TLabel.Create(FCanvasPanel);
lb.Parent := FCanvasPanel;
end;
Result := lb;
end;
function TMyPreviewBox.GetCanvas:TCanvas;
begin
Result := FCanvasPanel.Canvas;
end;
procedure TMyPreviewBox.SetPageParamMM(VarPageParamMM: TPageSizeData);
begin
if FPageParamMM <> VarPageParamMM then
begin
FPageParamMM := VarPageParamMM;
UpdatePageSetup;
Invalidate;
end;
end;
initialization
end.
