Стартовый пул
This commit is contained in:
720
RXLib/rxdbgrid_export_spreadsheet/rxdbgridexportspreadsheet.pas
Normal file
720
RXLib/rxdbgrid_export_spreadsheet/rxdbgridexportspreadsheet.pas
Normal file
@@ -0,0 +1,720 @@
|
||||
{ RxDBGridExportSpreadSheet unit
|
||||
|
||||
Copyright (C) 2005-2017 Lagunov Aleksey alexs@yandex.ru
|
||||
original conception from rx library for Delphi (c)
|
||||
|
||||
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 with the following modification:
|
||||
|
||||
As a special exception, the copyright holders of this library give you
|
||||
permission to link this library with independent modules to produce an
|
||||
executable, regardless of the license terms of these independent modules,and
|
||||
to copy and distribute the resulting executable under terms of your choice,
|
||||
provided that you also meet, for each linked independent module, the terms
|
||||
and conditions of the license of that module. An independent module is a
|
||||
module which is not derived from or based on this library. If you modify
|
||||
this library, you may extend this exception to your version of the library,
|
||||
but you are not obligated to do so. If you do not wish to do so, delete this
|
||||
exception statement from your 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
}
|
||||
|
||||
unit RxDBGridExportSpreadSheet;
|
||||
|
||||
{$I rx.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, rxdbgrid, DB, fpspreadsheet, Graphics, fpsTypes;
|
||||
|
||||
type
|
||||
TRxDBGridExportSpreadSheetOption = (ressExportTitle,
|
||||
ressExportColors,
|
||||
ressExportFooter,
|
||||
ressExportFormula,
|
||||
ressOverwriteExisting,
|
||||
ressExportSelectedRows,
|
||||
ressHideZeroValues,
|
||||
ressColSpanning,
|
||||
ressExportGroupData
|
||||
);
|
||||
|
||||
TRxDBGridExportSpreadSheetOptions = set of TRxDBGridExportSpreadSheetOption;
|
||||
|
||||
type
|
||||
|
||||
{ TRxDBGridExportSpreadSheet }
|
||||
|
||||
TRxDBGridExportSpreadSheet = class(TRxDBGridAbstractTools)
|
||||
private
|
||||
FFileName: string;
|
||||
FOpenAfterExport: boolean;
|
||||
FOptions: TRxDBGridExportSpreadSheetOptions;
|
||||
FPageName: string;
|
||||
function ColIndex(ACol:TRxColumn):integer;
|
||||
procedure ExpCurRow(AFont: TFont);
|
||||
procedure ExpAllRow;
|
||||
procedure ExpSelectedRow;
|
||||
procedure ExpGrpLine(G: TColumnGroupItem);
|
||||
protected
|
||||
FDataSet:TDataSet;
|
||||
FWorkbook: TsWorkbook;
|
||||
FWorksheet: TsWorksheet;
|
||||
FCurRow : integer;
|
||||
FFirstDataRow : integer;
|
||||
FLastDataRow : integer;
|
||||
FCurCol : integer;
|
||||
scColorBlack:TsColor;
|
||||
|
||||
procedure DoExportTitle;
|
||||
procedure DoExportBody;
|
||||
procedure DoExportFooter;
|
||||
procedure DoExportColWidth;
|
||||
function DoExecTools:boolean;override;
|
||||
function DoSetupTools:boolean; override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
published
|
||||
property FileName:string read FFileName write FFileName;
|
||||
property PageName:string read FPageName write FPageName;
|
||||
property Options:TRxDBGridExportSpreadSheetOptions read FOptions write FOptions;
|
||||
property OpenAfterExport:boolean read FOpenAfterExport write FOpenAfterExport default false;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
uses fpsallformats, LCLType, Forms, math, LazUTF8, rxdconst, Controls, LCLIntf,
|
||||
RxDBGridExportSpreadSheet_ParamsUnit, rxdbutils, fpsutils, DBGrids;
|
||||
|
||||
{$R rxdbgridexportspreadsheet.res}
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('RX DBAware',[TRxDBGridExportSpreadSheet]);
|
||||
end;
|
||||
|
||||
const
|
||||
ssAligns : array [TAlignment] of TsHorAlignment = (haLeft, haRight, haCenter);
|
||||
|
||||
type
|
||||
THackRxDBGrid = class(TRxDBGrid);
|
||||
|
||||
{ TRxDBGridExportSpeadSheet }
|
||||
|
||||
function TRxDBGridExportSpreadSheet.ColIndex(ACol: TRxColumn): integer;
|
||||
var
|
||||
C: TRxColumn;
|
||||
i: Integer;
|
||||
begin
|
||||
Result:=-1;
|
||||
if (not Assigned(ACol)) or (not ACol.Visible) then exit;
|
||||
for i:=0 to FRxDBGrid.Columns.Count - 1 do
|
||||
begin
|
||||
C:=FRxDBGrid.Columns[i] as TRxColumn;
|
||||
if C.Visible then
|
||||
Inc(Result);
|
||||
if ACol = C then
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxDBGridExportSpreadSheet.ExpCurRow(AFont:TFont);
|
||||
var
|
||||
i, J, L, R: Integer;
|
||||
C: TRxColumn;
|
||||
CT: TRxColumnTitle;
|
||||
S: String;
|
||||
CC: TColor;
|
||||
G: TColumnGroupItem;
|
||||
begin
|
||||
FCurCol:=0;
|
||||
|
||||
i:=0;
|
||||
|
||||
while i<FRxDBGrid.Columns.Count do
|
||||
begin
|
||||
C:=nil;
|
||||
R:=-1;
|
||||
if (rdgColSpanning in FRxDBGrid.OptionsRx) and (ressColSpanning in Options) then
|
||||
if FRxDBGrid.IsMerged(I + 1, L, R, C) then
|
||||
FWorksheet.MergeCells(FCurRow, FCurCol, FCurRow, R-1);
|
||||
|
||||
if not Assigned(C) then
|
||||
C:=FRxDBGrid.Columns[i] as TRxColumn;
|
||||
|
||||
CT:=C.Title as TRxColumnTitle;
|
||||
if C.Visible then
|
||||
begin
|
||||
if Assigned(C.Field) then
|
||||
begin
|
||||
//S:=C.Field.DisplayText;
|
||||
S:=THackRxDBGrid(FRxDBGrid).GetFieldDisplayText(C.Field, C);
|
||||
if (C.KeyList.Count > 0) and (C.PickList.Count > 0) then
|
||||
begin
|
||||
J := C.KeyList.IndexOf(S);
|
||||
if (J >= 0) and (J < C.PickList.Count) then
|
||||
S := C.PickList[j];
|
||||
FWorksheet.WriteUTF8Text(FCurRow, FCurCol, S);
|
||||
end
|
||||
else
|
||||
if Assigned(C.Field.OnGetText) then
|
||||
FWorksheet.WriteUTF8Text(FCurRow, FCurCol, S)
|
||||
else
|
||||
if C.Field.DataType in [ftCurrency] then
|
||||
begin
|
||||
if (C.Field.AsCurrency <> 0) or (not (ressHideZeroValues in FOptions)) then
|
||||
FWorksheet.WriteCurrency(FCurRow, FCurCol, C.Field.AsCurrency, nfCurrency, '')
|
||||
end
|
||||
else
|
||||
if C.Field.DataType in IntegerDataTypes then
|
||||
begin
|
||||
if (C.Field.AsInteger <> 0) or (not (ressHideZeroValues in FOptions)) then
|
||||
FWorksheet.WriteNumber(FCurRow, FCurCol, C.Field.AsInteger, nfFixed, 0)
|
||||
end
|
||||
else
|
||||
if C.Field.DataType in NumericDataTypes then
|
||||
begin
|
||||
if (C.Field.AsFloat <> 0) or (not (ressHideZeroValues in FOptions)) then
|
||||
FWorksheet.WriteNumber(FCurRow, FCurCol, C.Field.AsFloat, nfFixed, 2)
|
||||
end
|
||||
else
|
||||
FWorksheet.WriteUTF8Text(FCurRow, FCurCol, S);
|
||||
end;
|
||||
|
||||
if ressExportColors in FOptions then
|
||||
begin
|
||||
CC:=C.Color;
|
||||
if Assigned(RxDBGrid.OnGetCellProps) then
|
||||
RxDBGrid.OnGetCellProps(RxDBGrid, C.Field, AFont, CC);
|
||||
if (CC and SYS_COLOR_BASE) = 0 then
|
||||
begin
|
||||
{$IFDEF OLD_fpSPREADSHEET}
|
||||
scColor:=FWorkbook.AddColorToPalette(CC);
|
||||
FWorksheet.WriteBackgroundColor(FCurRow,FCurCol, scColor);
|
||||
{$ELSE}
|
||||
FWorksheet.WriteBackgroundColor(FCurRow,FCurCol, CC);
|
||||
{$ENDIF}
|
||||
end;
|
||||
end;
|
||||
|
||||
FWorksheet.WriteBorders(FCurRow,FCurCol, [cbNorth, cbWest, cbEast, cbSouth]);
|
||||
FWorksheet.WriteBorderColor(FCurRow,FCurCol, cbNorth, scColorBlack);
|
||||
FWorksheet.WriteBorderColor(FCurRow,FCurCol, cbWest, scColorBlack);
|
||||
FWorksheet.WriteBorderColor(FCurRow,FCurCol, cbEast, scColorBlack);
|
||||
FWorksheet.WriteBorderColor(FCurRow,FCurCol, cbSouth, scColorBlack);
|
||||
|
||||
FWorksheet.WriteHorAlignment(FCurRow, FCurCol, ssAligns[C.Alignment]);
|
||||
inc(FCurCol);
|
||||
end;
|
||||
|
||||
if R > -1 then
|
||||
begin
|
||||
i:=R-1;
|
||||
FCurCol:=R;
|
||||
end;
|
||||
|
||||
Inc(i);
|
||||
end;
|
||||
|
||||
if RxDBGrid.GroupItems.Active and (ressExportGroupData in Options) then
|
||||
begin
|
||||
|
||||
THackRxDBGrid(RxDBGrid).FGroupItemDrawCur:=RxDBGrid.GroupItems.FindGroupItem(RxDBGrid.DataSource.DataSet.Bookmark);
|
||||
if Assigned(THackRxDBGrid(RxDBGrid).FGroupItemDrawCur) then
|
||||
ExpGrpLine(THackRxDBGrid(RxDBGrid).FGroupItemDrawCur);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxDBGridExportSpreadSheet.ExpAllRow;
|
||||
var
|
||||
F: TFont;
|
||||
begin
|
||||
F:=TFont.Create;
|
||||
FDataSet.First;
|
||||
while not FDataSet.EOF do
|
||||
begin
|
||||
ExpCurRow(F);
|
||||
inc(FCurRow);
|
||||
FDataSet.Next;
|
||||
end;
|
||||
F.Free;
|
||||
end;
|
||||
|
||||
procedure TRxDBGridExportSpreadSheet.ExpSelectedRow;
|
||||
var
|
||||
F: TFont;
|
||||
k: Integer;
|
||||
begin
|
||||
F:=TFont.Create;
|
||||
FDataSet.First;
|
||||
for k:=0 to FRxDBGrid.SelectedRows.Count-1 do
|
||||
begin
|
||||
FDataSet.Bookmark:=FRxDBGrid.SelectedRows[k];
|
||||
ExpCurRow(F);
|
||||
inc(FCurRow);
|
||||
end;
|
||||
F.Free;
|
||||
end;
|
||||
|
||||
procedure TRxDBGridExportSpreadSheet.ExpGrpLine(G: TColumnGroupItem);
|
||||
var
|
||||
C: TRxColumn;
|
||||
|
||||
procedure OutGroupCellProps;
|
||||
{$IFDEF OLD_fpSPREADSHEET}
|
||||
var
|
||||
scColor : TsColor;
|
||||
{$ENDIF}
|
||||
var
|
||||
FColor: TColor;
|
||||
begin
|
||||
|
||||
if C.GroupParam.Color <> clNone then
|
||||
FColor := C.GroupParam.Color
|
||||
else
|
||||
if RxDBGrid.GroupItems.Color <> clNone then
|
||||
FColor := RxDBGrid.GroupItems.Color
|
||||
else
|
||||
FColor := clNone;
|
||||
|
||||
if (FColor <> clNone) and (ressExportColors in FOptions) then
|
||||
begin
|
||||
{$IFDEF OLD_fpSPREADSHEET}
|
||||
if (C.GroupParam.Color and SYS_COLOR_BASE) = 0 then
|
||||
begin
|
||||
scColor:=FWorkbook.AddColorToPalette(C.GroupParam.Color);
|
||||
FWorksheet.WriteBackgroundColor(FCurRow,FCurCol, scColor);}
|
||||
end;
|
||||
{$ELSE}
|
||||
FWorksheet.WriteBackgroundColor(FCurRow, FCurCol, FColor);
|
||||
{$ENDIF}
|
||||
end;
|
||||
FWorksheet.WriteBorders(FCurRow, FCurCol, [cbNorth, cbWest, cbEast, cbSouth]);
|
||||
FWorksheet.WriteBorderColor(FCurRow, FCurCol, cbNorth, scColorBlack);
|
||||
FWorksheet.WriteBorderColor(FCurRow, FCurCol, cbWest, scColorBlack);
|
||||
FWorksheet.WriteBorderColor(FCurRow, FCurCol, cbEast, scColorBlack);
|
||||
FWorksheet.WriteBorderColor(FCurRow, FCurCol, cbSouth, scColorBlack);
|
||||
end;
|
||||
|
||||
procedure OutGroupCell(G: TColumnGroupItem);
|
||||
var
|
||||
D: Integer;
|
||||
SF: String;
|
||||
begin
|
||||
if (C.GroupParam.ValueType <> fvtNon) then
|
||||
begin
|
||||
(* if (ressExportFormula in FOptions) and (Footer.ValueType in [fvtSum, fvtMax, fvtMin]) and (FFirstDataRow <= FLastDataRow) {and (Footer.DisplayFormat = '')} then
|
||||
begin
|
||||
D:=ColIndex(RxDBGrid.ColumnByFieldName(Footer.FieldName));
|
||||
|
||||
if D>=0 then
|
||||
begin
|
||||
case Footer.ValueType of
|
||||
fvtSum:SF:='SUM';
|
||||
fvtMax:SF:='MIN';
|
||||
fvtMin:SF:='MAX';
|
||||
else
|
||||
SF:='Error!(';
|
||||
end;
|
||||
|
||||
FWorksheet.WriteFormula(FCurRow, FCurCol,
|
||||
Format('=%s(%s%d:%s%d)', [SF, GetColString(D), FFirstDataRow+1, GetColString(D), FLastDataRow+1]));
|
||||
end
|
||||
else
|
||||
begin
|
||||
FWorksheet.WriteNumber(FCurRow, FCurCol, Footer.NumericValue, nfFixed, 2);
|
||||
end;
|
||||
end
|
||||
else *)
|
||||
FWorksheet.WriteUTF8Text(FCurRow, FCurCol, C.GroupParam.DisplayText);
|
||||
FWorksheet.WriteHorAlignment(FCurRow, FCurCol, ssAligns[C.GroupParam.Alignment]);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
inc(FCurRow);
|
||||
FCurCol:=0;
|
||||
for i:=0 to FRxDBGrid.Columns.Count - 1 do
|
||||
begin
|
||||
C:=FRxDBGrid.Columns[i] as TRxColumn;
|
||||
if C.Visible then
|
||||
begin
|
||||
OutGroupCellProps;
|
||||
OutGroupCell(G);
|
||||
inc(FCurCol);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxDBGridExportSpreadSheet.DoExportTitle;
|
||||
var
|
||||
i, k : Integer;
|
||||
C : TRxColumn;
|
||||
CT : TRxColumnTitle;
|
||||
CC : TColor;
|
||||
{$IFDEF OLD_fpSPREADSHEET}
|
||||
scColor : TsColor;
|
||||
{$ENDIF}
|
||||
CB:TsCellBorders;
|
||||
FMaxTitleHeight : integer;
|
||||
P: TMLCaptionItem;
|
||||
begin
|
||||
FCurCol:=0;
|
||||
FMaxTitleHeight:=1;
|
||||
for i:=0 to FRxDBGrid.Columns.Count - 1 do
|
||||
begin
|
||||
C:=FRxDBGrid.Columns[i] as TRxColumn;
|
||||
CT:=C.Title as TRxColumnTitle;
|
||||
FMaxTitleHeight:=Max(FMaxTitleHeight, CT.CaptionLinesCount);
|
||||
if C.Visible then
|
||||
begin
|
||||
if CT.CaptionLinesCount > 0 then
|
||||
begin
|
||||
for k:=0 to CT.CaptionLinesCount - 1 do
|
||||
begin
|
||||
CC:=C.Title.Color;
|
||||
if (CC and SYS_COLOR_BASE) = 0 then
|
||||
begin
|
||||
{$IFDEF OLD_fpSPREADSHEET}
|
||||
scColor:=FWorkbook.AddColorToPalette(CC);
|
||||
FWorksheet.WriteBackgroundColor(FCurRow, FCurCol, scColor);
|
||||
{$ELSE}
|
||||
FWorksheet.WriteBackgroundColor(FCurRow, FCurCol, CC);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
CB:=[cbNorth, cbWest, cbEast, cbSouth];
|
||||
|
||||
FWorksheet.WriteBorderColor(FCurRow + k, FCurCol, cbNorth, scColorBlack);
|
||||
|
||||
if not Assigned(CT.CaptionLine(k).Next) then
|
||||
FWorksheet.WriteBorderColor(FCurRow + k, FCurCol, cbWest, scColorBlack)
|
||||
else
|
||||
CB:=CB - [cbWest];
|
||||
|
||||
if not Assigned(CT.CaptionLine(k).Prior) then
|
||||
FWorksheet.WriteBorderColor(FCurRow + k, FCurCol, cbEast, scColorBlack)
|
||||
else
|
||||
CB:=CB - [cbEast];
|
||||
|
||||
|
||||
FWorksheet.WriteBorderColor(FCurRow + k ,FCurCol, cbSouth, scColorBlack);
|
||||
|
||||
FWorksheet.WriteBorders(FCurRow + k, FCurCol, CB);
|
||||
|
||||
FWorksheet.WriteHorAlignment(FCurRow + k, FCurCol, ssAligns[C.Title.Alignment]);
|
||||
|
||||
FWorksheet.WriteUTF8Text(FCurRow + k, FCurCol, CT.CaptionLine(k).Caption);
|
||||
|
||||
if Assigned(CT.CaptionLine(k).Next) and not Assigned(CT.CaptionLine(k).Prior) then
|
||||
begin
|
||||
//Merge title cell
|
||||
P:=CT.CaptionLine(k);
|
||||
CC:=FCurCol;
|
||||
while Assigned(P.Next) do
|
||||
begin
|
||||
Inc(CC);
|
||||
P:=P.Next;
|
||||
end;
|
||||
if CC<>FCurCol then
|
||||
FWorksheet.MergeCells(FCurRow, FCurCol, FCurRow, CC);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
CC:=C.Title.Color;
|
||||
if (CC and SYS_COLOR_BASE) = 0 then
|
||||
begin
|
||||
{$IFDEF OLD_fpSPREADSHEET}
|
||||
scColor:=FWorkbook.AddColorToPalette(CC);
|
||||
FWorksheet.WriteBackgroundColor( FCurRow, FCurCol, scColor);
|
||||
{$ELSE}
|
||||
FWorksheet.WriteBackgroundColor( FCurRow, FCurCol, CC);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
FWorksheet.WriteBorders(FCurRow,FCurCol, [cbNorth, cbWest, cbEast, cbSouth]);
|
||||
FWorksheet.WriteBorderColor(FCurRow,FCurCol, cbNorth, scColorBlack);
|
||||
FWorksheet.WriteBorderColor(FCurRow,FCurCol, cbWest, scColorBlack);
|
||||
FWorksheet.WriteBorderColor(FCurRow,FCurCol, cbEast, scColorBlack);
|
||||
FWorksheet.WriteBorderColor(FCurRow,FCurCol, cbSouth, scColorBlack);
|
||||
|
||||
FWorksheet.WriteHorAlignment(FCurRow, FCurCol, ssAligns[C.Title.Alignment]);
|
||||
|
||||
FWorksheet.WriteUTF8Text(FCurRow, FCurCol, C.Title.Caption);
|
||||
|
||||
end;
|
||||
|
||||
inc(FCurCol);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
if FMaxTitleHeight > 1 then
|
||||
begin
|
||||
for i:=0 to FRxDBGrid.Columns.Count-1 do
|
||||
begin
|
||||
C:=FRxDBGrid.Columns[i] as TRxColumn;
|
||||
CT:=C.Title as TRxColumnTitle;
|
||||
if CT.CaptionLinesCount < FMaxTitleHeight then
|
||||
begin
|
||||
FWorksheet.MergeCells( FCurRow + CT.CaptionLinesCount, I, FCurRow + FMaxTitleHeight - 1, I);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
inc(FCurRow, FMaxTitleHeight);
|
||||
FFirstDataRow:=FCurRow;
|
||||
end;
|
||||
|
||||
procedure TRxDBGridExportSpreadSheet.DoExportBody;
|
||||
begin
|
||||
if (dgMultiselect in RxDBGrid.Options) and (RxDBGrid.SelectedRows.Count > 0) and (ressExportSelectedRows in FOptions) then
|
||||
ExpSelectedRow
|
||||
else
|
||||
ExpAllRow;
|
||||
|
||||
FLastDataRow:=FCurRow-1;
|
||||
end;
|
||||
|
||||
procedure TRxDBGridExportSpreadSheet.DoExportFooter;
|
||||
var
|
||||
FooterColor:TColor;
|
||||
|
||||
procedure OutFooterCellProps;
|
||||
{$IFDEF OLD_fpSPREADSHEET}
|
||||
var
|
||||
scColor : TsColor;
|
||||
{$ENDIF}
|
||||
begin
|
||||
if (FRxDBGrid.FooterOptions.Color and SYS_COLOR_BASE) = 0 then
|
||||
begin
|
||||
{$IFDEF OLD_fpSPREADSHEET}
|
||||
scColor:=FWorkbook.AddColorToPalette(CC);
|
||||
FWorksheet.WriteBackgroundColor(FCurRow,FCurCol, scColor);}
|
||||
{$ELSE}
|
||||
FWorksheet.WriteBackgroundColor(FCurRow,FCurCol, FRxDBGrid.FooterOptions.Color);
|
||||
{$ENDIF}
|
||||
end;
|
||||
FWorksheet.WriteBorders(FCurRow,FCurCol, [cbNorth, cbWest, cbEast, cbSouth]);
|
||||
FWorksheet.WriteBorderColor(FCurRow,FCurCol, cbNorth, scColorBlack);
|
||||
FWorksheet.WriteBorderColor(FCurRow,FCurCol, cbWest, scColorBlack);
|
||||
FWorksheet.WriteBorderColor(FCurRow,FCurCol, cbEast, scColorBlack);
|
||||
FWorksheet.WriteBorderColor(FCurRow,FCurCol, cbSouth, scColorBlack);
|
||||
end;
|
||||
|
||||
procedure OutFooterCell(Footer: TRxColumnFooterItem);
|
||||
var
|
||||
D: Integer;
|
||||
SF: String;
|
||||
begin
|
||||
if (Footer.ValueType <> fvtNon) then
|
||||
begin
|
||||
if (ressExportFormula in FOptions) and (Footer.ValueType in [fvtSum, fvtMax, fvtMin]) and (FFirstDataRow <= FLastDataRow) {and (Footer.DisplayFormat = '')} then
|
||||
begin
|
||||
D:=ColIndex(RxDBGrid.ColumnByFieldName(Footer.FieldName));
|
||||
|
||||
if D>=0 then
|
||||
begin
|
||||
case Footer.ValueType of
|
||||
fvtSum:SF:='SUM';
|
||||
fvtMax:SF:='MIN';
|
||||
fvtMin:SF:='MAX';
|
||||
else
|
||||
SF:='Error!(';
|
||||
end;
|
||||
|
||||
FWorksheet.WriteFormula(FCurRow, FCurCol,
|
||||
Format('=%s(%s%d:%s%d)', [SF, GetColString(D), FFirstDataRow+1, GetColString(D), FLastDataRow+1]));
|
||||
end
|
||||
else
|
||||
begin
|
||||
FWorksheet.WriteNumber(FCurRow, FCurCol, Footer.NumericValue, nfFixed, 2);
|
||||
end;
|
||||
end
|
||||
else
|
||||
FWorksheet.WriteUTF8Text(FCurRow, FCurCol, Footer.DisplayText);
|
||||
FWorksheet.WriteHorAlignment(FCurRow, FCurCol, ssAligns[Footer.Alignment]);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
i , j: Integer;
|
||||
C : TRxColumn;
|
||||
begin
|
||||
for j:=0 to FRxDBGrid.FooterOptions.RowCount-1 do
|
||||
begin
|
||||
FCurCol:=0;
|
||||
for i:=0 to FRxDBGrid.Columns.Count - 1 do
|
||||
begin
|
||||
C:=FRxDBGrid.Columns[i] as TRxColumn;
|
||||
if C.Visible then
|
||||
begin
|
||||
OutFooterCellProps;
|
||||
if C.Footers.Count>j then
|
||||
OutFooterCell(C.Footers[j])
|
||||
else
|
||||
if J=0 then
|
||||
OutFooterCell(C.Footer);
|
||||
inc(FCurCol);
|
||||
end;
|
||||
end;
|
||||
Inc(FCurRow);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRxDBGridExportSpreadSheet.DoExportColWidth;
|
||||
var
|
||||
//FW:integer;
|
||||
C:TRxColumn;
|
||||
i: Integer;
|
||||
begin
|
||||
//FW:=FRxDBGrid.Canvas.TextWidth('W');
|
||||
FCurCol:=0;
|
||||
for i:=0 to FRxDBGrid.Columns.Count - 1 do
|
||||
begin
|
||||
C:=FRxDBGrid.Columns[i] as TRxColumn;
|
||||
if C.Visible then
|
||||
begin
|
||||
//FWorksheet.WriteColWidth(FCurCol, Max(C.Width div FW, 20));
|
||||
FWorksheet.WriteColWidth(FCurCol, C.Width, suPoints);
|
||||
inc(FCurCol);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
constructor TRxDBGridExportSpreadSheet.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FCaption:=sToolsExportSpeadSheet;
|
||||
FOpenAfterExport:=false;
|
||||
end;
|
||||
|
||||
function TRxDBGridExportSpreadSheet.DoExecTools: boolean;
|
||||
var
|
||||
P:TBookMark;
|
||||
begin
|
||||
Result:=false;
|
||||
if (not Assigned(FRxDBGrid)) or (not Assigned(FRxDBGrid.DataSource)) or (not Assigned(FRxDBGrid.DataSource.DataSet)) then
|
||||
exit;
|
||||
FDataSet:=FRxDBGrid.DataSource.DataSet;
|
||||
FDataSet.DisableControls;
|
||||
{$IFDEF NoAutomatedBookmark}
|
||||
P:=FDataSet.GetBookmark;
|
||||
{$ELSE}
|
||||
P:=FDataSet.Bookmark;
|
||||
{$ENDIF}
|
||||
|
||||
FWorkbook := TsWorkbook.Create;
|
||||
FWorksheet := FWorkbook.AddWorksheet(FPageName);
|
||||
try
|
||||
scColorBlack:=FRxDBGrid.GridLineColor;
|
||||
FCurRow:=0;
|
||||
FFirstDataRow:=0;
|
||||
FLastDataRow:=-1;
|
||||
|
||||
if ressExportTitle in FOptions then
|
||||
DoExportTitle;
|
||||
DoExportBody;
|
||||
|
||||
if (ressExportFooter in FOptions) and (RxDBGrid.FooterOptions.Active) and (RxDBGrid.FooterOptions.RowCount>0) then
|
||||
DoExportFooter;
|
||||
|
||||
DoExportColWidth;
|
||||
|
||||
FWorkbook.WriteToFile(UTF8ToSys(FileName), true);
|
||||
Result:=true;
|
||||
finally
|
||||
FWorkbook.Free;
|
||||
{$IFDEF NoAutomatedBookmark}
|
||||
FDataSet.GotoBookmark(P);
|
||||
FDataSet.FreeBookmark(P);
|
||||
{$ELSE}
|
||||
FDataSet.Bookmark:=P;
|
||||
{$ENDIF}
|
||||
FDataSet.EnableControls;
|
||||
end;
|
||||
|
||||
if Result and FOpenAfterExport then
|
||||
OpenDocument(FileName);
|
||||
end;
|
||||
|
||||
function TRxDBGridExportSpreadSheet.DoSetupTools: boolean;
|
||||
var
|
||||
F:TRxDBGridExportSpreadSheet_ParamsForm;
|
||||
begin
|
||||
F:=TRxDBGridExportSpreadSheet_ParamsForm.Create(Application);
|
||||
F.FileNameEdit1.FileName:=FFileName;
|
||||
F.cbOpenAfterExport.Checked:=FOpenAfterExport;
|
||||
F.cbExportColumnFooter.Checked:=ressExportFooter in FOptions;
|
||||
F.cbExportColumnFooter.Enabled:=RxDBGrid.FooterOptions.Active;
|
||||
|
||||
F.cbExportColumnHeader.Checked:=ressExportTitle in FOptions;
|
||||
F.cbExportCellColors.Checked:=ressExportColors in FOptions;
|
||||
F.cbOverwriteExisting.Checked:=ressOverwriteExisting in FOptions;
|
||||
|
||||
F.cbExportFormula.Checked:=ressExportFormula in FOptions;
|
||||
F.cbExportFormula.Enabled:=RxDBGrid.FooterOptions.Active;
|
||||
|
||||
F.cbExportSelectedRows.Checked:=ressExportSelectedRows in FOptions;
|
||||
F.cbExportSelectedRows.Enabled:=(dgMultiselect in RxDBGrid.Options) and (RxDBGrid.SelectedRows.Count > 0);
|
||||
F.cbHideZeroValues.Checked:=ressHideZeroValues in FOptions;
|
||||
|
||||
F.cbMergeCells.Checked:=ressColSpanning in FOptions;
|
||||
|
||||
F.cbExportGrpData.Checked:=ressExportGroupData in FOptions;
|
||||
F.cbExportGrpData.Enabled:=RxDBGrid.GroupItems.Active;
|
||||
|
||||
|
||||
F.edtPageName.Text:=FPageName;
|
||||
|
||||
Result:=F.ShowModal = mrOk;
|
||||
if Result then
|
||||
begin
|
||||
FOpenAfterExport:=F.cbOpenAfterExport.Checked;
|
||||
FFileName:=F.FileNameEdit1.FileName;
|
||||
FPageName:=F.edtPageName.Text;
|
||||
|
||||
FOptions:=[];
|
||||
if F.cbExportColumnFooter.Checked then
|
||||
FOptions :=FOptions + [ressExportFooter];
|
||||
if F.cbExportColumnHeader.Checked then
|
||||
FOptions :=FOptions + [ressExportTitle];
|
||||
if F.cbExportCellColors.Checked then
|
||||
FOptions :=FOptions + [ressExportColors];
|
||||
if F.cbOverwriteExisting.Checked then
|
||||
FOptions :=FOptions + [ressOverwriteExisting];
|
||||
if F.cbExportFormula.Checked then
|
||||
FOptions :=FOptions + [ressExportFormula];
|
||||
if F.cbExportSelectedRows.Enabled and F.cbExportSelectedRows.Checked then
|
||||
FOptions :=FOptions + [ressExportSelectedRows];
|
||||
if F.cbHideZeroValues.Checked then
|
||||
FOptions:=FOptions + [ressHideZeroValues];
|
||||
|
||||
if F.cbMergeCells.Checked then
|
||||
FOptions:=FOptions + [ressColSpanning];
|
||||
|
||||
if F.cbExportGrpData.Checked then
|
||||
FOptions:=FOptions + [ressExportGroupData];
|
||||
|
||||
end;
|
||||
F.Free;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,218 @@
|
||||
object RxDBGridExportSpreadSheet_ParamsForm: TRxDBGridExportSpreadSheet_ParamsForm
|
||||
Left = 483
|
||||
Height = 328
|
||||
Top = 235
|
||||
Width = 548
|
||||
Caption = 'Export params'
|
||||
ClientHeight = 328
|
||||
ClientWidth = 548
|
||||
OnCreate = FormCreate
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '1.9.0.0'
|
||||
object Label1: TLabel
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Owner
|
||||
Left = 6
|
||||
Height = 20
|
||||
Top = 6
|
||||
Width = 104
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'Export file name'
|
||||
FocusControl = FileNameEdit1
|
||||
ParentColor = False
|
||||
end
|
||||
object FileNameEdit1: TFileNameEdit
|
||||
AnchorSideLeft.Control = Label1
|
||||
AnchorSideTop.Control = Label1
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 12
|
||||
Height = 37
|
||||
Top = 32
|
||||
Width = 530
|
||||
Filter = 'All files (*.*)|*.*|LibreOffice/OpenOffice (*.ods)|*.ods|Excel 97-2003|*.xls|Excel 2007-2013|*.xlsx'
|
||||
FilterIndex = 0
|
||||
HideDirectories = False
|
||||
ButtonWidth = 23
|
||||
NumGlyphs = 1
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Around = 6
|
||||
MaxLength = 0
|
||||
Spacing = 0
|
||||
TabOrder = 0
|
||||
end
|
||||
object Label3: TLabel
|
||||
AnchorSideLeft.Control = Label4
|
||||
AnchorSideTop.Control = cbExportGrpData
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 280
|
||||
Height = 20
|
||||
Top = 195
|
||||
Width = 70
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'Page name'
|
||||
FocusControl = edtPageName
|
||||
ParentColor = False
|
||||
end
|
||||
object edtPageName: TEdit
|
||||
AnchorSideLeft.Control = Label3
|
||||
AnchorSideTop.Control = Label3
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 286
|
||||
Height = 37
|
||||
Top = 221
|
||||
Width = 256
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Around = 6
|
||||
TabOrder = 7
|
||||
end
|
||||
object cbExportColumnFooter: TCheckBox
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = cbExportColumnHeader
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 24
|
||||
Top = 135
|
||||
Width = 161
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'Export column footer'
|
||||
TabOrder = 3
|
||||
end
|
||||
object cbOpenAfterExport: TCheckBox
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = FileNameEdit1
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 24
|
||||
Top = 75
|
||||
Width = 140
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'Open after export'
|
||||
TabOrder = 1
|
||||
end
|
||||
object ButtonPanel1: TButtonPanel
|
||||
Left = 6
|
||||
Height = 46
|
||||
Top = 276
|
||||
Width = 536
|
||||
OKButton.Name = 'OKButton'
|
||||
OKButton.DefaultCaption = True
|
||||
HelpButton.Name = 'HelpButton'
|
||||
HelpButton.DefaultCaption = True
|
||||
CloseButton.Name = 'CloseButton'
|
||||
CloseButton.DefaultCaption = True
|
||||
CancelButton.Name = 'CancelButton'
|
||||
CancelButton.DefaultCaption = True
|
||||
TabOrder = 8
|
||||
ShowButtons = [pbOK, pbCancel, pbHelp]
|
||||
end
|
||||
object cbExportColumnHeader: TCheckBox
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = cbOpenAfterExport
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 24
|
||||
Top = 105
|
||||
Width = 166
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'Export column header'
|
||||
TabOrder = 2
|
||||
end
|
||||
object cbExportCellColors: TCheckBox
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = cbExportColumnFooter
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 24
|
||||
Top = 165
|
||||
Width = 137
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'Export cell colors'
|
||||
TabOrder = 4
|
||||
end
|
||||
object Label4: TLabel
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideLeft.Side = asrCenter
|
||||
AnchorSideTop.Control = Owner
|
||||
Left = 274
|
||||
Height = 1
|
||||
Top = 0
|
||||
Width = 1
|
||||
ParentColor = False
|
||||
end
|
||||
object cbOverwriteExisting: TCheckBox
|
||||
AnchorSideLeft.Control = Label4
|
||||
AnchorSideTop.Control = cbExportFormula
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 280
|
||||
Height = 24
|
||||
Top = 105
|
||||
Width = 166
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'Overwrite existing file'
|
||||
TabOrder = 6
|
||||
end
|
||||
object cbExportFormula: TCheckBox
|
||||
AnchorSideLeft.Control = Label4
|
||||
AnchorSideTop.Control = FileNameEdit1
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 280
|
||||
Height = 24
|
||||
Top = 75
|
||||
Width = 120
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'Export formula'
|
||||
TabOrder = 5
|
||||
end
|
||||
object cbExportSelectedRows: TCheckBox
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = cbExportCellColors
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 24
|
||||
Top = 195
|
||||
Width = 161
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'Export selected rows'
|
||||
TabOrder = 9
|
||||
end
|
||||
object cbHideZeroValues: TCheckBox
|
||||
AnchorSideLeft.Control = Label4
|
||||
AnchorSideTop.Control = cbOverwriteExisting
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 280
|
||||
Height = 24
|
||||
Top = 135
|
||||
Width = 133
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'Hide zero values'
|
||||
TabOrder = 10
|
||||
end
|
||||
object cbMergeCells: TCheckBox
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = cbExportSelectedRows
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 24
|
||||
Top = 225
|
||||
Width = 103
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'Merge cell''s'
|
||||
TabOrder = 11
|
||||
end
|
||||
object cbExportGrpData: TCheckBox
|
||||
AnchorSideLeft.Control = Label4
|
||||
AnchorSideTop.Control = cbHideZeroValues
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 280
|
||||
Height = 24
|
||||
Top = 165
|
||||
Width = 139
|
||||
BorderSpacing.Around = 6
|
||||
Caption = 'Export group data'
|
||||
TabOrder = 12
|
||||
end
|
||||
end
|
||||
@@ -0,0 +1,95 @@
|
||||
{ RxDBGridExportSpreadSheet_ParamsUnit unit
|
||||
|
||||
Copyright (C) 2005-2017 Lagunov Aleksey alexs@yandex.ru
|
||||
original conception from rx library for Delphi (c)
|
||||
|
||||
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 with the following modification:
|
||||
|
||||
As a special exception, the copyright holders of this library give you
|
||||
permission to link this library with independent modules to produce an
|
||||
executable, regardless of the license terms of these independent modules,and
|
||||
to copy and distribute the resulting executable under terms of your choice,
|
||||
provided that you also meet, for each linked independent module, the terms
|
||||
and conditions of the license of that module. An independent module is a
|
||||
module which is not derived from or based on this library. If you modify
|
||||
this library, you may extend this exception to your version of the library,
|
||||
but you are not obligated to do so. If you do not wish to do so, delete this
|
||||
exception statement from your 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
}
|
||||
|
||||
unit RxDBGridExportSpreadSheet_ParamsUnit;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||
EditBtn, ButtonPanel;
|
||||
|
||||
type
|
||||
|
||||
{ TRxDBGridExportSpreadSheet_ParamsForm }
|
||||
|
||||
TRxDBGridExportSpreadSheet_ParamsForm = class(TForm)
|
||||
ButtonPanel1: TButtonPanel;
|
||||
cbExportSelectedRows: TCheckBox;
|
||||
cbExportFormula: TCheckBox;
|
||||
cbExportColumnFooter: TCheckBox;
|
||||
cbExportGrpData: TCheckBox;
|
||||
cbMergeCells: TCheckBox;
|
||||
cbOpenAfterExport: TCheckBox;
|
||||
cbExportColumnHeader: TCheckBox;
|
||||
cbExportCellColors: TCheckBox;
|
||||
cbOverwriteExisting: TCheckBox;
|
||||
cbHideZeroValues: TCheckBox;
|
||||
edtPageName: TEdit;
|
||||
FileNameEdit1: TFileNameEdit;
|
||||
Label1: TLabel;
|
||||
Label3: TLabel;
|
||||
Label4: TLabel;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses rxdconst;
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TRxDBGridExportSpreadSheet_ParamsForm }
|
||||
|
||||
procedure TRxDBGridExportSpreadSheet_ParamsForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
Caption:=sExportParams;
|
||||
Label1.Caption:=sExportFileName;
|
||||
Label3.Caption:=sPageName;
|
||||
cbOpenAfterExport.Caption:=sOpenAfterExport;
|
||||
cbExportColumnHeader.Caption:=sExportColumnHeader;
|
||||
cbExportColumnFooter.Caption:=sExportColumnFooter;
|
||||
cbExportCellColors.Caption:=sExportCellColors;
|
||||
cbOverwriteExisting.Caption:=sOverwriteExisting;
|
||||
cbExportFormula.Caption:=sExportFormula;
|
||||
cbExportSelectedRows.Caption:=sExportSelectedRows;
|
||||
cbHideZeroValues.Caption:=sExportHideZeroValues;
|
||||
cbMergeCells.Caption:=sMergeCells;
|
||||
cbExportGrpData.Caption:=sExportGroupData;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user