Archive

Archive for April, 2009

Application Launching Another

April 19, 2009 programmervb Leave a comment

‘Description: Shell Function. Runs an executable program. Wait for program to
‘             terminate. Time out after 30 seconds.

‘Declare Function GetModuleUsage Lib “Kernel” (ByVal hModule As Integer) As Integer
‘Const SW_HIDE = 0      ‘Normal Window
‘Const SW_NORMAL = 1    ‘Maximized Window
‘Const SW_MAXIMIZE = 3  ‘Minimized Window
‘Const SW_MINIMIZE = 6  ‘Hidden Window

‘Sub Command1_Click ()
On Error Resume Next
command1.Enabled = False
iInst% = Shell(“C:\TEST\DOSAPP.EXE”, SW_MINIMIZE)
startt! = Timer
timeout% = False
Do While GetModuleUsage(iInst%) > 0
DoEvents
If Abs(Timer – startt!) > 30 Then
timeout% = True
Exit Do
End If
Loop

If timeout% Then MsgBox “Timed out, 30 seconds passed!”, 0, “Warning”
command1.Enabled = True
‘End Sub

Categories: forms

Control Sound With Visual Basic

April 13, 2009 programmervb 1 comment
   Control           Property    Setting
   ----------------------------------------

   Command Button    Name        PlaySound
                     Caption     Play Sound

   Command Button    Name        LeftUp
                     Caption     Left Up

   Command Button    Name        LeftDown
                     Caption     Left Down

   Command Button    Name        RightUp
                     Caption     Right Up

   Command Button    Name        RightDown
                     Caption     Right Down

   Label             Name        LeftVol

   Label             Name        RightVol

‘General Declarations
Declare Function sndPlaySound Lib "MMSYSTEM.DLL"
      (ByVal lpszSoundName As String, ByVal wFlags As Integer) As Integer
   Declare Function waveoutSetVolume Lib "mmsystem.dll"
      (ByVal wDeviceID As Integer, ByVal dwVolumeRight As Integer,
      ByVal dwVolumeLeft As Integer) As Integer
   Declare Function waveOutGetVolume Lib "MMSYSTEM.DLL"
      (ByVal wDeviceID As Integer, lpdwvolume As Long) As Integer

   Const SND_ASYNC = &H1
   Const SND_NODEFAULT = &H2

   Dim CurrentVolLeft As Long
   Dim CurrentVolRight As Long
                               
‘code
Sub Form_Load ()
   Dim x As Integer
   Dim BothVolumes As Long

 ' Note that the waveid is 0 indicating the first wave output device.
 ' If you were to play multiple wavefiles on multiple wave output devices
 ' you would use 1 for the second wave output device, 2 for the third and
 ' so on.
 ' This code will retrieve the current volume setting

   x = waveOutGetVolume(0, BothVolumes)

   ' This code isolates the low-order word.
   ' Note that the value &HFFFF& is a Long Integer, which is the same
   ' as 0000FFFF, but because Visual Basic would automatically
   ' truncate this to FFFF, you must force the logical operation to use
   ' a four-byte Long Integer (0000FFFF) rather than a two-byte Integer
   ' (FFFF). This is accomplished by using the type casting
   ' character (&).
   CurrentVolLeft = BothVolumes And &HFFFF&

   ' This code isolates the high-order word.
   ' Enter the following two lines as one, single line:
   CurrentVolRight = ((BothVolumes And &HFFFF0000) / &H10000)
     And &HFFFF&

   LeftVol.Caption = Hex$(CurrentVolLeft)   ' Update the label with the
   RightVol.Caption = Hex$(CurrentVolRight) ' current volume settings.
End Sub

Sub PlaySound_Click ()
   Dim x As Integer
   Dim wFlags As Integer
   Dim SoundName As String
   SoundName = "C:\WINDOWS\MSREMIND.WAV"    ' Pick any wave file.
   wFlags = SND_ASYNC Or SND_NODEFAULT
   x = sndPlaySound(SoundName$, wFlags%)    ' Play the wave file.
End Sub

Sub LeftUp_Click ()
   ' Increase the left sound channel setting:
   Dim x As Integer
   CurrentVolLeft = CurrentVolLeft + &H1000&
   ' Prevent the channel setting from exceeding the maximum limit:
   If CurrentVolLeft > &HFFFF& Then CurrentVolLeft = &HFFFF&
   LeftVol.Caption = Format$(Hex$(CurrentVolLeft))
   ' Enter the following two lines as one, single line:
   x = waveoutSetVolume(0, CInt("&H" + Hex$(CurrentVolRight)),
      CInt("&H" + Hex$(CurrentVolLeft)))
End Sub

Sub LeftDown_Click ()
   ' Decrease the left sound channel setting:
   Dim x As Integer
   CurrentVolLeft = CurrentVolLeft - &H1000&
   ' Prevent the channel setting from dropping below the minimum limit:
   If CurrentVolLeft < &H0& Then CurrentVolLeft = &H0&
   LeftVol.Caption = Hex$(CurrentVolLeft)
   ' Enter the following two lines as one, single line:
   x = waveoutSetVolume(0, CInt("&H" + Hex$(CurrentVolRight)),
      CInt("&H" + Hex$(CurrentVolLeft)))
End Sub

Sub RightUp_Click ()
   ' Increase the right sound channel setting:
   Dim x As Integer
   CurrentVolRight = CurrentVolRight + &H1000&
   ' Prevent the channel setting from exceeding the maximum limit.
   If CurrentVolRight > &HFFFF& Then CurrentVolRight = &HFFFF&
   RightVol.Caption = Hex$(CurrentVolRight)
   ' Enter the following two lines as one, single line:
   x = waveoutSetVolume(0, CInt("&H" + Hex$(CurrentVolRight)),
      CInt("&H" + Hex$(CurrentVolLeft)))
End Sub

Sub RightDown_Click ()
   ' Decrease the right sound channel setting:
   Dim x As Integer
   CurrentVolRight = CurrentVolRight - &H1000&
   ' Prevent the channel setting from dropping below the minimum limit:
   If CurrentVolRight < 0 Then CurrentVolRight = 0
   RightVol.Caption = Hex$(CurrentVolRight)
   ' Enter the following two lines as one, single line:
   x = waveoutSetVolume(0, CInt("&H" + Hex$(CurrentVolRight)),
      CInt("&H" + Hex$(CurrentVolLeft)))
End Sub
 

Categories: control

Drives, Determining Type

Description: Determines drive type by letter designation

‘Private Declare Function GetDriveType Lib “kernel32″ Alias “GetDriveTypeA” _
(ByVal nDrive As String) As Long
‘Const DRIVE_REMOVABLE = 2
‘Const DRIVE_REMOTE = 4
‘Const DRIVE_RAMDISK = 6
‘Const DRIVE_FIXED = 3
‘Const DRIVE_CDROM = 5

’syntax: MyDriveType(“a:”) or MyDriveType(dir1.path) etc..,
‘Function MyDriveType(ByVal DR As String) As String
DR = Left$(DR, 2)
x% = GetDriveType(DR)
Select Case x%
Case DRIVE_REMOVABLE
MyDriveType = “REMOVABLE    ” & DR
Case DRIVE_FIXED
MyDriveType = “FIXED        ” & DR
Case DRIVE_REMOTE
MyDriveType = “REMOTE       ” & DR
Case DRIVE_RAMDISK
MyDriveType = “RAMDISK      ” & DR
Case DRIVE_CDROM
MyDriveType = “CDROM        ” & DR
Case Else
MyDriveType = “UNKNOWN      ” & DR
End Select
‘End Function

Categories: control Tags: