创建自己的ListControl，Delphi中的一些问题

Question

前段时间我决定创建自己的ListControl。 ListControl 下的意思是一个类似于 Delphi 中标准 TListBox 的控件。 我知道，这是“重新发明轮子”，但我想完成我的控制。 因此，我在该控件中实现的功能不像TListBox 那样多，但我的控件允许：

1. 添加项目；
2. 选择项目；
3. 通过键盘（向上和向下箭头键）浏览项目。

我计划实现我的 ScrollBar，但这是另一个话题。

但是我有一个问题：当项目的摘要高度大于控件的高度并且选择了最后一个项目并且我尝试增加控件的高度时，我得到了一个“空白空间”，但我想向下“滚动”项目以填充空白空间。

在上图中，您可以看到控件缺少将它们绘制到“空白空间”的项目。

可能我解释的问题不是很清楚，但接下来做：

1. 将标准TListBox 放在表单上，​​并将其高度设置为等于100 px；

2. 将标准TrackBar 放在表单上，​​将最大值设置为100 并在事件OnChange 中写入：

   ListBox1.Height := ListBox1.Height + TrackBar1.Position;
   

3. 在这个Listbox添加12项；

4. 编译项目并选择Listbox中的最后一项，然后通过TrackBar开始更改其高度。你会看到，“看不见的顶级物品”是从上到下的。

我想在控件中添加该效果，但我不知道为什么。

控件的代码

unit aListBox;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  StdCtrls,
  ExtCtrls,
  StrUtils,
  Dialogs,
  Math;

type
  { main class }
  TaListBox       = class;


  {>>>>>>>>>>>>>>>>>>>>>>>>>}
  TaListBox = class(TCustomControl)
  private
    { Private declarations }
  protected
    { Protected declarations }
    FItemBmp: TBitmap;

    FEnabled: Boolean;
    FSelected: Boolean;

    FItems: TStringList;
    FItemHeight: Integer;
    FCurrentItemIndex: Integer;
    FMode: Integer;
    FGlobalY: Integer;
    FScrollOffset: Integer;
    FDownScroll: Integer;

    procedure SetItems(value: TStringList);

    procedure WMSIZE(var Message: TWMSize); message WM_SIZE;
    procedure WMGETDLGCODE(var Message: TWMGETDLGCODE); message WM_GETDLGCODE;

    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;

    function GetItemIndex: Integer;
    function GetVisibleItemsCount: Integer;
    function GetScrollItemIndex: Integer;

    procedure PaintItemStandard(BmpInOut: TBitmap; AMode, AIndex: Integer);
    procedure PaintControlStandard(ACanvas: TCanvas; AMode: Integer);

    procedure Paint; override;

  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Click; override;

    property ItemIndex    : Integer read FCurrentItemIndex;

  published
    { Published declarations }
    property Items     : TStringList read FItems write FItems;

    property OnClick;
  end;
  {<<<<<<<<<<<<<<<<<<<<<<<<<}


implementation


{ TaListBox }


procedure Register;
begin
  RegisterComponents('MyControl', [TaListBox]);
end;

constructor TaListBox.Create(AOwner: TComponent);
begin
  Inherited Create(AOwner);

  { standard declarations }
  ControlStyle := ControlStyle + [csOpaque, csCaptureMouse, csDoubleClicks];
  Width := 100;
  Height := 120;

  DoubleBuffered := true;

  { control's declarations }
  FItemBmp := TBitmap.Create;

  FEnabled := true;
  FSelected := false;

  FItems := TStringList.Create;

  FItemHeight := 20;
  FCurrentItemIndex := -1;
  FScrollOffset := 0;
  FDownScroll := 0;

  FMode := 1;
end;

destructor TaListBox.Destroy;
begin
  FreeAndNil(FItemBmp);
  FreeAndNil(FItems);

  Inherited Destroy;
end;

procedure TaListBox.Click;
begin
  if FEnabled then
    Inherited Click
  else
    Exit;
end;

procedure TaListBox.SetItems(value: TStringList);
begin
  Invalidate;
end;

procedure TaListBox.WMSize(var Message: TWMSize);
var
  LScrollIndex, LVisibleCount: Integer;
begin
  inherited;
  LScrollIndex := FScrollOffset div FItemHeight;
  LVisibleCount := GetVisibleItemsCount;
  if (FItems.Count - LScrollIndex) < LVisibleCount then
    FScrollOffset := FItemHeight * max(0, FItems.Count - GetVisibleItemsCount);
end;

procedure TaListBox.WMGETDLGCODE(var Message: TWMGETDLGCODE);
begin
  Inherited;
  Message.Result := DLGC_WANTARROWS;
end;

procedure TaListBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    begin
      Windows.SetFocus(Handle);

      if PtInRect(Rect(1, 1, Width - 1, Height - 1), Point(X, Y)) then
        FGlobalY := Y - 2;

      if GetItemIndex > FItems.Count - 1 then
        Exit
      else
        begin
          FSelected := true;
          FCurrentItemIndex := GetItemIndex;

          // prevent selecting next item if height too low
          if Height >= FItemHeight then
            if PtInRect(Rect(1, Height - FDownScroll - 1, Width - 1, Height - 1), Point(X, Y)) then
              FScrollOffset := FScrollOffset + FItemHeight;

          Invalidate;
        end;
    end;

  Inherited MouseDown(Button, Shift, X, Y);
end;

procedure TaListBox.KeyDown(var Key: Word; Shift: TShiftState);
var
  ScrollIndex: Integer;
begin
  Inherited KeyDown(Key, Shift);

  if FEnabled then
    begin
      case Key of
        VK_UP:
          begin
            if FCurrentItemIndex = 0 then
              Exit
            else
              begin
                if (FCurrentItemIndex + 1) > 0 then
                  begin
                    Dec(FCurrentItemIndex);
                    ScrollIndex := FScrollOffset div FItemHeight;
                    if FCurrentItemIndex < ScrollIndex then
                      FScrollOffset := FScrollOffset - FItemHeight;
                  end;
              end;
          end;
        VK_DOWN:
          begin
            if FCurrentItemIndex = FItems.Count - 1 then
              Exit
            else
              begin
                if (FCurrentItemIndex + 1) < FItems.Count then
                  begin
                    Inc(FCurrentItemIndex);
                    ScrollIndex := FScrollOffset div FItemHeight;
                    if (FCurrentItemIndex - GetVisibleItemsCount + 1) > ScrollIndex then
                      FScrollOffset := FScrollOffset + FItemHeight;
                  end;
              end;
          end;
      end;

      Invalidate;
    end
  else
    Exit;
end;

function TaListBox.GetItemIndex: Integer;
begin
  Result := (FGlobalY + FScrollOffset) div FItemHeight;
end;

function TaListBox.GetVisibleItemsCount: Integer;
begin
  Result := Height div FItemHeight;
end;

function TaListBox.GetScrollItemIndex: Integer;
begin
  Result := FScrollOffset div FItemHeight;
end;

procedure TaListBox.PaintItemStandard(BmpInOut: TBitmap; AMode, AIndex: Integer);
var
  Text: String;
  R: TRect;
begin
  BmpInOut.Width := Width - 2;
  BmpInOut.Height := FItemHeight;

  case AMode of
    1:
      begin
        if FSelected then
        begin
          BmpInOut.Canvas.Brush.Color := clWebCrimson;
          BmpInOut.Canvas.Font.Color := clWhite;
        end
        else
        begin
          BmpInOut.Canvas.Brush.Color := clWhite;
          BmpInOut.Canvas.Font.Color := clBlack;
        end;
        BmpInOut.Canvas.Pen.Color := clGray;
      end;
    4:
      begin
        BmpInOut.Canvas.Brush.Color := clSilver;
        BmpInOut.Canvas.Pen.Color := clGray;
        BmpInOut.Canvas.Font.Color := clBlack;
      end;
  end;
  BmpInOut.Canvas.FillRect(BmpInOut.Canvas.ClipRect);

  // paint item's text
  if AIndex = - 1 then
    Exit
  else
    BmpInOut.Canvas.TextOut(18, 2, FItems.Strings[AIndex]);
end;

procedure TaListBox.PaintControlStandard(ACanvas: TCanvas; AMode: Integer);
var
  i: Integer;
  OldSelected: Boolean;
  TempBmp: TBitmap;
begin
  case AMode of
    1:
      begin
        ACanvas.Brush.Color := clWhite;
        ACanvas.Pen.Color := clBlack;
      end;
    4:
      begin
        ACanvas.Brush.Color := clSilver;
        ACanvas.Pen.Color := clBlack;
      end;
  end;
  ACanvas.Rectangle(Rect(0, 0, Width, Height));

  // calculate DownButton size
  FDownScroll := Height - GetVisibleItemsCount * FItemHeight - 1 {top border pixel} - 1 {bottom border pixel};

  // create output bitmap
  TempBmp := TBitmap.Create;
  TempBmp.Width := Width - 2;
  TempBmp.Height := Height - 2;

  // turn off selected flag
  OldSelected := FSelected;
  FSelected := false;

  for i:=0 to FItems.Count - 1 do
    begin
      PaintItemStandard(FItemBmp, FMode, i);
      TempBmp.Canvas.Draw(0, 0 + (FItemHeight * i) - FScrollOffset, FItemBmp);
    end;

  // output result
  ACanvas.Draw(1, 1, TempBmp);

  // restore selected flag
  FSelected := OldSelected;
  if FSelected then
    begin
      // paint selected item
      PaintItemStandard(FItemBmp, FMode, FCurrentItemIndex);
      ACanvas.Draw(1, 1 + (FItemHeight * FCurrentItemIndex) - FScrollOffset, FItemBmp);
    end;

  // free resources
  FreeAndNil(TempBmp);
end;

procedure TaListBox.Paint;
begin
  if FEnabled then
    PaintControlStandard(Canvas, 1)
  else
    PaintControlStandard(Canvas, 4);
end;


end.

我希望我能在这里找到一些帮助。 感谢您的关注！

附言
在源代码中添加了通过更改控件大小来实现滚动项的实现，由 Tom Brunberg 编写。

附言
感谢用户 fantaghirocco 格式化我的问题 ;)

Answer 1

按照您的指示创建标准TListBox 我注意到，正如您所说，增加列表框时可见项目的数量增加（无论选择任何项目）。

但是，无论选择任何项目，减小大小都不会再次向上滚动项目。我知道您问的是相同的功能，因为您参考的是标准 TListBox。

添加到uses 子句和TaListBox 类声明：

uses ... Math;
  ...

  TaListBox = class(TCustomControl)
  private
    procedure WMSize(var Message: TWMSize); message WM_SIZE;

和实现

procedure TaListBox.WMSize(var Message: TWMSize);
var
  LScrollIndex, LVisibleCount: Integer;
begin
  inherited;
  LScrollIndex := FScrollOffset div FItemHeight;
  LVisibleCount := GetVisibleItemsCount;
  if (FItems.Count - LScrollIndex) < LVisibleCount then
    FScrollOffset := FItemHeight * max(0, FItems.Count - GetVisibleItemsCount);
end;

附注：您在很多地方都使用了以下类型的表达方式，例如

  Round(FScrollOffset div FItemHeight);

div 运算符表示integer division。它总是返回一个整数，因此对Round 的调用毫无意义。阅读文档中的 div 和 mod。

Answer 2

这个想法很简单：

1. 当您的控件达到一定高度时，始终知道可以显示多少项。这意味着如果您的 clientheight 是 100px 并且项目的高度是 10px 那么您显然将能够完全显示 10 个项目而没有任何人被剪裁。将该金额保存在变量中。保留为浮点数，因为有时会剪切某个项目。 （可见计数）
2. 保留上次滚动方向的变量。这很重要，因为这将帮助您决定是从底部还是从顶部显示项目，或者当控件的高度减小/增加时是否隐藏顶部或底部的项目。
3. 保留上次滚动时位于顶部或底部的项目的索引。是保留顶部还是底部取决于您上次滚动的方向（第 2 点）。当您添加项目等时，它显然会发生变化。

假设情况是您的项目多于可以显示的项目，并且您最后一次滚动是向上的，因此您将保留最可见项目的项目索引。如果该索引为 0（零），那么显然您只需要从底部将项目带入视图。但是，如果该索引是例如； 5，然后您将继续从底部进入视图，但直到可见计数增长到大于或大于项目计数在这种情况下，您将开始从顶部将尽可能多的项目带入视图以填充客户区。

你只需要根据上次滚动的方向和高度是增加还是减少来适应