{----------------------------------------------------------------------------- The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/MPL-1.1.html Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is: JvTextListBox.pas, released on 2003-10-19. The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev Copyright (c) 2001,2002 SGB Software All Rights Reserved. Contributor(s): Polaris Software Peter Thornqvist [peter3 at sourceforge dot net] Changes: 2003-10-19: * Moved TJvTextListBox from JvxCtrls to this unit You may retrieve the latest version of this file at the Project JEDI's JVCL home page, located at http://jvcl.sourceforge.net Known Issues: -----------------------------------------------------------------------------} // $Id: JvTextListBox.pas 10612 2006-05-19 19:04:09Z jfudickar $ unit JvTextListBox; {$I jvcl.inc} interface uses {$IFDEF UNITVERSIONING} JclUnitVersioning, {$ENDIF UNITVERSIONING} Windows, Messages, Graphics, StdCtrls, JvExStdCtrls; type TPositiveInt = 1..MaxInt; TJvTextListBox = class(TJvExCustomListBox) private FMaxWidth: Integer; procedure ResetHorizontalExtent; procedure SetHorizontalExtent; function GetItemWidth(Index: Integer): Integer; protected procedure WndProc(var Msg: TMessage); override; published property Align; property BorderStyle; property Color; property DragCursor; property DragMode; property Enabled; property ExtendedSelect; property Font; property IntegralHeight; property Anchors; property BiDiMode; property Constraints; property DragKind; property ParentBiDiMode; property ImeMode; property ImeName; property ItemHeight; property Items; property MultiSelect; property ParentColor; property ParentFont; property ParentShowHint; property PopupMenu; property ShowHint; property Sorted; property TabOrder; property TabStop; property TabWidth; property Visible; property OnClick; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnStartDrag; property OnContextPopup; property OnMouseWheelDown; property OnMouseWheelUp; property OnEndDock; property OnStartDock; end; {$IFDEF UNITVERSIONING} const UnitVersioning: TUnitVersionInfo = ( RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/branches/JVCL3_36_PREPARATION/run/JvTextListBox.pas $'; Revision: '$Revision: 10612 $'; Date: '$Date: 2006-05-19 21:04:09 +0200 (ven., 19 mai 2006) $'; LogPath: 'JVCL\run' ); {$ENDIF UNITVERSIONING} implementation uses Math; procedure TJvTextListBox.SetHorizontalExtent; begin SendMessage(Handle, LB_SETHORIZONTALEXTENT, FMaxWidth, 0); end; function TJvTextListBox.GetItemWidth(Index: Integer): Integer; var ATabWidth: Longint; S: string; begin S := Items[Index] + 'x'; if TabWidth > 0 then begin ATabWidth := Round((TabWidth * Canvas.TextWidth('0')) * 0.25); Result := LoWord(GetTabbedTextExtent(Canvas.Handle, @S[1], Length(S), 1, ATabWidth)); end else Result := Canvas.TextWidth(S); end; procedure TJvTextListBox.ResetHorizontalExtent; var I: Integer; begin FMaxWidth := 0; for I := 0 to Items.Count - 1 do FMaxWidth := Max(FMaxWidth, GetItemWidth(I)); SetHorizontalExtent; end; procedure TJvTextListBox.WndProc(var Msg: TMessage); begin case Msg.Msg of LB_ADDSTRING, LB_INSERTSTRING: begin inherited WndProc(Msg); FMaxWidth := Max(FMaxWidth, GetItemWidth(Msg.Result)); SetHorizontalExtent; end; LB_DELETESTRING: begin if GetItemWidth(Msg.WParam) >= FMaxWidth then begin Perform(WM_HSCROLL, SB_TOP, 0); inherited WndProc(Msg); ResetHorizontalExtent; end else inherited WndProc(Msg); end; LB_RESETCONTENT: begin FMaxWidth := 0; SetHorizontalExtent; Perform(WM_HSCROLL, SB_TOP, 0); inherited WndProc(Msg); end; WM_SETFONT: begin inherited WndProc(Msg); Canvas.Font.Assign(Self.Font); ResetHorizontalExtent; end; else inherited WndProc(Msg); end; end; {$IFDEF UNITVERSIONING} initialization RegisterUnitVersion(HInstance, UnitVersioning); finalization UnregisterUnitVersion(HInstance); {$ENDIF UNITVERSIONING} end.