vb6

KLAVYE VE FAREYİ SİSTEM DIŞI BIRAKMAK

 BlockInput() Api'si sayesinde fare ile klavye'yi, sistem disi birakip yeniden eski haline getirebiliyoruz.

Option Explicit

Private Declare Function BlockInput Lib "user32" (ByVal fBlock _
As Long) As Long

Const API_FALSE = 0&
Const API_TRUE = 1&

Private Sub Command1_Click()
Timer1.Interval = 500
Timer1.Enabled = True
Call BlockInput(API_TRUE)
End Sub

Private Sub Timer1_Timer()
Static Cnt As Long

Cnt = Cnt + 1
If Cnt > 10 Then
Cnt = 0
Timer1.Enabled = False
Call BlockInput(API_FALSE)
Label1.Caption = ""
Else
Label1.Caption = "Eski Hal İcin Kalan Zaman: " _
& Format$(CStr((10 - Cnt)) / 2, "0.0")
End If
End Sub

PENCERENİN DEVAMLI ÖNDE DURMASINI SAĞLAMAK

 Pencereyi devamli en önde tutar. Bu sayede programimizin devamli önde olmasini saglayabiliriz.

Option Explicit

Private 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

Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2

Private Sub Form_Load()
Check1.Caption = "Pencereyi önde tut"
Check1.Value = vbChecked
End Sub

Private Sub Check1_Click()
If Check1.Value = vbChecked Then
SetWindowPos hwnd, _
HWND_TOPMOST, 0, 0, 0, 0, _
SWP_NOMOVE + SWP_NOSIZE
Else
SetWindowPos hwnd, _
HWND_NOTOPMOST, 0, 0, 0, 0, _
SWP_NOMOVE + SWP_NOSIZE
End If
End Sub

PROGRAMIN BİRDEN FAZLA ÇALIŞMAMASI

 Programimizin ayni anda iki sefer calismamasini saglamak icin asagidaki kodu kullanabiliriz.

'-------------------- Kod Form1 --------------------------

Option Explicit

Private Sub Command1_Click()
Unload Me
End Sub

'--------------------- Kod Form1 Sonu---------------------

'------------------- Kode Module1 -------------------------

Option Explicit

Sub Main()
Dim MemTitle$
If App.PrevInstance = True Then
MemTitle = App.Title
App.Title = "%&irgendwas"
AppActivate MemTitle
Else
Form1.Show
End If
End Sub

'-------------------- Kod Module1 Sonu--------------------

PROGRAMI TASKBAR'DA GÖSTERMEK

Herkes Sistem saatinin bulundugu yerdeki iconlari bilir bazi programlara ait olanlar mesela.
Iste bu Kod sayesinde bizde kendi programimizin iconunu oraya yerlestirebiliriz. Mesela Sag tusla bir Popup Menu acabiliriz. Üzerine gelindiginde yazan yaziyi belirleyebiliriz..

Option Explicit

Private Declare Function Shell_NotifyIcon Lib "shell32"Alias _
"Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As _
NOTIFYICONDATA) As Boolean

Const NIM_ADD = &H0
Const NIM_MODIFY = &H1
Const NIM_DELETE = &H2
Const NIF_MESSAGE = &H1
Const NIF_ICON = &H2
Const NIF_TIP = &H4

Const WM_MOUSEMOVE = &H200
Const WM_LBUTTONDOWN = &H201
Const WM_LBUTTONUP = &H202
Const WM_LBUTTONDBLCLK = &H203
Const WM_RBUTTONDOWN = &H204
Const WM_RBUTTONUP = &H205
Const WM_RBUTTONDBLCLK = &H206

Private Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uId As Long
uFlags As Long
ucallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type

Dim TIcon As NOTIFYICONDATA

Private Sub Form_Load()
Me.Hide
App.TaskVisible = False
mnBar.Visible = False

TIcon.cbSize = Len(TIcon)
TIcon.hWnd = Picture1.hWnd
TIcon.uId = 1&
TIcon.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
TIcon.ucallbackMessage = WM_MOUSEMOVE
TIcon.hIcon = Me.Icon
TIcon.szTip = "Ne söylemem lazim" & Chr$(0)

Shell_NotifyIcon NIM_ADD, TIcon
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Form1.Hide
If UnloadMode = vbAppWindows Or UnloadMode = vbFormCode Then
Shell_NotifyIcon NIM_DELETE, TIcon
Else
Cancel = 1
End If
End Sub

Private Sub mnBeep_Click()
Beep
End Sub

Private Sub mnExit_Click(Index As Integer)
Shell_NotifyIcon NIM_DELETE, TIcon
Unload Me
End Sub

Private Sub mnMsgShow_Click()
MsgBox ("Burdayim...")
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, _
x As Single, Y As Single)
Dim Msg&
Msg = x / Screen.TwipsPerPixelX

Select Case Msg
Case WM_MOUSEMOVE: Beep
Case WM_LBUTTONDBLCLK: Me.Show
Case WM_LBUTTONDOWN:
Case WM_LBUTTONUP:
Case WM_RBUTTONDBLCLK: Me.Show
Case WM_RBUTTONDOWN:
Case WM_RBUTTONUP: Me.PopupMenu mnBar
End Select
End Sub