DirBrowser: A new control that displays an horizontal directory browser.

[GB.FORM]
* NEW: DirBrowser: A new control that displays an horizontal directory browser.

comp/src/gb.form/.project

@@ -1,6 +1,6 @@
 # Gambas Project File 3.0
 Title=More controls for graphical components
-Startup=FTestFileView
+Startup=FTestDirBrowser
 Icon=.hidden/icon.png
 Version=3.17.90
 VersionFile=1

comp/src/gb.form/.src/File/Chooser/DirButton.class

@@ -6,11 +6,13 @@ Event Click
 
 Property Path As String
 Property Label As String
+Property Picture As Picture
 
 Private $hObs As Observer
 Private $sPath As String
 Private $sText As String
 Private $sLabel As String
+Private $hPict As Picture
 
 Public Sub _new()
   
@@ -24,7 +26,7 @@ Private Sub Ellipsize(sText As String, hFont As Font, W As Integer) As String
   Dim sCar As String = "…"
   Dim iPos As Integer
   
-  If Not sText Then Return
+  If Not sText Or If W <= 0 Then Return
   If hFont.TextWidth(sText) <= W Then Return sText
   
   For iPos = 1 To String.Len(sText)
@@ -36,24 +38,34 @@ Private Sub Ellipsize(sText As String, hFont As Font, W As Integer) As String
 End
 
 Public Sub DirButton_Draw()
+
+  Dim DS As Integer
+  Dim X As Float
   
-  Paint.Background = Color.LightForeground
+  DS = Desktop.Scale
   
-  Paint.LineWidth = 1.5
-  Paint.MoveTo(Desktop.Scale / 2, Paint.H / 2 - Desktop.Scale / 2)
-  Paint.LineTo(Desktop.Scale, Paint.H / 2)
-  Paint.LineTo(Desktop.Scale / 2, Paint.H / 2 + Desktop.Scale / 2)
-  Paint.LineCap = Paint.LineCapRound
-  Paint.Stroke
+  If $hPict Then
+    Paint.DrawPicture($hPict, DS \ 2, CInt(Paint.H - $hPict.H) \ 2)
+    X = $hPict.W + DS
+  Else
+    Paint.Background = Color.LightForeground
+    Paint.LineWidth = 1.5
+    Paint.MoveTo(DS / 2, Paint.H / 2 - DS / 2)
+    Paint.LineTo(DS, Paint.H / 2)
+    Paint.LineTo(DS / 2, Paint.H / 2 + DS / 2)
+    Paint.LineCap = Paint.LineCapRound
+    Paint.Stroke
+    X = DS * 1.75
+  Endif
   
   Paint.Background = Style.ForegroundOf(Me)
 
   If Me.Hovered And If Not Me.Design Then 
     'Paint.Background = Color.SetAlpha(Paint.Background, 128)
-    Paint.DrawTextShadow($sText, Desktop.Scale * 1.75, 0, Paint.W - Desktop.Scale, Paint.H, Align.Left)
+    Paint.DrawTextShadow($sText, X, 0, Paint.W - X, Paint.H, Align.Left)
     'Paint.Background = Color.SetAlpha(Paint.Background, 0)
   Endif
-  Paint.DrawText($sText, Desktop.Scale * 1.75, 0, Paint.W - Desktop.Scale, Paint.H, Align.Left)
+  Paint.DrawText($sText, X, 0, Paint.W - X, Paint.H, Align.Left)
   
 End
 
@@ -86,12 +98,19 @@ Private Sub UpdateSize()
 
   Dim W As Integer
   Dim sText As String
+  Dim WA As Integer
   
   sText = GetText()
 
-  W = Min(Desktop.Scale * 2 + Me.Font.TextWidth(sText), Desktop.Scale * 20)
+  If $hPict Then
+    WA = Desktop.Scale * 1.25 + $hPict.W
+  Else 
+    WA = Desktop.Scale * 2
+  Endif
   
-  $sText = Ellipsize(sText, Me.Font, W - Desktop.Scale * 2)
+  W = Min(WA + Me.Font.TextWidth(sText), Desktop.Scale * 32)
+  
+  $sText = Ellipsize(sText, Me.Font, W - WA)
   If $sText <> sText Then
     Me.Tooltip = sText
   Else
@@ -133,3 +152,16 @@ Private Sub Label_Write(Value As String)
   $sLabel = Value
 
 End
+
+Private Function Picture_Read() As Picture
+
+  Return $hPict
+
+End
+
+Private Sub Picture_Write(Value As Picture)
+
+  $hPict = Value
+  UpdateSize
+
+End

comp/src/gb.form/.src/File/DirBrowser.class

@@ -0,0 +1,143 @@
+' Gambas class file
+
+Export
+
+Inherits UserControl
+
+Public Const _Properties As String = "*,Border=True,Dir,Root,Text,Picture"
+Public Const _DefaultEvent As String = "Click"
+Public Const _Group As String = "View"
+
+Event Click(Dir As String)
+
+Property Dir As String
+Property Root As String
+Property Text As String
+Property Picture As Picture
+Property Border As Boolean
+
+Private $sRoot As String
+Private $sText As String
+Private $hPict As Picture
+Private $sDir As String
+Private $hBorder As Panel
+
+Public Sub _new()
+  
+  $hBorder = New Panel(Me)
+  $hBorder.Border = Border.Plain
+  $hBorder.Arrangement = Arrange.Horizontal
+  
+  UpdateBrowser
+  
+End
+
+Private Function Root_Read() As String
+
+  Return $sRoot
+
+End
+
+Private Sub Root_Write(Value As String)
+
+  $sRoot = Value
+  UpdateBrowser
+
+End
+
+Private Function Text_Read() As String
+
+  Return $sText
+
+End
+
+Private Sub Text_Write(Value As String)
+
+  $sText = Value
+  UpdateBrowser
+
+End
+
+Private Function Picture_Read() As Picture
+
+  Return $hPict
+
+End
+
+Private Sub Picture_Write(Value As Picture)
+
+  $hPict = Value
+  UpdateBrowser
+
+End
+
+Private Sub UpdateBrowser()
+
+  Dim sPath As String
+  Dim sName As String
+  Dim hDirButton As DirButton
+  Dim sDir As String
+  Dim sRoot As String
+  
+  $hBorder.Children.Clear
+  
+  sDir = $sDir
+  If Not sDir Then sDir = User.Home
+  
+  sRoot = $sRoot
+  If Not sRoot Then sRoot = "/"
+  
+  hDirButton = New DirButton($hBorder) As "DirButton"
+  hDirButton.Path = sRoot
+  If $sText Then hDirButton.Label = $sText
+  If $hPict Then
+    hDirButton.Picture = $hPict
+  Else 
+    hDirButton.Picture = Picture["icon:/small/harddisk-root"]
+  Endif
+
+  sPath = "/"
+  For Each sName In Split(Mid$(sDir, 2), "/")
+    
+    sPath &/= sName
+    
+    If sRoot Begins sPath Then Continue
+    
+    hDirButton = New DirButton($hBorder) As "DirButton"
+    hDirButton.Path = sPath
+    
+  Next
+
+End
+
+Private Function Dir_Read() As String
+
+  Return $sDir
+
+End
+
+Private Sub Dir_Write(Value As String)
+
+  $sDir = Value
+  UpdateBrowser
+
+End
+
+Private Function Border_Read() As Boolean
+
+  Return $hBorder.Border <> Border.None
+
+End
+
+Private Sub Border_Write(Value As Boolean)
+
+  $hBorder.Border = If(Value, Border.Plain, Border.None)
+
+End
+
+Public Sub DirButton_Click()
+  
+  Raise Click(Last.Path)
+  
+End
+

comp/src/gb.form/.src/Test/FTestDirBrowser.class

@@ -0,0 +1,8 @@
+' Gambas class file
+
+
+Public Sub DirBrowser1_Click(Dir As String)
+
+  Debug Dir
+
+End

comp/src/gb.form/.src/Test/FTestDirBrowser.form

@@ -0,0 +1,11 @@
+# Gambas Form File 3.0
+
+{ Form Form
+  MoveScaled(0,0,64,64)
+  Arrangement = Arrange.Vertical
+  Margin = True
+  { DirBrowser1 DirBrowser
+    MoveScaled(7,6,41,4)
+    Background = Color.TextBackground
+  }
+}