Visual Basic Dersleri-1

Microsoft firması tarafından geliştirilen Visual Basic, atası olan QBASIC derleyicisinin geliştirilmiş ve Windows ortamına uyarlanmış olan sürümü olarak adlandırılabilir. Windows ortamına uyarlandığı için de Nesneye Yönelimli bir dildir. VBX kontrollerini destekleyen ilk dillerden biridir. VBasic'de, 1.0 sürümünden 6.0 sürümüne kadar bir çok yenilik ve değişiklik olmuştur. Bunlardan biri de, arayüzünün güçlü ve etkili bir görünüm kazanmasıdır. Visual Basic, devamlı geliştiği bu süre sonunda yüksek hızlı uygulamalar, OLE serverlar, ActiveX kontrolleri ve daha bir çok şey geliştirilebilecek hale gelmiştir.

Microsoft Windows için program geliştiren programcıların yüzde yirmibeşi Visual Basic'i tercih etmektedirler. Visual Basic'i en popüler programlama dillerinden biri yapan en önemli nedenlerden biri de büyük olasılıkla kolay olmasıdır. Visual Basic de program yazmak için çok fazla teknik bilgiye sahip olmak gerekmez. Sadece kontrolleri form üzerine yerleştirmek ve kodu yazmak yeterli. Kısaca Visual Basic, programcıyı, programın kullanıcıya yansıyan şekli için kod yazmak zorunda bırakmayan bir dildir.

Zamanla Microsoft dışındaki bazı şirketler tarafından benzer programlama dilleri geliştirildi. Muhtemelen bunların en popüleri Borland Delphi'dir.

STRING İŞLEMLERİ
StrComp: String Karsilastirma

StrComp (String1, String2, [Sart])

String1 : Karsilastirilacak ilk String
String2 : Karsilastirilacak ikinci String Sart : 0 ise büyük harf kücük harf ayrimi yapar 1 ise yapmaz

Geri Dönen deger 0 ise stringler esittir. Negatif ise String2 Pozitif ise String1 büyüktür. Büyüklük alfabetik siraya göre belirlenir.

StrConv: Stringi Verilen Moda cevirir.

StrConv(String,Mod)

String : cevirilecek metin
Mod : vbLowerCase = Kücük harfe cevrilir
vbUpperCase = Büyük harfe cevrilir
vbProperCase = Ilk harf büyük digerleri kücük
VbFromUnicode = Unicode'dan cevrilir
vbUnicode = Unicode'a cevrilir
vbHiragana = Hiragana
vbKatakana = Katakana
vbNarrow = Dar
vbWide = Genis


Option Compare Binary: General Declaration kismina yazilirsa stringler büyük-kücük ayrimi yapilarak karsilastirilir.

Option Compare Text: General Declaration kismina yazilirsa stringler büyük-kücük ayrimi yapilmadan karsilastirilir.

Ucase(String): Girilen stringi büyük harfe cevirir

Ucase(araba) 'dönen deger ARABA

LCase(String): Girilen stringi kücük harfe cevirir

LCase(ARABA) 'dönen deger araba

LTrim(String): String'in solundaki bosluklari kaldirir

LTrim(" Kalem ") 'dönen deger "Kalem "

RTrim(String): String'in sagindaki bosluklari kaldirir

RTrim(" Kalem ") 'dönen deger " Kalem"

Trim(String): String'in iki tarafindaki bosluklari kaldirir

Trim(" Kalem ") 'dönen deger "Kalem"

Len(String): String'in karakter sayisini verir. Bosluklar dahil

Len("Bilgisayar") 'dönen deger 10

Right(String,x): String'in sag tarafindan x sayisi kadar karakter verir

Right("Bilgisayar",5) 'dönen deger "sayar"

Left(String,x): String'in sol tarafindan x sayisi kadar karakter verir

Left("Bilgisayar",5) 'dönen deger "Bilgi"

Mid(String, bas, [uzunluk]): String'in bastan uzunluk kadar karakteri verir. uzunluk verilmesse metnin sonuna kadar.

Mid("Bilgisayar",4,4) ' dönen deger "gisa"
Mid("Bilgisayar",4) ' dönen deger "gisayar"

Instr([bas],String,Aranan,Ayrim): String'in icinde verilen karakteri arar. Bulunursa bastan kacinci karakter oldugu geri döner.

Dim ad as String
ad = "Bilgisayar"
y = Instr(ad,"g") ' dönen deger 4

String(x,karakter): Verilen kod dan x sayisi kadar üretir.

String(5,x) 'dönen deger "xxxxx"

Space(x): Verilen degerde bosluk olusturur.

Space(5)

RSet: RSet komutu ile yapilan atama sagdan yapilir

x = "Bilgisayar"
RSet x = "Kalem" ' dönen deger x = " Kalem"

Asc(Harf): Verilen Harfin ascii kodunu geri verir.

Chr(ascii): Verilen ascii kodunun karakter karsiligini verir

Str(sayi): Verilen sayiyi stringe cevirir

Val(String): Verilen string'i sayiya cevirir

Hex(sayi): Verilen dezimal sayiyi hexadezimal sayiya cevirir.

Oct(sayi): Verilen dezimal sayiyi Octal sayiya cevirir

Like Operatörü: String karsilastirma. Mesela bir kelimenin bir string icinde olup olmadigini bulmak.

Dim Test1
Test1 = "aBBBa" Like "a*a" ' dönen deger True.
Test1 = "F" Like "[A-Z]" ' True.
Test1 = "F" Like "[!A-Z]" ' False.
Test1 = "a2a" Like "a#a" ' True.
Test1 = "aM5b" Like "a[L-P]#[!c-e]" ' True.
Test1 = "BAT123khg" Like "B?T*" ' True.
Test1 = "CAT123khg" Like "B?T*" ' False.

OVAL FORM OLUŞTURMAK
Bu kod sayesinde formumuzu oval bir sekilde olusturabiliriz.

Option Explicit

Private Declare Function CreateEllipticRgn Lib "gdi32" _
(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As _
Long, ByVal Y2 As Long) As Long

Private Declare Function SetWindowRgn Lib "user32" (ByVal _
hwnd As Long, ByVal hRgn As Long, ByVal bRedraw _
As Long) As Long

Private Declare Function ReleaseCapture Lib "user32" () _
As Long

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 HTCAPTION = 2
Private Const WM_NCLBUTTONDOWN = &HA1
Private Sub Form_Load()
Me.Picture = LoadPicture(App.Path & "\Back.gif")
Call CreateReg
End Sub

Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, _
x As Single, y As Single)

If y / Screen.TwipsPerPixelY < 25 Then
Call ReleaseCapture
Call SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub

Private Sub CreateReg()
Dim x&, y&, dx&, dy&, Result&

With Me
dx = .Width / Screen.TwipsPerPixelX
dy = .Height / Screen.TwipsPerPixelY
Result = CreateEllipticRgn(y + 1, x + 1, dx - 1, dy - 1)
Call SetWindowRgn(.hwnd, Result, 1&)
End With
End Sub

FORM EFEKTLERİ
Formlari efek vererek acip kapatmak..

Option Explicit

Private Declare Function SetRect Lib "User32" (lpRect _
As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal _
X2 As Long, ByVal Y2 As Long) As Long

Private Declare Function DrawAnimatedRects Lib "User32" _
(ByVal hWnd As Long, ByVal idAni As Long, lprcFrom _
As RECT, lprcTo As RECT) As Long

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Const IDANI_OPEN = &H1
Const IDANI_CLOSE = &H2
Const IDANI_CAPTION = &H3

Dim TPP%

Private Sub Form_Load()
Dim R1 As RECT, R2 As RECT

TPP = Screen.TwipsPerPixelX

Call SetRect(R1, Screen.Width / TPP, Screen.Height / TPP, _
Screen.Width / TPP, Screen.Height / TPP)
Call SetRect(R2, 0, 0, Me.Width / TPP, Me.Height / TPP)

Call DrawAnimatedRects(Me.hWnd, IDANI_CLOSE Or _
IDANI_CAPTION, R1, R2)

Me.Top = 0
Me.Left = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim R1 As RECT, R2 As RECT

Call SetRect(R1, 0, 0, Me.Width / TPP, Me.Height / TPP)
Call SetRect(R2, Screen.Width / TPP, Screen.Height / TPP, _
Screen.Width / TPP, Screen.Height / TPP)

Call DrawAnimatedRects(Me.hWnd, IDANI_OPEN Or _
IDANI_CAPTION, R1, R2)
End Sub


AĞ ÜZERİNDEN MESAJ GÖNDERMEK
Bu örnek sayesinde ag ortaminda bilgisayarlar arasi mail ve mesaj gönderilebilir. Ayni zamanda bir server programi da durumu ve olaylari göstermekedir.

Option Explicit

Dim ID%

Private Function WSend(i%, Text$)
If Winsock(i).State = 7 Then
Winsock(i).SendData Text
Dim t As Long
t = Timer
Do While t + 0.5 > Timer
DoEvents
Loop
End If
End Function

Private Sub Form_Load()
If Winsock(0).State <> 0 Then Winsock(0).Close
'Kullanilacak Port
Winsock(0).LocalPort = 10567
'Dinle
Winsock(0).Listen
End Sub

Private Sub Winsock_ConnectionRequest(Index As Integer, ByVal requestID As Long)
'Aktif Kullaniciyi tanimla
Dim i%
START:

For i = 1 To User.ListItems.Count
User.ListItems.Item(i).SubItems(1) = Winsock(User.ListItems.Item(i)).State

If User.ListItems.Item(i).SubItems(1) <> 7 Then
Winsock(User.ListItems.Item(i)).Close
Unload Winsock(User.ListItems.Item(i))
User.ListItems.Remove i
GoTo START
End If
Next i

'Baglan
If Index = 0 Then
For i = 2 To User.ListItems.Count
If User.ListItems(i) > User.ListItems(i - 1) + 1 Then
Load Winsock(User.ListItems(i) - 1)
Winsock(User.ListItems(i) - 1).LocalPort = 10567
Winsock(User.ListItems(i) - 1).Accept requestID
Exit Sub
End If
Next i

If User.ListItems.Count > 0 Then
If User.ListItems(1) >= 2 Then
Load Winsock(User.ListItems(1) - 1)
Winsock(User.ListItems(1) - 1).LocalPort = 10567
Winsock(User.ListItems(1) - 1).Accept requestID
Exit Sub
End If

Load Winsock(User.ListItems.Count + 1)
Winsock(User.ListItems.Count + 1).LocalPort = 10567
Winsock(User.ListItems.Count + 1).Accept requestID
Exit Sub
End If

Load Winsock(1)
Winsock(1).LocalPort = 0
Winsock(1).Accept requestID
End If
End Sub

Private Sub Winsock_DataArrival(Index As Integer, ByVal bytesTotal As Long)
'Aktif kullaniciyi tanimla
Dim i%
START:

For i = 1 To User.ListItems.Count
User.ListItems.Item(i).SubItems(1) = Winsock(User.ListItems.Item(i)).State

If User.ListItems.Item(i).SubItems(1) <> 7 Then
Winsock(User.ListItems.Item(i)).Close
Unload Winsock(User.ListItems.Item(i))
User.ListItems.Remove i
GoTo START
End If
Next i

'Mesaj al
Dim Message$

Winsock(Index).GetData Message
Call SetList(Mid(Message, 1, 1) & Index & Mid(Message, 2, Len(Message)))
If Mid(Message, 1, 1) = 4 Then Exit Sub

'Mesaji paylastir
If Mid(Message, 1, 1) = 1 Then

Dim MFrom$, MTo$, MText$, ok%
MFrom = Mid(Message, 2, InStr(1, Message, "%") - 2)
MTo = Mid(Message, InStr(1, Message, "%") + 1, InStr(1, Message, "$") - InStr(1, Message, "%") - 1)
MText = Mid(Message, InStr(1, Message, "$") + 1, Len(Message))
ok = 0

For i = 1 To User.ListItems.Count
If LCase(User.ListItems(i).SubItems(2)) = LCase(MTo) Or LCase(MTo) = "alle"Then

If LCase(User.ListItems(i).SubItems(2)) <> LCase(MFrom) Then
WSend User.ListItems.Item(i), MText
SetList "3%" & User.ListItems(i).SubItems(2) & "$" & MText
ok = 1
Exit Sub
End If
End If
Next i

'Kullanici belli degil
If ok = 0 Then
WSend Index, "Kullanici aktif degil"
SetList "3%" & MFrom & "$" & "Kullanici aktif degil"
End If
End If
End Sub

Function SetList(Message$)
Dim litem As ListItem

Select Case CInt(Mid(Message, 1, 1))

Case 1, 4: ID = ID + 1
If LMessage.ListItems.Count > 13 Then LMessage.ListItems.Remove 1
Set litem = LMessage.ListItems.Add(, , ID)
litem.SubItems(1) = Mid(Message, 3, InStr(1, Message, "%") - 3)

litem.SubItems(2) = Mid(Message, InStr(1, Message, "%") + 1, InStr(1, Message, "$") - InStr(1, Message, "%") - 1)
litem.SubItems(3) = "<- " & Mid(Message, InStr(1, Message, "$") + 1, Len(Message))
Case 2: Set litem = User.ListItems.Add(, , Mid(Message, 2, 1))
litem.SubItems(1) = Winsock(CInt(Mid( Message, 2, 1))).State
litem.SubItems(2) = Mid(Message, 3, Len(Message))

Case 3: If LMessage.ListItems.Count > 13 Then LMessage.ListItems.Remove 1
Set litem = LMessage.ListItems.Add(, , ID)
litem.SubItems(1) = Mid(Message, 3, InStr(1, Message, "$") - 3)

litem.SubItems(2) = "MailServer"
litem.SubItems(3) = "<- " & Mid(Message, InStr(1, Message, "$") + 1, Len(Message))
End Select
End Function