TCheckComboBox: Komponente überarbeiten???

[romber]

Hallo!

Ich habe eine tolle CheckComboBox gefunden, die auf TCustomComboBox basiert. Ich weiss nicht, ob es richtig war, das gesamte Unit hier zu posten, für alle Fälle ist Unit auch angehängt. Kann mir jemand helfen, dieses Unit zu bearbeiten, damit die mit CheckBoxen ausgewählte Items eine bestimmte Farbe im Hintergrund haben? Im Voraus vielen Dank!

Noch eine Frage: Wenn ich es richtig verstehe, wird die Bitmap, die den CheckBox darstellt, aus der Ressource geladen wird. Gibt es eine Möglichkeit, einen üblichen Ansicht für CheckBox zu realisieren, der auch auf Laufzeit themen reagiert?

Delphi-Quellcode:

unit ATCheckedComboBox;

interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls;
type

   TATCBQuoteStyle   = (qsNone,qsSingle,qsDouble);

   TATCheckedComboBox = class(TCustomComboBox)
   private
      { Private declarations }
      FListInstance   : Pointer;
      FDefListProc   : Pointer;
      FListHandle    : HWnd;
      FQuoteStyle      : TATCBQuoteStyle;
      FColorNotFocus: TColor;
      FCheckedCount : integer;
      FTextAsHint    : boolean;
      FOnCheckClick : TNotifyEvent;
      FVersion        : String;
      procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
      procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
      procedure CMExit(var Message: TCMExit); message CM_EXIT;
      procedure ListWndProc(var Message: TMessage);
      procedure SetColorNotFocus(value:TColor);
      procedure SetVersion(value:String);
   protected
      { Protected declarations }
      m_strText          : string;
      m_bTextUpdated   : boolean;
      procedure WndProc(var Message: TMessage);override;
      procedure RecalcText;
      function GetText: string;
      function GetCheckedCount:integer;
   public
      { Public declarations }
      constructor Create(AOwner: TComponent);override;
      destructor    Destroy; override;
      procedure    SetCheck(nIndex:integer;checked:boolean);
      function       AddChecked(value:string;checked:boolean):integer;
      function       IsChecked(nIndex: integer):boolean;
      procedure    CheckAll(checked:boolean);
      property       Text:string read GetText;
      property      CheckedCount :integer read GetCheckedCount;
   published
      { Published declarations }
      property Anchors;
      property BiDiMode;
      property Color;
      property ColorNotFocus : TColor   read FColorNotFocus write SetColorNotFocus;
      property Constraints;
      property Ctl3D;
      property DragCursor;
      property DragKind;
      property DragMode;
      property DropDownCount;
      property Enabled;
      property Font;
      property ImeMode;
      property ImeName;
      property ItemHeight;
      property Items;
      property MaxLength;
      property ParentBiDiMode;
      property ParentColor;
      property ParentCtl3D;
      property ParentFont;
      property ParentShowHint;
      property PopupMenu;
      property QuoteStyle   : TATCBQuoteStyle read FQuoteStyle   write FQuoteStyle default qsNone;
      property ShowHint;
      property ShowTextAsHint : Boolean read FTextAsHint write FTextAsHint default true;
      property Sorted;
      property TabOrder;
      property TabStop;
      property Visible;
      property Version :string read FVersion write SetVersion; // ver 1.1
      property OnChange;
      property OnCheckClick: TNotifyEvent read FOnCheckClick write FOnCheckClick;
      property OnClick;
      property OnDblClick;
      property OnDragDrop;
      property OnDragOver;
      property OnDropDown;
      property OnEndDock;
      property OnEndDrag;
      property OnEnter;
      property OnExit;
      property OnKeyDown;
      property OnKeyPress;
      property OnKeyUp;
      property OnStartDock;
      property OnStartDrag;
   end;

procedure Register;

implementation

{ TATCheckedComboBox }
procedure Register;
begin
   RegisterComponents('Samples', [TATCheckedComboBox]);
end;

var
   FCheckWidth, FCheckHeight: Integer;

procedure GetCheckSize;
begin
   with TBitmap.Create do
      try
         Handle := LoadBitmap(0, PChar(32759));
         FCheckWidth := Width div 4;
         FCheckHeight := Height div 3;
      finally
         Free;
      end;
end;

procedure TATCheckedComboBox.SetVersion(value: String);
begin
   // read only
end;

procedure TATCheckedComboBox.SetCheck(nIndex:integer;checked:boolean);
begin
   if (nIndex>-1) and (nIndex<Items.count) then
   begin
      Items.Objects[nIndex] := TObject(checked);
      m_bTextUpdated := FALSE;
      Invalidate;
      if Assigned(FOnCheckClick) then
         OnCheckClick(self)
   end;
end;

function TATCheckedComboBox.AddChecked(value:string;checked:boolean):integer;
begin
   result := Items.AddObject(value, TObject(checked));
   if result>=0 then
   begin
      m_bTextUpdated := FALSE;
      Invalidate;
   end;
end;

function TATCheckedComboBox.IsChecked(nIndex: integer):boolean;
begin
   result := false;
   if (nIndex>-1) and (nIndex<Items.count) then
      result := Items.Objects[nIndex] = TObject(TRUE)
end;

procedure TATCheckedComboBox.CheckAll(checked:boolean);
var i:integer;
begin
   for i:= 0 to Items.count-1 do
      Items.Objects[i] := TObject(checked);
end;

function GetFormatedText(kind:TATCBQuoteStyle;str:string):string;
var s : string;
begin
   result := str;
   if length(str)>0 then
   begin
      s := str;
      case kind of
         qsSingle   : result :=
               ''''+
               StringReplace(S, ',', ''',''',[rfReplaceAll])+
               '''';
         qsDouble    : result :=
               '"'+
               StringReplace(S, ',', '","',[rfReplaceAll])+
               '"';
      end;
   end;
end;

function TATCheckedComboBox.GetText: string;
begin
   RecalcText;
   if FQuoteStyle = qsNone then
      result := m_strText
   else
      result := GetFormatedText(FQuoteStyle,m_strText);
end;

function TATCheckedComboBox.GetCheckedCount:integer;
begin
   RecalcText;
   result := FCheckedCount;
end;


procedure TATCheckedComboBox.RecalcText;
var
      nCount,i    : integer;
      strItem,
      strText,
      strSeparator : string;
begin
   if (not m_bTextUpdated) then
   begin
      FCheckedCount   := 0;
      nCount          := items.count;
      strSeparator    := '; ';
      strText          := '';
      for i := 0 to nCount - 1 do
         if IsChecked(i) then
         begin
            inc(FCheckedCount);
            strItem := items[i];
            if (strText<>'') then
               strText := strText + strSeparator;
            strText := strText + strItem;
         end;
      // Set the text
      m_strText          := strText;
      if FTextAsHint then
         Hint := m_strText;
      m_bTextUpdated    := TRUE;
   end;
end;

procedure TATCheckedComboBox.SetColorNotFocus(value:TColor);
begin
    if FColorNotFocus <> Value then
      FColorNotFocus := Value;
   Invalidate
end;

procedure TATCheckedComboBox.CMEnter(var Message: TCMEnter);
begin
   Self.Color      := clWhite;
   if Assigned(OnEnter) then OnEnter(Self);
end;

procedure TATCheckedComboBox.CMExit(var Message: TCMExit);
begin
   Self.Color       := FColorNotFocus;
   if Assigned(OnExit) then OnExit(Self);
end;


procedure TATCheckedComboBox.CNDrawItem(var Message: TWMDrawItem);
var
   State                  : TOwnerDrawState;
   rcBitmap,rcText   : Trect;
   nCheck               : integer; // 0 - No check, 1 - Empty check, 2 - Checked
   nState                : integer;
   strText             : string;
   ItId                  : Integer;
   dc                     : HDC;
begin
   with Message.DrawItemStruct^ do
   begin
      State       := TOwnerDrawState(LongRec(itemState).Lo);
      dc             := hDC;
      rcBitmap   := rcItem;
      rcText     := rcItem;
      ItId         := itemID;
   end;
   // Check if we are drawing the static portion of the combobox
  if (itID < 0) then
   begin
      RecalcText();
      strText := m_strText;
      nCheck  := 0;
   end
   else
   begin
      strtext             := Items[ItId];
      rcBitmap.Left    := 2;
      rcBitmap.Top       := rcText.Top + (rcText.Bottom - rcText.Top - FCheckWidth) div 2;
      rcBitmap.Right    := rcBitmap.Left + FCheckWidth;
      rcBitmap.Bottom := rcBitmap.Top + FCheckHeight;

      rcText.left := rcBitmap.right;
      nCheck := 1;
      if IsChecked(ItId) then
         inc(nCheck);
   end;
   if (nCheck > 0) then
   begin
       SetBkColor(dc, GetSysColor(COLOR_WINDOW));
       SetTextColor(dc, GetSysColor(COLOR_WINDOWTEXT));
       nState := DFCS_BUTTONCHECK;
      if (nCheck > 1) then
    nState := nState or DFCS_CHECKED;
      DrawFrameControl(dc, rcBitmap, DFC_BUTTON, nState);
   end;
   if (odSelected in State) then
   begin
      SetBkColor(dc, $0091622F);
      SetTextColor(dc, GetSysColor(COLOR_HIGHLIGHTTEXT));
   end
   else
   begin
      if (nCheck=0) then
      begin
         SetTextColor(dc, ColorToRGB(Font.Color));
         SetBkColor(dc, ColorToRGB(FColorNotFocus));
      end
      else
      begin
         SetTextColor(dc, ColorToRGB(Font.Color));
      SetBkColor(dc,     ColorToRGB(Brush.Color));
      end;
   end;
   if itID >= 0 then
  strText := ' ' + strtext;
   ExtTextOut(dc, 0, 0, ETO_OPAQUE, @rcText, Nil, 0, Nil);
   DrawText(dc, pchar(strText), Length(strText), rcText, DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS);
   if odFocused in State then DrawFocusRect(dc, rcText);
end;

 //DefWindowProc
procedure TATCheckedComboBox.ListWndProc(var Message: TMessage);
var
   nItemHeight, nTopIndex, nIndex: Integer;
   rcItem,rcClient: TRect;
   pt              : TPoint;
begin
   case Message.Msg of
      LB_GETCURSEL : // this is for to not draw the selected in the text area
         begin
            Message.result := -1;
            exit;
         end;
      WM_CHAR: // pressing space toggles the checked 
         begin
            if (TWMKey(Message).CharCode = VK_SPACE) then
            begin
               // Get the current selection
               nIndex := CallWindowProcA(FDefListProc, FListHandle, LB_GETCURSEL,Message.wParam, Message.lParam);
               SendMessage(FListHandle, LB_GETITEMRECT, nIndex, LongInt(@rcItem));
               InvalidateRect(FListHandle, @rcItem, FALSE);
               SetCheck(nIndex, not IsChecked(nIndex));
               SendMessage(WM_COMMAND, handle, CBN_SELCHANGE,handle);
               Message.result := 0;
               exit;
            end
         end;
      WM_LBUTTONDOWN:
         begin
            Windows.GetClientRect(FListHandle, rcClient);
            pt.x := TWMMouse(Message).XPos; //LOWORD(Message.lParam);
            pt.y := TWMMouse(Message).YPos; //HIWORD(Message.lParam);
            if (PtInRect(rcClient, pt)) then
            begin
               nItemHeight := SendMessage(FListHandle, LB_GETITEMHEIGHT, 0, 0);
               nTopIndex   := SendMessage(FListHandle, LB_GETTOPINDEX, 0, 0);
               // Compute which index to check/uncheck
               nIndex := trunc(nTopIndex + pt.y / nItemHeight);
               SendMessage(FListHandle, LB_GETITEMRECT, nIndex, LongInt(@rcItem));
               if (PtInRect(rcItem, pt)) then
               begin
                  InvalidateRect(FListHandle, @rcItem, FALSE);
                  SetCheck(nIndex, not IsChecked(nIndex));
                  SendMessage(WM_COMMAND, handle, CBN_SELCHANGE,handle);
               end
            end
         end;
      WM_LBUTTONUP:
         begin
            Message.result := 0;
            exit;
         end;
   end;
   ComboWndProc(Message, FListHandle, FDefListProc);
end;

constructor TATCheckedComboBox.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   ShowHint            := true;
   Fversion            := '1.2';
   FTextAsHint       := true;
   ParentShowHint  := False;
   FListHandle       := 0;
   FQuoteStyle       := qsNone;
   FColorNotFocus   := clInfoBk;
   Style                := csOwnerDrawVariable;
   m_bTextUpdated  := FALSE;
   FListInstance    := MakeObjectInstance(ListWndProc);
end;

destructor TATCheckedComboBox.Destroy;
begin
   FreeObjectInstance(FListInstance);
   inherited Destroy;
end;

procedure TATCheckedComboBox.WndProc(var Message: TMessage);
var lWnd :  HWND;
begin
   if message.Msg = WM_CTLCOLORLISTBOX then
   begin
      // If the listbox hasn't been subclassed yet, do so...
      if (FListHandle = 0) then
      begin
         lwnd := message.LParam;
         if (lWnd <> 0) and (lWnd <> FDropHandle) then
         begin
            // Save the listbox handle
            FListHandle := lWnd;
            FDefListProc := Pointer(GetWindowLong(FListHandle, GWL_WNDPROC));
            SetWindowLong(FListHandle, GWL_WNDPROC, Longint(FListInstance));
         end;
      end;
   end;
   inherited;
end;

initialization
   GetCheckSize;

end.

[romber]

Weiss keiner, wie das geht?

[alzaimar]

Delphi-Quellcode:

procedure TATCheckedComboBox.CNDrawItem(var Message: TWMDrawItem);
var
  State: TOwnerDrawState;
  rcBitmap, rcText: Trect;
  nCheck: integer; // 0 - No check, 1 - Empty check, 2 - Checked
  nState: integer;
  strText: string;
  ItId: Integer;
  dc: HDC;
begin
  with Message.DrawItemStruct^ do
  begin
    State := TOwnerDrawState(LongRec(itemState).Lo);
    dc := hDC;
    rcBitmap := rcItem;
    rcText := rcItem;
    ItId := itemID;
  end;
   // Check if we are drawing the static portion of the combobox
  if (itID < 0) then
  begin
    RecalcText();
    strText := m_strText;
    nCheck := 0;
  end
  else
  begin
    strtext := Items[ItId];
    rcBitmap.Left := 2;
    rcBitmap.Top := rcText.Top + (rcText.Bottom - rcText.Top - FCheckWidth) div 2;
    rcBitmap.Right := rcBitmap.Left + FCheckWidth;
    rcBitmap.Bottom := rcBitmap.Top + FCheckHeight;

    rcText.left := rcBitmap.right;
    nCheck := 1;
    if IsChecked(ItId) then
      inc(nCheck);
  end;
  if (nCheck > 0) then
  begin
    SetBkColor(dc, GetSysColor(COLOR_WINDOW));
    SetTextColor(dc, GetSysColor(COLOR_WINDOWTEXT));
    nState := DFCS_BUTTONCHECK;
    if (nCheck > 1) then
      nState := nState or DFCS_CHECKED;
    DrawFrameControl(dc, rcBitmap, DFC_BUTTON, nState);
  end;

  if (odSelected in State) then
  begin
    SetBkColor(dc, $0091622F);
    SetTextColor(dc, GetSysColor(COLOR_HIGHLIGHTTEXT));
  end
  else
  begin
    if (nCheck = 0) then
    begin
      SetTextColor(dc, ColorToRGB(Font.Color));
      SetBkColor(dc, ColorToRGB(FColorNotFocus));
    end
    else
    begin
      SetTextColor(dc, ColorToRGB(Font.Color));
      if ncheck = 1 then
        SetBkColor(dc, ColorToRGB(Brush.Color))
      else
        SetBkColor(dc, clRed);   // <<----- hier

    end;
  end;
  if itID >= 0 then
    strText := ' ' + strtext;
  ExtTextOut(dc, 0, 0, ETO_OPAQUE, @rcText, nil, 0, nil);
  DrawText(dc, pchar(strText), Length(strText), rcText, DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS);
  if odFocused in State then DrawFocusRect(dc, rcText);
end;

Zeichnet die angecheckten (aua!) Einträge rot.

[romber]

Danke sehr! Klappt sehr gut!