jvqfullcolorspaceseditors.pas

East make Tray Icon in delphi

end;

function TJvFullColorSpaceProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paSubProperties, paDialog, paMultiSelect, paReadOnly, 
    paVolatileSubProperties, paVCL, 
    paRevertable];
end;

function TJvFullColorSpaceProperty.GetName: string;
begin
  Result := ColorSpace.ShortName;
end;

procedure TJvFullColorSpaceProperty.GetProperties(Proc:  TGetPropProc );
var
  I: TJvAxisIndex;
begin
  for I := Low(TJvAxisIndex) to High(TJvAxisIndex) do
    Proc(TJvFullColorAxisProperty.Create(Self, I));
end;

function TJvFullColorSpaceProperty.GetValue: string;
begin
  Result := ColorSpace.Name;
end;

//=== { TJvFullColorAxisProperty } ===========================================

constructor TJvFullColorAxisProperty.Create(AParent: TJvFullColorSpaceProperty;
  AAxisIndex: TJvAxisIndex);
begin
  inherited Create(AParent.Parent);
  FParent := AParent;
  FAxisIndex := AAxisIndex;
end;

function TJvFullColorAxisProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList, paMultiSelect, paRevertable];
end;

function TJvFullColorAxisProperty.GetName: string;
begin
  Result := Parent.ColorSpace.AxisName[AxisIndex];
end;

function TJvFullColorAxisProperty.GetValue: string;
begin
  Result :=
    Format('$%.2x', [GetAxisValue(ColorSpaceManager.ConvertToID(GetOrdValue, Parent.ColorSpace.ID), AxisIndex)]);
end;

procedure TJvFullColorAxisProperty.GetValues(Proc: TGetStrProc);
var
  I: Byte;
begin
  with Parent.ColorSpace do
    for I := AxisMin[AxisIndex] to AxisMax[AxisIndex] do
      Proc(Format('$%.2x', [I]));
end;


procedure TJvFullColorAxisProperty.SetValue(const Value: string);
var
  AxisValue: Byte;
  LColor: TJvFullColor;
  LColorID: TJvFullColorSpaceID;
begin
  AxisValue := HexToInt(Value);
  LColor := TJvFullColor(GetOrdValue);
  LColorID := ColorSpaceManager.GetColorSpaceID(LColor);
  LColor := ColorSpaceManager.ConvertToID(LColor, Parent.ColorSpace.ID);
  LColor := SetAxisValue(LColor, AxisIndex, AxisValue);
  if not Parent.Parent.IsColorProperty then
    SetOrdValue(Ord(ColorSpaceManager.ConvertToID(LColor, LColorID)))
  else
    SetOrdValue(Ord(ColorSpaceManager.ConvertToColor(LColor)));
end;

//=== { TJvDEFColorSpaceProperty } ===========================================

procedure TJvDEFColorSpaceProperty.GetProperties(Proc:  TGetPropProc );
begin
  Proc(TJvDEFColorSpaceIndentProperty.Create(Self, pfConstant));
  Proc(TJvDEFColorSpaceIndentProperty.Create(Self, pfSystem));
end;

//=== { TJvDEFColorSpaceIndentProperty } =====================================

constructor TJvDEFColorSpaceIndentProperty.Create(AParent: TJvDEFColorSpaceProperty;
  APredefinedFamily: TJvDEFFamily);
begin
  inherited Create(AParent.Parent);
  FParent := AParent;
  FPredefinedFamily := APredefinedFamily;
end;

function TJvDEFColorSpaceIndentProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList, paMultiSelect, paRevertable];
end;

function TJvDEFColorSpaceIndentProperty.GetName: string;
begin
  Result := GetEnumName(TypeInfo(TJvDEFFamily), Ord(PredefinedFamily));
  Result := Copy(Result, 3, Length(Result) - 2);
end;

function TJvDEFColorSpaceIndentProperty.GetValue: string;
var
  AColor: TColor;
begin
  if Parent.Parent.IsColorProperty then
    AColor := GetOrdValue
  else
    AColor := ColorSpaceManager.ConvertToColor(TJvFullColor(GetOrdValue));
  if ((AColor and JvSystemColorMask) <> 0) xor (PredefinedFamily = pfConstant) then
    Result := ColorToPrettyName(AColor)
  else
    Result := '';
end;

procedure TJvDEFColorSpaceIndentProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
  AColor: TColor;
  CS: TJvDEFColorSpace;
begin
  CS := TJvDEFColorSpace(Parent.ColorSpace);
  for I := 0 to CS.ColorCount - 1 do
  begin
    AColor := CS.ColorValue[I];
    if ((AColor and JvSystemColorMask) <> 0) xor (PredefinedFamily = pfConstant) then
      Proc(CS.ColorPrettyName[I]);
  end;
end;


procedure TJvDEFColorSpaceIndentProperty.SetValue(const Value: string);
var
  I:Integer;
  CS: TJvDEFColorSpace;
  clPrefix: string;
begin
  clPrefix := Copy(ColorToString(clBlack), 1, 2);
  CS := TJvDEFColorSpace(Parent.ColorSpace);
  for I := 0 to CS.ColorCount - 1 do
    if (CompareText(Value, CS.ColorName[I]) = 0) or
      (CompareText(Value, clPrefix + CS.ColorName[I]) = 0) or
      (CompareText(Value, CS.ColorPrettyName[I]) = 0) then
    begin
      if Parent.Parent.IsColorProperty then
        SetOrdValue(CS.ColorValue[I])
      else
      if (CS.ColorValue[I] and JvSystemColorMask) <> 0 then
        SetOrdValue(CS.ConvertFromColor(CS.ColorValue[I]))
      else
        with ColorSpaceManager do
          SetOrdValue(ConvertToID(ConvertFromColor(CS.ColorValue[I]), GetColorSpaceID(GetOrdValue)));
      Break;
    end;
end;

//=== { TJvColorSelection } ==================================================



procedure TJvFullColorSelection.ExecuteVerb(Index: Integer; const List: IDesignerSelections);
begin
  // No execution
  inherited ExecuteVerb(Index, List);
end;

function TJvFullColorSelection.GetVerb(Index: Integer): string;
begin
  // No menu item
  Result := '';
end;

function TJvFullColorSelection.GetVerbCount: Integer;
begin
  // No menu item
  Result := 0;
end;

procedure TJvFullColorSelection.PrepareItem(Index: Integer; const AItem: IMenuItem);
begin
  // No menu item
  inherited PrepareItem(Index, AItem);
end;

procedure TJvFullColorSelection.RequireClass(Proc: TGetStrProc; AClass: TClass);
var
  LTypInfo: PTypeInfo;
begin
  LTypInfo := AClass.ClassInfo;
  if LTypInfo <> nil then
    Proc(GetTypeData(LTypInfo).UnitName);
end;

procedure TJvFullColorSelection.RequiresUnits(Proc: TGetStrProc);
var
  I: Integer;
begin
  inherited RequiresUnits(Proc);

  RequireClass(Proc, TJvColorSpace);

  with ColorSpaceManager do
    for I := 0 to Count - 1 do
      RequireClass(Proc, ColorSpaceByIndex[I].ClassType);
end;



//=== { TJvFullColorListEditor } =============================================

function TJvFullColorListEditor.AllEqual: Boolean;
var
  IndexList, IndexColor: Integer;
  FullColorList:TJvFullColorList;
begin
  Result := False;
  if PropCount > 1 then
  begin
    FullColorList := TJvFullColorList.Create;
    FullColorList.Assign(TJvFullColorList(GetOrdValue));

    for IndexList := 1 to PropCount - 1 do
      with TJvFullColorList(GetOrdValueAt(IndexList)) do
        for IndexColor:=0 to Count - 1 do
          if FullColorList.Items[IndexColor] <> Items[IndexColor] then
            Exit;
  end;
  Result := True;
end;

procedure TJvFullColorListEditor.Edit;
var
  FullColorListForm: TJvFullColorListFrm;
  FullColorList:TJvFullColorList;
  IndexList, IndexColor:Integer;
begin
  FullColorListForm := TJvFullColorListFrm.Create(Application);
  try
    FullColorList:=TJvFullColorList.Create;
    try
      for IndexList := 0 to PropCount - 1 do
        with TJvFullColorList(GetOrdValueAt(IndexList)) do
          for IndexColor := 0 to Count - 1 do
            if FullColorList.IndexOf(Items[IndexColor]) = -1 then
              FullColorList.Add(Items[IndexColor]);

      FullColorListForm.OnApply := FormApply;
      FullColorListForm.ColorList := FullColorList;
      if FullColorListForm.Execute then
        FormApply(FullColorListForm);
    finally
      FullColorList.Free;
    end;
  finally
    FullColorListForm.Free;
  end;
end;   

procedure TJvFullColorListEditor.FormApply(Sender: TObject);
begin
  SetOrdValue(Cardinal((Sender as TJvFullColorListFrm).ColorList));
end;

function TJvFullColorListEditor.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog,  paVCL,  paMultiSelect];
end;

var
  FullColorSpaceEditorList: TList = nil;

{procedure ModuleUnloadProc(HInstance: Integer);
var
  Index:Integer;
  AEditorClass:TJvFullColorSpacePropertyClass;
begin
  for Index:=FullColorSpaceEditorList.Count-1 downto 0 do
  begin
    AEditorClass:=TJvFullColorSpacePropertyClass(FullColorSpaceEditorList.Items[Index]);
    if   (AEditorClass<>nil) and (AEditorClass<>TJvFullColorSpaceProperty)
      and(IsClassInModule(HInstance,AEditorClass))
      then FullColorSpaceEditorList.Items[Index]:=nil;
  end;
end; }

procedure InitFullColorSpaceEditorList;
var
  ACount:Integer;
  Index:Integer;
begin
  ACount := (High(TJvFullColorSpaceID) - Low(TJvFullColorSpaceID) + 1) shr 2;
  FullColorSpaceEditorList.Count := ACount;
  for Index := 0 to FullColorSpaceEditorList.Count - 1 do
    FullColorSpaceEditorList.Items[Index] := nil;
end;

procedure RegisterFullColorSpaceEditor (AColorSpaceID: TJvFullColorSpaceID;
  AEditorClass: TJvFullColorSpacePropertyClass);
begin
  FullColorSpaceEditorList.Items[AColorSpaceID shr 2] := AEditorClass;
  // todo (outchy) notification for changing
end;

function FindFullColorSpaceEditor (AColorSpaceID: TJvFullColorSpaceID): TJvFullColorSpacePropertyClass;
begin
  Result := TJvFullColorSpacePropertyClass(FullColorSpaceEditorList.Items[AColorSpaceID shr 2]);
  if Result = nil then
    Result := DefaultFullColorSpacePropertyClass;
end;

initialization
  FullColorSpaceEditorList := TList.Create;
  InitFullColorSpaceEditorList;
//  AddModuleUnloadProc(ModuleUnloadProc);

  RegisterFullColorSpaceEditor(csDEF, TJvDEFColorSpaceProperty);

finalization
//  RemoveModuleUnloadProc(ModuleUnloadProc);
  FreeAndNil(FullColorSpaceEditorList);

end.