-
Content Count
1406 -
Joined
-
Last visited
-
Days Won
22
Everything posted by programmerdelphi2k
-
complexity is a scope of computation, then I think that yes, you can use it, for sure!
-
@damos you need protect your "Settings" var, because it can be destroy in another place in your app for example, then trying "use/free it" can raise a exception! see my sample above and change it for your usage (with more methods etc... to ensure better use and protection of data)
-
@damos as you know, "Setting" will be used in all app, then a "Singleton" would can be used here... unit uMySingletonSettings; interface uses System.SysUtils, System.Classes; type // I_Your_Interface_If_Want_Use_Without_Free_Object_At_End = interface // ['{....}'] // ... yor methods / getters/setters etc.. // end; TMySettingsSingleton = class { (TInterfacedObject, I_Your_Interface_If_Want_Use_Without_Free_Object_At_End } private class { } var FInstance: TMySettingsSingleton; // // another vars/const/methods... strict private FSettings: TStringList; // constructor Create; public destructor Destroy; override; // class function GetInstance: TMySettingsSingleton; // property MySettings: TStringList read FSettings; end; implementation { TMySettingsSingleton } constructor TMySettingsSingleton.Create; begin if (FSettings = nil) then FSettings := TStringList.Create; end; destructor TMySettingsSingleton.Destroy; begin FreeAndNil(FSettings); // inherited; end; class function TMySettingsSingleton.GetInstance: TMySettingsSingleton; begin if (FInstance = nil) then FInstance := TMySettingsSingleton.Create; // result := FInstance; end; end. in your main unit or DPR just add this ... initialization ReportMemoryLeaksOnShutdown := true; // TMySettingsSingleton.GetInstance; // creating your StringList... TMySettingsSingleton.GetInstance; // creating your StringList... 2ª call, dont will create a new StringList FSettings! finalization TMySettingsSingleton.GetInstance.Free; end. now, just use it as a StringList default usage: (dont need free all time, now! just before app END) TMySettingsSingleton.GetInstance.MySettings.SaveToFile('hello.ini'); TMySettingsSingleton.GetInstance.MySettings.LoadFromFile('hello.ini'); TMySettingsSingleton.GetInstance.MySettings.Add('key1=value1'); TMySettingsSingleton.GetInstance.MySettings[0] := 'hello=world'; for var L in TMySettingsSingleton.GetInstance.MySettings do ... Memo1.Lines.Add( L );
-
Prevent Space bar from focusing on a button
programmerdelphi2k replied to Willicious's topic in Delphi IDE and APIs
in time, you can use "GetKeyNameText(...) + MapVirtualKey(...)" to get all key names used in your system, at least in MSWindows! -
How can I read body of the TRESTRequest?
programmerdelphi2k replied to Magno's topic in Network, Cloud and Web
you can use the RestDebuger with your url + params, etc... after send your command, the RestDebugger receive the response (right or not)... after this, you can copy the objects and paste it in your form and see how all was done... you got it? -
Prevent Space bar from focusing on a button
programmerdelphi2k replied to Willicious's topic in Delphi IDE and APIs
@Willicious did you try some like this ( to see "what key" was pressed... later, do your actions... all keys will be processed by form, then you can get it more easy or using a API func like GetKeyStatexxxx() implementation {$R *.dfm} procedure TForm1.MyKeyPressed(AEvent: string; AKeyPressed: Word); // a procedure for easy usage... var LText: string; begin if (ActiveControl <> nil) then LText := '... ActiveControl = ' + ActiveControl.ToString else LText := '... ActiveControl = nil'; // Memo1.Lines.Add(LText + ', Event: ' + AEvent + ', Key pressed: ' + AKeyPressed.ToString); // 3 events will call it end; procedure TForm1.FormCreate(Sender: TObject); begin KeyPreview := true; // capture all keys pressed on form... same that in some controls Label1.Caption := 'Click on form to remove the focus if in any control...'; end; procedure TForm1.FormClick(Sender: TObject); begin ActiveControl := nil; // try remove the focus in any control (if focused) end; procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin MyKeyPressed('FormOnKeyDown: ', Key); end; procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin MyKeyPressed('FormOnKeyUp: ', Key); end; procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char); begin MyKeyPressed('FormOnKeyPress: ', ord(Key)); end; -
How can I allocate memory without raising exceptions ?
programmerdelphi2k replied to Marus's topic in General Help
why not use a "pattern singleton" to read/write your message/or list-of-message-strings, then you managed in all app (same that GLOBAL is not necessary so good, but sometime it's used, since protected when writing) = CriticalSession or anyother ---> mySingleton.add( who-sends, text-msg...) --> my Singleton.read(, who-sent, msg-index-or-any-other-way-if-exists-any-one) ... who read, can exclude it from list -
Decrement a value by 1 each time a function is called
programmerdelphi2k replied to Willicious's topic in Delphi IDE and APIs
this was a long time ago... I just found in my backup... just use Konopka CodeSite, maybe have some pattern 😂 uses CodeSiteLogging; procedure TForm1.Button1Click(Sender: TObject); begin CodeSite.Send('hello'); end; -
Decrement a value by 1 each time a function is called
programmerdelphi2k replied to Willicious's topic in Delphi IDE and APIs
here my sample for tests uses uMyLogger; procedure TForm1.BtnAddAnErrorOnMSWindowsEventLogClick(Sender: TObject); var i: integer; begin randomize; i := random($FFFFFFF); // TMyLoggerOnMSWindowsEventLogger.CustomLog('meu app: ' + i.ToString, 'meu error: ' + i.ToString); end; now, look in MS Events Viewer -
Decrement a value by 1 each time a function is called
programmerdelphi2k replied to Willicious's topic in Delphi IDE and APIs
well, if you needs know "how much" and dont want use breakpoints, then try "log it" (send all info when your function was accessed, later, look it) using a "file" as your target... or if in IDE, using any "listening" to debug, like Konopka KSVC (Raize components) suite or same you can send the message to MSWindows logger, in real-time! -
delphi7 Delphi 7 compatibility with Windows 11?
programmerdelphi2k replied to jsen262's topic in General Help
did you try right-click on executable and change the options ...(compatibility, etc...) and Snap Layout setup in Win11? note: changing scale can help in some situation... but this is used for all apps including Win11-apps note2: did you try FancyZones is a tool part of the PowerToys app that allows you to manage windows on Windows 11 and 10 https://youtu.be/ld-vmpbngDE -
maybe a little fix to get FTicks64 when the end the Thread.... procedure TMyThread.Execute; ... // while not Terminated do ... end; // if (LWaitRestult <> TWaitResult.wrTimeout) then // wrSignaled, etc... FTicks64 := GetTickCount64 - FTicks64; end;
-
How can I allocate memory without raising exceptions ?
programmerdelphi2k replied to Marus's topic in General Help
because the API take care before send result boolean be using TRY_EXCEPT (Delphi) or CATCH (C), for that you dont see it. try_block, dont costs almost nothing, and it was made for this. it is up to you to determine what will be returned in case of an exception and what actions will be taken. -
@Ian Branch maybe some like this: code attached... procedure TMyThread.Execute; var LWaitRestult: TWaitResult; begin // inherited; // FTicks64 := GetTickCount64; // while not Terminated do begin LogMe(Self.ThreadID.ToString + ', ...Thread is running ... 1 : Delay: ' + FDelay.ToString); // LWaitRestult := FEvent.WaitFor(FDelay); FMyEventWaitResult := LWaitRestult; // if (LWaitRestult = TWaitResult.wrTimeout) then begin LogMe(Self.ThreadID.ToString + ', hello timer: ' + FDelay.ToString + ', WaitResult: ' + LWaitRestult.ToString); // FTicks64 := (GetTickCount64 - FTicks64); // break; end; // LogMe(Self.ThreadID.ToString + ', ...Thread is running ... 2 : Delay: ' + FDelay.ToString); end; // if (LWaitRestult <> TWaitResult.wrTimeout) then begin FTicks64 := (GetTickCount64 - FTicks64); FMyEventWaitResult := LWaitRestult; end; end; code.txt
-
FMX-TTreeview: Intercept click on Expand-button
programmerdelphi2k replied to Renate Schaaf's topic in FMX
I have achieved using FindFirst/FindNext in "RELEASE/FMX" mode the time below. Naturally, using OS functions (at a lower level) would be ideal for a task like this. Total dirs found / Nodes created: 852 'C:\Users\Public\Documents\Embarcadero' Finding directory: Time: 00:00:00.0924180 (not expanded) - TreeView1.BeginUpdate; ... MyCreateSubNode(TreeView1, LDirRootForTest, '', 0, nil); ... TreeView1.EndUpdate; the reading of the files found in the clicked directory/node will also be relative... but generally it will be very fast, respecting the quantity, of course. And, to speed things up even more, some kind of "cache" of the previous read could be implemented, as I think is done at the level of the O.S. ... after this, wait for expand all nodes! Expand all directory: Time: 00:00:00.7945893 Collapse all directory: Time: 00:00:00.0065527 MS Explorer shows (by default) only the first level of a directory, and when expanding all subfolders of all directories, the time will also be longer. And, if by necessity, you need to expand folders/sub-folders on the network, this time will be even longer... -
FMX-TTreeview: Intercept click on Expand-button
programmerdelphi2k replied to Renate Schaaf's topic in FMX
@Renate Schaaf NOW, all works as expected! it was necessary to forget the use of TDirectory, due to the fact that it delivered the matrix ready, however, with all the absolute paths for each folder found in the indicated path. So, I preferred to go straight to the source and use the functions FindFirst, FindNext, and have access to each path and thus create the TreeView nodes as it should be. much less code and good speed for both functions: finding directories and showing their files implementation {$R *.fmx} uses System.IOUtils, System.Diagnostics; var SW: TStopWatch; function MyFullDirectoryPath(ANode: TTreeViewItem): string; var LDirs: TArray<string>; begin if ANode <> nil then begin while ANode <> nil do begin LDirs := LDirs + [ANode.Text]; ANode := ANode.ParentItem; end; // for var i: integer := high(LDirs) downto 0 do result := result + '\' + LDirs[i]; // if result.StartsWith('\') then result := result.Remove(0, 1); // "\C:..." end; end; function MyCreateSubNode(ATV: TTreeView; ADirRoot: string; ASubDirName: string; ALevel: integer; ANode: TTreeViewItem): TTreeViewItem; var LSrcRec : TSearchRec; LTrue : boolean; LResult : integer; LCurDirName: string; LSubNode : TTreeViewItem; LSlash : string; XNode : TTreeViewItem; begin LCurDirName := ''; LSlash := ''; XNode := nil; result := nil; // if not ASubDirName.IsEmpty then LSlash := '\'; // LResult := FindFirst(ADirRoot + '\' + ASubDirName + LSlash + '*.*', System.SysUtils.faDirectory, LSrcRec); try LTrue := (LResult = 0); // if LTrue and (ALevel = 0) and (ANode = nil) then begin //ATV.Clear; // clear all!! ??? ANode := TTreeViewItem.Create(ATV); ANode.Text := ADirRoot; ATV.AddObject(ANode); end; // // while LTrue do begin LCurDirName := LSrcRec.Name; // if (LCurDirName > '..') and (LSrcRec.Attr = System.SysUtils.faDirectory) then begin if (ANode <> nil) then begin LSubNode := TTreeViewItem.Create(ATV); LSubNode.Text := LCurDirName; ANode.AddObject(LSubNode); XNode := LSubNode; end; // result := MyCreateSubNode(ATV, ADirRoot + '\' + ASubDirName, LCurDirName, 1, XNode); end; // LTrue := FindNext(LSrcRec) = 0; end; // if result = nil then exit; finally if LResult = 0 then FindClose(LSrcRec); end; end; procedure MyShowFilesInDirectory(const ANode: TTreeViewItem; const AMemo: TMemo); var LText: string; begin LText := MyFullDirectoryPath(ANode); // if not LText.IsEmpty then begin try AMemo.Text := 'Directory:' + slinebreak + LText + slinebreak + slinebreak + 'Files:'; // if TDirectory.Exists(LText) then AMemo.Lines.AddStrings(TDirectory.GetFiles(LText)) else AMemo.Lines.Add('this path does not exists anymore, or...'); except on E: Exception do AMemo.Text := 'Error on "MyShowFilesInDirectory"' + slinebreak + E.Message; end; end; end; procedure TForm2.BtnFindDirectoriesClick(Sender: TObject); var LNode: TTreeViewItem; begin // // TreeView1.Clear; // needs reset it!!! // SW.StartNew; SW.Start; // { LNode := TTreeViewItem.Create(TreeView1); LNode.Text := 'Hello World'; TreeView1.AddObject(LNode); MyCreateSubNode(TreeView1, 'C:\Users\Public\Documents\Embarcadero', '', 1, LNode); } // TreeView1.Clear; MyCreateSubNode(TreeView1, 'C:\Users\Public\Documents\Embarcadero', '', 0, nil); // SW.Stop; // ShowMessage('Finding directory: Time: ' + SW.Elapsed.Duration.ToString + slinebreak + '... after this, wait for expand all nodes!'); // TreeView1.ExpandAll; end; procedure TForm2.BtnExpand_Colapse_ALLClick(Sender: TObject); begin if TreeView1.CountExpanded = 0 then TreeView1.ExpandAll else TreeView1.CollapseAll; end; procedure TForm2.TreeView1Click(Sender: TObject); begin SW.StartNew; SW.Start; // MyShowFilesInDirectory(TreeView1.Selected, Memo1); // SW.Stop; // ShowMessage('Finding directory: Time: ' + SW.Elapsed.Duration.ToString); end; initialization ReportMemoryLeaksOnShutdown := true; SW := TStopWatch.Create; end. -
FMX-TTreeview: Intercept click on Expand-button
programmerdelphi2k replied to Renate Schaaf's topic in FMX
Deleted: sorry! -
FMX-TTreeview: Intercept click on Expand-button
programmerdelphi2k replied to Renate Schaaf's topic in FMX
@Renate Schaaf I see the "my fault", then, just use this new procedures Deleted: sorry! -
FMX-TTreeview: Intercept click on Expand-button
programmerdelphi2k replied to Renate Schaaf's topic in FMX
@Renate Schaaf now, it's easer use the NODE to open the folder and show your files into it! Deleted: sorry! -
FMX-TTreeview: Intercept click on Expand-button
programmerdelphi2k replied to Renate Schaaf's topic in FMX
@Renate Schaaf maybe some like this; ( for a "BIG" directory , needs patience... of course!) Deleted: sorry! -
@giomach EDITED: now it's working... (see code abode and add this 2 buttons) now, just translate for your propose type TMyHackLB = class(TListBox); procedure TForm1.ListBox1Click(Sender: TObject); var i: integer; x: integer; n: nativeint; begin i := ListBox1.ItemIndex; if (i > -1) then begin n := TMyHackLB(ListBox1).GetItemData(i); // if (n - 1) >= 0 then ListBox2.ItemIndex := (n - 1); // -1 because ... // TObject( x + 1 ) to avoid 0 = nil // { if (ListBox1.Items[i] = ListBox2.Items[i]) then ListBox2.ItemIndex := i else ListBox2.ItemIndex := -1; // de-Select } end; end; procedure TForm1.Btn_LB1_NewOrderClick(Sender: TObject); var LMyItemsStringOutOfOrder: TArray<string>; LObj : TObject; LTotalItems : integer; LIndexLB2 : integer; begin // new order... MyNewOrderList(ListBox2.Items.ToStringArray, LMyItemsStringOutOfOrder); // LMyItemsStringOutOfOrder := ListBox2.Items.ToStringArray; // LTotalItems := length(LMyItemsStringOutOfOrder); ListBox1.Items.Clear; // for var z: integer := 0 to (LTotalItems - 1) do begin LIndexLB2 := ListBox2.Items.IndexOf(LMyItemsStringOutOfOrder[z]); LObj := TObject(LIndexLB2 + 1); // TObject( 0 ) = nil // ListBox1.Items.AddObject(LMyItemsStringOutOfOrder[z], LObj); end; end; procedure TForm1.BtnUpdateObjectsInListBox1Click(Sender: TObject); var LMyItemsStringOutOfOrder: TArray<string>; // LIndexLB1: integer; LIndexLB2: integer; LText : string; LObj : TObject; begin // // new order for test... MyNewOrderList(LMyItemsString, LMyItemsStringOutOfOrder); // LMyItemsStringOutOfOrder := ListBox2.Items.ToStringArray; // ListBox2.Items.Clear; ListBox2.Items.AddStrings(LMyItemsStringOutOfOrder); // for var z: integer := 0 to high(LMyItemsStringOutOfOrder) do begin // find new "ItemIndex" to update "Objects" in ListBox1 LText := LMyItemsStringOutOfOrder[z]; LIndexLB1 := ListBox1.Items.IndexOf(LText); LIndexLB2 := ListBox2.Items.IndexOf(LText); // if (LIndexLB1 > -1) then begin LObj := TObject(LIndexLB2 + 1); // TObject( 0 ) = nil ListBox1.Items.Objects[LIndexLB1] := LObj; end; end; end; end.
-
{$APPTYPE GUI} uses Winapi.Messages, // <--- System.SysInit Winapi.Windows; var hBmp: HBITMAP; function WndProc(hWnd: hWnd; uMsg: UINT; wParam: wParam; lParam: lParam): LRESULT; stdcall; var PS : TPaintStruct; { hBmp, } hOldBmp: HBITMAP; // <--- hiding hBMP global = hBmp always "0"
-
then... just needs:
-
would be that? "ITEMS" is a TStrings/TStringList - then ... implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); begin LMyItemsString := ['Item01', 'Item02', 'Item03', 'Item04', 'Item05', 'Item06', 'Item07', 'Item08', 'Item09', 'Item10']; // ListBox1.Items.AddStrings(LMyItemsString); ListBox2.Items.AddStrings(LMyItemsString); end; function MyAlreadyUsed(Arr: TArray<integer>; Value: integer): boolean; begin result := false; // for var V in Arr do if (V = Value) then exit(true); end; procedure MyNewOrderList(ASrcArray: TArray<string>; var ATrgArray: TArray<string>); var LPositionAlreadyUsed: TArray<integer>; LTotalItems : integer; LRandomPosition : integer; begin randomize; // LTotalItems := length(ASrcArray); // for var i: integer := 0 to (LTotalItems - 1) do begin LRandomPosition := random(LTotalItems); // if (length(LPositionAlreadyUsed) > 1) then while MyAlreadyUsed(LPositionAlreadyUsed, LRandomPosition) do begin LRandomPosition := random(LTotalItems); end; // LPositionAlreadyUsed := LPositionAlreadyUsed + [LRandomPosition]; // new order... ATrgArray := ATrgArray + [ASrcArray[LRandomPosition]]; end; end; procedure TForm1.Btn_DeOrder_itClick(Sender: TObject); var LMyItemsStringOutOfOrder: TArray<string>; begin ListBox2.Sorted := false; // MyNewOrderList(LMyItemsString, LMyItemsStringOutOfOrder); // ListBox2.Items.Clear; ListBox2.Items.AddStrings(LMyItemsStringOutOfOrder); // ListBox1.SetFocus; end; procedure TForm1.Btn_Order_itClick(Sender: TObject); begin ListBox2.Sorted := true; ListBox1.SetFocus; end; procedure TForm1.ListBox1Click(Sender: TObject); var i: integer; begin i := ListBox1.ItemIndex; if (i > -1) then begin if ListBox1.Items[i] = ListBox2.Items[i] then ListBox2.ItemIndex := i else ListBox2.ItemIndex := -1; // de-Select end; end; end.
-
About Delphi 11.3 CE Platform Selection
programmerdelphi2k replied to ChenShou's topic in Delphi IDE and APIs
as said Melander: ... Im a HobbyIST .... and I want Linux (free and open-source) in a IDE (no commercial usage and < $5000/year) = Community Edition! 😁