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.
![Delphi-PRAXiS [en]](https://en.delphipraxis.net/uploads/monthly_2018_12/logo.png.be76d93fcd709295cb24de51900e5888.png){kind=logo}
