1492 lines
39 KiB
ObjectPascal
1492 lines
39 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport VCL }
|
|
{ Excel OLE export filter }
|
|
{ }
|
|
{ Copyright (c) 1998-2021 }
|
|
{ by Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
{ Improved by: }
|
|
{ Serge Buzadzhy }
|
|
{ buzz@devrace.com }
|
|
{ Bysoev Alexander }
|
|
{ Kanal-B@Yandex.ru }
|
|
{******************************************}
|
|
|
|
unit frxExportXLS;
|
|
|
|
interface
|
|
|
|
{$I frx.inc}
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
StdCtrls, Printers, ComObj, frxClass, frxProgress,
|
|
frxExportMatrix, Clipbrd, ActiveX, Variants, frxExportBaseDialog
|
|
{$IFDEF DELPHI16}
|
|
, System.UITypes
|
|
{$ENDIF}
|
|
;
|
|
|
|
type
|
|
TfrxExcel = class;
|
|
|
|
{$IFDEF DELPHI16}
|
|
[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
|
|
{$ENDIF}
|
|
TfrxXLSExport = class(TfrxBaseDialogExportFilter)
|
|
private
|
|
FExcel: TfrxExcel;
|
|
FExportPictures: Boolean;
|
|
FExportStyles: Boolean;
|
|
FFirstPage: Boolean;
|
|
FMatrix: TfrxIEMatrix;
|
|
FMergeCells: Boolean;
|
|
FOpenExcelAfterExport: Boolean;
|
|
FPageBottom: Extended;
|
|
FPageLeft: Extended;
|
|
FPageRight: Extended;
|
|
FPageTop: Extended;
|
|
FPageOrientation: TPrinterOrientation;
|
|
FProgress: TfrxProgress;
|
|
FWysiwyg: Boolean;
|
|
FAsText: Boolean;
|
|
FBackground: Boolean;
|
|
FFastExport: Boolean;
|
|
FpageBreaks: Boolean;
|
|
FEmptyLines: Boolean;
|
|
FExportEMF: Boolean;
|
|
FTruncateLongTexts: Boolean;
|
|
FGridLines: Boolean;
|
|
procedure ExportPage_Fast;
|
|
procedure ExportPage;
|
|
function CleanReturns(const Str: WIdeString): WideString;
|
|
function FrameTypesToByte(Value: TfrxFrameTypes): Byte;
|
|
function GetNewIndex(Strings: TStrings; ObjValue: Integer): Integer;
|
|
function GetObjWidth(Obj: TfrxIEMObject): Extended;
|
|
function GetObjHeight(Obj: TfrxIEMObject): Extended;
|
|
protected
|
|
procedure AfterFinish; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
class function GetDescription: String; override;
|
|
class function ExportDialogClass: TfrxBaseExportDialogClass; override;
|
|
function Start: Boolean; override;
|
|
procedure Finish; override;
|
|
procedure FinishPage(Page: TfrxReportPage; Index: Integer); override;
|
|
procedure StartPage(Page: TfrxReportPage; Index: Integer); override;
|
|
procedure ExportObject(Obj: TfrxComponent); override;
|
|
published
|
|
property ExportEMF: Boolean read FExportEMF write FExportEMF;
|
|
property ExportStyles: Boolean read FExportStyles write FExportStyles default True;
|
|
property ExportPictures: Boolean read FExportPictures write FExportPictures default True;
|
|
property MergeCells: Boolean read FMergeCells write FMergeCells default True;
|
|
property OpenExcelAfterExport: Boolean read FOpenExcelAfterExport
|
|
write FOpenExcelAfterExport default False;
|
|
property Wysiwyg: Boolean read FWysiwyg write FWysiwyg default True;
|
|
property AsText: Boolean read FAsText write FAsText;
|
|
property Background: Boolean read FBackground write FBackground;
|
|
property FastExport: Boolean read FFastExport write FFastExport;
|
|
property PageBreaks: Boolean read FpageBreaks write FPageBreaks;
|
|
property EmptyLines: Boolean read FEmptyLines write FEmptyLines;
|
|
property SuppressPageHeadersFooters;
|
|
property OverwritePrompt;
|
|
|
|
{ When this property is enabled, the export filter truncates all
|
|
texts in cells by XLMaxChars = 900 characters. }
|
|
|
|
property TruncateLongTexts: Boolean read FTruncateLongTexts write FTruncateLongTexts default True;
|
|
|
|
property GridLines: Boolean read FGridLines write FGridLines default True;
|
|
end;
|
|
|
|
TfrxExcel = class(TObject)
|
|
private
|
|
FIsOpened: Boolean;
|
|
FIsVisible: Boolean;
|
|
Excel: Variant;
|
|
WorkBook: Variant;
|
|
WorkSheet: Variant;
|
|
Range: Variant;
|
|
function ByteToFrameTypes(Value: Byte): TfrxFrameTypes;
|
|
protected
|
|
function IntToCoord(X, Y: Integer): String;
|
|
function Pos2Str(Pos: Integer): String;
|
|
procedure SetVisible(DoShow: Boolean);
|
|
procedure ApplyStyles(aRanges:TStrings; Kind:byte;aProgress: TfrxProgress);
|
|
procedure ApplyFrame(const RangeCoord:string; aFrame:byte);
|
|
procedure SetRowsSize(aRanges: TStrings; Sizes: array of Currency;MainSizeIndex:integer;RowsCount:integer;aProgress: TfrxProgress);
|
|
procedure ApplyStyle(const RangeCoord: string; aStyle: integer);
|
|
procedure ApplyFormats(aRanges: TStringlist; aProgress: TfrxProgress);
|
|
procedure ApplyFormat(const RangeCoord, aFormat: String);
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure MergeCells;
|
|
procedure SetCellFrame(Frame: TfrxFrameTypes);
|
|
procedure SetRowSize(y: Integer; Size: Extended);
|
|
procedure OpenExcel;
|
|
procedure SetColSize(x: Integer; Size: Extended);
|
|
procedure SetPageMargin(Left, Right, Top, Bottom: Extended;
|
|
Orientation: TPrinterOrientation);
|
|
procedure SetRange(x, y, dx, dy: Integer);
|
|
property Visible: Boolean read FIsVisible write SetVisible;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
frxUtils,
|
|
frxFileUtils,
|
|
frxRes,
|
|
frxUnicodeUtils,
|
|
{$IFDEF DBGLOG}frxDebug,{$ENDIF}
|
|
frxrcExports,
|
|
frxExportXLSDialog;
|
|
|
|
const
|
|
Xdivider = 8;
|
|
Ydivider = 1.315;
|
|
XLMaxHeight = 409;
|
|
XLMaxChars = 900;
|
|
xlLeft = -4131;
|
|
xlRight = -4152;
|
|
xlTop = -4160;
|
|
xlCenter = -4108 ;
|
|
xlBottom = -4107;
|
|
xlJustify = -4130 ;
|
|
xlThin = 2;
|
|
xlHairline = 1;
|
|
xlNone = -4142;
|
|
xlAutomatic = -4105;
|
|
xlInsideHorizontal = 12 ;
|
|
xlInsideVertical = 11 ;
|
|
xlEdgeBottom = 9 ;
|
|
xlEdgeLeft = 7 ;
|
|
xlEdgeRight = 10 ;
|
|
xlEdgeTop = 8 ;
|
|
xlSolid = 1 ;
|
|
xlLineStyleNone = -4142;
|
|
xlTextWindows = 20 ;
|
|
xlNormal = -4143 ;
|
|
xlNoChange = 1 ;
|
|
xlPageBreakManual = -4135 ;
|
|
xlSizeYRound = 0.25;
|
|
|
|
{ TfrxXLSExport }
|
|
|
|
type
|
|
TArrData = array [1..1] of variant;
|
|
PArrData = ^TArrData;
|
|
PFrameTypes = ^TfrxFrameTypes;
|
|
|
|
constructor TfrxXLSExport.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FMergeCells := True;
|
|
FExportPictures := True;
|
|
FExportStyles := True;
|
|
FWysiwyg := True;
|
|
FAsText := False;
|
|
FBackground := True;
|
|
FFastExport := True;
|
|
FPageBreaks := True;
|
|
FilterDesc := frxGet(8009);
|
|
DefaultExt := frxGet(8010);
|
|
FEmptyLines := True;
|
|
FExportEMF := True;
|
|
FTruncateLongTexts := True;
|
|
FGridLines := True;
|
|
end;
|
|
|
|
class function TfrxXLSExport.GetDescription: String;
|
|
begin
|
|
Result := frxResources.Get('XlsOLEexport');
|
|
end;
|
|
|
|
class function TfrxXLSExport.ExportDialogClass: TfrxBaseExportDialogClass;
|
|
begin
|
|
Result := TfrxBaseExportDialogClass(TfrxXLSExportDialog);
|
|
end;
|
|
|
|
function TfrxXLSExport.FrameTypesToByte(Value: TfrxFrameTypes): Byte;
|
|
begin
|
|
Result := PByte(@Value)^
|
|
end;
|
|
|
|
function TfrxXLSExport.GetNewIndex(Strings: TStrings; ObjValue: Integer): Integer;
|
|
var
|
|
L, H, I, C: Integer;
|
|
begin
|
|
Result:=0;
|
|
if Strings.Count > 0 then
|
|
begin
|
|
L := 0;
|
|
H := Strings.Count - 1;
|
|
while L <= H do
|
|
begin
|
|
I := (L + H) shr 1;
|
|
C:= Integer(Strings.Objects[I]) - ObjValue;
|
|
if C < 0 then
|
|
L := I + 1
|
|
else begin
|
|
H := I - 1;
|
|
if C = 0 then
|
|
begin
|
|
L := I;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
Result := L;
|
|
end;
|
|
end;
|
|
|
|
function TfrxXLSExport.GetObjWidth(Obj: TfrxIEMObject): Extended;
|
|
var
|
|
r: TfrxRect;
|
|
begin
|
|
r := FMatrix.GetObjectBounds(Obj);
|
|
Result := r.Right - r.Left;
|
|
end;
|
|
|
|
function TfrxXLSExport.GetObjHeight(Obj: TfrxIEMObject): Extended;
|
|
var
|
|
r: TfrxRect;
|
|
begin
|
|
r := FMatrix.GetObjectBounds(Obj);
|
|
Result := r.Bottom - r.Top;
|
|
end;
|
|
|
|
procedure TfrxXLSExport.AfterFinish;
|
|
begin
|
|
//
|
|
end;
|
|
|
|
function TfrxXLSExport.CleanReturns(const Str: WideString): WideString;
|
|
var
|
|
i: Integer;
|
|
s: WideString;
|
|
begin
|
|
s := Str;
|
|
i := Pos(#13, s);
|
|
while i > 0 do
|
|
begin
|
|
if i > 0 then
|
|
Delete(s, i, 1);
|
|
i := Pos(#13, s);
|
|
end;
|
|
while Copy(s, Length(s), 1) = #10 do
|
|
Delete(s, Length(s), 1);
|
|
Result := s;
|
|
end;
|
|
|
|
{$WARNINGS OFF}
|
|
procedure TfrxXLSExport.ExportPage;
|
|
var
|
|
i, fx, fy, x, y, dx, dy: Integer;
|
|
dcol, drow: Extended;
|
|
s: WideString;
|
|
Vert, Horiz: Integer;
|
|
ExlArray: Variant;
|
|
obj: TfrxIEMObject;
|
|
EStyle: TfrxIEMStyle;
|
|
XStyle: Variant;
|
|
Pic: TPicture;
|
|
PicFormat: Word;
|
|
PicData: THandle;
|
|
PicPalette: HPALETTE;
|
|
PicCount: Integer;
|
|
PBreakCounter: Integer;
|
|
|
|
procedure AlignFR2AlignExcel(HAlign: TfrxHAlign; VAlign: TfrxVAlign; var AlignH, AlignV: integer);
|
|
begin
|
|
|
|
if HAlign = haLeft then
|
|
AlignH := xlLeft
|
|
else if HAlign = haRight then
|
|
AlignH := xlRight
|
|
else if HAlign = haCenter then
|
|
AlignH := xlCenter
|
|
else if HAlign = haBlock then
|
|
AlignH := xlJustify
|
|
else
|
|
AlignH := xlLeft;
|
|
|
|
if VAlign = vaTop then
|
|
AlignV := xlTop
|
|
else if VAlign = vaBottom then
|
|
AlignV := xlBottom
|
|
else if VAlign = vaCenter then
|
|
AlignV := xlCenter
|
|
else
|
|
AlignV := xlTop;
|
|
end;
|
|
|
|
begin
|
|
PicCount := 0;
|
|
FExcel.SetPageMargin(FPageLeft, FPageRight, FPageTop, FPageBottom, FPageOrientation);
|
|
|
|
if ShowProgress then
|
|
begin
|
|
FProgress := TfrxProgress.Create(nil);
|
|
FProgress.Execute(FMatrix.Height - 1, frxResources.Get('ProgressRows'), True, True);
|
|
end;
|
|
|
|
PBreakCounter := 0;
|
|
for y := 1 to FMatrix.Height - 1 do
|
|
begin
|
|
if ShowProgress then
|
|
begin
|
|
if FProgress.Terminated then break;
|
|
FProgress.Tick;
|
|
end;
|
|
drow := (FMatrix.GetYPosById(y) - FMatrix.GetYPosById(y - 1)) / Ydivider;
|
|
FExcel.SetRowSize(y, drow);
|
|
if (FMatrix.GetCellYPos(y) >= FMatrix.GetPageBreak(PBreakCounter)) and FpageBreaks then
|
|
begin
|
|
FExcel.WorkSheet.Rows[y + 2].PageBreak := xlPageBreakManual;
|
|
Inc(PBreakCounter);
|
|
end;
|
|
end;
|
|
|
|
if ShowProgress then
|
|
begin
|
|
if not FProgress.Terminated then
|
|
FProgress.Execute(FMatrix.Width - 1, frxResources.Get('ProgressColumns'), True, True);
|
|
end else;
|
|
|
|
for x := 1 to FMatrix.Width - 1 do
|
|
begin
|
|
if ShowProgress then
|
|
begin
|
|
if FProgress.Terminated then break;
|
|
FProgress.Tick;
|
|
end;
|
|
dcol := (FMatrix.GetXPosById(x) - FMatrix.GetXPosById(x - 1)) / Xdivider;
|
|
FExcel.SetColSize(x, dcol);
|
|
end;
|
|
|
|
if ShowProgress then
|
|
if not FProgress.Terminated then
|
|
FProgress.Execute(FMatrix.StylesCount - 1, frxResources.Get('ProgressStyles'), True, True);
|
|
|
|
for x := 0 to FMatrix.StylesCount - 1 do
|
|
begin
|
|
if ShowProgress then
|
|
begin
|
|
if FProgress.Terminated then break;
|
|
FProgress.Tick;
|
|
end;
|
|
EStyle := FMatrix.GetStyleById(x);
|
|
s := 'S' + IntToStr(x);
|
|
XStyle := FExcel.Excel.ActiveWorkbook.Styles.Add(s);
|
|
XStyle.Font.Bold := fsBold in EStyle.Font.Style;
|
|
XStyle.Font.Italic := fsItalic in EStyle.Font.Style;
|
|
XStyle.Font.Underline := fsUnderline in EStyle.Font.Style;
|
|
XStyle.Font.Strikethrough := fsStrikeOut in EStyle.Font.Style;
|
|
XStyle.Font.Name := EStyle.Font.Name;
|
|
XStyle.Font.Size := EStyle.Font.Size;
|
|
XStyle.Font.Color:= ColorToRGB(EStyle.Font.Color);
|
|
XStyle.Interior.Color := ColorToRGB(EStyle.Color);
|
|
AlignFR2AlignExcel(EStyle.HAlign, EStyle.VAlign, Horiz, Vert);
|
|
XStyle.VerticalAlignment := Vert;
|
|
XStyle.HorizontalAlignment := Horiz;
|
|
Application.ProcessMessages;
|
|
end;
|
|
|
|
ExlArray := VarArrayCreate([0, FMatrix.Height - 1, 0, FMatrix.Width - 1], varOleStr);
|
|
|
|
if ShowProgress then
|
|
if not FProgress.Terminated then
|
|
FProgress.Execute(FMatrix.Height, frxResources.Get('ProgressObjects'), True, True);
|
|
|
|
for y := 1 to FMatrix.Height do
|
|
begin
|
|
if ShowProgress then
|
|
begin
|
|
if FProgress.Terminated then break;
|
|
FProgress.Tick;
|
|
end;
|
|
for x := 1 to FMatrix.Width do
|
|
begin
|
|
i := FMatrix.GetCell(x - 1, y - 1);
|
|
if i <> -1 then
|
|
begin
|
|
Obj := FMatrix.GetObjectById(i);
|
|
if Obj.Counter = 0 then
|
|
begin
|
|
Obj.Counter := 1;
|
|
FMatrix.GetObjectPos(i, fx, fy, dx, dy);
|
|
FExcel.SetRange(x, y, dx, dy);
|
|
if Obj.IsText then
|
|
begin
|
|
if FExportStyles then
|
|
FExcel.Range.Style := 'S' + IntToStr(Obj.StyleIndex);
|
|
if FMergeCells then
|
|
if (dx > 1) or (dy > 1) then
|
|
if (dx > 1) or (dy > 1) then
|
|
begin
|
|
FExcel.SetRange(x, y, dx, dy);
|
|
FExcel.MergeCells;
|
|
end;
|
|
if FExportStyles then
|
|
FExcel.SetCellFrame(obj.Style.FrameTyp);
|
|
s := CleanReturns(Obj.Memo.Text);
|
|
if Length(s) > XLMaxChars then
|
|
s := Copy(s, 1, XLMaxChars);
|
|
ExlArray[y - 1, x - 1] := s;
|
|
end
|
|
else
|
|
if (Obj.Image <> nil) and (Obj.Image.Width > 0) then
|
|
begin
|
|
Inc(PicCount);
|
|
if FExportEMF then
|
|
Obj.Image.SaveToClipboardFormat(PicFormat, PicData, PicPalette)
|
|
else
|
|
begin
|
|
Pic := TPicture.Create;
|
|
try
|
|
Pic.Bitmap.Assign(Obj.Image);
|
|
Pic.SaveToClipboardFormat(PicFormat, PicData, PicPalette);
|
|
finally
|
|
Pic.Free;
|
|
end;
|
|
end;
|
|
Clipboard.SetAsHandle(PicFormat,THandle(PicData));
|
|
FExcel.Range.PasteSpecial(EmptyParam, EmptyParam, EmptyParam, EmptyParam);
|
|
FExcel.WorkSheet.Pictures[PicCount].Width := Round(GetObjWidth(Obj) / 1.38);
|
|
FExcel.WorkSheet.Pictures[PicCount].Height := Round(GetObjHeight(Obj) / 1.38);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
FExcel.SetRange(1, 1, FMatrix.Width - 1, FMatrix.Height - 1);
|
|
FExcel.Range.Value := ExlArray;
|
|
FExcel.WorkSheet.Cells.WrapText := True;
|
|
if ShowProgress then
|
|
FProgress.Free;
|
|
end;
|
|
{$WARNINGS ON}
|
|
|
|
procedure TfrxXLSExport.ExportPage_Fast;
|
|
var
|
|
i, fx, fy, x, y, dx, dy: Integer;
|
|
dcol, drow: Extended;
|
|
s: OLEVariant;
|
|
Vert, Horiz: Integer;
|
|
ExlArray: Variant;
|
|
|
|
obj: TfrxIEMObject;
|
|
EStyle: TfrxIEMStyle;
|
|
XStyle: Variant;
|
|
Pic: TPicture;
|
|
PicFormat: Word;
|
|
PicData: THandle;
|
|
PicPalette: HPALETTE;
|
|
PicCount: Integer;
|
|
PBreakCounter: Integer;
|
|
RowSizes: array of Currency;
|
|
RowSizesCount: array of Integer;
|
|
imc: Integer;
|
|
ArrData: PArrData;
|
|
j: Integer;
|
|
FixRow: String;
|
|
CurRowSize: Integer;
|
|
CurRangeCoord: String;
|
|
vRowsToSizes: TStrings;
|
|
vCellStyles: TStrings;
|
|
vCellFrames: TStrings;
|
|
vCellMerges: TStrings;
|
|
vCellFormats: TStringList;
|
|
NumFmt: string;
|
|
ts, ds: string;
|
|
|
|
function ConvertFormat(const fmt, ds, ts: string): string;
|
|
var
|
|
i, err, p : Integer;
|
|
s: string;
|
|
begin
|
|
Result := '';
|
|
|
|
if fmt = '' then
|
|
Exit;
|
|
|
|
p := Pos('.', fmt);
|
|
|
|
if p > 0 then
|
|
begin
|
|
s := Copy(fmt, p + 1, Length(fmt) - p - 1);
|
|
Val(s, p ,err);
|
|
end;
|
|
|
|
case fmt[Length(fmt)] of
|
|
'n', 'm':
|
|
begin
|
|
if ts = '' then
|
|
Result := '# # #0'
|
|
else
|
|
Result := '#' + ts + '# #0';
|
|
|
|
// Fixed by DROBATTO
|
|
if p > 0 then
|
|
Result := Result + ds;
|
|
|
|
for i := 1 to p do
|
|
Result := Result + '0';
|
|
end;
|
|
|
|
'f':
|
|
begin
|
|
Result := '0';
|
|
|
|
if p > 0 then
|
|
Result := Result + ds;
|
|
|
|
|
|
for i := 1 to p do
|
|
Result := Result + '0';
|
|
end;
|
|
|
|
'd':
|
|
begin
|
|
Result := '#';
|
|
|
|
if p > 0 then
|
|
Result := Result + ds;
|
|
|
|
|
|
for i := 1 to p do
|
|
Result := Result + '#';
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ConvertNumber(s: AnsiString): Extended;
|
|
var
|
|
i, j, len: Integer;
|
|
begin
|
|
i := 1;
|
|
len := Length(s);
|
|
if s[len] = '.' then len := len - 1;
|
|
|
|
for j := 1 to len do
|
|
case s[j] of
|
|
'0'..'9', '-','E','e':
|
|
begin
|
|
s[i] := s[j];
|
|
i := i + 1;
|
|
end;
|
|
|
|
',', '.':
|
|
begin
|
|
{$IFDEF DELPHI16}
|
|
s[i] := AnsiChar(FormatSettings.DecimalSeparator);
|
|
{$ELSE}
|
|
s[i] := AnsiChar(DecimalSeparator);
|
|
{$ENDIF}
|
|
|
|
i := i + 1;
|
|
end;
|
|
end;
|
|
|
|
SetLength(s, i - 1);
|
|
Result := StrToFloat(string(s));
|
|
end;
|
|
|
|
procedure AlignFR2AlignExcel(HAlign: TfrxHAlign; VAlign: TfrxVAlign; var AlignH, AlignV: integer; Rotation: integer);
|
|
begin
|
|
if Rotation = 90 then
|
|
begin
|
|
if HAlign = haLeft then
|
|
AlignV := xlBottom
|
|
else if HAlign = haRight then
|
|
AlignV := xlTop
|
|
else if HAlign = haCenter then
|
|
AlignV := xlCenter
|
|
else if HAlign = haBlock then
|
|
AlignV := xlJustify
|
|
else
|
|
AlignV := xlBottom;
|
|
|
|
if VAlign = vaTop then
|
|
AlignH := xlLeft
|
|
else if VAlign = vaBottom then
|
|
AlignH := xlRight
|
|
else if VAlign = vaCenter then
|
|
AlignH := xlCenter
|
|
else
|
|
AlignH := xlLeft;
|
|
end
|
|
else if Rotation = 270 then
|
|
begin
|
|
if HAlign = haLeft then
|
|
AlignV := xlTop
|
|
else if HAlign = haRight then
|
|
AlignV := xlBottom
|
|
else if HAlign = haCenter then
|
|
AlignV := xlCenter
|
|
else if HAlign = haBlock then
|
|
AlignV := xlJustify
|
|
else
|
|
AlignV := xlTop;
|
|
|
|
if VAlign = vaTop then
|
|
AlignH := xlRight
|
|
else if VAlign = vaBottom then
|
|
AlignH := xlLeft
|
|
else if VAlign = vaCenter then
|
|
AlignH := xlCenter
|
|
else
|
|
AlignH := xlRight;
|
|
end
|
|
else
|
|
begin
|
|
if HAlign = haLeft then
|
|
AlignH := xlLeft
|
|
else if HAlign = haRight then
|
|
AlignH := xlRight
|
|
else if HAlign = haCenter then
|
|
AlignH := xlCenter
|
|
else if HAlign = haBlock then
|
|
AlignH := xlJustify
|
|
else
|
|
AlignH := xlLeft;
|
|
|
|
if VAlign = vaTop then
|
|
AlignV := xlTop
|
|
else if VAlign = vaBottom then
|
|
AlignV := xlBottom
|
|
else if VAlign = vaCenter then
|
|
AlignV := xlCenter
|
|
else
|
|
AlignV := xlTop;
|
|
end;
|
|
end;
|
|
|
|
function RoundSizeY(const Value: Extended; xlSizeYRound: Currency): Currency;
|
|
begin
|
|
Result := Round(Value / xlSizeYRound) * xlSizeYRound
|
|
end;
|
|
|
|
function GetSizeIndex(const aSize: Currency): integer;
|
|
var
|
|
i: integer;
|
|
c: integer;
|
|
begin
|
|
c := Length(RowSizes);
|
|
for i := 0 to c - 1 do
|
|
begin
|
|
if RowSizes[i] = aSize then
|
|
begin
|
|
Result := i;
|
|
RowSizesCount[i] := RowSizesCount[i] + 1;
|
|
Exit
|
|
end;
|
|
end;
|
|
SetLength(RowSizes, c + 1);
|
|
SetLength(RowSizesCount,c + 1);
|
|
RowSizes[c] := aSize;
|
|
RowSizesCount[c] := 1;
|
|
Result := c
|
|
end;
|
|
|
|
begin
|
|
PicCount := 0;
|
|
FExcel.SetPageMargin(FPageLeft, FPageRight, FPageTop, FPageBottom, FPageOrientation);
|
|
|
|
if ShowProgress then
|
|
begin
|
|
FProgress := TfrxProgress.Create(nil);
|
|
FProgress.Execute(FMatrix.Height, frxResources.Get('ProgressRows') + ' - 1', True, True);
|
|
end;
|
|
|
|
PBreakCounter := 0;
|
|
|
|
FixRow := 'A1';
|
|
CurRowSize := 0;
|
|
vRowsToSizes := TStringList.Create;
|
|
try
|
|
vRowsToSizes.Capacity := FMatrix.Height;
|
|
imc := 0;
|
|
for y := 1 to FMatrix.Height - 1 do
|
|
begin
|
|
if ShowProgress then
|
|
begin
|
|
if FProgress.Terminated then
|
|
break;
|
|
FProgress.Tick;
|
|
end;
|
|
|
|
if (FMatrix.GetCellYPos(y) >= FMatrix.GetPageBreak(PBreakCounter)) and FpageBreaks then
|
|
begin
|
|
try
|
|
FExcel.WorkSheet.Rows[y + 2].PageBreak := xlPageBreakManual;
|
|
finally
|
|
Inc(PBreakCounter);
|
|
end;
|
|
end;
|
|
|
|
drow := (FMatrix.GetYPosById(y) - FMatrix.GetYPosById(y - 1)) / Ydivider;
|
|
j := GetSizeIndex(RoundSizeY(drow, xlSizeYRound));
|
|
if RowSizesCount[j] > RowSizesCount[imc] then
|
|
imc := j;
|
|
if y > 1 then
|
|
begin
|
|
if j <> CurRowSize then
|
|
begin
|
|
if FixRow <> 'A' + IntToStr(y - 1) then
|
|
CurRangeCoord := FixRow + ':A' + IntToStr(y - 1)
|
|
else
|
|
CurRangeCoord := FixRow;
|
|
i := GetNewIndex(vRowsToSizes, CurRowSize);
|
|
vRowsToSizes.InsertObject(i, CurRangeCoord, TObject(CurRowSize));
|
|
FixRow := 'A' + IntToStr(y);
|
|
CurRowSize := j;
|
|
end;
|
|
end;
|
|
if y = FMatrix.Height - 1 then
|
|
begin
|
|
CurRangeCoord := FixRow + ':A' + IntToStr(y);
|
|
i := GetNewIndex(vRowsToSizes, j);
|
|
vRowsToSizes.InsertObject(i, CurRangeCoord, TObject(j));
|
|
end;
|
|
end;
|
|
FExcel.SetRowsSize(vRowsToSizes, RowSizes, imc, FMatrix.Height, FProgress)
|
|
finally
|
|
vRowsToSizes.Free;
|
|
end;
|
|
|
|
if ShowProgress then
|
|
if not FProgress.Terminated then
|
|
FProgress.Execute(FMatrix.Width, frxResources.Get('ProgressColumns'), True, True);
|
|
|
|
for x := 1 to FMatrix.Width - 1 do
|
|
begin
|
|
if ShowProgress then
|
|
begin
|
|
if FProgress.Terminated then
|
|
break;
|
|
FProgress.Tick;
|
|
end;
|
|
dcol := (FMatrix.GetXPosById(x) - FMatrix.GetXPosById(x - 1)) / Xdivider;
|
|
FExcel.SetColSize(x, dcol);
|
|
end;
|
|
|
|
if ShowProgress then
|
|
if not FProgress.Terminated then
|
|
FProgress.Execute(FMatrix.StylesCount, frxResources.Get('ProgressStyles'), True, True);
|
|
|
|
for x := 0 to FMatrix.StylesCount - 1 do
|
|
begin
|
|
if ShowProgress then
|
|
begin
|
|
if FProgress.Terminated then break;
|
|
FProgress.Tick;
|
|
end;
|
|
EStyle := FMatrix.GetStyleById(x);
|
|
s := 'S' + IntToStr(x);
|
|
XStyle := FExcel.Excel.ActiveWorkbook.Styles.Add(s);
|
|
XStyle.Font.Bold := fsBold in EStyle.Font.Style;
|
|
XStyle.Font.Italic := fsItalic in EStyle.Font.Style;
|
|
XStyle.Font.Underline := fsUnderline in EStyle.Font.Style;
|
|
XStyle.Font.Strikethrough := fsStrikeOut in EStyle.Font.Style;
|
|
XStyle.Font.Name := EStyle.Font.Name;
|
|
XStyle.Font.Size := EStyle.Font.Size;
|
|
XStyle.Font.Color:= ColorToRGB(EStyle.Font.Color);
|
|
if (EStyle.Color <> clWhite) and (EStyle.Color <> clNone) then
|
|
XStyle.Interior.Color := ColorToRGB(EStyle.Color);
|
|
if (EStyle.Rotation > 0) and (EStyle.Rotation <= 90) then
|
|
XStyle.Orientation := EStyle.Rotation
|
|
else
|
|
if (EStyle.Rotation < 360) and (EStyle.Rotation >= 270) then
|
|
XStyle.Orientation := EStyle.Rotation - 360;
|
|
|
|
AlignFR2AlignExcel(EStyle.HAlign, EStyle.VAlign, Horiz, Vert, EStyle.Rotation);
|
|
XStyle.VerticalAlignment := Vert;
|
|
XStyle.HorizontalAlignment := Horiz;
|
|
Application.ProcessMessages;
|
|
end;
|
|
ExlArray := VarArrayCreate([1, FMatrix.Height , 1, FMatrix.Width ], varVariant);
|
|
if ShowProgress then
|
|
if not FProgress.Terminated then
|
|
FProgress.Execute(FMatrix.Height, frxResources.Get('ProgressObjects'), True, True);
|
|
ArrData := VarArrayLock(ExlArray) ;
|
|
vCellStyles := TStringList.Create;
|
|
vCellFrames := TStringList.Create;
|
|
vCellMerges := TStringList.Create;
|
|
vCellFormats := TStringList.Create;
|
|
try
|
|
for y := 1 to FMatrix.Height do
|
|
begin
|
|
if ShowProgress then
|
|
begin
|
|
if FProgress.Terminated then
|
|
Break;
|
|
FProgress.Tick;
|
|
end;
|
|
for x := 1 to FMatrix.Width do
|
|
begin
|
|
i := FMatrix.GetCell(x - 1, y - 1);
|
|
if i <> -1 then
|
|
begin
|
|
Obj := FMatrix.GetObjectById(i);
|
|
if Obj.Counter = 0 then
|
|
begin
|
|
Obj.Counter := 1;
|
|
FMatrix.GetObjectPos(i, fx, fy, dx, dy);
|
|
with FExcel do
|
|
if (dx > 1) or (dy > 1) then
|
|
CurRangeCoord := IntToCoord(x, y)+ ':' +
|
|
IntToCoord(x + dx - 1, y + dy - 1)
|
|
else
|
|
CurRangeCoord := IntToCoord(x, y);
|
|
if FExportStyles then
|
|
begin
|
|
j := GetNewIndex(vCellStyles, Obj.StyleIndex);
|
|
vCellStyles.InsertObject(j, CurRangeCoord, TObject(Obj.StyleIndex));
|
|
end;
|
|
|
|
if FMergeCells then
|
|
if (dx > 1) or (dy > 1) then
|
|
vCellMerges.Add(CurRangeCoord);
|
|
if FExportStyles then
|
|
begin
|
|
i := FrameTypesToByte(obj.Style.FrameTyp);
|
|
if i <> 0 then
|
|
begin
|
|
j := GetNewIndex(vCellFrames, i);
|
|
vCellFrames.InsertObject(j, CurRangeCoord, TObject(i));
|
|
end;
|
|
end;
|
|
|
|
s := CleanReturns(Obj.Memo.Text);
|
|
|
|
if FTruncateLongTexts and (Length(s) > XLMaxChars) then
|
|
s := Copy(s, 1, XLMaxChars);
|
|
|
|
with Obj.Style.DisplayFormat do
|
|
if FAsText or (Kind = fkText) then
|
|
s := '''' + s
|
|
else if (Kind = fkNumeric) and (s <> '') then
|
|
begin
|
|
{$IFDEF DBGLOG}
|
|
DbgLog('ThSep: ' + ThousandSeparator);
|
|
DbgLog('Sys.ThSep: ' + SysUtils.ThousandSeparator);
|
|
DbgLog('DecSep: ' + DecimalSeparator);
|
|
DbgLog('Sys.DecSep: ' + SysUtils.DecimalSeparator);
|
|
DbgLog('FS.DecSep: ' + FormatSettings.DecimalSeparator);
|
|
DbgLog('Text: ' + s);
|
|
DbgLog('App.DecSep: %s', [FExcel.Excel.Application.DecimalSeparator]);
|
|
DbgLog('App.ThSep: %s', [FExcel.Excel.Application.DecimalSeparator]);
|
|
{$ENDIF}
|
|
|
|
// Remove the thousands separator.
|
|
|
|
ts := ThousandSeparator;
|
|
|
|
if ts = '' then
|
|
{$IFDEF DELPHI16}
|
|
ts := FormatSettings.ThousandSeparator;
|
|
{$ELSE}
|
|
ts := SysUtils.ThousandSeparator;
|
|
{$ENDIF}
|
|
|
|
|
|
if ts <> '' then
|
|
s := StringReplace(s, ts, '', [rfReplaceAll]);
|
|
|
|
// Replace the decimal separator with the dot.
|
|
|
|
ds := DecimalSeparator;
|
|
|
|
if ds = '' then
|
|
{$IFDEF DELPHI16}
|
|
ds := FormatSettings.DecimalSeparator;
|
|
{$ELSE}
|
|
ds := SysUtils.DecimalSeparator;
|
|
{$ENDIF}
|
|
|
|
if ds <> '' then
|
|
s := StringReplace(s, ds, '.', [rfReplaceAll]);
|
|
|
|
{$IFDEF DBGLOG}
|
|
DbgLog('ModText: ' + s);
|
|
{$ENDIF}
|
|
|
|
// Create the format string.
|
|
|
|
if FormatStr <> '' then
|
|
begin
|
|
NumFmt := ConvertFormat(FormatStr, ds, ts);
|
|
{$IFDEF DBGLOG}
|
|
DbgLog('Fmt: ' + NumFmt);
|
|
{$ENDIF}
|
|
vCellFormats.Add(NumFmt + '=' + FExcel.IntToCoord(x, y))
|
|
end;
|
|
|
|
try
|
|
s := ConvertNumber(AnsiString(s));
|
|
except
|
|
s := AnsiString(s);
|
|
end;
|
|
|
|
{$IFDEF DBGLOG}
|
|
DbgLog('');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
ArrData^[y + FMatrix.Height * (x - 1)] := s;
|
|
|
|
if (not Obj.IsText) and ((Obj.Image <> nil) and (Obj.Image.Width > 0)) then
|
|
begin
|
|
FExcel.SetRange(x, y, dx, dy);
|
|
Inc(PicCount);
|
|
if FExportEMF then
|
|
Obj.Image.SaveToClipboardFormat(PicFormat, PicData, PicPalette)
|
|
else
|
|
begin
|
|
Pic := TPicture.Create;
|
|
try
|
|
Pic.Bitmap.Assign(Obj.Image);
|
|
Pic.SaveToClipboardFormat(PicFormat, PicData, PicPalette);
|
|
finally
|
|
Pic.Free;
|
|
end;
|
|
end;
|
|
Clipboard.SetAsHandle(PicFormat,THandle(PicData));
|
|
FExcel.Range.PasteSpecial(EmptyParam, EmptyParam, EmptyParam, EmptyParam);
|
|
FExcel.WorkSheet.Pictures[PicCount].Left := FExcel.WorkSheet.Pictures[PicCount].Left + 1;
|
|
FExcel.WorkSheet.Pictures[PicCount].Top := FExcel.WorkSheet.Pictures[PicCount].Top + 1;
|
|
FExcel.WorkSheet.Pictures[PicCount].Width := GetObjWidth(Obj) / 1.38;
|
|
FExcel.WorkSheet.Pictures[PicCount].Height := GetObjHeight(Obj) / 1.38;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if FExportStyles then
|
|
begin
|
|
FExcel.ApplyStyles(vCellStyles, 0, FProgress);
|
|
FExcel.ApplyStyles(vCellFrames, 1, FProgress);
|
|
FExcel.ApplyFormats(vCellFormats, FProgress);
|
|
end;
|
|
if FMergeCells then
|
|
FExcel.ApplyStyles(vCellMerges, 2, FProgress);
|
|
FExcel.SetRange(1, 1, FMatrix.Width , FMatrix.Height);
|
|
VarArrayUnlock(ExlArray);
|
|
FExcel.Range.Value := ExlArray;
|
|
FExcel.WorkSheet.Cells.WrapText := True;
|
|
finally
|
|
vCellStyles.Free;
|
|
vCellFrames.Free;
|
|
vCellMerges.Free;
|
|
vCellFormats.Free;
|
|
end;
|
|
|
|
if ShowProgress then
|
|
FProgress.Free;
|
|
end;
|
|
|
|
function TfrxXLSExport.Start: Boolean;
|
|
begin
|
|
Result := False;
|
|
if FileName <> '' then
|
|
begin
|
|
FFirstPage := True;
|
|
FMatrix := TfrxIEMatrix.Create(UseFileCache, Report.EngineOptions.TempDir, Report.PictureCacheOptions.CachedImagesBuildType);
|
|
FMatrix.DotMatrix := Report.DotMatrixReport;
|
|
FMatrix.ShowProgress := ShowProgress;
|
|
FMatrix.MaxCellHeight := XLMaxHeight * Ydivider;
|
|
FMatrix.BackgroundImage := False;
|
|
FMatrix.Background := FBackground and FEmptyLines;
|
|
FMatrix.RichText := not FExportEMF;
|
|
FMatrix.PlainRich := not FExportEMF;
|
|
if FWysiwyg then
|
|
FMatrix.Inaccuracy := 0.5
|
|
else
|
|
FMatrix.Inaccuracy := 10;
|
|
FMatrix.RotatedAsImage := False;
|
|
FMatrix.DeleteHTMLTags := True;
|
|
FMatrix.Printable := ExportNotPrintable;
|
|
FMatrix.EmptyLines := FEmptyLines;
|
|
{$IFNDEF FPC}
|
|
FMatrix.EMFPictures := FExportEMF;
|
|
{$ENDIF}
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxXLSExport.StartPage(Page: TfrxReportPage; Index: Integer);
|
|
begin
|
|
if FFirstPage then
|
|
begin
|
|
FFirstPage := False;
|
|
FPageLeft := Page.LeftMargin * 2.6;
|
|
FPageTop := Page.TopMargin * 2.6;
|
|
FPageBottom := Page.BottomMargin * 2.6;
|
|
FPageRight := Page.RightMargin * 2.6;
|
|
FPageOrientation := Page.Orientation;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxXLSExport.ExportObject(Obj: TfrxComponent);
|
|
var
|
|
v: TfrxView;
|
|
begin
|
|
if Obj.Page <> nil then
|
|
Obj.Page.Top := FMatrix.Inaccuracy;
|
|
|
|
if IsPageBG(Obj) then
|
|
Exit;
|
|
|
|
if not (Obj is TfrxView) then
|
|
Exit;
|
|
|
|
if Obj is TfrxView then
|
|
begin
|
|
v := Obj as TfrxView;
|
|
|
|
if not (vsExport in v.Visibility) then Exit;
|
|
|
|
if not (v is TfrxCustomMemoView) and not FExportPictures then
|
|
Exit;
|
|
|
|
FMatrix.AddObject(v);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxXLSExport.FinishPage(Page: TfrxReportPage; Index: Integer);
|
|
begin
|
|
FMatrix.AddPage(Page.Orientation, Page.Width, Page.Height, Page.LeftMargin,
|
|
Page.TopMargin, Page.RightMargin, Page.BottomMargin, Page.MirrorMargins, Index);
|
|
end;
|
|
|
|
procedure TfrxXLSExport.Finish;
|
|
begin
|
|
try
|
|
FExcel := TfrxExcel.Create;
|
|
FExcel.OpenExcel;
|
|
FExcel.Excel.ActiveWindow.DisplayGridlines := GridLines;
|
|
|
|
FMatrix.Prepare;
|
|
|
|
if FFastExport then
|
|
ExportPage_Fast
|
|
else
|
|
ExportPage;
|
|
|
|
FExcel.SetRange(1, 1, 1, 1);
|
|
FExcel.Range.Select;
|
|
|
|
if OpenAfterExport or OpenExcelAfterExport then
|
|
FExcel.Visible := True;
|
|
finally
|
|
try
|
|
try
|
|
if ExtractFilePath(FileName) = '' then
|
|
FileName := GetCurrentDir + '\' + FileName;
|
|
FExcel.WorkBook.SaveAs(FileName, xlNormal, EmptyParam,
|
|
EmptyParam, EmptyParam, EmptyParam, xlNoChange, EmptyParam, EmptyParam, EmptyParam);
|
|
finally
|
|
FExcel.Excel.Application.DisplayAlerts := True;
|
|
FExcel.Excel.Application.ScreenUpdating := True;
|
|
end;
|
|
if not (OpenAfterExport or OpenExcelAfterExport) then
|
|
begin
|
|
FExcel.Excel.Quit;
|
|
FExcel.Excel := Null;
|
|
FExcel.Excel := Unassigned;
|
|
end;
|
|
except
|
|
end;
|
|
|
|
FMatrix.Free;
|
|
FExcel.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TfrxExcel }
|
|
|
|
constructor TfrxExcel.Create;
|
|
begin
|
|
inherited Create;
|
|
FIsOpened := False;
|
|
FIsVisible := False;
|
|
OleInitialize(nil);
|
|
end;
|
|
|
|
function TfrxExcel.Pos2Str(Pos: Integer): String;
|
|
var
|
|
i, j: Integer;
|
|
begin
|
|
if Pos > 26 then
|
|
begin
|
|
i := Pos mod 26;
|
|
j := Pos div 26;
|
|
if i = 0 then
|
|
Result := Chr(64 + j - 1)
|
|
else
|
|
Result := Chr(64 + j);
|
|
if i = 0 then
|
|
Result := Result + chr(90)
|
|
else
|
|
Result := Result + Chr(64 + i);
|
|
end
|
|
else
|
|
Result := Chr(64 + Pos);
|
|
end;
|
|
|
|
procedure TfrxExcel.SetVisible(DoShow: Boolean);
|
|
begin
|
|
if not FIsOpened then Exit;
|
|
if DoShow then
|
|
Excel.Visible := True
|
|
else
|
|
Excel.Visible := False;
|
|
end;
|
|
|
|
function TfrxExcel.IntToCoord(X, Y: Integer): String;
|
|
begin
|
|
Result := Pos2Str(X) + IntToStr(Y);
|
|
end;
|
|
|
|
procedure TfrxExcel.SetColSize(x: Integer; Size: Extended);
|
|
var
|
|
r: Variant;
|
|
begin
|
|
if (Size > 0) and (Size < 256) and (x < 256) then
|
|
begin
|
|
try
|
|
r := WorkSheet.Columns;
|
|
r.Columns[x].ColumnWidth := Size;
|
|
except
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxExcel.SetRowSize(y: Integer; Size: Extended);
|
|
var
|
|
r: Variant;
|
|
begin
|
|
if Size > 0 then
|
|
begin
|
|
r := WorkSheet.Rows;
|
|
if size > 409 then
|
|
size := 409;
|
|
r.Rows[y].RowHeight := Size;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxExcel.MergeCells;
|
|
begin
|
|
Range.MergeCells := True;
|
|
end;
|
|
|
|
procedure TfrxExcel.OpenExcel;
|
|
begin
|
|
try
|
|
Excel := CreateOLEObject('Excel.Application');
|
|
Excel.Application.ScreenUpdating := False;
|
|
Excel.Application.DisplayAlerts := False;
|
|
WorkBook := Excel.WorkBooks.Add;
|
|
WorkSheet := WorkBook.WorkSheets[1];
|
|
FIsOpened := True;
|
|
except
|
|
FIsOpened := False;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxExcel.SetPageMargin(Left, Right, Top, Bottom: Extended;
|
|
Orientation: TPrinterOrientation);
|
|
var
|
|
Orient: Integer;
|
|
begin
|
|
if Orientation = poLandscape then
|
|
Orient := 2
|
|
else
|
|
Orient := 1;
|
|
try
|
|
Excel.ActiveSheet.PageSetup.LeftMargin := Left;
|
|
Excel.ActiveSheet.PageSetup.RightMargin := Right;
|
|
Excel.ActiveSheet.PageSetup.TopMargin := Top;
|
|
Excel.ActiveSheet.PageSetup.BottomMargin := Bottom;
|
|
Worksheet.PageSetup.Orientation := Orient;
|
|
except
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxExcel.SetRange(x, y, dx, dy: Integer);
|
|
begin
|
|
try
|
|
if x > 255 then
|
|
x := 255;
|
|
if (x + dx) > 255 then
|
|
dx := 255 - x;
|
|
if (dx > 0) and (dy > 0) then
|
|
Range := WorkSheet.Range[IntToCoord(x, y), IntToCoord(x + dx - 1, y + dy - 1)];
|
|
except
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxExcel.SetRowsSize(aRanges: TStrings;
|
|
Sizes: array of Currency; MainSizeIndex: integer;
|
|
RowsCount:integer; aProgress: TfrxProgress);
|
|
var
|
|
i: integer;
|
|
s: string;
|
|
curSizes: integer;
|
|
v: Variant;
|
|
begin
|
|
if aRanges.Count > 0 then
|
|
begin
|
|
|
|
if Assigned(aProgress) then
|
|
if not aProgress.Terminated then
|
|
begin
|
|
s := frxResources.Get('ProgressRows') + ' - 2';
|
|
aProgress.Execute(aRanges.Count, s, True, True);
|
|
end;
|
|
|
|
WorkSheet.Range['A1:A' + IntToStr(RowsCount)].RowHeight := Sizes[MainSizeIndex];
|
|
s := aRanges[0];
|
|
curSizes := Integer(aRanges.Objects[0]);
|
|
|
|
for i := 1 to Pred(aRanges.Count) do
|
|
begin
|
|
|
|
if Assigned(aProgress) then
|
|
begin
|
|
if aProgress.Terminated then
|
|
Break;
|
|
aProgress.Tick;
|
|
end;
|
|
|
|
if Integer(aRanges.Objects[i]) = MainSizeIndex then
|
|
Continue;
|
|
if Integer(aRanges.Objects[i]) <> curSizes then
|
|
begin
|
|
if curSizes <> MainSizeIndex then
|
|
begin
|
|
try
|
|
v := WorkSheet.Range[s];
|
|
v.RowHeight := Sizes[curSizes];
|
|
except
|
|
end;
|
|
end;
|
|
curSizes := Integer(aRanges.Objects[i]);
|
|
s := aRanges[i];
|
|
end
|
|
else if Length(s) + Length(aRanges[i]) + 1 > 255 then
|
|
begin
|
|
try
|
|
v := WorkSheet.Range[s];
|
|
v.RowHeight := Sizes[curSizes];
|
|
except
|
|
end;
|
|
s := aRanges[i];
|
|
end
|
|
else s := s + ';' + aRanges[i]
|
|
end;
|
|
|
|
if Length(s) > 0 then
|
|
begin
|
|
try
|
|
v := WorkSheet.Range[s].Rows;
|
|
v.RowHeight := Sizes[curSizes];
|
|
except
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxExcel.ApplyStyles(aRanges: TStrings; Kind: byte; aProgress: TfrxProgress);
|
|
// Kind=0 - Styles
|
|
// Kind=1 - Frames
|
|
// Kind=2 - Merge
|
|
var
|
|
i: integer;
|
|
s: string;
|
|
curStyle: integer;
|
|
begin
|
|
if aRanges.Count > 0 then
|
|
begin
|
|
if Assigned(aProgress) then
|
|
if not aProgress.Terminated then
|
|
aProgress.Execute(aRanges.Count, frxResources.Get('ProgressStyles') + ' - ' + IntToStr(Kind + 1), True, True);
|
|
|
|
s := aRanges[0];
|
|
curStyle := Integer(aRanges.Objects[0]);
|
|
for i := 1 to Pred(aRanges.Count) do
|
|
begin
|
|
if Assigned(aProgress) then
|
|
begin
|
|
if aProgress.Terminated then
|
|
Break;
|
|
aProgress.Tick;
|
|
end;
|
|
if Integer(aRanges.Objects[i]) <> CurStyle then
|
|
begin
|
|
case Kind of
|
|
0: ApplyStyle(s, CurStyle);
|
|
1: ApplyFrame(s, CurStyle);
|
|
end;
|
|
CurStyle := Integer(aRanges.Objects[i]);
|
|
s := aRanges[i];
|
|
end
|
|
else if Length(s) + Length(aRanges[i]) + 1 > 255 then
|
|
begin
|
|
case Kind of
|
|
0: ApplyStyle(s, CurStyle);
|
|
1: ApplyFrame(s, CurStyle);
|
|
2: try
|
|
WorkSheet.Range[s].MergeCells := True;
|
|
except
|
|
end;
|
|
end;
|
|
s := aRanges[i];
|
|
end
|
|
{$IFDEF DELPHI16}
|
|
else s := s + FormatSettings.ListSeparator + aRanges[i]
|
|
{$ELSE}
|
|
else s := s + ListSeparator + aRanges[i]
|
|
{$ENDIF}
|
|
end;
|
|
case Kind of
|
|
0: ApplyStyle(s, CurStyle);
|
|
1: ApplyFrame(s, CurStyle);
|
|
2: try
|
|
WorkSheet.Range[s].MergeCells := True;
|
|
except
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxExcel.ApplyStyle(const RangeCoord: String; aStyle: Integer);
|
|
begin
|
|
try
|
|
if Length(RangeCoord) > 0 then
|
|
WorkSheet.Range[RangeCoord].Style := 'S' + IntToStr(aStyle)
|
|
except
|
|
end;
|
|
end;
|
|
|
|
function TfrxExcel.ByteToFrameTypes(Value: Byte): TfrxFrameTypes;
|
|
begin
|
|
Result := PFrameTypes(@Value)^
|
|
end;
|
|
|
|
procedure TfrxExcel.ApplyFrame(const RangeCoord: String; aFrame: Byte);
|
|
var
|
|
vFrame: TfrxFrameTypes;
|
|
vBorders: Variant;
|
|
begin
|
|
try
|
|
if aFrame <> 0 then
|
|
if Length(RangeCoord) > 0 then
|
|
begin
|
|
vFrame := ByteToFrameTypes(aFrame);
|
|
vBorders := WorkSheet.Range[RangeCoord].Cells.Borders;
|
|
if ftLeft in vFrame then
|
|
vBorders.Item[xlEdgeLeft].Linestyle := xlSolid;
|
|
if ftRight in vFrame then
|
|
vBorders.Item[xlEdgeRight].Linestyle := xlSolid;
|
|
if ftTop in vFrame then
|
|
vBorders.Item[xlEdgeTop].Linestyle := xlSolid;
|
|
if ftBottom in vFrame then
|
|
vBorders.Item[xlEdgeBottom].Linestyle := xlSolid;
|
|
end;
|
|
except
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxExcel.SetCellFrame(Frame: TfrxFrameTypes);
|
|
begin
|
|
if ftLeft in Frame then
|
|
Range.Cells.Borders.Item[xlEdgeLeft].Linestyle := xlSolid;
|
|
if ftRight in Frame then
|
|
Range.Cells.Borders.Item[xlEdgeRight].Linestyle := xlSolid;
|
|
if ftTop in Frame then
|
|
Range.Borders.Item[xlEdgeTop].Linestyle := xlSolid;
|
|
if ftBottom in Frame then
|
|
Range.Borders.Item[xlEdgeBottom].Linestyle := xlSolid;
|
|
end;
|
|
|
|
procedure TfrxExcel.ApplyFormats(aRanges: TStringlist; aProgress: TfrxProgress);
|
|
var
|
|
i: integer;
|
|
s: string;
|
|
curFormat: string;
|
|
|
|
function ValueFrom(List: TStringList; Index: Integer): String;
|
|
begin
|
|
if Index >= 0 then
|
|
Result := Copy(List[Index], Length(List.Names[Index]) + 2, MaxInt) else
|
|
Result := '';
|
|
end;
|
|
|
|
begin
|
|
if aRanges.Count > 0 then
|
|
begin
|
|
if Assigned(aProgress) then
|
|
aProgress.Execute(aRanges.Count, 'Data formats', True, True);
|
|
s := ValueFrom(aRanges, 0);
|
|
curFormat := aRanges.Names[0];
|
|
for i := 1 to Pred(aRanges.Count) do
|
|
begin
|
|
if Assigned(aProgress) then
|
|
begin
|
|
if aProgress.Terminated then
|
|
Break;
|
|
aProgress.Tick;
|
|
end;
|
|
if aRanges.Names[i] <> CurFormat then
|
|
begin
|
|
ApplyFormat(s, CurFormat);
|
|
CurFormat := aRanges.Names[i];
|
|
s := ValueFrom(aRanges, i);
|
|
end
|
|
else
|
|
if Length(s) + Length(ValueFrom(aRanges, i)) + 1 > 255 then
|
|
begin
|
|
ApplyFormat(s, CurFormat);
|
|
s := ValueFrom(aRanges, i);
|
|
end
|
|
else
|
|
{$IFDEF DELPHI16}
|
|
s := s + FormatSettings.ListSeparator + ValueFrom(aRanges, i)
|
|
{$ELSE}
|
|
s := s + ListSeparator + ValueFrom(aRanges, i)
|
|
{$ENDIF}
|
|
end;
|
|
ApplyFormat(s, CurFormat);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxExcel.ApplyFormat(const RangeCoord, aFormat: String);
|
|
begin
|
|
if Length(RangeCoord) > 0 then
|
|
try
|
|
WorkSheet.Range[RangeCoord].NumberFormat := aFormat;
|
|
except
|
|
end;
|
|
end;
|
|
|
|
destructor TfrxExcel.Destroy;
|
|
begin
|
|
OleUnInitialize;
|
|
inherited;
|
|
end;
|
|
|
|
end.
|
|
|