How do I know if TPNGObject has a valid title?

I have the following class:

    TPNGButton = class(TNeoGraphicControl)
    private
        FImageDown: TPNGObject;
        fImageNormal: TPNGObject;
        fImageOver: TPNGObject;
    ...

    public
    ...
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
    published
        property ImageNormal: TPNGObject read fImageNormal write SetImageNormal;
        property ImageDown: TPNGObject read FImageDown write SetImageDown;
        property ImageOver: TPNGObject read FImageOver write SetImageOver;
    ...
end;

I use the function below to copy properties objFromin objToas a parameter.

procedure CopyObject(ObjFrom, ObjTo: TObject);
var
  PropInfos: PPropList;
  PropInfo: PPropInfo;
  Count, Loop: Integer;
  OrdVal: Longint;
  StrVal: String;
  FloatVal: Extended;
  MethodVal: TMethod;
begin
  { Iterate thru all published fields and properties of source }
  { copying them to target }

  { Find out how many properties we'll be considering }
  Count := GetPropList(ObjFrom.ClassInfo, tkAny, nil);
  { Allocate memory to hold their RTTI data }
  GetMem(PropInfos, Count * SizeOf(PPropInfo));
  try
    { Get hold of the property list in our new buffer }
    GetPropList(ObjFrom.ClassInfo, tkAny, PropInfos);
    { Loop through all the selected properties }
    for Loop := 0 to Count - 1 do
    begin
      PropInfo := GetPropInfo(ObjTo.ClassType, PropInfos^[Loop]^.Name);
      { Check the general type of the property }
      { and read/write it in an appropriate way }
      case PropInfos^[Loop]^.PropType^.Kind of
        tkInteger, tkChar, tkEnumeration,
        tkSet, tkClass{$ifdef Win32}, tkWChar{$endif}:
        begin
          OrdVal := GetOrdProp(ObjFrom, PropInfos^[Loop]);
          if Assigned(PropInfo) and (Assigned(PropInfo^.SetProc)) then
            SetOrdProp(ObjTo, PropInfo, OrdVal); //here happens the bug...
        end;
        tkFloat:
        begin
          FloatVal := GetFloatProp(ObjFrom, PropInfos^[Loop]);
          if Assigned(PropInfo) and (Assigned(PropInfo^.SetProc)) then
            SetFloatProp(ObjTo, PropInfo, FloatVal);
        end;
        {$ifndef DelphiLessThan3}
        tkWString,
        {$endif}
        {$ifdef Win32}
        tkLString,
        {$endif}
        tkString:
        begin
          { Avoid copying 'Name' - components must have unique names }
          if UpperCase(PropInfos^[Loop]^.Name) = 'NAME' then
            Continue;
          StrVal := GetStrProp(ObjFrom, PropInfos^[Loop]);
          if Assigned(PropInfo) and (Assigned(PropInfo^.SetProc)) then
            SetStrProp(ObjTo, PropInfo, StrVal);
        end;
        tkMethod:
        begin
          MethodVal := GetMethodProp(ObjFrom, PropInfos^[Loop]);
          if Assigned(PropInfo) and (Assigned(PropInfo^.SetProc)) then
            SetMethodProp(ObjTo, PropInfo, MethodVal);
        end
      end
    end
  finally
    FreeMem(PropInfos, Count * SizeOf(PPropInfo));
  end;
end;

But, when the PNGObject property is passed to SetOrdProp, Delphi returns the following exception: Exception

My question is: How can I find out if there is a PNGObjectvalid header before SetOrdProp? Or another way to solve this problem ...

Other comments

  • Using the method Assignas the following code and commenting on the function CopyObject:

      TControl(objCtrlZ.Referencia).Assign(Component);
      // "Component" is objFrom and objCtrlZ.Referencia is objTo
      //  CopyObject(Component, objCtrlZ.Referencia);
    

Delphi will catch the following exception:

Exception 2

+4
source share
1 answer

I solved my problem.

, TPNGObject , :

objTemp := GetObjectProp(ObjFrom,PropInfos^[Loop]);
if ((TPNGObject(objTemp).Chunks.Count <> 0) and (TPNGObject(objTemp).Chunks.Item[0] is TChunkIHDR)) then begin ... end;

TPNGObject , , objTemp AV.

, Chunks, , Item [0] TChunkIHDR, , .

!

+2

Source: https://habr.com/ru/post/1570509/


All Articles