pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

tvplanit: Mouse wheel support for DayView

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4728 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-06-12 15:29:23 +00:00
parent 3fe2442f42
commit 742ff53271
3 changed files with 89 additions and 45 deletions
Download Patch File Download Diff File Expand all files Collapse all files

29
components/tvplanit/source/vpbase.pas
View File

@ -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},
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}
{=====}
(*****************************************************************************)

10
components/tvplanit/source/vpcalendar.pas
View File

@ -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;

81
components/tvplanit/source/vpdayview.pas
View File

@ -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,12 +370,6 @@ 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;
@ -386,19 +378,23 @@ type
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
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 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,6 +1442,7 @@ begin
Result := FNumDays;
end;
{=====}
function TVpDayView.HourToLine (const Value: TVpHours;
const UseGran: TVpGranularity): Integer;
begin
@ -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