![]() |
Re: Combobox mit Bitmaps
Eine ComboBox ist nur eine Kombination aus einem Editfeld und einer Listbox (intern) und ich weiss nicht, ob er bei den Mousereignissen diese auch liefert, wenn er sich auf dem ListBoxbereich befindet. Aber das war hier nicht die Frage...
|
Re: Combobox mit Bitmaps
Zitat:
Zitat:
|
Re: Combobox mit Bitmaps
Liste der Anhänge anzeigen (Anzahl: 1)
Zitat:
Delphi-Quellcode:
HTH,
type
TRehCheckComboBox = class(TRehCustomComboBox) private FListInstance: Pointer; FDefListProc: Pointer; procedure ListWndProc(var Message: TMessage); // ... end; constructor TRehCheckComboBox.Create(AOwner: TComponent); begin inherited Create(AOwner); FListInstance := MakeObjectInstance(ListWndProc); end; destructor TRehCheckComboBox.Destroy; begin FreeObjectInstance(FListInstance); inherited; end; procedure TRehCheckComboBox.CreateWnd; var cbi: TComboBoxInfo; pListHandle: ^HWND; begin inherited CreateWnd; FillChar(cbi, SizeOf(cbi), 0); cbi.cbSize := SizeOf(cbi); pListHandle := @ListHandle; if GetComboBoxInfo(Handle, cbi) then begin pListHandle^ := cbi.hwndList; FDefListProc := Pointer(GetWindowLong(ListHandle, GWL_WNDPROC)); SetWindowLong(ListHandle, GWL_WNDPROC, Longint(FListInstance)); end else begin //OutputDebugString(PChar(SysErrorMessage(GetLastError))); pListHandle^ := 0; end; end; procedure TRehCheckComboBox.ListWndProc(var Message: TMessage); var X, Y, Index: Integer; begin case Message.Msg of WM_LBUTTONDOWN: begin X := TWMMouse(Message).XPos; Y := TWMMouse(Message).YPos; Index := ItemAtPos(Point(X, Y), True); if Index <> -1 then begin if not UseRightToLeftAlignment then begin if X - ItemRect(Index).Left < GetCheckWidth then begin ToggleClickCheck(Index); Exit; end; end else begin Dec(X, ItemRect(Index).Right - GetCheckWidth); if (X > 0) and (X < GetCheckWidth) then begin ToggleClickCheck(Index); Exit; end; end; end; end; end; Message.Result := CallWindowProc(FDefListProc, ListHandle, Message.Msg, Message.WParam, Message.LParam); end; Uli. |
Re: Combobox mit Bitmaps
Zitat:
Aber nichts desto trotz: Schöner Code :wink: |
Re: Combobox mit Bitmaps
Zitat:
Zitat:
Zitat:
|
Re: Combobox mit Bitmaps
Nochmal ein lauffähiges Beispiel:
Delphi-Quellcode:
unit MyCombo;
interface uses Windows, Messages, Classes, StdCtrls; type TRehCheckComboBox = class(TComboBox) private FListInstance: Pointer; FDefListProc: Pointer; procedure ListWndProc(var Message: TMessage); // List box simulation: function ItemAtPos(Pos: TPoint; Existing: Boolean): Integer; function ItemRect(Index: Integer): TRect; protected procedure CreateWnd; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; end; implementation uses SysUtils; constructor TRehCheckComboBox.Create(AOwner: TComponent); begin inherited Create(AOwner); FListInstance := MakeObjectInstance(ListWndProc); end; destructor TRehCheckComboBox.Destroy; begin FreeObjectInstance(FListInstance); inherited; end; procedure TRehCheckComboBox.CreateWnd; var cbi: TComboBoxInfo; pListHandle: ^HWND; begin inherited CreateWnd; FillChar(cbi, SizeOf(cbi), 0); cbi.cbSize := SizeOf(cbi); pListHandle := @ListHandle; if GetComboBoxInfo(Handle, cbi) then begin pListHandle^ := cbi.hwndList; FDefListProc := Pointer(GetWindowLong(ListHandle, GWL_WNDPROC)); SetWindowLong(ListHandle, GWL_WNDPROC, Longint(FListInstance)); end else begin //OutputDebugString(PChar(SysErrorMessage(GetLastError))); pListHandle^ := 0; end; end; procedure TRehCheckComboBox.ListWndProc(var Message: TMessage); const cCheckWidth = 20; var X, Y, Index: Integer; begin case Message.Msg of WM_LBUTTONDOWN: begin X := TWMMouse(Message).XPos; Y := TWMMouse(Message).YPos; Index := ItemAtPos(Point(X, Y), True); if Index <> -1 then begin if X - ItemRect(Index).Left < cCheckWidth then begin Beep; //ToggleClickCheck(Index); Exit; end; end; end; end; Message.Result := CallWindowProc(FDefListProc, ListHandle, Message.Msg, Message.WParam, Message.LParam); end; function TRehCheckComboBox.ItemAtPos(Pos: TPoint; Existing: Boolean): Integer; var Count: Integer; ItemRect, ClientRect: TRect; begin Windows.GetClientRect(ListHandle, ClientRect); if PtInRect(ClientRect, Pos) then begin Result := SendMessage(ListHandle, LB_GETTOPINDEX, 0, 0); Count := Items.Count; while Result < Count do begin SendMessage(ListHandle, LB_GETITEMRECT, Result, Longint(@ItemRect)); if PtInRect(ItemRect, Pos) then Exit; Inc(Result); end; if not Existing then Exit; end; Result := -1; end; function TRehCheckComboBox.ItemRect(Index: Integer): TRect; var Count: Integer; begin Count := Items.Count; if (Index = 0) or (Index < Count) then SendMessage(ListHandle, LB_GETITEMRECT, Index, Longint(@Result)) else if Index = Count then begin SendMessage(ListHandle, LB_GETITEMRECT, Index - 1, Longint(@Result)); OffsetRect(Result, 0, Result.Bottom - Result.Top); end else FillChar(Result, SizeOf(Result), 0); end; end.
Delphi-Quellcode:
Dabei hat ComboBox1 den Style csDropDownList. Wenn du das Programm laufen lässt, die Combo aufklappst und in die linken 20 Pixel klickst, machst's Piep und die Combo bleibt offen. Das ist doch halbwegs das, was der OP möchte.
unit MainF;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, MyCombo; type TComboBox = class(TRehCheckComboBox); TForm1 = class(TForm) ComboBox1: TComboBox; private { Private-Deklarationen } public { Public-Deklarationen } end; var Form1: TForm1; implementation {$R *.dfm} end. |
Re: Combobox mit Bitmaps
Zitat:
Und dein Code ist ja nun mal nicht soo arg leicht verständlich wie OnMouseDown :-D Nun gut, langsam wird's OT. Ich geh gleich in den Feierabend und euch allen wünsch ich ein schönes Wochenende :hi: |
Re: Combobox mit Bitmaps
Na an die Lösung die Windowsevents abzugreifen hatte ich auch schon gedacht, aber ich hatte noch gehofft, dass es irgendwie einfacher geht. Nun ja, jetzt ist erst mal Wochenende, werde mir die Vorschläge mal nächste Woche ganz in Ruhe zu gemüte führen, aber auf den ersten Blick gefällt mir der 2. besser, mal schauen. So, der Glühwein wartet...
Ein schönes Wochenende und DANKE!!!!! |
Re: Combobox mit Bitmaps
Zitat:
Zitat:
Zitat:
Zitat:
Zitat:
|
Alle Zeitangaben in WEZ +1. Es ist jetzt 20:44 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz