Compare revisions

gambas · gambas · e5f8cfb6 · e5f8cfb6 · e5f8cfb6 · e5f8cfb6
--- a/comp/src/gb.form/.lang/fr.po
+++ b/comp/src/gb.form/.lang/fr.po
@@ -27,8 +27,7 @@
 msgid ""
 msgstr ""
 "Project-Id-Version: gb.form 3.15.90\n"
-"POT-Creation-Date: 2021-02-17 15:39 UTC\n"
+"PO-Revision-Date: 2021-03-08 07:59 UTC\n"
-"PO-Revision-Date: 2021-02-17 15:39 UTC\n"
 "Last-Translator: Benoît Minisini <g4mba5@gmail.com>\n"
 "Language: fr\n"
 "MIME-Version: 1.0\n"
@@ -79,14 +78,6 @@ msgstr "Nouveau répertoire"
 msgid "Cannot create directory."
 msgstr "Impossible de créer le répertoire."
-#: FBugFileView.form:32
-msgid "Toggle Fileview Detailed View"
-msgstr ""
-#: FBugFileView.form:37
-msgid "Toggle Filechooser Detailed View"
-msgstr ""
 #: FCalendar.form:48
 msgid "Today"
 msgstr "Aujourd'hui"
@@ -115,117 +106,111 @@ msgstr "Répertoire introuvable."
 msgid "All files (*)"
 msgstr "Tous les fichiers (*)"
-#: FDirChooser.class:886
+#: FDirChooser.class:887
 msgid "&Overwrite"
 msgstr "&Remplacer"
-#: FDirChooser.class:886
+#: FDirChooser.class:887
-msgid ""
+msgid "This file already exists.\n\nDo you want to overwrite it?"
-"This file already exists.\n"
+msgstr "Ce fichier existe déjà.\n\nDésirez-vous le remplacer ?"
-"\n"
-"Do you want to overwrite it?"
-msgstr ""
-"Ce fichier existe déjà.\n"
-"\n"
-"Désirez-vous le remplacer ?"
-#: FDirChooser.class:1004
+#: FDirChooser.class:1005
 msgid "&Bookmark current directory"
 msgstr "&Marquer le répertoire courant"
-#: FDirChooser.class:1012
+#: FDirChooser.class:1013
 msgid "&Edit bookmarks..."
 msgstr "&Editer les signets..."
-#: FDirChooser.class:1023
+#: FDirChooser.class:1024
 msgid "Show &details"
 msgstr "Vue &détaillée"
-#: FDirChooser.class:1029
+#: FDirChooser.class:1030
 msgid "Show &hidden files"
 msgstr "Afficher les fichiers &cachés"
-#: FDirChooser.class:1035
+#: FDirChooser.class:1036
 msgid "Show &image preview"
 msgstr "Prévisualisation des &images"
-#: FDirChooser.class:1043
+#: FDirChooser.class:1044
 msgid "&Rename"
 msgstr "&Renommer"
-#: FDirChooser.class:1048
+#: FDirChooser.class:1049
 msgid "Copy"
 msgstr "Copier"
-#: FDirChooser.class:1053
+#: FDirChooser.class:1054
 msgid "&Delete"
 msgstr "&Supprimer"
-#: FDirChooser.class:1065
+#: FDirChooser.class:1066
 msgid "&Uncompress file"
 msgstr "&Décompresser le fichier"
-#: FDirChooser.class:1070
+#: FDirChooser.class:1071
 msgid "&Create directory"
 msgstr "&Créer un répertoire"
-#: FDirChooser.class:1075
+#: FDirChooser.class:1076
 msgid "Open in &file manager..."
 msgstr "Ouvrir dans le gestionnaire de &fichiers..."
-#: FDirChooser.class:1080
+#: FDirChooser.class:1081
 msgid "&Refresh"
 msgstr "&Actualiser"
-#: FDirChooser.class:1088
+#: FDirChooser.class:1089
 msgid "&Properties"
 msgstr "&Propriétés"
-#: FDirChooser.class:1302
+#: FDirChooser.class:1303
 msgid "Overwrite"
 msgstr "Ecraser"
-#: FDirChooser.class:1302
+#: FDirChooser.class:1303
 msgid "Overwrite all"
 msgstr "Tout écraser"
-#: FDirChooser.class:1302
+#: FDirChooser.class:1303
 msgid "This file or directory already exists."
 msgstr "Ce fichier ou ce répertoire existe déjà."
-#: FDirChooser.class:1323
+#: FDirChooser.class:1324
 msgid "Cannot list archive contents"
 msgstr "Impossible de lister le contenu de l'archive"
-#: FDirChooser.class:1363
+#: FDirChooser.class:1364
 msgid "Cannot uncompress file."
 msgstr "Impossible de décompresser le fichier."
-#: FDirChooser.class:1363
+#: FDirChooser.class:1364
 msgid "Unknown archive."
 msgstr "Archive inconnue."
-#: FDirChooser.class:1431
+#: FDirChooser.class:1432
 msgid "Delete file"
 msgstr "Supprimer le fichier"
-#: FDirChooser.class:1432
+#: FDirChooser.class:1433
 msgid "Do you really want to delete that file?"
 msgstr "Désirez-vous réellement supprimer ce fichier ?"
-#: FDirChooser.class:1439
+#: FDirChooser.class:1440
 msgid "Unable to delete file."
 msgstr "Impossible de supprimer le fichier."
-#: FDirChooser.class:1449
+#: FDirChooser.class:1450
 msgid "Delete directory"
 msgstr "Supprimer le répertoire"
-#: FDirChooser.class:1450
+#: FDirChooser.class:1451
 msgid "Do you really want to delete that directory?"
 msgstr "Désirez-vous vraiment supprimer ce répertoire ?"
-#: FDirChooser.class:1457
+#: FDirChooser.class:1458
 msgid "Unable to delete directory."
 msgstr "Impossible de supprimer le répertoire."
@@ -257,81 +242,14 @@ msgstr "Afficher les fichiers"
 msgid "Bookmarks"
 msgstr "Signets"
-#: FDirChooser.form:248 FInputBox.form:45 FWizard.class:76 Form1.form:36
+#: FDirChooser.form:248 FInputBox.form:45 FWizard.class:76
 msgid "OK"
 msgstr "OK"
-#: FDirChooser.form:254 FEditBookmark.class:119 FInputBox.form:51
+#: FDirChooser.form:254 FEditBookmark.class:119 FInputBox.form:51 FSidePanel.class:1149 FWizard.form:52
-#: FSidePanel.class:1149 FWizard.form:52 Form1.form:42
 msgid "Cancel"
 msgstr "Annuler"
-#: FDocumentView.form:51
-msgid "Zoom :"
-msgstr ""
-#: FDocumentView.form:56
-msgid "Show Shadow"
-msgstr ""
-#: FDocumentView.form:66 FTestTabPanel.form:64
-msgid "Padding"
-msgstr ""
-#: FDocumentView.form:71
-msgid "Spacing"
-msgstr ""
-#: FDocumentView.form:80
-msgid "Scale Mode"
-msgstr ""
-#: FDocumentView.form:89
-msgid "Goto :"
-msgstr ""
-#: FDocumentView.form:95
-msgid "Column"
-msgstr ""
-#: FDocumentView.form:95
-msgid "Fill"
-msgstr ""
-#: FDocumentView.form:95
-msgid "Horizontal"
-msgstr ""
-#: FDocumentView.form:95
-msgid "None"
-msgstr ""
-#: FDocumentView.form:95
-msgid "Row"
-msgstr ""
-#: FDocumentView.form:95
-msgid "Vertical"
-msgstr ""
-#: FDocumentView.form:96 FMain.form:69
-msgid "ComboBox1"
-msgstr ""
-#: FDocumentView.form:101 FMain.form:85 FTestBalloon.form:18
-#: FTestCompletion.form:23 FTestMenuButton.form:148 FTestMessageView.form:26
-#: FTestWizard.form:24
-msgid "Button1"
-msgstr ""
-#: FDocumentView.form:110
-msgid "Columns"
-msgstr ""
-#: FDocumentView.form:120
-msgid "Autocenter"
-msgstr ""
 #: FEditBookmark.class:23 FileView.class:143
 msgid "Name"
 msgstr "Nom"
@@ -452,54 +370,38 @@ msgstr "Aperçu"
 msgid "Errors"
 msgstr "Erreurs"
-#: FFontChooser.class:387
+#: FFontChooser.class:388
 msgid "How quickly daft jumping zebras vex"
 msgstr "Portez ce vieux whisky au juge blond qui fume"
-#: FFontChooser.form:95
+#: FFontChooser.form:60
+msgid "Building cache"
+msgstr "Construction du cache"
+#: FFontChooser.form:67
+msgid "Refresh cache"
+msgstr "Rafraîchir le cache"
+#: FFontChooser.form:119
 msgid "Bold"
 msgstr "Gras"
-#: FFontChooser.form:102
+#: FFontChooser.form:126
 msgid "Italic"
 msgstr "Italique"
-#: FFontChooser.form:109
+#: FFontChooser.form:133
 msgid "Underline"
 msgstr "Souligné"
-#: FFontChooser.form:116
+#: FFontChooser.form:140
 msgid "Strikeout"
 msgstr "Barré"
-#: FFontChooser.form:125
+#: FFontChooser.form:149
 msgid "Relative"
 msgstr "Relatif"
-#: FIconPanel.form:18
-msgid "Item 0"
-msgstr ""
-#: FIconPanel.form:23
-msgid "Toto"
-msgstr ""
-#: FIconPanel.form:26
-msgid "Item 1"
-msgstr ""
-#: FIconPanel.form:28
-msgid "Item 2"
-msgstr ""
-#: FIconPanel.form:35
-msgid "Item 3"
-msgstr ""
-#: FLCDLabel.form:15
-msgid "12:34"
-msgstr ""
 #: FListEditor.class:264
 msgid "Add"
 msgstr "Ajouter"
@@ -520,52 +422,6 @@ msgstr "Déplacer l'élément vers le haut"
 msgid "Move item down"
 msgstr "Déplacer l'élément vers le bas"
-#: FMain.class:26
-#, fuzzy
-msgid "PDF files"
-msgstr "fichiers"
-#: FMain.class:26
-msgid "Postscript files"
-msgstr ""
-#: FMain.form:29 FTestFileChooser.form:31 FTestMenuButton.form:40 FWiki.form:20
-msgid "Menu2"
-msgstr ""
-#: FMain.form:33 FTestFileChooser.form:36 FTestMenuButton.form:44 FWiki.form:24
-msgid "Menu3"
-msgstr ""
-#: FMain.form:68
-msgid "Élément 1"
-msgstr ""
-#: FMain.form:68
-msgid "Élément 2"
-msgstr ""
-#: FMain.form:68
-msgid "Élément 3"
-msgstr ""
-#: FMain.form:68
-msgid "Élément 4"
-msgstr ""
-#: FMain.form:74
-msgid "ComboBox2"
-msgstr ""
-#: FMain.form:80 FTestBalloon.form:12 FTestFileChooser.form:86
-#: FTestSwitchButton.form:22
-msgid "TextBox1"
-msgstr ""
-#: FMain.form:90 Form2.form:121
-msgid "MenuButton1"
-msgstr ""
 #: FMessage.form:39
 msgid "Do not display this message again"
 msgstr "Ne plus afficher ce message"
@@ -578,142 +434,6 @@ msgstr "Masqué"
 msgid "Transparent"
 msgstr "Transparent"
-#: FSpinBar.form:24
-msgid "Test"
-msgstr ""
-#: FTestBalloon.form:17
-msgid "Ceci est une bulle d'aide"
-msgstr ""
-#: FTestColorChooser.form:20
-msgid "Resizable"
-msgstr ""
-#: FTestCompletion.form:28
-msgid "Button2"
-msgstr ""
-#: FTestDateChooser.form:33
-msgid "Enable"
-msgstr ""
-#: FTestExpander.form:16
-msgid "Expander"
-msgstr ""
-#: FTestFileChooser.form:28 FTestMenuButton.form:36
-msgid "Menu1"
-msgstr ""
-#: FTestFileChooser.form:41 FTestMenuButton.form:70
-msgid "Menu7"
-msgstr ""
-#: FTestFileChooser.form:49 FTestMenuButton.form:53 FWiki.form:28
-msgid "Menu4"
-msgstr ""
-#: FTestFileChooser.form:54 FTestMenuButton.form:57 FWiki.form:32
-msgid "Menu5"
-msgstr ""
-#: FTestFileChooser.form:76
-msgid "Balloon"
-msgstr ""
-#: FTestFileChooser.form:81 FTestSwitchButton.form:38
-msgid "Label1"
-msgstr ""
-#: FTestMenuButton.form:32
-msgid "Project"
-msgstr ""
-#: FTestMenuButton.form:49
-msgid "View"
-msgstr ""
-#: FTestMenuButton.form:61
-msgid "Menu6"
-msgstr ""
-#: FTestMenuButton.form:66
-msgid "Tools"
-msgstr ""
-#: FTestMenuButton.form:74
-msgid "Menu8"
-msgstr ""
-#: FTestMenuButton.form:78
-msgid "Menu9"
-msgstr ""
-#: FTestMenuButton.form:81
-msgid "Menu10"
-msgstr ""
-#: FTestMenuButton.form:85
-msgid "Menu11"
-msgstr ""
-#: FTestMenuButton.form:124
-msgid "Menu button"
-msgstr ""
-#: FTestSwitchButton.form:45
-msgid "Label2"
-msgstr ""
-#: FTestTabPanel.form:41
-msgid "Text"
-msgstr ""
-#: FTestTabPanel.form:54
-msgid "Border"
-msgstr ""
-#: FTestTabPanel.form:59
-msgid "Orientation"
-msgstr ""
-#: FTestToolPanel.form:17
-msgid "Toolbar 1"
-msgstr ""
-#: FTestToolPanel.form:19
-msgid "Toolbar 2"
-msgstr ""
-#: FTestToolPanel.form:21
-msgid "Toolbar 3"
-msgstr ""
-#: FTestToolPanel.form:23
-msgid "Toolbar 4"
-msgstr ""
-#: FTestValueBox.form:15
-msgid "Hello world!"
-msgstr ""
-#: FTestWizard.form:20
-msgid "Étape n°1"
-msgstr ""
-#: FTestWizard.form:27
-msgid "Ceci est une longue étape"
-msgstr ""
-#: FTestWizard.form:33
-msgid "Étape n°3"
-msgstr ""
-#: FTestWizard.form:35
-msgid "Étape n°4"
-msgstr ""
 #: FWizard.class:88
 msgid "&Next"
 msgstr "&Suivant"
@@ -734,14 +454,6 @@ msgstr "Aucun fichier dans ce répertoire."
 msgid "Cannot rename file."
 msgstr "Impossible de renommer le fichier."
-#: Form2.form:126
-msgid "ButtonBox2"
-msgstr ""
-#: Form3.form:25
-msgid "Raise"
-msgstr ""
 #: Help.module:71
 msgid "A file or directory name cannot be void."
 msgstr "Le nom d'un fichier ou d'un répertoire ne peut être vide."
@@ -765,3 +477,4 @@ msgstr "&1 Gio"
 #: Wizard.class:86
 msgid "Step #&1"
 msgstr "Étape n°&1"
--- a/comp/src/gb.form/.project
+++ b/comp/src/gb.form/.project
 # Gambas Project File 3.0
 Title=More controls for graphical components
-Startup=FTestSpinner
+Startup=FTestFontChooser
 Version=3.15.90
 VersionFile=1
 Component=gb.image

--- a/comp/src/gb.form/.src/File/FileView.class
+++ b/comp/src/gb.form/.src/File/FileView.class
@@ -1211,7 +1211,7 @@ Public Sub Watcher_Resize()
 End
-Public Sub View_Draw(X As Integer, Y As Integer, Width As Integer, Height As Integer, (Key) As String)
+Public Sub View_Draw(X As Integer, Y As Integer, Width As Integer, Height As Integer, (Key) As String, Optional (Column) As Integer)
  'Dim iSize As Long
  'Dim hFont As Font
@@ -1221,6 +1221,8 @@ Public Sub View_Draw(X As Integer, Y As Integer, Width As Integer, Height As Int
  Dim sDate As String
  Dim sAuth As String
+  If Not $hIconView.Visible Then Return
  H = $hInfoFont.H
  If $iIconSize < (H * 4) Then Return

--- a/comp/src/gb.form/.src/Font/FFontChooser.class
+++ b/comp/src/gb.form/.src/Font/FFontChooser.class
@@ -12,6 +12,8 @@ Public ShowFixed As Boolean
 Public StylePanel As Container
 Public Preview As Control
+Static Private $cCache As New Collection
 Private $iNoChange As Integer
 Private $bNoRefresh As Boolean
 Private $sLast As String
@@ -21,13 +23,15 @@ Private $sSplitFont As String
 Private $aSplitFont As String[]
 Private $bShowFont As Boolean
 Private $sLastFilter As String
+Private $hTask As FontCacheTask
+Private $hObs As Observer
 Public Sub _new()
  Inc $iNoChange
  $bNoRefresh = True
  $bShowFont = True
-  Me.Proxy = txtFilter
+  'Me.Proxy = txtFilter
  'lstSize.List = ["6", "7", "8", "9", "10", "11", "12", "13", "14", "16", "18", "20", "24", "28", "32", "36", "40", "48", "56", "64", "72", "80", "96", "112", "128"]
@@ -38,6 +42,8 @@ Public Sub _new()
  SetFont("")
+  $hObs = New Observer(Me.Window) As "Window"
 End
 Public Sub Form_Open()
@@ -138,20 +144,6 @@ Private Sub SplitFont(sFont As String, N As Integer) As String
 End
-Private Sub GetFontName(sFont As String) As String
-  Dim sText As String
-  If $bShowFont Then
-    sText = "<font size=\"+2\" face=\"" & Html(sFont) & "\">" & Html(sFont) & "</font>"
-  Else
-    sText = Html(sFont)
-  Endif
-  Return sText
-End
 Private Sub FillFamily()
  Dim sFont As String
@@ -225,25 +217,33 @@ Private Sub FillFamily()
    If sParentFont And If tvwFamily[sParentFont].Children = 0 Then
      With tvwFamily[sParentFont]
+        If cFont[sParentFont] >= 1000 Then
+          .H = H
+          If Not $bShowFont Then 
+            .Text = sParentFont
+          Else 
+            .Tag = sParentFont
+          Endif
+        Else
          .Foreground = Color.Merge(Color.LightForeground, Color.TextForeground)
          .Background = Color.Merge(Color.LightForeground, Color.TextBackground, 0.8)
-        .Expanded = True
+          If .Depth = 0 Then .Expanded = True
          .Font = Font["-2"]
          .RichText = ""
          .Text = sParentFont
          .H = 0
-      End With
+          .Tag = ""
-      If cFont[sParentFont] >= 1000 Then
-        With tvwFamily.Add("." & sParentFont, "",, sParentFont)
-          .H = H
-          .RichText = GetFontName(sParentFont)
-        End With
        Endif
+      End With
    Endif
    With tvwFamily.Add(sFont, "",, sParentFont)
      .H = H
-      .RichText = GetFontName(sFont)
+      If Not $bShowFont Then
+        .Text = sFont
+      Else 
+        .Tag = sFont
+      Endif
    End With
    cParent[sFont] = True
@@ -453,13 +453,11 @@ Public Sub tvwFamily_Select()
  If Not tvwFamily.Current Then Return
-  If tvwFamily.Current.Children Then
+  If tvwFamily.Current.Tag Then
-    Return
-  Endif
    Family = tvwFamily.Key
    If Family Begins "." Then Family = Mid$(Family, 2)
    RefreshExample
+  Endif
 End
@@ -600,6 +598,29 @@ Public Sub btnStrikeout_Click()
 End
+Private Sub StartCacheTask()
+  If $hTask Then Return
+  If Not panFilter.Visible Then Return
+  If Me.Window.Minimized Then Return
+  $hTask = New FontCacheTask As "FontCacheTask"
+  spnCache.Value = 0
+  spnCache.Show
+  spnCache.Start
+  btnRefresh.Hide
+End
+Private Sub StopCacheTask()
+  If Not $hTask Then Return
+  $hTask.Stop 
+  $hTask = Null
+End
 Public Sub panBorder_BeforeArrange()
  If panBorder.H < (Desktop.Scale * 32) Then
@@ -610,7 +631,8 @@ Public Sub panBorder_BeforeArrange()
      sepToolbar.Hide
      cmbFamily.Show
      cmbFamily.Lower
-      txtFilter.Hide
+      panFilter.Hide
+      StopCacheTask
      RefreshFamily
    Endif
@@ -633,15 +655,16 @@ Public Sub panBorder_BeforeArrange()
      tvwFamily.Show
      sepFamily.Show
      sepToolbar.Show
-      txtFilter.Show
+      panFilter.Show
      RefreshFamily
+      StartCacheTask
    Endif
  Endif
  RefreshExample
-  Me.Proxy = If(txtFilter.Visible, txtFilter, cmbFamily)
+  Me.Proxy = If(panFilter.Visible, txtFilter, cmbFamily)
 End
@@ -691,11 +714,8 @@ Public Sub txtFilter_KeyPress()
  Dim hScrollArea As Control
  If Key.Normal Then
-    If Key.Code = Key.Down Or If Key.Code = Key.Up Then
+    If Key.Code = Key.Down Or If Key.Code = Key.Up Or If Key.Code = Key.PageUp Or If Key.Code = Key.PageDown Then
-      hGridView = tvwFamily.Children[0]
+      Goto SEND_TO_LIST
-      hScrollArea = hGridView.Children[0]
-      Object.Raise(hScrollArea, "KeyPress")
-      Stop Event
    Else If Key.Code = Key.Return Or If Key.Code = Key.Enter Then
      If tvwFamily.Current.Children Then
        hGridView = tvwFamily.Children[0]
@@ -706,7 +726,20 @@ Public Sub txtFilter_KeyPress()
        GetParent()._Activate()
      Endif
    Endif
+  Else If Key.Control Then
+    If Key.Code = Key.Home Or If Key.Code = Key.End Then
+      Goto SEND_TO_LIST
    Endif
+  Endif
+  Return
+SEND_TO_LIST:
+  hGridView = tvwFamily.Children[0]
+  hScrollArea = hGridView.Children[0]
+  Object.Raise(hScrollArea, "KeyPress")
+  Stop Event
 End
@@ -723,3 +756,109 @@ Public Sub Form_Show()
  RefreshFamily
 End
+Public Sub tvwFamily_Draw(X As Integer, Y As Integer, (Width) As Integer, Height As Integer, (Key) As String, (Column) As Integer)
+  Dim sFont As String
+  Dim hImage As Image
+  Dim sDir As String
+  Dim sPath As String
+  Dim hItem As _TreeView_Item
+  Dim sFontKey As String
+  If Not $bShowFont Then Return
+  hItem = tvwFamily[Key]
+  sFont = hItem.Tag
+  If Not sFont Then Return
+  sFontKey = FontCacheTask.Normalize(sFont)
+  hImage = $cCache[sFontKey]
+  If Not hImage Then
+    sDir = FontCacheTask.GetDir()
+    sPath = sDir &/ sFontKey & ".png"
+    Try hImage = Image.Load(sPath)
+    If Not hImage Then hImage = FontCacheTask.CreateFontCacheImage(sFont)
+    $cCache[sFont] = hImage
+  Endif
+  Paint.DrawImage(hImage, X + (1 + hItem.Depth) * tvwFamily.Indent, Y + (Height - hImage.H) \ 2)
+  tvwFamily.MoveTo(Key)
+  ' If hItem.Depth = 0 Or If tvwFamily.MoveNext() Then Paint.FillRect(0, Y + Height + Desktop.Scale \ 2 - 1, Width + Desktop.Scale, 1, Color.Merge(Color.LightForeground, Color.TextBackground, 0.8))
+End
+Public Sub Form_Close()
+  StopCacheTask
+End
+Public Sub FontCacheTask_Read(Data As String)
+  Dim aData As String[]
+  Dim iPos As Integer
+  Data = RTrim(Data)
+  iPos = RInStr(Data, "\n")
+  If iPos Then Data = Mid$(Data, iPos + 1)
+  aData = Split(Data, " ")
+  spnCache.Value = CInt(aData[0]) / CInt(aData[1])
+End
+Public Sub FontCacheTask_Kill()
+  spnCache.Stop
+  spnCache.Hide
+  btnRefresh.Show
+End
+Public Sub btnRefresh_Click()
+  Dim sDir As String
+  StopCacheTask
+  sDir = Main.GetCacheDir() &/ "gambas3/gb.form/fonts"
+  Try Shell "rm -rf " & Shell(sDir) & "~" Wait
+  Try Move sDir To sDir & "~"
+  Try Shell "rm -rf " & Shell(sDir) & "~" Wait
+  $cCache.Clear
+  StartCacheTask
+End
+Public Sub Window_Show()
+  StartCacheTask
+End
+Public Sub Window_Hide()
+  StopCacheTask
+End
+Public Sub Window_State()
+  Dim hWin As Window
+  hWin = Last
+  If hWin.Minimized Then
+    StopCacheTask
+  Else
+    StartCacheTask
+  Endif
+End
--- a/comp/src/gb.form/.src/Font/FFontChooser.form
+++ b/comp/src/gb.form/.src/Font/FFontChooser.form
@@ -11,13 +11,31 @@
      MoveScaled(40,1,27,4)
      ReadOnly = True
    }
+    { panFilter HBox
+      MoveScaled(4,7,70,4)
+      Background = Color.TextBackground
      { txtFilter ButtonBox
-      MoveScaled(5,7,69,4)
+        MoveScaled(0,0,51,4)
+        Expand = True
+        Picture = Picture["icon:/small/refresh"]
        Border = False
        Button = False
        ClearButton = True
        Filter = True
      }
+      { spnCache Spinner
+        MoveScaled(56,0,4,4)
+        Visible = False
+        ToolTip = ("Building cache") & "..."
+        Margin = True
+        Type = Spinner.Circle
+      }
+      { btnRefresh ToolButton
+        MoveScaled(61,0,4,4)
+        ToolTip = ("Refresh cache")
+        Picture = Picture["icon:/small/refresh"]
+      }
+    }
    { sepFamily Separator
      MoveScaled(17,14,35,0)
    }

--- a/comp/src/gb.form/.src/Font/FontCacheTask.class
+++ b/comp/src/gb.form/.src/Font/FontCacheTask.class
+' Gambas class file
+Inherits Task
+Static Public Sub Normalize(sFont As String) As String
+  Dim I As Integer
+  Dim sCar As String
+  Dim sStr As String
+  For I = 1 To Len(sFont)
+    sCar = Mid$(sFont, I, 1)
+    If sCar <= " " Then
+      sStr &= "_"
+    Else If IsLetter(sCar) Then 
+      sStr &= UCase(sCar)
+    Else If IsDigit(sCar) Then
+      sStr &= sCar
+    Else 
+      sStr &= "%" & Hex$(Asc(sCar), 2)
+    Endif
+    If Len(sStr) >= 240 Then Break
+  Next
+  Return sStr
+End
+Static Public Sub GetDir() As String
+  Dim sDir As String
+  Dim sComp As String
+  sDir = Main.GetCacheDir() &/ "gambas3/gb.form/fonts"
+  For Each sComp In ["gb.gtk", "gb.gtk3", "gb.qt4", "gb.qt5"]
+    If Component.IsLoaded(sComp) Then
+      sDir &/= sComp
+      Break
+    Endif
+  Next
+  Return sDir
+End
+Static Public Sub CreateFontCacheImage(sFont As String) As Image
+  Dim sDir As String
+  Dim sPath As String
+  Dim hFont As Font
+  Dim hSize As Rect
+  Dim hImage As Image
+  Dim sTemp As String
+  sDir = GetDir()
+  sPath = sDir &/ Normalize(sFont) & ".png"
+  If Exist(sPath) Then Return
+  Main.MkDir(sDir)
+  hFont = Font[sFont & ",+2"]
+  hSize = hFont.TextSize(sFont)
+  If hSize.IsVoid() Then
+    hFont = Font["+2"]
+    hSize = hFont.TextSize(sFont)
+    If hSize.IsVoid() Then Return
+  Endif
+  hImage = New Image(hSize.W + 1, hSize.H, Color.Transparent)
+  Paint.Begin(hImage)
+  Paint.Font = hFont
+  Paint.DrawText(sFont, 0, 0, hImage.W, hImage.H, Align.Normal)
+  Paint.End
+  sTemp = sDir &/ "~" & CStr(Application.Handle) & ".png"
+  Try Kill sTemp
+  hImage.Save(sTemp)
+  Move sTemp Kill sPath
+  Return hImage
+End
+Public Sub Main()
+  Dim sFont As String
+  Dim N As Integer
+  Dim I As Integer
+  Application.Priority = 19
+  N = Fonts.Count
+  For Each sFont In Fonts
+    CreateFontCacheImage(sFont)
+    Inc I
+    Print I;; N
+    Flush
+  Next
+End
--- a/comp/src/gb.form/.src/Main.module
+++ b/comp/src/gb.form/.src/Main.module
@@ -259,6 +259,16 @@ Public Sub Task_Kill()
  Else
    Debug "->";; sStr
  Endif
+End
+Public Sub GetCacheDir() As String
+  Dim sPath As String = Env["XDG_CACHE_HOME"]
+  If sPath Then 
+    Return sPath 
+  Else 
+    Return User.Home &/ ".cache"
+  Endif
 End
--- a/comp/src/gb.form/.src/Spinner.class
+++ b/comp/src/gb.form/.src/Spinner.class
@@ -4,7 +4,7 @@ Export
 Inherits UserControl
-Public Const _Properties As String = "*,Border,Label,Padding{Range:0;63},Type={Spinner.*}"
+Public Const _Properties As String = "*,Border,Label,Padding{Range:0;63},Margin=False,Type={Spinner.*}"
 Public Const _DefaultSize As String = "8,8"
 Public Enum {Line}, Dot, Circle
@@ -14,9 +14,9 @@ Property Label As Boolean
 Property Value As Float
 Property Enabled As Boolean
 Property Padding As Integer
+Property Margin As Boolean
 Property Type As Integer
-Private $hDrawingArea As DrawingArea
 Private $fStartTime As Float
 Private $hTimer As Timer
 Private $bBorder As Boolean
@@ -25,19 +25,14 @@ Private $fValue As Float
 Private $fLastWait As Float
 Private $iPadding As Integer
 Private $iType As Integer
+Private $bMargin As Boolean
-Public Sub _new()
-  $hDrawingArea = New DrawingArea(Me) As "DrawingArea"
-End
 Public Sub Start()
  $fStartTime = Timer
  $hTimer = New Timer As "Timer"
  $hTimer.Delay = 50
-  $hDrawingArea.Refresh
+  Me.Refresh
 End
@@ -60,13 +55,13 @@ Public Sub Wait()
 End
-Public Sub DrawingArea_Draw()
+Public Sub UserControl_Draw()
  'Dim iFlag As Integer
  Dim A As Float
  Dim X As Float
  Dim Y As Float
-  Dim R As Variant
+  Dim R As Float
  Dim D As Float
  Dim I As Integer
  Dim C As Float
@@ -75,6 +70,7 @@ Public Sub DrawingArea_Draw()
  Dim HL As Integer
  Dim iFg As Integer
  Dim XC, YC As Float
+  Dim P As Integer
  If Not Me.Design Then
    If $fStartTime = 0 Then Goto DRAW_BORDER
@@ -83,8 +79,13 @@ Public Sub DrawingArea_Draw()
  iFg = Style.ForegroundOf(Me)
-  W = Paint.W
+  P = $iPadding
-  H = Paint.H
+  If $bMargin Then P += Desktop.Scale
+  W = Paint.W - P * 2
+  H = Paint.H - P * 2
+  Paint.Translate(P, P)
  If $bLabel Then
    HL = Paint.Font.Height + Desktop.Scale
@@ -97,7 +98,7 @@ Public Sub DrawingArea_Draw()
      Case Circle
-        R = Min(W, H) / 2 * 12 / 16 - $iPadding
+        R = Min(W, H) / 2 * 3 / 4
        Paint.LineCap = Paint.LineCapButt
        Paint.LineWidth = R / 2
@@ -118,7 +119,7 @@ Public Sub DrawingArea_Draw()
        X = W / 2
        Y = H / 2
-        R = Min(W, H) / 2 * 13 / 16 - $iPadding
+        R = Min(W, H) / 2 * 13 / 16
        For I = 0 To 15
@@ -137,7 +138,7 @@ Public Sub DrawingArea_Draw()
        X = W / 2
        Y = H / 2
-        R = Min(W, H) / 2 * 7 / 8 - $iPadding
+        R = Min(W, H) / 2 * 7 / 8
        Paint.LineWidth = R / 8
        Paint.LineCap = Paint.LineCapRound
@@ -164,6 +165,8 @@ Public Sub DrawingArea_Draw()
    Paint.DrawText(Format($fValue, "0 %"), 0, Paint.H - HL, Paint.W, HL - Desktop.Scale, Align.Center)
  Endif
+  Paint.Translate(-P, -P)
 DRAW_BORDER:
  If $bBorder Then Style.PaintPanel(0, 0, Paint.W, Paint.H, Border.Plain) ', iFlag)
@@ -176,7 +179,7 @@ End
 Public Sub Timer_Timer()
-  $hDrawingArea.Refresh
+  Me.Refresh
  $hTimer.Stop
 End
@@ -190,7 +193,7 @@ End
 Private Sub Border_Write(Value As Boolean)
  $bBorder = Value
-  $hDrawingArea.Refresh
+  Me.Refresh
 End
@@ -203,7 +206,7 @@ End
 Private Sub Label_Write(Value As Boolean)
  $bLabel = Value
-  $hDrawingArea.Refresh
+  Me.Refresh
 End
@@ -216,7 +219,7 @@ End
 Private Sub Value_Write(Value As Float)
  $fValue = Max(0, Min(1, Value))
-  $hDrawingArea.Refresh
+  Me.Refresh
 End
@@ -230,7 +233,7 @@ Private Sub Enabled_Write(Value As Boolean)
  If Value = Me.Enabled Then Return
  Super.Enabled = Value
-  $hDrawingArea.Refresh
+  Me.Refresh
 End
@@ -244,7 +247,7 @@ Private Sub Padding_Write(Value As Integer)
  If $iPadding = Value Then Return
  $iPadding = Value
-  $hDrawingArea.Refresh
+  Me.Refresh
 End
@@ -256,7 +259,22 @@ End
 Private Sub Type_Write(Value As Integer)
+  If $iType = Value Then Return
  $iType = Value
  Me.Refresh
 End
+Private Function Margin_Read() As Boolean
+  Return $bMargin
+End
+Private Sub Margin_Write(Value As Boolean)
+  If $bMargin = Value Then Return
+  $bMargin = Value
+  Me.Refresh
+End
--- a/comp/src/gb.form/.src/Test/FTestFontChooser.form
+++ b/comp/src/gb.form/.src/Test/FTestFontChooser.form
 # Gambas Form File 3.0
 { Form Form
-  MoveScaled(0,0,74,31)
+  MoveScaled(0,0,74,67)
  Arrangement = Arrange.Fill
  { FontChooser1 FontChooser
    MoveScaled(1,1,72,28)

--- a/comp/src/gb.form/.src/Test/FTestSpinner.form
+++ b/comp/src/gb.form/.src/Test/FTestSpinner.form
@@ -6,11 +6,12 @@
  Arrangement = Arrange.Fill
  Margin = True
  { Spinner1 Spinner
-    MoveScaled(11,9,18.25,18.25)
+    MoveScaled(11,9,18,18)
    Font = Font["+4"]
    Foreground = Color.DarkRed
    Border = True
-    Type = Spinner.Dot
+    Margin = True
+    Type = Spinner.Circle
  }
  { Timer1 #Timer
    #MoveScaled(4,3)

--- a/comp/src/gb.gui.base/.project
+++ b/comp/src/gb.gui.base/.project
 # Gambas Project File 3.0
 Title=Common controls and classes for GUI components
-Startup=FLabel
+Startup=FTreeView
 Version=3.15.90
 VersionFile=1
 Component=gb.image

--- a/comp/src/gb.gui.base/.src/Frame.class
+++ b/comp/src/gb.gui.base/.src/Frame.class
@@ -78,10 +78,10 @@ Public Sub Frame_Draw()
    Paint.Background = Color.LightForeground
    Paint.MoveTo(CInt($hFrame.W - hRect.W) \ 2 - DS, H \ 2)
-    Paint.LineTo(DS \ 2, H \ 2)
+    Paint.LineTo(0, H \ 2)
-    Paint.LineTo(DS \ 2, $hFrame.H - DS \ 2)
+    Paint.LineTo(0, $hFrame.H - 1)
-    Paint.LineTo($hFrame.W - DS \ 2, $hFrame.H - DS \ 2)
+    Paint.LineTo($hFrame.W - 1, $hFrame.H - 1)
-    Paint.LineTo($hFrame.W - DS \ 2, H \ 2)
+    Paint.LineTo($hFrame.W - 1, H \ 2)
    Paint.LineTo(CInt($hFrame.W - hRect.W) \ 2 + hRect.W + DS, H \ 2)
    Paint.LineWidth = 1
    Paint.AntiAlias = False

--- a/comp/src/gb.gui.base/.src/ProgressBar.class
+++ b/comp/src/gb.gui.base/.src/ProgressBar.class
@@ -14,7 +14,6 @@ Property Value As Float
 Property Pulse As Boolean
 Property Border As Boolean
-Private $hDrawingArea As DrawingArea
 Private $fValue As Float
 Private $bLabel As Boolean = True
 Private $bPulse As Boolean
@@ -22,14 +21,6 @@ Private $iPulse As Integer
 Private $hTimerPulse As Timer
 Private $bBorder As Boolean = True
-Public Sub _new()
-  $hDrawingArea = New DrawingArea(Me) As "DrawingArea"
-  Me.Proxy = $hDrawingArea
-End
 Private Function Label_Read() As Boolean
  Return $bLabel
@@ -39,7 +30,7 @@ End
 Private Sub Label_Write(Value As Boolean)
  $bLabel = Value
-  $hDrawingArea.Refresh
+  Me.Refresh
 End
@@ -53,12 +44,16 @@ End
 Private Sub Value_Write(Value As Float)
  If $bPulse Then Return
-  $fValue = Max(0, Min(1, Value))
-  $hDrawingArea.Refresh
+  Value = Max(0, Min(1, Value))
+  If Value = $fValue Then Return
+  $fValue = Value
+  Me.Refresh
 End
-Public Sub DrawingArea_Draw()
+Public Sub UserControl_Draw()
  Dim F As Integer '= 2 'Max(4, Style.FrameWidth + 2)
  Dim iWP As Integer
@@ -170,7 +165,7 @@ Public Sub Pulse_Timer()
    $iPulse = -1
  Endif
-  $hDrawingArea.Refresh
+  Me.Refresh
 End
@@ -183,6 +178,6 @@ End
 Private Sub Border_Write(Value As Boolean)
  $bBorder = Value
-  $hDrawingArea.Refresh
+  Me.Refresh
 End
--- a/comp/src/gb.gui.base/.src/Test/FTestFrame.form
+++ b/comp/src/gb.gui.base/.src/Test/FTestFrame.form
 # Gambas Form File 3.0
 { Form Form
-  MoveScaled(0,0,64,64)
+  MoveScaled(0,0,102,64)
  { MyFrame1 Frame
-    MoveScaled(4,10,41,32)
+    MoveScaled(4,10,43,42)
    Text = ("Ceci est le titre de la frame et il peut être long mais très long en fait")
+    TextFont = Font["Bold"]
    { Button1 Button
      MoveScaled(5,5,15,5)
    }

--- a/comp/src/gb.gui.base/.src/Test/FProgressBar.class
+++ b/comp/src/gb.gui.base/.src/Test/FProgressBar.class
--- a/comp/src/gb.gui.base/.src/Test/FProgressBar.form
+++ b/comp/src/gb.gui.base/.src/Test/FProgressBar.form
--- a/comp/src/gb.gui.base/.src/TreeView/_TreeView.class
+++ b/comp/src/gb.gui.base/.src/TreeView/_TreeView.class
@@ -26,6 +26,8 @@ Property ScrollY As Integer
 Property Read ScrollW, ScrollWidth As Integer
 Property Read ScrollH, ScrollHeight As Integer
+Property Read Indent As Integer
 Event Click
 Event Activate
 Event Select
@@ -36,6 +38,7 @@ Event Cancel
 Event Compare(Key As String, OtherKey As String)
 Event BeforeSort
 Event Scroll
+Event Draw(X As Integer, Y As Integer, Width As Integer, Height As Integer, Key As String, Column As Integer)
 Static Private $iNoEvent As Integer
@@ -509,9 +512,16 @@ Public Sub GridView_Draw(X As Integer, Y As Integer, W As Integer, H As Integer,
  Dim HA As Float
  Dim bHasNext As Boolean
  Dim hParent As _TreeView_Item
+  Dim bStopEvent As Boolean
  If Not hItem Then Return
+  bStopEvent = Raise Draw(X, Y, W, H, hItem.Key, Column)
+  If bStopEvent Then
+    Stop Event
+    Return
+  Endif
  If Column = 0 Then
    If System.RightToLeft Then
@@ -653,14 +663,15 @@ Public Sub GridView_Draw(X As Integer, Y As Integer, W As Integer, H As Integer,
        If hItem.Count Then
          Paint.Background = Color.LightForeground
-          HA = H / 2
+          'HA = H / 2
-          If HA < Desktop.Scale Then HA = Min(H, Desktop.Scale)
+          'If HA < Desktop.Scale Then HA = Min(H, Desktop.Scale)
-          WA = HA
+          WA = Min(H, $iDepthW \ 2)
+          HA = WA
          XA = X + ($iDepthW - WA) / 2
          YA = Y + (H - HA) / 2
+          Paint.LineWidth = HA / 6
          Paint.Arrow(XA, YA, WA, HA, If(hItem.Expanded, Align.Bottom, Align.Right))
          Paint.Background = Color.SetAlpha(Style.ForegroundOf($hView), 64)
-          Paint.LineWidth = $iDepthW / 12
          Paint.LineCap = Paint.LineCapRound
          Paint.Stroke
@@ -1859,3 +1870,9 @@ Public Sub _RefreshPicture()
  Next
 End
+Private Function Indent_Read() As Integer
+  Return $iDepthW
+End
--- a/comp/src/gb.gui.base/.src/TreeView/_TreeView_Item.class
+++ b/comp/src/gb.gui.base/.src/TreeView/_TreeView_Item.class
@@ -19,6 +19,7 @@ Property Background As Integer
 Property Foreground As Integer
 Property Font As Font
 Property Tag As Variant
+Property Read Depth As Integer
 Private $sKey As String
 Private $sParent As String
@@ -300,7 +301,7 @@ Private Sub Expanded_Write(Value As Boolean)
  hTree._RestoreSelection
-  If Value Then hTree._EnsureVisible(Me, True)
+  hTree._EnsureVisible(Me, Value)
  hTree._RaiseExpand($sKey, $bExpanded)
@@ -619,3 +620,9 @@ Private Sub Height_Write(Value As Integer)
  hTree._RefreshView
 End
+Private Function Depth_Read() As Integer
+  Return _Depth
+End
No results found