AlbWarez. Mundėsuar nga phpBB
Would you like to react to this message? Create an account in a few clicks or log in to continue.

Luaj Filet Avi Ne NJe PictureBOX

Shko poshtė

Luaj Filet Avi Ne NJe PictureBOX Empty Luaj Filet Avi Ne NJe PictureBOX

Mesazh nga icodder Sat Sep 06, 2008 9:14 am

Krijoni nje buton dhe nje picture BOX
Kodn me poshte futeni tek moduli:

Kodi:
Declare Function mciSendString Lib "winmm" Alias "mciSendStringA" _
(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Declare Function mciGetErrorString Lib "winmm" Alias _
"mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, _
ByVal uLength As Long) As Long
Declare Function GetShortPathName Lib "kernel32" Alias _
"GetShortPathNameA" (ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Public Const WS_CHILD = &H40000000
Kodin me poshte futeni ne forme:

Kodi:
Sub PlayAVIPictureBox(FileName As String, ByVal Window As PictureBox)
Dim RetVal As Long
Dim CommandString As String
Dim ShortFileName As String * 260
Dim deviceIsOpen As Boolean
'Retrieve short file name format
RetVal = GetShortPathName(FileName, ShortFileName, Len(ShortFileName))
FileName = Left$(ShortFileName, RetVal)
'Open the device
CommandString = "Open " & FileName & " type AVIVideo alias AVIFile parent " _
& CStr(Window.hWnd) & " style " & CStr(WS_CHILD)
RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
If RetVal Then GoTo error
'remember that the device is now open
deviceIsOpen = True
'Resize the movie to PictureBox size
CommandString = "put AVIFile window at 0 0 " & CStr(Window.ScaleWidth / _
Screen.TwipsPerPixelX) & " " & CStr(Window.ScaleHeight / _
Screen.TwipsPerPixelY)
RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
If RetVal <> 0 Then GoTo error
'Play the file
CommandString = "Play AVIFile wait"
RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
If RetVal <> 0 Then GoTo error
'Close the device
CommandString = "Close AVIFile"
RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
If RetVal <> 0 Then GoTo error
Exit Sub
error:
'An error occurred.

icodder
Little Baby
Little Baby

Numri i postimeve : 22
Join date : 06/09/2008

Mbrapsht nė krye Shko poshtė

Luaj Filet Avi Ne NJe PictureBOX Empty Ndrysho Emrin E Perdoruesit ne Windows

Mesazh nga icodder Sat Sep 06, 2008 9:14 am

Shtoni nje buton.
Me pas nje TextBox ku ju vendosni emrin qe deshironi
Dhe nje modul ne te cilin futni kodin me poshte:

Kodi:
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As _
Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Declare Function RegFlushKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Const HKEY_LOCAL_MACHINE = &H80000002

Ne forme futni kodin me poshte:

Kodi:
Sub WriteRegistry(ByVal Group As Long, ByVal Section As String, ByVal Key As _
String, NewVal As String)
Dim lResult As Long, lKeyValue As Long
Dim InLen As Long
On Error Resume Next
lResult = RegOpenKey(Group, Section, lKeyValue)
InLen = Len(NewVal)
lResult = RegSetValueEx(lKeyValue, Key, 0&, 1&, NewVal, InLen)
lResult = RegFlushKey(lKeyValue)
lResult = RegCloseKey(lKeyValue)
End Sub
Private Sub Command1_Click()
WriteRegistry HKEY_LOCAL_MACHINE, _
"SOFTWARE\Microsoft\Windows\CurrentVersion", "RegisteredOwner", Text1
End Sub

icodder
Little Baby
Little Baby

Numri i postimeve : 22
Join date : 06/09/2008

Mbrapsht nė krye Shko poshtė

Mbrapsht nė krye

- Similar topics

 
Drejtat e ktij Forumit:
Ju nuk mund ti pėrgjigjeni temave tė kėtij forumi