diff --git a/components/tvplanit/source/vpbase.pas b/components/tvplanit/source/vpbase.pas index ffbd52fb2..4b6a5ecab 100644 --- a/components/tvplanit/source/vpbase.pas +++ b/components/tvplanit/source/vpbase.pas @@ -149,12 +149,8 @@ type procedure CMVisibleChanged(var Msg : TMessage); message CM_VISIBLECHANGED; {$IFNDEF LCL} procedure WMMouseWheel(var Msg : TMessage); message WM_MOUSEWHEEL; - {$ELSE} - procedure WMMouseWheel(var Msg : TLMessage); message LM_MOUSEWHEEL; - {$ENDIF} - - protected procedure DoOnMouseWheel(Shift: TShiftState; Delta, XPos, YPos: SmallInt); dynamic; + {$ENDIF} procedure CreateWnd; override; property AfterEnter: TNotifyEvent read FAfterEnter write FAfterEnter; property AfterExit: TNotifyEvent read FAfterExit write FAfterExit; @@ -427,14 +423,6 @@ begin end; {=====} -procedure TVpCustomControl.DoOnMouseWheel(Shift: TShiftState; - Delta, XPos, YPos: SmallInt); -begin - if Assigned(FOnMouseWheel) then - FOnMouseWheel(Self, Shift, Delta, XPos, YPos); -end; -{=====} - function TVpCustomControl.GetVersion: string; begin Result := VpVersionStr; @@ -449,17 +437,24 @@ end; {$IFNDEF LCL} procedure TVpCustomControl.WMMouseWheel(var Msg: TMessage); -{$ELSE} -procedure TVpCustomControl.WMMouseWheel(var Msg: TLMessage); -{$ENDIF} begin with Msg do - DoOnMouseWheel(KeysToShiftState(LOWORD(wParam)) {fwKeys}, - HIWORD(wParam) {zDelta}, - LOWORD(lParam) {xPos}, - HIWORD(lParam) {yPos} + DoOnMouseWheel( + KeysToShiftState(LOWORD(wParam)) {fwKeys}, + HIWORD(wParam) {zDelta}, + LOWORD(lParam) {xPos}, + HIWORD(lParam) {yPos} ); end; + +procedure TVpCustomControl.DoOnMouseWheel(Shift: TShiftState; + Delta, XPos, YPos: SmallInt); +begin + if Assigned(FOnMouseWheel) then + FOnMouseWheel(Self, Shift, Delta, XPos, YPos); +end; + +{$ENDIF} {=====} (*****************************************************************************) diff --git a/components/tvplanit/source/vpcalendar.pas b/components/tvplanit/source/vpcalendar.pas index 02652d497..e65e8546d 100644 --- a/components/tvplanit/source/vpcalendar.pas +++ b/components/tvplanit/source/vpcalendar.pas @@ -229,8 +229,12 @@ type procedure CreateWnd; override; procedure DoOnChange(Value : TDateTime); dynamic; function DoOnGetDateEnabled(ADate : TDateTime) : Boolean; dynamic; + {$IFDEF LCL} + // .... to be done in DoMouseWheel + {$ELSE} procedure DoOnMouseWheel(Shift : TShiftState; Delta, XPos, YPos : SmallInt); override; + {$ENDIF} function IsReadOnly : Boolean; dynamic; {-return true if the calendar is in read-only mode} procedure KeyDown(var Key : Word; Shift : TShiftState); override; @@ -973,12 +977,14 @@ begin end; {=====} +{$IFDEF LCL} + // to be done in DoMouseWheel +{$ELSE} procedure TVpCustomCalendar.DoOnMouseWheel(Shift : TShiftState; Delta, XPos, YPos : SmallInt); var Key : Word; begin inherited DoOnMouseWheel(Shift, Delta, XPos, YPos); -{$IFNDEF LCL} if Abs(Delta) = WHEEL_DELTA then begin {inc/dec month} if Delta < 0 then @@ -1001,8 +1007,8 @@ begin Key := VK_UP; KeyDown(Key, []); end; -{$ENDIF} end; +{$ENDIF} {=====} function TVpCustomCalendar.IsReadOnly : Boolean; diff --git a/components/tvplanit/source/vpdayview.pas b/components/tvplanit/source/vpdayview.pas index 7ec2d7353..fe2984825 100644 --- a/components/tvplanit/source/vpdayview.pas +++ b/components/tvplanit/source/vpdayview.pas @@ -332,8 +332,7 @@ type procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); override; { internal methods } - function dvCalcRowHeight (Scale : Extended; - UseGran : TVpGranularity) : Integer; + function dvCalcRowHeight (Scale: Extended; UseGran: TVpGranularity): Integer; function dvCalcVisibleLines (RenderHeight : Integer; ColHeadHeight : Integer; RowHeight : Integer; @@ -361,8 +360,7 @@ type procedure Paint; override; procedure Loaded; override; procedure dvSpawnEventEditDialog(NewEvent: Boolean); - procedure dvSetActiveRowByCoord (Pnt : TPoint; - Sloppy : Boolean); + procedure dvSetActiveRowByCoord(Pnt: TPoint; Sloppy: Boolean); procedure dvSetActiveColByCoord(Pnt: TPoint); procedure dvPopulate; procedure dvNavButtonsClick(Sender: TObject); @@ -372,33 +370,31 @@ type procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override; procedure MouseMove(Shift: TShiftState; X,Y: Integer); override; procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override; - {$IFNDEF LCL} - procedure WMLButtonDblClk(var Msg : TWMLButtonDblClk); - message WM_LBUTTONDBLCLK; - {$ELSE} - procedure WMLButtonDblClk(var Msg : TLMLButtonDblClk); message LM_LBUTTONDBLCLK; - {$ENDIF} procedure SetActiveEventByCoord (APoint : TPoint); function EditEventAtCoord(Point: TPoint): Boolean; function GetEventAtCoord(Point: TPoint): TVpEvent; procedure EditEvent; procedure EndEdit(Sender: TObject); procedure KeyDown(var Key: Word; Shift: TShiftState); override; - procedure SetTimeIntervals (UseGran : TVpGranularity); + procedure SetTimeIntervals(UseGran: TVpGranularity); { message handlers } - procedure VpDayViewInit (var Msg : TMessage); Message Vp_DayViewInit; + procedure VpDayViewInit(var Msg: TMessage); message Vp_DayViewInit; {$IFNDEF LCL} + procedure WMLButtonDblClk(var Msg : TWMLButtonDblClk); message WM_LBUTTONDBLCLK; procedure WMSize(var Msg: TWMSize); message WM_SIZE; procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL; procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS; - procedure WMEraseBackground (var Msg : TWMERASEBKGND); - procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); - message CM_WANTSPECIALKEY; + procedure WMEraseBackground (var Msg : TWMERASEBKGND); // ??? wp: missing "message WM_ERASEBKGN"? + procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY; {$ELSE} + function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override; + function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override; + function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override; procedure WMSize(var Msg: TLMSize); message LM_SIZE; procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL; - procedure WMSetFocus(var Msg : TLMSetFocus); message LM_SETFOCUS; - procedure WMEraseBackground (var Msg : TLMERASEBKGND); + procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS; + procedure WMEraseBackground(var Msg: TLMERASEBKGND); // ??? wp: missing "message WM_ERASEBKGN"? + procedure WMLButtonDblClk(var Msg: TLMLButtonDblClk); message LM_LBUTTONDBLCLK; {$ENDIF} public constructor Create(AOwner: TComponent); override; @@ -407,8 +403,7 @@ type procedure DeleteActiveEvent(Verify: Boolean); procedure DragDrop(Source: TObject; X, Y: Integer); override; - function HourToLine (const Value : TVpHours; - const UseGran : TVpGranularity) : Integer; + function HourToLine (const Value: TVpHours; const UseGran: TVpGranularity): Integer; procedure Invalidate; override; procedure LinkHandler(Sender: TComponent; NotificationType: TVpNotificationType; @@ -1447,8 +1442,9 @@ begin Result := FNumDays; end; {=====} -function TVpDayView.HourToLine (const Value : TVpHours; - const UseGran : TVpGranularity) : Integer; + +function TVpDayView.HourToLine (const Value: TVpHours; + const UseGran: TVpGranularity): Integer; begin case UseGran of gr60Min : Result := Ord (Value); @@ -1458,8 +1454,7 @@ begin gr10Min : Result := Ord (Value) * 6; gr06Min : Result := Ord (Value) * 10; gr05Min : Result := Ord (Value) * 12; - else - Result := Ord (Value) * 2; { Default to 30 minutes } + else Result := Ord (Value) * 2; { Default to 30 minutes } end; end; @@ -2029,6 +2024,54 @@ begin end; {=====} +{$IFDEF LCL} +{ +procedure TVpDayView.WMMouseWheel(var Message: TLMMouseEvent); +begin + inherited; +end; + } +function TVpDayView.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; + MousePos: TPoint): Boolean; +begin + Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos); +end; + +function TVpDayView.DoMouseWheelDown(Shift: TShiftState; + MousePos: TPoint): Boolean; +var + delta: Integer; +begin + Result := inherited DoMouseWheelDown(Shift, MousePos); + if not Result then begin + if [ssCtrl, ssShift] * Shift <> [] then begin + delta := HourToLine(h_01, FGranularity); + if delta = 1 then delta := 3; + end else + delta := 1; + dvScrollVertical(delta); + Result := True; + end; +end; + +function TVpDayView.DoMouseWheelUp(Shift: TShiftState; + MousePos: TPoint): Boolean; +var + delta: Integer; +begin + Result := inherited DoMouseWheelUp(Shift, MousePos); + if not Result then begin + if [ssCtrl, ssShift] * Shift <> [] then begin + delta := HourToLine(h_01, FGranularity); + if delta = 1 then delta := 3; + end else + delta := 1; + dvScrollVertical(-delta); + Result := True; + end; +end; +{$ENDIF} + procedure TVpDayView.EditSelectedEvent; begin if ReadOnly then