2、控件设计步骤
步骤1、使用Delphi提供的控件向导,选择TQShape为父类,建立新类TMyQRShape,并选择适当的包(Package),最后生成单元文件。
步骤2、在生成的单元文件中,增加枚举类型,
TLines = ( None,TopBottom,BottomTop ) ;
None、TopBottom、BottomTop三种取值,分别代表直线、斜线 和反斜线 / 。
步骤3、在新类TMyQRShape 中增加private 成员 FLineType:TLines ,增加published属性 LineType:TLines Read FLineType Write SetFLineType 。
步骤4、建立过程SetFLineType 。
procedure TMyQRShape.SetFLineType(Value:TLines);
begin
if Value<>FLineType then
begin
FLineType:=Value ;
Invalidate ;
end ;
end ;
步骤5、重载Paint方法
procedure TMyQRShape.Paint ;
begin
case LineType of
BottomTop:
begin
Canvas.MoveTo(0,Height) ;
Canvas.LineTo(width,0 ) ;
end ;
TopBottom:
begin
Canvas.MoveTo(0,0) ;
Canvas.LineTo(width,Height ) ;
end ;
None:
begin
Height := Parent.Height ;
Top:=0 ;
Width:=4 ;
Shape:=qrsVertLine ;
Inherited Paint ;
end ;
end ;
end ;
步骤6、重载Print方法
procedure TMyQRShape.Print(OfsX,OfsY : Integer);
begin
with QRPrinter do
begin
case LineType of
BottomTop:
begin
Canvas.MoveTo(XPos(OfsX + Size.Left), YPos(OfsY + Size.Top)+Height) ;
Canvas.LineTo(XPos(OfsX + Size.Left)+width,YPos(OfsY + Size.Top) ) ;
end ;
TopBottom:
begin
Canvas.MoveTo(XPos(OfsX + Size.Left), YPos(OfsY + Size.Top)) ;
Canvas.LineTo(XPos(OfsX + Size.Left)+Width,YPos(OfsY + Size.Top)+Height ) ;
end ;
None:
Inherited Print(OfsX,OfsY ) ;
end ;
end ;
end;
步骤7、保存并安装TMyQRShape控件。
本控件在Delphi40下调试、安装,并成功应用于某数据库管理系统的开发。该控件的完整代码如下。
源程序:
unit MyQRShape;
published
property LineType:TLines Read FLineType Write SetFLineType ;
end;
procedure Register;
implementation
procedure TMyQRShape.SetFLineType(Value:TLines);
begin
if Value<>FLineType then
begin
FLineType:=Value ;
Invalidate ;
end ;
end ;
procedure TMyQRShape.Paint ;
begin
case LineType of
BottomTop:
begin
Canvas.MoveTo(0,Height) ;
Canvas.LineTo(width,0 ) ;
end ;
TopBottom:
begin
Canvas.MoveTo(0,0) ;
Canvas.LineTo(width,Height ) ;
end ;
None:
begin
Height := Parent.Height ;
Top:=0 ;
Width:=4 ;
Shape:=qrsVertLine ;
Inherited Paint ;
end ;
end ;
end ;
procedure TMyQRShape.Print(OfsX,OfsY : Integer);
begin
with QRPrinter do
begin
case LineType of
BottomTop:
begin
Canvas.MoveTo(XPos(OfsX + Size.Left), YPos(OfsY + Size.Top)+Height) ;
Canvas.LineTo(XPos(OfsX + Size.Left)+width,YPos(OfsY + Size.Top) ) ;
end ;
TopBottom:
begin
Canvas.MoveTo(XPos(OfsX + Size.Left), YPos(OfsY + Size.Top)) ;
Canvas.LineTo(XPos(OfsX + Size.Left)+Width,YPos(OfsY + Size.Top)+Height ) ;
end ;
None:
Inherited Print(OfsX,OfsY ) ;
end ;
end ;
end;
procedure Register;
begin
RegisterComponents(`QReport`, [TMyQRShape]);
end;