-
Content Count
56 -
Joined
-
Last visited
Community Reputation
6 NeutralRecent Profile Visitors
-
inheritance Ensuring Consistent Base Interface Implementation in Delphi Class Hierarchy
bravesofts replied to bravesofts's topic in Algorithms, Data Structures and Class Design
I guess I'm not okay today, haha. Maybe I'm just lacking coffee or in need of some rest. Anyway, thank you, everyone!- 13 replies
-
- code reuse
- class hierarchy
- (and 3 more)
-
inheritance Ensuring Consistent Base Interface Implementation in Delphi Class Hierarchy
bravesofts replied to bravesofts's topic in Algorithms, Data Structures and Class Design
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 replies
-
- code reuse
- class hierarchy
- (and 3 more)
-
inheritance Ensuring Consistent Base Interface Implementation in Delphi Class Hierarchy
bravesofts replied to bravesofts's topic in Algorithms, Data Structures and Class Design
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- 13 replies
-
- code reuse
- class hierarchy
- (and 3 more)
-
inheritance Ensuring Consistent Base Interface Implementation in Delphi Class Hierarchy
bravesofts replied to bravesofts's topic in Algorithms, Data Structures and Class Design
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.- 13 replies
-
- code reuse
- class hierarchy
- (and 3 more)
-
inheritance Ensuring Consistent Base Interface Implementation in Delphi Class Hierarchy
bravesofts replied to bravesofts's topic in Algorithms, Data Structures and Class Design
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- 13 replies
-
- code reuse
- class hierarchy
- (and 3 more)
-
inheritance Ensuring Consistent Base Interface Implementation in Delphi Class Hierarchy
bravesofts replied to bravesofts's topic in Algorithms, Data Structures and Class Design
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.- 13 replies
-
- code reuse
- class hierarchy
- (and 3 more)
-
inheritance Ensuring Consistent Base Interface Implementation in Delphi Class Hierarchy
bravesofts replied to bravesofts's topic in Algorithms, Data Structures and Class Design
i search a workaround or a pure solution that let me avoid re-implementation of iBaseFoo methods since TBaseFoo Already there- 13 replies
-
- code reuse
- class hierarchy
- (and 3 more)
-
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?
- 13 replies
-
- code reuse
- class hierarchy
- (and 3 more)
-
ifthen strange return value !
bravesofts replied to bravesofts's topic in Algorithms, Data Structures and Class Design
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. -
ifthen strange return value !
bravesofts replied to bravesofts's topic in Algorithms, Data Structures and Class Design
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. -
ifthen strange return value !
bravesofts replied to bravesofts's topic in Algorithms, Data Structures and Class Design
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! -
ifthen strange return value !
bravesofts replied to bravesofts's topic in Algorithms, Data Structures and Class Design
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? -
ifthen strange return value !
bravesofts replied to bravesofts's topic in Algorithms, Data Structures and Class Design
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; -
ifthen strange return value !
bravesofts posted a topic in Algorithms, Data Structures and Class Design
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 -
unit API.Generics; interface uses System.Classes // , System.Generics.Collections , System.Generics.Defaults ; type TSort = (sNone, sAsc, sDes); TDynamicObjectList<T: class> = class(TObjectList<T>) private fComparer: TComparison<T>; fSortField: string; fSort: TSort; function CompareNumbers(const L, R: Integer): Integer; function CompareObjects(const aLeft, aRight: T): Integer; public constructor CreateWithSort(const aSortField: string; aSort: TSort = sAsc); procedure Sort(aSort: TSort = sAsc); function IsSortedCorrectly: Boolean; end; implementation uses System.SysUtils , System.Rtti , System.TypInfo ; { TDynamicObjectList<T> } constructor TDynamicObjectList<T>.CreateWithSort(const aSortField: string; aSort: TSort); begin inherited Create(True); fSortField := aSortField; fSort := aSort; fComparer := CompareObjects; end; function TDynamicObjectList<T>.CompareNumbers(const L, R: Integer): Integer; begin Result := L - R; end; function TDynamicObjectList<T>.CompareObjects(const aLeft, aRight: T): Integer; var L_Ctx : TRttiContext; L_Typ : TRttiType; L_Prop : TRttiProperty; L_Left : TClass absolute aLeft; L_Right : TClass absolute aRight; L_LeftValue, L_RightValue: TValue; begin if fSortField = '' then begin // Use default comparer if no specific field is specified .. Result := TComparer<T>.Default.Compare(T(L_Left), T(L_Right)); Exit; end; L_Ctx := TRttiContext.Create; try L_Typ := L_Ctx.GetType(T); // Get RTTI for type ( T ) L_Prop := nil; L_Prop := L_Typ.GetProperty(fSortField); if Assigned(L_Prop) then begin L_LeftValue := L_Prop.GetValue(L_Left); L_RightValue := L_Prop.GetValue(L_Right); case L_LeftValue.Kind of tkInteger, tkInt64: case fSort of sAsc: Result := CompareNumbers(L_LeftValue.AsInteger, L_RightValue.AsInteger); sDes: Result := CompareNumbers(L_RightValue.AsInteger, L_LeftValue.AsInteger); else Result := TComparer<T>.Default.Compare(T(L_Left), T(L_Right)); end; tkString, tkWString, tkLString, tkUString: case fSort of sAsc: Result := CompareNumbers(Integer.Parse(L_LeftValue.AsString), Integer.Parse(L_RightValue.AsString)); sDes: Result := CompareNumbers(Integer.Parse(L_LeftValue.AsString), Integer.Parse(L_RightValue.AsString)); else Result := TComparer<T>.Default.Compare(T(L_Left), T(L_Right)); end; else TComparer<T>.Default.Compare(T(L_Left), T(L_Right)); end; end else Result := 0; // Handle case where property is not found finally L_Ctx.Free; end; end; function TDynamicObjectList<T>.IsSortedCorrectly: Boolean; var I: Integer; begin Result := True; for I := 1 to Count - 1 do begin if CompareObjects(Items[I - 1], Items[I]) > 0 then begin Result := False; Break; end; end; end; procedure TDynamicObjectList<T>.Sort(aSort: TSort); begin fSort := aSort; inherited Sort(TComparer<T>.Construct(fComparer)); end; end. using: in separate Unit: MyFonts.pas type TFonType = (ft_TTF, ft_OTF, ft_Unknown); TFontInfo = class strict private fFileID, fFontName : string; fFontType : TFonType; fFontFileName: string; private function Get_FontType: string; procedure Set_FontType(const aValue: string); public constructor Add(const aFileID, aFontName: string; const aFontType: TFonType); destructor Destroy; override; property ID: string read fFileID write fFileID; property FontName:string read fFontName write fFontName; property FontType:string read Get_FontType write Set_FontType; property FontFileName: string read fFontFileName write fFontFileName; end; TFontsList = class(TDynamicObjectList<TFontInfo>); in MainForm: uses MyFonts; procedure TMainView.FormCreate(Sender: TObject); var L_FontInfo: TFontInfo; L_ListItem: TListItem; begin fFontsRes_List := TFontsList.CreateWithSort('ID'); // Add some sample data fFontsLst.Add(TFontInfo.Add('3', 'Courier New', ft_TTF)); fFontsLst.Add(TFontInfo.Add('1', 'Arial', ft_TTF)); fFontsLst.Add(TFontInfo.Add('2', 'Times New Roman', ft_OTF)); // Sort the list by ID in Asc fFontsLst.Sort(sAsc); // Populate the ListView for L_FontInfo in fFontsLst do begin L_ListItem := LV_Fonts.Items.Add; L_ListItem.Caption := L_FontInfo.ID; L_ListItem.SubItems.Add(L_FontInfo.FontName); L_ListItem.SubItems.Add(L_FontInfo.FontType); L_ListItem.SubItems.Add(L_FontInfo.FontFileName); end; end; procedure TMainView.FormDestroy(Sender: TObject); begin fFontsRes_List.Free; end; currentlly it's works only with fields marked as string or integer but real value are in integer and sorted using : CompareNumbers