home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD1319212302000.psc / Module2.bas < prev    next >
Encoding:
BASIC Source File  |  2000-09-29  |  2.4 KB  |  95 lines
  1. Attribute VB_Name = "Module2"
  2. '#This module is courtesy of Xtreme-Pad
  3. '#Use this module only knowing where you got it from
  4. Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
  5. (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
  6. ByVal lParam As Long) As Long
  7.  
  8. Global Secret As Integer, SecStr As String
  9. Global DefaultTitle As String, JustChanged As Boolean
  10.  
  11. Const WM_USER = &H400
  12. Const EM_UNDO = WM_USER + 23
  13. Global Docs As Integer
  14. Global ChildForms(1 To 30) As Form1
  15. Global UnAvail(1 To 30) As Boolean
  16. Global Pos As Integer
  17. Global SearchStr As String
  18. Global MatchCase As Boolean
  19. Global DefaultFontName As String
  20. Global DefaultFontSize As Integer
  21. Global DefaultFontColor As Long
  22. Global DefaultFontBold As Boolean
  23. Global DefaultFontItalic As Boolean
  24. Global DefaultFontUnderline As Boolean
  25. Global DefaultFontStrikethru As Boolean
  26. Global UndoText(1 To 30) As String, Opened As Boolean
  27. Global DocTemp As Integer, NeedSaved(30) As Boolean
  28. Global File(1 To 30) As String, PFile(1 To 30) As String
  29.  
  30. Function GetBinary(Number As Integer) As String
  31. Dim binstr As String
  32. binstr = ""
  33. Number = Number + 1
  34. For x = 7 To 0 Step -1
  35.   If Number > 2 ^ x Then
  36.     Number = Number - 2 ^ x
  37.     binstr = binstr & "1"
  38.   Else
  39.     binstr = binstr & "0"
  40.   End If
  41. Next
  42. GetBinary = binstr
  43. End Function
  44.  
  45. Function BintoDec(binstr As String) As Integer
  46. Dim Number As Integer
  47. For x = 0 To 7
  48.   If Mid$(binstr, x + 1, 1) = "1" Then
  49.     Number = Number + (2 ^ (7 - x))
  50.   End If
  51. Next
  52. BintoDec = Number
  53. End Function
  54.  
  55. Function frm() As Integer
  56. On Error GoTo CreateNew
  57. frm = Val(MDIForm1.ActiveForm.Tag)
  58. Exit Function
  59. CreateNew:
  60. Dim ret As Integer
  61. DocTemp = FirstAvail
  62. If DocTemp <> -1 Then
  63.   Set ChildForms(DocTemp) = New Form1
  64.   ChildForms(DocTemp).Caption = "Document " & DocTemp
  65.   ChildForms(DocTemp).Tag = DocTemp
  66. Else
  67.   MsgBox "You are only allowed 30 Documents opened at one time."
  68. End If
  69. frm = Val(MDIForm1.ActiveForm.Tag)
  70. End Function
  71.  
  72. Function FirstAvail() As Integer
  73. For x = 1 To 30
  74.   If UnAvail(x) = False Then
  75.     UnAvail(x) = True
  76.     FirstAvail = x
  77.     Exit Function
  78.   End If
  79. Next
  80. FirstAvail = -1
  81. End Function
  82.  
  83. Sub Point(mdiFrm As Form)
  84.     With ChildForms(frm).Text1
  85.         If (IsNull(.SelBullet) = True) Or (.SelBullet = False) Then
  86.             .SelBullet = True
  87.         ElseIf .SelBullet = True Then
  88.             .SelBullet = False
  89.             .SelHangingIndent = False
  90.         End If
  91.     End With
  92. End Sub
  93. v
  94.  
  95.