tobenschain 0 Posted September 23 TMemo sometimes ignores the delete key. I have been unable to trap the problem. Key Preview is true. Share this post Link to post
Anders Melander 1794 Posted September 23 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. Share this post Link to post
tobenschain 0 Posted September 26 All keys work except delete. Delete key works until I do a save. Share this post Link to post
tobenschain 0 Posted September 26 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. 1 Share this post Link to post
Anders Melander 1794 Posted September 26 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. Share this post Link to post