LazReport, new tool: 'Data inspector', to get list of Db Fields and drag & drop into report designer, from Alexey Lagunov

git-svn-id: trunk@44778 -
This commit is contained in:
jesus 2014-04-21 18:55:46 +00:00
parent d9f4262872
commit 80015d973f
18 changed files with 183 additions and 5 deletions

View File

@ -857,6 +857,10 @@ msgstr "Formulář FastReportu"
msgid "Force new page"
msgstr "Vynutit novou stránku"
#: lr_const.sfrdesignerdatainsp
msgid "Data inspector"
msgstr ""
#: lr_const.sfrdesignerexists
msgid "You already have one TfrDesigner component"
msgstr ""

View File

@ -839,6 +839,10 @@ msgstr "FastReport-Formular"
msgid "Force new page"
msgstr "Neue Seite erzwingen"
#: lr_const.sfrdesignerdatainsp
msgid "Data inspector"
msgstr ""
#: lr_const.sfrdesignerexists
msgid "You already have one TfrDesigner component"
msgstr "Sie haben bereits eine TfrDesigner Komponente"

View File

@ -832,6 +832,10 @@ msgstr "Formulario FastReport"
msgid "Force new page"
msgstr "Forzar página nueva"
#: lr_const.sfrdesignerdatainsp
msgid "Data inspector"
msgstr ""
#: lr_const.sfrdesignerexists
msgid "You already have one TfrDesigner component"
msgstr ""

View File

@ -843,6 +843,10 @@ msgstr "Fiches FastReport"
msgid "Force new page"
msgstr "Forcer une nouvelle page"
#: lr_const.sfrdesignerdatainsp
msgid "Data inspector"
msgstr ""
#: lr_const.sfrdesignerexists
msgid "You already have one TfrDesigner component"
msgstr ""

View File

@ -832,6 +832,10 @@ msgstr "Formulir FastReport"
msgid "Force new page"
msgstr "Paksa halaman baru"
#: lr_const.sfrdesignerdatainsp
msgid "Data inspector"
msgstr ""
#: lr_const.sfrdesignerexists
msgid "You already have one TfrDesigner component"
msgstr ""

View File

@ -835,6 +835,10 @@ msgstr "Form FastReport"
msgid "Force new page"
msgstr "Forza nuova pagina"
#: lr_const.sfrdesignerdatainsp
msgid "Data inspector"
msgstr ""
#: lr_const.sfrdesignerexists
msgid "You already have one TfrDesigner component"
msgstr ""

View File

@ -834,6 +834,10 @@ msgstr "FastReport forma"
msgid "Force new page"
msgstr "Naujas lapas"
#: lr_const.sfrdesignerdatainsp
msgid "Data inspector"
msgstr ""
#: lr_const.sfrdesignerexists
msgid "You already have one TfrDesigner component"
msgstr ""

View File

@ -835,6 +835,10 @@ msgstr "Formularz FastReport"
msgid "Force new page"
msgstr "Wymuś nową stronę"
#: lr_const.sfrdesignerdatainsp
msgid "Data inspector"
msgstr ""
#: lr_const.sfrdesignerexists
msgid "You already have one TfrDesigner component"
msgstr ""

View File

@ -815,6 +815,10 @@ msgstr ""
msgid "Force new page"
msgstr ""
#: lr_const.sfrdesignerdatainsp
msgid "Data inspector"
msgstr ""
#: lr_const.sfrdesignerexists
msgid "You already have one TfrDesigner component"
msgstr ""

View File

@ -833,6 +833,10 @@ msgstr "Formulário FastReport"
msgid "Force new page"
msgstr "Forçar nova página"
#: lr_const.sfrdesignerdatainsp
msgid "Data inspector"
msgstr ""
#: lr_const.sfrdesignerexists
msgid "You already have one TfrDesigner component"
msgstr "Você já tem um componente TfrDesigner"

View File

@ -831,6 +831,10 @@ msgstr "Форма FastReport"
msgid "Force new page"
msgstr "С новой страницы"
#: lr_const.sfrdesignerdatainsp
msgid "Data inspector"
msgstr ""
#: lr_const.sfrdesignerexists
msgid "You already have one TfrDesigner component"
msgstr "Экземпляр компонента TfrDesigner уже имеется"

View File

@ -835,6 +835,10 @@ msgstr "Форма FastReport"
msgid "Force new page"
msgstr "З нової сторінки"
#: lr_const.sfrdesignerdatainsp
msgid "Data inspector"
msgstr ""
#: lr_const.sfrdesignerexists
msgid "You already have one TfrDesigner component"
msgstr ""

View File

@ -30,7 +30,7 @@ Lazarus Port: Olivier Guilbaud, Jesus Reyes A.
See license.txt and license-lazreport.txt for details.
"/>
<Version Minor="9" Release="9"/>
<Files Count="64">
<Files Count="66">
<Item1>
<Filename Value="lr_about.pas"/>
<UnitName Value="LR_About"/>
@ -288,6 +288,14 @@ See license.txt and license-lazreport.txt for details.
<Filename Value="fr3tolrf.pas"/>
<UnitName Value="fr3tolrf"/>
</Item64>
<Item65>
<Filename Value="lr_design_ins_filed.lfm"/>
<Type Value="LFM"/>
</Item65>
<Item66>
<Filename Value="lr_design_ins_filed.pas"/>
<UnitName Value="lr_design_ins_filed"/>
</Item66>
</Files>
<i18n>
<EnableI18N Value="True"/>

View File

@ -13,7 +13,7 @@ uses
LR_GEdit, LR_GrpEd, LR_IFlds, LR_Pars, LR_pgopt, LR_PGrid, LR_PrDlg,
LR_Prntr, LR_progr, lr_propedit, LR_Register, LR_RRect, LR_Shape, LR_Utils,
LR_Var, LR_Vared, LR_View, LR_Newrp, Barcode, LR_DBRel, LR_DBComponent,
lr_hyphen, LR_Intrp, fr3tolrf, LazarusPackageIntf;
lr_hyphen, LR_Intrp, fr3tolrf, lr_design_ins_filed, LazarusPackageIntf;
implementation

View File

@ -565,6 +565,7 @@ resourcestring
sFRDesignerForm_Line = 'Line style';
sFRDesignerForm_Modified = 'Modified';
sFRDesignerExists = 'You already have one TfrDesigner component';
sFRDesignerDataInsp = 'Data inspector';
//--- InspForm resources ------------------------------------------------------
sObjectInspector ='Object inspector';

View File

@ -5019,6 +5019,9 @@ inherited frDesignerForm: TfrDesignerForm
GroupIndex = 1
OnClick = Pan2Click
end
object MenuItem2: TMenuItem
Action = tlsDBFields
end
end
object MastMenu: TMenuItem
Caption = 'Tools'
@ -5339,8 +5342,13 @@ inherited frDesignerForm: TfrDesignerForm
Caption = 'Before print script...'
OnExecute = FileBeforePrintScriptExecute
end
object tlsDBFields: TAction
Category = 'Tools'
Caption = 'Data inspector'
OnExecute = tlsDBFieldsExecute
end
end
object ActionsImageList: TImageList[15]
object ActionsImageList: TImageList
left = 328
top = 156
Bitmap = {

View File

@ -244,6 +244,8 @@ type
TfrDesignerForm = class(TfrReportDesigner)
acDuplicate: TAction;
MenuItem2: TMenuItem;
tlsDBFields: TAction;
FileBeforePrintScript: TAction;
FileOpen: TAction;
FilePreview: TAction;
@ -440,6 +442,10 @@ type
procedure DoClick(Sender: TObject);
procedure ClB1Click(Sender: TObject);
procedure GB1Click(Sender: TObject);
procedure ScrollBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure ScrollBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure tlsDBFieldsExecute(Sender: TObject);
procedure ZB1Click(Sender: TObject);
procedure ZB2Click(Sender: TObject);
procedure PgB1Click(Sender: TObject);
@ -614,6 +620,7 @@ type
procedure ToggleFrames(View: TfrView; Data: PtrInt);
procedure DuplicateView(View: TfrView; Data: PtrInt);
procedure ResetDuplicateCount;
function lrDesignAcceptDrag(const Source: TObject): TControl;
protected
procedure SetModified(AValue: Boolean);override;
public
@ -662,7 +669,7 @@ uses
LR_Pgopt, LR_GEdit, LR_Templ, LR_Newrp, LR_DsOpt, LR_Const,
LR_Prntr, LR_Hilit, LR_Flds, LR_Dopt, LR_Ev_ed, LR_BndEd, LR_VBnd,
LR_BTyp, LR_Utils, LR_GrpEd, LR_About, LR_IFlds, LR_DBRel,LR_DBSet,
DB;
DB, lr_design_ins_filed;
type
THackView = class(TfrView)
@ -2971,6 +2978,9 @@ begin
PageView.PopupMenu := Popup1;
PageView.ShowHint := True;
PageView.OnDragDrop:=@ScrollBox1DragDrop;
PageView.OnDragOver:=@ScrollBox1DragOver;
ColorSelector := TColorSelector.Create(Self);
ColorSelector.OnColorSelected := @ColorSelected;
ColorSelector.Hide;
@ -4639,6 +4649,17 @@ begin
FreeThenNil(FDuplicateList);
end;
function TfrDesignerForm.lrDesignAcceptDrag(const Source: TObject): TControl;
begin
if Source is TControl then
Result:=Source as TControl
else
if Source is TDragControlObject then
Result:=(Source as TDragControlObject).Control
else
Result:=nil;
end;
{$endif}
procedure TfrDesignerForm.SetModified(AValue: Boolean);
@ -6117,6 +6138,89 @@ begin
ShowGrid := GB1.Down;
end;
procedure TfrDesignerForm.ScrollBox1DragDrop(Sender, Source: TObject; X,
Y: Integer);
var
Control :TControl;
t : TfrMemoView;
dx, dy:integer;
begin
Control:=lrDesignAcceptDrag(Source);
if Assigned(lrFieldsList) and (Control = lrFieldsList.lbFieldsList) then
begin
Objects.Add(frCreateObject(gtMemo, '', Page));
t:=TfrMemoView(Objects.Last);
if Assigned(t) then
begin
t.MonitorFontChanges;
t.Memo.Text:='['+lrFieldsList.SelectedField+']';
t.CreateUniqueName;
t.Canvas:=Canvas;
GetDefaultSize(dx, dy);
t.x := X;
t.y := Y;
t.dx := DX;
t.dy := DY;
{$ifdef ppaint}
PageView.NPEraseSelection;
{$endif}
Unselect;
t.FrameWidth := LastFrameWidth;
t.FrameColor := LastFrameColor;
t.FillColor := LastFillColor;
t.Selected := True;
if t.Typ <> gtBand then
t.Frames:=LastFrames;
t.Font.Name := LastFontName;
t.Font.Size := LastFontSize;
t.Font.Color := LastFontColor;
t.Font.Style := frSetFontStyle(LastFontStyle);
t.Adjust := LastAdjust;
SelNum := 1;
PageView.NPRedrawViewCheckBand(t);
SelectionChanged;
AddUndoAction(acInsert);
if Page is TfrPageReport then
OB1.Down := True
else
OB7.Down := True
end;
end;
end;
procedure TfrDesignerForm.ScrollBox1DragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
var
Control :TControl;
begin
Accept:= false;
if Page is TfrPageDialog then Exit;
Control:=lrDesignAcceptDrag(Source);
if Assigned(lrFieldsList) then
Accept:= (Control = lrFieldsList.lbFieldsList);
end;
procedure TfrDesignerForm.tlsDBFieldsExecute(Sender: TObject);
begin
if Assigned(lrFieldsList) then
FreeThenNil(lrFieldsList)
else
lrFieldsList:=TlrFieldsList.Create(Self);
tlsDBFields.Checked:=Assigned(lrFieldsList);
end;
procedure TfrDesignerForm.GB2Click(Sender: TObject);
begin
GridAlign := GB2.Down;

View File

@ -68,6 +68,7 @@ function lrDateTimeToStr(ADate:TDateTime):string;
function lrStrToDateTime(AValue: string): TDateTime;
function lrExpandVariables(const S:string):string;
procedure lrNormalizeLocaleFloats(DisableLocale: boolean);
function lrConfigFolderName(ACreatePath: boolean): string;
// utf8 tools
function UTF8Desc(S:string; var Desc: string): Integer;
@ -81,7 +82,7 @@ function UTF8CountWords(const str:string; out WordCount,SpcCount,SpcSize:Integer
implementation
uses LR_Class, LR_Const, LR_Pars;
uses LR_Class, LR_Const, LR_Pars, FileUtil, LazUtilsStrConsts;
var
PreviousFormatSettings: TFormatSettings;
@ -748,6 +749,14 @@ begin
DefaultFormatSettings := PreviousFormatSettings;
end;
function lrConfigFolderName(ACreatePath: boolean): string;
begin
Result:=AppendPathDelim(GetAppConfigDirUTF8(false, ACreatePath))+'LazReport';
if ACreatePath and not ForceDirectoriesUTF8(Result) then
raise EInOutError.Create(SysUtils.Format(lrsUnableToCreateConfigDirectoryS,[Result]));
end;
function UTF8Desc(S: string; var Desc: string): Integer;
var
i,b: Integer;