TComboBox ListBox.....

[Gavin Godfrey]

Hi Peter, All,
I modified the control's createParams to include what you suggested, ie,
inherited CreateParams(Params);
with Params do
begin
Style := WS_POPUP or WS_BORDER;
ExStyle := WS_EX_TOOLWINDOW;
WindowClass.Style := CS_SAVEBITS;
end;

This works fine, but I still have 2 problems.

1. If mouse capture is set, I cannot get the vertical scroll bar to
work. Above, I had to change the Style := to be either

Style := WS_POPUP or WS_BORDER or WS_VSCROLL

or

Style := Style or WS_POPUP or WS_BORDER

This makes it show a scroll bar if needed but clicking on it does nothing.

2. When I setfocus to the ListBox, the form loses focus, ie, the title
bar colour of the form changes. This does not occur if WS_POPUP is not
in the style := part....... This does not occur with usual TCombo style
controls..

I have an OnMOuseUp event like the TDBLookupCOmbo ( which you directed
me to look at ) . Without this event, once the listbox is shown, you are
locked out of the program ( the ListBox seems then to be acting like a
modal window would ).

I really need help with getting this to work properly...

Another idea is if anyone knows how to change a standard TComboBox to
draw flat. I have tried to override the Createparams, but nothing seems
to change the way the TEdit part is drawn, ie, always 3D.

Thanks,
Gavin Godfrey

[Peter Below (TeamB)]

In article <3F85EBE8...@aia.net.au>, Gavin Godfrey wrote:
>
> Hi Peter,

I don't have the time to look at this in depth at the moment, sorry. Will
try over the weekend. Basically you need to handle WM_MOUSEACTIVATE to
prevent the popup list from stealing focus from the host window, and you
have to show it via ShowWindow( handle, SHOW_NA ).

>

--
Peter Below (TeamB)
Use the newsgroup archives :
http://www.mers.com/searchsite.html
http://www.tamaracka.com/search.htm
http://groups.google.com
http://www.prolix.be

[Peter Below (TeamB)]

> I modified the control's createParams to include what you suggested, ie,
> inherited CreateParams(Params);
> with Params do
> begin
> Style := WS_POPUP or WS_BORDER;
> ExStyle := WS_EX_TOOLWINDOW;
> WindowClass.Style := CS_SAVEBITS;
> end;

OK, i played around a bit and came to the conclusion that this is not the
optimal style set for a popup listbox, and that the mouse capture does
indeed interfere with the processing of mouse actions on the scrollbars.
No WM_NC* button messages are created while mouse capture is set to the
listbox and even if one creates them they are not processed while mouse
capture is set. Don't ask me why, this is probably one of the big Windows
enigmas....

Below is the final control i came up with, modify it as fits your needs.

Note: the design-time behaviour of this control has not been tested!
It should act like a normal listbox there, so you can set size and content
at designtime and then set its Visible to false.

Testbed form (Autoscroll = false!)):

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
FPopupList: TPBPopupListbox;
Procedure CreatePopupList;
Procedure PopuplistCloseup( sender: TObject );
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
if not Assigned( FPopupList ) then
CreatePopupList;
FPopuplist.ShowBeneath( Sender as TControl );
end;

procedure TForm1.CreatePopupList;
var
i: Integer;
begin
FPopuplist := TPBPopupListBox.Create( self );
FPopuplist.Parent := self;
FPopuplist.OnCloseUp := PopuplistCloseup;
for i:= 0 to 20 do
FPopuplist.Items.Add(
Format('This is item %d', [i]));
Canvas.Font := FPopupList.Font;
FPopuplist.Width:=
Canvas.TextWidth(FPopuplist.Items[FPopuplist.Items.Count-1]) +
GetSystemMetrics( SM_CXVSCROLL ) + 6;
end;

procedure TForm1.PopuplistCloseup(sender: TObject);
begin
if FPopupList.ItemIndex >= 0 then
caption := FPopupList.Items[FPopupList.ItemIndex]
else
caption := 'No selection';
end;

end.

Control unit:

unit PBPopupListBox;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls;

type
TPBPopupListBox = class(TListBox)
private
FCloseupEvent: TNotifyEvent;

protected
procedure DoCloseup; virtual;
procedure CloseUp;
procedure CreateParams(var Params: TCreateParams); override;
procedure DoEnter; override;
function GetOwnerformHandle: HWND;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
function MouseIsOnScrollbar( const Pos: TSmallpoint; var HittestCode:
Integer ): Boolean;
function ScreenPos(const Pos: TSmallpoint): LPARAM;
function PerformNCMouseAction( Msg, HittestCode: Integer; const Pos:
TSmallpoint ): Integer;
procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
procedure WMLButtonDown(var Message: TWMLButtonDown);
message WM_LBUTTONDOWN;
procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
public
procedure ShowBeneath( aControl: TControl );
published
property OnCloseUp: TNotifyEvent read FCloseupEvent write FCloseupEvent;
end;

procedure Register;

implementation

uses Forms;

{ Check if we are running on Windows 2000 or a newer version. Win2K is
Windows NT 5.0 }

function IsXPor2K: Boolean;
begin
Result :=
(Sysutils.Win32Platform = VER_PLATFORM_WIN32_NT)
and
(Sysutils.Win32MajorVersion >= 5);
end;

procedure Register;
begin
RegisterComponents('PBGoodies', [TPBPopupListBox]);
end;

{ TPBPopupListBox }

procedure TPBPopupListBox.CloseUp;
begin
MouseCapture := false;
Hide;
DoCloseup;
end;

procedure TPBPopupListBox.CreateParams(var Params: TCreateParams);
var
wnd: HWND;
begin
inherited;
if not (csDesigning in ComponentState ) then begin
Params.Style := Params.Style and not WS_CHILD or WS_POPUP;
if IsXPor2K then
Params.ExStyle := Params.ExStyle or WS_EX_NOACTIVATE;
Params.WindowClass.Style := CS_SAVEBITS;
wnd:= GetOwnerformHandle;
if wnd <> 0 then
params.WndParent := wnd;
end; { If }
end;

procedure TPBPopupListBox.DoEnter;
var
wnd: HWND;
begin
inherited;
wnd:= GetOwnerformHandle;
if wnd <> 0 then
SendMessage( wnd, WM_NCACTIVATE, 1, 0 );
end;

function TPBPopupListBox.ScreenPos( const Pos: TSmallpoint ): LPARAM;
var
pt: TPoint;
begin
pt := SmallpointToPoint( pos );
Win32Check( Windows.ClientToScreen( Handle, pt ));
Result := LPARAM( PointToSmallpoint(pt));
end;

function TPBPopupListBox.MouseIsOnScrollbar( const Pos: TSmallpoint; var
HittestCode: Integer ): Boolean;
begin
if csDesigning In ComponentState then
Result := false
else begin
Hittestcode := Perform( WM_NCHITTEST, 0, ScreenPos( Pos ));
Result := (Hittestcode = HTVSCROLL) or (Hittestcode = HTHSCROLL);
end; { Else }
end;

function TPBPopupListBox.GetOwnerformHandle: HWND;
var
ctrl: TWinControl;
begin
ctrl:= GetParentForm( Owner as TControl );
if Assigned( ctrl ) then
Result := ctrl.Handle
else
Result := 0;
end;

procedure TPBPopupListBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
if (Key = VK_ESCAPE) or (Key = VK_RETURN) then
Key := 0
else
inherited;
end;

procedure TPBPopupListBox.KeyPress(var Key: Char);
begin
if Key = #13 then
Closeup
else if Key = #27 then begin
ItemIndex := -1;
Closeup;
end { If }
else
inherited;
end;

procedure TPBPopupListBox.ShowBeneath(aControl: TControl);
var
pt: TPoint;
begin
Assert( Assigned( aControl ),
'ShowBeneath: aControl cannot be nil' );
Assert( Assigned( aControl.Parent ),
'ShowBeneath: aControl.Parent cannot be nil' );
pt:= Point( aControl.Left, aControl.Top + aControl.Height );
pt:= aControl.Parent.ClientToScreen( pt );
SetBounds( pt.x, pt.y, Width, Height );
ItemIndex := -1;
Show;
if not Focused and CanFocus then
SetFocus;
MouseCapture := true;
end;

procedure TPBPopupListBox.WMLButtonDown(var Message: TWMLButtonDown);
var
Where: Integer;
begin
if MouseIsOnScrollbar( Message.Pos, Where ) then
PerformNCMouseAction( WM_NCLBUTTONDOWN, Where, Message.Pos )
else
inherited;
end;

procedure TPBPopupListBox.WMLButtonUp(var Message: TWMLButtonUp);
var
Where: Integer;
begin
if MouseIsOnScrollbar( Message.Pos, Where ) then
PerformNCMouseAction( WM_NCLBUTTONUP, Where, Message.Pos )
else begin
inherited;
Closeup;
end;
end;

procedure TPBPopupListBox.WMMouseMove(var Message: TWMMouseMove);
var
Where: Integer;
begin
if MouseIsOnScrollbar( Message.Pos, Where ) then
PerformNCMouseAction( WM_NCMOUSEMOVE, Where, Message.Pos )
else
inherited;
end;

function TPBPopupListBox.PerformNCMouseAction(Msg, HittestCode: Integer;
const Pos: TSmallpoint): Integer;
begin
MouseCapture := false;
Result := Perform( Msg, HittestCode, ScreenPos( Pos ));
MouseCapture := true;
end;

procedure TPBPopupListBox.DoCloseup;
begin
if Assigned( FCloseupEvent ) then
FCloseupEvent( self );
end;

end.

[Gavin Godfrey]

Hi Peter,
Thank you very much for the effort you put into this. I had to modify
bits ( as you said ), but it now works perfectly......

The main things were getting the scroll bars to respond during mouse
capture , and to stop the form losing focus when the listbox was
focused. Both now work.....

I am not sure I follow ALL the code, but I understand enough of it to
make my stuff work.

the following :

if IsXPor2K then
Params.ExStyle := Params.ExStyle or WS_EX_NOACTIVATE;

does not work with my version of Delphi ( 3.02). The WS_EX_NOACTIVATE
constant is not recognized, but everything seems to work without it..

Also, TSMallPoint was replaced with TPoint..

Also, I implemented the MouseDOwn and MouseUp events differently, but
used basically the code you provided.... You have them as messages, I
have them as events.. eg, listbox.onMouseDown := ListMouseDown.

Cheers,
Gavin Godfrey

[Peter Below (TeamB)]

In article <3F8A1389...@aia.net.au>, Gavin Godfrey wrote:
> the following :
> if IsXPor2K then
> Params.ExStyle := Params.ExStyle or WS_EX_NOACTIVATE;
>
> does not work with my version of Delphi ( 3.02). The WS_EX_NOACTIVATE
> constant is not recognized, but everything seems to work without it..

const WS_EX_NOACTIVATE = $08000000;

>
> Also, TSMallPoint was replaced with TPoint..

No, that is not correct. TSmallpoint was defined since D2, it may just
be in another unit in D3. TSmallpoint is a record of two 2 byte
integers, which is the format in which the mouse messages transport the
mouse position in lparam. TPOint is a record of two 4 byte integers, and
of course it does not fit into a 4 byte message parameters.

> Also, I implemented the MouseDOwn and MouseUp events differently, but
> used basically the code you provided.... You have them as messages, I
> have them as events.. eg, listbox.onMouseDown := ListMouseDown.

You should never use the events if you write a component. Events are for
the components users, the component writer uses message handlers or the
methods that fire the events.

[Gavin Godfrey]

Hi Peter,
You are correct with TSmallPoint. Not sure why it complained. I have put
the TPoints back to TSmallPoints and it compiles now..

I also add the const WS_EX_NOACTIVATE = $08000000; It seemed to work
without it, but I have now put it in.

Thanks for the information re events/ messages. I have learned a lot
from this. And, it works.....

Cheers,
Gavin