frmprint.pas

delphi语言开发的矢量图形处理对象

unit frmPrint;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ImgList, ComCtrls, ToolWin,printers, StdCtrls;

type
  Tfrm_PrintObj = class(TForm)
    ImageList1: TImageList;
    Panel1: TPanel;
    ScrollBox1: TScrollBox;
    drwPaint: TPaintBox;
    Panel2: TPanel;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ComboBox1: TComboBox;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    Shape1: TShape;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure drwPaintPaint(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure ComboBox1Click(Sender: TObject);
    procedure ToolButton7Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
  private
    { Private declarations }
    iCanvasWidth,iCanvasHeigh:integer;
    tsDrawObj:TList;
    curBackColor:TColor;
    curZoomScale:single;
    procedure setObjList(obj_List:TList);
    procedure drawBack(drwCanvas:TCanvas);
    procedure drawObjs(drwCanvas:TCanvas);
    procedure drawMap;//画整个图形
    procedure setZoomScale(value:single);
    procedure ResetObjZoomScale;
    procedure PrintMap;
  public
    { Public declarations }
    procedure MoveCenter;//设置纸张居中
    procedure setPaperA4;
    property ObjList:TList write setObjList;
    property BackColor:TColor write curBackColor;
    property ZoomScale:single write setZoomScale;
  end;

var
  frm_PrintObj: Tfrm_PrintObj;

implementation
uses
   drwObj,drwBaseType;
{$R *.dfm}
//毫米单位转换为英寸单位
function MmToInch(Length: Extended): Extended;
begin
  Result := Length/25.4;
end;

//英寸单位转换为毫米单位
function InchToMm(Length: Extended): Extended;
begin
  Result := Length*25.4;
end;

//取得水平方向每英寸打印机的点数
function HPointsPerInch: Integer;
begin
  Result := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
end;

//取得纵向方向每英寸打印机的光栅数
function VPointsPerInch: Integer;
begin
  Result := GetDeviceCaps(Printer.Handle, LOGPIXELSY)
end;

//横向点单位转换为毫米单位
function XPointToMm(Pos: Integer): Extended;
begin
  Result := Pos*25.4/HPointsPerInch;
end;

//纵向点单位转换为毫米单位
function YPointToMm(Pos: Integer): Extended;
begin
  Result := Pos*25.4/VPointsPerInch;
end;

{ Tfrm_PrintObj }


procedure Tfrm_PrintObj.drawBack(drwCanvas: TCanvas);
var
  oldBrushColor:TColor;
  oldBrushStyle:TBrushStyle;
  t:TRect;
begin
  oldBrushColor:=drwCanvas.Brush.Color;
  oldBrushStyle:=drwCanvas.Brush.Style;
  drwCanvas.Brush.Color :=curBackColor;
  drwCanvas.Brush.Style :=bsSolid;
  t:=Rect(0,0,trunc(iCanvasWidth*curZoomScale),trunc(iCanvasHeigh*curZoomScale));
  drwCanvas.FillRect(t);
  drwCanvas.Brush.Style :=oldBrushStyle;
  drwCanvas.Brush.Color :=oldBrushColor;
end;

procedure Tfrm_PrintObj.MoveCenter;
var
  iLeft:integer;
begin
  if curZoomScale<=1.0 then
    iLeft:=(scrollBox1.Width-drwPaint.Width-8 ) div 2
  else
    iLeft:=8;
  drwPaint.Left :=iLeft;
  shape1.SetBounds(iLeft-1,drwPaint.Top -1,trunc(iCanvasWidth*curZoomScale)+3
  ,trunc(iCanvasHeigh*curZoomScale)+3);
end;

procedure Tfrm_PrintObj.setPaperA4;
Const
   W=210;
   H=297;
var
  iWidth,iHeigh:integer;
begin
  iWidth:=trunc(PixelsPerInch*MmToInch(W));
  iHeigh:=trunc(PixelsPerInch*MmToInch(H));
  iCanvasWidth:=iWidth;
  iCanvasHeigh:=iHeigh;
end;

procedure Tfrm_PrintObj.FormCreate(Sender: TObject);
begin
  tsDrawObj:=TList.Create;
  curZoomScale:=1.0;
end;

procedure Tfrm_PrintObj.FormDestroy(Sender: TObject);
begin
  tsDrawObj.Free;
end;

procedure Tfrm_PrintObj.drawObjs(drwCanvas: TCanvas);
var
  i:integer;
  drw_Ref:Pointer;
begin
  if tsDrawObj.Count =0 then
  exit;
  for i:=0 to tsDrawObj.Count -1 do
  begin
     drw_Ref:=tsDrawObj.Items[i];
     TDrawObject(drw_ref).Draw(drwCanvas);
  end;
end;

procedure Tfrm_PrintObj.drawMap;
begin
//  drwPaint.Width :=iCanvasWidth;
//  drwPaint.Height :=iCanvasHeigh;
  drawBack(drwPaint.Canvas);
  drawObjs(drwPaint.Canvas);
end;

procedure Tfrm_PrintObj.drwPaintPaint(Sender: TObject);
begin
  drawMap;
end;

procedure Tfrm_PrintObj.setObjList(obj_List: TList);
begin
  if obj_list=nil then
  exit;
  tsDrawObj.Assign(obj_List);
end;

//重新设置图元的放缩比列
procedure Tfrm_PrintObj.ResetObjZoomScale;
var
  i:integer;
begin
  for i:=0 to tsDrawObj.Count-1 do
  TDrawObject(tsDrawObj.Items[i]).ZoomScale:=curZoomScale;
  drwPaint.Width :=trunc(iCanvasWidth*curZoomScale);
  drwPaint.Height :=trunc(iCanvasHeigh*curZoomScale);
  moveCenter;
end;

procedure Tfrm_PrintObj.setZoomScale(value: single);
begin
  if value=curZoomScale then exit;
  curZoomScale:=value;
  ResetObjZoomScale;//重新设置图元的放缩比列
end;

procedure Tfrm_PrintObj.ToolButton4Click(Sender: TObject);
begin
  curZoomScale:=curZoomScale+0.2;
  ResetObjZoomScale;//重新设置图元的放缩比列
  drawMap;
end;

procedure Tfrm_PrintObj.ToolButton5Click(Sender: TObject);
begin
  curZoomScale:=curZoomScale-0.2;
  ResetObjZoomScale;//重新设置图元的放缩比列
  drawMap;
end;

procedure Tfrm_PrintObj.ComboBox1Click(Sender: TObject);
begin
  if comboBox1.ItemIndex <0 then
  exit;
  case comboBox1.ItemIndex of
    0:curZoomScale:=0.5;
    1:curZoomScale:=0.75;
    2:curZoomScale:=1.0;
    3:curZoomScale:=1.2;
    4:curZoomScale:=1.5;
  end;
  ResetObjZoomScale;
  drawMap;
end;

procedure Tfrm_PrintObj.ToolButton7Click(Sender: TObject);
begin
  Close;
end;

procedure Tfrm_PrintObj.FormShow(Sender: TObject);
begin
  ResetObjZoomScale;
  onShow:=nil;
end;

procedure Tfrm_PrintObj.PrintMap;
var
  i:integer;
begin
  for i:=0 to tsDrawObj.Count-1 do
  TDrawObject(tsDrawObj.Items[i]).ZoomScale:=1;
  printer.BeginDoc;
  drawBack(printer.Canvas);
  drawObjs(printer.Canvas);
  printer.EndDoc;
  for i:=0 to tsDrawObj.Count-1 do
  TDrawObject(tsDrawObj.Items[i]).ZoomScale:=curZoomScale;  
end;

procedure Tfrm_PrintObj.ToolButton1Click(Sender: TObject);
begin
  PrintMap;
end;

end.