flexprops.pas

是一套创建矢量图形的VCL组件

 if PropName <> '' then
  {$IFDEF FG_D5}
  TypInfo.SetPropValue(Self, PropName, Value);
  {$ELSE}
  FlexUtils.SetPropValue(Self, PropName, Value);
  {$ENDIF}
end;

function TCustomProp.GetPropType(const PropName: string): TPropType;
begin
 if PropName = ''
  then Result := FPropType
  else Result := ptSimple; // generic
end;

// TPropRefList ///////////////////////////////////////////////////////////////

constructor TPropRefList.Create;
begin
 inherited;
 FList := TList.Create;
end;

destructor TPropRefList.Destroy;
begin
 Clear;
 FList.Free;
 inherited;
end;

function TPropRefList.AddRef(AProp: TCustomProp; const APropName: ShortString;
  AData: PVariant): integer;
var Item: PPropRefItem;
//    i: integer;
begin
{
 for i:=0 to FList.Count-1 do with PPropRefItem(FList[i])^ do
  if (Prop = AProp) and (APropName = PropName) then begin
   DeleteRef(i);
   break;
  end;   }
 New(Item);
 try
  FillChar(Item^, SizeOf(Item^), 0);
  Item.Prop := AProp;
  Item.PropName := APropName;
  Item.Data := AData;
  Result := FList.Add(Item);
 except
  Dispose(Item);
  raise;
 end;
end;

procedure TPropRefList.Clear;
begin
 while (FList.Count > 0) do DeleteRef(FList.Count-1);
end;

procedure TPropRefList.DeleteRef(Index: integer);
begin
 with PPropRefItem(FList[Index])^ do begin
  VarClear(Data^);
  Dispose(Data);
 end;
 Dispose(PPropRefItem(FList[Index]));
 FList.Delete(Index);
end;

function TPropRefList.GetCount: integer;
begin
 Result := FList.Count;
end;

function TPropRefList.GetPropRefItem(Index: integer): PPropRefItem;
begin
 Result := PPropRefItem(FList[Index]);
end;

procedure TPropRefList.ResolveRef(Index: integer);
begin
 with PPropRefItem(FList[Index])^ do begin
  Prop.Owner.BeginResolve;
  try
   Prop.SetPropValue(PropName, Data^);
  finally
   Prop.Owner.EndResolve;
  end;
 end;
 DeleteRef(Index);
end;

procedure TPropRefList.ResolveAllRefs;
begin
 while FList.Count > 0 do ResolveRef(FList.Count-1);
end;

// TPropList //////////////////////////////////////////////////////////////////

constructor TPropList.Create(AOwner: TObject);
begin
 inherited Create;
 FOwner := AOwner;
 FPropList := TStringList.Create;
 FPropList.Sorted := True;
end;

destructor TPropList.Destroy;
begin
 Clear;
 FPropList.Free;
 inherited;
end;

procedure TPropList.BeginResolve;
begin
 inc(FResolveCount);
end;

procedure TPropList.EndResolve;
begin
 if FResolveCount > 0 then dec(FResolveCount);
end;

function TPropList.GetResolving: boolean;
begin
 Result := FResolveCount > 0
end;

function TPropList.GetPropsCount: integer;
begin
 Result := FPropList.Count;
end;

function TPropList.GetPropByIndex(Index: integer): TCustomProp;
begin
 Result := TCustomProp(FPropList.Objects[Index]);
end;

function TPropList.GetPropByName(const Name: string): TCustomProp;
var Index: integer;
begin
 Index := FPropList.IndexOf(Name);
 if Index < 0
  then Result := Nil
  else Result := TCustomProp(FPropList.Objects[Index]);
end;

function TPropList.GetPropName(Index: integer): string;
begin
 Result := FPropList[Index];
end;

function TPropList.GetRealIndex(VisibleIndex: integer): integer;
var i, CurIndex: integer;
begin
 Result := -1;
 if VisibleIndex < 0 then exit;
 CurIndex := -1;
 for i:=0 to FPropList.Count-1 do
  if psVisible in TCustomProp(FPropList.Objects[i]).Style then begin
   inc(CurIndex);
   if CurIndex = VisibleIndex then begin
    Result := i;
    break;
   end;
  end;
end;

function TPropList.GetVisibleIndex(RealIndex: integer): integer;
var i: integer;
begin
 if (RealIndex < 0) or
    not (psVisible in TCustomProp(FPropList.Objects[RealIndex]).Style) then
  Result := -1
 else begin
  Result := RealIndex;
  for i:=0 to RealIndex-1 do
   if not (psVisible in TCustomProp(FPropList.Objects[i]).Style) then
    dec(Result);
 end;
end;

function TPropList.GetVisibleCount: integer;
var i: integer;
begin
 Result := FPropList.Count;
 for i:=0 to FPropList.Count-1 do
  if not (psVisible in TCustomProp(FPropList.Objects[i]).Style) then dec(Result);
end;

function TPropList.GetVisibleProp(Index: integer): TCustomProp;
begin
 Index := GetRealIndex(Index);
 if Index >= 0
  then Result := TCustomProp(FPropList.Objects[Index])
  else Result := Nil;
end;

function TPropList.GetVisiblePropName(Index: integer): string;
begin
 Index := GetRealIndex(Index);
 if Index >= 0
  then Result := FPropList[Index]
  else Result := '';
end;

procedure TPropList.DoBeforeChanged(Prop: TCustomProp);
begin
 if Assigned(FOnPropBeforeChanged) then FOnPropBeforeChanged(Self, Prop);
end;

procedure TPropList.DoChanged(Prop: TCustomProp);
begin
 if Assigned(FOnPropChanged) then FOnPropChanged(Self, Prop);
end;

function TPropList.DoPropIsStored(Prop: TCustomProp): boolean;
begin
 Result := true;
 if Assigned(FOnPropStored) then FOnPropStored(Self, Prop, Result);
end;

function TPropList.IsNameValid(const AName: string): boolean;
var i: integer;
begin
 Result := False;
 for i:=0 to High(fcReserved) do
  if CompareStr(fcReserved[i], AName) = 0 then exit;
 if (FPropList.IndexOf(AName) >= 0) then exit;
 Result := true;
end;

function TPropList.Add(Prop: TCustomProp; const AName: string): integer;
begin
 if not IsNameValid(AName) or (FPropList.IndexOfObject(Prop) >= 0) then
  Result := -1
 else begin
  Result := FPropList.AddObject(AName, Prop);
  if Result >= 0 then Prop.Owner := Self;
 end;
end;

procedure TPropList.Delete(Index: integer);
begin
 ByIndex[Index].Free;
 FPropList.Delete(Index);
end;

procedure TPropList.Clear;
begin
 while FPropList.Count > 0 do Delete(FPropList.Count-1);
end;

function TPropList.IndexOf(Prop: TCustomProp): integer;
begin
 Result := FPropList.IndexOfObject(Prop);
end;

function TPropList.VisibleIndexOf(Prop: TCustomProp): integer;
begin
 Result := GetVisibleIndex( IndexOf(Prop) );
end;

function TPropList.IsReadOnly(Prop: TCustomProp): boolean;
begin
 Result := psReadOnly in Prop.Style;
 if not Result and Assigned(FOnPropReadOnly) then
  FOnPropReadOnly(Self, Prop, Result);
end;

procedure TPropList.SavePropValue(Filer: TFlexFiler; const Indent: string;
  Prop: TCustomProp; const PropName: string; IsComplex: boolean);
const HexBlockSize = 32;
var PType: TPropType;
    VarValue: Variant;
    s: string;
    NeedQuote: boolean;
    Buffer, Data: PChar;
    BufSize, BufPos, DataPos, DataBlockSize: integer;
    StrCount, FullCount, ShortStrExists : integer;
    IndentLen: integer;
    i,j, Last, Size: integer;
begin
 if IsComplex then begin
  VarValue := Prop.GetPropValue(PropName);
  PType := Prop.GetPropType(PropName);
 end else begin
  VarValue := Prop.GetPropValue('');
  PType := Prop.GetPropType('');
 end;
 case PType of
  ptSimple:
    if not (VarIsEmpty(VarValue) or VarIsNull(VarValue)) then begin
     s := VarAsType(VarValue, varString);
     if IsComplex and (PropType(Prop.ClassType, PropName) = tkSet) then begin
      s := '[' + s + ']';
     end else begin
      NeedQuote := False;
      for i:=1 to Length(s) do
       if s[i] in [#0..' ', ''''] then begin
        NeedQuote := True;
        break;
       end;
      if NeedQuote then s := '''' + s + '''';
     end;
     Filer.SaveStr(Indent + PropName + ' = ' + s);
    end;
  ptStrList:
    if VarIsEmpty(VarValue) or VarIsNull(VarValue) then
     Filer.SaveStr(Indent + PropName + ' = ( )')
    else
    if VarType(VarValue) and varArray <> 0 then begin
     Filer.SaveStr(Indent + PropName + ' = (');
     s := '';
     Last := VarArrayHighBound(VarValue, 1);
     for i:=0 to Last do begin
      if i = Last then s := ' )';
      Filer.SaveStr(Indent + IndentStep +
        '''' + VarAsType(VarValue[i], varString) + '''' + s);
     end;
    end;
  ptHexData:
    if VarIsEmpty(VarValue) or VarIsNull(VarValue) then
     Filer.SaveStr(Indent + PropName + ' = { }')
    else
    if VarType(VarValue) and varArray <> 0 then begin
     Filer.SaveStr(Indent + PropName + ' = {');
     Size := VarArrayHighBound(VarValue, 1)+1;
     IndentLen := Length(Indent) + Length(IndentStep);
     FullCount := Size div HexBlockSize;
     ShortStrExists := Byte(Size mod HexBlockSize <> 0);
     StrCount := FullCount + ShortStrExists;
     BufSize := StrCount * IndentLen +
                FullCount * (2*HexBlockSize + 2{EOLN}) +
                ShortStrExists * (2 * (Size mod HexBlockSize) + 2{EOLN}) +
                2{觐礤