修改控件吧 下面是我改的,因为想要大家分享,所以贴出代码,如果你要现成的 mail me
注意代码有缺点,datafield不能直接下拉,只能自己写入,可能是某个地方没设对,现在忙
没有时间看,大家解决了告诉我,我解决了告诉大家
下面是可以自动换行的dbtext的代码
unit wldbtext;
interface
uses
Windows, Messages, SysUtils, Classes,db,Graphics, Controls,StdCtrls, Forms, Dialogs,
QuickRpt;
{$R-}
{$B-}
type
// TQRExpr = class;
TQRLabelOnPrintEvent = procedure (sender : TObject;
var Value : string) of object;
Twlcustomlable = class(TQRPrintable)
private
{ Private declarations }
FCaptionBased : boolean;
do
neFormat : boolean;
FAutoSize : boolean;
FAutoStretch : boolean;
FCaption : string;
FCurrentLine : integer;
FPrintCaption : string;
FFontSize : integer;
FFormattedLines : TStrings;
FLines : TStrings;
FOnPrint : TQRLabelOnPrintevent;
FWordWrap : boolean;
UpdatingBounds : boolean;
function GetCaption : string;
function GetCaptionBased : boolean;
virtual;
procedure SetAutoStretch(Value : boolean);
procedure SetCaption(Value : string);
procedure SetLines(Value : TStrings);
procedure SetWordWrap(Value : boolean);
procedure PaintToCanvas(aCanvas : TCanvas;
aRect : TRect;
CanExpand : boolean;
LineHeight : integer);
procedure PrintToCanvas(aCanvas : TCanvas;
aLeft, aTop, aWidth, aHeight, LineHeight : extended;
CanExpand : boolean);
procedure CMFontChanged(var Message: TMessage);
message CM_FONTCHANGED;
procedure setchangdu(Value:integer);
protected
{ Protected declarations }
procedure FormatLines;
virtual;
procedure Loaded;
override;
procedure SetName(const Value: TComponentName);
override;
procedure SetParent(AParent: TWinControl);
override;
procedure DefineProperties(Filer: TFiler);
override;
procedure ReadFontSize(Reader : TReader);
virtual;
procedure WriteFontSize(Writer : TWriter);
virtual;
procedure Paint;
override;
procedure Prepare;
override;
procedure Unprepare;
override;
procedure Print(OfsX, OfsY : integer);
override;
procedure SetAlignment(Value : TAlignment);
override;
property OnPrint : TQRLabelOnPrintEvent read FOnPrint write FOnPrint;
public
{ Public declarations }
fchangdu:integer;
constructor Create(AOwner : TComponent);
override;
destructor Destroy;
override;
{$ifdef ver110}
function GetControlsAlignment: TAlignment;
override;
{$endif}
property CaptionBased : boolean read GetCaptionBased;
property Alignment;
property AutoSize : boolean read FAutoSize write FAutoSize;
property AutoStretch : boolean read FAutoStretch write SetAutoStretch;
property Caption : string read GetCaption write SetCaption stored true;
property Color;
property Font;
property Lines : TStrings read FLines write SetLines;
property WordWrap : boolean read FWordWrap write SetWordWrap;
property changdu:integer read fchangdu write setchangdu;
end;
twlqrdbtext = class(TwlCustomLable)
private
ComboBox : TEdit;
Field : TField;
FieldNo : integer;
FieldOK : boolean;
DataSourceName : string[30];
FDataSet : TDataSet;
FDataField : string;
FMask : string;
IsMemo : boolean;
procedure SetDataSet(Value : TDataSet);
procedure SetDataField(Value : string);
procedure SetMask(Value : string);
protected
function GetCaptionBased : boolean;
override;
procedure Loaded;
override;
procedure Notification(AComponent: TComponent;
Operation: TOperation);
override;
procedure Prepare;
override;
procedure Print(OfsX, OfsY : integer);
override;
procedure Unprepare;
override;
public
constructor Create(AOwner : TComponent);
override;
{$ifdef ver110}
function UseRightToLeftAlignment: boolean;
override;
{$endif}
published
property Alignment;
property AlignToBand;
property AutoSize;
property AutoStretch;
{$ifdef ver110}
property BiDiMode;
property ParentBiDiMode;
{$endif}
property Color;
property DataSet : TDataSet read FDataSet write SetDataSet;
property DataField : string read FDataField write SetDataField;
property Font;
property Mask : string read FMask write SetMask;
property OnPrint;
property ParentFont;
property Transparent;
property WordWrap;
property changdu;
end;
twlqrmemo = class(TwlCustomLable)
protected
function GetCaptionBased : boolean;
override;
public
procedure Paint;
override;
procedure Print(OfsX, OfsY : integer);
override;
published
property Alignment;
property AlignToBand;
property AutoSize;
property AutoStretch;
{$ifdef ver110}
property BiDiMode;
property ParentBiDiMode;
{$endif}
property Color;
property Font;
property Lines;
property ParentFont;
property Transparent;
property WordWrap;
property changdu;
end;
procedure Register;
implementation
{ TQRCustomLabel }
const
BreakChars : set of Char = [#13];
constructor TwlCustomLable.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FAutoSize := true;
FAutoStretch := false;
FWordWrap := true;
FLines := TStringList.Create;
FFormattedLines := TStringList.Create;
do
neFormat := false;
Caption := '';
Transparent := false;
UpdatingBounds := false;
FFontSize := 0;
FCaptionBased := true;
end;
destructor TwlCustomLable.Destroy;
begin
FLines.Free;
FFormattedLines.Free;
inherited Destroy;
end;
{$ifdef ver110}
function TwlCustomLable.GetControlsAlignment: TAlignment;
begin
Result := Alignment;
end;
{$endif}
function TwlCustomLable.GetCaption : string;
begin
result := FCaption;
end;
function TwlCustomLable.GetCaptionBased : boolean;
begin
Result := FCaptionBased;
end;
procedure TwlCustomLable.DefineProperties(Filer: TFiler);
begin
Filer.DefineProperty('FontSize', ReadFontSize, WriteFontSize, true);
//do
not translate
inherited DefineProperties(Filer);
end;
procedure TwlCustomLable.ReadFontSize(Reader : TReader);
begin
FFontSize := Reader.ReadInteger;
end;
procedure TwlCustomLable.WriteFontSize(Writer : TWriter);
begin
Writer.WriteInteger(Font.Size);
end;
procedure TwlCustomLable.Loaded;
begin
inherited Loaded;
if FFontSize > 0 then
Font.Size := FFontSize;
end;
procedure TwlCustomLable.CMFontChanged(var Message: TMessage);
begin
inherited;
do
neFormat := false;
formatlines;
end;
procedure TwlCustomLable.Prepare;
begin
inherited Prepare;
Caption := copy(Caption, 1, length(Caption));
end;
procedure TwlCustomLable.Unprepare;
begin
inherited Unprepare;
end;
procedure TwlCustomLable.FormatLines;
var
I, J : integer;
NewLine : string;
LineFinished : boolean;
HasParent : boolean;
MaxLineWidth : integer;
AAlignment: TAlignment;
function aLineWidth(Line : string) : integer;
begin
if HasParent then
result := Muldiv(Longint(ParentReport.TextWidth(Font, Line)),Zoom,100)
else
Result := Canvas.TextWidth(Line);
end;
procedure FlushLine;
begin
FFormattedLines.Add(NewLine);
NewLine := '';
end;
procedure AddWord(aWord : string);
{$ifdef ver100}
var
S: string;
{$endif}
begin
if aLineWidth(NewLine + aWord) > Width then
begin
if NewLine = '' then
begin
{$ifdef ver100}
if SysLocale.FarEast then
begin
while truedo
begin
if (aWord[1] in LeadBytes) and (Length(aWord) > 1) then
S := copy(aWord, 1, 2)
else
S := copy(aWord, 1, 1);
if aLineWidth(NewLine + S) < Width then
begin
NewLine := NewLine + S;
Delete(aWord, 1, Length(S));
end
else
Break;
end;
end
else
while aLineWidth(NewLine + copy(aWord, 1, 1)) < Widthdo
begin
NewLine := NewLine + copy(aWord, 1, 1);
Delete(aWord, 1, 1);
end;
{$else
}
while aLineWidth(NewLine + copy(aWord, 1, 1)) < Widthdo
begin
NewLine := NewLine + copy(aWord, 1, 1);
Delete(aWord, 1, 1);
end;
{$endif}
aWord := '';
end;
FlushLine;
if aLineWidth(aWord) > Width then
begin
if NewLine = '' then
begin
if Width = 0 then
aWord := ''
else
while aLineWidth(aWord) > Widthdo
{$ifdef ver100}
if ByteType(aWord, Length(aWord)) = mbTrailByte then
Delete(aWord, Length(aWord)-1, 2)
else
{$endif}
Delete(aWord, Length(aWord), 1);
end;
NewLine := aWord;
FlushLine;
aWord := '';
end;
if not WordWrap then
begin
aWord := '';
LineFinished := true;
end;
end;
NewLine := NewLine + aWord;
end;
procedure AddLine(Line : string);
var
aPos : integer;
begin
while pos(#10, Line) > 0do
Delete(Line, Pos(#10, Line), 1);
aPos := pos(#13, Line);
if aPos > 0 then
begin
repeat
AddLine(copy(Line, 1, aPos - 1));
Delete(Line, 1 , aPos);
aPos := pos(#13, Line);
until aPos = 0;
AddLine(Line);
end else
begin
J := 0;
NewLine := '';
LineFinished := false;
if AutoSize then
begin
NewLine := Line;
FlushLine;
LineFinished := True;
end else
begin
while (J < Length(Line)) and (Length(Line) > 0)do
begin
repeat
begin
inc(J);
if Line[J] in LeadBytes then
begin
inc(J);
break;
end;
end;
//until (J>=fchangdu) or (J >= Length(Line));
until (J >= Length(Line));
AddWord(copy(Line, 1, J));
Delete(Line, 1, J);
J := 0;
end;
if not LineFinished then
FlushLine;
end;
end;
end;
procedure FormatFromCaption;
begin
AddLine(FPrintCaption);
if not UpdatingBounds and HasParent then
begin
UpdatingBounds := true;
if Height < (longint(ParentReport.TextHeight(Font, 'W') * Zoom div 100) + 1) then
Height := (longint(ParentReport.TextHeight(Font, 'W')) * Zoom div 100) + 1;
UpdatingBounds := false;
end
end;
procedure FormatFromStringList;
var
J : integer;
begin
if (FLines.Count <> 0) then
begin
if AutoSize then
FFormattedLines.Assign(FLines)
else
for J := 0 to FLines.Count - 1do
AddLine(FLines[J]);
end else
if csDesigning in ComponentState then
begin
FCaption := Name;
FormatFromCaption;
FCaption := '';
end;
end;
begin
if Parent <> nil then
begin
if assigned(FFormattedLines) then
FFormattedLines.Clear
else
FFormattedLines := TStringList.Create;
HasParent := ParentReport <> nil;
LineFinished := false;
if CaptionBased then
FormatFromCaption
else
FormatFromStringList;
if AutoSize and (not UpdatingBounds) and HasParent then
begin
MaxLineWidth := 0;
for I := 0 to FFormattedLines.Count - 1do
if aLineWidth(FFormattedLines) > MaxLineWidth then
MaxLineWidth := aLineWidth(FFormattedLines);
if Frame.DrawLeft then
MaxLineWidth := MaxLineWidth + Frame.Width;
if Frame.DrawRight then
MaxLineWidth := MaxLineWidth + Frame.Width;
UpdatingBounds := true;
AAlignment := Alignment;
{$ifdef ver110}
if UseRightToLeftAlignment then
ChangeBiDiModeAlignment(AAlignment);
{$endif}
case AAlignment of
taCenter : Left := Left + ((Width - MaxLineWidth) div 2);
taRightJustify : Left := Left + Width - MaxLineWidth;
end;
Width := MaxLineWidth;
if (FFormattedLines.Count = 0) and (csDesigning in ComponentState) then
Height := (longint(ParentReport.TextHeight(Font, 'W')) * Zoom div 100) + 1;
if (Height < (longint(ParentReport.TextHeight(Font, 'W') * Zoom div 100) + 1)) then
Height := (longint(ParentReport.TextHeight(Font, 'W')) * Zoom div 100) + 1;
UpdatingBounds := false;
end;
end;
do
neFormat := true;
end;
procedure TwlCustomLable.SetLines(Value : TStrings);
begin
FLines.Assign(Value);
do
neFormat := false;
{xxx}
Invalidate;
end;
procedure TwlCustomLable.PaintToCanvas(aCanvas : TCanvas;
aRect : TRect;
CanExpand : boolean;
LineHeight: integer);
var
I : integer;
StartX : integer;
StartY : integer;
Cap : string;
VPos : integer;
Flags : integer;
AAlignment: TAlignment;
begin
FormatLines;
Flags := 0;
{ if AutoSize then
Flags := 0 else
Flags := ETO_CLIPPED;}
if not Transparent then
begin
aCanvas.Brush.Color := Color;
aCanvas.Brush.Style := bsSolid;
aCanvas.Fillrect(aRect);
end;
StartY := aRect.Top;
StartX := aRect.Left;
if Frame.AnyFrame then
begin
if Frame.DrawTop and (Frame.Width > 0 ) then
StartY := StartY + round(Frame.Width / 72 * Screen.PixelsPerInch * Zoom / 100);
if Frame.DrawLeft then
StartX := StartX + round(Frame.Width / 72 * Screen.PixelsPerInch * Zoom / 100)
end;
aRect.Right := aRect.Right - aRect.Left;
aRect.Left := 0;
aRect.Bottom := aRect.Bottom - aRect.Top;
aRect.Top := 0;
SetBkMode(aCanvas.Handle, Windows.Transparent);
begin
AAlignment := Alignment;
{$ifdef ver110}
if UseRightToLeftAlignment then
ChangeBiDiModeAlignment(AAlignment);
{$endif}
case AAlignment of
TaLeftJustify : SetTextAlign(aCanvas.Handle, TA_Left + TA_Top + TA_NoUpdateCP);
TaRightJustify: begin
SetTextAlign(aCanvas.Handle, TA_Right + TA_Top + TA_NoUpdateCP);
StartX := StartX + aRect.Right;
end;
TaCenter : begin
SetTextAlign(aCanvas.Handle, TA_Center + TA_Top + TA_NoUpdateCP);
StartX := StartX + (aRect.Right - aRect.Left) div 2;
end;
end;
end;
for I := 0 to FFormattedLines.Count - 1do
begin
VPos := StartY + I * LineHeight+2;
begin
Cap := FFormattedLines;
if Length(Cap) > 0 then
ExtTextOut(aCanvas.Handle, StartX, VPos, Flags, @aRect, @Cap[1], length(Cap), nil);
end;
end;
end;
type
TQRFixFrame = class(TQRFrame)
end;
{procedure TQRFixFrame.PaintFit(ACanvas : TCanvas;
ARect : TRect;
XFact, YFact : extended);
var
FWX, FWY : integer;
begin
FWX := round(XFact / 72 * 254 * Width);
if ((FWX < 1) and (Width >= 1)) or (Width = -1) then
FWX := 1;
FWY := round(YFact / 72 * 254 * Width);
if ((FWY < 1) and (Width >= 1)) or (Width = -1) then
FWY := 1;
ACanvas.Brush.Style := bsSolid;
ACanvas.Brush.Color := Color;
SetPen(ACanvas.Pen);
with aCanvasdo
begin
if DrawTop then
FillRect(Rect(ARect.Left, ARect.Top, ARect.Right, ARect.Top + FWY));
if DrawBottom then
FillRect(Rect(ARect.Left, ARect.Bottom, ARect.Right, ARect.Bottom - FWY));
if DrawLeft then
FillRect(Rect(ARect.Left, ARect.Top, ARect.Left + FWX, ARect.Bottom));
if DrawRight then
FillRect(Rect(ARect.Right - FWX, ARect.Top, ARect.Right, ARect.Bottom));
end;
ACanvas.Brush.Style := bsClear;
end;
}
procedure TwlCustomLable.PrintToCanvas(aCanvas : TCanvas;
aLeft, aTop, aWidth, aHeight,
LineHeight : extended;
CanExpand : boolean);
var
aRect : TRect;
ControlBottom : extended;
X, Y : extended;
SavedCaption : string;
NewCaption : string;
HasSaved : boolean;
HasExpanded : boolean;
Flags : integer;
{$ifdef ver110}
TAFlags : integer;
{$endif}
AAlignment : TAlignment;
AFExpanded : extended;
OrgWidth : extended;
function CanPrint : boolean;
var
PrevTop : extended;
begin
Result := true;
if Y + LineHeight > ControlBottom then
begin
if CanExpand and TQRCustomBand(Parent).CanExpand(LineHeight) then
begin
PrevTop := AFExpanded;
TQRCustomBand(Parent).ExpandBand(LineHeight, AFExpanded, HasExpanded);
ControlBottom := aTop + aHeight + 1 + AFExpanded;
if ParentReport.FinalPass and not Transparent then
with aCanvasdo
begin
Pen.Width := 0;
Brush.Color := Color;
Brush.Style := bsSolid;
FillRect(rect(QRPrinter.XPos(aLeft),
QRPrinter.YPos(aTop + AHeight + PrevTop),
QRPrinter.XPos(aLeft + aWidth),
QRPrinter.YPos(aTop + aHeight + AFExpanded)));
end;
end else
Result := false;
end;
end;
procedure PrintLine(LineNumber : integer);
begin
if ParentReport.FinalPass and (Length(FFormattedLines[LineNumber]) > 0) then
begin
ExtTextOut(aCanvas.Handle, QRPrinter.XPos(X), QRPrinter.YPos(Y),
Flags, @aRect, @FFormattedLines[LineNumber][1], length(FFormattedLines[LineNumber]), nil);
end;
if ParentReport.Exporting then
ParentReport.ExportFilter.TextOut(X, Y, Font, Color, AAlignment, FFormattedLines[LineNumber]);
Y := Y + LineHeight+fchangdu;
end;
begin
Flags := 0;
AFExpanded := 0;
OrgWidth := aWidth;
{ if AutoSize then
Flags := 0;
else
Flags := ETO_CLIPPED;}
{ if Transparent then
Flags := Flags + ETO_OPAQUE;}
HasSaved := false;
if (FPrintCaption <> '') and assigned(FOnPrint) then
begin
SavedCaption := FPrintCaption;
NewCaption := FprintCaption;
FOnPrint(Self, NewCaption);
if Font <> aCanvas.Font then
begin
aCanvas.Font := Font;
aHeight := Size.Height;
LineHeight := aCanvas.TextHeight('W') / QRPrinter.YFactor;
end;
if NewCaption <> FPrintCaption then
begin
FPrintCaption := NewCaption;
FormatLines;
HasSaved := true;
end;
end;
FormatLines;
// aWidth := Width / QRPrinter.XFactor;
{if not Autosize then
}aWidth := Size.Width;
if ParentReport.FinalPass and not Transparent then
with aCanvasdo
begin
Pen.Width := 0;
Brush.Color := Color;
Brush.Style := bsSolid;
FillRect(rect(QRPrinter.XPos(aLeft),
QRPrinter.YPos(aTop),
QRPrinter.XPos(aLeft + aWidth),
QRPrinter.YPos(aTop + aHeight)));
end;
if ParentReport.FinalPass then
if not AutoSize then
;
if Frame.AnyFrame then
begin
if Frame.DrawTop then
aTop := aTop + round(Frame.Width / 72 * 254 );
if Frame.DrawLeft then
aLeft := aLeft + round(Frame.Width / 72 * 254 )
end;
{ Get our rectangle for the next line }
aRect := Rect(0, 0, QRPrinter.XSize(aWidth), QRPrinter.YSize(LineHeight));
AAlignment := Alignment;
{$ifdef ver110}
if UseRightToLeftAlignment then
ChangeBiDiModeAlignment(AAlignment);
{$endif}
{ Calculate some stuff... }
ControlBottom := aTop + aHeight + 1;
Y := aTop;
if not AutoSize then
X := aLeft
else
begin
case Alignment of
TaLeftJustify : X := aLeft;
TaRightJustify: X := aLeft - (aWidth - OrgWidth);
TaCenter : X := aLeft - ((aWidth - OrgWidth) / 2);
end;
end;
SetBkMode(aCanvas.Handle, Windows.Transparent);
{ Set the attributes and update X for alignment }
{$ifndef ver110}
case Alignment of
TaLeftJustify : SetTextAlign(aCanvas.Handle, TA_Left + TA_Top + TA_NoUpdateCP);
TaRightJustify: begin
SetTextAlign(aCanvas.Handle, TA_Right + TA_Top + TA_NoUpdateCP);
X := X + aWidth;
if fsItalic in Font.Style then
X := X - (ParentReport.TextWidth(Font, ' '));
end;
TaCenter : begin
SetTextAlign(aCanvas.Handle, TA_Center + TA_Top + TA_NoUpdateCP);
X := X + aWidth / 2;
end;
end;
AAlignment := Alignment;
{$else
}
TAFlags := TA_Top + TA_NoUpdateCP;
AAlignment := Alignment;
if UseRightToLeftAlignment then
ChangeBiDiModeAlignment(AAlignment);
if UseRightToLeftReading then
begin
Flags := Flags or ETO_RTLREADING;
TAFlags := TAFlags + TA_RTLREADING;
end;
case AAlignment of
TaLeftJustify : SetTextAlign(aCanvas.Handle, TA_Left + TAFlags);
TaRightJustify: begin
SetTextAlign(aCanvas.Handle, TA_Right + TAFlags);
X := X + aWidth;
end;
TaCenter : begin
SetTextAlign(aCanvas.Handle, TA_Center + TAFlags);
X := X + aWidth / 2;
end;
end;
{$endif}
HasExpanded := false;
if PrintFinished then
FCurrentLine := 0;
while (FCurrentLine <= FFormattedLines.Count - 1) and CanPrintdo
begin
PrintLine(FCurrentLine);
inc(FCurrentLine);
end;
if (FCurrentLine <= FFormattedLines.Count - 1) and AutoStretch then
PrintFinished := false
else
PrintFinished := true;
SelectClipRgn(QRPrinter.Canvas.Handle, 0);
// end new code
if HasSaved then
FPrintCaption := SavedCaption;
if ParentReport.FinalPass and Frame.AnyFrame then
TQRFixFrame(Frame).PaintIt(aCanvas,
rect(QRPrinter.XPos(ALeft),
QRPrinter.YPos(ATop),
QRPrinter.XPos(ALeft + aWidth),
QRPrinter.YPos(Atop + Size.height+ AFExpanded)),
QRPrinter.XFactor,
QRPrinter.YFactor);
end;
procedure TwlCustomLable.Paint;
begin
Canvas.Font.Assign(Font);
if Canvas.Font.Size <> round(Font.Size * Zoom / 100) then
Canvas.Font.Size := round(Font.Size * Zoom / 100);
inherited Paint;
PaintToCanvas(Canvas, rect(0, 0, Width, Height), false, round(Canvas.TextHeight('W')));
PaintCorners;
end;
procedure TwlCustomLable.Print(OfsX, OfsY : integer);
var
aCanvas : TCanvas;
begin
if IsEnabled then
begin
aCanvas := QRPrinter.Canvas;
aCanvas.Font := Font;
with QRPrinterdo
PrintToCanvas(QRPrinter.Canvas,
OfsX + Size.Left, OfsY + Size.Top,
Size.Width, Size.Height,
aCanvas.TextHeight('W') / QRPrinter.YFactor, AutoStretch);
// inherited Print(OfsX, OfsY);
end;
end;
procedure TwlCustomLable.SetAutoStretch(Value : boolean);
begin
FAutoStretch := Value;
Invalidate;
end;
procedure TwlCustomLable.SetCaption(Value : string);
begin
FCaption := Value;
FPrintCaption := Value;
do
neFormat := false;
FormatLines;
Invalidate;
end;
procedure TwlCustomLable.SetName(const Value: TComponentName);
begin
if ((Caption = '') or (Caption = Name)) then
Caption := Value;
inherited SetName(Value);
end;
procedure TwlCustomLable.SetParent(AParent : TWinControl);
begin
inherited SetParent(AParent);
FormatLines;
end;
procedure TwlCustomLable.SetAlignment(Value : TAlignment);
begin
inherited SetAlignment(Value);
end;
procedure TwlCustomLable.SetWordWrap(Value : boolean);
begin
FWordWrap := Value;
Invalidate;
end;
{ TQRDBText }
constructor twlqrdbtext.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
DataSourceName := '';
ComboBox := nil;
IsMemo := false;
end;
procedure twlqrdbtext.SetDataSet(Value : TDataSet);
begin
FDataSet := Value;
if Value <> nil then
Value.FreeNotification(self);
end;
function twlqrdbtext.GetCaptionBased : boolean;
begin
Result := not IsMemo;
end;
procedure twlqrdbtext.SetDataField(Value : string);
begin
FDataField := Value;
Caption := Value;
end;
procedure twlqrdbtext.Loaded;
var
aComponent : TComponent;
begin
inherited Loaded;
if DataSourceName<>'' then
begin
aComponent := Owner.FindComponent(DataSourceName);
if (aComponent <> nil) and (aComponent is TDataSource) then
DataSet:=TDataSource(aComponent).DataSet;
end;
end;
procedure twlqrdbtext.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) then
if AComponent = FDataSet then
FDataSet := nil;
end;
procedure twlqrdbtext.SetMask(Value : string);
begin
FMask := Value;
end;
procedure twlqrdbtext.Prepare;
begin
inherited Prepare;
if assigned(FDataSet) then
begin
Field := FDataSet.FindField(FDataField);
if Field <> nil then
begin
FieldNo := Field.Index;
FieldOK := true;
if (Field is TMemoField) or (Field is TBlobField) then
begin
FPrintCaption := '';
IsMemo := true;
end
else
IsMemo := false;
end;
end else
begin
Field := nil;
FieldOK := false;
end;
end;
procedure twlqrdbtext.Print(OfsX, OfsY : integer);
begin
if IsEnabled then
begin
if FieldOK then
begin
if FDataSet.DefaultFields then
Field := FDataSet.Fields[FieldNo];
end
else
Field := nil;
if assigned(Field) then
begin
try
if (Field is TMemoField) or
(Field is TBlobField) then
begin
Lines.Text := TMemoField(Field).AsString;
end else
if (Mask = '') or (Field is TStringField) then
if not (Field is TBlobField) then
FPrintCaption := Field.DisplayText
else
FPrintCaption := Field.AsString
else
begin
if (Field is TIntegerField) or
(Field is TSmallIntField) or
(Field is TWordField) then
FPrintCaption := FormatFloat(Mask, TIntegerField(Field).Value * 1.0)
else
if (Field is TFloatField) or
(Field is TCurrencyField) or
(Field is TBCDField) then
FPrintCaption := FormatFloat(Mask,TFloatField(Field).Value)
else
if (Field is TDateTimeField) or
(Field is TDateField) or
(Field is TTimeField) then
FPrintCaption := FormatDateTime(Mask,TDateTimeField(Field).Value);
end;
except
FPrintCaption := '';
end;
end else
FPrintCaption := '';
do
neFormat := false;
inherited Print(OfsX,OfsY);
end;
end;
procedure twlqrdbtext.Unprepare;
begin
Field := nil;
inherited Unprepare;
if DataField <> '' then
SetDataField(DataField) { Reset component caption }
else
SetDataField(Name);
end;
{$ifdef ver110}
function twlqrdbtext.UseRightToLeftAlignment: Boolean;
begin
Result := QRDBUseRightToLeftAlignment(Self, Field);
end;
{$endif}
{ twlqrmemo }
function twlqrmemo.GetCaptionBased : boolean;
begin
Result := false;
end;
procedure twlqrmemo.Paint;
begin
if (Lines.Count > 0) and (Caption > '') then
Caption := '';
inherited Paint;
end;
procedure twlqrmemo.Print(OfsX, OfsY : integer);
begin
{ if (Lines.Count > 0) then
}
Caption := '';
inherited Print(OfsX, OfsY);
Caption := Name;
end;
procedure Register;
begin
RegisterComponents('test', [twlqrdbtext,twlqrmemo]);
end;
procedure Twlcustomlable.setchangdu(Value: integer);
begin
fchangdu:=Value;
end;
end.
其中还有一个可以设置行间距的memo