http://alpha-thema-online.uv.ro

Ad_Infinitum · Administrator

1) Auto-complete in combo-box-uri (cu date din mdb)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const CB_FINDSTRING = &H14C
Private Const CB_SELECTSTRING = &H14D
Private Const CB_LIMITTEXT = &H141
Private Const CB_ERR = (-1)

Dim r As DAO.Recordset

Private Sub Combo1_KeyPress(KeyAscii As Integer)
Dim t$, rez&, l&
Combo1.SelText = ""
t$ = Combo1.Text & Chr$(KeyAscii)
rez& = SendMessage(Combo1.hwnd, CB_FINDSTRING, -1,ByVal t$)
If rez& <> CB_ERR Then
l& = Len(t$)
Combo1.Text = Combo1.List(rez&)
KeyAscii = 0
Combo1.SelStart = l&
Combo1.SelLength = Len(Combo1.Text) - l&
End If
End Sub

Private Sub Combo1_LostFocus()
Dim t$, rez&
t$ = Combo1.Text
rez& = SendMessage(Combo1.hwnd, CB_FINDSTRING, -1, ByVal t$)
If rez& = CB_ERR Then
Combo1.AddItem Combo1.Text
'trebuie adaugat si in baza de date
End If
End Sub

Private Sub Form_Load()
Set r = DBEngine(0).OpenDatabase(_
"C:\Program Files\DevStudio\VB\BIBLIO.MDB").OpenRecordset("Authors")
While Not r.EOF
Combo1.AddItem r.Fields(1)
r.MoveNext
Wend
r.Close
Set r = Nothing
End Sub

2) Oprirea programului pentru un interval de timp
Pe lângã solutia cu Timer sau utilizarea functiei API Sleep se poate face astfel:

Private Sub Pause(interval) ' New sub
Current = Timer
Do While Timer - Current < Val(interval)
DoEvents
Loop
End Sub

3) Mãreste sau micsoreazã o imagine
Sursa este in Picture1 si va fi mutatã în Picture2.

Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, _
ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, _
ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, _
ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source

Private Sub Picture1_Click()
StretchBlt Picture2.hdc, 0, 0, Picture2.Width \ Screen.TwipsPerPixelX, _
Picture2.Height \ Screen.TwipsPerPixelY, _
Picture1.hdc, 0, 0, Picture1.Width \ Screen.TwipsPerPixelX, _
Picture1.Height \ Screen.TwipsPerPixelY, SRCCOPY
Picture2.Top = 0
End Sub

Roteste o imagine sub diferite unghiuri
' add three command buttons and two pictureboxes. Load a bitmap into picture1 in design
' mode. Set both box to the same size. Routines execute 3 times faster than routines
' found in Microsoft's Knowledge Base.

private Const SRCCOPY = &HCC0020
private Const Pi = 3.14159265359
private Declare Function SetPixel Lib "GDI32" (ByVal hDC As Integer, _
ByVal X As Integer, ByVal Y As Integer, ByVal crColor As Long) As Long
private Declare Function GetPixel Lib "GDI32" (ByVal hDC As Integer, _
ByVal X As Integer, ByVal Y As Integer) As Long
private Declare Function StretchBlt% Lib "GDI32" (ByVal hDC%, ByVal X%, _
ByVal Y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, _
ByVal YSrc%, ByVal nSrcWidth%, ByVal nSrcHeight%, ByVal dwRop&)

Sub Form_Load ()
picture1.ScaleMode = 3
picture2.ScaleMode = 3
End Sub

Sub Command1_Click ()
'flip horizontal
picture2.Cls
px% = picture1.ScaleWidth
py% = picture1.ScaleHeight
retval% = StretchBlt(picture2.hDC, px%, 0, -px%, py%, picture1.hDC, _
0, 0, px%, py%, SRCCOPY)
End Sub

Sub Command2_Click ()
'flip vertical
picture2.Cls
px% = picture1.ScaleWidth
py% = picture1.ScaleHeight
retval% = StretchBlt(picture2.hDC, 0, py%, px%, -py%, picture1.hDC, _
0, 0, px%, py%, SRCCOPY)
End Sub

Sub Command3_Click ()
'rotate 45 degrees
picture2.Cls
Call bmp_rotate(picture1, picture2, 3.14 / 4)
End Sub

Sub bmp_rotate (pic1 As PictureBox, pic2 As PictureBox, ByVal theta!)
' bmp_rotate(pic1, pic2, theta)
' Rotate the image in a picture box.
' pic1 is the picture box with the bitmap to rotate
' pic2 is the picture box to receive the rotated bitmap
' theta is the angle of rotation
Dim c1x As Integer, c1y As Integer
Dim c2x As Integer, c2y As Integer
Dim a As Single
Dim p1x As Integer, p1y As Integer
Dim p2x As Integer, p2y As Integer
Dim n As Integer, r As Integer

c1x = pic1.ScaleWidth \ 2
c1y = pic1.ScaleHeight \ 2
c2x = pic2.ScaleWidth \ 2
c2y = pic2.ScaleHeight \ 2

If c2x < c2y Then n = c2y Else n = c2x
n = n - 1
pic1hDC% = pic1.hDC
pic2hDC% = pic2.hDC

For p2x = 0 To n
For p2y = 0 To n
If p2x = 0 Then a = Pi / 2 Else a = Atn(p2y / p2x)
r = Sqr(1& * p2x * p2x + 1& * p2y * p2y)
p1x = r * Cos(a + theta!)
p1y = r * Sin(a + theta!)
c0& = GetPixel(pic1hDC%, c1x + p1x, c1y + p1y)
c1& = GetPixel(pic1hDC%, c1x - p1x, c1y - p1y)
c2& = GetPixel(pic1hDC%, c1x + p1y, c1y - p1x)
c3& = GetPixel(pic1hDC%, c1x - p1y, c1y + p1x)
If c0& <> -1 Then xret& = SetPixel(pic2hDC%, c2x + p2x, _
c2y + p2y, c0&)
If c1& <> -1 Then xret& = SetPixel(pic2hDC%, c2x - p2x, _
c2y - p2y, c1&)
If c2& <> -1 Then xret& = SetPixel(pic2hDC%, c2x + p2y, _
c2y - p2x, c2&)
If c3& <> -1 Then xret& = SetPixel(pic2hDC%, c2x - p2y, _
c2y + p2x, c3&)
Next
t% = DoEvents()
Next
End Sub

4) PC-ul are placa de sunet?
Private Declare Function waveOutGetNumDevs Lib "MMSYSTEM" () As Integer

i% = waveOutGetNumDevs()
If i% > 0 Then
MsgBox "You Can Play Wave Data"
Else
MsgBox "Cannot Play Wave Data"
End If

5) Invocarea conexiunii Dial-Up
Dim X
'"MyConnectionsName" is the name under the icon in Dial-up Networking
X = Shell("rundll32.exe rnaui.dll,RnaDial " & "MyConnectionsName", 1)
DoEvents
'You can type in your password before the { below.
SendKeys "{enter}", True
DoEvents
End Sub

6) Umplerea un picture-box cu aceeasi poză (repetata)
Private Declare Function BitBlt Lib "GDI32" (ByVal hDestDC As Integer, _
ByVal X As Integer, ByVal Y As Integer, ByVal nWid As Integer, _
ByVal nHt As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, _
ByVal YSrc As Integer, ByVal dwRop As Long) As Integer

Private Sub Tile(picParent As PictureBox, picTile As PictureBox)
'This subroutine tiles a picture onto another picture.
'call syntax: Tile Picture1, Picture2
' Tile (destination), (source)
Dim TileIt As Integer
Const SRCCOPY = &HCC0020
Dim X As Integer, Y As Integer
Dim MaximumX As Integer, MaximumY As Integer
MaximumX = picParent.Width + picTile.Width
MaximumY = picParent.Height + picTile.Height
MaximumX = MaximumX \ Screen.TwipsPerPixelX
MaximumY = MaximumY \ Screen.TwipsPerPixelY
Dim TileWidth As Integer, TileHeight As Integer
TileWidth = picTile.Width \ Screen.TwipsPerPixelX
TileHeight = picTile.Height \ Screen.TwipsPerPixelY
For Y = 0 To MaximumY Step TileHeight
For X = 0 To MaximumX Step TileWidth
TileIt = BitBlt(picParent.hDC, X, Y, TileWidth, TileHeight, _
picTile.hDC, 0, 0, SRCCOPY)
Next
Next
End Sub

7) Umplerea unei forme cu aceeasi fotografie (repetata)
Private Declare Function BitBlt Lib "GDI32" (ByVal hDestDC As Integer, _
ByVal X As Integer, ByVal Y As Integer, ByVal nWidth As Integer, _
ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, _
ByVal YSrc As Integer, ByVal dwRop As Long) As Integer

Dim maxhgt As Long, maxwid As Long
Dim pwid As Integer, phgt As Integer

Sub Form_Load ()
picture1.ScaleMode = 3
picture1.Visible = False
picture1.AutoSize = True
picture1.AutoRedraw = True
pwid = picture1.ScaleWidth
phgt = picture1.ScaleHeight
End Sub

Sub Form_Paint ()
phDC& = picture1.hDC
frmhdc& = hdc
For j% = 0 To maxhgt Step phgt
For i% = 0 To maxwid Step pwid
X% = BitBlt(frmhdc&, i%, j%, pwid, phgt, phDC&, 0, 0, &HCC0020)
Next
Next
End Sub

Sub Form_Resize ()
maxhgt = Height \ screen.TwipsPerPixelY
maxwid = Width \ screen.TwipsPerPixelX
End Sub

8) Mutarea / copierea fisierelor cu API
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" _
(ByVal lpExistingFileName As String, ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long
Private Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" _
(ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long

'Place the following code in under a command button or in a menu, etc...

source = "C:\myfile.txt"
target = "C:\Windows\myfile.txt"

'Copy File
A = CopyFile(Trim$(Source), Trim(Target), False)
If A Then
MsgBox "File copied!"
Else
MsgBox "Error. File not moved!"
End If

9) Spatiu neocupat pe HDD
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" ( _
ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, _
lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long

Dim free_Space As Long
ChDrive "C:"
Dim numSectorsPerCluster As Long
Dim numBytesPerSector As Long
Dim numFreeClusters As Long
Dim numTotalClusters As Long
Dim success As Boolean
success = GetDiskFreeSpace("C:\", numSectorsPerCluster, numBytesPerSector, _
numFreeClusters, numTotalClusters)
free_Space = numSectorsPerCluster * numBytesPerSector * numFreeClusters
Label1.Caption = "The total free space on Drive C: = " & _
format(Str$(free_Space/1024),"###,### ") & " KB"

Determinare an bisect sau nu
Function IsLeapYear(ByVal sYear As String) As Boolean
If IsDate("02/29/" & sYear) Then
IsLeapYear = True
Else
IsLeapYear = False
End If
End Function

Data este in week-end?
Public Function IsWeekend(ByVal vntDate As Variant) As Boolean
Dim bResult As Boolean
If IsDate(vntDate) Then
If (WeekDay(vntDate) Mod 6 = 1) Then bResult = True Else bResult = False
Else
Err.Raise 13, "Type Mismatch, Must Be Date"
End If
IsWeekend = bResult
End Function

Ad_Infinitum · Administrator

1) Determina toate controalele dintr-un frame (1)
Dim c As Control

Private Sub Command1_Click()
For Each c In Controls
If c.Container Is Frame1 Then Print c.Name
Next
End Sub

2) Determina toate controalele dintr-un frame (2)

Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, _
ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2

Dim l As Long
Dim s As String * 255

Private Sub Command2_Click()
l = GetWindow(Frame1.hwnd, GW_CHILD)
If l <> 0 Then
GetWindowText l, s, 255
Print Left$(s, InStr(s, Chr(0)) - 1)
Do
l = GetWindow(l, GW_HWNDNEXT)
If l <> 0 Then
GetWindowText l, s, 255
Print Left$(s, InStr(s, Chr(0)) - 1)
End If
Loop While l <> 0
End If
End Sub

3) Obtin serial-number-ul pentru HDD

Private Declare Function GetVolumeInformation Lib "kernel32" _
Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long

Dim VolName As String * 255
Dim VolFS As String * 255
Dim Serial As Long
GetVolumeInformation "c:\", VolName, 255, Serial, 0, 0, VolFS, 255
VolName = Left$(VolName, InStr(VolName, Chr(0)) - 1)
VolFS = Left$(VolFS, InStr(VolFS, Chr(0)) - 1)
MsgBox VolName & vbCrLf & VolFS & vbCrLf & Serial

4) Ce Service Pack e instalat pe NT?

Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

Private Declare Function GetVersionEx Lib "kernel32" Alias _
"GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

' Returns Version of Windows as a String
' NOTE: Win95 returns "4.00", WIn98 returns "4.10"
'
' It also optionally returns the Windows NT Service Pack
' version in the argument, if one is passed

Function WindowsVersionSP(Optional NTServicePack As Integer) As String
Dim osInfo As OSVERSIONINFO
osInfo.dwOSVersionInfoSize = Len(osInfo)
GetVersionEx osInfo
WindowsVersionSP = osInfo.dwMajorVersion & "." & Right$( _
"0" & Format$(osInfo.dwMinorVersion), 2)

If osInfo.dwMajorVersion = 4 Then
If InStr(osInfo.szCSDVersion, "3") > 0 Then
NTServicePack = 3
ElseIf InStr(osInfo.szCSDVersion, "4") > 0 Then
NTServicePack = 4
ElseIf InStr(osInfo.szCSDVersion, "5") > 0 Then
NTServicePack = 5
ElseIf InStr(osInfo.szCSDVersion, "6") > 0 Then
NTServicePack = 6
Else
NTServicePack = 0
End If
End If
End Function

5) Converteste ProgId la CLSID

Private Declare Function CLSIDFromProgID Lib "ole32.dll" (ByVal _
lpszProgID As Long, pCLSID As Any) As Long
Private Declare Function StringFromCLSID Lib "ole32.dll" (pCLSID As _
Any, lpszProgID As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (dest As Any, source As Any, ByVal bytes As Long)
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
' Convert a ProgID (such as "Word.Application") into the
' string representation of its CLSID
Function ProgIdToCLSID(ByVal ProgID As String) As String
Dim pResult As Long, pChar As Long
Dim char As Integer, length As Long
' No need to use a special UDT
Dim guid(15) As Byte

' get the CLSID in binary form
CLSIDFromProgID StrPtr(ProgID), guid(0)
' convert to a string, get pointer to result
StringFromCLSID guid(0), pResult
' find the terminating null char
pChar = pResult - 2
Do
pChar = pChar + 2
CopyMemory char, ByVal pChar, 2
Loop While char
' now get the entire string in one operation
length = pChar - pResult
' no need for a temporary string
ProgIdToCLSID = Space$(length \ 2)
CopyMemory ByVal StrPtr(ProgIdToCLSID), ByVal pResult, length
' release the memory allocated to the string
CoTaskMemFree pResult
End Function

6) Converteste CLSID la ProgID

Private Declare Function ProgIDFromCLSID Lib "ole32.dll" (pCLSID As _
Any, lpszProgID As Long) As Long
Private Declare Function CLSIDFromString Lib "ole32.dll" (ByVal _
lpszProgID As Long, pCLSID As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (dest As Any, source As Any, ByVal bytes As Long)
' Convert a string representation of a CLSID, including the
' surrounding brace brackets, into the corresponding ProgID.
Function CLSIDToProgID(ByVal CLSID As String) As String
Dim pResult As Long, pChar As Long
Dim char As Integer, length As Long
' No need to use a special UDT
Dim guid(15) As Byte
' convert from string to a binary CLSID
CLSIDFromString StrPtr(CLSID), guid(0)
' convert to a string, get pointer to result
ProgIDFromCLSID guid(0), pResult
' find the terminating null char
pChar = pResult - 2
Do
pChar = pChar + 2
CopyMemory char, ByVal pChar, 2
Loop While char
' now get the entire string in one operation
length = pChar - pResult
' no need for a temporary string
CLSIDToProgID = Space$(length \ 2)
CopyMemory ByVal StrPtr(CLSIDToProgID), ByVal pResult, length
End Function

7) Obtin un obiect dintr-un pointer

Private Declare Sub CopyMemory Lib "Kernel32" Alias _
"RtlMoveMemory" (dest As Any, Source As Any, ByVal bytes As Long)
' Returns an object given its pointer
' This function reverses the effect of the ObjPtr function
Function ObjFromPtr(ByVal pObj As Long) As Object
Dim obj As Object
' force the value of the pointer into the temporary object variable
CopyMemory obj, pObj, 4
' assign to the result (this increments the ref counter)
Set ObjFromPtr = obj
' manually destroy the temporary object variable
' (if you omit this step you'll get a GPF!)
CopyMemory obj, 0&, 4
End Function

Data crearii, modificarii si ultima accesare a unui fisier

Private Const MAX_PATH = 260

Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Declare Function CreateFile Lib "kernel32" Alias _
"CreateFileA" (ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
ByVal NoSecurity As Long, ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As _
Long) As Long
Private Declare Function GetFileTime Lib "kernel32" (ByVal hFile As _
Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, _
lpLastWriteTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" _
(lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" _
(lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long

Private Const GENERIC_READ = &H80000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const OPEN_EXISTING = 3
Private Const INVALID_HANDLE_VALUE = -1

' Retrieve the Create date, Modify (write) date and Last Access date of
' the specified file. Returns True if successful, False otherwise.

Function GetFileTimeInfo(ByVal FileName As String, Optional CreateDate As Date, _
Optional ModifyDate As Date, Optional LastAccessDate As Date) As Boolean

Dim hFile As Long
Dim ftCreate As FILETIME
Dim ftModify As FILETIME
Dim ftLastAccess As FILETIME
Dim ft As FILETIME
Dim st As SYSTEMTIME

' open the file, exit if error
hFile = CreateFile(FileName, GENERIC_READ, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, _
0&)
If hFile = INVALID_HANDLE_VALUE Then Exit Function

' read date information
If GetFileTime(hFile, ftCreate, ftLastAccess, ftModify) Then
' non zero means successful
GetFileTimeInfo = True

' convert result to date values
' first, convert UTC file time to local file time
FileTimeToLocalFileTime ftCreate, ft
' then convert to system time
FileTimeToSystemTime ft, st
' finally, make up the Date value
CreateDate = DateSerial(st.wYear, st.wMonth, _
st.wDay) + TimeSerial(st.wHour, st.wMinute, _
st.wSecond) + (st.wMilliseconds / 86400000)

' do the same for the ModifyDate
FileTimeToLocalFileTime ftModify, ft
FileTimeToSystemTime ft, st
ModifyDate = DateSerial(st.wYear, st.wMonth, _
st.wDay) + TimeSerial(st.wHour, st.wMinute, _
st.wSecond) + (st.wMilliseconds / 86400000)
' and for LastAccessDate
FileTimeToLocalFileTime ftLastAccess, ft
FileTimeToSystemTime ft, st
LastAccessDate = DateSerial(st.wYear, st.wMonth, _
st.wDay) + TimeSerial(st.wHour, st.wMinute, _
st.wSecond) + (st.wMilliseconds / 86400000)
End If

' close the file, in all cases
CloseHandle hFile
End Function

Private Sub Command1_Click()
Dim dateCreate As Date
Dim dateModify As Date
Dim dateLastAccess As Date
CommonDialog1.ShowOpen
Text1 = CommonDialog1.FileName
GetFileTimeInfo Text1, dateCreate, dateModify, dateLastAccess
MsgBox dateCreate & vbCrLf & dateModify & vbCrLf & dateLastAccess
End Sub

9) Ultima zi din luna

Public Function LastDay(Month As Integer, Year As Integer) As Integer
Dim dtThisMonth As Date
Dim dtNextMonth As Date
Dim dtLastDay As Date
dtThisMonth = CDate(Month & "/01/" & Year)
dtNextMonth = DateAdd("m", 1, dtThisMonth)
dtLastDay = DateAdd("d", -1, dtNextMonth)
LastDay = Day(dtLastDay)
End Function

10) Verific daca programul a mai fost lansat

'Private Type SECURITY_ATTRIBUTES
' nLength As Long
' lpSecurityDescriptor As Long
' bInheritHandle As Long
'End Type

Private Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" _
(ByVal lpMutexAttributes As Long, ByVal bInitialOwner As Long, _
ByVal lpName As String) As Long
Private Declare Function ReleaseMutex Lib "kernel32" (ByVal hMutex As Long) As Long

Private Const ERROR_ALREADY_EXISTS = 183&

Dim hMutex As Long

Private Sub Command1_Click()
Me.Caption = Text1
End Sub

Private Sub Form_Load()
On Error Resume Next
hMutex = CreateMutex(0, True, "Test 1")
If Err.LastDllError = ERROR_ALREADY_EXISTS Then
MsgBox "Deja ruleaza!"
Unload Me
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
ReleaseMutex hMutex
End Sub

11) Afiseaza/ascunde butonul 'Start'

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, _
ByVal wCmd As Long) As Long

Private Const GW_CHILD = 5
Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1

Dim h As Long

Private Sub Command1_Click()
ShowWindow h, SW_HIDE
End Sub

Private Sub Command2_Click()
ShowWindow h, SW_SHOWNORMAL
End Sub

Private Sub Form_Load()
Command1.Caption = "Hide start"
Command2.Caption = "Show start"
h = FindWindow("Shell_TrayWnd", vbNullString)
h = GetWindow(h, GW_CHILD)
End Sub

12) Converteste Byte Array la String

Public Function ByteArrayToString(bytArray() As Byte) As String
Dim sAns As String
Dim iPos As String
sAns = StrConv(bytArray, vbUnicode)
iPos = InStr(sAns, Chr(0))
If iPos > 0 Then sAns = Left(sAns, iPos - 1)
ByteArrayToString = sAns
End Function

gata .. sper sa va foloseasca :whistle: