View Issue Details
ID | Project | Category | View Status | Date Submitted | Last Update |
---|---|---|---|---|---|
0038099 | Lazarus | Packages | public | 2020-11-17 17:53 | 2020-11-20 12:08 |
Reporter | Andy Spry | Assigned To | Bart Broersma | ||
Priority | normal | Severity | minor | Reproducibility | have not tried |
Status | resolved | Resolution | fixed | ||
Product Version | 2.0.8 | ||||
Summary | 0038099: TUpDown MouseDown event is not fired by left and right click on component buttons | ||||
Description | The TUpDown MouseDown event is only fired when the mouse cursor is positioned in the narrow gap between the 2 buttons which makes it almost impossible to use the event. In Delphi (7) the MouseDown event fires when the cursor is over the buttons and either mouse button is clicked. | ||||
Tags | No tags attached. | ||||
Fixed in Revision | r64147 | ||||
LazTarget | - | ||||
Widgetset | Win32/Win64 | ||||
Attached Files |
|
related to | 0038101 | resolved | Bart Broersma | TUpDown MouseEnter and MouseLeave events are not fired when the mouse cursor is over component buttons |
|
Presumably this goes for all OnMouseXXXX events? Currently TUpDownButton (if we create that, seems to depend on WS) is unaware of the existence of the TUpDown that created it, so messages cannot be propagated. Also X and Y values of the mouse then probably reflect the coördinates of the TUpDownButton, not of the TUpDown. |
|
My D7 publishes OnMouseUp, OnMouseDown, OnMouseMove. Attached patch sort of implements this. Sort of, because: - order of events differs from Delphi * Delphi: Click, MouseDown, MouseUp (always followed by MouseMove for some reason) * Lazarus: MouseDown, MouseUp, Click - X and Y are relative to TUpDownButton - all this only workd if LCL actually creates TUpDownButtons in the first place (code suggests this is not always the case). Please try with attached patch and give some feedback. And from the WTF category: my D7 only fires OnClick if you click the "up" arrow, not if you click the "down" arrow. |
|
New patch (updown.mouse-events.2.diff) more or less solves the issue wiht the X and Y coördinates. updown.mouse-events.2.diff (2,141 bytes)
Index: lcl/include/customupdown.inc =================================================================== --- lcl/include/customupdown.inc (revision 64121) +++ lcl/include/customupdown.inc (working copy) @@ -20,11 +20,14 @@ FMouseTimer : TTimer; FUpDown : TCustomUpDown; FButtonType : TUDBtnType; + private + procedure ButtonCoordToUpDownCoord(var X,Y: Integer); protected procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure DblClick; override; public constructor CreateWithParams(UpDown : TCustomUpDown; @@ -34,10 +37,28 @@ procedure Paint; override; end; +procedure TUpDownButton.ButtonCoordToUpDownCoord(var X, Y: Integer); +begin + //Fix me: there must be a better way to do this? + //Result may be off by appr. 2 pixels + if FUpDown.Orientation = udVertical then + begin + if FButtonType = btPrev then //down arrow + Y := Y + Height; //assumes both buttons are equal height + end + else + begin + if FButtonType = btNext then //right arrow + X := X + Width; + end; +end; + procedure TUpDownButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseDown(Button, Shift, X, Y); + ButtonCoordToUpDownCoord(X, Y); + FUpDown.MouseDown(Button, Shift, X, Y); if Button = mbLeft then begin With FUpDown do begin FMouseTimerEvent := @Self.Click; @@ -59,6 +80,8 @@ Y: Integer); begin inherited MouseUp(Button, Shift, X, Y); + ButtonCoordToUpDownCoord(X, Y); + FUpDown.MouseUp(Button, Shift, X, Y); With FUpDown do If Assigned(FMouseTimer) then begin FreeAndNil(FMouseTimer); @@ -67,6 +90,13 @@ end; end; +procedure TUpDownButton.MouseMove(Shift: TShiftState; X, Y: Integer); +begin + inherited MouseMove(Shift, X, Y); + ButtonCoordToUpDownCoord(X, Y); + FUpDown.MouseMove(Shift, X, Y); +end; + procedure TUpDownButton.DblClick; begin Click; |
|
Thank you Bart. I'm afraid you will have to be patient with me. I am very much an amateur. I have patched your code and can confirm that both left and right mousedown events fire correctly. But I suspect I have done something wrong as the previous behaviour with a continuous left mouse down resulted in a continuous increment or decrement of Position. Now a Position change only occurs on MouseUp. Please could you confirm the code.. procedure TUpDownButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseDown(Button, Shift, X, Y); + ButtonCoordToUpDownCoord(X, Y); + FUpDown.MouseDown(Button, Shift, X, Y); if Button = mbLeft then begin With FUpDown do begin FMouseTimerEvent := @Self.Click; @@ -59,6 +80,8 @@ Y: Integer); //should not be here??? begin // :: ??? inherited MouseUp(Button, Shift, X, Y); + ButtonCoordToUpDownCoord(X, Y); + FUpDown.MouseUp(Button, Shift, X, Y); With FUpDown do If Assigned(FMouseTimer) then begin FreeAndNil(FMouseTimer); @@ -67,6 +90,13 @@ end; end; Please could you explain what @@ -67,6 +90,13 @@ means, for example - I have not included them in the patch, of course Sorry. |
|
How did you apply my patch? The @@ are there for the patch program, it indicates at what line (appr) the patch program searches for the next block + means: add this line - means: delete this line For humans, the patch file isn't always easy to interpret. For me if I hold the mouse down on either of the arrows, it will continue to increase/decrese the associated control. [Edit: Position is changed as expected also if Associate=nil] |
|
I attached custumupdown.inc file. You can do 2 things: Make a backup of ($LazarusDir)\lcl\include\customupdown.inc Copy the new customupdown.inc file to ($LazarusDir)\lcl\include (overwrite the old one), then rebuild your application. The LCL should be rebuilt as well. Since this file is now copied from the trunk version of Lazarus, there may be incompatibilities leading to compiler errors. If it does not compile then do the following: Restore the backup of custumupdown.inc Open my version of customupdown.inc in an editor (e.g. notepad, or even the Lazarus IDE, but this may become confusing) Open your test application in Lazarus Navigate to the custumupdown.inc file (the original one). In the class definition of TUpDownButton: add (just above the protected section): private procedure ButtonCoordToUpDownCoord(var X,Y: Integer); In the protected section add: procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; Now, from my version of customupdown.inc file, copy the implementation of ButtonCoordToUpDownCoord and MouseMove. Replace the old implementation of MouseUp and MouseDown with the ones in my file. Save your copy of custumupdown.inc. Rebuild your program, this should rebuild the LCL. No compilation errors should occur inside customupdown.inc. Test your application. Report back. customupdown.inc (19,315 bytes)
{%MainUnit ../comctrls.pp} { TCustomUpDown ***************************************************************************** This file is part of the Lazarus Component Library (LCL) See the file COPYING.modifiedLGPL.txt, included in this distribution, for details about the license. ***************************************************************************** Problems - - Doesn't draw Themed Arrows/doesn't match system colors - Associate Key down and Tabbing(VK_Up, VK_Down) } Type { TUpDownButton } TUpDownButton = Class(TSpeedButton) private FMouseTimer : TTimer; FUpDown : TCustomUpDown; FButtonType : TUDBtnType; private procedure ButtonCoordToUpDownCoord(var X,Y: Integer); protected procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure DblClick; override; public constructor CreateWithParams(UpDown : TCustomUpDown; ButtonType : TUDBtnType); procedure Click; override; procedure Paint; override; end; procedure TUpDownButton.ButtonCoordToUpDownCoord(var X, Y: Integer); begin //Fix me: there must be a better way to do this? //Result may be off by appr. 2 pixels if FUpDown.Orientation = udVertical then begin if FButtonType = btPrev then //down arrow Y := Y + Height; //assumes both buttons are equal height end else begin if FButtonType = btNext then //right arrow X := X + Width; end; end; procedure TUpDownButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseDown(Button, Shift, X, Y); ButtonCoordToUpDownCoord(X, Y); FUpDown.MouseDown(Button, Shift, X, Y); if Button = mbLeft then begin With FUpDown do begin FMouseTimerEvent := @Self.Click; FMouseDownBounds := Bounds(Self.ClientOrigin.X, Self.ClientOrigin.Y, Self.Width,Self.Height); If Not Assigned(FMouseTimer) then FMouseTimer := TTimer.Create(FUpDown); With FMouseTimer do begin Enabled := False; Interval := 300; OnTimer := @BTimerExec; Enabled := True; end; end; end; end; procedure TUpDownButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseUp(Button, Shift, X, Y); ButtonCoordToUpDownCoord(X, Y); FUpDown.MouseUp(Button, Shift, X, Y); With FUpDown do If Assigned(FMouseTimer) then begin FreeAndNil(FMouseTimer); FMouseDownBounds := Rect(0,0,0,0); FMouseTimerEvent := nil; end; end; procedure TUpDownButton.MouseMove(Shift: TShiftState; X, Y: Integer); begin inherited MouseMove(Shift, X, Y); ButtonCoordToUpDownCoord(X, Y); FUpDown.MouseMove(Shift, X, Y); end; procedure TUpDownButton.DblClick; begin Click; end; procedure TUpDownButton.Click; begin with FUpDown do begin FCanChangePos := Position; FCanChangeDir := updNone; case FButtonType of btPrev : begin FCanChangeDir := updDown; if FCanChangePos - Increment >= Min then FCanChangePos := FCanChangePos - Increment else if Wrap then FCanChangePos := Max + (FCanChangePos - Increment - Min) + 1 else FCanChangePos := Min; end; btNext : begin FCanChangeDir := updUp; if FCanChangePos + Increment <= Max then FCanChangePos := FCanChangePos + Increment else If Wrap then FCanChangePos := Min + (FCanChangePos + Increment - Max) - 1 else FCanChangePos := Max; end; end; if not CanChange then Exit; Position := FCanChangePos; Click(FButtonType); end; end; constructor TUpDownButton.CreateWithParams(UpDown : TCustomUpDown; ButtonType : TUDBtnType); begin Inherited Create(UpDown); FUpDown := UpDown; FButtonType := ButtonType; Parent := FUpDown; ControlStyle := ControlStyle + [csNoFocus, csNoDesignSelectable]; end; procedure TUpDownButton.Paint; var tmp : double; ax, ay, ah, aw : integer; j : integer; begin Inherited Paint; if Enabled then Canvas.Pen.Color := clBtnText //Not perfect, but it works else Canvas.Pen.Color := clGrayText; ah := height div 2; aw := width div 2; if (FUpDown.Orientation = udHorizontal) then begin tmp := double(ah+1)/2; if (tmp > aw) then begin ah := 2*aw - 1; aw := (ah+1) div 2; end else begin aw := RoundToInt(tmp); ah := 2*aw - 1; end; aw := max(aw, 3); ah := max(ah, 5); end else begin tmp := double(aw+1)/2; if (tmp > ah) then begin aw := 2*ah - 1; ah := (aw+1) div 2; end else begin ah := RoundToInt(tmp); aw := 2*ah - 1; end; ah := max(ah, 3); aw := max(aw, 5); end; ax := (width - aw) div 2; ay := (height - ah) div 2; Case FButtonType of btPrev : begin If FUpDown.Orientation = udVertical then begin for j := 0 to aw div 2 do begin Canvas.MoveTo(ax + j, ay + j); Canvas.LineTo(ax + aw - j, ay + j); end; end else for j := 0 to ah div 2 do begin Canvas.MoveTo(ax + aw - j - 2, ay + j); Canvas.LineTo(ax + aw - j - 2, ay + ah - j - 1); end; end; btNext : begin If FUpDown.Orientation = udVertical then begin for j := 0 to aw div 2 do begin Canvas.MoveTo(ax + j, ay + ah - j - 1); Canvas.LineTo(ax + aw - j, ay + ah - j - 1); end; end else for j := 0 to ah div 2 do begin Canvas.MoveTo(ax + j, ay + j); Canvas.LineTo(ax + j, ay + ah - j - 1); end; end end; end; { TCustomUpDown } constructor TCustomUpDown.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := ControlStyle - [csDoubleClicks] + [csClickEvents, csOpaque, csReplicatable, csNoFocus]; FUseWS := IsWSComponentInheritsFrom(TCustomUpDown, TWSCustomUpDown); FOrientation := udVertical; if not FUseWS then begin FMinBtn := TUpDownButton.CreateWithParams(Self, btPrev); FMaxBtn := TUpDownButton.CreateWithParams(Self, btNext); end; with GetControlClassDefaultSize do SetInitialBounds(0, 0, CX, CY); FArrowKeys := True; FMax := 100; FMinRepeatInterval := 100; FIncrement := 1; FAlignButton := udRight; FThousands := True; end; destructor TCustomUpDown.Destroy; begin FAssociate := nil; inherited destroy; end; procedure TCustomUpDown.BTimerExec(Sender : TObject); var AInterval:Integer; begin If Assigned(FMouseTimerEvent) and PtInRect(FMouseDownBounds,Mouse.CursorPos) then begin AInterval := TTimer(Sender).Interval; if AInterval > FMinRepeatInterval then begin AInterval := AInterval - 25; if AInterval < FMinRepeatInterval then AInterval := FMinRepeatInterval; TTimer(Sender).Interval := AInterval; end; FMouseTimerEvent; end; end; procedure TCustomUpDown.UpdateUpDownPositionText; begin if (not (csDesigning in ComponentState)) and (FAssociate <> nil) then begin if Thousands then FAssociate.Caption := FloatToStrF(FPosition, ffNumber, 0, 0) else FAssociate.Caption := IntToStr(FPosition); end; end; class procedure TCustomUpDown.WSRegisterClass; begin inherited WSRegisterClass; RegisterCustomUpDown; end; procedure TCustomUpDown.InitializeWnd; begin inherited InitializeWnd; if not FUseWS then Exit; TWSCustomUpDownClass(WidgetSetClass).SetMinPosition(Self, FMin); TWSCustomUpDownClass(WidgetSetClass).SetMaxPosition(Self, FMax); TWSCustomUpDownClass(WidgetSetClass).SetPosition(Self, FPosition); TWSCustomUpDownClass(WidgetSetClass).SetIncrement(Self, FIncrement); TWSCustomUpDownClass(WidgetSetClass).SetWrap(Self, FWrap); TWSCustomUpDownClass(WidgetSetClass).SetOrientation(Self, FOrientation); TWSCustomUpDownClass(WidgetSetClass).SetUseArrowKeys(Self, FArrowKeys); end; procedure TCustomUpDown.UpdateOrientation; var d, r: Integer; begin if FUseWS then Exit; If FOrientation = udHorizontal then begin d:=ClientWidth div 2; r:=ClientWidth mod 2; FMinBtn.SetBounds(0,0,d,ClientHeight); FMaxBtn.SetBounds(d+r,0,d,ClientHeight); end else begin d:=ClientHeight div 2; r:=ClientHeight mod 2; FMaxBtn.SetBounds(0,0,ClientWidth,d); FMinBtn.SetBounds(0,d+r,ClientWidth,d); end; end; procedure TCustomUpDown.UpdateAlignButtonPos; var NewWidth: Integer; NewLeft: Integer; NewHeight: Integer; NewTop: Integer; begin If Assigned(Associate) then begin if FAlignButton in [udLeft,udRight] then begin NewWidth := Width; NewHeight := Associate.Height; If FAlignButton = udLeft then NewLeft := Associate.Left - NewWidth else NewLeft := Associate.Left + Associate.Width; NewTop := Associate.Top; end else begin NewWidth := Associate.Width; NewHeight := Height; NewLeft := Associate.Left; If FAlignButton = udTop then NewTop := Associate.Top - NewHeight else NewTop := Associate.Top + Associate.Height; end; SetBounds(NewLeft,NewTop,NewWidth,NewHeight); end; end; function TCustomUpDown.CanChange: Boolean; begin Result := True; if Assigned(FOnChanging) then FOnChanging(Self, Result); if Assigned(FOnChangingEx) then FOnChangingEx(Self, Result, FCanChangePos, FCanChangeDir); end; procedure TCustomUpDown.Click(Button: TUDBtnType); begin if Assigned(FOnClick) then FOnClick(Self, Button); end; procedure TCustomUpDown.SetAssociate(Value: TWinControl); var I: Integer; OtherControl: TControl; begin // check that no other updown component is associated to the new Associate if (Value <> FAssociate) and (Value<>nil) then for I := 0 to Parent.ControlCount - 1 do begin OtherControl:=Parent.Controls[I]; if (OtherControl is TCustomUpDown) and (OtherControl <> Self) then if TCustomUpDown(OtherControl).Associate = Value then raise Exception.CreateFmt(rsIsAlreadyAssociatedWith, [Value.Name,OtherControl.Name]); end; // disconnect old Associate if FAssociate <> nil then begin FAssociate.RemoveAllHandlersOfObject(Self); FAssociate := nil; end; // connect new Associate if (Value <> nil) and (Value.Parent = Self.Parent) and not (Value is TCustomUpDown) and not (Value is TCustomTreeView) and not (Value is TCustomListView) then begin FAssociate := Value; UpdateUpDownPositionText; UpdateAlignButtonPos; FAssociate.AddHandlerOnKeyDown(@AssociateKeyDown,true); FAssociate.AddHandlerOnChangeBounds(@OnAssociateChangeBounds,true); FAssociate.AddHandlerOnEnabledChanged(@OnAssociateChangeEnabled,true); FAssociate.AddHandlerOnVisibleChanged(@OnAssociateChangeVisible,true); FAssociate.AddHandlerOnMouseWheel(@AssociateMouseWheel,true); end; end; procedure TCustomUpDown.AdjustPos(incPos: Boolean); var anewpos: Integer; begin if FUseWS then begin if incPos then anewpos := Position + Increment else anewpos := Position - Increment; if (anewpos < Min) then anewpos := Min else if (anewpos > Max) then anewpos := Max; SetPosition(anewpos); end else begin if incPos then TCustomSpeedButton(FMaxBtn).Click else TCustomSpeedButton(FMinBtn).Click; end; end; procedure TCustomUpDown.AssociateKeyDown(Sender: TObject; var Key: Word; ShiftState : TShiftState); var ConsumeKey: Boolean; begin ConsumeKey := False; if ArrowKeys and (ShiftState = []) then begin case FOrientation of udVertical: case Key of VK_Up: begin AdjustPos(True); ConsumeKey := True; end; VK_Down: begin AdjustPos(False); ConsumeKey := True; end; end; udHorizontal: case Key of VK_Left: begin AdjustPos(False); ConsumeKey := True; end; VK_Right: begin AdjustPos(True); ConsumeKey := True; end; end; end; end; if ConsumeKey then Key := 0; end; procedure TCustomUpDown.AssociateMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); begin //debugln('TCustomUpDown.AssociateMouseWheel A: Handled = ',DbgS(Handled)); if (WheelDelta > 0) then begin AdjustPos(True); Handled := True; end else if (WheelDelta < 0) then begin AdjustPos(False); Handled := True; end; //debugln('TCustomUpDown.AssociateMouseWheel End: Handled = ',DbgS(Handled)); end; procedure TCustomUpDown.OnAssociateChangeBounds(Sender: TObject); begin UpdateAlignButtonPos; end; procedure TCustomUpDown.OnAssociateChangeEnabled(Sender: TObject); begin if Assigned(FAssociate) then SetEnabled(FAssociate.Enabled); end; procedure TCustomUpDown.OnAssociateChangeVisible(Sender: TObject); begin if Assigned(FAssociate) then SetVisible(FAssociate.Visible); end; function TCustomUpDown.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; begin Result := inherited DoMouseWheelDown(Shift, MousePos); if not Result and not FUseWS then TCustomSpeedButton(FMinBtn).Click; end; function TCustomUpDown.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; begin Result := inherited DoMouseWheelUp(Shift, MousePos); if not Result and not FUseWS then TCustomSpeedButton(FMaxBtn).Click; end; function TCustomUpDown.DoMouseWheelLeft(Shift: TShiftState; MousePos: TPoint): Boolean; begin Result := inherited DoMouseWheelLeft(Shift, MousePos); if not Result then if (Orientation=udHorizontal) and not FUseWS then TCustomSpeedButton(FMinBtn).Click; end; function TCustomUpDown.DoMouseWheelRight(Shift: TShiftState; MousePos: TPoint): Boolean; begin Result := inherited DoMouseWheelRight(Shift, MousePos); if not Result then if (Orientation=udHorizontal) and not FUseWS then TCustomSpeedButton(FMaxBtn).Click; end; procedure TCustomUpDown.DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); begin inherited; UpdateOrientation; end; procedure TCustomUpDown.SetEnabled(Value: Boolean); begin if not FUseWS then begin FMinBtn.Enabled := Value; FMaxBtn.Enabled := Value; end; inherited SetEnabled(Value); end; class function TCustomUpDown.GetControlClassDefaultSize: TSize; begin Result.CX := 17; Result.CY := 31; end; procedure TCustomUpDown.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); begin case Orientation of udHorizontal: begin PreferredWidth:=31; PreferredHeight:=17; end; udVertical: begin PreferredWidth:=17; PreferredHeight:=31; end; end; end; procedure TCustomUpDown.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if (Operation = opRemove) and (AComponent = FAssociate) then SetAssociate(nil); end; function TCustomUpDown.GetPosition: SmallInt; var av,I : Integer; str : string; InvalidNumber : Boolean; begin If Associate <> nil then begin str := Trim(Associate.Caption); str := StringReplace(str, DefaultFormatSettings.ThousandSeparator, '', [rfReplaceAll]); if not TryStrToInt(str, AV) then begin Result := FPosition; Exit; end; //this will also correct for AV > High(SmallInt) or AV < Low(SMallInt) If AV > FMax then AV := FMax; If AV < FMin then AV := FMin; Position := AV; end; Result := FPosition; end; function TCustomUpDown.GetFlat: Boolean; begin if FUseWS then Result := false else if FMinBtn<>nil then Result := (FMinBtn as TSpeedButton).Flat else Result := False; end; procedure TCustomUpDown.SetMin(Value: SmallInt); begin if Value <> FMin then begin FMin := Value; If FPosition < FMin then Position := FMin; if FUseWS then TWSCustomUpDownClass(WidgetSetClass).SetMinPosition(Self, FMin); end; end; procedure TCustomUpDown.SetMinRepeatInterval(AValue: Byte); begin if FMinRepeatInterval = AValue then Exit; FMinRepeatInterval := AValue; if FMinRepeatInterval < 25 then FMinRepeatInterval := 25; end; procedure TCustomUpDown.SetMax(Value: SmallInt); begin if Value <> FMax then begin FMax := Value; If FPosition > FMax then Position := FMax; if FUseWS then TWSCustomUpDownClass(WidgetSetClass).SetMaxPosition(Self, FMax); end; end; procedure TCustomUpDown.SetIncrement(Value: Integer); begin if Value <> FIncrement then begin FIncrement := Value; if FUseWS then TWSCustomUpDownClass(WidgetSetClass).SetIncrement(Self, FIncrement); end; end; procedure TCustomUpDown.SetPosition(Value: SmallInt); begin if FPosition = Value then exit; FPosition := Value; if FUseWS then TWSCustomUpDownClass(WidgetSetClass).SetPosition(Self, FPosition); UpdateUpDownPositionText; end; procedure TCustomUpDown.SetOrientation(Value: TUDOrientation); begin if FOrientation = Value then exit; FOrientation := Value; if FUseWS then TWSCustomUpDownClass(WidgetSetClass).SetOrientation(Self, FOrientation); UpdateOrientation; end; procedure TCustomUpDown.SetAlignButton(Value: TUDAlignButton); begin if FAlignButton = Value then exit; FAlignButton := Value; UpdateAlignButtonPos; end; procedure TCustomUpDown.SetArrowKeys(Value: Boolean); begin if Value <> FArrowKeys then begin FArrowKeys := Value; if FUseWS then TWSCustomUpDownClass(WidgetSetClass).SetUseArrowKeys(Self, Value); end; end; procedure TCustomUpDown.SetThousands(Value: Boolean); begin if Value <> FThousands then FThousands := Value; end; procedure TCustomUpDown.SetFlat(Value: Boolean); begin if FUseWS then Exit; // todo: not supported by WS yet if Flat = Value then Exit; (FMinBtn as TSpeedButton).Flat := Value; (FMaxBtn as TSpeedButton).Flat := Value; end; procedure TCustomUpDown.SetWrap(Value: Boolean); begin if Value <> FWrap then FWrap := Value; if FUseWS then TWSCustomUpDownClass(WidgetSetClass).SetWrap(Self, FWrap); end; // included by comctrls.pp |
|
I took the easy route and overwrote the original with your new version. There were no compilation problems or errors. MouseUp and and MouseDown work fine. Continued mouse down continuously increments/decrements Position. But while I am being a nuisance, I did note that MouseEnter only fires with the mouse cursor in that narrow gap (that is, not over the buttons) or on a MouseUp event. Thank you, Bart |
|
Oops. Forget the bit about MouseEnter firing on MouseUp. It doesn't. Just another mistake of mine. |
|
Yes, MouseEnter/MouseLeave do not fire. I cannot even get my mouse (trackpad) to hover over the narrow gap. Problem is that I cannot simply forward the button's MouseEnter/MouseLeave, because that would fire also if you move from one button to the other. I will first commit the changes I made for MouseDown/MouseUp. Can you please open a separate bugreport for MouseEnter/MouseLeave, so we can continue there. |
Date Modified | Username | Field | Change |
---|---|---|---|
2020-11-17 17:53 | Andy Spry | New Issue | |
2020-11-17 19:00 | Bart Broersma | Note Added: 0127013 | |
2020-11-17 21:05 | Bart Broersma | Status | new => feedback |
2020-11-17 21:05 | Bart Broersma | LazTarget | => - |
2020-11-17 21:05 | Bart Broersma | Note Added: 0127017 | |
2020-11-17 21:12 | Bart Broersma | Note Edited: 0127017 | View Revisions |
2020-11-18 09:28 | Bart Broersma | Note Added: 0127024 | |
2020-11-18 09:28 | Bart Broersma | File Added: updown.mouse-events.2.diff | |
2020-11-18 13:22 | Andy Spry | Note Added: 0127028 | |
2020-11-18 13:22 | Andy Spry | Status | feedback => new |
2020-11-18 14:09 | Bart Broersma | Note Added: 0127029 | |
2020-11-18 14:12 | Bart Broersma | Note Edited: 0127029 | View Revisions |
2020-11-18 14:25 | Bart Broersma | Note Added: 0127030 | |
2020-11-18 14:25 | Bart Broersma | File Added: customupdown.inc | |
2020-11-18 14:26 | Bart Broersma | Assigned To | => Bart Broersma |
2020-11-18 14:26 | Bart Broersma | Status | new => feedback |
2020-11-18 15:08 | Andy Spry | Note Added: 0127031 | |
2020-11-18 15:08 | Andy Spry | Status | feedback => assigned |
2020-11-18 15:19 | Andy Spry | Note Added: 0127032 | |
2020-11-18 17:30 | Bart Broersma | Note Added: 0127036 | |
2020-11-18 17:32 | Bart Broersma | Status | assigned => resolved |
2020-11-18 17:32 | Bart Broersma | Resolution | open => fixed |
2020-11-18 17:32 | Bart Broersma | Fixed in Revision | => r64147 |
2020-11-18 17:32 | Bart Broersma | Widgetset | Win32/Win64 => Win32/Win64 |
2020-11-20 12:08 | Juha Manninen | Relationship added | related to 0038101 |