jvqcolorcombo.pas

East make Tray Icon in delphi

  FColorNameMap.Free;
  inherited Destroy;
end;

procedure TJvColorComboBox.GetColors;
var
  I: Integer;
  ColorName: string;
begin
//  Clear;
  FCustCnt := 0;
  for I := 1 to ColCount do
  begin
    ColorName := GetColorName(ColorValues[I], '');
    InternalInsertColor(Items.Count, ColorValues[I], ColorName);
  end;
  if coSysColors in FOptions then
    for I := 1 to SysColCount do
    begin
      ColorName := GetColorName(SysColorValues[I], '');
      InternalInsertColor(Items.Count, SysColorValues[I], ColorName);
    end;
  DoBeforeCustom;
  if coCustomColors in FOptions then
    InternalInsertColor(Items.Count, $000001, FOther);
  SetColorValue(FColorValue);
end;

procedure TJvColorComboBox.SetOptions(Value: TJvColorComboOptions);
begin
  if FOptions <> Value then
  begin
    if (coCustomColors in FOptions) and (Items.Count > 0) then
      Items.Delete(Items.Count - 1);
    FOptions := Value;
{    if coText in FOptions then
    begin
      Exclude(FOptions,coHex);
      Exclude(FOptions,coRGB);
    end
    else if coHex in Value then
      Exclude(FOptions,coRGB); }
    if coCustomColors in FOptions then
      InternalInsertColor(Items.Count, $000001, FOther);
    Invalidate;
  end;
end;

procedure TJvColorComboBox.SetOther(Value: string);
var
  I: Integer;
begin
  if FOther <> Value then
  begin
    I := Items.IndexOf(FOther);
    while I > -1 do
    begin
      Items[I] := Value;
      I := Items.IndexOf(FOther);
    end;
    FOther := Value;
  end;
end;

procedure TJvColorComboBox.SetColWidth(Value: Integer);
begin
  if FColWidth <> Value then
  begin
    FColWidth := Value;
    Invalidate;
  end;
end;

procedure TJvColorComboBox.SetColorValue(Value: TColor);
var
  I: Integer;
begin
  I := FindColor(Value);
  if I >= 0 then
  begin
    FColorValue := Value;
    if ItemIndex <> I then
      ItemIndex := I;
    Change;
    Exit;
  end
  else
  if coCustomColors in Options then
  begin
    InsertColor(Items.Count - 1, Value, Format(FPrefix, [FCustCnt]));
  end
  else
    AddColor(Value, Format(FPrefix, [FCustCnt]));
  ItemIndex := Items.Count - 2;
  FColorValue := Value;
end;

function TJvColorComboBox.DoNewColor(Color: TColor; var DisplayName: string): Boolean;
begin
  if Assigned(FNewColor) then
    FNewColor(Self, Color, DisplayName, Result)
  else
    Result := FindColor(Color) = -1;
  if Result then
    Inc(FCustCnt);
end;


procedure TJvColorComboBox.ItemDraw(Sender: TObject; Index: Integer; R: TRect;    // OnDrawItem Handler
  State: TOwnerDrawState; var Handled: Boolean );
var
  aRect: TRect;
  aColor: TColor;
  S: string;
begin
  if R.Bottom < 0 then      // CLX bug fix
  begin
                                // when using up/down arrow keys
    R.Right := ClientWidth ;   // then R.Bottom and R.Right have value -2 !
                               // for index > DropDownCount
  end;
  R.Bottom := R.Top + ItemHeight;
  if (Index >= 0) and (odSelected in State) and DroppedDown then
  begin
    Canvas.Brush.Color := FHiLiteColor;
    Canvas.Font.Color := FHiLiteText;
  end
  else if not Focused then
    Canvas.Font.Color := Font.Color;
  if Index < 0 then
  begin
    Canvas.FillRect(R);
    exit;  // not Handled
  end;
  aRect := R;
  Inc(aRect.Top, 2);
  Inc(aRect.Left, 2);
  Dec(aRect.Bottom, 2);
  if (coText in FOptions) or (coHex in FOptions) or (coRGB in FOptions) or
    ((coCustomColors in FOptions) and (Index = Items.Count - 1)) then
    aRect.Right := aRect.Left + FColWidth
  else
    Dec(aRect.Right, 3);
  with Canvas do
  begin
    aColor := Brush.Color;
    Brush.Color := Color;
    FillRect(R);
    Brush.Color := clGray;
    OffsetRect(aRect, 2, 2);
    FillRect(aRect);
    OffsetRect(aRect, -2, -2);
    Brush.Color := TColor(Items.Objects[Index]);
    try
      Rectangle(aRect);
    finally
      Brush.Color := aColor;
    end;
    if (coCustomColors in FOptions) and (Index = Items.Count - 1) then
    begin
      S := FOther;
      DoGetDisplayName(Index, TColor(Items.Objects[Index]), S);
      Brush.Color := Self.Color;
      FillRect(R);
      R.Left := R.Left + 2;
      R.Right := R.Left + TextWidth(S) + 2;
      Brush.Color := aColor;
      FillRect(R);
      DrawText(Canvas, S, -1, R, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
    end
    else
    if ((coText in FOptions) or (coHex in FOptions) or (coRGB in FOptions)) then
    begin
      S := Items[Index];
      DoGetDisplayName(Index, TColor(Items.Objects[Index]), S);
      if S <> FOther then
      begin
        AColor := ColorToRGB(TColor(Items.Objects[Index]));
        if coHex in FOptions then
          S := Format(HexPrefix + '%.6x', [AColor])
        else
        if coRGB in Foptions then
          S := Format('(%d,%d,%d)', [GetRValue(AColor), GetGValue(AColor),
            GetBValue(AColor)]);
      end;
      R.Left := R.Left + FColWidth + 6;
      R.Right := R.Left + TextWidth(S) + 6;
      FillRect(R);
      OffsetRect(R, 2, 0);
      DrawText(Canvas, S, -1, R, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
      OffsetRect(R, -2, 0);
    end
    else
      FrameRect(Canvas, R);
    if odSelected in State then
      DrawFocusRect(R);
  end;
  Handled := true ;
end;

procedure TJvColorComboBox.Click;
var
  S: string;
  CD: TColorDialog;
begin
  if FExecutingDialog then
    Exit;
  if (ItemIndex = Items.Count - 1) and (coCustomColors in FOptions) then
  begin
    FExecutingDialog := True;
    CD := TColorDialog.Create(Self);
    with CD do
    try
      CD.Color := ColorValue;
      S := FPrefix;
      if Execute and DoNewColor(CD.Color, S) then
      begin
        InternalInsertColor(Items.Count - 1, CD.Color, S);
        ItemIndex := Items.Count - 2;
      end
      else
        ColorValue := CD.Color;
    finally
      Free;
    end // with
  end
  else
  if ItemIndex >= 0 then
    ColorValue := TColor(Items.Objects[ItemIndex]);
  inherited Click;
  FExecutingDialog := False;
end;

procedure TJvColorComboBox.FontChanged;
begin
//  inherited;
  ResetItemHeight;
  Invalidate;
end;

procedure TJvColorComboBox.ResetItemHeight;
begin
  if not (csRecreating in ControlState) then
    ItemHeight := GetItemHeight(Font);
end;

procedure TJvColorComboBox.SetPrefix(const Value: string);
begin
  FPrefix := Value;
end;

procedure TJvColorComboBox.SetHexPrefix(const Value: string);
begin
  if Value <> FHexPrefix then
  begin
    FPrefix := Value;
    Invalidate;
  end;
end;

procedure TJvColorComboBox.AddColor(AColor: TColor;
  const DisplayName: string);
var
  S: string;
begin
  S := DisplayName;
  if DoNewColor(AColor, S) then
    InternalInsertColor(Items.Count - Ord(coCustomColors in Options), AColor, S);
end;

procedure TJvColorComboBox.DoGetDisplayName(Index: Integer; AColor: TColor;
  var DisplayName: string);
begin
  if Assigned(FOnGetDisplayName) then
    FOnGetDisplayName(Self, Index, AColor, DisplayName)
  else
    DisplayName := GetColorName(AColor, DisplayName);
end;

procedure TJvColorComboBox.InsertColor(AIndex: Integer; AColor: TColor;
  const DisplayName: string);
var
  S: string;
begin
  S := DisplayName;
  if DoInsertColor(AIndex, AColor, S) then
    InternalInsertColor(AIndex, AColor, S);
end;

function TJvColorComboBox.GetColor(Index: Integer): TColor;
begin
  Result := TColor(Items.Objects[Index]);
end;

procedure TJvColorComboBox.SetColorNameMap(const Value: TStrings);
begin
  FColorNameMap.Assign(Value);
  Invalidate;
end;

function TJvColorComboBox.GetColorName(AColor: TColor; const Default: string): string;
var
  Tmp: string;
begin
  Tmp := ColorToString(AColor);
  Result := FColorNameMap.Values[Tmp];
  case AColor of
  clMoneyGreen : Result := 'MoneyGreen';
  clSkyBlue: Result := 'SkyBlue';
  clCream: Result := 'Cream';
  clMedGray: result := 'MedGray';
  end;
  if Result = '' then
    Result := FColorNameMap.Values['cl'+Tmp];
  if Result = '' then
  begin
    if Default = '' then
    begin
      if (Length(Tmp) > 1) and AnsiSameText(Tmp[1], 'c') and AnsiSameText(Tmp[2], 'l') then
        Result := Copy(Tmp, 3, MaxInt)
      else
        Result := Tmp;
    end
    else
      Result := Default;
  end;
end;

procedure TJvColorComboBox.InitColorNames;
begin
  FColorNameMap.BeginUpdate;
  try
    FColorNameMap.Clear;
    FColorNameMap.Add('clBlack=Black');
    FColorNameMap.Add('clMaroon=Maroon');
    FColorNameMap.Add('clGreen=Green');
    FColorNameMap.Add('clOlive=Olive');
    FColorNameMap.Add('clNavy=Navy');
    FColorNameMap.Add('clPurple=Purple');
    FColorNameMap.Add('clTeal=Teal');
    FColorNameMap.Add('clGray=Gray');
    FColorNameMap.Add('clSilver=Silver');
    FColorNameMap.Add('clRed=Red');
    FColorNameMap.Add('clLime=Lime');
    FColorNameMap.Add('clYellow=Yellow');
    FColorNameMap.Add('clBlue=Blue');
    FColorNameMap.Add('clFuchsia=Fuchsia');
    FColorNameMap.Add('clAqua=Aqua');
    FColorNameMap.Add('clLtGray=Light Gray');
    FColorNameMap.Add('clDkGray=Dark Gray');
    FColorNameMap.Add('clWhite=White');
    FColorNameMap.Add('clMoneyGreen=Money Green');
    FColorNameMap.Add('clSkyBlue=Sky Blue');
    FColorNameMap.Add('clCream=Cream');
    FColorNameMap.Add('clMedGray=Medium Gray');
    FColorNameMap.Add('clForeground=Foreground');
    FColorNameMap.Add('clButton=Button');
    FColorNameMap.Add('clLight=Light');
    FColorNameMap.Add('clMidlight=Mid Light');
    FColorNameMap.Add('clDark=Drak');
    FColorNameMap.Add('clMid=Mid');
    FColorNameMap.Add('clText=Text');
    FColorNameMap.Add('clBrightText=Bright Text');
    FColorNameMap.Add('clButtonText=Button Text');
    FColorNameMap.Add('clBase=Base');
    FColorNameMap.Add('clBackground=BackGround');
    FColorNameMap.Add('clShadow=Shadow');
    FColorNameMap.Add('clHighlight=Highlight');
    FColorNameMap.Add('clHighlightedText=Highlighted Text');

    FColorNameMap.Add('clNormalForeground=Normal Foreground');
    FColorNameMap.Add('clNormalButton=Normal Button');
    FColorNameMap.Add('clNormalLight=Normal Light');
    FColorNameMap.Add('clNormalMidlight=Normal Mid Light');
    FColorNameMap.Add('clNormalDark=Normal Dark');
    FColorNameMap.Add('clNormalMid=Normal Mid');
    FColorNameMap.Add('clNormalText=Normal Text');
    FColorNameMap.Add('clNormalBrightText=Normal Bright Text');
    FColorNameMap.Add('clNormalButtonText=Normal Button Text');
    FColorNameMap.Add('clNormalBase=Normal Base');
    FColorNameMap.Add('clNormalBackground=Normal BackGround');
    FColorNameMap.Add('clNormalShadow=Normal Shadow');
    FColorNameMap.Add('clNormalHighlight=Normal Highlight');
    FColorNameMap.Add('clNormalHighlightedText=Normal Highlighted Text');

    FColorNameMap.Add('clDisabledForeground=Disabled Foreground');
    FColorNameMap.Add('clDisabledButton=Disabled Button');
    FColorNameMap.Add('clDisabledLight=Disabled Light');
    FColorNameMap.Add('clDisabledMidlight=Disabled Mid Light');
    FColorNameMap.Add('clDisabledDark=Disabled Dark');
    FColorNameMap.Add('clDisabledMid=Disabled Mid');
    FColorNameMap.Add('clDisabledText=Disabled Text');
    FColorNameMap.Add('clDisabledBrightText=Disabled Bright Text');
    FColorNameMap.Add('clDisabledButtonText=Disabled Button Text');
    FColorNameMap.Add('clDisabledBase=Disabled Base');
    FColorNameMap.Add('clDisabledBackground=Disabled BackGround');
    FColorNameMap.Add('clDisabledShadow=Disabled Shadow');
    FColorNameMap.Add('clDisabledHighlight=Disabled Highlight');
    FColorNameMap.Add('clDisabledHighlightedText=Disabled Highlighted Text');

    FColorNameMap.Add('clActiveForeground=Active Foreground');
    FColorNameMap.Add('clActiveButton=Active Button');
    FColorNameMap.Add('clActiveLight=Active Light');
    FColorNameMap.Add('clActiveMidlight=Active Mid Light');
    FColorNameMap.Add('clActiveDark=Active Dark');
    FColorNameMap.Add('clActiveMid=Active Mid');
    FColorNameMap.Add('clActiveText=Active Text');
    FColorNameMap.Add('clActiveBrightText=Active Bright Text');
    FColorNameMap.Add('clActiveButtonText=Active Button Text');
    FColorNameMap.Add('clActiveBase=Active Base');
    FColorNameMap.Add('clActiveBackground=Active BackGround');
    FColorNameMap.Add('clActiveShadow=Active Shadow');
    FColorNameMap.Add('clActiveHighlight=Active Highlight');
    FColorNameMap.Add('clActiveHighlightedText=Active Highlighted Text');
    FColorNameMap.Add('clNone=None');
    FColorNameMap.Add('clDefault=Default');
  finally
    FColorNameMap.EndUpdate;
  end;
end;

procedure TJvColorComboBox.Loaded;
begin
  inherited Loaded;
  GetColors;
  FontChanged;
end;

function TJvColorComboBox.DoInsertColor(AIndex: Integer; AColor: TColor;
  var DisplayName: string): Boolean;
begin
  Result := True;
  if Assigned(FOnInsertColor) then
    FOnInsertColor(Self, AColor, DisplayName, Result);
end;

procedure TJvColorComboBox.DoBeforeCustom;
begin
  if Assigned(FOnBeforeCustom) then
    FOnBeforeCustom(Self);
end;

procedure TJvColorComboBox.ChangeColor(AIndex: Integer; AColor: TColor;
  const DisplayName: string);
begin
  // raise Exception ?
  if (AIndex >= 0) and (AIndex < Items.Count - Ord(coCustomColors in Options)) then
  begin
    Items[AIndex] := DisplayName;
    Items.Objects[AIndex] := TObject(AColor);
  end;
end;


function TJvColorComboBox.ColorName(AColor: TColor): string;
begin
  Result := GetColorName(AColor, '');
  if Result = '' then
    DoGetDisplayName(-1, AColor, Result);
end;

function TJvColorComboBox.FindColor(AColor: TColor): Integer;
begin
  Result := Items.IndexOfObject(TObject(AColor));
  if (coCustomColors in Options) and (Result = Items.Count - 1) then
    Result := -1;
end;