mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-11 22:45:39 +02:00
4737 lines
155 KiB
ObjectPascal
4737 lines
155 KiB
ObjectPascal
Unit U_ExpXlsX;
|
|
interface
|
|
uses windows, Graphics, Forms, SysUtils, Variants, Classes, FR_Class, FR_View, FR_Utils, frx2xto30,
|
|
frxUnicodeUtils, FrxClass, DB, ComCtrls, dialogs;
|
|
|
|
type Tmy_Obj = class(TObject)
|
|
Private
|
|
procedure DoGetValue(const Expr: String; var Value: Variant);
|
|
end;
|
|
|
|
Procedure ExportObj_X(var aPage: TfrxReportPage; var aLineList: TList; aObj: Pointer; var aMemoList: TStringList; var aMemoCounter: integer);
|
|
Procedure ExportObj_W(var aPage: TfrxReportPage; aObj: Pointer; var aMemoCounter: integer; var aDrawedObjects: Boolean);
|
|
|
|
{function ExportReportToXLSX(aFileName: String; aReport: tfrReport): Boolean; // ïàêåòíàÿ ïå÷àòü
|
|
function ExportReportToDocX(aFileName: String; aReport: tfrReport): Boolean; // ïàêåòíàÿ ïå÷àòü}
|
|
|
|
function ExportReportToXLSX(aFileName: String; aReport: tfrReport; aFromPreview: Boolean = False ): Boolean; // ïàêåòíàÿ ïå÷àòü
|
|
function ExportReportToDocX(aFileName: String; aReport: tfrReport; aFromPreview: Boolean = False): Boolean; // ïàêåòíàÿ ïå÷àòü}
|
|
|
|
|
|
|
|
Procedure ExportRepToXLSX(aReport: tfrReport; aFileName: String); // ñ êíîïî÷êè íà ïðåâüþõå
|
|
Procedure ExportRepToDocX(aReport: tfrReport; aFileName: String); // ñ êíîïî÷êè íà ïðåâüþõå
|
|
|
|
//Procedure ClearText(aRep: TfrxReport);
|
|
|
|
//Procedure AssignPageProps_Word(var aFrxPage: TfrxReportPage; aFrPage: TfrPage; WriteTitul: Boolean);
|
|
Procedure AssignPageProps_Word(var aFrxPage: TfrxReportPage; aFrPage: TfrPage; WriteTitul: Boolean; FirstPageDrawed: Boolean = False);
|
|
Procedure SetfrxPictView_Word(var aNewPict: TfrxPictureView; aPict: TfrPictureView);
|
|
procedure SetfrxView_Word(var aFrxView: TfrxMemoView; aView: TfrMemoView);
|
|
Procedure SetfrxShapeView_Word(var aNewShape: TfrxShapeView; aLine: TfrLineView);
|
|
Procedure SetfrxLineView_Word(var aNewLine: TfrxPictureView; aLine: TfrLineView; aScale: Boolean);
|
|
|
|
Function CheckFormatCells(aReport: TfrReport; var aMemoList: TStringList): Boolean;
|
|
|
|
Function GetPageDeltaY(aPage: TfrPage): Extended;
|
|
|
|
|
|
//Procedure Inport;
|
|
|
|
var CurrPageLeft: Extended;
|
|
PageDeltaY: Extended;
|
|
implementation
|
|
|
|
|
|
Uses {FrxClass,} FrxExportXlsX, U_ProgressExp, U_Main, U_ResourceReport, U_BaseConstants, U_SCSComponent,
|
|
U_BaseCommon, U_Cad, U_Common, frxdbSet, frxExportDOCX, FrxPreviewPages, frxPreview;
|
|
|
|
Function GetPageDeltaY(aPage: TfrPage): Extended;
|
|
var i: integer;
|
|
begin
|
|
// Result := -18;
|
|
//Result := -32;
|
|
Result := 0;
|
|
for i := 0 to aPage.Objects.Count - 1 do
|
|
begin
|
|
if TObject(aPage.Objects[i]).ClassName = 'TfrMemoView' then
|
|
begin
|
|
// if TfrMemoView(aPage.Objects[i]).y <= 40 then
|
|
if TfrMemoView(aPage.Objects[i]).y <= 100 then
|
|
if TfrMemoView(aPage.Objects[i]).x <= 72 then
|
|
if Trim(TfrMemoView(aPage.Objects[i]).Memo.Text) = '' then
|
|
if TfrMemoView(aPage.Objects[i]).dx > 500 then
|
|
begin
|
|
Result := Result - TfrMemoView(aPage.Objects[i]).dy;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
Procedure AssignPageProps_Word(var aFrxPage: TfrxReportPage; aFrPage: TfrPage; WriteTitul: Boolean; FirstPageDrawed: Boolean = False);
|
|
begin
|
|
aFrxPage.Orientation := aFrPage.pgOr;
|
|
aFrxPage.PaperSize := aFrPage.pgSize;
|
|
// aFrxPage.PaperWidth := aFrPage.pgWidth;
|
|
// aFrxPage.PaperHeight := aFrPage.pgHeight;
|
|
// aFrxPage.Orientation := aFrPage.pgOr;
|
|
if not WriteTitul then
|
|
begin
|
|
aFrxPage.LeftMargin := Round(aFrPage.LeftMargin * 5)/18;
|
|
aFrxPage.RightMargin := aFrxPage.LeftMargin; //Round(aFrPage.RightMargin*5)/18;;
|
|
aFrxPage.TopMargin := Round(aFrPage.TopMargin*5)/18;
|
|
aFrxPage.BottomMargin := aFrxPage.TopMargin;//Round(aFrPage.BottomMargin*5)/18;
|
|
end
|
|
else
|
|
begin
|
|
aFrxPage.LeftMargin := 5;
|
|
aFrxPage.BottomMargin := 5;
|
|
aFrxPage.TopMargin := 5;
|
|
aFrxPage.RightMargin := 5;
|
|
if FirstPageDrawed then
|
|
aFrxPage.LeftMargin := 8
|
|
else
|
|
aFrxPage.LeftMargin := 5;
|
|
end;
|
|
end;
|
|
(*
|
|
Procedure SetfrxPictView_Word(var aNewPict: TfrxPictureView; aPict: TfrPictureView);
|
|
var
|
|
bit : TBitmap;
|
|
rect: TRect;
|
|
HalfPict, HalfBmp: Integer;
|
|
bandAlign: integer;
|
|
koef: Double;
|
|
begin
|
|
aNewPict.CreateUniqueName;
|
|
aNewPict.TransParent := True;
|
|
|
|
aNewPict.Top := aPict.y;
|
|
aNewPict.Left := aPict.x;
|
|
aNewPict.Width := aPict.dx;
|
|
aNewPict.Height := aPict.dy;
|
|
|
|
//aNewPict.Picture.Bitmap.width := Round(aNewPict.Width);
|
|
//aNewPict.Picture.Bitmap.height := Round(aNewPict.Height);
|
|
|
|
//aNewPict.Stretched := True;
|
|
|
|
//HalfPict := Round(aPict.dx/2);
|
|
//HalfBmp := Round(aPict.Picture.Bitmap.Width/2);
|
|
|
|
bit := TBitmap.Create;
|
|
bit.Height := aPict.Picture.Bitmap.Height;
|
|
bit.Width := aPict.Picture.Bitmap.Width;
|
|
|
|
if bit.Height > aPict.dy then
|
|
bit.Height := round(aPict.dy);
|
|
if bit.Width > aPict.dx then
|
|
bit.Width := aPict.dx;
|
|
|
|
if aPict.dy > aPict.Picture.Height then
|
|
begin
|
|
koef := aPict.dy / aPict.Picture.Height;
|
|
bit.width := Round(bit.width * koef);
|
|
bit.Height := Round(aPict.dy);
|
|
end;
|
|
|
|
Rect.Left := 0;
|
|
Rect.Top := 0;
|
|
//Rect.Right := aPict.dx;
|
|
//Rect.Bottom := aPict.dy;
|
|
Rect.Right := bit.Width;
|
|
Rect.Bottom := bit.Height;
|
|
|
|
//bit.Canvas.Draw(0,0,aPict.Picture.Bitmap);
|
|
bit.Canvas.StretchDraw(rect ,aPict.Picture.Bitmap);
|
|
|
|
{Rect.Right := round(aNewPict.Width);
|
|
Rect.Bottom := round(aNewPict.Height);
|
|
aNewPict.Picture.BitMap.Canvas.Brush.Color := clWhite;
|
|
|
|
aNewPict.Picture.BitMap.Canvas.FillRect(rect);
|
|
|
|
rect.Left := (HalfPict - HalfBmp);
|
|
|
|
if rect.Left < 0 then
|
|
rect.Left := 0;
|
|
|
|
rect.Right := rect.Left + Bit.width;
|
|
rect.Top := 0;
|
|
rect.Bottom := bit.Height;
|
|
//aNewPict.Picture.Bitmap.Canvas.Draw(rect.Left, Rect.Top, bit);
|
|
aNewPict.Picture.Bitmap.Canvas.StretchDraw(rect, bit);}
|
|
bit.SaveToFile('c:\1.bmp');
|
|
bit.Destroy;
|
|
aNewPict.Picture.Bitmap.LoadFromFile('c:\1.bmp');
|
|
|
|
if (aPict.FrameTyp and frftRight) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftRight];
|
|
if (aPict.FrameTyp and frftBottom) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftBottom];
|
|
if (aPict.FrameTyp and frftLeft) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftLeft];
|
|
if (aPict.FrameTyp and frftTop) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftTop];
|
|
aNewPict.Frame.Width := aPict.FrameWidth;
|
|
aNewPict.Frame.Color := aPict.FrameColor;
|
|
aNewPict.Frame.Style := TfrxFrameStyle(aPict.FrameStyle);
|
|
aNewPict.Color := aPict.FillColor;
|
|
aNewPict.TagStr := aPict.Tag;
|
|
|
|
aNewPict.IsPictureStored := True;
|
|
|
|
end;
|
|
*)
|
|
|
|
Procedure SetfrxPictView_Word(var aNewPict: TfrxPictureView; aPict: TfrPictureView);
|
|
var
|
|
bit : TBitmap;
|
|
rect: TRect;
|
|
HalfPict, HalfBmp: Integer;
|
|
bandAlign: integer;
|
|
koef: Double;
|
|
begin
|
|
aNewPict.CreateUniqueName;
|
|
aNewPict.TransParent := True;
|
|
|
|
//aNewPict.Top := aPict.y;
|
|
aNewPict.Top := aPict.y + PageDeltaY;
|
|
aNewPict.Left := aPict.x;
|
|
aNewPict.Width := aPict.dx;
|
|
aNewPict.Height := aPict.dy;
|
|
|
|
aNewPict.Picture.Bitmap.width := Round(aNewPict.Width);
|
|
aNewPict.Picture.Bitmap.height := Round(aNewPict.Height);
|
|
|
|
aNewPict.Stretched := True;
|
|
|
|
HalfPict := Round(aPict.dx/2);
|
|
HalfBmp := Round(aPict.Picture.Bitmap.Width/2);
|
|
|
|
bit := TBitmap.Create;
|
|
bit.Height := aPict.Picture.Bitmap.Height;
|
|
bit.Width := aPict.Picture.Bitmap.Width;
|
|
|
|
if bit.Height > aPict.dy then
|
|
bit.Height := round(aPict.dy);
|
|
if bit.Width > aPict.dx then
|
|
bit.Width := aPict.dx;
|
|
|
|
if aPict.dy > aPict.Picture.Height then
|
|
begin
|
|
koef := aPict.dy / aPict.Picture.Height;
|
|
bit.width := Round(bit.width * koef);
|
|
bit.Height := Round(aPict.dy);
|
|
end;
|
|
|
|
Rect.Left := 0;
|
|
Rect.Top := 0;
|
|
//Rect.Right := aPict.dx;
|
|
//Rect.Bottom := aPict.dy;
|
|
Rect.Right := bit.Width;
|
|
Rect.Bottom := bit.Height;
|
|
|
|
//bit.Canvas.Draw(0,0,aPict.Picture.Bitmap);
|
|
bit.Canvas.StretchDraw(rect ,aPict.Picture.Bitmap);
|
|
|
|
Rect.Right := round(aNewPict.Width);
|
|
Rect.Bottom := round(aNewPict.Height);
|
|
aNewPict.Picture.BitMap.Canvas.Brush.Color := clWhite;
|
|
|
|
aNewPict.Picture.BitMap.Canvas.FillRect(rect);
|
|
|
|
rect.Left := (HalfPict - HalfBmp);
|
|
|
|
if rect.Left < 0 then
|
|
rect.Left := 0;
|
|
|
|
rect.Right := rect.Left + Bit.width;
|
|
rect.Top := 0;
|
|
rect.Bottom := bit.Height;
|
|
//aNewPict.Picture.Bitmap.Canvas.Draw(rect.Left, Rect.Top, bit);
|
|
aNewPict.Picture.Bitmap.Canvas.StretchDraw(rect, bit);
|
|
bit.Destroy;
|
|
|
|
if (aPict.FrameTyp and frftRight) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftRight];
|
|
if (aPict.FrameTyp and frftBottom) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftBottom];
|
|
if (aPict.FrameTyp and frftLeft) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftLeft];
|
|
if (aPict.FrameTyp and frftTop) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftTop];
|
|
aNewPict.Frame.Width := aPict.FrameWidth;
|
|
aNewPict.Frame.Color := aPict.FrameColor;
|
|
aNewPict.Frame.Style := TfrxFrameStyle(aPict.FrameStyle);
|
|
aNewPict.Color := aPict.FillColor;
|
|
aNewPict.TagStr := aPict.Tag;
|
|
|
|
aNewPict.IsPictureStored := True;
|
|
end;
|
|
|
|
procedure SetfrxView_Word(var aFrxView: TfrxMemoView; aView: TfrMemoView);
|
|
var bandAlign: integer;
|
|
begin
|
|
//aFrxView.CreateUniqueName;
|
|
|
|
if (aView.FrameTyp and frftRight) <> 0 then
|
|
aFrxView.Frame.Typ := aFrxView.Frame.Typ + [ftRight];
|
|
if (aView.FrameTyp and frftBottom) <> 0 then
|
|
aFrxView.Frame.Typ := aFrxView.Frame.Typ + [ftBottom];
|
|
if (aView.FrameTyp and frftLeft) <> 0 then
|
|
aFrxView.Frame.Typ := aFrxView.Frame.Typ + [ftLeft];
|
|
if (aView.FrameTyp and frftTop) <> 0 then
|
|
aFrxView.Frame.Typ := aFrxView.Frame.Typ + [ftTop];
|
|
|
|
aFrxView.Frame.Width := aView.FrameWidth;
|
|
aFrxView.Frame.Color := aView.FrameColor;
|
|
aFrxView.Frame.Style := TfrxFrameStyle(aView.FrameStyle);
|
|
aFrxView.Color := aView.FillColor;
|
|
aFrxView.Font := aView.Font;
|
|
|
|
//aFrxView.Top := aView.y;
|
|
aFrxView.Top := aView.y + PageDeltaY;
|
|
aFrxView.Left := aView.x;
|
|
aFrxView.Width := aView.dx;
|
|
//aFrxView.Width := aView.dx + aView.dx/10;
|
|
aFrxView.Height := aView.dy;
|
|
aFrxView.Frame.ShadowColor := clBlack;//aFrxView.Frame.Color;
|
|
aFrxView.Frame.ShadowWidth := aView.FrameWidth;
|
|
aFrxView.Frame.DropShadow := False;
|
|
|
|
aFrxView.GapX := aView.GapX;
|
|
aFrxView.Gapy := aView.GapY;
|
|
|
|
aFrxView.LineSpacing := aView.LineSpacing;
|
|
|
|
if aFrxView.LineSpacing < 3 then
|
|
aFrxView.LineSpacing := 3; // 11/07/2020 --
|
|
|
|
aFrxView.CharSpacing := aView.CharacterSpacing;
|
|
|
|
{aFrxView.HAlign := haLeft;
|
|
aFrxView.VAlign := vaTop;}
|
|
|
|
if (aView.Alignment and frtaRight) <> 0 then
|
|
aFrxView.HAlign := haRight;
|
|
if (aView.Alignment and frtaCenter) <> 0 then
|
|
aFrxView.HAlign := haCenter;
|
|
if (aView.Alignment and 3) = 3 then
|
|
aFrxView.HAlign := haBlock;
|
|
if (aView.Alignment and frtaVertical) <> 0 then
|
|
aFrxView.Rotation := 90;
|
|
if (aView.Alignment and frtaMiddle) <> 0 then
|
|
aFrxView.VAlign := vaCenter;
|
|
if (aView.Alignment and frtaDown) <> 0 then
|
|
aFrxView.VAlign := vaBottom;
|
|
|
|
aFrxView.StretchMode := smDontStretch;
|
|
//aFrxView.WordWrap := (aView.Flags and flWordWrap) <> 0;
|
|
|
|
aFrxView.WordWrap := false;
|
|
|
|
aFrxView.WordBreak := (aView.Flags and flWordBreak) <> 0;
|
|
aFrxView.AutoWidth := (aView.Flags and flAutoSize) <> 0;
|
|
aFrxView.AllowExpressions := (aView.Flags and flTextOnly) = 0;
|
|
aFrxView.SuppressRepeated := (aView.Flags and flSuppressRepeated) <> 0;
|
|
aFrxView.HideZeros := (aView.Flags and flHideZeros) <> 0;
|
|
aFrxView.Underlines := (aView.Flags and flUnderlines) <> 0;
|
|
aFrxView.RTLReading := (aView.Flags and flRTLReading) <> 0;
|
|
aFrxView.AutoWidth := False;
|
|
bandAlign := aView.BandAlign;
|
|
if BandAlign = 6 then
|
|
BandAlign := 0;
|
|
if BandAlign = 7 then
|
|
BandAlign := 6;
|
|
aFrxView.Align := TfrxAlign(BandAlign);
|
|
aFrxView.TagStr := aView.Tag;
|
|
|
|
{ if aFrxView.Frame.Width > 1 then
|
|
aFrxView.Frame.Typ := aFrxView.Frame.Typ - [ftRight];}
|
|
end;
|
|
|
|
Procedure SetfrxShapeView_Word(var aNewShape: TfrxShapeView; aLine: TfrLineView);
|
|
var bit : TBitmap;
|
|
begin
|
|
aNewShape.CreateUniqueName;
|
|
aNewShape.Left := aLine.x;
|
|
|
|
//aNewShape.Top := aLine.y;
|
|
aNewShape.Top := aLine.y + PageDeltaY; // 29/09/2020 --
|
|
|
|
aNewShape.Width := aLine.dx;
|
|
aNewShape.Height := aLine.dy;
|
|
{if aNewShape.Width < aNewShape.Height then
|
|
aNewShape.Left := aNewShape.Left - 1;}
|
|
|
|
aNewShape.Frame.Width := aLine.FrameWidth;
|
|
if aNewShape.Width = 0 then
|
|
begin
|
|
aNewShape.Width := aLine.FrameWidth;
|
|
end
|
|
else
|
|
if aNewShape.Height = 0 then
|
|
begin
|
|
aNewShape.Height := aLine.FrameWidth;
|
|
end;
|
|
aNewShape.Color := clBlack;
|
|
end;
|
|
|
|
Procedure SetfrxLineView_Word(var aNewLine: TfrxPictureView; aLine: TfrLineView; aScale: Boolean);
|
|
var bandAlign, FrameTyp: integer;
|
|
bit : TBitmap;
|
|
rect: TRect;
|
|
TempList: TList;
|
|
Oldx, oldY: integer;
|
|
begin
|
|
Try
|
|
|
|
//aNewLine.Top := aLine.y;
|
|
aNewLine.Top := aLine.y + PageDeltaY; // 29/09/2020 --
|
|
aNewLine.Left := aLine.x;
|
|
aNewLine.Width := aLine.dx;
|
|
aNewLine.Height := aLine.dy;
|
|
aNewLine.Picture.Bitmap.width := aLine.dx;
|
|
aNewLine.Picture.Bitmap.height := aLine.dy;
|
|
|
|
bit := TBitmap.Create;
|
|
|
|
bit.Height := aLine.dy;
|
|
bit.Width := aLine.dx;
|
|
|
|
Bit.Canvas.Pen.Color := clBlack;
|
|
Bit.Canvas.MoveTo(0,0);
|
|
|
|
if bit.Height > bit.Width then
|
|
begin
|
|
bit.Width := Round(aLine.FrameWidth);
|
|
bit.Canvas.Pen.Width := bit.Width;
|
|
bit.Canvas.LineTo(0, bit.Height);
|
|
if aScale then
|
|
bit.Height := Round(bit.Height*aLine.ScaleY);
|
|
//aNewLine.Left := aNewLine.Left - 2;
|
|
end
|
|
else
|
|
begin
|
|
bit.Height := Round(aLine.FrameWidth);
|
|
bit.Canvas.Pen.Width := bit.Height;
|
|
bit.Canvas.LineTo(bit.Width, 0);
|
|
if aScale then
|
|
bit.Width := Round(bit.Width*aLine.ScaleY);
|
|
end;
|
|
|
|
rect.Left := 0;
|
|
rect.Right := aLine.dx;
|
|
rect.Top := 0;
|
|
rect.Bottom := aLine.dy;
|
|
aNewLine.Width := bit.Width;
|
|
aNewLine.Height := bit.Height;
|
|
aNewLine.Width := bit.Width;
|
|
aNewLine.Height := bit.Height;
|
|
aNewLine.Picture.Bitmap.Width := bit.Width;
|
|
aNewLine.Picture.Bitmap.Height := bit.Height;
|
|
|
|
aNewLine.Picture.Bitmap.Canvas.Draw(0,0,bit);
|
|
bit.Destroy;
|
|
|
|
Except
|
|
on E:Exception do
|
|
ShowMessage('ExportLine Error! ' + aLine.Name);
|
|
End;
|
|
end;
|
|
|
|
Function CheckFormatCells(aReport: TfrReport; var aMemoList: TStringList): Boolean;
|
|
var s: String;
|
|
begin
|
|
Result := False;
|
|
if aReport.FileName <> '' then
|
|
begin
|
|
s := ExtractFileName(aReport.FileName);
|
|
if s = 'RCable.frf' then
|
|
begin
|
|
aMemoList.Add('Memo52');
|
|
Result := True;
|
|
end
|
|
else
|
|
if s = 'RCableJournal.frf' then
|
|
begin
|
|
aMemoList.Add('Memo129');
|
|
aMemoList.Add('Memo130');
|
|
Result := True;
|
|
end
|
|
else
|
|
if s = 'RSTAMPCable.frf' then
|
|
begin
|
|
aMemoList.Add('Memo29');
|
|
Result := True;
|
|
end
|
|
else
|
|
if s = 'RSTAMPCableJournal.frf' then
|
|
begin
|
|
aMemoList.Add('Memo52');
|
|
Result := True;
|
|
end;
|
|
end;
|
|
end;
|
|
// *********************************************************************************************************
|
|
|
|
Procedure AssignPageProps(var aFrxPage: TfrxReportPage; aFrPage: TfrPage; WriteWithTitul: boolean = false);
|
|
begin
|
|
aFrxPage.Orientation := aFrPage.pgOr;
|
|
aFrxPage.PaperSize := aFrPage.pgSize;
|
|
//aFrxPage.PaperWidth := aFrPage.pgWidth / 10;
|
|
//aFrxPage.PaperHeight := aFrPage.pgHeight / 10;
|
|
|
|
//aFrxPage.PaperWidth := aFrPage.pgWidth;
|
|
// aFrxPage.PaperHeight := aFrPage.pgHeight;
|
|
// aFrxPage.Orientation := aFrPage.pgOr;
|
|
if not WriteWithTitul then
|
|
begin
|
|
//aFrxPage.LeftMargin := aFrPage.pgMargins.Left;
|
|
//aFrxPage.TopMargin := aFrPage.pgMargins.Top * 5 / 18;
|
|
|
|
{ aFrxPage.Top := aFrPage.Top * 5 / 18;
|
|
aFrxPage.Left := aFrPage.Left * 5 / 18;}
|
|
|
|
{
|
|
aFrxPage.Width := aFrPage.Width;
|
|
aFrxPage.Height := aFrPage.Height;}
|
|
|
|
//aFrxPage.RightMargin := aFrPage.pgMargins.Right;
|
|
//aFrxPage.BottomMargin := aFrPage.pgMargins.Bottom;
|
|
|
|
aFrxPage.LeftMargin := (aFrPage.pgMargins.Left * 5) / 18;
|
|
aFrxPage.TopMargin := (aFrPage.pgMargins.Top * 5) / 18;
|
|
aFrxPage.RightMargin := (aFrPage.pgMargins.Right * 5) / 18;
|
|
aFrxPage.BottomMargin := (aFrPage.pgMargins.Bottom * 5) / 18;
|
|
|
|
{aFrxPage.LeftMargin := aFrPage.pgMargins.Left / fr01cm;
|
|
aFrxPage.TopMargin := aFrPage.pgMargins.Top / fr01cm;
|
|
aFrxPage.RightMargin := aFrPage.pgMargins.Right / fr01cm;
|
|
aFrxPage.BottomMargin := aFrPage.pgMargins.Bottom / fr01cm;}
|
|
|
|
|
|
//aFrxPage.LeftMargin := (aFrPage.pgMargins.Left * 5) / 18 / 2.54;
|
|
//aFrxPage.TopMargin := (aFrPage.pgMargins.Top * 5) / 18 / 2.54;
|
|
//aFrxPage.RightMargin := (aFrPage.pgMargins.Right * 5) / 18 / 2.54;
|
|
//aFrxPage.BottomMargin := (aFrPage.pgMargins.Bottom * 5) / 18 / 2.54;
|
|
|
|
|
|
//aFrxPage.LeftMargin := Round(aFrPage.LeftMargin * 5)/18 / 25.4;
|
|
// aFrxPage.RightMargin := aFrxPage.LeftMargin; //Round(aFrPage.RightMargin*5)/18;;
|
|
// aFrxPage.RightMargin := Round(aFrPage.RightMargin*5)/18;;
|
|
//aFrxPage.TopMargin := Round(aFrPage.TopMargin*5)/18 / 25.4;
|
|
//aFrxPage.BottomMargin := aFrxPage.TopMargin;//Round(aFrPage.BottomMargin*5)/18;
|
|
//aFrxPage.BottomMargin := Round(aFrPage.BottomMargin*5)/18;
|
|
end
|
|
else
|
|
begin
|
|
aFrxPage.LeftMargin := 5;
|
|
aFrxPage.BottomMargin := 5;
|
|
aFrxPage.TopMargin := 5;
|
|
aFrxPage.RightMargin := 5;
|
|
{aPage.BottomMargin := 5;
|
|
aPage.TopMargin := 5;
|
|
aPage.RightMargin := 5;}
|
|
end;
|
|
aFrxPage.PaperSize := aFrPage.pgSize;
|
|
|
|
end;
|
|
|
|
|
|
//Procedure SetfrxPictView(aNewPict: TfrxPictureView; aPict: TfrPictureView);
|
|
Procedure SetfrxPictView(aNewPict: TfrxPictureView; aPict: TfrPictureView; aShift: Boolean);
|
|
var
|
|
bit : TBitmap;
|
|
rect: TRect;
|
|
HalfPict, HalfBmp: Integer;
|
|
begin
|
|
aNewPict.CreateUniqueName;
|
|
aNewPict.TransParent := True;
|
|
|
|
//aNewPict.Top := aPict.y;
|
|
if aShift then
|
|
aNewPict.Top := aPict.y + PageDeltaY
|
|
else
|
|
aNewPict.Top := aPict.y;
|
|
|
|
//aNewPict.Left := aPict.x - CurrPageLeft;
|
|
aNewPict.Left := aPict.x;
|
|
aNewPict.Width := aPict.dx;
|
|
aNewPict.Height := aPict.dy;
|
|
aNewPict.Picture.Bitmap.width := aPict.dx;
|
|
aNewPict.Picture.Bitmap.height := aPict.dy;
|
|
|
|
HalfPict := Round(aPict.dx/2);
|
|
HalfBmp := Round(aPict.Picture.Bitmap.Width/2);
|
|
|
|
bit := TBitmap.Create;
|
|
bit.Height := aPict.Picture.Bitmap.Height;
|
|
bit.Width := aPict.Picture.Bitmap.Width;
|
|
//bit.Height := aPict.dy;
|
|
//bit.Width := aPict.dx;
|
|
|
|
bit.Canvas.Draw(0,0,aPict.Picture.Bitmap);
|
|
|
|
rect.Left := HalfPict - HalfBmp;
|
|
//rect.Left := 0;
|
|
if rect.Left < 0 then
|
|
rect.Left := 0;
|
|
|
|
rect.Right := rect.Left + aPict.Picture.Bitmap.width;
|
|
//rect.Right := aPict.Picture.Bitmap.width;
|
|
rect.Top := 0;
|
|
rect.Bottom := aPict.dy;
|
|
aNewPict.Picture.Bitmap.Canvas.StretchDraw(rect, bit);
|
|
|
|
bit.Destroy;
|
|
|
|
if (aPict.FrameTyp and frftRight) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftRight];
|
|
if (aPict.FrameTyp and frftBottom) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftBottom];
|
|
if (aPict.FrameTyp and frftLeft) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftLeft];
|
|
if (aPict.FrameTyp and frftTop) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftTop];
|
|
aNewPict.Frame.Width := aPict.FrameWidth;
|
|
aNewPict.Frame.Color := aPict.FrameColor;
|
|
aNewPict.Frame.Style := TfrxFrameStyle(aPict.FrameStyle);
|
|
//aNewPict.isText := False;
|
|
aNewPict.Color := aPict.FillColor;
|
|
end;
|
|
|
|
//procedure SetfrxView(aFrxView: TfrxMemoView; aView: TfrMemoView; aMemoList: TStringList = nil);
|
|
procedure SetfrxView(aFrxView: TfrxMemoView; aView: TfrMemoView; aMemoList: TStringList = nil; aShift: Boolean = false);
|
|
|
|
var bandAlign: integer;
|
|
i: integer;
|
|
begin
|
|
//aFrxView.CreateUniqueName;
|
|
|
|
if (aView.FrameTyp and frftRight) <> 0 then
|
|
aFrxView.Frame.Typ := aFrxView.Frame.Typ + [ftRight];
|
|
if (aView.FrameTyp and frftBottom) <> 0 then
|
|
aFrxView.Frame.Typ := aFrxView.Frame.Typ + [ftBottom];
|
|
if (aView.FrameTyp and frftLeft) <> 0 then
|
|
aFrxView.Frame.Typ := aFrxView.Frame.Typ + [ftLeft];
|
|
if (aView.FrameTyp and frftTop) <> 0 then
|
|
aFrxView.Frame.Typ := aFrxView.Frame.Typ + [ftTop];
|
|
|
|
aFrxView.Frame.Width := aView.FrameWidth;
|
|
aFrxView.Frame.Color := aView.FrameColor;
|
|
aFrxView.Frame.Style := TfrxFrameStyle(aView.FrameStyle);
|
|
|
|
//aFrxView.LineSpacing := aView.LineSpacing;
|
|
//aFrxView.LineSpacing := aView.LineSpacing - 1;
|
|
|
|
aFrxView.CharSpacing := aView.CharacterSpacing;
|
|
|
|
//aFrxView.StretchMode := smActualHeight;
|
|
aFrxView.StretchMode := smDontStretch;
|
|
|
|
aFrxView.Color := aView.FillColor;
|
|
aFrxView.Font := aView.Font;
|
|
//aFrxView.Font.Size := aFrxView.Font.Size - 1;
|
|
|
|
//aFrxView.Top := aView.y;
|
|
if aShift then
|
|
aFrxView.Top := aView.y + PageDeltaY
|
|
else
|
|
aFrxView.Top := aView.y;
|
|
|
|
//aFrxView.Left := aView.x - CurrPageLeft;
|
|
aFrxView.Left := aView.x;
|
|
aFrxView.Width := aView.dx;
|
|
aFrxView.Height := aView.dy;
|
|
|
|
aFrxView.Frame.DropShadow := False;
|
|
|
|
aFrxView.GapX := aView.GapX;
|
|
aFrxView.Gapy := aView.GapY;
|
|
|
|
if (aView.Alignment and frtaRight) <> 0 then
|
|
aFrxView.HAlign := haRight;
|
|
if (aView.Alignment and frtaCenter) <> 0 then
|
|
aFrxView.HAlign := haCenter;
|
|
if (aView.Alignment and 3) = 3 then
|
|
aFrxView.HAlign := haBlock;
|
|
if (aView.Alignment and frtaVertical) <> 0 then
|
|
aFrxView.Rotation := 90;
|
|
if (aView.Alignment and frtaMiddle) <> 0 then
|
|
aFrxView.VAlign := vaCenter;
|
|
if (aView.Alignment and frtaDown) <> 0 then
|
|
aFrxView.VAlign := vaBottom;
|
|
|
|
//aFrxView.WordWrap := (aView.Flags and flWordWrap) <> 0;
|
|
aFrxView.WordWrap := False;
|
|
//
|
|
aFrxView.WordBreak := (aView.Flags and flWordBreak) <> 0;
|
|
aFrxView.AutoWidth := (aView.Flags and flAutoSize) <> 0;
|
|
aFrxView.AllowExpressions := (aView.Flags and flTextOnly) = 0;
|
|
aFrxView.SuppressRepeated := (aView.Flags and flSuppressRepeated) <> 0;
|
|
aFrxView.HideZeros := (aView.Flags and flHideZeros) <> 0;
|
|
aFrxView.Underlines := (aView.Flags and flUnderlines) <> 0;
|
|
aFrxView.RTLReading := (aView.Flags and flRTLReading) <> 0;
|
|
aFrxView.AutoWidth := False;
|
|
bandAlign := aView.BandAlign;
|
|
if BandAlign = 6 then
|
|
BandAlign := 0;
|
|
if BandAlign = 7 then
|
|
BandAlign := 6;
|
|
aFrxView.Align := TfrxAlign(BandAlign);
|
|
aFrxView.TagStr := aView.Tag;
|
|
//aFrxView.StretchMode := smActualHeight;
|
|
aFrxView.StretchMode := smDontStretch;
|
|
if aMemoList <> nil then
|
|
begin
|
|
for i := 0 to aMemoList.Count - 1 do
|
|
begin
|
|
{if ((aView.Name = 'Memo129') or (aView.Name = 'Memo130')) then
|
|
aFrxView.DisplayFormat.Kind := fkCommon;}
|
|
if aMemoList[i] = aView.Name then
|
|
begin
|
|
aFrxView.DisplayFormat.Kind := fkCommon;
|
|
//aFrxView.StretchMode := smDontStretch;
|
|
//aFrxView.StretchMode := smMaxHeight;
|
|
//rxView.LineSpacing := aFrxView.LineSpacing +1;
|
|
//aFrxView.Height := aFrxView.CalcHeight;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
//aFrxView.Frame.ShadowColor := clBlack;//aFrxView.Frame.Color;
|
|
//aFrxView.Frame.ShadowWidth := aView.FrameWidth;
|
|
end;
|
|
|
|
//Procedure SetfrxShapeView(aNewShape: TfrxShapeView; aLine: TfrLineView );
|
|
Procedure SetfrxShapeView(aNewShape: TfrxShapeView; aLine: TfrLineView; aShift: Boolean);
|
|
var bit : TBitmap;
|
|
begin
|
|
aNewShape.CreateUniqueName;
|
|
aNewShape.Left := aLine.x;
|
|
|
|
//aNewShape.Top := aLine.y;
|
|
//aNewShape.Top := aLine.y + PageDeltaY;
|
|
if aShift then
|
|
aNewShape.Top := aLine.y + PageDeltaY
|
|
else
|
|
aNewShape.Top := aLine.y;
|
|
|
|
aNewShape.Width := aLine.dx;
|
|
aNewShape.Height := aLine.dy;
|
|
aNewShape.Frame.Width := aLine.FrameWidth;
|
|
if aNewShape.Width = 0 then
|
|
begin
|
|
aNewShape.Width := aLine.FrameWidth;
|
|
end;
|
|
if aNewShape.Height = 0 then
|
|
begin
|
|
aNewShape.Height := aLine.FrameWidth;
|
|
end;
|
|
aNewShape.Color := clBlack;
|
|
end;
|
|
|
|
//Procedure SetfrxLineView(aNewLine: TfrxPictureView; aLine: TfrLineView; aScale: Boolean);
|
|
Procedure SetfrxLineView(aNewLine: TfrxPictureView; aLine: TfrLineView; aScale, aShift: Boolean);
|
|
var bandAlign, FrameTyp: integer;
|
|
bit : TBitmap;
|
|
rect: TRect;
|
|
TempList: TList;
|
|
Oldx, oldY: integer;
|
|
begin
|
|
Try
|
|
aNewLine.CreateUniqueName;
|
|
|
|
aNewLine.Stretched := True;
|
|
|
|
//aNewLine.Top := aLine.y;
|
|
if aShift then
|
|
aNewLine.Top := aLine.y + PageDeltaY
|
|
else
|
|
aNewLine.Top := aLine.y;
|
|
|
|
//aNewLine.Left := aLine.x - CurrPageLeft;
|
|
aNewLine.Left := aLine.x;
|
|
aNewLine.Width := aLine.dx;
|
|
aNewLine.Height := aLine.dy;
|
|
aNewLine.Picture.Bitmap.width := aLine.dx;
|
|
aNewLine.Picture.Bitmap.height := aLine.dy;
|
|
|
|
bit := TBitmap.Create;
|
|
|
|
{bit.Height := aLine. Picture.Bitmap.Height;
|
|
bit.Width := aLine.Picture.Bitmap.Width;}
|
|
bit.Height := aLine.dy;
|
|
bit.Width := aLine.dx;
|
|
|
|
Bit.Canvas.Pen.Color := clBlack;
|
|
Bit.Canvas.MoveTo(0,0);
|
|
|
|
if bit.Height > bit.Width then
|
|
begin
|
|
//bit.Width := Round(aLine.FrameWidth) * 2;
|
|
bit.Width := Round(aLine.FrameWidth);
|
|
bit.Canvas.Pen.Width := bit.Width;
|
|
bit.Canvas.LineTo(0, bit.Height);
|
|
if aScale then
|
|
bit.Height := Round(bit.Height*aLine.ScaleY);
|
|
end
|
|
else
|
|
begin
|
|
//bit.Height := Round(aLine.FrameWidth) * 2;
|
|
bit.Height := Round(aLine.FrameWidth);
|
|
bit.Canvas.Pen.Width := bit.Height;
|
|
bit.Canvas.LineTo(bit.Width, 0);
|
|
if aScale then
|
|
bit.Width := Round(bit.Width*aLine.ScaleY);
|
|
end;
|
|
//bit.Canvas.Draw(0,0,aLine.Picture.Bitmap);
|
|
//Oldx := aLine.x;
|
|
//oldY := aLine.y;
|
|
{aLine.x := 0;
|
|
aLine.y := 0;
|
|
aLine.Draw(bit.Canvas);
|
|
aLine.x := OldX;
|
|
aLine.y := OldY;}
|
|
|
|
rect.Left := 0;
|
|
rect.Right := aLine.dx;
|
|
rect.Top := 0;
|
|
rect.Bottom := aLine.dy;
|
|
aNewLine.Width := bit.Width;
|
|
aNewLine.Height := bit.Height;
|
|
aNewLine.Width := bit.Width;
|
|
aNewLine.Height := bit.Height;
|
|
|
|
aNewLine.Picture.Bitmap.Width := bit.Width;
|
|
aNewLine.Picture.Bitmap.Height := bit.Height;
|
|
{
|
|
aNewLine.Picture.Bitmap.Width := bit.Width*6;
|
|
aNewLine.Picture.Bitmap.Height := bit.Height*6;
|
|
}
|
|
if bit.Height > bit.Width then
|
|
begin
|
|
//bit.Canvas.Pen.Width := bit.Width*6;
|
|
bit.Canvas.Pen.Width := bit.Width;
|
|
bit.Canvas.LineTo(0, bit.Height);
|
|
//aNewLine.Picture.Bitmap.Canvas.Pen.Width := bit.Width*6;
|
|
aNewLine.Picture.Bitmap.Canvas.Pen.Width := bit.Width;
|
|
aNewLine.Picture.Bitmap.Canvas.Pen.Color := clBlack;
|
|
aNewLine.Picture.Bitmap.Canvas.MoveTo(0,0);
|
|
aNewLine.Picture.Bitmap.Canvas.LineTo(0, bit.Height);
|
|
aNewLine.Left := aNewLine.Left;
|
|
end
|
|
else
|
|
begin
|
|
bit.Canvas.Pen.Width := bit.Height;
|
|
bit.Canvas.LineTo(bit.Width, 0);
|
|
|
|
//aNewLine.Picture.Bitmap.Canvas.Pen.Width := bit.Height*6;
|
|
aNewLine.Picture.Bitmap.Canvas.Pen.Width := bit.Height;
|
|
aNewLine.Picture.Bitmap.Canvas.Pen.Color := clBlack;
|
|
aNewLine.Picture.Bitmap.Canvas.MoveTo(0,0);
|
|
aNewLine.Picture.Bitmap.Canvas.LineTo(bit.Width, 0);
|
|
aNewLine.Top := aNewLine.Top;
|
|
end;
|
|
//aNewLine.Picture.Bitmap.Canvas.StretchDraw(rect, bit);
|
|
//aNewLine.Picture.Bitmap.Canvas.Draw(0,0,bit);
|
|
//aNewLine.Picture.Bitmap.Canvas.Draw(1,1,bit);
|
|
bit.Destroy;
|
|
//aNewLine.Frame.Style := 0;
|
|
|
|
{if (aLine.FrameTyp and frftRight) <> 0 then
|
|
aNewLine.Frame.Typ := aNewLine.Frame.Typ + [ftRight];
|
|
if (aLine.FrameTyp and frftBottom) <> 0 then
|
|
aNewLine.Frame.Typ := aNewLine.Frame.Typ + [ftBottom];
|
|
if (aLine.FrameTyp and frftLeft) <> 0 then
|
|
aNewLine.Frame.Typ := aNewLine.Frame.Typ + [ftLeft];
|
|
if (aLine.FrameTyp and frftTop) <> 0 then
|
|
aNewLine.Frame.Typ := aNewLine.Frame.Typ + [ftTop];
|
|
aNewLine.Frame.Width := aLine.FrameWidth;
|
|
aNewLine.Frame.Color := aLine.FrameColor;
|
|
aNewLine.Frame.Style := TfrxFrameStyle(aLine.FrameStyle);}
|
|
|
|
Except
|
|
on E:Exception do
|
|
ShowMessage('ExportLine Error! ' + aLine.Name);
|
|
End;
|
|
end;
|
|
|
|
Procedure ExportObj_X(var aPage: TfrxReportPage; var aLineList: TList; aObj: Pointer; var aMemoList: TStringList; var aMemoCounter: integer);
|
|
var NewMemo: TfrxMemoView;
|
|
NewLine: TfrxPictureView;
|
|
NewPict: TfrxPictureView;
|
|
begin
|
|
if TObject(aObj).ClassNAme = 'TfrMemoView' then
|
|
begin
|
|
|
|
if TfrMemoView(aObj).x > aPage.width then
|
|
exit;
|
|
|
|
if (TfrMemoView(aObj).x + TfrMemoView(aObj).dx) <= 72 then
|
|
if TfrMemoView(aObj).Memo.text = '' then
|
|
if TfrMemoView(aObj).FrameTyp = 0 then
|
|
exit;
|
|
|
|
if TfrMemoView(aObj).x <= 72 then
|
|
//if TfrMemoView(aObj).y < 100 then
|
|
if TfrMemoView(aObj).Memo.text = '' then
|
|
begin
|
|
if TfrMemoView(aObj).dx > 500 then
|
|
if TfrMemoView(aObj).y <= 40 then
|
|
if TfrMemoView(aObj).x <= 72 then
|
|
if Trim(TfrMemoView(aObj).Memo.Text) = '' then
|
|
begin
|
|
//PageDeltaY := PageDeltaY - TfrMemoView(p^.Page.Objects[j]).dy;
|
|
//PageDeltaY := PageDeltaY - TfrMemoView(aObj).dy;
|
|
exit;
|
|
end;
|
|
end;
|
|
if TfrMemoView(aObj).x <= 72 then
|
|
if TfrMemoView(aObj).y < 100 then
|
|
if TfrMemoView(aObj).Memo.text = '' then
|
|
if TfrMemoView(aObj).dx > 500 then
|
|
exit;
|
|
|
|
NewMemo := TfrxMemoView.Create(aPage);
|
|
NewMemo.Name := 'Memo' + inttostr(aMemoCounter);
|
|
inc(aMemoCounter);
|
|
//SetfrxView(NewMemo, TfrMemoView(aObj), aMemoList, false);
|
|
SetfrxView(NewMemo, TfrMemoView(aObj), aMemoList, True);
|
|
NewMemo.Memo.Text := trim(TfrMemoView(aObj).Memo.Text);
|
|
NewMemo.Memo.Text := trim(StringReplace(NewMemo.Memo.Text, #$1, '', [rfReplaceAll, rfIgnoreCase]));
|
|
end
|
|
else
|
|
if TObject(aObj).ClassName = 'TfrLineView' then
|
|
begin
|
|
NewLine := TfrxPictureView.Create(aPage);
|
|
//SetfrxLineView(NewLine, TfrLineView(p^.Page.Objects[j]), false, false);
|
|
//SetfrxLineView(NewLine, TfrLineView(aObj), false, true);
|
|
SetfrxLineView(NewLine, TfrLineView(aObj), true, true);
|
|
aLineList.Add(NewLine);
|
|
end
|
|
else
|
|
if TObject(aObj).ClassName = 'TfrPictureView' then
|
|
begin
|
|
NewPict := TfrxPictureView.Create(aPage);
|
|
//SetfrxPictView(NewPict, TfrPictureView(aObj), false);
|
|
SetfrxPictView(NewPict, TfrPictureView(aObj), True);
|
|
end;
|
|
end;
|
|
|
|
Procedure ExportObj_W(var aPage: TfrxReportPage; aObj: Pointer; var aMemoCounter: integer; var aDrawedObjects: Boolean);
|
|
var NewMemo: TfrxMemoView;
|
|
NewShape: TfrxShapeView;
|
|
NewPict: TfrxPictureView;
|
|
begin
|
|
if TObject(aObj).ClassNAme = 'TfrMemoView' then
|
|
begin
|
|
|
|
if (TfrMemoView(aObj).x + TfrMemoView(aObj).dx) <= 72 then
|
|
if TfrMemoView(aObj).Memo.text = '' then
|
|
if TfrMemoView(aObj).FrameTyp = 0 then
|
|
exit;
|
|
|
|
|
|
if ((TfrMemoView(aObj).x > aPage.width) or (TfrMemoView(aObj).x + TfrMemoView(aObj).dx > aPage.width)) then
|
|
Exit;
|
|
|
|
|
|
if TfrMemoView(aObj).x < 0 then
|
|
Exit;
|
|
|
|
if TfrMemoView(aObj).DX > 500 then
|
|
if TfrMemoView(aObj).x <= 72 then
|
|
if TfrMemoView(aObj).y < 100 then
|
|
if TfrMemoView(aObj).Memo.text = '' then
|
|
Exit;
|
|
|
|
if TfrMemoView(aObj).x <= 72 then
|
|
if TfrMemoView(aObj).y < 100 then
|
|
if (TfrMemoView(aObj).x + TfrMemoView(aObj).dx) <= 72 then
|
|
if TfrMemoView(aObj).Memo.Text = '' then
|
|
Exit;
|
|
|
|
|
|
NewMemo := TfrxMemoView.Create(aPage);
|
|
NewMemo.Name := 'Memo' + inttostr(aMemoCounter);
|
|
inc(aMemoCounter);
|
|
//NewMemo := TfrxMemoView.Create(nil);
|
|
SetfrxView_Word(NewMemo, TfrMemoView(aObj));
|
|
NewMemo.Memo.Text := trim(TfrMemoView(aObj).Memo.Text);
|
|
NewMemo.Memo.Text := trim(StringReplace(NewMemo.Memo.Text, #$1, '', [rfReplaceAll, rfIgnoreCase]));
|
|
end
|
|
else
|
|
if TObject(aObj).ClassName = 'TfrLineView' then
|
|
begin
|
|
NewShape := TfrxShapeView.Create(aPage);
|
|
SetfrxShapeView_Word(NewShape, TfrLineView((aObj)));
|
|
aDrawedObjects := True;
|
|
end
|
|
else
|
|
if TObject(aObj).ClassName = 'TfrPictureView' then
|
|
begin
|
|
NewPict := TfrxPictureView.Create(aPage);
|
|
SetfrxPictView_Word(NewPict, TfrPictureView(aObj));
|
|
end;
|
|
end;
|
|
// *********************************************************************************************************
|
|
|
|
Procedure ExportRepToDocX(aReport: tfrReport; aFileName: String);
|
|
var i, j, k, l: Integer;
|
|
Filter: TfrxXLSXExport;
|
|
FilterDoc: TfrxDOCXExport;
|
|
NewRep: TfrxReport;
|
|
t: TfrView;
|
|
p: PfrPageInfo;
|
|
b: Byte;
|
|
s, ss: string;
|
|
NewMemo: TfrxMemoView;
|
|
//NewLine: TfrxLineView;
|
|
NewPict, NewLine: TfrxPictureView;
|
|
aPreviewPages, TitulPreviewPages: TfrxPreviewPages;
|
|
NewShape: TfrxShapeView;
|
|
apage: TfrxReportPage;
|
|
//frXLSXExport: TfrXLSXExport;
|
|
frxXLSXExport: TfrxXLSXExport;
|
|
f: TextFile;
|
|
TempList: TList;
|
|
Stream: TMeMoryStream;
|
|
ExportStream: TFileStream;
|
|
WriteWithTitul: boolean;
|
|
MemoCounter: integer;
|
|
DrawedObjects: Boolean;
|
|
|
|
(* Procedure AssignPageProps(aFrxPage: TfrxReportPage; aFrPage: TfrPage);
|
|
begin
|
|
aFrxPage.Orientation := aFrPage.pgOr;
|
|
aFrxPage.PaperSize := aFrPage.pgSize;
|
|
// aFrxPage.PaperWidth := aFrPage.pgWidth;
|
|
// aFrxPage.PaperHeight := aFrPage.pgHeight;
|
|
// aFrxPage.Orientation := aFrPage.pgOr;
|
|
if not WriteWithTitul then
|
|
begin
|
|
aFrxPage.LeftMargin := Round(aFrPage.LeftMargin * 5)/18;
|
|
aFrxPage.RightMargin := aFrxPage.LeftMargin; //Round(aFrPage.RightMargin*5)/18;;
|
|
aFrxPage.TopMargin := Round(aFrPage.TopMargin*5)/18;
|
|
aFrxPage.BottomMargin := aFrxPage.TopMargin;//Round(aFrPage.BottomMargin*5)/18;
|
|
end
|
|
else
|
|
begin
|
|
aPage.LeftMargin := 5;
|
|
aPage.BottomMargin := 5;
|
|
aPage.TopMargin := 5;
|
|
aPage.RightMargin := 5;
|
|
end;
|
|
end;
|
|
|
|
Procedure SetfrxPictView(aNewPict: TfrxPictureView; aPict: TfrPictureView);
|
|
var
|
|
bit : TBitmap;
|
|
rect: TRect;
|
|
HalfPict, HalfBmp: Integer;
|
|
bandAlign: integer;
|
|
koef: Double;
|
|
begin
|
|
aNewPict.CreateUniqueName;
|
|
aNewPict.TransParent := True;
|
|
|
|
aNewPict.Top := aPict.y;
|
|
aNewPict.Left := aPict.x;
|
|
aNewPict.Width := aPict.dx;
|
|
aNewPict.Height := aPict.dy;
|
|
|
|
{ if aPict.Picture.Bitmap.Height > aNewPict.Height then
|
|
aNewPict.Height := aPict.Picture.Bitmap.Height;
|
|
|
|
if aPict.Picture.Bitmap.Width > aNewPict.Width then
|
|
aNewPict.Width := aPict.Picture.Bitmap.Width;}
|
|
|
|
{aNewPict.Picture.Bitmap.width := aPict.dx;
|
|
aNewPict.Picture.Bitmap.height := aPict.dy;}
|
|
|
|
aNewPict.Picture.Bitmap.width := Round(aNewPict.Width);
|
|
aNewPict.Picture.Bitmap.height := Round(aNewPict.Height);
|
|
|
|
aNewPict.Stretched := True;
|
|
|
|
HalfPict := Round(aPict.dx/2);
|
|
HalfBmp := Round(aPict.Picture.Bitmap.Width/2);
|
|
|
|
bit := TBitmap.Create;
|
|
|
|
//bit.Height := aPict.Picture.Bitmap.Height - 2;
|
|
bit.Height := aPict.Picture.Bitmap.Height;
|
|
bit.Width := aPict.Picture.Bitmap.Width;
|
|
|
|
if bit.Height > aPict.dy then
|
|
bit.Height := round(aPict.dy);
|
|
if bit.Width > aPict.dx then
|
|
bit.Width := aPict.dx;
|
|
|
|
|
|
|
|
//bit.Height := aPict.dy;
|
|
//bit.Width := aPict.dx;
|
|
|
|
if aPict.dy > aPict.Picture.Height then
|
|
begin
|
|
koef := aPict.dy / aPict.Picture.Height;
|
|
bit.width := Round(bit.width * koef);
|
|
bit.Height := Round(aPict.dy);
|
|
end;
|
|
|
|
Rect.Left := 0;
|
|
Rect.Top := 0;
|
|
//Rect.Right := aPict.dx;
|
|
//Rect.Bottom := aPict.dy;
|
|
Rect.Right := bit.Width;
|
|
Rect.Bottom := bit.Height;
|
|
|
|
//bit.Canvas.Draw(0,0,aPict.Picture.Bitmap);
|
|
bit.Canvas.StretchDraw(rect ,aPict.Picture.Bitmap);
|
|
|
|
|
|
Rect.Right := round(aNewPict.Width);
|
|
Rect.Bottom := round(aNewPict.Height);
|
|
|
|
aNewPict.Picture.BitMap.Canvas.Brush.Color := clWhite;
|
|
aNewPict.Picture.BitMap.Canvas.FillRect(rect);
|
|
|
|
//rect.Left := Round((HalfPict - HalfBmp) * aPict.ScaleX);
|
|
rect.Left := (HalfPict - HalfBmp);
|
|
//rect.Left := 0;
|
|
if rect.Left < 0 then
|
|
rect.Left := 0;
|
|
|
|
//rect.Right := Round((rect.Left + aPict.Picture.Bitmap.width) * aPict.ScaleX);
|
|
//rect.Right := (rect.Left + aPict.Picture.Bitmap.width);
|
|
rect.Right := rect.Left + Bit.width;
|
|
|
|
//rect.Right := aPict.Picture.Bitmap.width;
|
|
rect.Top := 0;
|
|
//rect.Bottom := Round(aPict.dy*aPict.ScaleY);
|
|
//rect.Bottom := aPict.dy;
|
|
rect.Bottom := bit.Height;
|
|
|
|
//aNewPict.Picture.Bitmap.Canvas.StretchDraw(rect, bit);
|
|
aNewPict.Picture.Bitmap.Canvas.Draw(rect.Left, Rect.Top, bit);
|
|
|
|
bit.Destroy;
|
|
|
|
if (aPict.FrameTyp and frftRight) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftRight];
|
|
if (aPict.FrameTyp and frftBottom) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftBottom];
|
|
if (aPict.FrameTyp and frftLeft) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftLeft];
|
|
if (aPict.FrameTyp and frftTop) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftTop];
|
|
aNewPict.Frame.Width := aPict.FrameWidth;
|
|
aNewPict.Frame.Color := aPict.FrameColor;
|
|
aNewPict.Frame.Style := TfrxFrameStyle(aPict.FrameStyle);
|
|
//aNewPict.isText := False;
|
|
aNewPict.Color := aPict.FillColor;
|
|
|
|
{ bandAlign := aPict.BandAlign;
|
|
if BandAlign = 6 then
|
|
BandAlign := 0;
|
|
if BandAlign = 7 then
|
|
BandAlign := 6;
|
|
aNewPict.Align := TfrxAlign(BandAlign);}
|
|
// aNewPict.Align := baCenter;
|
|
// aNewPict.Center := true;
|
|
aNewPict.TagStr := aPict.Tag;
|
|
{
|
|
if (aPict.Alignment and frtaRight) <> 0 then
|
|
aNewPict.HAlign := haRight;
|
|
if (aPict.Alignment and frtaCenter) <> 0 then
|
|
aNewPict.HAlign := haCenter;
|
|
if (aPict.Alignment and 3) = 3 then
|
|
aNewPict.HAlign := haBlock;
|
|
if (aPict.Alignment and frtaVertical) <> 0 then
|
|
aNewPict.Rotation := 90;
|
|
if (aPict.Alignment and frtaMiddle) <> 0 then
|
|
aNewPict.VAlign := vaCenter;
|
|
if (aPict.Alignment and frtaDown) <> 0 then
|
|
aNewPict.VAlign := vaBottom;
|
|
}
|
|
end;
|
|
{ Procedure SetfrxPictView(aNewPict: TfrxPictureView; aPict: TfrPictureView);
|
|
var
|
|
bit : TBitmap;
|
|
rect: TRect;
|
|
HalfPict, HalfBmp: Integer;
|
|
begin
|
|
aNewPict.CreateUniqueName;
|
|
aNewPict.Top := aPict.y;
|
|
aNewPict.Left := aPict.x;
|
|
aNewPict.Width := aPict.dx;
|
|
aNewPict.Height := aPict.dy;
|
|
aNewPict.Picture.Bitmap.width := aPict.dx;
|
|
aNewPict.Picture.Bitmap.height := aPict.dy;
|
|
|
|
bit := TBitmap.Create;
|
|
bit.Height := aPict.Picture.Bitmap.Height;
|
|
bit.Width := aPict.Picture.Bitmap.Width;
|
|
bit.Height := aPict.dy;
|
|
bit.Width := aPict.dx;
|
|
|
|
bit.Canvas.Draw(0,0,aPict.Picture.Bitmap);
|
|
|
|
rect.Left := 0;
|
|
if rect.Left < 0 then
|
|
rect.Left := 0;
|
|
|
|
rect.Right := aPict.Picture.Bitmap.width;
|
|
rect.Top := 0;
|
|
rect.Bottom := aPict.dy;
|
|
aNewPict.Picture.Bitmap.Canvas.StretchDraw(rect, bit);
|
|
|
|
bit.Destroy;
|
|
|
|
if (aPict.FrameTyp and frftRight) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftRight];
|
|
if (aPict.FrameTyp and frftBottom) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftBottom];
|
|
if (aPict.FrameTyp and frftLeft) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftLeft];
|
|
if (aPict.FrameTyp and frftTop) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftTop];
|
|
aNewPict.Frame.Width := aPict.FrameWidth;
|
|
aNewPict.Frame.Color := aPict.FrameColor;
|
|
aNewPict.Frame.Style := TfrxFrameStyle(aPict.FrameStyle);
|
|
//aNewPict.isText := False;
|
|
aNewPict.Color := aPict.FillColor;
|
|
end; }
|
|
|
|
procedure SetfrxView(aFrxView: TfrxMemoView; aView: TfrMemoView);
|
|
var bandAlign: integer;
|
|
begin
|
|
aFrxView.CreateUniqueName;
|
|
|
|
if (aView.FrameTyp and frftRight) <> 0 then
|
|
aFrxView.Frame.Typ := aFrxView.Frame.Typ + [ftRight];
|
|
if (aView.FrameTyp and frftBottom) <> 0 then
|
|
aFrxView.Frame.Typ := aFrxView.Frame.Typ + [ftBottom];
|
|
if (aView.FrameTyp and frftLeft) <> 0 then
|
|
aFrxView.Frame.Typ := aFrxView.Frame.Typ + [ftLeft];
|
|
if (aView.FrameTyp and frftTop) <> 0 then
|
|
aFrxView.Frame.Typ := aFrxView.Frame.Typ + [ftTop];
|
|
|
|
aFrxView.Frame.Width := aView.FrameWidth;
|
|
aFrxView.Frame.Color := aView.FrameColor;
|
|
aFrxView.Frame.Style := TfrxFrameStyle(aView.FrameStyle);
|
|
aFrxView.Color := aView.FillColor;
|
|
aFrxView.Font := aView.Font;
|
|
aFrxView.Top := aView.y;
|
|
aFrxView.Left := aView.x;
|
|
aFrxView.Width := aView.dx;
|
|
aFrxView.Height := aView.dy;
|
|
aFrxView.Frame.ShadowColor := clBlack;//aFrxView.Frame.Color;
|
|
aFrxView.Frame.ShadowWidth := aView.FrameWidth;
|
|
aFrxView.Frame.DropShadow := False;
|
|
|
|
aFrxView.GapX := aView.GapX;
|
|
aFrxView.Gapy := aView.GapY;
|
|
|
|
aFrxView.LineSpacing := aView.LineSpacing;
|
|
aFrxView.CharSpacing := aView.CharacterSpacing;
|
|
|
|
if (aView.Alignment and frtaRight) <> 0 then
|
|
aFrxView.HAlign := haRight;
|
|
if (aView.Alignment and frtaCenter) <> 0 then
|
|
aFrxView.HAlign := haCenter;
|
|
if (aView.Alignment and 3) = 3 then
|
|
aFrxView.HAlign := haBlock;
|
|
if (aView.Alignment and frtaVertical) <> 0 then
|
|
aFrxView.Rotation := 90;
|
|
if (aView.Alignment and frtaMiddle) <> 0 then
|
|
aFrxView.VAlign := vaCenter;
|
|
if (aView.Alignment and frtaDown) <> 0 then
|
|
aFrxView.VAlign := vaBottom;
|
|
|
|
aFrxView.StretchMode := smDontStretch;
|
|
aFrxView.WordWrap := (aView.Flags and flWordWrap) <> 0;
|
|
aFrxView.WordBreak := (aView.Flags and flWordBreak) <> 0;
|
|
aFrxView.AutoWidth := (aView.Flags and flAutoSize) <> 0;
|
|
aFrxView.AllowExpressions := (aView.Flags and flTextOnly) = 0;
|
|
aFrxView.SuppressRepeated := (aView.Flags and flSuppressRepeated) <> 0;
|
|
aFrxView.HideZeros := (aView.Flags and flHideZeros) <> 0;
|
|
aFrxView.Underlines := (aView.Flags and flUnderlines) <> 0;
|
|
aFrxView.RTLReading := (aView.Flags and flRTLReading) <> 0;
|
|
aFrxView.AutoWidth := False;
|
|
bandAlign := aView.BandAlign;
|
|
if BandAlign = 6 then
|
|
BandAlign := 0;
|
|
if BandAlign = 7 then
|
|
BandAlign := 6;
|
|
aFrxView.Align := TfrxAlign(BandAlign);
|
|
aFrxView.TagStr := aView.Tag;
|
|
|
|
if aFrxView.Frame.Width > 1 then
|
|
aFrxView.Frame.Typ := aFrxView.Frame.Typ - [ftRight];
|
|
end;
|
|
|
|
Procedure SetfrxShapeView(aNewShape: TfrxShapeView; aLine: TfrLineView);
|
|
var bit : TBitmap;
|
|
begin
|
|
aNewShape.CreateUniqueName;
|
|
aNewShape.Left := aLine.x;
|
|
aNewShape.Top := aLine.y;
|
|
aNewShape.Width := aLine.dx;
|
|
aNewShape.Height := aLine.dy;
|
|
aNewShape.Frame.Width := aLine.FrameWidth;
|
|
if aNewShape.Width = 0 then
|
|
begin
|
|
aNewShape.Width := aLine.FrameWidth;
|
|
end;
|
|
if aNewShape.Height = 0 then
|
|
begin
|
|
aNewShape.Height := aLine.FrameWidth;
|
|
end;
|
|
aNewShape.Color := clBlack;
|
|
end;
|
|
|
|
Procedure SetfrxLineView(aNewLine: TfrxPictureView; aLine: TfrLineView; aScale: Boolean);
|
|
var bandAlign, FrameTyp: integer;
|
|
bit : TBitmap;
|
|
rect: TRect;
|
|
TempList: TList;
|
|
Oldx, oldY: integer;
|
|
begin
|
|
Try
|
|
aNewLine.Top := aLine.y;
|
|
aNewLine.Left := aLine.x;
|
|
aNewLine.Width := aLine.dx;
|
|
aNewLine.Height := aLine.dy;
|
|
aNewLine.Picture.Bitmap.width := aLine.dx;
|
|
aNewLine.Picture.Bitmap.height := aLine.dy;
|
|
|
|
bit := TBitmap.Create;
|
|
|
|
bit.Height := aLine.dy;
|
|
bit.Width := aLine.dx;
|
|
|
|
Bit.Canvas.Pen.Color := clBlack;
|
|
Bit.Canvas.MoveTo(0,0);
|
|
|
|
if bit.Height > bit.Width then
|
|
begin
|
|
bit.Width := Round(aLine.FrameWidth);
|
|
bit.Canvas.Pen.Width := bit.Width;
|
|
bit.Canvas.LineTo(0, bit.Height);
|
|
if aScale then
|
|
bit.Height := Round(bit.Height*aLine.ScaleY);
|
|
//aNewLine.Left := aNewLine.Left - 2;
|
|
end
|
|
else
|
|
begin
|
|
bit.Height := Round(aLine.FrameWidth);
|
|
bit.Canvas.Pen.Width := bit.Height;
|
|
bit.Canvas.LineTo(bit.Width, 0);
|
|
if aScale then
|
|
bit.Width := Round(bit.Width*aLine.ScaleY);
|
|
end;
|
|
|
|
rect.Left := 0;
|
|
rect.Right := aLine.dx;
|
|
rect.Top := 0;
|
|
rect.Bottom := aLine.dy;
|
|
aNewLine.Width := bit.Width;
|
|
aNewLine.Height := bit.Height;
|
|
aNewLine.Width := bit.Width;
|
|
aNewLine.Height := bit.Height;
|
|
aNewLine.Picture.Bitmap.Width := bit.Width;
|
|
aNewLine.Picture.Bitmap.Height := bit.Height;
|
|
|
|
aNewLine.Picture.Bitmap.Canvas.Draw(0,0,bit);
|
|
bit.Destroy;
|
|
|
|
Except
|
|
on E:Exception do
|
|
ShowMessage('ExportLine Error! ' + aLine.Name);
|
|
End;
|
|
end;
|
|
|
|
Procedure ClearText(aRep: TfrxReport);
|
|
var RPage: TfrxPage;
|
|
i, j: Integer;
|
|
begin
|
|
for i := 0 to aRep.PagesCount - 1 do
|
|
begin
|
|
RPage := aRep.Pages[i];
|
|
for j := 0 to RPage.Objects.Count - 1 do
|
|
begin
|
|
if TObject(RPage.Objects[j]).ClassName = 'TfrxMemoView' then
|
|
TfrxMemoView(RPage.Objects[j]).Memo.Text := ''
|
|
end;
|
|
end;
|
|
end;
|
|
*)
|
|
begin
|
|
/////////////////////////// MS WORD /////////////////////////////////////////////
|
|
MemoCounter := 1;
|
|
DrawedObjects := False;
|
|
PageDeltaY := 0;
|
|
try
|
|
TitulPreviewPages := nil;
|
|
WriteWithTitul := false;
|
|
ss := aFileName;
|
|
|
|
if aReport.Preview <> nil then
|
|
begin
|
|
NewRep := TfrxReport.Create(nil);
|
|
|
|
{for i := 0 to TfrEMFPages(aReport.Preview.Window.EMFPages).Count - 1 do
|
|
TfrEMFPages(aReport.Preview.Window.EMFPages).Pages[i]^.Visible := True;}
|
|
|
|
if TfrEMFPages(aReport.Preview.Window.EMFPages).Count > 1 then
|
|
if (TfrEMFPages(aReport.Preview.Window.EMFPages).Pages[0]^.pgOr <> TfrEMFPages(aReport.Preview.Window.EMFPages).Pages[1]^.pgOr) then
|
|
WriteWithTitul := True;
|
|
|
|
// --------------------- MS WORD -----------------------------------------------------
|
|
if WriteWithTitul then
|
|
k := 1
|
|
else
|
|
k := 0;
|
|
|
|
NewRep := TfrxReport.Create(nil);
|
|
|
|
if WriteWithTitul then
|
|
begin
|
|
FilterDoc := TfrxDOCXExport.create(NewRep);
|
|
|
|
TitulPreviewPages := TfrxPreviewPages.Create(NewRep);
|
|
TitulPreviewPages.Engine := NewRep.Engine;
|
|
|
|
p := TfrEMFPages(aReport.Preview.Window.EMFPages).Pages[0];
|
|
if not Assigned(p^.Page) then
|
|
TfrEMFPages(aReport.Preview.Window.EMFPages).ObjectsToPage(0);
|
|
|
|
aPage := TfrxReportPage.Create(NewRep);
|
|
|
|
AssignPageProps_Word(aPage, p^.Page, WriteWithTitul);
|
|
for j := 0 to p^.Page.Objects.Count - 1 do
|
|
begin
|
|
if TObject(p^.Page.Objects[j]).ClassNAme = 'TfrMemoView' then
|
|
begin
|
|
if TfrMemoView(p^.Page.Objects[j]).x < 72 then
|
|
if TfrMemoView(p^.Page.Objects[j]).y < 100 then
|
|
if TfrMemoView(p^.Page.Objects[j]).Memo.text = '' then
|
|
continue;
|
|
|
|
NewMemo := TfrxMemoView.Create(aPage);
|
|
//NewMemo := TfrxMemoView.Create(nil);
|
|
NewMemo.Name := 'Memo' + inttostr(MemoCounter);
|
|
Inc(MemoCounter);
|
|
SetfrxView_Word(NewMemo, TfrMemoView(p^.Page.Objects[j]));
|
|
NewMemo.Memo.Text := trim(TfrMemoView(p^.Page.Objects[j]).Memo.Text);
|
|
NewMemo.Memo.Text := trim(StringReplace(NewMemo.Memo.Text, #$1, '', [rfReplaceAll, rfIgnoreCase]));
|
|
end
|
|
else
|
|
if TObject(p^.Page.Objects[j]).ClassName = 'TfrLineView' then
|
|
begin
|
|
NewShape := TfrxShapeView.Create(aPage);
|
|
SetfrxShapeView_Word(NewShape, TfrLineView((p^.Page.Objects[j])));
|
|
end
|
|
else
|
|
if TObject(p^.Page.Objects[j]).ClassName = 'TfrPictureView' then
|
|
begin
|
|
NewPict := TfrxPictureView.Create(aPage);
|
|
SetfrxPictView_Word(NewPict, TfrPictureView(p^.Page.Objects[j]));
|
|
end;
|
|
end;
|
|
aPage.LeftMargin := 5;
|
|
aPage.TopMargin := 5;
|
|
aPage.RightMargin := 5;
|
|
aPage.BottomMargin := 5;
|
|
|
|
TitulPreviewPages.AddPage(aPage);
|
|
TitulPreviewPages.PageCache.AddObject('0', aPage);
|
|
FilterDoc.FileName := aFileName;
|
|
{s := aFileName;
|
|
s := StringReplace(s,'.xlsx','',[rfReplaceAll, rfIgnoreCase]);
|
|
s := s + '_Titul' + '.Docx';
|
|
FilterDoc.FileName := s;}
|
|
|
|
s := aFileName;
|
|
s := StringReplace(s,'.Docx','_Titul.Docx',[rfReplaceAll, rfIgnoreCase]);
|
|
//s := s + '_Titul' + '.Docx';
|
|
FilterDoc.FileName := s;
|
|
|
|
FilterDoc.ShowDialog := False;
|
|
//FilterDoc.showProgress := False;
|
|
FilterDoc.showProgress := True;
|
|
|
|
tempList := TList.Create;
|
|
for j := 0 to TitulPreviewPages.Count - 1 do
|
|
begin
|
|
aPage := TitulPreviewPages.Page[j];
|
|
for l := 0 to aPage.Objects.Count - 1 do
|
|
begin
|
|
if (TObject(aPage.Objects[k]) is TfrxShapeView) then
|
|
begin
|
|
TempList.Add(aPage.Objects[l]);
|
|
aPage.Objects[l] := nil;
|
|
end;
|
|
end;
|
|
aPage.Objects.Pack;
|
|
|
|
for l := 0 to TempList.Count - 1 do
|
|
aPage.Objects.Add(TempList[l]);
|
|
TempList.Clear;
|
|
end;
|
|
FreeAndNil(TempList);
|
|
|
|
TitulPreviewPages.Export(FilterDoc);
|
|
FilterDoc.Free;
|
|
NewRep.Free;
|
|
NewRep := TfrxReport.Create(nil);
|
|
end;
|
|
|
|
FilterDoc := TfrxDOCXExport.create(NewRep);
|
|
{s := aFileName;
|
|
i := Length(s);
|
|
s[i - 3] := 'd';
|
|
s[i - 2] := 'o';
|
|
s[i - 1] := 'c';
|
|
s[i] := 'x';}
|
|
|
|
//FilterDoc.FileName := aFileName;
|
|
FilterDoc.FileName := ss;
|
|
|
|
FilterDoc.ShowDialog := False;
|
|
FilterDoc.showProgress := False;
|
|
|
|
aPreviewPages := TfrxPreviewPages.Create(NewRep);
|
|
aPreviewPages.Engine := NewRep.Engine;
|
|
|
|
for i := k to TfrEMFPages(aReport.Preview.Window.EMFPages).Count - 1 do
|
|
TfrEMFPages(aReport.Preview.Window.EMFPages).Pages[i]^.Visible := True;
|
|
for i := k to TfrEMFPages(aReport.Preview.Window.EMFPages).Count - 1 do
|
|
begin
|
|
p := TfrEMFPages(aReport.Preview.Window.EMFPages).Pages[i];
|
|
begin
|
|
if not Assigned(p^.Page) then
|
|
TfrEMFPages(aReport.Preview.Window.EMFPages).ObjectsToPage(i);
|
|
|
|
begin
|
|
aPage := TfrxReportPage.Create(NewRep);
|
|
aPage.Frame.Width := 0;
|
|
PageDeltaY := 0;
|
|
AssignPageProps(aPage, p^.Page, WriteWithTitul);
|
|
PageDeltaY := GetPageDeltaY(p^.Page);
|
|
|
|
if k > 0 then
|
|
AssignPageProps_Word(aPage, p^.Page, WriteWithTitul, i > 1)
|
|
else
|
|
AssignPageProps_Word(aPage, p^.Page, WriteWithTitul, i > 0);
|
|
|
|
for j := 0 to p^.Page.Objects.Count - 1 do
|
|
begin
|
|
ExportObj_W(aPage, p^.Page.Objects[j], MemoCounter, DrawedObjects);
|
|
(*
|
|
if TObject(p^.Page.Objects[j]).ClassNAme = 'TfrMemoView' then
|
|
begin
|
|
if ((TfrMemoView(p^.Page.Objects[j]).x > aPage.width) or (TfrMemoView(p^.Page.Objects[j]).x + TfrMemoView(p^.Page.Objects[j]).dx > aPage.width)) then
|
|
begin
|
|
k := k;
|
|
continue;
|
|
end;
|
|
|
|
if TfrMemoView(p^.Page.Objects[j]).x < 0 then
|
|
continue;
|
|
|
|
if TfrMemoView(p^.Page.Objects[j]).DX > 500 then
|
|
if TfrMemoView(p^.Page.Objects[j]).x <= 72 then
|
|
if TfrMemoView(p^.Page.Objects[j]).y < 100 then
|
|
if TfrMemoView(p^.Page.Objects[j]).Memo.text = '' then
|
|
continue;
|
|
|
|
if TfrMemoView(p^.Page.Objects[j]).x <= 72 then
|
|
if TfrMemoView(p^.Page.Objects[j]).y < 100 then
|
|
if (TfrMemoView(p^.Page.Objects[j]).x + TfrMemoView(p^.Page.Objects[j]).dx) <= 72 then
|
|
if TfrMemoView(p^.Page.Objects[j]).MeMo.Text = '' then
|
|
continue;
|
|
|
|
|
|
|
|
|
|
{if TfrMemoView(p^.Page.Objects[j]).x < 72 then
|
|
if TfrMemoView(p^.Page.Objects[j]).y < 100 then
|
|
if TfrMemoView(p^.Page.Objects[j]).Memo.text = '' then
|
|
continue;}
|
|
|
|
NewMemo := TfrxMemoView.Create(aPage);
|
|
NewMemo.Name := 'Memo' + inttostr(MemoCounter);
|
|
inc(MemoCounter);
|
|
//NewMemo := TfrxMemoView.Create(nil);
|
|
SetfrxView_Word(NewMemo, TfrMemoView(p^.Page.Objects[j]));
|
|
NewMemo.Memo.Text := trim(TfrMemoView(p^.Page.Objects[j]).Memo.Text);
|
|
NewMemo.Memo.Text := trim(StringReplace(NewMemo.Memo.Text, #$1, '', [rfReplaceAll, rfIgnoreCase]));
|
|
|
|
{NewMemo := TfrxMemoView.Create(aPage);
|
|
//NewMemo := TfrxMemoView.Create(nil);
|
|
SetfrxView_word(NewMemo, TfrMemoView(p^.Page.Objects[j]));
|
|
NewMemo.Memo.Text := trim(TfrMemoView(p^.Page.Objects[j]).Memo.Text);
|
|
NewMemo.Memo.Text := trim(StringReplace(NewMemo.Memo.Text, #$1, '', [rfReplaceAll, rfIgnoreCase]));}
|
|
end
|
|
else
|
|
if TObject(p^.Page.Objects[j]).ClassName = 'TfrLineView' then
|
|
begin
|
|
NewShape := TfrxShapeView.Create(aPage);
|
|
SetfrxShapeView_word(NewShape, TfrLineView((p^.Page.Objects[j])));
|
|
end
|
|
else
|
|
if TObject(p^.Page.Objects[j]).ClassName = 'TfrPictureView' then
|
|
begin
|
|
NewPict := TfrxPictureView.Create(aPage);
|
|
SetfrxPictView_word(NewPict, TfrPictureView(p^.Page.Objects[j]));
|
|
end;
|
|
*)
|
|
end;
|
|
end;
|
|
end;
|
|
aPreviewPages.AddPage(aPage);
|
|
if WriteWithTitul then
|
|
aPreviewPages.PageCache.AddObject(inttostr(i - 1), aPage)
|
|
else
|
|
aPreviewPages.PageCache.AddObject(inttostr(i), aPage);
|
|
end;
|
|
|
|
tempList := TList.Create;
|
|
for j := 0 to aPreviewPages.Count - 1 do
|
|
begin
|
|
aPage := aPreviewPages.Page[j];
|
|
for k := 0 to aPage.Objects.Count - 1 do
|
|
begin
|
|
if (TObject(aPage.Objects[k]) is TfrxShapeView) then
|
|
begin
|
|
TempList.Add(aPage.Objects[k]);
|
|
aPage.Objects[k] := nil;
|
|
end;
|
|
end;
|
|
aPage.Objects.Pack;
|
|
|
|
for k := 0 to TempList.Count - 1 do
|
|
aPage.Objects.Add(TempList[k]);
|
|
TempList.Clear;
|
|
end;
|
|
FreeAndNil(TempList);
|
|
FilterDoc.OpenAfterExport := true;
|
|
aPreviewPages.Export(FilterDoc);
|
|
FilterDoc.Free;
|
|
NewRep.Free;
|
|
end;
|
|
//Ïåðåêîííåêòèòü ôîðìó, ÷òîáû íå áûëî îøèáîê ïðè ñêðîëëå ìûøêîé íà ôîðìå îò÷åòà
|
|
aReport.Preview.DisConnect;
|
|
aReport.Preview.Connect(aReport);
|
|
except
|
|
on E: Exception do
|
|
ShowMessage('Export Error!');
|
|
end;
|
|
end;
|
|
|
|
Procedure ExportRepToXLSX(aReport: tfrReport; aFileName: String);
|
|
var i, j, k,l: Integer;
|
|
Filter: TfrxXLSXExport;
|
|
FilterDoc: TfrxDOCXExport;
|
|
NewRep: TfrxReport;
|
|
t: TfrView;
|
|
p: PfrPageInfo;
|
|
b: Byte;
|
|
s: string;
|
|
NewMemo: TfrxMemoView;
|
|
//NewLine: TfrxLineView;
|
|
NewPict, NewLine: TfrxPictureView;
|
|
aPreviewPages, TitulPreviewPages: TfrxPreviewPages;
|
|
NewShape: TfrxShapeView;
|
|
apage: TfrxReportPage;
|
|
//frXLSXExport: TfrXLSXExport;
|
|
frxXLSXExport: TfrxXLSXExport;
|
|
f: TextFile;
|
|
TempList: TList;
|
|
Stream: TMeMoryStream;
|
|
ExportStream: TFileStream;
|
|
WriteWithTitul: boolean;
|
|
LineList: TList;
|
|
MemoList: TStringList;
|
|
MemoCounter: integer;
|
|
ObjList: TList;
|
|
CreatedPage: Boolean;
|
|
|
|
(* Procedure AssignPageProps(aFrxPage: TfrxReportPage; aFrPage: TfrPage);
|
|
begin
|
|
aFrxPage.Orientation := aFrPage.pgOr;
|
|
aFrxPage.PaperSize := aFrPage.pgSize;
|
|
//aFrxPage.PaperWidth := aFrPage.pgWidth;
|
|
// aFrxPage.PaperHeight := aFrPage.pgHeight;
|
|
// aFrxPage.Orientation := aFrPage.pgOr;
|
|
if not WriteWithTitul then
|
|
begin
|
|
aFrxPage.LeftMargin := Round(aFrPage.LeftMargin * 5)/18;
|
|
// aFrxPage.RightMargin := aFrxPage.LeftMargin; //Round(aFrPage.RightMargin*5)/18;;
|
|
// aFrxPage.RightMargin := Round(aFrPage.RightMargin*5)/18;;
|
|
aFrxPage.TopMargin := Round(aFrPage.TopMargin*5)/18;
|
|
//aFrxPage.BottomMargin := aFrxPage.TopMargin;//Round(aFrPage.BottomMargin*5)/18;
|
|
//aFrxPage.BottomMargin := Round(aFrPage.BottomMargin*5)/18;
|
|
end
|
|
else
|
|
begin
|
|
aPage.LeftMargin := 5;
|
|
// aPage.BottomMargin := 5;
|
|
// aPage.TopMargin := 5;
|
|
// aPage.RightMargin := 5;
|
|
end;
|
|
end;
|
|
|
|
(* Procedure SetfrxPictView(aNewPict: TfrxPictureView; aPict: TfrPictureView);
|
|
var
|
|
bit : TBitmap;
|
|
rect: TRect;
|
|
HalfPict, HalfBmp: Integer;
|
|
begin
|
|
aNewPict.Top := aPict.y;
|
|
aNewPict.Left := aPict.x;
|
|
aNewPict.Width := aPict.dx;
|
|
aNewPict.Height := aPict.dy;
|
|
aNewPict.Picture.Bitmap.width := aPict.dx;
|
|
aNewPict.Picture.Bitmap.height := aPict.dy;
|
|
|
|
HalfPict := Round(aPict.dx/2);
|
|
HalfBmp := Round(aPict.Picture.Bitmap.Width/2);
|
|
|
|
bit := TBitmap.Create;
|
|
bit.Height := aPict.Picture.Bitmap.Height;
|
|
bit.Width := aPict.Picture.Bitmap.Width;
|
|
bit.Height := aPict.dy;
|
|
bit.Width := aPict.dx;
|
|
|
|
bit.Canvas.Draw(0,0,aPict.Picture.Bitmap);
|
|
|
|
rect.Left := HalfPict - HalfBmp;
|
|
if rect.Left < 0 then
|
|
rect.Left := 0;
|
|
|
|
rect.Right := rect.Left + aPict.Picture.Bitmap.width;
|
|
rect.Top := 1;
|
|
rect.Bottom := aPict.dy - 1;
|
|
aNewPict.Picture.Bitmap.Canvas.StretchDraw(rect, bit);
|
|
|
|
bit.Destroy;
|
|
|
|
if (aPict.FrameTyp and frftRight) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftRight];
|
|
if (aPict.FrameTyp and frftBottom) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftBottom];
|
|
if (aPict.FrameTyp and frftLeft) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftLeft];
|
|
if (aPict.FrameTyp and frftTop) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftTop];
|
|
aNewPict.Frame.Width := aPict.FrameWidth;
|
|
aNewPict.Frame.Color := aPict.FrameColor;
|
|
aNewPict.Frame.Style := TfrxFrameStyle(aPict.FrameStyle);
|
|
|
|
//aNewPict.Color := aPict.FillColor;
|
|
|
|
end;*)
|
|
|
|
(* Procedure SetfrxPictView(aNewPict: TfrxPictureView; aPict: TfrPictureView);
|
|
var
|
|
bit : TBitmap;
|
|
rect: TRect;
|
|
HalfPict, HalfBmp: Integer;
|
|
begin
|
|
aNewPict.CreateUniqueName;
|
|
aNewPict.TransParent := True;
|
|
|
|
aNewPict.Top := aPict.y;
|
|
aNewPict.Left := aPict.x;
|
|
aNewPict.Width := aPict.dx;
|
|
aNewPict.Height := aPict.dy;
|
|
aNewPict.Picture.Bitmap.width := aPict.dx;
|
|
aNewPict.Picture.Bitmap.height := aPict.dy;
|
|
|
|
HalfPict := Round(aPict.dx/2);
|
|
HalfBmp := Round(aPict.Picture.Bitmap.Width/2);
|
|
|
|
bit := TBitmap.Create;
|
|
bit.Height := aPict.Picture.Bitmap.Height;
|
|
bit.Width := aPict.Picture.Bitmap.Width;
|
|
//bit.Height := aPict.dy;
|
|
//bit.Width := aPict.dx;
|
|
|
|
bit.Canvas.Draw(0,0,aPict.Picture.Bitmap);
|
|
|
|
rect.Left := HalfPict - HalfBmp;
|
|
//rect.Left := 0;
|
|
if rect.Left < 0 then
|
|
rect.Left := 0;
|
|
|
|
rect.Right := rect.Left + aPict.Picture.Bitmap.width;
|
|
//rect.Right := aPict.Picture.Bitmap.width;
|
|
rect.Top := 0;
|
|
rect.Bottom := aPict.dy;
|
|
aNewPict.Picture.Bitmap.Canvas.StretchDraw(rect, bit);
|
|
|
|
bit.Destroy;
|
|
|
|
if (aPict.FrameTyp and frftRight) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftRight];
|
|
if (aPict.FrameTyp and frftBottom) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftBottom];
|
|
if (aPict.FrameTyp and frftLeft) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftLeft];
|
|
if (aPict.FrameTyp and frftTop) <> 0 then
|
|
aNewPict.Frame.Typ := aNewPict.Frame.Typ + [ftTop];
|
|
aNewPict.Frame.Width := aPict.FrameWidth;
|
|
aNewPict.Frame.Color := aPict.FrameColor;
|
|
aNewPict.Frame.Style := TfrxFrameStyle(aPict.FrameStyle);
|
|
//aNewPict.isText := False;
|
|
aNewPict.Color := aPict.FillColor;
|
|
end;
|
|
|
|
procedure SetfrxView(aFrxView: TfrxMemoView; aView: TfrMemoView);
|
|
var bandAlign: integer;
|
|
begin
|
|
aFrxView.CreateUniqueName;
|
|
|
|
if (aView.FrameTyp and frftRight) <> 0 then
|
|
aFrxView.Frame.Typ := aFrxView.Frame.Typ + [ftRight];
|
|
if (aView.FrameTyp and frftBottom) <> 0 then
|
|
aFrxView.Frame.Typ := aFrxView.Frame.Typ + [ftBottom];
|
|
if (aView.FrameTyp and frftLeft) <> 0 then
|
|
aFrxView.Frame.Typ := aFrxView.Frame.Typ + [ftLeft];
|
|
if (aView.FrameTyp and frftTop) <> 0 then
|
|
aFrxView.Frame.Typ := aFrxView.Frame.Typ + [ftTop];
|
|
|
|
aFrxView.Frame.Width := aView.FrameWidth;
|
|
aFrxView.Frame.Color := aView.FrameColor;
|
|
aFrxView.Frame.Style := TfrxFrameStyle(aView.FrameStyle);
|
|
aFrxView.Color := aView.FillColor;
|
|
aFrxView.Font := aView.Font;
|
|
aFrxView.Top := aView.y;
|
|
aFrxView.Left := aView.x;
|
|
aFrxView.Width := aView.dx;
|
|
aFrxView.Height := aView.dy;
|
|
aFrxView.Frame.ShadowColor := clBlack;//aFrxView.Frame.Color;
|
|
aFrxView.Frame.ShadowWidth := aView.FrameWidth;
|
|
aFrxView.Frame.DropShadow := False;
|
|
|
|
//aFrxView.Frame.TopLine.Width := 1;
|
|
//aFrxView.Frame.TopLine.Width := aView.FrameWidth;
|
|
//aFrxView.Frame.ShadowWidth := 0;
|
|
|
|
aFrxView.GapX := aView.GapX;
|
|
aFrxView.Gapy := aView.GapY;
|
|
|
|
aFrxView.LineSpacing := aView.LineSpacing;
|
|
aFrxView.CharSpacing := aView.CharacterSpacing;
|
|
|
|
if (aView.Alignment and frtaRight) <> 0 then
|
|
aFrxView.HAlign := haRight;
|
|
if (aView.Alignment and frtaCenter) <> 0 then
|
|
aFrxView.HAlign := haCenter;
|
|
if (aView.Alignment and 3) = 3 then
|
|
aFrxView.HAlign := haBlock;
|
|
if (aView.Alignment and frtaVertical) <> 0 then
|
|
aFrxView.Rotation := 90;
|
|
if (aView.Alignment and frtaMiddle) <> 0 then
|
|
aFrxView.VAlign := vaCenter;
|
|
if (aView.Alignment and frtaDown) <> 0 then
|
|
aFrxView.VAlign := vaBottom;
|
|
|
|
{if (aView.Flags and flStretched) <> 0 then
|
|
aFrxView.StretchMode := smMaxHeight;}
|
|
//aFrxView.StretchMode := smDontStretch;
|
|
|
|
aFrxView.WordWrap := (aView.Flags and flWordWrap) <> 0;
|
|
aFrxView.WordBreak := (aView.Flags and flWordBreak) <> 0;
|
|
aFrxView.AutoWidth := (aView.Flags and flAutoSize) <> 0;
|
|
aFrxView.AllowExpressions := (aView.Flags and flTextOnly) = 0;
|
|
aFrxView.SuppressRepeated := (aView.Flags and flSuppressRepeated) <> 0;
|
|
aFrxView.HideZeros := (aView.Flags and flHideZeros) <> 0;
|
|
aFrxView.Underlines := (aView.Flags and flUnderlines) <> 0;
|
|
aFrxView.RTLReading := (aView.Flags and flRTLReading) <> 0;
|
|
aFrxView.AutoWidth := False;
|
|
bandAlign := aView.BandAlign;
|
|
if BandAlign = 6 then
|
|
BandAlign := 0;
|
|
if BandAlign = 7 then
|
|
BandAlign := 6;
|
|
aFrxView.Align := TfrxAlign(BandAlign);
|
|
aFrxView.TagStr := aView.Tag;
|
|
|
|
// if aFrxView.Frame.Width > 1 then
|
|
// aFrxView.Frame.Typ := aFrxView.Frame.Typ - [ftRight];
|
|
|
|
{
|
|
if aFrxView.Frame.Width > 1 then
|
|
begin
|
|
if aPage <> nil then
|
|
begin
|
|
NewShape := TfrxShapeView.Create(aPage);
|
|
NewShape.CreateUniqueName;
|
|
NewShape.Left := aView.x;
|
|
NewShape.Top := aView.y;
|
|
NewShape.Width := aView.dx;
|
|
NewShape.Height := aView.dy;
|
|
NewShape.Frame.Width := aFrxView.Frame.Width;
|
|
NewShape.Color := clBlack;
|
|
NewShape.FillType := ftGlass;
|
|
//NewShape.Objects.Add(aFrxView);
|
|
//aPage.Objects.Remove(aFrxView);
|
|
end;
|
|
end;
|
|
}
|
|
{
|
|
aFrxView.Frame.LeftLine.Width := aView.FrameWidth;
|
|
aFrxView.Frame.RightLine.Width := aView.FrameWidth;
|
|
aFrxView.Frame.TopLine.Width := aView.FrameWidth;
|
|
aFrxView.Frame.BottomLine.Width := aView.FrameWidth;
|
|
}
|
|
end;
|
|
|
|
{
|
|
Procedure SetfrxShapeView(aNewShape: TfrxShapeView; aLine: TfrLineView);
|
|
var bit : TBitmap;
|
|
|
|
begin
|
|
aNewShape.CreateUniqueName;
|
|
aNewShape.Left := aLine.x;
|
|
aNewShape.Top := aLine.y;
|
|
aNewShape.Width := aLine.dx;
|
|
aNewShape.Height := aLine.dy;
|
|
aNewShape.Frame.Width := aLine.FrameWidth;
|
|
bit := TBitmap.Create;
|
|
bit.Height := aLine.dy+1;
|
|
bit.Width := aLine.dx+1;
|
|
|
|
if bit.Height < aLine.FrameWidth then
|
|
bit.Height := Round(aLine.FrameWidth);
|
|
if bit.Width < aLine.FrameWidth then
|
|
bit.Width := Round(aLine.FrameWidth);
|
|
|
|
aLine.x := 0;
|
|
aLine.y := 0;
|
|
aLine.Draw(bit.Canvas);
|
|
aLine.x := Round(aNewShape.Left);
|
|
aLine.y := Round(aNewShape.Top);
|
|
aNewShape.Picture.Bitmap.Assign(bit);
|
|
bit.Destroy;
|
|
end;
|
|
}
|
|
|
|
Procedure SetfrxShapeView(aNewShape: TfrxShapeView; aLine: TfrLineView);
|
|
var bit : TBitmap;
|
|
begin
|
|
aNewShape.CreateUniqueName;
|
|
aNewShape.Left := aLine.x;
|
|
aNewShape.Top := aLine.y;
|
|
aNewShape.Width := aLine.dx;
|
|
aNewShape.Height := aLine.dy;
|
|
aNewShape.Frame.Width := aLine.FrameWidth;
|
|
if aNewShape.Width = 0 then
|
|
begin
|
|
aNewShape.Width := aLine.FrameWidth;
|
|
//aNewShape.Left := aLine.x - 1;
|
|
{if aLine.FrameWidth > 1 then
|
|
//aNewShape.Left := aNewShape.Left - Round(aLine.FrameWidth/2);
|
|
aNewShape.Left := aNewShape.Left - 1;}
|
|
end;
|
|
if aNewShape.Height = 0 then
|
|
begin
|
|
aNewShape.Height := aLine.FrameWidth;
|
|
//aNewShape.Top := aLine.y - 1;
|
|
{if aLine.FrameWidth > 1 then
|
|
//aNewShape.Top := aNewShape.Top - Round(aLine.FrameWidth/2);
|
|
aNewShape.Top := aNewShape.Top - 1;}
|
|
end;
|
|
aNewShape.Color := clBlack;
|
|
{bit := TBitmap.Create;
|
|
bit.Height := aLine.dy;
|
|
|
|
bit.Width := aLine.dx;
|
|
|
|
Bit.Canvas.Pen.Color := clBlack;
|
|
Bit.Canvas.MoveTo(0,0);
|
|
|
|
if bit.Height > bit.Width then
|
|
begin
|
|
bit.Width := Round(aLine.FrameWidth);
|
|
bit.Canvas.Pen.Width := bit.Width;
|
|
bit.Canvas.LineTo(0, bit.Height);
|
|
end
|
|
else
|
|
begin
|
|
bit.Height := Round(aLine.FrameWidth);
|
|
bit.Canvas.Pen.Width := bit.Height;
|
|
bit.Canvas.LineTo(bit.Width, 0);
|
|
end;
|
|
|
|
if bit.Height < aLine.FrameWidth then
|
|
bit.Height := Round(aLine.FrameWidth);
|
|
if bit.Width < aLine.FrameWidth then
|
|
bit.Width := Round(aLine.FrameWidth);
|
|
|
|
aLine.x := 0;
|
|
aLine.y := 0;
|
|
aLine.Draw(bit.Canvas);
|
|
aLine.x := Round(aNewShape.Left);
|
|
aLine.y := Round(aNewShape.Top);
|
|
//aNewShape.Picture.Bitmap.Assign(bit);
|
|
bit.Destroy;}
|
|
end;
|
|
|
|
Procedure SetfrxLineView(aNewLine: TfrxPictureView; aLine: TfrLineView; aScale: Boolean);
|
|
var bandAlign, FrameTyp: integer;
|
|
bit : TBitmap;
|
|
rect: TRect;
|
|
TempList: TList;
|
|
Oldx, oldY: integer;
|
|
begin
|
|
Try
|
|
aNewLine.CreateUniqueName;
|
|
|
|
aNewLine.Stretched := True;
|
|
|
|
aNewLine.Top := aLine.y;
|
|
aNewLine.Left := aLine.x;
|
|
aNewLine.Width := aLine.dx;
|
|
aNewLine.Height := aLine.dy;
|
|
aNewLine.Picture.Bitmap.width := aLine.dx;
|
|
aNewLine.Picture.Bitmap.height := aLine.dy;
|
|
|
|
bit := TBitmap.Create;
|
|
|
|
{bit.Height := aLine. Picture.Bitmap.Height;
|
|
bit.Width := aLine.Picture.Bitmap.Width;}
|
|
bit.Height := aLine.dy;
|
|
bit.Width := aLine.dx;
|
|
|
|
Bit.Canvas.Pen.Color := clBlack;
|
|
Bit.Canvas.MoveTo(0,0);
|
|
|
|
if bit.Height > bit.Width then
|
|
begin
|
|
//bit.Width := Round(aLine.FrameWidth) * 2;
|
|
bit.Width := Round(aLine.FrameWidth);
|
|
bit.Canvas.Pen.Width := bit.Width;
|
|
bit.Canvas.LineTo(0, bit.Height);
|
|
if aScale then
|
|
bit.Height := Round(bit.Height*aLine.ScaleY);
|
|
end
|
|
else
|
|
begin
|
|
//bit.Height := Round(aLine.FrameWidth) * 2;
|
|
bit.Height := Round(aLine.FrameWidth);
|
|
bit.Canvas.Pen.Width := bit.Height;
|
|
bit.Canvas.LineTo(bit.Width, 0);
|
|
if aScale then
|
|
bit.Width := Round(bit.Width*aLine.ScaleY);
|
|
end;
|
|
//bit.Canvas.Draw(0,0,aLine.Picture.Bitmap);
|
|
//Oldx := aLine.x;
|
|
//oldY := aLine.y;
|
|
{aLine.x := 0;
|
|
aLine.y := 0;
|
|
aLine.Draw(bit.Canvas);
|
|
aLine.x := OldX;
|
|
aLine.y := OldY;}
|
|
|
|
rect.Left := 0;
|
|
rect.Right := aLine.dx;
|
|
rect.Top := 0;
|
|
rect.Bottom := aLine.dy;
|
|
aNewLine.Width := bit.Width;
|
|
aNewLine.Height := bit.Height;
|
|
aNewLine.Width := bit.Width;
|
|
aNewLine.Height := bit.Height;
|
|
|
|
aNewLine.Picture.Bitmap.Width := bit.Width;
|
|
aNewLine.Picture.Bitmap.Height := bit.Height;
|
|
{
|
|
aNewLine.Picture.Bitmap.Width := bit.Width*6;
|
|
aNewLine.Picture.Bitmap.Height := bit.Height*6;
|
|
}
|
|
if bit.Height > bit.Width then
|
|
begin
|
|
//bit.Canvas.Pen.Width := bit.Width*6;
|
|
bit.Canvas.Pen.Width := bit.Width;
|
|
bit.Canvas.LineTo(0, bit.Height);
|
|
//aNewLine.Picture.Bitmap.Canvas.Pen.Width := bit.Width*6;
|
|
aNewLine.Picture.Bitmap.Canvas.Pen.Width := bit.Width;
|
|
aNewLine.Picture.Bitmap.Canvas.Pen.Color := clBlack;
|
|
aNewLine.Picture.Bitmap.Canvas.MoveTo(0,0);
|
|
aNewLine.Picture.Bitmap.Canvas.LineTo(0, bit.Height);
|
|
aNewLine.Left := aNewLine.Left;
|
|
end
|
|
else
|
|
begin
|
|
bit.Canvas.Pen.Width := bit.Height;
|
|
bit.Canvas.LineTo(bit.Width, 0);
|
|
|
|
//aNewLine.Picture.Bitmap.Canvas.Pen.Width := bit.Height*6;
|
|
aNewLine.Picture.Bitmap.Canvas.Pen.Width := bit.Height;
|
|
aNewLine.Picture.Bitmap.Canvas.Pen.Color := clBlack;
|
|
aNewLine.Picture.Bitmap.Canvas.MoveTo(0,0);
|
|
aNewLine.Picture.Bitmap.Canvas.LineTo(bit.Width, 0);
|
|
aNewLine.Top := aNewLine.Top;
|
|
end;
|
|
//aNewLine.Picture.Bitmap.Canvas.StretchDraw(rect, bit);
|
|
//aNewLine.Picture.Bitmap.Canvas.Draw(0,0,bit);
|
|
//aNewLine.Picture.Bitmap.Canvas.Draw(1,1,bit);
|
|
bit.Destroy;
|
|
//aNewLine.Frame.Style := 0;
|
|
|
|
{if (aLine.FrameTyp and frftRight) <> 0 then
|
|
aNewLine.Frame.Typ := aNewLine.Frame.Typ + [ftRight];
|
|
if (aLine.FrameTyp and frftBottom) <> 0 then
|
|
aNewLine.Frame.Typ := aNewLine.Frame.Typ + [ftBottom];
|
|
if (aLine.FrameTyp and frftLeft) <> 0 then
|
|
aNewLine.Frame.Typ := aNewLine.Frame.Typ + [ftLeft];
|
|
if (aLine.FrameTyp and frftTop) <> 0 then
|
|
aNewLine.Frame.Typ := aNewLine.Frame.Typ + [ftTop];
|
|
aNewLine.Frame.Width := aLine.FrameWidth;
|
|
aNewLine.Frame.Color := aLine.FrameColor;
|
|
aNewLine.Frame.Style := TfrxFrameStyle(aLine.FrameStyle);}
|
|
|
|
Except
|
|
on E:Exception do
|
|
ShowMessage('ExportLine Error! ' + aLine.Name);
|
|
End;
|
|
end;
|
|
*)
|
|
begin
|
|
MemoCounter := 1;
|
|
MemoList := TStringList.Create;
|
|
CurrPageLeft := 0;
|
|
PageDeltaY := 0;
|
|
|
|
if not CheckFormatCells(aReport, MemoList) then
|
|
FreeAndNil(MemoList);
|
|
try
|
|
TitulPreviewPages := nil;
|
|
WriteWithTitul := false;
|
|
//aReport.PrepareReport;
|
|
if aReport.Preview <> nil then
|
|
begin
|
|
//aReport.Preview.DisConnect;
|
|
// --------------------- EXCEL -----------------------------------------------------
|
|
for i := 0 to TfrEMFPages(aReport.Preview.Window.EMFPages).Count - 1 do
|
|
begin
|
|
//if TfrEMFPages(aReport.Preview.Window.EMFPages).Pages[i]^ <> nil then
|
|
TfrEMFPages(aReport.Preview.Window.EMFPages).Pages[i]^.Visible := True
|
|
end;
|
|
|
|
if TfrEMFPages(aReport.Preview.Window.EMFPages).Count > 1 then
|
|
if (TfrEMFPages(aReport.Preview.Window.EMFPages).Pages[0]^.pgOr <> TfrEMFPages(aReport.Preview.Window.EMFPages).Pages[1]^.pgOr) then
|
|
WriteWithTitul := True;
|
|
|
|
if WriteWithTitul then
|
|
k := 1
|
|
else
|
|
k := 0;
|
|
|
|
if WriteWithTitul then
|
|
begin
|
|
NewRep := TfrxReport.Create(nil);
|
|
frxXLSXExport := TfrxXLSXExport.Create(NewRep);
|
|
frxXLSXExport.ShowDialog := False;
|
|
|
|
//frxXLSXExport.SingleSheet := true;
|
|
//frxXLSXExport.emptyLines := True;
|
|
frxXLSXExport.showProgress := False;
|
|
|
|
TitulPreviewPages := TfrxPreviewPages.Create(NewRep);
|
|
TitulPreviewPages.Engine := NewRep.Engine;
|
|
LineList := TList.Create;
|
|
|
|
p := TfrEMFPages(aReport.Preview.Window.EMFPages).Pages[0];
|
|
CreatedPage := False;
|
|
|
|
if not Assigned(p^.Page) then
|
|
begin
|
|
TfrEMFPages(aReport.Preview.Window.EMFPages).ObjectsToPage(0);
|
|
CreatedPage := True;
|
|
end;
|
|
|
|
aPage := TfrxReportPage.Create(NewRep);
|
|
|
|
//AssignPageProps(aPage, p^.Page);
|
|
|
|
CurrPageLeft := p^.Page.pgMargins.Left;
|
|
|
|
for j := 0 to p^.Page.Objects.Count - 1 do
|
|
begin
|
|
ExportObj_X(aPage, LineList, Pointer(p^.Page.Objects[j]), MemoList, MemoCounter);
|
|
(*
|
|
if TObject(p^.Page.Objects[j]).ClassNAme = 'TfrMemoView' then
|
|
begin
|
|
|
|
if TfrMemoView(p^.Page.Objects[j]).x < 72 then
|
|
if TfrMemoView(p^.Page.Objects[j]).y < 100 then
|
|
if TfrMemoView(p^.Page.Objects[j]).Memo.text = '' then
|
|
continue;
|
|
|
|
NewMemo := TfrxMemoView.Create(aPage);
|
|
NewMemo.Name := 'Memo' + inttostr(MemoCounter);
|
|
Inc(MemoCounter);
|
|
SetfrxView(NewMemo, TfrMemoView(p^.Page.Objects[j]), MemoList, false);
|
|
{NewMemo.Memo.Text := trim(TfrMemoView(p^.Page.Objects[j]).Memo.Text);
|
|
NewMemo.Memo.Text := trim(StringReplace(NewMemo.Memo.Text, #$1, '', [rfReplaceAll, rfIgnoreCase]));}
|
|
NewMemo.Memo.Text := TfrMemoView(p^.Page.Objects[j]).Memo.Text;
|
|
end
|
|
else
|
|
if TObject(p^.Page.Objects[j]).ClassName = 'TfrLineView' then
|
|
begin
|
|
NewLine := TfrxPictureView.Create(aPage);
|
|
SetfrxLineView(NewLine, TfrLineView(p^.Page.Objects[j]), false, false);
|
|
LineList.Add(NewLine);
|
|
{NewShape := TfrxShapeView.Create(aPage);
|
|
SetfrxShapeView(NewShape, TfrLineView((p^.Page.Objects[j])));}
|
|
end
|
|
else
|
|
if TObject(p^.Page.Objects[j]).ClassName = 'TfrPictureView' then
|
|
begin
|
|
NewPict := TfrxPictureView.Create(aPage);
|
|
SetfrxPictView(NewPict, TfrPictureView(p^.Page.Objects[j]), false);
|
|
end;
|
|
*)
|
|
end;
|
|
|
|
//if CreatedPage then
|
|
// FreeAndNil(p^.Page);
|
|
|
|
aPage.LeftMargin := 5;
|
|
//aPage.BottomMargin := 5;
|
|
aPage.TopMargin := 5;
|
|
aPage.RightMargin := 5;
|
|
aPage.Frame.Width := 0;
|
|
|
|
|
|
TitulPreviewPages.AddPage(aPage);
|
|
TitulPreviewPages.PageCache.AddObject('0', aPage);
|
|
s := aFileName;
|
|
s := StringReplace(s,'.xlsx','',[rfReplaceAll, rfIgnoreCase]);
|
|
s := s + '_Titul' + '.xlsx';
|
|
frxXLSXExport.FileName := s;
|
|
|
|
frxXLSXExport.FileName := s;
|
|
for i := 0 to TitulPreviewPages.Count - 1 do
|
|
begin
|
|
aPage := TitulPreviewPages.Page[i];
|
|
for j := 0 to aPage.Objects.Count - 1 do
|
|
begin
|
|
if TComponent(aPage.Objects[j]) is TfrxPictureView then
|
|
begin
|
|
for l := 0 to LineList.Count - 1 do
|
|
begin
|
|
if TfrxPictureView(aPage.Objects[j]).Name = TfrxPictureView(LineList[l]).Name then
|
|
begin
|
|
TfrxPictureView(aPage.Objects[j]).Name := TfrxPictureView(aPage.Objects[j]).Name + '_DrawLine';
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
LineList.free;
|
|
|
|
TitulPreviewPages.Export(frxXLSXExport);
|
|
TitulPreviewPages.Free;
|
|
frxXLSXExport.Free;
|
|
NewRep.Free;
|
|
end;
|
|
|
|
NewRep := TfrxReport.Create(nil);
|
|
frxXLSXExport := TfrxXLSXExport.Create(NewRep);
|
|
frxXLSXExport.ShowDialog := False;
|
|
//frxXLSXExport.emptyLines := True;
|
|
frxXLSXExport.showProgress := False;
|
|
|
|
//frxXLSXExport.ExportPageBreaks := True;
|
|
//frxXLSXExport.SingleSheet := (TfrEMFPages(aReport.Preview.Window.EMFPages).Count = 1);
|
|
//frxXLSXExport.SingleSheet := true;
|
|
|
|
aPreviewPages := TfrxPreviewPages.Create(NewRep);
|
|
aPreviewPages.Engine := NewRep.Engine;
|
|
LineList := TList.Create;
|
|
for i := k to TfrEMFPages(aReport.Preview.Window.EMFPages).Count - 1 do
|
|
begin
|
|
p := TfrEMFPages(aReport.Preview.Window.EMFPages).Pages[i];
|
|
CreatedPage := False;
|
|
begin
|
|
if not Assigned(p^.Page) then
|
|
begin
|
|
TfrEMFPages(aReport.Preview.Window.EMFPages).ObjectsToPage(i);
|
|
CreatedPage := true;
|
|
end;
|
|
begin
|
|
aPage := TfrxReportPage.Create(NewRep);
|
|
|
|
aPage.Frame.Width := 0;
|
|
(*
|
|
if WriteWithTitul then
|
|
begin
|
|
aPage.Orientation := p^.Page.pgOr;
|
|
aPage.PaperSize := p^.Page.pgSize;
|
|
aPage.PaperWidth := p^.Page.pgWidth / 10;
|
|
aPage.PaperHeight := p^.Page.pgHeight / 10;
|
|
|
|
{ if i > 1 then
|
|
aPage.LeftMargin := 10
|
|
else}
|
|
aPage.LeftMargin := 0;
|
|
|
|
aPage.BottomMargin := 5;
|
|
aPage.TopMargin := 0;
|
|
aPage.RightMargin := 5;
|
|
end
|
|
else
|
|
*)
|
|
|
|
//AssignPageProps(aPage, p^.Page); // 08/07/2020 --
|
|
|
|
aPage.Orientation := p^.Page.pgOr;
|
|
aPage.PaperSize := p^.Page.pgSize;
|
|
|
|
//aPage.LeftMargin := p^.Page.LeftMargin;
|
|
|
|
|
|
//PageDeltaY := GetPageDeltaY(p^.Page);
|
|
|
|
for j := 0 to p^.Page.Objects.Count - 1 do
|
|
begin
|
|
ExportObj_X(aPage, LineList, Pointer(p^.Page.Objects[j]), MemoList, MemoCounter);
|
|
(*
|
|
if TObject(p^.Page.Objects[j]).ClassNAme = 'TfrMemoView' then
|
|
begin
|
|
//NewMemo.FHighlights := TfrxHighlightCollection.Create;
|
|
//NewMemo.FFormats := TfrxFormatCollection.Create;
|
|
//NewMemo.Memo := TfrxWideStrings.Create;
|
|
//NewMemo.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
|
|
//NewMemo.Color := TfrMemoView(p^.Page.Objects[j]).FillColor;
|
|
//NewMemo.Memo.Text := TfrMemoView(p^.Page.Objects[j]).Memo.Text;
|
|
//apage.Objects.Add(NewMemo);
|
|
|
|
{if TfrMemoView(p^.Page.Objects[j]).x <= 72 then
|
|
if TfrMemoView(p^.Page.Objects[j]).y < 100 then
|
|
if TfrMemoView(p^.Page.Objects[j]).dx > 500 then
|
|
if TfrMemoView(p^.Page.Objects[j]).Memo.text = '' then
|
|
continue;}
|
|
|
|
if TfrMemoView(p^.Page.Objects[j]).x > aPage.width then
|
|
continue;
|
|
|
|
if TfrMemoView(p^.Page.Objects[j]).x <= 72 then
|
|
if TfrMemoView(p^.Page.Objects[j]).y < 100 then
|
|
if TfrMemoView(p^.Page.Objects[j]).Memo.text = '' then
|
|
begin
|
|
if TfrMemoView(p^.Page.Objects[j]).dx > 500 then
|
|
if TfrMemoView(p^.Page.Objects[j]).y <= 40 then
|
|
if TfrMemoView(p^.Page.Objects[j]).x <= 72 then
|
|
if Trim(TfrMemoView(p^.Page.Objects[j]).Memo.Text) = '' then
|
|
//PageDeltaY := PageDeltaY - TfrMemoView(p^.Page.Objects[j]).dy;
|
|
continue;
|
|
end;
|
|
|
|
if TfrMemoView(p^.Page.Objects[j]).x <= 72 then
|
|
if TfrMemoView(p^.Page.Objects[j]).y < 100 then
|
|
if TfrMemoView(p^.Page.Objects[j]).Memo.text = '' then
|
|
if TfrMemoView(p^.Page.Objects[j]).dx > 500 then
|
|
continue;
|
|
|
|
NewMemo := TfrxMemoView.Create(aPage);
|
|
NewMemo.Name := 'Memo' + inttostr(MemoCounter);
|
|
Inc(MemoCounter);
|
|
//NewMemo.Memo.Text := trim(TfrMemoView(p^.Page.Objects[j]).Memo.Text);
|
|
//NewMemo.Memo.Text := trim(StringReplace(NewMemo.Memo.Text, #1, '', [rfReplaceAll, rfIgnoreCase]));
|
|
SetfrxView(NewMemo, TfrMemoView(p^.Page.Objects[j]), MemoList, (i > k));
|
|
NewMemo.Memo.Text := trim(TfrMemoView(p^.Page.Objects[j]).Memo.Text);
|
|
|
|
//NewMemo.Memo.Text := trim(TfrMemoView(p^.Page.Objects[j]).Memo.Text);
|
|
//NewMemo.Text := TfrMemoView(p^.Page.Objects[j]).Memo.Text;
|
|
|
|
end
|
|
else
|
|
if TObject(p^.Page.Objects[j]).ClassName = 'TfrLineView' then
|
|
begin
|
|
//NewShape := TfrxShapeView.Create(aPage);
|
|
//NewShape := TfrxShapeView.DesignCreate(aPage,1);
|
|
{NewShape.Shape := skRectangle;
|
|
SetfrxShapeView(NewShape, TfrLineView(p^.Page.Objects[j]));}
|
|
//NewLine := TfrxLineView.create(aPage);
|
|
|
|
NewLine := TfrxPictureView.Create(aPage);
|
|
SetfrxLineView(NewLine, TfrLineView(p^.Page.Objects[j]), false, (i > k));
|
|
LineList.Add(NewLine);
|
|
{NewShape := TfrxShapeView.Create(aPage);
|
|
SetfrxShapeView(NewShape, TfrLineView((p^.Page.Objects[j])));}
|
|
|
|
//aPage.Objects.Remove(NewShape);
|
|
//aPreviewPages.AddPicture(NewLine);
|
|
end
|
|
else
|
|
if TObject(p^.Page.Objects[j]).ClassName = 'TfrPictureView' then
|
|
begin
|
|
NewPict := TfrxPictureView.Create(aPage);
|
|
SetfrxPictView(NewPict, TfrPictureView(p^.Page.Objects[j]), (i > k));
|
|
//aPage.Objects.Remove(NewPict);
|
|
//aPreviewPages.AddPicture(NewPict);
|
|
end;
|
|
*)
|
|
end;
|
|
|
|
if WriteWithTitul then
|
|
begin
|
|
aPage.LeftMargin := 5;
|
|
aPage.BottomMargin := 5;
|
|
aPage.TopMargin := 5;
|
|
aPage.RightMargin := 5;
|
|
end;
|
|
//FreeAndNil(p^.Page);
|
|
end;
|
|
end;
|
|
if not WriteWithTitul then
|
|
begin
|
|
AssignPageProps(aPage, p^.Page, i > 0 ); // 08/07/2020 --
|
|
end;
|
|
|
|
//if CreatedPage then
|
|
// FreeAndNil(p^.Page);
|
|
|
|
aPreviewPages.AddPage(aPage);
|
|
if WriteWithTitul then
|
|
aPreviewPages.PageCache.AddObject(inttostr(i - 1), aPage)
|
|
else
|
|
aPreviewPages.PageCache.AddObject(inttostr(i), aPage);
|
|
end;
|
|
|
|
for i := 0 to aPreviewPages.Count - 1 do
|
|
begin
|
|
aPage := aPreviewPages.Page[i];
|
|
for j := 0 to aPage.Objects.Count - 1 do
|
|
begin
|
|
if TComponent(aPage.Objects[j]) is TfrxPictureView then
|
|
begin
|
|
for k := 0 to LineList.Count - 1 do
|
|
begin
|
|
if TfrxPictureView(aPage.Objects[j]).Name = TfrxPictureView(LineList[k]).Name then
|
|
begin
|
|
TfrxPictureView(aPage.Objects[j]).Name := TfrxPictureView(aPage.Objects[j]).Name + '_DrawLine';
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
LineList.Free;
|
|
|
|
tempList := TList.Create;
|
|
for i := 0 to aPreviewPages.Count - 1 do
|
|
begin
|
|
aPage := aPreviewPages.Page[i];
|
|
for j := 0 to aPage.Objects.Count - 1 do
|
|
begin
|
|
if (TObject(aPage.Objects[j]) is TfrxPictureView) then
|
|
{if ((TObject(aPage.Objects[j]) is TfrPictureView) or
|
|
(TObject(aPage.Objects[j]) is TfrxShapeView)) then}
|
|
begin
|
|
TempList.Add(aPage.Objects[j]);
|
|
aPage.Objects[j] := nil;
|
|
end;
|
|
end;
|
|
aPage.Objects.Pack;
|
|
//aPage.Objects.Sort(@CompareObjects);
|
|
|
|
for j := 0 to TempList.Count - 1 do
|
|
//aPage.Objects.Insert(0, TempList[j]);
|
|
aPage.Objects.Add(TempList[j]);
|
|
|
|
TempList.Clear;
|
|
end;
|
|
FreeAndNil(TempList);
|
|
|
|
{ tempList := TList.Create;
|
|
for i := 0 to aPreviewPages.Count - 1 do
|
|
begin
|
|
aPage := aPreviewPages.Page[i];
|
|
for j := 0 to aPage.Objects.Count - 1 do
|
|
begin
|
|
//if (TObject(aPage.Objects[j]) is TfrxPictureView) then
|
|
if ((TObject(aPage.Objects[j]) is TfrPictureView) or
|
|
(TObject(aPage.Objects[j]) is TfrxShapeView)) then
|
|
begin
|
|
TempList.Add(aPage.Objects[j]);
|
|
aPage.Objects[i] := nil;
|
|
end;
|
|
end;
|
|
aPage.Objects.Pack;
|
|
//aPage.Objects.Sort(@CompareObjects);
|
|
|
|
for j := 0 to TempList.Count - 1 do
|
|
//aPage.Objects.Insert(0, TempList[j]);
|
|
aPage.Objects.Add(TempList[j]);
|
|
|
|
TempList.Clear;
|
|
end;
|
|
FreeAndNil(TempList); }
|
|
|
|
frxXLSXExport.FileName := aFileName;
|
|
//frxXLSXExport.Wysiwyg := False;
|
|
frxXLSXExport.Wysiwyg := True;
|
|
//frxXLSXExport.ExportPageBreaks := True;
|
|
frxXLSXExport.OpenAfterExport := True;
|
|
aPreviewPages.Export(frxXLSXExport);
|
|
//aPreviewPages.Free;
|
|
frxXLSXExport.Free;
|
|
//aPreviewPages.free;
|
|
NewRep.Free;
|
|
CurrPageLeft := 0;
|
|
// --------------------- MS WORD -----------------------------------------------------
|
|
(* if WriteWithTitul then
|
|
k := 1
|
|
else
|
|
k := 0;
|
|
|
|
NewRep := TfrxReport.Create(nil);
|
|
|
|
if WriteWithTitul then
|
|
begin
|
|
FilterDoc := TfrxDOCXExport.create(NewRep);
|
|
|
|
TitulPreviewPages := TfrxPreviewPages.Create(NewRep);
|
|
TitulPreviewPages.Engine := NewRep.Engine;
|
|
|
|
p := TfrEMFPages(aReport.Preview.Window.EMFPages).Pages[0];
|
|
if not Assigned(p^.Page) then
|
|
TfrEMFPages(aReport.Preview.Window.EMFPages).ObjectsToPage(i);
|
|
|
|
aPage := TfrxReportPage.Create(NewRep);
|
|
|
|
//aPage.LeftMargin := 5;
|
|
//aPage.BottomMargin := 5;
|
|
//aPage.RightMargin := 5;
|
|
|
|
AssignPageProps(aPage, p^.Page);
|
|
for j := 0 to p^.Page.Objects.Count - 1 do
|
|
begin
|
|
if TObject(p^.Page.Objects[j]).ClassNAme = 'TfrMemoView' then
|
|
begin
|
|
NewMemo := TfrxMemoView.Create(aPage);
|
|
SetfrxView(NewMemo, TfrMemoView(p^.Page.Objects[j]));
|
|
NewMemo.Memo.Text := trim(TfrMemoView(p^.Page.Objects[j]).Memo.Text);
|
|
NewMemo.Memo.Text := trim(StringReplace(NewMemo.Memo.Text, #$1, '', [rfReplaceAll, rfIgnoreCase]));
|
|
end
|
|
else
|
|
if TObject(p^.Page.Objects[j]).ClassName = 'TfrLineView' then
|
|
begin
|
|
//NewLine := TfrxPictureView.Create(aPage);
|
|
//SetfrxLineView(NewLine, TfrLineView(p^.Page.Objects[j]), false);
|
|
//NewShape := TfrxShapeView.Create(aPage);
|
|
NewShape := TfrxShapeView.Create(aPage);
|
|
SetfrxShapeView(NewShape, TfrLineView((p^.Page.Objects[j])));
|
|
end
|
|
else
|
|
if TObject(p^.Page.Objects[j]).ClassName = 'TfrPictureView' then
|
|
begin
|
|
NewPict := TfrxPictureView.Create(aPage);
|
|
SetfrxPictView(NewPict, TfrPictureView(p^.Page.Objects[j]));
|
|
end;
|
|
end;
|
|
aPage.LeftMargin := 5;
|
|
//aPage.BottomMargin := 5;
|
|
aPage.TopMargin := 10;
|
|
aPage.RightMargin := 5;
|
|
|
|
TitulPreviewPages.AddPage(aPage);
|
|
TitulPreviewPages.PageCache.AddObject('0', aPage);
|
|
s := aFileName;
|
|
s := StringReplace(s,'.xlsx','',[rfReplaceAll, rfIgnoreCase]);
|
|
s := s + '_Titul' + '.Docx';
|
|
FilterDoc.FileName := s;
|
|
FilterDoc.ShowDialog := False;
|
|
FilterDoc.showProgress := False;
|
|
|
|
{tempList := TList.Create;
|
|
for j := 0 to aPreviewPages.Count - 1 do
|
|
begin
|
|
aPage := aPreviewPages.Page[j];
|
|
for k := 0 to aPage.Objects.Count - 1 do
|
|
begin
|
|
//if (TObject(aPage.Objects[j]) is TfrxPictureView) then
|
|
//{if ((TObject(aPage.Objects[j]) is TfrPictureView) or
|
|
if (TObject(aPage.Objects[k]) is TfrxShapeView) then
|
|
begin
|
|
TempList.Add(aPage.Objects[k]);
|
|
aPage.Objects[k] := nil;
|
|
end;
|
|
end;
|
|
aPage.Objects.Pack;
|
|
|
|
for k := 0 to TempList.Count - 1 do
|
|
//aPage.Objects.Insert(0, TempList[j]);
|
|
aPage.Objects.Add(TempList[k]);
|
|
TempList.Clear;
|
|
end;
|
|
FreeAndNil(TempList);}
|
|
|
|
TitulPreviewPages.Export(FilterDoc);
|
|
FilterDoc.Free;
|
|
NewRep.Free;
|
|
NewRep := TfrxReport.Create(nil);
|
|
end;
|
|
|
|
FilterDoc := TfrxDOCXExport.create(NewRep);
|
|
s := aFileName;
|
|
i := Length(s);
|
|
s[i - 3] := 'd';
|
|
s[i - 2] := 'o';
|
|
s[i - 1] := 'c';
|
|
s[i] := 'x';
|
|
|
|
FilterDoc.FileName := s;
|
|
FilterDoc.ShowDialog := False;
|
|
FilterDoc.showProgress := False;
|
|
|
|
aPreviewPages := TfrxPreviewPages.Create(NewRep);
|
|
aPreviewPages.Engine := NewRep.Engine;
|
|
//AssignFile(f, 'c:\ExportCL.txt');
|
|
//Rewrite(f);
|
|
for i := k to TfrEMFPages(aReport.Preview.Window.EMFPages).Count - 1 do
|
|
TfrEMFPages(aReport.Preview.Window.EMFPages).Pages[i]^.Visible := True;
|
|
for i := k to TfrEMFPages(aReport.Preview.Window.EMFPages).Count - 1 do
|
|
begin
|
|
p := TfrEMFPages(aReport.Preview.Window.EMFPages).Pages[i];
|
|
begin
|
|
if not Assigned(p^.Page) then
|
|
TfrEMFPages(aReport.Preview.Window.EMFPages).ObjectsToPage(i);
|
|
|
|
begin
|
|
aPage := TfrxReportPage.Create(NewRep);
|
|
AssignPageProps(aPage, p^.Page);
|
|
aPage.RightMargin := Round(p^.Page.pgMargins.Right/18*5);
|
|
aPage.BottomMargin := Round(p^.Page.pgMargins.Bottom/18*5);
|
|
aPage.LeftMargin := Round(p^.Page.pgMargins.Left/18*5);
|
|
aPage.TopMargin := Round(p^.Page.pgMargins.Top/18*5);
|
|
|
|
for j := 0 to p^.Page.Objects.Count - 1 do
|
|
begin
|
|
if TObject(p^.Page.Objects[j]).ClassNAme = 'TfrMemoView' then
|
|
begin
|
|
NewMemo := TfrxMemoView.Create(aPage);
|
|
SetfrxView(NewMemo, TfrMemoView(p^.Page.Objects[j]));
|
|
NewMemo.Memo.Text := trim(TfrMemoView(p^.Page.Objects[j]).Memo.Text);
|
|
NewMemo.Memo.Text := trim(StringReplace(NewMemo.Memo.Text, #$1, '', [rfReplaceAll, rfIgnoreCase]));
|
|
end
|
|
else
|
|
if TObject(p^.Page.Objects[j]).ClassName = 'TfrLineView' then
|
|
begin
|
|
//NewShape := TfrxShapeView.Create(aPage);
|
|
//NewShape := TfrxShapeView.DesignCreate(aPage,1);
|
|
{NewShape.Shape := skRectangle;
|
|
SetfrxShapeView(NewShape, TfrLineView(p^.Page.Objects[j]));}
|
|
//NewLine := TfrxLineView.create(aPage);
|
|
////////NewLine := TfrxPictureView.Create(aPage);
|
|
///////SetfrxLineView(NewLine, TfrLineView(p^.Page.Objects[j]), true);
|
|
NewShape := TfrxShapeView.Create(aPage);
|
|
SetfrxShapeView(NewShape, TfrLineView((p^.Page.Objects[j])));
|
|
//aPage.Objects.Remove(NewLine);
|
|
//aPreviewPages.AddPicture(NewLine);
|
|
end
|
|
else
|
|
if TObject(p^.Page.Objects[j]).ClassName = 'TfrPictureView' then
|
|
begin
|
|
NewPict := TfrxPictureView.Create(aPage);
|
|
SetfrxPictView(NewPict, TfrPictureView(p^.Page.Objects[j]));
|
|
//aPage.Objects.Remove(NewPict);
|
|
//aPreviewPages.AddPicture(NewPict);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{aPage.LeftMargin := 5;
|
|
aPage.BottomMargin := 5;
|
|
aPage.RightMargin := 5;}
|
|
|
|
tempList := TList.Create;
|
|
for j := 0 to aPreviewPages.Count - 1 do
|
|
begin
|
|
aPage := aPreviewPages.Page[j];
|
|
for k := 0 to aPage.Objects.Count - 1 do
|
|
begin
|
|
//if (TObject(aPage.Objects[j]) is TfrxPictureView) then
|
|
//{if ((TObject(aPage.Objects[j]) is TfrPictureView) or
|
|
if (TObject(aPage.Objects[k]) is TfrxShapeView) then
|
|
begin
|
|
TempList.Add(aPage.Objects[k]);
|
|
aPage.Objects[k] := nil;
|
|
end;
|
|
end;
|
|
aPage.Objects.Pack;
|
|
|
|
for k := 0 to TempList.Count - 1 do
|
|
//aPage.Objects.Insert(0, TempList[j]);
|
|
aPage.Objects.Add(TempList[k]);
|
|
TempList.Clear;
|
|
end;
|
|
FreeAndNil(TempList);
|
|
|
|
aPreviewPages.AddPage(aPage);
|
|
if WriteWithTitul then
|
|
aPreviewPages.PageCache.AddObject(inttostr(i - 1), aPage)
|
|
else
|
|
aPreviewPages.PageCache.AddObject(inttostr(i), aPage);
|
|
end;
|
|
|
|
|
|
|
|
aPreviewPages.Export(FilterDoc);
|
|
FilterDoc.Free;
|
|
//aPreviewPages.free;
|
|
//ClearDups(NewRep);
|
|
//ClearText(NewRep);
|
|
NewRep.Free;
|
|
{
|
|
Filter := TfrxXLSXExport.Create(NewRep);
|
|
Filter.FileName := aFileName;
|
|
Filter.ShowDialog := False;
|
|
NewRep.Export(Filter);
|
|
Filter.Free;
|
|
NewRep.Free;
|
|
}
|
|
*)
|
|
//aReport.Preview.Connect(aReport);
|
|
end;
|
|
|
|
//Ïåðåêîííåêòèòü ôîðìó, ÷òîáû íå áûëî îøèáîê ïðè ñêðîëëå ìûøêîé íà ôîðìå îò÷åòà
|
|
aReport.Preview.DisConnect;
|
|
aReport.Preview.Connect(aReport);
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
//aReport.Preview.Connect(aReport.Preview);
|
|
//if aReport.Preview <> nil then
|
|
//begin
|
|
// aReport.Preview.Connect(aReport);
|
|
//end;
|
|
ShowMessage('Export Error!');
|
|
end;
|
|
end;
|
|
if MemoList <> nil then
|
|
MemoList.free;
|
|
end;
|
|
|
|
//function ExportReportToDocX(aFileName: String; aReport: tfrReport): Boolean;
|
|
function ExportReportToDocX(aFileName: String; aReport: tfrReport; aFromPreview: Boolean = False): Boolean;
|
|
var i, j, k, l: Integer;
|
|
Filter: TfrxXLSXExport;
|
|
FilterDoc: TfrxDOCXExport;
|
|
NewRep: TfrxReport;
|
|
t: TfrView;
|
|
p: PfrPageInfo;
|
|
b: Byte;
|
|
s, ss: string;
|
|
NewMemo: TfrxMemoView;
|
|
|
|
NewPict, NewLine: TfrxPictureView;
|
|
aPreviewPages, TitulPreviewPages: TfrxPreviewPages;
|
|
NewShape: TfrxShapeView;
|
|
apage: TfrxReportPage;
|
|
|
|
frxXLSXExport: TfrxXLSXExport;
|
|
f: TextFile;
|
|
TempList: TList;
|
|
Stream: TMeMoryStream;
|
|
ExportStream: TFileStream;
|
|
WriteWithTitul: boolean;
|
|
DrawedObjects: Boolean;
|
|
MemoCounter: integer;
|
|
AllReportPages: TfrEMFPages;
|
|
begin
|
|
/////////////////////////// MS WORD /////////////////////////////////////////////
|
|
DrawedObjects := False;
|
|
MemoCounter := 1;
|
|
PageDeltaY := 0;
|
|
|
|
if aFromPreview then
|
|
AllReportPages := TfrEMFPages(aReport.Preview.Window.EMFPages)
|
|
else
|
|
begin
|
|
AllReportPages := TfrEMFPages(aReport.EMFPages);
|
|
TF_Main(F_ProjMan).F_ProgressExp.StartExport(aReport.EMFPages.Count, ExtractFileName(aFileName));
|
|
end;
|
|
|
|
try
|
|
TitulPreviewPages := nil;
|
|
WriteWithTitul := false;
|
|
ss := aFileName;
|
|
|
|
begin
|
|
NewRep := TfrxReport.Create(nil);
|
|
|
|
if AllReportPages.Count > 1 then
|
|
if AllReportPages.Pages[0]^.pgOr <> AllReportPages.Pages[1]^.pgOr then
|
|
WriteWithTitul := True;
|
|
|
|
// --------------------- MS WORD -----------------------------------------------------
|
|
if WriteWithTitul then
|
|
k := 1
|
|
else
|
|
k := 0;
|
|
|
|
NewRep := TfrxReport.Create(nil);
|
|
|
|
if WriteWithTitul then
|
|
begin
|
|
FilterDoc := TfrxDOCXExport.create(NewRep);
|
|
|
|
|
|
TitulPreviewPages := TfrxPreviewPages.Create(NewRep);
|
|
TitulPreviewPages.Engine := NewRep.Engine;
|
|
|
|
p := AllReportPages.Pages[0];
|
|
if not Assigned(p^.Page) then
|
|
AllReportPages.ObjectsToPage(i);
|
|
|
|
aPage := TfrxReportPage.Create(NewRep);
|
|
|
|
AssignPageProps_Word(aPage, p^.Page, WriteWithTitul);
|
|
for j := 0 to p^.Page.Objects.Count - 1 do
|
|
begin
|
|
|
|
if TObject(p^.Page.Objects[j]).ClassNAme = 'TfrMemoView' then
|
|
begin
|
|
if TfrMemoView(p^.Page.Objects[j]).x < 72 then
|
|
if TfrMemoView(p^.Page.Objects[j]).y < 100 then
|
|
if TfrMemoView(p^.Page.Objects[j]).Memo.text = '' then
|
|
continue;
|
|
|
|
NewMemo := TfrxMemoView.Create(aPage);
|
|
NewMeMo.Name := 'Memo' + inttostr(MemoCounter);
|
|
inc(MemoCounter);
|
|
SetfrxView_Word(NewMemo, TfrMemoView(p^.Page.Objects[j]));
|
|
NewMemo.Memo.Text := trim(TfrMemoView(p^.Page.Objects[j]).Memo.Text);
|
|
NewMemo.Memo.Text := trim(StringReplace(NewMemo.Memo.Text, #$1, '', [rfReplaceAll, rfIgnoreCase]));
|
|
end
|
|
else
|
|
if TObject(p^.Page.Objects[j]).ClassName = 'TfrLineView' then
|
|
begin
|
|
NewShape := TfrxShapeView.Create(aPage);
|
|
SetfrxShapeView_Word(NewShape, TfrLineView((p^.Page.Objects[j])));
|
|
DrawedObjects := True;
|
|
end
|
|
else
|
|
if TObject(p^.Page.Objects[j]).ClassName = 'TfrPictureView' then
|
|
begin
|
|
NewPict := TfrxPictureView.Create(aPage);
|
|
SetfrxPictView_Word(NewPict, TfrPictureView(p^.Page.Objects[j]));
|
|
end;
|
|
end;
|
|
|
|
aPage.LeftMargin := 5;
|
|
aPage.TopMargin := 5;
|
|
aPage.RightMargin := 5;
|
|
aPage.BottomMargin := 5;
|
|
|
|
TitulPreviewPages.AddPage(aPage);
|
|
TitulPreviewPages.PageCache.AddObject('0', aPage);
|
|
FilterDoc.FileName := aFileName;
|
|
|
|
|
|
s := aFileName;
|
|
s := StringReplace(s,'.Docx','_Titul.Docx',[rfReplaceAll, rfIgnoreCase]);
|
|
FilterDoc.FileName := s;
|
|
|
|
FilterDoc.ShowDialog := False;
|
|
FilterDoc.showProgress := False;
|
|
//FilterDoc.showProgress := True;
|
|
if DrawedObjects then
|
|
begin
|
|
tempList := TList.Create;
|
|
for j := 0 to TitulPreviewPages.Count - 1 do
|
|
begin
|
|
aPage := TitulPreviewPages.Page[j];
|
|
for l := 0 to aPage.Objects.Count - 1 do
|
|
begin
|
|
if (TObject(aPage.Objects[k]) is TfrxShapeView) then
|
|
begin
|
|
TempList.Add(aPage.Objects[l]);
|
|
aPage.Objects[l] := nil;
|
|
end;
|
|
end;
|
|
aPage.Objects.Pack;
|
|
|
|
for l := 0 to TempList.Count - 1 do
|
|
aPage.Objects.Add(TempList[l]);
|
|
TempList.Clear;
|
|
end;
|
|
FreeAndNil(TempList);
|
|
DrawedObjects := False;
|
|
end;
|
|
|
|
if aFromPreview then
|
|
FilterDoc.OpenAfterExport := True
|
|
else
|
|
FilterDoc.OpenAfterExport := False;
|
|
|
|
TitulPreviewPages.Export(FilterDoc);
|
|
FilterDoc.Free;
|
|
NewRep.Free;
|
|
|
|
if not aFromPreview then
|
|
TF_Main(F_ProjMan).F_ProgressExp.EndExportPage;
|
|
|
|
NewRep := TfrxReport.Create(nil);
|
|
end;
|
|
|
|
FilterDoc := TfrxDOCXExport.create(NewRep);
|
|
|
|
FilterDoc.FileName := ss;
|
|
|
|
FilterDoc.ShowDialog := False;
|
|
FilterDoc.showProgress := False;
|
|
//25/09/2020
|
|
FilterDoc.ExportNotPrintable := False;
|
|
FilterDoc.UseFileCache := False;
|
|
//
|
|
//FilterDoc.showProgress := True;
|
|
|
|
|
|
aPreviewPages := TfrxPreviewPages.Create(NewRep);
|
|
aPreviewPages.Engine := NewRep.Engine;
|
|
|
|
for i := k to AllReportPages.Count - 1 do
|
|
AllReportPages.Pages[i]^.Visible := True;
|
|
|
|
for i := k to AllReportPages.Count - 1 do
|
|
begin
|
|
p := AllReportPages.Pages[i];
|
|
begin
|
|
if not Assigned(p^.Page) then
|
|
AllReportPages.ObjectsToPage(i);
|
|
|
|
begin
|
|
aPage := TfrxReportPage.Create(NewRep);
|
|
//AssignPageProps_Word(aPage, p^.Page, WriteWithTitul);
|
|
//aPage.SetDefaults;
|
|
aPage.Frame.Width := 0;
|
|
PageDeltaY := 0;
|
|
AssignPageProps(aPage, p^.Page, WriteWithTitul);
|
|
PageDeltaY := GetPageDeltaY(p^.Page);
|
|
|
|
if k > 0 then
|
|
AssignPageProps_Word(aPage, p^.Page, WriteWithTitul, i > 1)
|
|
else
|
|
AssignPageProps_Word(aPage, p^.Page, WriteWithTitul, i > 0);
|
|
|
|
for j := 0 to p^.Page.Objects.Count - 1 do
|
|
begin
|
|
ExportObj_W(aPage, p^.Page.Objects[j], MemoCounter, DrawedObjects);
|
|
(*
|
|
if TObject(p^.Page.Objects[j]).ClassNAme = 'TfrMemoView' then
|
|
begin
|
|
if ((TfrMemoView(p^.Page.Objects[j]).x > aPage.width) or (TfrMemoView(p^.Page.Objects[j]).x + TfrMemoView(p^.Page.Objects[j]).dx > aPage.width)) then
|
|
begin
|
|
k := k;
|
|
continue;
|
|
end;
|
|
|
|
if TfrMemoView(p^.Page.Objects[j]).x < 0 then
|
|
continue;
|
|
|
|
if TfrMemoView(p^.Page.Objects[j]).DX > 500 then
|
|
if TfrMemoView(p^.Page.Objects[j]).x <= 72 then
|
|
if TfrMemoView(p^.Page.Objects[j]).y < 100 then
|
|
if TfrMemoView(p^.Page.Objects[j]).Memo.text = '' then
|
|
continue;
|
|
|
|
if TfrMemoView(p^.Page.Objects[j]).x <= 72 then
|
|
if TfrMemoView(p^.Page.Objects[j]).y < 100 then
|
|
if (TfrMemoView(p^.Page.Objects[j]).x + TfrMemoView(p^.Page.Objects[j]).dx) <= 72 then
|
|
if TfrMemoView(p^.Page.Objects[j]).MeMo.Text = '' then
|
|
continue;
|
|
|
|
|
|
NewMemo := TfrxMemoView.Create(aPage);
|
|
NewMemo.Name := 'Memo' + inttostr(MemoCounter);
|
|
inc(MemoCounter);
|
|
//NewMemo := TfrxMemoView.Create(nil);
|
|
SetfrxView_Word(NewMemo, TfrMemoView(p^.Page.Objects[j]));
|
|
NewMemo.Memo.Text := trim(TfrMemoView(p^.Page.Objects[j]).Memo.Text);
|
|
NewMemo.Memo.Text := trim(StringReplace(NewMemo.Memo.Text, #$1, '', [rfReplaceAll, rfIgnoreCase]));
|
|
end
|
|
else
|
|
if TObject(p^.Page.Objects[j]).ClassName = 'TfrLineView' then
|
|
begin
|
|
NewShape := TfrxShapeView.Create(aPage);
|
|
SetfrxShapeView_Word(NewShape, TfrLineView((p^.Page.Objects[j])));
|
|
DrawedObjects := True;
|
|
end
|
|
else
|
|
if TObject(p^.Page.Objects[j]).ClassName = 'TfrPictureView' then
|
|
begin
|
|
NewPict := TfrxPictureView.Create(aPage);
|
|
SetfrxPictView_Word(NewPict, TfrPictureView(p^.Page.Objects[j]));
|
|
end;
|
|
*)
|
|
end;
|
|
end;
|
|
if not aFromPreview then
|
|
TF_Main(F_ProjMan).F_ProgressExp.EndExportPage;
|
|
end;
|
|
// Tolik 07/09/2020 --
|
|
//if not WriteWithTitul then
|
|
|
|
// aPage.TopMargin := 5;
|
|
// aPage.BottomMargin := 6;
|
|
|
|
|
|
aPreviewPages.AddPage(aPage);
|
|
|
|
if WriteWithTitul then
|
|
aPreviewPages.PageCache.AddObject(inttostr(i - 1), aPage)
|
|
else
|
|
aPreviewPages.PageCache.AddObject(inttostr(i), aPage);
|
|
end;
|
|
|
|
if DrawedObjects then
|
|
begin
|
|
tempList := TList.Create;
|
|
for j := 0 to aPreviewPages.Count - 1 do
|
|
begin
|
|
aPage := aPreviewPages.Page[j];
|
|
for k := 0 to aPage.Objects.Count - 1 do
|
|
begin
|
|
if (TObject(aPage.Objects[k]) is TfrxShapeView) then
|
|
begin
|
|
TempList.Add(aPage.Objects[k]);
|
|
aPage.Objects[k] := nil;
|
|
end;
|
|
end;
|
|
aPage.Objects.Pack;
|
|
|
|
for k := 0 to TempList.Count - 1 do
|
|
aPage.Objects.Add(TempList[k]);
|
|
TempList.Clear;
|
|
end;
|
|
FreeAndNil(TempList);
|
|
end;
|
|
|
|
if aFromPreview then
|
|
FilterDoc.OpenAfterExport := True
|
|
else
|
|
FilterDoc.OpenAfterExport := False;
|
|
|
|
aPreviewPages.Export(FilterDoc);
|
|
FilterDoc.Free;
|
|
NewRep.Free;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
ShowMessage('Export Error!');
|
|
end;
|
|
|
|
if not aFromPreview then
|
|
begin
|
|
TF_Main(F_ProjMan).F_ResourceReport.ReportCountPrinted := TF_Main(F_ProjMan).F_ResourceReport.ReportCountPrinted + 1;
|
|
TF_Main(F_ProjMan).F_ProgressExp.EndExportReport;
|
|
end;
|
|
end;
|
|
|
|
//function ExportReportToXLSX(aFileName: String; aReport: tfrReport): Boolean;
|
|
function ExportReportToXLSX(aFileName: String; aReport: tfrReport; aFromPreview: Boolean = False ): Boolean;
|
|
var i, j, k,l: Integer;
|
|
Filter: TfrxXLSXExport;
|
|
FilterDoc: TfrxDOCXExport;
|
|
NewRep: TfrxReport;
|
|
t: TfrView;
|
|
p: PfrPageInfo;
|
|
b: Byte;
|
|
s: string;
|
|
NewMemo: TfrxMemoView;
|
|
//NewLine: TfrxLineView;
|
|
NewPict, NewLine: TfrxPictureView;
|
|
aPreviewPages, TitulPreviewPages: TfrxPreviewPages;
|
|
NewShape: TfrxShapeView;
|
|
apage: TfrxReportPage;
|
|
//frXLSXExport: TfrXLSXExport;
|
|
frxXLSXExport: TfrxXLSXExport;
|
|
f: TextFile;
|
|
TempList: TList;
|
|
Stream: TMeMoryStream;
|
|
ExportStream: TFileStream;
|
|
WriteWithTitul: boolean;
|
|
LineList: TList;
|
|
MemoCounter: Integer;
|
|
MemoList: TStringList;
|
|
ReportFileName: String;
|
|
AllReportPages: TfrEMFPages;
|
|
begin
|
|
MemoCounter := 1;
|
|
PageDeltaY := 0;
|
|
|
|
if aFromPreview then
|
|
AllReportPages := TfrEMFPages(aReport.Preview.Window.EMFPages)
|
|
else
|
|
AllReportPages := TfrEMFPages(aReport.EMFPages);
|
|
|
|
|
|
ReportFileName := ExtractFileName(aReport.FileName);
|
|
|
|
MemoList := TStringList.Create;
|
|
if not CheckFormatCells(aReport, MemoList) then
|
|
FreeAndNil(MemoList);
|
|
|
|
if not aFromPreview then
|
|
TF_Main(F_ProjMan).F_ProgressExp.StartExport(AllReportPages.Count, ExtractFileName(aFileName));
|
|
try
|
|
TitulPreviewPages := nil;
|
|
WriteWithTitul := false;
|
|
begin
|
|
// --------------------- EXCEL -----------------------------------------------------
|
|
for i := 0 to AllReportPages.Count - 1 do
|
|
AllReportPages.Pages[i]^.Visible := True;
|
|
|
|
if AllReportPages.Count > 1 then
|
|
if (AllReportPages.Pages[0]^.pgOr <> AllReportPages.Pages[1]^.pgOr) then
|
|
WriteWithTitul := True;
|
|
|
|
if Not WriteWithTitul then
|
|
begin
|
|
if Pos('Gost', ReportFileName) > 0 then
|
|
WriteWithTitul := true
|
|
else
|
|
if Pos('STAMP', ReportFileName) > 0 then
|
|
WriteWithTitul := true;
|
|
end;
|
|
|
|
|
|
if WriteWithTitul then
|
|
k := 1
|
|
else
|
|
k := 0;
|
|
|
|
PageDeltaY := 0;
|
|
if WriteWithTitul then
|
|
begin
|
|
NewRep := TfrxReport.Create(nil);
|
|
frxXLSXExport := TfrxXLSXExport.Create(NewRep);
|
|
frxXLSXExport.ShowDialog := False;
|
|
//frxXLSXExport.emptyLines := True;
|
|
frxXLSXExport.showProgress := False;
|
|
{frxXLSXExport.EmptyLines := False;
|
|
frxXLSXExport.DataOnly := True;
|
|
frxXLSXExport.ExportNotPrintable := False;}
|
|
|
|
|
|
TitulPreviewPages := TfrxPreviewPages.Create(NewRep);
|
|
TitulPreviewPages.Engine := NewRep.Engine;
|
|
LineList := TList.Create;
|
|
|
|
p := AllReportPages.Pages[0];
|
|
if not Assigned(p^.Page) then
|
|
AllReportPages.ObjectsToPage(0);
|
|
|
|
aPage := TfrxReportPage.Create(NewRep);
|
|
aPage.SetDefaults;
|
|
|
|
AssignPageProps(aPage, p^.Page, True);
|
|
|
|
for j := 0 to p^.Page.Objects.Count - 1 do
|
|
begin
|
|
if TObject(p^.Page.Objects[j]).ClassNAme = 'TfrMemoView' then
|
|
begin
|
|
if TfrMemoView(p^.Page.Objects[j]).x > aPage.width then
|
|
continue;
|
|
|
|
if TfrMemoView(p^.Page.Objects[j]).x <= 72 then
|
|
if TfrMemoView(p^.Page.Objects[j]).y < 100 then
|
|
if TfrMemoView(p^.Page.Objects[j]).Memo.text = '' then
|
|
begin
|
|
if TfrMemoView(p^.Page.Objects[j]).dx > 500 then
|
|
if TfrMemoView(p^.Page.Objects[j]).y <= 40 then
|
|
if TfrMemoView(p^.Page.Objects[j]).x <= 72 then
|
|
if Trim(TfrMemoView(p^.Page.Objects[j]).Memo.Text) = '' then
|
|
//PageDeltaY := PageDeltaY - TfrMemoView(p^.Page.Objects[j]).dy;
|
|
continue;
|
|
end;
|
|
if TfrMemoView(p^.Page.Objects[j]).x <= 72 then
|
|
if TfrMemoView(p^.Page.Objects[j]).y < 100 then
|
|
if TfrMemoView(p^.Page.Objects[j]).Memo.text = '' then
|
|
if TfrMemoView(p^.Page.Objects[j]).dx > 500 then
|
|
continue;
|
|
|
|
NewMemo := TfrxMemoView.Create(aPage);
|
|
NewMemo.Name := 'Memo' + inttostr(MemoCounter);
|
|
inc(MemoCounter);
|
|
SetfrxView(NewMemo, TfrMemoView(p^.Page.Objects[j]), MemoList, false);
|
|
NewMemo.Memo.Text := trim(TfrMemoView(p^.Page.Objects[j]).Memo.Text);
|
|
NewMemo.Memo.Text := trim(StringReplace(NewMemo.Memo.Text, #$1, '', [rfReplaceAll, rfIgnoreCase]));
|
|
end
|
|
else
|
|
if TObject(p^.Page.Objects[j]).ClassName = 'TfrLineView' then
|
|
begin
|
|
NewLine := TfrxPictureView.Create(aPage);
|
|
//SetfrxLineView(NewLine, TfrLineView(p^.Page.Objects[j]), false, false);
|
|
SetfrxLineView(NewLine, TfrLineView(p^.Page.Objects[j]), false, true);
|
|
LineList.Add(NewLine);
|
|
end
|
|
else
|
|
if TObject(p^.Page.Objects[j]).ClassName = 'TfrPictureView' then
|
|
begin
|
|
NewPict := TfrxPictureView.Create(aPage);
|
|
SetfrxPictView(NewPict, TfrPictureView(p^.Page.Objects[j]), false);
|
|
end;
|
|
end;
|
|
aPage.LeftMargin := 5;
|
|
//aPage.BottomMargin := 5;
|
|
aPage.TopMargin := 5;
|
|
aPage.RightMargin := 5;
|
|
aPage.Frame.Width := 0;
|
|
TitulPreviewPages.AddPage(aPage);
|
|
TitulPreviewPages.PageCache.AddObject('0', aPage);
|
|
s := aFileName;
|
|
s := StringReplace(s,'.xlsx','',[rfReplaceAll, rfIgnoreCase]);
|
|
s := s + '_Titul' + '.xlsx';
|
|
frxXLSXExport.FileName := s;
|
|
|
|
frxXLSXExport.FileName := s;
|
|
for i := 0 to TitulPreviewPages.Count - 1 do
|
|
begin
|
|
aPage := TitulPreviewPages.Page[i];
|
|
for j := 0 to aPage.Objects.Count - 1 do
|
|
begin
|
|
if TComponent(aPage.Objects[j]) is TfrxPictureView then
|
|
begin
|
|
for l := 0 to LineList.Count - 1 do
|
|
begin
|
|
if TfrxPictureView(aPage.Objects[j]).Name = TfrxPictureView(LineList[l]).Name then
|
|
begin
|
|
TfrxPictureView(aPage.Objects[j]).Name := TfrxPictureView(aPage.Objects[j]).Name + '_DrawLine';
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
LineList.free;
|
|
|
|
if aFromPreview then
|
|
frxXLSXExport.OpenAfterExport := True
|
|
else
|
|
frxXLSXExport.OpenAfterExport := False;
|
|
|
|
TitulPreviewPages.Export(frxXLSXExport);
|
|
TitulPreviewPages.Free;
|
|
frxXLSXExport.Free;
|
|
NewRep.Free;
|
|
|
|
TF_Main(F_ProjMan).F_ProgressExp.EndExportPage;
|
|
end;
|
|
|
|
NewRep := TfrxReport.Create(nil);
|
|
frxXLSXExport := TfrxXLSXExport.Create(NewRep);
|
|
frxXLSXExport.ShowDialog := False;
|
|
//frxXLSXExport.emptyLines := True;
|
|
frxXLSXExport.showProgress := False;
|
|
|
|
aPreviewPages := TfrxPreviewPages.Create(NewRep);
|
|
aPreviewPages.Engine := NewRep.Engine;
|
|
LineList := TList.Create;
|
|
for i := k to AllReportPages.Count - 1 do
|
|
begin
|
|
PageDeltaY := 0;
|
|
p := AllReportPages.Pages[i];
|
|
begin
|
|
if not Assigned(p^.Page) then
|
|
AllReportPages.ObjectsToPage(i);
|
|
begin
|
|
aPage := TfrxReportPage.Create(NewRep);
|
|
// ********************************************************************
|
|
aPage.SetDefaults;
|
|
aPage.Frame.Width := 0;
|
|
AssignPageProps(aPage, p^.Page, WriteWithTitul);
|
|
PageDeltaY := 0;
|
|
PageDeltaY := GetPageDeltaY(p^.Page);
|
|
|
|
for j := 0 to p^.Page.Objects.Count - 1 do
|
|
begin
|
|
ExportObj_X(aPage, LineList, Pointer(p^.Page.Objects[j]), MemoList, MemoCounter);
|
|
|
|
(*
|
|
if TObject(p^.Page.Objects[j]).ClassNAme = 'TfrMemoView' then
|
|
begin
|
|
if ((TfrMemoView(p^.Page.Objects[j]).x > aPage.width) or (TfrMemoView(p^.Page.Objects[j]).x + TfrMemoView(p^.Page.Objects[j]).dx > aPage.width)) then
|
|
begin
|
|
k := k;
|
|
continue;
|
|
end;
|
|
//if i > k then
|
|
if TfrMemoView(p^.Page.Objects[j]).dx > 500 then
|
|
if TfrMemoView(p^.Page.Objects[j]).x <= 72 then
|
|
if TfrMemoView(p^.Page.Objects[j]).y < 100 then
|
|
if TfrMemoView(p^.Page.Objects[j]).Memo.text = '' then
|
|
begin
|
|
//if TfrMemoView(p^.Page.Objects[j]).y <= 40 then
|
|
//if TfrMemoView(p^.Page.Objects[j]).x <= 72 then
|
|
// if Trim(TfrMemoView(p^.Page.Objects[j]).Memo.Text) = '' then
|
|
// PageDeltaY := PageDeltaY - TfrMemoView(p^.Page.Objects[j]).dy;
|
|
continue;
|
|
end;
|
|
if TfrMemoView(p^.Page.Objects[j]).x <= 72 then
|
|
if TfrMemoView(p^.Page.Objects[j]).y < 100 then
|
|
if (TfrMemoView(p^.Page.Objects[j]).x + TfrMemoView(p^.Page.Objects[j]).dx) <= 72 then
|
|
if TfrMemoView(p^.Page.Objects[j]).Memo.Text = '' then
|
|
continue;
|
|
{ if TfrMemoView(p^.Page.Objects[j]).x <= 12 then
|
|
continue;}
|
|
NewMemo := TfrxMemoView.Create(aPage);
|
|
NewMemo.Name := 'Memo' + inttostr(MemoCounter);
|
|
inc(MemoCounter);
|
|
//SetfrxView(NewMemo, TfrMemoView(p^.Page.Objects[j]), MemoList, (i > 0) );
|
|
|
|
SetfrxView(NewMemo, TfrMemoView(p^.Page.Objects[j]), MemoList, true);
|
|
NewMemo.Memo.Text := trim(TfrMemoView(p^.Page.Objects[j]).Memo.Text);
|
|
end
|
|
else
|
|
if TObject(p^.Page.Objects[j]).ClassName = 'TfrLineView' then
|
|
begin
|
|
NewLine := TfrxPictureView.Create(aPage);
|
|
//SetfrxLineView(NewLine, TfrLineView(p^.Page.Objects[j]), false, (i > 0));
|
|
//SetfrxLineView(NewLine, TfrLineView(p^.Page.Objects[j]), false, true);
|
|
//SetfrxLineView(NewLine, TfrLineView(p^.Page.Objects[j]), false, false);
|
|
SetfrxLineView(NewLine, TfrLineView(p^.Page.Objects[j]), false, true);
|
|
LineList.Add(NewLine);
|
|
end
|
|
else
|
|
if TObject(p^.Page.Objects[j]).ClassName = 'TfrPictureView' then
|
|
begin
|
|
NewPict := TfrxPictureView.Create(aPage);
|
|
//SetfrxPictView(NewPict, TfrPictureView(p^.Page.Objects[j]), (i > 0));
|
|
SetfrxPictView(NewPict, TfrPictureView(p^.Page.Objects[j]), true);
|
|
end;
|
|
*)
|
|
end;
|
|
if WriteWithTitul then
|
|
begin
|
|
aPage.LeftMargin := 5;
|
|
aPage.BottomMargin := 5;
|
|
aPage.TopMargin := 5;
|
|
aPage.RightMargin := 5;
|
|
end;
|
|
end;
|
|
TF_Main(F_ProjMan).F_ProgressExp.EndExportPage;
|
|
end;
|
|
//25/09/2020 --
|
|
{if not WritewIthTitul then
|
|
if i > 0 then
|
|
aPage.TopMargin := 5;}
|
|
|
|
aPreviewPages.AddPage(aPage);
|
|
if WriteWithTitul then
|
|
aPreviewPages.PageCache.AddObject(inttostr(i - 1), aPage)
|
|
else
|
|
aPreviewPages.PageCache.AddObject(inttostr(i), aPage);
|
|
end;
|
|
|
|
for i := 0 to aPreviewPages.Count - 1 do
|
|
begin
|
|
aPage := aPreviewPages.Page[i];
|
|
for j := 0 to aPage.Objects.Count - 1 do
|
|
begin
|
|
if TComponent(aPage.Objects[j]) is TfrxPictureView then
|
|
begin
|
|
for k := 0 to LineList.Count - 1 do
|
|
begin
|
|
if TfrxPictureView(aPage.Objects[j]).Name = TfrxPictureView(LineList[k]).Name then
|
|
begin
|
|
TfrxPictureView(aPage.Objects[j]).Name := TfrxPictureView(aPage.Objects[j]).Name + '_DrawLine';
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
LineList.Free;
|
|
|
|
tempList := TList.Create;
|
|
for i := 0 to aPreviewPages.Count - 1 do
|
|
begin
|
|
aPage := aPreviewPages.Page[i];
|
|
for j := 0 to aPage.Objects.Count - 1 do
|
|
begin
|
|
if (TObject(aPage.Objects[j]) is TfrxPictureView) then
|
|
begin
|
|
TempList.Add(aPage.Objects[j]);
|
|
aPage.Objects[j] := nil;
|
|
end;
|
|
end;
|
|
aPage.Objects.Pack;
|
|
|
|
for j := 0 to TempList.Count - 1 do
|
|
aPage.Objects.Add(TempList[j]);
|
|
|
|
TempList.Clear;
|
|
end;
|
|
FreeAndNil(TempList);
|
|
|
|
frxXLSXExport.FileName := aFileName;
|
|
|
|
if aFromPreview then
|
|
frxXLSXExport.OpenAfterExport := True
|
|
else
|
|
frxXLSXExport.OpenAfterExport := False;
|
|
//frxXLSXExport.EmptyLines
|
|
//frxXLSXExport.ExportPageBreaks := True;
|
|
//frxXLSXExport.Wysiwyg := True;
|
|
aPreviewPages.Export(frxXLSXExport);
|
|
|
|
frxXLSXExport.Free;
|
|
NewRep.Free;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
ShowMessage('Export Error!');
|
|
end;
|
|
|
|
if not aFromPreview then
|
|
begin
|
|
TF_Main(F_ProjMan).F_ResourceReport.ReportCountPrinted := TF_Main(F_ProjMan).F_ResourceReport.ReportCountPrinted + 1;
|
|
TF_Main(F_ProjMan).F_ProgressExp.EndExportReport;
|
|
end;
|
|
|
|
if MemoList <> nil then
|
|
MemoList.free;
|
|
end;
|
|
|
|
(*
|
|
function ExportReportToXLSX(aFileName: String; aReport: tfrReport): Boolean;
|
|
var i, j: integer;
|
|
Filter: TfrxXLSXExport;
|
|
FilterDoc: TfrxDOCXExport;
|
|
NewRep: TfrxReport;
|
|
Stream: TMemoryStream;
|
|
Compressor: TfrxCustomCompressor;
|
|
ffrCompressor: TfrCompressor;
|
|
my_Obj: TMy_Obj;
|
|
frDBDataset_Master, frDBDataset_MasterFirst, frDBDataset_Detail, frDBDataset_SubDetail, frDBDataset1, frDBDataset2, frDBDataset3: TfrxDBDataset;
|
|
c: TfrxComponent;
|
|
d: TfrxDataband;
|
|
dFNAme, s: string;
|
|
f: TextFile;
|
|
OldPrev: TfrPreview;
|
|
NewMemo: TfrxMemoView;
|
|
p: PfrPageInfo;
|
|
b: Byte;
|
|
t: TfrView;
|
|
|
|
Procedure SetNewReportPagesVisibility;
|
|
var i: integer;
|
|
begin
|
|
if TF_Main(F_ProjMan).F_ResourceReport.ReportPagesVisibilityList = nil then
|
|
exit;
|
|
if TF_Main(F_ProjMan).F_ResourceReport.ReportPagesVisibilityList.Count = 0 then
|
|
exit;
|
|
|
|
if (NewRep.PagesCount - 1) = TF_Main(F_ProjMan).F_ResourceReport.ReportPagesVisibilityList.Count then
|
|
begin
|
|
for i := 0 to TF_Main(F_ProjMan).F_ResourceReport.ReportPagesVisibilityList.Count - 1 do
|
|
begin
|
|
if TF_Main(F_ProjMan).F_ResourceReport.ReportPagesVisibilityList[i] = 1 then
|
|
NewRep.Pages[i + 1].Visible := True
|
|
else
|
|
NewRep.Pages[i + 1].Visible := false;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function CheckConnDataset(aSet: TfrxComponent): Boolean;
|
|
begin
|
|
Result := (
|
|
(aSet.ClassName = 'TfrxMasterData') or
|
|
(aSet.ClassName = 'TfrxReportTitle') or
|
|
(aSet.ClassName = 'TfrxReportSummary') or
|
|
(aSet.ClassName = 'TfrxPageFooter') or
|
|
(aSet.ClassName = 'TfrxDetailData') or
|
|
(aSet.ClassName = 'TfrxFooter') or
|
|
(aSet.ClassName = 'TfrxHeader') or
|
|
(aSet.ClassName = 'TfrxPageHeader') or
|
|
(aSet.ClassName = 'TfrxFooter') or
|
|
(aSet.ClassName = 'TfrxSubdetailData') or
|
|
(aSet.ClassName = 'TfrxOverlay') or
|
|
(aSet.ClassName = 'TfrxPictureView')
|
|
);
|
|
end;
|
|
|
|
Procedure CorrectPictureField(aView: TfrxPictureView);
|
|
var s, cs: String;
|
|
i,fPos, Lens: integer;
|
|
begin
|
|
s := aView.DataField;
|
|
fPos := Pos('"', s);
|
|
if FPos > 0 then
|
|
begin
|
|
cs := '';
|
|
inc(FPos);
|
|
LenS := Length(s);
|
|
if FPos < Lens then
|
|
begin
|
|
for i := FPos to Lens do
|
|
begin
|
|
if s[i] = '"' then
|
|
break
|
|
else
|
|
cs := cs + s[i];
|
|
end;
|
|
end;
|
|
if cs <> '' then
|
|
aView.DataField := cs;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Result := False;
|
|
NullStrictConvert := false;
|
|
|
|
NewRep := TfrxReport.Create(aReport.Owner);
|
|
|
|
Filter := TfrxXLSXExport.Create(NewRep);
|
|
|
|
Filter.FileName := aFileName;
|
|
Filter.ShowDialog := False;
|
|
|
|
{dFNAme := aFileName;
|
|
delete(dFName, Pos('.xlsx',dFName),5);
|
|
dFName := dFName + '.docx';
|
|
FilterDoc := TfrxDOCXExport.Create(NewRep);
|
|
FilterDoc.FileName := aFileName;
|
|
FilterDoc.ShowDialog := False;}
|
|
|
|
Stream := TMemoryStream.Create;
|
|
aReport.SaveToStream(stream);
|
|
Stream.Position := 0;
|
|
|
|
NewRep.LoadFromStream(Stream);
|
|
|
|
// Datasets (BEGIN)
|
|
//Create
|
|
//1
|
|
frDBDataset_Master := TfrxDbDataset.Create(Nil);
|
|
frDBDataset_Master.Name := 'frDBDataSet_Master';
|
|
//2
|
|
frDBDataset_MasterFirst := TfrxDbDataset.Create(Nil);
|
|
frDBDataset_MasterFirst.Name := 'frDBDataSet_MasterFirst';
|
|
//3
|
|
frDBDataset_Detail := TfrxDbDataset.Create(Nil);
|
|
frDBDataset_Detail.Name := 'frDBDataSet_Detail';
|
|
//4
|
|
frDBDataset_SubDetail := TfrxDbDataset.Create(Nil);
|
|
frDBDataset_SubDetail.Name := 'frDBDataset_SubDetail';
|
|
//5
|
|
frDBDataset1 := TfrxDbDataset.Create(Nil);
|
|
frDBDataset1.Name := 'frDBDataset1';
|
|
//6
|
|
frDBDataset2 := TfrxDbDataset.Create(Nil);
|
|
frDBDataset2.Name := 'frDBDataset2';
|
|
//7
|
|
frDBDataset3 := TfrxDbDataset.Create(Nil);
|
|
frDBDataset3.Name := 'frDBDataset3';
|
|
|
|
//Settings
|
|
//1
|
|
frDBDataset_Master.OpenDataSource := True;
|
|
frDBDataset_Master.RangeBegin := rbFirst;
|
|
frDBDataset_Master.RangeEnd := reLast;
|
|
//2
|
|
frDBDataset_MasterFirst.OpenDataSource := True;
|
|
frDBDataset_MasterFirst.RangeBegin := rbFirst;
|
|
frDBDataset_MasterFirst.RangeEnd := reLast;
|
|
//3
|
|
frDBDataset_Detail.OpenDataSource := True;
|
|
frDBDataset_Detail.RangeBegin := rbFirst;
|
|
frDBDataset_Detail.RangeEnd := reLast;
|
|
//4
|
|
frDBDataset_SubDetail.OpenDataSource := True;
|
|
frDBDataset_SubDetail.RangeBegin := rbFirst;
|
|
frDBDataset_SubDetail.RangeEnd := reLast;
|
|
//5
|
|
frDBDataset1.OpenDataSource := True;
|
|
frDBDataset1.RangeBegin := rbFirst;
|
|
frDBDataset1.RangeEnd := reLast;
|
|
//6
|
|
frDBDataset2.OpenDataSource := True;
|
|
frDBDataset2.RangeBegin := rbFirst;
|
|
frDBDataset2.RangeEnd := reLast;
|
|
//7
|
|
frDBDataset3.OpenDataSource := True;
|
|
frDBDataset3.RangeBegin := rbFirst;
|
|
frDBDataset3.RangeEnd := reLast;
|
|
|
|
//Define
|
|
//1
|
|
frDBDataset_Master.DataSource := TF_Main(F_ProjMan).F_ResourceReport.frDBDataSet_Master.DataSource;
|
|
frDBDataset_Master.DataSet := TF_Main(F_ProjMan).F_ResourceReport.frDBDataSet_Master.DataSet;
|
|
//2
|
|
frDBDataset_MasterFirst.DataSource := TF_Main(F_ProjMan).F_ResourceReport.frDBDataSet_MasterFirst.DataSource;
|
|
frDBDataset_MasterFirst.DataSet := TF_Main(F_ProjMan).F_ResourceReport.frDBDataSet_MasterFirst.DataSet;
|
|
//3
|
|
frDBDataset_Detail.DataSource := TF_Main(F_ProjMan).F_ResourceReport.frDBDataSet_Detail.DataSource;
|
|
frDBDataset_Detail.DataSet := TF_Main(F_ProjMan).F_ResourceReport.frDBDataSet_Detail.DataSet;
|
|
//4
|
|
frDBDataset_SubDetail.DataSource := TF_Main(F_ProjMan).F_ResourceReport.frDBDataSet_SubDetail.DataSource;
|
|
frDBDataset_SubDetail.DataSet := TF_Main(F_ProjMan).F_ResourceReport.frDBDataSet_SubDetail.DataSet;
|
|
//5
|
|
frDBDataset1.DataSource := TF_Main(F_ProjMan).F_ResourceReport.frDBDataSet1.DataSource;
|
|
frDBDataset1.DataSet := TF_Main(F_ProjMan).F_ResourceReport.frDBDataSet1.DataSet;
|
|
//6
|
|
frDBDataset2.DataSource := TF_Main(F_ProjMan).F_ResourceReport.frDBDataSet2.DataSource;
|
|
frDBDataset2.DataSet := TF_Main(F_ProjMan).F_ResourceReport.frDBDataSet2.DataSet;
|
|
//7
|
|
frDBDataset3.DataSource := TF_Main(F_ProjMan).F_ResourceReport.frDBDataSet3.DataSource;
|
|
frDBDataset3.DataSet := TF_Main(F_ProjMan).F_ResourceReport.frDBDataSet3.DataSet;
|
|
|
|
// Add to report assigned values
|
|
//1
|
|
if frDBDataset_Master.DataSource <> nil then
|
|
if frDBDataset_Master.DataSource.State <> dsInactive then
|
|
if frDBDataset_Master.DataSource.DataSet <> nil then
|
|
begin
|
|
frDBDataset_Master.DataSource.DataSet.First;
|
|
frDBDataset_Master.UserName := frDBDataset_Master.DataSource.DataSet.Name;
|
|
NewRep.DataSets.Add(frDBDataset_Master);
|
|
end;
|
|
//2
|
|
if frDBDataset_MasterFirst.DataSource <> nil then
|
|
if frDBDataset_MasterFirst.DataSource.State <> dsInactive then
|
|
if frDBDataset_MasterFirst.DataSource.DataSet <> nil then
|
|
begin
|
|
frDBDataset_MasterFirst.DataSource.DataSet.First;
|
|
frDBDataset_MasterFirst.UserName := frDBDataset_MasterFirst.DataSource.DataSet.Name;
|
|
NewRep.DataSets.Add(frDBDataset_MasterFirst);
|
|
end;
|
|
//3
|
|
if frDBDataset_Detail.DataSource <> nil then
|
|
if frDBDataset_Detail.DataSource.State <> dsInactive then
|
|
if frDBDataset_Detail.DataSource.DataSet <> nil then
|
|
begin
|
|
frDBDataset_Detail.DataSource.DataSet.First;
|
|
frDBDataset_Detail.UserName := frDBDataset_Detail.DataSource.DataSet.Name;
|
|
NewRep.DataSets.Add(frDBDataset_Detail);
|
|
end;
|
|
//4
|
|
if frDBDataset_SubDetail.DataSource <> nil then
|
|
if frDBDataset_SubDetail.DataSource.State <> dsInactive then
|
|
if frDBDataset_SubDetail.DataSource.DataSet <> nil then
|
|
begin
|
|
frDBDataset_SubDetail.DataSource.DataSet.First;
|
|
frDBDataset_SubDetail.UserName := frDBDataset_SubDetail.DataSource.DataSet.Name;
|
|
NewRep.DataSets.Add(frDBDataset_Detail);
|
|
end;
|
|
//5
|
|
if frDBDataset1.DataSource <> nil then
|
|
if frDBDataset1.DataSource.State <> dsInactive then
|
|
if frDBDataset1.DataSource.DataSet <> nil then
|
|
begin
|
|
frDBDataset1.DataSource.DataSet.First;
|
|
frDBDataset1.UserName := frDBDataset1.DataSource.DataSet.Name;
|
|
NewRep.DataSets.Add(frDBDataset1);
|
|
end;
|
|
//6
|
|
if frDBDataset2.DataSource <> nil then
|
|
if frDBDataset2.DataSource.State <> dsInactive then
|
|
if frDBDataset2.DataSource.DataSet <> nil then
|
|
begin
|
|
frDBDataset2.DataSource.DataSet.First;
|
|
frDBDataset2.UserName := frDBDataset2.DataSource.DataSet.Name;
|
|
NewRep.DataSets.Add(frDBDataset2);
|
|
end;
|
|
//7
|
|
if frDBDataset3.DataSource <> nil then
|
|
if frDBDataset3.DataSource.State <> dsInactive then
|
|
if frDBDataset3.DataSource.DataSet <> nil then
|
|
begin
|
|
frDBDataset3.DataSource.DataSet.First;
|
|
frDBDataset3.UserName := frDBDataset3.DataSource.DataSet.Name;
|
|
NewRep.DataSets.Add(frDBDataset3);
|
|
end;
|
|
|
|
// Datasets (END)
|
|
|
|
AssignFile(f, 'c:\ImpClasses.txt');
|
|
rewrite(f);
|
|
for i := 0 to NewRep.AllObjects.Count - 1 do
|
|
begin
|
|
c := NewRep.AllObjects[i];
|
|
s := c.ClassName;
|
|
writeln(f, s);
|
|
//if ((c is TfrxDataband) or (c is TfrxReportSummary)) then
|
|
if CheckConnDataset(c) then
|
|
begin
|
|
d := NewRep.AllObjects[i];
|
|
if (d.DataSet = nil) or (d.ClassName = 'TfrxPictureView') then
|
|
begin
|
|
if (d.ClassName = 'TfrxPictureView') then
|
|
begin
|
|
c := d.Parent;
|
|
s := '';
|
|
if c <> nil then
|
|
begin
|
|
s := TfrxDataband(c).DatasetName;
|
|
TfrxPictureView(NewRep.AllObjects[i]).DatasetName := s;
|
|
CorrectPictureField(TfrxPictureView(TfrxPictureView(NewRep.AllObjects[i])));
|
|
end;
|
|
end
|
|
else
|
|
s := d.DatasetName;
|
|
|
|
if ((CompareStr(s, frDBDataset_Master.UserName) = 0) or
|
|
(CompareStr(s, frDBDataset_Master.Name) = 0)) then
|
|
d.DataSet := frDBDataset_Master
|
|
else
|
|
if ((s = frDBDataset_Detail.UserName) or
|
|
(s = frDBDataset_Detail.Name)) then
|
|
d.DataSet := frDBDataset_Detail
|
|
else
|
|
if ((s = frDBDataset_SubDetail.UserName) or
|
|
(s = frDBDataset_SubDetail.Name)) then
|
|
d.DataSet := frDBDataset_SubDetail
|
|
else
|
|
if ((s = frDBDataset1.UserName) or
|
|
(s = frDBDataset1.Name)) then
|
|
d.DataSet := frDBDataset1
|
|
else
|
|
if ((s = frDBDataset2.UserName) or
|
|
(s = frDBDataset2.Name)) then
|
|
d.DataSet := frDBDataset2
|
|
else
|
|
if ((s = frDBDataset_MasterFirst.UserName) or
|
|
(s = frDBDataset_MasterFirst.Name)) then
|
|
d.DataSet := frDBDataset_MasterFirst
|
|
else
|
|
if ((s = frDBDataset3.UserName) or
|
|
(s = frDBDataset3.UserName)) then
|
|
d.DataSet := frDBDataset3
|
|
end;
|
|
end;
|
|
end;
|
|
CloseFile(f);
|
|
|
|
SetNewReportPagesVisibility; // óñòàíîâèòü âèäèìîñòü ñòðàíèö ... êàê áûëî
|
|
//aReport.Dictionary.BandDatasources.Count
|
|
NewRep.OnUserFunction := TfrxUserFunctionEvent(aReport.OnUserFunction);
|
|
|
|
my_Obj := TMy_Obj.Create;
|
|
|
|
frxFR2Events.OnGetValue := My_Obj.DoGetValue;//aREport.OnGetValue;
|
|
|
|
|
|
NewRep.OnGetValue := aREport.OnGetValue;
|
|
//NewRep.EngineOptions.DoublePass := True;
|
|
// TF_Main(F_ProjMan).F_ResourceReport.ShowXLSXReport(NewRep);
|
|
|
|
(* aReport.PrepareReport;
|
|
if aReport.EMFPages.Count > 0 then
|
|
begin
|
|
for i := 0 to aReport.EMFPages.Count - 1 do
|
|
begin
|
|
p := aReport.EMFPages.Pages[I];
|
|
with p^ do
|
|
begin
|
|
Stream.Position := 0;
|
|
Stream.Read(frVersion, 1);
|
|
while Stream.Position < Stream.Size do
|
|
begin
|
|
Stream.Read(b, 1);
|
|
if b = gtAddIn then
|
|
s := frReadString(Stream) else
|
|
s := '';
|
|
t := frCreateObject(b, s);
|
|
//t.StreamMode := smFRP;
|
|
t.LoadFromStream(Stream);
|
|
|
|
NewMemo := TfrxMemoView.Create(NewRep);
|
|
{NewMemo.Font := TFont.Create;
|
|
NewMemo.FHighlights := TfrxHighlightCollection.Create;
|
|
NewMemo.FFormats := TfrxFormatCollection.Create;}
|
|
NewMemo.Memo := TfrxWideStrings.Create;
|
|
NewMemo.Memo.Text := t.Memo.Text;
|
|
NewMemo.Text := t.Memo.Text;
|
|
NewMemo.Top := t.y;
|
|
NewMemo.Left := t.x;
|
|
NewMemo.Width := t.dx;
|
|
NewMemo.Height := t.dy;
|
|
NewMemo.Frame.TopLine.Width := 1;
|
|
NewMemo.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
|
|
t.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
*)
|
|
(*
|
|
NewRep.Export(Filter);
|
|
|
|
stream.free;
|
|
//NewRep.Preview.Assign(aReport.Preview);
|
|
//NewRep.Free;
|
|
i := 0;
|
|
Filter.Free;
|
|
FilterDoc.Free;
|
|
NewRep.Free;
|
|
my_Obj.Free;
|
|
Result := True;
|
|
end;
|
|
*)
|
|
|
|
|
|
|
|
Procedure TMy_Obj.DoGetValue(const Expr: String; var Value: Variant);
|
|
var s, param: String;
|
|
TempStr: string;
|
|
i, j: integer;
|
|
p1, p2, p3: Variant;
|
|
begin
|
|
p1 := null;
|
|
p2 := null;
|
|
p3 := null;
|
|
|
|
s := Expr;
|
|
param := '';
|
|
TempStr := '';
|
|
j := pos('(', s);
|
|
if j > 0 then
|
|
begin
|
|
i := 1;
|
|
|
|
while s[i] <> '(' do
|
|
begin
|
|
TempStr := TempStr + s[i];
|
|
inc(i);
|
|
end;
|
|
|
|
inc(j);
|
|
|
|
while s[j] <> ')' do
|
|
begin
|
|
param := param + s[j];
|
|
inc(j);
|
|
end;
|
|
|
|
s := Tempstr;
|
|
p1 := param;
|
|
end;
|
|
TF_Main(F_ProjMan).F_ResourceReport.ReportUserFunction(s, p1, p2, p3, Value);
|
|
end;
|
|
|
|
(*
|
|
procedure UserFunction(const Name: String; var Val: Variant);
|
|
var
|
|
SCSProjCatalog: TSCSCatalog;
|
|
FooterBand: TfrBandView;
|
|
p1, p2, p3: Variant;
|
|
begin
|
|
SCSProjCatalog := nil;
|
|
|
|
if TF_Main(F_ProjMan).F_ResourceReport.Catalog <> nil then
|
|
if TF_Main(F_ProjMan).F_ResourceReport.Catalog.ItemType = itProject then
|
|
SCSProjCatalog := TF_Main(F_ProjMan).F_ResourceReport.Catalog
|
|
else
|
|
SCSProjCatalog := TF_Main(F_ProjMan).F_ResourceReport.Catalog.GetTopParentCatalog;
|
|
|
|
if Name = 'GETREPLABEL' then
|
|
Val := DateToStr(Date)+' '+cResourceReport_Msg24 +ApplicationName+' '+ VersionEXE
|
|
else
|
|
if Name = 'GETPROJECTNAME' then
|
|
begin
|
|
Val := '';
|
|
SCSProjCatalog := nil;
|
|
if Assigned(TF_Main(F_ProjMan).F_ResourceReport.Catalog) then
|
|
if TF_Main(F_ProjMan).F_ResourceReport.Catalog.ItemType = itProject then
|
|
SCSProjCatalog := TF_Main(F_ProjMan).F_ResourceReport.Catalog
|
|
else
|
|
SCSProjCatalog := TF_Main(F_ProjMan).F_ResourceReport.Catalog.GetTopParentCatalog;
|
|
if Assigned(SCSProjCatalog) then
|
|
Val := SCSProjCatalog.GetNameForVisible;
|
|
end
|
|
else
|
|
if Name = 'GETLISTNAME' then
|
|
begin
|
|
Val := '';
|
|
if Assigned(TF_Main(F_ProjMan).F_ResourceReport.Catalog) then
|
|
if TF_Main(F_ProjMan).F_ResourceReport.Catalog.ItemType = itList then
|
|
Val := TF_Main(F_ProjMan).F_ResourceReport.Catalog.GetNameForVisible
|
|
else
|
|
if TF_Main(F_ProjMan).F_ResourceReport.Catalog.ItemType = itDir then
|
|
Val := TF_Main(F_ProjMan).F_ResourceReport.Catalog.GetNameForVisible+' ('+GetCatalogItemsNames(TF_Main(F_ProjMan).F_ResourceReport.Catalog, [itList])+')';
|
|
end
|
|
else
|
|
if Name = 'GETCOMPONNAME' then
|
|
begin
|
|
Val := '';
|
|
if Assigned(TF_Main(F_ProjMan).F_ResourceReport.Component) then
|
|
val := TF_Main(F_ProjMan).F_ResourceReport.Component.GetNameForVisible;
|
|
end
|
|
//Tolik
|
|
else
|
|
if Name = 'GETISCOMPCABLE' then // 08/02/2018 --äëÿ îò÷åòà "Ïîëíûé ïóòü êàáåëÿ " -- ïîêàçàòåëü, ïðèíàäëåæèò ëè êàáåëü,
|
|
// íà êîòîðîì âûçâàí îò÷åò êîìïüþòåðíîé ñåòè
|
|
begin
|
|
if TF_Main(F_ProjMan).F_ResourceReport.isCompCable then
|
|
Val := 1
|
|
else
|
|
val := 0;
|
|
end
|
|
else
|
|
if Name = 'GETCABLENAME' then
|
|
begin
|
|
Val := '';
|
|
if Assigned(TF_Main(F_ProjMan).F_ResourceReport.Component) then
|
|
Val := TF_Main(F_ProjMan).F_ResourceReport.Component.Name;
|
|
end
|
|
else
|
|
if Name = 'GETCABLEZAPAS' then
|
|
begin
|
|
Val := null;
|
|
if TF_Main(F_ProjMan).F_ResourceReport.Catalog.ItemType = itList then
|
|
Val := TSCSList(TF_Main(F_ProjMan).F_ResourceReport.Catalog).Setting.LengthKoef;
|
|
end
|
|
else
|
|
if Name = 'GETZAKAZCHIKNAME' then
|
|
begin
|
|
if rkCalc in FReportUseKind then
|
|
Val := FCostOfProjectReportParams.ZakazchikName
|
|
else
|
|
begin
|
|
Val := F_ProjMan.GSCSBase.CurrProject.Setting.CustomerName;
|
|
end;
|
|
end
|
|
else
|
|
if Name = 'GETPODRADCHIKNAME' then
|
|
begin
|
|
if rkCalc in FReportUseKind then
|
|
Val := FCostOfProjectReportParams.PodradchikName
|
|
else
|
|
if SCSProjCatalog <> nil then
|
|
Val := TSCSProject(SCSProjCatalog).Setting.ContractorName
|
|
else
|
|
Val := '';
|
|
end
|
|
else
|
|
if Name = 'GETORGANIZATIONNAME' then
|
|
begin
|
|
if SCSProjCatalog <> nil then
|
|
Val := TSCSProject(SCSProjCatalog).Setting.OrganizationName;
|
|
end
|
|
else
|
|
if Name = 'GETCURRNPP' then
|
|
begin
|
|
Val := DefineCurrRecNo; //frDBDataSet_Master.DataSource.DataSet.RecNo;
|
|
end
|
|
else
|
|
if Name = 'GETISNEWRECORD' then
|
|
begin
|
|
if (FCurrRecNo = FOldRecNo) and (FOldRecNo <> 0) then
|
|
Val := false
|
|
else
|
|
Val := true;
|
|
end
|
|
else
|
|
if Name = 'GETPASSNUM' then
|
|
begin
|
|
Val := FPassNum;
|
|
end
|
|
else
|
|
if Name = 'INCPASSNUM' then
|
|
begin
|
|
Inc(FPassNum);
|
|
Val := FPassNum;
|
|
end
|
|
else
|
|
if Name = 'DEFINEPAGEFOOTER' then
|
|
begin
|
|
FooterBand := TfrBandView(Report.FindObject('PageFooter'));
|
|
end
|
|
else
|
|
if Name = 'GETLENGTHTHROUGHFLOOR' then
|
|
begin
|
|
Val := 0;
|
|
if F_ResourceReport.Catalog is TSCSProject then
|
|
Val := Round2(FloatInUOM(TSCSProject(F_ResourceReport.Catalog).Setting.HeightThroughFloor * (TSCSProject(F_ResourceReport.Catalog).IDsNearFloorFigures.Count) / 2,
|
|
umMetr, TF_Main(GForm).FUOM));
|
|
end
|
|
else
|
|
if Name = 'GETIZM' then
|
|
Val := GetNameUOM(TF_Main(GForm).FUOM, true)
|
|
else
|
|
if Name = 'GETIZMSYMB' then
|
|
Val := GetNameUOM(TF_Main(GForm).FUOM, true, false)
|
|
else
|
|
if Name = 'GETIZMLENMIN' then
|
|
Val := GetUOMLengthMin
|
|
else
|
|
if Name = 'GETIZMWEIGHT' then
|
|
Val := GetUOMWeight
|
|
else
|
|
if Name = 'GETNDS' then
|
|
begin
|
|
if rkProject in FReportUseKind then
|
|
begin
|
|
if SCSProjCatalog <> nil then
|
|
Val := TSCSProject(SCSProjCatalog).Setting.NDS;
|
|
end
|
|
end
|
|
else
|
|
if Name = 'GETPRICEWITHNDS' then //21.11.2013 - Âåðíóòü öåíó ñ ÍÄÑ
|
|
begin
|
|
Report.GetVariableValue(p1, Val);
|
|
if Val <> null then
|
|
if TSCSProject(SCSProjCatalog).Setting.NDS > 0 then
|
|
Val := Val * (TSCSProject(SCSProjCatalog).Setting.NDS/100+1)
|
|
end
|
|
else
|
|
if Name = 'GETTOTALLABORTIME' then
|
|
Val := GetDisplayTextToNORMLaborTime(IntToStr(FTotalLaborTime))
|
|
else
|
|
if Name = 'GETCAPT' then
|
|
begin
|
|
Val := '';
|
|
if p1 = 'CUSTOMER' then
|
|
Val := cRepMsg01
|
|
// added by Tolik for CommerceInvoice Report
|
|
else
|
|
if p1 = 'RESOURCES' then
|
|
Val := cRepMsg207_1
|
|
else
|
|
if p1 = 'CONTRACTOR' then
|
|
Val := cRepMsg02
|
|
else
|
|
if p1 = 'PROJNAME' then
|
|
Val := cRepMsg03
|
|
else
|
|
if p1 = 'PAGENAME' then
|
|
Val := cRepMsg10
|
|
else
|
|
if p1 = 'GRAPHSYMBLEGEND' then
|
|
Val := cRepMsg04
|
|
else
|
|
if p1 = 'NUM' then
|
|
// Tolik 21/01/2020
|
|
{$IF DEFINED (SCS_PE)}
|
|
Val := 'N'
|
|
{$ELSE}
|
|
Val := cRepMsg05
|
|
{$IFEND}
|
|
//
|
|
else
|
|
if p1 = 'NAME' then
|
|
Val := cRepMsg06
|
|
else
|
|
if p1 = 'INDICATION' then
|
|
Val := cRepMsg07
|
|
else
|
|
if p1 = 'WORKEDOUT' then
|
|
Val := cRepMsg08
|
|
else
|
|
if p1 = 'LENGTHALLCABLES' then
|
|
Val := cRepMsg227
|
|
else
|
|
if p1 = 'CHECKEDBY' then
|
|
Val := cRepMsg09
|
|
else
|
|
if p1 = 'UNDERLINE' then
|
|
Val := DupStr('_', 30) //'______________________________'
|
|
else
|
|
if p1 = 'ADJUSTT' then
|
|
Val := cRepMsg11
|
|
else
|
|
if p1 = 'VZAMINVENTNUMT' then
|
|
Val := cRepMsg12
|
|
else
|
|
if p1 = 'SIGNANDDATET' then
|
|
Val := cRepMsg13
|
|
else
|
|
if p1 = 'INVNUMPODLT' then
|
|
Val := cRepMsg14
|
|
else
|
|
if p1 = 'IZMT' then
|
|
Val := cRepMsg15
|
|
else
|
|
if p1 = 'KOLICHT' then
|
|
Val := cRepMsg16
|
|
else
|
|
if p1 = 'PAGET' then
|
|
Val := cRepMsg17
|
|
else
|
|
if p1 = 'NUMDOCT' then
|
|
Val := cRepMsg18
|
|
else
|
|
if p1 = 'SIGNT' then
|
|
Val := cRepMsg19
|
|
else
|
|
if p1 = 'DATET' then
|
|
Val := cRepMsg20
|
|
else
|
|
if p1 = 'STAGET' then
|
|
Val := cRepMsg21
|
|
else
|
|
if p1 = 'PAGEST' then
|
|
Val := cRepMsg22
|
|
else
|
|
if p1 = 'SIGNATURE' then
|
|
Val := cRepMsg23
|
|
else
|
|
if p1 = 'LASTNAME' then
|
|
Val := cRepMsg24
|
|
else
|
|
if p1 = 'CABLEDUCTSLIST' then
|
|
Val := cRepMsg25
|
|
else
|
|
if p1 = 'UOM' then
|
|
Val := cRepMsg26
|
|
else
|
|
if p1 = 'FULLNESSPERC' then
|
|
Val := cRepMsg27
|
|
else
|
|
if p1 = 'LENGTH_M' then
|
|
Val := cRepMsg154 + GetUOMWithOrthographMarks //cRepMsg28
|
|
else
|
|
if p1 = 'RESERVE_M' then
|
|
Val := cRepMsg155 + GetUOMWithOrthographMarks //cRepMsg29
|
|
else
|
|
if p1 = 'PRICE' then
|
|
Val := cRepMsg30
|
|
else
|
|
if p1 = 'COST' then
|
|
Val := cRepMsg31
|
|
else
|
|
if p1 = 'TOTAL' then
|
|
Val := cRepMsg32
|
|
else
|
|
if p1 = 'GENERALCABDUCTSLEN' then
|
|
Val := cRepMsg33
|
|
else
|
|
if p1 = 'M' then
|
|
Val := cRepMsg34
|
|
else
|
|
if p1 = 'GENERALRESERVLEN' then
|
|
Val := cRepMsg35
|
|
else
|
|
if p1 = 'CABLEDUCTSLIST_NOTE1' then
|
|
Val := cRepMsg36
|
|
else
|
|
if p1 = 'CABLELIST' then
|
|
Val := cRepMsg37
|
|
else
|
|
if p1 = 'CONNECTBEGINSH' then
|
|
Val := cRepMsg38
|
|
else
|
|
if p1 = 'CONNECTENDSH' then
|
|
Val := cRepMsg39
|
|
else
|
|
if p1 = 'GENERALCABLESLEN' then
|
|
Val := cRepMsg40
|
|
else
|
|
if p1 = 'GENERALRESERVLEN' then
|
|
Val := cRepMsg41
|
|
else
|
|
if p1 = 'CABLELIST_NOTE1' then
|
|
Val := cRepMsg42
|
|
else
|
|
if p1 = 'CABLELIST_NOTE2' then
|
|
Val := cRepMsg43
|
|
else
|
|
if p1 = 'LISTOFWORKS' then
|
|
Val := cRepMsg44
|
|
else
|
|
if p1 = 'CODE' then
|
|
Val := cRepMsg45
|
|
else
|
|
if p1 = 'VOLUME' then
|
|
Val := cRepMsg46
|
|
else
|
|
if p1 = 'RESOURCELIST' then
|
|
Val := cRepMsg47
|
|
else
|
|
if p1 = 'VENDORSERIALNUM' then
|
|
Val := cRepMsg48
|
|
else
|
|
if p1 = 'DISTRIBSERIALNUM' then
|
|
Val := cRepMsg49
|
|
else
|
|
if p1 = 'VENDOR' then
|
|
Val := cRepMsg50
|
|
else
|
|
if p1 = 'QUANTITY' then
|
|
Val := cRepMsg51
|
|
else
|
|
if p1 = 'PRICEVAT' then
|
|
Val := cRepMsg52
|
|
else
|
|
if p1 = 'COSTVAT' then
|
|
Val := cRepMsg53
|
|
else
|
|
if p1 = 'TOTALCOST' then
|
|
Val := cRepMsg54
|
|
else
|
|
if p1 = 'RESOURCELIST_NOTE1' then
|
|
Val := cRepMsg55
|
|
else
|
|
if p1 = 'EXTLOGBOOK' then
|
|
Val := cRepMsg56
|
|
else
|
|
if p1 = 'NUMPP' then
|
|
Val := cRepMsg57
|
|
else
|
|
if p1 = 'NUMCABLE' then
|
|
Val := cRepMsg58
|
|
else
|
|
if p1 = 'CABLEDATA' then
|
|
Val := cRepMsg59
|
|
else
|
|
if p1 = 'CORENUMBER' then
|
|
Val := cRepMsg60
|
|
else
|
|
if p1 = 'GOFROM' then
|
|
Val := cRepMsg61
|
|
else
|
|
if p1 = 'GOWHERE' then
|
|
Val := cRepMsg62
|
|
else
|
|
if p1 = 'BUILDING' then
|
|
Val := cRepMsg63
|
|
else
|
|
if p1 = 'DEVICE_RACK' then
|
|
Val := cRepMsg64
|
|
else
|
|
if p1 = 'ELEMENT_PANEL' then
|
|
Val := cRepMsg65
|
|
else
|
|
if p1 = 'SEATORCIRCUITBOARDTYPE' then
|
|
Val := cRepMsg66
|
|
else
|
|
if p1 = 'NUMPORT' then
|
|
Val := cRepMsg67
|
|
else
|
|
if p1 = 'PORTMARKING' then
|
|
Val := cRepMsg68
|
|
else
|
|
if p1 = 'JUNCTWITHCABLE' then
|
|
Val := cRepMsg69
|
|
else
|
|
if p1 = 'CABLINGTRACE' then
|
|
Val := cRepMsg70
|
|
else
|
|
if p1 = 'MARKINGLABEL' then
|
|
Val := cRepMsg71
|
|
else
|
|
if p1 = 'CABLEDIAMETERMM' then
|
|
Val := cRepMsg156 +', '+ GetUOMLengthMin //cRepMsg72
|
|
else
|
|
if p1 = 'CABLELEN_M_BUILDING' then
|
|
Val := cRepMsg157+', '+ GetNameUOM(TF_Main(GForm).FUOM, true)+' '+cRepMsg158 //cRepMsg73
|
|
else
|
|
if p1 = 'NOTE' then
|
|
Val := cRepMsg74
|
|
else
|
|
if p1 = 'CABLELOGBOOK' then
|
|
Val := cRepMsg75
|
|
else
|
|
if p1 = 'GOST21_101_97' then
|
|
Val := cRepMsg76
|
|
else
|
|
if p1 = 'CABLETYPE' then
|
|
Val := cRepMsg77
|
|
else
|
|
if p1 = 'NUMSWITCHBOARD' then
|
|
Val := cRepMsg78
|
|
else
|
|
if p1 = 'NUMSWITCHBOARDPORT' then
|
|
Val := cRepMsg79
|
|
else
|
|
if p1 = 'COMESFROM' then
|
|
Val := cRepMsg80
|
|
else
|
|
if p1 = 'NUMOUTLETORSWITCHBOARD' then
|
|
Val := cRepMsg81
|
|
else
|
|
if p1 = 'NUMOUTLETORSWITCHBOARDPORT' then
|
|
Val := cRepMsg82
|
|
else
|
|
if p1 = 'ROOM' then
|
|
Val := cRepMsg83
|
|
else
|
|
if p1 = 'CABLE' then
|
|
Val := cRepMsg84
|
|
else
|
|
if p1 = 'CATEGORY' then
|
|
Val := cRepMsg85
|
|
else
|
|
if p1 = 'FROM' then
|
|
Val := cRepMsg86
|
|
else
|
|
if p1 = 'TO' then
|
|
Val := cRepMsg87
|
|
else
|
|
if p1 = 'WORKPLACE' then
|
|
Val := cRepMsg88
|
|
else
|
|
if p1 = 'WORKAREA' then
|
|
Val := cRepMsg88_
|
|
else
|
|
if p1 = 'PORT' then
|
|
Val := cRepMsg89
|
|
else
|
|
if p1 = 'TYPE' then
|
|
Val := cRepMsg90
|
|
else
|
|
if p1 = 'SPECIFICATION' then
|
|
Val := cRepMsg91
|
|
else
|
|
if p1 = 'PRODMARKNUMSH' then
|
|
Val := cRepMsg92
|
|
else
|
|
if p1 = 'DISTRIBMARKNUMSH' then
|
|
Val := cRepMsg93
|
|
else
|
|
if p1 = 'VENDOR' then
|
|
Val := cRepMsg94
|
|
else
|
|
if p1 = 'PRICEWITHVAT' then
|
|
Val := cRepMsg95
|
|
else
|
|
if p1 = 'COSTWITHVAT' then
|
|
Val := cRepMsg96
|
|
else
|
|
if p1 = 'SUM' then
|
|
Val := cRepMsg97
|
|
else
|
|
if p1 = 'SPECIFICATION_NOTE1' then
|
|
Val := cRepMsg98
|
|
else
|
|
if p1 = 'SPECIFICATION_NOTE2' then
|
|
Val := cRepMsg99
|
|
else
|
|
if p1 = 'GOST21_110_95' then
|
|
Val := cRepMsg100
|
|
else
|
|
if p1 = 'POSITION' then
|
|
Val := cRepMsg101
|
|
else
|
|
if p1 = 'NAMEANDTECHCHARACK' then
|
|
Val := cRepMsg102
|
|
else
|
|
if p1 = 'DOCTYPEMARKINDICAT' then
|
|
Val := cRepMsg103
|
|
else
|
|
if p1 = 'CODEOFEQUIPMMATERIAL' then
|
|
Val := cRepMsg104
|
|
else
|
|
if p1 = 'FACTORYPRODUCER' then
|
|
Val := cRepMsg105
|
|
else
|
|
if p1 = 'UNITOFMEASURE' then
|
|
Val := cRepMsg106
|
|
else
|
|
if p1 = 'MASSOFUNITKG' then
|
|
Val := cRepMsg153 + GetUOMWeightOrthographMarks
|
|
else
|
|
if p1 = 'EXPLANATORYNOTE' then
|
|
Val := cRepMsg109
|
|
else
|
|
if p1 = 'BYTHEPROJECT' then
|
|
Val := cRepMsg110
|
|
else
|
|
if p1 = 'BASEPROJCURRENCY' then
|
|
Val := cRepMsg111
|
|
else
|
|
if p1 = 'PROJVAT' then
|
|
Val := cRepMsg112
|
|
else
|
|
if p1 = 'INTERFLOORLIFTINGSHEIGHT_M' then
|
|
Val := cRepMsg145 + GetUOMWithOrthographMarks //cRepMsg113
|
|
else
|
|
if p1 = 'BYPAGES' then
|
|
Val := cRepMsg114
|
|
else
|
|
if p1 = 'FLOORHEIGHT_M' then
|
|
Val := cRepMsg146 + GetUOMWithOrthographMarks //cRepMsg115
|
|
else
|
|
if p1 = 'DROPCEILINGHEIGHT_M' then
|
|
Val := cRepMsg147 + GetUOMWithOrthographMarks //cRepMsg116
|
|
else
|
|
if p1 = 'POINTOBJECTSPLACEMENTHEIGHT_M' then
|
|
Val := cRepMsg148 + GetUOMWithOrthographMarks //cRepMsg117
|
|
else
|
|
if p1 = 'ROUTEPLACEMENTHEIGHT_M' then
|
|
Val := cRepMsg149 + GetUOMWithOrthographMarks //cRepMsg118
|
|
else
|
|
if p1 = 'CONDUITSFULLNESSCOEFFICIENT' then
|
|
Val := cRepMsg119
|
|
else
|
|
if p1 = 'CABLELENGTHRESERVE' then
|
|
Val := cRepMsg120
|
|
else
|
|
if p1 = 'PORTRESERVE_M' then
|
|
Val := cRepMsg150 + GetUOMWithOrthographMarks //cRepMsg121
|
|
else
|
|
if p1 = 'MULTIPORTRESERVE_M' then
|
|
Val := cRepMsg151 + GetUOMWithOrthographMarks //Val := cRepMsg122
|
|
else
|
|
if p1 = 'MAXLENRESTRICTION_M' then
|
|
Val := cRepMsg152 + GetUOMWithOrthographMarks //cRepMsg123
|
|
else
|
|
if p1 = 'EXPLICATIONROOM' then
|
|
Val := cRepMsg124
|
|
else
|
|
if p1 = 'LETTERTOPLAN' then
|
|
Val := cRepMsg125
|
|
else
|
|
if p1 = 'FLOOR' then
|
|
Val := cRepMsg126
|
|
else
|
|
if p1 = 'LODGEMENTTNUM' then
|
|
Val := cRepMsg127
|
|
else
|
|
if p1 = 'ROOMNUM' then
|
|
Val := cRepMsg128
|
|
else
|
|
if p1 = 'APPOINTMENTROOM' then
|
|
Val := cRepMsg129
|
|
else
|
|
if p1 = 'SQUAREINSIDE' then
|
|
Val := cRepMsg130
|
|
else
|
|
if p1 = 'SQM' then
|
|
Val := cRepMsg159+'.'+GetNameUOM(TF_Main(GForm).FUOM, true, false)+'.' //êâ.ì. êâ.ôò. cRepMsg131
|
|
else
|
|
if p1 = 'INCLUDING' then
|
|
Val := cRepMsg132
|
|
else
|
|
if p1 = 'TOTALSQUARE' then
|
|
Val := cRepMsg133
|
|
else
|
|
if p1 = 'HABITABLESQUARE' then
|
|
Val := cRepMsg134
|
|
else
|
|
if p1 = 'BACKROOMSQUARE' then
|
|
Val := cRepMsg135
|
|
else
|
|
if p1 = 'SQUARENOINCLUDETOTATAL' then
|
|
Val := cRepMsg136
|
|
else
|
|
if p1 = 'SQUARESELFWILLEDBUILDING' then
|
|
Val := cRepMsg137
|
|
else
|
|
if p1 = 'HEIGHT' then
|
|
Val := cRepMsg138
|
|
else
|
|
if p1 = 'TOTALINFLOOR' then
|
|
Val := cRepMsg139
|
|
else
|
|
if p1 = 'EXPLICATIONCOMPON' then
|
|
Val := cRepMsg140
|
|
else
|
|
if p1 = 'COMPONNUM' then
|
|
Val := cRepMsg141
|
|
else
|
|
if p1 = 'NAMEMARK' then
|
|
Val := cRepMsg142
|
|
else
|
|
if p1 = 'CROSSJOURNAL' then
|
|
Val := cRepMsg143
|
|
else
|
|
if p1 = 'GOST21_110_95' then
|
|
Val := cRepMsg144
|
|
else
|
|
if p1 = 'INTERFLOORLIFTINGSHEIGHT' then
|
|
Val := cRepMsg145
|
|
else
|
|
if p1 = 'FLOORHEIGHT' then
|
|
Val := cRepMsg146
|
|
else
|
|
if p1 = 'DROPCEILINGHEIGHT' then
|
|
Val := cRepMsg147
|
|
else
|
|
if p1 = 'POINTOBJECTSPLACEMENTHEIGHT' then
|
|
Val := cRepMsg148
|
|
else
|
|
if p1 = 'ROUTEPLACEMENTHEIGHT' then
|
|
Val := cRepMsg149
|
|
else
|
|
if p1 = 'PORTRESERVE' then
|
|
Val := cRepMsg150
|
|
else
|
|
if p1 = 'MULTIPORTRESERVE' then
|
|
Val := cRepMsg151
|
|
else
|
|
if p1 = 'MAXLENRESTRICTION' then
|
|
Val := cRepMsg152
|
|
else
|
|
if p1 = 'MASSOFUNIT' then
|
|
Val := cRepMsg153
|
|
else
|
|
if p1 = 'LENGTH' then
|
|
Val := cRepMsg154
|
|
else
|
|
if p1 = 'RESERVE' then
|
|
Val := cRepMsg155
|
|
else
|
|
if p1 = 'CABLEDIAMETER' then
|
|
Val := cRepMsg156
|
|
else
|
|
if p1 = 'CABLELEN' then
|
|
Val := cRepMsg157
|
|
else
|
|
if p1 = 'BUILDING_S' then
|
|
Val := cRepMsg158
|
|
else
|
|
if p1 = 'SQ' then
|
|
Val := cRepMsg159
|
|
else
|
|
if p1 = 'MATERIALS' then
|
|
Val := cRepMsg160
|
|
else
|
|
if p1 = 'ARTICUL' then
|
|
Val := cRepMsg161
|
|
else
|
|
if p1 = 'WORKS' then
|
|
Val := cRepMsg162
|
|
else
|
|
|
|
if p1 = 'DEFECTACT' then
|
|
Val := cRepMsg164
|
|
else
|
|
if p1 = 'FINDDEFECT' then
|
|
Val := cRepMsg165
|
|
else
|
|
if p1 = 'WITHDEFINEWORKS' then
|
|
Val := cRepMsg166
|
|
else
|
|
if p1 = 'REPAIRDEFECT' then
|
|
Val := cRepMsg167
|
|
else
|
|
if p1 = 'ADDRESS' then
|
|
Val := cRepMsg168
|
|
else
|
|
if p1 = 'DEFECTDESCRIPTION' then
|
|
Val := cRepMsg169
|
|
else
|
|
if p1 = 'LINKTRANSPORT' then
|
|
Val := cRepMsg170
|
|
else
|
|
if p1 = 'POINTA' then
|
|
Val := cRepMsg171
|
|
else
|
|
if p1 = 'POINTB' then
|
|
Val := cRepMsg172
|
|
else
|
|
if p1 = 'CABLE' then
|
|
Val := cRepMsg173
|
|
else
|
|
if p1 = 'DEFACTMATERIALS' then
|
|
Val := cRepMsg174
|
|
else
|
|
if p1 = 'SETEQUIPMENT' then
|
|
Val := cRepMsg175
|
|
else
|
|
if p1 = 'EQUIPMENT' then
|
|
Val := cRepMsg176
|
|
else
|
|
if p1 = 'MOVEEQUIPMENT' then
|
|
Val := cRepMsg177
|
|
else
|
|
if p1 = 'DEFACTCONTRACTOR' then
|
|
Val := cRepMsg178
|
|
else
|
|
if p1 = 'DATEGETTING' then
|
|
Val := cRepMsg179
|
|
else
|
|
if p1 = 'DATEEXECUTION' then
|
|
Val := cRepMsg180
|
|
else
|
|
if p1 = 'FORCOMPONENT' then
|
|
Val := cRepMsg181
|
|
|
|
else
|
|
if p1 = 'R25HOMEANDAPPROACH' then
|
|
Val := cRepMsg191
|
|
else
|
|
if p1 = 'R25NAME' then
|
|
Val := cRepMsg182
|
|
else
|
|
if p1 = 'R25COOPERATIVE' then
|
|
Val := cRepMsg183
|
|
else
|
|
if p1 = 'R25HEO' then
|
|
Val := cRepMsg184
|
|
else
|
|
if p1 = 'R25AGREED' then
|
|
Val := cRepMsg185
|
|
else
|
|
if p1 = 'R25BOXINSTALLED' then
|
|
Val := cRepMsg186
|
|
else
|
|
if p1 = 'R25PRESENCEPOWER200WFROMNETWORK' then
|
|
Val := cRepMsg187
|
|
else
|
|
if p1 = 'R25CABLESETTOBOX' then
|
|
Val := cRepMsg188
|
|
else
|
|
if p1 = 'R25FIBEROPTICWELDED' then
|
|
Val := cRepMsg189
|
|
else
|
|
if p1 = 'R25EQUIPMENTINSTALLED' then
|
|
Val := cRepMsg190
|
|
else
|
|
//Tolik
|
|
if p1 = 'CROSSCONNECTION' then
|
|
Val := cRepMsg205
|
|
else
|
|
if p1 = 'BUILDINGDISTRIBUTOR' then
|
|
Val := cRepMsg228
|
|
else
|
|
if p1 = 'REELSCABLEFLOW' then
|
|
Val := ReelsCableFlow.Text
|
|
else
|
|
if p1 = 'CABLEREZERV' then
|
|
Val := cRepMsg229
|
|
else
|
|
if p1 = 'WACOORDINATES' then
|
|
Val := cRepMsg238
|
|
else
|
|
if p1 = 'PATH' then
|
|
Val := cRepMsg230
|
|
else
|
|
if p1 = 'CABLE' then
|
|
Val := cRepMsg240
|
|
else
|
|
if p1 = 'CABLEWIREMARKING' then
|
|
Val := cRepMsg247
|
|
else
|
|
if p1 = 'TRACE' then
|
|
Val := cRepMsg248
|
|
else
|
|
if p1 = 'CABLETRACEPART' then
|
|
Val := cRepMsg249
|
|
else
|
|
if p1 = 'TRACEBEGIN' then
|
|
Val := cRepMsg250
|
|
else
|
|
if p1 = 'TRACEEND' then
|
|
Val := cRepMsg251
|
|
else
|
|
if p1 = 'CABLEWIRE' then
|
|
Val := cRepMsg252
|
|
else
|
|
if p1 = 'ONPROJECT' then
|
|
Val := cRepMsg253
|
|
else
|
|
if p1 = 'CABLELAID' then
|
|
Val := cRepMsg254
|
|
else
|
|
if p1 = 'COUNTANDCROSSSQUARE' then
|
|
Val := cRepMsg255
|
|
else
|
|
if p1 = 'CABLEMARK' then
|
|
Val := cRepMsg256
|
|
else
|
|
if p1 = 'CABLETUBEJOURNAL' then
|
|
Val := cRepMsg257
|
|
else
|
|
if p1 = 'THEN' then
|
|
Val := cRepMsg206
|
|
else
|
|
if p1 = 'PARTCABLELENGTH' then
|
|
Val := cRepMsg237
|
|
else
|
|
if p1 = 'PRIORCOSTOFPROJECT' then
|
|
Val := cRepMsg192
|
|
else
|
|
// ê îñíîâíîé ðàìêå íà ÷åðòåæ (ïîäïèñè)(Tolik)
|
|
if p1 = 'RAZRABOTAL' then
|
|
Val := cRepMsg260
|
|
else
|
|
if p1 = 'PROVERIL' then
|
|
Val := cRepMsg261
|
|
else
|
|
if p1 = 'NCONTROL' then
|
|
Val := cRepMsg262
|
|
else
|
|
if p1 = 'TCONTROL' then
|
|
Val := cRepMsg263
|
|
else
|
|
if p1 = 'UTVERDIL' then
|
|
Val := cRepMsg264
|
|
{ Çíà÷åíèÿ èç ñâîéñòâ ïðîåêòà è ëèñòà}
|
|
else
|
|
if p1 = 'STAMPDEVELOPER' then
|
|
try
|
|
Val := F_ProjMan.GSCSBase.CurrProject.ProjectLists.Items[0].Setting.CADStampDeveloper // ðàçðàáîòàë
|
|
except
|
|
end
|
|
else
|
|
if p1 = 'MAINENGINEER' then
|
|
try
|
|
Val := F_ProjMan.GSCSBase.CurrProject.ProjectLists.Items[0].Setting.CADStampMainEngineer //ãëàâíûé èíæåíåð ïðîåêòà
|
|
except
|
|
end
|
|
else
|
|
if p1 = 'STAMPCHECKER' then
|
|
try
|
|
Val := F_ProjMan.GSCSBase.CurrProject.ProjectLists.Items[0].Setting.CADStampChecker // ïðîâåðèë
|
|
except
|
|
end
|
|
else
|
|
if p1 = 'STAMPAPPROVED' then
|
|
try
|
|
Val := F_ProjMan.GSCSBase.CurrProject.ProjectLists.Items[0].Setting.CADStampApproved // óòâåðäèë
|
|
except
|
|
end
|
|
|
|
else
|
|
if p1 = 'DESIGNSTAGE' then
|
|
try
|
|
// Tolik -- 24/02/2020 --
|
|
if Assigned(GCadForm) then
|
|
Val := GCadForm.FListSettings.CADStampDesignStage
|
|
else
|
|
Val := F_ProjMan.GSCSBase.CurrProject.ProjectLists.Items[0].Setting.CADStampDesignStage // ñòàäèÿ ïðîåêòèðîâàíèÿ
|
|
except
|
|
end
|
|
|
|
else
|
|
if p1 = 'PROECTORGANIZATION' then
|
|
try
|
|
Val := F_ProjMan.GSCSBase.CurrProject.Setting.OrganizationName // íàèìåíîâàíèå îðãàíèçàöèè ïðîåêòèðîâùèêà
|
|
except
|
|
end
|
|
|
|
else
|
|
if p1 = 'LISTSIGN' then
|
|
try
|
|
Val := F_ProjMan.GSCSBase.CurrProject.ProjectLists.Items[0].Setting.CADStampListSign // îáîçíà÷åíèå äîêóìåíòà
|
|
except
|
|
end
|
|
|
|
//
|
|
else
|
|
begin
|
|
val := GetStrFromStringsByKey(FRepMsgList, p1);
|
|
end;
|
|
end
|
|
else if Name = 'GETLOAT' then
|
|
begin
|
|
val := FloatToStrFix(p1, FloatPrecision);
|
|
end;
|
|
end;
|
|
*)
|
|
end. |