欢迎使用画斜线的QR报表控件 (50分)

  • 主题发起人 glhglhglh
  • 开始时间
G

glhglhglh

Unregistered / Unconfirmed
GUEST, unregistred user!
欢迎使用画斜线的QR报表控件
如果你用QR 设计报表,这个小控件对你或许有用
练手之作,请勿笑话!!!

unit glhQRShape;
///////////////////////////////////////////////////////////
// 画斜线的QR报表控件 //
// 设计:甘论洪 glh@163.net //
// 2002.07.20 //
// //
///////////////////////////////////////////////////////////

{
说明:
1.此控件继承于TQrShape,相关帮助请参考 TQrShape
2.新增属性
a.ShapeStyle: 线类型
UseShape 使用TQrShape 的Shape 设置
Slash 画斜线 /
BackLash 画反斜线 /
b.LeftText 斜线左边的文本
c.RightText 斜线右边的文本
d.Font LeftText和RightText的字体
}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
QuickRpt, Qrctrls,QRPrntr;
type
TShapeStyle=(UseShape,BackLash,Slash);
TMyQRShape = class(TQRShape)
private
FShapeStyle:TShapeStyle;
FLefttext:String;
fRightText:String;
fOldPen:TPen;
fOldFont:Tfont;
fOldBrush:TBrush;
fFont:TFont;

Procedure SetShapeStyle(VAlue:TShapeStyle);
Procedure SetLeftText(Value:String);
Procedure SetRightText(Value:String);
Procedure SetFont(Value:TFont);


Function GetTextHeight:Real;
protected
Procedure Paint;Override;
Procedure Print(OfsX:Integer;ofsY:Integer);Override;
public
Constructor Create(Aowner:TComponent);Override;
Destructor Destroy;Override;
published
Property ShapeStyle:TShapeStyle Read FShapeStyle Write SetShapeStyle;
Property LeftText:String Read FLeftText Write SetLeftText;
Property RightText:String Read FRightText Write SetRightText;
Property Font:TFont Read FFont Write SetFont;
end;

procedure Register;
implementation
Constructor TMyQRShape.Create(Aowner:TComponent);
begin
Inherited Create(aOwner);
fFont:=TFont.Create;
end;
Destructor TMyQRShape.Destroy;
begin
fFont.Free ;
Inherited Destroy;
end;
Function TMyQRShape.GetTextHeight:Real;
VAR
fLabel:TQrLabel;
begin
fLabel:=TQrLAbel.Create(Self) ;
fLAbel.Font.Assign(Self.font);
flabel.Parent :=Self.Parent ;
flabel.Caption :=Self.LeftText ;
flabel.AutoSize :=true;
flabel.Refresh ;
result:=fLAbel.Size.Height;
flabel.Free ;
end;
Procedure TMyQRShape.SetShapeStyle(VAlue:TShapeStyle);
begin
IF fShapeStyle<>Value then
begin
fShapeStyle:=Value;
InValidate;
end;
end;

Procedure TMyQRShape.SetLeftText(Value:String);
begin
IF fLeftText<>Value then
begin
fLeftText:=Value;
InValidate;
end;

end;

Procedure TMyQRShape.SetRightText(Value:String);
begin
IF fRightText<>Value then
begin
fRightText:=Value;
InValidate;
end;

end;

Procedure TMyQRShape.SetFont(Value:TFont);
begin
IF fFont<>Value then
begin
fFont.assign(Value);
InValidate;
end;

end;



Procedure TMyQRShape.Paint;
var
fHeight:Integer;
x,y:Integer;
begin
Case Self.ShapeStyle Of
UseShape :Inherited Paint;
Slash :begin
canvas.Pen:=Self.pen;
Canvas.Font:=Self.Font;
Canvas.Brush:=Self.Brush;
fHeight:=Canvas.TextHeight(Self.leftText);

Canvas.MoveTo(width,0);
Canvas.LineTo(0,height);
x:=1;
y:=0;
Canvas.TextOut(x,y,Self.lefttext);
x:=Round(width/2)+8;
y:=Height-fHeight;
Canvas.TextOut(x,y,Self.Righttext);
end;
Backlash:begin

canvas.Pen:=Self.pen;
Canvas.Font:=Self.Font;
Canvas.Brush:=Self.Brush;

Canvas.MoveTo(0,0);
Canvas.LineTo(Width,height);
fHeight:=Canvas.TextHeight(Self.leftText);
x:=1;
y:=Height-fHeight;
Canvas.TextOut(x,y,Self.lefttext);
x:=Round(width/2)+Canvas.TextWidth('A') ;
y:=0;
Canvas.TextOut(x,y,Self.Righttext);
end;
end;
end;
Procedure TMyQRShape.Print(OfsX:Integer;ofsY:Integer);
var
fHeight:Real;
x,y:Integer;
begin

Case Self.ShapeStyle Of
UseShape :Inherited Print(OfsX,Ofsy);
Slash :begin
fOldPen:=QRPrinter.Canvas.Pen;
fOldFont:=QRPrinter.Canvas.Font;
fOldBrush:=qrPrinter.Canvas.Brush ;

QRPrinter.Canvas.Brush := Brush;
QRPrinter.Canvas.Pen :=Self.Pen ;
QRPrinter.Canvas.Font :=Self.Font ;
QRPrinter.Canvas.MoveTo(qrprinter.XPos(ofsX+size.left+Size.width),qrprinter.YPos(ofsY+Size.Top));
QRPrinter.Canvas.LineTo(qrprinter.XPos(ofsX+Size.Left),qrprinter.XPos(ofsY+Size.Top+Size.Height));
fHeight:=Self.GetTextHeight;
x:=qrprinter.XPos(ofsX+Size.Left+1);
y:=qrprinter.YPos(ofsY+Size.Top+1);
QRPrinter.Canvas.TextOut(x,y,Self.lefttext);
x:=qrprinter.XPos(ofsX+Size.Left+Size.Width /2+fHeight);
y:=qrprinter.YPos(ofsY+Size.Top+size.height-fHeight);
QRPrinter.Canvas.TextOut(x,y,Self.Righttext);
QRPrinter.Canvas.Pen :=fOldPen;
QRPrinter.Canvas.Font:=fOldFont;
qrprinter.Canvas.Brush :=fOldBrush;
end;
BAcklash:begin
fOldPen:=Self.ParentReport.QRPrinter.Canvas.Pen;
fOldFont:=Self.ParentReport.QRPrinter.Canvas.Font ;
fOldBrush:=qrPrinter.Canvas.Brush ;

QRPrinter.Canvas.Brush := Brush;
QRPrinter.Canvas.Pen :=Self.Pen ;
QRPrinter.Canvas.Font :=Self.Font ;
QRPrinter.Canvas.MoveTo(qrprinter.XPos(ofsX+Size.Left),qrprinter.XPos(ofsY+Size.Top));
QRPrinter.Canvas.LineTo(qrprinter.XPos(ofsX+Size.Left+Size.Width),qrprinter.XPos(ofsY+Size.Top+Size.Height));

fHeight:=Self.GetTextHeight;
x:=qrprinter.XPos(ofsX+Size.Left+1);
y:=qrprinter.YPos(ofsY+Size.Top+Size.Height -fheight);
QRPrinter.Canvas.TextOut(x,y,Self.lefttext);
x:=qrprinter.XPos(ofsX+Size.Left+Size.Width /2+fHeight);
y:=qrprinter.YPos(ofsY+Size.Top+1);
QRPrinter.Canvas.TextOut(x,y,Self.Righttext);


QRPrinter.Canvas.Pen :=fOldPen;
QRPrinter.Canvas.Font:=fOldFont;
QRPrinter.Canvas.Brush:=fOldBrush;
end;
end;

end;

procedure Register;
begin
RegisterComponents('glh', [TMyQRShape]);
end;

end.
 
高手!请问如何画表格(直线),多谢!
 
学习~~~~~~~~~已经收藏~~~~~~~~~~~
 
good
thankyou
 
网上早有了
 
多人接受答案了。
 
顶部