mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-30 19:22:42 +02:00
777 lines
25 KiB
PHP
777 lines
25 KiB
PHP
{%MainUnit ../stdctrls.pp}
|
|
{
|
|
*****************************************************************************
|
|
* *
|
|
* This file is part of the Lazarus Component Library (LCL) *
|
|
* *
|
|
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
|
|
* for details about the copyright. *
|
|
* *
|
|
* This program is distributed in the hope that it will be useful, *
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
|
* *
|
|
*****************************************************************************
|
|
}
|
|
{ if not HandleAllocated then
|
|
FItems contains a TExtendedStringList
|
|
else
|
|
FItems contains an interface specific TStrings descendent
|
|
}
|
|
|
|
type
|
|
TCustomListBoxItemRecord = record
|
|
TheObject: TObject;
|
|
Selected: Boolean;
|
|
end;
|
|
PCustomListBoxItemRecord = ^TCustomListBoxItemRecord;
|
|
|
|
{------------------------------------------------------------------------------
|
|
procedure TCustomListBox.AssignCacheToItemData
|
|
------------------------------------------------------------------------------}
|
|
procedure TCustomListBox.AssignCacheToItemData(const AIndex: Integer;
|
|
const AData: Pointer);
|
|
begin
|
|
if PCustomListBoxItemRecord(AData)^.Selected or (FItemIndex = AIndex) then
|
|
begin
|
|
LockSelectionChange;
|
|
SendItemSelected(AIndex, True);
|
|
UnlockSelectionChange;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomListBox.BeginAutoDrag;
|
|
begin
|
|
BeginDrag(False);
|
|
end;
|
|
|
|
function TCustomListBox.CalculateStandardItemHeight: Integer;
|
|
var
|
|
B: TBitmap;
|
|
begin
|
|
// Paul: This will happen only once if Style = lbStandard then CheckListBox is
|
|
// OwnerDrawFixed in real (under windows). Handle is not allocated and we
|
|
// cant use Canvas since it will cause recursion but we need correct font height
|
|
B := TBitmap.Create;
|
|
try
|
|
B.Canvas.Font := Font;
|
|
Result := B.Canvas.TextHeight('Fj');
|
|
finally
|
|
B.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomListBox.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
if HandleAllocated then begin
|
|
LockSelectionChange;
|
|
SendItemIndex;
|
|
UnlockSelectionChange;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
procedure TCustomListBox.AssignItemDataToCache
|
|
------------------------------------------------------------------------------}
|
|
procedure TCustomListBox.AssignItemDataToCache(const AIndex: Integer;
|
|
const AData: Pointer);
|
|
begin
|
|
PCustomListBoxItemRecord(AData)^.Selected := Selected[AIndex];
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
procedure TCustomListBox.InitializeWnd
|
|
------------------------------------------------------------------------------}
|
|
procedure TCustomListBox.InitializeWnd;
|
|
var
|
|
NewStrings : TStrings;
|
|
i, cnt: integer;
|
|
OldItems: TExtendedStringList;
|
|
begin
|
|
LockSelectionChange;
|
|
//DebugLn('[TCustomListBox.InitializeWnd] A ',FItems.ClassName);
|
|
inherited InitializeWnd;
|
|
//DebugLn('[TCustomListBox.InitializeWnd] B ',FItems.ClassName);
|
|
// create
|
|
TWSCustomListBoxClass(WidgetSetClass).SetBorder(Self);
|
|
|
|
// fetch the interface item list
|
|
NewStrings := TWSCustomListBoxClass(WidgetSetClass).GetStrings(Self);
|
|
// copy the items (text+objects)
|
|
OldItems := FItems as TExtendedStringList;
|
|
OldItems.Sorted:=false;// make sure the items are not reordered (needed for ItemIndex and attributes)
|
|
NewStrings.Assign(Items);
|
|
|
|
//for i:=0 to Fitems.Count-1 do
|
|
// DebugLn(['TCustomListBox.InitializeWnd ',i,' New=',NewStrings[i],' ',DbgSName(NewStrings.Objects[i]),' Old=',Items[i],' ',dbgsname(Items.Objects[i])]);
|
|
|
|
// new item list is the interface item list
|
|
FItems:= NewStrings;
|
|
FCacheValid := False;
|
|
|
|
SendItemIndex;
|
|
|
|
// copy items attributes
|
|
cnt := OldItems.Count;
|
|
for i:=0 to cnt-1 do
|
|
AssignCacheToItemData(i, OldItems.Records[i]);
|
|
|
|
// free old items
|
|
OldItems.Free;
|
|
TWSCustomListBoxClass(WidgetSetClass).SetSorted(Self, FItems, FSorted);
|
|
UnlockSelectionChange;
|
|
//DebugLn('[TCustomListBox.InitializeWnd] END ',FItems.ClassName);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
procedure TCustomListBox.FinalizeWnd
|
|
------------------------------------------------------------------------------}
|
|
procedure TCustomListBox.FinalizeWnd;
|
|
var
|
|
NewStrings : TExtendedStringList;
|
|
i, Cnt: integer;
|
|
begin
|
|
LockSelectionChange;
|
|
|
|
// save ItemIndex on destroy handle
|
|
if ([csDestroying,csLoading]*ComponentState=[]) then
|
|
GetItemIndex;
|
|
//DebugLn('[TCustomListBox.FinalizeWnd] A ',FItems.ClassName);
|
|
// create internal item list
|
|
if Assigned(FItems) then begin
|
|
NewStrings:= TExtendedStringList.Create(GetCachedDataSize);
|
|
|
|
// copy items (text+objects) from the interface items list
|
|
NewStrings.Assign(Items);
|
|
// copy items attributes
|
|
Cnt:=Items.Count;
|
|
for i:=0 to Cnt-1 do
|
|
AssignItemDataToCache(i, NewStrings.Records[i]);
|
|
|
|
// free the interface items list
|
|
TWSCustomListBoxClass(WidgetSetClass).FreeStrings(FItems);
|
|
// new item list is the internal item list
|
|
NewStrings.Sorted:=FSorted;
|
|
FItems:= NewStrings;
|
|
FCacheValid := True;
|
|
//DebugLn('[TCustomListBox.FinalizeWnd] B ',FItems.ClassName);
|
|
end;
|
|
inherited FinalizeWnd;
|
|
//DebugLn('[TCustomListBox.FinalizeWnd] END ',FItems.ClassName);
|
|
UnlockSelectionChange;
|
|
end;
|
|
|
|
class function TCustomListBox.GetControlClassDefaultSize: TPoint;
|
|
begin
|
|
Result.X:=100;
|
|
Result.Y:=80;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
procedure TCustomListBox.UpdateSelectionMode
|
|
------------------------------------------------------------------------------}
|
|
procedure TCustomListBox.UpdateSelectionMode;
|
|
begin
|
|
if not HandleAllocated then exit;
|
|
LockSelectionChange;
|
|
TWSCustomListBoxClass(WidgetSetClass).SetSelectionMode(Self,
|
|
ExtendedSelect, MultiSelect);
|
|
UnlockSelectionChange;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
function TCustomListBox.GetTopIndex: Integer;
|
|
------------------------------------------------------------------------------}
|
|
function TCustomListBox.GetTopIndex: Integer;
|
|
begin
|
|
if HandleAllocated then
|
|
FTopIndex := TWSCustomListBoxClass(WidgetSetClass).GetTopIndex(Self);
|
|
Result := FTopIndex;
|
|
end;
|
|
|
|
procedure TCustomListBox.RaiseIndexOutOfBounds(AIndex: integer);
|
|
begin
|
|
Exception.CreateFmt(rsIndexOutOfBounds, [ClassName, AIndex, FItems.Count-1]);
|
|
end;
|
|
|
|
procedure TCustomListBox.SetColumns(const AValue: Integer);
|
|
begin
|
|
if (FColumns = AValue) or (AValue < 0) then
|
|
exit;
|
|
FColumns := AValue;
|
|
if HandleAllocated then
|
|
TWSCustomListBoxClass(WidgetSetClass).SetColumnCount(Self, FColumns);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
function TCustomListBox.GetCount: Integer;
|
|
------------------------------------------------------------------------------}
|
|
function TCustomListBox.GetCount: Integer;
|
|
begin
|
|
Result := Items.Count;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
procedure TCustomListBox.SetTopIndex(const AValue: Integer);
|
|
------------------------------------------------------------------------------}
|
|
procedure TCustomListBox.SetTopIndex(const AValue: Integer);
|
|
begin
|
|
// don't check if changed. If the item is only partly visible, the message
|
|
// will make it complete visible.
|
|
FTopIndex:=AValue;
|
|
if HandleAllocated and ([csLoading,csDestroying]*ComponentState=[]) then
|
|
TWSCustomListBoxClass(WidgetSetClass).SetTopIndex(Self, AValue);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
procedure TCustomListBox.UpdateSorted;
|
|
------------------------------------------------------------------------------}
|
|
procedure TCustomListBox.UpdateSorted;
|
|
begin
|
|
if HandleAllocated then begin
|
|
LockSelectionChange;
|
|
TWSCustomListBoxClass(WidgetSetClass).SetSorted(Self, FItems, FSorted);
|
|
UnlockSelectionChange;
|
|
end else begin
|
|
TExtendedStringList(FItems).Sorted:=FSorted;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
procedure TCustomListBox.LMDrawListItem(var TheMessage: TLMDrawListItem);
|
|
|
|
Handler for custom drawing items.
|
|
------------------------------------------------------------------------------}
|
|
procedure TCustomListBox.LMDrawListItem(var TheMessage: TLMDrawListItem);
|
|
begin
|
|
with TheMessage.DrawListItemStruct^ do
|
|
begin
|
|
FCanvas.Handle := DC;
|
|
if Font<>nil then
|
|
FCanvas.Font := Font;
|
|
if Brush<>nil then
|
|
FCanvas.Brush := Brush;
|
|
if (ItemID >= 0) and (odSelected in ItemState) then
|
|
begin
|
|
FCanvas.Brush.Color := clHighlight;
|
|
FCanvas.Font.Color := clHighlightText
|
|
end else begin
|
|
FCanvas.Brush.Color:=clWindow;
|
|
FCanvas.Font.Color:=clWindowText;
|
|
end;
|
|
//DebugLn('TCustomListBox.LMDrawListItem ',DbgSName(Self));
|
|
DrawItem(ItemID, Area, ItemState);
|
|
if odFocused in ItemState then
|
|
{DrawFocusRect(hDC, rcItem)};
|
|
FCanvas.Handle := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomListBox.LMMeasureItem(var TheMessage: TLMMeasureItem);
|
|
var
|
|
AHeight: Integer;
|
|
begin
|
|
with TheMessage.MeasureItemStruct^ do
|
|
begin
|
|
if Self.ItemHeight <> 0 then
|
|
AHeight := Self.ItemHeight
|
|
else
|
|
AHeight := ItemHeight;
|
|
MeasureItem(Integer(ItemId), AHeight);
|
|
if AHeight > 0 then
|
|
ItemHeight := AHeight;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
procedure TCustomListBox.LMSelChange(var TheMessage);
|
|
------------------------------------------------------------------------------}
|
|
procedure TCustomListBox.LMSelChange(var TheMessage);
|
|
begin
|
|
//debugln('TCustomListBox.LMSelChange ',DbgSName(Self),' ',dbgs(ItemIndex));
|
|
if [csLoading,csDestroying,csDesigning]*ComponentState<>[] then exit;
|
|
//debugln('TCustomListBox.LMSelChange ',Name,':',ClassName,' ItemIndex=',dbgs(ItemIndex),' FLockSelectionChange=',dbgs(FLockSelectionChange));
|
|
if FLockSelectionChange=0 then
|
|
EditingDone;
|
|
DoSelectionChange(FLockSelectionChange=0);
|
|
end;
|
|
|
|
procedure TCustomListBox.WMLButtonUp(var Message: TLMLButtonUp);
|
|
begin
|
|
// prevent Click to be called twice when using selchange as click
|
|
if ClickOnSelChange and FClickTriggeredBySelectionChange then
|
|
Exclude(FControlState, csClicked);
|
|
//debugln('TCustomListBox.WMLButtonDown ',DbgSName(Self),' ',dbgs(ItemIndex));
|
|
inherited WMLButtonUp(Message);
|
|
// reset flag
|
|
FClickTriggeredBySelectionChange:=false;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
procedure TCustomListBox.SendItemSelected(Index: integer; IsSelected: boolean);
|
|
|
|
Tell the interface whether an item is selected.
|
|
------------------------------------------------------------------------------}
|
|
procedure TCustomListBox.SendItemSelected(Index: integer; IsSelected: boolean);
|
|
begin
|
|
if HandleAllocated then
|
|
TWSCustomListBoxClass(WidgetSetClass).SelectItem(Self, Index, IsSelected);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ procedure TCustomListBox.SetExtendedSelect }
|
|
{------------------------------------------------------------------------------}
|
|
procedure TCustomListBox.SetExtendedSelect(Val : boolean);
|
|
begin
|
|
if Val <> FExtendedSelect then begin
|
|
FExtendedSelect:= Val;
|
|
UpdateSelectionMode;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ procedure TCustomListBox.SetMultiSelect }
|
|
{------------------------------------------------------------------------------}
|
|
procedure TCustomListBox.SetMultiSelect(Val : boolean);
|
|
begin
|
|
if Val <> FMultiSelect then begin
|
|
FMultiSelect:= Val;
|
|
UpdateSelectionMode;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ procedure TCustomListBox.SetSelected }
|
|
{------------------------------------------------------------------------------}
|
|
procedure TCustomListBox.SetSelected(Index : integer; Val : boolean);
|
|
begin
|
|
CheckIndex(Index);
|
|
|
|
if not MultiSelect then
|
|
begin
|
|
if Val then
|
|
ItemIndex := Index
|
|
else
|
|
if Index = ItemIndex then
|
|
ItemIndex := -1;
|
|
end else
|
|
begin
|
|
if HandleAllocated
|
|
then SendItemSelected(Index, Val)
|
|
else PCustomListBoxItemRecord(GetCachedData(Index))^.Selected := Val;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ function TCustomListBox.GetSelected }
|
|
{------------------------------------------------------------------------------}
|
|
function TCustomListBox.GetSelected(Index : integer) : boolean;
|
|
begin
|
|
CheckIndex(Index);
|
|
if HandleAllocated then
|
|
Result:= TWSCustomListBoxClass(WidgetSetClass).GetSelected(Self, Index)
|
|
else
|
|
Result:= PCustomListBoxItemRecord(GetCachedData(Index))^.Selected;
|
|
//debugln('TCustomListBox.GetSelected A ',DbgSName(Self),' Index=',dbgs(Index),' Selected=',dbgs(Result));
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ function TCustomListBox.GetSelCount }
|
|
{------------------------------------------------------------------------------}
|
|
function TCustomListBox.GetSelCount : integer;
|
|
begin
|
|
if HandleAllocated then
|
|
Result := TWSCustomListBoxClass(WidgetSetClass).GetSelCount(Self)
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TCustomListBox.GetItemHeight: Integer;
|
|
begin
|
|
if HandleAllocated and (Style = lbStandard) then
|
|
begin
|
|
with ItemRect(TopIndex) do
|
|
Result := Bottom - Top;
|
|
end
|
|
else
|
|
Result := FItemHeight;
|
|
end;
|
|
|
|
procedure TCustomListBox.SetItemHeight(Value: Integer);
|
|
begin
|
|
if (FItemHeight <> Value) and (Value >= 0) then begin
|
|
FItemHeight := Value;
|
|
if (not HandleAllocated) or (csLoading in ComponentState) then exit;
|
|
// TODO: remove RecreateWnd
|
|
RecreateWnd(Self);
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ procedure TCustomListBox.SetSorted }
|
|
{------------------------------------------------------------------------------}
|
|
procedure TCustomListBox.SetSorted(Val : boolean);
|
|
begin
|
|
if Val <> FSorted then begin
|
|
FSorted:= Val;
|
|
UpdateSorted;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
procedure TCustomListBox.SetStyle
|
|
------------------------------------------------------------------------------}
|
|
procedure TCustomListBox.SetStyle(Val : TListBoxStyle);
|
|
begin
|
|
if Val <> FStyle then begin
|
|
FStyle:= Val;
|
|
if HandleAllocated then
|
|
TWSCustomListBoxClass(WidgetSetClass).SetStyle(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomListBox.DrawItem(Index: Integer; ARect: TRect;
|
|
State: TOwnerDrawState);
|
|
var
|
|
OldBrushStyle: TBrushStyle;
|
|
OldTextStyle: TTextStyle;
|
|
NewTextStyle: TTextStyle;
|
|
begin
|
|
//DebugLn('TCustomListBox.DrawItem ',DbgSName(Self));
|
|
if Assigned(FOnDrawItem) then
|
|
FOnDrawItem(Self, Index, ARect, State)
|
|
else if not (odPainted in State) then
|
|
begin
|
|
FCanvas.FillRect(ARect);
|
|
if (Index>=0) and (Index < Items.Count) then begin
|
|
OldBrushStyle := FCanvas.Brush.Style;
|
|
FCanvas.Brush.Style := bsClear;
|
|
|
|
OldTextStyle := FCanvas.TextStyle;
|
|
NewTextStyle := OldTextStyle;
|
|
NewTextStyle.Layout := tlCenter;
|
|
FCanvas.TextStyle := NewTextStyle;
|
|
|
|
FCanvas.TextRect(ARect, ARect.Left+2, ARect.Top, Items[Index]);
|
|
FCanvas.Brush.Style := OldBrushStyle;
|
|
FCanvas.TextStyle := OldTextStyle;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomListBox.DoSelectionChange(User: Boolean);
|
|
begin
|
|
if Assigned(OnSelectionChange) then
|
|
OnSelectionChange(Self,User);
|
|
if User and ClickOnSelChange then begin
|
|
Click;
|
|
// set flag, that we triggered a Click, so that a possible MouseClick will
|
|
// not trigger it again
|
|
FClickTriggeredBySelectionChange:=true;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomListBox.SendItemIndex;
|
|
begin
|
|
TWSCustomListBoxClass(WidgetSetClass).SetItemIndex(Self, FItemIndex);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
function TCustomListBox.GetCachedData
|
|
------------------------------------------------------------------------------}
|
|
function TCustomListBox.GetCachedData(const AIndex: Integer): Pointer;
|
|
begin
|
|
if not FCacheValid then
|
|
raise EInvalidOperation.Create('Reading form invalid cache');
|
|
Result := TExtendedStringList(FItems).Records[AIndex];
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
function TCustomListBox.GetCachedDataSize
|
|
|
|
Returns the amount of data needed when the widged isn't realized in the
|
|
interface
|
|
------------------------------------------------------------------------------}
|
|
function TCustomListBox.GetCachedDataSize: Integer;
|
|
begin
|
|
Result := SizeOf(TCustomListBoxItemRecord);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
function TCustomListBox.SetItems
|
|
------------------------------------------------------------------------------}
|
|
procedure TCustomListBox.SetItems(Value : TStrings);
|
|
begin
|
|
if (Value <> FItems) then begin
|
|
//DebugLn('[TCustomListBox.SetItems] A FItems=',FItems.ClassName,' Value=',Value.ClassName);
|
|
LockSelectionChange;
|
|
FItems.Assign(Value);
|
|
UnlockSelectionChange;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
function TCustomListBox.Create
|
|
------------------------------------------------------------------------------}
|
|
constructor TCustomListBox.Create(TheOwner : TComponent);
|
|
begin
|
|
inherited Create(TheOwner);
|
|
LockSelectionChange;
|
|
fCompStyle := csListBox;
|
|
BorderStyle:= bsSingle;
|
|
FItems := TExtendedStringList.Create(GetCachedDataSize);
|
|
FCacheValid := True;
|
|
FClickOnSelChange:= True;
|
|
FItemIndex:=-1;
|
|
FExtendedSelect := true;
|
|
FCanvas := TControlCanvas.Create;
|
|
TControlCanvas(FCanvas).Control := Self;
|
|
ParentColor := false;
|
|
TabStop := true;
|
|
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
|
|
UnlockSelectionChange;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
function TCustomListBox.Destroy
|
|
------------------------------------------------------------------------------}
|
|
destructor TCustomListBox.Destroy;
|
|
begin
|
|
Destroying;
|
|
DestroyWnd;
|
|
FreeAndNil(FCanvas);
|
|
FreeAndNil(FItems);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TCustomListBox.GetItemIndex : integer;
|
|
begin
|
|
//DebugLn('[TCustomListBox.GetItemIndex] A ',FItems.ClassName);
|
|
if HandleAllocated then
|
|
begin
|
|
Result := TWSCustomListBoxClass(WidgetSetClass).GetItemIndex(Self);
|
|
if (Result < 0) or (Result >= Count) then
|
|
Result := -1;
|
|
FItemIndex := Result;
|
|
end
|
|
else
|
|
Result := FItemIndex;
|
|
//DebugLn('[TCustomListBox.GetItemIndex] END ');
|
|
end;
|
|
|
|
procedure TCustomListBox.SetItemIndex(AIndex : integer);
|
|
begin
|
|
if (AIndex >= FItems.Count) then
|
|
RaiseIndexOutOfBounds(AIndex);
|
|
if AIndex<0 then AIndex:=-1;
|
|
//DebugLn('[TCustomListBox.SetItemIndex] A ',FItems.ClassName,' ',dbgs(AIndex));
|
|
FItemIndex:=AIndex;
|
|
if HandleAllocated and ([csLoading,csDestroying]*ComponentState=[]) then
|
|
SendItemIndex;
|
|
DoSelectionChange(false);
|
|
//DebugLn('[TCustomListBox.SetItemIndex] END ',FItems.ClassName);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
procedure TCustomListBox.CheckIndex
|
|
------------------------------------------------------------------------------}
|
|
procedure TCustomListBox.CheckIndex(const AIndex: Integer);
|
|
begin
|
|
if (AIndex < 0) or (AIndex >= Items.Count) then
|
|
RaiseIndexOutOfBounds(AIndex);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
procedure TCustomListBox.Clear
|
|
|
|
Delete all items.
|
|
------------------------------------------------------------------------------}
|
|
procedure TCustomListBox.Clear;
|
|
begin
|
|
FItems.Clear;
|
|
end;
|
|
|
|
procedure TCustomListBox.ClearSelection;
|
|
var
|
|
i: integer;
|
|
begin
|
|
if MultiSelect then
|
|
for i := 0 to Items.Count - 1 do
|
|
Selected[i] := False
|
|
else
|
|
ItemIndex := -1; // no need to traverse all items - look at SetSelected
|
|
end;
|
|
|
|
procedure TCustomListBox.LockSelectionChange;
|
|
begin
|
|
inc(FLockSelectionChange);
|
|
end;
|
|
|
|
procedure TCustomListBox.UnlockSelectionChange;
|
|
begin
|
|
dec(FLockSelectionChange);
|
|
end;
|
|
|
|
procedure TCustomListBox.Click;
|
|
begin
|
|
inherited Click;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
procedure TCustomListBox.MeasureItem(Index: Integer; var TheHeight: Integer);
|
|
|
|
------------------------------------------------------------------------------}
|
|
procedure TCustomListBox.MeasureItem(Index: Integer; var TheHeight: Integer);
|
|
begin
|
|
if Assigned(OnMeasureItem) then
|
|
OnMeasureItem(Self, Index, TheHeight);
|
|
end;
|
|
|
|
procedure TCustomListBox.SelectAll;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if MultiSelect then
|
|
begin
|
|
for i := 0 to Items.Count - 1 do
|
|
Selected[i] := true;
|
|
end else
|
|
begin
|
|
i := ItemIndex;
|
|
if (i>=0) and (i<Count) then
|
|
Selected[i] := true;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
function TCustomListBox.GetIndexAtXY(X, Y: integer): integer;
|
|
|
|
Returns item index at x, y coordinate (including scrolling)
|
|
------------------------------------------------------------------------------}
|
|
function TCustomListBox.GetIndexAtXY(X, Y: integer): integer;
|
|
begin
|
|
Result := -1;
|
|
if (not HandleAllocated) then Exit;
|
|
Result := TWSCustomListBoxClass(WidgetSetClass).GetIndexAtXY(Self, X, Y);
|
|
end;
|
|
|
|
function TCustomListBox.GetIndexAtY(Y: integer): integer;
|
|
begin
|
|
Result := GetIndexAtXY(1, Y);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
function TCustomListBox.GetSelectedText: string;
|
|
|
|
Returns Text of all selected items, separated by LineEnding
|
|
------------------------------------------------------------------------------}
|
|
function TCustomListBox.GetSelectedText: string;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := '';
|
|
if ItemIndex < 0 then
|
|
Exit;
|
|
for i := 0 to Items.Count - 1 do
|
|
if Selected[i] then
|
|
if Result = '' then
|
|
Result := Items[i]
|
|
else
|
|
Result := Result + LineEnding + Items[i]
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
function TCustomListBox.ItemAtPos(const Pos: TPoint; Existing: Boolean
|
|
): Integer;
|
|
|
|
Returns item index at y coordinate (including scrolling)
|
|
------------------------------------------------------------------------------}
|
|
function TCustomListBox.ItemAtPos(const Pos: TPoint; Existing: Boolean
|
|
): Integer;
|
|
begin
|
|
Result := GetIndexAtXY(Pos.X, Pos.Y);
|
|
if Existing then
|
|
begin
|
|
if Result >= Items.Count then
|
|
Result := -1;
|
|
end else
|
|
begin
|
|
if (Result < 0) and (Result > Items.Count) and PtInRect(ClientRect, Pos) then
|
|
Result := Items.Count;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
function TCustomListBox.ItemRect(Index: Integer): TRect;
|
|
|
|
Returns coordinates of an item (including scrolling)
|
|
Special: If Index=Count the rectangle is guessed (like VCL).
|
|
------------------------------------------------------------------------------}
|
|
function TCustomListBox.ItemRect(Index: Integer): TRect;
|
|
begin
|
|
FillChar(Result, SizeOf(Result), 0);
|
|
if not HandleAllocated then
|
|
Exit;
|
|
if (Index >= 0) and (Index < Items.Count) then
|
|
TWSCustomListBoxClass(WidgetSetClass).GetItemRect(Self, Index, Result)
|
|
else
|
|
if (Index=Items.Count) and (Index>0) then
|
|
begin
|
|
TWSCustomListBoxClass(WidgetSetClass).GetItemRect(Self, Index - 1, Result);
|
|
OffsetRect(Result, 0, Result.Bottom - Result.Top);
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
function TCustomListBox.ItemVisible(Index: Integer): boolean;
|
|
|
|
Returns true if Item is partially visible.
|
|
------------------------------------------------------------------------------}
|
|
function TCustomListBox.ItemVisible(Index: Integer): boolean;
|
|
var
|
|
ARect: TRect;
|
|
begin
|
|
Result:=false;
|
|
if (Index<0) or (Index>=Items.Count) then exit;
|
|
if not TWSCustomListBoxClass(WidgetSetClass).GetItemRect(Self, Index, ARect) then
|
|
exit;
|
|
if (ARect.Bottom<0) or (ARect.Top>ClientHeight) then
|
|
exit;
|
|
Result:=true;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
function TCustomListBox.ItemFullyVisible(Index: Integer): boolean;
|
|
|
|
Returns true if Item is fully visible.
|
|
------------------------------------------------------------------------------}
|
|
function TCustomListBox.ItemFullyVisible(Index: Integer): boolean;
|
|
var
|
|
ARect: TRect;
|
|
begin
|
|
Result:=false;
|
|
if (Index<0) or (Index>=Items.Count) then exit;
|
|
if not TWSCustomListBoxClass(WidgetSetClass).GetItemRect(Self, Index, ARect) then
|
|
exit;
|
|
if (ARect.Top<0) or (ARect.Bottom>ClientHeight) then
|
|
exit;
|
|
Result:=true;
|
|
end;
|
|
|
|
procedure TCustomListBox.MakeCurrentVisible;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i:=ItemIndex;
|
|
|
|
if (i<0) or (i>=Items.Count) then exit;
|
|
// don't change top index if items is already fully visible
|
|
if ItemFullyVisible(i) then exit;
|
|
|
|
TopIndex:=ItemIndex;
|
|
end;
|
|
|
|
|
|
// back to stdctrls.pp
|