德尔福XE5 : How to stop scrolling in a TButtonGroup

Question

我在 TCategoryPanel 内将 TbuttonGroup 设置为 alClient，我无法停止使用鼠标滚轮滚动。当焦点设置到按钮组时，即使所有项目都已经可见，并且大小设置为容纳所有内容 + 2 像素，它也会向上移动按钮组的内容并隐藏第一个项目并创建一个空白空间在底部。我在自己的研究中没有发现与此行为相关的任何内容，因此如果有人有建议，可以使用建议!

图片:

滚动之前

滚动1后

滚动2后

到目前为止，我发现阻止它的唯一方法是将其设置为高 1 个完整按钮高度(24px)。然而，当涉及到 GUI 时，这作为问题的解决方案并不是真正可以接受的。

DFM 副本:

object MainF: TMainF
  Left = 0
  Top = 0
  Caption = 'MainF'
  ClientHeight = 550
  ClientWidth = 785
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  Menu = MainMenu1
  OldCreateOrder = False
  OnClose = FormClose
  OnCreate = FormCreate
  OnPaint = FormPaint
  OnResize = FormResize
  DesignSize = (
    785
    550)
  PixelsPerInch = 96
  TextHeight = 13
  object ScrollBox1: TScrollBox
    Left = 200
    Top = 45
    Width = 585
    Height = 505
    Align = alClient
    BevelInner = bvNone
    BevelOuter = bvNone
    BorderStyle = bsNone
    Color = clWindow
    ParentColor = False
    TabOrder = 0
    OnClick = FlowPanel1Click
    object FlowPanel1: TFlowPanel
      Left = 0
      Top = 0
      Width = 585
      Height = 105
      Align = alTop
      AutoSize = True
      BevelOuter = bvNone
      Color = clWindow
      TabOrder = 0
      OnClick = FlowPanel1Click
    end
  end
  object CategoryPanelGroup1: TCategoryPanelGroup
    Left = 0
    Top = 45
    Height = 505
    VertScrollBar.Tracking = True
    HeaderFont.Charset = DEFAULT_CHARSET
    HeaderFont.Color = clWindowText
    HeaderFont.Height = -11
    HeaderFont.Name = 'Tahoma'
    HeaderFont.Style = []
    TabOrder = 1
    object CategoryPanel2: TCategoryPanel
      Top = 220
      Height = 100
      Caption = 'Hail'
      TabOrder = 0
      object ButtonGroup2: TButtonGroup
        Left = 0
        Top = 0
        Width = 196
        Height = 74
        Align = alClient
        BorderStyle = bsNone
        ButtonOptions = [gboFullSize, gboShowCaptions]
        Items = <
          item
            Caption = 'Extended Crop Report'
          end
          item
            Caption = 'Total Crop Summary Report'
          end
          item
            Caption = 'Crop Summary Report'
          end>
        TabOrder = 0
      end
    end
    object CategoryPanel1: TCategoryPanel
      Top = 0
      Height = 220
      Caption = 'Assessment'
      TabOrder = 1
      object ButtonGroup1: TButtonGroup
        Left = 0
        Top = 0
        Width = 196
        Height = 194
        Align = alClient
        BorderStyle = bsNone
        ButtonOptions = [gboFullSize, gboShowCaptions]
        Items = <
          item
            Caption = 'Assessment By Property(Detailed)'
          end
          item
            Caption = 'Assessment By Property'
          end
          item
            Caption = 'Assessment Summary 1 Page'
          end
          item
            Caption = 'Assessment By PPC'
          end
          item
            Caption = 'Assessment By LPC'
          end
          item
            Caption = 'Assessment By Authority For LPC'
          end
          item
            Caption = 'Property By Assessment Number'
          end
          item
            Caption = 'Assessment By Authority For PPC'
          end>
        TabOrder = 0
      end
    end
  end
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 785
    Height = 45
    Align = alTop
    BevelOuter = bvNone
    ParentColor = True
    TabOrder = 2
    object Label1: TLabel
      Left = 10
      Top = 0
      Width = 349
      Height = 43
      AutoSize = False
      Caption = 'Reports for redacted'
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -24
      Font.Name = 'Tahoma'
      Font.Style = []
      ParentFont = False
      Layout = tlCenter
    end
  end
  object WaitPanel: TPanel
    Left = 228
    Top = 167
    Width = 505
    Height = 100
    Anchors = [akLeft, akTop, akRight, akBottom]
    Caption = 'A report is open. Please wait...'
    TabOrder = 3
  end
  object MainMenu1: TMainMenu
    Left = 368
    Top = 152
    object mnuFile1: TMenuItem
      Caption = 'File'
      object mnuExit1: TMenuItem
        Caption = 'Exit'
      end
    end
    object Settings1: TMenuItem
      Caption = 'Settings'
      object mnuReports1: TMenuItem
        Caption = 'Reports'
        OnClick = mnuReports1Click
      end
      object mnuChangeCommon1: TMenuItem
        Caption = 'Change Common Reports'
        OnClick = mnuChangeCommon1Click
      end
    end
    object mnuHelp1: TMenuItem
      Caption = 'Help'
      object mnuAbout1: TMenuItem
        Caption = 'About'
        OnClick = mnuAbout1Click
      end
    end
  end
  object ReportListDB: TABSDatabase
    Connected = True
    CurrentVersion = '7.30 '
    DatabaseFileName = ''
    DatabaseName = 'RptName'
    Exclusive = False
    MaxConnections = 500
    MultiUser = False
    SessionName = 'Default'
    Left = 336
    Top = 261
  end
  object ReportList: TABSTable
    CurrentVersion = '7.30 '
    DatabaseName = 'RptName'
    InMemory = False
    ReadOnly = False
    StoreDefs = True
    IndexDefs = <
      item
        Name = 'IDKey'
        Fields = 'ID'
        Options = [ixPrimary]
      end>
    IndexName = 'IDKey'
    FieldDefs = <
      item
        Name = 'ID'
        DataType = ftAutoInc
      end
      item
        Name = 'ReportFileName'
        DataType = ftString
        Size = 100
      end
      item
        Name = 'ReportTitle'
        DataType = ftString
        Size = 100
      end
      item
        Name = 'ReportClass'
        DataType = ftString
        Size = 20
      end
      item
        Name = 'CommonReports'
        DataType = ftInteger
      end>
    TableName = 'ReportList'
    Exclusive = False
    Left = 408
    Top = 261
    object ReportListCommonReports: TIntegerField
      DisplayWidth = 10
      FieldName = 'CommonReports'
    end
    object ReportListReportTitle: TStringField
      DisplayWidth = 30
      FieldName = 'ReportTitle'
      Size = 100
    end
    object ReportListReportClass: TStringField
      DisplayWidth = 10
      FieldName = 'ReportClass'
    end
    object ReportListReportFileName: TStringField
      DisplayWidth = 45
      FieldName = 'ReportFileName'
      Visible = False
      Size = 100
    end
    object ReportListID: TAutoIncField
      DisplayWidth = 2
      FieldName = 'ID'
      Visible = False
    end
  end
  object ReportOrderQRY: TABSQuery
    CurrentVersion = '7.30 '
    DatabaseName = 'RptName'
    InMemory = False
    ReadOnly = True
    SQL.Strings = (
      'SELECT ID, CommonReports, ReportTitle'
      'FROM ReportList'
      'WHERE CommonReports > 0'
      'ORDER BY CommonReports')
    Left = 480
    Top = 261
    object ReportOrderQRYID: TIntegerField
      FieldName = 'ID'
    end
    object ReportOrderQRYCommonReports: TIntegerField
      FieldName = 'CommonReports'
    end
    object ReportOrderQRYReportTitle: TStringField
      FieldName = 'ReportTitle'
      Size = 100
    end
  end
end

Answer 1

AFAICS，问题在于，在调整按钮组大小以适合其父级的工作区之前，会计算按钮组中的总可见行数。这发生在 TButtonGroup.Resize 过程中。

一种解决方案是在窗口呈现其最终大小后强制调整大小。

ButtonGroup1.Height := ButtonGroup1.Height + 1;

虽然这有效，例如，在单击按钮时，我找不到在表单创建时调用它的好地方。在处理已发布的用户消息时执行此操作可能还为时过早(不太确定它不起作用的原因)。

另一种解决方案是为 OnMouseWheelDown 事件附加一个处理程序，以防止进一步处理。

procedure TForm1.ButtonGroup1MouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  if ButtonGroup1.ClientHeight >= ButtonGroup1.Items.Count * ButtonGroup1.ButtonHeight then
    Handled := True;
end;

..尽管隐藏滚动条仍然需要上面的内容。

procedure TForm1.FormCreate(Sender: TObject);
begin
  if ButtonGroup1.Align = alClient then
    ButtonGroup1.Height := ButtonGroup1.Height + 1;
end;