1 {
2 Copyright (C) Alexey Torgashin, uvviewsoft.com
3 License: MPL 2.0 or LGPL
4 }
5 
6 unit ATListbox;
7 
8 {$ifdef FPC}
9   {$mode delphi}
10 {$endif}
11 
12 interface
13 
14 uses
15   Classes, SysUtils, Graphics, Controls, Forms,
16   {$ifdef FPC}
17   LMessages,
18   {$else}
19   Messages, Windows, System.UITypes,
20   {$endif}
21   StrUtils,
22   ATScrollBar,
23   ATFlatThemes,
24   ATCanvasPrimitives;
25 
26 type
27   TATListboxDrawItemEvent = procedure(Sender: TObject; C: TCanvas; AIndex: integer; const ARect: TRect) of object;
28   TATListboxCalcWidth = function (Sender: TObject; C: TCanvas): integer of object;
29   TATListboxClickHeaderEvent = procedure(Sender: TObject; AColumn: integer) of object;
30 
31 type
32   TATIntArray = array of integer;
33 
34 type
35   TATListboxShowX = (
36     albsxNone,
37     albsxAllItems,
38     albsxHotItem
39     );
40 
41   TATListboxScrollStyle = (
42     alssHide,
43     alssShow,
44     alssAuto
45     );
46 
47 type
48   { TATListboxItemProp }
49 
50   TATListboxItemProp = class
51   public
52     Tag: Int64;
53     Modified: boolean;
54     DataText: string;
55     constructor Create(const ATag: Int64; AModified: boolean; const ADataText: string);
56   end;
57 
58 type
59   { TATListbox }
60 
61   TATListbox = class(TCustomControl)
62   private
63     FTheme: PATFlatTheme;
64     FThemedScrollbar: boolean;
65     FThemedFont: boolean;
66     FScrollbar: TATScrollbar;
67     FScrollbarHorz: TATScrollbar;
68     FScrollStyleHorz: TATListboxScrollStyle;
69     FScrollStyleVert: TATListboxScrollStyle;
70     FOwnerDrawn: boolean;
71     FVirtualMode: boolean;
72     FVirtualItemCount: integer;
73     FItemIndex: integer;
74     FItemHeightPercents: integer;
75     FItemHeight: integer;
76     FItemHeightIsFixed: boolean;
77     FItemTop: integer;
78     FHeaderImages: TImageList;
79     FScrollHorz: integer;
80     FBitmap: Graphics.TBitmap;
81     FBorderVisible: boolean;
82     FCanGetFocus: boolean;
83     FList: TStringList;
84     FHotTrack: boolean;
85     FHotTrackIndex: integer;
86     FIndentLeft: integer;
87     FIndentTop: integer;
88     FIndentForX: integer;
89     FColumnSep: char;
90     FColumnSizes: TATIntArray;
91     FColumnWidths: TATIntArray;
92     FHeaderImageIndexes: TATIntArray;
93     FHeaderText: string;
94     FClientOriginY: integer;
95     FClientWidth: integer;
96     FClientHeight: integer;
97     FShowX: TATListboxShowX;
98     FMaxWidth: integer;
99     FOnDrawItem: TATListboxDrawItemEvent;
100     FOnCalcScrollWidth: TATListboxCalcWidth;
101     FOnClickX: TNotifyEvent;
102     FOnClickHeader: TATListboxClickHeaderEvent;
103     FOnChangeSel: TNotifyEvent;
104     FOnScroll: TNotifyEvent;
105     FShowOsBarVert: boolean;
106     FShowOsBarHorz: boolean;
107     procedure SetShowOsBarVert(AValue: boolean);
108     procedure SetShowOsBarHorz(AValue: boolean);
109     property ShowOsBarVert: boolean read FShowOsBarVert write SetShowOsBarVert;
110     property ShowOsBarHorz: boolean read FShowOsBarHorz write SetShowOsBarHorz;
ShowColumnsnull111     function ShowColumns: boolean;
112     procedure DoDefaultDrawItem(C: TCanvas; AIndex: integer; R: TRect);
113     procedure DoPaintTo(C: TCanvas);
114     procedure DoPaintX(C: TCanvas; const R: TRect; ACircle: boolean);
GetMaxWidthnull115     function GetMaxWidth(C: TCanvas): integer;
GetOnDrawScrollbarnull116     function GetOnDrawScrollbar: TATScrollbarDrawEvent;
ItemBottomnull117     function ItemBottom: integer;
118     procedure ScrollbarChange(Sender: TObject);
119     procedure ScrollbarHorzChange(Sender: TObject);
120     procedure SetCanBeFocused(AValue: boolean);
121     procedure SetItemHeightPercents(AValue: integer);
122     procedure SetOnDrawScrollbar(AValue: TATScrollbarDrawEvent);
123     procedure SetScrollHorz(AValue: integer);
124     procedure SetVirtualItemCount(AValue: integer);
125     procedure SetItemIndex(AValue: integer);
126     procedure SetItemTop(AValue: integer);
127     procedure SetItemHeight(AValue: integer);
128     procedure SetThemedScrollbar(AValue: boolean);
129     procedure UpdateClientSizes;
130     procedure UpdateColumnWidths;
131     procedure UpdateFromScrollbarMsg(const Msg: {$ifdef FPC}TLMScroll{$else}TWMVScroll{$endif});
132     procedure UpdateFromScrollbarHorzMsg(const Msg: {$ifdef FPC}TLMScroll{$else}TWMHScroll{$endif});
133     {$ifndef FPC}
134     procedure CMMouseEnter(var msg: TMessage); message CM_MOUSEENTER;
135     procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
136     procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
137     {$endif}
138     procedure UpdateScrollbars(C: TCanvas);
GetVisibleItemsnull139     function GetVisibleItems: integer;
GetItemHeightDefaultnull140     function GetItemHeightDefault: integer;
GetColumnWidthnull141     function GetColumnWidth(AIndex: integer): integer;
142     procedure DoKeyDown(var Key: Word; Shift: TShiftState);
CurrentFontNamenull143     function CurrentFontName: string;
CurrentFontSizenull144     function CurrentFontSize: integer;
145   protected
146     procedure Paint; override;
147     procedure Click; override;
148     procedure Resize; override;
149     procedure DoExit; override;
150     {$ifdef FPC}
151     procedure LMVScroll(var Msg: TLMVScroll); message LM_VSCROLL;
152     procedure LMHScroll(var Msg: TLMHScroll); message LM_HSCROLL;
153     procedure MouseLeave; override;
154     {$else}
155     procedure WMSize(var Msg: TWMSize); message WM_SIZE;
156     procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
157     procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
158     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
159     procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
160     {$endif}
161     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
162     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
163     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
DoMouseWheelnull164     function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
165       MousePos: TPoint): Boolean; override;
166     procedure ChangedSelection; virtual;
167     procedure Scrolled; virtual;
168     procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); override;
169   public
170     constructor Create(AOwner: TComponent); override;
171     destructor Destroy; override;
172     property Items: TStringList read FList;
173     property ItemIndex: integer read FItemIndex write SetItemIndex;
174     property ItemTop: integer read FItemTop write SetItemTop;
175     property ItemHeight: integer read FItemHeight write SetItemHeight;
176     property ItemHeightDefault: integer read GetItemHeightDefault;
ItemCountnull177     function ItemCount: integer;
IsIndexValidnull178     function IsIndexValid(AValue: integer): boolean;
179     property ClientWidth: integer read FClientWidth write FClientWidth;
180     property ClientHeight: integer read FClientHeight write FClientHeight;
181     property ScrollHorz: integer read FScrollHorz write SetScrollHorz;
182     property HotTrackIndex: integer read FHotTrackIndex;
183     property VirtualItemCount: integer read FVirtualItemCount write SetVirtualItemCount;
184     property VisibleItems: integer read GetVisibleItems;
GetItemIndexAtnull185     function GetItemIndexAt(Pnt: TPoint): integer;
GetColumnIndexAtnull186     function GetColumnIndexAt(Pnt: TPoint): integer;
187     property Theme: PATFlatTheme read FTheme write FTheme;
188     property ThemedScrollbar: boolean read FThemedScrollbar write SetThemedScrollbar;
189     property ThemedFont: boolean read FThemedFont write FThemedFont;
190     property Scrollbar: TATScrollbar read FScrollbar;
191     property ScrollbarHorz: TATScrollbar read FScrollbarHorz;
192     property ColumnSeparator: char read FColumnSep write FColumnSep;
193     property ColumnSizes: TATIntArray read FColumnSizes write FColumnSizes;
194     property ColumnWidth[AIndex: integer]: integer read GetColumnWidth;
195     property HeaderText: string read FHeaderText write FHeaderText;
196     property HeaderImages: TImageList read FHeaderImages write FHeaderImages;
197     property HeaderImageIndexes: TATIntArray read FHeaderImageIndexes write FHeaderImageIndexes;
198     {$ifdef FPC}
CanFocusnull199     function CanFocus: boolean; override;
CanSetFocusnull200     function CanSetFocus: boolean; override;
201     {$endif}
202     procedure Invalidate; override;
203     procedure UpdateItemHeight;
204   published
205     property Align;
206     property Anchors;
207     property BorderVisible: boolean read FBorderVisible write FBorderVisible default false;
208     {$ifdef FPC}
209     property BorderStyle;
210     property BorderSpacing;
211     {$endif}
212     property CanGetFocus: boolean read FCanGetFocus write SetCanBeFocused default false;
213     property DoubleBuffered stored false;
214     property Enabled;
215     property HotTrack: boolean read FHotTrack write FHotTrack default false;
216     property IndentLeft: integer read FIndentLeft write FIndentLeft default 4;
217     property IndentTop: integer read FIndentTop write FIndentTop default 2;
218     property ItemHeightPercents: integer read FItemHeightPercents write SetItemHeightPercents default 100;
219     property OwnerDrawn: boolean read FOwnerDrawn write FOwnerDrawn default false;
220     property ParentColor;
221     property ParentFont;
222     property ParentShowHint;
223     property PopupMenu;
224     property ScrollStyleHorz: TATListboxScrollStyle read FScrollStyleHorz write FScrollStyleHorz default alssAuto;
225     property ScrollStyleVert: TATListboxScrollStyle read FScrollStyleVert write FScrollStyleVert default alssShow;
226     property ShowHint;
227     property ShowXMark: TATListboxShowX read FShowX write FShowX default albsxNone;
228     property VirtualMode: boolean read FVirtualMode write FVirtualMode default true;
229     property Visible;
230     property OnClick;
231     property OnClickXMark: TNotifyEvent read FOnClickX write FOnClickX;
232     property OnClickHeader: TATListboxClickHeaderEvent read FOnClickHeader write FOnClickHeader;
233     property OnDblClick;
234     property OnContextPopup;
235     property OnChangedSel: TNotifyEvent read FOnChangeSel write FOnChangeSel;
236     property OnDrawItem: TATListboxDrawItemEvent read FOnDrawItem write FOnDrawItem;
237     property OnCalcScrollWidth: TATListboxCalcWidth read FOnCalcScrollWidth write FOnCalcScrollWidth;
238     property OnDrawScrollbar: TATScrollbarDrawEvent read GetOnDrawScrollbar write SetOnDrawScrollbar;
239     property OnScroll: TNotifyEvent read FOnScroll write FOnScroll;
240     property OnKeyPress;
241     property OnKeyDown;
242     property OnKeyUp;
243     property OnResize;
244     property OnMouseDown;
245     property OnMouseUp;
246     property OnMouseMove;
247     property OnMouseEnter;
248     property OnMouseLeave;
249     property OnMouseWheel;
250     property OnMouseWheelDown;
251     property OnMouseWheelUp;
252   end;
253 
254 
255 implementation
256 
257 uses
258   {$ifdef FPC}
259   Types,
260   InterfaceBase,
261   LCLType, LCLIntf,
262   {$endif}
263   Math;
264 
265 type
266   TATStringSeparator = record
267   private
268     FSep: char;
269     FStr: string;
270     FPos: integer;
271   public
272     procedure Init(const AStr: string; ASep: char);
GetItemStrnull273     function GetItemStr(out AValue: string): boolean;
274   end;
275 
276 procedure TATStringSeparator.Init(const AStr: string; ASep: char);
277 begin
278   FStr:= AStr;
279   FSep:= ASep;
280   FPos:= 1;
281 end;
282 
GetItemStrnull283 function TATStringSeparator.GetItemStr(out AValue: string): boolean;
284 var
285   N: integer;
286 begin
287   if FPos>Length(FStr) then
288   begin
289     AValue:= '';
290     exit(false);
291   end;
292   N:= PosEx(FSep, FStr, FPos);
293   if N=0 then
294     N:= Length(FStr)+1;
295   AValue:= Copy(FStr, FPos, N-FPos);
296   FPos:= N+1;
297   Result:= true;
298 end;
299 
IsDoubleBufferedNeedednull300 function IsDoubleBufferedNeeded: boolean;
301 begin
302   Result := true;
303   {$ifdef FPC}
304   Result:= WidgetSet.GetLCLCapability(lcCanDrawOutsideOnPaint) = LCL_CAPABILITY_YES;
305   {$endif}
306 end;
307 
308 { TATListboxItemProp }
309 
310 constructor TATListboxItemProp.Create(const ATag: Int64; AModified: boolean;
311   const ADataText: string);
312 begin
313   Tag:= ATag;
314   Modified:= AModified;
315   DataText:= ADataText;
316 end;
317 
318 { TATListbox }
319 
GetVisibleItemsnull320 function TATListbox.GetVisibleItems: integer;
321 begin
322   Result:= (ClientHeight-FClientOriginY) div FItemHeight;
323 end;
324 
TATListbox.IsIndexValidnull325 function TATListbox.IsIndexValid(AValue: integer): boolean;
326 begin
327   Result:= (AValue>=0) and (AValue<ItemCount);
328 end;
329 
GetItemHeightDefaultnull330 function TATListbox.GetItemHeightDefault: integer;
331 begin
332   Result:= FTheme^.DoScaleFont(CurrentFontSize) * 18 div 10 + 2;
333   Result:= Result * Screen.PixelsPerInch div 96;
334 end;
335 
336 procedure TATListbox.UpdateItemHeight;
337 begin
338   if not FItemHeightIsFixed then
339     FItemHeight:= GetItemHeightDefault * FItemHeightPercents div 100;
340 end;
341 
342 procedure TATListbox.ChangedSelection;
343 begin
344   if Assigned(FOnChangeSel) then
345     FOnChangeSel(Self);
346 end;
347 
348 procedure TATListbox.Scrolled;
349 begin
350   if Assigned(FOnScroll) then
351     FOnScroll(Self);
352 end;
353 
354 procedure TATListbox.DoContextPopup(MousePos: TPoint; var Handled: Boolean);
355 begin
356   //must select item under mouse cursor
357   ItemIndex:= GetItemIndexAt(MousePos);
358 
359   inherited;
360 end;
361 
TATListbox.GetMaxWidthnull362 function TATListbox.GetMaxWidth(C: TCanvas): integer;
363 var
364   i: integer;
365 begin
366   Result:= 0;
367 
368   if FVirtualMode then
369   begin
370     if Assigned(FOnCalcScrollWidth) then
371       Result:= FOnCalcScrollWidth(Self, C);
372   end
373   else
374   if ShowColumns then
375   begin
376     for i:= 0 to High(FColumnWidths) do
377       Inc(Result, FColumnWidths[i]);
378   end
379   else
380   begin
381     for i:= 0 to ItemCount-1 do
382       Result:= Max(Result, C.TextWidth(Items[i]));
383     Inc(Result, FIndentLeft+2);
384   end;
385 end;
386 
387 procedure TATListbox.UpdateScrollbars(C: TCanvas);
388 var
389   NeedVertBar, NeedHorzBar: boolean;
390   si: TScrollInfo;
391 begin
392   if FScrollStyleHorz in [alssShow, alssAuto] then
393     FMaxWidth:= GetMaxWidth(C)
394   else
395     FMaxWidth:= 10;
396 
397   case FScrollStyleVert of
398     alssAuto:
399       NeedVertBar:= ItemCount*ItemHeight>Height; //not ClientHeight
400     alssShow:
401       NeedVertBar:= true;
402     alssHide:
403       NeedVertBar:= false;
404   end;
405 
406   case FScrollStyleHorz of
407     alssAuto:
408       NeedHorzBar:= FMaxWidth>Width; //not ClientWidth
409     alssShow:
410       NeedHorzBar:= true;
411     alssHide:
412       NeedHorzBar:= false;
413   end;
414 
415   FScrollbar.Visible:=     FThemedScrollbar and NeedVertBar;
416   FScrollbarHorz.Visible:= FThemedScrollbar and NeedHorzBar;
417   ShowOsBarVert:= not FThemedScrollbar and NeedVertBar;
418   ShowOsBarHorz:= not FThemedScrollbar and NeedHorzBar;
419 
420   if FThemedScrollbar then
421   begin
422     if FScrollbar.Visible then
423     begin
424       FScrollbar.Min:= 0;
425       FScrollbar.Max:= ItemCount;
426       FScrollbar.PageSize:= VisibleItems;
427       FScrollbar.Position:= ItemTop;
428       FScrollbar.Update;
429     end;
430 
431     if FScrollbarHorz.Visible then
432     begin
433       if FScrollbar.Visible then
434         FScrollbarHorz.IndentCorner:= 100
435       else
436         FScrollbarHorz.IndentCorner:= 0;
437 
438       FScrollbarHorz.Min:= 0;
439       FScrollbarHorz.Max:= FMaxWidth;
440       FScrollbarHorz.PageSize:= ClientWidth;
441       FScrollbarHorz.Position:= ScrollHorz;
442       FScrollbarHorz.Update;
443     end;
444   end
445   else
446   begin
447     FillChar(si{%H-}, SizeOf(si), 0);
448     si.cbSize:= SizeOf(si);
449     si.fMask:= SIF_ALL or SIF_DISABLENOSCROLL;
450     si.nMin:= 0;
451 
452     if ShowOsBarVert then
453     begin
454       si.nMax:= ItemCount;
455       si.nPage:= GetVisibleItems;
456       si.nPos:= FItemTop;
457       SetScrollInfo(Handle, SB_VERT, si, True);
458     end;
459 
460     if ShowOsBarHorz then
461     begin
462       si.nMax:= FMaxWidth;
463       si.nPage:= ClientWidth;
464       si.nPos:= ScrollHorz;
465       SetScrollInfo(Handle, SB_HORZ, si, True);
466     end;
467   end;
468 end;
469 
ItemCountnull470 function TATListbox.ItemCount: integer;
471 begin
472   if FVirtualMode then
473     Result:= FVirtualItemCount
474   else
475     Result:= Items.Count;
476 end;
477 
478 
479 procedure TATListbox.DoPaintTo(C: TCanvas);
480 var
481   Index: integer;
482   bPaintX, bCircle: boolean;
483   R, RectX: TRect;
484 begin
485   C.Font.Name:= CurrentFontName;
486   C.Font.Size:= FTheme^.DoScaleFont(CurrentFontSize);
487 
488   C.Brush.Color:= ColorToRGB(FTheme^.ColorBgListbox);
489   C.FillRect(Rect(0, 0, ClientWidth, ClientHeight));
490 
491   if FHeaderText<>'' then
492     FClientOriginY:= FItemHeight
493   else
494     FClientOriginY:= 0;
495 
496   FIndentForX:= 0;
497   if FShowX<>albsxNone then
498     Inc(FIndentForX, FTheme^.DoScale(FTheme^.XMarkWidth));
499 
500   if FHeaderText<>'' then
501   begin
502     r.Top:= 0;
503     r.Bottom:= FItemHeight;
504     r.Left:= 0;
505     r.Right:= ClientWidth;
506 
507     C.Font.Style:= [];
508     DoDefaultDrawItem(C, -1, r);
509 
510     C.Pen.Color:= FTheme^.ColorSeparators;
511     C.MoveTo(0, FItemHeight-1);
512     C.LineTo(ClientWidth, FItemHeight-1);
513   end;
514 
515   for Index:= FItemTop to ItemCount-1 do
516   begin
517     r.Top:= (Index-FItemTop)*FItemHeight + FClientOriginY;
518     r.Bottom:= r.Top+FItemHeight;
519     r.Left:= 0;
520     r.Right:= ClientWidth;
521     if r.Top>=ClientHeight then Break;
522 
523     if FOwnerDrawn then
524     begin
525       if Assigned(FOnDrawItem) then
526         FOnDrawItem(Self, C, Index, r);
527     end
528     else
529     begin
530       DoDefaultDrawItem(C, Index, r);
531     end;
532 
533     bCircle:=
534       (Index>=0) and (Index<FList.Count) and
535       (FList.Objects[Index] is TATListboxItemProp) and
536       TATListboxItemProp(FList.Objects[Index]).Modified;
537 
538     case FShowX of
539       albsxNone:
540         bPaintX:= false;
541       albsxAllItems:
542         bPaintX:= true;
543       albsxHotItem:
544         bPaintX:= bCircle or (FHotTrack and (Index=FHotTrackIndex));
545     end;
546 
547     if bPaintX then
548     begin
549       RectX:= Rect(r.Left, r.Top, r.Left+FIndentForX, r.Bottom);
550       DoPaintX(C, RectX, bCircle and (Index<>FHotTrackIndex));
551     end;
552   end;
553 
554   if FBorderVisible then
555   begin
556     if Focused then
557       C.Brush.Color:= FTheme^.ColorListboxBorderFocused
558     else
559       C.Brush.Color:= FTheme^.ColorListboxBorderPassive;
560     C.FrameRect(Rect(0, 0, ClientWidth, ClientHeight));
561   end;
562 end;
563 
564 procedure TATListbox.DoPaintX(C: TCanvas; const R: TRect; ACircle: boolean);
565 var
566   P: TPoint;
567   NColor: TColor;
568 begin
569   NColor:= FTheme^.ColorArrows;
570   if FHotTrack then
571   begin
572     P:= ScreenToClient(Mouse.CursorPos);
573     if PtInRect(R, P) then
574       NColor:= FTheme^.ColorArrowsOver;
575   end;
576 
577   if ACircle then
578     CanvasPaintCircleMark(C, R, NColor,
579       FTheme^.DoScale(FTheme^.XMarkOffsetLeft),
580       FTheme^.DoScale(FTheme^.XMarkOffsetRight)
581     )
582   else
583     CanvasPaintXMark(C, R, NColor,
584       FTheme^.DoScale(FTheme^.XMarkOffsetLeft),
585       FTheme^.DoScale(FTheme^.XMarkOffsetRight),
586       FTheme^.DoScale(FTheme^.XMarkLineWidth)
587       );
588 end;
589 
TATListbox.GetOnDrawScrollbarnull590 function TATListbox.GetOnDrawScrollbar: TATScrollbarDrawEvent;
591 begin
592   Result:= FScrollbar.OnOwnerDraw;
593 end;
594 
GetColumnWidthnull595 function TATListbox.GetColumnWidth(AIndex: integer): integer;
596 begin
597   if (AIndex>=0) and (AIndex<Length(FColumnSizes)) then
598     Result:= FColumnWidths[AIndex]
599   else
600     Result:= 0;
601 end;
602 
603 procedure TATListbox.UpdateColumnWidths;
604 var
605   NTotalWidth, NTotalWidthEx,
606   NAutoSized,
607   NSize, NFixedSize, i: integer;
608 begin
609   NTotalWidth:= ClientWidth;
610   NTotalWidthEx:= NTotalWidth;
611   NAutoSized:= 0;
612   NFixedSize:= 0;
613 
614   SetLength(FColumnWidths, Length(FColumnSizes));
615 
616   for i:= 0 to High(FColumnSizes) do
617     if FColumnSizes[i]>0 then
618       Dec(NTotalWidthEx, FColumnSizes[i]);
619   NTotalWidthEx:= Max(0, NTotalWidthEx);
620 
621   //set width of fixed columns
622   for i:= 0 to High(FColumnSizes) do
623   begin
624     NSize:= FColumnSizes[i];
625 
626     //auto-sized?
627     if NSize=0 then
628       Inc(NAutoSized)
629     else
630     //in percents?
631     if NSize<0 then
632       NSize:= NTotalWidthEx * -NSize div 100;
633 
634     Inc(NFixedSize, NSize);
635     FColumnWidths[i]:= NSize;
636   end;
637 
638   //set width of auto-sized columns
639   for i:= 0 to High(FColumnSizes) do
640     if FColumnSizes[i]=0 then
641       FColumnWidths[i]:= Max(0, NTotalWidth-NFixedSize) div NAutoSized;
642 end;
643 
644 procedure TATListbox.SetShowOsBarVert(AValue: boolean);
645 begin
646   if FShowOsBarVert=AValue then Exit;
647   FShowOsBarVert:= AValue;
648   ShowScrollBar(Handle, SB_Vert, AValue);
649 end;
650 
651 procedure TATListbox.SetShowOsBarHorz(AValue: boolean);
652 begin
653   if FShowOsBarHorz=AValue then Exit;
654   FShowOsBarHorz:= AValue;
655   ShowScrollBar(Handle, SB_Horz, AValue);
656 end;
657 
TATListbox.ShowColumnsnull658 function TATListbox.ShowColumns: boolean;
659 begin
660   Result:= Length(FColumnSizes)>0;
661 end;
662 
663 procedure TATListbox.DoDefaultDrawItem(C: TCanvas; AIndex: integer; R: TRect);
664 //AIndex=-1 means 'paint header'
665 var
666   Sep: TATStringSeparator;
667   SLine, SItem: string;
668   NIndentLeft, NIndentTop, NLineHeight, NIndentText,
669   NColOffset, NColWidth, NAllWidth, i: integer;
670 begin
671   if AIndex=-1 then
672   begin
673     C.Brush.Color:= ColorToRGB(FTheme^.ColorBgListboxHeader);
674     C.Font.Color:= ColorToRGB(FTheme^.ColorFontListboxHeader);
675   end
676   else
677   if AIndex=FItemIndex then
678   begin
679     C.Brush.Color:= ColorToRGB(FTheme^.ColorBgListboxSel);
680     C.Font.Color:= ColorToRGB(FTheme^.ColorFontListboxSel);
681   end
682   else
683   if FHotTrack and (AIndex=FHotTrackIndex) then
684   begin
685     C.Brush.Color:= ColorToRGB(FTheme^.ColorBgListboxHottrack);
686     C.Font.Color:= ColorToRGB(FTheme^.ColorFontListbox);
687   end
688   else
689   begin
690     C.Brush.Color:= ColorToRGB(FTheme^.ColorBgListbox);
691     C.Font.Color:= ColorToRGB(FTheme^.ColorFontListbox);
692   end;
693   C.FillRect(R);
694 
695   if AIndex=-1 then
696     SLine:= FHeaderText
697   else
698   if (AIndex>=0) and (AIndex<FList.Count) then
699     SLine:= FList[AIndex]
700   else
701     SLine:= '('+IntToStr(AIndex)+')';
702 
703   NIndentLeft:= FIndentLeft+FIndentForX;
704   NLineHeight:= C.TextHeight(SLine);
705   NIndentTop:= (FItemHeight-NLineHeight) div 2;
706 
707   if not ShowColumns then
708   begin
709     C.TextOut(
710       R.Left+NIndentLeft-ScrollHorz,
711       R.Top+NIndentTop,
712       SLine);
713   end
714   else
715   begin
716     NAllWidth:= ClientWidth;
717     NColOffset:= R.Left+FIndentLeft-ScrollHorz;
718     C.Pen.Color:= Theme^.ColorSeparators;
719     Sep.Init(SLine, FColumnSep);
720 
721     for i:= 0 to Length(FColumnSizes)-1 do
722     begin
723       NColWidth:= FColumnWidths[i];
724       Sep.GetItemStr(SItem);
725 
726       NIndentText:= NColOffset+1+IfThen(i=0, NIndentLeft);
727 
728       C.FillRect(
729         Rect(NColOffset,
730         R.Top,
731         NAllWidth,
732         R.Bottom)
733         );
734 
735       if AIndex=-1 then
736         if Assigned(FHeaderImages) and
737           (i<=High(FHeaderImageIndexes)) and
738           (FHeaderImageIndexes[i]>=0) then
739         begin
740           FHeaderImages.Draw(C,
741             NIndentText,
742             R.Top+(R.Height-FHeaderImages.Height) div 2,
743             FHeaderImageIndexes[i]);
744           Inc(NIndentText, FHeaderImages.Width);
745         end;
746 
747       C.TextOut(
748         NIndentText,
749         R.Top+NIndentTop,
750         SItem
751         );
752 
753       Inc(NColOffset, NColWidth);
754       {$ifdef FPC}
755       C.Line(NColOffset-1, R.Top, NColOffset-1, R.Bottom);
756       {$else}
757       C.MoveTo (NColOffset-1, R.Top);
758       C.LineTo (NColOffset-1, R.Bottom);
759       {$endif}
760     end;
761   end;
762 end;
763 
764 procedure TATListbox.UpdateClientSizes;
765 begin
766   FClientWidth:= Width;
767   if FScrollbar.Visible then
768     FClientWidth:= Max(0, FClientWidth-FScrollbar.Width);
769 
770   FClientHeight:= Height;
771   if FScrollbarHorz.Visible then
772     FClientHeight:= Max(0, FClientHeight-FScrollbarHorz.Height);
773 end;
774 
775 procedure TATListbox.Paint;
776 var
777   R: TRect;
778   C: TCanvas;
779 begin
780   inherited;
781 
782   if DoubleBuffered then
783     C:= FBitmap.Canvas
784   else
785     C:= Canvas;
786 
787   UpdateItemHeight;
788   UpdateScrollbars(C);
789   UpdateClientSizes;
790   UpdateColumnWidths;
791 
792   R:= Rect(0, 0, ClientWidth, ClientHeight);
793   if DoubleBuffered then
794   begin
795     DoPaintTo(C);
796     Canvas.CopyRect(R, C, R);
797   end
798   else
799     DoPaintTo(C);
800 end;
801 
802 procedure TATListbox.Click;
803 var
804   Pnt: TPoint;
805   NItem, NColumn: integer;
806 begin
807   if FCanGetFocus then
808     {$ifdef FPC}
809     LCLIntf.SetFocus(Handle);
810     {$else}
811     SetFocus;
812     {$endif}
813 
814   Pnt:= ScreenToClient(Mouse.CursorPos);
815   NItem:= GetItemIndexAt(Pnt);
816 
817   if NItem>=0 then
818     if FShowX<>albsxNone then
819       if Pnt.X<FIndentForX then
820       begin
821         if Assigned(FOnClickX) then
822           FOnClickX(Self);
823         exit;
824       end;
825 
826   if NItem=-2 then
827   begin
828     if Assigned(FOnClickHeader) then
829     begin
830       NColumn:= GetColumnIndexAt(Pnt);
831       FOnClickHeader(Self, NColumn);
832     end;
833     exit;
834   end;
835 
836   inherited; //OnClick must be after ItemIndex set
837 end;
838 
839 procedure TATListbox.Resize;
840 begin
841   inherited;
842 
843   //ATSynEdit has the same code
844   if DoubleBuffered then
845     if Assigned(FBitmap) then
846       BitmapResizeBySteps(FBitmap, Width, Height);
847 
848   Invalidate;
849 end;
850 
851 procedure TATListbox.DoExit;
852 begin
853   inherited;
854   if FBorderVisible then
855     Invalidate;
856 end;
857 
TATListbox.GetColumnIndexAtnull858 function TATListbox.GetColumnIndexAt(Pnt: TPoint): integer;
859 var
860   NSize, i: integer;
861 begin
862   Result:= -1;
863   NSize:= 0;
864 
865   if ShowXMark<>albsxNone then
866   begin
867     NSize:= FIndentForX;
868     if Pnt.X<FIndentForX then
869     begin
870       Result:= -2;
871       exit;
872     end;
873   end;
874 
875   if not ShowColumns then
876     exit;
877 
878   for i:= 0 to High(FColumnWidths) do
879   begin
880     if Pnt.X<NSize+FColumnWidths[i] then
881     begin
882       Result:= i;
883       exit;
884     end;
885     Inc(NSize, FColumnWidths[i]);
886   end;
887 end;
888 
GetItemIndexAtnull889 function TATListbox.GetItemIndexAt(Pnt: TPoint): integer;
890 begin
891   if FHeaderText<>'' then
892     if (Pnt.Y>=0) and (Pnt.Y<FItemHeight) then
893     begin
894       Result:= -2;
895       exit
896     end;
897 
898   Result:= -1;
899   if ItemCount=0 then exit;
900 
901   Dec(Pnt.Y, FClientOriginY);
902 
903   if (Pnt.X>=0) and (Pnt.X<ClientWidth) then
904   begin
905     Result:= Pnt.Y div FItemHeight + FItemTop;
906     if Result>=ItemCount then
907       Result:= -1;
908   end;
909 end;
910 
TATListbox.ItemBottomnull911 function TATListbox.ItemBottom: integer;
912 begin
913   Result:= Min(ItemCount-1, FItemTop+GetVisibleItems-1);
914 end;
915 
916 procedure TATListbox.ScrollbarChange(Sender: TObject);
917 begin
918   ItemTop:= FScrollbar.Position;
919 end;
920 
921 procedure TATListbox.ScrollbarHorzChange(Sender: TObject);
922 begin
923   ScrollHorz:= FScrollbarHorz.Position;
924 end;
925 
926 procedure TATListbox.SetCanBeFocused(AValue: boolean);
927 begin
928   if FCanGetFocus=AValue then Exit;
929   FCanGetFocus:= AValue;
930   {$ifdef FPC}
931   if AValue then
932     ControlStyle:= ControlStyle-[csNoFocus]
933   else
934     ControlStyle:= ControlStyle+[csNoFocus];
935   {$endif}
936 end;
937 
938 procedure TATListbox.SetItemHeightPercents(AValue: integer);
939 begin
940   if FItemHeightPercents=AValue then Exit;
941   FItemHeightPercents:= AValue;
942   FItemHeightIsFixed:= false;
943 end;
944 
945 procedure TATListbox.SetOnDrawScrollbar(AValue: TATScrollbarDrawEvent);
946 begin
947   FScrollbar.OnOwnerDraw:= AValue;
948 end;
949 
950 procedure TATListbox.SetScrollHorz(AValue: integer);
951 begin
952   if FScrollHorz=AValue then Exit;
953   FScrollHorz:= AValue;
954   FScrollbarHorz.Position:= AValue;
955   Invalidate;
956 end;
957 
958 procedure TATListbox.SetVirtualItemCount(AValue: integer);
959 begin
960   if FVirtualItemCount=AValue then Exit;
961   if AValue<0 then Exit;
962   FVirtualItemCount:= AValue;
963   Scrolled;
964   Invalidate;
965 end;
966 
967 procedure TATListbox.SetItemIndex(AValue: integer);
968 begin
969   if FItemIndex=AValue then Exit;
970   if not IsIndexValid(AValue) then Exit;
971   FItemIndex:= AValue;
972 
973   UpdateItemHeight; //ItemHeight may be not inited
974   UpdateClientSizes; //ClientHeight may be not inited
975 
976   //scroll if needed
977   if FItemIndex=0 then
978     FItemTop:= 0
979   else
980   if FItemIndex<FItemTop then
981     FItemTop:= FItemIndex
982   else
983   if FItemIndex>ItemBottom then
984     FItemTop:= Max(0, FItemIndex-GetVisibleItems+1);
985 
986   ChangedSelection;
987   Invalidate;
988 end;
989 
990 procedure TATListbox.SetItemTop(AValue: integer);
991 begin
992   if FItemTop=AValue then Exit;
993   if not IsIndexValid(AValue) then Exit;
994   FItemTop:= Max(0, AValue);
995   Scrolled;
996   Invalidate;
997 end;
998 
999 procedure TATListbox.SetItemHeight(AValue: integer);
1000 begin
1001   if AValue=FItemHeight then exit;
1002   FItemHeight:= AValue;
1003   FItemHeightIsFixed:= true;
1004 end;
1005 
1006 procedure TATListbox.SetThemedScrollbar(AValue: boolean);
1007 begin
1008   if FThemedScrollbar=AValue then Exit;
1009   FThemedScrollbar:= AValue;
1010   Invalidate;
1011 end;
1012 
1013 
1014 constructor TATListbox.Create(AOwner: TComponent);
1015 begin
1016   inherited;
1017 
1018   ControlStyle:= ControlStyle+[csOpaque] {$ifdef FPC}-[csTripleClicks]{$endif};
1019   DoubleBuffered:= IsDoubleBufferedNeeded;
1020   Width:= 180;
1021   Height:= 150;
1022   Font.Size:= 9;
1023 
1024   CanGetFocus:= false;
1025   FBorderVisible:= false;
1026   FList:= TStringList.Create;
1027   FVirtualItemCount:= 0;
1028   FItemIndex:= 0;
1029   FItemHeightPercents:= 100;
1030   FItemHeight:= 17;
1031   FItemTop:= 0;
1032   FScrollStyleVert:= alssShow;
1033   FScrollStyleHorz:= alssAuto;
1034   FScrollHorz:= 0;
1035   FIndentLeft:= 4;
1036   FIndentTop:= 2;
1037   FOwnerDrawn:= false;
1038   FVirtualMode:= true;
1039   FHotTrack:= false;
1040   FColumnSep:= #9;
1041   SetLength(FColumnSizes, 0);
1042   SetLength(FColumnWidths, 0);
1043   FShowX:= albsxNone;
1044 
1045   FBitmap:= Graphics.TBitmap.Create;
1046   BitmapResize(FBitmap, 800, 600);
1047 
1048   FTheme:= @ATFlatTheme;
1049   FThemedScrollbar:= true;
1050   FThemedFont:= true;
1051 
1052   FScrollbar:= TATScrollbar.Create(Self);
1053   FScrollbar.Parent:= Self;
1054   FScrollbar.Kind:= sbVertical;
1055   FScrollbar.Align:= alRight;
1056   FScrollbar.OnChange:= ScrollbarChange;
1057 
1058   FScrollbarHorz:= TATScrollbar.Create(Self);
1059   FScrollbarHorz.Parent:= Self;
1060   FScrollbarHorz.Kind:= sbHorizontal;
1061   FScrollbarHorz.Align:= alBottom;
1062   FScrollbarHorz.IndentCorner:= 100;
1063   FScrollbarHorz.OnChange:= ScrollbarHorzChange;
1064 end;
1065 
1066 destructor TATListbox.Destroy;
1067 begin
1068   FreeAndNil(FList);
1069   FreeAndNil(FBitmap);
1070   inherited;
1071 end;
1072 
1073 procedure TATListbox.UpdateFromScrollbarMsg(const Msg: {$ifdef FPC}TLMScroll{$else}TWMVScroll{$endif});
1074 var
1075   NMax: integer;
1076 begin
1077   NMax:= Max(0, ItemCount-GetVisibleItems);
1078 
1079   case Msg.ScrollCode of
1080     SB_TOP:        FItemTop:= 0;
1081     SB_BOTTOM:     FItemTop:= NMax;
1082 
1083     SB_LINEUP:     FItemTop:= Max(0, FItemTop-1);
1084     SB_LINEDOWN:   FItemTop:= Min(NMax, FItemTop+1);
1085 
1086     SB_PAGEUP:     FItemTop:= Max(0, FItemTop-GetVisibleItems);
1087     SB_PAGEDOWN:   FItemTop:= Min(NMax, FItemTop+GetVisibleItems);
1088 
1089     SB_THUMBPOSITION,
1090     SB_THUMBTRACK: FItemTop:= Max(0, Msg.Pos);
1091   end;
1092 end;
1093 
1094 procedure TATListbox.UpdateFromScrollbarHorzMsg(const Msg: {$ifdef FPC}TLMScroll{$else}TWMHScroll{$endif});
1095 var
1096   NMax: integer;
1097 begin
1098   NMax:= Max(0, FMaxWidth-ClientWidth);
1099 
1100   case Msg.ScrollCode of
1101     SB_TOP:        FScrollHorz:= 0;
1102     SB_BOTTOM:     FScrollHorz:= NMax;
1103 
1104     SB_LINEUP:     FScrollHorz:= Max(0, FScrollHorz-1);
1105     SB_LINEDOWN:   FScrollHorz:= Min(NMax, FScrollHorz+1);
1106 
1107     SB_PAGEUP:     FScrollHorz:= Max(0, FScrollHorz-ClientWidth);
1108     SB_PAGEDOWN:   FScrollHorz:= Min(NMax, FScrollHorz+ClientWidth);
1109 
1110     SB_THUMBPOSITION,
1111     SB_THUMBTRACK: FScrollHorz:= Max(0, Msg.Pos);
1112   end;
1113 end;
1114 
1115 {$ifndef FPC}
1116 procedure TATListbox.CMMouseEnter(var msg: TMessage);
1117 begin
1118   inherited;
1119   Invalidate;
1120 end;
1121 
1122 procedure TATListbox.CMMouseLeave(var msg: TMessage);
1123 begin
1124   inherited;
1125   Invalidate;
1126 end;
1127 
1128 procedure TATListbox.WMEraseBkgnd(var Message: TMessage);
1129 begin
1130   Message.Result:= 1;
1131   if Assigned(FScrollbar) then
1132   if not MouseInClient then
1133     FScrollbar.Refresh;
1134 end;
1135 {$endif}
1136 
1137 {$ifdef FPC}
1138 procedure TATListbox.LMVScroll(var Msg: TLMVScroll);
1139 begin
1140   UpdateFromScrollbarMsg(Msg);
1141   Invalidate;
1142 end;
1143 
1144 procedure TATListbox.LMHScroll(var Msg: TLMHScroll);
1145 begin
1146   UpdateFromScrollbarHorzMsg(Msg);
1147   Invalidate;
1148 end;
1149 {$endif}
1150 
1151 {$ifndef FPC}
1152 procedure TATListbox.WMSize(var Msg: TWMSize);
1153 begin
1154   inherited;
1155   if (csCreating in ControlState) then exit;
1156   Invalidate;
1157 end;
1158 
1159 procedure TATListbox.WMVScroll(var Msg: TWMVScroll);
1160 begin
1161   UpdateFromScrollbarMsg(Msg);
1162   Invalidate;
1163 end;
1164 
1165 procedure TATListbox.WMHScroll(var Msg: TWMHScroll);
1166 begin
1167   UpdateFromScrollbarHorzMsg(Msg);
1168   Invalidate;
1169 end;
1170 
1171 procedure TATListbox.WMGetDlgCode(var Message: TWMGetDlgCode);
1172 begin
1173  inherited;
1174  Message.Result:= Message.Result or DLGC_WANTARROWS;
1175 end;
1176 
1177 procedure TATListbox.WMKeyDown(var Message: TWMKeyDown);
1178 var
1179   ShiftState: TShiftState;
1180 begin
1181 
1182  { Check the ShiftState, like delphi does while processing WMKeyDown }
1183  ShiftState := KeyDataToShiftState(Message.KeyData);
1184  DoKeyDown(Message.CharCode,ShiftState);
1185 
1186  inherited;
1187 
1188 end;
1189 
1190 {$endif}
1191 
1192 {$ifdef FPC}
CanFocusnull1193 function TATListbox.CanFocus: boolean;
1194 begin
1195   Result:= FCanGetFocus;
1196 end;
1197 {$endif}
1198 
1199 {$ifdef FPC}
CanSetFocusnull1200 function TATListbox.CanSetFocus: boolean;
1201 begin
1202   Result:= FCanGetFocus;
1203 end;
1204 {$endif}
1205 
TATListbox.CurrentFontNamenull1206 function TATListbox.CurrentFontName: string;
1207 begin
1208   if FThemedFont then
1209     Result:= FTheme^.FontName
1210   else
1211     Result:= Font.Name;
1212 end;
1213 
TATListbox.CurrentFontSizenull1214 function TATListbox.CurrentFontSize: integer;
1215 begin
1216   if FThemedFont then
1217     Result:= FTheme^.FontSize
1218   else
1219     Result:= Font.Size;
1220 end;
1221 
1222 procedure TATListbox.Invalidate;
1223 {$ifndef FPC}
1224 var
1225   R: TRect;
1226 {$endif}
1227 begin
1228   {$ifdef FPC}
1229   inherited Invalidate;
1230   {$else}
1231   // https://github.com/Alexey-T/ATFlatControls/issues/32
1232   if (Assigned(FScrollbar) and FScrollbar.Visible) or
1233   (Assigned(FScrollbarHorz) and FScrollbarHorz.Visible) then
1234   begin
1235     R:= Rect(0, 0, ClientWidth, ClientHeight);
1236     InvalidateRect(Handle, R, false);
1237   end
1238   else
1239     inherited Invalidate;
1240   {$endif}
1241 end;
1242 
TATListbox.DoMouseWheelnull1243 function TATListbox.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
1244   MousePos: TPoint): Boolean;
1245 begin
1246   if not ThemedScrollbar then
1247   begin
1248     Result:= inherited;
1249     exit
1250   end;
1251 
1252   Result:= true;
1253   if WheelDelta>0 then
1254     ItemTop:= Max(0, ItemTop-Mouse.WheelScrollLines)
1255   else
1256     ItemTop:= Max(0, Min(ItemCount-VisibleItems, ItemTop+Mouse.WheelScrollLines));
1257 end;
1258 
1259 procedure TATListbox.DoKeyDown(var Key: Word; Shift: TShiftState);
1260 begin
1261   if (key=vk_up) then
1262   begin
1263     ItemIndex:= ItemIndex-1;
1264     key:= 0;
1265     Exit
1266   end;
1267   if (key=vk_down) then
1268   begin
1269     ItemIndex:= ItemIndex+1;
1270     key:= 0;
1271     Exit
1272   end;
1273 
1274   if (key=vk_prior) then
1275   begin
1276     ItemIndex:= Max(0, ItemIndex-(VisibleItems-1));
1277     key:= 0;
1278     Exit
1279   end;
1280   if (key=vk_next) then
1281   begin
1282     ItemIndex:= Min(ItemCount-1, ItemIndex+(VisibleItems-1));
1283     key:= 0;
1284     Exit
1285   end;
1286 
1287   if (key=vk_home) then
1288   begin
1289     ItemIndex:= 0;
1290     key:= 0;
1291     Exit
1292   end;
1293   if (key=vk_end) then
1294   begin
1295     ItemIndex:= ItemCount-1;
1296     key:= 0;
1297     Exit
1298   end;
1299 
1300   if (key=vk_return) then
1301   begin
1302     DblClick;
1303     key:= 0;
1304     Exit
1305   end;
1306 end;
1307 
1308 procedure TATListbox.KeyDown(var Key: Word; Shift: TShiftState);
1309 begin
1310   inherited;
1311   DoKeyDown(Key,Shift);
1312 end;
1313 
1314 procedure TATListbox.MouseMove(Shift: TShiftState; X, Y: Integer);
1315 var
1316   NewIndex: integer;
1317 begin
1318   inherited;
1319 
1320   if FHotTrack then
1321   begin
1322     NewIndex:= GetItemIndexAt(Point(X, Y));
1323     if (FHotTrackIndex<>NewIndex) or (FShowX<>albsxNone) then
1324     begin
1325       FHotTrackIndex:= NewIndex;
1326       Invalidate;
1327     end;
1328   end
1329   else
1330     FHotTrackIndex:= -1;
1331 end;
1332 
1333 procedure TATListbox.MouseDown(Button: TMouseButton; Shift: TShiftState;
1334   X, Y: Integer);
1335 begin
1336   ItemIndex:= GetItemIndexAt(Point(X, Y));
1337   inherited;
1338 end;
1339 
1340 {$ifdef fpc}
1341 procedure TATListbox.MouseLeave;
1342 begin
1343   inherited;
1344   if FHotTrack then
1345   begin
1346     FHotTrackIndex:= -1;
1347     Invalidate;
1348   end;
1349 end;
1350 {$endif}
1351 
1352 initialization
1353 
1354 end.
1355 
1356