Vb za pocetnike, poznavaoce,profesionalce -primeri i trikovi

• 1Ovo se svidja korisniku: mcrule
  
  Registruj se da bi pohvalio/la poruku!

Ovaj podforum je mnooogo zapusten, pa sam odlucio da ga malo ozivim.
Ovde se mogu stavljati svi trikovi i source kodovi ( kako uraditi/dobiti nesto...) ...
Ja cu poceti sa nekim primerima:

1.Dozvolite samo jedno pokretanje vase aplikacije:

Private Sub Form_Load() If App.PrevInstance = True Then  Call MsgBox("This program is already running!", vbExclamation) Unload Me End Sub

2.Diskonektovanje sa interneta ( probao sam na dial-up i adsl konekciji ):

Stavite jedan modul u projekat i jedno komandno dugme u formu

Ovo ide u modul:
Public Const RAS_MAXENTRYNAME As Integer = 256 Public Const RAS_MAXDEVICETYPE As Integer = 16 Public Const RAS_MAXDEVICENAME As Integer = 128 Public Const RAS_RASCONNSIZE As Integer = 412 Public Const ERROR_SUCCESS = 0& Public Type RasEntryName dwSize As Long szEntryName(RAS_MAXENTRYNAME) As Byte End Type Public Type RasConn dwSize As Long hRasConn As Long szEntryName(RAS_MAXENTRYNAME) As Byte szDeviceType(RAS_MAXDEVICETYPE) As Byte szDeviceName(RAS_MAXDEVICENAME) As Byte End Type Public Declare Function RasEnumConnections Lib "rasapi32.DLL" _ Alias "RasEnumConnectionsA" (lpRasConn As Any, lpcb As Long, _ lpcConnections As Long) As Long Public Declare Function RasHangUp Lib "rasapi32.DLL" Alias _ "RasHangUpA" (ByVal hRasConn As Long) As Long Public gstrISPName As String Public ReturnCode As Long

A ovo u formu:
Public Function ByteToString(bytString() As Byte) As String Dim I As Integer ByteToString = "" I = 0 While bytString(I) = 0& ByteToString = ByteToString & Chr(bytString(I)) I = I + 1 Wend End Function Private Sub Command1_Click() Dim I As Long Dim lpRasConn(255) As RasConn Dim lpcb As Long Dim lpcConnections As Long Dim hRasConn As Long lpRasConn(0).dwSize = RAS_RASCONNSIZE lpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSize lpcConnections = 0 ReturnCode = RasEnumConnections(lpRasConn(0), lpcb, lpcConnections) If ReturnCode = ERROR_SUCCESS Then For I = 0 To lpcConnections - 1 If Trim(ByteToString(lpRasConn(I).szEntryName)) = Trim(gstrISPName) Then hRasConn = lpRasConn(I).hRasConn ReturnCode = RasHangUp(ByVal hRasConn) End If Next I End If End Sub

3.Prikazi/sakri TaskBar:

Stavite modul u projekat i 2 komandna dugmeta u formu:

Ovo ide u modul:
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _ ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _ ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Const SWP_HIDEWINDOW = &H80 Public Const SWP_SHOWWINDOW = &H40

A ovo u formu:
Private Sub Command1_Click() hwnd1 = FindWindow("Shell_traywnd", "") Call SetWindowPos(hwnd1, 0, 0, 0, 0, 0, SWP_HIDEWINDOW) End Sub   Private Sub Command2_Click() hwnd1 = FindWindow("Shell_traywnd", "") Call SetWindowPos(hwnd1, 0, 0, 0, 0, 0, SWP_SHOWWINDOW) End Sub

To je to za sad ( mozda ovo nije bas prikladno za pocetnike,ali bice jos trikova), vise nemam vremena, voleo bih kad bi jos neko ubacio neki trik dok se ja ne vratim.

• 0Niko još nije pohvalio poruku.
  Registruj se da bi pohvalio/la poruku!

veoma dobra ideja, ovaj forum je stvarno zapusten (ja ga sve redje obilazim)...
ja cu ti se pridruziti cim budem dosao do novog kompa :p (stari crko pa sad visim u internet clubu)
sto se tice tvog prvog primera, za PrevInstance, mnogo bolje resenje je da se koristi mutex, tj CreateMutex API jer App.PrevInstance nekad nece da radi kako treba (meni je prijavljivao da nema druge instance iako je ona vec pokrenuta)...

valjalo bi kad bi se sto vise ljudi prikljucilo, da ozivimo malo ovaj forum!

pozdrav,
krcko

• 0Niko još nije pohvalio poruku.
  Registruj se da bi pohvalio/la poruku!

Kao moder u potpunosti se slazem sa vama stavrno je za pusten i ja pokusavam da ga ozivi, ali slaba vajda...

• 0Niko još nije pohvalio poruku.
  Registruj se da bi pohvalio/la poruku!

Nekoliko Shell poziva:

1. Poziva Notepad:

Call Shell("notepad", vbNormalFocus)

2.Poziva Wordpad

Call Shell("write", vbNormalFocus)

3.Poziva igricu solitaire:

Call Shell("sol", vbNormalFocus)

4.Poziva digitron:

Call Shell("calc", vbNormalFocus)

I tako dalje. Ako hocete da pozovete jos nesto, idite u system32 folder, nadjite program koji vas interesuje i njegovo ime bez ekstenzije unesite izmedju navodnika: kao "sol" ili "notepad"...
Ako tog programa nema u system32, onda unesite sledece:
Shell("putanja")

• 0Niko još nije pohvalio poruku.
  Registruj se da bi pohvalio/la poruku!

Eject CD

Deklarisanje:
Private Declare Function GetVersion Lib "kernel32" () As Long Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _ (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _ lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _ ByVal hTemplateFile As Long) As Long Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, _ ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, _ ByVal nOutBufferSize As Long, lpBytesReturned As Long, lpOverlapped As Any) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Const INVALID_HANDLE_VALUE = -1 Private Const OPEN_EXISTING = 3 Private Const FILE_FLAG_DELETE_ON_CLOSE = 67108864 Private Const GENERIC_READ = &H80000000 Private Const GENERIC_WRITE = &H40000000 Private Const IOCTL_STORAGE_EJECT_MEDIA = 2967560 Private Const VWIN32_DIOC_DOS_IOCTL = 1   Private Type DIOC_REGISTERS   reg_EBX As Long   reg_EDX As Long   reg_ECX As Long   reg_EAX As Long   reg_EDI As Long   reg_ESI As Long   reg_Flags As Long End Type

Kod za dugme:
Private Sub Command1_Click() Dim hDrive As Long, DummyReturnedBytes As Long Dim EjectDrive As String, DriveLetterAndColon As String Dim RawStuff As DIOC_REGISTERS   EjectDrive = InputBox("Iz kojeg diska zelis da izbacis cd?", "Eject Media")   If Len(EjectDrive) Then     DriveLetterAndColon = UCase(Left$(EjectDrive & ":", 2))     If GetVersion >= 0 Then       hDrive = CreateFile("\\.\" & DriveLetterAndColon, GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, 0, 0)       If hDrive <> INVALID_HANDLE_VALUE Then         Call DeviceIoControl(hDrive, IOCTL_STORAGE_EJECT_MEDIA, 0, 0, 0, 0, DummyReturnedBytes, ByVal 0)         Call CloseHandle(hDrive)        End If     Else        hDrive = CreateFile("\\.\VWIN32", 0, 0, ByVal 0, 0, FILE_FLAG_DELETE_ON_CLOSE, 0)       If hDrive <> INVALID_HANDLE_VALUE Then         RawStuff.reg_EAX = &H440D   'The function to use         RawStuff.reg_EBX = Asc(DriveLetterAndColon) - Asc("A") + 1 'The drive to do it on         RawStuff.reg_ECX = &H49 Or &H800            Call DeviceIoControl(hDrive, VWIN32_DIOC_DOS_IOCTL, RawStuff, LenB(RawStuff), RawStuff, LenB(RawStuff), DummyReturnedBytes, ByVal 0)         Call CloseHandle(hDrive)       End If     End If   End If End Sub

• 0Niko još nije pohvalio poruku.
  Registruj se da bi pohvalio/la poruku!

Mnooogo kraci nacin:

U modul:
Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

U command click:
lngReturn = mciSendString("set CDAudio door open", strReturn, 127, 0)

A da se zatvori ista deklaracija samo se u command click stavlja:
lngReturn = mciSendString("set CDAudio door closed", strReturn, 127, 0)

• 0Niko još nije pohvalio poruku.
  Registruj se da bi pohvalio/la poruku!

Dejan123 ::


U command click:
lngReturn = mciSendString("set CDAudio door open", strReturn, 127, 0)

a sta ako nema prikljucen audio

• 0Niko još nije pohvalio poruku.
  Registruj se da bi pohvalio/la poruku!

Probao sam na vecini kompjutera ( pre svakog posta proverim ). Moj drug nije imao prikljucen audio pa je sve radilo ok.

Dopuna: 02 Nov 2005 8:56

Dejan123 ::Moj drug nije imao prikljucen audio pa je sve radilo ok.
I mene si zbunio . ovu recenicu zaboravi ( bio sam pospan dok sam kucao ). Da se vratimo na problem. Kod koji sam ja poslao 100% radi na svim cd/dvd uredjajima, jer su oni multimedijalni, pa odatle u vb-u "CdAudio".
pozdrav

Dopuna: 05 Nov 2005 9:58

Xp style za vb aplikacije:

U kod forme unesite:
Option Explicit Private Declare Function InitCommonControls Lib "comctl32.dll" () As Long Private Sub Form_Initialize() InitCommonControls End Sub

Napravit exe fajl ( sa imeom "xp.exe" npr ), otvorite notepad i upisite sledece:

<?xml version="1.0" encoding="UTF-8" standalone="yes"?> <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"> <assemblyIdentity type="win32" processorArchitecture="*" version="6.0.0.0" name="mash"/> <description>Ovde napisati neki opis</description> <dependency> <dependentAssembly> <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" language="*" processorArchitecture="*" publicKeyToken="6595b64144ccf1df" /> </dependentAssembly> </dependency> </assembly>

Fajl imenujte: "xp.exe.manifest" i snimite u direktorijum u kome je snimljen exe.

• 0Niko još nije pohvalio poruku.
  Registruj se da bi pohvalio/la poruku!

@Dejan123

Jedno pitanje u vezi sa tvojim kodom za izbacivanje vratanca za CD. Imam 3 uredjaja koji mogu da izbacuju vratanca... kako da izaberem koji da otvorim?

• 0Niko još nije pohvalio poruku.
  Registruj se da bi pohvalio/la poruku!

Ja imam gotov primer okacicu ga do kraja dana