【VB 物件】ShadowText 演示有陰影的藝術字體

#E6E6E6

作者：吳文成

　　雖然 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