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.

[shmia]

Mal unabhängig von deinem Problem:

Delphi-Quellcode:

initialization 
   GetCheckSize;  // das ist schlecht

Du solltest Code im Abschnitt initialization wann immer möglich vermeiden.
Gründe:
* der Code bremst den Start deiner Anwendung auch dann, wenn deine Komponente vielleicht gar nicht angezeigt wird.
* sollte im Abschnitt initalization eine Exception auftreten dann wird diese nicht sauber gemeldet, da die VCL noch nicht ausreichend initialisiert wurde.
Stattdessen erscheint die Fehlermeldung "Runtime error 217 at 003E36F" und das Programm wird gewaltsam beendet.

Delphi-Quellcode:

constructor TATCheckedComboBox.Create(AOwner: TComponent); 
begin 
  inherited Create(AOwner); 
  if (FCheckWidth=0) and (FCheckHeight=0) then GetCheckSize;   // <=======

[romber]

@shmia

Vielen Dank! Ich habe es schon geändert.
Zu meinem Problem habe ich leider immer noch keine Lösung. :(

[romber]

Kann mir keiner helfen?

[romber]

Das Problemm ist leider immen noch nicht gelöst!

LIEBE EXPERTEN! Schaut doch bitte die Code an! Ihr Profis hier werden sicher einen Lösungsvorschlag machen können! Vielen Dank!

[romber]

*push*

[Angel4585]

Ich weis nicht ob es dir weiterhilft aber ich beobachte folgendes:

Ich wähle mit der Linken Maustaste ein Item aus, mache einen Haken rein.
Ab jetzt scroll die Box mit wenn ich die Maus bewege.

Nachdem ich ein Item mit Space selektiert habe, scroll die Box mit wenn ich ein Item mit einem Mausklick auswähle. Wenn ich nochmal draufklicke scrollt die Box nichtmehr und es ist immernoch selektiert.
Edit: Das Verhalten ist nur bei dem Item das ich mit Space ausgewählt habe.

[KrasserChecker]

Hallo,

es sieht so aus, als würden da 2 Messages "parallel" für dieses unerwünschte Verhalten sorgen:

1) Scheinbar läuft irgendwo ein Timer im Hintergrund, dr dafür sorgt, daß immer der Eintrag über dem die Maus ist fokusiert wird.
2) Außerdem wird die Muasbewegung abgefangen, um den gleichen Test zu machen.

Um das zu umgehen müßte es daher eigentlich reichen, wenn diese beiden Messages abgefangen werden. Dann wird überprüft, ob dich der Mauszeiger über dem Dropdown befindet oder nicht. Falls nicht wird die Message einfach nicht weiterbearbeitet.

Delphi-Quellcode:

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;
//--------------------------------------------------------------------------------------
// This code prevents automatic scrolling when mouse leaves to dropdown window
      WM_MOUSEMOVE,
      WM_TIMER:
         begin
           GetWindowRect(FListHandle, rcClient);
           if not PtInRect(rcClient, Mouse.CursorPos) then
           begin
             Message.Result := -1;
             Exit;
           end;
         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;

[teebee]

Füge der ListWndProc mal die beiden Zeilen hinzu:

Delphi-Quellcode:

begin
                  InvalidateRect(FListHandle, @rcItem, FALSE);
                  SetCheck(nIndex, not IsChecked(nIndex));
                  SendMessage(WM_COMMAND, handle, CBN_SELCHANGE,handle);
                  Message.result := 0; // <- diese beiden Zeilen
                  exit;                // <- hinzufügen
               end;

Scheint bei meinen ersten Tests zu funktionieren.

Gruß, teebee

[ChrisE]

Zitat:

Zitat von teebee

Füge der ListWndProc mal die beiden Zeilen hinzu:

Delphi-Quellcode:

begin
                  InvalidateRect(FListHandle, @rcItem, FALSE);
                  SetCheck(nIndex, not IsChecked(nIndex));
                  SendMessage(WM_COMMAND, handle, CBN_SELCHANGE,handle);
                  Message.result := 0; // <- diese beiden Zeilen
                  exit;                // <- hinzufügen
               end;

Scheint bei meinen ersten Tests zu funktionieren.

Gruß, teebee

Kann ich bestätigen. Tut bei mir auch. Vista 32 Bit SP1 und Delphi 2007

Gruß, Chris

[romber]

Vielen Dank Euch allen! Es geht endlich!

[Angel4585]

Un wer bekommt nu die Kohle? :lol: :zwinker:
Spende Sie am besten Daniel