⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 asansi.pas

📁 wptools5 pro 完整源代码 Msword界面的文本编辑器源代码
💻 PAS
字号:
unit AsANSI;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, WPRTEDefs, WPCTRMemo, WPCTRRich;

type
  TForm1 = class(TForm)
    WPRichText1: TWPRichText;
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Memo1: TWPRichText;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    function GetANSIText(
      Source : TWPCustomRTFedit;
      pagenr : Integer;
      cpi    : Integer) : string;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  WPRichtext1.Load;
end;

function TForm1.GetANSIText(
      Source : TWPCustomRTFedit;
      pagenr : Integer;
      cpi    : Integer) : string;
var page     : TWPVirtPage;
    i,y,h,lowx, j : Integer;
    linedata : TWPVirtPageImageLineRef;
    s : string;
    str : TStringList;
begin
   page := Source.BodyText.Pages[pagenr];
   str  := TStringList.Create;
   try
   i := 0;
   y := 0;
   lowx := -1;
   while page.GetLine(i,linedata) do
   begin
     if (linedata.lineflags and WPDRAW_NOCURSOR)=0 then
     begin
        if (linedata.y>y) and ((lowx<0) or (linedata.x<=lowx)) then
        begin
         //  if lowx<0 then lowx := linedata.x;
           y := linedata.y;
           h := linedata.h;
           j := 0; // i works most of the times!
           s := '';
           while page.GetLine(j,linedata) do
           begin
             if (linedata.par<>nil) and
                ((linedata.lineflags and WPDRAW_NOCURSOR)=0) and
                (linedata.y>=y) and (linedata.y<y+h) then
             begin
                if s<>'' then s := s + #9;
                s := s + linedata.par.GetLineText(linedata.linenr);
             end;
             inc(j);
           end;
           if s<>'' then str.Append(s);
           inc(y,h-1);
        end;
     end;
     inc(i);
   end;
   Result := str.Text + #13+#10 +
     '------------------------- Page ' + IntToStr(pagenr+1) +
     '-------------------------' +
     #13+#10;
   finally
    str.Free;
   end;
end;


procedure TForm1.Button2Click(Sender: TObject);
var i : Integer;
    s : string;
begin
  s := '';
  for i:=0 to WPRichText1.BodyText.PageCount-1 do
  begin
    s := s + GetANSIText(WPRichText1,i,10);
  end;
  Memo1.Clear;
  Memo1.DefaultAttr.SetFontName('Courier New');
  Memo1.DefaultAttr.SetFontSize(8);
  Memo1.AsString := s;
  Memo1.Header.SetPageWH(10*1440, 20*1440, 10, 10, 10, 10);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -