' CETweak by Mark Gamber using NS Basic
' This is a useful example of the registry and HTML
' controls. The program sets a couple useful flags
' in the registry to enable / disable window animation
' and if the \Network folder is visible from the root
' directory. Also, the system, menu bar and popup
' menu fonts may be specified, the interface to the
' three types handled by a tabstrip and HTML
' control. The HTML control uses a form to obtain
' data which is picked apart in basic and saved.

' Changes will take effect after the next soft reset.

Option Explicit

' Create the various objects
addobject "MGCEWin32.Registry", "reg"
addobject "Label", "lbl1", 2, 2, 120, 16
addobject "Checkbox", "AniChk", 124, 2, 16, 16
addobject "Label", "lbl2", 2, 20, 120, 16
addobject "Checkbox", "NetChk", 124, 20, 16, 16
addobject "CETabStrip.TabStrip.1", "Tab", 2, 41, 240, 20
addobject "MGCENet.HTML", "html", 2, 60, 239, output.height - 62

reg.Key = 2     ' We never leave HKEY_LOCAL_MACHINE in this app, so set it now

lbl1.BackColor = output.BackColor                        ' Initialize the rest of the controls
lbl1.Caption = "Window Animation:"
lbl2.BackColor = output.BackColor
lbl2.Caption = "Network Folder:"
Tab.tabs.Add 1,, "System Font"                             '  Add some stuff to the tabstrip
Tab.tabs.Add 2,, "Menu Font"
Tab.tabs.Add 3,, "Popup Font"
Tab.tabs.Remove 4

html.SetText GetSystemFont( 1 ) ' Initialize HTML by feeding it the system font form

reg.Path = "System\GWE"                      ' HKLM\System\GWE\Animate is first flag
reg.Name = "Animate"                                                     '  and it may not be there

on error resume next
i = reg.Value
if Err.number <> 0 then                                    '  If the entry is missing, it's enabled
   AniChk.Value = TRUE
else
   if CInt( i ) = 1 then                                                    ' Otherwise, check it's value
      AniChk.Value = TRUE
   end if
end if

Err.Clear
reg.Path = "Comm\Redir"
reg.Name = "RegisterFSRoot"                                 ' Looking for network folder flag
i = reg.Value
if Err.number = 0 then                  ' It's off by default, so it can only be on if it's there
   if CInt( i ) <> 0  then NetChk.Value = TRUE
end if


sub Tab_click                                        ' Select HTML form based on selected tab
   if Tab.SelectedItem.Caption = "System Font" then html.SetText GetSystemFont( 1 )
   if Tab.SelectedItem.Caption = "Menu Font" then html.SetText GetSystemFont( 2 )
   if Tab.SelectedItem.Caption = "Popup Font" then html.SetText GetSystemFont( 3 )
end sub


function GetSystemFont( fType )
   Dim s

   s = "
"
   s = s + ""
   s = s + ""
   s = s + ""
   s = s & ""
   s = s + "
Font Name:
"
   s = s + "
Font Size:
"
   s = s + "
Bold:
"
   s = s + " 400 then s = s & " CHECKED"
   s = s & ">   Italic:"
   s = s + "
"
   GetSystemFont = s
end function


sub AniChk_Click
   reg.Path = "System\GWE"
   reg.Name = "Animate"
   reg.ValueType = 4
   reg.Value = AniChk.Value
end sub


sub NetChk_Click
   reg.Path = "Comm\Redir"
   reg.CreatePath
   reg.Name = "RegisterFSRoot"
   reg.ValueType = 4
   reg.Value = NetChk.Value
end sub


sub html_Click( url, data )
   Dim i, j, s, sName, sSize
   
   if url = "1" then  reg.Path = "System\GDI\SYSFNT"
   if url = "2" then  reg.Path = "System\GWE\Menu\BarFnt"
   if url = "3" then  reg.Path = "System\GWE\Menu\PopFnt"
   i = InStr( 1, data, "FontName=" )
   if i = 0 then
      MsgBox "You need to specify a font name!", vbOKOnly, "Error"
      exit sub
   end if
   i = i + 9
   j = InStr( i, data, "&" ) - i
   sName = Trim( Mid( data, i, j ) )
   if Len( sName ) < 1 then
      MsgBox "You need to specify a font name!", vbOKOnly, "Error"
      exit sub
   end if

   i = InStr( 1, data, "FontSize=" )
   if i = 0 then
      MsgBox "You need to specify a font size!", vbOKOnly, "Error"
      exit sub
   end if
   i = i + 9
   j = InStr( i, data, "&" )
   if j > 0 then
      sSize = Trim( Mid( data, i, j - i ) )
   else
      sSize = Trim( Mid( data, i ) )
   end if
   if Len( sSize ) < 1 then
      MsgBox "You need to specify a font size!", vbOKOnly, "Error"
      exit sub
   end if

   reg.ValueType = 1
   reg.Name = "Nm"
   reg.Value = sName
   reg.Name = "Ht"
   reg.ValueType = 4
   MsgBox sSize
   reg.Value = sSize
   i = InStr( 1, data, "FontBold=" )
   reg.Name = "Wt"
   if i > 0 then
      reg.Value = 700
   else
      reg.Value = 400
   end if
   i = InStr( 1, data, "FontItal=" )
   reg.Name = "It"
   if i > 0 then
      reg.Value = 1
   else
      reg.Value = 0
   end if
end sub