Jaka jest poprawna klasa TCustomListControl dla lazarusa? W klasie TCustomListControl znajduje się ListBox.Count
0
0
Nie ma — już Ci pisałem pół roku temu. Właściwość TListBox.Count jest read-only, więc jeśli chcesz zmienić liczbę pozycji w kontrolce, to je dodaj lub usuń w pętli.
0
File: 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.
File: 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.
File: 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>
File: l_listbox.pas
unit L_ListBox;
{$mode objfpc}{$H+}
interface
uses Math, StdCtrls, Controls, Classes, Forms, Graphics, Messages, Windows, SysUtils, Commctrl, Types,
LResources, LCLType, LCLIntf, LMessages;
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) // TCustomListControl? i tutaj brakuje ListBox.Count
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
resourcestring
SErrorSettingCount = 'Error setting %s.Count';
SListBoxMustBeVirtual = 'Listbox (%s) style must be virtual in order to set Count';
SListIndexError = 'List %s is invalid';
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
Error := SendMessage(Handle, LB_SETCOUNT, Value, 0);
if (Error <> LB_ERR) and (Error <> LB_ERRSPACE) then FCount := Value else raise Exception.CreateFmt(SErrorSettingCount, [Name]);
end
else raise Exception.CreateFmt(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));
if Longint(Result) = LB_ERR then Error(SListIndexError, Index);
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.
Call:
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.
0
Jakaś puenta by się przydała, bo nie wiem po co ten kod wkleiłeś. :/
À propos tego SetCount — równie dobrze możesz nadpisać istniejącą właściwość TListBox.Count i dodać swój setter.
0
Jak nie mylę się błąd ListBox.Count wynika z tego, że kontrolka nie wyświetla itemów. Po zmianie poniższej procedury - L_ListBox.Count zwraca już ilość itemów. Jakie procedury lub funkcje służą do wyświetlenia ich w powyższej kontrolce w TL_ListBox = class(TlistBox) bo jak zastosuję lbStandard to wyświetla jeśli styl wirtualny lbVirtual to nie :( Tylko to pozostanie mi do rozwiązania. w Delphi 7 jak i w l azarusie dla pliku l_listbox.pas ten sam problem. Myślę, że pomożecie. Dziękuję z góry.
procedure TL_ListBox.SetCount(const Value: Integer);
begin
FCount := Value ;
end;
0
Czy wprost walić na items lub setitems?
procedure ....SetItems(Value: TStrings);
begin
if Style in [lbVirtual, lbVirtualOwnerDraw] then
case Style of
lbVirtual: Style := lbVirtual;
lbVirtualOwnerDraw: Style := lbOwnerDrawFixed;
end;
Items.Assign(Value);
end;
0
Dla Delphi 7 kompiluje się.
unit L_LISTBOX;
{$R-,T-,H+,X+}
// {$mode objfpc}{$H+}
interface
uses Math, StdCtrls, Controls, Classes, Forms, Graphics, Messages, Windows, SysUtils, Commctrl, Types;//,
// LResources, LCLType, LCLIntf, LMessages;
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
FAutoComplete: Boolean;
FCount: Integer;
FItems: TStrings;
FFilter: String;
FLastTime: Cardinal;
FBorderStyle: TBorderStyle;
FCanvas: TCanvas;
FColumns: Integer;
FItemHeight: Integer;
FOldCount: Integer;
FStyle: TListBoxStyle;
FIntegralHeight: Boolean;
FSorted: Boolean;
FExtendedSelect: Boolean;
FTabWidth: Integer;
FSaveItems: TStringList;
FSaveTopIndex: Integer;
FSaveItemIndex: Integer;
FOnDrawItem: TDrawItemEvent;
FOnMeasureItem: TMeasureItemEvent;
FOnData: TLBGetDataEvent;
FOnDataFind: TLBFindDataEvent;
FOnDataObject: TLBGetDataObjectEvent;
function GetItemHeight: Integer;
function GetTopIndex: Integer;
procedure LBGetText(var Message: TMessage); message LB_GETTEXT;
procedure LBGetTextLen(var Message: TMessage); message LB_GETTEXTLEN;
procedure SetBorderStyle(Value: TBorderStyle);
procedure SetColumnWidth;
procedure SetColumns(Value: Integer);
procedure SetCount(const Value: Integer);
procedure SetExtendedSelect(Value: Boolean);
procedure SetIntegralHeight(Value: Boolean);
procedure SetItemHeight(Value: Integer);
procedure SetItems(Value: TStrings);
procedure SetSelected(Index: Integer; Value: Boolean);
procedure SetSorted(Value: Boolean);
procedure SetStyle(Value: TListBoxStyle);
procedure SetTabWidth(Value: Integer);
procedure SetTopIndex(Value: Integer);
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
function GetScrollWidth: Integer;
procedure SetScrollWidth(const Value: Integer);
protected
FMoving: Boolean;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure DestroyWnd; override;
function DoGetData(const Index: Integer): String;
function DoGetDataObject(const Index: Integer): TObject;
function DoFindData(const Data: String): Integer;
procedure WndProc(var Message: TMessage); override;
procedure DragCanceled; override;
procedure DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState); virtual;
function GetCount: Integer; override;
function GetSelCount: Integer; override;
procedure MeasureItem(Index: Integer; var Height: Integer); virtual;
function InternalGetItemData(Index: Integer): Longint; dynamic;
procedure InternalSetItemData(Index: Integer; AData: Longint); dynamic;
function GetItemData(Index: Integer): LongInt; dynamic;
function GetItemIndex: Integer; override;
function GetSelected(Index: Integer): Boolean;
procedure KeyPress(var Key: Char); override;
procedure SetItemData(Index: Integer; AData: LongInt); dynamic;
procedure ResetContent; dynamic;
procedure DeleteString(Index: Integer); dynamic;
procedure SetMultiSelect(Value: Boolean); override;
procedure SetItemIndex(const Value: Integer); override;
property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
property Columns: Integer read FColumns write SetColumns default 0;
property ExtendedSelect: Boolean read FExtendedSelect write SetExtendedSelect default True;
property IntegralHeight: Boolean read FIntegralHeight write SetIntegralHeight default False;
property ItemHeight: Integer read GetItemHeight write SetItemHeight;
property ParentColor default False;
property Sorted: Boolean read FSorted write SetSorted default False;
property Style: TListBoxStyle read FStyle write SetStyle default lbStandard;
property TabWidth: Integer read FTabWidth write SetTabWidth default 0;
property OnDrawItem: TDrawItemEvent read FOnDrawItem write FOnDrawItem;
property OnMeasureItem: TMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
property OnData: TLBGetDataEvent read FOnData write FOnData;
property OnDataObject: TLBGetDataObjectEvent read FOnDataObject write FOnDataObject;
property OnDataFind: TLBFindDataEvent read FOnDataFind write FOnDataFind;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure AddItem(Item: String; AObject: TObject); override;
procedure Clear; override;
procedure ClearSelection; override;
procedure CopySelection(Destination: TCustomListControl); override;
procedure DeleteSelected; override;
function ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
function ItemRect(Index: Integer): TRect;
procedure SelectAll; override;
property AutoComplete: Boolean read FAutoComplete write FAutoComplete default True;
property Canvas: TCanvas read FCanvas;
property Count: Integer read GetCount write SetCount;
property Items: TStrings read FItems write SetItems;
property Selected[Index: Integer]: Boolean read GetSelected write SetSelected;
property ScrollWidth: Integer read GetScrollWidth write SetScrollWidth default 0;
property TopIndex: Integer read GetTopIndex write SetTopIndex;
published
property TabStop default True;
end;
TListBox = class(TL_ListBox)
private
published
property Style;
property AutoComplete;
property Align;
property Anchors;
property BevelEdges;
property BevelInner;
property BevelKind default bkNone;
property BevelOuter;
property BiDiMode;
property BorderStyle;
property Color;
property Columns;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property ExtendedSelect;
property Font;
property ImeMode;
property ImeName;
property IntegralHeight;
property ItemHeight;
property Items;
property MultiSelect;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ScrollWidth;
property ShowHint;
property Sorted;
property TabOrder;
property TabStop;
property TabWidth;
property Visible;
property OnClick;
property OnContextPopup;
property OnData;
property OnDataFind;
property OnDataObject;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawItem;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMeasureItem;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
procedure Register;
implementation
uses RTLConsts, Consts;
//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;
type
TListBoxStrings = class(TStrings)
private
ListBox: TL_ListBox;
protected
procedure Put(Index: Integer; const S: string); override;
function Get(Index: Integer): string; override;
function GetCount: Integer; override;
function GetObject(Index: Integer): TObject; override;
procedure PutObject(Index: Integer; AObject: TObject); override;
procedure SetUpdateState(Updating: Boolean); override;
public
function Add(const S: string): Integer; override;
procedure Clear; override;
procedure Delete(Index: Integer); override;
procedure Exchange(Index1, Index2: Integer); override;
function IndexOf(const S: string): Integer; override;
procedure Insert(Index: Integer; const S: string); override;
procedure Move(CurIndex, NewIndex: Integer); override;
end;
const
BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
{ TListBoxStrings }
function TListBoxStrings.GetCount: Integer;
begin
Result := SendMessage(ListBox.Handle, LB_GETCOUNT, 0, 0);
end;
function TListBoxStrings.Get(Index: Integer): string;
var
Len: Integer;
begin
if ListBox.Style in [lbVirtual, lbVirtualOwnerDraw] then
Result := ListBox.DoGetData(Index)
else
begin
Len := SendMessage(ListBox.Handle, LB_GETTEXTLEN, Index, 0);
if Len = LB_ERR then Error(SListIndexError, Index);
SetLength(Result, Len);
if Len <> 0 then
begin
Len := SendMessage(ListBox.Handle, LB_GETTEXT, Index, Longint(PChar(Result)));
SetLength(Result, Len); // LB_GETTEXTLEN isn't guaranteed to be accurate
end;
end;
end;
function TListBoxStrings.GetObject(Index: Integer): TObject;
begin
if ListBox.Style in [lbVirtual, lbVirtualOwnerDraw] then
Result := ListBox.DoGetDataObject(Index)
else
begin
Result := TObject(ListBox.GetItemData(Index));
if Longint(Result) = LB_ERR then Error(SListIndexError, Index);
end;
end;
procedure TListBoxStrings.Put(Index: Integer; const S: string);
var
I: Integer;
TempData: Longint;
begin
I := ListBox.ItemIndex;
TempData := ListBox.InternalGetItemData(Index);
// Set the Item to 0 in case it is an object that gets freed during Delete
ListBox.InternalSetItemData(Index, 0);
Delete(Index);
InsertObject(Index, S, nil);
ListBox.InternalSetItemData(Index, TempData);
ListBox.ItemIndex := I;
end;
procedure TListBoxStrings.PutObject(Index: Integer; AObject: TObject);
begin
if (Index <> -1) and not (ListBox.Style in [lbVirtual, lbVirtualOwnerDraw]) then
ListBox.SetItemData(Index, LongInt(AObject));
end;
function TListBoxStrings.Add(const S: string): Integer;
begin
Result := -1;
if ListBox.Style in [lbVirtual, lbVirtualOwnerDraw] then exit;
Result := SendMessage(ListBox.Handle, LB_ADDSTRING, 0, Longint(PChar(S)));
if Result < 0 then raise EOutOfResources.Create(SInsertLineError);
end;
procedure TListBoxStrings.Insert(Index: Integer; const S: string);
begin
if ListBox.Style in [lbVirtual, lbVirtualOwnerDraw] then exit;
if SendMessage(ListBox.Handle, LB_INSERTSTRING, Index,
Longint(PChar(S))) < 0 then
raise EOutOfResources.Create(SInsertLineError);
end;
procedure TListBoxStrings.Delete(Index: Integer);
begin
ListBox.DeleteString(Index);
end;
procedure TListBoxStrings.Exchange(Index1, Index2: Integer);
var
TempData: Longint;
TempString: string;
begin
if ListBox.Style in [lbVirtual, lbVirtualOwnerDraw] then exit;
BeginUpdate;
try
TempString := Strings[Index1];
TempData := ListBox.InternalGetItemData(Index1);
Strings[Index1] := Strings[Index2];
ListBox.InternalSetItemData(Index1, ListBox.InternalGetItemData(Index2));
Strings[Index2] := TempString;
ListBox.InternalSetItemData(Index2, TempData);
if ListBox.ItemIndex = Index1 then
ListBox.ItemIndex := Index2
else if ListBox.ItemIndex = Index2 then
ListBox.ItemIndex := Index1;
finally
EndUpdate;
end;
end;
procedure TListBoxStrings.Clear;
begin
ListBox.ResetContent;
end;
procedure TListBoxStrings.SetUpdateState(Updating: Boolean);
begin
SendMessage(ListBox.Handle, WM_SETREDRAW, Ord(not Updating), 0);
if not Updating then ListBox.Refresh;
end;
function TListBoxStrings.IndexOf(const S: string): Integer;
begin
if ListBox.Style in [lbVirtual, lbVirtualOwnerDraw] then
Result := ListBox.DoFindData(S)
else
Result := SendMessage(ListBox.Handle, LB_FINDSTRINGEXACT, -1, LongInt(PChar(S)));
end;
procedure TListBoxStrings.Move(CurIndex, NewIndex: Integer);
var
TempData: Longint;
TempString: string;
begin
if ListBox.Style in [lbVirtual, lbVirtualOwnerDraw] then exit;
BeginUpdate;
ListBox.FMoving := True;
try
if CurIndex <> NewIndex then
begin
TempString := Get(CurIndex);
TempData := ListBox.InternalGetItemData(CurIndex);
ListBox.InternalSetItemData(CurIndex, 0);
Delete(CurIndex);
Insert(NewIndex, TempString);
ListBox.InternalSetItemData(NewIndex, TempData);
end;
finally
ListBox.FMoving := False;
EndUpdate;
end;
end;
{ TL_ListBox }
constructor TL_ListBox.Create(AOwner: TComponent);
const
ListBoxStyle = [csSetCaption, csDoubleClicks, csOpaque];
begin
inherited Create(AOwner);
if NewStyleControls then
ControlStyle := ListBoxStyle else
ControlStyle := ListBoxStyle + [csFramed];
Fstyle := lbVirtual; // gdy to umieszczę mam efekt jak na obrazku
// jednak zakłóca to normalne ListBox
Width := 121;
Height := 97;
TabStop := True;
ParentColor := False;
FAutoComplete := True;
FItems := TListBoxStrings.Create;
TListBoxStrings(FItems).ListBox := Self;
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;
FItemHeight := 16;
FBorderStyle := bsSingle;
FExtendedSelect := True;
FOldCount := -1;
end;
destructor TL_ListBox.Destroy;
begin
inherited Destroy;
FCanvas.Free;
FItems.Free;
FSaveItems.Free;
end;
procedure TL_ListBox.AddItem(Item: String; AObject: TObject);
var
S: String;
begin
SetString(S, PChar(Item), StrLen(PChar(Item)));
Items.AddObject(S, AObject);
end;
function TL_ListBox.GetItemData(Index: Integer): LongInt;
begin
Result := SendMessage(Handle, LB_GETITEMDATA, Index, 0);
end;
procedure TL_ListBox.SetItemData(Index: Integer; AData: LongInt);
begin
SendMessage(Handle, LB_SETITEMDATA, Index, AData);
end;
function TL_ListBox.InternalGetItemData(Index: Integer): LongInt;
begin
Result := GetItemData(Index);
end;
procedure TL_ListBox.InternalSetItemData(Index: Integer; AData: LongInt);
begin
SetItemData(Index, AData);
end;
procedure TL_ListBox.DeleteString( Index: Integer );
begin
SendMessage(Handle, LB_DELETESTRING, Index, 0);
end;
procedure TL_ListBox.ResetContent;
begin
if Style in [lbVirtual, lbVirtualOwnerDraw] then exit;
SendMessage(Handle, LB_RESETCONTENT, 0, 0);
end;
procedure TL_ListBox.Clear;
begin
FItems.Clear;
end;
procedure TL_ListBox.ClearSelection;
var
I: Integer;
begin
if MultiSelect then
for I := 0 to Items.Count - 1 do
Selected[I] := False
else
ItemIndex := -1;
end;
procedure TL_ListBox.CopySelection(Destination: TCustomListControl);
var
I: Integer;
begin
if MultiSelect then
begin
for I := 0 to Items.Count - 1 do
if Selected[I] then
Destination.AddItem(PChar(Items[I]), Items.Objects[I]);
end
else
if ItemIndex <> -1 then
Destination.AddItem(PChar(Items[ItemIndex]), Items.Objects[ItemIndex]);
end;
procedure TL_ListBox.DeleteSelected;
var
I: Integer;
begin
if MultiSelect then
begin
for I := Items.Count - 1 downto 0 do
if Selected[I] then
Items.Delete(I);
end
else
if ItemIndex <> -1 then
Items.Delete(ItemIndex);
end;
procedure TL_ListBox.SetColumnWidth;
var
ColWidth: Integer;
begin
if (FColumns > 0) and (Width > 0) then
begin
ColWidth := Trunc(ClientWidth / FColumns);
if ColWidth < 1 then ColWidth := 1;
SendMessage(Handle, LB_SETCOLUMNWIDTH, ColWidth, 0);
end;
end;
procedure TL_ListBox.SetColumns(Value: Integer);
begin
if FColumns <> Value then
if (FColumns = 0) or (Value = 0) then
begin
FColumns := Value;
RecreateWnd;
end else
begin
FColumns := Value;
if HandleAllocated then SetColumnWidth;
end;
end;
function TL_ListBox.GetItemIndex: Integer;
begin
if MultiSelect then
Result := SendMessage(Handle, LB_GETCARETINDEX, 0, 0)
else
Result := SendMessage(Handle, LB_GETCURSEL, 0, 0);
end;
function TL_ListBox.GetCount: Integer;
begin
if Style in [lbVirtual, lbVirtualOwnerDraw] then
Result := FCount
else
Result := Items.Count;
end;
function TL_ListBox.GetSelCount: Integer;
begin
Result := SendMessage(Handle, LB_GETSELCOUNT, 0, 0);
end;
procedure TL_ListBox.SetItemIndex(const Value: Integer);
begin
if GetItemIndex <> Value then
if MultiSelect then SendMessage(Handle, LB_SETCARETINDEX, Value, 0)
else SendMessage(Handle, LB_SETCURSEL, Value, 0);
end;
procedure TL_ListBox.SetExtendedSelect(Value: Boolean);
begin
if Value <> FExtendedSelect then
begin
FExtendedSelect := Value;
RecreateWnd;
end;
end;
procedure TL_ListBox.SetIntegralHeight(Value: Boolean);
begin
if Value <> FIntegralHeight then
begin
FIntegralHeight := Value;
RecreateWnd;
RequestAlign;
end;
end;
function TL_ListBox.GetItemHeight: Integer;
var
R: TRect;
begin
Result := FItemHeight;
if HandleAllocated and (FStyle = lbStandard) then
begin
Perform(LB_GETITEMRECT, 0, Longint(@R));
Result := R.Bottom - R.Top;
end;
end;
procedure TL_ListBox.SetItemHeight(Value: Integer);
begin
if (FItemHeight <> Value) and (Value > 0) then
begin
FItemHeight := Value;
RecreateWnd;
end;
end;
procedure TL_ListBox.SetTabWidth(Value: Integer);
begin
if Value < 0 then Value := 0;
if FTabWidth <> Value then
begin
FTabWidth := Value;
RecreateWnd;
end;
end;
procedure TL_ListBox.SetMultiSelect(Value: Boolean);
begin
if FMultiSelect <> Value then
begin
FMultiSelect := Value;
RecreateWnd;
end;
end;
function TL_ListBox.GetSelected(Index: Integer): Boolean;
var
R: Longint;
begin
R := SendMessage(Handle, LB_GETSEL, Index, 0);
if R = LB_ERR then
raise EListError.CreateResFmt(@SListIndexError, [Index]);
Result := LongBool(R);
end;
procedure TL_ListBox.SetSelected(Index: Integer; Value: Boolean);
begin
if FMultiSelect then
begin
if SendMessage(Handle, LB_SETSEL, Longint(Value), Index) = LB_ERR then
raise EListError.CreateResFmt(@SListIndexError, [Index]);
end
else
if Value then
begin
if SendMessage(Handle, LB_SETCURSEL, Index, 0) = LB_ERR then
raise EListError.CreateResFmt(@SListIndexError, [Index])
end
else
SendMessage(Handle, LB_SETCURSEL, -1, 0);
end;
procedure TL_ListBox.SetSorted(Value: Boolean);
begin
if Style in [lbVirtual, lbVirtualOwnerDraw] then exit;
if FSorted <> Value then
begin
FSorted := Value;
RecreateWnd;
end;
end;
procedure TL_ListBox.SetStyle(Value: TListBoxStyle);
begin
if FStyle <> Value then
begin
if Value in [lbVirtual, lbVirtualOwnerDraw] then
begin
Items.Clear;
Sorted := False;
end;
FStyle := Value;
RecreateWnd;
end;
end;
function TL_ListBox.GetTopIndex: Integer;
begin
Result := SendMessage(Handle, LB_GETTOPINDEX, 0, 0);
end;
procedure TL_ListBox.LBGetText(var Message: TMessage);
var
S: string;
begin
if Style in [lbVirtual, lbVirtualOwnerDraw] then
begin
if Assigned(FOnData) and (Message.WParam > -1) and (Message.WParam < Count) then
begin
S := '';
OnData(Self, Message.wParam, S);
StrCopy(PChar(Message.lParam), PChar(S));
Message.Result := Length(S);
end
else
Message.Result := LB_ERR;
end
else
inherited;
end;
procedure TL_ListBox.LBGetTextLen(var Message: TMessage);
var
S: string;
begin
if Style in [lbVirtual, lbVirtualOwnerDraw] then
begin
if Assigned(FOnData) and (Message.WParam > -1) and (Message.WParam < Count) then
begin
S := '';
OnData(Self, Message.wParam, S);
Message.Result := Length(S);
end
else
Message.Result := LB_ERR;
end
else
inherited;
end;
procedure TL_ListBox.SetBorderStyle(Value: TBorderStyle);
begin
if FBorderStyle <> Value then
begin
FBorderStyle := Value;
RecreateWnd;
end;
end;
procedure TL_ListBox.SetTopIndex(Value: Integer);
begin
if GetTopIndex <> Value then
SendMessage(Handle, LB_SETTOPINDEX, Value, 0);
end;
procedure TL_ListBox.SetItems(Value: TStrings);
begin
if Style in [lbVirtual, lbVirtualOwnerDraw] then
case Style of
lbVirtual: Style := lbStandard;
lbVirtualOwnerDraw: Style := lbOwnerDrawFixed;
end;
Items.Assign(Value);
end;
function TL_ListBox.ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
var
Count: Integer;
ItemRect: TRect;
begin
if PtInRect(ClientRect, Pos) then
begin
Result := TopIndex;
Count := Items.Count;
while Result < Count do
begin
Perform(LB_GETITEMRECT, Result, Longint(@ItemRect));
if PtInRect(ItemRect, Pos) then Exit;
Inc(Result);
end;
if not Existing then Exit;
end;
Result := -1;
end;
function TL_ListBox.ItemRect(Index: Integer): TRect;
var
Count: Integer;
begin
Count := Items.Count;
if (Index = 0) or (Index < Count) then
Perform(LB_GETITEMRECT, Index, Longint(@Result))
else if Index = Count then
begin
Perform(LB_GETITEMRECT, Index - 1, Longint(@Result));
OffsetRect(Result, 0, Result.Bottom - Result.Top);
end else FillChar(Result, SizeOf(Result), 0);
end;
procedure TL_ListBox.CreateParams(var Params: TCreateParams);
type
PSelects = ^TSelects;
TSelects = array[Boolean] of DWORD;
const
Styles: array[TListBoxStyle] of DWORD =
(0, LBS_OWNERDRAWFIXED, LBS_OWNERDRAWVARIABLE, LBS_OWNERDRAWFIXED,
LBS_OWNERDRAWFIXED);
Sorteds: array[Boolean] of DWORD = (0, LBS_SORT);
MultiSelects: array[Boolean] of DWORD = (0, LBS_MULTIPLESEL);
ExtendSelects: array[Boolean] of DWORD = (0, LBS_EXTENDEDSEL);
IntegralHeights: array[Boolean] of DWORD = (LBS_NOINTEGRALHEIGHT, 0);
MultiColumns: array[Boolean] of DWORD = (0, LBS_MULTICOLUMN);
TabStops: array[Boolean] of DWORD = (0, LBS_USETABSTOPS);
CSHREDRAW: array[Boolean] of DWORD = (CS_HREDRAW, 0);
Data: array[Boolean] of DWORD = (LBS_HASSTRINGS, LBS_NODATA);
var
Selects: PSelects;
begin
inherited CreateParams(Params);
CreateSubClass(Params, 'LISTBOX');
with Params do
begin
Selects := @MultiSelects;
if FExtendedSelect then Selects := @ExtendSelects;
Style := Style or (WS_HSCROLL or WS_VSCROLL or
Data[Self.Style in [lbVirtual, lbVirtualOwnerDraw]] or
LBS_NOTIFY) or Styles[FStyle] or Sorteds[FSorted] or
Selects^[FMultiSelect] or IntegralHeights[FIntegralHeight] or
MultiColumns[FColumns <> 0] or BorderStyles[FBorderStyle] or
TabStops[FTabWidth <> 0];
if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
begin
Style := Style and not WS_BORDER;
ExStyle := ExStyle or WS_EX_CLIENTEDGE;
end;
WindowClass.style := WindowClass.style and not (CSHREDRAW[UseRightToLeftAlignment] or CS_VREDRAW);
end;
end;
procedure TL_ListBox.CreateWnd;
var
W, H: Integer;
begin
W := Width;
H := Height;
inherited CreateWnd;
SetWindowPos(Handle, 0, Left, Top, W, H, SWP_NOZORDER or SWP_NOACTIVATE);
if FTabWidth <> 0 then
SendMessage(Handle, LB_SETTABSTOPS, 1, Longint(@FTabWidth));
SetColumnWidth;
if (FOldCount <> -1) or Assigned(FSaveItems) then
begin
if (Style in [lbVirtual, lbVirtualOwnerDraw]) then
Count := FOldCount;
if FSaveItems <> nil then
begin
FItems.Assign(FSaveItems);
FreeAndNil(FSaveItems);
end;
SetTopIndex(FSaveTopIndex);
SetItemIndex(FSaveItemIndex);
FOldCount := -1;
end;
end;
procedure TL_ListBox.DestroyWnd;
begin
if (FItems.Count > 0) then
begin
if (Style in [lbVirtual, lbVirtualOwnerDraw]) then
FOldCount := FItems.Count
else
begin
FSaveItems := TStringList.Create;
FSaveItems.Assign(FItems);
end;
FSaveTopIndex := GetTopIndex;
FSaveItemIndex := GetItemIndex;
end;
inherited DestroyWnd;
end;
procedure TL_ListBox.WndProc(var Message: TMessage);
begin
{for auto drag mode, let listbox handle itself, instead of TControl}
if not (csDesigning in ComponentState) and ((Message.Msg = WM_LBUTTONDOWN) or
(Message.Msg = WM_LBUTTONDBLCLK)) and not Dragging then
begin
if DragMode = dmAutomatic then
begin
if IsControlMouseMsg(TWMMouse(Message)) then
Exit;
ControlState := ControlState + [csLButtonDown];
Dispatch(Message); {overrides TControl's BeginDrag}
Exit;
end;
end;
inherited WndProc(Message);
end;
procedure TL_ListBox.WMLButtonDown(var Message: TWMLButtonDown);
var
ItemNo : Integer;
ShiftState: TShiftState;
begin
ShiftState := KeysToShiftState(Message.Keys);
if (DragMode = dmAutomatic) and FMultiSelect then
begin
if not (ssShift in ShiftState) or (ssCtrl in ShiftState) then
begin
ItemNo := ItemAtPos(SmallPointToPoint(Message.Pos), True);
if (ItemNo >= 0) and (Selected[ItemNo]) then
begin
BeginDrag (False);
Exit;
end;
end;
end;
inherited;
if (DragMode = dmAutomatic) and not (FMultiSelect and
((ssCtrl in ShiftState) or (ssShift in ShiftState))) then
BeginDrag(False);
end;
procedure TL_ListBox.CNCommand(var Message: TWMCommand);
begin
case Message.NotifyCode of
LBN_SELCHANGE:
begin
inherited Changed;
Click;
end;
LBN_DBLCLK: DblClick;
end;
end;
procedure TL_ListBox.WMPaint(var Message: TWMPaint);
procedure PaintListBox;
var
DrawItemMsg: TWMDrawItem;
MeasureItemMsg: TWMMeasureItem;
DrawItemStruct: TDrawItemStruct;
MeasureItemStruct: TMeasureItemStruct;
R: TRect;
Y, I, H, W: Integer;
begin
{ Initialize drawing records }
DrawItemMsg.Msg := CN_DRAWITEM;
DrawItemMsg.DrawItemStruct := @DrawItemStruct;
DrawItemMsg.Ctl := Handle;
DrawItemStruct.CtlType := ODT_LISTBOX;
DrawItemStruct.itemAction := ODA_DRAWENTIRE;
DrawItemStruct.itemState := 0;
DrawItemStruct.hDC := Message.DC;
DrawItemStruct.CtlID := Handle;
DrawItemStruct.hwndItem := Handle;
{ Intialize measure records }
MeasureItemMsg.Msg := CN_MEASUREITEM;
MeasureItemMsg.IDCtl := Handle;
MeasureItemMsg.MeasureItemStruct := @MeasureItemStruct;
MeasureItemStruct.CtlType := ODT_ListBox;
MeasureItemStruct.CtlID := Handle;
{ Draw the listbox }
Y := 0;
I := TopIndex;
GetClipBox(Message.DC, R);
H := Height;
W := Width;
while Y < H do
begin
MeasureItemStruct.itemID := I;
if I < Items.Count then
MeasureItemStruct.itemData := Longint(Pointer(Items.Objects[I]));
MeasureItemStruct.itemWidth := W;
MeasureItemStruct.itemHeight := FItemHeight;
DrawItemStruct.itemData := MeasureItemStruct.itemData;
DrawItemStruct.itemID := I;
Dispatch(MeasureItemMsg);
DrawItemStruct.rcItem := Rect(0, Y, MeasureItemStruct.itemWidth,
Y + Integer(MeasureItemStruct.itemHeight));
Dispatch(DrawItemMsg);
Inc(Y, MeasureItemStruct.itemHeight);
Inc(I);
if I >= Items.Count then break;
end;
end;
begin
if Message.DC <> 0 then
{ Listboxes don't allow paint "sub-classing" like the other windows controls
so we have to do it ourselves. }
PaintListBox
else inherited;
end;
procedure TL_ListBox.WMSize(var Message: TWMSize);
begin
inherited;
SetColumnWidth;
end;
procedure TL_ListBox.DragCanceled;
var
M: TWMMouse;
MousePos: TPoint;
begin
with M do
begin
Msg := WM_LBUTTONDOWN;
GetCursorPos(MousePos);
Pos := PointToSmallPoint(ScreenToClient(MousePos));
Keys := 0;
Result := 0;
end;
DefaultHandler(M);
M.Msg := WM_LBUTTONUP;
DefaultHandler(M);
end;
procedure TL_ListBox.DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
var
Flags: Longint;
Data: String;
begin
if Assigned(FOnDrawItem) then FOnDrawItem(Self, Index, Rect, State) else
begin
FCanvas.FillRect(Rect);
if Index < Count then
begin
Flags := DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
if not UseRightToLeftAlignment then
Inc(Rect.Left, 2)
else
Dec(Rect.Right, 2);
Data := '';
if (Style in [lbVirtual, lbVirtualOwnerDraw]) then
Data := DoGetData(Index)
else
Data := Items[Index];
DrawText(FCanvas.Handle, PChar(Data), Length(Data), Rect, Flags);
end;
end;
end;
procedure TL_ListBox.MeasureItem(Index: Integer; var Height: Integer);
begin
if Assigned(FOnMeasureItem) then FOnMeasureItem(Self, Index, Height)
end;
procedure TL_ListBox.CNDrawItem(var Message: TWMDrawItem);
var
State: TOwnerDrawState;
begin
with Message.DrawItemStruct^ do
begin
State := TOwnerDrawState(LongRec(itemState).Lo);
FCanvas.Handle := hDC;
FCanvas.Font := Font;
FCanvas.Brush := Brush;
if (Integer(itemID) >= 0) and (odSelected in State) then
begin
FCanvas.Brush.Color := clHighlight;
FCanvas.Font.Color := clHighlightText
end;
if Integer(itemID) >= 0 then
DrawItem(itemID, rcItem, State) else
FCanvas.FillRect(rcItem);
if odFocused in State then DrawFocusRect(hDC, rcItem);
FCanvas.Handle := 0;
end;
end;
procedure TL_ListBox.CNMeasureItem(var Message: TWMMeasureItem);
begin
with Message.MeasureItemStruct^ do
begin
itemHeight := FItemHeight;
if FStyle = lbOwnerDrawVariable then
MeasureItem(itemID, Integer(itemHeight));
end;
end;
procedure TL_ListBox.CMCtl3DChanged(var Message: TMessage);
begin
if NewStyleControls and (FBorderStyle = bsSingle) then RecreateWnd;
inherited;
end;
procedure TL_ListBox.SelectAll;
var
I: Integer;
begin
if FMultiSelect then
for I := 0 to Items.Count - 1 do
Selected[I] := True;
end;
procedure TL_ListBox.KeyPress(var Key: Char);
procedure FindString;
var
Idx: Integer;
begin
if Style in [lbVirtual, lbVirtualOwnerDraw] then
Idx := DoFindData(FFilter)
else
Idx := SendMessage(Handle, LB_FINDSTRING, -1, LongInt(PChar(FFilter)));
if Idx <> LB_ERR then
begin
if MultiSelect then
begin
ClearSelection;
SendMessage(Handle, LB_SELITEMRANGE, 1, MakeLParam(Idx, Idx))
end;
ItemIndex := Idx;
Click;
end;
if not (Ord(Key) in [VK_RETURN, VK_BACK, VK_ESCAPE]) then
Key := #0; // Clear so that the listbox's default search mechanism is disabled
end;
var
Msg: TMsg;
begin
inherited KeyPress(Key);
if not FAutoComplete then exit;
if GetTickCount - FLastTime >= 500 then
FFilter := '';
FLastTime := GetTickCount;
if Ord(Key) <> VK_BACK then
begin
if Key in LeadBytes then
begin
if PeekMessage(Msg, Handle, WM_CHAR, WM_CHAR, PM_REMOVE) then
begin
FFilter := FFilter + Key + Chr(Msg.wParam);
Key := #0;
end;
end
else
FFilter := FFilter + Key;
end
else
begin
while ByteType(FFilter, Length(FFilter)) = mbTrailByte do
Delete(FFilter, Length(FFilter), 1);
Delete(FFilter, Length(FFilter), 1);
end;
if Length(FFilter) > 0 then
FindString
else
begin
ItemIndex := 0;
Click;
end;
end;
procedure TL_ListBox.SetCount(const Value: Integer);
var
Error: Integer;
begin
if Style in [lbVirtual, lbVirtualOwnerDraw] 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(SErrorSettingCount, [Name]);
end
else
raise Exception.CreateFmt(SListBoxMustBeVirtual, [Name]);
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.DoFindData(const Data: String): Integer;
begin
if Assigned(FOnDataFind) then
Result := FOnDataFind(Self, Data)
else
Result := -1;
end;
function TL_ListBox.GetScrollWidth: Integer;
begin
Result := SendMessage(Handle, LB_GETHORIZONTALEXTENT, 0, 0);
end;
procedure TL_ListBox.SetScrollWidth(const Value: Integer);
begin
if Value <> ScrollWidth then
SendMessage(Handle, LB_SETHORIZONTALEXTENT, Value, 0);
end;
end.
0
Bo cały czas mam wrażenie, że jest możliwe napisanie kodu w lazarusie. Tylko nie za Bardzo orientuje się w tym. — Mariusz Bruniewski 2021-01-10 17:39
Możliwość zawsze masz " Wyobraźnia jest ważniejsza od wiedzy, ponieważ wiedza jest ograniczona. - Albert Einstein " tylko musisz sobie to sam okodować.
Przybliż kontekst bo może jest inny sposób na osiągnięcie wymaganej funkcjonalności zamiast wklejać kod standardowych pas'ów.
0
dla Delphi 7 śmiga dla lazarusa pokazuje błąd L_ListBox.count.
unit L_ListBox;
interface
uses Math, StdCtrls, Controls, Classes, Forms, Graphics, Messages, Windows, SysUtils, Commctrl, Types;
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 GetCount : Integer;
procedure SetCount(const Value: Integer);
procedure SetStyle(Value: TListBoxStyle);
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;
property SelCount : Integer read GetSelCount;
property Count : Integer read GetCount write SetCount;
protected
function DoGetData(const Index: Integer): String;
function DoGetDataObject(const Index: Integer): TObject;
function DoFindData(const Data: String): Integer;
public
procedure CreateParams(var Params: TCreateParams); override;
constructor Create(AOwner: TComponent); override;
published
end;
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;
{ TL_ListBox }
constructor TL_ListBox.Create(AOwner: TComponent);
const
ListBoxStyle = [csSetCaption, csDoubleClicks, csOpaque];
begin
inherited Create(AOwner);
if NewStyleControls then
ControlStyle := ListBoxStyle else
ControlStyle := ListBoxStyle + [csFramed];
FStyle := lbVirtual;
FCount := Count;
Width := 121;
Height := 97;
end;
procedure TL_ListBox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
CreateSubClass(Params, 'ListBox');
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;
procedure TL_ListBox.SetCount(const Value: Integer);
var
Error: Integer;
begin
if Style in [lbVirtual] then
begin
Error := SendMessage(Handle, LB_SETCOUNT, Value, 0);
if (Error <> LB_ERR) and (Error <> LB_ERRSPACE) then FCount := Value else raise Exception.CreateFmt(SErrorSettingCount, [Name]);
end
else raise Exception.CreateFmt(SListBoxMustBeVirtual, [Name]);
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;
end.
0
property Count : Integer read GetCount write SetCount;
masz w private daj to do np public i zobacz czy działa. Albo doklep getter/setter
W D7 jest to pewnie w publicznym więc to widać, a w lazarusie jest w zakresie prywatnym więc wywala błąd.
Jeżeli nie będzie działać, to musisz odwoływać się do Count w klasie po której dziedziczysz.
0
Problem w tym najpierw ListBox.Count w lazarusie był tylko read-only. Odblokowałem go, lecz cały czas zgłasza błędy. W załączniku są komponenty i programy dla D7 i Lazarusa. Nie radzę sobie z lazarusem, aby wyświetlić dużo linii w ListBox przy lbVirtual oraz property Ondata KOMPONENTY.rar
1
hzmzp napisał(a):
masz w private daj to do np public i zobacz czy działa. Albo doklep getter/setter
To nie ma znaczenia — co najwyżej dostanie hint, że property TListBox.Count never used. Sprawdziłem to dokładnie i nie ma żadnego problemu z nadpisaniem tej właściwości, i nie ma problemu, bo żadnego być nie powinno. Nieważne czy zmodyfikuję deklarację tej właściwości subclassując standardową klasę:
type
TListBox = class(StdCtrls.TListBox)
private
function GetCount(): Integer;
procedure SetCount(ACount: Integer);
public
property Count: Integer read GetCount write SetCount;
end;
czy zadeklaruję własną, dziedziczącą z bazowej:
type
TMyListBox = class(StdCtrls.TCustomListBox)
private
function GetCount(): Integer;
procedure SetCount(ACount: Integer);
public
property Count: Integer read GetCount write SetCount;
end;
Kompilacja przebiega poprawnie — brak jakichkolwiek błędów czy hintów.
W D7 jest to pewnie w publicznym więc to widać, a w lazarusie jest w zakresie prywatnym więc wywala błąd.
Nie — właściwość Count znajduje się w klasie TCustomListBox w sekcji public, tak jak każda inna właściwość w każdym innym komponencie. Dopiero klasa końcowa (czyli np. TListBox) podbija wybrane właściwości do sekcji published, aby dało się do nich dobrać za pomocą RTTI (czyli np. aby były widoczne w oknie Inspektora Obiektów).
Getter właściwości Count jest w sekcji private i bez problemu można napisać swój, bo jedyne co robi to odczytuje liczbę pozycji z właściwości Items. A setter można sobie napisać tak, aby listę pozycji modyfikował. Można to zrobić w pętli, a można skorzystać z metody SetText i podać jej ciąg zduplikowany np. za pomocą funkcji DupeString:
procedure TListBox.SetCount(ACount: Integer);
begin
Items.SetText(PChar(DupeString('auto item'#10, ACount)));
end;
A jak chce się mieć puste itemki po takiej aktualizacji to można zduplikować sam separator linii, za pomocą StringOfChar:
procedure TListBox.SetCount(ACount: Integer);
begin
Items.SetText(PChar(StringOfChar(#10, ACount)));
end;
A jak się chce jeszcze inny efekt, to se można jeszcze inaczej ten setter napisać. Np. taki, który zachowa obecne itemki, a w pętli doda brakujące (puste) do wymaganej całkowitej ich liczby (lub usunie z końca listy, jeśli ma być ich mniej niż jest obecnie).
Żeby nie było że zmyślam, w załączniku programik testowy, który wykorzystuje zmodyfikowaną właściwość Count, dzięki czemu można jej przypisywać wartości. W tym testowym programiku liczba itemów brana jest z kontrolki edycyjnej, a po aktualizacji, nową ich liczę wyświetla się na pasku tytułowym okna:
procedure TMainForm.CUpdateCountButtonClick(Sender: TObject);
begin
CItemsListBox.Count := CItemsCountSpin.Value; // ło tu
Self.Caption := 'ListBox.Items.Count — %d'.Format([CitemsListBox.Count]);
end;
Tak więc jedyne co jest problemem to cuda na kiju w kodzie OP, bo wystarczą naprawdę proste skrawki kodu, aby sobie tę właściwość rozbudować. Nie ma sensu ani pisać tysiąca linii kodu i przepisywać wszystko samemu, ani tym bardziej rzeźbić w WinAPI jakichś dziwnych konstrukcji.
No ale powodzenia życzę.
0
W odpowiedzi było wspomniane o RTII, co bym mógł uzyskać tym. Potrzebuję klasy TCustomListControl na Lazarusa, aby dało się skompilować projekt.Czy istnieją sztuczne przekładanie klas. Jakieś biblioteki, które zamieniają kod w pamięci.
1
Nie uprawiam już dawno Delphi, ani Lazarusa, ale w każdym kontenerze w dowolnych językach, Count (lub odpowiednik) jest read only, zależny o ilości pozycji.
W waszym świecie jest inaczej?
1
AnyKtokolwiek napisał(a):
W waszym świecie jest inaczej?
No właśnie chodzi o to, że jest tak samo, a OP z uporem maniaka chce tę właściwość przerobić na modyfikowalną. A teraz dodatkowo mu nie pasuje, że wewnątrz settera odwołuję się do Items, który jest głównym i jedynym kontenerem do przechowywania pozycji widocznych w kontrolce (i on też posiada właściwość Count, która też jest read-only).
Ten wątek to istna komedia.
0
W wielu wątkach wspominacie, że Count to read only czy chodzi dokładnie oto co zamieszczam na obrazkach?
Dla typowego ListBox w lazarusie jest zablokowany. Dla L_ListBox1.Count jest odblokowany.
procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Count ...
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
L_ListBox1.Count ...
end;
0
Poniższy komponent dla Delphi 7 skraca metodę ładowania pliku wystarczy wywołać ListBoxEX1.Items2.LoadFromFile('');
Kod pochodzi ze strony http://codeverge.com/embarcadero.delphi.general/tstringlist-and-memory/1039345
unit ListBoxEx;
interface
uses
SysUtils, Classes, Controls, StdCtrls;
type
TListBoxEx = class(TCustomListBox)
private
FStrings: TStringlist;
procedure Recount(Sender: TObject);
procedure ListboxOnData(Control: TWinControl; Index: Integer; var Data: string);
protected
procedure Loaded; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Style;
property AutoComplete;
property Align;
property Anchors;
property BevelEdges;
property BevelInner;
property BevelKind default bkNone;
property BevelOuter;
property BiDiMode;
property BorderStyle;
property Color;
property Columns;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property ExtendedSelect;
property Font;
property ImeMode;
property ImeName;
property IntegralHeight;
property ItemHeight;
property Items2:TStringList read FStrings write FStrings;
property MultiSelect;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ScrollWidth;
property ShowHint;
property Sorted;
property TabOrder;
property TabStop;
property TabWidth;
property Visible;
property OnClick;
property OnContextPopup;
property OnData;
property OnDataFind;
property OnDataObject;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawItem;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMeasureItem;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
procedure Register;
implementation
constructor TListBoxEx.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FStrings:=TStringList.Create;
FStrings.OnChange:=Recount;
end;
destructor TListBoxEx.Destroy;
begin
FStrings.Free;
inherited Destroy;
end;
procedure TListBoxEx.ListboxOnData(Control: TWinControl; Index: Integer;
var Data: string);
begin
Data := FStrings.Strings[Index];
end;
procedure TListBoxEx.Loaded;
begin
inherited;
Style := lbVirtual;
OnData := ListboxOnData;
end;
procedure TListBoxEx.Recount(Sender: TObject);
begin
Count:=FStrings.Count;
end;
procedure Register;
begin
RegisterComponents('Standard', [TListBoxEx]);
end;
end.
0
Skoro count jest w klasie TListBox, TCustomListBox, TCustomListControl to musi istnieć w TWinControl. Bo trudno ocenić w delphi 7 gdzie można odwołać się do ListBox.Count. Działa na TListBox, TCustomListBox, TCustomListControl. Nawet w TWinControl. W lazarusie szczęka mi opada :-(. W lazarusie zauważyłem jedno jest bardzo szczegółowy. Być może to problem w odwołaniu w klasach create? Wiem, że jest to możliwe, aby kod przenieść z delphi 7 na lazarusa.. Geniusz f@urious programming wspomniał, że items jest po to, aby w danej kontrolce wyświetlić itemy, ale w lbvirtual jest po to property ondata . ażeby odwoływać się do count bez items.count
1
Mariusz Bruniewski napisał(a):
Skoro count jest w klasie TListBox, TCustomListBox, TCustomListControl to musi istnieć w TWinControl.
A niby do czego miałaby służyć w TWinControl, skoro to kontrolka bazowa dla wszystkich komponentów ”okienkowych” (posiadających uchwyt i potrafiących zbierać input) i nie posiada niczego policzalnego? :|
0
Dzięki takiemu rozwiązaniu mogę te same procedury i funkcje umieścić np. w public a zarazem w published np.
TL_ListBox = class(TlistBox)
private
protected
public
property Count : Integer read GetCount write SetCount;
published
end;
TListBox = class(TL_ListBox)
private
protected
public
published
property Count : Integer read GetCount write SetCount;
end;
Czy mi to coś da @furious programming ? Skoro mówimy o podbijaniu klas?
Odnośnie twojej wypowiedzi. "Nie — właściwość Count znajduje się w klasie TCustomListBox w sekcji public, tak jak każda inna właściwość w każdym innym komponencie. Dopiero klasa końcowa (czyli np. TListBox) podbija wybrane właściwości do sekcji published, aby dało się do nich dobrać za pomocą RTTI (czyli np. aby były widoczne w oknie Inspektora Obiektów)."
Bo mogę w ten sposób skompilować procedury takie same w jednym kodzie.
1
Mariusz Bruniewski napisał(a):
Dzięki takiemu rozwiązaniu mogę te same procedury i funkcje umieścić np. w public a zarazem w published np.
Czy mi to coś da @furious programming ? Skoro mówimy o podbijaniu klas?
I tak i nie. Subclassing działa tylko w obrębie modułu, w którym znajduje się redefiniowana klasa. Tak więc jeśli chcesz z subclassingu skorzystać, to w każdym module, w którym używa się TListBox, musisz wrzucić ten kod. Czyli to bez sensu, jeśli masz kupę formularzy (a pisałeś kiedyś, że jest ich setki).
Pewnym rozwiązaniem jest przeniesienie kodu subclassingu do plików .inc (osobno nagłówki i osobno ciała metod) i dorzucenie po dwie dyrektywy {$INCLUDE} w każdym module, w którym używane są klasy tych kontrolek. Benefit jest taki, że dyrektywy dodaje się raz, a modyfikacje wprowadza w jednym miejscu (czyli w tych dwóch plikach dołączanych, zamiast w setkach modułów).
Sam skorzystałem z tego sposobu w projekcie CTCT, w którym potrzebowałem poprawić błędy klasy TCheckListBox oraz redefiniować niektóre jego zachowania, bez tworzenia i instalowania dodatkowych komponentów. Mam plik LCL.CheckListBox.Headers.inc z subclassowaną deklaracją klasy komponentu, oraz LCL.CheckListBox.Definitions.inc z definicjami metod. Ten pierwszy dołączam w sekcji interface (przed klasą okna) w module każdego formularza, który posiada kontrolki klasy TCheckListBox, a ten drugi w sekcji implementation, tuż pod listą uses. Po dwa {$INCLUDE} na moduł, a łącznie tych modułów są trzy.
Zrób w ten sam sposób. Ale jeśli nie chcesz tworzyć komponentów zgodnie z wytycznymi, a tylko redefiniować zachowanie Count i mieć to z głowy, to subclassuj po prostu TListBox, bez zabawy z dziedziczeniem. No i wydziel ten kod do plików dołącznych, jak opisałem wyżej.
0
@furious programming co robię nie tak? Nadal brakuje count.
unit L_ListBox;
{$mode objfpc}{$H+}
interface
uses Math, StdCtrls, Controls, Classes, Forms, Graphics, Messages, Windows, SysUtils, Commctrl, Types,
LResources, LCLType, LCLIntf, LMessages;
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 GetCount : Integer;
procedure SetCount(const Value: Integer);
procedure SetStyle(Value: TListBoxStyle);
procedure CreateParams(var Params: TCreateParams); override;
protected
function DoGetData(const Index: Integer): String;
function DoGetDataObject(const Index: Integer): TObject;
function DoFindData(const Data: String): Integer;
public
constructor Create(AOwner: TComponent); override;
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;
TListBox = class(TL_ListBox)
private
protected
public
published
property Count : Integer read GetCount write SetCount;
end;
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;
{ TL_ListBox }
constructor TL_ListBox.Create(AOwner: TComponent);
const
ListBoxStyle = [csSetCaption, csDoubleClicks, csOpaque];
begin
inherited Create(AOwner);
if NewStyleControls then
ControlStyle := ListBoxStyle else
ControlStyle := ListBoxStyle + [csFramed];
FStyle := lbVirtual; // tu dodaje na sztywno
FCount := Count; // tu dodaje na sztywno
Width := 121;
Height := 97;
end;
procedure TL_ListBox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
CreateSubClass(Params, 'ListBox');
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;
procedure TL_ListBox.SetCount(const Value: Integer);
var
Error: Integer;
begin
if Style in [lbVirtual] then
begin
Error := SendMessage(Handle, LB_SETCOUNT, Value, 0);
if (Error <> LB_ERR) and (Error <> LB_ERRSPACE) then FCount := Value else raise Exception.CreateFmt(SErrorSettingCount, [Name]);
end
else raise Exception.CreateFmt(SListBoxMustBeVirtual, [Name]);
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;
end.
2
Komunikat LB_SETCOUNT jest obsługiwany tylko i wyłącznie jeżeli ListBox ma styl LBS_NODATA i NIE MA LBS_HASSTRINGS i choć to nie jest wyraźnie zaznaczone w dokumentacji musi mieć LBS_OWNERDRAWFIXED czyli jak tak zrobisz:
procedure TL_ListBox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style:= Params.Style and (not LBS_HASSTRINGS) or LBS_NODATA or LBS_OWNERDRAWFIXED;
CreateSubClass(Params, 'ListBox'); //to nie wiem po co masz skoro ta procedura w źródłach jest pusta (nie ma w ogóle kodu)!
end;
To właściwość zadziała tylko, że musisz w jakiś sposób sam rysować pozycje listy a więc raczej zrezygnować z lbVirtual ... a nawet jeżeli się da nadpisać procedurę rysowania aby działała z lbVirtual to nie to skąd brać danych co ma być w którym item skoro ma LBS_NODATA,
Dokąd ten temat w ogóle zmierza? Naprawdę Count do zapisu jest niezbędny? Albo co by było gdyby właściwość działała na zasadzie tworzenia w pętli Items z "pustymi" pozycjami lub usuwania ostatnich?
2
kAzek napisał(a):
Dokąd ten temat w ogóle zmierza? Naprawdę
Countdo zapisu jest niezbędny? Albo co by było gdyby właściwość działała na zasadzie tworzenia w pętliItemsz "pustymi" pozycjami lub usuwania ostatnich?
Już mu to sugerowałem, nawet gotowca podrzuciłem — ale nie. Sugerowałem też kiedyś, aby nie dłubał z tym lbVirtual, a zamiast tego po prostu samemu kontrolował co trafia do kontrolki, coby uniknąć ładowania milionów linii — też nie. Dlatego nie mam za bardzo ochoty udzielać się w tym wątku.
0
LBS_nodata Określa pole listy bez danych. Określ ten styl, gdy liczba elementów w polu listy przekroczy tysiąc. Pole listy bez danych również musi mieć styl LBS_OWNERDRAWFIXED , ale nie może mieć stylu LBS_SORT ani LBS_HASSTRINGS .
Pole listy bez danych przypomina pole listy narysowane przez właściciela, z tym wyjątkiem, że nie zawiera żadnych danych w postaci ciągów ani bitmap dla elementu. Polecenia dodawania, wstawiania lub usuwania pozycji zawsze ignorują określone dane pozycji; żądania znalezienia ciągu w polu listy zawsze kończą się niepowodzeniem. System wysyła wiadomość WM_DRAWITEM do okna właściciela, gdy element musi zostać narysowany. ItemID członkiem DRAWITEMSTRUCT struktury zapadają WM_DRAWITEM komunikat określa numer wiersza elementu, który ma zostać narysowany. Pole listy bez danych nie wysyła komunikatu WM_DELETEITEM . WM_DRAWITEM spróbuje z tym.
0
Szanowny @furious programming tak jak wspomniałeś LBS_OWNERDRAWFIXED jest potrzebny. W demo jest program i komponent, który wyświetla wszystkie kombinacje Lotto (Duży Lotek) poprzez T_LISTBOX1.Count. Pozostaje jedynie kwestia wyświetlenia ich w liniach. W komponencie jest więcej procedur być może one świadczą o wyświetlaniu. Tam gdzie zastosowałem // oznacza, że lazarus nie kompiluje kodu.
Demo.JPG
0
@furious programming już jestem blisko komponent działa i wyświetla itemy tylko, że nie mogę ich klikaniem myszy podświetlać to zapewne // w WPaint i po drugie zwalnia pamięć bardzo wolno to desteroy. Zobacz sam :-) dziękuję. Jeśli masz maszynę o mniejszej pamięci wstaw plik ex.txt byle jaki bo mój ma ponad 200Mb. Być może to ReadOnly trzeba w create zastosować. Dalej walczę :-)
0
Dziękuję wszystkim za wyrażenie opinii w tym wątku :-) Z całego serca dziękuję.
0
Mam do Was jeszcze 4 pytania, które poprawnie wyświetlą itemy z ich zaznaczeniami w lazasusie. Potrzeba mi tylko skompilowanie GetClipBox, DrawTextBiDiModeFlags, TOwnerDrawState: Do czego służy {$modeswith advencedrecords}
var
R: TRect; // delphi
R: lpRect; // Lazarus
begin
{ Initialize drawing records }
GetClipBox(Message.DC, R); // kompiluje w lazarusie, gdy R: lpRect;
var
Flags: Longint;
Flags := DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX); // nie rozpoznaje DrawTextBiDiModeFlags w lazarusie
// co mi da takie zastosowanie poniżej?
{$IFDEF USED_BiDi}
Flags := DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
{$ENDIF}
var
State: TOwnerDrawState;
State := TOwnerDrawState(LongRec(itemState).Lo); // Nie rozpoznaje w begin TOwnerDrawState w lazarusie
- Dlaczego w delphi 7 kiedy zamykam okno z załadowanymi itemami kontrolka zwalnia pamięć natychmiast. Natomiast w lazarusie podbija pamięć i nie zwalnia jej?
1
-
LPRECTw Lazarusie to wskaźnik na strukturę zgodną zRECT(lub popularnąTRect). -
Jeśli nie ma importu funkcji
DrawTextBiDiModeFlagsw moduleWindows, to sobie taki import dopisz samemu. -
Typ
TOwnerDrawStateznajduje się w moduleStdCtrls, który jest aliasem tego z modułuLCLTypes. Typ o identycznej nazwie zadeklarowany jest też w moduleWindows, więc jeśli dousesmasz dodane te dwa moduły, to kompilacja może być przerywana ze względu na pomieszane typy. W takim przypadku kompilator brać będzie pod uwagę typ zadeklarowany w module, który jest najniżej wuses. -
Cooo?!