home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / appshell / apputil.bas < prev    next >
Encoding:
BASIC Source File  |  1995-10-23  |  3.6 KB  |  151 lines
  1. DefInt A-Z
  2.  
  3.  
  4.  
  5. Sub GetDefaultPrinter (Win_PrinterName As String, Win_PrinterDriver As String, Win_PrinterPort As String)
  6.   
  7.   '
  8.   ' get the Windows default printer
  9.   '
  10.   buf$ = String$(2048, 0)
  11.   BufSize% = Len(buf$)
  12.   y% = GetProfileString("windows", ByVal "device", "Error", buf$, BufSize%)
  13.   If buf$ <> "Error" Then
  14.     '
  15.     ' parse the string
  16.     '
  17.     i% = InStr(buf$, ",")
  18.     j% = InStr(i% + 1, buf$, ",")
  19.     Win_PrinterName = Left$(buf$, i% - 1)
  20.     Win_PrinterDriver = Mid$(buf$, i% + 1, j% - i% - 1)
  21.     Win_PrinterPort = Mid$(buf$, j% + 1)
  22.   End If
  23.  
  24. End Sub
  25.  
  26. '
  27. ' Startup Main Procedure
  28. '
  29. Sub Main ()
  30.     '
  31.     ' Since you cannot assign values like CR and LF to string
  32.     ' constants, the value of CRLF which is used frequently
  33.     ' thoughout App Shell when displaying messages, these values are
  34.     ' are assigned to the global string values of CRLF
  35.     '
  36.     CRLF = Chr$(13) + Chr$(10)
  37.     App_FileExtension = ".TXT"
  38.  
  39.     AppMain.Show
  40.  
  41. End Sub
  42.  
  43. Sub pause (seconds As Integer)
  44.  
  45.   Start! = Timer
  46.   Finish! = Start! + seconds
  47.  
  48.   Do While Timer < Finish! And Timer > Start!
  49.   Loop
  50.  
  51. End Sub
  52.  
  53. Sub Place_DialogBox_in_Form (DB As Form, A_Form As Form)
  54.   
  55.   NewLeft! = A_Form.Left + (A_Form.Width \ 2)
  56.   If NewLeft! - (DB.Width \ 2) > 0 Then
  57.     NewLeft! = NewLeft! - (DB.Width \ 2)
  58.   Else
  59.     NewLeft! = 0
  60.   End If
  61.  
  62.   If NewLeft! + DB.Width > Screen.Width Then
  63.     NewLeft! = Screen.Width - DB.Width
  64.   End If
  65.   
  66.   NewTop! = A_Form.Top + (A_Form.Height \ 2)
  67.   If NewTop! - (DB.Height \ 2) > 0 Then
  68.     NewTop! = NewTop! - (DB.Height \ 2)
  69.   Else
  70.     NewTop! = 0
  71.   End If
  72.  
  73.   If NewTop! + DB.Height > Screen.Height Then
  74.     NewTop! = Screen.Height - DB.Height
  75.   End If
  76.  
  77.   DB.Move NewLeft!, NewTop!
  78.   
  79. End Sub
  80.  
  81. '
  82. ' Removes various menu items from the System menu of the specified Form.
  83. ' Dialog boxes should only have a move and close menu
  84. '
  85. Sub Remove_Items_from_Sysmenu (A_Form As Form)
  86.  
  87.     ' Obtain the handle to the forms System menu
  88.     '
  89.     HSysMenu = GetSystemMenu(A_Form.Hwnd, 0)
  90.   
  91.     ' Remove all but the MOVE and CLOSE options.  The menu items
  92.     ' must be removed starting with the last menu item.
  93.     '
  94.     R = RemoveMenu(HSysMenu, 8, MF_BYPOSITION) 'Switch to
  95.     R = RemoveMenu(HSysMenu, 7, MF_BYPOSITION) 'Separator
  96.     R = RemoveMenu(HSysMenu, 5, MF_BYPOSITION) 'Separator
  97.  
  98. End Sub
  99.  
  100.  
  101. Sub SplitFileName (fn As String, pqual As String, fqual As String)
  102.  
  103.   Dim LastOne As Integer
  104.  
  105.   '
  106.   ' split file name into any path entry and file qualifer
  107.   '
  108.   ' find last \ or : in file name
  109.   '
  110.   test$ = fn
  111.   For i% = 1 To Len(test$)
  112.     If Mid$(test$, i%, 1) = "\" Or Mid$(test$, i%, 1) = ":" Then
  113.       LastOne = i%
  114.     End If
  115.   Next
  116.   
  117.   Select Case LastOne
  118.     Case 0
  119.       pqual = ""
  120.       fqual = fn
  121.     Case 1
  122.       pqual = "/"
  123.       fqual = Right$(fn, Len(fn) - 1)
  124.     Case 2, 3
  125.       If Mid$(fn, 2, 1) = ":" Then
  126.         pqual = Left$(fn, LastOne)
  127.       Else
  128.         pqual = Left$(fn, LastOne - 1)
  129.       End If
  130.       fqual = Right$(fn, Len(fn) - LastOne)
  131.     Case Else
  132.       pqual = Left$(fn, LastOne - 1)
  133.       fqual = Right$(fn, Len(fn) - LastOne)
  134.   End Select
  135.  
  136. End Sub
  137.  
  138. Sub WriteDefaultPrinter (Win_PrinterName As String, Win_PrinterDriver As String, Win_PrinterPort As String)
  139.   '
  140.   ' write the Windows default printer
  141.   '
  142.   buf$ = Win_PrinterName + "," + Win_PrinterDriver + "," + Win_PrinterPort
  143.   y% = WriteProfileString("windows", "device", ByVal buf$)
  144.   '
  145.   ' notify app of change
  146.   '
  147.   x& = SendMessage(&HFFFF, WM_WININICHANGE, &H0, ByVal "windows")
  148.   
  149. End Sub
  150.  
  151.