From: <tw...@us...> - 2021-10-01 15:53:10
|
Revision: 3636 http://sourceforge.net/p/gexperts/code/3636 Author: twm Date: 2021-10-01 15:53:08 +0000 (Fri, 01 Oct 2021) Log Message: ----------- * updated to latest version from dzlib * added some more units from dzlib Modified Paths: -------------- trunk/ExternalSource/dzlib/u_dzClassUtils.pas trunk/ExternalSource/dzlib/u_dzOsUtils.pas trunk/ExternalSource/dzlib/u_dzVclUtils.pas Added Paths: ----------- trunk/ExternalSource/dzlib/u_dzAdvancedObject.pas trunk/ExternalSource/dzlib/u_dzDpiScaleUtils.pas trunk/ExternalSource/dzlib/u_dzTypInfo.pas Added: trunk/ExternalSource/dzlib/u_dzAdvancedObject.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzAdvancedObject.pas (rev 0) +++ trunk/ExternalSource/dzlib/u_dzAdvancedObject.pas 2021-10-01 15:53:08 UTC (rev 3636) @@ -0,0 +1,626 @@ +unit u_dzAdvancedObject; + +{$INCLUDE 'dzlib.inc'} + +interface + +{$IFNDEF DELPHI2007_UP} +{$IFNDEF NO_DELPHI2007UP_HINT} +{$MESSAGE HINT 'Delphi <2007 not supported'} +{$ENDIF} +{$ELSE} + +uses + Classes, + TypInfo, + u_dzTypes, + u_dzTranslator; + +type + EPropertyNotFound = class(EdzException) + + end; + +type +{$M+} + ///<summary> + /// Advanced object class with helper functions to access published properties (of descendants) </summary> + TAdvancedObject = class + public + type + TStringArray = array of string; + public + function HasProperty(const _Name: string; out _Type: TTypeKind): Boolean; overload; + class function HasProperty(_Instance: TObject; const _Name: string; out _Type: TTypeKind): Boolean; overload; + + function HasEnumProperty(const _Name: string): Boolean; overload; + class function HasEnumProperty(_Instance: TObject; const _Name: string): Boolean; overload; + + function HasStringProperty(const _Name: string): Boolean; overload; + class function HasStringProperty(_Instance: TObject; const _Name: string): Boolean; overload; + + function HasFloatProperty(const _Name: string): Boolean; overload; + class function HasFloatProperty(_Instance: TObject; const _Name: string): Boolean; overload; + + function HasIntProperty(const _Name: string): Boolean; overload; + class function HasIntProperty(_Instance: TObject; const _Name: string): Boolean; overload; + + function HasObjectProperty(const _Name: string): Boolean; overload; + class function HasObjectProperty(_Instance: TObject; const _Name: string): Boolean; overload; + + function HasEventProperty(const _Name: string): Boolean; overload; + class function HasEventProperty(_Instance: TObject; const _Name: string): Boolean; overload; + + ///<summary> + /// Calls HasEnumProperty and raises an exception if that call returns false </summary> + class procedure CheckHasEnumProperty(_Instance: TObject; const _Name: string); + + ///<summary> + /// Calls HasIntProperty and raises an exception if that call returns false </summary> + class procedure CheckHasIntProperty(_Instance: TObject; const _Name: string); + + ///<summary> + /// Access a string property + /// @param Name is the name of the property + /// @param Value is the value of the property, only valid if Result is true + /// @returns true, if the property exists and is a string property + /// false if it either doesn't exist or has a different type </summary> + function TryGetStringProperty(const _Name: string; out _Value: string): Boolean; overload; + class function TryGetStringProperty(_Instance: TObject; const _Name: string; out _Value: string): Boolean; overload; + function GetStringProperty(const _Name: string; const _Default: string): string; overload; + class function GetStringProperty(_Instance: TObject; const _Name: string; const _Default: string): string; overload; + function GetStringProperty(const _Name: string): string; overload; + class function GetStringProperty(_Instance: TObject; const _Name: string): string; overload; + ///<summary> + /// Sets a string property, returns true on success + /// @param Name is the name of the property to set + /// @param Value is the value to set the property to + /// @returns true, if the property could be set + /// false otherwise </summary> + function SetStringProperty(const _Name: string; const _Value: string): Boolean; overload; + class function SetStringProperty(_Instance: TObject; const _Name: string; const _Value: string): Boolean; overload; + + ///<summary> + /// Access a boolean property + /// @param Name is the name of the property + /// @param Value is the value of the property, only valid if Result is true + /// @returns true, if the property exists and is an enum(!) property + /// false if it either doesn't exist or has a different type + /// Note: It is not possible to distinguish between Boolean and any other enum type + /// So, this will Get or Set any enum property. </summary> + function TryGetBoolProperty(const _Name: string; out _Value: Boolean): Boolean; overload; + class function TryGetBoolProperty(_Instance: TObject; const _Name: string; out _Value: Boolean): Boolean; overload; + function GetBoolProperty(const _Name: string): Boolean; overload; + class function GetBoolProperty(_Instance: TObject; const _Name: string): Boolean; overload; + function SetBoolProperty(const _Name: string; _Value: Boolean): Boolean; overload; + class function SetBoolProperty(_Instance: TObject; const _Name: string; _Value: Boolean): Boolean; overload; + + ///<summary> + /// Access a float property + /// @param Name is the name of the property + /// @param Value is the value of the property, only valid if Result is true + /// @returns true, if the property exists and is a float property + /// false if it either doesn't exist or has a different type </summary> +{$IFDEF SUPPORTS_EXTENDED} + function TryGetFloatProperty(const _Name: string; out _Value: Extended): Boolean; overload; +{$ENDIF} + function TryGetFloatProperty(const _Name: string; out _Value: Double): Boolean; overload; + function TryGetFloatProperty(const _Name: string; out _Value: Single): Boolean; overload; +{$IFDEF SUPPORTS_EXTENDED} + function GetFloatProperty(const _Name: string; const _Default: Extended): Extended; overload; + function GetFloatProperty(const _Name: string): Extended; overload; +{$ELSE} + function GetFloatProperty(const _Name: string; const _Default: Double): Double; overload; + function GetFloatProperty(const _Name: string): Double; overload; +{$ENDIF} + + ///<summary> + /// Access an integer property + /// @param Name is the name of the property + /// @param Value is the value of the property, only valid if Result is true + /// @returns true, if the property exists and is an integer property + /// false if it either doesn't exist or has a different type </summary> + function TryGetIntProperty(const _Name: string; out _Value: Integer): Boolean; overload; + class function TryGetIntProperty(_Instance: TObject; const _Name: string; out _Value: Integer): Boolean; overload; + function GetIntProperty(const _Name: string): Integer; overload; + class function GetIntProperty(_Instance: TObject; const _Name: string): Integer; overload; + function SetIntProperty(const _Name: string; _Value: Integer): Boolean; overload; + class function SetIntProperty(_Instance: TObject; const _Name: string; _Value: Integer): Boolean; overload; + + ///<summary> + /// Access an enum property + /// @param Name is the name of the property + /// @param Value is the value of the property, only valid if Result is true + /// Note: The value must be type cast to the appropriate enum type + /// @returns true, if the property exists and is an enum property + /// false if it either doesn't exist or has a different type </summary> + function TryGetEnumProperty(const _Name: string; out _Value: Integer): Boolean; overload; + class function TryGetEnumProperty(_Instance: TObject; const _Name: string; out _Value: Integer): Boolean; overload; + function GetEnumProperty(const _Name: string): Integer; overload; + class function GetEnumProperty(_Instance: TObject; const _Name: string): Integer; overload; + function SetEnumProperty(const _Name: string; _Value: Integer): Boolean; overload; + class function SetEnumProperty(_Instance: TObject; const _Name: string; _Value: Integer): Boolean; overload; + + ///<summary> + /// Access an object reference property + /// @param Name is the name of the property + /// @param Value is the value of the property, only valid if Result is true + /// @returns true, if the property exists and is an object reference property + /// false if it either doesn't exist or has a different type </summary> + function TryGetObjectProperty(const _Name: string; out _Value: TObject): Boolean; overload; + class function TryGetObjectProperty(_Instance: TObject; const _Name: string; out _Value: TObject): Boolean; overload; + function GetObjectProperty(const _Name: string; _Default: TObject): TObject; overload; + class function GetObjectProperty(_Instance: TObject; const _Name: string; _Default: TObject): TObject; overload; + function GetObjectProperty(const _Name: string): TObject; overload; + class function GetObjectProperty(_Instance: TObject; const _Name: string): TObject; overload; + + ///<summary> + /// Access an event property + /// @param Name is the name of the property + /// @param Value is the value of the property, only valid if Result is true + /// @returns true, if the property exists and is an event property + /// false if it either doesn't exist or has a different type </summary> + function TryGetEventProperty(const _Name: string; out _Value: TMethod): Boolean; + function GetEventProperty(const _Name: string; _Default: TMethod): TMethod; overload; + function GetEventProperty(const _Name: string): TMethod; overload; + + ///<summary> + /// Sets an event property, returns true on success </summary> + function SetEventProperty(const _Name: string; _Value: TMethod): Boolean; overload; + class function SetEventProperty(_Instance: TObject; const _Name: string; _Value: TMethod): Boolean; overload; + + function GetProperties: TStringArray; + + function TryGetEnumValues(const _Name: string; _sl: TStrings): Boolean; overload; + class function TryGetEnumValues(_Instance: TObject; const _Name: string; _sl: TStrings): Boolean; overload; + procedure GetEnumValues(const _Name: string; _sl: TStrings); overload; + class procedure GetEnumValues(_Instance: TObject; const _Name: string; _sl: TStrings); overload; + end; +{$M-} +{$ENDIF DELPHI2007_UP} + +implementation + +{$IFDEF DELPHI2007_UP} + +uses + u_dzTypInfo; + +{ TAdvancedObject } + +function TAdvancedObject.GetEventProperty(const _Name: string; _Default: TMethod): TMethod; +begin + Result := u_dzTypInfo.GetEventProperty(Self, _Name, _Default); +end; + +class procedure TAdvancedObject.CheckHasEnumProperty(_Instance: TObject; const _Name: string); +begin + if not HasEnumProperty(_Instance, _Name) then + raise EPropertyNotFound.CreateFmt(dzlibGetText('Class "%s" has no published %s property "%s".'), + [_Instance.ClassName, 'Enum', _Name]); +end; + +class procedure TAdvancedObject.CheckHasIntProperty(_Instance: TObject; const _Name: string); +begin + if not HasIntProperty(_Instance, _Name) then + raise EPropertyNotFound.CreateFmt(dzlibGetText('Class "%s" has no published %s property "%s".'), + [_Instance.ClassName, 'Integer', _Name]); +end; + +function TAdvancedObject.GetBoolProperty(const _Name: string): Boolean; +begin + Result := GetBoolProperty(Self, _Name); +end; + +class function TAdvancedObject.GetBoolProperty(_Instance: TObject; const _Name: string): Boolean; +begin + if not TryGetBoolProperty(_Instance, _Name, Result) then + raise EPropertyNotFound.CreateFmt(dzlibGetText('Class "%s" has no published %s property "%s".'), + [_Instance.ClassName, 'Enum', _Name]); +end; + +class function TAdvancedObject.GetEnumProperty(_Instance: TObject; const _Name: string): Integer; +begin + if not TryGetEnumProperty(_Instance, _Name, Result) then + raise EPropertyNotFound.CreateFmt(dzlibGetText('Class "%s" has no published %s property "%s".'), + [_Instance.ClassName, 'Enum', _Name]); +end; + +function TAdvancedObject.GetEnumProperty(const _Name: string): Integer; +begin + Result := GetEnumProperty(Self, _Name); +end; + +function TAdvancedObject.GetEventProperty(const _Name: string): TMethod; +begin + Result := u_dzTypInfo.GetEventProperty(Self, _Name); +end; + +function TAdvancedObject.SetEventProperty(const _Name: string; _Value: TMethod): Boolean; +begin + Result := SetEventProperty(Self, _Name, _Value); +end; + +class function TAdvancedObject.SetBoolProperty(_Instance: TObject; const _Name: string; + _Value: Boolean): Boolean; +var + PropInfo: PPropInfo; + Value: NativeInt; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind = tkEnumeration); + if Result then begin + Value := NativeInt(_Value); + TypInfo.SetOrdProp(_Instance, PropInfo, Value); + end; +end; + +function TAdvancedObject.SetBoolProperty(const _Name: string; _Value: Boolean): Boolean; +begin + Result := SetBoolProperty(Self, _Name, _Value); +end; + +class function TAdvancedObject.SetEnumProperty(_Instance: TObject; const _Name: string; + _Value: Integer): Boolean; +var + PropInfo: PPropInfo; + Value: NativeInt; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind = tkEnumeration); + if Result then begin + Value := NativeInt(_Value); + TypInfo.SetOrdProp(_Instance, PropInfo, Value); + end; +end; + +function TAdvancedObject.SetEnumProperty(const _Name: string; _Value: Integer): Boolean; +begin + Result := SetEnumProperty(Self, _Name, _Value); +end; + +class function TAdvancedObject.SetEventProperty(_Instance: TObject; const _Name: string; + _Value: TMethod): Boolean; +var + PropInfo: PPropInfo; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind = tkMethod); + if Result then + TypInfo.SetMethodProp(_Instance, PropInfo, _Value); +end; + +function TAdvancedObject.SetIntProperty(const _Name: string; _Value: Integer): Boolean; +begin + Result := SetIntProperty(Self, _Name, _Value); +end; + +class function TAdvancedObject.SetIntProperty(_Instance: TObject; const _Name: string; + _Value: Integer): Boolean; +var + PropInfo: PPropInfo; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind = tkInteger); + if Result then + TypInfo.SetOrdProp(_Instance, PropInfo, _Value); +end; + +{$IFDEF SUPPORTS_EXTENDED} +function TAdvancedObject.GetFloatProperty(const _Name: string; const _Default: Extended): Extended; +begin + Result := u_dzTypInfo.GetFloatProperty(Self, _Name, _Default); +end; + +function TAdvancedObject.GetFloatProperty(const _Name: string): Extended; +begin + Result := u_dzTypInfo.GetFloatProperty(Self, _Name); +end; +{$ELSE} +function TAdvancedObject.GetFloatProperty(const _Name: string; const _Default: Double): Double; overload; +begin + Result := u_dzTypInfo.GetFloatProperty(Self, _Name, _Default); +end; + +function TAdvancedObject.GetFloatProperty(const _Name: string): Double; overload; +begin + Result := u_dzTypInfo.GetFloatProperty(Self, _Name); +end; +{$ENDIF} + +function TAdvancedObject.GetIntProperty(const _Name: string): Integer; +begin + Result := GetIntProperty(Self, _Name); +end; + +class function TAdvancedObject.GetIntProperty(_Instance: TObject; const _Name: string): Integer; +begin + if not TryGetIntProperty(_Instance, _Name, Result) then + raise EPropertyNotFound.CreateFmt(dzlibGetText('Class "%s" has no published %s property "%s".'), + [_Instance.ClassName, 'Integer', _Name]); +end; + +class function TAdvancedObject.GetObjectProperty(_Instance: TObject; const _Name: string; + _Default: TObject): TObject; +begin + Result := u_dzTypInfo.GetObjectProperty(_Instance, _Name, _Default); +end; + +function TAdvancedObject.GetObjectProperty(const _Name: string; _Default: TObject): TObject; +begin + Result := GetObjectProperty(Self, _Name, _Default); +end; + +class function TAdvancedObject.GetObjectProperty(_Instance: TObject; const _Name: string): TObject; +begin + Result := u_dzTypInfo.GetObjectProperty(_Instance, _Name); +end; + +function TAdvancedObject.GetObjectProperty(const _Name: string): TObject; +begin + Result := GetObjectProperty(Self, _Name); +end; + +function TAdvancedObject.GetStringProperty(const _Name, _Default: string): string; +begin + Result := u_dzTypInfo.GetStringProperty(Self, _Name, _Default); +end; + +class function TAdvancedObject.GetStringProperty(_Instance: TObject; const _Name, _Default: string): string; +begin + if not TryGetStringProperty(_Instance, _Name, Result) then + Result := _Default; +end; + +class function TAdvancedObject.GetStringProperty(_Instance: TObject; const _Name: string): string; +begin + if not TryGetStringProperty(_Instance, _Name, Result) then + raise EPropertyNotFound.CreateFmt(dzlibGetText('Class "%s" has no published %s property "%s".'), + [_Instance.ClassName, 'String', _Name]); +end; + +function TAdvancedObject.GetStringProperty(const _Name: string): string; +begin + Result := u_dzTypInfo.GetStringProperty(Self, _Name); +end; + +function TAdvancedObject.HasEventProperty(const _Name: string): Boolean; +begin + Result := HasEventProperty(Self, _Name); +end; + +function TAdvancedObject.HasEnumProperty(const _Name: string): Boolean; +begin + Result := HasEnumProperty(Self, _Name); +end; + +class function TAdvancedObject.HasEnumProperty(_Instance: TObject; const _Name: string): Boolean; +var + Kind: TTypeKind; +begin + Result := HasProperty(_Instance, _Name, Kind) and (Kind = tkEnumeration); +end; + +class function TAdvancedObject.HasEventProperty(_Instance: TObject; const _Name: string): Boolean; +var + Kind: TTypeKind; +begin + Result := HasProperty(_Instance, _Name, Kind) and (Kind = tkMethod); +end; + +class function TAdvancedObject.HasFloatProperty(_Instance: TObject; const _Name: string): Boolean; +var + Kind: TTypeKind; +begin + Result := HasProperty(_Instance, _Name, Kind) and (Kind in FLOAT_PROPERTY_TYPES); +end; + +function TAdvancedObject.HasFloatProperty(const _Name: string): Boolean; +begin + Result := HasFloatProperty(Self, _Name); +end; + +class function TAdvancedObject.HasIntProperty(_Instance: TObject; const _Name: string): Boolean; +var + Kind: TTypeKind; +begin + Result := HasProperty(_Instance, _Name, Kind) and (Kind = tkInteger); +end; + +function TAdvancedObject.HasIntProperty(const _Name: string): Boolean; +begin + Result := HasIntProperty(Self, _Name); +end; + +class function TAdvancedObject.HasObjectProperty(_Instance: TObject; const _Name: string): Boolean; +var + Kind: TTypeKind; +begin + Result := HasProperty(_Instance, _Name, Kind) and (Kind = tkClass); +end; + +function TAdvancedObject.HasObjectProperty(const _Name: string): Boolean; +begin + Result := HasObjectProperty(Self, _Name); +end; + +class function TAdvancedObject.HasProperty(_Instance: TObject; const _Name: string; + out _Type: TTypeKind): Boolean; +var + PropInfo: PPropInfo; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo); + if Result then + _Type := PropInfo.PropType^.Kind; +end; + +function TAdvancedObject.HasProperty(const _Name: string; out _Type: TTypeKind): Boolean; +begin + Result := HasProperty(Self, _Name, _Type); +end; + +class function TAdvancedObject.HasStringProperty(_Instance: TObject; const _Name: string): Boolean; +var + Kind: TTypeKind; +begin + Result := HasProperty(_Instance, _Name, Kind) and (Kind in STRING_PROPERTY_TYPES); +end; + +function TAdvancedObject.HasStringProperty(const _Name: string): Boolean; +begin + Result := HasStringProperty(_Name); +end; + +class function TAdvancedObject.SetStringProperty(_Instance: TObject; const _Name, _Value: string): Boolean; +var + PropInfo: PPropInfo; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind in STRING_PROPERTY_TYPES); + if Result then + TypInfo.SetStrProp(_Instance, PropInfo, _Value); +end; + +function TAdvancedObject.SetStringProperty(const _Name, _Value: string): Boolean; +begin + Result := SetStringProperty(Self, _Name, _Value); +end; + +class function TAdvancedObject.TryGetBoolProperty(_Instance: TObject; const _Name: string; + out _Value: Boolean): Boolean; +var + PropInfo: PPropInfo; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind = tkEnumeration); + if Result then + _Value := GetOrdProp(_Instance, PropInfo) <> 0; +end; + +function TAdvancedObject.TryGetBoolProperty(const _Name: string; out _Value: Boolean): Boolean; +begin + Result := TryGetBoolProperty(Self, _Name, _Value); +end; + +class function TAdvancedObject.TryGetEnumProperty(_Instance: TObject; const _Name: string; + out _Value: Integer): Boolean; +var + PropInfo: PPropInfo; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind = tkEnumeration); + if Result then + _Value := GetOrdProp(_Instance, PropInfo); +end; + +function TAdvancedObject.TryGetEnumProperty(const _Name: string; out _Value: Integer): Boolean; +begin + Result := TryGetEnumProperty(Self, _Name, _Value); +end; + +function TAdvancedObject.TryGetEventProperty(const _Name: string; out _Value: TMethod): Boolean; +begin + Result := u_dzTypInfo.TryGetEventProperty(Self, _Name, _Value); +end; + +{$IFDEF SUPPORTS_EXTENDED} +function TAdvancedObject.TryGetFloatProperty(const _Name: string; out _Value: Extended): Boolean; +begin + Result := u_dzTypInfo.TryGetFloatProperty(Self, _Name, _Value); +end; +{$ENDIF} + +function TAdvancedObject.TryGetFloatProperty(const _Name: string; out _Value: Double): Boolean; +begin + Result := u_dzTypInfo.TryGetFloatProperty(Self, _Name, _Value); +end; + +function TAdvancedObject.TryGetFloatProperty(const _Name: string; out _Value: Single): Boolean; +begin + Result := u_dzTypInfo.TryGetFloatProperty(Self, _Name, _Value); +end; + +class function TAdvancedObject.TryGetIntProperty(_Instance: TObject; const _Name: string; + out _Value: Integer): Boolean; +var + PropInfo: PPropInfo; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind = tkInteger); + if Result then + _Value := GetOrdProp(_Instance, PropInfo); +end; + +function TAdvancedObject.TryGetIntProperty(const _Name: string; out _Value: Integer): Boolean; +begin + Result := TryGetIntProperty(Self, _Name, _Value); +end; + +class function TAdvancedObject.TryGetObjectProperty(_Instance: TObject; const _Name: string; + out _Value: TObject): Boolean; +begin + Result := u_dzTypInfo.TryGetObjectProperty(_Instance, _Name, _Value); +end; + +function TAdvancedObject.TryGetObjectProperty(const _Name: string; out _Value: TObject): Boolean; +begin + Result := TryGetObjectProperty(Self, _Name, _Value); +end; + +class function TAdvancedObject.TryGetStringProperty(_Instance: TObject; const _Name: string; + out _Value: string): Boolean; +begin + Result := u_dzTypInfo.TryGetStringProperty(_Instance, _Name, _Value); +end; + +function TAdvancedObject.TryGetStringProperty(const _Name: string; out _Value: string): Boolean; +begin + Result := TryGetStringProperty(Self, _Name, _Value); +end; + +function TAdvancedObject.GetProperties: TStringArray; +var + Props: PPropList; + cnt: Integer; + i: Integer; + PropInfo: PPropInfo; +begin + cnt := GetPropList(Self, Props); + try + SetLength(Result, cnt); + for i := 0 to cnt - 1 do begin + PropInfo := Props^[i]; + Result[i] := String(PropInfo.Name); + end; + finally + FreeMem(Props); + end; +end; + +class function TAdvancedObject.TryGetEnumValues(_Instance: TObject; const _Name: string; + _sl: TStrings): Boolean; +begin + Result := u_dzTypInfo.TryGetEnumValues(_Instance, _Name, _sl); +end; + +function TAdvancedObject.TryGetEnumValues(const _Name: string; _sl: TStrings): Boolean; +begin + Result := TryGetEnumValues(Self, _Name, _sl); +end; + +class procedure TAdvancedObject.GetEnumValues(_Instance: TObject; const _Name: string; + _sl: TStrings); +begin + u_dzTypInfo.GetEnumValues(_Instance, _Name, _sl); +end; + +procedure TAdvancedObject.GetEnumValues(const _Name: string; _sl: TStrings); +begin + GetEnumValues(Self, _Name, _sl); +end; + +{$ENDIF DELPHI2007_UP} + +end. + Modified: trunk/ExternalSource/dzlib/u_dzClassUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzClassUtils.pas 2021-09-30 15:34:25 UTC (rev 3635) +++ trunk/ExternalSource/dzlib/u_dzClassUtils.pas 2021-10-01 15:53:08 UTC (rev 3636) @@ -58,7 +58,7 @@ ///<summary> /// Creates a TStringList from the given array of string. /// @NOTE: This function is deprecated, se the overload with a SortHandling parameter </summary> -function TStringList_CreateFrom(const _sa: array of string; _Sorted: Boolean = False): TStringList; overload; deprecated; +function TStringList_CreateFrom(const _sa: array of string; _Sorted: Boolean): TStringList; overload; deprecated; ///<summary> /// Creates a TStringList from the given array of string. </summary> function TStringList_CreateFrom(const _sa: array of string; @@ -435,6 +435,15 @@ /// <summary> /// Reads the given section from the given .INI file and returns all its keys as a TStrings /// (This is short for opening the file, calling Ini.ReadSection and closing it.) +/// @returns false, if the section does not exist. </summary> +function TIniFile_TryReadSectionKeys(const _Filename, _Section: string; _sl: TStrings): Boolean; +{$IFDEF SUPPORTS_INLINE} +inline; +{$ENDIF} + +/// <summary> +/// Reads the given section from the given .INI file and returns all its keys as a TStrings +/// (This is short for opening the file, calling Ini.ReadSection and closing it.) /// @raises Exception if the section does not exist. </summary> procedure TIniFile_ReadSectionKeys(const _Filename, _Section: string; _sl: TStrings); {$IFDEF SUPPORTS_INLINE} @@ -1625,24 +1634,32 @@ end; end; -procedure TIniFile_ReadSectionKeys(const _Filename, _Section: string; _sl: TStrings); +function TIniFile_TryReadSectionKeys(const _Filename, _Section: string; _sl: TStrings): Boolean; var Ini: TMemIniFile; - ErrStr: string; begin Ini := TMemIniFile.Create(_Filename); try - if not Ini.SectionExists(_Section) then begin - ErrStr := Format(_('Section "%s" does not exist in ini file'), [_Section]) - + ' ' + _Filename; - raise Exception.Create(ErrStr); + Result := Ini.SectionExists(_Section); + if Result then begin + Ini.ReadSection(_Section, _sl); end; - Ini.ReadSection(_Section, _sl); finally FreeAndNil(Ini); end; end; +procedure TIniFile_ReadSectionKeys(const _Filename, _Section: string; _sl: TStrings); +var + ErrStr: string; +begin + if not TIniFile_TryReadSectionKeys(_Filename, _Section, _sl) then begin + ErrStr := Format(_('Section "%s" does not exist in ini file'), [_Section]) + + ' ' + _Filename; + raise Exception.Create(ErrStr); + end; +end; + function TIniFile_TryReadSectionValues(const _Filename, _Section: string; _sl: TStrings): Boolean; var Ini: TMemIniFile; @@ -1690,10 +1707,10 @@ end; end else begin for i := _Sections.Count - 1 downto 0 do begin - s := _Sections[i]; + s := _Sections[i]; if not SameText(Copy(s, 1, Len), _Section) or (Copy(s, Len + 1, 1) <> '\') then _Sections.Delete(i) - else begin + else begin s := TailStr(s, Len + 2); if (s = '') or (Pos('\', s) > 0) then _Sections.Delete(i) @@ -2239,7 +2256,7 @@ end; end; -function TStringList_CreateFrom(const _sa: array of string; _Sorted: Boolean = False): TStringList; +function TStringList_CreateFrom(const _sa: array of string; _Sorted: Boolean): TStringList; var SortHandling: TStringListSortHandling; begin Added: trunk/ExternalSource/dzlib/u_dzDpiScaleUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzDpiScaleUtils.pas (rev 0) +++ trunk/ExternalSource/dzlib/u_dzDpiScaleUtils.pas 2021-10-01 15:53:08 UTC (rev 3636) @@ -0,0 +1,245 @@ +unit u_dzDpiScaleUtils; + +interface + +uses + Windows, + SysUtils, + Classes, + Graphics, + Forms, + Controls, + Types; + +type + TDpiScaler = record + private + FDesignDpi: Integer; + FCurrentDpi: Integer; + public + procedure Init(_frm: TCustomForm); overload; inline; + procedure Init(_Dpi: Integer); overload; inline; + procedure Init(_DesignDpi, _CurrentDpi: Integer); overload; inline; + procedure SetCurrentDpi(_frm: TCustomForm); overload; inline; + procedure SetCurrentDpi(_Dpi: Integer); overload; inline; + function Calc(_Value: Integer): Integer; overload; inline; + function Calc(const _Value: TRect): TRect; overload; inline; + end; + +type + TCtrlDpiScaler = record + Ctrl: TControl; + BoundsRect: TRect; + FontSize: Integer; + procedure Assign(_ctrl: TControl); + procedure ApplyScale(const _Scaler: TDpiScaler); + procedure ResizeFont(const _Scaler: TDpiScaler); + end; + + TFormDpiScaler = class + private + DesignDPI: Integer; + Width, Height: Integer; + FontSize: Integer; + FFrm: TForm; + CtrlParams: array of TCtrlDpiScaler; + procedure AddControls(_ctrl: TWinControl); + public + constructor Create(_frm: TForm); + procedure ApplyScale(const _Scaler: TDpiScaler); + procedure ApplyDpi(_NewDpi: Integer; _NewBounds: PRect); + end; + +implementation + +uses + u_dzAdvancedObject, + u_dzVclUtils; + +{ TDpiScaler } + +function TDpiScaler.Calc(_Value: Integer): Integer; +begin + Result := MulDiv(_Value, FCurrentDpi, FDesignDpi); +end; + +function TDpiScaler.Calc(const _Value: TRect): TRect; +begin + Result.Left := Calc(_Value.Left); + Result.Top := Calc(_Value.Top); + Result.Right := Calc(_Value.Right); + Result.Bottom := Calc(_Value.Bottom); +end; + +procedure TDpiScaler.Init(_Dpi: Integer); +begin + FDesignDpi := _Dpi; + FCurrentDpi := _Dpi; +end; + +procedure TDpiScaler.Init(_DesignDpi, _CurrentDpi: Integer); +begin + FDesignDpi := _DesignDpi; + FCurrentDpi := _CurrentDpi; +end; + +procedure TDpiScaler.Init(_frm: TCustomForm); +begin + if not Assigned(_frm) then begin + FDesignDpi := 96; + FCurrentDpi := 96; + end else begin +// todo: adjust as needed +{$IFDEF DELPHIX_TOKYO_UP} + FDesignDpi := TForm_GetDesignDPI(TForm(_frm)); + FCurrentDpi := TScreen_GetDpiForForm(_frm); +{$ELSE ~DELPHIX_TOKYO_UP} + FDesignDpi := TForm(_frm).PixelsPerInch; + FCurrentDpi := TForm(_frm).PixelsPerInch; +{$ENDIF DELPHIX_TOKYO_UP} + end; +end; + +procedure TDpiScaler.SetCurrentDpi(_Dpi: Integer); +begin + FCurrentDpi := _Dpi; +end; + +procedure TDpiScaler.SetCurrentDpi(_frm: TCustomForm); +begin + if not Assigned(_frm) then begin + FCurrentDpi := 96; + end else begin +// todo: adjust as needed +{$IFDEF DELPHIX_TOKYO_UP} + FCurrentDpi := TScreen_GetDpiForForm(_frm) +{$ELSE ~DELPHIX_TOKYO_UP} + FCurrentDpi := TForm(_frm).PixelsPerInch; +{$ENDIF DELPHIX_TOKYO_UP} + end; +end; + +{ TCtrlDpiScaler } + +function GetFontSize(_fnt: TFont): Integer; +begin +// Result := _fnt.Size; + Result := _fnt.Height; +end; + +procedure SetFontSize(_fnt: TFont; _Size: Integer); +begin +// _fnt.Size := _Size; + _fnt.Height := _Size; +end; + +procedure TCtrlDpiScaler.ApplyScale(const _Scaler: TDpiScaler); +var + br: TRect; +begin + br := _Scaler.Calc(BoundsRect); + Ctrl.BoundsRect := br; + ResizeFont(_Scaler); +end; + +procedure TCtrlDpiScaler.Assign(_ctrl: TControl); +var + fnt: TFont; +begin + Ctrl := _ctrl; + BoundsRect := Ctrl.BoundsRect; + if not TAdvancedObject.TryGetObjectProperty(_ctrl, 'Font', TObject(fnt)) then begin + FontSize := 0; + end else begin + FontSize := GetFontSize(fnt); + end; +end; + +procedure TCtrlDpiScaler.ResizeFont(const _Scaler: TDpiScaler); +var + fnt: TFont; + ParentFontValue: Boolean; +begin + if TAdvancedObject.TryGetObjectProperty(Ctrl, 'Font', TObject(fnt)) then begin + if not TAdvancedObject.TryGetBoolProperty(Ctrl, 'ParentFont', ParentFontValue) + or not ParentFontValue then begin + Assert(FontSize <> 0); + SetFontSize(fnt, _Scaler.Calc(FontSize)); + end; + end; +end; + +{ TFormDpiScaler } + +procedure TFormDpiScaler.AddControls(_ctrl: TWinControl); +var + Offset: Integer; + i: Integer; + cnt: Integer; + Ctrl: TControl; +begin + cnt := _ctrl.ControlCount; + Offset := Length(CtrlParams); + SetLength(CtrlParams, Offset + cnt); + for i := 0 to cnt - 1 do begin + Ctrl := _ctrl.Controls[i]; + CtrlParams[Offset + i].Assign(Ctrl); + if Ctrl is TWinControl then + AddControls(TWinControl(Ctrl)); + end; +end; + +procedure TFormDpiScaler.ApplyDpi(_NewDpi: Integer; _NewBounds: PRect); +var + Scaler: TDpiScaler; + br: TRect; + RedrawLock: IInterface; +begin + if not Assigned(FFrm) then + Exit; //==> + + RedrawLock := TWinControl_Lock(FFrm); + try + Scaler.Init(DesignDPI, _NewDpi); + if Assigned(_NewBounds) then begin + FFrm.BoundsRect := _NewBounds^; + end else begin + br := FFrm.BoundsRect; + br.Width := Scaler.Calc(br.Width); + br.Height := Scaler.Calc(br.Height); + FFrm.BoundsRect := br; + end; + ApplyScale(Scaler); + finally + RedrawLock := nil; + end; +end; + +procedure TFormDpiScaler.ApplyScale(const _Scaler: TDpiScaler); +var + cnt: Integer; + i: Integer; +begin + SetFontSize(FFrm.Font, _Scaler.Calc(FontSize)); + cnt := Length(CtrlParams); + for i := 0 to cnt - 1 do begin + CtrlParams[i].ApplyScale(_Scaler); + end; +end; + +constructor TFormDpiScaler.Create(_frm: TForm); +var + Scaler: TDpiScaler; +begin + inherited Create; + FFrm := _frm; + Width := _frm.ClientWidth; + Height := _frm.ClientHeight; + FontSize := GetFontSize(_frm.Font); + DesignDPI := TForm_GetDesignDPI(_frm); + Scaler.Init(_frm.Font.PixelsPerInch, DesignDPI); + FontSize := Scaler.Calc(FontSize); + AddControls(FFrm); +end; + +end. Modified: trunk/ExternalSource/dzlib/u_dzOsUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzOsUtils.pas 2021-09-30 15:34:25 UTC (rev 3635) +++ trunk/ExternalSource/dzlib/u_dzOsUtils.pas 2021-10-01 15:53:08 UTC (rev 3636) @@ -16,6 +16,7 @@ EOsFunc = class(EdzException); EOFNoFileinfo = class(EOsFunc); EPowerRequestFailed = class(EOsFunc) + public ErrorCode: Word; end; Added: trunk/ExternalSource/dzlib/u_dzTypInfo.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzTypInfo.pas (rev 0) +++ trunk/ExternalSource/dzlib/u_dzTypInfo.pas 2021-10-01 15:53:08 UTC (rev 3636) @@ -0,0 +1,320 @@ +unit u_dzTypInfo; + +{$INCLUDE 'dzlib.inc'} + +interface + +{$IFNDEF DELPHI2007_UP} +{$IFNDEF NO_DELPHI2007UP_HINT} +{$MESSAGE HINT 'Delphi <2007 not supported'} +{$ENDIF} +{$ELSE} + +uses + SysUtils, + Classes, + TypInfo, + u_dzTranslator; + + // I am not going to proved support for Variant properties here. I hate Variants. + +const + ///<summary> property types that can be converted to string </summary> + STRING_PROPERTY_TYPES = [ +{$IFDEF FPC} + tkAString, + tkUString, +{$ENDIF} +{$IFDEF SUPPORTS_UNICODE} + tkUString, +{$ENDIF SUPPORTS_UNICODE} + tkChar, tkString, tkWChar, tkLString, tkWString]; + ///<summary> property types that can be converted to float </summary> + FLOAT_PROPERTY_TYPES = [tkInteger, tkFloat]; + +const + NilMethod: TMethod = (Code: nil; Data: nil); + +function TryGetStringProperty(_Instance: TObject; const _Name: string; out _Value: string): Boolean; +function GetStringProperty(_Instance: TObject; const _Name: string; const _Default: string): string; overload; +function GetStringProperty(_Instance: TObject; const _Name: string): string; overload; + +{$IFDEF SUPPORTS_EXTENDED} +function TryGetFloatProperty(_Instance: TObject; const _Name: string; out _Value: Extended): Boolean; overload; +{$ENDIF} +function TryGetFloatProperty(_Instance: TObject; const _Name: string; out _Value: Double): Boolean; overload; +function TryGetFloatProperty(_Instance: TObject; const _Name: string; out _Value: Single): Boolean; overload; + +function TryGetIntProperty(_Instance: TObject; const _Name: string; out _Value: Integer): Boolean; +function TrySetIntProperty(_Instance: TObject; const _Name: string; _Value: Integer): Boolean; +function TryGetBoolProperty(_Instance: TObject; const _Name: string; out _Value: Boolean): Boolean; +///<summary> +/// Reads an enum type property with type checking. +/// @param TypeInfo is the PTypeInfo for the enum, pass TypeInfo(YourEnumType) here </summary> +function TryGetEnumProperty(_Instance: TObject; const _Name: string; const _TypeInfo: PTypeInfo; + out _Value: Integer): Boolean; overload; +///<summary> +/// Reads an enum type property without type checking </summary> +function TryGetEnumProperty(_Instance: TObject; const _Name: string; + out _Value: Integer): Boolean; overload; + +{$IFDEF SUPPORTS_EXTENDED} +function GetFloatProperty(_Instance: TObject; const _Name: string; const _Default: Extended): Extended; overload; +function GetFloatProperty(_Instance: TObject; const _Name: string): Extended; overload; +{$ELSE} +function GetFloatProperty(_Instance: TObject; const _Name: string; const _Default: Double): Double; overload; +function GetFloatProperty(_Instance: TObject; const _Name: string): Double; overload; +{$ENDIF SUPPORTS_EXTENDED} + +function TryGetObjectProperty(_Instance: TObject; const _Name: string; out _Value: TObject): Boolean; +function GetObjectProperty(_Instance: TObject; const _Name: string; _Default: TObject): TObject; overload; +function GetObjectProperty(_Instance: TObject; const _Name: string): TObject; overload; + +function TryGetEventProperty(_Instance: TObject; const _Name: string; out _Value: TMethod): Boolean; +function GetEventProperty(_Instance: TObject; const _Name: string; _Default: TMethod): TMethod; overload; +function GetEventProperty(_Instance: TObject; const _Name: string): TMethod; overload; +function TrySetEventProperty(_Instance: TObject; const _Name: string; _Value: TMethod): Boolean; +procedure SetEventProperty(_Instance: TObject; const _Name: string; _Value: TMethod); + +function TryGetEnumValues(_Instance: TObject; const _Name: string; _sl: TStrings): Boolean; +procedure GetEnumValues(_Instance: TObject; const _Name: string; _sl: TStrings); + +{$ENDIF DELPHI2007_UP} + +implementation + +{$IFDEF DELPHI2007_UP} + +function _(const _s: string): string; inline; +begin + Result := dzlibGetText(_s); +end; + +function TryGetStringProperty(_Instance: TObject; const _Name: string; out _Value: string): Boolean; +var + PropInfo: PPropInfo; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind in STRING_PROPERTY_TYPES); + if Result then + _Value := GetPropValue(_Instance, PropInfo) +end; + +function GetStringProperty(_Instance: TObject; const _Name: string; const _Default: string): string; +begin + if not TryGetStringProperty(_Instance, _Name, Result) then + Result := _Default; +end; + +function GetStringProperty(_Instance: TObject; const _Name: string): string; overload; +begin + if not TryGetStringProperty(_Instance, _Name, Result) then + raise EPropertyError.CreateFmt(_('String property %s not found.'), [_Name]); +end; + +{$IFDEF SUPPORTS_EXTENDED} +function TryGetFloatProperty(_Instance: TObject; const _Name: string; out _Value: Extended): Boolean; +var + PropInfo: PPropInfo; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind in FLOAT_PROPERTY_TYPES); + if Result then + _Value := GetPropValue(_Instance, PropInfo) +end; +{$ENDIF} + +function TryGetFloatProperty(_Instance: TObject; const _Name: string; out _Value: Double): Boolean; +var + PropInfo: PPropInfo; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind in FLOAT_PROPERTY_TYPES); + if Result then + _Value := GetPropValue(_Instance, PropInfo) +end; + +function TryGetFloatProperty(_Instance: TObject; const _Name: string; out _Value: Single): Boolean; +var + PropInfo: PPropInfo; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind in FLOAT_PROPERTY_TYPES); + if Result then + _Value := GetPropValue(_Instance, PropInfo) +end; + +{$IFDEF SUPPORTS_EXTENDED} +function GetFloatProperty(_Instance: TObject; const _Name: string; const _Default: Extended): Extended; +begin + if not TryGetFloatProperty(_Instance, _Name, Result) then + Result := _Default; +end; + +function GetFloatProperty(_Instance: TObject; const _Name: string): Extended; +begin + if not TryGetFloatProperty(_Instance, _Name, Result) then + raise EPropertyError.CreateFmt(_('Float property %s not found.'), [_Name]); +end; +{$ELSE} +function GetFloatProperty(_Instance: TObject; const _Name: string; const _Default: Double): Double; +begin + if not TryGetFloatProperty(_Instance, _Name, Result) then + Result := _Default; +end; + +function GetFloatProperty(_Instance: TObject; const _Name: string): Double; +begin + if not TryGetFloatProperty(_Instance, _Name, Result) then + raise EPropertyError.CreateFmt(_('Float property %s not found.'), [_Name]); +end; +{$ENDIF} + +function TryGetIntProperty(_Instance: TObject; const _Name: string; out _Value: Integer): Boolean; +var + PropInfo: PPropInfo; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind = tkInteger); + if Result then + _Value := GetOrdProp(_Instance, PropInfo); +end; + +function TrySetIntProperty(_Instance: TObject; const _Name: string; _Value: Integer): Boolean; +var + PropInfo: PPropInfo; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind = tkInteger); + if Result then + SetOrdProp(_Instance, PropInfo, _Value); +end; + +function TryGetBoolProperty(_Instance: TObject; const _Name: string; out _Value: Boolean): Boolean; +var + PropInfo: PPropInfo; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind = tkEnumeration) + and (GetTypeData(PropInfo.PropType^)^.BaseType^ = TypeInfo(Boolean)); + if Result then + _Value := Boolean(GetOrdProp(_Instance, PropInfo)); +end; + +function TryGetEnumProperty(_Instance: TObject; const _Name: string; const _TypeInfo: PTypeInfo; + out _Value: Integer): Boolean; +var + PropInfo: PPropInfo; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind = tkEnumeration) + and (GetTypeData(PropInfo.PropType^)^.BaseType^ = _TypeInfo); + if Result then + _Value := GetOrdProp(_Instance, PropInfo); +end; + +function TryGetEnumProperty(_Instance: TObject; const _Name: string; out _Value: Integer): Boolean; +var + PropInfo: PPropInfo; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind = tkEnumeration); + if Result then + _Value := GetOrdProp(_Instance, PropInfo); +end; + +function TryGetObjectProperty(_Instance: TObject; const _Name: string; out _Value: TObject): Boolean; +var + PropInfo: PPropInfo; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind = tkClass); + if Result then + _Value := TObject(GetOrdProp(_Instance, PropInfo)); +end; + +function GetObjectProperty(_Instance: TObject; const _Name: string; _Default: TObject): TObject; +begin + if not TryGetObjectProperty(_Instance, _Name, Result) then + Result := _Default; +end; + +function GetObjectProperty(_Instance: TObject; const _Name: string): TObject; +begin + if not TryGetObjectProperty(_Instance, _Name, Result) then + raise EPropertyError.CreateFmt(_('Object property %s not found.'), [_Name]); +end; + +function TryGetEventProperty(_Instance: TObject; const _Name: string; out _Value: TMethod): Boolean; +var + PropInfo: PPropInfo; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind = tkMethod); + if Result then begin + _Value := GetMethodProp(_Instance, PropInfo); + end; +end; + +function GetEventProperty(_Instance: TObject; const _Name: string; _Default: TMethod): TMethod; +begin + if not TryGetEventProperty(_Instance, _Name, Result) then + Result := _Default; +end; + +function GetEventProperty(_Instance: TObject; const _Name: string): TMethod; +begin + if not TryGetEventProperty(_Instance, _Name, Result) then + raise EPropertyError.CreateFmt(_('Event property %s not found.'), [_Name]); +end; + +function TrySetEventProperty(_Instance: TObject; const _Name: string; _Value: TMethod): Boolean; +var + PropInfo: PPropInfo; +begin + PropInfo := GetPropInfo(_Instance.ClassInfo, _Name); + Result := Assigned(PropInfo) and (PropInfo.PropType^.Kind = tkMethod); + if Result then begin + SetMethodProp(_Instance, PropInfo, _Value); + end; +end; + +procedure SetEventProperty(_Instance: TObject; const _Name: string; _Value: TMethod); +begin + if not TrySetEventProperty(_Instance, _Name, _Value) then + raise EPropertyError.CreateFmt(_('Event property %s not found.'), [_Name]); +end; + +function TryGetEnumValues(_Instance: TObject; const _Name: string; _sl: TStrings): Boolean; +var + T: PTypeData; + i: Integer; + PropInfo: PPropInfo; + PropType: PTypeInfo; +begin + PropInfo := GetPropInfo(_Instance, _Name); + Result := Assigned(PropInfo); + if not Result then + Exit; //==> + + PropType := PropInfo.PropType^; + Result := PropType^.Kind = tkEnumeration; + if not Result then + Exit; //==> + + _sl.Clear; + T := GetTypeData(GetTypeData(PropType).BaseType^); + for i := T.MinValue to T.MaxValue do begin + _sl.AddObject(GetEnumName(PropType, i), Pointer(i)); + end; +end; + +procedure GetEnumValues(_Instance: TObject; const _Name: string; _sl: TStrings); +begin + if not TryGetEnumValues(_Instance, _Name, _sl) then + raise EPropertyError.CreateFmt(_('Enum property %s not found.'), [_Name]); +end; + +{$ENDIF DELPHI2007_UP} + +end. Modified: trunk/ExternalSource/dzlib/u_dzVclUtils.pas =================================================================== --- trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2021-09-30 15:34:25 UTC (rev 3635) +++ trunk/ExternalSource/dzlib/u_dzVclUtils.pas 2021-10-01 15:53:08 UTC (rev 3636) @@ -86,20 +86,7 @@ end; {$IFEND} -{$IFDEF SUPPORTS_ENHANCED_RECORDS} type - TDpiScaler = record - private - FDesignDpi: Integer; - FCurrentDpi: Integer; - public - procedure Init(_frm: TCustomForm); inline; - procedure SetCurrentDpi(_frm: TCustomForm); inline; - function Calc(_Value: Integer): Integer; inline; - end; -{$ENDIF SUPPORTS_ENHANCED_RECORDS} - -type ///<summary> This is a copy of the TFileFormatsList class from Graphics which /// is unfortunately only declaread in the implementation section </summary> TFileFormatsList = class(TList) @@ -7063,46 +7050,6 @@ end; {$ENDIF} -{$IFDEF SUPPORTS_ENHANCED_RECORDS} -{ TDpiScaler } - -function TDpiScaler.Calc(_Value: Integer): Integer; -begin - Result := MulDiv(_Value, FCurrentDpi, FDesignDpi); -end; - -procedure TDpiScaler.Init(_frm: TCustomForm); -begin - if not Assigned(_frm) then begin - FDesignDpi := 96; - FCurrentDpi := 96; - end else begin -// todo: adjust as needed -{$IFDEF DELPHIX_TOKYO_UP} - FDesignDpi := TForm_GetDesignDPI(TForm(_frm)); - FCurrentDpi := TScreen_GetDpiForForm(_frm); -{$ELSE ~DELPHIX_TOKYO_UP} - FDesignDpi := TForm(_frm).PixelsPerInch; - FCurrentDpi := TForm(_frm).PixelsPerInch; -{$ENDIF DELPHIX_TOKYO_UP} - end; -end; - -procedure TDpiScaler.SetCurrentDpi(_frm: TCustomForm); -begin - if not Assigned(_frm) then begin - FCurrentDpi := 96; - end else begin -// todo: adjust as needed -{$IFDEF DELPHIX_TOKYO_UP} - FCurrentDpi := TScreen_GetDpiForForm(_frm) -{$ELSE ~DELPHIX_TOKYO_UP} - FCurrentDpi := TForm(_frm).PixelsPerInch; -{$ENDIF DELPHIX_TOKYO_UP} - end; -end; -{$ENDIF SUPPORTS_ENHANCED_RECORDS} - initialization InitializeCustomMessages; finalization This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |