visual basic e book

Hata Mesajlarının Listesini Almak

2007-05-27T10:30:00.000+02:00

Private Sub Command1_Click()
List1.Clear
Dim ErCode As Long
Dim ErDesc As String
Dim FatalEr As String
FatalEr = Error(1)
For ErCode = 3 To 750
If Error(ErCode) <> FatalEr Then
ErDesc = Format$(ErCode) & " " & Error(ErCode)
List1.AddItem ErDesc
End If
Next ErCode
End Sub

Private Sub Form_Load()
Command1.Caption = "HATA" & vbCrLf & vbCrLf & "MESAJLARI"
End Sub

Hata Yönetimi

2007-05-27T10:28:00.002+02:00

Hata Çeşitleri

Yazılış hataları
İşleyiş hataları
Mantık hataları

On Error Resume Next : Hata oluşması durumunda işleme devam edilir
On Error Goto Etiket : Hata oluşması durumunda etiket ile belirtilen işlemler yapılır
On Error Goto 0 : Hata kontrolü iptal edilir
Err.Number : Oluşan hatanın tanımlama numarasını verir
CVErr : Hata numarasını Error tipinde Variant olarak döndürür
IsError : Değişkenin bir variant yada Error olup olmadığını denetler

Private Sub Form_Click()
On Error GoTo Hata_Var
....
Picture1.Picture = LoadPicture("olmayan.bmp")
....
Hata_Var:
MsgBox (Err.Number)
If Err.Number = 53 Then
MsgBox "Gerekli Dosya Bulunamadı."
End If
End Sub

Function Hesap()
On error goto hata:
...
hata:
If Err.Number <> 0 then
Hesap = CVErr() ‘ CVErr fonksiyonu
End If
End Function

Deger=Hesap()
If IsError(Deger) Then ‘ IsError fonksiyonu
....
End If

Sistemde Ses Kartı Olup Olmadığını Kontrol Etmek

2007-05-27T10:28:00.001+02:00

(Modul)(General)(Declaration)
Public Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long

Private Sub Command1_Click()
Dim i As Integer
i = waveOutGetNumDevs()
If i > 0 Then
MsgBox " Sistemde Ses Kartı Bulunmaktadır ", vbInformation
Else
MsgBox " Sistemde Ses Kartı Bulunmamaktadır ", vbInformation
End If
End Sub

Internet Bağlantısını Kontrol Etmek

2007-05-27T10:27:00.002+02:00

(Modul)(General)(Declaration)
Public Declare Function RasEnumConnections Lib "RasApi32.dll" Alias _
"RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, _
lpcConnections As Long) As Long
Public Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias _
"RasGetConnectStatusA" (ByVal hRasCon As Long, _
lpStatus As Any) As Long

Public Const RAS95_MaxEntryName = 256 ' Bağlantı Değişkenleri
Public Const RAS95_MaxDeviceType = 16
Public Const RAS95_MaxDeviceName = 32

Public Type RASCONN95 ' Bağlantı Bilgileri
dwSize As Long
hRasCon As Long
szEntryName(RAS95_MaxEntryName) As Byte
szDeviceType(RAS95_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type

Public Type RASCONNSTATUS95 ' Bağlantı Durumları
dwSize As Long
RasConnState As Long
dwError As Long
szDeviceType(RAS95_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type

Private Sub Timer1_Timer()
If InternetDurumu = False Then
' İnternete bağlı olmadığını gösteren resim
Image1.Visible = True
' İnternete bağlı olduğunu gösteren resim
Image2.Visible = False
End If
If InternetDurumu = True Then
' İnternete bağlı olmadığını gösteren resim
Image1.Visible = False
' İnternete bağlı olduğunu gösteren resim
Image2.Visible = True
End If
End Sub

İşlemci Bilgileri Öğrenmek

2007-05-27T10:27:00.001+02:00

(General)(Declaration)
Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Private Type SYSTEM_INFO
dwOemID As Long
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOrfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
dwReserved As Long
End Type

Private Sub Command1_Click()
Dim cpu As SYSTEM_INFO
GetSystemInfo cpu
Print "Cpu Tipi : " & cpu.dwProcessorType
Print "Cpu Sayısı : " & cpu.dwNumberOrfProcessors
End Sub

Bellek Bilgilerini Öğrenmek

2007-05-27T09:55:00.000+02:00

(General)(declaration)
Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)

Private Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type

Private Sub Command2_Click()
Dim bellek As MEMORYSTATUS
GlobalMemoryStatus bellek
Print "Toplam Bellek : " & bellek.dwTotalPhys / 1024 / 1024
Print "Kullanılabilir Bellek : " & bellek.dwAvailPhys
Print "Bellek Kullanımı : %" & bellek.dwMemoryLoad
Print "Toplam Virtual Memory : " & bellek.dwTotalVirtual
Print "Kullanılabilir Virtual Memory : " & bellek.dwAvailVirtual
End Sub

Sabit Disk Bilgileri

2007-05-27T09:53:00.000+02:00

1 - bir -I

(Modul)(General)(Declaration)
Option Explicit
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

Private Sub rgbGetVolumeInformationRDI(PathName$, DrvVolumeName$, DrvSerialNo$)
Dim r As Long
Dim pos As Integer
Dim HiWord As Long
Dim HiHexStr As String
Dim LoWord As Long
Dim LoHexStr As String
Dim VolumeSN As Long
Dim MaxFNLen As Long
Dim UnusedStr As String
Dim UnusedVal1 As Long
Dim UnusedVal2 As Long
DrvVolumeName$ = Space$(14)
UnusedStr$ = Space$(32)

r& = GetVolumeInformation(PathName$, DrvVolumeName$, Len(DrvVolumeName$), VolumeSN&, UnusedVal1&, UnusedVal2&, UnusedStr$, Len(UnusedStr$))

If r& = 0 Then Exit Sub
pos% = InStr(DrvVolumeName$, Chr$(0))
If pos% Then DrvVolumeName$ = Left$(DrvVolumeName$, pos% - 1)
If Len(Trim$(DrvVolumeName$)) = 0 Then DrvVolumeName$ = "(no label)"
HiWord& = GetHiWord(VolumeSN&) And &HFFFF&
LoWord& = GetLoWord(VolumeSN&) And &HFFFF&
HiHexStr$ = Format$(Hex(HiWord&), "0000")
LoHexStr$ = Format$(Hex(LoWord&), "0000")
DrvSerialNo$ = HiHexStr$ & "-" & LoHexStr$
End Sub

Function GetHiWord(dw As Long) As Integer
If dw& And &H80000000 Then
GetHiWord% = (dw& \ 65535) - 1
Else
GetHiWord% = dw& \ 65535
End If
End Function

Function GetLoWord(dw As Long) As Integer
If dw& And &H8000& Then
GetLoWord% = &H8000 Or (dw& And &H7FFF&)
Else
GetLoWord% = dw& And &HFFFF&
End If
End Function

Private Sub form_Click()
Dim r As Long
Dim PathName As String
Dim DrvVolumeName As String
Dim DrvSerialNo As String
PathName$ = " C:\"
rgbGetVolumeInformationRDI PathName$, DrvVolumeName$, DrvSerialNo$
Print: Print " Sürücü", , ": "; UCase$(PathName$)
Print: Print " Sürücü Etiketi", ": "; DrvVolumeName$
Print: Print " Seri Numarası", ": "; DrvSerialNo$
End Sub

2 - iki - II

(General)(Declaration)
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

Private Sub Form_click()
Dim x As Long
Dim sectorpercluster As Long
Dim bytepersector As Long
Dim freecluster As Long
Dim totalcluster As Long
x = GetDiskFreeSpace("c:\", sectorpercluster, bytepersector, _
freecluster, totalcluster)
Label1.Caption = sectorpercluster
Label2.Caption = bytepersector
Label3.Caption = freecluster
Label4.Caption = totalcluster
Label5.Caption = freecluster * sectorpercluster * bytepersector / 1024 / 1024 & "MB"
Label6.Caption = totalcluster * sectorpercluster * bytepersector / 1024 / 1024 & "MB"
End Sub

CD Sürücünün Kapağını Açıp Kapatmak

2007-05-27T09:52:00.003+02:00

(General)(Declaration)
Private 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

Private Sub Command1_Click() ‘ Açmak
retvalue = mciSendString("set CDAudio door open", returnstring, 127, 0)
End Sub

Private Sub Command2_Click() ‘ Kapatmak
retvalue = mciSendString("set CDAudio door closed", returnstring, 127, 0)
End Sub

Sürücü Tipini Bulmak

2007-05-27T09:52:00.001+02:00

(General)(Declaration)
Option Explicit
Private Declare Function GetDriveType Lib "kernel32" Alias _
"GetDriveTypeA" (ByVal nDrive As String) As Long
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6

Private Sub Form_Click()
Dim i, drv, d$
For i = 0 To 25
d$ = Chr$(i + 65) & ":"
drv = GetDriveType(d$)
Select Case drv
Case DRIVE_REMOVABLE
Print d$ & " Disket Sürücü"
Case DRIVE_FIXED
Print d$ & " Sabit Disk"
Case DRIVE_REMOTE
Print d$ & " Ağ Sürücüsü"
Case DRIVE_CDROM
Print d$ & " CD_ROM Sürücü"
Case DRIVE_RAMDISK
Print d$ & " Ram Disk"
End Select
Next i
End Sub

Ekran Çözünürlüğünü Bulmak

2007-05-27T09:50:00.004+02:00

1-bir-I

Private Sub Command1_Click()
En = Screen.Width \ Screen.TwipsPerPixelX
Boy = Screen.Height \ Screen.TwipsPerPixelY
Ekran_Coz = En & "x" & Boy
Print Ekran_Coz
End Sub

2-iki-II

(Modul)(General)(Declaration)

Option Explicit
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Const SPI_GETWORKAREA& = 48
Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long

Private Sub Command1_Click()
Dim rct As RECT
Dim z As Long
Dim msg As String
z = SystemParametersInfo(SPI_GETWORKAREA, 0&, rct, 0&)
msg = "Ekran Çözünürlüğü" & vbCrLf
msg = msg & "Genişlik - " & rct.Right & vbCrLf
msg = msg & "Yükseklik - " & rct.Bottom & vbCrLf & vbCrLf
MsgBox msg
End Sub

Sistemin Kaç Bit Renk Kullandığını Bulmak

2007-05-27T09:50:00.001+02:00

(General)(Declaration)
Option Explicit
Private Const BITSPIXEL = 12
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Private Sub Form_Load()
MsgBox "Format$(GetDeviceCaps(hdc, BITSPIXEL)) & "-bit renk kullanılıyor."
End Sub

Fare İmlecini Çalışma Anında Değiştirmek

2007-05-27T09:49:00.002+02:00

Text1.MousePointer = 99
Text1.MouseIcon = LoadPicture("c:\bjk.ico")

Fare İmlecini Saklamak / Göstermek

2007-05-27T09:49:00.001+02:00

(General)(Declaration)
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long

Private Sub Command1_Click()
FImlec = ShowCursor(False) ' Fare imlecini saklar
End Sub

Private Sub Command2_Click()
FImlec = ShowCursor(True) ' Fare imlecini gösterir
End Sub

Farenin Pozisyonunu Bulmak ve Değiştirmek

2007-05-27T09:48:00.002+02:00

(Modul)(General)(Declaration)

Type PointApi
X As Long
Y As Long
End Type

Global FareXY As PointApi

Declare Function GetCursorPos Lib "user32" (lpPoint As PointApi) As Long
Declare Function SetCursorPos Lib "user32" (ByVal x As Long, _
ByVal y As Long) As Long

Private Sub Form_Click() ‘ Farenin yeri
Z = GetCursorPos(PointApi)
MsgBox "Fare Pozisyonu : (" & FareXY.Y & "," & FareXY.Y & ") "
End Sub

Private Sub Command1_Click() ‘ Farenin yerini değiştirmek
X = Val(InputBox("X ?"))
Y = Val(InputBox("Y ?"))
Z = SetCursorPos(x, y)
MsgBox "Fare Pozisyonu: (" & X & "," & Y & ")"
End Sub

Çalışmakta Olan Programların Listesi

2007-05-27T09:48:00.001+02:00

(General)(Declaration)
Option Explicit
Private Const MAX_PATH = 260
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" _
(ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" _
(ByVal hSnapshot As Long, lppe As Any) As Long
Private Declare Function Process32Next Lib "kernel32" _
(ByVal hSnapshot As Long, lppe As Any) As Long
Private Const TH32CS_SNAPHEAPLIST = &H1
Private Const TH32CS_SNAPPROCESS = &H2
Private Const TH32CS_SNAPTHREAD = &H4
Private Const TH32CS_SNAPMODULE = &H8
Private Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST + _
TH32CS_SNAPPROCESS + TH32CS_SNAPTHREAD + _
TH32CS_SNAPMODULE)
Private Const TH32CS_INHERIT = &H80000000

Private Sub Form_Load() ' ListBox Kullanılıyor
Dim hSnapshot As Long, lRet As Long, P As PROCESSENTRY32
P.dwSize = Len(P)
hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, ByVal 0)
If hSnapshot Then
lRet = Process32First(hSnapshot, P)
Do While lRet
List1.AddItem Left$(P.szExeFile, InStr(P.szExeFile, Chr$(0)) - 1)
lRet = Process32Next(hSnapshot, P)
Loop
lRet = CloseHandle(hSnapshot)
End If
End Sub

Uygulamanın TaskManager’da Görülmesini Engellemek

2007-05-27T09:47:00.000+02:00

(General)(Declaration)

Const RSP_SIMPLE_SERVICE = 1
Const RSP_UNREGISTER_SERVICE = 0

Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long

Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long

Public Sub MakeMeService()
Dim pid As Long, reserv As Long
pid = GetCurrentProcessId()
regserv = RegisterServiceProcess(pid, RSP_SIMPLE_SERVICE)
End Sub

Public Sub UnMakeMeService()
Dim pid As Long, reserv As Long
pid = GetCurrentProcessId()
regserv = RegisterServiceProcess(pid, RSP_UNREGISTER_SERVICE)
End Sub

Private Sub Form_Load()
MakeMeService
End Sub

Private Sub Form_Unload(Cancel As Integer)
UnMakeMeService
End Sub

Bir Programı Form Sınırları İçerisinde Çalıştırmak

2007-05-27T09:45:00.000+02:00

(General)(Declaration)

Option Explicit

Private Const GW_HWNDNEXT = 2

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long

Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long

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 Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long

Private old_parent As Long

Private child_hwnd As Long

Private Function InstanceToWnd(ByVal target_pid As Long) As Long
Dim test_hwnd As Long
Dim test_pid As Long
Dim test_thread_id As Long
test_hwnd = FindWindow(ByVal 0&, ByVal 0&)
Do While test_hwnd <> 0
If GetParent(test_hwnd) = 0 Then
test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid)
If test_pid = target_pid Then
InstanceToWnd = test_hwnd
Exit Do
End If
End If
test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
Loop
End Function

Private Sub Form_Resize()
Dim hgt As Single
hgt = ScaleHeight - Picture1.Top
If hgt < 120 Then hgt = 120
Picture1.Move 0, Picture1.Top, ScaleWidth, hgt
End Sub

Private Sub Command2_Click() ' Program serbest bırakılır form dışına çıkar
SetParent child_hwnd, old_parent
Command1.Enabled = True
Command2.Enabled = False
End Sub

Private Sub Command1_Click() ' Program form içerisinde çalıştırır
Dim pid As Long
Dim buf As String
Dim buf_len As Long
pid = Shell("notepad.exe", vbNormalFocus) ‘ NotePad çalıştırılıyor
If pid = 0 Then
MsgBox "Hatalı İşlem"
Exit Sub
End If
child_hwnd = InstanceToWnd(pid)
old_parent = SetParent(child_hwnd, Picture1.hwnd)
Command1.Enabled = False
Command2.Enabled = True
End Sub

Shell - Uygulama İçerisinden Bir Başka Programı Çalıştırmak

2007-05-27T09:43:00.004+02:00

Private Sub Command1_Click()
i = Shell("NotePad.Exe", 3) ‘ Notepad tüm ekranı kaplayacak
End Sub ‘ şekilde çalıştırılır

Uygulamanın Çalışma Klasörünü Bulmak / Değiştirmek

2007-05-27T09:43:00.003+02:00

Private Declare Function GetCurrentDirectory Lib "kernel32" Alias _
"GetCurrentDirectoryA" (ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function SetCurrentDirectory Lib "kernel32" Alias _
"SetCurrentDirectoryA" (ByVal lpPathName As String) As Long

Private Sub Form_Paint()
Dim Klasor As String
Klasor = String(255, 0)
GetCurrentDirectory 255, Klasor ‘ Klasörü bulur
MsgBox Klasor
‘ SetCurrentDirectory App.Path ‘ Klasörü değiştirir
End Sub

TaskBar’ı Saklamak / Göstermek

2007-05-27T09:43:00.001+02:00

(General)(Declaration)
Dim hWnd1 As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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_HIDEWINDOW = &H80
Const SWP_SHOWWINDOW = &H40

Private Sub Command1_Click()
hWnd1 = FindWindow("Shell_traywnd", "")
Call SetWindowPos(hWnd1, 0, 0, 0, 0, 0, SWP_HIDEWINDOW) ' Saklar
End Sub

Private Sub Command2_Click()
Call SetWindowPos(hWnd1, 0, 0, 0, 0, 0, SWP_SHOWWINDOW) ' Gösterir
End Sub

Komut Satırı Parametresi Kullanmak

2007-05-27T09:42:00.002+02:00

Private Sub Form_Load()
If Command = "" Then ‘ Komut satırı parametresi kontrol ediliyor
MsgBox " Komut satırı parametresi yok"
Else
MsgBox "Komut satırı parametresi:" & Command
End If
End Sub

Sistem Klasörleri

2007-05-27T09:42:00.001+02:00

(General)(Declaration)
Option Explicit
Private Type SHITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hWndOwner As Long, ByVal nFolder As Long, pidl As Any) As Long
Const MAX_PATH = 260

Private Sub Form_Load()
List1.AddItem "CSIDL_DESKTOP": List1.ItemData(List1.NewIndex) = &H0
List1.AddItem "CSIDL_INTERNET": List1.ItemData(List1.NewIndex) = &H1
List1.AddItem "CSIDL_PROGRAMS": List1.ItemData(List1.NewIndex) = &H2
List1.AddItem "CSIDL_CONTROLS": List1.ItemData(List1.NewIndex) = &H3
List1.AddItem "CSIDL_PRINTERS": List1.ItemData(List1.NewIndex) = &H4
List1.AddItem "CSIDL_PERSONAL": List1.ItemData(List1.NewIndex) = &H5
List1.AddItem "CSIDL_FAVORITES": List1.ItemData(List1.NewIndex) = &H6
List1.AddItem "CSIDL_STARTUP": List1.ItemData(List1.NewIndex) = &H7
List1.AddItem "CSIDL_RECENT": List1.ItemData(List1.NewIndex) = &H8
List1.AddItem "CSIDL_SENDTO": List1.ItemData(List1.NewIndex) = &H9
List1.AddItem "CSIDL_BITBUCKET": List1.ItemData(List1.NewIndex) = &HA
List1.AddItem "CSIDL_STARTMENU": List1.ItemData(List1.NewIndex) = &HB
List1.AddItem "CSIDL_DESKTOPDIRECTORY"
List1.ItemData(List1.NewIndex) = &H10
List1.AddItem "CSIDL_DRIVES": List1.ItemData(List1.NewIndex) = &H11
List1.AddItem "CSIDL_NETWORK": List1.ItemData(List1.NewIndex) = &H12
List1.AddItem "CSIDL_NETHOOD": List1.ItemData(List1.NewIndex) = &H13
List1.AddItem "CSIDL_FONTS": List1.ItemData(List1.NewIndex) = &H14
List1.AddItem "CSIDL_TEMPLATES": List1.ItemData(List1.NewIndex) = &H15
List1.AddItem "CSIDL_COMMON_STARTMENU"
List1.ItemData(List1.NewIndex) = &H16
List1.AddItem "CSIDL_COMMON_PROGRAMS"
List1.ItemData(List1.NewIndex) = &H17
List1.AddItem "CSIDL_COMMON_STARTUP"
List1.ItemData(List1.NewIndex) = &H18
List1.AddItem "CSIDL_COMMON_DESKTOPDIRECTORY"
List1.ItemData(List1.NewIndex) = &H19
List1.AddItem "CSIDL_APPDATA": List1.ItemData(List1.NewIndex) = &H1A

List1.AddItem "CSIDL_PRINTHOOD": List1.ItemData(List1.NewIndex) = &H1B
List1.AddItem "CSIDL_LOCAL_APPDATA"
List1.ItemData(List1.NewIndex) = &H1C
List1.AddItem "CSIDL_ALTSTARTUP": List1.ItemData(List1.NewIndex) = &H1D
List1.AddItem "CSIDL_COMMON_ALTSTARTUP"
List1.ItemData(List1.NewIndex) = &H1E
List1.AddItem "CSIDL_COMMON_FAVORITES"
List1.ItemData(List1.NewIndex) = &H1F
List1.AddItem "CSIDL_INTERNET_CACHE"
List1.ItemData(List1.NewIndex) = &H20
List1.AddItem "CSIDL_COOKIES": List1.ItemData(List1.NewIndex) = &H21
List1.AddItem "CSIDL_HISTORY": List1.ItemData(List1.NewIndex) = &H22
List1.AddItem "CSIDL_COMMON_APPDATA"
List1.ItemData(List1.NewIndex) = &H23
List1.AddItem "CSIDL_WINDOWS": List1.ItemData(List1.NewIndex) = &H24
List1.AddItem "CSIDL_SYSTEM": List1.ItemData(List1.NewIndex) = &H25
List1.AddItem "CSIDL_PROGRAM_FILES"
List1.ItemData(List1.NewIndex) = &H26
List1.AddItem "CSIDL_MYPICTURES": List1.ItemData(List1.NewIndex) = &H27
List1.AddItem "CSIDL_PROFILE": List1.ItemData(List1.NewIndex) = &H28
List1.AddItem "CSIDL_SYSTEMX86": List1.ItemData(List1.NewIndex) = &H29
List1.AddItem "CSIDL_PROGRAM_FILESX86"
List1.ItemData(List1.NewIndex) = &H2A
List1.AddItem "CSIDL_PROGRAM_FILES_COMMON"
List1.ItemData(List1.NewIndex) = &H2B
List1.AddItem "CSIDL_PROGRAM_FILES_COMMONX86"
List1.ItemData(List1.NewIndex) = &H2C
List1.AddItem "CSIDL_COMMON_TEMPLATES"
List1.ItemData(List1.NewIndex) = &H2D
List1.AddItem "CSIDL_COMMON_DOCUMENTS"
List1.ItemData(List1.NewIndex) = &H2E
List1.AddItem "CSIDL_COMMON_ADMINTOOLS"
List1.ItemData(List1.NewIndex) = &H2F
List1.AddItem "CSIDL_ADMINTOOLS": List1.ItemData(List1.NewIndex) = &H30
List1.AddItem "CSIDL_CONNECTIONS": List1.ItemData(List1.NewIndex) = &H31
List1.ListIndex = 0
End Sub

Private Sub list1_Click()
Dim idl As Long, aPath As String
aPath = Space$(MAX_PATH)
Label1.Caption = " * Yok *"
If SHGetSpecialFolderLocation(hwnd, List1.ItemData(List1.ListIndex), idl) = 0 Then
If SHGetPathFromIDList(idl, aPath) Then
Label1.Caption = Left$(aPath, InStr(aPath, Chr$(0)) - 1)
End If
LocalFree idl
End If
End Sub

Program İkonunu Görev Çubuğuna Yerleştirmek

2007-05-27T09:41:00.002+02:00

(General)(Declaration)
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
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const WM_MOUSEMOVE = &H200
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" _
(ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Dim tk As NOTIFYICONDATA

Public Sub trayicon(kontrol As Boolean)
tk.cbSize = Len(tk)
tk.hwnd = Form1.Picture1.hwnd
tk.uId = 1&
tk.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
tk.ucallbackMessage = WM_MOUSEMOVE
tk.hIcon = Form1.Picture1.Picture ‘ İkon resmi
tk.szTip = " Sarkıntı " & Chr$(0)
If kontrol = False Then Shell_NotifyIcon NIM_DELETE, tk
If kontrol = True Then Shell_NotifyIcon NIM_ADD, tk
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Hex(x) = "1E3C" Then
Me.PopupMenu MnPr ‘ İkon PopUp mönüsü
End If
End Sub

Private Sub Form_Load()
trayicon True ' SysTray’e ikon eklenir
End Sub
Private Sub Form_Unload(Cancel As Integer)
trayicon False ' SysTray’den ikon silinir
End Sub

Program Sürüm Numarası

2007-05-27T09:41:00.001+02:00

Private Sub Command1_Click()
Me.Caption = App.Title & " Version " & App.Major & "." & App.Minor & "." & App.Revision
End Sub

Programın Akışını Bir Süre Durdurmak

2007-05-27T09:40:00.002+02:00

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Command1_Click()
Sleep (1800)
MsgBox "Program 1800 mili saniye durdu"
End Sub

Uygulamanın Aynı Anda Birden Fazla Çalışmasını Engellemek

2007-05-27T09:40:00.001+02:00

Private Sub Form_Load()
If App.PrevInstace Then
Msgbox "Pogram Çalışıyor"
End
End If
End Sub

Application – Uygulama

2007-05-27T09:39:00.002+02:00

App.ExeName : Çalışan exe dosyasının ismi
App.Title : Task Manager’da gösterilen isim
App.Path : Çalışma anında geçerli olan yol
App.PrevInstace : Program çalışıp çalışmadığı

With App
.CompanyName = "ProgKENT Yazılım"
.EXEName = "Not Defteri.exe"
.FileDescription = "Visual Basic Programlama Kodları"
.LegalCopyright = "Ustaglu"
.LegalTrademarks = "ProgKENT"
.Major = 6 ‘ Versiyon
.Minor = 0
.Revision = 1
.Title = "ProgKENT Programcının Not Defteri"
End With

OCX - Event - Olay Eklemek

2007-05-27T09:39:00.001+02:00

(General)(Declaration)

Event dblclick()

Private Sub StatusBar1_DblClick()
RaiseEvent dblclick ‘ StatusBar çift tıklanınca kontrolün
End Sub ‘ çift tıklama olayı oluşacak

OCX - Property Pages – Özellikler Sayfası Eklemek

2007-05-27T09:37:00.001+02:00

Project > Add Propety Page > Name : Metin

Private Sub txtMetin_Change()
Changed = True
End Sub

Private Sub PropertyPage_ApplyChanges()
SelectedControls(0).Metin = txtMetin.Text
End Sub

Private Sub PropertyPage_SelectionChanged()
txtMetin.Text = SelectedControls(0).Metin
End Sub

OCX - Programcının Özelliklerde Yaptığı Değişiklikleri Saklamak

2007-05-27T09:36:00.002+02:00

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Metin = PropBag.ReadProperty("metin")
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
PropBag.WriteProperty "metin", Metin
End Sub

OCX - Özellik Eklemek

2007-05-27T09:36:00.001+02:00

Public Property Get Metin() As String
Metin = RichTextBox1.Text
End Property

Public Property Let Metin(ByVal vNewValue As String)
RichTextBox1.Text = vNewValue
End Property

ActiveX Kontrol ( OCX ) - Uygulama

2007-05-27T09:32:00.002+02:00

File > New Project > ActiveX Control

Project > Project1 Proterties > General>
Project > Type : ActiveX Control
Project > Name : RTF Metin
Project > Description : RTF Metin Editörü

Make>Application > Title : RTFmetin

ToolBox –RichTextBox – ImageList – StatusBar – CommonDialog - Image

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
Case 1 ' Yeni
RichTextBox1.Text = ""
Case 2 ' Aç
CommonDialog1.DialogTitle = "RTF Dosya Aç"
CommonDialog1.Filter = "Rich Text Format*.RTF"
CommonDialog1.FileName = ""
CommonDialog1.ShowOpen
RichTextBox1.LoadFile CommonDialog1.FileName
StatusBar1.Panels(1).Text = CommonDialog1.FileName
Case 3 ' Kaydet
CommonDialog1.DialogTitle = "Kaydet"
CommonDialog1.Filter = "Rich Text Format*.RTF"
CommonDialog1.FileName = "adsız"
CommonDialog1.ShowSave
RichTextBox1.SaveFile CommonDialog1.FileName

Case 5 ' Font özellikleri
CommonDialog1.Flags = cdlCFScreenFonts
CommonDialog1.DialogTitle = "Karakter Özellikleri"
CommonDialog1.FontName = RichTextBox1.SelFontName
CommonDialog1.FontBold = RichTextBox1.SelBold
CommonDialog1.FontItalic = RichTextBox1.SelItalic
CommonDialog1.FontSize = RichTextBox1.SelFontSize
CommonDialog1.FontUnderline = RichTextBox1.SelUnderline
CommonDialog1.FontStrikethru = RichTextBox1.SelStrikeThru
CommonDialog1.ShowFont
RichTextBox1.SelFontName = CommonDialog1.FontName
RichTextBox1.SelBold = CommonDialog1.FontBold
RichTextBox1.SelFontSize = CommonDialog1.FontSize
RichTextBox1.SelItalic = CommonDialog1.FontItalic
RichTextBox1.SelStrikeThru = CommonDialog1.FontStrikethru
RichTextBox1.SelUnderline = CommonDialog1.FontUnderline
Case 6 ' Font Rengi
CommonDialog1.Flags = cdlCCRGBInit
CommonDialog1.Color = RichTextBox1.SelColor
CommonDialog1.ShowColor
RichTextBox1.SelColor = CommonDialog1.Color
Case 8 ' Resim Ekle
CommonDialog1.DialogTitle = "Resim Ekle"
CommonDialog1.Filter = "BitMap Picture*.BMP"
CommonDialog1.FileName = ""
CommonDialog1.ShowOpen
Image1.Picture = LoadPicture(CommonDialog1.FileName)
Clipboard.Clear
Clipboard.SetData Image1.Picture
RichTextBox1.SetFocus
SendKeys "+{Insert}"

Case 10 ' Yazdır
CommonDialog1.DialogTitle = "Yazdır"
CommonDialog1.Flags = cdlPDReturnDC + cdlPDNoPageNums
If RichTextBox1.SelLength = 0 Then
CommonDialog1.Flags = CommonDialog1.Flags + cdlPDAllPages
Else
CommonDialog1.Flags = CommonDialog1.Flags + cdlPDSelection
End If
CommonDialog1.Copies = 1
CommonDialog1.ShowPrinter
RichTextBox1.SelPrint CommonDialog1.hDC
End Select
End Sub

ActiveX Kontrol ( OCX ) Oluşturmak

2007-05-27T09:32:00.001+02:00

AccessKeys : Kısayol tuşu
Alignable : True - Align özelliği var
Ambient : Kontrolun bulunacağı yerin özellikleri
CanGetFocus : True – Tab tuşu ile kontrole erişilebilir
ControlContainer : True – İçerisine başka kontroller yerleştirilebilir
DefaultCancel : Defaul ve Cancel özelliği
EditAtDesignTime : True - Kontrolu tasarım zamanında çalıştırılabilme
InvisibleAtRunTime : Kontrolün çalışma zamanında görünmesi
PropertyPages : Özellikler penceresi
Public : True - kontrol diğer uygulamalarda kullanabilir
ToolBoxBitmap : Kontrolun ToolBox’a eklendiğinde görülecek olan resim

Initialize : Yeni bir kontrol üretilmesi
InitProperties : Initialize olayı sonrası ilk değerlerin oluşumu
Terminate : Kontrolün hafızadan silinmesi
AccesKeyPress : AccessKeys ile belirlenen tuşa basılması
Hide : Kontrolün gizlenmesi
Show : Kontrolün gösterilmesi
AmbientChanged : Ambient özelliklerinden birinin değişmesi
EnterFocus : GotFocus
ExitFocus : LostFocus
ReadProperties : Propertiese aktarılan değerin okunması
WriteProperties : Değerin properties’e aktarılması
ReSize : Kontrolün boyutunun değişmesi
Paint : Kontrol nesnesinin formda gözükmesi

DDE ile Excel Bağlantısı

2007-05-27T09:30:00.000+02:00

Private Sub Command1_Click()
Dim KolonSatir As String
Text1.LinkMode = 0
Text1.LinkTopic = "ExcelKitap1"
Text1.LinkItem = "R1C1" ' Başlangıç Hücresi
Text1.LinkMode = 1
On Error Resume Next
For Satir = 1 To 5 ' Satır ve sütünlar sıra ile
For Kolon = 1 To 5 ' okunup gride alınıyor.
KolonSatir = "R" & Satir & "C" & Kolon
Grid1.Row = Satir
Grid1.Col = Kolon
Text1.LinkItem = KolonSatir
Grid1.Text = Text1.Text
Next Kolon
Next Satir
End Sub

DDE - Hedef - Kaynak

2007-05-27T09:29:00.001+02:00

Kaynak

Kaynak.Exe ‘ Exe ismi
Application.Title = “Kaynak” ‘ Program başlığı
KaynakForm ‘ Formun ismi
KaynakForm.LinkMode = 1 ‘ Form sunucu özelliği alıyor
KaynakForm.LinkTopik = “KaynakForm” ‘ Sunucu formun tanımı

Private Sub Text1_LinkOpen(Cancel As Integer) ‘ İstemci bağlanıyor
Text1.LinkMode = 1 ‘ Bağlantı automatik oluyor
End Sub

Hedef

Private Sub baglan_Click() ‘ Bağlantı
If Command1.Caption = "&Bağlan" Then
Text1.LinkMode = 0 ‘ Açık bağlantıları kapat
Text1.LinkTopic = "KaynakKaynakForm" ‘ Sunucu tanımlaması
Text1.LinkItem = "Text1" ‘ Bilginin alınacağı yer
Text1.LinkMode = 1 ‘ Automatik bağlantı
Command1.Caption = "&Bağlantıyı Kes"
Else
Text1.LinkMode = 0 ‘ Bağlantıyı kes
Command1.Caption = "&Bağlan"
End If
End Sub

DDE – Dinamik Veri Erişimi

2007-05-27T09:28:00.002+02:00

İki windows uygulaması arasında istemci(client) – sunucu(server) bağlantısı ile veri alışverişine olanak sağlar. Visual Basic’de formlar sunucu olabilirler; metin kutuları , etiketler ve resim kutuları istemcidir.

LinkTopik : Sunucu tanımlaması
Text1.LinkTopic = “Excel C:\Gelir.Xls”
LinkItem : Sunucudan bilginin alınacağı yer
Text1.LinkItem = "R1C1" ‘ A2 hücresi
LinkMode : Bağlantı şekli
1 – Automatic : Değişiklik anında bildirilir
2 – Manual : Değişiklikler istemci tarafından istenir
3 – Notify : Sunucu istemciye değişiklik olduğunu bildirir
(LinkRequest ile oluşur)
LinkTimeOut : Sunucu - istemci arasındaki bağlantı süresi ( 10 – 1 sn )
LinkOpen : DDE bağlantısının sağlanması
LinkClose : DDE bağlantısının sona ermesi
LinkExecute : İstemci sunucudan bir şey talep edince oluşur
LinkError : DDE haberleşmesinde hata oluşması
LinkPoke : İstemcinin, sunucuya veri göndermesi
İstemci_Kontrol.LinkPoke
LinkRequest : Sunucunun, istemciye bilgi göndermesi (LinkMOde = 2)
İstemci_Kontrol.LinkRequest
LinkSend : Sunucunun bir resim kutusunun içeriğini istemciye göndermesi
Resim_Kutusu.LinkSend

Sunucu program oluşturulurken exe oluşturma sırasında istemcide LinkTopik tanımlaması için kullanılacak isim Visual Basic mönüsünde File > Make Exe > Options > Application > Title kısmında girilmelidir.

Resource - Resource

2007-05-27T09:28:00.001+02:00

Private Sub Form_Load()
Dim Dsy As String
Dsy = StrConv(LoadResData(101, "Custom"), vbUnicode) ‘ Dosya alınıyor
Open "C:\Aktarma.Doc" For Binary As #1
Put #1, , Dsy
Close #1
End Sub
Private Sub Command1_Click() ' Dosya içerisindeki resmi al
Image1.Picture = LoadResPicture(101, 0)
End Sub

Private Sub Command4_Click() ' Dosya İçerisinde ki ikonu al
Image1.Picture = LoadResPicture(101, 1)
End Sub

Private Sub Command3_Click() ' Dosya içerisindeki kursörü al
Image1.Picture = LoadResPicture(101, 2)
End Sub

Resource – Kaynak Dosyası

2007-05-27T09:26:00.004+02:00

Birden fazla dosyayı tek bir dosya halinde birleştirek gerektiğinde gerekli dosyayı ayırma işlemidir. Dosyalar bir resource dosyası içerisinde projeye dahil edilir. Proje derlendiği zaman dosyalar artık .exe uzantılı programın içinde gömülü durmaktadır.

Add-Ins > Add-In Manager ile Resource Editor çalıştırılarak resource dosyası oluşturulabilir. Bu dosyaya resim, ikon, text, exe vb. eklenebilir.

Project > Add File ile Resource dosyasını (.RES) projeye Related Document İçerisine eklenir.

Registry ile Demo Program Hazırlamak

2007-05-27T09:26:00.003+02:00

‘ Yüklendiği tarih registry’e kaydedilir
Savesetting "Demo_Prog","Kontrol”,"Yükleme_Tarihi", Now
‘ Yüklendiği tarih ile çalıştırıldığı tarih arasındaki fark kontrol edilir
Tarih = Getsetting ("Demo_Prog","Kontrol","Yükleme_Tarihi")

‘ Kullanım sayısına göre
Kullanım_Sayısı = GetSetting("Demo_Prog”, "Kontrol”, "Çalıştırılma_Sayısı")
If (Kullanım_Sayısı) = 30 Then
Unload Me
Else
Kullanım_Sayısı = Val(Kullanım_Sayısı) + 1
SaveSetting "Demo_Prog”, "Kontrol”, "Çalıştırılma_Sayısı" , Kullanım_Sayısı
End If

‘ Registry “kontrol” kaydını silmek
Deletesetting "Demo_Prog”,"Kontrol"

Registry – Sistem Kaydı

2007-05-27T09:26:00.001+02:00

Komut "Program Adı", "Anahtar", "Özellik", "Değer”
SaveSetting : Registrye değer yazar
GetSetting : Registryden değer okur
DeleteSetting : registryden değer siler
Private Sub RegKaydı_Click()
‘ Registry’e form genişiliği kaydediliyor
SaveSetting "Test Programı", "Ölçekler", "Genişlik", Form1.Width
End Sub

Private Sub RegOku_Click()
‘ Registry’den form genişiliği alınıyor
Genislik = GetSetting("Test Programı", "Ölçekler", "Genişlik")
Form1.Width =Genislik
End Sub

Private Sub RegSil_Click()
‘ Registry’den Test programı ölçekler kaydı siliniyor
DeleteSetting "Test Programı", "Ölçekler"
End Sub

Form ve Ekran Görüntüsünü Yazıcıdan Almak

2007-05-27T09:25:00.004+02:00

(General)(Declaration)

Option Explicit

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const VK_MENU As Byte = &H12
Const VK_SNAPSHOT As Byte = &H2C
Const KEYEVENTF_KEYUP = &H2

Private Sub FormYaz_Click()
Dim lWidth As Long, lHeight As Long
Clipboard.Clear
Call keybd_event(VK_MENU, 0, 0, 0)
Call keybd_event(VK_SNAPSHOT, 0, 0, 0)
DoEvents
Call keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0)
Call keybd_event(VK_MENU, 0, KEYEVENTF_KEYUP, 0)
Printer.Print
If Width > Printer.ScaleWidth Then
lWidth = Printer.ScaleWidth
lHeight = (Printer.ScaleWidth / Width) * Height
Else
lWidth = Width
lHeight = Height
End If
Printer.PaintPicture Clipboard.GetData, 0, 0, lWidth, lHeight
Printer.EndDoc
SavePicture Clipboard.GetData, Me.Name & ".BMP"
End Sub

Private Sub Command2_Click()
Dim lHeight As Long
Clipboard.Clear
Call keybd_event(VK_SNAPSHOT, 1, 0, 0)
DoEvents
Call keybd_event(VK_SNAPSHOT, 1, KEYEVENTF_KEYUP, 0)
Printer.Print
lHeight = (Printer.ScaleWidth / Screen.Width) * Screen.Height
Printer.PaintPicture Clipboard.GetData, 0, 0, Printer.ScaleWidth, lHeight
Printer.EndDoc
SavePicture Clipboard.GetData, Me.Name & ".BMP"
End Sub

Sistemde Kurulu Yazıcı Olup Olmadığını Kontrol Etmek

2007-05-27T09:25:00.003+02:00

Private Sub Yazıcı_Click()
Dim msg$
msg = YaziciAdi
If Bak = "" Then
MsgBox ("Yazıcı kurulmamış")
Else
MsgBox ("Sistemde Kurulu Olan Yazıcı :" + msg)
End If

End Sub
Function Yazici() As String
On Local Error Resume Next
Yazici = Printer.DeviceName
End Function

Resmin Boyutunu Değiştirerek Yazıcıdan Çıkarmak

2007-05-27T09:25:00.001+02:00

Dim X1, X2, Y1, Y2
X2 = Picture1.Width
Y2 = Picture1.Height
X1 = X2 * 1.5 ‘ 1.5 Oranında Büyütme

Y1 = Y2 * 1.5
Printer.PaintPicture Picture1.Image, 0, 0, X1, Y1, 0, 0, X2, Y2

Resmi Yazıcıdan Çıkarmak

2007-05-27T09:24:00.002+02:00

Printer.PaintPicture Picture1.Picture
Printer.EndDoc

Yeni Sayfa Yazdırmak

2007-05-27T09:24:00.001+02:00

Printer.Print "Page 1"
Printer.Newpage
Printer.Print "Page 2"

Format – Print – Printer

2007-05-27T09:23:00.000+02:00

Print Format(Sayı,Format)
Print Format(32465,6429,"###,###,##") 'Çıktı : 324,465,64
Print Format(32465,6029,"###,###,##") ' Çıktı : 324,465,6
Print Format(32465,602,"000,000,000") ' Çıktı : 324,465,602
Print Format(3.2465,"###,##%") ' Çıktı : 324,46%
Print Format(sayı, "General Number")
Print Format(sayı, "Currency")
Print Format(sayı, "Fixed")
Print Format(sayı "Standard")
Print Format(sayı, "Percent")
Print Format(sayı, "Scientific")
Print Format(sayı, "Yes/No") ‘ Sayı 0 ise NO
Print Format(sayı, "True/False") ‘ Sayı 0 ise FALSE
Print Format(sayı, "On/Off") ‘ Sayı 0 ise OFF
Print Format(sayi, "General Date")
Print Format(sayi, "Long Date")
Print Format(sayi, "Medium Date")
Print Format(sayi, "Short Date")
Print Format(sayi, "Long Time")
Print Format(sayi, "Medium Time")
Print Format(sayi, "Short Time")

FontSize : Karakter büyüklüğü
FontName : Kayakter tipi
Copies : Kopya sayısı
CurrentX : Çıktının sol kenardan uzaklığı
CurrentY : Çıktının yukarıdan uzaklığı
FontSize : Yazı karakteri boyu
FontName : Yazı tipi
Height : Kullanılan sayfa boyutuna bağlı olarak yazım alanı yüksekliği
NewPage : Yeni bir sayfaya yazılmaya başlanağını bildirir
EndDoc : Yazdırılacak dökümanın bittiğini bildirir
Page : Aktarılan sayfa sayısı ( EndDoc ile sayma tamalanır )
ColorMode : vbPRCMMonochrome (1- siyah-beyaz), vbPRMMColor (2-renkli)
PrintQuality : VbPRPQDraft (-1, Düşük çözünürlük), VbPRQLow (-2, Düşük çz.),
VbPRQMedium (-3, Orta çözünürlük), VbPRQHight (-4, Yüksek çz.)
Orientation : Çıktı yönü ( Dikey / Yatay )
PaperSize : Çıktısı alınacak kağıdın boyutu
Width : Yazım alanı genişliği
( ; ) Noktalı Virgül : Arada boşluk bırakmaz
( , ) Virgül : Arada bir tab boşluk bırakır
( & ) : Arada boşluk bırakmaz
Tab : Yazılmaya başlanacak sütunu gösterir
( ) Boşluk : Arada boşluk bırakmaz

ClipBoard İçeriği

2007-05-27T09:21:00.002+02:00

If Clipboard.GetFormat(vbCFText) Then
Text1.Text = Clipboard.GetText()
Else
MsgBox ("Clipboard metin içermemektedir.")
End If

ClipBoard – Pano

2007-05-27T09:21:00.001+02:00

Clipboard.Clear ' Clipboard temizlenir
Clipboard.SetText MetinKutu.SelText ' Seçili texti clipboarda kopyalar
Clipboard.SetData Picture1.Picture ' Resmi clipboarda kopyalar
TextBox1.SelText = Clipboard.GetText() ' Seçili alanı clipboardaki text ile değiştirir
TextBox1.Text = Clipboard.GetText() ' Tüm texti clipboardaki text ile değiştirir
Picture1.Picture = Clipboard.GetData() ' Clipboard içeriğini PictureBox’a yapıştırır

SelStart : Seçilen bölgenin başlangıcı
SelLenght : Seçilen bölgenin karakter sayısı olarak uzunluğu
SelText : Klavye ya da mouse yardımı ile seçilen metin içeriği

Kopyala ClipBoard.SetText Screen.ActiveControl.SelText

Kes ClipBoard.SetText Screen.ActiveControl.SelText
Screen.ActiveControl.SelText = ""

Yapıştır Screen.ActiveControl.SelText = ClipBoard.GetText()

Tüm metni seç text1.SelStart = 0
text1.SelLength = Len(text1.Text)

Bul Değiştir

Bul = InStr(text1.Text, aranantext)
If Bul Then
text1.SelStart = Bul – 1 ‘ Başlangıç ve bitiş aralığı
text1.SelLength = Len(aranantext)
Screen.ActiveControl.SelText = "" ‘ Sil
Screen.ActiveControl.SelText = ClipBoard.GetText() ‘ Yapıştır
End If

Pop-Up Mönü

2007-05-27T09:19:00.000+02:00

Mönü editörle visible özelliği iptal edilmiş bir ana mönü ve alt mönüleri oluşturulur. Mönü oluşturulduktan sonra bu mönünün çıkması istenne fare olayı içerisinde popupmenu olarak tanımlanır.

Private Sub MDIForm_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then ‘ Farenin sağ tuşuna basıldığında
PopupMenu dsy ‘ dsy; visible özelliği false olan
End If ‘ mönü adı
End Sub

Programlara Mönü Eklemek

2007-05-27T09:16:00.000+02:00

Hazırlamakta olduğumuz programa mönü eklemek için form tasarım penceresi aktifken Visual Basic mönüsünden Tools > Menu Editor ( Ctrl + E ) ‘ü seçeriz.

Caption Mönüde görülecek olan başlık
Name Mönü ismi , kodlama isim_click yordamında yapılır
Index Aynı isimde olan mönülere index numarası verilir
Enabled Mönünün erişilebilir olmasını sağlar
Shortcut Mönüye klavye ile erişebilmek için kısayol tanımlar
Checked Mönü önüne onay işareti koyar
WindowList Bir MDIform için açık olan Child formların listesini mönüye ekler

Caption’da “&” kendisinde sonra gelen harf için alt kısayolu oluşturur. ( alt-a vb.)

Caption’da “-” mönüler arasında bölmeler oluşturur.

Alt mönüler ana mönü editörde ana mönülerin altında sekme işaretleri ile (....) oluşturulur.

Agent - Uygulama

2007-05-27T09:14:00.000+02:00

Dim Wizard As IagentCtlCharacterEx ‘ Bir agent karakteri olduğu bildiriliyor

Agent1.Characters.Load "wizard", "wizard.acs" ‘ Karakter çağrılıyor
Set Wizard = Agent1.Characters("wizard")
Wizard.Show ‘ Karakter gösteriliyor
Wizard.Play "Greet" ‘ “Greet” animasyonu oynatılıyor
Wizard.Speak "Merhaba Ben Geldim!" ‘ Animasyonla birlikte konuşuyor

Wizard.MoveTo 300, 400 ‘ 300, 400 pozisyonuna gönderiliyor
Wizard.Play "DoMagic1" ‘ Sihir animasyonu
Wizard.Play "DoMagic2"
Wizard.Speak "Basit bir numara"
Wizard.Hide ‘ Saklanıyor

Agent - Karakter Animasyonları

2007-05-27T09:13:00.000+02:00

Agent - Yöntemler

2007-05-27T09:12:00.000+02:00

Agent - Olaylar

2007-05-27T09:11:00.000+02:00

Agent - Özellikler

2007-05-27T09:10:00.002+02:00

Agent – Animasyon Karakter

2007-05-27T09:10:00.001+02:00

Karakterler “c:\windows\msagent\char” klasörü içerisinde bulunabilir. Her karakter her animasyonu desteklemez.

WebBrowser - Uygulama

2007-05-25T21:39:00.000+02:00

Private Sub Form_Load()
WebBrowser1.Navigate "http://www.kentmerkezi.8m.com"
Combo1.AddItem “http://www.kentmerkezi.8m.com/”
End Sub

Private Sub Geri_Click() ‘ Bir önceki sayfaya gider
On Error Resume Next
WebBrowser1.GoBack
End Sub

Private Sub ileri_Click() ‘ Geri gidilmiş ise bir sonraki sayfaya
On Error Resume Next
WebBrowser1.GoForward
End Sub

Private Sub Ana_Sayfa_Click() ‘ İlk gidilen adrese gider
On Error Resume Next
WebBrowser1.GoHome
End Sub

Private Sub Yenile_Click() ‘ Sayfayı tekrar çağır
On Error Resume Next
WebBrowser1.Refresh
End Sub

Private Sub dur_Click() ‘ Sayfa çağırma işlemini durdurur
On Error Resume Next
WebBrowser1.Stop
End Sub

Private Sub Combo1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then ‘ Enter tuşu ile yazılan sayfa çağrılır
Git_Click ‘ Ortak kod nedeniyle Git_Click
End If
End Sub

Private Sub Git_Click()
Dim kontrol As Boolean
kontrol = False
WebBrowser1.Navigate Combo1.Text ‘ Combo’da yazılı adrese git
For I = 0 To Combo1.ListCount – 1 ‘ Combo’da yoksa listeye ekle
If Combo1.List(I) = Combo1.Text Then kontrol = True
Next I
If kontrol = False Then Combo1.AddItem Combo1.Text
End Sub

Private Sub WebBrowser1_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
sayfa_adı.Caption = "Bağlanılıyor " & Combo1.Text ‘ Durum bilgisi
End Sub

Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
sayfa_adı.Caption = WebBrowser1.LocationName
End Sub ‘ Bağlanılan adresin başlığı

WebBrowser - Yöntemler

2007-05-25T21:37:00.000+02:00

WebBrowser - Olaylar

2007-05-25T21:36:00.001+02:00

WebBrowser – Web Tarayıcı - Özellikler

2007-05-25T21:35:00.001+02:00

Execute / FTP

2007-05-25T21:34:00.002+02:00

CD : Dizin değiştirme “CD Kaynaklar\Yeni”
CDUp : Bir üst dizinine geçiş “CDUP”
Delete : Dosya sil “DELETE Kaynak.txt”
Dir : Dizindeki dosya listesi “DIR Kaynaklar”
Get : Karşıdan dosya transferi “Get Kaynak.Txt c:\Kaynak.Txt”
MkDir : Dizin oluşturma “MKDIR /YeniDizin”
Put : Karşı ya dosya transferi “PUT c:\Kaynak:txt kaynak:txt”
Pwd : Dizin yazıcıya gönederilir “PWD”
Quit : Bağlantı kesilir “QUIT”
Recv : Karşıdan dosya transferi “RECV Kaynak.Txt c:\Kaynak.Txt”
Rename : Dosya ismi değiştirme “RENAME Kaynak.Txt KaynakYeni.Txt”
RmDir : Dizin silme “RMDIR SilinecekDizin”
Send : Karşıya dosya transferi “SEND c:\Kaynak:txt kaynak:txt”
Size : Dosya boyutu “SIZE Kaynak.Txt

Inet.Execute “ftp://ftp.dokuman.com/” , “Get Kaynak.Txt c:\Kaynak.Txt”

Execute / HTTP

2007-05-25T21:34:00.001+02:00

Get : Dosya alımı
Head : URL içerisinde tanımlı dosya adları
Post : Bilgi yollama
Put : URL içerisinde veri değişimi

Inet1.Execute “http://www.alan.com/index.htm” , “Get”

INET - Yöntemler

2007-05-25T21:33:00.003+02:00

OpenURL : URL ye bağlantı
Execute : Gelişmiş URL bağlantısı ( FTP )
GetChunk : FTP - Veri transferi

INET - Olaylar

2007-05-25T21:33:00.001+02:00

StateChanged : Bağlantıda oluşan değişiklikler

INET - Özellikler

2007-05-25T21:31:00.000+02:00

AccessType : Erişim tipi
Password : Kullanıcı şifresi
Proxy : Proxy server adresi ( AccesType -2 )
URL : URL
RemotePort : Bağlantı kurulacak port numarası
( HTTP – 80, FTP – 21, Mail Server POP - 110 )
RequestTimeOut : Bağlantı için bekleme süresi
( Bağlantı gerçekleşmezse StateChange oluşur )
StillExecuting : True - Meşgul
UserName : Kullanıcı Adı

INET – İnternet Transferi Kontrolü

2007-05-25T21:28:00.000+02:00

HTTP ve FTP protolkollerini kullanır.

Inet1.Protocol = icHTTP
Inet1.RemotePort = 80
Inet1.UserName = “AliCan”
Inet1.PassWord = “12312312”Inet1.AccessType = 2
Inet1.Proxy = “192.168.0.2:1253”
Inet1.OpenURL()
Text1.Text = Inet1.OpenURL(“http://www.hurriyet.com/”) ‘ HTML kod metin kutusuna
Text1.Text = Inet1.OpenURL(“ftp://ftp.al.com/dosya.txt”) ‘ Text metin kutusuna aktarılır
With Inet1
.URL = “ftp://ftp.dosyasan.com”
.Userame = “usta”
.Password = “yenibirgun”
End With

Inet.Execute “ftp://ftp.dokuman.com/” , “Get Kaynak.Txt c:\Kaynak.Txt”

Dim Form_Veri As String
Form_Veri = “find=insan”
Inet1.execute “http://www.arama.com/cgi-bin/ara.exe” , “POST”, Form_Veri

Text1.Text = Inet1.OpenURL(“http://www.arama.com/cgi-bin/ara.exe?find=insan”)

Byte Aktarım

Dosya = “ftp://ftp.dosyalist.com/icq.exe”
Dosya_No = FreeFile
Temp() = Inet1.OpenURL(Dosya, icByteArray)
Open “icq.exe” For Binary Access Write As #Dosya_No
Put #Dosya_No, Temp()
Close #Dosya_No

Text Aktarım

Dosya = “ftp://ftp.dosyalist.com/dosyalistesi.txt”
Dosya_No = FreeFile
Open “dosyalistesi.txt” For Output As #Dosya_No
Write #Dosya_No, Inet1.OpenURL(Dosya)
Close #Dosya_No

UDP

2007-05-25T21:27:00.000+02:00

1 - UDP : Basit bağlantı programları yazmakta
Winsock1.Protocol = sckUDPProtocol

Private Sub Form_Load()
Randomize ‘ Rastlantısal olarak kullanıcı ismi oluşturmak
Text3.Text = "Kullanıcı - " & Int(100 * Rnd + 1)
End Sub

Private Sub Clie_Click() ‘ Server’a bağlantı
Dim adres As String
adres = InputBox("Server'ın IP Adresini Giriniz :", "Bağlantı", "127.0.0.1")
With Winsock1
.RemoteHost = adres
.RemotePort = 1002
.Bind 1001
End With
Form1.Caption = "PeerB"
End Sub

Private Sub serv_Click() ‘ Server moda geçiş
With Winsock1
.RemoteHost = LocalHostIP
.RemotePort = 1001
.Bind 1002
End With
Form1.Caption = "PeerA"
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer) ‘ Bilgi gönderme
If KeyAscii = 13 Then
Winsock1.SendData Text3.Text & " :" & Text2.Text
Text1.Text = Text1.Text & Text3.Text & " :" & Text2.Text & vbCrLf
Text2.Text = ""
End If
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
Winsock1.Accept requestID ‘ Bağlantı kabulü
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim Veri As String
Winsock1.GetData Veri ‘ Bilgi alınışı
Text1.Text = Text1.Text & Veri & vbCrLf
End Sub

TCP

2007-05-25T21:23:00.001+02:00

0 - TCP : Dosya transferi, Chat oturumları yazmakta

Winsock1.Protocol = sckTCPProtocol

Port Dinlemek (Server)
Winsock1.LocalPort = 1234 ‘ Dinleme Portu
Winsock1.RemotePort = 5678 ‘ Bağlantı sonrasında yanıt yollanacak port
Winsock1.Listen ‘ Dinlemeye Başla

Bağlantı Talebi
Winsock1.RemotePort = 1234 ‘ Bağlanılacak Winsock nesnesinin Port numarası
Winsock1.RemoteHost = "127.0.0.1" ‘ Bağlanılacak Winsock nesnesinin IP adresi
‘ Winsock1.RemoteHost = "www.ev.com" ‘ Bağlanılacak IP adresi
Winsock1.Connect ‘ Bağlantı

Bağlantı Kabul Etmek
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
‘ Bir bağlantı varsa onu kapatıyor
If Winsock1.State <> sckClosed Then Winsock1.Close
Winsock1.Accept requestID ‘ Gelen bağlantı talebini kabul etmek
End Sub

Veri Yollamak
Winsock1.SendData "Bu Bir Deneme Mesajıdır!", vbString ‘ String veri yollamak

Veri Almak
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData Gelen ‘Gelen veriyi almak
MsgBox Gelen, 16, "Gelen Veri"
End Sub

Private Sub Form_Load()
Randomize
Text3.Text = "Kullanıcı - " & Int(100 * Rnd + 1) ‘ Kullanıcı ismi
End Sub

Private Sub serv_Click() ‘ Server açma
Winsock1.LocalPort = 1234
Winsock1.RemotePort = 5678
Winsock1.Listen
serv.Visible = False
Clie.Visible = False
Form1.Caption = "Server"
End Sub

Private Sub Clie_Click() ‘ Server’a bağlanma
On Error GoTo hata
Dim adres As String
adres = InputBox("Server'ın IP adresini Giriniz :", "Bağlantı", "127.0.0.1")
Winsock1.RemotePort = 1234
Winsock1.RemoteHost = adres
Winsock1.Connect
serv.Visible = False
Clie.Visible = False
Form1.Caption = "Client"
hata:
MsgBox "Bağlantı Sağlanamadı", vbInformation, "Bağlantı"
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
If Winsock1.State <> sckClosed Then Winsock1.Close
Winsock1.Accept requestID ‘ Bağlantı kabulü
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim gelen As String
Winsock1.GetData gelen ‘ Bilgi alınışı
Text1.Text = Text1.Text & gelen & vbCrLf
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer) ‘ Bilgi gönderme
If serv.Visible = True Then Exit Sub
If KeyAscii = 13 Then
Winsock1.SendData Text3.Text & " :" & Text2.Text
Text1.Text = Text1.Text & Text3.Text & " :" & Text2.Text & vbCrLf
End If
End Sub

Private Sub çık_Click() ‘ Programdan çıkış
End
End Sub

WinSock - Yöntemler

2007-05-25T21:22:00.001+02:00

WinSock - Olaylar

2007-05-25T21:21:00.000+02:00

WinSock - Özellikler

2007-05-25T21:20:00.001+02:00

Protocol :
UDP (User Datagram Protocol) - Hızlı
TCP (Transmission Control Protocol) - Yavaş

Winsock – Bağlantı Protokolleri

2007-05-25T21:19:00.003+02:00

İki ayrı protokol kullanarak iki program ya da bilgisayar arasında bağlantı kurar.

Winsock1.Protocol = sckUDPProtocol 1 - UDP : Basit bağlantı programları yazmakta
Winsock1.Protocol = sckTCPProtocol 0 - TCP : Dosya transferi, Chat oturumları yazmakta

MSComm - Olaylar

2007-05-25T21:19:00.001+02:00

OnComm : İletişimde değişiklik yada hata oluşması

MSComm - Özellikler

2007-05-25T21:17:00.000+02:00

PortOpen : Portu açıp kapama
InBufferSize : Alım için ayrılan hafıza miktarı
OutBufferSize : Gönderim için ayrılan hafıza miktarı
InputLen : 0 - Bilgi girişinin tamamı okunur
EOFEnable : EOF zamanı
HandShaking : Veri koruma

MSComm – Seri Port İletişimi

2007-05-25T21:15:00.000+02:00

MsComm1.Output = "ATDT 01232503222" & VbCr ‘ Göderilen bilgi
MsComm1.Output = "Bilgi Bilgi Bilgi Bilgi Bilgi Bilgi" & VbCr
Text1.Text = MsComm1.Input ‘ Alınan bilgi

Private Sub Form_Load ()
Dim Instring As String
MSComm1.CommPort = 2
MSComm1.Settings = "9600,N,8,1"
MSComm1.InputLen = 0
MSComm1.PortOpen = True
MSComm1.Output = "ATV1Q0" & Chr$(13)
Do
DoEvents
Buffer$ = Buffer$ & MSComm1.Input
Loop Until InStr(Buffer$, "OK" & vbCRLF)
MSComm1.PortOpen = False
End Sub

CommEvent : OnComm İle değişir

Private Sub MSComm_OnComm ()
Select Case MSComm1.CommEvent
' Olaylar
Case comEvCD
Case comEvCTS
Case comEvDSR
Case comEvRing
Case comEvReceive
Case comEvSend
Case comEvEof
' Hatalar
Case comEventBreak
Case comEventFrame
Case comEventOverrun
Case comEventRxOver
Case comEventRxParity
Case comEventTxFull
Case comEventDCB
End Select
End Sub

MAPIMessage - Yöntemler

2007-05-25T21:14:00.001+02:00

Compose : Yeni mesaj düzenler
Copy : En son indexlenmiş mesajı kopyalar
Delete : Mesajı siler
Fetch : Seçili mesajlardan bir mesaj seti oluşturur
Forward : Mesajı başka kullanıcıya gönderiri
Reply : Mesajı cevaplar
Save : Mesajı kaydeder
Send : Mesajı gönderir

MAPIMessage - Özellikler

2007-05-25T21:13:00.001+02:00

AddressCaption : Adres kitabı adı
AddressEditFieldCount : Adres kitabı üzerindek, kontoller
AddressModifiable : Değişiklik yapabilme izni
AddressResolveUI : Adres kitabından kontrol yapılması
AttachmentCount : Eklenti sayısı
AttachmentIndex : Eklenti numarası
AttachmentName : Tam yeri ve adı
AttachmentPosition : Mesaj da ekleneceği yer
AttachmentType : Eklenen dosyanın türü

MAPIMessage

2007-05-25T21:12:00.002+02:00

Mesaj gönderme fonksiyonu. MAPISession ile oturum başlatıldıktan sonra devreye girer.

MAPISesion - Yöntemler

2007-05-25T21:12:00.001+02:00

SingOn : Oturumu açar
SingOff : Oturumu kapar

MAPISesion - Özellikler

2007-05-25T21:11:00.002+02:00

Password : Kullanıcı şifresi
UserName : Kullanıcı adı

MAPISesion

2007-05-25T21:11:00.001+02:00

MAPI oturumu hazırlar.

MAPI – Mesaj Alıp Yollama

2007-05-25T21:10:00.001+02:00

With MAPImessages1
.Compose ‘ msgindex = -1 olur
.RecipDisplayName = "Murat Ustaoğlu"
.RecipAddress = "ustaoglu@yahoo.com"
.AddressResolveUI = True ‘ Adres için kullanıcı kontrolu
.ResolveName
.MsgSubject = "Bilgilendirme"
.MsgNoteText = "Bugünkü toplantı iptal edildi"
.AttachmentpathName = "C:\Aciklama.txt"
.Send = False ‘ Gönder
End With

Private Sub PostaGonder_Click()
MAPISession1.DownLoadMail = False
MAPISession1.LogonUI = True
MAPISession1.SignOn
DoEvents
If MAPISession1.SessionID = 0 Then
SendMAPIMail = False
MsgBox "MAPI Başlatılamadı.", vbCritical, "MAPI"
Exit Sub
End If
MAPIMessages1.SessionID = MAPISession1.SessionID
With MAPIMessages1
.MsgIndex = -1
.Compose
'.RecipIndex = 0
'.RecipType = mapToList
'.RecipDisplayName = "Mehmet Yılmaz"
.RecipAddress = “mehmet14@bedavamail.com”
' Adres_TextBox.Text
'.AddressResolveUI = False
'.ResolveName
'.RecipIndex = 1
'.RecipType = mapCcList
'.RecipAddress = CCAdresi
'.ResolveName
.MsgSubject = "Toplantı Hakkında" ' Konu_TextBox.Text
.MsgNoteText = "Toplantı ertlenmistir ....." ' Icerik_TextBox.Text
'.AttachmentPathName = "C:\Aciklama.txt"
.Send
End With
MAPISession1.SignOff
End Sub

SysInfo - Olaylar

2007-05-25T20:17:00.002+02:00

SysInfo - Özellikler

2007-05-25T20:17:00.001+02:00

SysInfo – Sistem Bilgisi

2007-05-25T20:16:00.002+02:00

Private Sub Command1_Click()
Dim Sistem As String
Select Case SysInfo1.OSPlatform
Case 0
Sistem = "Tanımlanamadı"
Case 1
Sistem = "Windows 95 version." & CStr(SysInfo1.OSVersion)
Case 2
Sistem = "Windows NT version." & CStr(SysInfo1.OSVersion)
End Select
MsgBox "Sistem: " & Sistem
End Sub

Private Sub SysInfo1_DisplayChanged()
If Screen.ActiveForm.Width > SysInfo1.WorkAreaWidth Then
Screen.ActiveForm.Left = SysInfo1.WorkAreaLeft
Screen.ActiveForm.Width = SysInfo1.WorkAreaWidth
End If
If Screen.ActiveForm.Height > SysInfo1.WorkAreaHeight Then
Screen.ActiveForm.Top = SysInfo1.WorkAreaTop
Screen.ActiveForm.Height = SysInfo1.WorkAreaHeight
End If
End Sub

MMControl - Yöntemler

2007-05-25T20:16:00.001+02:00

MMControl - Olaylar

2007-05-25T20:15:00.001+02:00

MMControl - Özellikler

2007-05-25T20:14:00.001+02:00

MMControl – Çoklu Ortam Dosyası Oynatıcı

2007-05-25T20:13:00.001+02:00

Media kontrol interface sürücülerini kullanmamıza yarar. Bu sayede CD-Rom, ses kartı gibi parçalarda kontrol edilebilir.

Animation : Animation cihazı
CDAudio : Audio CD cihazı
Dat : Digital audio tape cihazı
Sequencer : MIDI *.mid cihazı
VCR : VideoTape kaydedici ve oynatıcı cihaz
Video : Video dosyası *.avi cihazı
VideoDisc : VideoDisk cihazı
WaveAudio : Audio *.wav cihazı
Private Sub Command1_Click ()
MMControl1.Notify = FALSE
MMControl1.Wait = TRUE
MMControl1.Shareable = FALSE
MMControl1.DeviceType = "WaveAudio"
MMControl1.FileName = "C:\Merhaba.wav"
MMControl1.Command = "Open"
End Sub

Private Sub Command2_Click ()
MMControl1.Command = "Close"
End Sub

Animation - Yöntemler

2007-05-25T20:12:00.001+02:00

Open : Dosya açma. AutoPlay - true ise otomatik olarak oynatır
Play : Dosyayı oynatır
Stop : Dosyanın oynatılması durur
Close : Dosya kapatılır

Animation - Olaylar

2007-05-25T20:11:00.001+02:00

Animation - Özellikler

2007-05-25T20:10:00.001+02:00

AutoPlay : Otomatik oynatma
Center : Animasyonun kontrol içerisinde ortalanması

Animation – Avi Dosyası Oynatıcı

2007-05-25T20:09:00.000+02:00

Avi dosyalarını sessiz olarak oynatır.

Private Sub Form_Click()
CommonDialog1.Filter = "Avi Dosyaları(*.avi)*avi"
CommonDialog1.ShowOpen
Animation1.Open CommonDialog1.FileName
Animation1.Play
End Sub

DBGrid - Data Kontrol

2007-05-25T20:07:00.000+02:00

Private Sub Form_Load()
Form1.Caption = " DBGrid ve Data Kontrol"
With Data1 ‘ Data kontrol ayarları
.Align = 2
.DatabaseName = "Personel.mdb"
.RecordSource = " Select * from Kisiler"
End With

With DBGrid1 ‘ DBGrid1 kontrol ayarları
Set .DataSource = Data1
.Align = 1
.AllowAddNew = True ‘ Kayıt girişi, silinmesi
.AllowDelete = True ‘ ve düzeltilmesi
.AllowUpdate = True ‘ otomatik yapılıyor
.ColumnHeaders = True
End With
End Sub

Private Sub Data1_Reposition() ‘ Data1 başlığı
Data1.Caption = Data1.Recordset.AbsolutePosition + 1 & "/" & Data1.Recordset.RecordCount
End Sub

Private Sub DBGrid1_HeadClick(ByVal ColIndex As Integer) ‘ Başlığa göre sıralama
Data1.RecordSource = "select * from kisiler Order By " & DBGrid1.Columns(ColIndex).DataField
Data1.Refresh
End Sub

DBGrid - Yöntemler

2007-05-25T20:06:00.000+02:00

DBGrid - Olaylar

2007-05-25T20:05:00.000+02:00

DBGrid – RDO Veri Izgarası - Özellikler

2007-05-25T20:02:00.000+02:00

ADO - Kod ile Veri Tabanı Yönetimi

2007-05-25T19:58:00.000+02:00

(General)(Declaration)
Dim Baglanti As Connection
Dim KayitSet As Recordset

Private Sub veri_set() ‘ Tekrar eden tanımlama için
Text1.Text = KayitSet![sicil_no] ‘ ortak kod
Text2.Text = KayitSet![ad]
Text3.Text = KayitSet![soyad]
Text4.Text = KayitSet![adres]
End Sub

Private Sub ilk_okuma() ‘ Ortak kod
Set KayitSet = New Recordset ‘ Kayıt seti tanımlanıyor
KayitSet.Open "Select * from kisiler", Baglanti, adOpenKeyset, adLockOptimistic
If KayitSet.RecordCount <> 0 Then
KayitSet.Fields.Refresh
veri_set
End If
End Sub

Private Sub Form_Load()
Set Baglanti = New Connection ‘ Veri tabanının tanıtımı
Baglanti.Open "Provider=Microsoft.jet.oledb.4.0; Data Source = personel.mdb"
ilk_okuma
End Sub

Private Sub Command4_Click() ‘ İlk kayıt
On Error Resume Next
KayitSet.MoveFirst
veri_set
End Sub

Private Sub Command2_Click() ‘ Önceki kayıt
On Error GoTo yenihata
KayitSet.MovePrevious
veri_set
Exit Sub
yenihata:
KayitSet.MoveFirst
End Sub

Private Sub Command3_Click() ‘ Son Kayıt
On Error Resume Next
KayitSet.MoveLast
veri_set
End Sub

Private Sub Command1_Click() ‘ Sonraki kayıt
On Error GoTo yenihata
KayitSet.MoveNext
veri_set
Exit Sub
yenihata:
KayitSet.MoveLast
End Sub

Private Sub Command6_Click() ‘ Arama
On Error Resume Next
Dim ara_sicil_no As Double ‘ Arama için yeni kayıt seti
Dim yeni_k_s As New Recordset
ara_sicil_no = InputBox("Aranan kişinin sicil numarasını giriniz :", "Sicil Numarası İle Arama")
yeni_k_s.Open "Select * from kisiler where sicil_no=" & Val(ara_sicil_no), Baglanti, adOpenKeyset, adLockOptimistic
If yeni_k_s.RecordCount <> 0 Then
Text1.Text = yeni_k_s![sicil_no]
Text2.Text = yeni_k_s![ad]
Text3.Text = yeni_k_s![soyad]
Text4.Text = yeni_k_s![adres]
yeni_k_s.Close
Else
MsgBox "Kayıt Bulunamadı", vbCritical, "Arama"
End If
End Sub

Private Sub Command7_Click() ‘ Kayıt ekleme
If Command7.Caption = "Ekle" Then ‘ başlığa göre işlem seçimi
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Command7.Caption = "Kaydet" ‘ Başlık değiştirme
Else
Dim yeni_k_s As New Recordset
yeni_k_s.Open "Select * from kisiler", Baglanti, adOpenKeyset, adLockOptimistic
If yeni_k_s.RecordCount <> 0 Then
yeni_k_s.AddNew
yeni_k_s![sicil_no] = Text1.Text
yeni_k_s![ad] = Text2.Text
yeni_k_s![soyad] = Text3.Text
yeni_k_s![adres] = Text4.Text
yeni_k_s.Update
yeni_k_s.Close
End If
ilk_okuma
Command7.Caption = "Ekle"
End If
End Sub

Private Sub Command5_Click() ‘ Kayıt silme
On Error Resume Next
Dim yeni_k_s As New Recordset ‘ Kayıt silme için kayıt seti
yeni_k_s.Open "Select * from kisiler where sicil_no=" & Text1.Text, Baglanti, adOpenKeyset, adLockOptimistic
If yeni_k_s.RecordCount <> 0 Then
yeni_k_s.Delete
yeni_k_s.Close
End If
ilk_okuma
End Sub

Private Sub Command8_Click()
Close All ‘ Açık olan herşeyi kapat
End ‘ Programdan çık
End Sub

Programın kodlanmasına başlamadan önce Project > Reference mönüsünden “Microsoft ActiveX Data Object 2.5 Library” referanslar arasına eklenir.

ADO Kontrol & DataList & DataCombo & DataGrid

2007-05-25T19:55:00.000+02:00

Private Sub Form_Load() ‘ Veri tabanı tanımlama
Adodc1.ConnectionString = "Provider =" & "Microsoft.Jet.OLEDB.4.0; Data Source= personel.mdb"

SecimIptal _Click ‘ Ortak kod

With DataList1 ‘ DataList veri tabanına bağlanıyor
Set .DataSource = Adodc1
.DataField = "Sicil_No"
.BoundColumn = "Sicil_No"
Set .RowSource = Adodc1
.ListField = "Sicil_No"
End With

With DataCombo1 ‘ DataCombo veri tabanına bağlanıyor
Set .DataSource = Adodc1
.DataField = "Soyad"
.BoundColumn = "Soyad"
Set .RowSource = Adodc1
.ListField = "Soyad"
End With

With DataGrid1 ‘ DataGrid veri tabanına bağlanıyor
Set .DataSource = Adodc1
.AllowAddNew = True
.AllowDelete = True
.AllowUpdate = True
End With

Set Text1.DataSource = Adodc1 ‘ TextBoxlar veri tabanına bağlanıyor
Set Text2.DataSource = Adodc1
Set Text3.DataSource = Adodc1
Set Text4.DataSource = Adodc1
Text1.DataField = "Sicil_No"
Text2.DataField = "Ad"
Text3.DataField = "Soyad"
Text4.DataField = "Adres"
End Sub

Private Sub SecimIptal _Click() ‘ Alan seçimi
Adodc1.RecordSource = "SELECT * FROM kisiler"
Adodc1.Refresh
Adodc1.Recordset.MoveFirst
End Sub

Private Sub DataCombo1_DblClick(Area As Integer)
Adodc1.RecordSource = "select * from kisiler where soyad='" & DataCombo1.Text & "'"
Adodc1.Refresh ‘ Çift tıklana kayıt seçiliyor
End Sub

Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer)
Adodc1.RecordSource = "select * from kisiler Order By " & DataGrid1.Columns(ColIndex).DataField
Adodc1.Refresh ‘ Seçilen başlıkda sıralama yapılıyor
End Sub

Private Sub DataList1_Click()
Adodc1.RecordSource = "select * from kisiler where sicil_no=" & DataList1.Text
Adodc1.Refresh ‘ Tıklanan sicil numaralı kayıt seçiliyor
End Sub

Private Sub Cık_Click()
End ‘ Program kapatılıyor
End Sub

ADO Data Control - Yöntemler

2007-05-25T19:54:00.002+02:00