diff options
Diffstat (limited to 'src/gui/fpg_listview.pas')
| -rw-r--r-- | src/gui/fpg_listview.pas | 1753 |
1 files changed, 1753 insertions, 0 deletions
diff --git a/src/gui/fpg_listview.pas b/src/gui/fpg_listview.pas new file mode 100644 index 00000000..acb4e337 --- /dev/null +++ b/src/gui/fpg_listview.pas @@ -0,0 +1,1753 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + 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. + + Description: + Defines a Listview control. +} + +unit fpg_listview; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, + SysUtils, + fpg_base, + fpg_main, + fpg_widget, + fpg_scrollbar; + +type + TfpgListView = class; + TfpgLVItem = class; + TfpgLVColumns = class; + TfpgLVColumn = class; + + TfpgLVColumnClickEvent = procedure(Listview: TfpgListView; Column: TfpgLVColumn; Button: Integer) of object; + + + TfpgLVColumn = class(TComponent) + private + FAlignment: TAlignment; + FCaptionAlignment: TAlignment; + FDown: Boolean; + FAutoSize: Boolean; + FCaption: String; + FClickable: Boolean; + FColumnIndex: Integer; + FColumns: TfpgLVColumns; + FHeight: Integer; + FResizable: Boolean; + FVisible: Boolean; + FWidth: Integer; + procedure SetAlignment(const AValue: TAlignment); + procedure SetAutoSize(const AValue: Boolean); + procedure SetCaption(const AValue: String); + procedure SetCaptionAlignment(const AValue: TAlignment); + procedure SetColumnIndex(const AValue: Integer); + procedure SetHeight(const AValue: Integer); + procedure SetResizable(const AValue: Boolean); + procedure SetVisible(const AValue: Boolean); + procedure SetWidth(const AValue: Integer); + public + constructor Create(AColumns: TfpgLVColumns); reintroduce; + destructor Destroy; override; + property Caption: String read FCaption write SetCaption; + property CaptionAlignment: TAlignment read FCaptionAlignment write SetCaptionAlignment; + property Alignment: TAlignment read FAlignment write SetAlignment; + property AutoSize: Boolean read FAutoSize write SetAutoSize; + property Width: Integer read FWidth write SetWidth; + property Height: Integer read FHeight write SetHeight; + property Visible: Boolean read FVisible write SetVisible; + property ColumnIndex: Integer read FColumnIndex write SetColumnIndex; + property Clickable: Boolean read FClickable write FClickable; + property Resizable: Boolean read FResizable write SetResizable; + end; + + + TfpgLVColumns = class(TPersistent) + private + FListView: TfpgListView; + FColumns: TList; + function GetColumn(AIndex: Integer): TfpgLVColumn; + procedure SetColumn(AIndex: Integer; const AValue: TfpgLVColumn); + public + constructor Create(AListView: TfpgListView); + destructor Destroy; override; + function Add(AColumn: TfpgLVColumn): Integer; + procedure Clear; + procedure Delete(AIndex: Integer); + procedure Insert(AColumn: TfpgLVColumn; AIndex: Integer); + function Count: Integer; + property Column[AIndex: Integer]: TfpgLVColumn read GetColumn write SetColumn; + end; + + + TfpgLVItemState = set of (lisFocused, lisSelected, lisHotTrack); + + TfpgLVItemPaintPart = set of (lvppBackground, lvppIcon, lvppText, lvppFocused); + + TfpgLVPaintColumnEvent = procedure(ListView: TfpgListView; Canvas: TfpgCanvas; Column: TfpgLVColumn; + ColumnIndex: Integer; Area: TfpgRect; var PaintPart: TfpgLVItemPaintPart) of object; + TfpgLVPaintItemEvent = procedure(ListView: TfpgListView; Canvas: TfpgCanvas; Item: TfpgLVItem; + ItemIndex: Integer; Area:TfpgRect; var PaintPart: TfpgLVItemPaintPart) of object; + TfpgLVItemSelectEvent = procedure(ListView: TfpgListView; Item: TfpgLVItem; + ItemIndex: Integer; Selected: Boolean) of object; + + + IfpgLVItemViewer = interface + procedure ItemDeleted(AIndex: Integer); + procedure ItemAdded(AIndex: Integer); + procedure ItemChanged(AIndex: Integer); + procedure ItemsUpdated; + end; + + + TfpgLVItems = class(TObject) + private + FUpdateCount: Integer; + FColumns: TfpgLVColumns; + FCurrentIndexOf: Integer; + FViewers: TList; + FItems: TList; + function GetCapacity: Integer; + function GetItem(AIndex: Integer): TfpgLVItem; + procedure SetCapacity(const AValue: Integer); + procedure SetItem(AIndex: Integer; const AValue: TfpgLVItem); + procedure AddViewer(AValue: IfpgLVItemViewer); + procedure DeleteViewer(AValue: IfpgLVItemViewer); + // interface method triggers + procedure DoChange(AItem: TfpgLVItem); + procedure DoAdd(AItem: TfpgLVItem); + procedure DoDelete(AItem: TfpgLVItem); + procedure DoEndUpdate; + public + constructor Create(AViewer: IfpgLVItemViewer); + destructor Destroy; override; + function Add(AItem: TfpgLVItem): Integer; + function Count: Integer; + procedure Clear; + procedure Delete(AIndex: Integer); + function IndexOf(AItem: TfpgLVItem): Integer; + procedure InsertItem(AItem: TfpgLVItem; AIndex: Integer); + procedure BeginUpdate; + procedure EndUpdate; + property Capacity: Integer read GetCapacity write SetCapacity; + property Columns: TfpgLVColumns read FColumns; + property Item[AIndex: Integer]: TfpgLVItem read GetItem write SetItem; + end; + + + TfpgLVItem = class(TObject) + private + FCaption: String; + FItems: TfpgLVItems; + FSubItems: TStrings; + FUserData: Pointer; + function GetSelected(ListView: TfpgListView): Boolean; + procedure SetCaption(const AValue: String); + procedure SetSelected(ListView: TfpgListView; const AValue: Boolean); + procedure SubItemsChanged(Sender: TObject); + public + constructor Create(Items: TfpgLVItems); virtual; + destructor Destroy; override; + property Caption: String read FCaption write SetCaption; + property UserData: Pointer read FUserData write FUserData; + property SubItems: TStrings read FSubItems; + property Selected[ListView: TfpgListView]: Boolean read GetSelected write SetSelected; + end; + + + TfpgListView = class(TfpgWidget, IfpgLVItemViewer) + private + FItemIndex: Integer; + FMultiSelect: Boolean; + FOnPaintColumn: TfpgLVPaintColumnEvent; + FOnSelectionChanged: TfpgLVItemSelectEvent; + FShiftCount: Integer; + FSelectionFollowsFocus: Boolean; + FSelectionShiftStart: Integer; + FOnColumnClick: TfpgLVColumnClickEvent; + FSelected: TList; + FOldSelected: TList; + FUpdateCount: Integer; + FVScrollBar: TfpgScrollBar; + FHScrollBar: TfpgScrollBar; + FColumns: TfpgLVColumns; + FItems: TfpgLVItems; + FOnPaintItem: TfpgLVPaintItemEvent; + FShowHeaders: Boolean; + FResizingColumn: TfpgLVColumn; + FMouseDownPoint: TPoint; + FScrollBarNeedsUpdate: Boolean; + function GetItemHeight: Integer; + procedure SetItemIndex(const AValue: Integer); + procedure SetItems(const AValue: TfpgLVItems); + procedure SetMultiSelect(const AValue: Boolean); + procedure SetOnColumnClick(const AValue: TfpgLVColumnClickEvent); + procedure SetShowHeaders(const AValue: Boolean); + procedure VScrollChange(Sender: TObject; Position: Integer); + procedure HScrollChange(Sender: TObject; Position: Integer); + // interface methods + procedure ItemDeleted(AIndex: Integer); + procedure ItemAdded(AIndex: Integer); + procedure ItemChanged(AIndex: Integer); + procedure ItemsUpdated; + // + function GetVisibleColumnsWidth: Integer; + function GetItemAreaHeight: Integer; + procedure StartShiftSelection; + procedure EndShiftSelection; + procedure SelectionSetRangeEnabled(AStart, AEnd: Integer; AValue: Boolean); + procedure SelectionToggleRange(AStart, AEnd: Integer; const ShiftState: TShiftState; IgnoreStartIndex: Boolean); + procedure SelectionClear; + function ItemGetSelected(const AItem: TfpgLVItem): Boolean; + procedure ItemSetSelected(const AItem: TfpgLVItem; const AValue: Boolean); + function ItemGetFromPoint(const X, Y: Integer): TfpgLVItem; + function ItemGetRect(AIndex: Integer): TfpgRect; + function ItemIndexFromY(Y: Integer): Integer; + function HeaderHeight: Integer; + procedure DoRepaint; + procedure DoColumnClick(Column: TfpgLVColumn; Button: Integer); + procedure HandleHeaderMouseMove(x, y: Integer; btnstate: word; Shiftstate: TShiftState); + protected + procedure MsgPaint(var msg: TfpgMessageRec); message FPGM_PAINT; + procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override; + procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; + procedure HandleRMouseDown(x, y: integer; shiftstate: TShiftState); override; + procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override; + procedure HandleRMouseUp(x, y: integer; shiftstate: TShiftState); override; + procedure HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override; + procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; + procedure HandleKeyRelease(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; + procedure HandlePaint; override; + procedure HandleResize(awidth, aheight: TfpgCoord); override; + procedure PaintHeaders; virtual; + procedure PaintItems; virtual; + procedure UpdateScrollBarPositions; virtual; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + function GetClientRect: TfpgRect; override; + procedure BeginUpdate; + procedure EndUpdate; + procedure MakeItemVisible(AIndex: Integer; PartialOK: Boolean = False); + function ItemAdd: TfpgLVItem; + published + property Columns: TfpgLVColumns read FColumns; + property HScrollBar: TfpgScrollBar read FHScrollBar; + property ItemHeight: Integer read GetItemHeight; + property ItemIndex: Integer read FItemIndex write SetItemIndex; + property Items: TfpgLVItems read FItems write SetItems; + property MultiSelect: Boolean read FMultiSelect write SetMultiSelect; + property ParentShowHint; + property SelectionFollowsFocus: Boolean read FSelectionFollowsFocus write FSelectionFollowsFocus; + property ShowHeaders: Boolean read FShowHeaders write SetShowHeaders; + property ShowHint; + property TabOrder; + property VScrollBar: TfpgScrollBar read FVScrollBar; + property OnColumnClick: TfpgLVColumnClickEvent read FOnColumnClick write SetOnColumnClick; + property OnPaintColumn: TfpgLVPaintColumnEvent read FOnPaintColumn write FOnPaintColumn; + property OnPaintItem: TfpgLVPaintItemEvent read FOnPaintItem write FOnPaintItem; + property OnSelectionChanged: TfpgLVItemSelectEvent read FOnSelectionChanged write FOnSelectionChanged; + end; + + +implementation + +uses + fpg_constants; + + +type + // used to access protected methods + TfpgScrollbarFriend = class(TfpgScrollbar) + end; + +{ TfpgLVItems } + +function Min(AInt, BInt: Integer): Integer; +begin + if AInt < Bint then + Result := AInt + else Result := BInt; +end; + +function Max(AInt, BInt: Integer): INteger; +begin + if AInt > Bint then + Result := AInt + else Result := BInt; +end; + +function TfpgLVItems.GetItem(AIndex: Integer): TfpgLVItem; +begin + Result := TfpgLVItem(FItems.Items[AIndex]); +end; + +function TfpgLVItems.GetCapacity: Integer; +begin + Result := FItems.Capacity; +end; + +procedure TfpgLVItems.SetCapacity(const AValue: Integer); +begin + FItems.Capacity := AValue; +end; + +procedure TfpgLVItems.SetItem(AIndex: Integer; const AValue: TfpgLVItem); +begin + FItems.Items[AIndex] := AValue; +end; + +procedure TfpgLVItems.AddViewer(AValue: IfpgLVItemViewer); +begin + if AValue <> nil then + FViewers.Add(AValue); +end; + +procedure TfpgLVItems.DeleteViewer(AValue: IfpgLVItemViewer); +var + AIndex: Integer; +begin + AIndex := FViewers.IndexOf(AValue); + if AIndex > -1 then + begin + FViewers.Delete(AIndex); + end; + if FViewers.Count = 0 then + Free; +end; + +procedure TfpgLVItems.DoChange(AItem: TfpgLVItem); +var + I: Integer; + AIndex: Integer; +begin + if FUpdateCount > 0 then + Exit; + AIndex := IndexOf(AItem); + for I := 0 to FViewers.Count -1 do + begin + IfpgLVItemViewer(FViewers.Items[I]).ItemChanged(AIndex); + end; +end; + +procedure TfpgLVItems.DoAdd(AItem: TfpgLVItem); +var + I: Integer; + AIndex: Integer; +begin + if FUpdateCount > 0 then + Exit; + AIndex := IndexOf(AItem); + for I := 0 to FViewers.Count -1 do + begin + IfpgLVItemViewer(FViewers.Items[I]).ItemAdded(AIndex); + end; +end; + +procedure TfpgLVItems.DoDelete(AItem: TfpgLVItem); +var + I: Integer; + AIndex: Integer; +begin + if FUpdateCount > 0 then + Exit; + AIndex := IndexOf(AItem); + for I := 0 to FViewers.Count -1 do + begin + IfpgLVItemViewer(FViewers.Items[I]).ItemDeleted(AIndex); + end; +end; + +procedure TfpgLVItems.DoEndUpdate; +var + I: Integer; +begin + if FUpdateCount > 0 then + Exit; + for I := 0 to FViewers.Count -1 do + begin + IfpgLVItemViewer(FViewers.Items[I]).ItemsUpdated; + end; +end; + +constructor TfpgLVItems.Create(AViewer: IfpgLVItemViewer); +begin + FItems := TList.Create; + FViewers := TList.Create; + AddViewer(AViewer); +end; + +destructor TfpgLVItems.Destroy; +begin + FItems.Free; + FViewers.Free; + inherited Destroy; +end; + +function TfpgLVItems.Add(AItem: TfpgLVItem): Integer; +begin + Result := Count; + InsertItem(AItem, Count); + DoAdd(AItem); +end; + +function TfpgLVItems.Count: Integer; +begin + Result := FItems.Count; +end; + +procedure TfpgLVItems.Clear; +var + i: integer; +begin + for i := FItems.Count-1 downto 0 do + Delete(i); + FItems.Clear; +end; + +procedure TfpgLVItems.Delete(AIndex: Integer); +begin + DoDelete(GetItem(AIndex)); + FItems.Delete(AIndex); +end; + +function TfpgLVItems.IndexOf(AItem: TfpgLVItem): Integer; +begin + Result := -1; + // this checks for a index close to the old one whic can speed up + // search significantly when we are using indexof in a for loop + if (FCurrentIndexOf > 100) and (FCurrentIndexOf < Count-2) then + begin + if FItems.Items[FCurrentIndexOf] = Pointer(AItem) then + Result := FCurrentIndexOf + else if FItems.Items[FCurrentIndexOf+1] = Pointer(AItem) then + Result := FCurrentIndexOf+1 + else if FItems.Items[FCurrentIndexOf-1] = Pointer(AItem) then + Result := FCurrentIndexOf-1 + end; + if Result = -1 then + Result := FItems.IndexOf(AItem); + FCurrentIndexOf := Result; +end; + +procedure TfpgLVItems.InsertItem(AItem: TfpgLVItem; AIndex: Integer); +begin + if AItem.InheritsFrom(TfpgLVItem) then + FItems.Insert(AIndex, AItem) + else + raise Exception.CreateFmt(rsErrItemOfWrongType, ['TfpgLVItem']); +end; + +procedure TfpgLVItems.BeginUpdate; +begin + Inc(FUpdateCount); +end; + +procedure TfpgLVItems.EndUpdate; +begin + Dec(FUpdateCount); + if FUpdateCount < 0 then + FUpdateCount := 0; + if FUpdateCount = 0 then + DoEndUpdate; +end; + +{ TfpgLVItem } + +procedure TfpgLVItem.SetCaption(const AValue: String); +begin + if FCaption=AValue then + Exit; + FCaption:=AValue; + if Assigned(FItems) then + FItems.DoChange(Self); +end; + +function TfpgLVItem.GetSelected(ListView: TfpgListView): Boolean; +begin + Result := ListView.ItemGetSelected(Self); +end; + +procedure TfpgLVItem.SetSelected(ListView: TfpgListView; const AValue: Boolean); +begin + ListView.ItemSetSelected(Self, AValue); +end; + +procedure TfpgLVItem.SubItemsChanged(Sender: TObject); +begin + if Assigned(FItems) then + FItems.DoChange(Self); +end; + +constructor TfpgLVItem.Create(Items: TfpgLVItems); +begin + FItems := Items; + FSubItems := TStringList.Create; + TStringList(FSubItems).OnChange := @SubItemsChanged; +end; + +destructor TfpgLVItem.Destroy; +begin + FSubItems.Free; + inherited Destroy; +end; + +{ TfpgListView } + + +procedure TfpgListView.SetShowHeaders(const AValue: Boolean); +begin + if FShowHeaders=AValue then + Exit; + FShowHeaders:=AValue; + DoRePaint; +end; + + +procedure TfpgListView.VScrollChange(Sender: TObject; Position: Integer); +begin + DoRepaint; +end; + +procedure TfpgListView.HScrollChange(Sender: TObject; Position: Integer); +begin + DoRepaint; +end; + +procedure TfpgListView.SetItems(const AValue: TfpgLVItems); +begin + if AValue = FItems then + Exit; + AValue.AddViewer(Self); + FItems.DeleteViewer(Self); + Fitems := AValue; +end; + +procedure TfpgListView.SetMultiSelect(const AValue: Boolean); +begin + if FMultiSelect=AValue then + Exit; + FMultiSelect:=AValue; +end; + +procedure TfpgListView.SetOnColumnClick(const AValue: TfpgLVColumnClickEvent); +begin + if FOnColumnClick=AValue then + Exit; + FOnColumnClick:=AValue; +end; + +function TfpgListView.GetItemHeight: Integer; +begin + Result := Canvas.Font.Height + 4; +end; + +procedure TfpgListView.SetItemIndex(const AValue: Integer); +begin + if FItemIndex=AValue then + Exit; + if (AValue >= -1) and (AValue < FItems.Count) then + FItemIndex:=AValue; +end; + +procedure TfpgListView.ItemDeleted(AIndex: Integer); +begin + if FUpdateCount = 0 then + DoRePaint; +end; + +procedure TfpgListView.ItemAdded(AIndex: Integer); +begin + if FUpdateCount = 0 then + DoRePaint; +end; + +procedure TfpgListView.ItemChanged(AIndex: Integer); +begin + if FUpdateCount = 0 then + DoRePaint; +end; + +procedure TfpgListView.ItemsUpdated; +begin + DoRepaint; +end; + +function TfpgListView.GetClientRect: TfpgRect; +begin + Result.Top := 2; + Result.Left := 2; + Result.SetRight(Width - 2); + Result.SetBottom(Height - 2); +end; + +function TfpgListView.GetVisibleColumnsWidth: Integer; +var + I: Integer; +begin + Result := 0; + for I := 0 to FColumns.Count-1 do + if FColumns.Column[I].Visible then + Inc(Result, FColumns.Column[I].Width); +end; + +function TfpgListView.GetItemAreaHeight: Integer; +begin + Result := Height - 4; + if ShowHeaders then + Dec(Result, HeaderHeight); + if FHScrollBar.Visible then + Dec(Result,FHScrollBar.Height); +end; + +procedure TfpgListView.StartShiftSelection; +var + I: Integer; +begin + Inc(FShiftCount); + if FItems.Count = 0 then + Exit; + if FShiftCount> 1 then + Exit; + FSelectionShiftStart := FItemIndex; + if FSelectionShiftStart = -1 then + Inc(FSelectionShiftStart); + FOldSelected.Clear; + FOldSelected.Capacity := FSelected.Capacity; + for I := 0 to FSelected.Count-1 do + begin + FOldSelected.Add(FSelected.Items[I]); + end; +end; + +procedure TfpgListView.EndShiftSelection; +begin + Dec(FShiftCount); + if FShiftCount > 0 then + Exit; + FSelectionShiftStart := -1; + FOldSelected.Clear; +end; + +procedure TfpgListView.SelectionSetRangeEnabled(AStart, AEnd: Integer; AValue: Boolean); +var + TmpI: LongInt; + I: LongInt; + ShouldShow: Boolean; +begin + if AStart > AEnd then + begin + TmpI := AStart; + AStart := AEnd; + AEnd := TmpI; + end; + FSelected.Clear; + FSelected.Capacity := FOldSelected.Capacity; + for I := 0 to FOldSelected.Count-1 do + begin + FSelected.Add(FOldSelected.Items[I]); + end; + if (AStart < 0) or (AEnd > FItems.Count-1) then + Exit; + for I := AStart to AEnd do + begin + ShouldShow := AValue; + if FOldSelected.IndexOf(FItems.Item[I]) > -1 then + ShouldShow := not AValue; + + if I <> FSelectionShiftStart then + ItemSetSelected(FItems.Item[I], ShouldShow); + end; +end; + +procedure TfpgListView.SelectionToggleRange(AStart, AEnd: Integer; + const ShiftState: TShiftState; IgnoreStartIndex: Boolean); +var + TmpI: Integer; + I: LongInt; +begin + TmpI := AStart; + if AStart > AEnd then + begin + AStart := AEnd; + AEnd := TmpI; + end; + if not FMultiSelect then + begin + SelectionClear; + ItemSetSelected(FItems.Item[TmpI], True); + Exit; + end; + if ssShift in ShiftState then + for I := AStart to AEnd do + begin + if not(IgnoreStartIndex and (I = TmpI)) + then ItemSetSelected(FItems.Item[I], not ItemGetSelected(FItems.Item[I])); + end; +end; + +procedure TfpgListView.SelectionClear; +var + Item: TfpgLVItem; + I: Integer; +begin + for I := FSelected.Count-1 downto 0 do + begin + Item := TfpgLVItem(FSelected.Items[I]); + FSelected.Delete(I); + if Assigned(FOnSelectionChanged) then + FOnSelectionChanged(Self, Item, Items.IndexOf(Item), False); + end; + +end; + + +function TfpgListView.ItemGetSelected(const AItem: TfpgLVItem): Boolean; +begin + Result := FSelected.IndexOf(AItem) > -1; +end; + +procedure TfpgListView.ItemSetSelected(const AItem: TfpgLVItem; const AValue: Boolean); +var + Index: Integer; +begin + Index := FSelected.IndexOf(AItem); + + if AValue and (Index = -1) then + FSelected.Add(AItem); + if (AValue = False) and (Index <> -1) then + FSelected.Delete(Index); + if Assigned(FOnSelectionChanged) then + FOnSelectionChanged(Self, AItem, Items.IndexOf(AItem), AValue); +end; + +function TfpgListView.ItemGetFromPoint(const X, Y: Integer): TfpgLVItem; +var + Index: Integer; + ItemTop: Integer; +begin + Result := nil; + ItemTop := (FVScrollBar.Position + Y) -2; + if ShowHeaders then + Dec(ItemTop, HeaderHeight); + Index := ItemTop div ItemHeight; + if Index < 0 then + Exit; + if Index >= FItems.Count then + Exit; + if FHScrollBar.Position - 2 + X > GetVisibleColumnsWidth then + Exit; + + Result := FItems.Item[Index]; +end; + +function TfpgListView.ItemGetRect(AIndex: Integer): TfpgRect; +begin + Result.Top := 2 + (AIndex * ItemHeight) - FVScrollBar.Position; + if ShowHeaders then + Inc(Result.Top, HeaderHeight); + Result.Height := ItemHeight; + Result.Left := 2 - FHScrollBar.Position; + Result.Width := GetVisibleColumnsWidth; +end; + +function TfpgListView.ItemIndexFromY(Y: Integer): Integer; +var + TopPos: Integer; +begin + if ShowHeaders and (Y < HeaderHeight) then + Exit(-1); + + TopPos := (FVScrollBar.Position + Y) - 2; + if ShowHeaders then + Dec(TopPos, HeaderHeight); + Result := TopPos div ItemHeight; + if Result > Fitems.Count-1 then + Result := -1; +end; + +function TfpgListView.HeaderHeight: Integer; +begin + Result := Canvas.Font.Height + 10; +end; + +procedure TfpgListView.DoRepaint; +begin + if FUpdateCount = 0 then + RePaint; +end; + +procedure TfpgListView.DoColumnClick(Column: TfpgLVColumn; Button: Integer); +begin + if not Column.Clickable then + Exit; + if Assigned(FOnColumnClick) then + FOnColumnClick(Self, Column, Button); + + Column.FDown := True; + + if FUpdateCount = 0 then + begin + Canvas.BeginDraw(False); + PaintHeaders; + Canvas.EndDraw;//(2,2, width-4, Height-4); + end; +end; + +procedure TfpgListView.HandleHeaderMouseMove(x, y: Integer; btnstate: word; + Shiftstate: TShiftState); +var + I: Integer; + curLeft: Integer; + curRight: Integer; + Column: TfpgLVColumn; + LastColumn: TfpgLVColumn; + HeaderX: Integer; // this is X from the headers point of view + NewMouseCursor: TMouseCursor; +begin + curLeft := 0; + + HeaderX := FHScrollBar.Position - 2 + X; + NewMouseCursor := MouseCursor; + LastColumn := nil; + for I := 0 to FColumns.Count-1 do + begin + Column := FColumns.Column[I]; + if not Column.Visible then + Continue; + curRight := curLeft + Column.Width-1; + if Column.Resizable or (Assigned(LastColumn) and LastColumn.Resizable) then + begin + if (FResizingColumn <> nil) and (FResizingColumn = Column) then + begin + FResizingColumn.Width := (x + FHScrollBar.Position)- curLeft; + DoRepaint; + Break; + end + else begin + if (HeaderX >= curLeft) and (HeaderX <= curRight) then // we are within this columns space + begin + if ((LastColumn <> nil) and (LastColumn.Resizable) and (HeaderX - curLeft < 5)) + or (Column.Resizable) and (curRight - HeaderX < 5) + then + begin + NewMouseCursor := mcSizeEW; + Break; + end; + end + else + NewMouseCursor := mcDefault; + end; + end; + LastColumn := Column; + Inc(curLeft, Column.Width); + end; + if not Assigned(FResizingColumn) and Assigned(LastColumn) and LastColumn.Resizable then + if (HeaderX - curLeft < 5) and (HeaderX - curLeft >= 0) then + NewMouseCursor := mcSizeEW; + + if FResizingColumn <> nil then + NewMouseCursor := mcSizeEW; + + if NewMouseCursor <> MouseCursor then + MouseCursor := NewMouseCursor; + +end; + +procedure TfpgListView.MsgPaint(var msg: TfpgMessageRec); +begin + // Optimises painting and prevents Begin[End]Draw and OnPaint event firing + // in not needed. + if FUpdateCount = 0 then + inherited MsgPaint(msg); +end; + +procedure TfpgListView.HandleMouseScroll(x, y: integer; + shiftstate: TShiftState; delta: smallint); +var + cRect: TfpgRect; +begin + cRect := GetClientRect; + if FShowHeaders then + Inc(cRect.Top, HeaderHeight); + if FHScrollBar.Visible then + Dec(cRect.Height, FHScrollBar.Height); + if FVScrollBar.Visible then + Dec(cRect.Width, FVScrollBar.Width); + + + if not PtInRect(cRect, Point(X,Y)) then + Exit; + + TfpgScrollbarFriend(FVScrollBar).HandleMouseScroll(x, y, shiftstate, delta); +end; + +procedure TfpgListView.HandleLMouseDown(x, y: integer; shiftstate: TShiftState); +var + Item: TfpgLVItem; + cRect: TfpgRect; + curLeft, curRight: Integer; + I: Integer; + Column: TfpgLVColumn; + LastColumn: TfpgLVColumn; + HeaderX: Integer; +begin + inherited HandleLMouseDown(x, y, shiftstate); + + cRect := GetClientRect; + + FMouseDownPoint := Point(X,Y); + + if not PtInRect(cRect, Point(X,Y)) then + Exit; + + if FShowHeaders then + begin + if (Y < HeaderHeight + cRect.Top) then + begin + LastColumn := nil; + HeaderX := FHScrollBar.Position - 2 + x; + + curLeft := 0; + for I := 0 to FColumns.Count-1 do + begin + Column := FColumns.Column[I]; + if Column.Visible then + begin + curRight := curLeft + Column.Width-1; + if (HeaderX <= curRight) and (HeaderX >= curLeft) then + begin + if (MouseCursor = mcSizeEW) then + begin + if Column.Resizable and (curRight - HeaderX < 5) then + FResizingColumn := Column + else + if Assigned(LastColumn) and LastColumn.Resizable and (HeaderX - curLeft < 5) then + FResizingColumn := LastColumn + end + else // only perform a mouse click if we aren't resizing + DoColumnClick(Column, 1); + end; + Inc(curLeft, Column.Width); + end; + LastColumn := Column; + end; + if not Assigned(FResizingColumn) and Assigned(LastColumn) and LastColumn.Resizable then + if (HeaderX - curLeft < 5) and (HeaderX - curLeft >= 0) then + FResizingColumn := LastColumn; + end; + + Inc(cRect.Top, HeaderHeight); + end; + + if FHScrollBar.Visible then + Dec(cRect.Height, FHScrollBar.Height); + if FVScrollBar.Visible then + Dec(cRect.Width, FVScrollBar.Width); + + if not PtInRect(cRect, Point(X,Y)) then + Exit; + + Item := ItemGetFromPoint(X, Y); + if not FMultiSelect then + SelectionClear; + if Item <> nil then + begin + FItemIndex := ItemIndexFromY(Y); + MakeItemVisible(FItemIndex); + if FMultiSelect then + begin + if not ((ssCtrl in shiftstate) or (ssShift in shiftstate)) then + begin + SelectionClear; + ItemSetSelected(Item, True); + end + else begin + if ssCtrl in shiftstate then + ItemSetSelected(Item, not ItemGetSelected(Item)); + if ssShift in shiftstate then + SelectionSetRangeEnabled(FSelectionShiftStart, FItemIndex, True); + end + end + else ItemSetSelected(Item, True); + end; + DoRepaint; +end; + +procedure TfpgListView.HandleRMouseDown(x, y: integer; shiftstate: TShiftState); +var + I: Integer; + cLeft, cRight: Integer; + cRect: TfpgRect; + Column: TfpgLVColumn; +begin + inherited HandleRMouseDown(x, y, shiftstate); + + cRect := GetClientRect; + + if not PtInRect(cRect, Point(X,Y)) then + Exit; + + if FShowHeaders then + begin + if (Y < HeaderHeight + cRect.Top) then + begin + cLeft := cRect.Left - FHScrollBar.Position; + for I := 0 to FColumns.Count-1 do + begin + Column := FColumns.Column[I]; + if Column.Visible then + begin + cRight := cLeft + Column.Width-1; + if (X <= cRight) and (X >= cLeft) then + DoColumnClick(Column, 3); + Inc(cLeft, Column.Width); + end; + end; + end; + Inc(cRect.Top, HeaderHeight); + end; + + if FVScrollBar.Visible then + Dec(cRect.Width, FVScrollBar.Width); + if FHScrollBar.Visible then + Dec(cRect.Height, FHScrollBar.Height); +end; + +procedure TfpgListView.HandleLMouseUp(x, y: integer; shiftstate: TShiftState); +var + I: Integer; +begin + inherited HandleLMouseUp(x, y, shiftstate); + for I := 0 to FColumns.Count-1 do + begin + FColumns.Column[I].FDown := False; + end; + + FResizingColumn := nil; + DoRepaint; +end; + +procedure TfpgListView.HandleRMouseUp(x, y: integer; shiftstate: TShiftState); +var + I: Integer; +begin + inherited HandleRMouseUp(x, y, shiftstate); + for I := 0 to FColumns.Count-1 do + begin + FColumns.Column[I].FDown := False; + end; + DoRepaint; +end; + +procedure TfpgListView.HandleMouseMove(x, y: integer; btnstate: word; + shiftstate: TShiftState); +var + cRect: TfpgRect; +begin + inherited HandleMouseMove(x, y, btnstate, shiftstate); + + cRect := GetClientRect; + + if not PtInRect(cRect, Point(X,Y)) and (FResizingColumn = nil) then + Exit; + + if ((Y < (cRect.Top + HeaderHeight)) and ShowHeaders) or (FResizingColumn <> nil) then + begin + HandleHeaderMouseMove(x, y, btnstate, shiftstate); + end + else + if (MouseCursor <> mcDefault) and (FResizingColumn = nil) then + MouseCursor := mcDefault; + + //if FVScrollBar.Visible then Dec(cRect.Width, FVScrollBar.Width); + //if FHScrollBar.Visible then Dec(cRect.Height, FHScrollBar.Height); +end; + +procedure TfpgListView.HandleKeyPress(var keycode: word; + var shiftstate: TShiftState; var consumed: boolean); +var + iIndex: Integer; + OldIndex: Integer; + procedure CheckMultiSelect; + begin + if FMultiSelect then begin + if (ssShift in shiftstate) or (FSelectionShiftStart > -1) then + begin + SelectionSetRangeEnabled(FSelectionShiftStart, FItemIndex, True); + end + else if ssCtrl in shiftstate then + begin + SelectionToggleRange(FItemIndex, FItemIndex, shiftstate, False); + end; + end; + end; + procedure CheckSelectionFocus; + begin + if ((ssShift in shiftstate) or (ssCtrl in shiftstate)) then + Exit; + SelectionClear; + if FSelectionFollowsFocus and (FItemIndex > -1) then + ItemSetSelected(FItems.Item[FItemIndex], True); + end; +begin + consumed := True; + OldIndex := FItemIndex; + //WriteLn('Got key: ',IntToHex(keycode, 4)); + case keycode of + keyShift, keyShiftR: + begin + if FMultiSelect then + StartShiftSelection; + end; + keyUp: + begin + if ItemIndex > 0 then + ItemIndex := ItemIndex-1; + MakeItemVisible(ItemIndex); + if OldIndex <> ItemIndex then + CheckSelectionFocus; + CheckMultiSelect; + end; + keyDown: + begin + ItemIndex := ItemIndex+1; + MakeItemVisible(ItemIndex); + if OldIndex <> ItemIndex then + CheckSelectionFocus; + CheckMultiSelect; + end; + keyLeft: + begin + FHScrollBar.Position := FHScrollBar.Position - FHScrollBar.ScrollStep; + end; + keyRight: + begin + FHScrollBar.Position := FHScrollBar.Position + FHScrollBar.ScrollStep; + end; + keyHome: + begin + ItemIndex := 0; + MakeItemVisible(ItemIndex); + if OldIndex <> ItemIndex then + CheckSelectionFocus; + CheckMultiSelect; + end; + keyEnd: + begin + ItemIndex := FItems.Count-1; + MakeItemVisible(ItemIndex); + if OldIndex <> ItemIndex then + CheckSelectionFocus; + CheckMultiSelect; + end; + keyPageUp: + begin + iIndex := ItemIndex - (GetItemAreaHeight div ItemHeight); + if iIndex < 0 then + iIndex := 0; + ItemIndex := iIndex; + MakeItemVisible(ItemIndex); + if OldIndex <> ItemIndex then + CheckSelectionFocus; + CheckMultiSelect; + end; + keyPageDown: + begin + iIndex := ItemIndex + (GetItemAreaHeight div ItemHeight); + if iIndex > FItems.Count-1 then + iIndex := FItems.Count-1; + ItemIndex := iIndex; + MakeItemVisible(ItemIndex); + if OldIndex <> ItemIndex then + CheckSelectionFocus; + CheckMultiSelect + end; + else + consumed := False; + inherited HandleKeyPress(keycode, shiftstate, consumed); + Exit; + end; + DoRepaint; + +end; + +procedure TfpgListView.HandleKeyRelease(var keycode: word; + var shiftstate: TShiftState; var consumed: boolean); +begin + consumed := True; + case keycode of + keyShift, keyShiftR: + begin + EndShiftSelection; + end; + else + consumed := False; + inherited HandleKeyRelease(keycode, shiftstate, consumed); + end; + +end; + +procedure TfpgListView.HandlePaint; +var + ClipRect: TfpgRect; +begin + //if FScrollBarNeedsUpdate then + UpdateScrollBarPositions; + fpgStyle.DrawControlFrame(Canvas, 0, 0, Width, Height); + + ClipRect.Top := 2; + ClipRect.Left := 2; + ClipRect.Width := Width -4; + ClipRect.Height := Height -4; + + if ShowHeaders then + begin + PaintHeaders; + Inc(ClipRect.Top, HeaderHeight); + Dec(ClipRect.Height, HeaderHeight); + end; + + Canvas.SetClipRect(ClipRect); + + // this paints the small square remaining below the vscrollbar and to the right of the hscrollbar + if FVScrollBar.Visible and FHScrollBar.Visible then + begin + Canvas.Color := clButtonFace; + Canvas.FillRectangle(Width - 2 - FVScrollBar.Width, + Height - 2 - FHScrollBar.Height, + Width - 2, + Height - 2); + end; + + if FVScrollBar.Visible then + Dec(ClipRect.Width, FVScrollBar.Width); + if FHScrollBar.Visible then + Dec(ClipRect.Height, FhScrollBar.Height); + + Canvas.SetClipRect(ClipRect); + PaintItems; +end; + +procedure TfpgListView.HandleResize(awidth, aheight: TfpgCoord); +begin + inherited HandleResize(awidth, aheight); + FScrollBarNeedsUpdate := FScrollBarNeedsUpdate or FSizeIsDirty; +end; + +procedure TfpgListView.PaintHeaders; +var + I: Integer; + cLeft, + cTop: Integer; + Column: TfpgLVColumn; + Flags: TFButtonFlags; + ClipRect: TfpgRect; + cRect: TfpgRect; + PaintPart: TfpgLVItemPaintPart; + tWidth, + tLeft: Integer; +begin + cLeft := 2; + ClipRect.Top := 2; + ClipRect.Left := 2; + ClipRect.Height := HeaderHeight; + ClipRect.Width := Width -4; + Canvas.SetClipRect(ClipRect); + + if FHScrollBar.Visible then Dec(cLeft, FHScrollBar.Position); + cTop := 2; + for I := 0 to Columns.Count-1 do + begin + Column := Columns.Column[I]; + if Column.Visible then + begin + Flags := [btfIsEmbedded]; + if Column.FDown then Flags := Flags + [btfIsPressed]; + cRect.Top := cTop; + cRect.Left := cLeft; + cRect.Width := Column.Width; + cRect.Height := HeaderHeight; + fpgStyle.DrawButtonFace(Canvas,cLeft, cRect.Top, cRect.Width, cRect.Height, Flags); + PaintPart := [lvppText]; + + if Assigned(FOnPaintColumn) then + FOnPaintColumn(Self, Canvas, Column, I, cRect, PaintPart); + + if lvppText in PaintPart then + begin + tLeft := cLeft; + tWidth := Canvas.Font.TextWidth(Column.Caption); + case Column.CaptionAlignment of + taRightJustify: Inc(tLeft, Column.Width - tWidth - 5); + taCenter: Inc(tLeft, (Column.Width - tWidth - 5) div 2); + taLeftJustify: Inc(tLeft, 5); + end; + fpgStyle.DrawString(Canvas, tLeft, cTop+5, Column.Caption, Enabled); + end; + Inc(cLeft, Column.Width); + end; + end; + if cLeft < FWidth-2 then + begin + Canvas.SetColor(clButtonFace); + Canvas.FillRectangle(cLeft, cTop, cLeft+(Width-3-cLeft), Canvas.Font.Height+10); + end; +end; + +procedure TfpgListView.PaintItems; +var + FirstIndex, + LastIndex: Integer; + I, J : Integer; + PaintPart: TfpgLVItemPaintPart; + ItemRect: TfpgRect; + ItemState: TfpgLVItemState; + Item: TfpgLVItem; + TheText: String; + TheTextColor: TfpgColor; + oClipRect: TfpgRect; + iColumnClipRect: TfpgRect; + ColumnIndex: Integer; + cBottom: Integer; + vBottom: Integer; + tLeft, + tWidth: Integer; +begin + FirstIndex := (FVScrollBar.Position) div ItemHeight; + LastIndex := (FVScrollBar.Position+GetItemAreaHeight) div ItemHeight; + + if LastIndex > FItems.Count-1 then + LastIndex := FItems.Count-1; + + cBottom := 2 + ((LastIndex+1 - FirstIndex) * ItemHeight); + + if ShowHeaders then + Inc(cBottom, HeaderHeight); + + oClipRect := Canvas.GetClipRect; + + for I := FirstIndex to LastIndex do + begin + ItemState := []; + PaintPart := [lvppBackground, lvppIcon, lvppText]; + ItemRect := ItemGetRect(I); + + if (I = FirstIndex) + and (ShowHeaders) + and (ItemRect.Top < 2 + HeaderHeight) then + Dec(cBottom, (2 + HeaderHeight) - ItemRect.Top); + + Item := FItems.Item[I]; + if Item.Selected[Self] then + Include(ItemState, lisSelected); + if FItemIndex = I then + begin + Include(ItemState, lisFocused); + Include(PaintPart, lvppFocused); + end; + + if lisSelected in (ItemState) then + begin + if Focused then + Canvas.Color := clSelection + else + Canvas.Color := clInactiveSel; + end + else Canvas.Color := clListBox; + + Canvas.FillRectangle(ItemRect); + Exclude(PaintPart, lvppBackground); + TheTextColor := Canvas.TextColor; + if Assigned(FOnPaintItem) then + FOnPaintItem(Self, Canvas, Item, I, ItemRect, PaintPart); + + if lvppIcon in PaintPart then + begin + { TODO: paint icon } + end; + + if lvppFocused in PaintPart then + begin + Canvas.Color := clBlack; + Canvas.SetLineStyle(1, lsDot); + Canvas.DrawRectangle(ItemRect); + end; + + if lvppText in PaintPart then + begin + if lisSelected in ItemState then + Canvas.TextColor := clSelectionText; + for J := 0 to FColumns.Count-1 do + begin + if FColumns.Column[J].Visible then + begin + iColumnClipRect.Left := Max(ItemRect.Left, oClipRect.Left); + iColumnClipRect.Top := Max(ItemRect.Top, oClipRect.Top); + iColumnClipRect.SetRight(Min(ItemRect.Left+FColumns.Column[J].Width, oClipRect.Right)); + iColumnClipRect.SetBottom(Min(ItemRect.Bottom, oClipRect.Bottom)); + Canvas.SetClipRect(iColumnClipRect); + if FColumns.Column[J].ColumnIndex <> -1 then + ColumnIndex := FColumns.Column[J].ColumnIndex + else + ColumnIndex := J; + if ColumnIndex = 0 then + TheText := Item.Caption + else if Item.SubItems.Count >= ColumnIndex then + TheText := Item.SubItems.Strings[ColumnIndex-1] + else + TheText := ''; + + tLeft := ItemRect.Left; + tWidth := Canvas.Font.TextWidth(TheText); + case FColumns.Column[J].Alignment of + taRightJustify: Inc(tLeft, FColumns.Column[J].Width - tWidth - 5); + taCenter: Inc(tLeft, (FColumns.Column[J].Width - tWidth - 5) div 2); + taLeftJustify: Inc(tLeft, 5); + end; + + fpgStyle.DrawString(Canvas, tLeft, ItemRect.Top+2, TheText, Enabled); + Inc(ItemRect.Left, FColumns.Column[J].Width); + //WriteLn(ItemRect.Left,' ', ItemRect.Top, ' ', ItemRect.Right, ' ', ItemRect.Bottom); + end; + end; + end; + + Canvas.SetClipRect(oClipRect); + + Canvas.TextColor := TheTextColor; + end; + + vBottom := Height - 2; + if FHScrollBar.Visible then + Dec(vBottom, FHScrollBar.Height); + + // the painted items haven't fully covered the visible area + if vBottom > cBottom then begin + ItemRect.Left := 2; + ItemRect.Top := cBottom; + ItemRect.SetBottom(vBottom); + ItemRect.Width := Width - 4; + Canvas.SetColor(clListBox); + Canvas.FillRectangle(ItemRect); + end; + if GetVisibleColumnsWidth < oClipRect.Width then + begin + ItemRect.Left := GetVisibleColumnsWidth+2; + ItemRect.SetRight(oClipRect.Right); + ItemRect.Top := oClipRect.Top; + ItemRect.Height := oClipRect.Height; + Canvas.SetColor(clListBox); + Canvas.FillRectangle(ItemRect); + end; +end; + +procedure TfpgListView.UpdateScrollBarPositions; +var + BevelSize: Integer; + I: Integer; + MaxH, + MaxV: Integer; +begin + MaxH := 0; + MaxV := 0; + BevelSize := 2; + + for I := 0 to Columns.Count -1 do + begin + if Columns.Column[I].Visible then + Inc(MaxH, Columns.Column[I].Width); + end; + + MaxV := (FItems.Count+2) * ItemHeight - (Height); + if ShowHeaders then + Inc(MaxV, HeaderHeight); + if FVScrollBar.Visible then + Inc(MaxH, FVScrollBar.Width); + + FHScrollBar.Top := Height - FHScrollBar.Height - (BevelSize ); + FHScrollBar.Left := BevelSize; + FHScrollBar.Width := Width - (BevelSize * 2); + + + FVScrollBar.Top := BevelSize; + FVScrollBar.Left := Width - FVScrollBar.Width - (BevelSize ); + FVScrollBar.Height := Height - FVScrollBar.Top - BevelSize; + + if FVScrollBar.Visible and FHScrollBar.Visible then + begin + FHScrollBar.Width := FHScrollBar.Width - FVScrollBar.Width; + FVScrollBar.Height := FVScrollBar.Height - FHScrollBar.Height; + end; + + FHScrollBar.Max := MaxH-(Width-(BevelSize * 2)); + FVScrollBar.Max := MaxV; + + if FVScrollBar.Max = 0 then + FVScrollBar.SliderSize := 1 + else + begin + if (FVScrollBar.Max + FVScrollBar.Height) > 0 then + FVScrollBar.SliderSize := FVScrollBar.Height / (FVScrollBar.Max + FVScrollBar.Height) + else + FVScrollBar.SliderSize := 0.5; + end; + FVScrollBar.RepaintSlider; + + if FHScrollBar.Max = 0 then + FHScrollBar.SliderSize := 1 + else + begin + if (FHScrollBar.Max + FHScrollBar.Width) > 0 then + FHScrollBar.SliderSize := FHScrollBar.Width / (FHScrollBar.Max + FHScrollBar.Width) + else + FHScrollBar.SliderSize := 0.5; + end; + FHScrollBar.RepaintSlider; + + + if FHScrollBar.Visible then + FHScrollBar.UpdateWindowPosition; + if FVScrollBar.Visible then + FVScrollBar.UpdateWindowPosition; + + FScrollBarNeedsUpdate := False; +end; + +constructor TfpgListView.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FWidth := 120; + FHeight := 80; + Focusable := True; + FShowHeaders := True; + + FVScrollBar := TfpgScrollBar.Create(Self); + FVScrollBar.Orientation := orVertical; + FVScrollBar.OnScroll := @VScrollChange; + FVScrollBar.ScrollStep := 18; + FVScrollBar.Position := 0; + + FHScrollBar := TfpgScrollBar.Create(Self); + FHScrollBar.Orientation := orHorizontal; + FHScrollBar.OnScroll := @HScrollChange; + FHScrollBar.ScrollStep := 18; + FHScrollBar.Position := 0; + + FColumns := TfpgLVColumns.Create(Self); + + FItems := TfpgLVItems.Create(Self); + FSelected := TList.Create; + FOldSelected := TList.Create;; + FSelectionShiftStart := -1; + FSelectionFollowsFocus := True; + FItemIndex := -1; + FScrollBarNeedsUpdate := True; +end; + +destructor TfpgListView.Destroy; +begin + FItems.DeleteViewer(Self); + FSelected.Free; + FOldSelected.Free; + inherited Destroy; +end; + +procedure TfpgListView.BeginUpdate; +begin + Inc(FUpdateCount); + FItems.BeginUpdate; +end; + +procedure TfpgListView.EndUpdate; +begin + FItems.EndUpdate; + Dec(FUpdateCount); + if FUpdateCount < 0 then + FUpdateCount := 0; + if FUpdateCount = 0 then + DoRePaint; +end; + +procedure TfpgListView.MakeItemVisible(AIndex: Integer; PartialOK: Boolean); +var + iTop, + iBottom: integer; + tVisible, bVisible: Boolean; +begin + if AIndex = -1 then + Exit; + iTop := AIndex * ItemHeight; + iBottom := iTop + ItemHeight; + + tVisible := (iTop >= FVScrollBar.Position) and (iTop < FVScrollBar.Position + GetItemAreaHeight); + bVisible := (iBottom >= FVScrollBar.Position) and (iBottom < FVScrollBar.Position + GetItemAreaHeight); + + if PartialOK and (bVisible or tVisible) then + Exit; + + if bVisible and tVisible then + Exit; + + if (iBottom >= FVScrollBar.Position + GetItemAreaHeight) then + FVScrollBar.Position := iBottom - GetItemAreaHeight + else + FVScrollBar.Position := iTop; +end; + +function TfpgListView.ItemAdd: TfpgLVItem; +begin + Result := TfpgLVItem.Create(FItems); + FItems.Add(Result); +end; + +{ TfpgLVColumns } + +function TfpgLVColumns.GetColumn(AIndex: Integer): TfpgLVColumn; +begin + Result := TfpgLVColumn(FColumns.Items[AIndex]); +end; + +procedure TfpgLVColumns.SetColumn(AIndex: Integer; const AValue: TfpgLVColumn); +begin + FColumns.Items[AIndex] := AValue; +end; + +constructor TfpgLVColumns.Create(AListView: TfpgListView); +begin + FListView := AListView; + FColumns := TList.Create; +end; + +destructor TfpgLVColumns.Destroy; +begin + FColumns.Free; + inherited Destroy; +end; + +function TfpgLVColumns.Add(AColumn: TfpgLVColumn): Integer; +begin + Result := Count; + Insert(AColumn, Count); +end; + +procedure TfpgLVColumns.Clear; +var + i: integer; +begin + for i := FColumns.Count-1 downto 0 do + Delete(i); + FColumns.Clear; +end; + +procedure TfpgLVColumns.Delete(AIndex: Integer); +begin + FColumns.Delete(AIndex); +end; + +procedure TfpgLVColumns.Insert(AColumn: TfpgLVColumn; AIndex: Integer); +begin + FColumns.Insert(AIndex, AColumn); +end; + +function TfpgLVColumns.Count: Integer; +begin + Result := FColumns.Count; +end; + +{ TfpgLVColumn } + +procedure TfpgLVColumn.SetCaption(const AValue: String); +begin + if FCaption=AValue then + Exit; + FCaption:=AValue; +end; + +procedure TfpgLVColumn.SetCaptionAlignment(const AValue: TAlignment); +begin + if FCaptionAlignment=AValue then exit; + FCaptionAlignment:=AValue; + if Assigned(FColumns) and Assigned(FColumns.FListView) then + FColumns.FListView.DoRepaint; + +end; + +procedure TfpgLVColumn.SetColumnIndex(const AValue: Integer); +begin + if FColumnIndex=AValue then + Exit; + FColumnIndex:=AValue; +end; + +procedure TfpgLVColumn.SetHeight(const AValue: Integer); +begin + if FHeight=AValue then Exit; + FHeight:=AValue; +end; + +procedure TfpgLVColumn.SetResizable(const AValue: Boolean); +begin + if FResizable=AValue then exit; + FResizable:=AValue; +end; + +procedure TfpgLVColumn.SetVisible(const AValue: Boolean); +begin + if FVisible=AValue then exit; + FVisible:=AValue; +end; + +procedure TfpgLVColumn.SetAutoSize(const AValue: Boolean); +begin + if FAutoSize=AValue then exit; + FAutoSize:=AValue; +end; + +procedure TfpgLVColumn.SetAlignment(const AValue: TAlignment); +begin + if FAlignment=AValue then exit; + FAlignment:=AValue; + if Assigned(FColumns)and Assigned(FColumns.FListView) then + FColumns.FListView.DoRepaint; +end; + +procedure TfpgLVColumn.SetWidth(const AValue: Integer); +begin + if FWidth=AValue then exit; + FWidth:=AValue; + if FWidth < 1 then + FWidth := 1; +end; + +constructor TfpgLVColumn.Create(AColumns: TfpgLVColumns); +begin + FVisible := True; + FColumnIndex := -1; + FColumns := AColumns; + FClickable := True; + FAlignment := taLeftJustify; + FCaptionAlignment := taLeftJustify; +end; + +destructor TfpgLVColumn.Destroy; +begin + inherited Destroy; +end; + +end. |