Attribute VB_Name = "basAPI"
Option Explicit
' Derleyen Dozer
' General API functions.
Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
 
Private Const HWND_TOPMOST = -1
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOREPOSITION = &H200
Private Const SWP_NOSIZE = &H1
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
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, ByVal _
lpWindowName As String) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetParent Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" _
Alias "GetWindowTextLengthA" (ByVal hwnd 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 Declare Function GetUserNameA Lib "advapi32.dll" _
(ByVal lpBuffer As String, nSize As Long) As Long
Private TaskBarhWnd As Long
 
'Exit's windows with one of the following results.
' dwReserved = 0
Private Declare Function ExitWindowsEx Lib "user32" (ByVal _
uFlags As Long, ByVal dwReserved As Long) As Long
Public Const EXIT_LOGOFF = 0
Public Const EXIT_SHUTDOWN = 1
Public Const EXIT_REBOOT = 2
Private Declare Function GetComputerNameA Lib "kernel32" _
(ByVal lpBuffer As String, nSize As Long) As Long
' General API functions. (with no VBasic wrapper)
'Puts the app to sleep for the given number of milliseconds
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Type klavye
k As String * 1
End Type
Public kk As klavye
'----------------------------------------------------------------
'Buraya kadar tanımlar vardı Sub lar ve fonsiyonlar buradan sonra
'----------------------------------------------------------------
'Windowstan çıkış
Public Sub ExitWindows(ByVal uFlags As Long)
Call ExitWindowsEx(uFlags, 0)
End Sub
'Kullanıcının adın bulunması
Public Function GetUserName() As String
Dim UserName As String * 255
Call GetUserNameA(UserName, 255)
GetUserName = Left$(UserName, InStr(UserName, Chr$(0)) - 1)
End Function
'
' Bilgisayar adının bulunması
'
Public Function GetComputerName() As String
Dim UserName As String * 255
Call GetComputerNameA(UserName, 255)
GetComputerName = Left$(UserName, InStr(UserName, Chr$(0)) - 1)
End Function
'
' Active Pencerenin title(başlığının) bulunması.
' if GetParent = true then Aktif pencerenin altındaki pencereyi bulur
'
Public Function GetActiveWindowTitle(ByVal ReturnParent As Boolean) As String
Dim i As Long
Dim j As Long
i = GetForegroundWindow
 
If ReturnParent Then
Do While i <> 0
j = i
i = GetParent(i)
Loop
i = j
End If
GetActiveWindowTitle = GetWindowTitle(i)
End Function
' Başlat çubugunu gizlemek için
Public Sub HideTaskBar()
TaskBarhWnd = FindWindow("Shell_traywnd", "")
If TaskBarhWnd <> 0 Then
Call SetWindowPos(TaskBarhWnd, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
End If
End Sub
' Başlat çubugunu tekrar gösterir
Public Sub ShowTaskBar()
If TaskBarhWnd <> 0 Then
Call SetWindowPos(TaskBarhWnd, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
End If
End Sub
'
' Aktif pencerenin handle(işletim sistemince verilen numara).
'
Public Function GetActiveWindow(ByVal ReturnParent As Boolean) As Long
Dim i As Long
Dim j As Long
i = GetForegroundWindow
 
If ReturnParent Then
Do While i <> 0
j = i
i = GetParent(i)
Loop
i = j
End If
GetActiveWindow = i
End Function
' Hwnd (kısaca Pencereye windows tarafından verilen işlem numarası) bilinen pencerelerin başlığını bulmak.
' Öyle lazım oluyorki bazen
Public Function GetWindowTitle(ByVal hwnd As Long) As String
Dim l As Long
Dim s As String
l = GetWindowTextLength(hwnd)
s = Space(l + 1)
GetWindowText hwnd, s, l + 1
GetWindowTitle = Left$(s, l)
End Function
'
' Program içerisinde kullandıgınız formları en ustte tutmak için gereken alt program
' Burada ki boolean Ture ise pencere daima en ustte durur değilse normale doner
Public Sub TopMostForm(f As Form, Top As Boolean)
If Top Then
SetWindowPos f.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE
Else
SetWindowPos f.hwnd, 0, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE
End If
End Sub
'
' Programınız içinde duraklamalar yaratmak için gereken bir funksiyon.
' Örneğin bir formununuzun 5 saniye okunmasını zorunlu kılmak istiyorsunuz.
' Yukarıdaki programla en ustte tutun ne kadar durması gerektiğinide bu programla ayarlayın
' Timer yerien kullanabilrsiniz
'
Public Sub Pause(ByVal seconds As Single)
Call Sleep(Int(seconds * 1000#))
End Sub
'
' Hakkında kutusu yaratmak için
'
Public Sub AboutBox(frm As Form, Optional copyright As Variant)
If VarType(copyright) = vbString Then
Call ShellAbout(frm.hwnd, App.ProductName, copyright, frm.Icon)
Else
Call ShellAbout(frm.hwnd, App.ProductName, "", frm.Icon)
End If
End Sub