home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Multimedia Adventure Set / Visual_Basic_4_Multimedia_Adventure_Set_Coriolis_Group_1995.iso / sharware / csrplus / csrplus.bas < prev    next >
BASIC Source File  |  1994-06-07  |  8KB  |  268 lines
  1. 'CsrPlus.DLL should be in your Windows\System directory or in the Path
  2.  
  3.  
  4. 'Assorted CsrPlus Functions
  5. Declare Function GetCsrPlusVersion% Lib "CsrPlus.DLL" ()
  6. Declare Sub FormBackDrop Lib "CsrPlus.DLL" (ByVal TheHwnd%, ByVal TheStyle$)
  7.     'Style names
  8.         'SmallCheckLight
  9.         'SmallCheckDark
  10.         'SmallCheckBlue
  11.         'SmallCheckRed
  12.         'BigCheckLight
  13.         'BigCheckDark
  14.         'BigCheckBlue
  15.         'BigCheckRed
  16.         'HorzLinesLight
  17.         'HorzLinesDark
  18.         'DiamondsLight
  19.         'DiamondsDark
  20.         'SlickFillLight
  21.         'SlickFillDark
  22.         'User1
  23.         'User2
  24.         'User3
  25.         'User4
  26.  
  27.  
  28. 'CsrPlus functions for cursor control
  29. Declare Function MakeCursor& Lib "CsrPlus.DLL" (ByVal TheHwnd%, ByVal TheCursorName$)
  30.     Global OrgCursor As Long
  31.     Global OrgTextCursor As Long
  32. Declare Function MakeSysCursor& Lib "CsrPlus.DLL" (ByVal TheHwnd%, ByVal TheCursorName$)
  33. Declare Sub RestoreCursor Lib "CsrPlus.DLL" (ByVal TheHwnd%, ByVal hOrgCursor&)
  34. 'Cursor Names (Functional)
  35.     'ContextHelp
  36.     'CopyText
  37.     'CrossHair
  38.     'DrawRectangleEmpty
  39.     'DrawRectangleFilled
  40.     'DrawOvalEmpty
  41.     'DrawOvalFilled
  42.     'DrawRRectEmpty
  43.     'DrawRRectFilled
  44.     'Eraser
  45.     'Eyedropper
  46.     'FountainPen
  47.     'FrameUpperLeft
  48.     'FrameUpperRight
  49.     'FrameLowerLeft
  50.     'FrameLowerRight
  51.     'Hand
  52.     'Help
  53.     'Magnet
  54.     'Magnifier
  55.     'MoveHand
  56.     'MoveTruck
  57.     'PaintBrush
  58.     'PaintRoller
  59.     'PasteIt
  60.     'Pen
  61.     'Pencil
  62.     'Pencil2
  63.     'Scissors
  64.     'SprayCan
  65.     'Syringe
  66.     'Text
  67. 'Cursor Names (Standard)
  68.     'CheckMark
  69.     'DartNW
  70.     'DartSW
  71.     'FatArrowNE
  72.     'FatArrowNW
  73.     'FatArrowSE
  74.     'FatArrowSW
  75.     'HandPointE
  76.     'HandPointN
  77.     'HandPointS
  78.     'HandPointW
  79.     'Lightning
  80.     'MagicWand
  81.     'StarWand
  82.     'TrekPointer
  83. 'Cursor Names (Novelty)
  84.     'Ampersand
  85.     'Bug
  86.     'CardClub
  87.     'CardDiamond
  88.     'CardHeart
  89.     'CardSpade
  90.     'DollarSign
  91.     'GolfClub
  92.     'Horse
  93.     'Key
  94.     'Knight
  95.     'Mouse
  96.     'RaisinMan
  97.     'Skull
  98.     'Star
  99.     'Sword
  100.     'Xmark
  101.     'YinYang
  102. 'Cursor Names (Animation)
  103.     'HourGlass1 (1-7)
  104.     'Timer1 (1-8)
  105. 'Cursor Names (User Defined)
  106.     'User1 (1-8)
  107.  
  108.  
  109. 'Assorted API Help function
  110. Declare Function GetWindowsDirectory% Lib "Kernel" (ByVal lpBuffer$, ByVal nSize%)
  111. Declare Function OutMessage% Lib "User" Alias "SendMessage" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, lParam As Any)
  112. Declare Function SendMessage& Lib "User" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, lParam As Any)
  113. Declare Function WinHelp% Lib "User" (ByVal hWnd%, ByVal lpHelpFile$, ByVal wCommand%, ByVal dwData As Any)
  114.     Global Const HELP_CONTENTS = &H3
  115.     Global Const HELP_PARTIALKEY = &H105
  116.  
  117.  
  118. 'program constants
  119. Global Const raised = 1
  120. Global Const sunken = 2
  121.  
  122.  
  123. 'program variables
  124. Global FormPassString As String     'used to pass strings
  125. Global FormPassString2 As String
  126.  
  127. Function AddSeparator (ThePath$)
  128.     If Right$(ThePath$, 1) <> "\" Then
  129.         ThePath$ = ThePath$ + "\"
  130.         End If
  131.     AddSeparator = ThePath$
  132. End Function
  133.  
  134. Sub DoControl3D (Obj As Control, Style%, Thick%)
  135.     If Thick <= 0 Then Thick = 1
  136.     If Thick > 8 Then Thick = 8
  137.     OldMode = Obj.Parent.ScaleMode
  138.     OldWidth = Obj.Parent.DrawWidth
  139.     Obj.Parent.ScaleMode = 3
  140.     Obj.Parent.DrawWidth = 1
  141.     ObjHeight = Obj.Height
  142.     ObjWidth = Obj.Width
  143.     ObjLeft = Obj.Left
  144.     ObjTop = Obj.Top
  145.     
  146.     Select Case Style
  147.         Case sunken:
  148.             TLshade = QBColor(8)
  149.             BRshade = QBColor(15)
  150.         Case raised:
  151.             TLshade = QBColor(15)
  152.             BRshade = QBColor(8)
  153.         End Select
  154.         For i = 1 To Thick
  155.             CurLeft = ObjLeft - i
  156.             CurTop = ObjTop - i
  157.             CurWide = ObjWidth + (i * 2) - 1
  158.             CurHigh = ObjHeight + (i * 2) - 1
  159.             Obj.Parent.Line (CurLeft, CurTop)-Step(CurWide, 0), TLshade
  160.             Obj.Parent.Line -Step(0, CurHigh), BRshade
  161.             Obj.Parent.Line -Step(-CurWide, 0), BRshade
  162.             Obj.Parent.Line -Step(0, -CurHigh), TLshade
  163.             Next i
  164.         If Thick > 2 Then
  165.             CurLeft = ObjLeft - Thick - 1
  166.             CurTop = ObjTop - Thick - 1
  167.             CurWide = ObjWidth + ((Thick + 1) * 2) - 1
  168.             CurHigh = ObjHeight + ((Thick + 1) * 2) - 1
  169.             Obj.Parent.Line (CurLeft, CurTop)-Step(CurWide, 0), QBColor(0)
  170.             Obj.Parent.Line -Step(0, CurHigh), QBColor(0)
  171.             Obj.Parent.Line -Step(-CurWide, 0), QBColor(0)
  172.             Obj.Parent.Line -Step(0, -CurHigh), QBColor(0)
  173.             End If
  174.     Obj.Parent.ScaleMode = OldMode
  175.     Obj.Parent.DrawWidth = OldWidth
  176. End Sub
  177.  
  178. Sub DoForm3D (TheForm As Form, Style%, Thick%, Distance%)
  179.     If Thick <= 0 Then Thick = 1
  180.     If Thick > 8 Then Thick = 8
  181.     If Distance < 0 Then Distance = 0
  182.     If Distance > 8 Then Distance = 8
  183.     OldMode = TheForm.ScaleMode
  184.     OldWidth = TheForm.DrawWidth
  185.     TheForm.ScaleMode = 3
  186.     TheForm.DrawWidth = 1
  187.     FormHeight = TheForm.ScaleHeight
  188.     FormWidth = TheForm.ScaleWidth
  189.     FormLeft = TheForm.ScaleLeft
  190.     FormTop = TheForm.ScaleTop
  191.     
  192.     Select Case Style
  193.         Case sunken:
  194.             TLshade = QBColor(8)
  195.             BRshade = QBColor(15)
  196.         Case raised:
  197.             TLshade = QBColor(15)
  198.             BRshade = QBColor(8)
  199.         End Select
  200.     Select Case TheForm.BorderStyle
  201.         Case 0:
  202.             OLshade = QBColor(0)
  203.             TheForm.Line (0, 0)-(FormWidth, 0), OLshade
  204.             TheForm.Line (0, 0)-(0, FormHeight), OLshade
  205.             TheForm.Line (FormWidth - 1, 0)-(FormWidth - 1, FormHeight + 1), OLshade
  206.             TheForm.Line (0, FormHeight - 1)-(FormWidth, FormHeight - 1), OLshade
  207.             For i = 1 To Thick
  208.                 CurLeft = FormLeft + i + Distance
  209.                 CurTop = FormTop + i + Distance
  210.                 CurWide = FormWidth - (i + Distance) * 2 - 1
  211.                 CurHigh = FormHeight - (i + Distance) * 2 - 1
  212.                 TheForm.Line (CurLeft, CurTop)-Step(CurWide, 0), TLshade
  213.                 TheForm.Line -Step(0, CurHigh), BRshade
  214.                 TheForm.Line -Step(-CurWide, 0), BRshade
  215.                 TheForm.Line -Step(0, -CurHigh), TLshade
  216.                 Next i
  217.         Case 1 To 3:
  218.             If Thickness = 1 Then
  219.                 TheForm.Line (Thick, Thick)-(FormWidth - Thick, Thick), TLshade
  220.                 TheForm.Line (Thick, Thick)-(Thick, FormHeight - Thick), TLshade
  221.                 TheForm.Line (FormWidth - Thick, Thick)-(FormWidth - Thick, FormHeight - Thick + 1), BRshade
  222.                 TheForm.Line (Thick, FormHeight - Thick)-(FormWidth - Thick, FormHeight - Thick), BRshade
  223.                 Else
  224.             For i = 1 To Thick
  225.                 CurLeft = FormLeft + i - 1 + Distance
  226.                 CurTop = FormTop + i - 1 + Distance
  227.                 CurWide = FormWidth - (i + Distance) * 2 + 1
  228.                 CurHigh = FormHeight - (i + Distance) * 2 + 1
  229.                 TheForm.Line (CurLeft, CurTop)-Step(CurWide, 0), TLshade
  230.                 TheForm.Line -Step(0, CurHigh), BRshade
  231.                 TheForm.Line -Step(-CurWide, 0), BRshade
  232.                 TheForm.Line -Step(0, -CurHigh), TLshade
  233.                 Next i
  234.                 End If
  235.         End Select
  236.     TheForm.ScaleMode = OldMode
  237.     TheForm.DrawWidth = OldWidth
  238. End Sub
  239.  
  240. Sub FormCenterForm (TheForm As Form, MainForm As Form)
  241.     TheForm.Move MainForm.Left + (MainForm.Width - TheForm.Width) / 2, MainForm.Top + (MainForm.Height - TheForm.Height) / 2
  242. End Sub
  243.  
  244. Sub FormCenterScreen (TheForm As Form)
  245.     TheForm.Move (Screen.Width - TheForm.Width) / 2, (Screen.Height - TheForm.Height) / 2
  246. End Sub
  247.  
  248. Function GetWinDir ()
  249.      Buffer$ = Space$(255)
  250.      count% = GetWindowsDirectory(Buffer$, 255)
  251.      GetWinDir = Left$(Buffer$, count%)
  252. End Function
  253.  
  254. Sub ListHscroll (TheListBox As Control, CharsWide%)
  255.     If CharsWide% > 15000 Then CharsWide% = 15000
  256.     LongString$ = String$(CharsWide%, "W")
  257.     tppx% = Screen.TwipsPerPixelX
  258.     MaxiWide% = TheListBox.Parent.TextWidth(LongString$) / tppx%
  259.     HscrollLen& = SendMessage(TheListBox.hWnd, 1045, MaxiWide%, 0)
  260. End Sub
  261.  
  262. Sub TrimAtNull (TheWord$)
  263.     pos% = InStr(TheWord$, Chr$(0))
  264.     If pos% = 0 Then Exit Sub
  265.     TheWord$ = Left$(TheWord$, pos% - 1)
  266. End Sub
  267.  
  268.