home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / vb_code2 / str_plus / strplus.bas < prev    next >
BASIC Source File  |  1994-07-19  |  11KB  |  334 lines
  1. 'StrPlus.DLL should be in your Windows\System directory or in the Path
  2.  
  3.  
  4. 'Assorted StrPlus Functions
  5. Declare Function GetStrPlusVersion% Lib "StrPlus.DLL" ()
  6. Declare Function GetStateOfKey% Lib "StrPlus.DLL" (ByVal KeyName$)
  7.     'KeyName$=ScrollLock,NumLock,CapsLock,Rshift,Lshift,Control, or Alt
  8.  
  9.  
  10. 'StrPlus General String Functions
  11. Declare Sub ReverseString Lib "StrPlus.DLL" (ByVal lpString$)
  12. Declare Sub ToName Lib "StrPlus.DLL" (ByVal lpString$)
  13.     'end of lpString$ is assumed at chr$(0) or chr$(13)
  14. Declare Sub GetToken Lib "StrPlus.DLL" (ByVal lpString$, ByVal lpDelimiters$, ByVal TokenNumber%, ByVal lpReturn$)
  15. Declare Function GetTokenCount% Lib "StrPlus.DLL" (ByVal lpString$, ByVal lpDelimiters$)
  16. Declare Sub Encrypt Lib "StrPlus.DLL" (ByVal lpString$, ByVal KeyCode%)
  17. Declare Sub Decrypt Lib "StrPlus.DLL" (ByVal lpString$, ByVal KeyCode%)
  18. Declare Function CountWords% Lib "StrPlus.DLL" (ByVal lpString$)
  19.     'end of lpString$ is assumed at chr$(0) or chr$(13)
  20. Declare Sub GetOrdinalExt Lib "StrPlus.DLL" (ByVal TheNumber%, ByVal lpReturnString$)
  21. Declare Sub GetRomanNumber Lib "StrPlus.DLL" (ByVal TheNumber%, ByVal lpReturnString$)
  22. Declare Sub GetWordNumber Lib "StrPlus.DLL" (ByVal lpAmount$, ByVal lpReturnString$)
  23. Declare Function WordColor& Lib "StrPlus.DLL" (ByVal ColorWord$)
  24.     'Basic Color Words
  25.     'Black
  26.     'Blue
  27.     'Green
  28.     'Cyan
  29.     'Red
  30.     'Magenta
  31.     'DarkYellow
  32.     'LightGray
  33.     'DarkGray
  34.     'BrightBlue
  35.     'BrightGreen
  36.     'BrightCyan
  37.     'BrightRed
  38.     'BrightMagenta
  39.     'BrightYellow
  40.     'BrightWhite
  41.     'System Color Words
  42.     'ActiveBorder
  43.     'ActiveCaption
  44.     'AppWorkSpace
  45.     'BackGround
  46.     'BtnFace
  47.     'BtnHighlight
  48.     'BtnShadow
  49.     'BtnText
  50.     'CaptionText
  51.     'GrayText
  52.     'Highlight
  53.     'HighlightText
  54.     'InactiveBorder
  55.     'InactiveCaption
  56.     'InactiveCaptionText
  57.     'Menu
  58.     'MenuText
  59.     'Window
  60.     'WindowFrame
  61.     'WindowText
  62.  
  63.  
  64. 'StrPlus File String Functions
  65. Declare Sub ExtFromPath Lib "StrPlus.DLL" (ByVal lpFullPath$, ByVal lpString$)
  66. Declare Sub FileNameOnlyFromPath Lib "StrPlus.DLL" (ByVal lpFullPath$, ByVal lpString$)
  67. Declare Sub FullFileNameFromPath Lib "StrPlus.DLL" (ByVal lpFullPath$, ByVal lpString$)
  68. Declare Sub DirFromPath Lib "StrPlus.DLL" (ByVal lpFullPath$, ByVal lpString$)
  69. Declare Sub DriveFromPath Lib "StrPlus.DLL" (ByVal lpFullPath$, ByVal lpString$)
  70.  
  71.  
  72. 'StrPlus String Output Functions
  73. Declare Sub JustifyLine Lib "StrPlus.DLL" (ByVal hDC%, ByVal StartXpixel%, ByVal StartYpixel%, ByVal TheWidthPixels%, ByVal lpString$)
  74. Declare Sub SuperPrint Lib "StrPlus.DLL" (ByVal hDC%, ByVal XstartPixel%, ByVal YstartPixel%, ByVal TheString$, ByVal FontName$, ByVal TheStyle$, ByVal The3DStyle$, ByVal AlignmentType$, ByVal PointSize%, ByVal TheColor&, ByVal ShadowColor&, ByVal RotationAngle%)
  75.     'TheStyle$=bold, italic, BoldItalic, or plain
  76.     'The3Dstyle$=raised, sunken, or plain
  77.     'AlignmentType$=left, right, or center
  78.     'RototationAngle= 0- 359
  79.  
  80.  
  81. 'Assorted Win API Functions
  82. Declare Function DestroyWindow% Lib "User" (ByVal hWnd%)
  83. Declare Function GetWindowsDirectory% Lib "Kernel" (ByVal lpBuffer$, ByVal nSize%)
  84. Declare Function OutMessage% Lib "User" Alias "SendMessage" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, lParam As Any)
  85. Declare Function SendMessage& Lib "User" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, lParam As Any)
  86. Declare Function WinHelp% Lib "User" (ByVal hWnd%, ByVal lpHelpFile$, ByVal wCommand%, ByVal dwData As Any)
  87.     Global Const HELP_CONTENTS = &H3
  88.     Global Const HELP_PARTIALKEY = &H105
  89.  
  90.  
  91. 'program constants
  92. Global Const raised = 1
  93. Global Const sunken = 2
  94.  
  95.  
  96. 'program variables
  97. Global FormPassString As String     'used to pass strings
  98. Global FormPassString2 As String
  99.  
  100. Function AddSeparator (ThePath$)
  101.     If Right$(ThePath$, 1) <> "\" Then
  102.     ThePath$ = ThePath$ + "\"
  103.     End If
  104.     AddSeparator = ThePath$
  105. End Function
  106.  
  107. Sub DoControl3D (Obj As Control, Style%, Thick%)
  108.     If Thick <= 0 Then Thick = 1
  109.     If Thick > 8 Then Thick = 8
  110.     OldMode = Obj.Parent.ScaleMode
  111.     OldWidth = Obj.Parent.DrawWidth
  112.     Obj.Parent.ScaleMode = 3
  113.     Obj.Parent.DrawWidth = 1
  114.     ObjHeight = Obj.Height
  115.     ObjWidth = Obj.Width
  116.     ObjLeft = Obj.Left
  117.     ObjTop = Obj.Top
  118.     
  119.     Select Case Style
  120.     Case sunken:
  121.         TLshade = QBColor(8)
  122.         BRshade = QBColor(15)
  123.     Case raised:
  124.         TLshade = QBColor(15)
  125.         BRshade = QBColor(8)
  126.     End Select
  127.     For i = 1 To Thick
  128.         CurLeft = ObjLeft - i
  129.         CurTop = ObjTop - i
  130.         CurWide = ObjWidth + (i * 2) - 1
  131.         CurHigh = ObjHeight + (i * 2) - 1
  132.         Obj.Parent.Line (CurLeft, CurTop)-Step(CurWide, 0), TLshade
  133.         Obj.Parent.Line -Step(0, CurHigh), BRshade
  134.         Obj.Parent.Line -Step(-CurWide, 0), BRshade
  135.         Obj.Parent.Line -Step(0, -CurHigh), TLshade
  136.         Next i
  137.     If Thick > 2 Then
  138.         CurLeft = ObjLeft - Thick - 1
  139.         CurTop = ObjTop - Thick - 1
  140.         CurWide = ObjWidth + ((Thick + 1) * 2) - 1
  141.         CurHigh = ObjHeight + ((Thick + 1) * 2) - 1
  142.         Obj.Parent.Line (CurLeft, CurTop)-Step(CurWide, 0), QBColor(0)
  143.         Obj.Parent.Line -Step(0, CurHigh), QBColor(0)
  144.         Obj.Parent.Line -Step(-CurWide, 0), QBColor(0)
  145.         Obj.Parent.Line -Step(0, -CurHigh), QBColor(0)
  146.         End If
  147.     Obj.Parent.ScaleMode = OldMode
  148.     Obj.Parent.DrawWidth = OldWidth
  149. End Sub
  150.  
  151. Sub DoForm3D (TheForm As Form, Style%, Thick%, Distance%)
  152.     If Thick <= 0 Then Thick = 1
  153.     If Thick > 8 Then Thick = 8
  154.     If Distance < 0 Then Distance = 0
  155.     If Distance > 8 Then Distance = 8
  156.     OldMode = TheForm.ScaleMode
  157.     OldWidth = TheForm.DrawWidth
  158.     TheForm.ScaleMode = 3
  159.     TheForm.DrawWidth = 1
  160.     FormHeight = TheForm.ScaleHeight
  161.     FormWidth = TheForm.ScaleWidth
  162.     FormLeft = TheForm.ScaleLeft
  163.     FormTop = TheForm.ScaleTop
  164.     
  165.     Select Case Style
  166.     Case sunken:
  167.         TLshade = QBColor(8)
  168.         BRshade = QBColor(15)
  169.     Case raised:
  170.         TLshade = QBColor(15)
  171.         BRshade = QBColor(8)
  172.     End Select
  173.     Select Case TheForm.BorderStyle
  174.     Case 0:
  175.         OLshade = QBColor(0)
  176.         TheForm.Line (0, 0)-(FormWidth, 0), OLshade
  177.         TheForm.Line (0, 0)-(0, FormHeight), OLshade
  178.         TheForm.Line (FormWidth - 1, 0)-(FormWidth - 1, FormHeight + 1), OLshade
  179.         TheForm.Line (0, FormHeight - 1)-(FormWidth, FormHeight - 1), OLshade
  180.         For i = 1 To Thick
  181.         CurLeft = FormLeft + i + Distance
  182.         CurTop = FormTop + i + Distance
  183.         CurWide = FormWidth - (i + Distance) * 2 - 1
  184.         CurHigh = FormHeight - (i + Distance) * 2 - 1
  185.         TheForm.Line (CurLeft, CurTop)-Step(CurWide, 0), TLshade
  186.         TheForm.Line -Step(0, CurHigh), BRshade
  187.         TheForm.Line -Step(-CurWide, 0), BRshade
  188.         TheForm.Line -Step(0, -CurHigh), TLshade
  189.         Next i
  190.     Case 1 To 3:
  191.         If Thickness = 1 Then
  192.         TheForm.Line (Thick, Thick)-(FormWidth - Thick, Thick), TLshade
  193.         TheForm.Line (Thick, Thick)-(Thick, FormHeight - Thick), TLshade
  194.         TheForm.Line (FormWidth - Thick, Thick)-(FormWidth - Thick, FormHeight - Thick + 1), BRshade
  195.         TheForm.Line (Thick, FormHeight - Thick)-(FormWidth - Thick, FormHeight - Thick), BRshade
  196.         Else
  197.         For i = 1 To Thick
  198.         CurLeft = FormLeft + i - 1 + Distance
  199.         CurTop = FormTop + i - 1 + Distance
  200.         CurWide = FormWidth - (i + Distance) * 2 + 1
  201.         CurHigh = FormHeight - (i + Distance) * 2 + 1
  202.         TheForm.Line (CurLeft, CurTop)-Step(CurWide, 0), TLshade
  203.         TheForm.Line -Step(0, CurHigh), BRshade
  204.         TheForm.Line -Step(-CurWide, 0), BRshade
  205.         TheForm.Line -Step(0, -CurHigh), TLshade
  206.         Next i
  207.         End If
  208.     End Select
  209.     TheForm.ScaleMode = OldMode
  210.     TheForm.DrawWidth = OldWidth
  211. End Sub
  212.  
  213. Sub FillArray (array() As String, FillValue As String, low As Integer, high As Integer)
  214. 'PURPOSE:   fills an array (or a portion thereof) with a specified value
  215. 'Comment:   *   low is the array element to start with
  216. '           *   high is the array element to end with
  217. '           *   to include entire array, set
  218. '               low to LBOUND of the array and
  219. '               high to UBOUND of the array
  220.     
  221.     lb% = LBound(array)
  222.     ub% = UBound(array)
  223.     If low < lb% Then
  224.     MsgBox "Illegal Low Limit", 16, "FillArray Error"
  225.     Exit Sub
  226.     End If
  227.     If high > ub% Then
  228.     MsgBox "Illegal High Limit", 16, "FillArray Error"
  229.     Exit Sub
  230.     End If
  231.     
  232.     For x = low To high
  233.     array(x) = FillValue
  234.     Next x
  235. End Sub
  236.  
  237. Sub FormCenterForm (TheForm As Form, MainForm As Form)
  238.     TheForm.Move MainForm.Left + (MainForm.Width - TheForm.Width) / 2, MainForm.Top + (MainForm.Height - TheForm.Height) / 2
  239. End Sub
  240.  
  241. Sub FormCenterScreen (TheForm As Form)
  242.     TheForm.Move (Screen.Width - TheForm.Width) / 2, (Screen.Height - TheForm.Height) / 2
  243. End Sub
  244.  
  245. Function GetWinDir ()
  246.      Buffer$ = Space$(255)
  247.      count% = GetWindowsDirectory(Buffer$, 255)
  248.      GetWinDir = Left$(Buffer$, count%)
  249. End Function
  250.  
  251. Sub ListHscroll (TheListBox As Control, CharsWide%)
  252.     If CharsWide% > 15000 Then CharsWide% = 15000
  253.     LongString$ = String$(CharsWide%, "W")
  254.     tppx% = Screen.TwipsPerPixelX
  255.     MaxiWide% = TheListBox.Parent.TextWidth(LongString$) / tppx%
  256.     HscrollLen& = SendMessage(TheListBox.hWnd, 1045, MaxiWide%, 0)
  257. End Sub
  258.  
  259. Sub ReadData (ThisArray$(), ArrayString$, ArrayCount%)
  260. 'ThisArray$() is the array in which to place the strings
  261. 'ArrayString$ is the comma delimited string
  262. 'ArrayCount% will contain count of data
  263.     lpDelimiters$ = ","
  264.     ArrayCount% = GetTokenCount(ArrayString$, lpDelimiters$)
  265.     ReDim Preserve ThisArray$(ArrayCount%)
  266.     For x% = 1 To ArrayCount%
  267.     ReturnString$ = Space$(255)
  268.     GetToken ArrayString$, lpDelimiters$, x%, ReturnString$
  269.     TrimAtNull ReturnString$
  270.     ThisArray$(x%) = ReturnString$
  271.     Next x%
  272. End Sub
  273.  
  274. Sub SortArray (ThisArray() As String, low As Integer, high As Integer)
  275. 'PURPOSE:   sorts an array (or a portion thereof) with a specified value
  276. 'Comment:   *   low is the array element to start with
  277. '           *   high is the array element to end with
  278. '           *   to include entire array, set
  279. '               low to LBOUND of the array and
  280. '               high to UBOUND of the array
  281.  
  282.     Dim i%, j%
  283.     Dim Temp$
  284.     
  285.     lb% = LBound(ThisArray)
  286.     ub% = UBound(ThisArray)
  287.     If low < lb% Then
  288.     MsgBox "Illegal Low Limit", 16, "SortArray Error"
  289.     Exit Sub
  290.     End If
  291.     If high > ub% Then
  292.     MsgBox "Illegal High Limit", 16, "SortArray Error"
  293.     Exit Sub
  294.     End If
  295.     
  296.     For i = low To high
  297.     For j = low To high - 1
  298.         If ThisArray(j) > ThisArray(j + 1) Then
  299.         Temp$ = ThisArray(j + 1)
  300.         ThisArray(j + 1) = ThisArray(j)
  301.         ThisArray(j) = Temp$
  302.         End If
  303.         Next j
  304.     Next i
  305. End Sub
  306.  
  307. Function Strip (x As String, y As String)
  308. 'strips all occurences of Y string from X string
  309.     Dim z As String
  310.     If Len(x) < 1 Or Len(y) < 1 Then
  311.     Strip = ""
  312.     Exit Function
  313.     End If
  314.     Start = 1
  315.     z = x
  316.     Do
  317.     pos% = InStr(x, y)
  318.     If pos% = 0 Then Strip = z: Exit Function
  319.     z = Left$(x, (pos% - 1)) + Mid$(x, pos% + Len(y), Len(x) - Len(y) - pos% + 1)
  320.     If Start = Len(x) Then Exit Do
  321.     Start = Start + 1
  322.     Loop
  323.     Strip = z
  324. End Function
  325.  
  326. Sub TrimAtNull (TheWord$)
  327.     'this sub removes the NULL, chr$(0), at the end of
  328.     'strings returned from DLL's
  329.     pos% = InStr(TheWord$, Chr$(0))
  330.     If pos% = 0 Then Exit Sub
  331.     TheWord$ = Left$(TheWord$, pos% - 1)
  332. End Sub
  333.  
  334.