-
Content Count
107 -
Joined
-
Last visited
Everything posted by bravesofts
-
🔥 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! 👇 ----
-
unit Main.View; interface uses {$REGION ' Defaults Units .. '} Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.Buttons, Vcl.StdCtrls, {$ENDREGION} // System.Types; type TMainView = class(TForm) Lbl1: TLabel; Btn1: TButton; Pnl1: TPanel; Pnl2: TPanel; Btn2: TButton; Lbl2: TLabel; Btn3: TSpeedButton; BtnCapture: TButton; ImgCapturedCtrl: TImage; CmboBox_Ctrls: TComboBox; procedure FormCreate(Sender: TObject); procedure BtnCaptureClick(Sender: TObject); private function CaptureControl(aControl: TControl): TBitmap; inline; public { Public declarations } end; var MainView: TMainView; implementation {$R *.dfm} function TMainView.CaptureControl(aControl: TControl): TBitmap; var LDC: HDC; LRect: TRect; LCtrlHwnd: THandle; LOffset: TPoint; begin Result := TBitmap.Create; try LRect := aControl.BoundsRect; Result.SetSize(LRect.Width, LRect.Height); Result.Canvas.Brush.Color := clWhite; Result.Canvas.FillRect(Rect(0, 0, LRect.Width, LRect.Height)); Result.Canvas.Lock; try if aControl is TWinControl then begin LCtrlHwnd := TWinControl(aControl).Handle; LOffset := Point(0, 0); // No offset needed for TWinControl end else begin LCtrlHwnd := TWinControl(aControl.Parent).Handle; LOffset := aControl.BoundsRect.TopLeft; // Convert to parent-relative coordinates end; LDC := GetDC(LCtrlHwnd); try BitBlt(Result.Canvas.Handle, 0, 0, LRect.Width, LRect.Height, LDC, LOffset.X, LOffset.Y, SRCCOPY); finally ReleaseDC(LCtrlHwnd, LDC); end; finally Result.Canvas.Unlock; end; except Result.Free; raise; end; end; procedure TMainView.FormCreate(Sender: TObject); var I: Integer; begin CmboBox_Ctrls.Items.Clear; for I := 0 to Self.ComponentCount - 1 do if Self.Components[I] is TControl then CmboBox_Ctrls.Items.Add(Self.Components[I].Name); CmboBox_Ctrls.ItemIndex := 0; end; procedure TMainView.BtnCaptureClick(Sender: TObject); var LCtrl: TControl; LBmp: TBitmap; begin if CmboBox_Ctrls.ItemIndex <> -1 then begin LCtrl := FindComponent(CmboBox_Ctrls.Text) as TControl; if Assigned(LCtrl) then begin LBmp := CaptureControl(LCtrl); try ImgCapturedCtrl.Picture.Assign(LBmp); finally LBmp.Free; end; end; end; end; end. Dfm object MainView: TMainView Left = 0 Top = 0 Margins.Left = 5 Margins.Top = 5 Margins.Right = 5 Margins.Bottom = 5 Caption = 'MainView' ClientHeight = 297 ClientWidth = 705 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -18 Font.Name = 'Segoe UI' Font.Style = [] OnCreate = FormCreate PixelsPerInch = 144 TextHeight = 25 object Lbl1: TLabel Left = 417 Top = 33 Width = 33 Height = 25 Margins.Left = 5 Margins.Top = 5 Margins.Right = 5 Margins.Bottom = 5 Caption = 'Lbl1' end object ImgCapturedCtrl: TImage Left = 18 Top = 117 Width = 304 Height = 176 Margins.Left = 5 Margins.Top = 5 Margins.Right = 5 Margins.Bottom = 5 end object Btn1: TButton Left = 558 Top = 18 Width = 125 Height = 47 Margins.Left = 5 Margins.Top = 5 Margins.Right = 5 Margins.Bottom = 5 Caption = 'Btn1' TabOrder = 0 end object Pnl1: TPanel Left = 402 Top = 202 Width = 281 Height = 68 Margins.Left = 5 Margins.Top = 5 Margins.Right = 5 Margins.Bottom = 5 Caption = 'Pnl1' TabOrder = 1 end object Pnl2: TPanel Left = 402 Top = 90 Width = 281 Height = 107 Margins.Left = 5 Margins.Top = 5 Margins.Right = 5 Margins.Bottom = 5 Caption = 'Pnl2' TabOrder = 2 object Lbl2: TLabel Left = 174 Top = 27 Width = 33 Height = 25 Margins.Left = 5 Margins.Top = 5 Margins.Right = 5 Margins.Bottom = 5 Caption = 'Lbl2' end object Btn3: TSpeedButton Left = 150 Top = 69 Width = 118 Height = 33 Margins.Left = 5 Margins.Top = 5 Margins.Right = 5 Margins.Bottom = 5 end object Btn2: TButton Left = 15 Top = 27 Width = 113 Height = 38 Margins.Left = 5 Margins.Top = 5 Margins.Right = 5 Margins.Bottom = 5 Caption = 'Btn2' TabOrder = 0 end end object BtnCapture: TButton Left = 18 Top = 21 Width = 304 Height = 50 Margins.Left = 5 Margins.Top = 5 Margins.Right = 5 Margins.Bottom = 5 Caption = 'Get Control Capture' TabOrder = 3 OnClick = BtnCaptureClick end object CmboBox_Ctrls: TComboBox Left = 18 Top = 81 Width = 304 Height = 33 Margins.Left = 5 Margins.Top = 5 Margins.Right = 5 Margins.Bottom = 5 TabOrder = 4 Text = 'CmboBox_Ctrls' end end good luck..
-
Of course, yes! It's your hard work and dedication here, and you absolutely deserve not only a license but lifelong respect for your efforts! 🔥🚀
-
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
-
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! 😊
-
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!
-
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!
-
The Challenge Requirement has been updated. 😊🚀🔥
-
in fact your reply is correct, BUT MY VCL WINDOW STILL DO THE SAME !!
-
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. 🚀
-
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
-
ANN: StyleControls VCL v. 5.76 + new demo with Lottie Animations just released!
bravesofts replied to Almediadev Support's topic in Delphi Third-Party
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 -
ANN: StyleControls VCL v. 5.76 + new demo with Lottie Animations just released!
bravesofts replied to Almediadev Support's topic in Delphi Third-Party
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! -
record functions with parameters?
bravesofts replied to Nigel Thomas's topic in Algorithms, Data Structures and Class Design
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.. -
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!
-
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;
-
Try use OLEDB (using AdoConnection) rather using ODBC
-
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:
-
Vcl text box that user can move/resize at runtime?
bravesofts replied to Paul Dardeau's topic in VCL
try use this here: TSizeControl the github code here: Github Code any updates i will post it here, if possible -
how to set delphi android app's idsig file, why my app can not be installed?
bravesofts replied to tomye's topic in Cross-platform
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.* -
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.
-
fix stretched splash 🔥 Delphi Android Tip: Fix Stretched Splash Images in Your Delphi Apps! 🚀
bravesofts posted a topic in I made this
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.- 3 replies
-
- android splash
- fmx
-
(and 1 more)
Tagged with:
-
fix stretched splash 🔥 Delphi Android Tip: Fix Stretched Splash Images in Your Delphi Apps! 🚀
bravesofts replied to bravesofts's topic in I made this
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.!!- 3 replies
-
- android splash
- fmx
-
(and 1 more)
Tagged with:
-
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.
-
variadic-arguments How to create a Delphi variadic method similar to Write/Writeln without requiring brackets for arguments?
bravesofts replied to bravesofts's topic in Algorithms, Data Structures and Class Design
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.