如何实现象Fineprint中那样的进行缩印？(100分)

如题目，请提供解决的方法与思路，最好由原码举例。

?

给你我写的一段程序，希望能对你有所帮助。定位都是用的毫米，输出在OutPutAll中处理
//form define
object FormPreview: TFormPreview
Left = 200
Top = 106
Width = 577
Height = 375
Caption = '打印预览'
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -14
Font.Name = '宋体'
Font.Style = []
OldCreateOrder = False
PrintScale = poPrintToFit
PixelsPerInch = 96
TextHeight = 14
object CoolBar1: TCoolBar
Left = 0
Top = 0
Width = 569
Height = 28
AutoSize = True
BandBorderStyle = bsNone
Bands = <
item
Control = ToolBar1
ImageIndex = -1
MinHeight = 24
Width = 565
end>
object ToolBar1: TToolBar
Left = 9
Top = 0
Width = 552
Height = 24
AutoSize = True
Caption = 'ToolBar1'
EdgeBorders = []
TabOrder = 0
object SpeedButton2: TSpeedButton
Left = 0
Top = 2
Width = 65
Height = 22
Caption = '打印'
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
04000000000000010000120B0000120B00001000000000000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00300000000000
0003377777777777777308888888888888807F33333333333337088888888888
88807FFFFFFFFFFFFFF7000000000000000077777777777777770F8F8F8F8F8F
8F807F333333333333F708F8F8F8F8F8F9F07F333333333337370F8F8F8F8F8F
8F807FFFFFFFFFFFFFF7000000000000000077777777777777773330FFFFFFFF
03333337F3FFFF3F7F333330F0000F0F03333337F77773737F333330FFFFFFFF
03333337F3FF3FFF7F333330F00F000003333337F773777773333330FFFF0FF0
33333337F3F37F3733333330F08F0F0333333337F7337F7333333330FFFF0033
33333337FFFF7733333333300000033333333337777773333333}
NumGlyphs = 2
OnClick = SpeedButton2Click
end
object SpeedButton4: TSpeedButton
Left = 65
Top = 2
Width = 102
Height = 22
Caption = '设置打印机'
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
04000000000000010000120B0000120B00001000000000000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00555550FF0559
1950555FF75F7557F7F757000FF055591903557775F75557F77570FFFF055559
1933575FF57F5557F7FF0F00FF05555919337F775F7F5557F7F700550F055559
193577557F7F55F7577F07550F0555999995755575755F7FFF7F5570F0755011
11155557F755F777777555000755033305555577755F75F77F55555555503335
0555555FF5F75F757F5555005503335505555577FF75F7557F55505050333555
05555757F75F75557F5505000333555505557F777FF755557F55000000355557
07557777777F55557F5555000005555707555577777FF5557F55553000075557
0755557F7777FFF5755555335000005555555577577777555555}
NumGlyphs = 2
OnClick = SpeedButton4Click
end
object SpeedButton1: TSpeedButton
Left = 167
Top = 2
Width = 31
Height = 22
Caption = '预览'
Visible = False
OnClick = SpeedButton1Click
end
object SpeedButton3: TSpeedButton
Left = 198
Top = 2
Width = 89
Height = 22
Caption = '中断打印'
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
04000000000000010000130B0000130B00001000000000000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
3333333333FFFFF3333333333999993333333333F77777FFF333333999999999
33333337777FF377FF3333993370739993333377FF373F377FF3399993000339
993337777F777F3377F3393999707333993337F77737333337FF993399933333
399377F3777FF333377F993339903333399377F33737FF33377F993333707333
399377F333377FF3377F993333101933399377F333777FFF377F993333000993
399377FF3377737FF7733993330009993933373FF3777377F7F3399933000399
99333773FF777F777733339993707339933333773FF7FFF77333333999999999
3333333777333777333333333999993333333333377777333333}
NumGlyphs = 2
OnClick = SpeedButton3Click
end
object RzComboBox1: TRzComboBox
Left = 287
Top = 2
Width = 106
Height = 22
Style = csDropDownList
ItemHeight = 14
TabOrder = 0
OnChange = ViewBoxPaint
Items.Strings = (
'200%'
'150%'
'100%'
'75%'
'50%'
'25%'
'10%')
end
object SpeedButton5: TSpeedButton
Left = 393
Top = 2
Width = 88
Height = 22
Caption = '设置顶部空白'
end
object BitBtn1: TBitBtn
Left = 481
Top = 2
Width = 75
Height = 22
Caption = '退出'
TabOrder = 1
Kind = bkClose
end
end
end
object RzStatusBar1: TRzStatusBar
Left = 0
Top = 329
Width = 569
Height = 19
AutoStyle = False
BorderInner = fsNone
BorderOuter = fsNone
BorderSides = [sdLeft, sdTop, sdRight, sdBottom]
BorderWidth = 0
FrameSides = []
TabOrder = 1
end
object ScrollBox1: TScrollBox
Left = 0
Top = 28
Width = 569
Height = 301
Align = alClient
Color = clWhite
ParentColor = False
TabOrder = 2
object ViewPanel: TRzPanel
Left = 12
Top = 12
Width = 361
Height = 145
BorderOuter = fsNone
Color = clWhite
TabOrder = 0
object ViewPanel2: TRzPanel
Left = 60
Top = 24
Width = 185
Height = 41
BorderOuter = fsNone
BorderHighlight = clActiveBorder
Color = clWhite
FrameSides = [sdLeft, sdTop, sdRight, sdBottom]
TabOrder = 0
object ViewBox: TPaintBox
Left = 2
Top = 2
Width = 181
Height = 37
OnPaint = ViewBoxPaint
end
end
end
end
object PrinterSetupDialog1: TPrinterSetupDialog
Left = 243
Top = 54
end
object PrintDialog1: TPrintDialog
Left = 187
Top = 94
end
end



//pas file
unit Preview;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, IniFiles ,
StdCtrls, RzCmboBx, ComCtrls, ToolWin, ExtCtrls, RzPanel, Buttons ,Printers;

type
TTextControlCode = record
Font:String;
OutText:String;
Position:TPoint;
FontSize:TPoint;
end;

TFormPreview = class(TForm)
CoolBar1: TCoolBar;
ToolBar1: TToolBar;
RzComboBox1: TRzComboBox;
RzStatusBar1: TRzStatusBar;
ScrollBox1: TScrollBox;
PrinterSetupDialog1: TPrinterSetupDialog;
PrintDialog1: TPrintDialog;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
ViewPanel: TRzPanel;
ViewPanel2: TRzPanel;
ViewBox: TPaintBox;
BitBtn1: TBitBtn;
SpeedButton5: TSpeedButton;
procedure SetOutType(oType:integer);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
procedure ViewBoxPaint(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure GetOutDeviceCaps(uDevice :Thandle);
function PixelToDec(Pixels:TPoint):TPoint;
//点到丝米转换
function DecToPixel(Pixels:TPoint):TPoint;
//丝米到点转换
function PrintSingleLine(Texts:TTextControlCode):boolean;
procedure OutPutAll;
procedure GetPageSize;
procedure SetScale(s:String);
function CalcScale(tTexts:TTextControlCode):TTextControlCode;
procedure SpeedButton3Click(Sender: TObject);
private
{ Private declarations }

public
{ Public declarations }
end;

Const
IniFileName = 'htPrint.ini';
var FormPreview: TFormPreview;
OutDevice:TCanvas;
OutDeviceCaps:TPoint;
OutType :integer;
OutDeviceSize:TPoint;
nScale:Integer;
opTitle : String;
SpaceOnTop : Integer;
implementation


{$R *.DFM}

procedure TFormPreview.SetOutType(oType:integer);
begin

OutType := oType;
if oType = 0 then

OutDevice := ViewBox.Canvas
else
begin

// Printer.begin
Doc;
OutDevice := Printer.Canvas;
// Printer.EndDoc;
end;

end;


procedure TFormPreview.GetOutDeviceCaps(uDevice :Thandle);
begin

OutDeviceCaps.X := GetDeviceCaps(uDevice,LOGPIXELSX);
OutDeviceCaps.Y := GetDeviceCaps(uDevice,LOGPIXELSY);
end;


function TFormPreview.PixelToDec(Pixels:TPoint):TPoint;
//点到丝米转换
var tmpPoints:TPoint;
begin

tmpPoints.x := round ( OutDeviceCaps.X /254 * Pixels.X );
tmpPoints.y := round ( OutDeviceCaps.Y /254 * Pixels.Y) ;
result := tmpPoints;
end;


function TFormPreview.DecToPixel(Pixels:TPoint):TPoint;
//丝米到点转换
var tmpPoints:TPoint;
begin

tmpPoints.x := round ( Pixels.X /254 * OutDeviceCaps.X );
tmpPoints.Y := round ( Pixels.Y /254 * OutDeviceCaps.Y );
result := tmpPoints;
end;


function TFormPreview.PrintSingleLine(Texts:TTextControlCode):boolean;
var
LogFont: TLogFont;
MyFont, OldFont: HFONT;
tmpPoint:TPoint;
begin

Texts := CalcScale(Texts);
with LogFontdo

try
tmpPoint:=DecToPixel ( Texts.FontSize);
lfHeight := tmpPoint.Y;
lfWidth := tmpPoint.x div 2;
lfEscapement := 0;
lfOrientation := 0;
lfWeight := FW_NORMAL;
lfItalic := 0;
lfUnderline := 0;
lfStrikeOut := 0;
lfCharSet := GB2312_CHARSET;
lfOutPrecision := OUT_DEFAULT_PRECIS ;
lfClipPrecision := CLIP_DEFAULT_PRECIS;
lfQuality := DEFAULT_QUALITY;
lfPitchAndFamily := FIXED_PITCH;
StrPCopy(@lfFaceName,Texts.Font);
finally
MyFont := CreateFontIndirect(LogFont);
with OutDevicedo

begin

OldFont := SelectObject(Handle, MyFont);
tmpPoint:=DecToPixel ( Texts.Position);
TextOut ( TmpPoint.X , TmpPoint.Y , Texts.OutText);
SelectObject(Handle, OldFont);
DeleteObject(MyFont);
end;

result := True;
end;

end;


procedure TFormPreview.OutPutAll;
var Text:TTextControlCode;
n,m:integer;
begin

for m:=0 to 3do
begin

if OutType <>0 then
begin

Printer.Title := opTitle;
Printer.begin
Doc;
end;

text.OutText:='----------------------------';
text.FontSize.x := 100;
text.FontSize.y := 100;
for n:=0 to 12do
begin

Text.Position.x :=100;
Text.Position.y :=100*n;
printSingleLine(text);
end;

if OutType <> 0 then
Printer.EndDoc;
end;

end;


procedure TFormPreview.GetPageSize;
var tmpHandle:THandle;
tmpPoint:TPoint;
begin

tmpHandle := Printer.Handle;
tmpPoint.x:= GetDeviceCaps ( tmpHandle,HORZSIZE)*10;
tmpPoint.Y:= GetDeviceCaps ( tmpHandle,VERTSIZE)*10;
OutDeviceSize:= DecToPixel(tmpPoint);
end;


procedure TFormPreview.SpeedButton1Click(Sender: TObject);
begin

SetOutType(0);
if OutType =0 then

GetOutDeviceCaps(ViewBox.Canvas.Handle) else

GetOutDeviceCaps(Printer.Handle);
GetPageSize;
ViewPanel.Width := round ( OutDevicesize.x *nScale / 100 )+20;
ViewPanel.Height :=round ( OutDevicesize.y *nScale / 100 ) +20;
ViewPanel2.Width :=round ( OutDevicesize.x *nScale / 100 )+4;
ViewPanel2.Height :=round ( OutDevicesize.y *nScale / 100 )+4;
ViewBox.Width := round ( OutDevicesize.x *nScale / 100 );
ViewBox.Height := round ( OutDevicesize.y *nScale / 100 );
OutPutAll;
end;


procedure TFormPreview.SpeedButton4Click(Sender: TObject);
begin

if PrinterSetupDialog1.Execute then
begin

SpeedButton1Click(Sender);
end;

end;


procedure TFormPreview.ViewBoxPaint(Sender: TObject);
var r:Trect;
begin

r.Top :=0;
r.Left := 0;
r.Right := ViewBox.Width;
r.Bottom := ViewBox.Height;
ViewBox.Canvas.FillRect(r);
SetScale(RzComboBox1.Text);
SpeedButton1Click(Sender);
end;


procedure TFormPreview.SetScale(s:String);
var n:integer;
begin

if s='' then
nScale := 100 else
begin

n:=Pos('%',s);
s := Copy (s,1,n-1);
nScale := StrToInt(s);
end;

end;



function TFormPreview.CalcScale(tTexts:TTextControlCode):TTextControlCode;
begin

if OutType <>0 then
tTexts.Position.Y := tTexts.Position.Y - SpaceOnTop
else
begin

tTexts.Position.x := round ( tTexts.Position.x /100 *nScale);
tTexts.Position.Y := round ( tTexts.Position.Y /100 *nScale);
tTexts.FontSize.x := round ( tTexts.FontSize.x /100 *nScale);
tTexts.FontSize.Y := round ( tTexts.FontSize.Y /100 *nScale);
end;

result := tTexts;
end;


procedure TFormPreview.SpeedButton2Click(Sender: TObject);
begin

SetOutType(1);
GetOutDeviceCaps(Printer.Handle);
GetPageSize;
OutPutAll;

end;


procedure TFormPreview.SpeedButton3Click(Sender: TObject);
begin

if Printer.Printing then
Printer.Abort;
end;


end.

谢谢你I
前段时间由于登录不上大富翁，没有得看。
程序很长，先让我看看。

接受答案了.