{----------------------------------------------------------------------------- The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/MPL-1.1.html Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for the specific language governing rights and limitations under the License. The Initial Developer of the Original Code is Marcel Bestebroer . Portions created by Marcel Bestebroer are Copyright (C) 2000 - 2001 mbeSoft. All Rights Reserved. Contributor(s): Michael Beck [mbeck att bigfoot dott com]. You may retrieve the latest version of this file at the Project JEDI's JVCL home page, located at http://jvcl.sourceforge.net Description: JvInspector XVCL data layer. Provides access to TJvxNode and descendants. XVCL can be obtained from the XVCL home page, located at http://xvcl.sourceforge.net Known Issues: -----------------------------------------------------------------------------} // $Id: JvInspXVCL.pas 10612 2006-05-19 19:04:09Z jfudickar $ unit JvInspXVCL; {$I jvcl.inc} interface uses {$IFDEF UNITVERSIONING} JclUnitVersioning, {$ENDIF UNITVERSIONING} JvInspector, JvxClasses; type TJvInspectorxNodeData = class(TJvCustomInspectorData) private FJvxNode: TJvxNode; protected function GetAsFloat: Extended; override; function GetAsInt64: Int64; override; function GetAsMethod: TMethod; override; function GetAsOrdinal: Int64; override; function GetAsString: string; override; function GetJvxNode: TJvxNode; virtual; function IsEqualReference(const Ref: TJvCustomInspectorData): Boolean; override; procedure NodeNotifyEvent(Sender: TJvxNode; Operation: TJvxNodeOperation); virtual; procedure SetAsFloat(const Value: Extended); override; procedure SetAsInt64(const Value: Int64); override; procedure SetAsMethod(const Value: TMethod); override; procedure SetAsOrdinal(const Value: Int64); override; procedure SetAsString(const Value: string); override; procedure SetJvxNode(Value: TJvxNode); virtual; public procedure GetAsSet(var Buf); override; function HasValue: Boolean; override; function IsAssigned: Boolean; override; function IsInitialized: Boolean; override; class function New(const AParent: TJvCustomInspectorItem; const AName: string; const AJvxNode: TJvxNode): TJvCustomInspectorItem; procedure SetAsSet(const Buf); override; property JvxNode: TJvxNode read GetJvxNode write SetJvxNode; end; {$IFDEF UNITVERSIONING} const UnitVersioning: TUnitVersionInfo = ( RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvInspXVCL.pas $'; Revision: '$Revision: 10612 $'; Date: '$Date: 2006-05-19 21:04:09 +0200 (ven., 19 mai 2006) $'; LogPath: 'JVCL\run' ); {$ENDIF UNITVERSIONING} implementation uses {$IFDEF VCL} Consts, {$ENDIF VCL} {$IFDEF VisualCLX} QConsts, {$ENDIF VisualCLX} SysUtils, TypInfo, JvTypes, JvResources; function TJvInspectorxNodeData.GetAsFloat: Extended; begin CheckReadAccess; if JvxNode.TypeInfo^.Kind = tkFloat then Result := JvxNode.AsFloat else raise EJvInspectorData.CreateResFmt(@RsEJvInspDataNoAccessAs, [cJvInspectorFloat]); end; function TJvInspectorxNodeData.GetAsInt64: Int64; begin CheckReadAccess; raise EJvInspectorData.CreateResFmt(@RsEJvInspDataNoAccessAs, [cJvInspectorInt64]); end; function TJvInspectorxNodeData.GetAsMethod: TMethod; begin CheckReadAccess; raise EJvInspectorData.CreateResFmt(@RsEJvInspDataNoAccessAs, [cJvInspectorTMethod]); end; function TJvInspectorxNodeData.GetAsOrdinal: Int64; begin CheckReadAccess; if JvxNode.TypeInfo^.Kind in [tkInteger, tkChar, tkEnumeration, tkSet, tkWChar, tkClass] then begin if GetTypeData(JvxNode.TypeInfo).OrdType = otULong then Result := Cardinal(JvxNode.AsInteger) else Result := JvxNode.AsInteger; end else raise EJvInspectorData.CreateResFmt(@RsEJvInspDataNoAccessAs, [cJvInspectorOrdinal]); end; function TJvInspectorxNodeData.GetAsString: string; begin CheckReadAccess; if JvxNode.TypeInfo^.Kind in [tkString, tkLString, tkWString] then Result := JvxNode.AsString else raise EJvInspectorData.CreateResFmt(@RsEJvInspDataNoAccessAs, [cJvInspectorString]); end; function TJvInspectorxNodeData.GetJvxNode: TJvxNode; begin Result := FJvxNode; end; function TJvInspectorxNodeData.IsEqualReference(const Ref: TJvCustomInspectorData): Boolean; begin Result := (Ref is TJvInspectorxNodeData) and (TJvInspectorxNodeData(Ref).JvxNode = JvxNode); end; procedure TJvInspectorxNodeData.NodeNotifyEvent(Sender: TJvxNode; Operation: TJvxNodeOperation); begin if (Sender = JvxNode) and (Operation = noChange) then begin InvalidateData; Invalidate; end; end; procedure TJvInspectorxNodeData.SetAsFloat(const Value: Extended); begin CheckWriteAccess; if JvxNode.TypeInfo^.Kind = tkFloat then JvxNode.AsFloat := Value else raise EJvInspectorData.CreateResFmt(@RsEJvInspDataNoAccessAs, [cJvInspectorFloat]); end; procedure TJvInspectorxNodeData.SetAsInt64(const Value: Int64); begin CheckWriteAccess; raise EJvInspectorData.CreateResFmt(@RsEJvInspDataNoAccessAs, [cJvInspectorInt64]); end; procedure TJvInspectorxNodeData.SetAsMethod(const Value: TMethod); begin CheckWriteAccess; raise EJvInspectorData.CreateResFmt(@RsEJvInspDataNoAccessAs, [cJvInspectorTMethod]); end; procedure TJvInspectorxNodeData.SetAsOrdinal(const Value: Int64); var MinValue: Int64; MaxValue: Int64; begin CheckWriteAccess; if TypeInfo.Kind in [tkInteger, tkChar, tkEnumeration, tkWChar] then begin case GetTypeData(TypeInfo).OrdType of otSByte: begin MinValue := GetTypeData(TypeInfo).MinValue; MaxValue := GetTypeData(TypeInfo).MaxValue; if (Value < MinValue) or (Value > MaxValue) then raise ERangeError.CreateResFmt(@SOutOfRange, [MinValue, MaxValue]); JvxNode.AsInteger := Shortint(Value) end; otUByte: begin MinValue := GetTypeData(TypeInfo).MinValue; MaxValue := GetTypeData(TypeInfo).MaxValue; if (Value < MinValue) or (Value > MaxValue) then raise ERangeError.CreateResFmt(@SOutOfRange, [MinValue, MaxValue]); JvxNode.AsInteger := Byte(Value) end; otSWord: begin MinValue := GetTypeData(TypeInfo).MinValue; MaxValue := GetTypeData(TypeInfo).MaxValue; if (Value < MinValue) or (Value > MaxValue) then raise ERangeError.CreateResFmt(@SOutOfRange, [MinValue, MaxValue]); JvxNode.AsInteger := Smallint(Value) end; otUWord: begin MinValue := GetTypeData(TypeInfo).MinValue; MaxValue := GetTypeData(TypeInfo).MaxValue; if (Value < MinValue) or (Value > MaxValue) then raise ERangeError.CreateResFmt(@SOutOfRange, [MinValue, MaxValue]); JvxNode.AsInteger := Word(Value) end; otSLong: begin MinValue := GetTypeData(TypeInfo).MinValue; MaxValue := GetTypeData(TypeInfo).MaxValue; if (Value < MinValue) or (Value > MaxValue) then raise ERangeError.CreateResFmt(@SOutOfRange, [MinValue, MaxValue]); JvxNode.AsInteger := Integer(Value) end; otULong: begin MinValue := Longword(GetTypeData(TypeInfo).MinValue); MaxValue := Longword(GetTypeData(TypeInfo).MaxValue); if (Value < MinValue) or (Value > MaxValue) then raise ERangeError.CreateResFmt(@SOutOfRange, [MinValue, MaxValue]); JvxNode.AsInteger := Integer(Value) end; end; end else if TypeInfo.Kind = tkClass then JvxNode.AsInteger := Integer(Value) else raise EJvInspectorData.CreateResFmt(@RsEJvInspDataNoAccessAs, [cJvInspectorOrdinal]); end; procedure TJvInspectorxNodeData.SetAsString(const Value: string); begin CheckWriteAccess; if JvxNode.TypeInfo.Kind in [tkString, tkLString, tkWString] then JvxNode.AsString := Value else raise EJvInspectorData.CreateResFmt(@RsEJvInspDataNoAccessAs, [cJvInspectorString]); end; procedure TJvInspectorxNodeData.SetJvxNode(Value: TJvxNode); begin if Value <> JvxNode then begin if JvxNode <> nil then JvxNode.OnNotifyEvents.Remove(NodeNotifyEvent); FJvxNode := Value; if JvxNode <> nil then begin JvxNode.OnNotifyEvents.Add(NodeNotifyEvent); TypeInfo := Value.TypeInfo; end end; end; procedure TJvInspectorxNodeData.GetAsSet(var Buf); var CompType: PTypeInfo; EnumMin: Integer; EnumMax: Integer; ResBytes: Integer; TmpInt: Integer; begin CheckReadAccess; if JvxNode.TypeInfo.Kind <> tkSet then raise EJvInspectorData.CreateResFmt(@RsEJvInspDataNoAccessAs, [cJvInspectorSet]); CompType := GetTypeData(TypeInfo).CompType^; EnumMin := GetTypeData(CompType).MinValue; EnumMax := GetTypeData(CompType).MaxValue; ResBytes := (EnumMax div 8) - (EnumMin div 8) + 1; if ResBytes > 4 then ResBytes := 4; TmpInt := JvxNode.AsInteger; Move(TmpInt, Buf, ResBytes); end; function TJvInspectorxNodeData.HasValue: Boolean; begin Result := IsInitialized and (JvxNode.TypeInfo <> nil); end; function TJvInspectorxNodeData.IsAssigned: Boolean; begin Result := IsInitialized and JvxNode.Assigned; end; function TJvInspectorxNodeData.IsInitialized: Boolean; begin Result := (JvxNode <> nil); end; class function TJvInspectorxNodeData.New(const AParent: TJvCustomInspectorItem; const AName: string; const AJvxNode: TJvxNode): TJvCustomInspectorItem; var Data: TJvInspectorxNodeData; begin if AJvxNode = nil then raise EJVCLException.CreateRes(@RsENoNodeSpecified); if AJvxNode.NodeName <> '' then Data := TJvInspectorxNodeData.CreatePrim(AJvxNode.NodeName, AJvxNode.TypeInfo)) else Data := TJvInspectorxNodeData.CreatePrim(AName, AJvxNode.TypeInfo)); Data.JvxNode := AJvxNode; Data := TJvInspectorxNodeData(RegisterInstance(Data)); if Data <> nil then Result := Data.NewItem(AParent) else Result := nil; end; procedure TJvInspectorxNodeData.SetAsSet(const Buf); var CompType: PTypeInfo; EnumMin: Integer; EnumMax: Integer; ResBytes: Integer; TmpInt: Integer; begin CheckWriteAccess; if JvxNode.TypeInfo.Kind <> tkSet then raise EJvInspectorData.CreateResFmt(@RsEJvInspDataNoAccessAs, [cJvInspectorSet]); CompType := GetTypeData(TypeInfo).CompType^; EnumMin := GetTypeData(CompType).MinValue; EnumMax := GetTypeData(CompType).MaxValue; ResBytes := (EnumMax div 8) - (EnumMin div 8) + 1; if ResBytes > 4 then ResBytes := 4; TmpInt := 0; Move(Buf, TmpInt, ResBytes); JvxNode.AsInteger := TmpInt; end; {$IFDEF UNITVERSIONING} initialization RegisterUnitVersion(HInstance, UnitVersioning); finalization UnregisterUnitVersion(HInstance); {$ENDIF UNITVERSIONING} end.