main.pas

来自「精彩编程百例26～50 其中有 控制任务栏 windows底层任务控制 屏保预览」· PAS 代码 · 共 155 行

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs,
  Menus, StdCtrls, ComCtrls;

type
    Tform1 = class(TForm)
    MainMenu: TMainMenu;
    MenuFile: TMenuItem;
    MenuOpen: TMenuItem;
    MenuSaveAs: TMenuItem;
    N1: TMenuItem;
    MenuExit: TMenuItem;
    OpenDlg: TOpenDialog;
    SaveDlg: TSaveDialog;
    Richtext: TRichEdit;
    StatusBar: TStatusBar;
    MenuPopup: TPopupMenu;
    MenuSelectAll: TMenuItem;
    MenuCopy: TMenuItem;
    menuhelp: TMenuItem;
    A1: TMenuItem;
    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
  form1: Tform1;

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 form1.Progress(Stream.Position);
end;

procedure Tform1.Progress(Address:LongInt);
begin
  StatusBar.SimpleText := 'Converting...  $'+IntToHex(Address,5);
  StatusBar.Update;
end;

procedure Tform1.FormCreate(Sender: TObject);
begin
  Richtext.RegisterConversionFormat('bin',THexConversion);
  Richtext.RegisterConversionFormat('obj',THexConversion);
  Richtext.RegisterConversionFormat('exe',THexConversion);
end;

procedure Tform1.MenuOpenClick(Sender: TObject);
var fname:string;
begin
 if OpenDlg.Execute then
   begin
     try
       Screen.Cursor := crHourglass;
       fname := ExtractFileName(OpenDlg.Filename);
       StatusBar.SimpleText := 'Converting...';
       Richtext.Lines.Clear;
       Application.ProcessMessages;
       try
         Richtext.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 Tform1.MenuSaveAsClick(Sender: TObject);
begin
  SaveDlg.Filename := ChangeFileExt(OpenDlg.FileName,'.txt');
  if SaveDlg.Execute then
    Richtext.Lines.SaveToFile(SaveDlg.FileName);
end;

procedure Tform1.MenuExitClick(Sender: TObject);
begin
  Close;
end;

procedure Tform1.MenuPopupPopup(Sender: TObject);
var SelStart,SelEnd:LongInt;
begin
  Richtext.Perform(EM_GETSEL,WPARAM(@SelStart),WPARAM(@SelEnd));
  MenuCopy.Enabled := SelStart <> SelEnd;
end;

procedure Tform1.MenuSelectAllClick(Sender: TObject);
begin
  Richtext.Perform(EM_SETSEL,0,-1);
end;

procedure Tform1.MenuCopyClick(Sender: TObject);
begin
  Richtext.Perform(WM_COPY,0,0);
end;

end.