Jump to content

programmerdelphi2k

Members
  • Content Count

    1406
  • Joined

  • Last visited

  • Days Won

    22

Everything posted by programmerdelphi2k

  1. programmerdelphi2k

    ini file not writtable

    complexity is a scope of computation, then I think that yes, you can use it, for sure!
  2. programmerdelphi2k

    ini file not writtable

    @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)
  3. programmerdelphi2k

    ini file not writtable

    @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 );
  4. programmerdelphi2k

    Prevent Space bar from focusing on a button

    in time, you can use "GetKeyNameText(...) + MapVirtualKey(...)" to get all key names used in your system, at least in MSWindows!
  5. programmerdelphi2k

    How can I read body of the TRESTRequest?

    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?
  6. programmerdelphi2k

    Prevent Space bar from focusing on a button

    @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;
  7. programmerdelphi2k

    How can I allocate memory without raising exceptions ?

    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
  8. programmerdelphi2k

    Decrement a value by 1 each time a function is called

    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;
  9. programmerdelphi2k

    Decrement a value by 1 each time a function is called

    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
  10. programmerdelphi2k

    Decrement a value by 1 each time a function is called

    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!
  11. programmerdelphi2k

    Delphi 7 compatibility with Windows 11?

    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
  12. programmerdelphi2k

    Loop a Delay in a thread??

    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;
  13. programmerdelphi2k

    How can I allocate memory without raising exceptions ?

    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.
  14. programmerdelphi2k

    Loop a Delay in a thread??

    @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
  15. programmerdelphi2k

    FMX-TTreeview: Intercept click on Expand-button

    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...
  16. programmerdelphi2k

    FMX-TTreeview: Intercept click on Expand-button

    @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.
  17. programmerdelphi2k

    FMX-TTreeview: Intercept click on Expand-button

    Deleted: sorry!
  18. programmerdelphi2k

    FMX-TTreeview: Intercept click on Expand-button

    @Renate Schaaf I see the "my fault", then, just use this new procedures Deleted: sorry!
  19. programmerdelphi2k

    FMX-TTreeview: Intercept click on Expand-button

    @Renate Schaaf now, it's easer use the NODE to open the folder and show your files into it! Deleted: sorry!
  20. programmerdelphi2k

    FMX-TTreeview: Intercept click on Expand-button

    @Renate Schaaf maybe some like this; ( for a "BIG" directory , needs patience... of course!) Deleted: sorry!
  21. programmerdelphi2k

    Sorting two lists in step?

    @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.
  22. programmerdelphi2k

    bitmap is not displayed

    {$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"
  23. programmerdelphi2k

    Sorting two lists in step?

    then... just needs:
  24. programmerdelphi2k

    Sorting two lists in step?

    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.
  25. programmerdelphi2k

    About Delphi 11.3 CE Platform Selection

    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! 😁
×