今天講解的是字型對話盒，這一個程式比起檔案對話盒單純很多，只要載入系統內所有的字型名稱，依使用者的設定變更範例文字的樣式，再將使用者的設定存入變數之中就可以了，先來看程式吧

Private Sub Form_Load()
Dim dx%, dy%, rc&

'Set Form Position,Get System Font Name,Set cmbAlign Value,Check Profile's Value
'Set then Object's Value

'略
Dim i As Integer

For i% = 0 To Screen.FontCount - 1
    If Left$(Screen.Fonts(i%), 1) <> "@" Then lstFontName.AddItem Screen.Fonts(i%)
Next i%

經由Screen物件的Fonts陣列可以取得系統的字型名稱，我們把它一一取出加到ListBox裡


cmbAlign.AddItem "置於左上"
'略

If ProFile(SetProFileNo).TextSet.Size = 0 Or ProFileUpdate = True Then
   txtFontSize.Text = Trim$(Str$(FontBuffer.Size))
Else
   txtFontSize.Text = Trim$(Str$(ProFile(SetProFileNo).TextSet.Size))
End If

If ProFile(SetProFileNo).TextSet.Alignment = 0 Or ProFileUpdate = True Then
   cmbAlign.ListIndex = FontBuffer.Alignment
Else
   cmbAlign.ListIndex = ProFile(SetProFileNo).TextSet.Alignment
End If

If ProFile(SetProFileNo).TextSet.Name <> "" And ProFileUpdate = False Then
   For i% = 0 To Screen.FontCount - 1
       If lstFontName.List(i%) = ProFile(SetProFileNo).TextSet.Name Then
          lstFontName.ListIndex = i%
          Exit For
       End If
   Next i%
End If
   
If i% = Screen.FontCount Or ProFile(SetProFileNo).TextSet.Name = "" Or ProFileUpdate = True Then
   For i% = 0 To Screen.FontCount - 1
       If lstFontName.List(i%) = FontBuffer.Name Then
          lstFontName.ListIndex = i%
          Exit For
       End If
   Next i%
End If

我們根據Profile的資料來判斷要在這個From所顯式出的資料，如果有資料則從ProFile載入資料，否則載入FontBuffer的資料

lblSample.FontName = lstFontName.Text
lblSample.FontSize = CInt(Val(txtFontSize.Text))
If ProFile(SetProFileNo).TextSet.Color = 0 Or ProFileUpdate = True Then
   lblSample.ForeColor = FontBuffer.Color
Else
   lblSample.ForeColor = ProFile(SetProFileNo).TextSet.Color
End If
End Sub

最後將這些值代入lblSample即可
嗯....這一個部份好像沒什麼好說的，混了一點版面，好吧，那麼我們來看桌布的更換程式吧。哇咧....程式沒寫錯，但是.....作者在設計視窗有兩個地方可以設定桌布，一個是上方的Menu，一個是從FileList Box或 ListBox的快顯功能表指定，但...我把上方Menu的程式完全忘記了... 其實只要簡單的幾行就好了，我大多是用快顯功能表來切換桌布，根本沒有發現Menu的程式忘了 ....等一下說明完後請自行補上....
設定桌布有三種方式，但是它的步驟其實完全一樣，差別只在於最後傳給Windows決定桌布顯示方式的參數，這裡我把它寫成Set_WallPaper這個副程式來做，這裡需要傳入一個參數，也就是使用者決定的桌布顯示方式

Private Sub Set_WallPaper(WallPaperType As Integer)
'略

On Error GoTo SetWallPaperError
Dim X As String
Me.MousePointer = 11
chgFileName$ = winPath & "MyTheme.BMP"

因為接下來的動作，依圖檔大小，可能會暫時佔住系統，所以我們先把遊標改為忙錄中，然後設定一個變數，存放Windows的路徑和一個MyTheme.BMP的檔名。在這裡，我是仿造AcdSee 的做法，將你指定要成為桌布的圖檔另存為Mytheme.BMP，再將桌布指定成這個檔案，為什麼要這麼做呢?Windows98雖然可以直接指定非BMP格式的圖檔做為桌布，但是它其實是利用Active Desktop的功能來作的，實際上，Windows的桌布還是以BMP為主，而且，如果使用者用的是 Windows95的舊版，更不可能可以將非BMP格式的圖檔設為桌布了，因此我們才要將圖檔再存成 BMP的格式，這樣才能確定使用者能成功切換桌布。而將它存成同一個檔名，則是為了避免資源的浪費，一個時間我們只能指定一張圖成為桌布，如果我們將每張指定過的圖都另存一份BMP格式的圖，那麼磁碟機容量的消耗恐怕是很巨大的(BMP檔沒有經過壓縮，一張全彩的800*600就超過1MB 了)

If Dir(picName$) = "" Then
   Me.MousePointer = 0
   
   MsgBox "指定的圖檔不存在,請確定所指定的圖檔是正確的", 48, "系統錯誤"
   Exit Sub
End If


If imgPreView.Picture = 0 Then
   Me.MousePointer = 0

   MsgBox "沒有指定圖檔,無法更換桌布", 48, "系統錯誤"
   Exit Sub
Else
   Me.AutoRedraw = True
   DoEvents
   
   SavePicture picSource, chgFileName$
End If

Select Case WallPaperType
Case SET_WALLPAPER_CENTER
     '1.Open Registry & Get Registry Data's hkey(HKEY_CURRENT_USER\Control Panel\Desktop)
     '2.Set Values For Registry (hkey:key handle,"TitleWallpaper":valueName
     '  0:保留參數,無用處,REG_SZ :資料型別 unicode nul terminaled string
     '  Byval "0":set value(Type string),1:Len(set value)
     '3.Close Registry
     
     RegOpenKey HKEY_CURRENT_USER, "Control Panel\Desktop", hkey
     RegSetValueEx hkey, "TileWallpaper", 0, REG_SZ, ByVal "0", 1
     RegSetValueEx hkey, "WallpaperStyle", 0, REG_SZ, ByVal "0", 1

          
Case SET_WALLPAPER_TITLE

     RegOpenKey HKEY_CURRENT_USER, "Control Panel\Desktop" & Chr$(0), hkey
     RegSetValueEx hkey, "TileWallpaper", 0, REG_SZ, ByVal "1", 1
     
Case SET_WALLPAPER_FULL
     RegOpenKey HKEY_CURRENT_USER, "Control Panel\Desktop", hkey
     RegSetValueEx hkey, "TileWallpaper", 0, REG_SZ, ByVal "0", 1
     RegSetValueEx hkey, "WallpaperStyle", 0, REG_SZ, ByVal "2", 1

End Select
RegCloseKey hkey

這裡我們先用Dir及Picture的屬性來檢查要儲存的圖檔是否正確，正確的話就用SavePicture將圖檔儲存起來，接者使用RegOpenKey等API來設定桌布的展示方式，只要分別設定其TitleWallpaper 及WallpaperStyle即可，Windows95必須有裝Plus!或IE4才有展開的效果，這一點要注意，不過並不會因此發生程式錯誤，不用擔心。

rc = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, chgFileName$, SPIF_UPDATEINIFILE + SPIF_SENDWININICHANGE)

Me.MousePointer = 0
MsgBox "桌布更換完畢", 64, "系統回覆"
Exit Sub

'略
   
End Sub

最後一步就簡單了，只要呼叫SystemParametersInfo這個API，就可以將桌布變更了， SystemParameter這個API的功用很多，要詳細解釋太佔篇幅了，可以自己查看MSDN。

上個禮拜比較忙一點，這個禮拜小偷懶一下，就到此為止囉！下禮拜講解我本人最討厭的圖型特效的部份！Screen Saver Maker Ver0.91 BugFix即將放出（...大概吧？），Ver 1.0Beta 既將開始動工，會加入一些新功能喔！有興趣的大大力的期待吧（預定2000年推出？）

回到VB教學教室