TCheckComboBox: unangenehmes Scroll-Effekt beseitigen???

[romber]

Hallo!

Ich benutze in meinem Programm eine tolle CheckComboBox-Komponente, basiert auf TCustomComboBox. Bis jetzt hat alles wunderbar funktioniert. Und heute, als ich mehrere hundert Items in eine Box hinzufügten musste, habe ich eine unangenehme "Nebenwirkung" entdeckt, die ich nicht ohne Eurer kompetenten Hilfe beseitigen kann.
Und zwar, in der normalen ComboBox verschwindet die Auswahlliste, sobald ein Item ausgewählt (angeklickt) wurde. Der Sinn der Komponente, die ich benutze, ist mehrere Items durch integrierte CheckBoxen auszuwählen. Hier verschwintet die Auswahlliste erst, wenn man irgendeine andere Komponente auf der Form anklickt wurde. Und genau hier kommt es zu der Nebenwirkung: wenn die geladene Items nicht in den DropDown passen und ein Item angeklickt wird, scrollt der DropDown, wenn man die Mouse bewegt. Wie werde ich diese störende Nebenwirkung los?

Hier ist die Code der Komponente:

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.