📄 frxexportrtf.pas
字号:
CellsLine := AnsiString(GetRTFHAlignment(Obj.Style.HAlign) +
'{' + s + s2 + ' ' + s1 + '\cell}');
s := '\par'#13#10'\cell';
while Pos(AnsiString(s), CellsLine) > 0 do
CellsLine := AnsiString(StringReplace(String(CellsLine), s, '\cell', []));
CellsStream.Write(CellsLine[1], Length(CellsLine));
end
else if FExportPictures then
begin
if ExportEMF then
begin
Str := TMemoryStream.Create;
try
// begin export EMF
Obj.Metafile.SaveToStream(Str);
Str.Position := 0;
dx := Round(Obj.Metafile.Width);
dy := Round(Obj.Metafile.Height);
CellsLine := '{\sb0\li0\sl0\slmult0 {\pict\picw' +
AnsiString(FloatToStr(dx * IMAGE_DIVIDER)) + '\pich' + AnsiString(FloatToStr(dy * IMAGE_DIVIDER)) + '\picscalex98\picscaley98\piccropl0\piccropr0\piccropt0\piccropb0\emfblip'#13#10;
CellsStream.Write(CellsLine[1], Length(CellsLine));
n1 := 0; s := '';
repeat
n := Str.Read(bArr[0], 1024);
for j := 0 to n - 1 do
begin
s := s + IntToHex(bArr[j], 2);
Inc(n1);
if n1 > 63 then
begin
n1 := 0;
CellsLine := AnsiString(s + #13#10);
CellsStream.Write(CellsLine[1], Length(CellsLine));
s := '';
end;
end;
until n < 1024;
if n1 <> 0 then
begin
CellsLine := AnsiString(s + #13#10);
CellsStream.Write(CellsLine[1], Length(CellsLine));
end;
CellsLine := '}\cell}' + #13#10;
CellsStream.Write(CellsLine[1], Length(CellsLine));
// end export EMF
finally
Str.Free;
end;
end
else
begin
// begin export Bitmap
Graphic := Obj.Image;
if not ((Graphic = nil) or Graphic.Empty) then
begin
Str := TMemoryStream.Create;
try
dx := Round(Obj.Width);
dy := Round(Obj.Height);
fx := Graphic.Width;
fy := Graphic.Height;
Graphic.SaveToStream(Str);
Str.Position := 0;
CellsLine := '{\sb0\li0\sl0\slmult0 {\pict\wmetafile8\picw' + AnsiString(FloatToStr(Round(dx * IMAGE_DIVIDER))) +
'\pich' + AnsiString(FloatToStr(Round(dy * IMAGE_DIVIDER))) + '\picbmp\picbpp4' + #13#10;
CellsStream.Write(CellsLine[1], Length(CellsLine));
Str.Read(n, 2);
Str.Read(n, 4);
n := n div 2 + 7;
s0 := IntToHex(n + $24, 8);
s := '010009000003' + Copy(s0, 7, 2) + Copy(s0, 5, 2) +
Copy(s0, 3, 2) + Copy(s0, 1, 2) + '0000';
s0 := IntToHex(n, 8);
s1 := Copy(s0, 7, 2) + Copy(s0, 5, 2) + Copy(s0, 3, 2) + Copy(s0, 1, 2);
s := s + s1 + '0000050000000b0200000000050000000c02';
s0 := IntToHex(fy, 4);
s := s + Copy(s0, 3, 2) + Copy(s0, 1, 2);
s0 := IntToHex(fx, 4);
s := s + Copy(s0, 3, 2) + Copy(s0, 1, 2) +
'05000000090200000000050000000102ffffff000400000007010300' + s1 +
'430f2000cc000000';
s0 := IntToHex(fy, 4);
s := s + Copy(s0, 3, 2) + Copy(s0, 1, 2);
s0 := IntToHex(fx, 4);
s := s + Copy(s0, 3, 2) + Copy(s0, 1, 2) + '00000000';
s0 := IntToHex(fy, 4);
s := s + Copy(s0, 3, 2) + Copy(s0, 1, 2);
s0 := IntToHex(fx, 4);
s := s + Copy(s0, 3, 2) + Copy(s0, 1, 2) + '00000000';
CellsLine := AnsiString(s + #13#10);
CellsStream.Write(CellsLine[1], Length(CellsLine));
Str.Read(bArr[0], 8);
n1 := 0; s := '';
repeat
n := Str.Read(bArr[0], 1024);
for j := 0 to n - 1 do
begin
s := s + IntToHex(bArr[j], 2);
Inc(n1);
if n1 > 63 then
begin
n1 := 0;
CellsLine := AnsiString(s + #13#10);
CellsStream.Write(CellsLine[1], Length(CellsLine));
s := '';
end;
end;
until n < 1024;
finally
Str.Free;
end;
if n1 <> 0 then
begin
CellsLine := AnsiString(s + #13#10);
CellsStream.Write(CellsLine[1], Length(CellsLine));
end;
s := '030000000000}';
CellsLine := AnsiString(s + '\cell}' + #13#10);
CellsStream.Write(CellsLine[1], Length(CellsLine));
end;
// end export Bitmap
end;
end;
Obj.Counter := y + 1;
end
else
begin
if (dy > 1) and (Obj.Counter <> (y + 1)) then
begin
buff := buff + '\clvmrg';
buff := buff + GetRTFBorders(Obj.Style) + '\cltxlrtb';
dcol := Round((Obj.Left + Obj.Width - xoffs) * Xdivider);
buff := buff + '\cellx' + IntToStr(dcol);
j := drow div FONT_DIVIDER;
if j > 20 then
j := 20;
CellsLine := '{\fs' + AnsiString(IntToStr(j)) + '\cell}';
CellsStream.Write(CellsLine[1], Length(CellsLine));
Obj.Counter := y + 1;
end;
end
end
end;
if CellsStream.Size > 0 then
begin
s := '\trowd' + buff + '\pard\intbl';
WriteExpLn(s);
Stream.CopyFrom(CellsStream, 0);
WriteExpLn('\pard\intbl{\trowd' + buff + '\row}');
end;
finally
CellsStream.Free;
end;
end;
if FMode in [2, 3] then
WriteExpLn('}');
Dec(FMode);
end;
WriteExpLn('}');
end;
function TfrxRTFExport.ShowModal: TModalResult;
begin
if not Assigned(Stream) then
begin
with TfrxRTFExportDialog.Create(nil) do
begin
SendMessage(GetWindow(PColontitulCB.Handle,GW_CHILD), EM_SETREADONLY, 1, 0);
OpenCB.Visible := not SlaveExport;
if OverwritePrompt then
SaveDialog1.Options := SaveDialog1.Options + [ofOverwritePrompt];
if SlaveExport then
FOpenAfterExport := False;
if (FileName = '') and (not SlaveExport) then
SaveDialog1.FileName := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(Report.FileName)), SaveDialog1.DefaultExt)
else
SaveDialog1.FileName := FileName;
ContinuousCB.Checked := SuppressPageHeadersFooters;
PicturesCB.Checked := FExportPictures;
PageBreaksCB.Checked := FExportPageBreaks;
WCB.Checked := FWysiwyg;
OpenCB.Checked := FOpenAfterExport;
if PageNumbers <> '' then
begin
PageNumbersE.Text := PageNumbers;
PageNumbersRB.Checked := True;
end;
if FHeaderFooterMode = hfText then
PColontitulCB.ItemIndex := 0
else if FHeaderFooterMode = hfPrint then
PColontitulCB.ItemIndex := 1
else
PColontitulCB.ItemIndex := 2;
Result := ShowModal;
if Result = mrOk then
begin
if PColontitulCB.ItemIndex = 0 then
FHeaderFooterMode := hfText
else if PColontitulCB.ItemIndex = 1 then
FHeaderFooterMode := hfPrint
else
FHeaderFooterMode := hfNone;
PageNumbers := '';
CurPage := False;
if CurPageRB.Checked then
CurPage := True
else if PageNumbersRB.Checked then
PageNumbers := PageNumbersE.Text;
SuppressPageHeadersFooters := ContinuousCB.Checked;
if FHeaderFooterMode = hfPrint then
SuppressPageHeadersFooters := True;
FExportPictures := PicturesCB.Checked;
FExportPageBreaks := PageBreaksCB.Checked;
FWysiwyg := WCB.Checked;
FOpenAfterExport := OpenCB.Checked;
if not SlaveExport then
begin
if DefaultPath <> '' then
SaveDialog1.InitialDir := DefaultPath;
if SaveDialog1.Execute then
FileName := SaveDialog1.FileName
else
Result := mrCancel;
end
end;
Free;
end;
end else
Result := mrOk;
end;
function TfrxRTFExport.Start: Boolean;
begin
if SlaveExport then
begin
if Report.FileName <> '' then
FileName := ChangeFileExt(GetTemporaryFolder + ExtractFileName(Report.FileName), frxGet(8505))
else
FileName := ChangeFileExt(GetTempFile, frxGet(8505))
end;
if (FileName <> '') or Assigned(Stream) then
begin
if (ExtractFilePath(FileName) = '') and (DefaultPath <> '') then
FileName := DefaultPath + '\' + FileName;
FFirstPage := True;
FCurrentPage := 0;
FMatrix := TfrxIEMatrix.Create(UseFileCache, Report.EngineOptions.TempDir);
FMatrix.ShowProgress := ShowProgress;
if FWysiwyg then
FMatrix.Inaccuracy := 0.5
else
FMatrix.Inaccuracy := 10;
FMatrix.RotatedAsImage := True;
FMatrix.RichText := True;
FMatrix.PlainRich := False;
FMatrix.AreaFill := True;
FMatrix.CropAreaFill := True;
FMatrix.DeleteHTMLTags := False;
FMatrix.BackgroundImage := False;
FMatrix.Background := False;
FMatrix.Printable := ExportNotPrintable;
FMatrix.EMFPictures := FExportEMF;
FFontTable := TStringList.Create;
FCharsetTable := TStringList.Create;
FColorTable := TStringList.Create;
FDataList := TList.Create;
Result := True
end
else
Result := False;
end;
procedure TfrxRTFExport.StartPage(Page: TfrxReportPage; Index: Integer);
begin
Inc(FCurrentPage);
if FFirstPage then
FFirstPage := False;
end;
procedure TfrxRTFExport.ExportObject(Obj: TfrxComponent);
begin
if (Obj is TfrxPageHeader) and (ExportNotPrintable or TfrxView(Obj).Printable) then
FMatrix.SetPageHeader(TfrxBand(Obj))
else if (Obj is TfrxPageFooter) and (ExportNotPrintable or TfrxView(Obj).Printable) then
FMatrix.SetPageFooter(TfrxBand(Obj))
else if (Obj is TfrxView) and (ExportNotPrintable or TfrxView(Obj).Printable) then
begin
if (Obj is TfrxCustomMemoView) or
(FExportPictures and (not (Obj is TfrxCustomMemoView))) then
FMatrix.AddObject(TfrxView(Obj))
end;
end;
procedure TfrxRTFExport.FinishPage(Page: TfrxReportPage; Index: Integer);
begin
FMatrix.AddPage(Page.Orientation, Page.Width, Page.Height, Page.LeftMargin,
Page.TopMargin, Page.RightMargin, Page.BottomMargin);
end;
procedure TfrxRTFExport.Finish;
var
Exp: TStream;
begin
FMatrix.Prepare;
if ShowProgress then
FProgress := TfrxProgress.Create(nil);
try
if Assigned(Stream) then
Exp := Stream
else
Exp := TFileStream.Create(FileName, fmCreate);
try
ExportPage(Exp);
finally
if not Assigned(Stream) then
Exp.Free;
end;
if FOpenAfterExport and (not Assigned(Stream)) then
ShellExecute(GetDesktopWindow, 'open', PChar(FileName), nil, nil, SW_SHOW);
except
on e: Exception do
case Report.EngineOptions.NewSilentMode of
simSilent: Report.Errors.Add(e.Message);
simMessageBoxes: frxErrorMsg(e.Message);
simReThrow: raise;
end;
end;
FMatrix.Clear;
FMatrix.Free;
FFontTable.Free;
FCharsetTable.Free;
FColorTable.Free;
FDataList.Free;
if ShowProgress then
FProgress.Free;
end;
{ TfrxRTFExportDialog }
procedure TfrxRTFExportDialog.FormCreate(Sender: TObject);
begin
Caption := frxGet(8500);
OkB.Caption := frxGet(1);
CancelB.Caption := frxGet(2);
GroupPageRange.Caption := frxGet(7);
AllRB.Caption := frxGet(3);
CurPageRB.Caption := frxGet(4);
PageNumbersRB.Caption := frxGet(5);
DescrL.Caption := frxGet(9);
GroupQuality.Caption := frxGet(8);
ContinuousCB.Caption := frxGet(8950);
PicturesCB.Caption := frxGet(8501);
PageBreaksCB.Caption := frxGet(6);
WCB.Caption := frxGet(8502);
OpenCB.Caption := frxGet(8503);
SaveDialog1.Filter := frxGet(8504);
SaveDialog1.DefaultExt := frxGet(8505);
HeadFootL.Caption := frxGet(8951);
PColontitulCB.Items[0] := frxGet(8952);
PColontitulCB.Items[1] := frxGet(8953);
PColontitulCB.Items[2] := frxGet(8954);
if UseRightToLeftAlignment then
FlipChildren(True);
end;
procedure TfrxRTFExportDialog.PageNumbersEChange(Sender: TObject);
begin
PageNumbersRB.Checked := True;
end;
procedure TfrxRTFExportDialog.PageNumbersEKeyPress(Sender: TObject;
var Key: Char);
begin
case key of
'0'..'9':;
#8, '-', ',':;
else
key := #0;
end;
end;
procedure TfrxRTFExportDialog.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_F1 then
frxResources.Help(Self);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -