lazarus/components/lazreport/samples/editor/maincalleditor.pas

632 lines
18 KiB
ObjectPascal

{
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.
Author : Jesus Reyes
Abstract:
Show how to use TFrReport component for call editor
}
unit maincalleditor;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Variants, FileUtil, LResources, Forms, Controls, Graphics,
Dialogs, Buttons, StdCtrls, LR_Const, LR_Class, LR_Desgn, Dbf, DB, DBGrids,
LR_DBSet, IniFiles, LR_PGrid, Menus, ComCtrls, ActnList, Lr_e_txt, Lr_e_htm,
LR_E_CSV, LR_DSet, LR_BarC, LR_RRect, LR_Shape, LR_ChBox, lconvencoding,
lr_e_gen, lr_utils, LCLProc, ExtCtrls, custompreview, LR_Pars, LR_e_htmldiv,
lrAddFunctionLibrary, LazLoggerBase, LazFileUtils, LCLTranslator;
type
{ TfrmMain }
TfrmMain = class(TForm)
accNewReport: TAction;
accEditReport: TAction;
accPreviewReport: TAction;
accPrintGrid: TAction;
accPrintReport: TAction;
accClose: TAction;
accExportToText: TAction;
accExportToHtml: TAction;
accOpenReport: TAction;
accExportToCSV: TAction;
accThumbnails: TAction;
accExportToDbg: TAction;
accComposite: TAction;
accCustomPreview: TAction;
ActionList1: TActionList;
ApplicationProperties1: TApplicationProperties;
btnMasterDetail: TToggleBox;
btnNewReport: TButton;
btnCustomPreview: TButton;
btnPrintGrid: TButton;
btnPreviewReport: TButton;
btnEditReport: TButton;
btnPrintReport: TButton;
btnOpenReport: TButton;
btnImageList: TButton;
btnComposite: TButton;
btnExportLast: TButton;
comboIndex: TComboBox;
frDbMaster: TfrDBDataSet;
frHtmlDivExport1: TfrHtmlDivExport;
lrAddFunctionLibrary1: TlrAddFunctionLibrary;
mastergrid: TDBGrid;
Panel1: TPanel;
srcMaster: TDatasource;
master: TDbf;
srcDetail: TDatasource;
DetailAUTHOR: TStringField;
DetailCOMPANY1: TStringField;
DetailCOMPANYID: TLongintField;
DetailCOUNTRY1: TStringField;
DetailCOUNTRYID: TLongintField;
DetailIN_STOCK: TBooleanField;
DetailLAST_SELL: TDateField;
DetailNOTE: TStringField;
DetailPRICE: TFloatField;
DetailQTY: TSmallintField;
DetailTITLE: TStringField;
DetailYEAR: TSmallintField;
Detail: TDbf;
LookCountries: TDbf;
LookCompanies: TDbf;
grid: TDBGrid;
frBarCodeObject1: TfrBarCodeObject;
frCheckBoxObject1: TfrCheckBoxObject;
Composite: TfrCompositeReport;
frCSVExport1: TfrCSVExport;
frDbDetail: TfrDBDataSet;
frRoundRectObject1: TfrRoundRectObject;
frShapeObject1: TfrShapeObject;
frUserDataset1: TfrUserDataset;
lblExpr: TLabel;
lblIndex: TLabel;
MainMenu1: TMainMenu;
MenuItem1: TMenuItem;
MenuItem10: TMenuItem;
MenuItem11: TMenuItem;
MenuItem12: TMenuItem;
MenuItem13: TMenuItem;
MenuItem14: TMenuItem;
MenuItem15: TMenuItem;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
MenuItem4: TMenuItem;
MenuItem5: TMenuItem;
MenuItem6: TMenuItem;
MenuItem7: TMenuItem;
MenuItem8: TMenuItem;
MenuItem9: TMenuItem;
OpenDialog1: TOpenDialog;
PrintGrid: TFrPrintGrid;
sbar: TStatusBar;
TheReport: TfrReport;
procedure accCompositeExecute(Sender: TObject);
procedure accCustomPreviewExecute(Sender: TObject);
procedure accExportToCSVExecute(Sender: TObject);
procedure accExportToDbgExecute(Sender: TObject);
procedure accExportToHtmlExecute(Sender: TObject);
procedure accExportToTextExecute(Sender: TObject);
procedure accThumbnailsExecute(Sender: TObject);
procedure ApplicationProperties1ShowHint(var HintStr: string;
var CanShow: Boolean; var HintInfo: THintInfo);
procedure accCloseExecute(Sender: TObject);
procedure accEditReportExecute(Sender: TObject);
procedure accNewReportExecute(Sender: TObject);
procedure accOpenReportExecute(Sender: TObject);
procedure accPreviewReportExecute(Sender: TObject);
procedure accPrintGridExecute(Sender: TObject);
procedure accPrintReportExecute(Sender: TObject);
procedure btnExportLastClick(Sender: TObject);
procedure btnMasterDetailClick(Sender: TObject);
procedure comboIndexSelect(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
procedure gridTitleClick(Column: TColumn);
procedure frmMainCreate(Sender: TObject);
procedure TheReportBeginDoc;
procedure TheReportEnterRect(Memo: TStringList; View: TfrView);
procedure TheReportExportFilterSetup(Sender: TfrExportFilter);
procedure TheReportGetValue(const ParName: String; var ParValue: Variant);
procedure TheReportUserFunction(const AName: String; p1, p2, p3: Variant;
var Val: Variant);
private
{ private declarations }
FImageList: TStringList;
FImageListIndex: Integer;
FObjCount: Integer;
FCountryIndex: Integer;
FCurReport: string;
procedure UpdateAppTranslation;
procedure SetIndex(const aIndexName: string);
procedure OpenReport(const aFileName:string);
procedure UpdateActiveReport;
function GetDataPath: string;
procedure MasterDetail;
procedure LoadConfig;
procedure SaveConfig;
public
{ public declarations }
end;
var
frmMain: TfrmMain;
implementation
uses translations, lazutf8;
{$R *.lfm}
resourcestring
cerOpenReport = 'Open report';
cerNewReport = 'New report';
cerEditReport = 'Edit Report';
cerPreviewReport = 'Preview report';
cerPrintReport = 'Print report';
cerPrintGrid = 'Print grid';
cerPrepareFailed = 'PrepareReport Failed!';
cerIndex = 'Index';
cerNone = 'none';
cerIndexFields = 'Index Fields: %s';
cerOpenReportFirst= 'Open report first';
cerActiveReport = 'Active report: %s';
cerHintNewReport = 'Create and edit a empty report';
cerHintOpenReport = 'Open an existing report';
cerHintEditReport = 'Edit active report';
cerHintPrevReport = 'Preview active report';
cerHintPrevGrid = 'Print preview current DbGrid content';
cerHintPrnReport = 'Print directly the active report (i.e. without preview)';
cerHintCloseApp = 'Close application';
cerAppCaption = 'LazReport Test Suite';
cerHintThumbnails = 'This Action will Load and Preview a thumbnails Report';
cerThumbnails = 'Thumbnails';
cerHintComposite = 'This Action will Load and Preview a composite Report';
cerComposite = 'Composite';
{ TfrmMain }
procedure TfrmMain.UpdateAppTranslation;
begin
accOpenReport.Caption := cerOpenReport;
accNewReport.Caption := cerNewReport;
accEditReport.Caption := cerEditReport;
accPreviewReport.Caption := cerPreviewReport;
accPrintReport.Caption := cerPrintReport;
accPrintGrid.Caption := cerPrintGrid;
lblIndex.Caption:=cerIndex;
accNewReport.Hint := cerHintNewReport;
accOpenReport.Hint := cerHintOpenReport;
accEditReport.Hint := cerHintEditReport;
accPreviewReport.Hint := cerHintPrevReport;
accPrintGrid.Hint := cerHintPrevGrid;
accPrintReport.Hint := cerHintPrnReport;
accClose.Hint := cerHintCloseApp;
caption := cerAppCaption;
accThumbnails.Hint := cerHintThumbnails;
accThumbnails.Caption := cerThumbnails;
accComposite.Hint := cerHintComposite;
accComposite.Caption := cerComposite;
end;
procedure TfrmMain.ApplicationProperties1ShowHint(var HintStr: string;
var CanShow: Boolean; var HintInfo: THintInfo);
begin
sbar.SimpleText := HintStr;
CanShow := False;
sbar.SimplePanel := HintStr<>'';
end;
procedure TfrmMain.accExportToTextExecute(Sender: TObject);
begin
if TheReport.PrepareReport then
TheReport.ExportTo(TfrTextExportFilter, 'salida.txt')
else
ShowMessage(cerPrepareFailed);
end;
procedure TfrmMain.accThumbnailsExecute(Sender: TObject);
begin
OpenReport(ExtractFilePath(ParamStrUTF8(0))+'thumbnails.lrf');
FImageListIndex := 0;
FImageList := FindAllFiles('../../../../images/components','*.png',false);
try
if FImageList.Count>0 then begin
frUserDataset1.RangeEndCount:=FImageList.Count;
TheReport.ShowReport;
end else
ShowMessage('png images not found');
finally
FImageList.Free;
FImageList:=nil;
end;
end;
procedure TfrmMain.accExportToHtmlExecute(Sender: TObject);
begin
if TheReport.PrepareReport then begin
TheReport.ExportTo(TfrHTMExportFilter, 'salida.html');
end else
ShowMessage(cerPrepareFailed);
end;
procedure TfrmMain.accExportToCSVExecute(Sender: TObject);
begin
if TheReport.PrepareReport then begin
TheReport.ExportTo(TfrCSVExportFilter, 'salida.csv');
end else
ShowMessage(cerPrepareFailed);
end;
procedure TfrmMain.accCompositeExecute(Sender: TObject);
var
i: Integer;
r: TFrReport;
begin
// force reload of reports in case modified reports
// were modified in designer at run-time
for i := 0 to Composite.Reports.Count-1 do begin
r := TfrReport(Composite.Reports[i]);
r.LoadFromFile(r.FileName);
end;
Composite.ShowReport;
end;
procedure TfrmMain.accCustomPreviewExecute(Sender: TObject);
var
F: TfrmCustomPreview;
begin
F := TfrmCustomPreview.Create(self);
try
TheReport.Preview := F.frPreview1;
TheReport.ShowReport;
F.Caption := accCustomPreview.Caption;
F.ShowModal;
finally
TheReport.Preview := nil;
F.Free;
end;
end;
procedure TfrmMain.accExportToDbgExecute(Sender: TObject);
begin
if TheReport.PrepareReport then begin
TheReport.ExportTo(TfrDbgExportFilter, 'salida.dbg');
end else
ShowMessage(cerPrepareFailed);
end;
procedure TfrmMain.accCloseExecute(Sender: TObject);
begin
Close;
end;
procedure TfrmMain.accEditReportExecute(Sender: TObject);
begin
if TheReport.FileName='' then
raise Exception.Create(cerOpenReportFirst);
ApplicationProperties1.OnShowHint := nil;
TheReport.DesignReport;
ApplicationProperties1.OnShowHint := @ApplicationProperties1ShowHint;
end;
procedure TfrmMain.accNewReportExecute(Sender: TObject);
begin
TheReport.Pages.Clear;
TheReport.FileName:=SUntitled;
TheReport.DesignReport;
UpdateActiveReport;
end;
procedure TfrmMain.accOpenReportExecute(Sender: TObject);
begin
if OpenDialog1.Execute then begin
OpenReport(OpenDialog1.FileName);
end;
end;
procedure TfrmMain.accPreviewReportExecute(Sender: TObject);
begin
if btnMasterDetail.Checked then begin
grid.DataSource := nil;
MasterGrid.Datasource := nil;
end;
TheReport.ShowReport;
if btnMasterDetail.Checked then begin
MasterGrid.DataSource := srcMaster;
grid.Datasource := srcDetail;
end;
end;
procedure TfrmMain.accPrintGridExecute(Sender: TObject);
begin
PrintGrid.PreviewReport;
end;
procedure TfrmMain.accPrintReportExecute(Sender: TObject);
begin
if TheReport.PrepareReport then
TheReport.PrintPreparedReport('1',1)
else
ShowMessage(cerPrepareFailed);
end;
procedure TfrmMain.btnExportLastClick(Sender: TObject);
begin
if TheReport.PrepareReport then
TheReport.ExportTo(nil, '')
else
ShowMessage(cerPrepareFailed);
end;
procedure TfrmMain.btnMasterDetailClick(Sender: TObject);
begin
MasterDetail;
end;
procedure TfrmMain.comboIndexSelect(Sender: TObject);
var
i: Integer;
begin
i := comboIndex.ItemIndex;
if i<=0 then begin
SetIndex('');
end else begin
SetIndex(comboIndex.Items[i]);
end;
end;
procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: boolean);
begin
SaveConfig;
end;
procedure TfrmMain.gridTitleClick(Column: TColumn);
begin
if CompareText(Column.FieldName,'year')=0 then
SetIndex('ByYear')
else
if CompareText(Column.FieldName,'company1')=0 then
SetIndex('ByCompany')
else
if CompareText(Column.FieldName,'country1')=0 then
SetIndex('ByCountry')
else
SetIndex('');
end;
procedure TfrmMain.frmMainCreate(Sender: TObject);
const
rptarr:array[0..1] of string[10] = ('rpta.lrf','rptb.lrf');
var
i: integer;
r: TfrReport;
dataPath: string;
begin
DebugLogger.MaxNestPrefixLen:=100;
UpdateAppTranslation;
DataPath := GetDataPath;
LookCountries.Close;
LookCountries.FilePath := datapath + 'db/';
LookCountries.TableName := 'countries.dbf';
LookCountries.open;
LookCompanies.Close;
LookCompanies.FilePath := datapath + 'db/';
LookCompanies.TableName := 'companies.dbf';
LookCompanies.Open;
Detail.close;
Detail.FilePath := datapath + 'db/';
Detail.TableName := 'disco.dbf';
Detail.open;
Master.Close;
Master.FilePath := datapath + 'db/';
Master.TableName := 'countries.dbf';
LoadConfig;
comboIndex.Clear;
comboIndex.Items.Add(cerNone);
for i:=0 to Detail.Indexes.Count-1 do
comboIndex.Items.Add(Detail.Indexes[i].Name);
FCountryIndex := ComboIndex.Items.IndexOf('BYCOUNTRY');
SetIndex('');
for i:=Low(rptArr) to High(rptArr) do begin
r := TfrReport.Create(self);
r.LoadFromFile(rptArr[i]);
Composite.Reports.Add(r);
end;
Composite.DoublePass:=true;
if FileExistsUTF8(fCurReport) then
OpenReport(fCurReport);
frSelectHyphenDictionary(dataPath + 'hyph_es_ANY.dic');
end;
procedure TfrmMain.TheReportBeginDoc;
begin
FObjCount := 0;
end;
procedure TfrmMain.TheReportEnterRect(Memo: TStringList; View: TfrView);
begin
if (FImageList<>nil) and (View.Name='thumbnail') then begin
TFrPictureView(View).Picture.LoadFromFile(FImageList[FImageListIndex]);
Inc(FImageListIndex);
end;
end;
procedure TfrmMain.TheReportExportFilterSetup(Sender: TfrExportFilter);
begin
// parameters that all export filters can change
Sender.UseProgressbar:=false;
//Sender.BandTypes := [btMasterData]; // by default all bandtypes are processed
if sender is TfrHtmExportFilter then begin
//TfrTextExportFilter(sender).UseBOM := true; // false by default
//TfrTextExportFilter(Sender).UsedFont:=0; // force to show used font dialog
TfrHtmExportFilter(Sender).UseCSS:=false; // true by default
end else
if sender is TfrCSVExportFilter then begin
TfrCSVExportFilter(sender).UseBOM := true; // default settings + BOM = excel compatible
//TfrCSVExportFilter(sender).QuoteChar := '''';
//TfrCSVExportFilter(sender).QuoteType := qtNone;
//TfrCSVExportFilter(sender).Separator := ';';
end else
if Sender is TfrTextExportFilter then begin
TfrTextExportFilter(sender).UseBOM := false;
TfrTextExportFilter(Sender).UsedFont:=0; // force to show used font dialog
end;
end;
procedure TfrmMain.TheReportGetValue(const ParName: String;
var ParValue: Variant);
begin
if ParName='vv1' then begin
if FObjCount mod 3 = 0 then
ParValue := 'áñâàÑ€¼2³¤€¼½¾'
else
ParValue := '12345678901234';
Inc(FObjCount);
end;
end;
procedure TfrmMain.TheReportUserFunction(const AName: String; p1, p2,
p3: Variant; var Val: Variant);
var
v: variant;
begin
if AName='STOCKFLAG' then begin
v := frParser.Calc(P1);
if VarIsNull(V) or not boolean(v) then
Val := ':('
else
Val:= ':)';
end;
end;
procedure TfrmMain.SetIndex(const aIndexName: string);
begin
Detail.IndexName := aIndexName;
lblExpr.Caption:= format(cerIndexFields, [Detail.IndexFieldNames]);
end;
procedure TfrmMain.OpenReport(const aFileName: string);
begin
TheReport.LoadFromFile(aFileName);
fCurReport := TheReport.FileName;
UpdateActiveReport;
end;
procedure TfrmMain.UpdateActiveReport;
begin
SBar.Panels[0].Text:= format(cerActiveReport, [TheReport.FileName]);
end;
function TfrmMain.GetDataPath: string;
begin
result := ExtractFilePath(ParamStr(0));
{$ifdef Darwin}
result := IncludeTrailingPathDelimiter(ExpandFileName(result + '../../..'));
{$endif}
end;
procedure TfrmMain.MasterDetail;
begin
if mastergrid.Visible then begin
MasterGrid.Visible := false;
Grid.AnchorSideLeft.Control := Self;
Grid.AnchorSideLeft.Side := asrTop;
detail.MasterSource := nil;
detail.MasterFields := '';
detail.IndexName := '';
comboIndexSelect(self);
comboIndex.Enabled := true;
end else begin
Master.Open;
detail.MasterSource := srcMaster;
detail.MasterFields := 'CountryID';
comboIndex.ItemIndex := FCountryIndex;
comboIndexSelect(self);
MasterGrid.Visible := true;
Grid.AnchorSideLeft.Control := MasterGrid;
Grid.AnchorSideLeft.Side := asrBottom;
comboIndex.Enabled := false;
end;
end;
procedure TfrmMain.LoadConfig;
var
ini: TIniFile;
s: string;
begin
ini := TIniFile.Create(GetDataPath+'config.ini');
s := ini.ReadString('General', 'LastReport', '');
if s<>'' then
fCurreport := s
else
fCurReport := GetDataPath + 'salida.lrf';
TheReport.DefExportFileName := ini.ReadString('General','LastExportFilename','');
TheReport.DefExportFilterClass := ini.ReadString('General','LastExportFilterClass', '');
ini.Free;
end;
procedure TfrmMain.SaveConfig;
var
ini: TIniFile;
begin
ini := TIniFile.Create(GetDataPath+'config.ini');
ini.WriteString('General', 'LastReport', fCurReport);
ini.WriteString('General', 'LastExportFilename', theReport.DefExportFileName);
ini.WriteString('General', 'LastExportFilterClass', theReport.DefExportFilterClass);
ini.free;
end;
procedure TranslateResStrings;
var
LangID: TLanguageID;
begin
LangID := GetLanguageID;
TranslateUnitResourceStrings('LCLStrConsts','../../../../lcl/languages/lclstrconsts.%s.po', LangID.LanguageID, LangID.LanguageCode);
TranslateUnitResourceStrings('Lr_const','../../source/languages/lr_const.%s.po', LangID.LanguageID, LangID.LanguageCode);
TranslateUnitResourceStrings('lr_add_function_const','../../source/addons/addfunction/languages/lr_add_function_const.%s.po',
LangID.LanguageID, LangID.LanguageCode);
SetDefaultLang('', '', '', false); // needed to translate strings extracted from forms
end;
initialization
TranslateResStrings;
end.