paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-11 07:08:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: if a speedbutton is not part of a group a dblclick is translated to two click events fixes bug #8625

Browse Source 
git-svn-id: trunk@11256 -
This commit is contained in:
vincents 2007-06-01 17:38:41 +00:00
parent 0d0427f294
commit 72e8b7d4b3
2 changed files with 21 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/buttons.pp
View File

@ -314,7 +314,9 @@ type
private
procedure DoBeforeMouseMessage;
procedure DoMouseUp(var Message: TLMMouse; Button: TMouseButton);
procedure WMLButtonDown(Var Message: TLMLButtonDown); message LM_LBUTTONDOWN;
procedure WMLButtonUp(var Message: TLMLButtonUp); message LM_LBUTTONUP;
procedure WMLButtonDBLCLK(Var Message: TLMLButtonDblClk); message LM_LBUTTONDBLCLK;
protected
FState: TButtonState;
function GetNumGlyphs: Integer;

20
lcl/include/speedbutton.inc
View File

@ -40,7 +40,7 @@ begin
FGlyph.OnChange := @GlyphChanged;
SetInitialBounds(0, 0, 23, 22);
ControlStyle := ControlStyle + [csCaptureMouse]-[csSetCaption];
ControlStyle := ControlStyle + [csCaptureMouse]-[csSetCaption, csClickEvents];
FLayout:= blGlyphLeft;
FAllowAllUp:= false;
@ -699,6 +699,24 @@ begin
MouseUp(Button, KeysToShiftState(Keys), XPos, YPos);
end;
procedure TCustomSpeedButton.WMLButtonDown(var Message: TLMLButtonDown);
begin
inherited;
// because csClickEvents is not set no csClicked is set in the inherited method
Include(FControlState, csClicked);
end;
procedure TCustomSpeedButton.WMLButtonDBLCLK(var Message: TLMLButtonDblClk);
begin
inherited;
// if in a group, raise dblclick event, otherwise translate to click event
if Down
then DblClick
else Click;
end;
{------------------------------------------------------------------------------
Method: TCustomSpeedButton.WMLButtonUp
Params: Message