PC Plus SuperCD (UK) 2000 March/pcp161b.iso/handson/archive/Issue145/Delphi/MacroEd/maced.pas

Pascal/Delphi Source File | 1998-07-10 | 16.2 KB | 516 lines

unit Maced;
{ -------------------------------------
  --- PC Plus sample Delphi program ---
  --- Text editor with 'macros'     ---
  --- Author: Huw Collingbourne     ---
  -------------------------------------

  -------------------------------------------------
  IMPORTANT NOTES ON NEW DRAG-DROP-ENABLED VERSION:
  -------------------------------------------------
  This new version adds the ability to drag a file from Explorer
  When the file is dropped, it is loaded if it is found to be of the
  appropriate type (TXT or PAS) otherwise an error message is
  shown. There is a limit to the file size possible to load (32k in Delphi 1,
  closer to 64K in 32-bit Delphis).

  Note: No checks are made for file size. For a more robust application,
  you may either want to add Exception handling to recover from errors
  caused by attempting to load very long files or you may want to convert this
  application (using Delphi 2 or above) to use a RichEdit control instead
  of a Memo.

  The main code relevant to drag-drop file loading is indicated by a
  comment starting with these characters
          {!!
  -------------------------------------------------



  The following notes explain how to use the 'macro' feature....
  USAGE:

  RECORD a new macro (or edit an existing macro): Press CTRL-R

  PLAY BACK a macro: Press CTRL+ALT+(a char)
  -------------------------------------


  NOTES:
  MACROS
  * Macros are stored as strings. The first letter in the macro text
  is the 'activator char' and will not be displayed when the macro is run.
  e.g.  if the macro test is
         'Xrated'
        -'X' is the activator char, so you can run the macro by
             pressing CTRL-ALT-X
        - the macro text that appears in the editor will be
             'rated'

  * A list of macros is stored in a TStringList object called Macros

  * Saving and Loading macros.
  At first sight it might seem that you should be able to save
  and load macros in the same way as the text in the Memo, using Delphi's
  SaveToFile and LoadFromFile methods.

  The trouble is that each item of macro text may include carriage returns.
  A 3-line macro would be saved in the form of 3 separate lines of text.
  On reloading, you would end up with 3 different macros!

  To get around this problem, I've created a simple record containing a string
  and written typed files of these records. This approach also gives me the
  option of adding extra fields to the record - such as macro control keys
  (CTRL, ALT, SHIFT etc.), should I wish to extend the features of the macros
  at a later stage.


  }

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Menus, StdCtrls, ExtCtrls,
  Macrec,   { use Macrec unit }
  ShellAPI; {!! use ShellAPI unit }

type
  TMainForm = class(TForm)
    MainMenu1: TMainMenu;
    EditorMemo: TMemo;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    FileMnu: TMenuItem;
    FileNew: TMenuItem;
    FileSave: TMenuItem;
    FileLoad: TMenuItem;
    N1: TMenuItem;
    FileExit: TMenuItem;
    FileSaveAs: TMenuItem;
    StatusPanel: TPanel;
    Macros1: TMenuItem;
    SaveMac: TMenuItem;
    LoadMac: TMenuItem;
    ClearMac: TMenuItem;
    RecordMac: TMenuItem;
    DisplayMac: TMenuItem;
    procedure FileNewClick(Sender: TObject);
    procedure FileSaveClick(Sender: TObject);
    procedure FileSaveAsClick(Sender: TObject);
    procedure FileLoadClick(Sender: TObject);
    procedure FileExitClick(Sender: TObject);
    procedure EditorMemoKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure EditorMemoKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormActivate(Sender: TObject);
    procedure EditorMemoKeyPress(Sender: TObject; var Key: Char);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure LoadMacClick(Sender: TObject);
    procedure ClearMacClick(Sender: TObject);
    procedure SaveMacClick(Sender: TObject);
    procedure RecordMacClick(Sender: TObject);
    procedure DisplayMacClick(Sender: TObject);
  private
    { Private declarations }

  public
    { Public declarations }
    function ConfirmFileSave(FileName : string) : boolean;
    procedure GetCursorPos( var LinePos, ColPos : LongInt );
    procedure ShowCursorPos;

    { ** Macro methods }
    procedure ClearMacros;
    procedure RecordMacro;
    function GetMacStringIndex( ch: char ) : integer;
    function GetMacString( ch : char ) : string;

       {!! declare proc to respond to dragdrop messages }
    procedure RespondToMessage(var Msg: Tmsg; var Handled: Boolean);
    function FileTypeOK( fname : string ) : boolean;
    procedure TryToLoadFile( fname  : string);
  end;

const
{ codes for special 'editing' characters }
  CR = chr(13);    { carriage return }
  LF = chr(10);    { linefeed        }
  CRLF = CR + LF;
  BS = chr(8);     { backspace       }
  DEL = chr(16);   { delete          }
  MACROFILE        = 'Macros.mac';

type               { define record for file operations }
  StringRecord = record
    str : string[255];
  end;

var
  MainForm         : TMainForm;
  TextFileName     : string;       { ** current file name                      }
  MacroFileName    : string;       { ** current macro file name                }
  Macros           : TStringList;  { ** store macros in this StringList        }

implementation

{$R *.DFM}

function TMainForm.FileTypeOK( fname : string ) : boolean;
{ check file extsnion to see if it matches one of the expected file types }
{ if so, return true, else return false }
var
   Ext : string;
begin
  Ext := UpperCase(ExtractFileExt(fname));
  if (Ext = '.TXT') or (Ext = '.PAS') then
     result := true
  else
     result := false;
end;


procedure TMainForm.TryToLoadFile( fname : string);
begin
   if FileExists( fname ) then
   begin
     EditorMemo.Lines.LoadFromFile( fname );
     Caption := 'Text Editor - ' + ExtractFilename( fname );
     TextFileName := fname; { ** reset TextFileName on FileLoad }
   end
   else
     MessageDlg('Sorry. Can''t load this file. '+ fname +
                ' does not exist!',
                 mtInformation, [mbOK], 0);
end;

procedure TMainForm.RespondToMessage(var Msg: Tmsg; var Handled: Boolean);
{!! Respond to filename that's been drag-dropped from Explorer. Load
  file if it's a valid text file, else display error message }
const
  BUFFLEN = 255;
var
  buffer : array[0..BUFFLEN] of char;
  fname : string;
begin
   if Msg.Message = WM_DROPFILES then
   begin
      DragQueryFile(Msg.WParam, 0, buffer, BUFFLEN);
      fname  := StrPas(buffer);
      DragFinish(Msg.WParam);
      Handled := True;
      if FileTypeOK( fname ) then
         TryToLoadFile( fname )
      else
         MessageDlg('Sorry. Cannot load files with the extension '+
                 ExtractFileExt(fname) +
                '!',  mtInformation, [mbOK], 0);
   end;
end;

{ Macro Methods }

procedure TMainForm.RecordMacro;
{ Pop up a window in which a new macro can be recorded or an existing
  macro can be edited. }
var
  macChar     : char;
  macText     : string;
  macPos      : integer;
begin
    macText := '';
    macChar := macText[1];
    macPos  := -1;
    if MacroForm.ShowModal = mrOK then  { if user chooses to use the newly     }
      begin                             { recorded or edited macro...          }
        macChar := UpCase(MacroForm.KeyCharEdit.Text[1]);{ get activator       }
        macText := macChar + MacroForm.MacroMemo.Text;   { char and macro      }
        macpos := GetMacStringIndex( macChar );          { text from MacroForm }
        if macPos > - 1 then            { if there is a previous macro with the}
          Macros.Delete( macPos );      { activator char, delete it.           }
        Macros.Add( macText );          { Add the new macro to the Macros list }
      end;
end;

procedure TMainForm.ClearMacros;
{ delete strings from StringList of macros }
begin
   Macros.Clear;
end;

function TMainForm.GetMacStringIndex( ch: char ) : integer;
{** Return the index of a macro string in Macros StringList,
  based on the position of its initial 'activator' character }
var
  i          : integer;
  stopsearch : boolean; { true when macro is found or no more macros remain    }
  macroPos   : integer;
begin
   i := 0;
   macroPos := -1;        { no macro found, by default        }
   stopsearch := false;
   if Macros.Count = 0 then
       stopsearch := true; { check there are macros available }
     While not ( stopsearch ) do
     begin
                          { try to match the character, ch, with the first char}
                          { of the item at index i in the Macros StringList    }
       if ( Macros[i][1] = UpCase(ch) ) then
          begin
            macroPos := i;
            stopsearch := true;
          end
       else i := i+1;
       if (i = Macros.Count) then
          stopsearch := true; { don't try to search beyond last item in Macros }
     end;
      GetMacStringIndex := macroPos;
end;




function TMainForm.GetMacString( ch : char ) : string;
{** Return a string associated with the HotKey char, ch }
var
  macstr     : string;  { the macro string to be returned. Blank if no match   }
  macpos     : integer;
begin                   { Macros StringList                                    }
   macstr := '';
   macpos := GetMacStringIndex( ch );
   if macpos > -1 then { if a macro is already assigned to activator char, ch  }
     begin            { return the associated string minus the initial char    }
      macstr := Macros[macpos];
      macstr := copy( macstr, 2, Length(macstr)-1);
     end;
   GetMacString := macstr;
end;


function TMainForm.ConfirmFileSave(FileName : string) : boolean;
{ put up a dialog box to confirm that the existing file should be
  overwritten. This function returns True if the Yes button is pressed,
  otherwise it returns false. Note that you can test for the
  buttons used in dialogs with these constants: mrNone,mrOk,mrCancel,
  mrAbort,mrRetry,mrIgnore,mrYes,mrNo,mrAbort,mrRetry,mrIgnore,mrAll }

begin
    if MessageDlg(FileName + ' already exists. Save anyway?',
                        mtConfirmation, mbYesNoCancel, 0)
                        = mrYes then
      ConfirmFileSave := true
    else
      ConfirmFileSave := false;
end;

procedure TMainForm.FileNewClick(Sender: TObject);
begin
  EditorMemo.Clear;
  TextFileName := '' ; { ** on FileNew rest TextFileName to '' }
  OpenDialog1.Filename := '*.*';
  Caption := 'Text Editor - [Untitled]';
end;

procedure TMainForm.FileSaveClick(Sender: TObject);
{** If TextFileName has been assigned, save text to file.
    Otherwise, pass processing to FileSaveAs }
begin
  if TextFileName <> '' then
    EditorMemo.Lines.SaveToFile(TextFileName)
  else FileSaveAsClick(Sender);
end;

procedure TMainForm.FileSaveAsClick(Sender: TObject);
var
   SaveFile : boolean;
begin
   SaveFile := true;
   with SaveDialog1 do
    if Execute then
    begin
      if FileExists(FileName) then
         SaveFile := ConfirmFileSave(FileName);
      If SaveFile then
      begin
         EditorMemo.Lines.SaveToFile(Filename);
         Caption := 'Text Editor - ' + ExtractFilename(FileName);
         TextFileName := FileName; {** on file SaveAs, set TextFileName }
      end;
    end;
end;

procedure TMainForm.FileLoadClick(Sender: TObject);
begin
  with OpenDialog1 do
    if Execute then
         TryToLoadFile(FileName);
end;

procedure TMainForm.FileExitClick(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.GetCursorPos( var LinePos, ColPos : LongInt );
{ Assign the current Line Number and Column Number of the cursor to the
  arguments: LinePos and ColPos.
  Note the 'var' parameters - var parameters are passed by reference so the
  values of the original variables are changed by actions inside this procedure}
begin
   LinePos := SendMessage(EditorMemo.Handle, EM_LINEFROMCHAR, EditorMemo.SelStart,0);
   ColPos := (SendMessage(EditorMemo.Handle, EM_LINEINDEX, LinePos, 0));
   ColPos := EditorMemo.SelStart - ColPos;
end;

procedure TMainForm.ShowCursorPos;
var
   LineNum, ColNum : LongInt;
begin
   GetCursorPos( LineNum, ColNum );
   StatusPanel.Caption := (' Line: ' + IntToStr(LineNum) +
                       ', Col: ' + IntToStr((ColNum)));
end;



procedure TMainForm.EditorMemoKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
{ When a keydown event is fired, check to see if a 'shift' key or keys
  such as CTRL or ALT has been pressed along with a character A to z.
  If so, see if macro text is associated with this HotKey. If so,
  insert the text into the current line of the Memo }
var
   LineNum, ColNum, StartPos : LongInt;
   aLine, st: string;
begin
  if (ssCtrl in Shift) then
     if (ssAlt in Shift) and (chr(Key) in ['A'..'Z','a'..'z'] ) then
     begin
      st := GetMacString(chr(Key));
      if st <> '' then
      begin
        GetCursorPos( LineNum, ColNum );
        StartPos := EditorMemo.selStart;
        aLine := EditorMemo.Lines[LineNum];      { get current line from Memo  }
        insert(st, aLine, ColNum+1 );            { insert Macro text           }
        EditorMemo.Lines[LineNum] := aLine;      { put altered line in Memo    }
        EditorMemo.selStart := StartPos + Length(st);{ put cursor after mactext}
      end;
    end
    else if (UpCase(chr(Key)) = 'R') then
         RecordMacro;
end;



procedure TMainForm.EditorMemoKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  ShowCursorPos;
end;

procedure TMainForm.FormActivate(Sender: TObject);
begin
  ShowCursorPos;
end;

procedure TMainForm.EditorMemoKeyPress(Sender: TObject; var Key: Char);
{ Some key combinations generate foreign or non-printable characters
  - e.g. CTRL-ALT-E = Θ
  All ASCII characters are handled by this method. We just filter out
  unwanted characters. We do allow CR+LF, however!
}
begin    { filter foreign + nonprintable chars }
 If not (Key in [CR, LF, BS, DEL, ' '..'~']) then
   Key := Chr(0);
end;

procedure TMainForm.FormCreate(Sender: TObject);
{ Init global variables }
begin
  TextFileName := '';
  Macros := TStringList.Create;
  {!! set up app to accept files dragged from Explorer }
  DragAcceptFiles(MainForm.Handle, true);
  Application.OnMessage := RespondToMessage;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  Macros.Free; {** destroy StringList on exit }
end;

procedure TMainForm.LoadMacClick(Sender: TObject);
{ Load Macros }
var
  RecFile : File of StringRecord;
  Rec     : StringRecord;
begin
  if FileExists(MACROFILE) then
  begin
    Macros.Clear; { get rid of existing macros }
    AssignFile(RecFile, MACROFILE);
    Reset(RecFile);
    while not Eof(RecFile) do
    begin
      Read(RecFile,Rec);
      Macros.Add(Rec.str);
    end;
    CloseFile(RecFile);
  end
  else
      MessageDlg('Sorry. Macro file "'+ MACROFILE +
                          '" does not exist!',
                       mtInformation, [mbOK], 0);
end;

procedure TMainForm.ClearMacClick(Sender: TObject);
begin
  ClearMacros;
end;

procedure TMainForm.SaveMacClick(Sender: TObject);
var
   SaveFile : boolean;
   RecFile  : file of StringRecord;
   aRecord  : StringRecord;
   i        : integer;
begin
   SaveFile := false;
   if Macros.Count = 0 then
      ShowMessage( 'There are no macros to save!' )
   else
   begin
      if FileExists(MACROFILE) then
         SaveFile := ConfirmFileSave(MACROFILE)
      else
         SaveFile := true;
      if SaveFile then
         begin
           { write a file of stringRecords }
           AssignFile(RecFile, MACROFILE );
           Rewrite(RecFile);
           for i := 0 to Macros.Count - 1 do
           begin
             aRecord.str := Macros[i];
             Write(RecFile, aRecord );
           end;
           CloseFile(RecFile);
         end;
   end;
end;

procedure TMainForm.RecordMacClick(Sender: TObject);
begin
  RecordMacro;
end;

procedure TMainForm.DisplayMacClick(Sender: TObject);
begin
  EditorMemo.Lines.AddStrings(Macros);
end;

end.