Lazarus: TListBox.Style:= lbVirtual but no OnData event - listbox

Question

From Delphi 6 on it was possible to put millions of lines in the TListBox component via .Style:= lbVirtual and using the OnData event. In Lazarus lbVirtual exists, too, but not the OnData event. I want to extend this component to be able to display millions of lines, but I get errors during compilation.
My problem is that I can't really port code from Delphi to Lazarus when it comes to using lbVirtual in Lazarus, as no OnData event exists.
Delphi 7:
ListBox.Style:= lbVirtual;
property OnData;
ListBox.Count:= // for reading
Lazarus:
ListBox.Style:= lbVirtual; // which behaves like lbStandard
ListBox.Count:= // ReadOnly
In Lazarus I used the property OnData in my new L_Listbox component and ListBox.Count:=. I still don't know if L_ListBox lines will show up like I know it from lbVirtual. Now I get compiler error messages such as
resourcestring
LongInt
I thought I would solve this by appending to uses Math. However, it did not help. All compilation errors pop up in the file: l_listbox.pas
LLB.pas
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit LLB;
{$warn 5023 off : no warning about unused units}
interface
uses
L_ListBox, LazarusPackageIntf;
implementation
procedure Register;
begin
RegisterUnit('L_ListBox', #L_ListBox.Register);
end;
initialization
RegisterPackage('LLB', #Register);
end.
LLB.lpk
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="4">
<PathDelim Value="\"/>
<Name Value="LLB"/>
<Type Value="RunAndDesignTime"/>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\"/>
</SearchPaths>
</CompilerOptions>
<Files Count="1">
<Item1>
<Filename Value="l_listbox.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="L_ListBox"/>
</Item1>
</Files>
<RequiredPkgs Count="2">
<Item1>
<PackageName Value="LCL"/>
</Item1>
<Item2>
<PackageName Value="FCL"/>
</Item2>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
</Package>
</CONFIG>
l_listbox.pas (see comments where the compiler complains in function TListBoxStrings.GetObject(Index: Integer): TObject;)
unit L_ListBox;
{$mode objfpc}{$H+}
interface
uses Math, StdCtrls, Controls, Classes, Forms, Graphics, Messages, Windows, SysUtils, Commctrl, Types,
LResources, LCLType, LCLIntf, LMessages;
resourcestring
SErrorSettingCount = 'Error setting %s.Count';
SListBoxMustBeVirtual = 'Listbox (%s) style must be virtual in order to set Count';
SListIndexError = 'List %s is invalid';
type
TListBoxStyle = (lbStandard, lbOwnerDrawFixed, lbOwnerDrawVariable, lbVirtual, lbVirtualOwnerDraw);
TLBGetDataEvent = procedure(Control: TWinControl; Index: Integer; var Data: string) of object;
TLBFindDataEvent = function(Control : TWinControl; FindString: string): Integer of object;
TLBGetDataObjectEvent = procedure(Control: TWinControl; Index: Integer; var DataObject: TObject) of object;
TL_ListBox = class(Tlistbox)
private
FCount : Integer;
FStyle : TListBoxStyle;
FOnDataFind : TLBFindDataEvent;
FOnData : TLBGetDataEvent;
FOnDataObject : TLBGetDataObjectEvent;
function GetSelCount : Integer;
function GetCount : Integer;
procedure SetCount(const Value: Integer);
procedure SetStyle(Value: TListBoxStyle);
protected
function DoGetData(const Index: Integer): String;
function DoGetDataObject(const Index: Integer): TObject;
function DoFindData(const Data: String): Integer;
function InternalGetItemData(Index: Integer): Longint; dynamic;
procedure InternalSetItemData(Index: Integer; AData: Longint); dynamic;
function GetItemData(Index: Integer): LongInt; dynamic;
procedure SetItemData(Index: Integer; AData: LongInt); dynamic;
procedure CreateParams(var Params: TCreateParams); override;
public
property SelCount : Integer read GetSelCount;
property Count : Integer read GetCount write SetCount;
published
property OnData : TLBGetDataEvent read FOnData write FOnData;
property OnDataObject : TLBGetDataObjectEvent read FOnDataObject write FOnDataObject;
property OnDataFind : TLBFindDataEvent read FOnDataFind write FOnDataFind;
property Style: TListBoxStyle read FStyle write SetStyle default lbStandard;
end;
procedure Register;
implementation
uses RTLConsts;
procedure Register;
begin
RegisterComponents('ex',[TL_ListBox]);
end;
type
TListBoxStrings = class(TStrings)
private
ListBox: TL_ListBox;
protected
function GetCount: Integer; override;
function GetObject(Index: Integer): TObject; override;
procedure PutObject(Index: Integer; AObject: TObject); override;
public
end;
{ TL_ListBox }
procedure TL_ListBox.CreateParams(var Params: TCreateParams);
const
Styles: array[TListBoxStyle] of DWORD = (0, LBS_OWNERDRAWFIXED, LBS_OWNERDRAWVARIABLE, LBS_OWNERDRAWFIXED, LBS_OWNERDRAWFIXED);
Data: array[Boolean] of DWORD = (LBS_HASSTRINGS, LBS_NODATA);
begin
inherited CreateParams(Params);
CreateSubClass(Params, 'ListBox');
with Params do begin
Style := Style or ({WS_HSCROLL or }WS_VSCROLL or Data[Self.Style in [lbVirtual]] or LBS_NOTIFY) or Styles[FStyle];
end;
end;
function TL_ListBox.DoFindData(const Data: String): Integer;
begin
if Assigned(FOnDataFind) then Result := FOnDataFind(Self, Data) else Result := -1;
end;
function TL_ListBox.DoGetData(const Index: Integer): String;
begin
if Assigned(FOnData) then FOnData(Self, Index, Result);
end;
function TL_ListBox.DoGetDataObject(const Index: Integer): TObject;
begin
if Assigned(FOnDataObject) then FOnDataObject(Self, Index, Result);
end;
function TL_ListBox.GetCount: Integer;
begin
if Style in [lbVirtual] then Result := FCount else Result := Items.Count;
end;
function TL_ListBox.GetItemData(Index: Integer): LongInt;
begin
Result := SendMessage(Handle, LB_GETITEMDATA, Index, 0);
end;
function TL_ListBox.GetSelCount: Integer;
begin
Result := SendMessage(Handle, LB_GETSELCOUNT, 0, 0);
end;
function TL_ListBox.InternalGetItemData(Index: Integer): Longint;
begin
Result := GetItemData(Index);
end;
procedure TL_ListBox.InternalSetItemData(Index, AData: Integer);
begin
SetItemData(Index, AData);
end;
procedure TL_ListBox.SetCount(const Value: Integer);
var
Error: Integer;
begin
if Style in [lbVirtual] then
begin
// Limited to 32767 on Win95/98 as per Win32 SDK
Error := SendMessage(Handle, LB_SETCOUNT, Value, 0);
if (Error <> LB_ERR) and (Error <> LB_ERRSPACE) then FCount := Value else raise Exception.CreateFmt(LoadStr(SErrorSettingCount), [Name]);
end
else raise Exception.CreateFmt(LoadStr(SListBoxMustBeVirtual), [Name]);
end;
procedure TL_ListBox.SetItemData(Index, AData: Integer);
begin
SendMessage(Handle, LB_SETITEMDATA, Index, AData);
end;
procedure TL_ListBox.SetStyle(Value: TListBoxStyle);
begin
if FStyle <> Value then
begin
if Value in [lbVirtual] then
begin
Items.Clear;
Sorted := False;
end;
FStyle := Value;
end;
end;
{ TListBoxStrings }
function TListBoxStrings.GetCount: Integer;
begin
Result := SendMessage(ListBox.Handle, LB_GETCOUNT, 0, 0);
end;
function TListBoxStrings.GetObject(Index: Integer): TObject;
begin
if ListBox.Style in [lbVirtual] then
Result := ListBox.DoGetDataObject(Index)
else
begin
Result := TObject(ListBox.GetItemData(Index)); // Compiler complains here on TObject...
if Longint(Result) = LB_ERR then Error(SListIndexError, Index); // ...and here on Longint
end;
end;
procedure TListBoxStrings.PutObject(Index: Integer; AObject: TObject);
begin
if (Index <> -1) and not (ListBox.Style in [lbVirtual]) then
ListBox.SetItemData(Index, LongInt(AObject));
end;
end.
My Form:
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
L_ListBox;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
L_ListBox1: TL_ListBox;
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure L_ListBox1Data(Control: TWinControl; Index: Integer;
var Data: string);
private
public
end;
var
Form1: TForm1;
MyList : TStringlist;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
begin
MyList := TStringlist.Create;
L_ListBox1.Style := lbVirtual;
MyList.LoadFromFile('ex.txt');
L_ListBox1.Count := MyList.Count;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
MyList.Free;
end;
procedure TForm1.L_ListBox1Data(Control: TWinControl; Index: Integer;
var Data: string);
begin
Data := MyList[Index];
end;
end.
I corrected the code in L_ListBox.pas
procedure Register;
implementation
uses RTLConsts;
resourcestring
SErrorSettingCount = 'Error setting% s.Count';
SListBoxMustBeVirtual = 'Listbox (% s) style must be virtual in order to set Count';
SListIndexError = 'List% s is invalid';
procedure Register;
begin
RegisterComponents ('ex', [TL_ListBox]);
end;
I am getting an error:
[Debugger Exception Notification]
Project project1 raised exception class 'Exception' with message:
Error setting L_ListBox1.Count

Answer 1

What is the construction in Lazarus ?
since the compiler stops I marked bold
TObject
Longint
Result := TObject(ListBox.GetItemData(Index));
if Longint(Result) = LB_ERR then Error(SListIndexError, Index);