Question

前段时间我决定创建自己的ListControl。 ListControl下的含义是一个类似于Delphi中标准TListBox的控件。我知道，这是'重新发明一个轮子'，但我想完成我的控制。所以，我在TListBox之类的控件中实现的功能并不多，但我的控件允许：

添加项目;
选择项目;
通过键盘浏览项目（箭头键向上向下）。

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

但我有一个问题：当项目的总高度超过控件的高度和最后一项选择时我试图增加控件的高度我得到一个'空白'，但我想'滚动'项目填充空白空间。

enter image description here

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

我可能不太清楚地解释我的问题，但接下来要做：

在表单上放置标准TListBox并将其高度设置为100 px;
在表单上放置标准TrackBar，将最大值设置为100，并在事件OnChange中写下：
```
ListBox1.Height := ListBox1.Height + TrackBar1.Position;
```
在此Listbox;
编译项目并选择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.

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

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

P.S.S。
感谢用户 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

这个想法很简单：

当控件达到一定高度时，始终知道可以显示多少项目。这意味着如果您的客户端高度为100px且项目高度为10px，那么您显然可以完全显示10个项目，而不会被剪裁。将该金额保存在变量中。保持浮动，因为有时会剪切一个项目。（可见数）
保留最后滚动方向的变量。这很重要，因为这将帮助您决定是从底部还是从顶部将项目带入视图，或者当控件的高度减小/增加时是否隐藏顶部或底部的项目。
保留上次滚动时位于顶部或底部的项目的索引。是保留顶部还是底部将取决于您上次滚动的方向（第2点）。当你添加项目等时，它会明显改变。

因此，假设情况是您拥有的项目数量超出了可显示的数量，并且您上次滚动的时间已经结束，因此您将保留最顶部可见项目的项目索引。如果该索引为0（零），那么显然您只需要从底部将项目带入视图。但是，如果该指数是例如; 5，然后您将继续从底部将项目带入视图，但直到可见计数增长为大于或大于项目计数，在这种情况下，您将开始从顶部将尽可能多的项目带入视图中客户区。

你必须根据最后的滚动方向以及高度是增加还是减少进行调整

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

2 个答案: