2022年8月10日 星期三

TCategoryPanelGroup - MouseWheel : Not functional ?

 //---------------
//Form MouseWheel
//---------------
procedure TForm.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  if PtInRect(CategoryPanelGroup1.BoundsRect, ScreenToClient(Mouse.CursorPos)) then
    CategoryPanelGroup1MouseWheel(Sender, Shift, WheelDelta, MousePos, Handled);
end;

//-----------------------------
//CategoryPanelGroup MouseWheel
//-----------------------------
procedure TForm.CategoryPanelGroup1MouseWheel(Sender: TObject;
  Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
  var Handled: Boolean);
var
  msg: Cardinal;
  code: Cardinal;
  i, n: Integer;
begin // Thanks to *Peter Below* for this code (adapted here)
  Handled := true;
  if ssShift in Shift then
    msg := WM_HSCROLL
  else
    msg := WM_VSCROLL;
  if WheelDelta > 0 then
    code := SB_LINEUP
  else
    code := SB_LINEDOWN;
  n:= Mouse.WheelScrollLines;
  for i:= 1 to n do
    CategoryPanelGroup1.Perform(msg, code, 0);
  CategoryPanelGroup1.Perform(msg, SB_ENDSCROLL, 0);
end;

沒有留言:

張貼留言