home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / sgwnd10 / sgcodete.cls < prev    next >
Encoding:
Visual Basic class definition  |  1998-06-17  |  3.5 KB  |  124 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "sgCodeTemplate"
  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. Attribute VB_Ext_KEY = "Member0" ,"CodeBlocks"
  13. Option Explicit
  14.  
  15. Private mvarTemplateFile As String
  16. Private mvarName As String
  17. Private mvarCodeBlocks As CodeBlocks
  18. Private mvarParameters As Parameters
  19.  
  20.  
  21. Const skeySectOpen = "{{"
  22. Const skeySectClose = "}}"
  23. Const skeyCodeBlock = "{CodeBlock}"
  24. Const skeyEndCode = "{EndCode}"
  25.  
  26.  
  27.  
  28. Public Property Get Blocks() As CodeBlocks
  29.     Set Blocks = mvarCodeBlocks
  30. End Property
  31.  
  32. Public Property Get TemplateFile() As String
  33. Attribute TemplateFile.VB_Description = "Full template file path"
  34.     TemplateFile = mvarTemplateFile
  35. End Property
  36.  
  37. Public Property Let TemplateFile(ByVal vData As String)
  38.     mvarTemplateFile = vData
  39.     If (mvarName <> "") Then Update
  40. End Property
  41.  
  42. Public Property Get Name() As String
  43.     Name = mvarName
  44. End Property
  45.  
  46. Public Property Let Name(Name As String)
  47.     mvarName = Name
  48.     If (mvarTemplateFile <> "") Then Update
  49. End Property
  50.  
  51. Public Property Get Parameters() As Parameters
  52.     If mvarParameters Is Nothing Then
  53.         Set mvarParameters = New Parameters
  54.     End If
  55.     Set Parameters = mvarParameters
  56. End Property
  57.  
  58.  
  59. '----------------------------------------------------------------------
  60. ' Implementation
  61. '----------------------------------------------------------------------
  62. Private Sub Update()
  63.     On Error GoTo Error_
  64.     
  65.     Set mvarCodeBlocks = Nothing
  66.     Set mvarCodeBlocks = New CodeBlocks
  67.     If (mvarTemplateFile = "") Or (mvarName = "") Then Exit Sub
  68.     
  69.     ' Read template file
  70.     Dim sFileText$, nFileNum%
  71.     nFileNum = FreeFile
  72.     Open mvarTemplateFile For Input As nFileNum
  73.     sFileText = Input(LOF(nFileNum), nFileNum)
  74.     Close nFileNum
  75.     
  76.     ' Find section with specified name
  77.     Dim sSection$, sSectName$, nSectStart&, nSectEnd&
  78.     sSectName = skeySectOpen & mvarName & skeySectClose
  79.     nSectStart = InStr(sFileText, sSectName)
  80.     If (nSectStart = 0) Then Exit Sub
  81.     nSectStart = nSectStart + Len(sSectName)
  82.     sSection = Mid(sFileText, nSectStart)
  83.     
  84.     ' Find end of the section
  85.     nSectEnd = InStr(sSection, skeySectOpen)
  86.     If (nSectEnd > 0) Then
  87.         sSection = Left(sSection, nSectEnd - 1)
  88.     End If
  89.     sSection = Str_Trim(sSection)
  90.     
  91.     ' Parse all code blocks
  92.     Dim sCodeBlock$, nCodeBlockStart&, nCodeBlockEnd&
  93.     nCodeBlockEnd = 1
  94.     Do
  95.         ' Extract code block string
  96.         nCodeBlockStart = InStr(nCodeBlockEnd, sSection, skeyCodeBlock)
  97.         If (nCodeBlockStart = 0) Then Exit Do
  98.         nCodeBlockEnd = InStr(nCodeBlockStart, sSection, skeyEndCode)
  99.         If (nCodeBlockEnd < nCodeBlockStart) Then Exit Do
  100.         nCodeBlockEnd = nCodeBlockEnd + Len(skeyEndCode)
  101.         sCodeBlock = Mid(sSection, nCodeBlockStart, nCodeBlockEnd - nCodeBlockStart)
  102.         
  103.         ' Create code block object
  104.         Dim block As codeBlock
  105.         Set block = New codeBlock
  106.         block.Initialize sCodeBlock, mvarParameters
  107.         mvarCodeBlocks.Add block, block.Name
  108.     Loop
  109.     
  110.     Exit Sub
  111. Error_:
  112.     MsgBox Error$
  113. End Sub
  114.  
  115. Private Sub Class_Initialize()
  116.     Set mvarCodeBlocks = New CodeBlocks
  117.     Set mvarParameters = Nothing
  118. End Sub
  119.  
  120. Private Sub Class_Terminate()
  121.     Set mvarCodeBlocks = Nothing
  122.     Set mvarParameters = Nothing
  123. End Sub
  124.