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

Question

前段时间我决定创建自己的 ListControl。 ListControl 下的意思 - 是类似于 Delphi 中标准 TListBox 的控件。我知道，是'reinventing a wheel'，但我想完成我的控制。因此，我在该控件中实现的功能不像 TListBox 那样多，但我的控件允许：

添加项目；
Select 项；
通过键盘（向上和向下箭头键）浏览项目。

我打算实现我的 ScrollBar，但这是另一个话题。

但我有一个问题：当项目的总高度超过控件的高度和最后一个项目 selected 并且我尝试增加控件的高度时我得到了 'blank space'，但我想'scroll' 项向下填充空白 space。

在上图中，您可以看到控件缺少可将它们绘制到 'blank space' 上的项目。

可能我的问题解释的不是很清楚，但是下一步：

将标准 TListBox 放在表单上并设置其高度等于 100 px;
将标准 TrackBar 放在表格上，将最大值设置为 100 并在事件 OnChange 中写入：
```
ListBox1.Height := ListBox1.Height + TrackBar1.Position;
```
在此添加 12 项 Listbox;
编译项目和 select Listbox 中的最后一项，然后开始通过 TrackBar 更改其高度。你会看到，'invisible top items'是从上到下一个一个地过来的

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

控件代码

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.

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

P.S.
在源代码中添加了通过更改控件大小实现滚动项的实现，由 Tom Brunberg.

编写

P.S.S.
感谢用户 fantaghirocco 格式化我的问题 ;)

Answer 1

想法很简单：

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

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

你只需要根据上次的滚动方向和高度是增加还是减少进行适配即可

Answer 2

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

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

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

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。它总是 returns 一个整数，因此调用 Round 是没有意义的。阅读文档中的 div 和 mod。

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

Creating my own ListControl, some problems in Delphi

delphi

controls

listbox

custom-controls