#E6E6E6 【VB 物件】ShadowText 演示有陰影的藝術字體 作者:吳文成

  雖然 Visual Basic 不是採用純然的物件導向式 , 但是所開發的應用程式仍然以物件(與其事件驅動)為基礎,所以其撰寫的程式結構,與該程式在螢幕上的實體表現相當接近 。 大致來說 ,Visual Basic 的物件樣式有視覺化的控制項(副檔名為 .ocx), 例如 CheckBox (核取盒)或我所開發的 FlatButton(平面按鈕)。 然而還有另一種常見的 ,但是非視覺化的物件樣式,那便是物件類別(副檔名為 .cls), 物件類別包含了程式碼、資料、屬性與多介面,物件類別所建立的新物件可以被應用程式多重地呼叫,我們可以將它視為一個有屬性、有方法,卻沒有實體的控制項。

  把物件類別僅僅是視為「無實體的控制項」,似乎會限制我們對於物件類別的「可能視野」。物件類別在設計階段的確是無實體的,但是我們[[img src=computer/ShadowText.gif height=79 width=154 align=left]]只要花點心思,就可以讓物件類別在執行階段給視覺化,甚至是可事件驅動化。怎麼說呢,例如在這裡我要介紹我所撰寫的 ShadowText 物件 , 它可以在執行階段實現(動態地)有陰影的藝術字體,以及其事件觸發,這只是一個簡單的例子,如圖所示。基本上它可以改變陰影字體相對於主字體的偏移量,陰影字體或主字體的個別字型大小、底線
、斜體等等,你可以移動它,改變它的收納器,當然你也可以將「阿特拉斯」字樣改成家人或是親密愛人。如果你在字體上滑鼠移動、點按或鍵盤按鍵,都可以觸發相關事件。這樣聽起來,它就像是一個實體化、視覺化的控制項,但是它徹頭徹尾是一個物件類別。

  其實沒什麼特別的,只是花點心思的問題,撰寫程式在虛擬的、數位的電腦上原本就有無限的可能性,在電腦上所謂的實體化與非實體化、視覺化與非視覺化只是銅板的兩面,差別僅僅是在於將銅板翻過來與翻過去
,或者這樣「神奇地」說,差別僅僅是在於頭轉過來與頭轉過去--這就是數位的特徵,可以虛擬地操作、任意地量變,以及純粹功能性的演示。剛剛提到的所謂花點心思,其關鍵就是在這個物件類別裡運用「動態新增控制項」(主要是 Label 控件),並且選擇其收納器的技巧。這樣的基本方法果然是沒什麼特別,但是在知識產業的領域,在基本方法上花點心思去組合、去變新、去累積就是所謂的創意,而創意就是價值

  只是介紹一個自製的、簡單的 ShadowText 物件類別 , 我就這樣地冗詞贅句。回到這個物件類別的製作原理,在這個物件範例裡,我們將看到如何使用 Form.Controls.Add 動態新增控制項,如何使用 Private WithEvents 與 Public Event 來註冊前者控制項的事件 , Private WithEvents 來宣告物件的事件,如何使用 Err.Raise 產生執行階段的錯誤訊息 , 還包括( 類似於製作控制項的)物件屬性與方法的程序撰寫,類似的物件實體化的範例,讀者可以參考由我所撰寫的 TextScroll 物件, 它實現循環捲動的文字走馬燈,這是一個比 ShadowText 更進階的例子。

  程式碼我列舉於後,相關的註解也在其中。限於篇幅,我只列舉出物件 ShadowText 的部分關鍵的程式碼:

' 定義其他區域變數或新增物件
 Private isCreatedCtr As Boolean
 Private lblShadow As Label
 ' 動作事件的主要註冊者,同時也是主字體
 Private WithEvents lblMain As Label

' 若要引動以下的事件,請使用 RaiseEvent 指
' 你可以依同樣方法再新增其他事件
Public Event Click()
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Public Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Private Sub Class_Initialize()
 ' 當物件類別初始化時,設置預設屬性值
 m_Visible = True
 
 m_TextFont.Size = 15
 m_TextFont.Bold = True
 m_ShadowFont.Size = 15
 m_ShadowFont.Bold = True
 m_ShadowFont.Italic = True

 m_TextColor = RGB(0, 255, 0)
 m_ShadowColor = RGB(255, 0, 0)
 m_ShadowDeflectX = -2
 m_ShadowDeflectY = 2
End Sub

Public Sub TextOut(textString As String, Optional ByVal X As Single, Optional ByVal Y As Single, Optional inContainer As Object)
 ' 當指定 inContainer 參數,並且當
 ' 尚未實體化 lblMain 與 lblShadow,則新增這些 Label 控件

 If Not inContainer Is Nothing Then creatControl inContainer
 ' 移動控件到指定位置,包括指定的 Container
 Me.Move X, Y, inContainer
 
 ' 設置控件 lblMain 的屬性值
 With lblMain
  Set .Font = m_TextFont
  .BackStyle = 0
  .ForeColor = m_TextColor
  .Alignment = vbCenter
  .AutoSize = True
  .Caption = textString
  .Visible = m_Visible
 End With
 
 ' 設置控件 lblShadow 的屬性值
 With lblShadow
  Set .Font = m_ShadowFont
  .BackStyle = 0
  .ForeColor = m_ShadowColor
  .Alignment = vbCenter
  .AutoSize = True
  .Caption = textString
  .Visible = m_Visible
 End With
End Sub

' 當尚未實體化 lblMain 與 lblShadow,則新增這些 Label 控件
Private Sub creatControl(inContainer As Object)
 Dim inForm As Form, uniqueName As String
 
 If Not isCreatedCtr Then
  ' 確認新增控件所屬的表單
  If TypeOf inContainer Is Form Then Set inForm = inContainer Else Set inForm = inContainer.Parent
  ' 動態新增控件時,必須設定相異的標識字串,例如以下的 uniqueName
  ' uniqueName 是根據目前表單的控件總數,所以不會有重複定義的情況

  uniqueName = "X" & CStr(inForm.Controls.Count)
  Set lblMain = inForm.Controls.Add("VB.Label", uniqueName & "_1", inContainer)
  Set lblShadow = inForm.Controls.Add("VB.Label", uniqueName & "_2", inContainer)
  isCreatedCtr = True
 End If
End Sub

' 當指定不同 inContainer 參數,則改變控件的 Container
Private Sub changeContainer(inContainer As Object)
 If Not lblMain.Container Is inContainer Then
  Set lblMain.Container = inContainer
  Set lblShadow.Container = inContainer
 End If
End Sub

' 移動控件到指定位置,包括指定的 Container
Public Sub Move(ByVal X As Single, ByVal Y As Single, Optional inContainer As Object)
 If isCreatedCtr Then
  lblMain.Move X, Y
  lblShadow.Move X + m_ShadowDeflectX, Y + m_ShadowDeflectY
  lblMain.Container.Refresh
  If Not inContainer Is Nothing Then changeContainer inContainer
 Else
  ' 當控件沒有指定 Container,則產生執行階段的錯誤訊息
  Err.Raise 513, , "請先使用 TextOut 方法設置 inContainer 參數"
 End If
End Sub

' 以下是事件在執行階段的設定與引發
Private Sub lblMain_Click()
 RaiseEvent Click
End Sub

Private Sub lblMain_KeyDown(KeyCode As Integer, Shift As Integer)
 RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Private Sub lblMain_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

範例源碼下載
2004/10/20