home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / sgwnd10 / csgwindo.cls < prev    next >
Encoding:
Visual Basic class definition  |  1998-08-10  |  7.8 KB  |  247 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "sgWindowTemplate"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
  11. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  12. '--------------------------------------------------------------------------
  13. ' File: CSGWINDOWTEMPLATE.CLS
  14. '
  15. ' This file is part of the 'Stinga sgWindow Wizard' project.
  16. ' Copyright (C) 1998 Stinga
  17. ' All rights reserved.
  18. '--------------------------------------------------------------------------
  19.  
  20. Private mvarProject As String           ' Updated project
  21. Private mvarCodeModule As String        ' File name of the module that will contain wizard code
  22. Private mvarFirstMessage As Long        ' First message in the range of the handled messages
  23. Private mvarLastMessage As Long         ' Last message in the range of the handled messages
  24. Private mvarForm As String              ' Name of the subclassed form or form that contain subclassed control
  25. Private mvarControl As String           ' Name of the sublassed control or empty string if no control is subclassed
  26. Private mvarHandlerName As String       ' Handler variable name
  27. Private mvarTemplateFile As String      ' Name of the file that contain code template
  28. Private mvarTemplate As String          ' Code template
  29.  
  30. ' sgWindow type library
  31. Public TypeLib As TypeLibInfo
  32.  
  33. Const sparCodeModule = "CodeModule"
  34. Const sparHandlerName = "HandlerName"
  35. Const sparWindowHandle = "WindowHandle"
  36. Const sparFirstMessage = "FirstMessage"
  37. Const sparLastMessage = "LastMessage"
  38.  
  39.  
  40.  
  41. Private Function MsgName(msg&)
  42.     MsgName = "UNKNOWN"
  43.     Dim mi As MemberInfo
  44.     For Each mi In TypeLib.TypeInfos.NamedItem("WinMsg").Members
  45.         If (mi.Value = msg) Then MsgName = mi.name: Exit Function
  46.     Next
  47. End Function
  48.  
  49. Public Sub Clear()
  50.     mvarFirstMessage = wm_NULL
  51.     mvarLastMessage = wm_NULL
  52.     mvarHandlerName = ""
  53.     mvarProject = ""
  54.     mvarCodeModule = ""
  55.     mvarForm = ""
  56.     mvarControl = ""
  57.     mvarTemplateFile = ""
  58.     mvarTemplate = ""
  59.  
  60.     ' Load sgWindow type library
  61.     Set TypeLib = New TypeLibInfo
  62.     TypeLib.LoadRegTypeLib "{485B1F95-F7E3-11D1-9825-204C4F4F5020}", 1, 0, 0
  63. End Sub
  64.  
  65. Public Function UpdateCodeModule(code As CodeModule, sName$) As Boolean
  66.     On Error GoTo Error_
  67.  
  68.     UpdateCodeModule = False
  69.     If (code Is Nothing) Then Exit Function
  70.     
  71.     ' Make sure that we have code template
  72.     If (TemplateFile = "") Then Exit Function
  73.     
  74.     ' Create code template parser object
  75.     Dim codeTemplate As sgCodeTemplate
  76.     Set codeTemplate = New sgCodeTemplate
  77.     codeTemplate.TemplateFile = TemplateFile
  78.     codeTemplate.Parameters.Add sparHandlerName, HandlerName
  79.     codeTemplate.Parameters.Add sparCodeModule, sName
  80.     codeTemplate.Parameters.Add sparFirstMessage, MsgName(FirstMessage)
  81.     codeTemplate.Parameters.Add sparLastMessage, MsgName(LastMessage)
  82.     If (ControlName = "") Then
  83.         codeTemplate.Parameters.Add sparWindowHandle, "Me.HWND"
  84.     Else
  85.         codeTemplate.Parameters.Add sparWindowHandle, ControlName & ".HWND"
  86.     End If
  87.     
  88.     ' Parse declaration block
  89.     Dim sCode$
  90.     Dim block As CodeBlock
  91.     codeTemplate.name = "Declare"
  92.     If (codeTemplate.Blocks.Count < 1) Then RaiseError 1, " (Declare)"
  93.     For Each block In codeTemplate.Blocks
  94.         ' Create handler variable declaration if it does not exist
  95.         On Error Resume Next
  96.         Dim hndlr As Member
  97.         Set hndlr = code.Members.Item(HandlerName)
  98.         On Error GoTo Error_
  99.         If (hndlr Is Nothing) Then
  100.             block.InsertCode code
  101.         End If
  102.     Next
  103.     
  104.     ' Parse handler block
  105.     codeTemplate.name = "Handle"
  106.     If (codeTemplate.Blocks.Count < 1) Then RaiseError 1, " (Handle)"
  107.     For Each block In codeTemplate.Blocks
  108.         block.InsertCode code
  109.     Next
  110.     
  111.     ' Parse init block
  112.     codeTemplate.name = "Init"
  113.     If (codeTemplate.Blocks.Count < 1) Then RaiseError 1, " (Init)"
  114.     For Each block In codeTemplate.Blocks
  115.         block.InsertCode code
  116.     Next
  117.     
  118.     UpdateCodeModule = True
  119.     Exit Function
  120. Error_:
  121.     MsgBox Error$
  122. End Function
  123.  
  124. Public Property Let HandlerName(ByVal vData As String)
  125.     mvarHandlerName = vData
  126. End Property
  127.  
  128. Public Property Get HandlerName() As String
  129.     HandlerName = mvarHandlerName
  130. End Property
  131.  
  132. Public Property Get DescriptionText() As String
  133.     
  134.     ' Subclassed window description
  135.     If FormName = "" And ControlName = "" Then
  136.         DescriptionText = "There is no selected window": Exit Property
  137.     End If
  138.     If FormName <> "" And ControlName = "" Then
  139.         DescriptionText = "Subclassed form is '" & FormName & "'" + vbCrLf
  140.     End If
  141.     If FormName <> "" And ControlName <> "" Then
  142.         DescriptionText = "Subclassed control is '" & ControlName & _
  143.                           "' located on the '" & FormName & "'" + vbCrLf
  144.     End If
  145.     
  146.     ' Handled messages description
  147.     If (FirstMessage <> wm_NULL) Then
  148.         If (LastMessage = FirstMessage) Then
  149.             DescriptionText = DescriptionText & _
  150.                 "Handled message is " & UCase(MsgName(FirstMessage)) & vbCrLf
  151.         Else
  152.             DescriptionText = DescriptionText & _
  153.                 "Handled message range is from " & _
  154.                 UCase(MsgName(FirstMessage)) & " to " & _
  155.                 UCase(MsgName(LastMessage)) & vbCrLf
  156.         End If
  157.     End If
  158.     
  159.     ' Handler object description
  160.     If (HandlerName <> "") Then
  161.         DescriptionText = DescriptionText & _
  162.             "Handler object name is '" & HandlerName & "'"
  163.     End If
  164. End Property
  165.  
  166. Public Property Let ControlName(ByVal vData As String)
  167. Attribute ControlName.VB_Description = "Subclassed control or Nothing if subclassed item is not control"
  168.     mvarControl = vData
  169. End Property
  170.  
  171. Public Property Get ControlName() As String
  172.     ControlName = mvarControl
  173. End Property
  174.  
  175. Public Property Let FormName(ByVal vData As String)
  176. Attribute FormName.VB_Description = "Subclassed form or form that contain subclassed control."
  177.     mvarForm = vData
  178. End Property
  179.  
  180. Public Property Get FormName() As String
  181.     FormName = mvarForm
  182. End Property
  183.  
  184. Public Property Let TemplateFile(ByVal vData As String)
  185.     mvarTemplateFile = vData
  186. End Property
  187.  
  188. Public Property Get TemplateFile() As String
  189.     TemplateFile = mvarTemplateFile
  190. End Property
  191.  
  192. Public Property Let LastMessage(ByVal vData As Long)
  193.     mvarLastMessage = vData
  194. End Property
  195.  
  196. Public Property Get LastMessage() As Long
  197.     LastMessage = mvarLastMessage
  198. End Property
  199.  
  200. Public Property Let FirstMessage(ByVal vData As Long)
  201.     mvarFirstMessage = vData
  202. End Property
  203.  
  204. Public Property Get FirstMessage() As Long
  205.     FirstMessage = mvarFirstMessage
  206. End Property
  207.  
  208. Public Property Let CodeModule(ByVal vData As String)
  209.     mvarCodeModule = vData
  210. End Property
  211.  
  212. Public Property Get CodeModule() As String
  213.     CodeModule = mvarCodeModule
  214. End Property
  215.  
  216. Public Property Let Project(ByVal vData As String)
  217.     mvarProject = vData
  218. End Property
  219.  
  220. Public Property Get Project() As String
  221.     Project = mvarProject
  222. End Property
  223.  
  224. Private Sub Class_Initialize()
  225.     mvarFirstMessage = wm_NULL
  226.     mvarLastMessage = wm_NULL
  227.     mvarHandlerName = ""
  228.     
  229.     ' Load sgWindow type library
  230.     Set TypeLib = New TypeLibInfo
  231.     TypeLib.LoadRegTypeLib "{485B1F95-F7E3-11D1-9825-204C4F4F5020}", 1, 0, 0
  232. End Sub
  233.  
  234. Private Sub RaiseError(nErr%, Optional sText$ = "")
  235.     Err.Raise vbError + 1, "sgWindowWizard", ErrMsg(nErr) + sText, 0, 0
  236. End Sub
  237.  
  238. Private Function ErrMsg(nErr%)
  239.     Select Case nErr
  240.     Case 1
  241.         ErrMsg = "Code block does not exist"
  242.     
  243.     Case Else
  244.         ErrMsg = "Unknown error"
  245.     End Select
  246. End Function
  247.