delete key is ignored

[tobenschain 0]

TMemo sometimes ignores the delete key. I have been unable to trap the problem. Key Preview is true.

[Anders Melander 1782]

Is your form modal? If not, do you have a TAction on the mainform with the shortcut [Del] ?

 

KeyPreview is a property on the form. Unless you are intercepting keystrokes on the form there is no reason to have KeyPreview=True.

If you need KeyPreview=True then the problem might be that your event handler eats the [Del] key. Show us your code.

[tobenschain 0]

All keys work except delete. Delete key works until I do a save.

[tobenschain 0]

unit cEditor; {$H+,F+,X+,N+} {copyright (c) 1998-2021 Old Dominion Solutions, Inc.}
interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls, ComCtrls, Menus, ExtCtrls, wsData;
{$I ods_os.inc}

{weak: MemoSelectionChange was disabled 08/01/2011 when TMemo replaced TRichEdit
   delete key is sometimes ignored?}

function  open_rept_editor(Afilename: ShortString; Aro, Acreate: boolean): pointer;

procedure open_script_editor(Afilename: PShortString; AScriptCol: TStringList_2;
            Asubap, Aline, Acol: integer; Amodal: boolean);

type
  TReptTextEditor = class(TForm)  SaveDialog: TSaveDialog;    Edit: TMenuItem;
      PopupMenu1: TPopupMenu;     Print: TMenuItem;           SaveRept: TMenuItem;
      SaveReptAs: TMenuItem;      PrintReportCode: TMenuItem; CloseReptEdit: TMenuItem;
      Undo: TMenuItem;            ClearUndo: TMenuItem;
      Cut: TMenuItem;             Copy: TMenuItem;            Paste: TMenuItem;
      Delete: TMenuItem;          Find: TMenuItem;            Replace: TMenuItem;
      SearchAgain: TMenuItem;     StatusLine: TPanel;         Screen: TMenuItem;
      Status1: TPanel;            Status2: TPanel;            Status3: TPanel;
      InsertField: TMenuItem;     Memo: TMemo;                RichEdit: TRichEdit;
    ReplaceAllFiles: TMenuItem;
    procedure Open(const AFilename: ShortString);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormDestroy(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure ScreenClick(Sender: TObject);
    procedure PrintClick(Sender: TObject);
    procedure PrintReportCodeClick(Sender: TObject);
    procedure EditClick(Sender: TObject);
    procedure Save;
    procedure SaveAs;
    procedure SaveReptClick(Sender: TObject);
    procedure SaveReptAsClick(Sender: TObject);
    procedure CloseReptEditClick(Sender: TObject);
    procedure UndoClick(Sender: TObject);
    procedure InsertFieldClick(Sender: TObject);
    procedure ClearUndoClick(Sender: TObject);
    procedure CutClick(Sender: TObject);
    procedure CopyClick(Sender: TObject);
    procedure PasteClick(Sender: TObject);
    procedure DeleteClick(Sender: TObject);
    procedure FindClick(Sender: TObject);
    procedure ReplaceClick(Sender: TObject);
    procedure SearchAgainClick(Sender: TObject);
    procedure MemoChange(Sender: TObject);
    procedure MemoSelectionChange(Sender: TObject);
    procedure MemoContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure MemoKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure MemoMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SaveDialogCanClose(Sender: TObject; var CanClose: Boolean);
    procedure ReplaceAllFilesClick(Sender: TObject);
  public Filename: ShortString;
      find_val{from_val}, to_val, timew, ext: string[80];
      modal, script_mode, override_edit, abort_save: boolean;
      filenamew: PShortString; script_subap: integer;
    procedure show_status;
    procedure exec_rept(Ascreen: boolean);
    function  exec_find: boolean;
    function  edit_script: boolean;
      end;

{ bfd01.rpt -----------------------------
|                                        |
|                                        |
|                                        |
|                                        |
|                                        |
|                                        |
|                                        |
|----------------------------------------|                                        |
| Line Column Modified Insert            |
 ----------------------------------------}

implementation uses ClipBrd, wsGlob1, wsGlob2, wsGlob3, wsGlob4,
  wsGetStr, wsGetSt2, wsSelFld, wsDataBase,
  wbData, wrData, wdData, wpData, weData,
  wsRepGlo, wsISAMrep, wsISAMsec, wsContr, oScreen, oExec, ReptGlob,
  {$IFDEF IntraWeb} ServerController, {$ENDIF}
  {$IFDEF PlainWindows} cReptDir, GenMain, {$ENDIF}  wsHelp, GenGlob, GenHelp;

{$R *.DFM}

const
  SWarningText = 'Do you wish to save Changes to ''%s''?';
  form_id_prefix = 'Editor ';

{******************************}
procedure TReptTextEditor.Open(const AFilename: ShortString);
    var j1: integer; begin
  Filename := AFilename;

  if exists(FileName) then begin {Memo.Lines.LoadFromFile(FileName);}

    RichEdit.Lines.Clear;
    RichEdit.Lines.LoadFromFile(FileName); {get rid of trailing nuls}
    Memo.Lines.Clear;

    for j1 := 0 to RichEdit.Lines.Count-1 do
      Memo.Lines.Add(RichEdit.Lines[j1]);
    RichEdit.Lines.Clear; end;

  Memo.SelStart := 0; Caption := ExtractFileName(FileName);
  if Memo.ReadOnly then Caption := 'View ' + Caption;
  Memo.Modified := False;
  show_status; end;

procedure TReptTextEditor.FormDestroy(Sender: TObject); begin
  {$IFDEF BudGen}
  if script_mode then begin
    ScriptEditorOpts.Height := Height; ScriptEditorOpts.Width := Width;
    ScriptEditorOpts.Top := Top;       ScriptEditorOpts.Left := Left; end
  else begin
    ReportTextEditorOpts.Height := Height; ReportTextEditorOpts.Width := Width;
    ReportTextEditorOpts.Top := Top;       ReportTextEditorOpts.Left := Left;
    end;
  {$ENDIF}
  end;

procedure TReptTextEditor.FormActivate(Sender: TObject);
    var new_time: ShortString; begin
  if script_mode then exit;
  new_time := get_file_time(Filename);
  if new_time>timew then
    case get_y_or_n('Newer file detected. Do you wish to edit it?',warn,center)
      of 'N': timew := new_time;
         'Y': begin Open(Filename);
                timew := get_file_time(Filename); end; end; end;

procedure TReptTextEditor.FormClose(Sender: TObject; var Action: TCloseAction); begin
  Action := caFree; end;

procedure TReptTextEditor.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    var DialogValue: Integer; FName: ShortString; begin  CanClose := True;
  if Memo.Modified then begin  FName := Caption;
    DialogValue := MessageDlg(Format(SWarningText, [FName]), mtConfirmation,
      [mbYes, mbNo, mbCancel], 0);
    case DialogValue of id_Yes: begin
        if script_mode and (edit_script=fails) then begin
          if abort_save or (get_y_or_n('Script contains errors. Do you wish '+
              'to continue with Save?',warn,center)='N') then begin
            CanClose := False; exit; end; end;
        override_edit := true; Save; end;
      id_Cancel: CanClose := False; end; end; end;

procedure TReptTextEditor.FormKeyDown(Sender: TObject; var Key: Word;
    Shift: TShiftState); begin
  case Key of
    VK_F1:  if Shift=[] then Application.HelpCommand(HELP_CONTEXT,HelpContext);
    VK_F10: if (ssAlt in Shift) then PopupMenu1.Popup(Left+100,Top+100);end;end;

{******************************}
procedure TReptTextEditor.EditClick(Sender: TObject); begin
  edit_script; end;

procedure TReptTextEditor.ScreenClick(Sender: TObject); begin
  exec_rept(true{screen}); end;

procedure TReptTextEditor.PrintClick(Sender: TObject); begin
  exec_rept(false{screen}); end;

procedure TReptTextEditor.Save;
  var j1, subapw: integer; namew, extw: string[80];
    ReptsRecw: TReptsRec; begin
  if Memo.ReadOnly then begin get_cr('Mode is read-only',error); exit; end;
  if Filename='' then SaveAs
  else if script_mode then begin
    if (not override_edit) and (edit_script=fails) and (get_y_or_n('Script '+
        'contains errors. Do you wish to continue with Save?',warn,center)='N')
      then exit;
    if get_control_rec(true{lock})=failed then exit;
    Memo.Lines.SaveToFile(Filename); Memo.Modified := False;
    filenamew^ := upcasestring(name_part(Filename));
    unlock_control_file; show_status; end
  else begin  namew := name_part(Filename); extw := ext_part(Filename);
    subapw := pos(upcase(namew[1]),csubap)-1;
    if SecurityRecw.subapp[subapw].rept<>read_write then begin
      get_cr(ap_title[subapw]+' report write access is required',inform);
      exit; end;
    if (extw[2]='T') and (get_y_or_n(namew+extw+' is a temporary file and will '
      +'be overidden. Do you wish to continue?',warn,center)='N') then exit;
    if get_control_rec(true{lock})=failed then exit;
    while (Memo.Lines.Count>0) and (length(Memo.Lines[0])>0) and
      (Memo.Lines[0][1]<' ') do Memo.Lines[0] := system.copy(Memo.Lines[0],2);
    Memo.Lines.SaveToFile(Filename); Memo.Modified := False;
    if (subapw>=0) and
        ((upcasestring(extw)='.RPT') or (upcasestring(extw)='.RPB')) then begin

      fillchar(ReptsRecw, sizeof(ReptsRecw),#0);
      ReptsRecw.file_name := upcasestring(namew+extw);
      get_file_stats(rept_dir[subapw]^+ReptsRecw.file_name,
        ReptsRecw.modified_time, ReptsRecw.size);

      if get_adv_rept_info(subapw, ReptsRecw.file_name, ReptsRecw)>0{fails} then

        begin end;
      if update_rept_dir(subapw, ReptsRecw,'A'{add or change})=fails then
        begin end;

      {$IFDEF BudGen}
      if ReportDirDial[subapw]<>nil then
        ReportDirDial[subapw].show_item(''{top},namew,system.copy(ext,2));
      {$ENDIF}

      end;
    unlock_control_file; show_status; end;
  timew := get_file_time(Filename); end;

procedure TReptTextEditor.SaveAs; var namew, extw: string[80]; begin
  if Memo.ReadOnly then begin get_cr('Mode is read-only',error); exit; end;
  with SaveDialog do
    if script_mode then begin  Options := Options + [ofNoChangeDir];
      DefaultExt := System.copy(script_suffix[script_subap],2,3);
      Filter := 'Advanced Range Script (*'+script_suffix[script_subap]+
        ')|*'+script_suffix[script_subap]; end
    else if ext='.RPB' then begin DefaultExt := 'RPB';
      Filter := 'Advanced Report (*.rpb)|*.rpb'; end
    else begin DefaultExt := 'RPT';
      Filter := 'Advanced Report (*.rpt)|*.rpt'; end;
  SaveDialog.Filename := Filename;
  SaveDialog.InitialDir := dir_part(Filename);
  if SaveDialog.Execute then begin Filename := SaveDialog.Filename;
    {$IFDEF PlainWindows} Caption := cEditor.form_id_prefix+FileName; {$ENDIF}
{   Caption := ExtractFileName(Filename); }
{   if script_mode then Caption := Caption+' Adv Range Script'; }
    Save; end; end;

procedure TReptTextEditor.SaveReptClick(Sender: TObject); begin
  Save; end;

procedure TReptTextEditor.SaveReptAsClick(Sender: TObject); begin
  SaveAs; end;

procedure TReptTextEditor.PrintReportCodeClick(Sender: TObject);
    var j1: integer; begin

  {$IFDEF PlainWindows}
    with PrintDialog2 do begin MinPage := 1; MaxPage := 9999;
      Options := [{poPageNums, poSelection, poPrintToFile}];
      print_dialog_caption := 'Print '+Caption;
      if Execute=wsData.failed then exit; end; {$ENDIF}

  RichEdit.Lines.Clear;
  RichEdit.Lines.Add('');
  RichEdit.Lines.Add('');
  for j1 := 0 to Memo.Lines.Count-1 do
    RichEdit.Lines.Add('            '+Memo.Lines[j1]);

  if script_mode then RichEdit.Print(ap_title[script_subap]+' '+Caption)
    else RichEdit.Print(get_rept_title(Memo.Lines[2]));

 end;

procedure TReptTextEditor.CloseReptEditClick(Sender: TObject); begin
  if modal then ModalResult := mrOk else Close;
  Release; end;

{******************************}
procedure TReptTextEditor.UndoClick(Sender: TObject); begin
  Memo.Undo; show_status; end;

procedure TReptTextEditor.ClearUndoClick(Sender: TObject); begin
  Memo.ClearUndo; show_status; end;

procedure TReptTextEditor.InsertFieldClick(Sender: TObject);
  var i, j1, d1, subapw, startw, endw: integer; FieldObj: TFieldObj;
    cur,namew: ShortString; begin
  if script_mode then subapw := script_subap
  else begin  namew := name_part(FileName); if length(namew)=0 then exit;
    subapw := pos(namew[1],csubap)-1;         if subapw<0 then exit; end;
  try SelFieldDial := TSelFieldDial.Create(Application);
    except on EOutOfMemory do wsGlob1.abort('Out of memory'); end;
  with FieldList[subapw] do try 
    for i := 0 to Count-1 do begin
      FieldObj := TFieldObj(FieldList[subapw].Objects);
      SelFieldDial.SelectLB.Items.Add(FieldObj.name); end;
    cur := Memo.SelText;

    if (cur='') and (length(Text)>0) then with Memo do begin startw := SelStart;
      while (startw>0) and is_word(Text[startw]) do dec(startw);
      if not is_word(Text[startw]) then inc(startw);
      endw := startw; while is_word(Text[endw]) do inc(endw);
      if not is_word(Text[endw]) then dec(endw);
      cur := system.copy(Text,startw,endw-startw+1); end;

    cur := conv_chars(^M,' ',cur);
    cur := conv_chars(^J,' ',cur);
    cur := trim(cur);
    cur := lefttrim(cur);

{   cur := conv_chars('-',' ',cur); }

    i := choose_field2('Select Field',@cur,true{is_rept},subapw,nil{VersionLB},
      d1{vernum});

    if i<0 then exit;
    FieldObj := TFieldObj(FieldList[subapw].Objects);
    namew := get_name(FieldObj);
    Memo.SelText := namew; {note: SelLength, SelStart, SetSelTextBuf}
  except on EOutOfMemory do begin
    get_cr('Out of memory',wsData.error); exit; end; end; end;

procedure TReptTextEditor.CutClick(Sender: TObject); begin
  Memo.CutToClipboard; show_status; end;

procedure TReptTextEditor.CopyClick(Sender: TObject); begin
  Memo.CopyToClipboard; show_status; end;

procedure TReptTextEditor.PasteClick(Sender: TObject); begin
  Memo.PasteFromClipboard; show_status; end;

procedure TReptTextEditor.DeleteClick(Sender: TObject); begin
  if Memo.SelLength=0 then Memo.SelLength := 1;
  Memo.ClearSelection; show_status; end;

{******************************}
procedure TReptTextEditor.FindClick(Sender: TObject); begin
  if get_string('Find','Text',0{opts},2{margin},30{len},hcFind,@find_val)=success
    then exec_find; show_status; end;

procedure TReptTextEditor.ReplaceClick(Sender: TObject);
    var foundw: boolean; respw: AnsiChar; startw: integer; begin
  if get_2_strings('Replace','From','To',0{opts},2{margin},30{len},hcReplace,
    @find_val,@to_val)=failed then exit;
  if (find_val='') or (find_val=to_val) then exit;
  startw := Memo.SelStart; Memo.SelLength := 0;
  foundw := exec_find; respw := ' ';
  while foundw do with Memo do begin
    if respw<>'A' then begin Memo.HideSelection := false;
      respw := get_y_n_all_or_cancel('Do you wish to replace?',inform,center);
      Memo.HideSelection := true;
      if respw=^[{esc} then begin SelLength := 0; exit; end; end;
    if respw<>'N' then SelText := to_val;
    foundw := exec_find; end;
  Memo.SelStart := startw; Memo.SelLength := 0; show_status; end;

procedure TReptTextEditor.SearchAgainClick(Sender: TObject); begin
  exec_find; show_status; end;

{******************************}
procedure TReptTextEditor.MemoChange(Sender: TObject); begin
  {$IFDEF PlainWindows} with MainForm do begin
    if Memo.CanUndo then EditUndoItem.Enabled := true
      else EditUndoItem.Enabled := false;
    if script_mode or
        (upcasestring(system.copy(Memo.Lines[0],1,7))='PROGRAM') then begin
      Print.Enabled := true;  PrintSB.Enabled := true;{Print} end
    else begin
      Print.Enabled := false; PrintSB.Enabled := false;{Print}
      end; end; {$ENDIF}
  show_status; end;

procedure TReptTextEditor.MemoSelectionChange(Sender: TObject); begin
  {$IFDEF PlainWindows} with MainForm do begin            {was for TRichText}
    if Memo.SelLength>0 then begin
      EditCutItem.Enabled := true;    {SpeedButton7.Enabled := true;}{Cut}
      EditCopyItem.Enabled := true;   {SpeedButton8.Enabled := true;}{Copy} end
    else begin
      EditCutItem.Enabled := false;   {SpeedButton7.Enabled := false;}{Cut}
      EditCopyItem.Enabled := false;  {SpeedButton8.Enabled := false;}{Copy}end;
    if Clipboard.HasFormat(CF_TEXT) then begin
      EditPasteItem.Enabled := true;  {SpeedButton9.Enabled := true;}{Paste} end
    else begin
      EditPasteItem.Enabled := false; {SpeedButton9.Enabled := false;}{Paste}
      end; end; {$ENDIF}
  show_status; end;

procedure TReptTextEditor.MemoContextPopup(Sender: TObject; MousePos: TPoint;
    var Handled: Boolean); begin
  if upcasestring(system.copy(Memo.Lines[0],1,7))='PROGRAM' then
    Print.Enabled := true
  else Print.Enabled := false;
  if Memo.SelLength>0 then begin
    Cut.Enabled := true;  Copy.Enabled := true;  Delete.Enabled := true; end
  else begin
    Cut.Enabled := false; Copy.Enabled := false; Delete.Enabled := false; end;
  if Clipboard.HasFormat(CF_TEXT) then Paste.Enabled := true
    else Paste.Enabled := false;
  if find_val>'' then SearchAgain.Enabled := true
    else SearchAgain.Enabled := false;
  if Memo.CanUndo then Undo.Enabled := true
    else Undo.Enabled := false; end;

{******************************}
procedure TReptTextEditor.MemoKeyUp(Sender: TObject; var Key: Word;
    Shift: TShiftState); begin
  show_status; end;

procedure TReptTextEditor.MemoMouseUp(Sender: TObject;
    Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin
  show_status; end;

procedure TReptTextEditor.show_status; begin
  with Memo.CaretPos do
    Status1.Caption := showint(Y+1,0)+':'+showint(X+1,0);
  if Odd(GetKeyState(VK_INSERT)){inserting} then
    Status2.Caption := 'Insert'
  else Status2.Caption := 'Overwrite';
  if Memo.Modified then Status3.Caption := 'Modified'
    else Status3.Caption := ''; end;

{******************************}
procedure TReptTextEditor.SaveDialogCanClose(Sender: TObject;
    var CanClose: Boolean); var namew, dirw: string[100]; begin
  namew := name_part(SaveDialog.FileName); CanClose := true;
  dirw := dir_part(SaveDialog.FileName);
  if (length(namew)>8) or (edit_node(namew,false{space_ok})=failed) then begin
    get_cr('Name must be 8 valid characters',error);
    CanClose := false; exit; end;
  if script_mode then begin
    if exists(dirw+namew+range_suffix[script_subap]) then begin
      if get_y_or_n(namew+' is already used with a Simple Range ('+
          range_suffix[script_subap]+') file and will be deleted. Do you wish '+
          'to continue?',warn,center)='N' then
        CanClose := false
      else delete_file(dirw+namew+range_suffix[script_subap]); end; end
  else begin
    if exists(dirw+namew+'.RPS') then begin  CanClose := false;
      get_cr('Cannot use '+namew+' because it is already used with a simple '+
        '(.RPS) report',inform); end; end; end;

{******************************}
procedure TReptTextEditor.exec_rept(Ascreen: boolean);
    var subapw: integer; namew: string[80]; formw: TForm; begin
  formw := find_form(oScreen.form_id_prefix+FileName);
  if formw<>nil then begin formw.SetFocus; exit; end;
  if Memo.Modified then begin
    if Filename='' then begin SaveAs; if Filename='' then exit; end
    else Save; end;
  namew := name_part(FileName); subapw := pos(namew[1],csubap);
  if subapw=0 then begin
    get_cr('First letter of file name must be B, R, D, or P',error); exit; end
  else dec(subapw);
  TReptTextEditor(cEditor_win2) := self;
  execute_report(@FileName,subapw,Ascreen,true{set_reporting});
  cEditor_win2 := nil; end;

{******************************}
function TReptTextEditor.exec_find: boolean;
    var found_at: longint; start_pos, to_end: integer;

  function FindText(SearchStr: string;  StartPos, Length: Integer; 
      Options: TSearchTypes): Integer; var j1: integer; begin
    result := -1; j1 := StartPos;
    SearchStr := upcasestring(SearchStr);
    while j1<=system.length(Memo.Text) do
      if upcasestring(system.copy(Memo.Text, j1, system.length(SearchStr)))=
        SearchStr then begin result := j1-1; exit; end
      else inc(j1); end;

begin result := false;
  if find_val>'' then with Memo do begin
    if SelLength <> 0 then start_pos := SelStart + SelLength
      else start_pos := SelStart;
    to_end := Length(Text) - start_pos;
    found_at := FindText(find_val, start_pos, to_end, []);
    if found_at <> -1 then begin SetFocus; SelStart := found_at;
      SelLength := length(find_val); result := true; end; end; end;

{******************************}
function TReptTextEditor.edit_script: boolean;
    var Objw: TData; ScriptColw: TStringList_2; j1: integer; begin
  result := false; abort_save := false;
  create_StringList(ScriptColw,'ScriptColw');
  for j1 := 0 to Memo.Lines.Count-1 do
    ScriptColw.Add(Memo.Lines[j1]);
  try  TReptTextEditor(cEditor_win2) := self;
    Objw := nil;
    case script_subap of
      budsubap: if open_bud_file_0=success then Objw := BudObj[0];
      revsubap: if open_rev_file_0=success then Objw := RevObj[0];
      detsubap: if open_det_file_0=success then Objw := DetObj[0];
      possubap: if open_pos_file_0=success then Objw := PosObj[0];
      empsubap: if open_emp_file_0=success then Objw := EmpObj[0]; end;
    if Objw<>nil then {$IFDEF BGWeb5} with UserSession do {$ENDIF} begin
      result := compile_script(filenamew^,ScriptColw,Objw,script_subap,0{grp},
        false{executing});
      abort_save := (result=failed) and (rept_resp='N');
      free_script(@misc_vars);
      if result=failed then with misc_vars do begin
        Memo.SelStart := Memo.Perform(EM_LINEINDEX,script_line-1,0) + scriptp-1;
        Memo.Perform(EM_SCROLLCARET, 0, 0); end; end;
  finally  free_StringList(ScriptColw);
    cEditor_win2 := nil; end; end;

{******************************}
function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
    FontType: Integer; Data: Pointer): Integer; stdcall; begin
  TStrings(Data).Add(LogFont.lfFaceName);
  Result := 1; end;

{******************************}
function open_rept_editor(Afilename: ShortString; Aro, Acreate: boolean): pointer;
  var Editorw: TReptTextEditor; j1,matchw,posw: integer; s1,dirw: ShortString;
    fname1, fname2: string[16]; file_info: TSearchRec; ercodew,maxw: integer;
    is_num: boolean; x: double;
      const fchars: string[36] = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';  begin
  if Acreate then begin  dirw := dir_part(Afilename);
    fname1 := upcasestring(name_part(Afilename)); fname2 := fname1;
    conv_to_real(copy(fname2,length(fname2)-1),x,is_num);
    if is_num then begin  maxw := 99;
      j1 := round(x); fname2 := copy(fname2,1,length(fname2)-2); end
    else begin  maxw := length(fchars); j1:= pos(fname2[length(fname2)],fchars);
      fname2 := copy(fname2,1,length(fname2)-1); if j1<1 then j1 := 1; end;
    ercodew := 0;
    while ercodew=0 do begin inc(j1);
      if j1>maxw then begin
        get_cr('Unable to create new name',inform); exit; end;
      if is_num then s1 := showint0(j1,2) else s1 := fchars[j1];
      ercodew := FindFirst(dirw+fname2 + s1 + '.RP?',faAnyFile,file_info); end;
    fname2 := fname2 + s1; SysUtils.FindClose(file_info); end
  else begin s1 := upcasestring(name_part(Afilename)+ext_part(Afilename));
    with Forms.Screen do for j1 := FormCount-1 downto 0 do
      if (Forms[j1] is TReptTextEditor) and
          (upcasestring(Forms[j1].Caption)=s1) then begin
        result := Forms[j1]; Forms[j1].SetFocus; exit; end; end;
  try Editorw := TReptTextEditor.Create(Application);
    except on EOutOfMemory do wsGlob1.abort('Out of memory'); end; 
  with Editorw do begin  HelpContext := hcReportTextEditor;
    ext := upcasestring(ext_part(Afilename));

    {$IFDEF PlainWindows}
    Caption := cEditor.form_id_prefix+Afilename;
    with ReportTextEditorOpts do if Width>0 then begin
      Position := poDesigned; SetBounds2(Editorw,Left,Top, Width, Height); end
    else SetBounds(20, 20, 500, 550);
   {$ENDIF} 

    Constraints.MinHeight := 30; Constraints.MinWidth := 30;
    Edit.Visible := false; end;
  Editorw.Memo.ReadOnly := Aro;
  if Afilename>'' then Editorw.Open(Afilename);
  Editorw.timew := get_file_time(Editorw.Filename);
  Editorw.Memo.HelpContext := hcReportTextEditor;

  if Acreate then with Editorw, Memo do begin
    for j1 := 0 to Lines.Count-1 do begin
      matchw := pos(fname1,upcasestring(Lines[j1]));
      if matchw>0 then begin  s1 := Lines[j1];
        for posw := 0 to length(fname1)-1 do
          s1[matchw+posw] := fname2[posw+1];
        Lines[j1] := s1; end; end;
    Modified := true; FileName := dirw+fname2+ext_part(Afilename);
    Caption := ExtractFileName(FileName);
    show_status; end;
  Editorw.Show; result := Editorw; end;

{******************************}
procedure open_script_editor(Afilename: PShortString; AScriptCol: TStringList_2;
  Asubap, Aline, Acol: integer; Amodal: boolean);
    var Editorw: TReptTextEditor; j1: integer; s1: ShortString; begin

  if not Amodal then begin
    s1 := upcasestring(name_part(Afilename^)+script_suffix[Asubap]);
    with Forms.Screen do for j1 := FormCount-1 downto 0 do
      if (Forms[j1] is TReptTextEditor) and
          (upcasestring(copy(Forms[j1].Caption,1,length(Forms[j1].Caption)-17))=
          s1) then begin Forms[j1].SetFocus;
        free_StringList(AScriptCol); exit; end; end;

  Editorw := nil;
  try Editorw := TReptTextEditor.Create(Application);
    except on EOutOfMemory do wsGlob1.abort('Out of memory'); end; 
  with Editorw do begin HelpContext := hcScriptEditor; filenamew := Afilename;
    modal := Amodal; script_mode := true; script_subap := Asubap;

    {$IFDEF PlainWindows}
    Caption := cEditor.form_id_prefix+Afilename^;
    with ScriptEditorOpts do if Width>0 then begin
      Position := poDesigned; SetBounds2(Editorw,Left,Top, Width, Height); end
    else SetBounds(20, 20, 500, 550);
   {$ENDIF} 

    Constraints.MinHeight := 30; Constraints.MinWidth := 30;
    Screen.Visible := false; Print.Visible := false;
    PrintReportCode.Caption := 'Print Ranges Script';
    Filename := rept_dir[Asubap]^+AFilename^+script_suffix[Asubap];
    timew := get_file_time(Filename);
    for j1 := 0 to AScriptCol.Count-1 do
      Memo.Lines.Add(AScriptCol[j1]);
    free_StringList(AScriptCol);
    if (Aline>0) or (Acol>0) then begin
      Memo.SelStart := Memo.Perform(EM_LINEINDEX,Aline-1,0) + Acol-1;
      Memo.Perform(EM_SCROLLCARET, 0, 0); end
    else Memo.SelStart := 0;
    Caption := ExtractFileName(FileName)+' Adv Range Script';
    Memo.Modified := False;
    show_status;
    Editorw.Memo.HelpContext := hcScriptEditor;

    if Amodal then ShowModal
      else Show; end; end;

{******************************}
procedure TReptTextEditor.ReplaceAllFilesClick(Sender: TObject);
  var foundw, found2: boolean; respw: AnsiChar; j1, subapw, ercodew: integer;
    s1, namew,suffixw: string[40]; file_info: TSearchRec; begin
  namew := upcasestring(name_part(FileName));
  suffixw := upcasestring(ext_part(FileName));
  if script_mode then begin  subapw := script_subap;
    s1 := 'Replace All '+ap_title[script_subap]+' Scripts'; end
  else begin subapw := pos(namew[1],csubap)-1; if subapw<0 then exit;
    s1 := 'Replace All '+ap_title[subapw]+' Adv Reports'; end;
  if get_2_strings(s1,'From','To',0{opts},2{margin},30{len},hcReplace,
    @find_val,@to_val)=failed then exit;
  if (find_val='') or (find_val=to_val) then exit;
  try respw := ' '; found2 := false;
    ercodew := FindFirst(rept_dir[subapw]^+'*'+suffixw,faAnyFile,file_info);
    while ercodew=0 do begin RichEdit.Lines.Clear;
      RichEdit.Lines.LoadFromFile(rept_dir[subapw]^+file_info.Name);
      Memo.Lines.Clear;
      for j1 := 0 to RichEdit.Lines.Count-1 do
        Memo.Lines.Add(RichEdit.Lines[j1]);
      RichEdit.Lines.Clear;
      Memo.SelStart := 0; Memo.SelLength := 0;
      foundw := exec_find;
      if foundw then begin
        self.Caption := rept_dir[subapw]^+file_info.Name;
        while foundw do with Memo do begin
          if respw<>'A' then begin Memo.HideSelection := false;
            respw := get_y_n_all_or_cancel('Do you wish to replace?',inform,center);
            Memo.HideSelection := true;
            if respw=^[{esc} then begin SelLength := 0; exit; end; end;
          if respw<>'N' then begin SelText := to_val; found2 := true; end;
          foundw := exec_find; end;
        Memo.Lines.SaveToFile(rept_dir[subapw]^+file_info.Name); end;
      ercodew := FindNext(file_info); end;
  finally SysUtils.FindClose(file_info);
(*  if found2 then
      build_rept_dir(subapw,false{confirm},false{inc_users}); *)
    Open(rept_dir[subapw]^+namew+suffixw);
    Memo.SelStart := 0; Memo.SelLength := 0; show_status; end; end;

end.

[Anders Melander 1782]

Thanks. I just meant this:

procedure TReptTextEditor.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_F1:  if Shift=[] then Application.HelpCommand(HELP_CONTEXT,HelpContext);
    VK_F10: if (ssAlt in Shift) then PopupMenu1.Popup(Left+100,Top+100);
  end;
end;

...and that looks okay.