tobenschain
Members-
Content Count
43 -
Joined
-
Last visited
Community Reputation
0 NeutralRecent Profile Visitors
The recent visitors block is disabled and is not being shown to other users.
-
Is there any way to delete a column ClientDataSet?
-
I wasn't speaking of hardware failure. Over time can memory become corrupt? I understand .Net reduces this problem.
-
Can memory on a PC become error prone over rime? Are there AV's that are not caused by the program?
-
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.
-
All keys work except delete. Delete key works until I do a save.
-
TMemo sometimes ignores the delete key. I have been unable to trap the problem. Key Preview is true.
-
Can't figure out why I can process Module Data but not BudSys, BudSys works after I create it but not after I exit BudGen.
-
Can't figure out why BudSys_DB.Indexes.Count is zero BudSys_Con := TFDConnection.Create(nil); with BudSys_Con do begin Params.DriverId := 'SQLite'; Params.Database := sys_dir^+'BudSysDB'+'.sdb'; ExecSQL('PRAGMA locking_mode = NORMAL'); ExecSQL('PRAGMA journal_mode = OFF'); Open; end; if BudSys_DB=nil then begin BudSys_DB := TFDTable.Create(nil); BudSys_DB.TableName := 'BudSysDB'; BudSys_DB.IndexFieldNames := 'key'; BudSys_DB.Connection := BudSys_Con; BudSys_DB.Open; end;
-
Many thanks for the example.
-
I needed: try FDQuery1.ExecSQL('insert into MyTab(code, name) values (:code, :name)', [100, 'Tokyo']); except on E: EFDDBEngineException do begin // E.Message - Actual error message. For the DBMS messages only Message property is used. // E.ErrorCode - DBMS-specific error code. // E.Kind - DBMS-independent error code and other properties. if E.Kind = ekUKViolated then ShowMessage('Please enter unique value !'); raise; end; end;
-
This is what I do Module_DB.Close; Module_DB.Disconnect; Module_Con.Close;
-
Created, Copied and Deleted
-
<<Have you checked what PRAGMA locking_mode is returning?>> I use: ExecSQL('PRAGMA locking_mode = NORMAL'); <<Can you delete the file before opening any connection?>> The file is being created.
-
I tried Module_Con.Close; Didn't help
-
I wasn't qualifying the Close statement