home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / A_ScriptMa1782528162004.psc / EditSubDefinition.frm < prev    next >
Text File  |  2004-08-10  |  10KB  |  342 lines
  1. VERSION 5.00
  2. Begin VB.Form EditSubDefinition 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "New SubRoutine"
  5.    ClientHeight    =   5175
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   6015
  9.    BeginProperty Font 
  10.       Name            =   "Arial"
  11.       Size            =   8.25
  12.       Charset         =   0
  13.       Weight          =   700
  14.       Underline       =   0   'False
  15.       Italic          =   0   'False
  16.       Strikethrough   =   0   'False
  17.    EndProperty
  18.    Icon            =   "EditSubDefinition.frx":0000
  19.    LinkTopic       =   "Form1"
  20.    MaxButton       =   0   'False
  21.    MinButton       =   0   'False
  22.    ScaleHeight     =   5175
  23.    ScaleWidth      =   6015
  24.    StartUpPosition =   1  'CenterOwner
  25.    Begin VB.OptionButton Option1 
  26.       Caption         =   "Function"
  27.       Height          =   255
  28.       Index           =   1
  29.       Left            =   2940
  30.       TabIndex        =   11
  31.       TabStop         =   0   'False
  32.       Top             =   360
  33.       Width           =   1755
  34.    End
  35.    Begin VB.OptionButton Option1 
  36.       Caption         =   "SubRoutine"
  37.       Height          =   255
  38.       Index           =   0
  39.       Left            =   1080
  40.       TabIndex        =   10
  41.       TabStop         =   0   'False
  42.       Top             =   360
  43.       Value           =   -1  'True
  44.       Width           =   1755
  45.    End
  46.    Begin VB.ComboBox Combo1 
  47.       Height          =   330
  48.       ItemData        =   "EditSubDefinition.frx":0442
  49.       Left            =   1080
  50.       List            =   "EditSubDefinition.frx":044C
  51.       Style           =   2  'Dropdown List
  52.       TabIndex        =   0
  53.       Top             =   1080
  54.       Width           =   3855
  55.    End
  56.    Begin VB.CommandButton Command1 
  57.       Cancel          =   -1  'True
  58.       Caption         =   "&Cancel"
  59.       Height          =   435
  60.       Index           =   1
  61.       Left            =   4320
  62.       TabIndex        =   4
  63.       Top             =   4680
  64.       Width           =   1515
  65.    End
  66.    Begin VB.CommandButton Command1 
  67.       Caption         =   "&Save"
  68.       Height          =   435
  69.       Index           =   0
  70.       Left            =   240
  71.       TabIndex        =   3
  72.       Top             =   4680
  73.       Width           =   1515
  74.    End
  75.    Begin VB.TextBox Text1 
  76.       BeginProperty Font 
  77.          Name            =   "MS Sans Serif"
  78.          Size            =   8.25
  79.          Charset         =   0
  80.          Weight          =   400
  81.          Underline       =   0   'False
  82.          Italic          =   0   'False
  83.          Strikethrough   =   0   'False
  84.       EndProperty
  85.       Height          =   375
  86.       Index           =   1
  87.       Left            =   1080
  88.       TabIndex        =   2
  89.       Top             =   2400
  90.       Width           =   3855
  91.    End
  92.    Begin VB.TextBox Text1 
  93.       BeginProperty Font 
  94.          Name            =   "MS Sans Serif"
  95.          Size            =   8.25
  96.          Charset         =   0
  97.          Weight          =   400
  98.          Underline       =   0   'False
  99.          Italic          =   0   'False
  100.          Strikethrough   =   0   'False
  101.       EndProperty
  102.       Height          =   375
  103.       Index           =   0
  104.       Left            =   1080
  105.       MaxLength       =   32
  106.       TabIndex        =   1
  107.       Text            =   "MySubRoutine"
  108.       Top             =   1740
  109.       Width           =   3855
  110.    End
  111.    Begin VB.Label Label1 
  112.       BackStyle       =   0  'Transparent
  113.       Caption         =   "SubRoutine Scope"
  114.       Height          =   255
  115.       Index           =   0
  116.       Left            =   1080
  117.       TabIndex        =   9
  118.       Top             =   840
  119.       Width           =   3795
  120.    End
  121.    Begin VB.Image Image1 
  122.       Height          =   480
  123.       Index           =   1
  124.       Left            =   5520
  125.       Picture         =   "EditSubDefinition.frx":0461
  126.       Stretch         =   -1  'True
  127.       Top             =   60
  128.       Width           =   480
  129.    End
  130.    Begin VB.Image Image1 
  131.       Height          =   480
  132.       Index           =   0
  133.       Left            =   0
  134.       Picture         =   "EditSubDefinition.frx":08A3
  135.       Stretch         =   -1  'True
  136.       Top             =   60
  137.       Width           =   480
  138.    End
  139.    Begin VB.Label Label3 
  140.       Caption         =   "Prototype"
  141.       Height          =   195
  142.       Left            =   60
  143.       TabIndex        =   8
  144.       Top             =   2820
  145.       Width           =   3195
  146.    End
  147.    Begin VB.Label Label2 
  148.       BackStyle       =   0  'Transparent
  149.       BeginProperty Font 
  150.          Name            =   "Arial"
  151.          Size            =   9.75
  152.          Charset         =   0
  153.          Weight          =   400
  154.          Underline       =   0   'False
  155.          Italic          =   0   'False
  156.          Strikethrough   =   0   'False
  157.       EndProperty
  158.       Height          =   1335
  159.       Left            =   120
  160.       TabIndex        =   7
  161.       Top             =   3120
  162.       UseMnemonic     =   0   'False
  163.       Width           =   5835
  164.       WordWrap        =   -1  'True
  165.    End
  166.    Begin VB.Label Label1 
  167.       BackStyle       =   0  'Transparent
  168.       Caption         =   "Parameters"
  169.       Height          =   255
  170.       Index           =   3
  171.       Left            =   1080
  172.       TabIndex        =   6
  173.       Top             =   2220
  174.       Width           =   3855
  175.    End
  176.    Begin VB.Label Label1 
  177.       BackStyle       =   0  'Transparent
  178.       Caption         =   "SubRoutine Name"
  179.       Height          =   255
  180.       Index           =   1
  181.       Left            =   1080
  182.       TabIndex        =   5
  183.       Top             =   1500
  184.       Width           =   3855
  185.    End
  186. End
  187. Attribute VB_Name = "EditSubDefinition"
  188. Attribute VB_GlobalNameSpace = False
  189. Attribute VB_Creatable = False
  190. Attribute VB_PredeclaredId = True
  191. Attribute VB_Exposed = False
  192. Option Explicit
  193. Private IsLoaded As Boolean
  194. Public InitClassType As Integer
  195.  
  196.  
  197. Private Sub Combo1_Click()
  198. SetLabel2
  199. End Sub
  200.  
  201. Private Sub Command1_Click(Index As Integer)
  202. Dim buff$
  203. Dim clsName As String
  204. clsName = IIf(Option1(0).Value = True, "SUBROUTINES", "FUNCTIONS")
  205. Select Case Index
  206.     Case 0
  207.         If ValidateData() Then
  208.             If frmCodeMain.ItemExists(Text1(0).Text) Then
  209.                 MsgBox "An object called '" & Text1(0).Text & "' already exists in your project.  Choose another name.", vbCritical, "Error.."
  210.                 Text1(0).SetFocus
  211.                 Exit Sub
  212.             End If
  213.             If Not ValidateParameterList(Text1(1).Text) Then
  214.                 Text1(1).SetFocus
  215.                 Exit Sub
  216.             End If
  217.             Text1(1).Text = FormatParameterList(Text1(1).Text)
  218.             buff$ = MakeSubXML()
  219.             If frmCodeMain.AddProjectItem(clsName, buff$) Then
  220.                 Unload Me
  221.                 Exit Sub
  222.             End If
  223.         End If
  224.     Case 1
  225.         Unload Me
  226. End Select
  227. End Sub
  228. Private Function MakeSubXML() As String
  229. Dim ob1 As New QSXML
  230. Dim nd As Object
  231. Dim strXML As String
  232. Dim buff$
  233. With ob1
  234.     .Initialize pavAUTO
  235.     If Option1(0).Value Then
  236.     .CreateRootElement "", "SUBROUTINE"
  237.     Else
  238.     .CreateRootElement "", "FUNCTION"
  239.     End If
  240.     Set nd = .GetRootElement()
  241.     .SetAttribute nd, "NAME", Text1(0).Text
  242.     .SetAttribute nd, "PARAMETERS", Text1(1).Text
  243.     .SetAttribute nd, "SCOPE", Combo1.Text
  244.     If Option1(0).Value Then
  245.         buff$ = "'" & vbLf
  246.         buff$ = buff$ & "MsgBox " & Dquote("TO DO: Add processing code for " & Text1(0).Text) & vbLf
  247.         buff$ = buff$ & "'" & vbLf
  248.     Else
  249.         buff$ = "'" & vbLf
  250.         buff$ = buff$ & "Dim retValue " & vbLf & Text1(0).Text & " = retValue " & vbLf
  251.         buff$ = buff$ & "MsgBox " & Dquote("TO DO: Add processing code for " & Text1(0).Text) & vbLf
  252.         buff$ = buff$ & "'" & vbLf
  253.     End If
  254.     nd.Text = buff$
  255.     strXML = .XML
  256. End With
  257. MakeSubXML = strXML
  258. Set ob1 = Nothing
  259. End Function
  260. Private Function ValidateData() As Boolean
  261. Dim buff$
  262. Text1(0) = Trim$(Text1(0))
  263. Text1(1) = Trim$(Text1(1))
  264. buff$ = Text1(0)
  265. If buff$ = "" Then
  266.     MsgBox "Enter an object name", vbCritical, "Error.."
  267.     Text1(0).SetFocus
  268.     ValidateData = False
  269.     Exit Function
  270. End If
  271. If InStr(buff$, " ") > 0 Then
  272.     MsgBox "Names may not contain spaces.", vbCritical, "Error.."
  273.     ValidateData = False
  274.     Exit Function
  275. End If
  276. If InStr(CALPHA, UCase$(Left$(buff$, 1))) = 0 Then
  277.     MsgBox "Object names must begin with A-Z or a-z", vbCritical, "Error.."
  278.     ValidateData = False
  279.     Exit Function
  280. End If
  281. ValidateData = True
  282. End Function
  283.  
  284. Private Sub Form_Activate()
  285. If Not IsLoaded Then
  286.     Text1(0).SetFocus
  287.     IsLoaded = True
  288. End If
  289. End Sub
  290.  
  291. Private Sub Form_Load()
  292. Dim i As Long
  293. Option1(InitClassType).Value = True
  294. If Option1(0).Value Then
  295.     i = frmCodeMain.CountChildren("SUBROUTINES")
  296.     Text1(0).Text = "MySubRoutine" & i + 1
  297. Else
  298.     i = frmCodeMain.CountChildren("FUNCTIONS")
  299.     Text1(0).Text = "MyFunction" & i + 1
  300. End If
  301. Combo1.ListIndex = 0
  302. SetLabel2
  303. Text1(0).SelLength = Len(Text1(0).Text)
  304. End Sub
  305.  
  306. Private Sub Form_Unload(Cancel As Integer)
  307. InitClassType = 0
  308. IsLoaded = False
  309. End Sub
  310.  
  311. Private Sub Option1_Click(Index As Integer)
  312. If Option1(0).Value Then
  313.     Label1(0).Caption = "SubRoutine Scope"
  314.     Label1(1).Caption = "SubRoutine Name"
  315.     Me.Caption = "New SubRoutine"
  316. Else
  317.     Label1(0).Caption = "Function Scope"
  318.     Label1(1).Caption = "Function Name"
  319.     Me.Caption = "New Function"
  320. End If
  321. SetLabel2
  322. End Sub
  323.  
  324. Private Sub Text1_Change(Index As Integer)
  325. SetLabel2
  326. End Sub
  327. Private Sub SetLabel2()
  328. Dim buff$
  329. If Option1(0).Value Then
  330. buff$ = Combo1.Text & " Sub " & Trim$(Text1(0).Text) & "(" & _
  331. Trim$(Text1(1).Text) & ")" & vbLf & vbLf & "End Sub"
  332. Label2.Caption = buff$
  333. Else
  334. buff$ = Combo1.Text & " Function " & Trim$(Text1(0).Text) & "(" & _
  335. Trim$(Text1(1).Text) & ")" & vbLf
  336. buff$ = buff$ & "Dim retValue" & vbLf & _
  337. Text1(0).Text & " = retValue"
  338. buff$ = buff$ & vbLf & "End Sub"
  339. Label2.Caption = buff$
  340. End If
  341. End Sub
  342.