mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-16 19:29:34 +02:00
LazReport: Patch from Aleksey Lagunov:
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
parent
2f05933d7f
commit
f54444c6ae
@ -103,7 +103,7 @@ implementation
|
||||
{$R lr_zeos_img.res}
|
||||
|
||||
uses LR_Utils, DBPropEdits, PropEdits, LazarusPackageIntf, ZDbcIntfs, types,
|
||||
lr_EditParams, Forms, Controls, variants, Dialogs;
|
||||
lr_EditParams, Forms, Controls, variants, Dialogs, strutils;
|
||||
|
||||
var
|
||||
lrBMP_ZQuery:TBitmap = nil;
|
||||
@ -316,6 +316,9 @@ end;
|
||||
procedure TLRZQuery.AfterLoad;
|
||||
var
|
||||
D:TComponent;
|
||||
SPage: String;
|
||||
S: String;
|
||||
Z: TLRZConnection;
|
||||
begin
|
||||
D:=frFindComponent(OwnerForm, DataSource);
|
||||
if Assigned(D) and (D is TDataSource)then
|
||||
@ -326,6 +329,21 @@ begin
|
||||
begin
|
||||
TZQuery(DataSet).Connection:=TZConnection(D);
|
||||
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;
|
||||
|
||||
@ -339,7 +357,7 @@ begin
|
||||
DataSet.Active:=false;
|
||||
D:=frFindComponent(TZQuery(DataSet).Owner, FDatabase);
|
||||
if Assigned(D) and (D is TZConnection)then
|
||||
TZQuery(DataSet).Connection:=TZConnection(D);
|
||||
TZQuery(DataSet).Connection:=TZConnection(D)
|
||||
end;
|
||||
|
||||
procedure TLRZQuery.ZQueryBeforeOpen(ADataSet: TDataSet);
|
||||
@ -610,9 +628,31 @@ end;
|
||||
|
||||
{ TLRZQueryDataBaseProperty }
|
||||
procedure TLRZQueryDataBaseProperty.FillValues(const Values: TStringList);
|
||||
var
|
||||
i: Integer;
|
||||
j: Integer;
|
||||
S: String;
|
||||
begin
|
||||
if (GetComponent(0) is TLRZQuery) then
|
||||
begin
|
||||
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;
|
||||
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
<?xml version="1.0"?>
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<Package Version="4">
|
||||
<Name Value="LR_ZeosDB"/>
|
||||
@ -8,39 +8,29 @@
|
||||
<SearchPaths>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Description Value="Add support to ZEOSdb components for designing LazReport dialogs at runtime with lr_dialogdesign package"/>
|
||||
<License Value="modified LGPL-2
|
||||
"/>
|
||||
<Version Minor="2" Release="2"/>
|
||||
<Files Count="5">
|
||||
<Files Count="4">
|
||||
<Item1>
|
||||
<Filename Value="lr_db_zeos.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="LR_DB_Zeos"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Filename Value="lr_zeos_img.inc"/>
|
||||
<Type Value="Include"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Filename Value="lr_editvariables.pas"/>
|
||||
<UnitName Value="LR_EditVariables"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Filename Value="lr_editparams.pas"/>
|
||||
<UnitName Value="lr_EditParams"/>
|
||||
</Item4>
|
||||
<Item5>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<Filename Value="lrdbzeosconst.pas"/>
|
||||
<UnitName Value="lrDBZeosConst"/>
|
||||
</Item5>
|
||||
</Item4>
|
||||
</Files>
|
||||
<i18n>
|
||||
<EnableI18N Value="True"/>
|
||||
|
||||
@ -80,6 +80,7 @@ type
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses LR_Utils;
|
||||
|
||||
// missing cairo functions to make shared images posible
|
||||
const
|
||||
@ -767,7 +768,12 @@ begin
|
||||
if fCairoPrinter.Canvas.Font.Orientation<>0 then
|
||||
fCairoPrinter.Canvas.TextRect(R, nx, R.Bottom, Text, aStyle)
|
||||
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
|
||||
//if OldClipping then
|
||||
|
||||
@ -22,6 +22,9 @@ uses
|
||||
LR_Intrp, LR_DSet, LR_DBSet, LR_DBRel, LR_Const, DbCtrls, LazUtf8Classes,
|
||||
LazLoggerBase;
|
||||
|
||||
const
|
||||
lrMaxBandsInReport = 256; //temp fix. in future need remove this limit
|
||||
|
||||
const
|
||||
// object flags
|
||||
flStretched = $01;
|
||||
@ -396,8 +399,6 @@ type
|
||||
end;
|
||||
|
||||
|
||||
{ TfrMemoView }
|
||||
|
||||
{ TfrCustomMemoView }
|
||||
|
||||
TfrCustomMemoView = class(TfrStretcheable)
|
||||
@ -409,6 +410,7 @@ type
|
||||
FOnClick: TfrScriptStrings;
|
||||
FOnMouseEnter: TfrScriptStrings;
|
||||
FOnMouseLeave: TfrScriptStrings;
|
||||
FParagraphGap: integer;
|
||||
|
||||
function GetAlignment: TAlignment;
|
||||
function GetAngle: Byte;
|
||||
@ -471,6 +473,7 @@ type
|
||||
HighlightStr: String;
|
||||
LineSpacing, CharacterSpacing: Integer;
|
||||
LastLine: boolean; // are we painting/exporting the last line?
|
||||
FirstLine: boolean;
|
||||
|
||||
constructor Create(AOwnerPage:TfrPage); override;
|
||||
destructor Destroy; override;
|
||||
@ -502,6 +505,7 @@ type
|
||||
property OnClick : TfrScriptStrings read FOnClick write SetOnClick;
|
||||
property OnMouseEnter : TfrScriptStrings read FOnMouseEnter write SetOnMouseEnter;
|
||||
property OnMouseLeave : TfrScriptStrings read FOnMouseLeave write SetOnMouseLeave;
|
||||
property ParagraphGap : integer read FParagraphGap write FParagraphGap;
|
||||
end;
|
||||
|
||||
TfrMemoView = class(TfrCustomMemoView)
|
||||
@ -527,6 +531,7 @@ type
|
||||
property Format;
|
||||
property FormatStr;
|
||||
property Restrictions;
|
||||
property ParagraphGap;
|
||||
property OnClick;
|
||||
property OnMouseEnter;
|
||||
property OnMouseLeave;
|
||||
@ -587,8 +592,13 @@ type
|
||||
{ TfrSubReportView }
|
||||
|
||||
TfrSubReportView = class(TfrView)
|
||||
private
|
||||
FSubPageIndex: Integer; //temp var for find page on load
|
||||
FSubPage : TfrPage;
|
||||
protected
|
||||
procedure AfterLoad;override;
|
||||
public
|
||||
SubPage: Integer;
|
||||
//SubPage: Integer;
|
||||
constructor Create(AOwnerPage:TfrPage); override;
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
procedure Draw(aCanvas: TCanvas); override;
|
||||
@ -597,6 +607,7 @@ type
|
||||
procedure SaveToStream(Stream: TStream); override;
|
||||
procedure SaveToXML(XML: TLrXMLConfig; const Path: String); override;
|
||||
procedure DefinePopupMenu({%H-}Popup: TPopupMenu); override;
|
||||
property SubPage : TfrPage read FSubPage write FSubPage;
|
||||
published
|
||||
property Restrictions;
|
||||
end;
|
||||
@ -695,8 +706,7 @@ type
|
||||
Flags: Word;
|
||||
Next, Prev: TfrBand;
|
||||
SubIndex, MaxY: Integer;
|
||||
EOFReached: Boolean;
|
||||
EOFArr: Array[0..31] of Boolean;
|
||||
EOFArr: Array[0..lrMaxBandsInReport - 1] of Boolean;
|
||||
Positions: Array[TfrDatasetPosition] of Integer;
|
||||
LastGroupValue: Variant;
|
||||
HeaderBand, FooterBand, LastBand: TfrBand;
|
||||
@ -729,6 +739,7 @@ type
|
||||
procedure ResetLastValues;
|
||||
function getName: string;
|
||||
public
|
||||
EOFReached: Boolean;
|
||||
MaxDY: Integer;
|
||||
|
||||
Typ: TfrBandType;
|
||||
@ -783,7 +794,6 @@ type
|
||||
|
||||
TfrPage = class(TfrObject)
|
||||
private
|
||||
Bands : Array[TfrBandType] of TfrBand;
|
||||
fColCount : Integer;
|
||||
fColGap : Integer;
|
||||
fColWidth : Integer;
|
||||
@ -799,7 +809,6 @@ type
|
||||
CurColumn : Integer;
|
||||
LastStaticColumnY : Integer;
|
||||
XAdjust : Integer;
|
||||
List : TFpList;
|
||||
LastBand : TfrBand;
|
||||
ColPos : Integer;
|
||||
CurPos : Integer;
|
||||
@ -810,11 +819,15 @@ type
|
||||
procedure ClearRecList;
|
||||
procedure DrawPageFooters;
|
||||
function BandExists(b: TfrBand): Boolean;
|
||||
function GetPageIndex: integer;
|
||||
procedure LoadFromStream(Stream: TStream);
|
||||
procedure SaveToStream(Stream: TStream);
|
||||
procedure SetPageIndex(AValue: integer);
|
||||
|
||||
procedure ShowBand(b: TfrBand);
|
||||
protected
|
||||
List : TFpList;
|
||||
Bands : Array[TfrBandType] of TfrBand;
|
||||
Mode : TfrPageMode;
|
||||
PlayFrom : Integer;
|
||||
function PlayRecList: Boolean;
|
||||
@ -878,6 +891,7 @@ type
|
||||
property Script;
|
||||
property Height;
|
||||
property Width;
|
||||
property PageIndex:integer read GetPageIndex write SetPageIndex;
|
||||
end;
|
||||
|
||||
TFrPageClass = Class of TfrPage;
|
||||
@ -949,8 +963,9 @@ type
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Clear;
|
||||
procedure Add(const aClassName : string='TfrPageReport');
|
||||
function Add(const aClassName : string='TfrPageReport'):TfrPage;
|
||||
procedure Delete(Index: Integer);
|
||||
procedure Move(OldIndex, NewIndex: Integer);
|
||||
procedure LoadFromStream(Stream: TStream);
|
||||
procedure LoadFromXML(XML: TLrXMLConfig; const Path: String);
|
||||
procedure SaveToStream(Stream: TStream);
|
||||
@ -1701,7 +1716,11 @@ begin
|
||||
frObj := CurReport.FindObject(FObjName);
|
||||
|
||||
if Assigned(frObj) then
|
||||
begin
|
||||
Result:=GetPropInfo(frObj, PropName); //Retreive property informations
|
||||
if not Assigned(Result) then
|
||||
IsCustomProp(PropName, PropIndex);
|
||||
end;
|
||||
|
||||
end;
|
||||
end;
|
||||
@ -2077,7 +2096,7 @@ begin
|
||||
DebugLn('Error: ', e.message,'. Hyphenation support will be disabled');
|
||||
end;
|
||||
end;
|
||||
|
||||
{
|
||||
procedure CanvasTextRectJustify(const Canvas:TCanvas;
|
||||
const ARect: TRect; X1, X2, Y: integer; const Text: string;
|
||||
Trimmed: boolean);
|
||||
@ -2154,7 +2173,7 @@ begin
|
||||
|
||||
SetLength(Arr, 0);
|
||||
end;
|
||||
|
||||
}
|
||||
{ TlrDetailReports }
|
||||
|
||||
function TlrDetailReports.GetItems(AReportName: string): TlrDetailReport;
|
||||
@ -3296,6 +3315,7 @@ begin
|
||||
FOnMouseEnter:=TfrScriptStrings.Create;
|
||||
FOnMouseLeave:=TfrScriptStrings.Create;
|
||||
FFindHighlight:=false;
|
||||
FParagraphGap:=0;
|
||||
|
||||
Typ := gtMemo;
|
||||
FFont := TFont.Create;
|
||||
@ -3425,6 +3445,7 @@ begin
|
||||
FOnMouseLeave.Assign(TfrCustomMemoView(Source).FOnMouseLeave);
|
||||
FDetailReport:=TfrCustomMemoView(Source).FDetailReport;
|
||||
FCursor:=TfrCustomMemoView(Source).FCursor;
|
||||
FParagraphGap:=TfrCustomMemoView(Source).FParagraphGap;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -3557,6 +3578,8 @@ var
|
||||
{$ENDIF}
|
||||
SMemo.Add(str + Chr(w div 256) + Chr(w mod 256));
|
||||
Inc(size, size1);
|
||||
//!!
|
||||
maxWidth := dx - gapx - gapx;
|
||||
end;
|
||||
|
||||
procedure WrapLine(const s: String);
|
||||
@ -3704,13 +3727,14 @@ var
|
||||
begin
|
||||
size := y + gapy;
|
||||
size1 := -WCanvas.Font.Height + LineSpacing;
|
||||
maxWidth := dx - gapx - gapx;
|
||||
// maxWidth := dx - gapx - gapx;
|
||||
{$IFDEF DebugLR}
|
||||
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]);
|
||||
{$ENDIF}
|
||||
for i := 0 to Memo1.Count - 1 do
|
||||
begin
|
||||
maxWidth := dx - gapx - gapx - FParagraphGap;
|
||||
if (Flags and flWordWrap) <> 0 then
|
||||
WrapLine(Memo1[i])
|
||||
else
|
||||
@ -3777,6 +3801,7 @@ var
|
||||
var
|
||||
i: Integer;
|
||||
curyf, thf, linespc: double;
|
||||
FTmpFL:boolean;
|
||||
|
||||
function OutLine(st: String): Boolean;
|
||||
var
|
||||
@ -3803,8 +3828,12 @@ var
|
||||
SetLength(St, n - 2);
|
||||
if Length(St) > 0 then
|
||||
begin
|
||||
FTmpFL:=false;
|
||||
if St[Length(St)] = #1 then
|
||||
SetLength(St, Length(St) - 1)
|
||||
begin
|
||||
FTmpFL:=true;
|
||||
SetLength(St, Length(St) - 1);
|
||||
end
|
||||
else
|
||||
LastLine := false;
|
||||
end;
|
||||
@ -3847,12 +3876,27 @@ var
|
||||
if not Exporting then
|
||||
begin
|
||||
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
|
||||
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
|
||||
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);
|
||||
Result := False;
|
||||
@ -3861,6 +3905,7 @@ var
|
||||
Result := True;
|
||||
|
||||
curyf := curyf + thf;
|
||||
FirstLine:=FTmpFL;
|
||||
end;
|
||||
|
||||
begin {OutMemo}
|
||||
@ -3868,7 +3913,8 @@ var
|
||||
begin
|
||||
if Layout=tlCenter then
|
||||
y:=y+(dy-VHeight) div 2
|
||||
else if Layout=tlBottom then
|
||||
else
|
||||
if Layout=tlBottom then
|
||||
y:=y+dy-VHeight;
|
||||
end;
|
||||
curyf := y + gapy;
|
||||
@ -3885,6 +3931,9 @@ var
|
||||
[curyf, thf, Canvas.Font.Height, Canvas.Textheight('H'), dbgs(DR), Memo1.Count]);
|
||||
{$ENDIF}
|
||||
CurStrNo := 0;
|
||||
|
||||
FirstLine:=true;
|
||||
|
||||
for i := 0 to Memo1.Count - 1 do
|
||||
if OutLine(Memo1[i]) then
|
||||
break;
|
||||
@ -4356,6 +4405,7 @@ begin
|
||||
frReadMemo(Stream, FOnMouseEnter);
|
||||
frReadMemo(Stream, FOnMouseLeave);
|
||||
FDetailReport:=frReadString(Stream);
|
||||
Stream.Read(FParagraphGap, SizeOf(FParagraphGap));
|
||||
end;
|
||||
|
||||
end;
|
||||
@ -4393,6 +4443,7 @@ begin
|
||||
FOnMouseLeave.Text:= XML.GetValue(Path+'Data/OnMouseLeave/Value', '');
|
||||
|
||||
FDetailReport:= XML.GetValue(Path+'Data/DetailReport/Value', '');
|
||||
FParagraphGap:=XML.GetValue(Path+'Data/ParagraphGap/Value', 0);
|
||||
end;
|
||||
|
||||
procedure TfrCustomMemoView.SaveToStream(Stream: TStream);
|
||||
@ -4433,6 +4484,7 @@ begin
|
||||
frWriteMemo(Stream, FOnMouseEnter);
|
||||
frWriteMemo(Stream, FOnMouseLeave);
|
||||
frWriteString(Stream, FDetailReport);
|
||||
Stream.Write(FParagraphGap, SizeOf(FParagraphGap));
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -4463,6 +4515,7 @@ begin
|
||||
XML.SetValue(Path+'Data/OnMouseLeave/Value', FOnMouseLeave.Text);
|
||||
|
||||
XML.SetValue(Path+'Data/DetailReport/Value', FDetailReport);
|
||||
XML.SetValue(Path+'Data/ParagraphGap/Value', FParagraphGap);
|
||||
end;
|
||||
|
||||
procedure TfrCustomMemoView.GetBlob(b: TfrTField);
|
||||
@ -5258,6 +5311,12 @@ begin
|
||||
Parent.Visible := Avalue;
|
||||
end;
|
||||
|
||||
procedure TfrSubReportView.AfterLoad;
|
||||
begin
|
||||
inherited AfterLoad;
|
||||
FSubPage:= CurReport.Pages[FSubPageIndex];
|
||||
end;
|
||||
|
||||
{----------------------------------------------------------------------------}
|
||||
constructor TfrSubReportView.Create(AOwnerPage: TfrPage);
|
||||
begin
|
||||
@ -5270,7 +5329,7 @@ procedure TfrSubReportView.Assign(Source: TPersistent);
|
||||
begin
|
||||
inherited Assign(Source);
|
||||
if Source is TfrSubReportView then
|
||||
SubPage := TfrSubReportView(Source).SubPage;
|
||||
FSubPage := TfrSubReportView(Source).FSubPage;
|
||||
end;
|
||||
|
||||
procedure TfrSubReportView.Draw(aCanvas: TCanvas);
|
||||
@ -5291,8 +5350,7 @@ begin
|
||||
Brush.Color := clWhite;
|
||||
Rectangle(x, y, x + dx + 1, y + dy + 1);
|
||||
Brush.Style := bsClear;
|
||||
TextRect(DRect, x + 2, y + 2, sSubReportOnPage + ' ' +
|
||||
IntToStr(SubPage + 1));
|
||||
TextRect(DRect, x + 2, y + 2, sSubReportOnPage + ' ' + IntToStr(SubPage.PageIndex + 1));
|
||||
end;
|
||||
RestoreCoord;
|
||||
end;
|
||||
@ -5305,13 +5363,13 @@ end;
|
||||
procedure TfrSubReportView.LoadFromStream(Stream: TStream);
|
||||
begin
|
||||
inherited LoadFromStream(Stream);
|
||||
Stream.Read(SubPage, 4);
|
||||
Stream.Read(FSubPageIndex, 4);
|
||||
end;
|
||||
|
||||
procedure TfrSubReportView.LoadFromXML(XML: TLrXMLConfig; const Path: String);
|
||||
begin
|
||||
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;
|
||||
|
||||
procedure TfrSubReportView.SaveToStream(Stream: TStream);
|
||||
@ -5323,7 +5381,8 @@ end;
|
||||
procedure TfrSubReportView.SaveToXML(XML: TLrXMLConfig; const Path: String);
|
||||
begin
|
||||
inherited SaveToXML(XML, Path);
|
||||
XML.SetValue(Path+'SubPage/Value'{%H-}, SubPage);
|
||||
FSubPageIndex:=FSubPage.PageIndex;
|
||||
XML.SetValue(Path+'SubPage/Value'{%H-}, FSubPageIndex);
|
||||
end;
|
||||
|
||||
{----------------------------------------------------------------------------}
|
||||
@ -6220,7 +6279,7 @@ begin
|
||||
t :=TfrView(Objects[i]);
|
||||
if t is TfrSubReportView then
|
||||
begin
|
||||
Page := CurReport.Pages[(t as TfrSubReportView).SubPage];
|
||||
Page := (t as TfrSubReportView).SubPage;
|
||||
Page.Mode := pmBuildList;
|
||||
Page.FormPage;
|
||||
Page.CurY := y + t.y;
|
||||
@ -6247,7 +6306,7 @@ begin
|
||||
t :=TfrView(Objects[i]);
|
||||
if t is TfrSubReportView then
|
||||
begin
|
||||
Page := CurReport.Pages[(t as TfrSubReportView).SubPage];
|
||||
Page := (t as TfrSubReportView).SubPage;
|
||||
Page.CurY := Parent.CurY;
|
||||
Page.CurBottomY := Parent.CurBottomY;
|
||||
end;
|
||||
@ -6259,7 +6318,7 @@ begin
|
||||
t :=TfrView(Objects[i]);
|
||||
if (t is TfrSubReportView) and (not EOFArr[i - SubIndex]) then
|
||||
begin
|
||||
Page := CurReport.Pages[(t as TfrSubReportView).SubPage];
|
||||
Page := (t as TfrSubReportView).SubPage;
|
||||
if Page.PlayRecList then
|
||||
EOFReached := False
|
||||
else
|
||||
@ -6288,7 +6347,7 @@ begin
|
||||
t :=TfrView(Objects[i]);
|
||||
if t is TfrSubReportView then
|
||||
begin
|
||||
Page := CurReport.Pages[(t as TfrSubReportView).SubPage];
|
||||
Page := (t as TfrSubReportView).SubPage;
|
||||
Page.ClearRecList;
|
||||
end;
|
||||
end;
|
||||
@ -7311,7 +7370,7 @@ var
|
||||
bt, t: TfrView;
|
||||
Bnd, Bnd1: TfrBand;
|
||||
FirstBand, Flag: Boolean;
|
||||
BArr: Array[0..31] of TfrBand;
|
||||
BArr: Array[0..lrMaxBandsInReport - 1] of TfrBand;
|
||||
s: String;
|
||||
begin
|
||||
for i := 0 to Objects.Count - 1 do
|
||||
@ -7337,7 +7396,7 @@ begin
|
||||
t.Parent := nil;
|
||||
frInterpretator.PrepareScript(t.Script, t.Script, SMemo);
|
||||
if t.Typ = gtSubReport then
|
||||
CurReport.Pages[(t as TfrSubReportView).SubPage].Skip := True;
|
||||
(t as TfrSubReportView).SubPage.Skip := True;
|
||||
end;
|
||||
Flag := False;
|
||||
for i := 0 to RTObjects.Count - 1 do // search for btCrossXXX bands
|
||||
@ -7931,7 +7990,7 @@ begin
|
||||
RowStarted := result;
|
||||
end;
|
||||
|
||||
procedure TfrPage.DoAggregate(a: Array of TfrBandType);
|
||||
procedure TfrPage.DoAggregate(a: array of TfrBandType);
|
||||
var
|
||||
i: Integer;
|
||||
procedure DoAggregate1(bt: TfrBandType);
|
||||
@ -8328,6 +8387,11 @@ begin
|
||||
Result := b.Objects.Count > 0;
|
||||
end;
|
||||
|
||||
function TfrPage.GetPageIndex: integer;
|
||||
begin
|
||||
Result:=CurReport.Pages.FPages.IndexOf(Self);
|
||||
end;
|
||||
|
||||
procedure TfrPage.AfterPrint;
|
||||
var
|
||||
i: Integer;
|
||||
@ -8421,6 +8485,12 @@ begin
|
||||
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);
|
||||
begin
|
||||
Inherited SavetoXML(XML,Path);
|
||||
@ -8472,24 +8542,25 @@ begin
|
||||
FPages.Clear;
|
||||
end;
|
||||
|
||||
procedure TfrPages.Add(const aClassName : string='TfrPageReport');
|
||||
Var Pg : TFrPage;
|
||||
Rf : TFrPageClass;
|
||||
function TfrPages.Add(const aClassName: string): TfrPage;
|
||||
var
|
||||
Rf : TFrPageClass;
|
||||
begin
|
||||
Pg:=nil;
|
||||
|
||||
Result := nil;
|
||||
|
||||
Rf:=TFrPageClass(GetClass(aClassName));
|
||||
if Assigned(Rf) then
|
||||
begin
|
||||
Pg:=Rf.CreatePage;
|
||||
Result := Rf.CreatePage;
|
||||
|
||||
if Assigned(Pg) then
|
||||
if Assigned(Result) then
|
||||
begin
|
||||
Pg.CreateUniqueName;
|
||||
FPages.Add(Pg);
|
||||
Result.CreateUniqueName;
|
||||
FPages.Add(Result);
|
||||
end;
|
||||
end
|
||||
else showMessage(Format('Class %s not found',[aClassName]))
|
||||
else
|
||||
ShowMessage(Format('Class %s not found',[aClassName]))
|
||||
end;
|
||||
|
||||
procedure TfrPages.Delete(Index: Integer);
|
||||
@ -8498,6 +8569,11 @@ begin
|
||||
FPages.Delete(Index);
|
||||
end;
|
||||
|
||||
procedure TfrPages.Move(OldIndex, NewIndex: Integer);
|
||||
begin
|
||||
FPages.Move(OldIndex, NewIndex);
|
||||
end;
|
||||
|
||||
procedure TfrPages.LoadFromStream(Stream: TStream);
|
||||
var
|
||||
b: Byte;
|
||||
|
||||
@ -39,11 +39,32 @@ uses
|
||||
|
||||
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 = class
|
||||
private
|
||||
FCelCol:string;
|
||||
FCelCol:Variant;
|
||||
FValue:Variant;
|
||||
FDataset: TDataset;
|
||||
FBookmark:TBookMark;
|
||||
@ -59,7 +80,7 @@ type
|
||||
|
||||
TExRow = class(TFPList)
|
||||
private
|
||||
FRow:string;
|
||||
FRow:Variant;
|
||||
function GetCell(ACol: Variant): Variant;
|
||||
function GetCellData(ACol: Variant): TExItem;
|
||||
procedure SetCell(ACol: Variant; AValue: Variant);
|
||||
@ -77,15 +98,15 @@ type
|
||||
FColCount: integer;
|
||||
FRowCount: integer;
|
||||
FRows:TFPList;
|
||||
FColHeader:TStringList;
|
||||
FRowHeader:TStringList;
|
||||
FRowHeader:TVariantList;
|
||||
FColHeader:TVariantList;
|
||||
function GetCell(ACol, ARow: variant): variant;
|
||||
function GetCellData(ACol, ARow : variant): TExItem;
|
||||
function GetColCount: integer;
|
||||
function GetColHeader(ACol: integer): string;
|
||||
function GetColHeader(ACol: integer): Variant;
|
||||
function GetRowCount: integer;
|
||||
function GetRowHeader(ARow: integer): string;
|
||||
procedure SetCell(ACol, ARow: variant; AValue: variant);
|
||||
function GetRowHeader(ARow: integer): Variant;
|
||||
procedure SetCell(ACol, ARow: variant; AValue: Variant);
|
||||
function Find(ARow:variant; out Index: Integer): Boolean;
|
||||
public
|
||||
constructor Create;
|
||||
@ -95,8 +116,8 @@ type
|
||||
property CellData[ACol, ARow : variant]:TExItem read GetCellData;
|
||||
property ColCount:integer read GetColCount;
|
||||
property RowCount:integer read GetRowCount;
|
||||
property ColHeader[ACol:integer]:string read GetColHeader;
|
||||
property RowHeader[ARow:integer]:string read GetRowHeader;
|
||||
property ColHeader[ACol:integer]:Variant read GetColHeader;
|
||||
property RowHeader[ARow:integer]:Variant read GetRowHeader;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -104,6 +125,110 @@ uses math, variants;
|
||||
|
||||
{ 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);
|
||||
begin
|
||||
if IsBookmarkValid then
|
||||
@ -165,7 +290,6 @@ end;
|
||||
function TExRow.Find(ACol: Variant; out Index: Integer): Boolean;
|
||||
var
|
||||
I,L,R,Dir: Integer;
|
||||
S1, S2:string;
|
||||
begin
|
||||
Result := false;
|
||||
// Use binary search.
|
||||
@ -174,10 +298,7 @@ begin
|
||||
while L<=R do
|
||||
begin
|
||||
I := (L+R) div 2;
|
||||
// Dir := CompareStr(TExItem(Items[i]).FCelCol, VarToStr(ACol));
|
||||
S1:=TExItem(Items[i]).FCelCol;
|
||||
S2:=VarToStr(ACol);
|
||||
Dir := CompareStr(S1, S2);
|
||||
Dir := CompareVariant(TExItem(Items[i]).FCelCol,ACol);
|
||||
if Dir < 0 then
|
||||
L := I+1
|
||||
else
|
||||
@ -232,12 +353,12 @@ begin
|
||||
Result:=FColHeader.Count;
|
||||
end;
|
||||
|
||||
function TExVarArray.GetColHeader(ACol: integer): string;
|
||||
function TExVarArray.GetColHeader(ACol: integer): Variant;
|
||||
begin
|
||||
if (ACol>=0) and (ACol<FColHeader.Count) then
|
||||
Result:=FColHeader[ACol]
|
||||
Result:=FColHeader.Items[ACol]
|
||||
else
|
||||
Result:='';
|
||||
Result:=null;
|
||||
end;
|
||||
|
||||
function TExVarArray.GetRowCount: integer;
|
||||
@ -245,15 +366,15 @@ begin
|
||||
Result:=FRowHeader.Count;
|
||||
end;
|
||||
|
||||
function TExVarArray.GetRowHeader(ARow: integer): string;
|
||||
function TExVarArray.GetRowHeader(ARow: integer): Variant;
|
||||
begin
|
||||
if (ARow>=0) and (ARow<FRowHeader.Count) then
|
||||
Result:=FRowHeader[ARow]
|
||||
Result:=FRowHeader.Items[ARow]
|
||||
else
|
||||
Result:='';
|
||||
Result:=null;
|
||||
end;
|
||||
|
||||
procedure TExVarArray.SetCell(ACol, ARow: variant; AValue: variant);
|
||||
procedure TExVarArray.SetCell(ACol, ARow: variant; AValue: Variant);
|
||||
var
|
||||
R:TExRow;
|
||||
i:integer;
|
||||
@ -270,32 +391,25 @@ begin
|
||||
FRowCount:=Max(FRowCount, FRows.Count);
|
||||
FColCount:=Max(FColCount, R.Count);
|
||||
|
||||
i:=FColHeader.IndexOf(VarToStr(ACol));
|
||||
if i<0 then
|
||||
FColHeader.Add(VarToStr(ACol));
|
||||
|
||||
i:=FRowHeader.IndexOf(VarToStr(ARow));
|
||||
if i<0 then
|
||||
FRowHeader.Add(VarToStr(ARow));
|
||||
if not FColHeader.Find(ACol, i) then
|
||||
FColHeader.Insert(ACol);
|
||||
|
||||
if not FRowHeader.Find(ARow, i) then
|
||||
FRowHeader.Insert(ARow);
|
||||
end;
|
||||
|
||||
function TExVarArray.Find(ARow: variant; out Index: Integer): Boolean;
|
||||
var
|
||||
I,L,R,Dir: Integer;
|
||||
S1, S2:string;
|
||||
begin
|
||||
Result := false;
|
||||
// Use binary search.
|
||||
L := 0;
|
||||
R := FRows.Count - 1;
|
||||
S2:=VarToStr(ARow);
|
||||
while L<=R do
|
||||
begin
|
||||
I := (L+R) div 2;
|
||||
// Dir := CompareStr(TExRow(FRows[i]).FRow, VarToStr(ARow));
|
||||
S1:=TExRow(FRows[i]).FRow;
|
||||
Dir := CompareStr(S1, S2);
|
||||
Dir := CompareVariant(TExRow(FRows[i]).FRow, ARow);
|
||||
if Dir < 0 then
|
||||
L := I+1
|
||||
else
|
||||
@ -316,10 +430,8 @@ constructor TExVarArray.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FRows:=TFPList.Create;
|
||||
FColHeader:=TStringList.Create;
|
||||
FColHeader.Sorted:=true;
|
||||
FRowHeader:=TStringList.Create;
|
||||
FRowHeader.Sorted:=true;
|
||||
FColHeader:=TVariantList.Create;
|
||||
FRowHeader:=TVariantList.Create;
|
||||
end;
|
||||
|
||||
destructor TExVarArray.Destroy;
|
||||
|
||||
@ -303,9 +303,9 @@ var
|
||||
FD:TField;
|
||||
FR:TField;
|
||||
FC:TField;
|
||||
S, SR, SC: String;
|
||||
S: String;
|
||||
P:TBookMark;
|
||||
V, VT:Variant;
|
||||
V, VT, SR, SC:Variant;
|
||||
FCalcTotal:boolean;
|
||||
j: Integer;
|
||||
i: Integer;
|
||||
@ -383,7 +383,7 @@ begin
|
||||
begin
|
||||
if FCalcTotal then
|
||||
begin
|
||||
V:=FExVarArray.Cell[FC.DisplayText, FR.DisplayText];
|
||||
V:=FExVarArray.Cell[FC.Value, FR.Value];
|
||||
if V = null then
|
||||
begin
|
||||
if FuncNo in [2,3] then
|
||||
@ -391,12 +391,12 @@ begin
|
||||
else
|
||||
V:=0;
|
||||
end;
|
||||
FExVarArray.Cell[FC.DisplayText, FR.DisplayText]:=DoFunc(V, FD.AsFloat);
|
||||
FExVarArray.Cell[FC.Value, FR.Value]:=DoFunc(V, FD.AsFloat);
|
||||
end
|
||||
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
|
||||
ExItem.SaveBookmark(FData);
|
||||
FData.Next;
|
||||
@ -545,10 +545,10 @@ end;
|
||||
|
||||
procedure TlrCrossView.OnEnterRect(AMemo: TStringList; AView: TfrView);
|
||||
var
|
||||
S, SC, SR: String;
|
||||
S: String;
|
||||
ColNo: Integer;
|
||||
RecNo: Integer;
|
||||
V : Variant;
|
||||
V, SC, SR : Variant;
|
||||
ExItem:TExItem;
|
||||
begin
|
||||
ColNo:=FBandCrossRowRT.Parent.DataSet.RecNo;
|
||||
@ -867,7 +867,12 @@ begin
|
||||
FPage.ColCount := 1;
|
||||
|
||||
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.Free;
|
||||
|
||||
@ -23,12 +23,12 @@ object frDesignerForm: TfrDesignerForm
|
||||
OnResize = FormResize
|
||||
OnShow = FormShow
|
||||
ShowHint = True
|
||||
LCLVersion = '1.3'
|
||||
LCLVersion = '1.5'
|
||||
WindowState = wsMaximized
|
||||
object StatusBar1: TStatusBar
|
||||
Left = 0
|
||||
Height = 25
|
||||
Top = 382
|
||||
Height = 23
|
||||
Top = 384
|
||||
Width = 695
|
||||
Panels = <
|
||||
item
|
||||
@ -120,42 +120,6 @@ object frDesignerForm: TfrDesignerForm
|
||||
Action = FileOpen
|
||||
Align = alLeft
|
||||
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
|
||||
end
|
||||
object FileBtn3: TSpeedButton
|
||||
@ -167,42 +131,6 @@ object frDesignerForm: TfrDesignerForm
|
||||
Action = FileSave
|
||||
Align = alLeft
|
||||
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
|
||||
end
|
||||
object FileBtn4: TSpeedButton
|
||||
@ -214,42 +142,6 @@ object frDesignerForm: TfrDesignerForm
|
||||
Action = FilePreview
|
||||
Align = alLeft
|
||||
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
|
||||
end
|
||||
object CutB: TSpeedButton
|
||||
@ -2324,7 +2216,7 @@ object frDesignerForm: TfrDesignerForm
|
||||
object E1: TEdit
|
||||
Tag = 6
|
||||
Left = 4
|
||||
Height = 31
|
||||
Height = 33
|
||||
Top = 1
|
||||
Width = 31
|
||||
TabOrder = 0
|
||||
@ -2389,21 +2281,21 @@ object frDesignerForm: TfrDesignerForm
|
||||
end
|
||||
object frDock2: TPanel
|
||||
Left = 0
|
||||
Height = 299
|
||||
Height = 301
|
||||
Top = 83
|
||||
Width = 27
|
||||
Align = alLeft
|
||||
ClientHeight = 299
|
||||
ClientHeight = 301
|
||||
ClientWidth = 27
|
||||
FullRepaint = False
|
||||
TabOrder = 1
|
||||
object panForDlg: TPanel
|
||||
Left = 1
|
||||
Height = 297
|
||||
Height = 299
|
||||
Top = 1
|
||||
Width = 25
|
||||
Align = alClient
|
||||
ClientHeight = 297
|
||||
ClientHeight = 299
|
||||
ClientWidth = 25
|
||||
FullRepaint = False
|
||||
TabOrder = 1
|
||||
@ -2469,11 +2361,11 @@ object frDesignerForm: TfrDesignerForm
|
||||
end
|
||||
object Panel4: TPanel
|
||||
Left = 1
|
||||
Height = 297
|
||||
Height = 299
|
||||
Top = 1
|
||||
Width = 25
|
||||
Align = alClient
|
||||
ClientHeight = 297
|
||||
ClientHeight = 299
|
||||
ClientWidth = 25
|
||||
FullRepaint = False
|
||||
TabOrder = 0
|
||||
@ -2772,7 +2664,7 @@ object frDesignerForm: TfrDesignerForm
|
||||
end
|
||||
object Tab1: TTabControl
|
||||
Left = 27
|
||||
Height = 299
|
||||
Height = 301
|
||||
Top = 83
|
||||
Width = 641
|
||||
TabStop = False
|
||||
@ -2786,24 +2678,24 @@ object frDesignerForm: TfrDesignerForm
|
||||
TabOrder = 2
|
||||
object panTab: TPanel
|
||||
Left = 2
|
||||
Height = 267
|
||||
Top = 30
|
||||
Height = 266
|
||||
Top = 33
|
||||
Width = 637
|
||||
Align = alClient
|
||||
BevelOuter = bvNone
|
||||
Caption = 'panTab'
|
||||
ClientHeight = 267
|
||||
ClientHeight = 266
|
||||
ClientWidth = 637
|
||||
TabOrder = 1
|
||||
object ScrollBox1: TScrollBox
|
||||
Left = 0
|
||||
Height = 267
|
||||
Height = 266
|
||||
Top = 0
|
||||
Width = 637
|
||||
HorzScrollBar.Page = 488
|
||||
VertScrollBar.Page = 174
|
||||
Align = alClient
|
||||
ClientHeight = 265
|
||||
ClientHeight = 264
|
||||
ClientWidth = 635
|
||||
Color = clGray
|
||||
ParentColor = False
|
||||
@ -4066,12 +3958,12 @@ object frDesignerForm: TfrDesignerForm
|
||||
end
|
||||
object frDock4: TPanel
|
||||
Left = 668
|
||||
Height = 299
|
||||
Height = 301
|
||||
Top = 83
|
||||
Width = 27
|
||||
Align = alRight
|
||||
Anchors = [akTop, akRight]
|
||||
ClientHeight = 299
|
||||
ClientHeight = 301
|
||||
ClientWidth = 27
|
||||
FullRepaint = False
|
||||
TabOrder = 3
|
||||
|
||||
@ -43,6 +43,7 @@ type
|
||||
SaveAs: Boolean; var Saved: Boolean) of object;
|
||||
|
||||
TfrDesignerForm = class;
|
||||
TlrTabEditControl = class(TCustomTabControl);
|
||||
|
||||
{ TfrDesigner }
|
||||
|
||||
@ -623,6 +624,14 @@ type
|
||||
procedure DuplicateView(View: TfrView; Data: PtrInt);
|
||||
procedure ResetDuplicateCount;
|
||||
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
|
||||
procedure SetModified(AValue: Boolean);override;
|
||||
function IniFileName:string;
|
||||
@ -1777,11 +1786,8 @@ var
|
||||
|
||||
procedure CreateSubReport;
|
||||
begin
|
||||
{ Objects.Add(TfrSubReportView.Create(FDesigner.Page));
|
||||
t := TfrView(Objects.Last);}
|
||||
t:=TfrSubReportView.Create(FDesigner.Page);
|
||||
(t as TfrSubReportView).SubPage := CurReport.Pages.Count;
|
||||
CurReport.Pages.Add;
|
||||
(t as TfrSubReportView).SubPage := CurReport.Pages.Add;
|
||||
end;
|
||||
|
||||
begin
|
||||
@ -2907,6 +2913,14 @@ begin
|
||||
StatusBar1.OnDrawPanel := @StatusBar1Drawpanel;
|
||||
Panel7.Visible := false;
|
||||
{$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;
|
||||
|
||||
destructor TfrDesignerForm.Destroy;
|
||||
@ -3759,30 +3773,28 @@ begin
|
||||
end;
|
||||
|
||||
procedure TfrDesignerForm.RemovePage(n: Integer);
|
||||
procedure AdjustSubReports;
|
||||
var
|
||||
i, j: Integer;
|
||||
t: TfrView;
|
||||
|
||||
procedure AdjustSubReports(APage:TfrPage);
|
||||
var
|
||||
i, j: Integer;
|
||||
t: TfrView;
|
||||
begin
|
||||
for i := 0 to CurReport.Pages.Count - 1 do
|
||||
begin
|
||||
with CurReport do
|
||||
for i := 0 to Pages.Count - 1 do
|
||||
j := 0;
|
||||
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
|
||||
j := 0;
|
||||
while j < Pages[i].Objects.Count do
|
||||
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;
|
||||
CurReport.Pages[i].Delete(j);
|
||||
Dec(j);
|
||||
end;
|
||||
Inc(j);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
fInBuildPage:=True;
|
||||
try
|
||||
@ -3794,10 +3806,10 @@ begin
|
||||
Pages[n].Clear
|
||||
else
|
||||
begin
|
||||
AdjustSubReports(Pages[n]);
|
||||
CurReport.Pages.Delete(n);
|
||||
Tab1.Tabs.Delete(n);
|
||||
Tab1.TabIndex := 0;
|
||||
AdjustSubReports;
|
||||
CurPage := 0;
|
||||
end;
|
||||
end;
|
||||
@ -3813,37 +3825,35 @@ var
|
||||
i: Integer;
|
||||
s: String;
|
||||
|
||||
function IsSubreport(PageN: Integer): Boolean;
|
||||
var
|
||||
i, j: Integer;
|
||||
t: TfrView;
|
||||
begin
|
||||
Result := False;
|
||||
with CurReport do
|
||||
for i := 0 to Pages.Count - 1 do
|
||||
for j := 0 to Pages[i].Objects.Count - 1 do
|
||||
begin
|
||||
t := TfrView(Pages[i].Objects[j]);
|
||||
if t.Typ = gtSubReport then
|
||||
if TfrSubReportView(t).SubPage = PageN then
|
||||
begin
|
||||
s := t.Name;
|
||||
Result := True;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
function IsSubreport(PageN: Integer): Boolean;
|
||||
var
|
||||
i, j: Integer;
|
||||
t: TfrView;
|
||||
begin
|
||||
Result := False;
|
||||
for i := 0 to CurReport.Pages.Count - 1 do
|
||||
for j := 0 to CurReport.Pages[i].Objects.Count - 1 do
|
||||
begin
|
||||
t := TfrView(CurReport.Pages[i].Objects[j]);
|
||||
if (T is TfrSubReportView) and (TfrSubReportView(t).SubPage = CurReport.Pages[PageN]) then
|
||||
begin
|
||||
s := t.Name;
|
||||
Result := True;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
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
|
||||
for i := 0 to Tab1.Tabs.Count - 1 do
|
||||
begin
|
||||
if not IsSubreport(i) then
|
||||
s := sPg + IntToStr(i + 1);
|
||||
if Tab1.Tabs[i] <> s then
|
||||
Tab1.Tabs[i] := s;
|
||||
end;
|
||||
if not IsSubreport(i) then
|
||||
s := sPg + IntToStr(i + 1);
|
||||
if Tab1.Tabs[i] <> s then
|
||||
Tab1.Tabs[i] := s;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -4465,6 +4475,52 @@ end;
|
||||
|
||||
{$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);
|
||||
begin
|
||||
inherited SetModified(AValue);
|
||||
@ -5290,7 +5346,7 @@ begin
|
||||
end
|
||||
else
|
||||
if t.Typ = gtSubReport then
|
||||
CurPage := (t as TfrSubReportView).SubPage
|
||||
CurPage := (t as TfrSubReportView).SubPage.PageIndex
|
||||
else
|
||||
if t.Typ = gtAddIn then
|
||||
begin
|
||||
@ -6271,7 +6327,7 @@ var
|
||||
end;
|
||||
|
||||
begin
|
||||
Ini:=TIniFile.Create(IniFileName);
|
||||
Ini:=TIniFile.Create(UTF8ToSys(IniFileName));
|
||||
Ini.WriteString('frEditorForm', 'ScriptFontName', edtScriptFontName);
|
||||
Ini.WriteInteger('frEditorForm', 'ScriptFontSize', edtScriptFontSize);
|
||||
|
||||
@ -6318,7 +6374,7 @@ var
|
||||
begin
|
||||
if FileExistsUTF8(IniFileName) then
|
||||
begin
|
||||
Ini:=TIniFile.Create(IniFileName);
|
||||
Ini:=TIniFile.Create(UTF8ToSys(IniFileName));
|
||||
edtScriptFontName:=Ini.ReadString('frEditorForm', 'ScriptFontName', edtScriptFontName);
|
||||
edtScriptFontSize:=Ini.ReadInteger('frEditorForm', 'ScriptFontSize', edtScriptFontSize);
|
||||
GridSize := Ini.ReadInteger('frEditorForm', rsGridSize, 4);
|
||||
@ -7634,6 +7690,35 @@ type
|
||||
procedure Edit; override;
|
||||
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 }
|
||||
|
||||
function TfrViewDataFieldProperty.GetAttributes: TPropertyAttributes;
|
||||
@ -8092,6 +8177,8 @@ initialization
|
||||
RegisterPropertyEditor(TypeInfo(String), TfrCustomMemoView, 'DetailReport', TfrCustomMemoViewDetailReportProperty);
|
||||
RegisterPropertyEditor(TypeInfo(String), TfrView, 'DataField', TfrViewDataFieldProperty);
|
||||
|
||||
RegisterPropertyEditor(TypeInfo(String), TfrBandView, 'Child', TTfrBandViewChildProperty);
|
||||
|
||||
FlrInternalTools:=TlrInternalTools.Create;
|
||||
finalization
|
||||
If Assigned(frDesigner) then
|
||||
|
||||
@ -20,7 +20,7 @@ uses
|
||||
{$IFDEF WIN32}
|
||||
Windows,
|
||||
{$ENDIF}
|
||||
LCLType, LCLIntf, LazUTF8, LConvEncoding;
|
||||
LCLType, LCLIntf, LConvEncoding;
|
||||
|
||||
type
|
||||
TUTF8Item=packed record
|
||||
@ -70,6 +70,10 @@ function lrExpandVariables(const S:string):string;
|
||||
procedure lrNormalizeLocaleFloats(DisableLocale: boolean);
|
||||
function lrConfigFolderName(ACreatePath: boolean): string;
|
||||
|
||||
procedure CanvasTextRectJustify(const Canvas:TCanvas;
|
||||
const ARect: TRect; X1, X2, Y: integer; const Text: string;
|
||||
Trimmed: boolean);
|
||||
|
||||
// utf8 tools
|
||||
function UTF8Desc(S:string; var Desc: string): Integer; 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
|
||||
|
||||
uses LR_Class, LR_Const, LR_Pars, FileUtil, LazUtilsStrConsts, LR_DSet,
|
||||
LR_DBComponent, strutils;
|
||||
LR_DBComponent, strutils, LazUTF8;
|
||||
|
||||
var
|
||||
PreviousFormatSettings: TFormatSettings;
|
||||
@ -1086,4 +1090,81 @@ begin
|
||||
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.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user