From 9e37aa68da3e886d334fa73570d850ec1823226d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Beno=C3=AEt=20Minisini?= Date: Sun, 7 Aug 2022 20:33:10 +0200 Subject: [PATCH] DirBrowser: A new control that displays an horizontal directory browser. [GB.FORM] * NEW: DirBrowser: A new control that displays an horizontal directory browser. --- .../gb.form/.hidden/control/dirbrowser.png | Bin 0 -> 244 bytes comp/src/gb.form/.project | 2 +- .../gb.form/.src/File/Chooser/DirButton.class | 56 +++++-- comp/src/gb.form/.src/File/DirBrowser.class | 143 ++++++++++++++++++ .../gb.form/.src/Test/FTestDirBrowser.class | 8 + .../gb.form/.src/Test/FTestDirBrowser.form | 11 ++ 6 files changed, 207 insertions(+), 13 deletions(-) create mode 100644 comp/src/gb.form/.hidden/control/dirbrowser.png create mode 100644 comp/src/gb.form/.src/File/DirBrowser.class create mode 100644 comp/src/gb.form/.src/Test/FTestDirBrowser.class create mode 100644 comp/src/gb.form/.src/Test/FTestDirBrowser.form diff --git a/comp/src/gb.form/.hidden/control/dirbrowser.png b/comp/src/gb.form/.hidden/control/dirbrowser.png new file mode 100644 index 0000000000000000000000000000000000000000..b533eed93a61c7f6f839f08e526c0a8783bb4b8d GIT binary patch literal 244 zcmeAS@N?(olHy`uVBq!ia0vp^4j|0J3?w7mbKU|e&H|6fVg?4jBOuH;Rhv&5C@3A^ z6XNP#;FG`nenLXRjw|o~|NsB*-@iF?=B!`8e)jCyp6rh1KxK?2L4Lsu4$p3+0XapU zE{-7{$CDEzSQ8ewFkEnNZj zITO7ClnXQ)q#L~%?{LiFikYq8Her3k1W^`Q&l9s-n7aZ3g!^=KF7_@v&|1Qpq1jc! ky7=kg1dY}1j1mkCpBFgIk&*rW0%$vfr>mdKI;Vst0J6|f&;S4c literal 0 HcmV?d00001 diff --git a/comp/src/gb.form/.project b/comp/src/gb.form/.project index e6aeedbd2..871d9d29f 100644 --- a/comp/src/gb.form/.project +++ b/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 diff --git a/comp/src/gb.form/.src/File/Chooser/DirButton.class b/comp/src/gb.form/.src/File/Chooser/DirButton.class index 1cbd0c736..320093658 100644 --- a/comp/src/gb.form/.src/File/Chooser/DirButton.class +++ b/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 diff --git a/comp/src/gb.form/.src/File/DirBrowser.class b/comp/src/gb.form/.src/File/DirBrowser.class new file mode 100644 index 000000000..79fbc05dc --- /dev/null +++ b/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 + diff --git a/comp/src/gb.form/.src/Test/FTestDirBrowser.class b/comp/src/gb.form/.src/Test/FTestDirBrowser.class new file mode 100644 index 000000000..b76e56411 --- /dev/null +++ b/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 diff --git a/comp/src/gb.form/.src/Test/FTestDirBrowser.form b/comp/src/gb.form/.src/Test/FTestDirBrowser.form new file mode 100644 index 000000000..1019748ff --- /dev/null +++ b/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 + } +}