RichEdit的自动格式化

      Delphi 2004-12-25 11:12
第一：要从TCoriversion派生出一个新类
第二：重载CorrvertReadStream函数
第三：在主窗体的OnCreate函数中登记文件类型。用RichEdit的.RegisterConversionFormat函数
unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs,
Menus, StdCtrls, ComCtrls;
type
TMainForm = class(TForm)
MainMenu1: TMainMenu;
Menufile: TMenuItem;
MenuOpen: TMenuItem;
MenuSaveAs: TMenuItem;
N1: TMenuItem;
MenuExit: TMenuItem;
OpenDlg: TOpenDialog;
SaveDlg: TSaveDialog;
Rich: TRichEdit;
StatusBar: TStatusBar;
procedure FormCreate(Sender: TObject);
procedure MenuOpenClick(Sender: TObject);
procedure MenuSaveAsClick(Sender: TObject);
procedure MenuExitClick(Sender: TObject);
procedure MenuPopupPopup(Sender: TObject);
procedure MenuSelectAllClick(Sender: TObject);
procedure MenuCopyClick(Sender: TObject);
private
procedure Progress(Address:LongInt);
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
type
THexConversion = class(TConversion)
public
function ConvertReadStream(Stream:TStream; Buffer:PChar;
BufSize:integer): integer; override;
end;
// This implements a callback procedure used by TRichEdit when loading
// a file. Gets called repeatedly until stream is empty.
//
function THexConversion.ConvertReadStream(Stream:TStream; Buffer:PChar;
BufSize:integer): integer;
var s:string;
buf:array[1..16] of char;
i,n:integer;
begin
Result := 0;
if BufSize < = 82 then Exit;
s := Format(';%.5x ',[Stream.Position]);
n := Stream.Read(buf,16);
if n = 0 then Exit;
for i := 1 to n do
begin
AppendStr(s,IntToHex(ord(buf[i]),2)+' ');
if i mod 4 = 0 then AppendStr(s,' ');
end;
AppendStr(s,StringOfChar(' ',62-length(s)));
for i := 1 to n do
begin
if (buf[i] < #32) or (buf[i] > #126) then
buf[i] := '.';
AppendStr(s,buf[i]);
end;
AppendStr(s,#13#10);
StrPCopy(Buffer,s);
Result := length(s);
if Stream.Position and $FFF = 0 then MainForm.Progress(Stream.Position);
end;
procedure TMainForm.Progress(Address:LongInt);
begin
StatusBar.SimpleText := 'Reading...
标签集:TAGS:
回复Comments() 点击Count()
+IntToHex(Address,5);
StatusBar.Update;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
Rich.RegisterConversionFormat('bin',THexConversion);
Rich.RegisterConversionFormat('obj',THexConversion);
Rich.RegisterConversionFormat('exe',THexConversion);
end;
procedure TMainForm.MenuOpenClick(Sender: TObject);
var fname:string;
begin
if OpenDlg.Execute then
begin
try
Screen.Cursor := crHourglass;
fname := ExtractFileName(OpenDlg.Filename);
StatusBar.SimpleText := 'Reading...';
Rich.Lines.Clear;
Application.ProcessMessages;
try
Rich.Lines.LoadFromFile(OpenDlg.Filename);
StatusBar.SimpleText := fname;
except on E:EFOpenError do
begin
StatusBar.SimpleText := '';
MessageDlg(Format('Can''t open file %s.',[fname]),mtError,[mbOk],0);
end;
end;
finally
Screen.Cursor := crDefault;
end;
end;
end;
procedure TMainForm.MenuSaveAsClick(Sender: TObject);
begin
SaveDlg.Filename := ChangeFileExt(OpenDlg.FileName,'.txt');
if SaveDlg.Execute then
Rich.Lines.SaveToFile(SaveDlg.FileName);
end;
procedure TMainForm.MenuExitClick(Sender: TObject);
begin
Close;
end;
end.
标签集:TAGS:
回复Comments() 点击Count()

回复Comments

{commentauthor}
{commentauthor}
{commenttime}
{commentnum}
{commentcontent}
作者:
{commentrecontent}