rm_e_txt.pas

进销存·完整的·有数据库的·非常完整·只得参考

{*****************************************}
{                                         }
{         Report Machine v2.0             }
{           Text export filter            }
{                                         }
{*****************************************}

unit RM_e_txt;

interface

{$I RM.inc}

uses
  SysUtils, Windows, Messages, Classes, Graphics, Forms, Dialogs,
  StdCtrls, Controls, RM_Class;

type
	{ TRMTextExport }
  TRMTextExport = class(TRMExportFilter)
  protected
    FScaleX, FScaleY: Double;
    FKillEmptyLines, FConvertToOEM, FExportFrames,
    FUsePseudographic, FPageBreaks: Boolean;
    Strings: TStringList;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ShowModal: Word; override;
    procedure OnEndPage; override;
    procedure OnBeginPage; override;
    procedure OnText(DrawRect: TRect; X, Y: Integer; const Text: string;
      FrameTyp: Integer; View: TRMView); override;
    procedure InsertTextRec(p: PRMTextRec; LineIndex: Integer);
  published
    property ScaleX: Double read FScaleX write FScaleX;
    property ScaleY: Double read FScaleY write FScaleY;
    property KillEmptyLines: Boolean read FKillEmptyLines write FKillEmptyLines default True;
    property ConvertToOEM: Boolean read FConvertToOEM write FConvertToOEM default False;
    property ExportFrames: Boolean read FExportFrames write FExportFrames default False;
    property UsePseudographic: Boolean read FUsePseudographic write FUsePseudographic default False;
    property PageBreaks: Boolean read FPageBreaks write FPageBreaks default True;
  end;

  { TRMTXTExportForm }
  TRMTXTExportForm = class(TForm)
    GroupBox1: TGroupBox;
    CB1: TCheckBox;
    CB2: TCheckBox;
    CB4: TCheckBox;
    Label1: TLabel;
    E1: TEdit;
    btnOK: TButton;
    btnCancel: TButton;
    CB5: TCheckBox;
    CB3: TCheckBox;
    Label2: TLabel;
    Label3: TLabel;
    E2: TEdit;
    procedure CB3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure Localize;
  public
    { Public declarations }
  end;

implementation

uses RM_Utils, RM_Const, RM_CmpReg;

{$R *.DFM}

const
  Frames = '|-+++++++++';
  Pseudo = #179#196#218#191#192#217#193#195#194#180#197;
  PseudoHex = #5#10#6#12#3#9#11#7#14#13#15;

{-------------------------------------------------------------------_----------}
{--------------------------------------------------------------------_---------}
{TRMTextExport}

constructor TRMTextExport.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
	if AnsiCompareText(ClassName, 'TRMTextExport') = 0 then
	  RMRegisterExportFilter(Self, RMLoadStr(STextFile) + ' (*.txt)', '*.txt');

  Strings := TStringList.Create;
  ShowDialog := True;
  ScaleX := 1;
  ScaleY := 1;
  KillEmptyLines := True;
  ConvertToOEM := False;
  ExportFrames := False;
  UsePseudographic := False;
  PageBreaks := True;
end;

destructor TRMTextExport.Destroy;
begin
  Strings.Free;
  RMUnRegisterExportFilter(Self);
  inherited Destroy;
end;

function TRMTextExport.ShowModal: Word;
begin
  if not ShowDialog then
    Result := mrOk
  else
  begin
    with TRMTXTExportForm.Create(nil) do
    begin
	    CB1.Checked := KillEmptyLines;
  	  CB2.Checked := ConvertToOEM;
	    CB3.Checked := ExportFrames;
  	  CB4.Checked := UsePseudoGraphic;
	    CB5.Checked := PageBreaks;
  	  E1.Text := FloatToStr(ScaleX);
    	E2.Text := FloatToStr(ScaleY);
	    CB3Click(nil);
      Result := ShowModal;
      try
        ScaleX := RMStrToFloat(E1.Text);
      except
        ScaleX := 1;
      end;
      try
        ScaleY := RMStrToFloat(E2.Text);
      except
        ScaleY := 1;
      end;
      FKillEmptyLines := CB1.Checked;
      ConvertToOEM := CB2.Checked;
      ExportFrames := CB3.Checked;
      UsePseudoGraphic := CB4.Checked;
      PageBreaks := CB5.Checked;
      Free;
    end;
  end;
end;

procedure TRMTextExport.OnEndPage;
var
  i, n, x, dx, x1, dx1, tc1: Integer;
  p: PRMTextRec;
  s: String;
  AddIndex: Integer;
  IsEmpty: Boolean;
  liOffset: Integer;

  function Dup(Count: Integer): String;
  var
    i: Integer;
  begin
    Result := '';
    for i := 1 to Count do
      Result := Result + ' ';
  end;

  procedure CheckLine(Index: Integer);
  var
    i: Integer;
    s: String;
  begin
    s := Strings[Index];
    for i := 1 to Length(s) do
    begin
      if (Pos(s[i], PseudoHex) = 0) and (s[i] <> ' ') then
      begin
        Strings.Add('');
        AddIndex := Strings.Count;
        break;
      end;
    end;
  end;

  procedure FillLine(Index, x, dx: Integer; ch: Integer);
  var
    i, n: Integer;
    s: String;
  begin
    s := Strings[Index];
    if Length(s) < x + dx then
      s := s + Dup(x + dx - Length(s));
    for i := x to x + dx - 1 do
    begin
      n := Pos(s[i], PseudoHex);
      if n = 0 then
        s[i] := PseudoHex[ch]
      else
        s[i] := Chr(Ord(PseudoHex[n]) or Ord(PseudoHex[ch]));
    end;
    Strings[Index] := s;
  end;

  procedure AddLine(s: String);
  var
    i: Integer;
    s1: String;
  begin
    if AddIndex >= Strings.Count then
      Strings.Add(s)
    else
    begin
      s1 := Strings[AddIndex];
      if Length(s) > Length(s1) then
        s1 := s1 + Dup(Length(s) - Length(s1));
      for i := 1 to Length(s) do
      begin
        if s1[i] = ' ' then
          s1[i] := s[i];
      end;
      Strings[AddIndex] := s1;
    end;
  end;

  function ReplaceFrames(s: String): String;
  var
    i, n: Integer;
  begin
    for i := 1 to Length(s) do
    begin
      n := Pos(s[i], PseudoHex);
      if n <> 0 then
      begin
        if UsePseudoGraphic then
          s[i] := Pseudo[n]
        else
          s[i] := Frames[n];
      end;
    end;
    Result := s;
  end;

begin
  n := Lines.Count - 1;
  while n >= 0 do
  begin
    if Lines[n] <> nil then break;
    Dec(n);
  end;

  Strings.Clear;
  for i := 0 to n do
  begin
    s := '';
    tc1 := 0;
    p := PRMTextRec(Lines[i]);
    AddIndex := Strings.Count;
    IsEmpty := True;
    while p <> nil do
    begin
      IsEmpty := False;
      x := Round((p^.X + 1) / (6.5 / ScaleX));
      if p^.Alignment = rmtaRight then
        Dec(x, Length(p^.Text));
      if ExportFrames and (p^.FrameTyp <> 0) then
      begin
        x1 := Round(p^.DrawRect.Left / (6.5 / ScaleX));
        dx1 := Round(p^.DrawRect.Right / (6.5 / ScaleX) );

        liOffset := 0;
        while (x + Length(p^.Text) - liOffset) >= dx1 do
          Inc(liOffset);
        s := s + Dup(x - tc1 - liOffset) + p^.Text + Dup(liOffset);
        tc1 := x + Length(p^.Text);
        dx1 := dx1 - x1 + 1;
        if ((p^.FrameTyp and rmftTop) <> 0) or ((p^.FrameTyp and rmftBottom) <> 0) then
        begin
          if (p^.FrameTyp and rmftTop) <> 0 then
          begin
            if Strings.Count = 0 then
            begin
              Strings.Add('');
              AddIndex := 1;
            end
            else
              CheckLine(AddIndex - 1);
          end;

          x := x1; dx := dx1;
          if (p^.FrameTyp and rmftTop) <> 0 then
          begin
            if (p^.FrameTyp and rmftLeft) <> 0 then
            begin
              FillLine(AddIndex - 1, x, 1, 3);
              Inc(x); Dec(dx);
            end;
            if (p^.FrameTyp and rmftRight) <> 0 then
            begin
              FillLine(AddIndex - 1, x + dx - 1, 1, 4);
              Dec(dx);
            end;
            FillLine(AddIndex - 1, x, dx, 2);
          end;

          x := x1; dx := dx1;
          if (p^.FrameTyp and rmftBottom) <> 0 then
          begin
            if AddIndex = Strings.Count then
            begin
              Strings.Add('');
              AddIndex := Strings.Count - 1;
              Strings.Add('');
            end
            else if AddIndex = Strings.Count - 1 then
              Strings.Add('');

            if (p^.FrameTyp and rmftLeft) <> 0 then
            begin
              FillLine(AddIndex + 1, x, 1, 5);
              Inc(x); Dec(dx);
            end;
            if (p^.FrameTyp and rmftRight) <> 0 then
            begin
              FillLine(AddIndex + 1, x + dx - 1, 1, 6);
              Dec(dx);
            end;
            FillLine(AddIndex + 1, x, dx, 2);
          end;
        end;

        x := x1; dx := dx1;
        if ((p^.FrameTyp and rmftLeft) <> 0) or ((p^.FrameTyp and rmftRight) <> 0) then
        begin
          if AddIndex >= Strings.Count then
          begin
            Strings.Add('');
            AddIndex := Strings.Count - 1;
          end;
          if (p^.FrameTyp and rmftLeft) <> 0 then
            FillLine(AddIndex, x, 1, 1);
          if (p^.FrameTyp and rmftRight) <> 0 then
            FillLine(AddIndex, x + dx - 1, 1, 1);
        end;
      end
      else
      begin
        s := s + Dup(x - tc1) + p^.Text;
        tc1 := x + Length(p^.Text);
      end;
      p := p^.Next;
    end;

    if not KillEmptyLines or not IsEmpty then
      AddLine(s);
  end;

  if PageBreaks then
  begin
    s := #12;
    Strings.Add(s);
  end;

  for i := 0 to Strings.Count - 1 do
  begin
    s := Strings[i];
    if ConvertToOEM then
      CharToOEMBuff(@s[1], @s[1], Length(s));
    if s <> #12 then
      s := ReplaceFrames(s) + #13#10
    else
      s := s + #13#10;
    Stream.Write(s[1], Length(s));
  end;
end;

procedure TRMTextExport.OnBeginPage;
var
  i: Integer;
begin
  ClearLines;
  for i := 0 to 200 do
    Lines.Add(nil);
end;

procedure TRMTextExport.InsertTextRec(p: PRMTextRec; LineIndex: Integer);
var
  p1, p2: PRMTextRec;
begin
  p1 := PRMTextRec(Lines[LineIndex]);
  p^.Next := nil;
  if p1 = nil then
    Lines[LineIndex] := TObject(p)
  else
  begin
    p2 := p1;
    while (p1 <> nil) and (p1^.X < p^.X) do
    begin
      p2 := p1;
      p1 := p1^.Next;
    end;
    if p2 <> p1 then
    begin
      p2^.Next := p;
      p^.Next := p1;
    end
    else
    begin
      Lines[LineIndex] := TObject(p);
      p^.Next := p1;
    end;
  end;
end;

procedure TRMTextExport.OnText(DrawRect: TRect; X, Y: Integer;
  const Text: string; FrameTyp: Integer; View: TRMView);
var
  p: PRMTextRec;
begin
  if View = nil then Exit;

  Y := Round(Y / (14 / ScaleY));
  New(p);
  p^.X := X;
  p^.Text := Text;
  if View is TRMMemoView then
  begin
    with View as TRMMemoView do
    begin
      p^.FontName := Font.Name;
      p^.FontSize := Font.Size;
      p^.FontStyle := RMGetFontStyle(Font.Style);
      p^.FontColor := Font.Color;
      p^.Alignment := Alignment;
      if Alignment = rmtaRight then
        p^.X := DrawRect.Right;
{$IFNDEF Delphi2}
      p^.FontCharset := Font.Charset;
{$ENDIF}
    end;
  end;
  p^.DrawRect := DrawRect;
  p^.DrawRect.Left := p^.DrawRect.Left + 1;
  p^.FrameTyp := FrameTyp;
  p^.FillColor := View.FillColor;
  InsertTextRec(p, Y);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMTXTExportForm}
procedure TRMTXTExportForm.Localize;
begin
	Font.Name := RMLoadStr(SRMDefaultFontName);
  Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
  Font.Charset := StrToInt(RMLoadStr(SCharset));

  RMSetStrProp(Self, 'Caption', rmRes + 1800);
  RMSetStrProp(CB1, 'Caption', rmRes + 1801);
  RMSetStrProp(CB2, 'Caption', rmRes + 1802);
  RMSetStrProp(CB3, 'Caption', rmRes + 1803);
  RMSetStrProp(CB4, 'Caption', rmRes + 1804);
  RMSetStrProp(CB5, 'Caption', rmRes + 1805);
  RMSetStrProp(Label1, 'Caption', rmRes + 1806);

  btnOK.Caption := RMLoadStr(SOk);
  btnCancel.Caption := RMLoadStr(SCancel);
end;

procedure TRMTXTExportForm.CB3Click(Sender: TObject);
begin
  CB4.Enabled := CB3.Checked;
end;

procedure TRMTXTExportForm.FormCreate(Sender: TObject);
begin
	Localize;
end;

initialization

end.