home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / simple5a / brain.bas next >
Encoding:
BASIC Source File  |  1999-09-19  |  9.1 KB  |  331 lines
  1. Attribute VB_Name = "Brain"
  2. Option Explicit
  3.  
  4. Global HTMLData As Boolean
  5. Dim htmrows As Long
  6. Dim htmcols As Long
  7. Dim htmtitle As String
  8.  
  9.  
  10.  
  11.  
  12. Sub main()
  13.     HTMLData = False
  14.     frmHTMLEditor.Show
  15. End Sub
  16.  
  17. Function AddLinkTable(ColumnCount As Long, RowCount As Long, TitleLine As String) As String
  18. 'Add table with embedded HTML links
  19. Dim Temp$
  20. Dim j As Long
  21. Dim k As Long
  22. Dim Quote$
  23. Quote$ = Chr$(34)
  24.  
  25. Temp$ = "<TABLE WIDTH=100% BORDER=4>" & vbCrLf
  26. Temp$ = Temp$ & "<TR>" & vbCrLf
  27. Temp$ = Temp$ & "<TH COLSPAN=" & ColumnCount
  28. Temp$ = Temp$ & "><FONT SIZE=5>" & TitleLine & "<FONT SIZE=3></TH>" & vbCrLf
  29. Temp$ = Temp$ & "</TR>" & vbCrLf
  30.  
  31. For j = 1 To RowCount
  32.     Temp$ = Temp$ & "<TR>" & vbCrLf & "<TD><A HREF=" & Quote$ & "siteaddr" & Quote$ & ">" & "sitelbl" & "</A><BR></TD>" & vbCrLf
  33.     If ColumnCount > 1 Then
  34.         For k = 2 To ColumnCount
  35.             Temp$ = Temp$ & "<TD><A HREF=" & Quote$ & "siteaddr" & Quote$ & " >" & "sitelbl" & " </A><BR></TD>" & vbCrLf
  36.         Next k
  37.     End If
  38.     Temp$ = Temp$ & "</TR>" & vbCrLf & vbCrLf
  39.     
  40. Next j
  41.  
  42. Temp$ = Temp$ & "</TABLE>" & vbCrLf & "<BR>" & vbCrLf
  43.  
  44. AddLinkTable = Temp$
  45. End Function
  46. Function AddTable(ColumnCount As Long, RowCount As Long, TitleLine As String) As String
  47. 'Add table
  48. Dim Temp$
  49. Dim j As Long
  50. Dim k As Long
  51. Dim Quote$
  52. Quote$ = Chr$(34)
  53.  
  54. Temp$ = "<TABLE WIDTH=100% BORDER=4>" & vbCrLf
  55. Temp$ = Temp$ & "<TR>" & vbCrLf
  56. Temp$ = Temp$ & "<TH COLSPAN=" & ColumnCount
  57. Temp$ = Temp$ & "><FONT SIZE=5>" & TitleLine & "<FONT SIZE=3></TH>" & vbCrLf
  58. Temp$ = Temp$ & "</TR>" & vbCrLf
  59.  
  60. For j = 1 To RowCount
  61.     Temp$ = Temp$ & "<TR>" & vbCrLf & "<TD>" & "data" & "<BR></TD>" & vbCrLf
  62.     If ColumnCount > 1 Then
  63.         For k = 2 To ColumnCount
  64.             Temp$ = Temp$ & "<TD>" & "data" & "<BR></TD>" & vbCrLf
  65.         Next k
  66.     End If
  67.     Temp$ = Temp$ & "</TR>" & vbCrLf & vbCrLf
  68.     
  69. Next j
  70.  
  71. Temp$ = Temp$ & "</TABLE>" & vbCrLf & "<BR>" & vbCrLf
  72.  
  73. AddTable = Temp$
  74. End Function
  75.  
  76. Function AddPicElement(PictureName As String, BorderValue As Integer) As String
  77.     AddPicElement = "<IMG SRC=" & PictureName & " BORDER=" & BorderValue & ">" & vbCrLf
  78. End Function
  79.  
  80. Sub ColorsOn()
  81.     With frmHTMLEditor
  82.         .cmdBTApproved.Visible = True
  83.         .rtbHTML.Visible = False
  84.         .txtPicture.Visible = True
  85.         .cmdPicture.Visible = True
  86.         .Label1(4).Visible = True
  87.         .Combo1.Visible = True
  88.         .Combo2.Visible = True
  89.         .Combo3.Visible = True
  90.         .Combo4.Visible = True
  91.         .Label1(0).Visible = True
  92.         .Label1(1).Visible = True
  93.         .Label1(2).Visible = True
  94.         .Label1(3).Visible = True
  95.         .cmdColorDone.Visible = True
  96.         .cmdCancelColor.Visible = True
  97.         .Combo1.SetFocus
  98.     End With
  99. End Sub
  100.  
  101. Sub ColorsOff()
  102.     With frmHTMLEditor
  103.         .cmdBTApproved.Visible = False
  104.         .rtbHTML.Visible = True
  105.         .txtPicture.Visible = False
  106.         .cmdPicture.Visible = False
  107.         .Label1(4).Visible = False
  108.         .Combo1.Visible = False
  109.         .Combo2.Visible = False
  110.         .Combo3.Visible = False
  111.         .Combo4.Visible = False
  112.         .Label1(0).Visible = False
  113.         .Label1(1).Visible = False
  114.         .Label1(2).Visible = False
  115.         .Label1(3).Visible = False
  116.         .cmdColorDone.Visible = False
  117.         .cmdCancelColor.Visible = False
  118.     End With
  119. End Sub
  120.  
  121. Sub StuffColors(Trgt As ComboBox)
  122.     Trgt.Clear
  123.     Trgt.AddItem "Aqua"
  124.     Trgt.AddItem "Black"
  125.     Trgt.AddItem "Blue"
  126.     Trgt.AddItem "Fuchsia"
  127.     Trgt.AddItem "Gray"
  128.     Trgt.AddItem "Green"
  129.     Trgt.AddItem "Lime"
  130.     Trgt.AddItem "Maroon"
  131.     Trgt.AddItem "Navy"
  132.     Trgt.AddItem "Olive"
  133.     Trgt.AddItem "Purple"
  134.     Trgt.AddItem "Red"
  135.     Trgt.AddItem "Silver"
  136.     Trgt.AddItem "Teal"
  137.     Trgt.AddItem "White"
  138.     Trgt.AddItem "Yellow"
  139.     Trgt.Text = "White"
  140. End Sub
  141.  
  142. Function BodyColorScheme() As String
  143.     Dim Temp$
  144.     Dim Quote$
  145.     Quote$ = Chr$(34)
  146.     
  147. '<BODY BACKGROUND="e:\smachine\downloads\bondage\sh1016.jpg" BGCOLOR="Tan" TEXT="MAROON" LINK="AQUA" VLINK="BLUE" >
  148.     
  149.     
  150.     With frmHTMLEditor
  151.     '<BODY BGCOLOR="PURPLE"" TEXT="WHITE" LINK="AQUA" VLINK="RED" >
  152.         If Len(Trim(.txtPicture.Text)) < 1 Then
  153.         Temp$ = "<BODY BGCOLOR=" & Quote$ & .Combo1.Text & Quote$ & " TEXT=" & Quote$ & .Combo2.Text & Quote$ & _
  154.             " LINK=" & Quote$ & .Combo3.Text & Quote$ & " VLINK=" & Quote$ & .Combo4.Text & Quote$ & " >"
  155.         Else
  156.         Temp$ = "<BODY BACKGROUND=" & Quote$ & .txtPicture.Text & Quote$ & " BGCOLOR=" & Quote$ & .Combo1.Text & Quote$ & " TEXT=" & Quote$ & .Combo2.Text & Quote$ & _
  157.             " LINK=" & Quote$ & .Combo3.Text & Quote$ & " VLINK=" & Quote$ & .Combo4.Text & Quote$ & " >"
  158.         End If
  159.     End With
  160.     
  161.     BodyColorScheme = Temp$
  162. End Function
  163.  
  164. Function PickAPicture() As String
  165.     With frmHTMLEditor
  166.     .CommonDialog1.DialogTitle = "Select a picture file."
  167.     .CommonDialog1.Flags = &H4& Or &H2&
  168.     .CommonDialog1.DefaultExt = "JPG"
  169.     .CommonDialog1.Filter = "JPeg (*.jpg)|*.jpg|GIF (*.gif)|*.gif|BMP (*.BMP)|*.bmp"
  170.     .CommonDialog1.ShowOpen
  171.  
  172.     PickAPicture = .CommonDialog1.FileName
  173.     
  174.     End With
  175. End Function
  176.  
  177. Sub SaveAPage()
  178.     With frmHTMLEditor
  179.     
  180.     .CommonDialog1.DialogTitle = "SAVE HTML FILE"
  181.     .CommonDialog1.Filter = "HTML Files (*.html)|*.html|HTM Files (*.htm)|*.htm)"
  182.     .CommonDialog1.DefaultExt = "HTML"
  183.     .CommonDialog1.Flags = &H4& Or &H2&
  184.     .CommonDialog1.ShowSave
  185.         
  186.     Dim fileNum As Integer
  187.     fileNum = FreeFile
  188.     
  189.     If .CommonDialog1.FileName <> "" Then
  190.         Open .CommonDialog1.FileName For Output As #fileNum
  191.         Print #fileNum, .rtbHTML.Text
  192.         Close #fileNum
  193.     End If
  194.     
  195.     End With
  196. End Sub
  197.  
  198. Sub LoadAPage(mode As Boolean)
  199.     'if mode is false, replace selected text (insert)
  200.     'if mode if true, replace all text (load)
  201.     
  202.     Dim Temp$
  203.     Dim Big$
  204.     Dim fileNum As Integer
  205.     fileNum = FreeFile
  206.     With frmHTMLEditor
  207.     
  208.     .CommonDialog1.DialogTitle = "LOAD HTML FILE"
  209.     .CommonDialog1.Filter = "HTML Files (*.html)|*.html|HTM Files (*.htm)|*.htm)"
  210.     .CommonDialog1.DefaultExt = "HTML"
  211.     .CommonDialog1.Flags = &H4& Or &H2&
  212.     .CommonDialog1.ShowOpen
  213.         
  214.     
  215.     
  216.     If .CommonDialog1.FileName <> "" Then
  217.         frmHTMLEditor.rtbHTML.LoadFile .CommonDialog1.FileName
  218. '        Open .CommonDialog1.FileName For Input As #fileNum
  219. '        Do While Not EOF(fileNum)
  220. '            Line Input #fileNum, temp$
  221. '            Debug.Print temp$
  222. '            Big$ = Big$ & temp$
  223. '        Loop
  224. '        Close #fileNum
  225.     End If
  226.     
  227.     
  228.     
  229.     If mode = True Then
  230.         'Overwrite mode
  231. '        .rtbHTML.SelStart = 0
  232. '        .rtbHTML.SelLength = Len(.rtbHTML.Text)
  233. '        .rtbHTML.SelRTF = Big$
  234.     Else
  235.         'Insert mode
  236.         .rtbHTML.SelLength = 0
  237.         .rtbHTML.SelRTF = Big$
  238.     End If
  239.     
  240.     End With
  241.  
  242. End Sub
  243.  
  244. Sub NumberedList(Style As Integer)
  245.  
  246.     '1  Std Numbers
  247.     '2  Uppercase Letters
  248.     '3  Lowercase Letters
  249.     '4  Uppercase Roman
  250.     '5  Lowercase Roman
  251.     
  252.     Dim Quote$
  253.     Dim LineCount As Long
  254.     Dim Temp$
  255.     Dim j As Long
  256.     
  257.     Quote$ = Chr$(34)
  258.     
  259.     Temp$ = InputBox("Number of bulleted items.", "Row Count", "0")
  260.     LineCount = CLng(Temp$)
  261.     
  262.     Select Case Style
  263.     Case 1
  264.         Temp$ = "<OL TYPE=" & Quote$ & "1" & Quote$ & ">" & vbCrLf
  265.         For j = 1 To LineCount
  266.             Temp$ = Temp$ & "<LI> </LI>" & vbCrLf
  267.         Next j
  268.         Temp$ = Temp$ & "</OL>"
  269.     Case 2
  270.         Temp$ = "<OL TYPE=" & Quote$ & "A" & Quote$ & ">" & vbCrLf
  271.         For j = 1 To LineCount
  272.             Temp$ = Temp$ & "<LI> </LI>" & vbCrLf
  273.         Next j
  274.         Temp$ = Temp$ & "</OL>"
  275.     Case 3
  276.         Temp$ = "<OL TYPE=" & Quote$ & "a" & Quote$ & ">" & vbCrLf
  277.         For j = 1 To LineCount
  278.             Temp$ = Temp$ & "<LI> </LI>" & vbCrLf
  279.         Next j
  280.         Temp$ = Temp$ & "</OL>"
  281.     Case 4
  282.         Temp$ = "<OL TYPE=" & Quote$ & "I" & Quote$ & ">" & vbCrLf
  283.         For j = 1 To LineCount
  284.             Temp$ = Temp$ & "<LI> </LI>" & vbCrLf
  285.         Next j
  286.         Temp$ = Temp$ & "</OL>"
  287.  
  288.     Case 5
  289.         Temp$ = "<OL TYPE=" & Quote$ & "i" & Quote$ & ">" & vbCrLf
  290.         For j = 1 To LineCount
  291.             Temp$ = Temp$ & "<LI> </LI>" & vbCrLf
  292.         Next j
  293.         Temp$ = Temp$ & "</OL>"
  294.  
  295.     End Select
  296.     
  297.         
  298.     If frmHTMLEditor.rtbHTML.Visible = True Then
  299.         frmHTMLEditor.rtbHTML.SelLength = 0
  300.         frmHTMLEditor.rtbHTML.SelRTF = Temp$
  301.     End If
  302.  
  303. End Sub
  304. Sub BulletedList()
  305.     Dim LineCount As Long
  306.     Dim Temp$
  307.     Dim j As Long
  308.     
  309.     
  310.     Temp$ = InputBox("Number of bulleted items.", "Row Count", "0")
  311.     LineCount = CLng(Temp$)
  312.     
  313.     Temp$ = "<UL>" & vbCrLf
  314.     For j = 1 To LineCount
  315.         Temp$ = Temp$ & "<LI> </LI>" & vbCrLf
  316.     Next j
  317.     Temp$ = Temp$ & "</UL>"
  318.         
  319.     If frmHTMLEditor.rtbHTML.Visible = True Then
  320.         frmHTMLEditor.rtbHTML.SelLength = 0
  321.         frmHTMLEditor.rtbHTML.SelRTF = Temp$
  322.     End If
  323.  
  324. '<UL>
  325. '<LI>This is the first item</LI>
  326. '<LI>This is the second item</LI>
  327. '<LI>This is the third item</LI>
  328. '</UL>
  329.  
  330. End Sub
  331.