home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0200 - 0209 / ibm0200-0209 / ibm0200.tar / ibm0200 / VBTIPS17.ZIP / COMMON01.BA_ / COMMON01.BA
Encoding:
Text File  |  1994-05-26  |  12.0 KB  |  267 lines
  1. Option Explicit
  2. '****************************************************
  3. '* COMMON01.BAS Version 1.1 Date: 4/30/94           *
  4. '* DPM Computer Solutions                           *
  5. '* 8430-D Summerdale Road San Diego CA 92126-5415   *
  6. '* InterNet: DPMCS@HIGH-COUNTRY.COM                 *
  7. '* Compuserve: 74227,1557                           *
  8. '****************************************************
  9. Declare Function WritePrivateProfileString Lib "Kernel" (ByVal AppName As String, ByVal KeyName As String, ByVal NewString As String, ByVal FileName As String) As Integer
  10. Declare Function GetPrivateProfilestring Lib "Kernel" (ByVal AppName As String, ByVal KeyName As String, ByVal default As String, ByVal ReturnedString As String, ByVal MAXSIZE As Integer, ByVal FileName As String) As Integer
  11. Declare Function GetKeyState Lib "User" (ByVal NVirtKey%) As Integer
  12.  
  13. Declare Function FindWindow Lib "User" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Integer
  14. Declare Sub ShowWindow Lib "User" (ByVal hWnd As Integer, ByVal nCmdShow As Integer)
  15. Declare Sub SFocus Lib "User" Alias "SetFocus" (ByVal hWnd As Integer)
  16. Declare Sub SetWindowPos Lib "User" (ByVal hWnd As Integer, ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal Y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer)
  17.  
  18. Global hWnd As Integer
  19.  
  20. Const SWP_NOMOVE = 2
  21. Const SWP_NOSIZE = 1
  22. Const HWND_TOPMOST = -1
  23. Const HWND_NOTOPMOST = -2
  24.  
  25. '*******************************************************
  26. '* Procedure Name: AppRunning                          *
  27. '*-----------------------------------------------------*
  28. '* Created: 2/8/94    By: MSDN                         *
  29. '* Modified:          By:                              *
  30. '*=====================================================*
  31. '*Checks to see if the current application is already  *
  32. '*running. To use just call the sub. If the application*
  33. '*is already running, it will end the current          *
  34. '*application.                                         *
  35. '*                                                     *
  36. '*******************************************************
  37. Sub AppRunning ()
  38.     Dim sMsg As String
  39.     If App.PrevInstance Then
  40.     sMsg = App.EXEName & " already running! "
  41.        MsgBox sMsg, 4112
  42.     End
  43.     End If
  44. End Sub
  45.  
  46. '*******************************************************
  47. '* Procedure Name: CenterForm                          *
  48. '*-----------------------------------------------------*
  49. '* Created: 2/10/94   By: VB Programmers Journal       *
  50. '* Modified: 4/24/94  By: David McCarter               *
  51. '*=====================================================*
  52. '*This code will center a form in the center of the    *
  53. '*screen. To use it, just call the sub and pass it the *
  54. '*form name [Call CenterForm main]                     *
  55. '*                                                     *
  56. '*                                                     *
  57. '*******************************************************
  58. Sub CenterForm (frmIN As Form)
  59.     Dim iTop, iLeft As Integer
  60.  
  61.     If frmIN.WindowState <> 0 Then Exit Sub
  62.     iTop = (Screen.Height - frmIN.Height) \ 2
  63.     iLeft = (Screen.Width - frmIN.Width) \ 2
  64.     
  65.     If iTop And iLeft Then
  66.     frmIN.Move iLeft, iTop
  67.     End If
  68. End Sub
  69.  
  70. '*******************************************************
  71. '*                                                     *
  72. '*      Procedure Name:CenterMDIChild                  *
  73. '*                                                     *
  74. '*             Created:2/10/94       By:VB Prog Journl *
  75. '*            Modified:              By:               *
  76. '*                                                     *
  77. '*            Comments:                                *
  78. '*                                                     *
  79. '*******************************************************
  80. '*******************************************************
  81. '* Procedure Name: CenterMDIChild                      *
  82. '*-----------------------------------------------------*
  83. '* Created: 2/10/94   By: VB Programmers Journal       *
  84. '* Modified: 3/24/94  By: D. McCarter                  *
  85. '*=====================================================*
  86. '* Centers a child form within a parent MDI form. To   *
  87. '* use, call the sub and pass it the parent form name  *
  88. '* and the child form name [CenterMDIChild form1 form2]*
  89. '*                                                     *
  90. '*                                                     *
  91. '*******************************************************
  92. Sub CenterMDIChild (frmParent As Form, frmChild As Form)
  93.     Dim iTop, iLeft As Integer
  94.     If frmParent.WindowState <> 0 Or frmChild.WindowState <> 0 Then Exit Sub
  95.     iTop = (frmParent.ScaleHeight - frmChild.Height) \ 2
  96.     iLeft = (frmParent.ScaleWidth - frmChild.Width) \ 2
  97.  
  98.     If iTop And iLeft Then
  99.     frmChild.Move iLeft, iTop
  100.     End If
  101. End Sub
  102.  
  103. '*******************************************************
  104. '* Procedure Name: CheckUnique                         *
  105. '*-----------------------------------------------------*
  106. '* Created: 4/18/94   By: Terry Brooking               *
  107. '* Modified:          By:                              *
  108. '*=====================================================*
  109. '*Checks for previous instance of application, If found*
  110. '*ensures it's restored from Icon and Focused on! It is*
  111. '*up to main routine to end application if required.   *
  112. '*                                                     *
  113. '*                                                     *
  114. '*******************************************************
  115. Function CheckUnique (F As Form) As Integer
  116. 'Check for previous instance of application. If found, ensures
  117. 'is restored from Icon and Focused on! It is up to Main routine
  118. 'to end application if required.
  119. Dim x As Integer
  120. Dim Title As String
  121.  
  122.     CheckUnique = True
  123.     If App.PrevInstance Then
  124.     'MsgBox "Prev Instance found!"
  125.     Title = F.Caption
  126.     F.Caption = Title & " - New"    'This is necessary as you may find yourself!
  127.     hWnd = FindWindow(0&, Title)
  128.     F.Caption = Title               'Restore caption
  129.     DoEvents
  130.     If hWnd Then
  131.         'MsgBox "Handle found!"
  132.         ShowWindow hWnd, 1          'Restores from Minimsed if necessary
  133.         DoEvents
  134.         SFocus hWnd                 'Sets focus
  135.         DoEvents
  136.         CheckUnique = False
  137.     End If
  138.     End If
  139. End Function
  140.  
  141. '*******************************************************
  142. '* Procedure Name: CutCopyPaste                        *
  143. '*-----------------------------------------------------*
  144. '* Created:           By: VB Help File                 *
  145. '* Modified:          By:                              *
  146. '*=====================================================*
  147. '*This procedure puts all the cut,copy paste commands  *
  148. '*in one place. To use, just call the sub and pass it  *
  149. '*your choice- 0=Cut, 1=Copy, 2=Paste, 3=Delete,       *
  150. '*[Call CutCopyPaste 2]                                *
  151. '*                                                     *
  152. '*******************************************************
  153. Sub CutCopyPaste (iChoice As Integer)
  154.     ' ActiveForm refers to the active form in the MDI form.
  155.     If TypeOf Screen.ActiveControl Is TextBox Then
  156.     Select Case iChoice
  157.             Case 0          ' Cut.
  158.             ' Copy selected text to Clipboard.
  159.             Clipboard.SetText Screen.ActiveControl.SelText
  160.             ' Delete selected text.
  161.             Screen.ActiveControl.SelText = ""
  162.             Case 1          ' Copy.
  163.             ' Copy selected text to Clipboard.
  164.             Clipboard.SetText Screen.ActiveControl.SelText
  165.             Case 2          ' Paste.
  166.             ' Put Clipboard text in text box.
  167.             Screen.ActiveControl.SelText = Clipboard.GetText()
  168.             Case 3          ' Delete.
  169.             ' Delete selected text.
  170.             Screen.ActiveControl.SelText = ""
  171.     End Select
  172.     End If
  173. End Sub
  174.  
  175. '*******************************************************
  176. '* Procedure Name: GetAppPath                          *
  177. '*-----------------------------------------------------*
  178. '* Created: 3/24/94   By: David McCarter               *
  179. '* Modified:          By:                              *
  180. '*=====================================================*
  181. '*Returns the application path with a trailing \.      *
  182. '*To use, call the function [SomeString=GetAppPath()]  *
  183. '*                                                     *
  184. '*                                                     *
  185. '*                                                     *
  186. '*******************************************************
  187. Function GetAPPPath () As String
  188.     Dim sTemp As String
  189.     sTemp = App.Path
  190.     If Right$(sTemp, 1) <> "\" Then sTemp = sTemp + "\"
  191.     GetAPPPath = sTemp
  192. End Function
  193.  
  194. '*******************************************************
  195. '* Procedure Name: CheckUnique                         *
  196. '*-----------------------------------------------------*
  197. '* Created: 4/18/94   By: KeepOnTop                    *
  198. '* Modified:          By:                              *
  199. '*=====================================================*
  200. '*Keep form on top. Note that this is switched off if  *
  201. '*form is minimised, so place in resize event as well. *
  202. '*                                                     *
  203. '*                                                     *
  204. '*                                                     *
  205. '*******************************************************
  206. Sub KeepOnTop (F As Form)
  207. 'Keep form on top. Note that this is switched off if form is
  208. 'minimised, so place in resize event as well.
  209. Const wFlags = SWP_NOMOVE Or SWP_NOSIZE
  210.  
  211.     SetWindowPos F.hWnd, HWND_TOPMOST, 0, 0, 0, 0, wFlags    'Window will stay on top
  212.     'To undo call again with HWND_NOTOPMOST
  213.     DoEvents
  214. End Sub
  215.  
  216. '*******************************************************
  217. '* Procedure Name: ReadINI                             *
  218. '*-----------------------------------------------------*
  219. '* Created:           By: Daniel Bowen                 *
  220. '* Modified: 3/24/94  By: David McCarter               *
  221. '*=====================================================*
  222. '*Returns a string from an INI file. To use, call the  *
  223. '*functions and pass it the AppName, KeyName and INI   *
  224. '*File Name, [sReg=ReadINI(App1,Key1,INIFile)]. If you *
  225. '*need the returned value to be a integer then use the *
  226. '*val command.                                         *
  227. '*******************************************************
  228. Function ReadINI (AppName, KeyName, FileName As String) As String
  229.     Dim sRet As String
  230.     sRet = String(255, Chr(0))
  231.     ReadINI = Left(sRet, GetPrivateProfilestring(AppName, ByVal KeyName, "", sRet, Len(sRet), FileName))
  232. End Function
  233.  
  234. '*******************************************************
  235. '* Procedure Name: SelectText                          *
  236. '*-----------------------------------------------------*
  237. '* Created: 2/14/94   By: David McCarter               *
  238. '* Modified:          By:                              *
  239. '*=====================================================*
  240. '*Selects all the text in a text box. Call it when the *
  241. '*text box get focus, [SelectText Text1.text]          *
  242. '*                                                     *
  243. '*                                                     *
  244. '*                                                     *
  245. '*******************************************************
  246. Sub SelectText (ctrIn As Control)
  247.     ctrIn.SelStart = 0
  248.     ctrIn.SelLength = Len(ctrIn.Text)
  249. End Sub
  250.  
  251. '*******************************************************
  252. '* Procedure Name: WriteINI                            *
  253. '*-----------------------------------------------------*
  254. '* Created: 2/10/94   By: David McCarter               *
  255. '* Modified:          By:                              *
  256. '*=====================================================*
  257. '*Writes a string to an INI file. To use, call the     *
  258. '*function and pass it the AppName, KeyName, the New   *
  259. '*String and the INI File Name,                        *
  260. '*[R=WriteINI(App1,Key1,sReg,INIFile)]. Returns a 1 if *
  261. '*there were no errors and a 0 if there were errors.   *
  262. '*******************************************************
  263. Function WriteINI (AppName, KeyName, NewString, FileName As String) As Integer
  264.     WriteINI = WritePrivateProfileString(AppName, KeyName, NewString, FileName)
  265. End Function
  266.  
  267.