fccolorcombo.pas

一套及时通讯的原码

       else
          ColorRect := Classes.Rect(fcmax(Rect.Right-ColorMargin-CWidth,ACanvas.TextWidth(Text)+2*ColorMargin),
                                 Rect.Top + ColorMargin,
                                 Rect.Right - ColorMargin,
                                 Rect.Bottom - ColorMargin);
    end
    else begin
       if (ColorAlignment = taLeftJustify) then
          ColorRect := Classes.Rect(Rect.Left + ColorMargin, Rect.Top + ((Rect.Bottom-Rect.Top-CHeight) div 2),
                                    fcMin(Rect.Left + ColorMargin + CWidth,Rect.Right-(ACanvas.TextWidth(Text)+2*ColorMargin)),
                                    Rect.Bottom - ((Rect.Bottom-Rect.Top-CHeight) div 2))
       else
          ColorRect := Classes.Rect(fcmax(Rect.Right-ColorMargin-CWidth,ACanvas.TextWidth(Text)+2*ColorMargin),
                                 Rect.Top + ColorMargin,
                                 Rect.Right - ColorMargin,
                                 Rect.Bottom - ColorMargin);
    end;

    if (Index = -1) and (AColor = clNullColor) then ColorRect := Classes.Rect(Rect.Left,Rect.Top,Rect.Left,Rect.Top);

    if (Alignment = taLeftjustify) then begin
      if (ColorAlignment=taLeftJustify) then
         TextRect := Classes.Rect(ColorRect.Right + ColorMargin, Rect.Top, Rect.Right-ColorMargin, Rect.Bottom)
      else
         TextRect := Classes.Rect(Rect.Left + ColorMargin,Rect.Top,
                                  fcmax(Rect.Right-ColorMargin-CWidth,ACanvas.TextWidth(Text)+2*ColorMargin),
                                  Rect.Bottom);
    end
    else begin
      if (ColorAlignment=taLeftJustify) then
         TextRect := Classes.Rect(ColorRect.Left + ColorMargin,
                        Rect.Top, Rect.Right-ColorMargin,Rect.Bottom)
      else
         TextRect := Classes.Rect(Rect.Left + ColorMargin,Rect.Top,
                     fcmax(Rect.Right-2*ColorMargin-CWidth,Rect.Left+ACanvas.TextWidth(Text)+ColorMargin),
                     Rect.Bottom);
    end;
  end
  else begin
      ColorRect := Classes.Rect(Rect.Left + ColorMargin, Rect.Top + ColorMargin,
                                Rect.Right - ColorMargin, Rect.Bottom - ColorMargin);

      if (Index = -1) and (AColor = clNullColor) then ColorRect := Classes.Rect(Rect.Left,Rect.Top,Rect.Left,Rect.Top);
  end;

  // Paint background color
  if (ItemIndex <> -1) then begin //3/3/99 - Eliminate Flicker when resizing with Align set.
    ACanvas.Brush.Color := HighlightCol;
    ACanvas.FillRect(Rect);
  end;

  if (AColor <> clNullColor) then begin
  // Paint Color Square
    ACanvas.Pen.Color := HighlightTextCol;
    ACanvas.Brush.Color := CurColor;

    if NoneFlag and
       (odSelected in State) and (odFocused in State) and (ShowText) then
       ACanvas.Brush.Color := GetHighlightColor;

    ACanvas.FillRect(ColorRect);

  // If Displaying Transparent Color Box then don't paint highlight
    if NoneFlag then begin
      if ShowText and (odSelected in State) and (odFocused in State) then
          ACanvas.Pen.Color := HighlightTextCol
      else if (ShowText = True) then
          ACanvas.Pen.Color := OrigFontColor
      else ACanvas.Pen.Color := CurColor;
    end;
    ACanvas.Rectangle(ColorRect.Left, ColorRect.Top, ColorRect.Right, ColorRect.Bottom);
  end;
  ACanvas.Brush.Color := HighlightCol;
  ACanvas.Font.Color := HighlightTextCol;
  SetBkMode(ACanvas.Handle,Transparent);

  NoneStr := NoneString;
  if (ShowText) and (Not NoneFlag) then begin
    if Alignment = taLeftJustify then
//      DrawText(ACanvas.Handle, PChar(GetNamesFromStringList(AllColors,Index)), Length(GetNamesFromStringList(AllColors,Index)), TextRect, DT_SINGLELINE or DT_VCENTER)
      DrawText(ACanvas.Handle, PChar(Text), Length(Text), TextRect, DT_SINGLELINE or DT_VCENTER)
    else
      DrawText(ACanvas.Handle, PChar(Text), Length(Text), TextRect, DT_SINGLELINE or DT_VCENTER or DT_RIGHT);
  end
  else if (ShowText) then begin
    if NoneString = '' then NoneStr := 'None';
    if Alignment = taLeftJustify then
      DrawText(ACanvas.Handle, PChar(NoneStr), Length(NoneStr), TextRect, DT_SINGLELINE or DT_VCENTER)
    else
      DrawText(ACanvas.Handle, PChar(NoneStr), Length(NoneStr), TextRect, DT_SINGLELINE or DT_VCENTER or DT_RIGHT);
  end;

  if NoneFlag then begin
    if (odSelected in State) and (odFocused in State) then
       ACanvas.Pen.Color := HighlightTextCol
    else ACanvas.Pen.Color := OrigFontColor;
    if ShowText then begin
       ACanvas.Polyline([Point(ColorRect.TopLeft.X,ColorRect.TopLeft.Y),
                         Point(ColorRect.BottomRight.X,ColorRect.BottomRight.Y)]);
       ACanvas.Polyline([Point(ColorRect.TopLeft.X,ColorRect.BottomRight.Y-1),
                         Point(ColorRect.BottomRight.X,ColorRect.TopLeft.Y-1)]);
    end
    else begin
       if (odSelected in State) and (odFocused in State) and ShowText then
            ACanvas.Font.Color := HighlightTextCol
       else ACanvas.Font.Color := OrigFontColor;
       DrawText(ACanvas.Handle, PChar(NoneStr), Length(NoneStr), ColorRect,
          DT_SINGLELINE or DT_VCENTER or DT_CENTER);
    end;
  end;
  // Reset Font, Pen, and Brush Colors
  ACanvas.Font.Color := HighlightTextCol;
  ACanvas.Pen.Color := HighlightTextCol;
  ACanvas.Brush.Color := HighlightCol;
  SetBkMode(ACanvas.Handle,Opaque);

  if (odSelected in State) and (odFocused in State) then
     ACanvas.DrawFocusRect(Rect);

 ACanvas.Brush.Color := OrigColor;
 ACanvas.Font.Color := OrigFontColor;
 ACanvas.Pen.Color := OrigPenColor;
 SetBkMode(ACanvas.Handle,OrigBkMode);
end;

procedure TfcCustomColorList.InitColorList;
var i, count: integer;
    FTempList: TStringList;
begin
   FTempList:= TStringList.Create;
                            //Fill Standard and System Colors
   FillColorList(FTempList,FOptions,NoneString);

   FAllColors.Clear;
   for i:=0 to FTempList.Count-1 do
      AddToAllColors(FTempList.Names[i],FTempList.Values[FTempList.Names[i]]);
   FTempList.Free;
                          //Fill with Custom Colors
   if ccoShowCustomColors in Options then
      for i := 0 to FCustomColors.Count - 1 do
         AddToAllColors(FCustomColors.Names[i],fcGetValuesFromStringList(FCustomColors,i));

   for i := 0 to FTempColors.Count - 1 do
      AddToAllColors(FTempColors.Names[i],fcGetValuesFromStringList(FTempColors,i));

   if ccoShowGreyScale in Options then begin
      i:= 0;
      count :=1;
      while i <= 255 do begin
        if AddToAllColors('Grey'+IntToStr(Count),fcRGBToHexString(i,i,i)) then
           count:=count+1;
        i := i+GreyScaleIncrement;
      end;
   end;

{  k:=0;          //Code to add Standard 255 Colors
   count:=0;
   while k<=255 do begin
      j:=0;
      while j<=255 do begin
         i:=0;
         while i<=255 do begin
            if (ValueInList(RGBToHexString(i,j,k),FAllColors)=-1) then begin
               count := count+1;
               FAllColors.Add('MyColor'+IntToStr(Count)+'='+RGBToHexString(i,j,k));
            end;
            i:=i+51;
         end;
         j:=j+51;
      end;
      k:=k+51;
   end;}

   SortList;
end;


{function TfcCustomColorList.MapItemID(val: integer): integer;
begin
   result:= integer(ItemIDMap[val]);
end;
}
// 3/1/99 - Make sure that colorlist invalidates when resizing.
procedure TfcCustomColorList.WMSize(var Message: TWMSize);
begin
  inherited;
  if not (csDesigning in ComponentState) then exit;
  if not (Owner is TfcCustomColorCombo) then invalidate;
end;

procedure TfcCustomColorList.CNDrawItem(var Message: TWMDrawItem);
var
  State: TOwnerDrawState;
  cwidth:Integer;
  AName:String;
  AColor:TColor;
  function GetOwnerDrawStates(AState: DWORD): TOwnerDrawState;
  begin
    result := [];
    if (ODS_CHECKED and AState) = ODS_CHECKED then result := result + [odChecked];
    if (ODS_DISABLED and AState) = ODS_DISABLED then result := result + [odDisabled];
    if (ODS_FOCUS and AState) = ODS_FOCUS then result := result + [odFocused];
    if (ODS_GRAYED and AState) = ODS_GRAYED then result := result + [odGrayed];
    if (ODS_SELECTED and AState) = ODS_SELECTED then result := result + [odSelected];
  end;
begin
//  inherited;   //(This causes control to flicker, removed) -ksw
  with Message.DrawItemStruct^ do
  begin
    if Integer(ItemID) < 0 then begin
       inherited;
       exit;
    end;
    State := GetOwnerDrawStates(itemState);
    Canvas.Handle := hDC;
    Canvas.Font := Font;
    Canvas.Brush := Brush;

    if ColorWidth = 0 then
       cwidth := ItemHeight-(2*ColorMargin)
    else cwidth := ColorWidth;

    AName := '';
    AColor := clWindow;
    if (ItemId <> $FFFFFFFF) then  // Changed from -1 to avoid compiler warning. -ksw (9/18/98)
    begin
      AName := Items.Names[ItemId];
      AColor := StringToColor('$'+Items.Values[AName]);
    end;

{    if (cslbuttondown in controlstate) and not PtInRect(ClientRect,ScreenToClient(fcGetCursorPos)) then
    begin
        State := State - [odfocused];
    end;}

    DoDrawItem(Canvas, itemID, cwidth, ItemHeight-2*ColorMargin, rcItem, State, AName, AColor);

    Canvas.Handle := 0;
  end;
end;

function TfcCustomColorList.GetItemIndex: integer;
begin
   if MultiSelect then
      Result := SendMessage(Handle, LB_GETCARETINDEX, 0, 0)
   else Result := SendMessage(Handle, LB_GETCURSEL, 0, 0);
end;

Procedure TfcCustomColorList.SetItemIndex(Value: integer);
begin
   if MultiSelect then
      SendMessage(Handle, LB_SETCARETINDEX, Value, 0)
   else SendMessage(Handle, LB_SETCURSEL, Value, 0);

   if Value <> ItemIndex then
      inherited ItemIndex:= value;

   if (Value < Items.Count) and (Value <> -1) then
      FSelectedColor := StringToColor('$'+Items.Values[Items.Names[Value]])
      //fcGetColorFromList(FAllColors,Value)
   else FSelectedColor := clNullColor;
end;

procedure TfcCustomColorList.SetSortBy(Value: TfcSortByOption);
begin
  if FSortByOption <> Value then
  begin
    FSortByOption := Value;
    //2/26/99 - Set Sorted only when byname.
    //3/2/99 - Sort Only when byName and not Grouping System Colors.
    inherited Sorted := (FSortByOption = csoByName) and not (ccoGroupSystemColors in Options);
    SortList;
  end;
end;

procedure TfcCustomColorList.SetGreyScaleIncrement(Value: Integer);
begin
  if (FGreyScaleIncrement <> Value) and
      (Value > 0) and (Value <=255) then begin
     FGreyScaleIncrement := Value;
     if not (csLoading in ComponentState) then InitColorList;
  end;
end;

procedure TfcCustomColorList.SetNoneString(Value: String);
begin
  if (FNoneString <> Value) then begin
     FNoneString := Value;
     if not (csLoading in ComponentState) then InitColorList;
  end;
end;

procedure TfcCustomColorList.SetSelectedColor(Value: TColor);
var i: integer;
begin
  if Value <> SelectedColor then
  begin
     FSelectedColor := Value;
     { 4/11/99 - RSW - Used to be before  Value <> SelectedColor comparison,
       which prevented internal value from being updated during streaming}
     if FAllColors.Count = 0 then Exit;

     i := fcValueInList(IntToHex(Value,6), FAllColors);
     if i<> -1 then i := Items.indexofname(allcolors.Names[i]);
     if i >= 0 then ItemIndex := i
     else begin
       if Value <> clNullColor then begin    //3/1/99 - Check for NullColor
         AddToAllColors(fcColorToRGBString(Value),IntToHex(Value,6));
         //3/3/99 -PYW- Don't add twice and don't reset itemindex to wrong value. 
{         if AddToAllColors(fcColorToRGBString(Value),IntToHex(Value,6)) then
         begin
            Items.Add(fcColorToRGBString(Value));
            ItemIndex := Items.Count - 1;
            SortList;
         end;        }
       end
       else begin
         ItemIndex := -1;
       end;
     end;
  end;
end;

function TfcCustomColorList.GetSelectedColor: TColor;
begin
  if ItemIndex = -1 then
     result := clNullColor
  else result := FSelectedColor;
end;

//Returns whether or not Color was added to the list...
function TfcCustomColorList.AddToAllColors(AName,AValue:String) : Boolean;
var curColor:TColor;
    ColorNotInList,accept,IsCustomColor: Boolean;
begin
  result := False;
  accept := True;
  ColorNotInList := False;
  if (fcValueInList(AValue,FAllColors)=-1) then
     ColorNotInList := True;

  curColor:=  StringToColor('$'+AValue);
  IsCustomColor := (Pos('RGB:',AName)=1);

  //3/4/99 - Don't call onaddnewcolors for non customcolors.
  if IsCustomColor and Assigned(FOnAddNewColor) then FOnAddNewColor(self, curColor, AName, accept);

  if not accept then exit;
  if (fcNameInList(AName,FAllColors)=-1) and (ColorNotInList) then begin
     result := True;
     FAllColors.Add(AName+'='+AValue);
     if IsCustomColor then begin
        FTempColors.Add(AName+'='+AValue);
        SortList;
     end;
  end;
end;

procedure TfcCustomColorList.SetCustomColors(Value: TStringList);
var dup:String;
begin
  FCustomColors.Assign(Value);
  if not (csLoading in ComponentState) then InitColorList;
  if HasDuplicateNames(dup) then
     MessageDlg('Duplicate Color Name Not Allowed: '+dup, mtWarning, [mbok], 0);
end;

procedure TfcCustomColorList.SetAlignment(Value: TLeftRight);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    Invalidate;
//    RecreateWnd;
  end;
end;