colorboxse.pas

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

      else
        LStart := 1;
      Result := '';
      for I := LStart to Length(AName) do
      begin
        case AName[I] of
          'A'..'Z':
            if Result <> '' then
              Result := Result + ' ';
        end;
        Result := Result + AName[I];
      end;
    end;
  end
  else
    Result := AName;
end;

procedure TCustomColorBoxSE.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);

  function ColorToBorderColor(AColor: TColor): TColor;
  type
    TColorQuad = record
      Red,
      Green,
      Blue,
      Alpha: Byte;
    end;
  begin
    if (TColorQuad(AColor).Red > 192) or
       (TColorQuad(AColor).Green > 192) or
       (TColorQuad(AColor).Blue > 192) then
      Result := clBlack
    else if odSelected in State then
      Result := clWhite
    else
      Result := AColor;
  end;

var
  LRect: TRect;
  LBackground: TColor;
  IsCustom: Boolean;
begin
  IsCustom := ColorType[Index] = fcbCustomColor;
  with Canvas do
  begin
    FillRect(Rect);
    LBackground := Brush.Color;
    LRect := Rect;
    LRect.Right := LRect.Bottom - LRect.Top + LRect.Left;
    InflateRect(LRect, -1, -1);
    if (Colors[Index] = clNone) and not IsCustom then with LRect do
    begin
     Brush.Style := bsSolid;
     Brush.Color := clWhite;
     Rectangle(Left, Top, Right, Bottom);
     Pen.Color := clBlack;
     Pen.Style := psSolid;
     MoveTo(Left, Top);
     LineTo(Right-1, Bottom-1);
     MoveTo(Right-1, Top);
     LineTo(Left, Bottom-1);
    end
    else
    begin
      if Colors[Index] = clNone
       then Brush.Color := clWhite
       else Brush.Color := Colors[Index];
      if Brush.Color = clDefault then
        Brush.Color := DefaultColor;
      FillRect(LRect);
      Brush.Color := ColorToBorderColor(ColorToRGB(Brush.Color));
      FrameRect(LRect);
    end;

    Brush.Color := LBackground;
    Rect.Left := LRect.Right + 5;

    TextRect(Rect, Rect.Left,
      Rect.Top + (Rect.Bottom - Rect.Top - TextHeight(Items[Index])) div 2,
      Items[Index]);
  end;
end;

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

function TCustomColorBoxSE.GetColorName(Index: Integer): string;
begin
  Result := Items[Index];
end;

function TCustomColorBoxSE.GetColorType(Index: Integer): TFlexColorBoxStyles;
begin
 if (fcbCustomColor in FStyle) and (Index = Items.Count-1) then begin
  Result := fcbCustomColor;
  exit;
 end;
 if fcbNoneColor in FStyle then begin
  if Index = 0 then begin
   Result := fcbNoneColor;
   exit;
  end else
   dec(Index);
 end;
 if fcbDefaultColor in FStyle then begin
  if Index = 0 then begin
   Result := fcbDefaultColor;
   exit;
  end else
   dec(Index);
 end;
 if fcbStandardColors in FStyle then begin
  if Index < StandardColorsCount then begin
   Result := fcbStandardColors;
   exit;
  end else
   dec(Index, StandardColorsCount);
 end;
 if fcbExtendedColors in FStyle then begin
  if Index < ExtendedColorsCount then begin
   Result := fcbExtendedColors;
   exit;
  end{ else
   dec(Index, ExtendedColorsCount);}
 end;
 if fcbSystemColors in FStyle then
  Result := fcbSystemColors
 else
  // Unknown
  Result := fcbCustomColor;
end;

function TCustomColorBoxSE.GetCustomColor: TColor;
begin
 if (fcbCustomColor in FStyle) and (Items.Count > 0)
  then Result := TColor(Items.Objects[Items.Count-1])
  else Result := clBlack;
end;

function TCustomColorBoxSE.GetColorValue: TColor;
begin
  if HandleAllocated then
    if ItemIndex <> -1 then
      Result := Colors[ItemIndex]
    else
      Result := NoColorSelected
  else
    Result := FSelectedColor;
end;

procedure TCustomColorBoxSE.KeyDown(var Key: Word; Shift: TShiftState);
begin
  FListSelected := False;
  inherited KeyDown(Key, Shift);
end;

procedure TCustomColorBoxSE.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  if (fcbCustomColor in Style) and (Key = #13) and (ItemIndex = 0) then
  begin
    { If the user picked a custom color, force a select event to happen
      so the user can handle it }
    if PickCustomColor then Select;
    Key := #0;
  end;
end;

function TCustomColorBoxSE.PickCustomColor: Boolean;
var
  LColor: TColor;
begin
  with TColorDialog.Create(nil) do
    try
      Options := Options + [ cdFullOpen ];
      LColor := ColorToRGB(CustomColor{TColor(Items.Objects[0])});
      Color := LColor;
      //CustomColors.Text := Format('ColorA=%.8x', [LColor]);
      CustomColors.Assign(CustomColors);
      Result := Execute;
      if Result then
      begin
        //Items.Objects[0] := TObject(Color);
        CustomColors.Assign(CustomColors);
        CustomColor := Color;
        Self.Invalidate;
      end;
    finally
      Free;
    end;
end;

procedure TCustomColorBoxSE.PopulateList;
  procedure DeleteRange(const AMin, AMax: Integer);
  var
    I: Integer;
  begin
    for I := AMax downto AMin do
      Items.Delete(I);
  end;
  procedure DeleteColor(const AColor: TColor);
  var
    I: Integer;
  begin
    I := Items.IndexOfObject(TObject(AColor));
    if I <> -1 then
      Items.Delete(I);
  end;
var
  LSelectedColor, LCustomColor: TColor;
  ColorName: string;
begin
  if HandleAllocated then
  begin
    Items.BeginUpdate;
    try
      LCustomColor := clBlack;
      if (fcbCustomColor in Style) and (Items.Count > 0) then
        LCustomColor := CustomColor; //TColor(Items.Objects[0]);
      LSelectedColor := FSelectedColor;
      Items.Clear;
      GetColorValues(ColorCallBack);
      if fcbDefaultColor in Style then begin
        if FColorNames[fcbDefaultColor] <> ''
         then ColorName := FColorNames[fcbDefaultColor]
         else ColorName := ColorToName(clDefault);
        Items.InsertObject(0, ColorName, TObject(clDefault));
      end;
      if fcbNoneColor in Style then begin
        if FColorNames[fcbNoneColor] <> ''
         then ColorName := FColorNames[fcbNoneColor]
         else ColorName := ColorToName(clNone);
        Items.InsertObject(0, ColorName, TObject(clNone));
      end;
      if not (fcbSystemColors in Style) then
        DeleteRange(StandardColorsCount + ExtendedColorsCount, Items.Count - 1);
      if not (fcbExtendedColors in Style) then
        DeleteRange(StandardColorsCount, StandardColorsCount + ExtendedColorsCount - 1);
      if not (fcbStandardColors in Style) then
        DeleteRange(0, StandardColorsCount - 1);
      if fcbCustomColor in Style then begin
        if FColorNames[fcbCustomColor] <> ''
         then ColorName := FColorNames[fcbCustomColor]
         else ColorName := SFlexColorBoxCustomCaption;
        Items.AddObject(ColorName, TObject(LCustomColor));
      end;
      ColorValue := LSelectedColor;
    finally
      Items.EndUpdate;
      FNeedToPopulate := False;
    end;
  end
  else
    FNeedToPopulate := True;
end;

procedure TCustomColorBoxSE.Select;
begin
  if FListSelected then
  begin
    FListSelected := False;
    if (fcbCustomColor in Style) and
       (ColorType[ItemIndex] = fcbCustomColor) then begin
      ColorValue := FSelectedColor; 
      if PickCustomColor then
        ColorValue := CustomColor
      else
        exit;
    end else
      CustomColor := ColorValue;
  end;
  FSelectedColor := ColorValue;
  {$IFDEF DELPHI6_UP}
  inherited Select;
  {$ELSE}
  Change;  
  {$ENDIF}
end;

procedure TCustomColorBoxSE.SetCustomColor(const Value: TColor);
begin
 if (fcbCustomColor in FStyle) and (Items.Count > 0) then begin
  Items.Objects[Items.Count-1] := TObject(Value);
  Invalidate;
 end;
end;

procedure TCustomColorBoxSE.SetDefaultColor(const Value: TColor);
begin
  if Value <> FDefaultColor then
  begin
    FDefaultColor := Value;
    Invalidate;
  end;
end;

procedure TCustomColorBoxSE.SetColorValue(const AColor: TColor);
var
  I, Index: Integer;
begin
  if HandleAllocated then
  begin
    I := Items.IndexOfObject(TObject(AColor));
    if (I = -1) and (fcbCustomColor in Style) and (AColor <> NoColorSelected) then
    begin
      CustomColor{Items.Objects[0]} := AColor;
      I := 0;
    end
    else if (fcbCustomColor in Style) and (ColorType[I] = fcbCustomColor) then
    begin
      { Look for the color anywhere else but the first color before
        defaulting to selecting the "custom color". }
      for Index := 1 to Items.Count - 1 do
      begin
        if Items.Objects[Index] = TObject(AColor) then
        begin
          I := Index;
          Break;
        end;
      end;
    end;
    ItemIndex := I;
    if I <> Items.Count-1 then
      CustomColor := ColorValue;
  end;
  FSelectedColor := AColor;
end;

procedure TCustomColorBoxSE.SetStyle(AStyle: TFlexColorBoxStyle);
begin
  if AStyle <> Style then
  begin
    FStyle := AStyle;
    Enabled := (
      [fcbStandardColors, fcbExtendedColors,
       fcbSystemColors, fcbCustomColor] * FStyle ) <> [];
    PopulateList;
    if (Items.Count > 0) and (ItemIndex = -1) then
      ItemIndex := 0;
  end;
end;

function TCustomColorBoxSE.GetUserColorName(
  const Index: TFlexColorBoxStyles): string;
begin
 Result := FColorNames[Index];
end;

procedure TCustomColorBoxSE.SetUserColorName(const Index: TFlexColorBoxStyles;
  const Value: string);
begin
 if Value = FColorNames[Index] then exit;
 FColorNames[Index] := Value;
 PopulateList;
end;

function TCustomColorBoxSE.StoredUserColorName(
  const Index: TFlexColorBoxStyles): Boolean;
begin
 Result := FColorNames[Index] <> '';
end;

initialization
  CustomColors := TStringList.Create;

finalization
  CustomColors.Free;
  CustomColors := Nil;

end.