frxexporttxt.pas

这个是功能强大的报表软件

          ((PObjPos(ObjectPos[i]).x + 1) = x) then
        begin
          Obj := TfrxMemoView(PageObj[PObjPos(ObjectPos[i]).obj]);
          s := ChangeReturns(TruncReturns(Obj.Memo.Text));
          DrawMemo(Round(expScaleX * obj.Left / Xdivider),
            Round(expScaleY * obj.Top / Ydivider),
            Round(expScaleX * obj.Width / Xdivider),
            Round(expScaleY * obj.Height / Ydivider),
            s, PObjPos(ObjectPos[i]).style);
          Obj.Free;
          Inc(i);
        end;
  end;
  FlushScr;
  FreeScr;
end;


function TfrxTXTExport.ShowModal: TModalResult;
var
  preview: Boolean;
begin
  if ShowDialog then
  begin
    preview := False;
    frExportSet := TfrxTXTExportDialog.Create(nil);
    frExportSet.Exporter := Self;
    frExportSet.CB_PrintAfter.Visible := not SlaveExport;
    if SlaveExport then
      expPrintAfter := False;

    if FileName = '' then
      frExportSet.SaveDialog1.FileName := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(Report.FileName)), frExportSet.SaveDialog1.DefaultExt)
    else
      frExportSet.SaveDialog1.FileName := FileName;

    frExportSet.PreviewActive := false;
    frExportSet.RB_Graph.Checked := expBordersGraph;
    frExportSet.RB_NoneFrames.Checked := not expBorders;
    frExportSet.RB_Simple.Checked := expBorders and (not expBordersGraph);
    frExportSet.CB_PageBreaks.Checked := expPageBreaks;
    frExportSet.CB_OEM.Checked := expOEM;
    frExportSet.CB_EmptyLines.Checked := expEmptyLines;
    frExportSet.CB_LeadSpaces.Checked := expLeadSpaces;
    frExportSet.UpDown1.Position := StrToInt(IntToStr(Round(expScaleX * 100)));
    frExportSet.UpDown2.Position := StrToInt(IntToStr(Round(expScaleY * 100)));
    frExportSet.CB_PrintAfter.Checked := expPrintAfter;
    frExportSet.PreviewActive := preview;
    frExportSet.PagesCount := Report.PreviewPages.Count;
    Result := frExportSet.ShowModal;
    if Result = mrOk then
    begin
      PageNumbers := frExportSet.E_Range.Text;
      expBorders := not frExportSet.RB_NoneFrames.Checked;
      expBordersGraph := frExportSet.RB_Graph.Checked;
      expPageBreaks := frExportSet.CB_PageBreaks.Checked;
      expOEM := frExportSet.CB_OEM.Checked;
      expEmptyLines := frExportSet.CB_EmptyLines.Checked;
      expLeadSpaces := frExportSet.CB_LeadSpaces.Checked;
      expScaleX := StrToInt(frExportSet.E_ScaleX.Text) / 100;
      expScaleY := StrToInt(frExportSet.E_ScaleY.Text) / 100;
      expPrintAfter := frExportSet.CB_PrintAfter.Checked;
      if frExportSet.MakeInit then
      begin
        SelectedPrinterType := frExportSet.printer;
        MakeInitString;
      end;
      if DefaultPath <> '' then
        frExportSet.SaveDialog1.InitialDir := DefaultPath;
      if not SlaveExport then
      begin
        if frExportSet.SaveDialog1.Execute then
        begin
          FileName := frExportSet.SaveDialog1.Filename;
        end
        else
          Result := mrCancel;
      end
    end;
    frExportSet.Free;
  end
  else
    Result := mrOk;
end;

function TfrxTXTExport.Start: Boolean;
begin
  if SlaveExport then
  begin
    if Report.FileName <> '' then
      FileName := ChangeFileExt(GetTemporaryFolder + ExtractFileName(Report.FileName), frxGet(8326))
    else
      FileName := ChangeFileExt(GetTempFile, frxGet(8326))
  end;
  CurrentPage := 0;
  FirstPage := True;
  ClearLastPage;
  if not IsPreview then
    WriteExp(PrinterInitString);
  pgBreakList.Clear;
  if FileName <> '' then
  begin
    if (ExtractFilePath(FileName) = '') and (DefaultPath <> '') then
      FileName := DefaultPath + '\' + FileName;
    Stream := TFileStream.Create(FileName, fmCreate);
    Result := True
  end
  else
    Result := False;
end;

procedure TfrxTXTExport.StartPage(Page: TfrxReportPage; Index: Integer);
begin
  Inc(CurrentPage);
  MaxWidth := 0;
  LastY := 0;
  CY := 0;
  CurY := 0;
  PageWidth := 0;
  PageHeight := 0;
end;

procedure TfrxTXTExport.ExportObject(Obj: TfrxComponent);
var
  MemoView: TfrxMemoView;
  maxy: Extended;
begin
  if Obj is TfrxCustomMemoView then
  begin
    if ((TfrxMemoView(Obj).Memo.Count > 0) or (TfrxMemoView(Obj).Frame.Typ <> [])) then
    begin
      MemoView := TfrxMemoView.Create(nil);
      MemoView.Assign(Obj);
      MemoView.Left := Obj.AbsLeft;
      MemoView.Top := Obj.AbsTop + CY;
      MemoView.Width := Obj.Width;
      MemoView.Height := Obj.Height;
      MemoView.Font.Assign(Obj.Font); // added by Samuel Herzog
      PageObj.Add(MemoView);
      ObjCellAdd(RX, Obj.AbsLeft);
      ObjCellAdd(RX, Obj.AbsLeft + Obj.Width);
      ObjCellAdd(RY, Obj.AbsTop + CY);
      ObjCellAdd(RY, Obj.AbsTop + Obj.Height + CY);
    end;
  end;
  if Obj.AbsLeft + Obj.Width > MaxWidth then
    MaxWidth := Obj.AbsLeft + Obj.Width;
  maxy := Obj.AbsTop + Obj.Height + CY;
  if maxy > LastY then
    LastY := maxy;
end;

procedure TfrxTXTExport.FinishPage(Page: TfrxReportPage; Index: Integer);
begin
  PrepareExportPage;
  ExportPage;
  if expPageBreaks then
    FormFeed;
  ClearLastPage;
end;

procedure TfrxTXTExport.Finish;
begin
  if (not expPageBreaks) and (not IsPreview) then
    FormFeed;
  Stream.Free;
  AfterExport(FileName);
end;

procedure TfrxTXTExport.SpoolFile(const FileName: String);
const
  BUF_SIZE = 1024;
var
  f: TFileStream;
  buf: String;
  l: longint;
begin
  frxPrinters.Printer.Title := FileName;
  frxPrinters.Printer.BeginRAWDoc;
  f := TFileStream.Create(FileName, fmOpenRead);
  SetLength(buf, BUF_SIZE);
  l := BUF_SIZE;
  while l = BUF_SIZE do
  begin
    l := f.Read(buf[1], BUF_SIZE);
    SetLength(buf, l);
    frxPrinters.Printer.WriteRAWDoc(buf);
  end;
  f.Free;
  frxPrinters.Printer.EndRAWDoc;
  DeleteFile(FileName);
end;

function GetTempFName: String;
var
  Path: String[64];
  FileName: String[255];
begin
{$IFDEF Delphi12}
  Path[0] := AnsiChar(Chr(GetTempPath(64, PWideChar(@Path[1]))));
  GetTempFileName(@Path[1], PChar('fr'), 0, @FileName[1]);
  Result := StrPas(PWideChar(@FileName[1]));
{$ELSE}
  Path[0] := Chr(GetTempPath(64, @Path[1]));
  GetTempFileName(@Path[1], PChar('fr'), 0, @FileName[1]);
  Result := StrPas(@FileName[1]);
{$ENDIF}
end;

procedure TfrxTXTExport.AfterExport(const FileName: String);
var
  i: Integer;
  fname: String;
  f, ffrom: TFileStream;
begin
  if expPrintAfter then
  begin
    if Printer.Printers.Count = 0 then Exit;
    if expPrinterDialog  then
      with TfrxPrnInit.Create(Self) do
      begin
        i := ShowModal;
        if i = mrOk then
          Copys := UpDown1.Position;
        Free;
      end
    else
      i := mrOk;
    if i = mrOk then
    begin
      MakeInitString;
      fname := GetTempFName;
      f := TFileStream.Create(fname, fmCreate);
      ffrom := TFileStream.Create(FileName, fmOpenRead);
      f.Write(PrinterInitString[1], Length(PrinterInitString));
      f.CopyFrom(ffrom, 0);
      f.Free;
      ffrom.Free;
      f := TFileStream.Create(FileName, fmCreate);
      ffrom := TFileStream.Create(fname, fmOpenRead);
      f.CopyFrom(ffrom, 0);
      f.Free;
      ffrom.Free;
      DeleteFile(fname);
      for i := 1 to Copys do
        SpoolFile(FileName);
    end;
  end;
end;

procedure TfrxTXTExport.PrepareExportPage;
begin
  RX.Sort(@ComparePoints);
  RY.Sort(@ComparePoints);
  PageObj.Sort(@CompareObjects);
  OrderObjectByCells;
  MakeStyleList;
end;

function TfrxTXTExport.MakeInitString: String;
var
  i: Integer;
begin
  if PrintersCount > 0 then
  begin
    PrinterInitString := '';
    for i := 0 to PrinterTypes[SelectedPrinterType].CommCount - 1 do
      if PrinterTypes[SelectedPrinterType].Commands[i].Trigger then
        PrinterInitString := PrinterInitString +
           PrinterTypes[SelectedPrinterType].Commands[i].SwitchOn
      else
        PrinterInitString := PrinterInitString +
            PrinterTypes[SelectedPrinterType].Commands[i].SwitchOff;
  end;
end;

procedure TfrxTXTExport.RegisterPrinterCommand(PrinterIndex: Integer;
  const Name, switch_on, switch_off: String);
var
  i: Integer;
begin
  i := PrinterTypes[PrinterIndex].CommCount;
  PrinterTypes[PrinterIndex].Commands[i].Name := Name;
  PrinterTypes[PrinterIndex].Commands[i].SwitchOn := Switch_On;
  PrinterTypes[PrinterIndex].Commands[i].SwitchOff := Switch_Off;
  PrinterTypes[PrinterIndex].Commands[i].Trigger := False;
  Inc(PrinterTypes[PrinterIndex].CommCount);
end;

function TfrxTXTExport.RegisterPrinterType(const Name: String): Integer;
begin
  PrinterTypes[PrintersCount].Name := Name;
  PrinterTypes[PrintersCount].CommCount := 0;
  Inc(PrintersCount);
  Result := PrintersCount - 1;
end;

procedure TfrxTXTExport.LoadPrinterInit(const FName: String);
var
  f: TextFile;
  i: Integer;
  buf: String;
  b: Boolean;
begin
{$I-}
  AssignFile(f, FName);
  Reset(f);
  ReadLn(f, buf);
  SelectedPrinterType := StrToInt(buf);
  i := 0;
  while (not eof(f)) and (i < PrinterTypes[SelectedPrinterType].CommCount) do
  begin
    ReadLn(f, buf);
      if Pos('True', buf) > 0 then
        b := True
      else
        b := False;
      PrinterTypes[SelectedPrinterType].Commands[i].Trigger := b;
    Inc(i);
  end;
  MakeInitString;
{$I+}
end;

procedure TfrxTXTExport.SavePrinterInit(const FName: String);
var
  f: TextFile;
  i: Integer;
  s: String;
begin
{$I-}
  AssignFile(f, FName);
  Rewrite(f);
  WriteLn(f, IntToStr(SelectedPrinterType));
  for i := 0 to PrinterTypes[SelectedPrinterType].CommCount - 1 do
  begin
    if PrinterTypes[SelectedPrinterType].Commands[i].Trigger then
      s := 'True' else
      s := 'False';
    WriteLn(f, s);
  end;
  CloseFile(f);
{$I+}
end;

procedure TfrxTXTExport.FormFeed;
begin
  WriteExp(#12);
end;

//////////////////////////////////////////////

procedure TfrxTXTExportDialog.FormCreate(Sender: TObject);
begin
  Caption := frxGet(8300);
  OK.Caption := frxGet(1);
  Cancel.Caption := frxGet(2);
  BtnPreview.Hint := frxGet(8301);
  GroupCellProp.Caption := frxGet(8302);
  CB_PageBreaks.Caption := frxGet(8303);
  CB_OEM.Caption := frxGet(8304);
  CB_EmptyLines.Caption := frxGet(8305);
  CB_LeadSpaces.Caption := frxGet(8306);
  GroupPageRange.Caption := frxGet(7);
  Pages.Caption := frxGet(8307);
  Descr.Caption := frxGet(8308);
  GroupScaleSettings.Caption := frxGet(8309);
  ScX.Caption := frxGet(8310);
  ScY.Caption := frxGet(8311);
  GroupFramesSettings.Caption := frxGet(8312);
  RB_NoneFrames.Caption := frxGet(8313);
  RB_Simple.Caption := frxGet(8314);
  RB_Graph.Caption := frxGet(8315);
  RB_Graph.Hint := frxGet(8316);
  CB_PrintAfter.Caption := frxGet(8317);
  GroupBox1.Caption := frxGet(8319);
  Label1.Caption := frxGet(8320);
  Label3.Caption := frxGet(8321);
  LBPage.Caption := frxGet(8322);
  ToolButton1.Hint := frxGet(8323);
  ToolButton2.Hint := frxGet(8324);
  SaveDialog1.Filter := frxGet(8325);
  SaveDialog1.DefaultExt := frxGet(8326);

  created := False;
  TxtExp := TfrxTXTExport.CreateNoRegister;
  BtnPreviewClick(Sender);
  Created := True;
  MakeInit := False;
  printer := 0;
  PageUpDown.Max := PagesCount;
  running := False;

  if UseRightToLeftAlignment then
    FlipChildren(True);
end;

procedure TfrxTXTExportDialog.CB_OEMClick(Sender: TObject);
begin
  RB_Graph.Enabled := CB_OEM.Checked;
  if not RB_Simple.Checked then
    RB_Simple.Checked := RB_Graph.Checked;
  E_ScaleXChange(Sender);
end;

procedure TfrxTXTExportDialog.RefreshClick(Sender: TObject);
var
  fname: String;
  Progr: Boolean;
begin
 if Flag then
 begin
   running := true;
   fname := GetTempFName;
   TxtExp.IsPreview := True;
   TxtExp.ShowDialog := False;
   TxtExp.Borders := not RB_NoneFrames.Checked;
   TxtExp.Pseudogrpahic := RB_Graph.Checked;
   TxtExp.PageBreaks := CB_PageBreaks.Checked;
   TxtExp.OEMCodepage := CB_OEM.Checked;
   TxtExp.EmptyLines := CB_EmptyLines.Checked;
   TxtExp.LeadSpaces := CB_LeadSpaces.Checked;
   TxtExp.ScaleWidth := StrToInt(E_ScaleX.Text) / 100;
   TxtExp.ScaleHeight := StrToInt(E_ScaleY.Text) / 100;
   progr := Exporter.ShowProgress;
   Exporter.ShowProgress := False;
   TxtExp.FileName := fname;
   TxtExp.PageNumbers := EPage.Text;
   Exporter.Report.Export(TxtExp);
   Exporter.ShowProgress := progr;
   if CB_OEM.Checked then
     Preview.Font.Name := 'Terminal' else
     Preview.Font.Name := 'Courier New';
   Preview.Lines.LoadFromFile(fname);
   DeleteFile(fname);
   PgWidth.Caption := IntToStr(TxtExp.PageWidth);
   PgHeight.Caption := IntToStr(TxtExp.PageHeight);
   running := false;
 end;
end;

procedure TfrxTXTExportDialog.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  TxtExp.Free;
end;

procedure TfrxTXTExportDialog.FormActivate(Sender: TObject);
begin
{  CB_OEMClick(Sender);
  if PreviewActive then
    BtnPreview.Down := True;
  BtnPreviewClick(Sender);}
end;

procedure TfrxTXTExportDialog.E_ScaleXChange(Sender: TObject);
begin
  if PreviewActive then
    RefreshClick(Sender);
end;

procedure TfrxTXTExportDialog.BtnPreviewClick(Sender: TObject);
begin
  if BtnPreview.Down then
  begin
    PreviewActive := True;
    Left := Left - 177;
    Width := 631;
    Panel2.Visible := True;
    Flag := True;
    E_ScaleXChange(Sender);
  end
  else
  begin
    if created and PreviewActive then
      Left := Left + 177;
    Flag := False;
    PreviewActive := False;
    Width := 277;
    Panel2.Visible := False;
  end;
end;

procedure TfrxTXTExportDialog.ToolButton1Click(Sender: TObject);
begin
  if Preview.Font.Size < 30 then
   Preview.Font.Size := Preview.Font.Size + 1;
end;

procedure TfrxTXTExportDialog.ToolButton2Click(Sender: TObject);
begin
  if Preview.Font.Size > 2 then
   Preview.Font.Size := Preview.Font.Size - 1;
end;

procedure TfrxTXTExportDialog.UpDown1Changing(Sender: TObject;
  var AllowChange: Boolean);
begin
  if PreviewActive then
    if not running then
      RefreshClick(Sender)
    else
      AllowChange := False;
end;

procedure TfrxTXTExportDialog.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_F1 then
    frxResources.Help(Self);
end;

end.