Leaderboard

I wonder when anyone comes up with a request for threadconst.

Delphi 12.2 introduced a new text-processing engine, WebStencils, that can be used in WebBroker and other applications to generate HTML and other template-based text. To get my head around how to work with this, I wrote a couple of small WebBroker applications, one using PageProducers and the other doing the same thing using WebStencils. You can read about it in my latest blog entry, Introducing WebStencils and download the projects from Github. I hope this is useful for learning about this new text-processing engine.

... unless you allow that with a compiler directive: Writeable typed constants

Who do they feel the need to keep the details secret from? All 27 other commercial Pascal IDE vendors?

@cupboy Reply back and threaten them with action from whatever comsumer rights legislation you have in your country. In the UK it's Trading Standards. Refer them to this blog from their General Manager, particularly the "Policy Update" section; https://blogs.embarcadero.com/from-the-gm-new-updates-and-changes-to-the-registration-bumps-policy/ It really irks me when Embarcadero try to weasel out of their contractual responsibilities. When we purchase their product the licence is "lifetime" - the subscription element is an add-on that can allow you to keep updated at a lower price than buying new licences, but it is in no way mandatory. What is mandatory is that the lifetime licence for the product you purchased is honoured. Registration limits are there to prevent you from installing more than x installations at any one time. They should not (and in most jurisdictions, cannot) be used to stop one from migrating an installation to a new system.

ICS V9.3 has been released at: https://wiki.overbyte.eu/wiki/index.php/ICS_Download ICS is a free internet component library for Delphi 7, 2006 to 2010, XE to XE8, 10, 10.1, 10.2, 10.3, 10.4, 11 and 12 and C++ Builder 10.4, 11 and 12. ICS supports VCL and FMX, Win32 and Win64 targets. Beware C++ have not been tested recently due to lack of support from such users. The distribution zip includes the latest OpenSSL 3.0.15, 3.2.3 and 3.3.2, for Win32 and Win64. Changes in ICS V9.3 include: 1 - V9.3 continues the simplification of use of ICS components by consolidating many types and constants into the OverbyteIcsTypes unit, avoiding projects needing to find and add specific units before they will build. For XE2 and later, OverbyteIcsTypes and OverbyteIcsSslBase will be added automatically when components needing them are dropped on a form, or that form accessed for existing projects. One benefit of this change is removing dependence on several units for many components and applications, it should be possible to remove OverbyteIcsWinsock, OverbyteIcsLIBEAY, OverbyteIcsSSLEAY and OverbyteIcsLogger from most applications, and also other units. See https://wiki.overbyte.eu/wiki/index.php?title=Updating_projects_to_V9.3 for more information. 2 - Previously, the Windows Certificate Store was supported on Windows for all components and samples, despite it not always being required. There are three new defines {$DEFINE MSCRYPT_Clients}, {$DEFINE MSCRYPT_Servers} and {$DEFINE MSCRYPT_Tools) that determine which components can use the store, at least one must be set or applications that need the store will fail. Although these new defines all default to enabled in the OverbyteIcsDefs.inc supplied with V9.3 and later, unless this file is installed, Windows Certificate Store will be unavailable. These defines are disabled for non-Windows platforms and for C++ Builder which has bugs. 3 - Added new application independent monitoring, comprising a client component and server sample. The ICS Application Monitor TIcsAppMonCli client component is designed to report to an ICS Application Monitor server, which will ensure the main application remains running. The ICS Application Monitor server IcsAppMon.exe is designed to monitor ICS applications using the TIcsAppMonCli client component, and ensure they remain running, restarting the application if it stops or becomes non-responsive, or on demand. Primarily to keep ICS server Windows services running non-stop, but may also be used for network wide monitoring of ICS applications. Client and server both use the TIcsIpStrmLog component with a simple TCP protocol. More information at https://wiki.overbyte.eu/wiki/index.php?title=FAQ_ICS_Application_Monitoring 4 - The HTTP client components TSslHttpCli and TSslHttpRest have new RespMimeType and RespCharset response properties parsed from the Content-Type header to avoid applications needing to parse this headers. Fixed a problem in V9.2 where a missing / was added to the start of the request path, but was not needed for absolute paths used for proxies. 5 - The TIcsIpStrmLog streaming log component has improvements for TCP Server mode when multiple remote clients connect. Previously the same data was sent to all remote clients (the original concept being remote logging), but now applications can send data to specific remote clients, and more easily check which remote client is receiving data. This change means TIcsIpStrmLog can be used as the core of many TCP servers with different protocols, such as the new IcsAppMon sample, see above. 6 - The TSslHttpRest and component has a new way for applications to check SSL certificate chains themselves, ignoring OpenSSL bundle checks, usually for self signed private certificates, maybe checking certificate serials, names or public key. If LogSslVerMethod = logSslVerOwnEvent, a new event OnSslCertVerifyEvent is called so the application can check the chain and change the verify result appropriately. 7 - Improved the ability to customise SSL ciphers if the ICS defaults need to be changed. TSslContext and TIcsHosts have three properties, SslCipherList for TLSv12 ciphers, SslCipherList13 for TLSv13 ciphers, and SslCryptoGroups sets the cipher curve groups allowed (like P-256 or X25519). Beware old SslContexts may include group P-512 which must be corrected to T-521. SSL handshake responses now show the curve group used for OpenSSL 3.2 and later. The OverbyteIcsHttpsTst client sample may be used to test the new cipher options, and they will be read from IcsHosts INI files for servers. 8 - Added a new web server sample OverbyteIcsBasicWebServer1.dpr which is a simplified version of OverbyteIcsSslMultiWebServ ignoring configuration INI files, security features, session data, most demo pages and most logging, and settings for localhost set in code, search for IcsHosts to change IP addresses, etc. This sample should be easier to use as a basis for new web server applications. The existing samples OverbyteIcsSslMultiWebServ and OverbyteIcsDDWebService have a new index.html template page, and default to localhost 127.0.0.1 with an internal localhost SSL certificate, so should always response to https://localhost/ without any INI file changes. 9 - Fixed an HTTP web server problem in V9.2 to avoid repeated redirection for virtual default page /, was adding /// etc. 10 - Updated OpenSSL binary and resource files to releases 3.3.2, 3.2.3 and 3.0.15, only one of which will be linked according to defines. 11 - Restored the sample OverbyteIcsConHttp.dpr which is a console example, now supports SSL by replacing THttpCli with TSslHttpRest, no longer needs any events or a message loop for a single sync request, so a less code than without SSL. Now contacts https://wiki.overbyte.eu/wiki. 12 - A lot of changes have been made preparing ICS for Linux. Corrected loading OpenSSL on Posix, now loads the system supplied OpenSSL 3 DLLs on Ubuntu 22.04. The Linux package now builds correctly, but beware WSocket is not yet supported on Linux so no protocols will work. There is a new IcsPemTest FMX sample that works on Ubuntu 22.04 and which will create ICS signed SSL certificates. Note, MacOS support is disabled pending the new Posix implementation. The release notes for V9.3 are at https://wiki.overbyte.eu/wiki/index.php/ICS_V9.3 All ICS active samples are available as prebuilt executables, to allow ease of testing without needing to install ICS and build them all. There are four separate zip files split into clients, servers, tools and miscellaneous samples which can be downloaded from https://wiki.overbyte.eu/wiki/index.php/ICS_Samples

Clever way of introducing thread-unsafety 😉

How about an untyped Multiplier and MULTIPLIED_CONSTANT = 1E-11 * NativeInt(MULTIPLIER); ?

Added embt quality https://embt.atlassian.net/servicedesk/customer/portal/1/RSS-1922

You need to use a control that supports proper "z-order" with platform-derived controls such as TWebBrowser. Kastri has such controls (TNativeImage, TNativeRectangle etc), and I've now created a demo that could be used as a starting point to achieve what you want. Please note that you would need to first install the KastriFMX package, which contains the native controls.

Just installed Delphi 12.2 in the same VM as 11.3 with 150% and I can confirm that drop-down works correctly in 12.2.

If it is not bullsh*t (obviously a road map cannot be legal binding especially when they have a "safe harbor" section), then it is sad. Very sad. 😞

Delphi doesn't know that you want [] to be an array rather than a set. Because the language has been designed iteratively and there is ambiguity. Delphi literals are a bit of a mess. In any case are you sure that you want to use = with a reference type? That's reference identity and not value identity. You will need to test for Length(a)=0 or not Assigned(a) or a = nil

Did you create a new project for version 12.2 or did you just open the one you used with the earlier version? Yeah, try creating a new project.

The listed errors are linker ones, which means there is a confliction in the compiled source units, to understand these errors you have to get in the shoes of the compiler and linker, the compiler check for the source file time for last modification and build the .o/.obj (same goes for the .dcu in Delphi), (well dates and times among other parameters but most relevant is the time) if these times are identical then will skip compiling !!, assuming it is the same and nothing changed then nothing to recompile, linker on other hand will build the executable binary from scratch and from its own build version, here comes the unresolved externals... in case the .o/.obj files were built/compiled with different compiler form different IDE. Delphi doesn't suffer form this because DCU files has the compiler version included (again among others, like all the compiling switches are there in the DCU) , while .o/.obj files can't be used effectively as dcu files. So it is either bug in the compiler where it should check for the compiler version (and project switches) before skip compiling, Or you have to clean your paths from all artefacts (.o , .obj...) to be able to build on different compiler, I can't say for sure about this being compiler bug or not.

Not tested on 11.1 yet but I wrote this unit (for FMX) unit ImageUtils; interface uses System.SysUtils, System.UITypes, System.UIConsts , System.Math, System.Classes, FMX.Types, FMX.Graphics, FMX.Utils; type Talgorithm = (algnone,algluminosity,algaverage,alglightness, alpow); function ConvertToGrayscale(const aBitmap: TBitmap; const aMethod : TAlgorithm=algnone) : TBitmap; overload; function ConvertToGrayscale(const FileName : String; const aMethod : TAlgorithm=algnone) : TBitmap; overload; function ConvertToGrayscale(const aStream : TMemoryStream ; const aMethod : TAlgorithm=algnone) : TBitmap; overload; implementation function Colortogray(const aColor : Talphacolor; const aAlgo : TAlgorithm=algnone) : Talphacolor; var H,S,L : Single; C : TAlphacolorRec; gris : Integer; // https://www.johndcook.com/blog/2009/08/24/algorithms-convert-color-grayscale/ begin c.Color:=acolor; case aAlgo of algluminosity: gris:=Round((0.2126*c.R) + (0.7152*c.G) + (0.0722*C.B)); algaverage: gris := (c.R + c.G + c.B) div 3; alglightness: gris:=Round((maxvalue([TAlphacolorRec(aColor).R,TAlphacolorRec(aColor).G,TAlphacolorRec(aColor).B]) + minvalue([TAlphacolorRec(aColor).R,TAlphacolorRec(aColor).G,TAlphacolorRec(aColor).B])) / 2); alpow : gris:=round(power(( 0.2126*power(c.R,2.2)+0.7152*power(c.G,2.2)+0.0722*power(c.B,2.2)),1/2.2) ); else begin RGBToHSL(aColor,H,S,L); Exit(HSLtoRGB(0,0, L)); end; end; exit(Makecolor(gris,gris,gris)); end; function ConvertToGrayscale(const aBitmap: TBitmap; const aMethod : TAlgorithm=algnone): TBitmap; var X, Y: Integer; bd1, bd2: TBitmapData; p1, p2: PAlphaColorArray; begin Result := TBitmap.Create(Round(aBitmap.Width), Round(aBitmap.Height)); if (aBitmap.Map(TMapAccess.Read, bd1) and Result.Map(TMapAccess.Write, bd2)) then begin try for Y := 0 to (aBitmap.Height - 1) do begin p1 := PAlphaColorArray(bd1.GetScanline(Y)); p2 := PAlphaColorArray(bd2.GetScanline(Y)); for X := 0 to (aBitmap.Width - 1) do begin p2[X] := Colortogray(p1[X],aMethod); end; end; finally aBitmap.Unmap(bd1); Result.Unmap(bd2); end; end; end; function ConvertToGrayscale(const FileName : String; const aMethod : TAlgorithm=algnone): TBitmap; var X, Y: Integer; bd1 : TBitmapData; p1 : PAlphaColorArray; begin if not FileExists(FileName) then exit(nil); result:=TBitmap.CreateFromFile(FileName); if Result.Map(TMapAccess.ReadWrite, bd1) then begin try for Y := 0 to (Result.Height - 1) do begin p1 := PAlphaColorArray(bd1.GetScanline(Y)); for X := 0 to (Result.Width - 1) do begin p1[X] := Colortogray(p1[X],aMethod); end; end; finally Result.Unmap(bd1); end; end; end; function ConvertToGrayscale(const aStream : TMemoryStream ; const aMethod : TAlgorithm=algnone) : TBitmap; overload; var X, Y: Integer; bd1 : TBitmapData; p1 : PAlphaColorArray; begin if aStream.Size=0 then Exit(nil); aStream.Position:=0; result:=TBitmap.CreateFromStream(AStream); if Result.Map(TMapAccess.ReadWrite, bd1) then begin try for Y := 0 to (Result.Height - 1) do begin p1 := PAlphaColorArray(bd1.GetScanline(Y)); for X := 0 to (Result.Width - 1) do begin p1[X] := Colortogray(p1[X],aMethod); end; end; finally Result.Unmap(bd1); end; end; end; end. as a quick test, left number is speed, effet is using Monochrome effect instead of function try with TmonochromeEffect.Create(nil) do try ProcessEffect(nil,aBitmap, 0); finally Free; end; image6.Bitmap:=abitmap; finally aBitmap.Free; watch.Stop; lblEffet.Text:='Effet '+Watch.ElapsedMilliseconds.ToString; end;

I like the way Delphi is getting better at arrays, but there is still a gap in the compiler that let me down. I tried this code in 12.2 to highlight the issue. const nostrings: tarray<string> = []; procedure TForm1.FormShow(Sender: TObject); begin var a: tarray<string>; a := []; if a = nostrings then say('nostrings'); if a = [] then say('it''s blank'); end; procedure TForm1.say(const s: string); begin ListBox1.Items.Add(s); end; This refuses to compile at the line if a = [] then with the error "Incompatible types". But it has no problem with the assignment, so it looks like the programmers have just put this in the "do eventually" basket. Does anyone have any insights into this? --- Mark

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.

And check out what the other sales guy said: Thank you for reaching out! Unfortunately, both serial keys have not been on active maintenance for more than 365 days. You cannot renew the same licenses or increase the registration limits. Warm Regards, Faraz Khattak Customer Renewals Representative E: faraz.khattak@idera.com

They stopped publishing roadmaps publicly, there hasn't been a new roadmap shown for several years now.

IIRC, he said that internally there is a road map. They use to have private talks to selected users about their needs, which may influence their road map. He also mentioned that there is no official road map due to legal concerns.