Jump to content

bravesofts

Members
  • Content Count

    66
  • Joined

  • Last visited

Everything posted by bravesofts

  1. 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
  2. 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.*
  3. 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.
  4. 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.
  5. 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
  6. 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.!!
  7. 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.
  8. 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.
  9. 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.
  10. 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?
  11. I guess I'm not okay today, haha. Maybe I'm just lacking coffee or in need of some rest. Anyway, thank you, everyone!
  12. I apologize for the delay and also for the code full of errors above. I hope this example is easy to understand. Thank you Github Example Link
  13. Give me a maximum of an hour; I'm working on it and will provide a very simple, working example that can be easily understood
  14. I understand the code above is a bit long, but I’d like to keep it to ensure the example can be compiled fully. It provides the necessary context for the issue. If you don’t mind, I’d prefer to leave it here.
  15. unit Model.DB.Exceptions; interface uses System.SysUtils; type EDatabaseError = class(Exception); EInvalidParameterError = class(EDatabaseError); EConnectionError = class(EDatabaseError); implementation end. ---- Unit Model.Firedac.ParamsTypes; interface uses System.Classes, System.Generics.Collections; type {$REGION ' Firedac Connection Params .. '} {$REGION ' DriverName Param & DataType .. '} TDriverFDTypeEnum = (dtAccessDB, dtSqlite, dtPostgreSql, dtMySQL, dtFirebird, dtInterbase, dtInterbaseLite); TDriverFDTypeEnumHelper = record helper for TDriverFDTypeEnum public function ToString: string; function GetDriverName: string; end; TBaseFiredacDriver = class protected class function DBName(const aValue: TDriverFDTypeEnum): string; static; class function DriverName(const aValue: TDriverFDTypeEnum): string; static; end; TMSAccessDriver = class(TBaseFiredacDriver) end; TSQLiteDriver = class(TBaseFiredacDriver) end; TPostgreSqlDriver = class(TBaseFiredacDriver) end; TMySQLDriver = class(TBaseFiredacDriver) end; TFirebirdDriver = class(TBaseFiredacDriver) end; TInterbaseDriver = class(TBaseFiredacDriver) end; TInterbaseLiteDriver = class(TBaseFiredacDriver) end; {$ENDREGION} {$REGION ' SQLite Params .. '} TSQLiteLockingMode = (mLockingExclusive, mLockingNormal); TSQLiteLockingModeHelper = record helper for TSQLiteLockingMode public function ToString: string; end; TSQLiteEncryptMode = (EncryptNone, AES128, AES192, AES256, AES_CTR128, AES_CTR192, AES_CTR256, AES_ECB128, AES_ECB192, AES_ECB256); TSQLiteEncryptModeHelper = record helper for TSQLiteEncryptMode public function ToString: string; class function FromString(const aValue: string): TSQLiteEncryptMode; static; end; {$ENDREGION} TFDRemoteBy = (FlatFile, Remote, Custom); TFDRemoteByHelper = record helper for TFDRemoteBy public function ToString: string; end; {$ENDREGION} implementation uses System.SysUtils, Model.DB.Exceptions; {$REGION ' Driver FireDac Type Helper.. '} function TDriverFDTypeEnumHelper.ToString: string; const cDBTypeNames: array [TDriverFDTypeEnum] of string = ( 'MSAccess', 'SQLite', 'PostgreSQL', 'MySQL', 'Firebird', 'Interbase', 'Interbase Lite' ); begin Result := cDBTypeNames[Self]; end; function TDriverFDTypeEnumHelper.GetDriverName: string; const cDBDriverNames: array [TDriverFDTypeEnum] of string = ( 'MSAcc', 'SQLite', 'PG', 'MySQL', 'FB', 'IB', 'IBLite' ); begin Result := cDBDriverNames[Self]; end; {$ENDREGION} {$REGION ' SQLite Locking Mode Helper .. '} function TSQLiteLockingModeHelper.ToString: string; const cLockingModeNames: array [TSQLiteLockingMode] of string = ( 'Exclusive','Normal' ); begin Result := cLockingModeNames[Self]; end; {$ENDREGION} {$REGION ' SQLite Encrypt Mode Helper .. '} function TSQLiteEncryptModeHelper.ToString: string; const cEncryptModeNames: array [TSQLiteEncryptMode] of string = ( 'No', 'aes-128', 'aes-192', 'aes-256', 'aes-ctr-128', 'aes-ctr-192', 'aes-ctr-256', 'aes-ecb-128', 'aes-ecb-192', 'aes-ecb-256' ); begin Result := cEncryptModeNames[Self]; end; class function TSQLiteEncryptModeHelper.FromString(const aValue: string): TSQLiteEncryptMode; var LEncryptMode: TSQLiteEncryptMode; begin for LEncryptMode := Low(TSQLiteEncryptMode) to High(TSQLiteEncryptMode) do if SameText(aValue, LEncryptMode.ToString) then Exit(LEncryptMode); raise EInvalidParameterError.CreateFmt('Invalid encryption mode: %s', [aValue]); end; {$ENDREGION} {$REGION ' FireDac RemoteBy Helper .. '} function TFDRemoteByHelper.ToString: string; const cFDRemoteByNames: array [TFDRemoteBy] of string = ( 'FlateFile', 'Remote', 'Custom' ); begin Result := cFDRemoteByNames[Self]; end; {$ENDREGION} { TBaseFiredacDriver } class function TBaseFiredacDriver.DBName( const aValue: TDriverFDTypeEnum): string; begin Result := aValue.ToString; end; class function TBaseFiredacDriver.DriverName( const aValue: TDriverFDTypeEnum): string; begin Result := aValue.GetDriverName; end; end. ---- unit Model.FiredacParams.BaseInterface; interface uses Model.Firedac.ParamsTypes; type iBaseFDParams<TDBType: TBaseFiredacDriver> = interface ['{B5A4A031-EFA0-4424-902D-2529FC4F1B48}'] function Pooled(aValue: Boolean): iBaseFDParams<TDBType>; overload; function Database(aValue: string): iBaseFDParams<TDBType>; overload; function Username(aValue: string): iBaseFDParams<TDBType>; overload; function Password(aValue: string): iBaseFDParams<TDBType>; overload; // function MonitorBy(aValue: TFDRemoteBy): iBaseFDParams<TDriverFDType>; overload; function Pooled: Boolean; overload; function Database: string; overload; function UserName: string; overload; function Password: string; overload; // function MonitorBy: TFDRemoteBy; overload; function Params: iBaseFDParams<TDBType>; end; implementation end. ---- The code provided above contains necessary units used by my main unit below (Model.Firedac.ConnectionParams), where the actual issue occurs. unit Model.Firedac.ConnectionParams; interface uses System.Classes, System.SysUtils, System.Generics.Collections, // Model.Firedac.ParamsTypes, Model.FiredacParams.BaseInterface, Model.DB.Exceptions; type iMSAccesseParams = iBaseFDParams<TMSAccessDriver>; iSQLiteParams = interface (iBaseFDParams<TSQLiteDriver>) function LockingMode(aValue: TSQLiteLockingMode): iBaseFDParams<TSQLiteDriver>; overload; function Encrypt(aValue: TSQLiteEncryptMode): iBaseFDParams<TSQLiteDriver>; overload; function LockingMode: TSQLiteLockingMode; overload; function Encrypt: TSQLiteEncryptMode; overload; end; iPostgreSqlParams = iBaseFDParams<TPostgreSqlDriver>; iMySQLParams = iBaseFDParams<TMySQLDriver>; iFirebirdParams = iBaseFDParams<TFirebirdDriver>; iInterbaseParams = iBaseFDParams<TInterbaseDriver>; iInterbaseLParams = iBaseFDParams<TInterbaseLiteDriver>; function GetDefault_SqliteParams(const aDatabase: string; const aUsername: string = ''; const aPassword: string = ''; const aLockingMode: TSQLiteLockingMode = mLockingExclusive; aEncrypt: TSQLiteEncryptMode = EncryptNone): iSQLiteParams; implementation type iBaseFiredacParams = iBaseFDParams<TBaseFiredacDriver>; TBaseConnectionParams = class(TInterfacedObject, iBaseFiredacParams) strict private protected function Pooled(aValue: Boolean): iBaseFiredacParams; overload; virtual; function Database(aValue: string): iBaseFiredacParams; overload; virtual; function Username(aValue: string): iBaseFiredacParams; overload; virtual; function Password(aValue: string): iBaseFiredacParams; overload; virtual; function Pooled: Boolean; overload; virtual; function Database: string; overload; virtual; function UserName: string; overload; virtual; function Password: string; overload; virtual; function Params: iBaseFiredacParams; virtual; procedure ValidateParams; virtual; abstract; end; TSqliteParams = class(TBaseConnectionParams, iSQLiteParams) public constructor Create (const aDatabase: string; const aUsername: string = ''; const aPassword: string = ''; const aLockingMode: TSQLiteLockingMode = mLockingExclusive; aEncrypt: TSQLiteEncryptMode = EncryptNone); procedure ValidateParams; override; function LockingMode(aValue: TSQLiteLockingMode): iBaseFDParams<TSQLiteDriver>; overload; virtual; function Encrypt(aValue: TSQLiteEncryptMode): iBaseFDParams<TSQLiteDriver>; overload; virtual; function LockingMode: TSQLiteLockingMode; overload; virtual; function Encrypt: TSQLiteEncryptMode; overload; virtual; end; function GetDefault_SqliteParams(const aDatabase: string; const aUsername: string = ''; const aPassword: string = ''; const aLockingMode: TSQLiteLockingMode = mLockingExclusive; aEncrypt: TSQLiteEncryptMode = EncryptNone): iSQLiteParams; begin Result := TSqliteParams.Create(aDatabase, aUsername,aPassword,aLockingMode, aEncrypt) as iSQLiteParams; end; end. TSqliteParams act as TTestFoo and TBaseConnectionParams as TBaseFoo
  16. I am looking for a good software design solution that helps me avoid repeatedly implementing methods from TBaseFoo. Logically, by adding iTestFoo as an ancestor to TTestFoo, I am always forced to implement the methods of iBaseFoo, which come from iTestFoo. I want to avoid re-implementation of these methods. I tried marking the methods of TBaseFoo as virtual, but it didn’t help.
  17. i search a workaround or a pure solution that let me avoid re-implementation of iBaseFoo methods since TBaseFoo Already there
  18. why this IfThen inline function gives me Object is Allocated in memory !! --- type TMainView = class(TForm) Label1: TLabel; procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var MainView: TMainView; implementation type TMyClass = class private // fValue: string; class var ClassValue: string; function GetValue: string; procedure SetValue(const aValue: string); public property Value: string Read GetValue write SetValue; end; { TMyClass } function TMyClass.GetValue: string; begin Result := ClassValue; end; procedure TMyClass.SetValue(const aValue: string); begin ClassValue := aValue; end; { TMainView } function IsAllocated(aObj: TMyClass): Boolean; begin Result := Assigned(aObj); case Result of True: aObj.Value := 'the OBJECT Is Allocated ..'; False: aObj.Value := 'Not Allocated Yet !!'; end; end; procedure TMainView.FormCreate(Sender: TObject); var LObj: TMyClass; begin // LObj := nil; // LObj := TMyClass.Create; Label1.Caption := IfThen(IsAllocated(LObj), LObj.Value, LObj.Value); end; link to github test project here
  19. Did the tone of this conversation lean towards mockery or belittling the person asking the question, or am I mistaken? -- In any case, thank you for the information.
  20. i agree with you @Rollo62 on this term, we should be the first to ask a good questions to get a good answers with best accuracy of the truth .. By the way, the answer from ChatGPT above would have been impossible without the question being, in reality, the answer from the highly respected and dear-to-my-heart @Dalija Prasnikar. If you take a closer look at what ChatGPT provided above, you’ll notice that it did a wonderful job of summarize, re-format and complete ., and beautifully elaborating on the esteemed professor Dalija Prasnikar's response.. The above post from ChatGPT 4.o is the best proof of what you say. --- finally , I want to thank you all once again for your amazing and enthusiastic contributions. Your accuracy in providing information has really helped me understand and sum up a journey that many people might still be struggling with.
  21. i ask GPT for a good Example and gives me this: procedure TMainView.Btn_1Click(Sender: TObject); var LObj: TMyClass; // Declare a local variable of reference type begin // At this point, LObj is just a pointer, and it hasn't been assigned to any object yet. ShowMessage(IntToStr(Integer(LObj))); // This may show some random (garbage) value LObj := TMyClass.Create; // Now, LObj points to a new instance of TMyClass allocated on the heap. ShowMessage(IntToStr(Integer(LObj))); // This will show the actual memory address of the object instance // When you’re done, free the object to avoid memory leaks. LObj.Free; end; Explanation LObj Declaration: LObj is declared as a variable of type TMyClass. This is a reference type, which means LObj is just a pointer (an address) that will eventually point to an object instance. Memory Allocation: LObj itself is a local variable, so it is allocated on the stack. However, the object instance that LObj will point to is allocated on the heap when you create it using TMyClass.Create. Garbage Value: When LObj is declared, it hasn't been initialized to point to anything. The memory allocated on the stack for LObj might contain whatever data was there before, which is why ShowMessage(IntToStr(Integer(LObj))) might display a random (garbage) value. This is because stack memory isn't automatically cleared. Object Creation: When you create a new instance of TMyClass with LObj := TMyClass.Create;, the memory for this instance is allocated on the heap. LObj now holds the memory address of this instance. Managed Types: Only managed types (e.g., strings, dynamic arrays, interfaces) are automatically initialized to nil or equivalent values when declared. Since LObj is not a managed type, it can hold any value until you explicitly initialize it by creating an object. Key Takeaways Uninitialized Pointers: If you don't initialize a reference type variable (like LObj), it might contain a garbage value that points to an undefined memory location. Memory Allocation: Local variables are allocated on the stack, but the actual object instances they point to are allocated on the heap. Automatic Initialization: Only managed types are automatically initialized to nil or similar default values when declared. This example illustrates the importance of initializing your reference variables to nil or creating an object before using them to avoid unexpected behavior. ---- I have a much clearer understanding of the entire process now. Thank you, everyone!
  22. So, the heap might contain some garbage data, and when we declare a variable, the pointer may refer to something that isn’t related to our program at all. Does this happen only in Windows?
  23. Do random values only occur for local variables? Why does uninitialized memory sometimes contain garbage values, especially when an object hasn't been allocated yet? LObj is just a variable that will reference the object once TMyClass creates it. Does TMyClass automatically assign anything to LObj just by declaring it like this? var LObj: TMyClass;
  24. the Purpose of reintroduce is to make a second introduce for same method from base class (not marked as virtual or dynamic) with overload arguments in Drived Class whith inherited ofcourse .. reintroduce let us add inherited in implementation of that overload method that reintroduced in Derrived Class ex: type TBaseClass = class public constructor Create; // no virtual or dynamic end; TDerivedClass = class(TBaseClass) public // constructor Create; overload// introduced as overload but no arguments there !! constructor Create(aArg:T); reintroduce; overload; end; implementation { TBaseClass } constructor TBaseClass.Create; begin // for example No code here !! end; { TDerivedClass } constructor TDerivedClass.Create; begin inherited Create; // reintroduce let us make inherited here //since base method is not marked as virtual or dynamic .. MyCode; // our method here will implement both (the inherited + MyCode) // but since the inherited is empty : the reintroduce here is Totally useless !! // the aim of reintroduce is to let us Merge the old method from base to reintroduce it // as a new method in derived class using directive [inherited] // does the overload necessary ? // if there is no necessary to add new arguments you can add just reintroduce to use // the inherited directive there .. // Is inherited mandatory when using reintroduce ? // a reintroduce without inherited is totally nosense !! end; finally : reintroduce is used especially for two Reasons: make inherited + overload with new parameters for same base method in Drived class make just inherited without overload it with new parameters Q1)does reintroduce work also with base methods marked as virtual or dynamic ? A1) do you heard about override ? Q2) but if i need to introduce it with my custom parameters ? A2) if that case ofcourse you need reintroduce; with overload; Q3) is overload mandatory ? A3) since reintroduce her second work is to hide any warnning compiler i can say yes the overload is a mandatory logically .. ----- if i'm wrong plz tell me (Many thanks in Advance)
×