tntjvcolorcombo.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

  LoadDescrSysColorValues;
  FCustomColors := TStringList.Create;
  FColorNameMap := TTntStringList.Create;
  Style := csOwnerDrawFixed;
  FColorValue := clBlack;
  FColorWidth := 21;
  FNewColorText := RsNewColorPrefix;
  FColorDialogText := RsCustomCaption;
  FOptions := [coText];
  FHiliteColor := clHighlight;
  FHiliteText := clHighlightText;
  AutoComplete := False;
  // make sure that if this is the first time the component is dropped on the form,
  // the default Name/Value map is created (thanks to Brian Cook on the borland NG's):
  if (Owner <> nil) and ([csDesigning, csLoading] * Owner.ComponentState = [csDesigning]) then
    InitColorNames;
  FColorNameMap.OnChange := DoNameMapChange;
end;

destructor TTntJvColorComboBox.Destroy;
begin
  FColorNameMap.Free;
  FCustomColors.Free;
  inherited Destroy;
end;

function TTntJvColorComboBox.BeginUpdate: Integer;
begin
  Inc(FUpdateCount);
  Result := FUpdateCount;
end;

function TTntJvColorComboBox.EndUpdate: Integer;
begin
  Dec(FUpdateCount);
  if FUpdateCount = 0 then
    GetColors
  else
  if FUpdateCount < 0 then
    FUpdateCount := 0;
  Result := FUpdateCount;
end;

procedure TTntJvColorComboBox.GetColors;
var
  I: Integer;
  ColorName: WideString;
begin
  if FUpdateCount = 0 then
  begin
    Items.BeginUpdate;
    try
      Clear;
      FCustomColorCount := 0;
      for I := Low(TntColorValues) to High(TntColorValues) do
      begin
        ColorName := GetColorName(TntColorValues[I].Value, '');
        InternalInsertColor(Items.Count, TntColorValues[I].Value, ColorName);
      end;
      if coSysColors in FOptions then
        for I := Low(TntSysColorValues) to High(TntSysColorValues) do
        begin
          ColorName := GetColorName(TntSysColorValues[I].Value, '');
          InternalInsertColor(Items.Count, TntSysColorValues[I].Value, ColorName);
        end;
      DoBeforeCustom;
      if coCustomColors in FOptions then
        InternalInsertColor(Items.Count, $000001, FColorDialogText);
      SetColorValue(FColorValue);
    finally
      Items.EndUpdate;
    end;
  end;
end;

procedure TTntJvColorComboBox.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, FColorDialogText);
    Invalidate;
  end;
end;

procedure TTntJvColorComboBox.SetColorDialogText(Value: WideString);
var
  I: Integer;
begin
  if FColorDialogText <> Value then
  begin
    I := Items.IndexOf(FColorDialogText);
    while I > -1 do
    begin
      Items[I] := Value;
      I := Items.IndexOf(FColorDialogText);
    end;
    FColorDialogText := Value;
  end;
end;

procedure TTntJvColorComboBox.SetColorWidth(Value: Integer);
begin
  if FColorWidth <> Value then
  begin
    FColorWidth := Value;
    Invalidate;
  end;
end;

procedure TTntJvColorComboBox.SetColorValue(Value: TColor);
var
  I: Integer;
begin
  I := FindColor(Value);
  if I >= 0 then
  begin
    FColorValue := Value;
    if ItemIndex <> I then
    begin
      ItemIndex := I;
      Change;
    end;
    Exit;
  end
  else
  if coCustomColors in Options then
  begin
    InsertColor(Items.Count - 1, Value, WideFormat(FNewColorText, [FCustomColorCount]));
    //      Items.InsertObject(Items.Count, FNewColorText + IntToStr(FCustomColorCount), TObject(Value))
    Inc(FCustomColorCount);
    FColorValue := Value;
    ItemIndex := Items.Count - 2;
  end
  else
  begin
    AddColor(Value, WideFormat(FNewColorText, [FCustomColorCount]));
    FColorValue := Value;
    ItemIndex := Items.Count - 1;
    Change;
  end;
  //      Items.AddObject(FNewColorText + IntToStr(FCustomColorCount), TObject(Value));
end;

function TTntJvColorComboBox.DoNewColor(Color: TColor; var DisplayName: WideString): Boolean;
begin
  Result := FindColor(Color) = -1;
  if Assigned(FNewColor) then
    FNewColor(Self, Color, DisplayName, Result);
end;

procedure TTntJvColorComboBox.CNDrawItem(var Msg: TWMDrawItem);
var
  State: TOwnerDrawState;
begin
  with Msg.DrawItemStruct{$IFNDEF CLR}^{$ENDIF} do
  begin
    State := ItemStateToOwnerDrawState(itemState);
    Canvas.Handle := hDC;
    Canvas.Font := Font;
    Canvas.Brush := Brush;
    if (Integer(itemID) >= 0) and (odSelected in State) then
    begin
      Canvas.Brush.Color := FHiliteColor;
      Canvas.Font.Color := FHiliteText;
    end;
    if Integer(itemID) >= 0 then
      DrawItem(itemID, rcItem, State)
    else
      Canvas.FillRect(rcItem);
    Canvas.Handle := 0;
  end;
end;

procedure TTntJvColorComboBox.DrawItem(Index: Integer; R: TRect;
  State: TOwnerDrawState);
var
  aRect: TRect;
  AColor: TColor;
  S: WideString;
begin
  if Index >= Items.Count then Exit;
  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 + FColorWidth

  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.Style := bsSolid;
      Brush.Color := AColor;
    end;
    if (coCustomColors in FOptions) and (Index = Items.Count - 1) then
    begin
      S := FColorDialogText;
      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;
      if AColor = clNone then
        Brush.Style := bsFDiagonal
      else
      if AColor = clDefault then
        Brush.Style := bsBDiagonal;
      FillRect(R);
      SetBkMode(Canvas.Handle, TRANSPARENT);
      {$IFDEF CLR}
      DrawText(Canvas.Handle, S, Length(S), R, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX); {???}
      {$ELSE}
      Tnt_DrawTextW(Canvas.Handle, PWideChar(S), Length(S), R, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
      {$ENDIF CLR}
    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 <> FColorDialogText then
      begin
        if coHex in FOptions then
          S := Format('0x%.6x', [ColorToRGB(TColor(Items.Objects[Index]))])
        else
        if coRGB in FOptions then
          S := Format('(%d,%d,%d)', [GetRValue(TColor(Items.Objects[Index])), GetGValue(TColor(Items.Objects[Index])),
            GetBValue(TColor(Items.Objects[Index]))]);
      end;
      R.Left := R.Left + FColorWidth + 6;
      R.Right := R.Left + TextWidth(S) + 6;
      if AColor = clNone then
        Brush.Style := bsFDiagonal
      else
      if AColor = clDefault then
        Brush.Style := bsBDiagonal;
      FillRect(R);
      OffsetRect(R, 2, 0);
      SetBkMode(Canvas.Handle, TRANSPARENT);
      {$IFDEF CLR}
      DrawText(Canvas.Handle, S, Length(S), R, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX); {???}
      {$ELSE}
      Tnt_DrawTextW(Canvas.Handle, PWideChar(S), Length(S), R, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
      {$ENDIF CLR}
      OffsetRect(R, -2, 0);
    end
    else
      FrameRect(R);
    if odSelected in State then
      DrawFocusRect(R);
  end;
end;

procedure TTntJvColorComboBox.Click;
var
  S, Tmp: WideString;
  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;
      CD.CustomColors := Self.CustomColors;
      Options := Options + [cdFullOpen, cdPreventFullOpen];
      S := FNewColorText;
      if Execute then
      begin
        Self.CustomColors := CD.CustomColors;
        if DoNewColor(CD.Color, S) then
          Inc(FCustomColorCount);
        Tmp := FNewColorText;
        try
          FNewColorText := S;
          ColorValue := CD.Color;
        finally
          FNewColorText := Tmp;
        end;
        Change;
      end
      else
        ItemIndex := Items.Count - 2;
    finally
      Free;
    end;
  end
  else
  if ItemIndex >= 0 then
    ColorValue := TColor(Items.Objects[ItemIndex]);
  inherited Click;
  FExecutingDialog := False;
end;

procedure TTntJvColorComboBox.FontChanged;
begin
  inherited FontChanged;
  ResetItemHeight;
  RecreateWnd;
end;

procedure TTntJvColorComboBox.ResetItemHeight;
begin
  ItemHeight := Max(GetItemHeight(Font), 9);
end;

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

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

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

function TTntJvColorComboBox.GetColorNameMap: TTntStrings;
begin
  Result := FColorNameMap;
end;

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

procedure TTntJvColorComboBox.SetColorNameMap(const Value: TTntStrings);
begin
  FColorNameMap.Assign(Value);
  Invalidate;
end;

function TTntJvColorComboBox.GetColorName(AColor: TColor; const Default: WideString): WideString;
var
  Tmp: WideString;
begin
  Tmp := ColorToString(AColor);
  Result := FColorNameMap.Values[Tmp];
  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 TTntJvColorComboBox.InitColorNames;
var
  I: Integer;
begin
  FColorNameMap.BeginUpdate;
  try
    FColorNameMap.Clear;
    for I := Low(TntColorValues) to High(TntColorValues) do
      FColorNameMap.Add(TntColorValues[I].Constant + '=' + TntColorValues[I].Description);
    for I := Low(TntSysColorValues) to High(TntSysColorValues) do
      FColorNameMap.Add(TntSysColorValues[I].Constant + '=' + TntSysColorValues[I].Description);
  finally
    FColorNameMap.EndUpdate;
  end;
end;

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

procedure TTntJvColorComboBox.DoBeforeCustom;
begin
  if Assigned(FOnBeforeCustom) then