fccolorcombo.pas

一套及时通讯的原码

procedure TfcCustomColorList.SetColorAlignment(Value: TLeftRight);
begin
  if FColorAlignment <> Value then
  begin
    FColorAlignment := Value;
    RecreateWnd;
  end;
end;

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

procedure TfcCustomColorList.SetColorMargin(Value: Integer);
begin
  if FColorMargin <> Value then
  begin
    if Value >= 0 then begin
       FColorMargin := Value;
       Invalidate;
    end;
  end;
end;

function TfcCustomColorList.GetEditRectHeight: Integer;
var
  DC: HDC;
  SaveFont: HFont;
  I: Integer;
  SysMetrics, Metrics: TTextMetric;
begin
  DC := GetDC(0);
  GetTextMetrics(DC, SysMetrics);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
  I := SysMetrics.tmHeight;
  if I > Metrics.tmHeight then I := Metrics.tmHeight;
  result := I;
end;

// Custom Color Combo
procedure TfcCustomColorCombo.SetAlignment(Value: TLeftRight);
begin
  if FAlignment <> Value then FAlignment := Value;
end;

{
procedure TfcCustomColorCombo.SetAlignmentVertical(Value: TfcAlignVertical);
begin
  if FAlignmentVertical <> Value then begin
     FAlignmentVertical := Value;
     Invalidate;
  end;
end;
}
procedure TfcCustomColorCombo.SetColorAlignment(Value: TLeftRight);
begin
  if FColorAlignment <> Value then begin
     FColorAlignment := Value;
     if FListBox <> nil then
        FListBox.ColorAlignment := Value;
     SetEditRect;
     Invalidate;
  end;
end;

procedure TfcCustomColorCombo.SetCustomColors(Value: TStringList);
begin
  FCustomColors.Assign(Value);
  if FListbox <> nil then
  begin
     FListBox.CustomColors.Assign(Value);
     FListBox.InitColorList;
  end
end;

procedure TfcCustomColorCombo.SetItemIndex(Value: integer);
begin
   if Value < -1 then Value := -1;
   ListBoxNeeded;
   if Value >= Listbox.Items.Count then Value := FListBox.Items.Count - 1;

   if FItemIndex <> Value then begin
      FItemIndex := Value;
      FListBox.ItemIndex := Value;

      if FItemIndex <> -1 then
         FSelectedColor := StringToColor('$'+Listbox.Items.Values[Listbox.Items.Names[FItemIndex]])
//         fcGetColorFromList(FListBox.AllColors,FItemIndex)
      else FSelectedColor := clNullColor;

      if FItemIndex <> -1 then
         Text := Listbox.Items.Names[FItemIndex];
         //fcGetNamesFromStringList(ListBox.AllColors,Fitemindex);

      invalidate;
   end;
end;

{ RSW }
procedure TfcCustomColorCombo.UpdateSelectedColor;
var AName:String;
    i:integer;
    Value: integer;
begin
     Value:= SelectedColor;

     if Value=clNullColor then begin //3/1/99 - Check for SelectedColor.
       FListBox.SelectedColor := clNullColor;
       Text:= '';
       invalidate;
       exit;
     end;

     i := fcValueInList(IntToHex(Value,6),FListBox.AllColors);
     if i = -1 then
     begin
        AName := fcColorToRGBString(Value);
        FListBox.AddToAllColors(AName,IntToHex(Value,6));
        if fcValueInList(IntToHex(Value,6),FListBox.AllColors) = -1 then exit;
     end;

     FListBox.SelectedColor := Value;

     i := fcValueInList(IntToHex(Value,6),FListBox.AllColors);
     if i<> -1 then i := Listbox.Items.indexofname(Listbox.Allcolors.Names[i]);
     if i<> -1 then SetComboText(Listbox.items.names[i])
     else SetComboText('');
     Invalidate;
end;

procedure TfcCustomColorCombo.SetSelectedColor(Value: TColor);
begin
  if FSelectedColor <> Value then
  begin
     FSelectedColor := Value;
     if not HandleAllocated then exit;
     ListBoxNeeded;
     UpdateSelectedColor; { RSW }

//     if csLoading in ComponentState then Exit;   // Causes a resource leak if ListBoxNeeded called here -ksw (2/18/99)
(*     ListBoxNeeded;
     i := fcValueInList(IntToHex(Value,6),FListBox.AllColors);
     if i = -1 then
     begin
        AName := fcColorToRGBString(Value);
        FListBox.AddToAllColors(AName,IntToHex(Value,6));
        if fcValueInList(IntToHex(Value,6),FListBox.AllColors) = -1 then exit;
     end;
     FListBox.SelectedColor := Value;
     i := fcValueInList(IntToHex(Value,6),FListBox.AllColors);
     if i<> -1 then i := Listbox.Items.indexofname(Listbox.Allcolors.Names[i]);
     if i<> -1 then SetComboText(Listbox.items.names[i])
     else SetComboText('');
     Invalidate;
*)
  end;
end;

procedure TfcCustomColorCombo.CustomColorsChangeEvent(Sender: TObject);
begin
   ListBoxNeeded;
   FListBox.CustomColors.Assign(CustomColors);
   FListBox.SelectedColor := SelectedColor;
end;

procedure TfcCustomColorCombo.AddNewColorEvent(Sender: TObject; AColor:TColor;
  var AColorName:String; var Accept: Boolean);
begin
  if Assigned(FOnAddNewColor) then FOnAddNewColor(Sender, AColor, AColorName, Accept);
end;

procedure TfcCustomColorCombo.OnFilterColorEvent(Sender: TObject; AColor:TColor;
  AColorName:String; var Accept: Boolean);
begin
  if Assigned(FOnFilterColor) then FOnFilterColor(Sender, AColor, AColorName, Accept);
end;

procedure TfcCustomColorCombo.ListMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FCloseOnUp := False;
  if PtInRect(FListBox.ClientRect, Point(X,Y)) then
     FCloseOnUp := True;

  FSelectedItemIndex := FListBox.ItemIndex;
  inherited;
end;

procedure TfcCustomColorCombo.ListMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if (Button = mbLeft) and FCloseOnUp then begin
    if not PtInRect(FListBox.ClientRect, Point(X,Y)) then begin
       FListBox.ItemIndex := FSelectedItemIndex;
       FSelectedColor := Listbox.OldSelectedColor;
    end;
    CloseUp(True);
  end;

  FCloseOnUp := False;
end;

procedure TfcCustomColorCombo.CMExit(var Message: TCMExit);
begin
  // 2/23/99 - Not necessary anymore.
{  if (Style = csDropDownList) then
     if (ItemIndex = -1) and (Text <> '')  then begin
        EditCanModify;
        SetModified(True);
        Text := ''
     end
     else if (ItemIndex <> -1) and (Text <> Listbox.Items.Names[ItemIndex]) then
     begin
        EditCanModify;
        SetModified(True);
        Text := Listbox.Items.Names[ItemIndex];
     end;}
  inherited;
//  if not Editable then Invalidate;
end;

procedure TfcCustomColorCombo.CMTextChanged(var Message: TMessage);
var s:String;
begin
  inherited;
  if skipTextChange then exit;
  if (DataLink.Field = nil) then exit;

  if {(GetComboDataType=ccdColor) and }(fcisinwwgrid(self)) then begin
     s:= inherited text;
     SkipTextChange := True;
     if (StrToIntDef(s,-1) <> -1) then
        Text := GetComboDisplayText(StrToIntDef(s,-1));
     SkipTextChange := False;
  end;
end;

procedure TfcCustomColorCombo.CNCommand(var Message: TWMCommand);
begin
  if Message.NotifyCode <> CBN_DBLCLK then inherited;
end;

procedure TfcCustomColorCombo.CNKeyDown(var Message: TWMKeyDown);
begin
  inherited;
end;

procedure TfcCustomColorCombo.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  skipDropDown:=True;  //3/4/99-PYW-SkipDropDown when double clicking.
  try
    inherited;
    if (cdoEnabled in FColorDialogOptions) then begin
       ListBox.UpdateItems;
       ExecuteColorDialog;
    end;
  finally
    skipDropDown:=False;
  end;
end;

procedure TfcCustomColorCombo.WMPaste(var Message: TMessage);
begin
  inherited;
  ItemIndex := fcNameinList(Text,ListBox.AllColors); //!!
end;

procedure TfcCustomColorCombo.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
{  if ItemIndex <> -1 then
     ListBox.SelectedColor := fcGetColorFromList(ListBox.FAllColors,ItemIndex)
  else ListBox.SelectedColor := clNullColor;
  invalidate;}
//  if not Editable then
//     HideCaret(Handle);
end;

procedure TfcCustomColorCombo.CloseUp(Accept: Boolean);
var IsDroppedDown: Boolean;
    ListValue: String;
    i:integer;
begin
   IsDroppedDown := self.IsDroppedDown;
   inherited;
   if IsDroppedDown then begin

     if Accept and (FListBox.SelectedColor<>FOriginalSelectedColor) and EditCanModify {2/11/99 - RSW } then
     begin
        if (FListbox.ItemIndex <> -1) then begin
           ListValue := Listbox.Items.Names[Listbox.ItemIndex];
           if (ListValue <> '') then

//           if {((FListBox.ItemIndex <> ItemIndex) or (ListValue<>Text)) and }EditCanModify then
//           begin
              FItemIndex:= FListBox.itemIndex;
              SetModifiedInChangeEvent:=true;
              SelectedColor := ListBox.SelectedColor;
              if ListValue<>'' then Text:= ListValue;
              SetModifiedInChangeEvent:=false;
              SetModified(True);
//           end;
        end;
     end
     else begin
        i := fcValueInList(IntToHex(FOriginalSelectedColor,6),Listbox.AllColors);
        if i<> -1 then i := Listbox.Items.indexofname(Listbox.allcolors.Names[i]);

        ItemIndex := i;
        SelectedColor := FOriginalSelectedColor;
       //2/17/99 - Update Text if Text doesn't match
        if (ItemIndex <> -1) and
           (Text <> FListbox.Items.Names[ItemIndex]) then
              Text := FListbox.Items.Names[ItemIndex]
     end;
     DoCloseUp(Accept);

   end;
   SelectAll;
end;

procedure TfcCustomColorCombo.CreateWnd;
begin
  inherited CreateWnd;
  if not (csDesigning in ComponentState) then begin
     ListBoxNeeded;
  end;
end;

procedure TfcCustomColorCombo.DataChange(Sender: TObject);
begin
  //3/25/99-PYW-Exit if Combo is being destroyed.
  if (csDestroying in ComponentState) then exit;

  if SkipDataChange then exit;

  if DataLink.Field <> nil then
  begin
    if FAlignment <> DataLink.Field.Alignment then
    begin
//      Text := '';  {forces update}
//      FAlignment := DataLink.Field.Alignment;
    end;

    if not (csDesigning in ComponentState) then
    begin
      if (DataLink.Field.DataType = ftString) and (MaxLength = 0) then
        MaxLength := DataLink.Field.Size;
    end;
    if Focused and DataLink.CanModify then begin
      if GetComboDataType=ccdColor then
         // 10/12/2000 - PYW - Check for Null to initialize to blank.
         if (Not Datalink.Field.IsNull) then
            Text := GetComboDisplayText(Datalink.Field.AsInteger)
         else Text :=''
      else Text := DataLink.Field.Text;
    end
    else begin
      if GetComboDataType=ccdColor then begin
         if Datalink.Field.DisplayText <> '' then begin
            if StrToIntDef(Datalink.Field.DisplayText,-1) <> -1 then
               Text := GetComboDisplayText(StrToIntDef(Datalink.Field.DisplayText,-1));
         e