scomboboxes.pas

AlphaControls是一个Delphi标准控件的集合

        InflateRect(R, 2, 2);
        BitBlt(Bmp.Canvas.Handle, R.Left, R.Top, WidthOf(R), HeightOf(R), FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
      end;
      Bmp.Canvas.Brush.Color := Colors[Index];
      if ShowcolorName then begin
        R := ColorRect(Rect, State);

        if Bmp.Canvas.Brush.Color = clDefault then begin
          Bmp.Canvas.Brush.Color := DefaultColorColor
        end
        else if Bmp.Canvas.Brush.Color = clNone then begin
          Bmp.Canvas.Brush.Color := NoneColorColor;
        end;
        Bmp.Canvas.FillRect(R);
        Bmp.Canvas.Brush.Color := ColorToBorderColor(ColorToRGB(Brush.Color));
        Bmp.Canvas.FrameRect(R);

        Rect.Left := R.Right + 5;

        Bmp.Canvas.Brush.Style := bsClear;
        if (odFocused in state) and gd[FCommonData.SkinIndex].ShowFocus then begin
          Bmp.Canvas.TextRect(Rect, Rect.Left,
            Rect.Top + (Rect.Bottom - Rect.Top - Bmp.Canvas.TextHeight(Items[Index])) div 2,
            Items[Index]);
        end
        else begin
          WriteTextEx(Bmp.Canvas, PChar(Items[Index]),
                 Enabled,
                 Rect, 0, FCommonData.SkinIndex, FCommonData.ControlIsActive);
        end;
      end
      else begin
        R := ColorRect(Rect, State);

        if Bmp.Canvas.Brush.Color = clDefault then begin
          Bmp.Canvas.Brush.Color := DefaultColorColor
        end
        else if Bmp.Canvas.Brush.Color = clNone then begin
          Bmp.Canvas.Brush.Color := NoneColorColor;
        end;
        Bmp.Canvas.FillRect(R);
        Bmp.Canvas.Brush.Color := ColorToBorderColor(ColorToRGB(Brush.Color));
        Bmp.Canvas.FrameRect(R);
      end;
    end;

    if not Enabled then begin
      CI.Bmp := CommonData.FCacheBmp;
      CI.X := 0;
      CI.Y := 0;
      CI.Ready := True;
      BmpDisabledKind(Bmp, DisabledKind, Parent, CI, Point(aRect.Left, aRect.Top));
    end;
//    BitBlt(Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, SRCCOPY);
    BitBlt(Canvas.Handle, aRect.Left, aRect.Top, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, SRCCOPY);
    FreeAndNil(Bmp);
  end
  else begin
    if odFocused in state then begin
      Canvas.Brush.Color := clHighLight;
      Canvas.Font.Color := clHighlightText;
      Canvas.FillRect(Classes.Rect(R.Left, R.Top, R.Right, R.Bottom));
      DrawFocusRect(Canvas.Handle, Classes.Rect(R.Left, R.Top, R.Right, R.Bottom));
    end
    else begin
      Canvas.Brush.Color := clWindow;
      Canvas.FillRect(Rect);
      Canvas.Font.Color := clWindowText;
    end;

    R := Rect;
    R.Right := R.Bottom - R.Top + R.Left;
    InflateRect(R, -1, -1);

    Canvas.Brush.Color := Colors[Index];
    if Canvas.Brush.Color = clDefault then begin
      Canvas.Brush.Color := DefaultColorColor
    end
    else if Canvas.Brush.Color = clNone then begin
      Canvas.Brush.Color := NoneColorColor;
    end;
    Canvas.FillRect(R);
    Canvas.Brush.Color := ColorToBorderColor(ColorToRGB(Brush.Color));
    Canvas.FrameRect(R);

    Rect.Left := R.Right + 5;

    Canvas.Brush.Style := bsClear;
    Canvas.TextRect(Rect, Rect.Left,
      Rect.Top + (Rect.Bottom - Rect.Top - Canvas.TextHeight(Items[Index])) div 2,
      Items[Index]);
  end;
end;

function TsCustomColorBox.GetColor(Index: Integer): TColor;
begin
  if Index < 0 then begin
    Result := clNone;
    Exit;
  end;
  Result := TColor(Items.Objects[Index]);
end;

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

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

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

procedure TsCustomColorBox.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  if (cbCustomColor in Style) and (Key = #13) and (ItemIndex = 0) then
  begin
    PickCustomColor;
    Key := #0;
  end;
end;

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

procedure TsCustomColorBox.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;
begin
  if HandleAllocated then
  begin
    Items.BeginUpdate;
    try
      LCustomColor := clBlack;
      if (cbCustomColor in Style) and (Items.Count > 0) then
        LCustomColor := TColor(Items.Objects[0]);
      LSelectedColor := FSelectedColor;
      Items.Clear;
      GetColorValues(ColorCallBack);
      if not (cbIncludeNone in Style) then
        DeleteColor(clNone);
      if not (cbIncludeDefault in Style) then
        DeleteColor(clDefault);
      if not (cbSystemColors in Style) then
        DeleteRange(StandardColorsCount + ExtendedColorsCount, Items.Count - 1);
      if not (cbExtendedColors in Style) then
        DeleteRange(StandardColorsCount, StandardColorsCount + ExtendedColorsCount - 1);
      if not (cbStandardColors in Style) then
        DeleteRange(0, StandardColorsCount - 1);
      if cbCustomColor in Style then
        Items.InsertObject(0, 'Custom...', TObject(LCustomColor));
      Selected := LSelectedColor;
    finally
      Items.EndUpdate;
      FNeedToPopulate := False;
    end;
  end
  else
    FNeedToPopulate := True;
end;

procedure TsCustomColorBox.Select;
begin
  if FListSelected then begin
    FListSelected := False;
    if (cbCustomColor in Style) and
         (ItemIndex = 0) and
           not PickCustomColor then
      Exit;
  end;
  inherited Select;
end;

procedure TsCustomColorBox.SetDefaultColorColor(const Value: TColor);
begin
  if Value <> FDefaultColorColor then begin
    FDefaultColorColor := Value;
    FCommonData.Invalidate;
  end;
end;

procedure TsCustomColorBox.SetMargin(const Value: integer);
begin
  if FMargin <> Value then begin
    FMargin := Value;
    FMargin := min(FMargin, Height div 2);
    FCommonData.Invalidate;
  end;
end;

procedure TsCustomColorBox.SetNoneColorColor(const Value: TColor);
begin
  if Value <> FNoneColorColor then
  begin
    FNoneColorColor := Value;
    FCommonData.Invalidate;
  end;
end;

procedure TsCustomColorBox.SetSelected(const AColor: TColor);
var
  I: Integer;
begin
  if HandleAllocated then begin
    I := Items.IndexOfObject(TObject(AColor));
    if (I = -1) and (cbCustomColor in Style) and (AColor <> NoColorSelected) then begin
      Items.Objects[0] := TObject(AColor);
      I := 0;
    end;
    ItemIndex := I;
  end;
  FSelectedColor := AColor;
end;

procedure TsCustomColorBox.SetShowColorName(const Value: boolean);
begin
  if FShowColorName <> Value then begin
    FShowColorName := Value;
    FCommonData.Invalidate;
  end;
end;

procedure TsCustomColorBox.SetStyle(AStyle: TsColorBoxStyle);
begin
  if AStyle <> Style then begin
    FStyle := AStyle;
    Enabled := ([cbStandardColors, cbExtendedColors, cbSystemColors, cbCustomColor] * FStyle) <> [];
    PopulateList;
    if (Items.Count > 0) and (ItemIndex = -1) then ItemIndex := 0;
  end;
end;

{ TsCustomComboBoxStrings }

procedure TsCustomComboBoxStrings.Clear;
var
  S: string;
begin
  S := ComboBox.Text;
  SendMessage(ComboBox.Handle, CB_RESETCONTENT, 0, 0);
  ComboBox.Text := S;
  ComboBox.Update;
end;

procedure TsCustomComboBoxStrings.Delete(Index: Integer);
begin
  SendMessage(ComboBox.Handle, CB_DELETESTRING, Index, 0);
end;

function TsCustomComboBoxStrings.Get(Index: Integer): string;
var
  Text: array[0..4095] of Char;
  Len: Integer;
begin
  Len := SendMessage(ComboBox.Handle, CB_GETLBTEXT, Index, Longint(@Text));
  if Len = CB_ERR then Len := 0;
  SetString(Result, Text, Len);
end;

function TsCustomComboBoxStrings.GetCount: Integer;
begin
  Result := SendMessage(ComboBox.Handle, CB_GETCOUNT, 0, 0);
end;

function TsCustomComboBoxStrings.GetObject(Index: Integer): TObject;
begin
  Result := TObject(SendMessage(ComboBox.Handle, CB_GETITEMDATA, Index, 0));
  if Longint(Result) = CB_ERR then
    Error('List index out of bounds', Index);
end;

function TsCustomComboBoxStrings.IndexOf(const S: string): Integer;
begin
  Result := SendMessage(ComboBox.Handle, CB_FINDSTRINGEXACT, -1, LongInt(PChar(S)));
end;

procedure TsCustomComboBoxStrings.PutObject(Index: Integer;
  AObject: TObject);
begin
  SendMessage(ComboBox.Handle, CB_SETITEMDATA, Index, Longint(AObject));
end;

procedure TsCustomComboBoxStrings.SetUpdateState(Updating: Boolean);
begin
  SendMessage(ComboBox.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  if not Updating then ComboBox.Refresh;
end;

{ TsComboBoxStrings }

function TsComboBoxStrings.Add(const S: string): Integer;
begin
  Result := SendMessage(ComboBox.Handle, CB_ADDSTRING, 0, Longint(PChar(S)));
  if Result < 0 then
    raise EOutOfResources.Create(SInsertLineError);
end;

procedure TsComboBoxStrings.Insert(Index: Integer; const S: string);
begin
  if SendMessage(ComboBox.Handle, CB_INSERTSTRING, Index,
    Longint(PChar(S))) < 0 then
    raise EOutOfResources.Create(SInsertLineError);
end;

{ TsCustomComboBoxEx }

constructor TsCustomComboBoxEx.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Style := csOwnerDrawVariable;
  FItemsEx := TsComboItems.Create(Self);
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := ImageListChange;
  UpdateList;
end;

procedure TsCustomComboBoxEx.CreateWnd;
begin
  inherited CreateWnd;
  if NeedToUpdate then UpdateList;
  UpdateMargins;
end;

function TsCustomComboBoxEx.CurrentImage(Item : TsComboItem; State: TOwnerDrawState): integer;
begin
  Result := -1;
  if (Images = nil) or (Item = nil) then Exit;
  if odComboBoxEdit in State then begin
    Result := Item.ImageIndex;
  end
  else if odSelected in State then begin
    Result := Item.SelectedImageIndex;
    if Result < 0 then Result := Item.ImageIndex;
  end
  else begin
    Result := Item.ImageIndex;
  end;
end;

destructor TsCustomComboBoxEx.Destroy;
begin
  if Assigned(FItemsEX) then FreeAndNil(FItemsEx);
  FreeAndNil(FImageChangeLink);
  inherited Destroy;
end;

procedure TsCustomComboBoxEx.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  R, rText : TRect;
  i : integer;
  function ColorToBorderColor(AColor: TColor): TColor; begin
    if (TsColor(AColor).R > 192) or (TsColor(AColor).G > 192) or (TsColor(AColor).B > 192) then
      Result := clBlack
    else if odSelected in State then
      Result := clWhite
    else
      Result := AColor;
  end;
begin
  R := Rect;
  Canvas.Brush.Style := bsSolid;
  if odComboBoxEdit in State then begin // if editor window ...
    R.Right := R.Right - WidthOf(ButtonRect);
    if (CommonData.Ffocused or Focused or (odFocused in state)) and not DroppedDown then begin
      Canvas.Brush.Color := clHighLight;
      Canvas.FillRect(R);
//      DrawFocusRect(Canvas.Handle, Classes.Rect(R.Left + 1, R.Top + 1, R.Right, R.Bottom));
    end
    else begin
      Canvas.Brush.Color := Color;
      Canvas.FillRect(R);
    end;
    R.Right := R.Right - 3;
    if Index > -1 then begin
      R := ImgRect(SelectedItem, State);
      i := CurrentImage(ItemsEx[Index], State);
      if i > -1 then begin
        Images.Draw(FCanvas, R.Left, R.Top, i, Enabled);
      end else R.Bottom := Rect.bottom;
    end;
    // Text out
    rText := R;