Jump to content

bravesofts

Members
  • Content Count

    81
  • Joined

  • Last visited

Everything posted by bravesofts

  1. πŸ”₯ Who can accurately recreate this UI in Delphi VCL? πŸ”₯ ---- πŸ‘‰ Rules of the challenge: No third-party components – Only pure VCL! Windows API calls only – No hacks like setting a blurred wallpaper. True glass blur effect – The UI must feature real-time Gaussian Blur, not a fake overlay. Resizable & smooth movement – The form should be fully resizable and draggable without lag. Performance separation – The blur effect must run on a separate thread, ensuring that UI interactions stay smooth. Native Windows 11 style – The form should have real rounded corners, using the native Windows 11 API. Update on the challenge requirements: Regarding Resizing, and even Moving, the developer may revert the form’s design to be Normal in terms of background and borders (to make it easier for everyone to participate and to minimize code for smoother application performance). Regarding updating the background when the form does not move, you are also not required to provide this background capture (meaning we want everyone to participate, thank you). --- Happy birthday and a new year for Delphiβ€”and every year, becomes stronger and better... --- πŸš€ Fun fact: The login form shown in the image is actually running on Windows XP! 🀯 πŸ’¬ Can you achieve this in Delphi VCL? Post your best attempt below! πŸ‘‡ ----
  2. bravesofts

    VCL UI Design Challenge for Delphi Developers πŸ’‘

    Windows Composition API Is Still WinAPI ? Even though it’s sometimes called the β€œcomposition API,” functions like SetWindowCompositionAttribute or DwmSetWindowAttribute are exported from system DLLs (e.g., user32.dll or dwmapi.dll) and thus part of the Windows API. On Windows 11, you can apply Acrylic (DWMSBT_ACRYLIC) or Mica (DWMSBT_MAINWINDOW) to a window without a custom GPU pipeline, and it’s still hardware-accelerated by DWM behind the scenes. Delphi Borderless Form Native Windows 11 Rounded Corners You can request real rounded corners via the Windows 11 API
  3. bravesofts

    VCL UI Design Challenge for Delphi Developers πŸ’‘

    Sorry for that. TStyleManager uses custom resizing instead of the native Windows border, meaning the window won't have a native border & shadow when resizing. The form should be fully resizable and draggable without lag. -- To help you move forward, try this technique first: Delphi Borderless Form This is a good starting point. Regarding rounded corners, the challenge primarily targets Windows 11, but support for older versions down to XP is still important. -- For the glass blur effect, you should use the provided Windows API. Otherwise, if you implement your own workaround, the blur effect must run on a separate thread to ensure UI interactions remain smooth. -- Third-party components are not allowed. The window resizing and movement must be smoothly updated without high CPU usage. The app should run as fast and responsively as possible. --- Thank you for your interest! 😊
  4. bravesofts

    VCL UI Design Challenge for Delphi Developers πŸ’‘

    You have earned an abundance of love and respect over the years, especially through your outstanding contributions to UI design. I know you can do itβ€”haha, you've already proven yourself time and time again!
  5. bravesofts

    VCL UI Design Challenge for Delphi Developers πŸ’‘

    You have earned an abundance of love and respect over the years, especially through your outstanding contributions to UI design. I know you can do itβ€”haha, you've already proven yourself time and time again!
  6. bravesofts

    VCL UI Design Challenge for Delphi Developers πŸ’‘

    No, the background is not a static image. The form background is dynamically captured in real-time, just like a real glass window. It continuously updates to reflect any changes happening behind the form, creating a true transparent and blurred glass effect. πŸš€
  7. bravesofts

    Introducing TRange<T>

    unit API.Utils; interface uses System.SysUtils, System.Types, System.Generics.Defaults; type TRange<T> = class public // Check if a value is within the range [aMin, aMax] using a custom comparer class function IsIn(const aValue, aMin, aMax: T; const aComparer: IComparer<T>): Boolean; overload; static; // Check if a value is within the range [aMin, aMax] using the default comparer class function IsIn(const aValue, aMin, aMax: T): Boolean; overload; static; end; implementation { TRange<T> } class function TRange<T>.IsIn(const aValue, aMin, aMax: T; const aComparer: IComparer<T>): Boolean; begin Result := (aComparer.Compare(aValue, aMin) >= 0) and (aComparer.Compare(aValue, aMax) <= 0); end; class function TRange<T>.IsIn(const aValue, aMin, aMax: T): Boolean; begin Result := IsIn(aValue, aMin, aMax, TComparer<T>.Default); end; end. to put this Super class in test i build a new console project: this unit here act as my objects: unit API.Objects.Comparer; interface uses System.Types, System.Generics.Defaults; type ICustomRecord = interface; // Forward ICustomRecordUpdate = interface function Edit(const aName: string; const aValue: Integer): ICustomRecord; end; ICustomRecord = interface function GetName: string; function GetValue: Integer; function GetCustomRecordUpdate: ICustomRecordUpdate; property Name: string read GetName; property Value: Integer read GetValue; property New: ICustomRecordUpdate read GetCustomRecordUpdate; end; IProduct = interface; // Forward IProductUpdate = interface function Edit(const aID: Integer; const aPrice: Currency): IProduct; end; IProduct = interface function GetID: Integer; function GetPrice: Currency; function GetIProductUpdate: IProductUpdate; property ID: Integer read GetID; property Price: Currency read GetPrice; property New: IProductUpdate read GetIProductUpdate; end; IClient = interface; // Forward IClientUpdate = interface function Edit(const aName: string; const aAge: Integer): IClient; end; IClient = interface function GetName: string; function GetAge: Integer; function GetIClientUpdate: IClientUpdate; property Name: string read GetName; property Age: Integer read GetAge; property New: IClientUpdate read GetIClientUpdate; end; // Compare Custom Records <Helper function> function CompareCustomRecord(const R1, R2: ICustomRecord): Integer; // Compare Products by thier Prices <Helper function> function CompareProductByPrice(const P1, P2: IProduct): Integer; // Compare Clients by thier Ages <Helper function> function CompareClientByAge(const C1, C2: IClient): Integer; // points comparison <Helper functions> function ComparePoints(const P1, P2: TPoint): Integer; overload; function ComparePoints(const P1, P2: TPointF): Integer; overload; // Returns a custom comparer for TPoint function PointComparer: IComparer<TPoint>; function GetTCustomRecord(const aName: string; aValue: Integer): ICustomRecord; function GetTProduct(aID: Integer; aPrice: Currency): IProduct; function GetTClient(const aName: string; aAge: Integer): IClient; implementation uses System.Math; type TCustomRecord = class(TInterfacedObject, ICustomRecord, ICustomRecordUpdate) strict private fName: string; fValue: Integer; function GetName: string; function GetValue: Integer; function GetCustomRecordupdate: ICustomRecordUpdate; function Edit(const aName: string; const aValue: Integer): ICustomRecord; public constructor Create(const aName: string; aValue: Integer); end; TProduct = class(TInterfacedObject, IProduct, IProductUpdate) private fID: Integer; fPrice: Currency; function GetID: Integer; function GetPrice: Currency; function GetIProductUpdate: IProductUpdate; function Edit(const aID: Integer; const aPrice: Currency): IProduct; public constructor Create(aID: Integer; aPrice: Currency); end; TClient = class(TInterfacedObject, IClient, IClientUpdate) private fName: string; fAge: Integer; function GetName: string; function GetAge: Integer; function GetIClientUpdate: IClientUpdate; function Edit(const aName: string; const aAge: Integer): IClient; public constructor Create(const aName: string; aAge: Integer); end; function GetTCustomRecord(const aName: string; aValue: Integer): ICustomRecord; begin Result := TCustomRecord.Create(aName, aValue); end; function GetTProduct(aID: Integer; aPrice: Currency): IProduct; begin Result := TProduct.Create(aID, aPrice); end; function GetTClient(const aName: string; aAge: Integer): IClient; begin Result := TClient.Create(aName, aAge); end; {$REGION ' Points Comparer & Helper Functions .. '} function ComparePoints(const P1, P2: TPoint): Integer; begin if P1.X < P2.X then Exit(-1) else if P1.X > P2.X then Exit(1); if P1.Y < P2.Y then Exit(-1) else if P1.Y > P2.Y then Exit(1); Result := 0; // Points are equal end; function ComparePoints(const P1, P2: TPointF): Integer; begin if P1.X <> P2.X then Result := Sign(P1.X - P2.X) else Result := Sign(P1.Y - P2.Y); end; function PointComparer: IComparer<TPoint>; begin Result := TComparer<TPoint>.Construct( function(const P1, P2: TPoint): Integer begin Result := ComparePoints(P1, P2); end ); end; {$ENDREGION} { Helper CustomRecord function } function CompareCustomRecord(const R1, R2: ICustomRecord): Integer; begin Result := R1.Value - R2.Value; end; { Helper ProductByPrice function } function CompareProductByPrice(const P1, P2: IProduct): Integer; begin if P1.Price < P2.Price then Result := -1 else if P1.Price > P2.Price then Result := 1 else Result := 0; end; { Helper ClientByAge function } function CompareClientByAge(const C1, C2: IClient): Integer; begin Result := C1.Age - C2.Age; end; { TCustomRecord } {$REGION ' TCustomRecord .. '} constructor TCustomRecord.Create(const aName: string; aValue: Integer); begin fName := aName; fValue := aValue; end; function TCustomRecord.GetName: string; begin Result := fName; end; function TCustomRecord.GetValue: Integer; begin Result := fValue; end; function TCustomRecord.GetCustomRecordupdate: ICustomRecordUpdate; begin Result := Self as ICustomRecordUpdate; end; function TCustomRecord.Edit(const aName: string; const aValue: Integer): ICustomRecord; begin fName := aName; fValue := aValue; end; {$ENDREGION} { TProduct } {$REGION ' TProduct .. '} constructor TProduct.Create(aID: Integer; aPrice: Currency); begin fID := aID; fPrice := aPrice; end; function TProduct.GetID: Integer; begin Result := fID; end; function TProduct.GetPrice: Currency; begin Result := fPrice; end; function TProduct.GetIProductUpdate: IProductUpdate; begin Result := Self as IProductUpdate; end; function TProduct.Edit(const aID: Integer; const aPrice: Currency): IProduct; begin fID := aID; fPrice := aPrice; end; {$ENDREGION} { TClient } {$REGION ' TClient .. '} constructor TClient.Create(const aName: string; aAge: Integer); begin fName := aName; fAge := aAge; end; function TClient.GetName: string; begin Result := fName; end; function TClient.GetAge: Integer; begin Result := fAge; end; function TClient.GetIClientUpdate: IClientUpdate; begin Result := Self as IClientUpdate; end; function TClient.Edit(const aName: string; const aAge: Integer): IClient; begin fName := aName; fAge := aAge; end; {$ENDREGION} end. now here is my dpr console code: program RangChecker; {$APPTYPE CONSOLE} {$R *.res} uses System.SysUtils, System.Types, DateUtils, System.Generics.Defaults, API.Utils in 'API\API.Utils.pas', API.Objects.Comparer in 'API\API.Objects.Comparer.pas'; var gPoint1, gPoint2, gPoint3: TPoint; gRec1, gRec2, gRec3: ICustomRecord; gRecordComparer: IComparer<ICustomRecord>; gProduct1, gProduct2, gProduct3: IProduct; gProductComparer: IComparer<IProduct>; gClient1, gClient2, gClient3: IClient; gClientComparer: IComparer<IClient>; gEndDateStr: string; begin gPoint1 := TPoint.Create(1, 2); gPoint2 := TPoint.Create(0, 0); gPoint3 := TPoint.Create(3, 4); gRec1 := GetTCustomRecord('Low', 10); gRec2 := GetTCustomRecord('Mid', 20); gRec3 := GetTCustomRecord('High', 30); gRecordComparer := TComparer<ICustomRecord>.Construct(CompareCustomRecord); gProduct1 := GetTProduct(1, 10.0); gProduct2 := GetTProduct(2, 20.0); gProduct3 := GetTProduct(3, 30.0); gProductComparer := TComparer<IProduct>.Construct(CompareProductByPrice); gClient1 := GetTClient('Alice', 25); gClient2 := GetTClient('Bob', 30); gClient3 := GetTClient('Charlie', 35); gClientComparer := TComparer<IClient>.Construct(CompareClientByAge); with FormatSettings do begin ShortDateFormat := 'DD MMMM YYYY'; CurrencyString := 'DA'; DecimalSeparator := ','; ThousandSeparator := '.'; end; gEndDateStr := DateToStr(Today +10, FormatSettings); try Writeln('-----------------<< Integer Tests >>--------------------------------'); {$REGION ' Integer Tests .. '} if TRange<Integer>.IsIn(5, 1, 10) then Writeln('5 is within the range [1, 10]') else Writeln('5 is outside the range [1, 10]'); if TRange<Integer>.IsIn(5, 6, 10) then Writeln('5 is within the range [6, 10]') else Writeln('5 is outside the range [6, 10]'); {$ENDREGION} Writeln('-----------------<< Int64 Tests >>--------------------------------'); {$REGION ' Int64 Tests .. '} if TRange<Int64>.IsIn(5_000_000_000_000_000_001, 5_000_000_000_000_000_000, 5_000_000_000_000_000_010) then Writeln('5_000_000_000_000_000_001 is within the range [5_000_000_000_000_000_000, 5_000_000_000_000_000_010]') else Writeln('5 is outside the range [5_000_000_000_000_000_000, 5_000_000_000_000_000_010]'); if TRange<Int64>.IsIn(5_000_000_000_000_000_000, 5_000_000_000_000_000_001, 5_000_000_000_000_000_010) then Writeln('5_000_000_000_000_000_000 is within the range [5_000_000_000_000_000_001, 5_000_000_000_000_000_010]') else Writeln('5_000_000_000_000_000_000 is outside the range [5_000_000_000_000_000_001, 5_000_000_000_000_000_010]'); {$ENDREGION} Writeln('-----------------<< Float Tests >>----------------------------------'); {$REGION ' Float Tests .. '} if TRange<Double>.IsIn(7.5, 5.0, 10.0) then Writeln('7.5 is within the range [5.0, 10.0]') else Writeln('7.5 is outside the range [5.0, 10.0]'); if TRange<Double>.IsIn(7.5, 7.6, 10.0) then Writeln('7.5 is within the range [7.6, 10.0]') else Writeln('7.5 is outside the range [7.6, 10.0]'); {$ENDREGION} Writeln('-----------------<< DateTime Tests >>------------------------------'); {$REGION ' DateTime Tests .. '} if TRange<TDateTime>.IsIn(Today, Today, Today +10) then Writeln('Today is within ['+Today.ToString+'] and ['+gEndDateStr+']') else Writeln('Today is outside ['+Today.ToString+'] and ['+gEndDateStr+']'); if TRange<TDateTime>.IsIn(Yesterday, Today, Today +10) then Writeln('Yesterday is within ['+Today.ToString+'] and ['+gEndDateStr+']') else Writeln('Yesterday is outside ['+Today.ToString+'] and ['+gEndDateStr+']'); {$ENDREGION} Writeln('-----------------<< String Tests >>--------------------------------'); {$REGION ' String Tests .. '} if TRange<string>.IsIn('hello', 'alpha', 'zulu') then Writeln('"hello" is within the range [alpha, zulu]') else Writeln('"hello" is outside the range [alpha, zulu]'); if TRange<string>.IsIn('zulu', 'alpha', 'omega') then Writeln('"zulu" is within the range [alpha, omega]') else Writeln('"zulu" is outside the range [alpha, omega]'); {$ENDREGION} Writeln('-----------------<< TPoint Tests >>-----------------------------'); {$REGION ' TPoint Tests .. '} if TRange<TPoint>.IsIn(gPoint1, gPoint2, gPoint3, PointComparer) then Writeln('Point(1, 2) is within the range [Point(0, 0), Point(3, 4)]') else Writeln('Point(1, 2) is outside the range [Point(0, 0), Point(3, 4)]'); if TRange<TPoint>.IsIn(Point(5, 5), Point(0, 0), Point(3, 4), PointComparer) then Writeln('Point(5, 5) is within the range [Point(0, 0), Point(3, 4)]') else Writeln('Point(5, 5) is outside the range [Point(0, 0), Point(3, 4)]'); {$ENDREGION} Writeln('-----------------<< TCustomRecord Tests >>-----------------------------'); {$REGION ' TCustomRecord Tests .. '} if TRange<ICustomRecord>.IsIn(gRec2, gRec1, gRec3, gRecordComparer) then Writeln('Record is within the range') else Writeln('Record is outside the range'); gRec2.New.Edit('Mid', 40); if TRange<ICustomRecord>.IsIn(gRec2, gRec1, gRec3, gRecordComparer) then Writeln('Record is within the range') else Writeln('Record is outside the range'); {$ENDREGION} Writeln('-----------------<< TProduct Tests >>-----------------------------'); {$REGION ' TProduct Tests .. '} if TRange<IProduct>.IsIn(gProduct2, gProduct1, gProduct3, gProductComparer) then Writeln('Product price is within the range') else Writeln('Product price is outside the range'); gProduct2.New.Edit(2, 40); if TRange<IProduct>.IsIn(gProduct2, gProduct1, gProduct3, gProductComparer) then Writeln('Product price is within the range') else Writeln('Product price is outside the range'); {$ENDREGION} Writeln('-----------------<< TClient Tests >>-----------------------------'); {$REGION ' TClient Tests .. '} if TRange<IClient>.IsIn(gClient2, gClient1, gClient3, gClientComparer) then Writeln('Client age is within the range') else Writeln('Client age is outside the range'); gClient2.New.Edit('Bob', 40); if TRange<IClient>.IsIn(gClient2, gClient1, gClient3, gClientComparer) then Writeln('Client age is within the range') else Writeln('Client age is outside the range'); {$ENDREGION} except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end. Output Result: My Github Link
  8. I finally found the best solution for this problem: Just put GPControls on TIKPageViewPage of TIKPageView (magically faster rendering happens) -- embedding GPControls on a TIKPageViewPage (from TIKPageView) dramatically improves the rendering performanceβ€”essentially making it "magically" faster. My Github Repo here
  9. Question About Optimizing GPControls Performance: I have a question if you don't mind: How can I make GPControls paint faster? I'm using multiple TscGPxxx controls in my form, and when resizing the form (especially with controls set to align/resize), I experience flickering and freezing. The entire form becomes unresponsive during resizing. Is there an efficient way to optimize rendering and improve performance when handling multiple GP controls? Any best practices or recommended settings to reduce redraw lag? Thanks in advance for your help!
  10. sorry, i can't understand your question --- are you trying to make more than one property read from single universal function, or you are trying to build a record for converting strings to integers ? --- or are you trying to build a dictionary of integers based on given strings ? this is what i can help for, if i get exactly what you want: if a dictionary: unit API.MyDictionary; interface uses System.SysUtils, System.Generics.Collections; type TDictionaryContainer = TDictionary<string, Integer>; TMyDictionary = class private fStrDictionary: TDictionaryContainer; function GetValueOrDefault(const aKey: string): Integer; procedure Log(const aMessage: string); public constructor Create(const aStrList: array of string); destructor Destroy; override; procedure AddOrUpdateKey(const aKey: string; aValue: Integer); procedure RemoveKey(const aKey: string); function TryGetValue(const aKey: string; out aValue: Integer): Boolean; property Dictionary: TDictionaryContainer read fStrDictionary; property Values[const aKey: string]: Integer read GetValueOrDefault; end; implementation { TMyDictionary } constructor TMyDictionary.Create(const aStrList: array of string); var I: Integer; begin fStrDictionary := TDictionaryContainer.Create; Log('Dictionary created.'); for I := Low(aStrList) to High(aStrList) do begin fStrDictionary.Add(aStrList[I], 0); // Initialize all keys with a default value of 0 Log(Format('Key "%s" added with default value 0.', [aStrList[I]])); end; end; destructor TMyDictionary.Destroy; begin Log('Dictionary destroyed.'); fStrDictionary.Free; inherited; end; procedure TMyDictionary.Log(const aMessage: string); begin // Simple console output for logging. // Replace this with your custom logging if needed. Writeln('[LOG] ', aMessage); end; procedure TMyDictionary.AddOrUpdateKey(const aKey: string; aValue: Integer); begin if fStrDictionary.ContainsKey(aKey) then begin fStrDictionary.AddOrSetValue(aKey, aValue); Log(Format('Key "%s" updated with value %d.', [aKey, aValue])); end else begin fStrDictionary.Add(aKey, aValue); Log(Format('Key "%s" added with value %d.', [aKey, aValue])); end; end; procedure TMyDictionary.RemoveKey(const aKey: string); begin if not fStrDictionary.ContainsKey(aKey) then begin Log(Format('Failed to remove key "%s": Key not found.', [aKey])); raise Exception.CreateFmt('Key "%s" does not exist in the dictionary.', [aKey]); end; fStrDictionary.Remove(aKey); Log(Format('Key "%s" removed.', [aKey])); end; function TMyDictionary.GetValueOrDefault(const aKey: string): Integer; begin if not fStrDictionary.TryGetValue(aKey, Result) then begin Result := 0; // Default value Log(Format('Key "%s" not found. Returning default value %d.', [aKey, Result])); end else Log(Format('Key "%s" found with value %d.', [aKey, Result])); end; function TMyDictionary.TryGetValue(const aKey: string; out aValue: Integer): Boolean; begin Result := fStrDictionary.TryGetValue(aKey, aValue); if Result then Log(Format('Key "%s" found with value %d.', [aKey, aValue])) else Log(Format('Key "%s" not found.', [aKey])); end; end. the dpr console test: program DictionaryPrj; {$APPTYPE CONSOLE} {$R *.res} uses System.SysUtils, API.MyDictionary in 'API\API.MyDictionary.pas'; procedure TestMyDictionary; var MyDict: TMyDictionary; Value: Integer; begin // Create the dictionary with initial keys MyDict := TMyDictionary.Create(['Key1', 'Key2']); try MyDict.AddOrUpdateKey('Key1', 10); MyDict.AddOrUpdateKey('Key3', 15); MyDict.TryGetValue('Key2', Value); MyDict.Values['Key1']; MyDict.Values['Key4']; // Returns default value (0) MyDict.RemoveKey('Key1'); MyDict.AddOrUpdateKey('Key1', 100); MyDict.Dictionary.Items['Key1']; finally MyDict.Free; end; end; begin try TestMyDictionary; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end. i hope this what you looking for..
  11. bravesofts

    Introducing TRange<T>

    Thank you for your questions and feedback! I understandβ€”it’s a lot to go through! That was long for a reason: I know many people don’t have much time to browse a repo, so I wrote everything necessary to make it easier for them, especially on mobile devices. Still, I’ll consider shortening it for better clarity. Thanks for the feedback! My class specifically handles the IsInRange case. In the demo, I used TPoint (a record) and a custom comparer to determine if a point is within a range of two points. While equality or ordering functions aren’t implemented yet, I believe they would work similarly. Adding these is something I plan to explore in future updates and It would be great if you’d like to contribute by adding this functionalityβ€”it’d be much appreciated! 😊 To be honest, I’ve never used this functionality before in my life. I didn’t publish this class to boast or to tell people, β€œLook how skilled I am in Delphi.” In reality, I’m a very simple and self-taught Delphi developer, and I’m proud of that, of course. I’m still in the process of learning and discovering what amazing capabilities and skills can be unlocked in Delphi. I might try DUnit or DUnitX in the future, but for now, I’m focused on exploring and growing my understanding of the language. Like I mentioned before, I’m not as good a programmer as you might thinkβ€”I’m just a self-taught Delphi enthusiast. Honestly, I think I just love Delphi and its tools, but when it comes to GitHub or any other tools, they’re not really my thing. I’ve never worked as a programmer or developer in a professional capacity, and tools like Agile or Git aren’t even on my radar. I guess you could call me a jungle developer! 😊 That said, I appreciate the feedback and will try to improve the repo organization in the future. Thanks for the feedback!
  12. bravesofts

    How to open form2 then close form1

    hidding instance of TForm1 doesn't mean is closed!! --- Creating a Form2 instance without an owner by passing nil in Create(nil) can lead to a memory leak if an exception occurs!! The code lacks proper cleanup for Form2. A better practice is to use a try..finally block to ensure Form2 is freed, even if an exception occurs. Form2 := TForm2.Create(nil); try Form2.ReceivedValue := TButton(Sender).Caption; Form2.Position := poScreenCenter; Form2.ShowModal; finally Form2.Free; end; When Form1 is the main form, closing it will terminate the entire application. To handle this scenario while still achieving the desired behavior (hiding Form1 and showing Form2 modally), you can modify the code as follows: Avoid Global Form Variables: Avoid using Form2 as a global variable unless necessary. Use local variables whenever possible: Updated Code with Form1 as MainForm: procedure TForm1.Button1Click(Sender: TObject); var LNewForm2: TForm2; begin // Hide the MainForm (Form1) Self.Hide; try // Create and display Form2 LNewForm2 := TForm2.Create(nil); try LNewForm2.ReceivedValue := TButton(Sender).Caption; // Pass value to Form2 LNewForm2.Position := poScreenCenter; if LNewForm2.ShowModal = mrOk then begin // Show Form1 again if Form2 was accepted Self.Show; end else begin // Handle Cancel logic (if needed) Self.Close; end; finally LNewForm2.Free; // Ensure Form2 is freed end; except on E: Exception do begin // Show the MainForm back if any exception occurs Self.Show; raise; // Re-raise the exception end; end; end;
  13. bravesofts

    Open HFSQL WINDEV Table error

    Try use OLEDB (using AdoConnection) rather using ODBC
  14. bravesofts

    Introducing TRange<T>

    i update the class my github Repo here unit API.Utils; interface uses System.SysUtils, // [Exceptions] System.Generics.Defaults; // [IComparer, TComparer] type TRange<T> = class public // Check if a value is within the range [aMin, aMax] using a custom comparer class function IsIn(const aValue, aMin, aMax: T; const aComparer: IComparer<T>): Boolean; overload; static; // Check if a value is within the range [aMin, aMax] using the default comparer class function IsIn(const aValue, aMin, aMax: T): Boolean; overload; static; end; implementation { TRange<T> } class function TRange<T>.IsIn(const aValue, aMin, aMax: T; const aComparer: IComparer<T>): Boolean; begin case GetTypeKind(T) of tkString, tkClass, tkLString, tkWString, tkInterface, tkDynArray, tkUString: begin if PPointer(@aValue)^ = nil then Exit(False); end; tkMethod: begin if (PMethod(@aValue)^.Data = nil) or (PMethod(@aValue)^.Code = nil) then Exit(False); end; tkPointer: if PPointer(@aValue)^ = nil then Exit(False); end; if not Assigned(aComparer) then raise EArgumentNilException.Create('Comparer is not assigned.'); Result := (aComparer.Compare(aValue, aMin) >= 0) and (aComparer.Compare(aValue, aMax) <= 0); end; class function TRange<T>.IsIn(const aValue, aMin, aMax: T): Boolean; begin Result := IsIn(aValue, aMin, aMax, TComparer<T>.Default); end; end. the call test : program RangeCheckerPrj; {$APPTYPE CONSOLE} {$R *.res} uses System.SysUtils, DateUtils, System.Types, System.Generics.Defaults, API.Utils in 'API\API.Utils.pas', API.Objects.Comparer in 'API\API.Objects.Comparer.pas', API.RangeCheckerTest in 'API\API.RangeCheckerTest.pas'; begin try Writeln('-----------------<< Integer Tests >>--------------------------------'); Writeln(TRangeTester<Integer>.Test(5, 1, 10)); // "5 is within the range [1, 10]" Writeln(TRangeTester<Integer>.Test(15, 1, 10)); // "15 is outside the range [1, 10]" Writeln('-----------------<< Int64 Tests >>--------------------------------'); Writeln(TRangeTester<Int64>.Test(5_000_000_000_000_000_001, 5_000_000_000_000_000_000, 5_000_000_000_000_000_010)); Writeln(TRangeTester<Int64>.Test(5_000_000_000_000_000_000, 5_000_000_000_000_000_001, 5_000_000_000_000_000_010)); Writeln('-----------------<< Float Tests >>----------------------------------'); Writeln(TRangeTester<Double>.Test(7.5, 5.0, 10.0)); Writeln(TRangeTester<Double>.Test(7.5, 7.6, 10.0)); Writeln('-----------------<< DateTime Tests >>------------------------------'); Writeln(TRangeTester<TDateTime>.Test(Today, Today, Today +10)); Writeln(TRangeTester<TDateTime>.Test(Yesterday, Today, Today +10)); Writeln('-----------------<< String Tests >>--------------------------------'); Writeln(TRangeTester<string>.Test('hello', 'alpha', 'zulu')); Writeln(TRangeTester<string>.Test('zulu', 'alpha', 'omega')); Writeln(TRangeTester<string>.Test('b', 'a', 'c')); // "'b' is within the range ['a', 'c']" Writeln(TRangeTester<string>.Test('A', 'b', 'c')); Writeln(TRangeTester<string>.Test('B', 'a', 'c')); Writeln('-----------------<< TPoint Tests >>-----------------------------'); Writeln(TRangeTester<TPoint>.Test(gPoint1, gPoint2, gPoint3, PointComparer)); Writeln(TRangeTester<TPoint>.Test(Point(5, 5), Point(0, 0), Point(3, 4), PointComparer)); Writeln('-----------------<< TCustomRecord Tests >>-----------------------------'); Writeln(TRangeTester<ICustomRecord>.Test(gRec1, gRec2, gRec3, gRecordComparer)); gRec1.New.Edit('Mid', 40); Writeln(TRangeTester<ICustomRecord>.Test(gRec1, gRec2, gRec3, gRecordComparer)); Writeln('-----------------<< TProduct Tests >>-----------------------------'); Writeln(TRangeTester<IProduct>.Test(gProduct1, gProduct2, gProduct3, gProductComparer)); gProduct1.New.Edit(1, 40); Writeln(TRangeTester<IProduct>.Test(gProduct1, gProduct2, gProduct3, gProductComparer)); Writeln('-----------------<< TClient Tests >>-----------------------------'); Writeln(TRangeTester<IClient>.Test(gClient1, gClient2, gClient3, gClientComparer)); gClient1.New.Edit('Alice', 40); Writeln(TRangeTester<IClient>.Test(gClient1, gClient2, nil, gClientComparer)); except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end. the Output:
  15. bravesofts

    Vcl text box that user can move/resize at runtime?

    try use this here: TSizeControl the github code here: Github Code any updates i will post it here, if possible
  16. Resolving .idsig Issues in Delphi Android Apps Understand the .idsig File Role The .idsig file is generated during APK signing with APK Signature Scheme V2/V3. It ensures APK integrity. Deleting it forces fallback to legacy signing (V1). Update Your SDK Tools Use the latest Android SDK and Build Tools compatible with Delphi. Ensure Android SDK Build Tools 30.0.0 or higher is installed. Verify SDK paths in Tools > Options > SDK Manager. Prevent App Disappearance After Reboot Ensure consistent and trusted APK signing with a proper keystore. Avoid modifying the APK (e.g., deleting .idsig) after signing. Test on Multiple Devices Test your app on various devices and Android versions, focusing on 7.0 and above. Check for Manufacturer-Specific Issues Investigate device-specific forums for issues with customized Android versions. Use Logcat for Debugging Gather installation/runtime logs using: adb shell logcat | grep "com.yourCompany.yourAppName" Share the log file with us here for further analysis. *Always use at least Android SDK Build Tools 30.0.0 or higher to avoid outdated signing issues.*
  17. bravesofts

    Bold for Delphi history and update

    Would you consider adding some video tutorials on how to use Bold? It would be very helpful if the demo databases were PostgreSQL, SQLite, or even Paradox, as this would make it easier to understand the entire concept at once.
  18. Hey Delphi developers! If you've ever generated Android splash screen images using Delphi IDE and noticed they appear **stretched**, here's a simple way to fix that and ensure your splash image is always **centered without distortion**. ### Steps to Fix It: ) After building your project, go to the following paths where the splash screen files are generated: if your target android system is 64bit: <YourProjectDirectory>\Android64\Debug\<YourProjectName>\res\drawable <YourProjectDirectory>\Android64\Debug\<YourProjectName>\res\drawable-anydpi-v21 or <YourProjectDirectory>\Android\Debug\<YourProjectName>\res\drawable <YourProjectDirectory>\Android\Debug\<YourProjectName>\res\drawable-anydpi-v21 Copy both files **`splash_image_def.xml | splash_image_def-v21.xml`** from this folder and paste it into a new directory in your project (e.g., **`YourProjectDirectory\res\theme`**). 2 Open both files in Delphi IDE and add the following line inside each file: android:scaleType="centerInside" 3 Deployment: Go to Project > Deployment in Delphi IDE. Select all configurations for your target system. Click on the column header "Local Name" to sort the list by name. Scroll down, find the default splash xml files, uncheck them, and replace them with your newly edited files. Don’t forget to set the remote path for the new files according to the unchecked ones. That’s it! Clean&Rebuild and deploy your project, and you’ll see your splash image properly centered on all devices without any stretching! ------------------------------------------------------------------------------------------------- I hope Embarcadero adds this by default in an upcoming version to fix the issue. ------------------------------------------------------------------------------------------------- Hope this helps, and happy coding! If you have questions, feel free to drop them below.
  19. Not yet... I wish someone could do it for me. I do have an account there, but the website’s interface is far from user-friendly.!!
  20. I've been diving deep into Embarcadero's Androidapi.JNI units, especially Androidapi.JNIBridge, and I'm truly amazed by the software design. The implementation of TJavaGenericImport showcases an incredibly high level of abstraction and modularity, making it both elegant and powerful. The way these units bridge Delphi with Java is nothing short of genius. I can't help but wonder who the developer (or team) was behind this architectural masterpiece. Does anyone know who contributed to these units? Or perhaps some background on the development process for this part of the RTL? I'm keen to learn more about the design philosophy and the thought process that led to such an outstanding implementation.
  21. I want to implement a variadic method in Delphi that behaves like Write and Writeln, where I can pass a variable number of arguments directly, without using brackets ([]) around the arguments. For example, instead of calling a method like this: MyWriteln(['Hello', 123, 45.67]); // Using array of const with brackets I want to call it like this: MyWriteln('Hello', 123, 45.67); // Without brackets, similar to Writeln I found that Delphi supports varargs for external DLL functions declared with cdecl, like this: procedure Test(aArgs: array of const); varargs; cdecl; external 'externalLibrary.dll'; However, since this approach is limited to external functions, I’d like to know if there’s any way to implement a similar variadic method directly in Delphi, avoiding the need for brackets around the arguments. My main questions are: How can I implement a Delphi variadic method that allows calling it without brackets, similar to Write/Writeln? If it's only possible using varargs with external DLLs, how would I correctly declare and call such a method? Any help or examples would be greatly appreciated! ----- I’m working on a Delphi console application where I want to redirect the standard Write and Writeln output to a synchronized memo viewer in a separate VCL application. Here's a simplified version of my current setup: unit Console.Output.MemoViewer; interface uses Winapi.Windows, System.SysUtils, System.Classes, System.SyncObjs, System.RTTI, System.Generics.Collections; type TOutputViewer = class private fVCLAppPath: string; fStartupInfo: TStartupInfo; fProcessInfo: TProcessInformation; fLogFileName: string; fLogFileStream: TFileStream; fStreamWriter: TStreamWriter; fFileLock: TCriticalSection; procedure SetFileHiddenAttribute(const aFilePath: string); procedure ExtractVCLApp(const aResourceName: string; const aOutputPath: string); procedure LaunchVCLApp; procedure WaitForVCLAppClose; procedure WriteOutput(const aText: string); public constructor Create; destructor Destroy; override; procedure mWriteln(const aArgs: array of const); procedure HandleConsoleClose; stdcall; end; implementation { TOutputViewer } constructor TOutputViewer.Create; begin fVCLAppPath := ExtractFilePath(ParamStr(0)) + 'MemoViewer.exe'; fLogFileName := 'ConsoleOutput.log'; fFileLock := TCriticalSection.Create; // Extract and launch the VCL app ExtractVCLApp('MEMOVIEWER', fVCLAppPath); LaunchVCLApp; // Initialize the log file for writing output fLogFileStream := TFileStream.Create(fLogFileName, fmCreate or fmShareDenyNone); fStreamWriter := TStreamWriter.Create(fLogFileStream, TEncoding.UTF8); end; destructor TOutputViewer.Destroy; begin fFileLock.Acquire; try FreeAndNil(fStreamWriter); FreeAndNil(fLogFileStream); finally fFileLock.Release; FreeAndNil(fFileLock); end; // Wait for VCL app to close and clean up WaitForVCLAppClose; inherited; end; procedure TOutputViewer.SetFileHiddenAttribute(const aFilePath: string); var LFileAttr: DWORD; begin LFileAttr := GetFileAttributes(PChar(aFilePath)); if LFileAttr <> INVALID_FILE_ATTRIBUTES then SetFileAttributes(PChar(aFilePath), LFileAttr or FILE_ATTRIBUTE_HIDDEN); end; procedure TOutputViewer.ExtractVCLApp(const aResourceName: string; const aOutputPath: string); var LResourceStream: TResourceStream; LFileStream: TFileStream; begin if not FileExists(aOutputPath) then begin LResourceStream := TResourceStream.Create(HInstance, aResourceName, RT_RCDATA); try LFileStream := TFileStream.Create(aOutputPath, fmCreate); try LFileStream.CopyFrom(LResourceStream, LResourceStream.Size); finally LFileStream.Free; end; finally LResourceStream.Free; end; SetFileHiddenAttribute(aOutputPath); end; end; procedure TOutputViewer.LaunchVCLApp; begin ZeroMemory(@fStartupInfo, SizeOf(fStartupInfo)); fStartupInfo.cb := SizeOf(fStartupInfo); if not CreateProcess(nil, PChar(fVCLAppPath), nil, nil, False, 0, nil, nil, fStartupInfo, fProcessInfo) then RaiseLastOSError; end; procedure TOutputViewer.WaitForVCLAppClose; begin WaitForSingleObject(fProcessInfo.hProcess, INFINITE); CloseHandle(fProcessInfo.hProcess); CloseHandle(fProcessInfo.hThread); if FileExists(fVCLAppPath) then DeleteFile(PChar(fVCLAppPath)); end; procedure TOutputViewer.WriteOutput(const aText: string); begin fFileLock.Acquire; try fStreamWriter.WriteLine(aText); fStreamWriter.Flush; finally fFileLock.Release; end; end; function VarRecToStr(const V: TVarRec): string; begin case V.VType of vtInteger: Result := IntToStr(V.VInteger); vtBoolean: Result := BoolToStr(V.VBoolean, True); vtChar: Result := V.VChar; vtString: Result := string(V.VString^); vtAnsiString: Result := string(AnsiString(V.VAnsiString)); vtWideString: Result := WideString(V.VWideString); vtUnicodeString: Result := string(UnicodeString(V.VUnicodeString)); vtInt64: Result := IntToStr(V.VInt64^); else Result := '[Unknown]'; end; end; procedure TOutputViewer.mWriteln(const aArgs: array of const); var LText: string; LArg: TVarRec; begin LText := ''; for LArg in aArgs do LText := LText + Format('%s', [VarRecToStr(LArg)]) + ' '; WriteOutput(LText.Trim); writeln(LText.Trim); end; procedure TOutputViewer.HandleConsoleClose; stdcall; begin TerminateProcess(fProcessInfo.hProcess, 0); WaitForVCLAppClose; Halt(0); end; end. program ConsoleMemoViewer; {$APPTYPE CONSOLE} uses SysUtils, Console.Output.MemoViewer in 'API\Console.Output.MemoViewer.pas'; var Viewer: TOutputViewer; begin try Viewer := TOutputViewer.Create; with Viewer do try mWriteln('Hello from redirected Writeln!:', 22, 35.7); mWriteln('This line uses redirected Write:', 22, ', Test 2: ', 35.7); mWriteln('Foo String: ', 22, ', Test 2: ', 35.7, 'Foo string:', 3333); finally Viewer.Free; end; except on E: Exception do Writeln('Error: ', E.Message); end; end. Currently, I'm using an array of const approach for mWriteln, but that requires enclosing the arguments in brackets, like this: mWriteln(['Hello', 123, 45.67]); // Requires brackets I’m aware of the overload solution where multiple versions of mWriteln can be created for different argument counts, but this is not practical when dealing with a large or unknown number of arguments.
  22. Temporary Solution: By using Delphi's TValue type from the System.Rtti unit, I was able to implement a robust custom Writeln procedure usin overload. Here's how it works: Main Procedure to Process Arguments This procedure processes the arguments, determining their types and formatting them as needed: procedure DoCustomWriteln(const Args: array of TValue); var LArg: TValue; LOutput: string; I: Integer; begin LOutput := ''; for I := Low(Args) to High(Args) do begin LArg := Args[I]; case LArg.Kind of tkInteger: LOutput := LOutput + IntToStr(LArg.AsInteger); tkFloat: LOutput := LOutput + FloatToStr(LArg.AsExtended); tkString, tkLString, tkUString, tkWString: LOutput := LOutput + LArg.AsString; tkChar, tkWChar: LOutput := LOutput + LArg.AsString; tkVariant: try LOutput := LOutput + VarToStr(LArg.AsVariant); except LOutput := LOutput + '<invalid variant>'; end; else LOutput := LOutput + '<unsupported type>'; end; // Add a separator unless it's the last argument if I < High(Args) then LOutput := LOutput + ', '; end; Writeln(LOutput); end; Overloading Writeln To make calling this function straightforward without requiring brackets, I created multiple overloads for the CustomWriteln procedure: procedure CustomWriteln(A1: TValue); overload; begin DoCustomWriteln([A1]); end; procedure CustomWriteln(A1, A2: TValue); overload; begin DoCustomWriteln([A1, A2]); end; procedure CustomWriteln(A1, A2, A3: TValue); overload; begin DoCustomWriteln([A1, A2, A3]); end; // Add more overloads as needed for additional parameters Test in Project: begin try // Examples of usage with different types CustomWriteln(42); CustomWriteln(3.14, 'Hello'); CustomWriteln(1, 2.2, 'Text', True); CustomWriteln(1, 'Two', 3.3, 'Four', False, 6); except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end. Example Output ------- 42 3,14, Hello 1, 2,2, Text, <unsupported type> 1, Two, 3,3, Four, <unsupported type>, 6 Advantages of This Approach: Flexible Input: Handles integers, floats, strings, characters, and variants. Type-Safe: Uses TValue to handle types dynamically. Scalable: Easy to extend by adding more overloads or enhancing DoCustomWriteln. --- Final Project: program CustomWritelnProj; {$APPTYPE CONSOLE} {$R *.res} uses System.SysUtils, System.Variants, System.Math, System.Rtti; procedure DoCustomWriteln(const Args: array of TValue); var LArg: TValue; LOutput: string; I: Integer; begin LOutput := ''; for I := Low(Args) to High(Args) do begin LArg := Args[I]; case LArg.Kind of tkInteger, tkInt64: LOutput := LOutput + LArg.AsInt64.ToString; tkFloat: LOutput := LOutput + LArg.AsExtended.ToString; tkEnumeration: LOutput := LOutput + BoolToStr(LArg.AsBoolean, True); tkString, tkLString, tkUString, tkWString, tkChar, tkWChar: LOutput := LOutput + LArg.AsString; tkVariant: try LOutput := LOutput + LArg.AsVariant.ToString; except LOutput := LOutput + '<invalid variant>'; end; else LOutput := LOutput + '<unsupported type>'; end; // Add a separator unless processing the last element if I < High(Args) then LOutput := LOutput + ', '; end; Writeln(LOutput); end; // Overloaded CustomWriteln implementations procedure CustomWriteln(A1: TValue); overload; begin DoCustomWriteln([A1]); end; procedure CustomWriteln(A1, A2: TValue); overload; begin DoCustomWriteln([A1, A2]); end; procedure CustomWriteln(A1, A2, A3: TValue); overload; begin DoCustomWriteln([A1, A2, A3]); end; procedure CustomWriteln(A1, A2, A3, A4: TValue); overload; begin DoCustomWriteln([A1, A2, A3, A4]); end; procedure CustomWriteln(A1, A2, A3, A4, A5: TValue); overload; begin DoCustomWriteln([A1, A2, A3, A4, A5]); end; procedure CustomWriteln(A1, A2, A3, A4, A5, A6: TValue); overload; begin DoCustomWriteln([A1, A2, A3, A4, A5, A6]); end; procedure CustomWriteln(A1, A2, A3, A4, A5, A6, A7: TValue); overload; begin DoCustomWriteln([A1, A2, A3, A4, A5, A6, A7]); end; procedure CustomWriteln(A1, A2, A3, A4, A5, A6, A7, A8: TValue); overload; begin DoCustomWriteln([A1, A2, A3, A4, A5, A6, A7, A8]); end; procedure CustomWriteln(A1, A2, A3, A4, A5, A6, A7, A8, A9: TValue); overload; begin DoCustomWriteln([A1, A2, A3, A4, A5, A6, A7, A8, A9]); end; begin try // Examples of usage with different types CustomWriteln(42); CustomWriteln(MaxComp,'The max value of Int64'); CustomWriteln(MaxComp,MinComp, 'Int64 Interval'); CustomWriteln(1, 2.2, 'Text', True); CustomWriteln(1, 'Two', 3.3, 'Four', False, 6); except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; Readln; end.
  23. i have base interface: type iBaseFoo = interface BaseMethod1; BaseMethod2; BaseMethod3; end; iTestFoo = interface(ibaseFoo) TestFooMethod; end; -- TBaseFoo = class(TInterfacedObject, iBaseFoo) private // some code here protected BaseMethod1; BaseMethod2; BaseMethod3; end; TTestFoo = class(TBaseFoo, ITestFoo) // how to Ensures TTestFoo inherits IBaseFoo methods from TBaseFoo, avoiding re-implementation. procedure TestFooMethod; end; -- my question is: How can I ensure that TTestFoo (or any descendant of TBaseFoo) uses the IBaseFoo method implementations provided by TBaseFoo, without re-implementing these methods in every descendant class?
Γ—