RichEdit的十六进制转换器

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...' + 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.