[Pythianproject-cvsmail] CVS: Prototypes/GUISystem vglStdCtrls.pas,NONE,1.1

[Michael H. <mh...@us...>]

Update of /cvsroot/pythianproject/Prototypes/GUISystem
In directory slayer.i.sourceforge.net:/tmp/cvs-serv1414

Added Files:
	vglStdCtrls.pas 
Log Message:
can't remember exact changes, just got cooler that's all -mike

--- NEW FILE ---
unit vglStdCtrls;

{ VGL Standard Controls (C) 2000- The Pythian Project

  - Kamil Krauspe
  - Michael Hearn

  Notes:
    * Changed scrollbar to use skins - 11th December 2000
    * Changed listbox to use one TGLText object for increased efficiency,
      cut loading time from 8 seconds to 2 :)

  Bugs:
    * Scrollbar doesn't quite work correctly in horizontal mode
}

interface
uses Windows, GLCanvas, Classes, vglClasses, Graphics;

const
  VGL_SKINRECT_SCROLLBUTTON_LEFT :TRect = (Left:32;Top:174;Right:51;Bottom:187);
  VGL_SKINRECT_SCROLLBUTTON_RIGHT :TRect = (Left:31;Top:191;Right:51;Bottom:204);
  VGL_SKINRECT_SCROLLBUTTON_UP :TRect = (Left:73;Top:180;Right:86;Bottom:199);
  VGL_SKINRECT_SCROLLBUTTON_DOWN :TRect = (Left:56;Top:180;Right:69;Bottom:199);
  VGL_SKINRECT_SCROLL_TAB :TRect = (Left:90;Top:185;Right:116;Bottom:198);

type
  TvglScrollBarKind = (sbHorizontal, sbVertical);
  TvglScrollBarInc = 1..32767;
  TvglScrollCode = (scLineUp, scLineDown, scPageUp, scPageDown, scPosition,
    scTrack, scTop, scBottom, scEndScroll);
  TvglScrollEvent = procedure(Sender: TObject; ScrollCode: TvglScrollCode;
    var ScrollPos: Integer) of object;

  TvglScrollStyle = (ssNone, ssHorizontal, ssVertical, ssBoth);

  TvglScrollBar = class(TvglComponent)
  private
    FMin: Integer;
    FPosition: Integer;
    FScrollingPos: Integer;
    FMax: Integer;
    FOnChange: TNotifyEvent;
    FSmallChange: TvglScrollBarInc;
    FLargeChange: TvglScrollBarInc;
    FKind: TvglScrollBarKind;
    FOnScroll: TvglScrollEvent;
    FPageSize: Integer;
    FBackPanel :TvglPanel;
    FColor: TColor;
    FPageAlpha: Single;
    procedure SetKind(const Value: TvglScrollBarKind);
    procedure SetMax(const Value: Integer);
    procedure SetMin(const Value: Integer);
    procedure SetPosition(const Value: Integer);
    procedure SetPageSize(const Value: Integer);
    function GetPageRect(where: TRect): TRect;
    function GetMinBtnRect(where: TRect): TRect;
    function GetMaxBtnRect(where: TRect): TRect;
    function GetBodyRect(where: TRect): TRect;
    procedure TimerPass;
    procedure TimerReset;
    procedure HandleMousePositioning(X, Y: Integer);
  protected
    FMouseOver: Boolean;
    FMouseDwnC: Boolean;
    FMousePositioning: Boolean;
    FMouseDown: Boolean;
    FMousePosConst: Integer;
    FMousePart, OldMousePart: Integer;
    FTiming: Boolean;
    FTimerInterval: Cardinal;
    FTimerLast, FTimerDiff: Cardinal;
    FTimingFirst: Boolean;
    FElapsedTime: Cardinal;
    FHighLightPaging: Boolean;

    FImage :TGLBitmap;

    function GetComponentType: string; override;
    function GetClientBounds: TRect; override;
    procedure SetWidth(const Value: integer); override;
    procedure SetHeight(const Value: integer); override;

    procedure DoOnMouseEntry; override ;
    procedure DoOnMouseExit; override ;
    procedure DoOnMouseDown(mb,x,y:integer); override ;
    procedure DoOnMouseMove(X,Y:integer); override;
    procedure DoOnMouseUp(mb, X,Y:integer); override;
    function CheckPart(X, Y: Integer): Integer;
    procedure Update(const ElapsedTime: Cardinal); override;
  public
    constructor Create(aName: string; AOwner: TvglComponent);
    destructor Destroy; override;
    procedure DrawSelf(where: TRect); override;
    procedure SetParams(APosition, AMin, AMax: Integer);
    procedure DoChange; dynamic;
    procedure DoScroll(ScrollCode: TvglScrollCode; var ScrollPos: Integer); dynamic;
    procedure Trigger(ScrollCode: TvglScrollCode);
  published
    property Kind: TvglScrollBarKind read FKind write SetKind default sbHorizontal;
    property LargeChange: TvglScrollBarInc read FLargeChange write FLargeChange default 10;
    property Max: Integer read FMax write SetMax default 100;
    property Min: Integer read FMin write SetMin default 0;
    property SmallChange: TvglScrollBarInc read FSmallChange write FSmallChange default 1;
    property Position: Integer read FPosition write SetPosition default 0;
    property PageSize: Integer read FPageSize write SetPageSize;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnScroll: TvglScrollEvent read FOnScroll write FOnScroll;
    property Color :TColor read FColor write FColor;
    property PageAlpha :Single read FPageAlpha write FPageAlpha;
  end;

  TvglSimpleListBox = class(TvglComponent)
  private
    FScrollBar: TvglScrollBar;
    procedure ScrollBarChanged(Sender: TObject);
    procedure ScrollBarScrolled(Sender: TObject; ScrollCode: TvglScrollCode; var ScrollPos: Integer);
    procedure ItemsChanged(Sender: TObject);
    procedure UpdateScrollBar;
  protected
    FSelFgColor: TColor;
    FSorted: Boolean;
    FItemHeight: Integer;
    FItemIndex: Integer;
    //FGLTexts: TStringList;
    FGLText :TGLText; // for efficiancy reasons now holds all items
    FItems: TStringList;
    FColor: TColor;
    FTranslucency: Single;
    FScrollBars: TvglScrollStyle;
    FSelBgTranslulency: Single;
    FSelBgColor: TColor;
    procedure SetItemHeight(const Value: Integer);
    procedure SetItemIndex(const Value: Integer);
    procedure SetItems(const Value: TStringList);
    procedure SetSorted(const Value: Boolean);
    procedure SetColor(const Value: TColor);
    function GetComponentType: string; override;
    procedure SetWidth(const Value: integer); override;
    procedure SetHeight(const Value: integer); override;
    procedure SetTranslucency(const Value: Single);
    procedure SetBounds(const Value: TRect); override;
    procedure SetScrollBars(const Value: TvglScrollStyle);
    procedure SetSelBgColor(const Value: TColor);
    procedure SetSelBgTranslulency(const Value: Single);

    procedure DrawClient(where: TRect); // background f.e.
    procedure DrawItems(where: TRect);  // the items
    procedure DoOnMouseClick(x, y: Integer); override;
    procedure SetSelFgColor(const Value: TColor);
  public
  // TODO keyboard input - as soon as this and focusing will implemented into
  // the system - very easy only need to call FScrollBar.Trigger(...)

    constructor Create(aName:string; AOwner:TvglComponent);
    destructor Destroy; override ;
    procedure DrawSelf(where:TRect); override ;
    function ItemIndexAt(X, Y: Integer): Integer;
  published
    property ScrollBars: TvglScrollStyle read FScrollBars write SetScrollBars;
    // TODO : Horizontal scrollbar
    property Translucency: Single read FTranslucency write SetTranslucency;
    property SelBgTranslulency: Single read FSelBgTranslulency write SetSelBgTranslulency;
    property Color: TColor read FColor write SetColor;
    property SelBgColor: TColor read FSelBgColor write SetSelBgColor;
    property SelFgColor: TColor read FSelFgColor write SetSelFgColor;

    property Items: TStringList read FItems write SetItems;
    property ItemIndex: Integer read FItemIndex write SetItemIndex;
    property ItemHeight: Integer read FItemHeight write SetItemHeight;
    property Sorted: Boolean read FSorted write SetSorted;
  end;

implementation
uses
  Consts, Math;

const
  vglSB_BtnSizeX = 19;
  vglSB_BtnSizeY = 13;
  vglSB_TimerInterval = 100;
  vglSB_TimerIntervalFirst = 500;

{ TvglScrollbar }

function TvglScrollBar.CheckPart(X, Y: Integer): Integer;
var
  tempr, pgr: TRect;
begin
  Result := -1;
  tempr := ScreenBounds;
  if PointInRect(GetMinBtnRect(tempr), X, Y) then
    Result := 0
  else if PointInRect(GetMaxBtnRect(tempr), X, Y) then
    Result := 1
  else begin
    PGR := GetPageRect(tempr);
    if PointInRect(PGR, X, Y) then
      Result := 4
    else if PointInRect(GetBodyRect(tempr), X, Y) then
    begin
      case FKind of
        sbHorizontal: if X <= pgr.Left then Result := 2 else Result := 3;
        sbVertical: if Y <= pgr.Top then Result := 2 else Result := 3;
      end;
    end;
  end;
end;

constructor TvglScrollBar.Create(aName: string; AOwner: TvglComponent);
begin
  inherited Create(aName, AOwner);
  FAcceptsChildren := False;
  FTiming := False;
  TimerReset;
  FColor := clBlue;
  FPageAlpha := 0.5;
  FMin := 0;
  FMax := 100;
  FSmallChange := 1;
  FLargeChange := 10;
  FPageSize := 10;
  FPosition := 0;
  FScrollingPos := 0;
  FOnChange := nil;
  FOnScroll := nil;
  FKind := sbHorizontal;
  FMousePart := -1;
  OldMousePart := -1;
  FImage := TGLBitmap(Manager.GetResource(VGL_SKIN_1));
end;

destructor TvglScrollBar.Destroy;
begin
  //
  inherited Destroy;
end;

procedure TvglScrollBar.DoChange;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TvglScrollBar.DoOnMouseDown(mb, x, y: integer);
var
  PGR: TRect;
begin
  inherited;
  if mb <> VGL_MOUSE_LEFT then
    Exit;
  FMouseDown := True;
  FMousePart := CheckPart(X, Y);
  if FMousePart < 0 then
    Exit;
  if FMousePart < 4 then
  begin
    FMouseDwnC := True;
    TimerReset;
    FTiming := True;
    TimerPass;
    if FMousePart in [2, 3] then
      FHighlightPaging := True;
  end;
  if FMousePart = 4 then
  begin
    PGR := GetPageRect(ScreenBounds);
    FMousePositioning := True;
    case FKind of
      sbHorizontal: FMousePosConst := x - PGR.Left;
      sbVertical: FMousePosConst := y - PGR.Top;
    end;
  end;
  OldMousePart := FMousePart;
end;
procedure TvglScrollBar.DoOnMouseEntry;
begin
  inherited;
  FMouseOver := True;
  if FMouseDwnC then
  begin
    FTiming := True;
  end;
end;

procedure TvglScrollBar.DoOnMouseExit;
begin
  inherited;
  FMouseOver := False;
  FTiming := False;
  FScrollingPos := Position;
end;

procedure TvglScrollBar.DoOnMouseMove(X, Y: integer);
var
  NewMousePart: Integer;
begin
  inherited;
  if FMousePositioning then
  begin
    HandleMousePositioning(X, Y);
  end
  else begin
    NewMousePart := CheckPart(X, Y);
    if NewMousePart <> OldMousePart then
      FMousePart := -1
    else
      FMousePart := NewMousePart;
  end;
end;

procedure TvglScrollBar.DoOnMouseUp(mb, X, Y: integer);
begin
  inherited;
  FMousePart := -1;
  FMouseDwnC := False;
  FMouseDown := False;
  FTiming := False;
  FHighLightPaging := False;
  if FMousePositioning then
  begin
    DoScroll(scPosition, FScrollingPos);
    Position := FScrollingPos;
    FMousePositioning := False;
  end;
end;

procedure TvglScrollBar.DoScroll(ScrollCode: TvglScrollCode;
  var ScrollPos: Integer);
begin
  if Assigned(FOnScroll) then
    FOnScroll(Self, ScrollCode, ScrollPos);
end;

procedure TvglScrollBar.DrawSelf(where: TRect);
var
  TempR, HP: TRect;
  procedure DrawButtons;
  begin
    tempr := GetMinBtnRect(where);
    if Kind = sbHorizontal then
    begin
      FCanvas.DrawBitmapSubRect(tempr.Left,tempr.Top,VGL_SKINRECT_SCROLLBUTTON_RIGHT,FImage);
      FCanvas.SetClipping(FOwner.ChildClipRect);
      //FCanvas.Rectangle(tempr.Left, tempr.Top, tempr.Right, tempr.Bottom);
      tempr := GetMaxBtnRect(where);
      FCanvas.DrawBitmapSubRect(tempr.Left,tempr.Top,VGL_SKINRECT_SCROLLBUTTON_LEFT,FImage);
      FCanvas.SetClipping(FOwner.ChildClipRect);
      //FCanvas.Rectangle(tempr.Left, tempr.Top, tempr.Right, tempr.Bottom);
    end else if Kind = sbVertical then
    begin
      FCanvas.DrawBitmapSubRect(tempr.Left,tempr.Top,VGL_SKINRECT_SCROLLBUTTON_UP,FImage);
      FCanvas.SetClipping(FOwner.ChildClipRect);
      //FCanvas.Rectangle(tempr.Left, tempr.Top, tempr.Right, tempr.Bottom);
      tempr := GetMaxBtnRect(where);
      FCanvas.DrawBitmapSubRect(tempr.Left,tempr.Top,VGL_SKINRECT_SCROLLBUTTON_DOWN,FImage);
      FCanvas.SetClipping(FOwner.ChildClipRect);
      //FCanvas.Rectangle(tempr.Left, tempr.Top, tempr.Right, tempr.Bottom);
    end;
  end; // DrawButtons;

  procedure DrawBody;
  begin
    FCanvas.Solid := True;
    FCanvas.CurrentColor := FColor;
    FCanvas.FillAlpha := FPageAlpha;
    tempr := GetBodyRect(where);
    FCanvas.Rectangle(tempr.Left, tempr.Top, tempr.Right, tempr.Bottom);
  end; // DrawBody

  procedure DrawPage;
  begin
    FCanvas.Solid := True;
    FCanvas.CurrentColor := clNavy;
    FCanvas.FillAlpha := 0.5;
    tempr := GetPageRect(where);
    FCanvas.Rectangle(tempr.Left, tempr.Top, tempr.Right, tempr.Bottom);
    FCanvas.Solid := false; FCanvas.FillAlpha := 1.0;
    FCanvas.Rectangle(tempr.Left, tempr.Top+1, tempr.Right, tempr.Bottom);
    if FHighLightPaging and FMouseOver then
    begin
      case FMousePart of
        2: HP := Rect(tempr.Left, where.Top + vglSB_BtnSizeY, tempr.Right, tempr.Top);
        3: HP := Rect(tempr.Left, tempr.Bottom, tempr.Right, where.Bottom - vglSB_BtnSizeY);
      end;
      FCanvas.CurrentColor := clBlack;
      FCanvas.FillAlpha := 1;
      FCanvas.Rectangle(HP.Left, HP.Top, HP.Right, HP.Bottom);
    end;
  end;

begin
  inherited;
  DrawBody;
  DrawButtons;
  DrawPage;
end;

function TvglScrollBar.GetBodyRect(where: TRect): TRect;
begin
  if Kind = sbHorizontal then
  begin
    where.Left := where.Left+ (VGL_SKINRECT_SCROLLBUTTON_LEFT.Right-VGL_SKINRECT_SCROLLBUTTON_LEFT.Left);
    where.Right := where.Right-(VGL_SKINRECT_SCROLLBUTTON_LEFT.Right-VGL_SKINRECT_SCROLLBUTTON_LEFT.Left);
  end else if Kind = sbVertical then
  begin
    where.Top := where.Top + (VGL_SKINRECT_SCROLLBUTTON_UP.Bottom-VGL_SKINRECT_SCROLLBUTTON_UP.Top);
    where.Bottom := where.Bottom - (VGL_SKINRECT_SCROLLBUTTON_DOWN.Bottom-VGL_SKINRECT_SCROLLBUTTON_DOWN.Top);
    where.Right := where.Right - ((VGL_SKINRECT_SCROLLBUTTON_DOWN.Right-VGL_SKINRECT_SCROLLBUTTON_DOWN.Left) div 2); // why? dunno
  end;
  Result := where;
end;

function TvglScrollBar.GetClientBounds: TRect;
begin
  Result := inherited GetClientBounds;
end;

function TvglScrollBar.GetComponentType: string;
begin
  Result := 'ScrollBar';
end;

function TvglScrollBar.GetMaxBtnRect(where: TRect): TRect;
begin
  case FKind of
    sbHorizontal: Result := Rect(where.Right - vglSB_BtnSizeX + 1, where.Top, where.Right, where.Top + vglSB_BtnSizeY - 1);
    sbVertical: Result := Rect(where.Left, where.Bottom - vglSB_BtnSizeX + 1, where.Left + vglSB_BtnSizeX - 1, where.Bottom);
  end;
end;

function TvglScrollBar.GetMinBtnRect(where: TRect): TRect;
begin
  case FKind of
    sbHorizontal: Result := Rect(where.Left, where.Top, where.Left + vglSB_BtnSizeX - 1, where.Top + vglSB_BtnSizeY - 1);
    sbVertical: Result := Rect(where.Left, where.Top, where.Left + vglSB_BtnSizeY - 1, where.Top + vglSB_BtnSizeY - 1);
  end;
end;

function TvglScrollBar.GetPageRect(where: TRect): TRect;
var
  L, T, W, H: Integer;
  a, b, c: Single;
begin
  c := 0;
  case FKind of
    sbHorizontal: c := Abs(where.Right - where.Left + 1) - 2*vglSB_BtnSizeX;
    sbVertical: c := Abs(where.Bottom - where.Top + 1) - 2*vglSB_BtnSizeY;
  end;
  if c <= 0 then
    Exit;
  b := c / ((FMax - FMin + 1) / FPageSize); // size of the tab
  a := (c - b + 1) / (FMax - FMin + 1); // x pixels per one scrolling measure - positional
  L := 0;
  T := 0;
  if FKind = sbHorizontal then
  begin
    W := vglSB_BtnSizeX;
    H := vglSB_BtnSizeY;
  end else begin
    W := vglSB_BtnSizeY;
    H := vglSB_BtnSizeX;
  end;
  case FKind of
    sbHorizontal:
      begin
        L := vglSB_BtnSizeX + Math.Min(Math.Max(Round(FScrollingPos * a), 0), Round(c - b + 1));
        W := Round(b);
      end;
    sbVertical:
      begin
        T := vglSB_BtnSizeY + Math.Min(Math.Max(Round(FScrollingPos * a), 0), Round(c - b + 1));
        H := Round(b);
      end;
  end;
  Result := Rect(where.Left + L, where.Top + T, where.Left + L +W, where.Top + T + H);
end;

procedure TvglScrollBar.HandleMousePositioning(X, Y: Integer);
var
  a, b, c, d: Single; OldPos: Integer;
begin
  OldPos := FScrollingPos;
  if FKind = sbVertical then
  begin
    c := Abs(ScreenBounds.Bottom - ScreenBounds.Top + 1) - 2*vglSB_BtnSizeY;
    d := c / ((FMax - FMin + 1) / FPageSize); // size of the tab
    b := (c - d + 1) / (FMax - FMin + 1); // x pixels per one scrolling measure - positional
    a := Y - ScreenBounds.Top - vglSB_BtnSizeY - FMousePosConst; // Top of the tab (page)
    c := a / b; // c -> FPosition
    FScrollingPos := Math.Max(Math.Min(Trunc(c), FMax), FMin);
  end else
  if FKind = sbHorizontal then
  begin
    c := Abs(ScreenBounds.Right - ScreenBounds.Left + 1) - 2*vglSB_BtnSizeX;
    b := c / (FMax - FMin + 1); // x pixels per one scrolling measure - positional
    a := X - ScreenBounds.Left - vglSB_BtnSizeX - FMousePosConst; // Top of the tab (page)
    c := a / b; // c -> FPosition
    FScrollingPos := Math.Max(Math.Min(Trunc(c), FMax), FMin);
  end;
  if OldPos <> FScrollingPos then
    DoScroll(scTrack, FScrollingPos);
end;

procedure TvglScrollBar.SetHeight(const Value: Integer);
var
  AValue: Integer;
begin
  AValue := Value;
  case FKind of
    sbHorizontal:
      begin
        if AValue < vglSB_BtnSizeY then
          AValue := vglSB_BtnSizeY;
      end;
    sbVertical:
      begin
        if AValue < 2*vglSB_BtnSizeY then
          AValue := 2*vglSB_BtnSizeY;
      end;
  end;
  inherited SetHeight(AValue);
end;

procedure TvglScrollBar.SetKind(const Value: TvglScrollBarKind);
begin
  FKind := Value;
end;

procedure TvglScrollBar.SetMax(const Value: Integer);
begin
  SetParams(FPosition, FMin, Value);
end;

procedure TvglScrollBar.SetMin(const Value: Integer);
begin
  SetParams(FPosition, Value, FMax);
end;

procedure TvglScrollBar.SetPageSize(const Value: Integer);
begin
  FPageSize := Value;
end;

procedure TvglScrollBar.SetParams(APosition, AMin, AMax: Integer);
begin
  if AMax < AMin then
    raise EInvalidOperation.Create(SScrollBarRange);
  if APosition < AMin then APosition := AMin;
  if APosition > AMax then APosition := AMax;
  FMin := AMin;
  FMax := AMax;
  FPosition := APosition;
  FScrollingPos := FPosition;
end;

procedure TvglScrollBar.SetPosition(const Value: Integer);
begin
  SetParams(Value, FMin, FMax);
  DoChange;
end;

procedure TvglScrollBar.SetWidth(const Value: integer);
var
  AValue: Integer;
begin
  AValue := Value;
  case FKind of
    sbVertical:
      begin
        if AValue < vglSB_BtnSizeY then
          AValue := vglSB_BtnSizeY;
      end;
    sbHorizontal:
      begin
        if AValue < 2*vglSB_BtnSizeX then
          AValue := 2*vglSB_BtnSizeX;
      end;
  end;
  inherited SetWidth(AValue);
end;

procedure TvglScrollBar.TimerPass;
begin
  if (FMousePart >= 0) and (FMousePart < 4) then
    Trigger(TvglScrollCode(FMousePart));
end;

procedure TvglScrollBar.TimerReset;
begin
  FTimerLast := FElapsedTime;
  FTimerInterval := vglSB_TimerIntervalFirst;
  FTimingFirst := True;
end;

procedure TvglScrollBar.Trigger(ScrollCode: TvglScrollCode);
var
  TempI: Integer;
begin
  TempI := Position;
  if ScrollCode = scLineUp then
  begin
    TempI := Position - FSmallChange;
    DoScroll(scLineUp, TempI);
    Position := TempI;
  end
  else if ScrollCode = scLineDown then
  begin
    TempI := Position + FSmallChange;
    DoScroll(scLineDown, TempI);
    Position := TempI;
  end
  else if ScrollCode = scPageUp then
  begin
    TempI := Position - FLargeChange;
    DoScroll(scPageUp, TempI);
    Position := TempI;
  end
  else if ScrollCode = scPageDown then
  begin
    TempI := Position + FLargeChange;
    DoScroll(scPageDown, TempI);
    Position := TempI;
  end;
end;

procedure TvglScrollBar.Update(const ElapsedTime: Cardinal);
begin
  inherited;
  // this will handle everything, what TTimer should handle, but does not...
  FElapsedTime := ElapsedTime;
  if FTiming then
  begin
    FTimerDiff := ElapsedTime - FTimerLast;
    if FTimerDiff >= FTimerInterval then
    begin
      if FTimingFirst then
      begin
        FTimingFirst := False;
        FTimerInterval := vglSB_TimerInterval;
        Exit;
      end;
      FTimerLast := ElapsedTime;
      TimerPass;
    end;
  end;
end;

{ TvglSimpleListBox }

constructor TvglSimpleListBox.Create(aName: string; AOwner: TvglComponent);
begin
  inherited Create(aName, AOwner);
  FAcceptsChildren := True;
  Width := 100;
  Height := 250;
  FScrollBar := TvglScrollBar.Create(aName + '_ScrollBarInternal', Self);
  FScrollBar.Min := 0;
  FScrollBar.Max := 0;
  FScrollBar.OnChange := ScrollBarChanged;
  FScrollBar.OnScroll := ScrollBarScrolled;
  FScrollBar.Kind := sbVertical;
  FScrollBar.Width := 13; // force auto-size
  FScrollBar.Height := Height;
  FScrollBar.Top := 0;
  FScrollBar.Left := FBounds.Right - 13{FScrollBar.Width} + 1;
  FScrollBar.Color := clAqua;
  FItems := TStringList.Create;
  FItems.OnChange := ItemsChanged;
  //FGLTexts := TStringList.Create;
  FGLText := TGLText.Create('Arial');
  FAcceptsChildren := False;
  FItemHeight := 25;
  SetScrollBars(ssBoth);
  FSelBgTranslulency := 0;
  FSelBgColor := clNavy;
  FSelFgColor := clWhite;
end;

destructor TvglSimpleListBox.Destroy;
begin
  FItems.Free;
  FGLText.Free;
  inherited Destroy;
end;

procedure TvglSimpleListBox.DoOnMouseClick(x, y: Integer);
begin
  inherited;
  ItemIndex := ItemIndexAt(X, Y);
end;

procedure TvglSimpleListBox.DrawClient(where: TRect);
begin
  FCanvas.CurrentColor := FColor;
  FCanvas.FillAlpha := 1 - Translucency;
  FCanvas.Solid := True;
  FCanvas.Rectangle(where.Left, where.Top, where.Right, where.Bottom);
end;

procedure TvglSimpleListBox.DrawItems(where: TRect);
var
  i, j, k: Integer;
  CC, NC, DC: TRect;

  procedure DrawItem(NO: Integer);
  var
    SavedC: array[0..2] of Byte;
  begin
    if No < FGLText.Lines.Count then
    begin
      if FItemIndex = NO then
      begin
        FCanvas.CurrentColor := FSelBgColor;
        FCanvas.FillAlpha := 1 - FSelBgTranslulency;
        FCanvas.Solid := True;
        FCanvas.Rectangle(DC.Left, DC.Top, DC.Right, DC.Bottom);
        with FGLText do
        begin
          SavedC[0] := Red; SavedC[1] := Green; SavedC[2] := Blue;
          SetColor(FSelFgColor);
        end;
      end;
      FCanvas.DrawTextLine(DC.Left + 2, DC.Top + 2, No, FGLText);
      if FItemIndex = NO then
        with FGLText do
        begin
          Red := SavedC[0]; Green := SavedC[1]; Blue := SavedC[2];
        end;
    end;
  end;

begin
  CC := where;
  k := FScrollBar.FScrollingPos;
  j := (Height div FItemHeight);
  FCanvas.CancelClipping;
  for i := 0 to j do
  begin
    NC := Rect(CC.Left, CC.Top + i*FItemHeight, CC.Left + Width - FScrollBar.Width, CC.Top + (i+1)*FItemHeight-1);
    DC := FitRectToRect(CC, NC);
    FCanvas.SetClipping(DC);
    DrawItem(i + k);
    FCanvas.CancelClipping;
  end;
  FCanvas.SetClipping(CC);
end;

function TvglSimpleListBox.ItemIndexAt(X, Y: Integer): Integer;
begin
  Result := FScrollBar.FScrollingPos + (Y - ScreenBounds.Top) div FItemHeight;
end;

procedure TvglSimpleListBox.DrawSelf(where: TRect);
begin
  inherited;
  DrawClient(where);
  DrawItems(where);
end;

function TvglSimpleListBox.GetComponentType: string;
begin
  Result := 'SimpleListBox';
end;


procedure TvglSimpleListBox.ItemsChanged(Sender: TObject);
var
  i: Integer;
  TT: TGLText;
begin
  if FScrollBar = nil then
    Exit;
  UpdateScrollBar;
{  for i := 0 to FGLTexts.Count - 1 do
  begin
    if FGLTexts.Objects[i] <> nil then
      FGLTexts.Objects[i].Free;
  end;}
  FGLText.Lines.Clear;

  for i := 0 to FItems.Count - 1 do
  begin
    {TT := TGLText.Create(FItems[i], FGLTexttmpl.FontName, FGLTexttmpl.TextType, GLC_DEFAULT_FONT_DATA);
    with TGLText(TT) do
    begin
      GLFFontHandle := FGLTexttmpl.GLFFontHandle;
      QT := FGLTexttmpl.QT;
      Red := FGLTexttmpl.Red;
      Blue := FGLTexttmpl.Blue;
      Green := FGLTexttmpl.Green;
      Size := FGLTexttmpl.Size;
      Precache := FGLTexttmpl.Precache;
    end;
    FGLTexts.AddObject(FItems[i], TT);}
    FGLText.Lines.Add(FItems[i]);
  end;
end;

procedure TvglSimpleListBox.ScrollBarChanged(Sender: TObject);
begin
  //
end;

procedure TvglSimpleListBox.ScrollBarScrolled(Sender: TObject;
  ScrollCode: TvglScrollCode; var ScrollPos: Integer);
begin

end;

procedure TvglSimpleListBox.SetBounds(const Value: TRect);
begin
  inherited;
  UpdateScrollBar;
end;

procedure TvglSimpleListBox.SetColor(const Value: TColor);
begin
  FColor := Value;
end;

procedure TvglSimpleListBox.SetHeight(const Value: integer);
begin
  inherited SetHeight(Value);
  UpdateScrollBar;
end;

procedure TvglSimpleListBox.SetItemHeight(const Value: Integer);
begin
  FItemHeight := Max(Value, 1);
end;

procedure TvglSimpleListBox.SetItemIndex(const Value: Integer);
var
  i: Integer;
begin
  FItemIndex := Value;
  i := Height div FItemHeight + FScrollBar.Position - 1;
  if i < FItemIndex then
    FScrollBar.Position := FItemIndex;
end;

procedure TvglSimpleListBox.SetItems(const Value: TStringList);
begin
  FItems := Value;
end;

procedure TvglSimpleListBox.SetScrollBars(const Value: TvglScrollStyle);
begin
  FScrollBars := Value;
  if Value = ssBoth then
  begin
    FScrollBar.Visible := True;
  end
  else if Value = ssVertical then
  begin
    FScrollBar.Visible := True;
  end
  else if Value = ssHorizontal then
  begin
    FScrollBar.Visible := False;
  end
  else begin
    FScrollBar.Visible := False;
  end;
end;

procedure TvglSimpleListBox.SetSelBgColor(const Value: TColor);
begin
  FSelBgColor := Value;
end;

procedure TvglSimpleListBox.SetSelBgTranslulency(const Value: Single);
begin
  FSelBgTranslulency := Max(Min(Value, 1), 0);
end;

procedure TvglSimpleListBox.SetSelFgColor(const Value: TColor);
begin
  FSelFgColor := Value;
end;

procedure TvglSimpleListBox.SetSorted(const Value: Boolean);
begin
  FSorted := Value;
  FItems.BeginUpdate;
  FItems.Sorted := Value;
  FItems.EndUpdate;
end;

procedure TvglSimpleListBox.SetTranslucency(const Value: Single);
begin
  FTranslucency := Max(Min(Value, 1), 0);
end;

procedure TvglSimpleListBox.SetWidth(const Value: integer);
begin
  inherited SetWidth(Value);
  UpdateScrollBar;
end;


procedure TvglSimpleListBox.UpdateScrollBar;
begin
  if FScrollBar = nil then
    Exit;
  FScrollBar.Top := 1;
  FScrollBar.Left := Width - FScrollBar.Width;
  FScrollBar.Width := vglSB_BtnSizeX;
  FScrollBar.Height := Height - 1;
  FScrollBar.PageSize := (Height div FItemHeight);
  FScrollBar.Min := 0;
  FScrollBar.Max := FItems.Count - FScrollBar.PageSize;
  FScrollBar.LargeChange := FScrollBar.PageSize;
end;

end.