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.