急！编的一个VCL控件，在设置字体出现错误（Can Not Assign a Nil To a TFOnt）？代码如下 (50分)

unit Rep;

interface

Uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, Math,Printers,DB,FileCtrl,extctrls;

Const
ConvFac=2.54;
Type

TZoomOption = (zoFitToPage, zoFitToWidth, zoCustom);
TPageCustom=(DefaultSize,CustomSize);

TReportControl=Class;

{标注}
TLbl=Class(TCollectionItem)
Private
FLabCap : String;
FLabel : String;
FLogFont : TLogFont;
FLeft : Double;
FTop : Double;
FCapRect : TRect;
FFont : TFont;
Function GetRControl: TReportControl;
Protected
Procedure SetLabCap(NewCap : String);
Procedure SetLogFont(NewFont : TLogFont);
Procedure SetFont(NewFont : TFont);
Function GetFont: TFont;
Procedure SetLeft(NewLeft : Double);
Procedure SetTop(NewTop : Double);

Public
Function DefaultFont: TFont;
procedure Assign(Source: TPersistent);
//Procedure PaintLBl(hpaintDC : HDC );
Procedure PaintLBl(Canvas : TCanvas );
Procedure CalcLblRect;
Function GetOwner : Tpersistent ; OverRide;
//Constructor Create;
Constructor Create(Collection: TCollection);
Destructor Destroy;Override;
Published
Property LabCap : String Read FLabCap Write SetLabCap;
Property LogFont : TLogFont Read FLogFont Write SetLogFont;
Property Font : TFont Read FFONT Write SetFont Stored TRue;(出现错误)
Property Left : Double Read FLeft Write SetLeft;
Property Top : Double Read FTop Write SetTop;
Property CapRect : TRect Read FCapRect;
End;

TLbls=Class(TCollection)
Private
FRControl : TReportControl;
Function GetItem( Index : Integer) : TLBL;
Procedure SetITem(Index : Integer;Value : TLBL);
Protected
Procedure Update(Item : TCollectionItem );OverRide;
Public

Constructor Create ( RControl : TReportControl);
Function Add : TLbl;
Function GetOwner : Tpersistent ; OverRide;
Property ITems[Item : Integer] : TLBL Read GetItem Write SetITem;Default;
End;
{TReportcontrol}
TReportControl=Class(TScrollingWinControl)
Private
FBorderStyle: TBorderStyle;
//组件所需的设置
FContainPanel:TPanel;
FPagePanel : TPanel;
FPB : TPaintBox;
//标注
FLBL : TLBLs;
//页面属性
FPageCustom : TpageCustom;
FPageLenght : Double;
FPageWidth : Double;
FOrient : TPrinterOrientation; //打印方向
FPrinting : boolean;
//页边距
FLeftMargin : Double;
FRightMargin : Double;
FTopMargin : Double;
FBottomMargin : Double;
//打印标题
FTitle : string;
//存放页面
MFList : TList;
//有关TCanVas设置
CurCanvas : TCanvas;
ppix, ppiy : integer;
sizex,sizey : integer;
offx, offy : integer;
UsedPage : boolean;
//预览设置
FZoomOpt : TZoomOption;
FZoomVal : integer;
//当前面
FCurrentPage : Integer;
FCurPage : integer;

Function GetCanvas: TCanvas;
Function GetPageNum: integer;
Procedure FreeMetaFiles;
Function GetMetaFile(i: integer): TMetaFile;
Function GetLastAvailPage: integer;
Procedure InitPrinterVars(hdc: THandle);
// procedure Loaded; override;
Procedure SetPrintPage;//设置打印机
Procedure SetPageCustom(FPCustom : TPageCustom);//后加

procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure WMNCHitTest(var Message: TMessage); message WM_NCHITTEST;
procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
Protected

procedure CreateParams(var Params: TCreateParams); override;
Public
procedure Resize; override;
Constructor Create(AOwner: TComponent);override;
Destructor destroy ; override;

Procedure SetBorderStyle(Value: TBorderStyle);

Function UnitToX(x: double): integer;
Function UnitToY(y: double): integer;
function XToUnit(x: integer): double;
function YToUnit(y: integer): double;
procedure FixFont(Font: TFont);
procedure RestoreFont(Font: TFont; PPI: integer);
procedure BeginDoc;
procedure NewPage;
procedure EndDoc;
procedure Print;
function PrintDialog: boolean;
function PrintRange(StartPage, StopPage: integer): boolean;

procedure SetCurPage(Val: integer);

procedure DrawMetaFile(PB: TPaintBox; mf: TMetaFile);
procedure PBPaint(Sender: TObject);

procedure DrawTable();

property MetaFiles[i: integer]: TMetaFile read GetMetaFile;
property PixelsPerInchX: integer read ppix;
property PixelsPerInchY: integer read ppiy;
property PageWidth: integer read sizex;
property PageHeight: integer read sizey;
property OffsetX: integer read offx;
property OffsetY: integer read offy;
property LastAvailPage: integer read GetLastAvailPage;
property Canvas: TCanvas read GetCanvas;
property PageNumber: integer read GetPageNum;
property Printing: boolean read FPrinting;

property CurPage: integer read FCurPage write SetCurPage; //当前页

published

// property MarginLeft: double read FMarginLeft write FLeftMargin;
// property MarginTop: double read FMarginTop write FMarginTop;
// property MarginRight: double read FMarginRight write FMarginRight;
// property MarginBottom: double read FMarginBottom write FMarginBottom;

Property Font;
Property Color;
property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
property Align;
property AutoScroll;
Property LabCap : TLbls Read FLBL Write FLBL;


property Orientation: TPrinterOrientation read FOrient write FOrient;
property Title: string read FTitle write FTitle;
property ZoomOption: TZoomOption read FZoomOpt write FZoomOpt;
property ZoomVal: integer read FZoomVal write FZoomVal;

property PageCustom : TPageCustom Read FPageCustom Write FPageCustom; //自定义页面大小
property PageLenghtS : Double Read FPageLenght Write FPageLenght; //页的高度
property PageWidthS : Double Read FPageWidth Write FPageWidth; //页的宽度

End;

Procedure Register;

implementation

// TBenMetaFileCanvas
type
TBenMetaFileCanvas = class(TMetaFileCanvas)
protected
OldFontChanged : TNotifyEvent;
procedure NewFontChanged(Sender: TObject);
public
PPI : integer;
constructor Create(AMetafile: TMetafile; ReferenceDevice: HDC);
end;

Constructor TBenMetaFileCanvas.Create(AMetafile: TMetafile; ReferenceDevice: HDC);
Begin
inherited;
OldFontChanged := Font.OnChange;
Font.OnChange := NewFontChanged;
End;

Procedure TBenMetaFileCanvas.NewFontChanged(Sender: TObject);
Begin
If Assigned(OldFontChanged) then OldFontChanged(Sender);
End;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{注册组件}
Procedure Register;
Begin
RegisterComponents('报表',[TReportControl]);
End;

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
{TLabCap}
Procedure TLbl.SetLabCap(NewCap : String);
Begin
IF Newcap=FLabCap Then Exit;
FLabel := NewCap;
FLabCap:= Newcap;
CalcLblRect;
End;

Procedure TLbl.SetLogFont(NewFont : TLogFont);
Begin
FLogFont := NewFont;
CalcLblRect;
End;

Procedure TLbl.SetFont(NewFont : TFont);
Begin
FFont.Assign(NewFont);
End;

Procedure TLbl.SetLeft(NewLeft : Double);
Begin
IF NewLeft=FLeft Then Exit;
FLeft := NewLeft;
CalcLblRect;
End;

Procedure TLbl.SetTop(NewTop : Double);
Begin
IF NewTop=FTop Then Exit;
FTop := NewTop;
CalcLblRect;
End;


//Procedure TLbl.PaintLBl(hpaintDC : HDC );
Procedure TLbl.PaintLBl(Canvas : TCanvas );
Var
SaveDCIndex : Integer;
Format : UINT;
hTextFont,hPrevFont : HFONT;
TempRect : TRect;
Begin
IF Length(FLabel)>0 Then
Begin
{ShowMessage(FLabel);
SaveDCIndex := SaveDC(hpaintDC);
Format := DT_EditControl Or DT_WordBreak Or DT_Left;
hTextFont := CreateFontIndirect(FLogFont);
HPrevFont := SelectObject(hPaintDc,hTextFont);
TempRect := FCapRect;
DrawText(hPaintDc,Pchar(FLabel),Length(FLabel),TempRect,format);
SelectObject(hPaintDc,hPrevFont);
DeleteObject(hTextFont);
RestoreDc(hPaintDc,SaveDCIndex);
// Format := DT_EditControl Or DT_WordBreak Or DT_Left; }
Canvas.Font:=FFont;
DrawText(Canvas.Handle,Pchar(FLabel),Length(FLabel),TempRect,format)
End;
End;

Procedure TLbl.CalcLblRect;
Var
hTempFont,hPrevFont : HFont;
hTempDc : HDC;
TempString : String;
TempRect : TRect;
Format : UINT;
TempLeft,TempTop : Integer;
LRControl: TReportControl;
Begin
IF Length(FLabel)>0 Then
Begin
ShowMessage(FloatToStr(Left));
LRControl := GetRControl;
IF LRControl=Nil Then Exit;
TempLeft:=LRControl.UnitToX(Left);
TempTop :=LRControl.UnitToY(Top);

hTempFont := CreateFontIndirect(FlogFOnt);
TempString:= FLabel;
hTempDc := GetDc(0);
hPrevFont :=SelectObject(hTempDc,htempFont);
SetRect(TempRect,0,0,0,0);
TempRect.Left:=TempLeft;
TempRect.Top :=TempTop;

TempRect.Bottom:=65535;
TempRect.Right:=65535;
Format:=DT_EditControl Or DT_WordBreak Or DT_Left Or DT_CALCRECT;
DrawText(hTempDc,PChar(TempString),Length(TempString),TempRect,Format);
FCapRect := TempRect;
SelectObject(hTempDc,hPrevFont);
DeleteObject(hTempFont);
End;
End;

Constructor TLbl.Create(Collection: TCollection);
Var
hTempDC: HDC;
pt, ptOrg: TPoint;
Begin

inherited Create(Collection);
ShowMessage('a');
FLabCap :='';
FLeft :=1;
FTop :=1;

// font
FLogFont.lfHeight := 120;
FLogFont.lfWidth := 0;
FLogFont.lfEscapement := 0;
FLogFont.lfOrientation := 0;
FLogFont.lfWeight := 0;
FLogFont.lfItalic := 0;
FLogFont.lfUnderline := 0;
FLogFont.lfStrikeOut := 0;
FLogFont.lfCharSet := DEFAULT_CHARSET;
FLogFont.lfOutPrecision := 0;
FLogFont.lfClipPrecision := 0;
FLogFont.lfQuality := 0;
FLogFont.lfPitchAndFamily := 0;
FLogFont.lfFaceName := '宋体';

hTempDC := GetDC(0);


pt.y := GetDeviceCaps(hTempDC, LOGPIXELSY) * FLogFont.lfHeight;
pt.y := trunc(pt.y / 720 + 0.5); // 72 points/inch, 10 decipoints/point
DPtoLP(hTempDC, pt, 1);
ptOrg.x := 0;
ptOrg.y := 0;
DPtoLP(hTempDC, ptOrg, 1);
FLogFont.lfHeight := -abs(pt.y - ptOrg.y);
ReleaseDC(0, hTempDC);

FFont := TFont.Create;
{FFont.Name:='宋体';
FFont.Size:=9;
FFOnt.Style:=[];}
FFOnt.Assign(Self.Font);

FCapRect.Left:=0;
FCapRect.Top:=0;
FCapRect.Right:=10;
FCapRect.Bottom:=10;

End;

Destructor TLbl.Destroy;
Begin
inherited Destroy;
End;

Function TLbl.GetOwner : Tpersistent ;
Begin
Result := (Collection As TLbls).FRControl;
End;

Function TLbl.GetFont: TFont;
Var
Save: TNotifyEvent;
Begin
IF (FFont.Handle <> DefaultFont.Handle) then
Begin
ShowMessage('a');
Save := FFont.OnChange;
FFont.OnChange := nil;
FFont.Assign(DefaultFont);
FFont.OnChange := Save;
End;
Result := FFont;
End;

Function TLbl.DefaultFont: TFont;
Var
LRControl: TReportControl;
Begin
LRControl := GetRControl;
if Assigned(LRControl)
then Result := LRControl.Font
else Result := FFont;
End;

Function TLbl.GetRControl: TReportControl;
Begin
if {Assigned(Collection) and} (Collection is TLBLS)
then Result := (Collection As TLBLS).FRControl
else Result := nil;
End;

procedure TLbl.Assign(Source: TPersistent);
begin
if Source is TLBL then
begin
if Assigned(Collection) then Collection.BeginUpdate;
try
Font := TLbl(Source).Font;

finally
if Assigned(Collection) then Collection.EndUpdate;
end;
end else
inherited Assign(Source);
end;



{TBLS}
Function TLbls.Add : TLbl;
Begin
Result := TLbl(Inherited Add);
End;

Function TLbls.GetItem( Index : Integer) : TLBL;
Begin
Result := TLbl(Inherited GetItem(Index));
End;
Procedure TLbls.SetITem(Index : Integer;Value : TLBL);
Begin
Inherited SetItem(Index,Value);
End;

Constructor TLbls.Create ( RControl : TReportControl);
Begin
Inherited Create (TLBL);
FRControl :=RControl;
End;
Procedure TLbls.Update(Item : TCollectionItem );
BEgin
IF Item<>Nil Then FRControl.Invalidate;
End;

Function TLbls.GetOwner : Tpersistent ;
Begin
Result := FRControl;
End;


///////////////////////////////////////////////////////////////

{TreportControl}

Procedure TReportControl.SetBorderStyle(Value: TBorderStyle);
Begin
if Value <> FBorderStyle then
begin
FBorderStyle := Value;
RecreateWnd;
end;
End;

procedure TReportControl.CreateParams(var Params: TCreateParams);
const
BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
begin
inherited CreateParams(Params);
with Params do
begin
Style := Style or BorderStyles[FBorderStyle];
if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
begin
Style := Style and not WS_BORDER;
ExStyle := ExStyle or WS_EX_CLIENTEDGE;
end;
end;
end;

Procedure TReportControl.WMNCHitTest(var Message: TMessage);
Begin
DefaultHandler(Message);
End;

Procedure TReportControl.CMCtl3DChanged(var Message: TMessage);
Begin
if NewStyleControls and (FBorderStyle = bsSingle) then RecreateWnd;
inherited;
End;

procedure TReportControl.WMSize(var Message: TWMSize);
Begin
inherited;
IF not (csDesigning in ComponentState) then
Begin
// ScrollBoxResize(Nil)
End
Else
Begin
FContainPanel.Width:=ClientWidth;
FContainPanel.Height:=ClientHeight;

FPagePanel.Left:=(FContainPanel.Width-FPagePanel.Width) Div 2;
FPagePanel.Top:=(FContainPanel.Height-FPagePanel.Height) Div 2;
End;
End;
// Sender: TObject

Procedure TReportControl.Resize();
const
BORD = 20;
Var
tmp : integer;
TotWid : integer;
Z : Double;
Begin
IF (csDesigning in ComponentState) then Exit;
IF (ZoomOption =zoCustom) And (Z=0) Then ZoomOption:=zoFitToPage;
Case ZoomOption of
zoFitToPage : z := ((ClientHeight - BORD) / Screen.PixelsPerInch) /
(PageHeight / PixelsPerInchY);
zoFitToWidth : z := ((ClientWidth - BORD) / Screen.PixelsPerInch) /
(PageWidth / PixelsPerInchX);
Else
z := ZoomVal /100;
End;
FPagePanel.Height := TRUNC(Screen.PixelsPerInch * z * PageHeight / PixelsPerInchY);
FPagePanel.Width := TRUNC(Screen.PixelsPerInch * z * PageWidth / PixelsPerInchX);

TotWid := FPagePanel.Width + BORD;
tmp := FPagePanel.Height + BORD;
if tmp < ClientHeight then tmp := ClientHeight-1;
FContainPanel.Height := tmp;

tmp := TotWid;
if tmp < ClientWidth then tmp := ClientWidth-1;
FContainPanel.Width := tmp;

if FPagePanel.Height + BORD < Height then begin
FPagePanel.Top := FContainPanel.Height div 2 - FPagePanel.Height div 2;
end else begin
FPagePanel.Top := BORD div 2;
end;

if TotWid < Width then begin
FPagePanel.Left := FContainPanel.Width div 2 - (TotWid - BORD) div 2;
end else begin
FPagePanel.Left := BORD div 2;
end;

end;


Constructor TReportControl.Create(AOwner: TComponent);
Begin
Inherited Create(AOwner);

FLBL := TLBLs.Create(Self);

Width := 185;
Height := 41;

FContainPanel:=TPanel.Create(Self);
FContainPanel.BevelInner:=BvNone;
FContainPanel.BevelOuter:=bvNone;
FContainPanel.Parent := Self;
FContainPanel.Color :=ClGray;
FContainPanel.Left:=0;
FContainPanel.Top:=0;

FPagePanel:=TPanel.Create(Self);
FpagePanel.BevelInner:=BvNone;
FPagePanel.BevelOuter:=bvNone;
FpagePanel.Parent := FContainPanel;
FPagePanel.Color:=Clwindow;
FPagePanel.Height:=289;
FPagePanel.Width:=225;
FBorderStyle:=bsSingle;
FPagePanel.Visible:=True;
FPagePanel.BorderStyle:=bsSingle;

FPB :=TPaintBox.Create(Self);
FPB.Parent := FpagePanel;
FPB.Align := alClient;
FPB.Visible:=True;
FPB.OnPaint:=PBPaint;

FPrinting := False;
FOrient := poPortrait;
CurCanvas := nil;
MFList := TList.Create;
FZoomOpt := zoFitToPage;
FZoomVal := 100;

ControlStyle := ControlStyle+[csdesigninteractive];

InitPrinterVars(Printer.Handle);

End;

Destructor TReportControl.destroy ;
Begin
FPagePanel :=Nil;
FPB :=Nil;

FreeMetaFiles;
MFList.Free;
Printer.PrinterIndex:=-1;
Printer.PrinterIndex:=Printer.PrinterIndex;;

FLBL.Free;
FLBL:=Nil;

Inherited Destroy;
End;

//打印设置

{procedure TReportControl.Loaded;
Begin
inherited;
End; }

procedure TReportControl.FreeMetaFiles;
Var
i : integer;
Begin
IF MFList<>Nil Then
IF MFList.Count>0 Then
for i := 0 to MFList.Count-1 do
MetaFiles.Free;
IF MFList.Count>0 Then MFList.Clear;

CurCanvas.Free;
CurCanvas := nil;
End;

Function TReportControl.GetMetaFile(i: integer): TMetaFile;
Begin
Result := MFList;
End;


Procedure TReportControl.BeginDoc;
Begin

FPrinting := True;
FreeMetaFiles;
NewPage;

End;

Procedure TReportControl.InitPrinterVars(hdc: THandle);
Begin
ppix := GetDeviceCaps(hdc, LOGPIXELSX);
ppiy := GetDeviceCaps(hdc, LOGPIXELSY);

Sizex := GetDeviceCaps(hdc, PHYSICALWIDTH);
Sizey := GetDeviceCaps(hdc, PHYSICALHEIGHT);

IF sizex = 0 then
begin
sizex := Round(8.5 * Screen.PixelsPerInch);
sizey := Round(11 * Screen.PixelsPerInch);
End;

offx := GetDeviceCaps(hdc, PHYSICALOFFSETX);
offy := GetDeviceCaps(hdc, PHYSICALOFFSETY);
End;

Procedure TReportControl.NewPage;
Var
MetaFile : TMetaFile;
NewCanvas : TCanvas;
UseScreen : boolean;
Begin
Assert(FPrinting);
MetaFile := TMetaFile.Create;
FCurrentPage:=MFList.Add(MetaFile)+1;
UseScreen := True;
NewCanvas := nil;
IF Printer.Printers.Count > 0 then
Begin
UseScreen := False;
Try
Printer.Orientation := Orientation;
NewCanvas := TBenMetaFileCanvas.Create(MetaFile, Printer.Handle);
InitPrinterVars(Printer.Handle);
Except
UseScreen := True;
NewCanvas.Free;
End;
End;

If UseScreen then{打印机是否安装，否则用Screen 显示}
Begin
NewCanvas := TBenMetaFileCanvas.Create(MetaFile, 0);
InitPrinterVars(NewCanvas.Handle);
End;

(NewCanvas as TBenMetaFileCanvas).PPI := ppiy;
NewCanvas.Font.PixelsPerInch := ppiy; // 给字体赋精度
IF CurCanvas<>nil then
Begin
NewCanvas.Font := CurCanvas.Font;
NewCanvas.Brush := CurCanvas.Brush;
NewCanvas.Pen := CurCanvas.Pen;
End
Else
Begin
NewCanvas.Font.Name := '宋体';
NewCanvas.Font.Size := 9;
NewCanvas.Brush.Style := bsClear;
End;

CurCanvas.Free;
CurCanvas := NewCanvas;

UsedPage := False;

End;

Function TReportControl.UnitToX(x: double): integer;
Begin
Result := Round(x * ppix / ConvFac);
End;

Function TReportControl.UnitToY(y: double): integer;
Begin
Result := Round(y * ppiy / ConvFac);
End;

Function TReportControl.XToUnit(x: integer): double;
Begin
Result := x / ppix * ConvFac;
End;

Function TReportControl.YToUnit(y: integer): double;
Begin
Result := y / ppiy * ConvFac;
End;

Procedure TReportControl.EndDoc;
Var
I : Integer;
Begin
FPrinting := False;
CurCanvas.Free; //释放CurCanvas
CurCanvas := nil;

FCurrentPage:=0;

if UsedPage = False then begin
i := MFList.Count-1;
MetaFiles[MFList.Count-1].Free;
MFList.Delete(i);
end;

End;

function TReportControl.PrintDialog: boolean;
var
pd : TPrintDialog;
Start, Stop, Copy : integer;
begin
Result := False;

pd := TPrintDialog.Create(nil);
pd.FromPage := 1;
pd.MinPage := 1;
pd.MaxPage := LastAvailPage;
pd.ToPage := LastAvailPage;
pd.Options := [poPageNums];

try
if pd.Execute then begin
Result := True;

if pd.PrintRange = prAllPages then begin
Start := 0;
Stop := LastAvailPage - 1;
end else begin
Start := pd.FromPage - 1;
Stop := pd.ToPage - 1;
end;

for Copy := 1 to pd.Copies do begin
PrintRange(Start, Stop);
end;
end;
finally
pd.Free;
end;
end;

procedure TReportControl.Print;
begin
PrintRange(0, LastAvailPage-1);
end;

Procedure TReportControl.SetPrintPage;
Var
Device : Array[0..CchdeviceName-1] OF Char;
Driver : Array[0..Max_Path-1] OF Char;
Port : Array[0..32] OF Char;
HDMode : THandle;
PDMode : PDevMode;
begin
if Printer.Printers.Count > 0 then
IF PageCustom=CustomSize Then
begin
try
Printer.PrinterIndex:=Printer.PrinterIndex;
Printer.GetPrinter(DeVice,Driver,Port,HDMode);
IF HDMode<>0 Then
Begin
PDMode:=GlobalLock(HDMode);
IF PDMode<>Nil then
Begin
PDMode^.dmFields := pDMode^.dmFields or
DM_PAPERSIZE or
DM_PAPERWIDTH or
DM_PAPERLENGTH;
pDMode^.dmPaperSize := DMPAPER_USER;
PDMode^.dmPaperLength:=Round(PageLenghtS*100);
PDMode^.dmPaperWidth:=Round(PageWidthS*100);
pDMode^.dmFields := pDMode^.dmFields or DMBIN_MANUAL;
//pDMode^.dmDefaultSource := DMBIN_MANUAL;
// GlobalUnlock(hDMode);
// Printer.PrinterIndex:=Printer.PrinterIndex;
End;
End;
Printer.PrinterIndex:=Printer.PrinterIndex;
except
end;
end
Else
Begin
Printer.PrinterIndex:=-1;
Printer.PrinterIndex:=Printer.PrinterIndex;;
End;
End;

// 打印
function TReportControl.PrintRange(StartPage, StopPage: integer): boolean;
var
Page : integer;
begin
Screen.Cursor := crHourGlass;
try
Result := True;
Printer.Orientation := Orientation;
Printer.BeginDoc;
Printer.Title := Title;
InitPrinterVars(Printer.Handle);
for Page := StartPage to StopPage do begin
{ if Assigned(OnStatus) then
OnStatus(Self, Format('正在打印： %d', [Page]), Page, stPrinting); }
Printer.Canvas.Draw(-offx, -offy, MetaFiles[Page]);
if Page < StopPage then Printer.NewPage;
end;
Printer.EndDoc;
{ if Assigned(OnStatus) then
OnStatus(Self, '打印工作结束', -1, stPrintFinished); }
finally
Screen.Cursor := crDefault;
end;
end;

function TReportControl.GetPageNum: integer;
begin
Result := MFList.Count;
end;

function TReportControl.GetLastAvailPage: integer;
Begin
Result := GetPageNum;
end;

function TReportControl.GetCanvas: TCanvas;
begin
Assert(FPrinting, 'Canvas is not available before BeginDoc');
Result := CurCanvas;
UsedPage := True;
end;

procedure TReportControl.RestoreFont(Font: TFont; PPI: integer);
var
OldSize : integer;
begin
OldSize := Font.Size;
Font.PixelsPerInch := PPI;
Font.Size := OldSize;
end;

procedure TReportControl.FixFont(Font: TFont);
Begin

end;

Procedure TReportControl.SetPageCustom(FPCustom : TPageCustom);//后加
Begin
IF FpCustom<>FPageCustom Then
FPageCustom:=FpCustom;
End;

//有关打印

procedure TReportControl.SetCurPage(Val: integer);
var
tmp : integer;
begin
FCurPage := Val;
// tmp := 0;
// if PrevPrinter<>nil then tmp := PrevPrinter.LastAvailPage;
// CurPageLabel.Caption := Format('第 %d 页，共 %d 页', [Val+1, tmp]);
FPB.Invalidate;
// PB2.Invalidate;
end;

procedure TReportControl.DrawMetaFile(PB: TPaintBox; mf: TMetaFile);
begin
PB.Canvas.Draw(0, 0, mf);
end;

procedure TReportControl.PBPaint(Sender: TObject);
var
PB : TPaintBox;
x1, y1 : integer;
x, y : integer;
Draw : boolean;
Page : integer;
begin
PB := Sender as TPaintBox;
Draw := CurPage < LastAvailPage;
Page := CurPage;
SetMapMode(FPB.Canvas.Handle, MM_ANISOTROPIC);
SetWindowExtEx(FPB.Canvas.Handle, PageWidth, PageHeight, nil);
SetViewportExtEx(FPB.Canvas.Handle, FPB.Width, FPB.Height, nil);
if Draw then
DrawMetaFile(FPB, MetaFiles[Page]);

end;



procedure TReportControl.DrawTable();
Var
Coli : Integer;
Begin
SetPrintPage; //设置打印机
//以下为绘图象
BeginDoc;
// ShowMessage(IntToStr(LabCap.Count));

For Coli:=0 to LabCap.Count-1 do


LabCap.ITems[Coli].PaintLBl(Canvas);
Begin
//DrawText(Canvas.Handle,PChar(LabCap.ITems[Coli].FLabel),
// Length(LabCap.ITems[Coli].FLabel),LabCap.ITems[Coli].FCapRect,DT_BOTTOM OR DT_SINGLELINE);

End;
EndDoc;
CurPage:=0;


End;

end.
设置时错误为：Can Not Assign a Nil To a TFOnt

请把你的代码补充完整

在你的create中加上：
FFont:＝TFont.Create;
就OK了；
祝你这个控件早一天开发成功！

FFont没有创建过，是空的

FFONT没有初始化。