paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 13:59:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazReport: Patch from Aleksey Lagunov:

Browse Source 
1. fix work with Zeos DB components (lr.zeos.diff)
2. fix export to pdf with cairo export - correctly export justify text (lr.cairo.diff)
3. Increase max bands on page to 255 
4. for MemoView implemebtated First Line indent - ParagraphGap property
5. Rework code for subreports - need for drag page in report designer
6. Rework code for crosstab reports - fix sorting in report
7. In report designer implement page reordering

git-svn-id: trunk@48876 -
This commit is contained in:
jesus 2015-04-27 17:50:38 +00:00
parent 2f05933d7f
commit f54444c6ae
9 changed files with 578 additions and 289 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
components/lazreport/source/addons/ZeosDB/lr_db_zeos.pas
View File

@ -103,7 +103,7 @@ implementation
{$R lr_zeos_img.res} {$R lr_zeos_img.res}
uses LR_Utils, DBPropEdits, PropEdits, LazarusPackageIntf, ZDbcIntfs, types, uses LR_Utils, DBPropEdits, PropEdits, LazarusPackageIntf, ZDbcIntfs, types,
lr_EditParams, Forms, Controls, variants, Dialogs; lr_EditParams, Forms, Controls, variants, Dialogs, strutils;
var var
lrBMP_ZQuery:TBitmap = nil; lrBMP_ZQuery:TBitmap = nil;
@ -316,6 +316,9 @@ end;
procedure TLRZQuery.AfterLoad; procedure TLRZQuery.AfterLoad;
var var
D:TComponent; D:TComponent;
SPage: String;
S: String;
Z: TLRZConnection;
begin begin
D:=frFindComponent(OwnerForm, DataSource); D:=frFindComponent(OwnerForm, DataSource);
if Assigned(D) and (D is TDataSource)then if Assigned(D) and (D is TDataSource)then
@ -326,6 +329,21 @@ begin
begin begin
TZQuery(DataSet).Connection:=TZConnection(D); TZQuery(DataSet).Connection:=TZConnection(D);
DataSet.Active:=FActive; DataSet.Active:=FActive;
end
else
if Assigned(CurReport) then
begin
S:=FDatabase;
if Pos('.', S)>0 then
SPage:=Copy2SymbDel(S, '.')
else
SPage:='';
Z:=CurReport.FindObject(S) as TLRZConnection;
if Assigned(Z) then
begin
TZQuery(DataSet).Connection:=Z.FZConnection;
DataSet.Active:=FActive;
end
end; end;
end; end;
@ -339,7 +357,7 @@ begin
DataSet.Active:=false; DataSet.Active:=false;
D:=frFindComponent(TZQuery(DataSet).Owner, FDatabase); D:=frFindComponent(TZQuery(DataSet).Owner, FDatabase);
if Assigned(D) and (D is TZConnection)then if Assigned(D) and (D is TZConnection)then
TZQuery(DataSet).Connection:=TZConnection(D); TZQuery(DataSet).Connection:=TZConnection(D)
end; end;
procedure TLRZQuery.ZQueryBeforeOpen(ADataSet: TDataSet); procedure TLRZQuery.ZQueryBeforeOpen(ADataSet: TDataSet);
@ -610,9 +628,31 @@ end;
{ TLRZQueryDataBaseProperty } { TLRZQueryDataBaseProperty }
procedure TLRZQueryDataBaseProperty.FillValues(const Values: TStringList); procedure TLRZQueryDataBaseProperty.FillValues(const Values: TStringList);
var
i: Integer;
j: Integer;
S: String;
begin begin
if (GetComponent(0) is TLRZQuery) then if (GetComponent(0) is TLRZQuery) then
begin
frGetComponents(nil, TZConnection, Values, nil); frGetComponents(nil, TZConnection, Values, nil);
if Assigned(CurReport) then
begin
for i:=0 to CurReport.Pages.Count-1 do
if CurReport.Pages[i] is TfrPageDialog then
begin
for j:=0 to CurReport.Pages[i].Objects.Count-1 do
begin
if TfrObject(CurReport.Pages[i].Objects[j]) is TLRZConnection then
begin
S:=CurReport.Pages[i].Name+'.'+TLRDataSetControl(CurReport.Pages[i].Objects[j]).lrDBDataSet.Name;
Values.Add(S);
end;
end;
end;
end;
end;
end; end;

24
components/lazreport/source/addons/ZeosDB/lr_zeosdb.lpk
View File

@ -1,4 +1,4 @@
<?xml version="1.0"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<Package Version="4"> <Package Version="4">
<Name Value="LR_ZeosDB"/> <Name Value="LR_ZeosDB"/>
@ -8,39 +8,29 @@
<SearchPaths> <SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths> </SearchPaths>
<Other>
<CompilerMessages>
<MsgFileName Value=""/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions> </CompilerOptions>
<Description Value="Add support to ZEOSdb components for designing LazReport dialogs at runtime with lr_dialogdesign package"/> <Description Value="Add support to ZEOSdb components for designing LazReport dialogs at runtime with lr_dialogdesign package"/>
<License Value="modified LGPL-2 <License Value="modified LGPL-2
"/> "/>
<Version Minor="2" Release="2"/> <Version Minor="2" Release="2"/>
<Files Count="5"> <Files Count="4">
<Item1> <Item1>
<Filename Value="lr_db_zeos.pas"/> <Filename Value="lr_db_zeos.pas"/>
<HasRegisterProc Value="True"/> <HasRegisterProc Value="True"/>
<UnitName Value="LR_DB_Zeos"/> <UnitName Value="LR_DB_Zeos"/>
</Item1> </Item1>
<Item2> <Item2>
<Filename Value="lr_zeos_img.inc"/>
<Type Value="Include"/>
</Item2>
<Item3>
<Filename Value="lr_editvariables.pas"/> <Filename Value="lr_editvariables.pas"/>
<UnitName Value="LR_EditVariables"/> <UnitName Value="LR_EditVariables"/>
</Item3> </Item2>
<Item4> <Item3>
<Filename Value="lr_editparams.pas"/> <Filename Value="lr_editparams.pas"/>
<UnitName Value="lr_EditParams"/> <UnitName Value="lr_EditParams"/>
</Item4> </Item3>
<Item5> <Item4>
<Filename Value="lrdbzeosconst.pas"/> <Filename Value="lrdbzeosconst.pas"/>
<UnitName Value="lrDBZeosConst"/> <UnitName Value="lrDBZeosConst"/>
</Item5> </Item4>
</Files> </Files>
<i18n> <i18n>
<EnableI18N Value="True"/> <EnableI18N Value="True"/>

8
components/lazreport/source/addons/cairoexport/lr_e_cairo.pas
View File

@ -80,6 +80,7 @@ type
end; end;
implementation implementation
uses LR_Utils;
// missing cairo functions to make shared images posible // missing cairo functions to make shared images posible
const const
@ -767,7 +768,12 @@ begin
if fCairoPrinter.Canvas.Font.Orientation<>0 then if fCairoPrinter.Canvas.Font.Orientation<>0 then
fCairoPrinter.Canvas.TextRect(R, nx, R.Bottom, Text, aStyle) fCairoPrinter.Canvas.TextRect(R, nx, R.Bottom, Text, aStyle)
else else
fCairoPrinter.Canvas.TextRect(R, R.Left, ny, Text, aStyle); begin
if TfrMemoView_(View).Justify and not TfrMemoView_(View).LastLine then
CanvasTextRectJustify(fCairoPrinter.Canvas, R, nx, R.Right, ny, Text, true)
else
fCairoPrinter.Canvas.TextRect(R, {R.Left} nx, ny, Text, aStyle);
end;
// restore previous clipping // restore previous clipping
//if OldClipping then //if OldClipping then

154
components/lazreport/source/lr_class.pas
View File

@ -22,6 +22,9 @@ uses
LR_Intrp, LR_DSet, LR_DBSet, LR_DBRel, LR_Const, DbCtrls, LazUtf8Classes, LR_Intrp, LR_DSet, LR_DBSet, LR_DBRel, LR_Const, DbCtrls, LazUtf8Classes,
LazLoggerBase; LazLoggerBase;
const
lrMaxBandsInReport = 256; //temp fix. in future need remove this limit
const const
// object flags // object flags
flStretched = $01; flStretched = $01;
@ -396,8 +399,6 @@ type
end; end;
{ TfrMemoView }
{ TfrCustomMemoView } { TfrCustomMemoView }
TfrCustomMemoView = class(TfrStretcheable) TfrCustomMemoView = class(TfrStretcheable)
@ -409,6 +410,7 @@ type
FOnClick: TfrScriptStrings; FOnClick: TfrScriptStrings;
FOnMouseEnter: TfrScriptStrings; FOnMouseEnter: TfrScriptStrings;
FOnMouseLeave: TfrScriptStrings; FOnMouseLeave: TfrScriptStrings;
FParagraphGap: integer;
function GetAlignment: TAlignment; function GetAlignment: TAlignment;
function GetAngle: Byte; function GetAngle: Byte;
@ -471,6 +473,7 @@ type
HighlightStr: String; HighlightStr: String;
LineSpacing, CharacterSpacing: Integer; LineSpacing, CharacterSpacing: Integer;
LastLine: boolean; // are we painting/exporting the last line? LastLine: boolean; // are we painting/exporting the last line?
FirstLine: boolean;
constructor Create(AOwnerPage:TfrPage); override; constructor Create(AOwnerPage:TfrPage); override;
destructor Destroy; override; destructor Destroy; override;
@ -502,6 +505,7 @@ type
property OnClick : TfrScriptStrings read FOnClick write SetOnClick; property OnClick : TfrScriptStrings read FOnClick write SetOnClick;
property OnMouseEnter : TfrScriptStrings read FOnMouseEnter write SetOnMouseEnter; property OnMouseEnter : TfrScriptStrings read FOnMouseEnter write SetOnMouseEnter;
property OnMouseLeave : TfrScriptStrings read FOnMouseLeave write SetOnMouseLeave; property OnMouseLeave : TfrScriptStrings read FOnMouseLeave write SetOnMouseLeave;
property ParagraphGap : integer read FParagraphGap write FParagraphGap;
end; end;
TfrMemoView = class(TfrCustomMemoView) TfrMemoView = class(TfrCustomMemoView)
@ -527,6 +531,7 @@ type
property Format; property Format;
property FormatStr; property FormatStr;
property Restrictions; property Restrictions;
property ParagraphGap;
property OnClick; property OnClick;
property OnMouseEnter; property OnMouseEnter;
property OnMouseLeave; property OnMouseLeave;
@ -587,8 +592,13 @@ type
{ TfrSubReportView } { TfrSubReportView }
TfrSubReportView = class(TfrView) TfrSubReportView = class(TfrView)
private
FSubPageIndex: Integer; //temp var for find page on load
FSubPage : TfrPage;
protected
procedure AfterLoad;override;
public public
SubPage: Integer; //SubPage: Integer;
constructor Create(AOwnerPage:TfrPage); override; constructor Create(AOwnerPage:TfrPage); override;
procedure Assign(Source: TPersistent); override; procedure Assign(Source: TPersistent); override;
procedure Draw(aCanvas: TCanvas); override; procedure Draw(aCanvas: TCanvas); override;
@ -597,6 +607,7 @@ type
procedure SaveToStream(Stream: TStream); override; procedure SaveToStream(Stream: TStream); override;
procedure SaveToXML(XML: TLrXMLConfig; const Path: String); override; procedure SaveToXML(XML: TLrXMLConfig; const Path: String); override;
procedure DefinePopupMenu({%H-}Popup: TPopupMenu); override; procedure DefinePopupMenu({%H-}Popup: TPopupMenu); override;
property SubPage : TfrPage read FSubPage write FSubPage;
published published
property Restrictions; property Restrictions;
end; end;
@ -695,8 +706,7 @@ type
Flags: Word; Flags: Word;
Next, Prev: TfrBand; Next, Prev: TfrBand;
SubIndex, MaxY: Integer; SubIndex, MaxY: Integer;
EOFReached: Boolean; EOFArr: Array[0..lrMaxBandsInReport - 1] of Boolean;
EOFArr: Array[0..31] of Boolean;
Positions: Array[TfrDatasetPosition] of Integer; Positions: Array[TfrDatasetPosition] of Integer;
LastGroupValue: Variant; LastGroupValue: Variant;
HeaderBand, FooterBand, LastBand: TfrBand; HeaderBand, FooterBand, LastBand: TfrBand;
@ -729,6 +739,7 @@ type
procedure ResetLastValues; procedure ResetLastValues;
function getName: string; function getName: string;
public public
EOFReached: Boolean;
MaxDY: Integer; MaxDY: Integer;
Typ: TfrBandType; Typ: TfrBandType;
@ -783,7 +794,6 @@ type
TfrPage = class(TfrObject) TfrPage = class(TfrObject)
private private
Bands : Array[TfrBandType] of TfrBand;
fColCount : Integer; fColCount : Integer;
fColGap : Integer; fColGap : Integer;
fColWidth : Integer; fColWidth : Integer;
@ -799,7 +809,6 @@ type
CurColumn : Integer; CurColumn : Integer;
LastStaticColumnY : Integer; LastStaticColumnY : Integer;
XAdjust : Integer; XAdjust : Integer;
List : TFpList;
LastBand : TfrBand; LastBand : TfrBand;
ColPos : Integer; ColPos : Integer;
CurPos : Integer; CurPos : Integer;
@ -810,11 +819,15 @@ type
procedure ClearRecList; procedure ClearRecList;
procedure DrawPageFooters; procedure DrawPageFooters;
function BandExists(b: TfrBand): Boolean; function BandExists(b: TfrBand): Boolean;
function GetPageIndex: integer;
procedure LoadFromStream(Stream: TStream); procedure LoadFromStream(Stream: TStream);
procedure SaveToStream(Stream: TStream); procedure SaveToStream(Stream: TStream);
procedure SetPageIndex(AValue: integer);
procedure ShowBand(b: TfrBand); procedure ShowBand(b: TfrBand);
protected protected
List : TFpList;
Bands : Array[TfrBandType] of TfrBand;
Mode : TfrPageMode; Mode : TfrPageMode;
PlayFrom : Integer; PlayFrom : Integer;
function PlayRecList: Boolean; function PlayRecList: Boolean;
@ -878,6 +891,7 @@ type
property Script; property Script;
property Height; property Height;
property Width; property Width;
property PageIndex:integer read GetPageIndex write SetPageIndex;
end; end;
TFrPageClass = Class of TfrPage; TFrPageClass = Class of TfrPage;
@ -949,8 +963,9 @@ type
destructor Destroy; override; destructor Destroy; override;
procedure Clear; procedure Clear;
procedure Add(const aClassName : string='TfrPageReport'); function Add(const aClassName : string='TfrPageReport'):TfrPage;
procedure Delete(Index: Integer); procedure Delete(Index: Integer);
procedure Move(OldIndex, NewIndex: Integer);
procedure LoadFromStream(Stream: TStream); procedure LoadFromStream(Stream: TStream);
procedure LoadFromXML(XML: TLrXMLConfig; const Path: String); procedure LoadFromXML(XML: TLrXMLConfig; const Path: String);
procedure SaveToStream(Stream: TStream); procedure SaveToStream(Stream: TStream);
@ -1701,7 +1716,11 @@ begin
frObj := CurReport.FindObject(FObjName); frObj := CurReport.FindObject(FObjName);
if Assigned(frObj) then if Assigned(frObj) then
begin
Result:=GetPropInfo(frObj, PropName); //Retreive property informations Result:=GetPropInfo(frObj, PropName); //Retreive property informations
if not Assigned(Result) then
IsCustomProp(PropName, PropIndex);
end;
end; end;
end; end;
@ -2077,7 +2096,7 @@ begin
DebugLn('Error: ', e.message,'. Hyphenation support will be disabled'); DebugLn('Error: ', e.message,'. Hyphenation support will be disabled');
end; end;
end; end;
{
procedure CanvasTextRectJustify(const Canvas:TCanvas; procedure CanvasTextRectJustify(const Canvas:TCanvas;
const ARect: TRect; X1, X2, Y: integer; const Text: string; const ARect: TRect; X1, X2, Y: integer; const Text: string;
Trimmed: boolean); Trimmed: boolean);
@ -2154,7 +2173,7 @@ begin
SetLength(Arr, 0); SetLength(Arr, 0);
end; end;
}
{ TlrDetailReports } { TlrDetailReports }
function TlrDetailReports.GetItems(AReportName: string): TlrDetailReport; function TlrDetailReports.GetItems(AReportName: string): TlrDetailReport;
@ -3296,6 +3315,7 @@ begin
FOnMouseEnter:=TfrScriptStrings.Create; FOnMouseEnter:=TfrScriptStrings.Create;
FOnMouseLeave:=TfrScriptStrings.Create; FOnMouseLeave:=TfrScriptStrings.Create;
FFindHighlight:=false; FFindHighlight:=false;
FParagraphGap:=0;
Typ := gtMemo; Typ := gtMemo;
FFont := TFont.Create; FFont := TFont.Create;
@ -3425,6 +3445,7 @@ begin
FOnMouseLeave.Assign(TfrCustomMemoView(Source).FOnMouseLeave); FOnMouseLeave.Assign(TfrCustomMemoView(Source).FOnMouseLeave);
FDetailReport:=TfrCustomMemoView(Source).FDetailReport; FDetailReport:=TfrCustomMemoView(Source).FDetailReport;
FCursor:=TfrCustomMemoView(Source).FCursor; FCursor:=TfrCustomMemoView(Source).FCursor;
FParagraphGap:=TfrCustomMemoView(Source).FParagraphGap;
end; end;
end; end;
@ -3557,6 +3578,8 @@ var
{$ENDIF} {$ENDIF}
SMemo.Add(str + Chr(w div 256) + Chr(w mod 256)); SMemo.Add(str + Chr(w div 256) + Chr(w mod 256));
Inc(size, size1); Inc(size, size1);
//!!
maxWidth := dx - gapx - gapx;
end; end;
procedure WrapLine(const s: String); procedure WrapLine(const s: String);
@ -3704,13 +3727,14 @@ var
begin begin
size := y + gapy; size := y + gapy;
size1 := -WCanvas.Font.Height + LineSpacing; size1 := -WCanvas.Font.Height + LineSpacing;
maxWidth := dx - gapx - gapx; // maxWidth := dx - gapx - gapx;
{$IFDEF DebugLR} {$IFDEF DebugLR}
DebugLn('OutMemo I: Size=%d Size1=%d MaxWidth=%d DIM:%d %d %d %d gapxy:%d %d', DebugLn('OutMemo I: Size=%d Size1=%d MaxWidth=%d DIM:%d %d %d %d gapxy:%d %d',
[Size,Size1,MaxWidth,x,y,dx,dy,gapx,gapy]); [Size,Size1,MaxWidth,x,y,dx,dy,gapx,gapy]);
{$ENDIF} {$ENDIF}
for i := 0 to Memo1.Count - 1 do for i := 0 to Memo1.Count - 1 do
begin begin
maxWidth := dx - gapx - gapx - FParagraphGap;
if (Flags and flWordWrap) <> 0 then if (Flags and flWordWrap) <> 0 then
WrapLine(Memo1[i]) WrapLine(Memo1[i])
else else
@ -3777,6 +3801,7 @@ var
var var
i: Integer; i: Integer;
curyf, thf, linespc: double; curyf, thf, linespc: double;
FTmpFL:boolean;
function OutLine(st: String): Boolean; function OutLine(st: String): Boolean;
var var
@ -3803,8 +3828,12 @@ var
SetLength(St, n - 2); SetLength(St, n - 2);
if Length(St) > 0 then if Length(St) > 0 then
begin begin
FTmpFL:=false;
if St[Length(St)] = #1 then if St[Length(St)] = #1 then
SetLength(St, Length(St) - 1) begin
FTmpFL:=true;
SetLength(St, Length(St) - 1);
end
else else
LastLine := false; LastLine := false;
end; end;
@ -3847,12 +3876,27 @@ var
if not Exporting then if not Exporting then
begin begin
if Justify and not LastLine then if Justify and not LastLine then
CanvasTextRectJustify(Canvas, DR, x+gapx, x+dx-1-gapx, round(CurYf), St, true) begin
if FirstLine then
CanvasTextRectJustify(Canvas, DR, x+gapx + FParagraphGap, x+dx-1-gapx, round(CurYf), St, true)
else
CanvasTextRectJustify(Canvas, DR, x+gapx, x+dx-1-gapx, round(CurYf), St, true)
end
else else
Canvas.TextRect(DR, CurX, round(curYf), St); begin
if FirstLine then
Canvas.TextRect(DR, CurX + FParagraphGap, round(curYf), St)
else
Canvas.TextRect(DR, CurX, round(curYf), St);
end;
end end
else else
CurReport.InternalOnExportText(X, round(curYf), St, Self); begin
if FirstLine then
CurReport.InternalOnExportText(X + FParagraphGap, round(curYf), St, Self)
else
CurReport.InternalOnExportText(X, round(curYf), St, Self);
end;
Inc(CurStrNo); Inc(CurStrNo);
Result := False; Result := False;
@ -3861,6 +3905,7 @@ var
Result := True; Result := True;
curyf := curyf + thf; curyf := curyf + thf;
FirstLine:=FTmpFL;
end; end;
begin {OutMemo} begin {OutMemo}
@ -3868,7 +3913,8 @@ var
begin begin
if Layout=tlCenter then if Layout=tlCenter then
y:=y+(dy-VHeight) div 2 y:=y+(dy-VHeight) div 2
else if Layout=tlBottom then else
if Layout=tlBottom then
y:=y+dy-VHeight; y:=y+dy-VHeight;
end; end;
curyf := y + gapy; curyf := y + gapy;
@ -3885,6 +3931,9 @@ var
[curyf, thf, Canvas.Font.Height, Canvas.Textheight('H'), dbgs(DR), Memo1.Count]); [curyf, thf, Canvas.Font.Height, Canvas.Textheight('H'), dbgs(DR), Memo1.Count]);
{$ENDIF} {$ENDIF}
CurStrNo := 0; CurStrNo := 0;
FirstLine:=true;
for i := 0 to Memo1.Count - 1 do for i := 0 to Memo1.Count - 1 do
if OutLine(Memo1[i]) then if OutLine(Memo1[i]) then
break; break;
@ -4356,6 +4405,7 @@ begin
frReadMemo(Stream, FOnMouseEnter); frReadMemo(Stream, FOnMouseEnter);
frReadMemo(Stream, FOnMouseLeave); frReadMemo(Stream, FOnMouseLeave);
FDetailReport:=frReadString(Stream); FDetailReport:=frReadString(Stream);
Stream.Read(FParagraphGap, SizeOf(FParagraphGap));
end; end;
end; end;
@ -4393,6 +4443,7 @@ begin
FOnMouseLeave.Text:= XML.GetValue(Path+'Data/OnMouseLeave/Value', ''); FOnMouseLeave.Text:= XML.GetValue(Path+'Data/OnMouseLeave/Value', '');
FDetailReport:= XML.GetValue(Path+'Data/DetailReport/Value', ''); FDetailReport:= XML.GetValue(Path+'Data/DetailReport/Value', '');
FParagraphGap:=XML.GetValue(Path+'Data/ParagraphGap/Value', 0);
end; end;
procedure TfrCustomMemoView.SaveToStream(Stream: TStream); procedure TfrCustomMemoView.SaveToStream(Stream: TStream);
@ -4433,6 +4484,7 @@ begin
frWriteMemo(Stream, FOnMouseEnter); frWriteMemo(Stream, FOnMouseEnter);
frWriteMemo(Stream, FOnMouseLeave); frWriteMemo(Stream, FOnMouseLeave);
frWriteString(Stream, FDetailReport); frWriteString(Stream, FDetailReport);
Stream.Write(FParagraphGap, SizeOf(FParagraphGap));
end; end;
end; end;
@ -4463,6 +4515,7 @@ begin
XML.SetValue(Path+'Data/OnMouseLeave/Value', FOnMouseLeave.Text); XML.SetValue(Path+'Data/OnMouseLeave/Value', FOnMouseLeave.Text);
XML.SetValue(Path+'Data/DetailReport/Value', FDetailReport); XML.SetValue(Path+'Data/DetailReport/Value', FDetailReport);
XML.SetValue(Path+'Data/ParagraphGap/Value', FParagraphGap);
end; end;
procedure TfrCustomMemoView.GetBlob(b: TfrTField); procedure TfrCustomMemoView.GetBlob(b: TfrTField);
@ -5258,6 +5311,12 @@ begin
Parent.Visible := Avalue; Parent.Visible := Avalue;
end; end;
procedure TfrSubReportView.AfterLoad;
begin
inherited AfterLoad;
FSubPage:= CurReport.Pages[FSubPageIndex];
end;
{----------------------------------------------------------------------------} {----------------------------------------------------------------------------}
constructor TfrSubReportView.Create(AOwnerPage: TfrPage); constructor TfrSubReportView.Create(AOwnerPage: TfrPage);
begin begin
@ -5270,7 +5329,7 @@ procedure TfrSubReportView.Assign(Source: TPersistent);
begin begin
inherited Assign(Source); inherited Assign(Source);
if Source is TfrSubReportView then if Source is TfrSubReportView then
SubPage := TfrSubReportView(Source).SubPage; FSubPage := TfrSubReportView(Source).FSubPage;
end; end;
procedure TfrSubReportView.Draw(aCanvas: TCanvas); procedure TfrSubReportView.Draw(aCanvas: TCanvas);
@ -5291,8 +5350,7 @@ begin
Brush.Color := clWhite; Brush.Color := clWhite;
Rectangle(x, y, x + dx + 1, y + dy + 1); Rectangle(x, y, x + dx + 1, y + dy + 1);
Brush.Style := bsClear; Brush.Style := bsClear;
TextRect(DRect, x + 2, y + 2, sSubReportOnPage + ' ' + TextRect(DRect, x + 2, y + 2, sSubReportOnPage + ' ' + IntToStr(SubPage.PageIndex + 1));
IntToStr(SubPage + 1));
end; end;
RestoreCoord; RestoreCoord;
end; end;
@ -5305,13 +5363,13 @@ end;
procedure TfrSubReportView.LoadFromStream(Stream: TStream); procedure TfrSubReportView.LoadFromStream(Stream: TStream);
begin begin
inherited LoadFromStream(Stream); inherited LoadFromStream(Stream);
Stream.Read(SubPage, 4); Stream.Read(FSubPageIndex, 4);
end; end;
procedure TfrSubReportView.LoadFromXML(XML: TLrXMLConfig; const Path: String); procedure TfrSubReportView.LoadFromXML(XML: TLrXMLConfig; const Path: String);
begin begin
inherited LoadFromXML(XML, Path); inherited LoadFromXML(XML, Path);
SubPage := XML.GetValue(Path+'SubPage/Value'{%H-}, 0); // todo chk FSubPageIndex := XML.GetValue(Path+'SubPage/Value'{%H-}, 0); // todo chk
end; end;
procedure TfrSubReportView.SaveToStream(Stream: TStream); procedure TfrSubReportView.SaveToStream(Stream: TStream);
@ -5323,7 +5381,8 @@ end;
procedure TfrSubReportView.SaveToXML(XML: TLrXMLConfig; const Path: String); procedure TfrSubReportView.SaveToXML(XML: TLrXMLConfig; const Path: String);
begin begin
inherited SaveToXML(XML, Path); inherited SaveToXML(XML, Path);
XML.SetValue(Path+'SubPage/Value'{%H-}, SubPage); FSubPageIndex:=FSubPage.PageIndex;
XML.SetValue(Path+'SubPage/Value'{%H-}, FSubPageIndex);
end; end;
{----------------------------------------------------------------------------} {----------------------------------------------------------------------------}
@ -6220,7 +6279,7 @@ begin
t :=TfrView(Objects[i]); t :=TfrView(Objects[i]);
if t is TfrSubReportView then if t is TfrSubReportView then
begin begin
Page := CurReport.Pages[(t as TfrSubReportView).SubPage]; Page := (t as TfrSubReportView).SubPage;
Page.Mode := pmBuildList; Page.Mode := pmBuildList;
Page.FormPage; Page.FormPage;
Page.CurY := y + t.y; Page.CurY := y + t.y;
@ -6247,7 +6306,7 @@ begin
t :=TfrView(Objects[i]); t :=TfrView(Objects[i]);
if t is TfrSubReportView then if t is TfrSubReportView then
begin begin
Page := CurReport.Pages[(t as TfrSubReportView).SubPage]; Page := (t as TfrSubReportView).SubPage;
Page.CurY := Parent.CurY; Page.CurY := Parent.CurY;
Page.CurBottomY := Parent.CurBottomY; Page.CurBottomY := Parent.CurBottomY;
end; end;
@ -6259,7 +6318,7 @@ begin
t :=TfrView(Objects[i]); t :=TfrView(Objects[i]);
if (t is TfrSubReportView) and (not EOFArr[i - SubIndex]) then if (t is TfrSubReportView) and (not EOFArr[i - SubIndex]) then
begin begin
Page := CurReport.Pages[(t as TfrSubReportView).SubPage]; Page := (t as TfrSubReportView).SubPage;
if Page.PlayRecList then if Page.PlayRecList then
EOFReached := False EOFReached := False
else else
@ -6288,7 +6347,7 @@ begin
t :=TfrView(Objects[i]); t :=TfrView(Objects[i]);
if t is TfrSubReportView then if t is TfrSubReportView then
begin begin
Page := CurReport.Pages[(t as TfrSubReportView).SubPage]; Page := (t as TfrSubReportView).SubPage;
Page.ClearRecList; Page.ClearRecList;
end; end;
end; end;
@ -7311,7 +7370,7 @@ var
bt, t: TfrView; bt, t: TfrView;
Bnd, Bnd1: TfrBand; Bnd, Bnd1: TfrBand;
FirstBand, Flag: Boolean; FirstBand, Flag: Boolean;
BArr: Array[0..31] of TfrBand; BArr: Array[0..lrMaxBandsInReport - 1] of TfrBand;
s: String; s: String;
begin begin
for i := 0 to Objects.Count - 1 do for i := 0 to Objects.Count - 1 do
@ -7337,7 +7396,7 @@ begin
t.Parent := nil; t.Parent := nil;
frInterpretator.PrepareScript(t.Script, t.Script, SMemo); frInterpretator.PrepareScript(t.Script, t.Script, SMemo);
if t.Typ = gtSubReport then if t.Typ = gtSubReport then
CurReport.Pages[(t as TfrSubReportView).SubPage].Skip := True; (t as TfrSubReportView).SubPage.Skip := True;
end; end;
Flag := False; Flag := False;
for i := 0 to RTObjects.Count - 1 do // search for btCrossXXX bands for i := 0 to RTObjects.Count - 1 do // search for btCrossXXX bands
@ -7931,7 +7990,7 @@ begin
RowStarted := result; RowStarted := result;
end; end;
procedure TfrPage.DoAggregate(a: Array of TfrBandType); procedure TfrPage.DoAggregate(a: array of TfrBandType);
var var
i: Integer; i: Integer;
procedure DoAggregate1(bt: TfrBandType); procedure DoAggregate1(bt: TfrBandType);
@ -8328,6 +8387,11 @@ begin
Result := b.Objects.Count > 0; Result := b.Objects.Count > 0;
end; end;
function TfrPage.GetPageIndex: integer;
begin
Result:=CurReport.Pages.FPages.IndexOf(Self);
end;
procedure TfrPage.AfterPrint; procedure TfrPage.AfterPrint;
var var
i: Integer; i: Integer;
@ -8421,6 +8485,12 @@ begin
end; end;
end; end;
procedure TfrPage.SetPageIndex(AValue: integer);
begin
if (AValue>-1) and (AValue < CurReport.Pages.Count) and (GetPageIndex <> AValue) then
CurReport.Pages.Move(GetPageIndex, AValue);
end;
procedure TfrPage.SavetoXML(XML: TLrXMLConfig; const Path: String); procedure TfrPage.SavetoXML(XML: TLrXMLConfig; const Path: String);
begin begin
Inherited SavetoXML(XML,Path); Inherited SavetoXML(XML,Path);
@ -8472,24 +8542,25 @@ begin
FPages.Clear; FPages.Clear;
end; end;
procedure TfrPages.Add(const aClassName : string='TfrPageReport'); function TfrPages.Add(const aClassName: string): TfrPage;
Var Pg : TFrPage; var
Rf : TFrPageClass; Rf : TFrPageClass;
begin begin
Pg:=nil; Result := nil;
Rf:=TFrPageClass(GetClass(aClassName)); Rf:=TFrPageClass(GetClass(aClassName));
if Assigned(Rf) then if Assigned(Rf) then
begin begin
Pg:=Rf.CreatePage; Result := Rf.CreatePage;
if Assigned(Pg) then if Assigned(Result) then
begin begin
Pg.CreateUniqueName; Result.CreateUniqueName;
FPages.Add(Pg); FPages.Add(Result);
end; end;
end end
else showMessage(Format('Class %s not found',[aClassName])) else
ShowMessage(Format('Class %s not found',[aClassName]))
end; end;
procedure TfrPages.Delete(Index: Integer); procedure TfrPages.Delete(Index: Integer);
@ -8498,6 +8569,11 @@ begin
FPages.Delete(Index); FPages.Delete(Index);
end; end;
procedure TfrPages.Move(OldIndex, NewIndex: Integer);
begin
FPages.Move(OldIndex, NewIndex);
end;
procedure TfrPages.LoadFromStream(Stream: TStream); procedure TfrPages.LoadFromStream(Stream: TStream);
var var
b: Byte; b: Byte;

186
components/lazreport/source/lr_crossarray.pas
View File

@ -39,11 +39,32 @@ uses
type type
TVariantArray = array of Variant;
{ TVariantList }
TVariantList = class
private
FItems:TVariantArray;
FCount: integer;
function GetItems(AIndex: integer): Variant;
procedure SetItems(AIndex: integer; AValue: Variant);
public
constructor Create;
destructor Destroy; override;
function Insert(AValue:Variant):integer;
function Find(AValue:Variant; out Index: Integer): Boolean;
function AsString(AIndex: Integer):string;
procedure Clear;
property Count:integer read FCount;
property Items[AIndex:integer]:Variant read GetItems write SetItems;
end;
{ TExItem } { TExItem }
TExItem = class TExItem = class
private private
FCelCol:string; FCelCol:Variant;
FValue:Variant; FValue:Variant;
FDataset: TDataset; FDataset: TDataset;
FBookmark:TBookMark; FBookmark:TBookMark;
@ -59,7 +80,7 @@ type
TExRow = class(TFPList) TExRow = class(TFPList)
private private
FRow:string; FRow:Variant;
function GetCell(ACol: Variant): Variant; function GetCell(ACol: Variant): Variant;
function GetCellData(ACol: Variant): TExItem; function GetCellData(ACol: Variant): TExItem;
procedure SetCell(ACol: Variant; AValue: Variant); procedure SetCell(ACol: Variant; AValue: Variant);
@ -77,15 +98,15 @@ type
FColCount: integer; FColCount: integer;
FRowCount: integer; FRowCount: integer;
FRows:TFPList; FRows:TFPList;
FColHeader:TStringList; FRowHeader:TVariantList;
FRowHeader:TStringList; FColHeader:TVariantList;
function GetCell(ACol, ARow: variant): variant; function GetCell(ACol, ARow: variant): variant;
function GetCellData(ACol, ARow : variant): TExItem; function GetCellData(ACol, ARow : variant): TExItem;
function GetColCount: integer; function GetColCount: integer;
function GetColHeader(ACol: integer): string; function GetColHeader(ACol: integer): Variant;
function GetRowCount: integer; function GetRowCount: integer;
function GetRowHeader(ARow: integer): string; function GetRowHeader(ARow: integer): Variant;
procedure SetCell(ACol, ARow: variant; AValue: variant); procedure SetCell(ACol, ARow: variant; AValue: Variant);
function Find(ARow:variant; out Index: Integer): Boolean; function Find(ARow:variant; out Index: Integer): Boolean;
public public
constructor Create; constructor Create;
@ -95,8 +116,8 @@ type
property CellData[ACol, ARow : variant]:TExItem read GetCellData; property CellData[ACol, ARow : variant]:TExItem read GetCellData;
property ColCount:integer read GetColCount; property ColCount:integer read GetColCount;
property RowCount:integer read GetRowCount; property RowCount:integer read GetRowCount;
property ColHeader[ACol:integer]:string read GetColHeader; property ColHeader[ACol:integer]:Variant read GetColHeader;
property RowHeader[ARow:integer]:string read GetRowHeader; property RowHeader[ARow:integer]:Variant read GetRowHeader;
end; end;
implementation implementation
@ -104,6 +125,110 @@ uses math, variants;
{ TExItem } { TExItem }
function CompareVariant(AVal1, AVAl2:Variant):integer;
begin
if AVal1>AVAl2 then
Result := 1
else
if AVal1<AVAl2 then
Result := -1
else
Result :=0;
end;
{ TVariantList }
function TVariantList.GetItems(AIndex: integer): Variant;
begin
if (AIndex>=0) and (AIndex < Count) then
Result:=FItems[AIndex]
else
raise Exception.CreateFmt('Index % out of bounds %d:%d', [AIndex, 0, Count-1]);
end;
procedure TVariantList.SetItems(AIndex: integer; AValue: Variant);
begin
if (AIndex>=0) and (AIndex < Count) then
FItems[AIndex]:=AValue
else
raise Exception.CreateFmt('Index % out of bounds %d:%d', [AIndex, 0, Count-1]);
end;
constructor TVariantList.Create;
begin
inherited Create;
SetLength(FItems, 10);
FCount:=0;
end;
destructor TVariantList.Destroy;
begin
Clear;
SetLength(FItems, 0);
inherited Destroy;
end;
function TVariantList.Insert(AValue: Variant): integer;
var
FIndex: Integer;
i: Integer;
begin
if Length(FItems) = FCount then
SetLength(FItems, FCount + 100);
if not Find(AValue, FIndex) then
begin
for i:=FCount-1 downto FIndex do
FItems[i+1]:=FItems[i];
FItems[FIndex]:=AValue;
Inc(FCount);
end;
end;
function TVariantList.Find(AValue: Variant; out Index: Integer): Boolean;
var
L: Integer;
R: Integer;
I: Integer;
Dir: Integer;
begin
Result := false;
// Use binary search.
L := 0;
R := Count - 1;
while L<=R do
begin
I := (L+R) div 2;
Dir := CompareVariant(FItems[i], AValue);
if Dir < 0 then
L := I+1
else
begin
R := I-1;
if Dir = 0 then
begin
Result := true;
L := I;
end;
end;
end;
Index := L;
end;
function TVariantList.AsString(AIndex: Integer): string;
begin
Result:=VarToStr(GetItems(AIndex));
end;
procedure TVariantList.Clear;
var
i: Integer;
begin
for i:=0 to FCount-1 do
FItems[i]:=null;
FCount:=0;
end;
procedure TExItem.SaveBookmark(Ds: TDataset); procedure TExItem.SaveBookmark(Ds: TDataset);
begin begin
if IsBookmarkValid then if IsBookmarkValid then
@ -165,7 +290,6 @@ end;
function TExRow.Find(ACol: Variant; out Index: Integer): Boolean; function TExRow.Find(ACol: Variant; out Index: Integer): Boolean;
var var
I,L,R,Dir: Integer; I,L,R,Dir: Integer;
S1, S2:string;
begin begin
Result := false; Result := false;
// Use binary search. // Use binary search.
@ -174,10 +298,7 @@ begin
while L<=R do while L<=R do
begin begin
I := (L+R) div 2; I := (L+R) div 2;
// Dir := CompareStr(TExItem(Items[i]).FCelCol, VarToStr(ACol)); Dir := CompareVariant(TExItem(Items[i]).FCelCol,ACol);
S1:=TExItem(Items[i]).FCelCol;
S2:=VarToStr(ACol);
Dir := CompareStr(S1, S2);
if Dir < 0 then if Dir < 0 then
L := I+1 L := I+1
else else
@ -232,12 +353,12 @@ begin
Result:=FColHeader.Count; Result:=FColHeader.Count;
end; end;
function TExVarArray.GetColHeader(ACol: integer): string; function TExVarArray.GetColHeader(ACol: integer): Variant;
begin begin
if (ACol>=0) and (ACol<FColHeader.Count) then if (ACol>=0) and (ACol<FColHeader.Count) then
Result:=FColHeader[ACol] Result:=FColHeader.Items[ACol]
else else
Result:=''; Result:=null;
end; end;
function TExVarArray.GetRowCount: integer; function TExVarArray.GetRowCount: integer;
@ -245,15 +366,15 @@ begin
Result:=FRowHeader.Count; Result:=FRowHeader.Count;
end; end;
function TExVarArray.GetRowHeader(ARow: integer): string; function TExVarArray.GetRowHeader(ARow: integer): Variant;
begin begin
if (ARow>=0) and (ARow<FRowHeader.Count) then if (ARow>=0) and (ARow<FRowHeader.Count) then
Result:=FRowHeader[ARow] Result:=FRowHeader.Items[ARow]
else else
Result:=''; Result:=null;
end; end;
procedure TExVarArray.SetCell(ACol, ARow: variant; AValue: variant); procedure TExVarArray.SetCell(ACol, ARow: variant; AValue: Variant);
var var
R:TExRow; R:TExRow;
i:integer; i:integer;
@ -270,32 +391,25 @@ begin
FRowCount:=Max(FRowCount, FRows.Count); FRowCount:=Max(FRowCount, FRows.Count);
FColCount:=Max(FColCount, R.Count); FColCount:=Max(FColCount, R.Count);
i:=FColHeader.IndexOf(VarToStr(ACol)); if not FColHeader.Find(ACol, i) then
if i<0 then FColHeader.Insert(ACol);
FColHeader.Add(VarToStr(ACol));
i:=FRowHeader.IndexOf(VarToStr(ARow));
if i<0 then
FRowHeader.Add(VarToStr(ARow));
if not FRowHeader.Find(ARow, i) then
FRowHeader.Insert(ARow);
end; end;
function TExVarArray.Find(ARow: variant; out Index: Integer): Boolean; function TExVarArray.Find(ARow: variant; out Index: Integer): Boolean;
var var
I,L,R,Dir: Integer; I,L,R,Dir: Integer;
S1, S2:string;
begin begin
Result := false; Result := false;
// Use binary search. // Use binary search.
L := 0; L := 0;
R := FRows.Count - 1; R := FRows.Count - 1;
S2:=VarToStr(ARow);
while L<=R do while L<=R do
begin begin
I := (L+R) div 2; I := (L+R) div 2;
// Dir := CompareStr(TExRow(FRows[i]).FRow, VarToStr(ARow)); Dir := CompareVariant(TExRow(FRows[i]).FRow, ARow);
S1:=TExRow(FRows[i]).FRow;
Dir := CompareStr(S1, S2);
if Dir < 0 then if Dir < 0 then
L := I+1 L := I+1
else else
@ -316,10 +430,8 @@ constructor TExVarArray.Create;
begin begin
inherited Create; inherited Create;
FRows:=TFPList.Create; FRows:=TFPList.Create;
FColHeader:=TStringList.Create; FColHeader:=TVariantList.Create;
FColHeader.Sorted:=true; FRowHeader:=TVariantList.Create;
FRowHeader:=TStringList.Create;
FRowHeader.Sorted:=true;
end; end;
destructor TExVarArray.Destroy; destructor TExVarArray.Destroy;

23
components/lazreport/source/lr_crosstab.pas
View File

@ -303,9 +303,9 @@ var
FD:TField; FD:TField;
FR:TField; FR:TField;
FC:TField; FC:TField;
S, SR, SC: String; S: String;
P:TBookMark; P:TBookMark;
V, VT:Variant; V, VT, SR, SC:Variant;
FCalcTotal:boolean; FCalcTotal:boolean;
j: Integer; j: Integer;
i: Integer; i: Integer;
@ -383,7 +383,7 @@ begin
begin begin
if FCalcTotal then if FCalcTotal then
begin begin
V:=FExVarArray.Cell[FC.DisplayText, FR.DisplayText]; V:=FExVarArray.Cell[FC.Value, FR.Value];
if V = null then if V = null then
begin begin
if FuncNo in [2,3] then if FuncNo in [2,3] then
@ -391,12 +391,12 @@ begin
else else
V:=0; V:=0;
end; end;
FExVarArray.Cell[FC.DisplayText, FR.DisplayText]:=DoFunc(V, FD.AsFloat); FExVarArray.Cell[FC.Value, FR.Value]:=DoFunc(V, FD.AsFloat);
end end
else else
FExVarArray.Cell[FC.DisplayText, FR.DisplayText]:=FD.DisplayText; FExVarArray.Cell[FC.Value, FR.Value]:=FD.DisplayText;
ExItem:=FExVarArray.CellData[FC.DisplayText, FR.DisplayText]; ExItem:=FExVarArray.CellData[FC.Value, FR.Value];
if Assigned(ExItem) then if Assigned(ExItem) then
ExItem.SaveBookmark(FData); ExItem.SaveBookmark(FData);
FData.Next; FData.Next;
@ -545,10 +545,10 @@ end;
procedure TlrCrossView.OnEnterRect(AMemo: TStringList; AView: TfrView); procedure TlrCrossView.OnEnterRect(AMemo: TStringList; AView: TfrView);
var var
S, SC, SR: String; S: String;
ColNo: Integer; ColNo: Integer;
RecNo: Integer; RecNo: Integer;
V : Variant; V, SC, SR : Variant;
ExItem:TExItem; ExItem:TExItem;
begin begin
ColNo:=FBandCrossRowRT.Parent.DataSet.RecNo; ColNo:=FBandCrossRowRT.Parent.DataSet.RecNo;
@ -867,7 +867,12 @@ begin
FPage.ColCount := 1; FPage.ColCount := 1;
FPage.PlayFrom := 0; FPage.PlayFrom := 0;
FPage.PlayRecList; while FPage.PlayFrom < FPage.List.Count do
begin
FPage.PlayRecList;
{ if FPage.List.Count > FPage.PlayFrom then
FPage.NewPage;}
end;
FPage.DoneReport; FPage.DoneReport;
FPage.Free; FPage.Free;

144
components/lazreport/source/lr_desgn.lfm
View File

@ -23,12 +23,12 @@ object frDesignerForm: TfrDesignerForm
OnResize = FormResize OnResize = FormResize
OnShow = FormShow OnShow = FormShow
ShowHint = True ShowHint = True
LCLVersion = '1.3' LCLVersion = '1.5'
WindowState = wsMaximized WindowState = wsMaximized
object StatusBar1: TStatusBar object StatusBar1: TStatusBar
Left = 0 Left = 0
Height = 25 Height = 23
Top = 382 Top = 384
Width = 695 Width = 695
Panels = < Panels = <
item item
@ -120,42 +120,6 @@ object frDesignerForm: TfrDesignerForm
Action = FileOpen Action = FileOpen
Align = alLeft Align = alLeft
Flat = True Flat = True
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000298EDEFF2986DEFF298EDEFF298EDEFF298EDEFF298EDEFF298EDEFF298E
DEFF298EDEFF298EDEFF2986DEFF298EDEFF2986DEFF0000000000000000318E
DEFFDEF7FFFFA5DFF7FF9CDFF7FF94DFF7FF8CDFF7FF84D7F7FF7BD7F7FF7BD7
F7FF73D7F7FF6BD7F7FF6BCFF7FFC6EFFFFF318EDEFF00000000000000003196
DEFFEFFFFFFFA5EFFFFF94E7FFFF84E7F7FF73DFF7FF63DFF7FF52D7F7FF42D7
F7FF39D7F7FF29CFF7FF21CFF7FFCEF7FFFF3196DEFF0000000000000000319E
DEFFF7FFFFFFB5EFFFFFA5EFFFFF94E7FFFF84E7F7FF73DFF7FF63DFF7FF52D7
F7FF4AD7F7FF39D7F7FF31CFF7FFCEF7FFFF319EDEFF000000000000000031A6
DEFFF7FFFFFFCEF7FFFFBDEFFFFFADEFFFFF9CEFFFFF8CE7F7FF7BE7F7FF6BDF
F7FF5ADFF7FF4AD7F7FF42D7F7FFD6F7FFFF319EDEFF000000000000000031A6
DEFFFFFFFFFFFFFFFFFFF7FFFFFFF7FFFFFFF7FFFFFFDEF7FFFF94E7FFFF84E7
F7FF73DFF7FF6BDFF7FF5ADFF7FFD6F7FFFF31A6DEFF000000000000000031AE
DEFFEFF7FFFF94D7EFFF8CCFEFFF73C7EFFFCEEFF7FFF7FFFFFFF7FFFFFFF7FF
FFFFF7FFFFFFEFFFFFFFEFFFFFFFFFFFFFFF31AEDEFF000000000000000031AE
DEFFF7FFFFFF94DFF7FF94DFF7FF84D7F7FF6BCFEFFF6BCFEFFF84D7EFFF84D7
EFFF7BD7EFFF73CFEFFF73CFEFFFEFF7FFFF31AEDEFF000000000000000031AE
DEFFF7FFFFFF8CE7FFFF94DFF7FF9CE7F7FFADE7F7FFEFFFFFFFF7FFFFFFF7FF
FFFFF7FFFFFFEFFFFFFFEFFFFFFFFFFFFFFF31AEDEFF000000000000000031B6
DEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFF7FFFF6BC7E7FF6BC7
E7FF6BC7E7FF6BC7E7FF7BCFE7FF73CFE7FF00000000000000000000000031B6
DEFF5AC7E7FF63C7E7FF63C7E7FF63C7E7FF5AC7E7FF39B6DEFF000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000
}
ShowCaption = False ShowCaption = False
end end
object FileBtn3: TSpeedButton object FileBtn3: TSpeedButton
@ -167,42 +131,6 @@ object frDesignerForm: TfrDesignerForm
Action = FileSave Action = FileSave
Align = alLeft Align = alLeft
Flat = True Flat = True
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000BD6931FFBD69
31FFBD6931FFB56931FFB56931FFB56531FFB56531FFB56531FFAD6531FFAD61
31FFAD6131FFAD6131FFAD6131FFA56131FFA56131FFAD6131FFBD6931FFEFC7
ADFFEFC7ADFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFCE9E7BFFC69E7BFFA56131FFBD6931FFEFCF
B5FFE7A67BFFFFFFF7FF63C78CFF63C78CFF63C78CFF63C78CFF63C78CFF63C7
8CFF63C78CFF63C78CFFFFFFF7FFCE8E63FFCE9E7BFFA56131FFBD6D39FFEFCF
B5FFE7A67BFFFFFFF7FFBDDFC6FFBDDFC6FFBDDFC6FFBDDFC6FFBDDFC6FFBDDF
C6FFBDDFC6FFBDDFC6FFFFFFF7FFCE966BFFCE9E84FFAD6131FFBD6939FFEFCF
BDFFE7A67BFFFFFFF7FF63C78CFF63C78CFF63C78CFF63C78CFF63C78CFF63C7
8CFF63C78CFF63C78CFFFFFFF7FFCE966BFFCEA684FFAD6131FFBD6931FFEFD7
BDFFE7A67BFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFD6966BFFD6A68CFFAD6131FFBD6931FFF7D7
BDFFE7A67BFFE7A67BFFE7A67BFFE7A67BFFE7A67BFFE7A67BFFDE9E73FFDE9E
73FFDE9E73FFDE9E73FFDE9E73FFD69E73FFD6AE8CFFAD6131FFBD6931FFF7D7
C6FFE7A67BFFE7A67BFFE7A67BFFE7A67BFFE7A67BFFE7A67BFFE7A67BFFDEA6
73FFDE9E73FFDE9E73FFDE9E73FFDE9E73FFDEB694FFAD6531FFBD6931FFF7DF
C6FFE7A67BFFE7A67BFFE7A67BFFE7A67BFFE7A67BFFE7A67BFFE7A67BFFDEA6
73FFDE9E73FFDE9E73FFDE9E73FFDE9E73FFDEB69CFFB56531FFBD6931FFF7DF
C6FFE7A67BFFCE8E63FFCE8E63FFCE8E63FFCE966BFFCE966BFFCE966BFFCE8E
63FFCE8E63FFCE8E63FFCE8E63FFDE9E73FFE7BE9CFFB56531FFBD6931FFF7DF
CEFFE7A67BFFFFEFE7FFFFEFE7FFFFEFE7FFFFF7EFFFFFFFF7FFFFF7F7FFFFEF
E7FFF7E7DEFFF7E7DEFFF7E7DEFFDEA673FFE7BEA5FFB56531FFBD6931FFF7DF
CEFFE7AE7BFFFFF7EFFFFFF7EFFFCE8E63FFFFF7EFFFFFFFF7FFFFFFFFFFFFF7
EFFFFFEFDEFFF7E7DEFFF7E7DEFFE7A67BFFE7C7ADFFB56931FFBD6931FFF7DF
D6FFEFAE7BFFFFF7F7FFFFF7F7FFCE8E63FFFFF7EFFFFFF7EFFFFFFFF7FFFFFF
F7FFFFF7EFFFFFEFDEFFF7E7DEFFE7A67BFFEFD7C6FFB56931FFBD6931FFF7DF
D6FFEFAE84FFFFFFF7FFFFFFF7FFCE8E63FFFFF7EFFFFFF7EFFFFFF7F7FFFFFF
FFFFFFF7F7FFFFEFE7FFFFE7DEFFEFD7BDFFEFD7BDFFBD7139FFBD6931FFF7E7
D6FFF7E7D6FFFFFFFFFFFFFFF7FFFFFFF7FFFFF7F7FFFFF7EFFFFFF7EFFFFFFF
F7FFFFFFF7FFFFF7EFFFFFEFDEFFEFD7BDFFCE8E5AFF0000000000000000BD69
31FFBD6931FFBD6931FFBD6931FFBD6931FFBD6931FFBD6931FFBD6931FFBD6D
39FFBD6D39FFBD6D39FFBD6939FFBD7139FF0000000000000000
}
ShowCaption = False ShowCaption = False
end end
object FileBtn4: TSpeedButton object FileBtn4: TSpeedButton
@ -214,42 +142,6 @@ object frDesignerForm: TfrDesignerForm
Action = FilePreview Action = FilePreview
Align = alLeft Align = alLeft
Flat = True Flat = True
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000005A7DADFF5A86B5FF5A86B5FF5A86BDFF5A7D
B5FF5275ADFF0000000000000000000000000000000000000000000000000000
0000BDC7CEFF94AEC6FF84AEDEFF8CB6EFFF9CBEEFFFA5C7E7FFA5BEE7FFA5BE
E7FF94B6E7FF6B9EE7FF6386C6FF8496B5FF000000000000000000000000C6CF
DEFF9CBEE7FF9CC7EFFFBDD7EFFFD6DFEFFFE7E7EFFFEFEFEFFFEFEFEFFFEFEF
EFFFEFEFEFFFCED7EFFF94B6E7FF6396E7FF738EBDFF00000000D6DFE7FFADCF
EFFFC6D7EFFFE7E7EFFFEFEFEFFFEFDFD6FFE7BEA5FFDE9E73FFDE9E73FFDEB6
94FFEFD7CEFFF7F7F7FFE7EFEFFFB5CFEFFF6396E7FF849EC6FFC6D7E7FFD6E7
EFFFF7F7F7FFF7F7F7FFF7E7DEFFE7B69CFFE7A67BFFE79E73FFDE9E6BFFDE96
63FFE7A67BFFEFDFCEFFF7F7F7FFF7F7F7FFCED7E7FF7BA6DEFFDEE7E7FFEFEF
EFFFF7F7F7FFFFFFFFFFF7D7BDFFEFB68CFFE7AE84FFE7A67BFFE7A673FFE79E
73FFE7966BFFEFBE9CFFFFFFFFFFF7F7F7FFEFEFEFFF94B6DEFFB5CFDEFFDEE7
EFFFF7F7F7FFFFFFFFFFF7C7ADFFEFBE9CFFEFB694FF181008FF181008FFE7A6
7BFFE79E73FFE7A67BFFFFFFFFFFF7F7F7FFD6DFEFFF6B8ECEFFD6DFE7FFADCF
E7FFBDCFD6FFFFFFFFFFF7CFB5FFEFBEA5FFEFBE9CFF181410FF181408FFEFAE
84FFEFA67BFFEFAE84FFFFFFFFFFC6D7E7FF7BA6E7FF739ED6FFE7E7E7FFC6D7
E7FFB5D7EFFF94AEBDFFD6CFC6FFEFC7ADFFEFC7A5FFEFBE9CFFEFB694FFEFB6
8CFFEFAE84FFEFC7B5FFA5BEDEFF84AEE7FF84B6F7FFC6D7E7FF00000000E7E7
E7FFC6D7E7FFBDD7EFFFA5BED6FF8CA6B5FF9CA6ADFFB5AEA5FFB5A6A5FFB5A6
9CFF9C9EA5FF849EC6FF94BEEFFF94BEEFFFBDD7EFFF00000000000000000000
0000E7E7E7FFCEDFE7FFBDD7EFFFBDD7EFFFB5CFEFFFA5BEDEFF9CBED6FF9CBE
DEFFADCFF7FFA5C7EFFFA5C7EFFFD6DFEFFF0000000000000000000000000000
00000000000000000000DEDFE7FFC6D7E7FFBDD7E7FFBDCFE7FFB5CFE7FFB5CF
E7FFB5CFE7FFC6D7E7FF00000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000
}
ShowCaption = False ShowCaption = False
end end
object CutB: TSpeedButton object CutB: TSpeedButton
@ -2324,7 +2216,7 @@ object frDesignerForm: TfrDesignerForm
object E1: TEdit object E1: TEdit
Tag = 6 Tag = 6
Left = 4 Left = 4
Height = 31 Height = 33
Top = 1 Top = 1
Width = 31 Width = 31
TabOrder = 0 TabOrder = 0
@ -2389,21 +2281,21 @@ object frDesignerForm: TfrDesignerForm
end end
object frDock2: TPanel object frDock2: TPanel
Left = 0 Left = 0
Height = 299 Height = 301
Top = 83 Top = 83
Width = 27 Width = 27
Align = alLeft Align = alLeft
ClientHeight = 299 ClientHeight = 301
ClientWidth = 27 ClientWidth = 27
FullRepaint = False FullRepaint = False
TabOrder = 1 TabOrder = 1
object panForDlg: TPanel object panForDlg: TPanel
Left = 1 Left = 1
Height = 297 Height = 299
Top = 1 Top = 1
Width = 25 Width = 25
Align = alClient Align = alClient
ClientHeight = 297 ClientHeight = 299
ClientWidth = 25 ClientWidth = 25
FullRepaint = False FullRepaint = False
TabOrder = 1 TabOrder = 1
@ -2469,11 +2361,11 @@ object frDesignerForm: TfrDesignerForm
end end
object Panel4: TPanel object Panel4: TPanel
Left = 1 Left = 1
Height = 297 Height = 299
Top = 1 Top = 1
Width = 25 Width = 25
Align = alClient Align = alClient
ClientHeight = 297 ClientHeight = 299
ClientWidth = 25 ClientWidth = 25
FullRepaint = False FullRepaint = False
TabOrder = 0 TabOrder = 0
@ -2772,7 +2664,7 @@ object frDesignerForm: TfrDesignerForm
end end
object Tab1: TTabControl object Tab1: TTabControl
Left = 27 Left = 27
Height = 299 Height = 301
Top = 83 Top = 83
Width = 641 Width = 641
TabStop = False TabStop = False
@ -2786,24 +2678,24 @@ object frDesignerForm: TfrDesignerForm
TabOrder = 2 TabOrder = 2
object panTab: TPanel object panTab: TPanel
Left = 2 Left = 2
Height = 267 Height = 266
Top = 30 Top = 33
Width = 637 Width = 637
Align = alClient Align = alClient
BevelOuter = bvNone BevelOuter = bvNone
Caption = 'panTab' Caption = 'panTab'
ClientHeight = 267 ClientHeight = 266
ClientWidth = 637 ClientWidth = 637
TabOrder = 1 TabOrder = 1
object ScrollBox1: TScrollBox object ScrollBox1: TScrollBox
Left = 0 Left = 0
Height = 267 Height = 266
Top = 0 Top = 0
Width = 637 Width = 637
HorzScrollBar.Page = 488 HorzScrollBar.Page = 488
VertScrollBar.Page = 174 VertScrollBar.Page = 174
Align = alClient Align = alClient
ClientHeight = 265 ClientHeight = 264
ClientWidth = 635 ClientWidth = 635
Color = clGray Color = clGray
ParentColor = False ParentColor = False
@ -4066,12 +3958,12 @@ object frDesignerForm: TfrDesignerForm
end end
object frDock4: TPanel object frDock4: TPanel
Left = 668 Left = 668
Height = 299 Height = 301
Top = 83 Top = 83
Width = 27 Width = 27
Align = alRight Align = alRight
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
ClientHeight = 299 ClientHeight = 301
ClientWidth = 27 ClientWidth = 27
FullRepaint = False FullRepaint = False
TabOrder = 3 TabOrder = 3

199
components/lazreport/source/lr_desgn.pas
View File

@ -43,6 +43,7 @@ type
SaveAs: Boolean; var Saved: Boolean) of object; SaveAs: Boolean; var Saved: Boolean) of object;
TfrDesignerForm = class; TfrDesignerForm = class;
TlrTabEditControl = class(TCustomTabControl);
{ TfrDesigner } { TfrDesigner }
@ -623,6 +624,14 @@ type
procedure DuplicateView(View: TfrView; Data: PtrInt); procedure DuplicateView(View: TfrView; Data: PtrInt);
procedure ResetDuplicateCount; procedure ResetDuplicateCount;
function lrDesignAcceptDrag(const Source: TObject): TControl; function lrDesignAcceptDrag(const Source: TObject): TControl;
private
FTabMouseDown:boolean;
FTabsPage:TlrTabEditControl;
procedure TabsEditDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure TabsEditDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure TabsEditMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure TabsEditMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure TabsEditMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
protected protected
procedure SetModified(AValue: Boolean);override; procedure SetModified(AValue: Boolean);override;
function IniFileName:string; function IniFileName:string;
@ -1777,11 +1786,8 @@ var
procedure CreateSubReport; procedure CreateSubReport;
begin begin
{ Objects.Add(TfrSubReportView.Create(FDesigner.Page));
t := TfrView(Objects.Last);}
t:=TfrSubReportView.Create(FDesigner.Page); t:=TfrSubReportView.Create(FDesigner.Page);
(t as TfrSubReportView).SubPage := CurReport.Pages.Count; (t as TfrSubReportView).SubPage := CurReport.Pages.Add;
CurReport.Pages.Add;
end; end;
begin begin
@ -2907,6 +2913,14 @@ begin
StatusBar1.OnDrawPanel := @StatusBar1Drawpanel; StatusBar1.OnDrawPanel := @StatusBar1Drawpanel;
Panel7.Visible := false; Panel7.Visible := false;
{$endif} {$endif}
FTabsPage:=TlrTabEditControl((Tab1.Tabs as TTabControlNoteBookStrings).NoteBook);
FTabsPage.DragMode:=dmManual;
FTabsPage.OnDragOver:=@TabsEditDragOver;
FTabsPage.OnDragDrop:=@TabsEditDragDrop;
FTabsPage.OnMouseDown:=@TabsEditMouseDown;
FTabsPage.OnMouseMove:=@TabsEditMouseMove;
FTabsPage.OnMouseUp:=@TabsEditMouseUp;
end; end;
destructor TfrDesignerForm.Destroy; destructor TfrDesignerForm.Destroy;
@ -3759,30 +3773,28 @@ begin
end; end;
procedure TfrDesignerForm.RemovePage(n: Integer); procedure TfrDesignerForm.RemovePage(n: Integer);
procedure AdjustSubReports;
var procedure AdjustSubReports(APage:TfrPage);
i, j: Integer; var
t: TfrView; i, j: Integer;
t: TfrView;
begin
for i := 0 to CurReport.Pages.Count - 1 do
begin begin
with CurReport do j := 0;
for i := 0 to Pages.Count - 1 do while j < CurReport.Pages[i].Objects.Count do
begin
t := TfrView(CurReport.Pages[i].Objects[j]);
if (T is TfrSubReportView) and (TfrSubReportView(t).SubPage = APage) then
begin begin
j := 0; CurReport.Pages[i].Delete(j);
while j < Pages[i].Objects.Count do Dec(j);
begin
t := TfrView(Pages[i].Objects[j]);
if t.Typ = gtSubReport then
if TfrSubReportView(t).SubPage = n then
begin
Pages[i].Delete(j);
Dec(j);
end
else if TfrSubReportView(t).SubPage > n then
Dec(TfrSubReportView(t).SubPage);
Inc(j);
end;
end; end;
Inc(j);
end;
end; end;
end;
begin begin
fInBuildPage:=True; fInBuildPage:=True;
try try
@ -3794,10 +3806,10 @@ begin
Pages[n].Clear Pages[n].Clear
else else
begin begin
AdjustSubReports(Pages[n]);
CurReport.Pages.Delete(n); CurReport.Pages.Delete(n);
Tab1.Tabs.Delete(n); Tab1.Tabs.Delete(n);
Tab1.TabIndex := 0; Tab1.TabIndex := 0;
AdjustSubReports;
CurPage := 0; CurPage := 0;
end; end;
end; end;
@ -3813,37 +3825,35 @@ var
i: Integer; i: Integer;
s: String; s: String;
function IsSubreport(PageN: Integer): Boolean; function IsSubreport(PageN: Integer): Boolean;
var var
i, j: Integer; i, j: Integer;
t: TfrView; t: TfrView;
begin begin
Result := False; Result := False;
with CurReport do for i := 0 to CurReport.Pages.Count - 1 do
for i := 0 to Pages.Count - 1 do for j := 0 to CurReport.Pages[i].Objects.Count - 1 do
for j := 0 to Pages[i].Objects.Count - 1 do begin
begin t := TfrView(CurReport.Pages[i].Objects[j]);
t := TfrView(Pages[i].Objects[j]); if (T is TfrSubReportView) and (TfrSubReportView(t).SubPage = CurReport.Pages[PageN]) then
if t.Typ = gtSubReport then begin
if TfrSubReportView(t).SubPage = PageN then s := t.Name;
begin Result := True;
s := t.Name; Exit;
Result := True; end;
Exit; end;
end; end;
end;
end;
begin begin
if Tab1.Tabs.Count = CurReport.Pages.Count then if Tab1.Tabs.Count = CurReport.Pages.Count then
begin
for i := 0 to Tab1.Tabs.Count - 1 do
begin begin
for i := 0 to Tab1.Tabs.Count - 1 do if not IsSubreport(i) then
begin s := sPg + IntToStr(i + 1);
if not IsSubreport(i) then if Tab1.Tabs[i] <> s then
s := sPg + IntToStr(i + 1); Tab1.Tabs[i] := s;
if Tab1.Tabs[i] <> s then end;
Tab1.Tabs[i] := s;
end;
end end
else else
begin begin
@ -4465,6 +4475,52 @@ end;
{$endif} {$endif}
procedure TfrDesignerForm.TabsEditDragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
begin
Accept:=(Source = FTabsPage) and (FTabsPage.IndexOfTabAt(X, Y) <> Tab1.TabIndex);
end;
procedure TfrDesignerForm.TabsEditDragDrop(Sender, Source: TObject; X,
Y: Integer);
var
NewIndex: Integer;
begin
NewIndex:=FTabsPage.IndexOfTabAt(X, Y);
//ShowMessageFmt('New index = %d', [NewIndex]);
if (NewIndex>-1) and (NewIndex < CurReport.Pages.Count) then
begin
CurReport.Pages.Move(CurPage, NewIndex);
Tab1.Tabs.Move(CurPage, NewIndex);
SetPageTitles;
ClearUndoBuffer;
ClearRedoBuffer;
Modified := True;
Tab1.TabIndex:=NewIndex;
RedrawPage;
end;
end;
procedure TfrDesignerForm.TabsEditMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
FTabMouseDown:=true;
end;
procedure TfrDesignerForm.TabsEditMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
if FTabMouseDown then
FTabsPage.BeginDrag(false);
end;
procedure TfrDesignerForm.TabsEditMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
FTabMouseDown:=false;
end;
procedure TfrDesignerForm.SetModified(AValue: Boolean); procedure TfrDesignerForm.SetModified(AValue: Boolean);
begin begin
inherited SetModified(AValue); inherited SetModified(AValue);
@ -5290,7 +5346,7 @@ begin
end end
else else
if t.Typ = gtSubReport then if t.Typ = gtSubReport then
CurPage := (t as TfrSubReportView).SubPage CurPage := (t as TfrSubReportView).SubPage.PageIndex
else else
if t.Typ = gtAddIn then if t.Typ = gtAddIn then
begin begin
@ -6271,7 +6327,7 @@ var
end; end;
begin begin
Ini:=TIniFile.Create(IniFileName); Ini:=TIniFile.Create(UTF8ToSys(IniFileName));
Ini.WriteString('frEditorForm', 'ScriptFontName', edtScriptFontName); Ini.WriteString('frEditorForm', 'ScriptFontName', edtScriptFontName);
Ini.WriteInteger('frEditorForm', 'ScriptFontSize', edtScriptFontSize); Ini.WriteInteger('frEditorForm', 'ScriptFontSize', edtScriptFontSize);
@ -6318,7 +6374,7 @@ var
begin begin
if FileExistsUTF8(IniFileName) then if FileExistsUTF8(IniFileName) then
begin begin
Ini:=TIniFile.Create(IniFileName); Ini:=TIniFile.Create(UTF8ToSys(IniFileName));
edtScriptFontName:=Ini.ReadString('frEditorForm', 'ScriptFontName', edtScriptFontName); edtScriptFontName:=Ini.ReadString('frEditorForm', 'ScriptFontName', edtScriptFontName);
edtScriptFontSize:=Ini.ReadInteger('frEditorForm', 'ScriptFontSize', edtScriptFontSize); edtScriptFontSize:=Ini.ReadInteger('frEditorForm', 'ScriptFontSize', edtScriptFontSize);
GridSize := Ini.ReadInteger('frEditorForm', rsGridSize, 4); GridSize := Ini.ReadInteger('frEditorForm', rsGridSize, 4);
@ -7634,6 +7690,35 @@ type
procedure Edit; override; procedure Edit; override;
end; end;
{ TTfrBandViewChildProperty }
TTfrBandViewChildProperty = class(TStringProperty)
public
function GetAttributes: TPropertyAttributes; override;
procedure GetValues(Proc: TGetStrProc); override;
end;
{ TTfrBandViewChildProperty }
function TTfrBandViewChildProperty.GetAttributes: TPropertyAttributes;
begin
Result:=inherited GetAttributes + [paValueList, paSortList];
end;
procedure TTfrBandViewChildProperty.GetValues(Proc: TGetStrProc);
var
I: Integer;
begin
if Assigned(frDesigner) and Assigned(frDesigner.Page) then
begin
for i:=0 to frDesigner.Page.Objects.Count-1 do
if TObject(frDesigner.Page.Objects[i]) is TfrBandView then
if (TfrBandView(frDesigner.Page.Objects[i]).BandType = btChild) and
(TfrBandView(GetComponent(0)) <> TfrBandView(frDesigner.Page.Objects[i])) then
Proc(TfrBandView(frDesigner.Page.Objects[i]).Name);
end;
end;
{ TfrPictureViewDataFieldProperty } { TfrPictureViewDataFieldProperty }
function TfrViewDataFieldProperty.GetAttributes: TPropertyAttributes; function TfrViewDataFieldProperty.GetAttributes: TPropertyAttributes;
@ -8092,6 +8177,8 @@ initialization
RegisterPropertyEditor(TypeInfo(String), TfrCustomMemoView, 'DetailReport', TfrCustomMemoViewDetailReportProperty); RegisterPropertyEditor(TypeInfo(String), TfrCustomMemoView, 'DetailReport', TfrCustomMemoViewDetailReportProperty);
RegisterPropertyEditor(TypeInfo(String), TfrView, 'DataField', TfrViewDataFieldProperty); RegisterPropertyEditor(TypeInfo(String), TfrView, 'DataField', TfrViewDataFieldProperty);
RegisterPropertyEditor(TypeInfo(String), TfrBandView, 'Child', TTfrBandViewChildProperty);
FlrInternalTools:=TlrInternalTools.Create; FlrInternalTools:=TlrInternalTools.Create;
finalization finalization
If Assigned(frDesigner) then If Assigned(frDesigner) then

85
components/lazreport/source/lr_utils.pas
View File

@ -20,7 +20,7 @@ uses
{$IFDEF WIN32} {$IFDEF WIN32}
Windows, Windows,
{$ENDIF} {$ENDIF}
LCLType, LCLIntf, LazUTF8, LConvEncoding; LCLType, LCLIntf, LConvEncoding;
type type
TUTF8Item=packed record TUTF8Item=packed record
@ -70,6 +70,10 @@ function lrExpandVariables(const S:string):string;
procedure lrNormalizeLocaleFloats(DisableLocale: boolean); procedure lrNormalizeLocaleFloats(DisableLocale: boolean);
function lrConfigFolderName(ACreatePath: boolean): string; function lrConfigFolderName(ACreatePath: boolean): string;
procedure CanvasTextRectJustify(const Canvas:TCanvas;
const ARect: TRect; X1, X2, Y: integer; const Text: string;
Trimmed: boolean);
// utf8 tools // utf8 tools
function UTF8Desc(S:string; var Desc: string): Integer; deprecated; function UTF8Desc(S:string; var Desc: string): Integer; deprecated;
function UTF8Char(S:string; index:Integer; Desc:string): TUTF8Char; deprecated; function UTF8Char(S:string; index:Integer; Desc:string): TUTF8Char; deprecated;
@ -83,7 +87,7 @@ function UTF8CountWords(const str:string; out WordCount,SpcCount,SpcSize:Integer
implementation implementation
uses LR_Class, LR_Const, LR_Pars, FileUtil, LazUtilsStrConsts, LR_DSet, uses LR_Class, LR_Const, LR_Pars, FileUtil, LazUtilsStrConsts, LR_DSet,
LR_DBComponent, strutils; LR_DBComponent, strutils, LazUTF8;
var var
PreviousFormatSettings: TFormatSettings; PreviousFormatSettings: TFormatSettings;
@ -1086,4 +1090,81 @@ begin
end; end;
end; end;
procedure CanvasTextRectJustify(const Canvas:TCanvas;
const ARect: TRect; X1, X2, Y: integer; const Text: string;
Trimmed: boolean);
var
WordCount,SpcCount,SpcSize:Integer;
Arr: TArrUTF8Item;
PxSpc,RxSpc,Extra: Integer;
i: Integer;
Cini,Cend: Integer;
SpaceWidth, AvailWidth: Integer;
s:string;
begin
AvailWidth := (X2-X1);
// count words
Arr := UTF8CountWords(Text, WordCount, SpcCount, SpcSize);
// handle trimmed text
s := Text;
if (SpcCount>0) then
begin
Cini := 0;
CEnd := Length(Arr)-1;
if Trimmed then
begin
s := UTF8Trim(Text, [u8tKeepStart]);
if Arr[CEnd].Space then
begin
Dec(CEnd);
Dec(SpcCount);
end;
end;
AvailWidth := AvailWidth - Canvas.TextWidth(s);
end;
// check if long way is needed
if (SpcCount>0) and (AvailWidth>0) then
begin
SpaceWidth := Canvas.TextWidth(' ');
PxSpc := AvailWidth div SpcCount;
RxSpc := AvailWidth mod SpcCount;
if PxSPC=0 then
begin
PxSPC := 1;
RxSpc := 0;
end;
for i:=CIni to CEnd do
if Arr[i].Space then
begin
X1 := X1 + Arr[i].Count * SpaceWidth;
if AvailWidth>0 then
begin
Extra := PxSpc;
if RxSpc>0 then
begin
Inc(Extra);
Dec(RxSpc);
end;
X1 := X1 + Extra;
Dec(AvailWidth, Extra);
end;
end
else
begin
s := Copy(Text, Arr[i].Index, Arr[i].Count);
Canvas.TextRect(ARect, X1, Y, s);
X1 := X1 + Canvas.TextWidth(s);
end;
end else
Canvas.TextRect(ARect, X1, Y, s);
SetLength(Arr, 0);
end;
end. end.