AKTİF YAZICININ DEĞİŞTİRLMESİ

Bu kodlar Windows'un varsayılan yazıcısını değiştirmez. O an çalışan programın içindeki aktif yazıcıyı değiştirir.

Private Sub Form_Load()
prnlist
MsgBox ("Şu anki aktif yaziciniz : " & Printer.DeviceName & " ")
End Sub

Private Sub prnlist()
Dim X As Printer
For Each X In Printers
prncombo.AddItem X.DeviceName
Next
End Sub

Private Sub prncombo_Click()
Dim X As Printer
For Each X In Printers
Set Printer = X
If Printer.DeviceName = prncombo.Text Then
Exit For
End If
Next
MsgBox ("Şu anki aktif yaziciniz : " & Printer.DeviceName & " ")
End Sub

DESKTOPTAKİ İKONLARIN DÜZENLENMESİ

Aşağıdaki kodu fare ile copy yapın ve Visual Basic'i açarak General Declerations bölümünden itibaren paste edin
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long



Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long



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



Private Const GW_CHILD = 5



Private Const LVA_ALIGNLEFT = &H1



Private Const LVM_ARRANGE = &H1016







Private Sub Command1_Click()



Dim hWnd1 As Long



Dim hWnd2 As Long



Dim Ret As Long



hWnd1 = FindWindow("Progman", vbNullString)



hWnd2 = GetWindow(hWnd1, GW_CHILD)



hWnd1 = GetWindow(hWnd2, GW_CHILD)



Ret = SendMessage(hWnd1, LVM_ARRANGE, LVA_ALIGNLEFT, 0)



End Sub



Command1 fonksiyonunu bir butona bağlayın. Butona bastığınız zaman desktop'daki tüm ikonlar sol tarafa asker gibi dizilecektir.

İNTERNET BAĞLANTISINI KONTROL ETME


İnternet bağlantısının aktif olup olmadığını kontrol etmek için VB'de herhangi bir komut bulunmaz. Ancak internetle ilgili bir kontrol çalıştırıldığında bunu kontrol ederek aktif bağlantı yoksa, önce bağlantı kurmak için bağlantı penceresini açar. Yine de siz bir komutu kullanmadan önce internete aktif bağlantı olup olmadığını öğrenmek isterseniz bazı API'ler aracılığı ile regisrty dosyasında bulunan System\CurrentControlSet\Servi ces\RemoteAccess yolu altındaki "Remote Connection" anahtarının değerini okuyarak aktif bağlantının olup olmadığını anlayabilirsiniz.

ÖRNEK: Bilgisayarın internete bağlı olup olmadığını anlayacak kod.


Option Explicit

Private Const HKEY_LOCAL_MACHINE = &H80000002

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA"

(ByVal hKey As Long, ByVal alt As String, hKey As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA"

(ByVal hKey As Long, ByVal sKeyValue As String, ByVal lpReserved As Long,

lpType As Long, lpData As Any, nSizeData As Long) As Long



Private Sub Form_Load()

Dim hKey As Long, lpData As Long, nSizeData As Long

Dim alt, anahtar

alt = "System\CurrentControlSet\Serv ices\RemoteAccess"

anahtar = "Remote Connection"

If RegOpenKey(HKEY_LOCAL_MACHINE, alt, hKey) = 0 Then

lpData = 0&

nSizeData = Len(lpData)

If RegQueryValueEx(hKey, anahtar, 0&, 0&, lpData, nSizeData) = 0 Then

If lpData
<> 0 Then

MsgBox ("İnternet bağlantısı aktif")

Else

MsgBox ("İnternet bağlantısı aktif değil")

End If

End If

RegCloseKey (hKey)

End If

End Sub

MENÜLERE BITMAP RESİMLER EKLEME
______________________________ __________
Bu kod parçası menülere bitmap resimleri ekliyor. Öncelik bir modüle su satırları ekleyin.

Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long

Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long

Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long

Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, _ byVal hBitmapChecked As Long) As Long

Public Const MF_BITMAP = &H4&

Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type

Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long

Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, _
lpMenuItemInfo As MENUITEMINFO) As Boolean

Public Const MIIM_ID = &H2
Public Const MIIM_TYPE = &H10
Public Const MFT_STRING = &H0&

Daha sonra içerisinde menü bulunduran bir form üzerinde bir PictureBox yarattiktan sonra aşağıdaki kod satırını giriniz.

Private Sub Form_Load()
hMenu& = GetMenu(Form1.hwnd)
hSubMenu& = GetSubMenu(hMenu&, 0)
hID& = GetMenuItemID(hSubMenu&, 0)
SetMenuItemBitmaps hMenu&, hID&, MF_BITMAP, Picture1.Picture, Picture1.Picture
End Sub

SAYILARI NOKTA İLE AYIRMAK



Kodun yazıldığı sistem..: Pentium II 333Mhz, 64Mb ram
İşletim Sistemi.............: MS WindowsNT 4.0, Service Pack 5
Version....................... : MS Visual Basic 6.0 Enterprise + Service Pack 3

Sayıları nokta ile ayırmak
______________________________ __________

Bir arkadaşımız mail'inde sayıların arasına nokta koyarak göstermek istediğini yazmış. Böylece okunurluluğu arttırmış olacaktır. Text box'a girilen sayı onlar, yüzler, binler vs olarak ayrılmakta ve aralarına nokta koyulmaktadır. Ayrıca eğer ondalıklı bir sayı ise ondalıklı kısım korunarak görüntülenmektedir. Şimdi aşağıdaki kodu bir modül içine kopyalayın ve bir form üzerine iki adet text box koyun.



Public Function VirgulEkle(ByVal Sayi As Double)

Dim YeniSayi As String
Dim VirgulluKisim As String
Dim Yedek As String
Dim TestSayisi As String

TestSayisi = CStr(Sayi)

For x = 1 To Len(TestSayisi)
Yedek = Left(TestSayisi, x)

If Right(Yedek, 1) = "," Then
VirgulluKisim = Right(TestSayisi, Len(TestSayisi) - x)
TestSayisi = Left(TestSayisi, (x - 1))
End If

Next x

If (Len(TestSayisi) Mod 3) <> 0 Then
YeniSayi = Left(TestSayisi, (Len(TestSayisi) Mod 3))
YeniSayi = YeniSayi & "."
TestSayisi = Right(TestSayisi, Len(TestSayisi) - (Len(TestSayisi) Mod 3))
End If

Do While (Len(TestSayisi) > 3)
YeniSayi = YeniSayi & Left(TestSayisi, 3)
YeniSayi = YeniSayi & "."
TestSayisi = Right(TestSayisi, Len(TestSayisi) - 3)
Loop

YeniSayi = YeniSayi & TestSayisi

If VirgulluKisim <> "" Then
YeniSayi = YeniSayi & ","
YeniSayi = YeniSayi & VirgulluKisim
End If

VirgulEkle = YeniSayi

End Function



Şimdi text boxlardan ilkinin LostFocus event'ine şu kodları yerleştirin.


Private Sub Text1_LostFocus()
Dim Yazi As String

Yazi = VirgulEkle(CDbl(Text1.Text))
Text1.Text = CStr(Yazi)
End Sub


Text box'dan lostfocus durumu gerçekleştiğinde tb içindeki sayı formatlanarak noktalı hale getirilecektir. Bu mail'e bu kadar geç cevap verdiğim için kusura bakmayın. Çok meşgul günler geçiriyorum.