frxexporttxt.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

begin
  i := 0;
  CreateScr(Round(expScaleX * MaxWidth / Xdivider) + 10, Round(expScaleY * LastY / Ydivider) + 2);
  for y := 1 to RY.Count - 1 do
  begin
    for x := 1 to RX.Count - 1 do
      if i < ObjectPos.Count then
        if ((PObjPos(ObjectPos[i]).y + CurY + 1) = y) and
          ((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;

const
  REGISTRY_KEY = '\Software\FastReports\TxtAdvExport\1030';

function TfrxTXTExport.ShowModal: TModalResult;
var
  Reg: TRegistry;
  preview: Boolean;
begin
  if ShowDialog then
  begin
    preview := False;
    frExportSet := TfrxTXTExportDialog.Create(nil);
    frExportSet.Exporter := Self;
    if expUseSavedProps then
    begin
      Reg := TRegistry.Create;
      Reg.RootKey := HKEY_CURRENT_USER;
      if Reg.OpenKey(REGISTRY_KEY, True) then
      begin
        if Reg.ValueExists('Borders') then
        begin
          expBorders := Reg.ReadBool('Borders');
          expBordersGraph := Reg.ReadBool('BordersGraph');
          expPageBreaks := Reg.ReadBool('PageBreaks');
          expOEM := Reg.ReadBool('OEM');
          expEmptyLines := Reg.ReadBool('EmptyLines');
          expLeadSpaces := Reg.ReadBool('LeadSpaces');
          expScaleX := Reg.ReadFloat('ScaleX');
          expScaleY := Reg.ReadFloat('ScaleY');
          preview := Reg.ReadBool('Preview');
          frExportSet.Preview.Font.Size := Reg.ReadInteger('FontSize');
          expPrintAfter := Reg.ReadBool('PrintAfter');
        end;
        Reg.CloseKey;
      end;
      Reg.Free;
    end;
    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
      if frExportSet.SaveDialog1.Execute then
      begin
        FileName := frExportSet.SaveDialog1.Filename;
        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 frExportSet.CB_Save.Checked then
        begin
          Reg := TRegistry.Create;
          Reg.RootKey := HKEY_CURRENT_USER;
          if Reg.OpenKey(REGISTRY_KEY, True) then
          begin
            Reg.WriteBool('Borders', expBorders);
            Reg.WriteBool('BordersGraph', expBordersGraph);
            Reg.WriteBool('PageBreaks', expPageBreaks);
            Reg.WriteBool('OEM', expOEM);
            Reg.WriteBool('EmptyLines', expEmptyLines);
            Reg.WriteBool('LeadSpaces', expLeadSpaces);
            Reg.WriteFloat('ScaleX', expScaleX);
            Reg.WriteFloat('ScaleY', expScaleY);
            Reg.WriteBool('Preview', frExportSet.PreviewActive);
            Reg.WriteInteger('FontSize', frExportSet.Preview.Font.Size);
            Reg.WriteBool('PrintAfter', expPrintAfter);
            Reg.CloseKey;
          end;
          Reg.Free;
        end;
      end
      else
        Result := mrCancel;
    end;
    frExportSet.Free;
  end
  else
    Result := mrOk;
end;

function TfrxTXTExport.Start: Boolean;
begin
  CurrentPage := 0;
  FirstPage := True;
  ClearLastPage;
  if not IsPreview then
    WriteExp(PrinterInitString);
  pgBreakList.Clear;
  if FileName <> '' then
  begin
    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;
      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
  Path[0] := Chr(GetTempPath(64, @Path[1]));
  GetTempFileName(@Path[1], PChar('fr'), 0, @FileName[1]);
  Result := StrPas(@FileName[1]);
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
  frxResources.LocalizeForm(Self);
  created := False;
  TxtExp := TfrxTXTExport.CreateNoRegister;
  BtnPreviewClick(Sender);
  Created := True;
  MakeInit := False;
  printer := 0;
  PageUpDown.Max := PagesCount;
  running := False;
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;

end.