'(sadece win xp için)



Shell "Shutdown.exe -s",vbMaximizeFocus

diğper parametreler

'-r - restart

'-l - logoff

'-f - force logoff



------------------------------------------------------------------------

(win 9x,win 2000)



Private declare function ExitWindowex lib "User32.dll" (byval dwOptions as long,

Byval DwReserved as long)



'adı cmdshutdown olan bit command button ekle



Private sub cmdShutdown_click()



  dim lng as long

  private const EWX_SHUTDOWN as long =1 

  

  lng = ExitWindowsEx(EWX_SHUTDOWN,0) 



End sub

Vusial Basic 6 Sanal Klavye Yapımı

Epey bir süre projelerimde kullanmak üzere (dokunmatik ekranlı) sanal klavye araştırması yaptım. Malesef hazır componentlerin dışında ciddi bir bilgiye ulaşamadım. Neredeyse tüm forumlarda bu yönde talep var fakat işe yarar cevap yok(en azından ben göremedim). Şimdi sizlere basit bir sanal klavye yapmaya çalışacağım.

ANA PROBLEM : Sanal klavyedeki ana problem herhangi bir TextBox ı tıkladıktan sonra açılan sanal klavyede basılan tuşa ait bilginin tam olarak ilgili formun ilgili TextBox ına nasıl yazdırılacağıdır. Diyelimki FORM1 in TEXT1 ine tıkladım ve karşıma Sanal Klavye çıktı. Sanal klavyenin "0" tuşuna bastım. Şimdi "0" sayısını FORM1 in TEXT1 ine nasıl atacağım. Eminim ki ilk cevap şu olacaktır. FORM1.TEXT1.TEXT="0". Evet doğru cevap. Peki 20 tane formunuz varsa ve herbirinde 10 ar adet TEXTBOX varsa nasıl olacak. Sanal klavye talebin hangi formun hangi TextBox ından geldiğini nasıl bilecek. Benim cevabım FOR EACH döngüsü kullanmak. İsterseniz sözü uzatmadan Talep eden FORM1 in kodlarını yazayım.
-----------------------------------------------------------------
Private Sub Text1_Click()
Text1.Text = "" 'Text i temizliyorum
Form2.Show 'Form2 (sanal klavye) yi açıyorum
Form2.Label1 = Me.Name 'Form2 nin Label1 ine mevcut formun
'adını yazdırıyorum
Form2.Label2 = "Text1" 'Form2 nin Label2 sinede şuan tıkladığım
'TextBox ın adını yazdırıyorum
End Sub
-----------------------------------------------------------------

Sanırım kodları açıklamama gerek yok. 
Şimdi de Sanal klavyenin yani FORM2 nin kodlarını veriyorum. Form2 deki tek mantık şu :
İki Label ekliyorum ve birince Label'a Talebin geldiği formun adını , ikinci labelada talebin geldiği TextBox2'ın adını yukarıdaki kodlar ile yazdırıyorum. tebi projede bu iki Label 'i INVISIBLE yapacaksınız. Yani "Label1.Visinle=FALSE" gibi.

-------------------------------------------------------------------
Dim frm As Form
Dim txt As TextBox

Private Sub Command1_Click()
klavye (1)
End Sub

Private Sub Command2_Click()
klavye (2)
End Sub

Function klavye(tus As Long)
For Each frm In Forms 'Projedeki tüm formları tek tek tarıyorum
For Each txt In frm.Controls 'Herformdaki tüm textboxları tarıyorum
'Formadı ve TextBox adı Label1 ve Label2 de yazanlarla örtüşüyor ise
If (frm.Name = Label1.Caption) And (txt.Name = Label2.Caption) Then
txt.Text = txt.Text + Str(tus) 'İlgili TextBoxa basılan tuşu ekliyorum.
GoTo cik
End If
Next
Next
cik:
End Function

---------------------------------------------------------------------

İşinize yaraması ümidi ile.
_______________________________________________________________

Değişkenleri Karşılaştırmal İçin Like Komutu

Siz hala........değişkenleri karşılaştırmak için IF komutunu mu kullanıyorsunuz. Eğer öyle ise size daha hızlı bir yol öneriyoruz: Like. Kafanız karışmasın aslında komutun yaptığı işlem IF ile hayli farklı ama yine de bir karşılaştırma komutu. Komutun yaptığı iş VB?de pek de kullanılmayan "numune"leri değişkenlere karşılaştırmak aşağıdaki kodlara bakarsanız ne demek istediğimi anlayacaksınız: 
Deger = "aBBBa" Like "a*a"	' Doğru döndürür.
Deger = "F" Like "[A-Z]"		 ' Doğru döndürür.
Deger = "F" Like "[!A-Z]"	' Yanlış döndürür
Deger = "a2a" Like "a#a"		' Doğru döndürür.
Deger = "aM5b" Like "a[L-P]#[!c-e]"	' Doğru döndürür.
Deger = "BAT123khg" Like "B?T*"	' Doğru döndürür.
Deger = "CAT123khg" Like "B?T*"	' Yanlış döndürür



________________________________________

Bütün Özellikleri Bir Komutta Atamak (With ---End With yapısı)

VB?nin her yeni sürümü ile programcıların işini daha da kolaylaştıracak komutlar ve özellikler geliyor. İşte With (Birlikte) komutu bunlara en güzel örnek. Şimdi aşağıdaki satırları inceleyin ve bazı komutların ne kadar gereksiz olarak kullanıldığını görün:

Private Sub Form_Load()
Form1.Height = 4000
Form1.Caption = "With Örneği"
Form1.BackColor = QBColor(6)
End Sub



Burada dikkat ettiğiniz gibi "Form1" nesnesi her satırda tekrarlanmış. VB 4.0 ile bu soruna bir çözüm getirilerek With komutu yaratılmıştır. Aşağıdaki örnek size bu komutun nasıl kullanıldığı hakkında fikir verecektir.

Private Sub Form_Load()
With Form1			'Form1'i kullanarak...
 .Height = 4000		'Yüksekliği 4000,
 .Caption = "With Örneği"	'Form başlığını "With Örneği",
 .BackColor = QBColor(6)	'Arkaplan rengini yeşil yap.
End With			?Komutu bitir
End Sub



Bu komutu kullanırken With ve End With satırları arasına yine With ve End With satırlarını girebilirsiniz fakat bu iki komut arasına komplike komutlar ve döngüler eklememelisiniz. Bu hem programınızı yavaşlatır hem de ciddi hatalara sebep olabilir. 






--------------------------------------------------------------------------------------

3D Zar Yapmak

Option Explicit







Private CenterX As Integer



Private CenterY As Integer



Private Size As Integer



Private renk As Boolean



Private Radius As Integer



Private Winkel As Integer



Private CurX As Integer



Private CurY As Integer



Private Pi As Double



Private Ecke(1 To 8, 1 To 3) As Integer



Private X(8) As Integer



Private Y(8) As Integer







Private Sub Form_Load()



With Me



.ForeColor = RGB(255, 255, 255)



.BackColor = RGB(143, 143, 143)



.AutoRedraw = True



.DrawWidth = 1



.ScaleMode = vbPixels



CenterX = .ScaleWidth / 2



CenterY = .ScaleHeight / 2



.Show



End With







With Combo1



.AddItem "renk"



.AddItem "kirmizi"



.AddItem "yesil"



.AddItem "mavi"



.AddItem "sari"



.AddItem "lila"



.AddItem "beyaz"



End With



Combo1.ListIndex = 4



renk = False







With Combo2



.AddItem "1"



.AddItem "2"



.AddItem "3"



.AddItem "4"



.AddItem "5"



.AddItem "6"



End With



Combo2.ListIndex = 1







Size = 200



Winkel = 0



Radius = Sqr(2 * (Size / 2) ^ 2)



Pi = Atn(1) * 4







Ecke(1, 2) = Size / 2



Ecke(2, 2) = Size / 2



Ecke(3, 2) = -Size / 2



Ecke(4, 2) = -Size / 2



Ecke(5, 2) = Size / 2



Ecke(6, 2) = Size / 2



Ecke(7, 2) = -Size / 2



Ecke(8, 2) = -Size / 2







Timer1.Interval = 1



End Sub







Private Sub WuerfelDrehen()



Dim i As Integer







Me.Cls







For i = 1 To 8



X(i) = CenterX + Ecke(i, 1) + Ecke(i, 3) / 8



Y(i) = CenterY + Ecke(i, 2) + Sgn(Ecke(i, 2)) * Ecke(i, 3) / 8



Next i







Line (X(3), Y(3))-(X(4), Y(4))



Line (X(4), Y(4))-(X(8), Y(8))



Line (X(3), Y(3))-(X(7), Y(7))



Line (X(7), Y(7))-(X(8), Y(8))



Line (X(1), Y(1))-(X(3), Y(3))



Line (X(1), Y(1))-(X(2), Y(2))



Line (X(5), Y(5))-(X(6), Y(6))



Line (X(5), Y(5))-(X(1), Y(1))



Line (X(5), Y(5))-(X(7), Y(7))



Line (X(6), Y(6))-(X(8), Y(8))



Line (X(2), Y(2))-(X(4), Y(4))



Line (X(2), Y(2))-(X(6), Y(6))



Line (X(4), Y(4))-(X(8), Y(8))



Line (X(3), Y(3))-(X(7), Y(7))







DoEvents



End Sub







Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _



X As Single, Y As Single)



CurX = X



CurY = Y



If renk Then



Randomize Timer



Me.ForeColor = RGB(256 * Rnd, 256 * Rnd, 256 * Rnd)



End If



End Sub







Private Sub Timer1_Timer()



Dim i As Integer







Select Case CurX



Case Is > ScaleWidth / 2



Winkel = Winkel + Abs(CurX - ScaleWidth / 2) / 20



If Winkel = 360 Then Winkel = 0



Case Else



Winkel = Winkel - Abs(CurX - ScaleWidth / 2) / 20



If Winkel = 0 Then Winkel = 360



End Select







For i = 1 To 3 Step 2



Ecke(i, 3) = Radius * Cos((Winkel) * Pi / 180)



Ecke(i, 1) = Radius * Sin((Winkel) * Pi / 180)



Next i







For i = 2 To 4 Step 2



Ecke(i, 3) = Radius * Cos((Winkel + 2 * 45) * Pi / 180)



Ecke(i, 1) = Radius * Sin((Winkel + 2 * 45) * Pi / 180)



Next i







For i = 5 To 7 Step 2



Ecke(i, 3) = Radius * Cos((Winkel + 6 * 45) * Pi / 180)



Ecke(i, 1) = Radius * Sin((Winkel + 6 * 45) * Pi / 180)



Next i







For i = 6 To 8 Step 2



Ecke(i, 3) = Radius * Cos((Winkel + 4 * 45) * Pi / 180)



Ecke(i, 1) = Radius * Sin((Winkel + 4 * 45) * Pi / 180)



Next i







Call WuerfelDrehen



End Sub







Private Sub Combo1_Click()



Select Case Combo1.ListIndex



Case 0



renk = True



Case 1



renk = False



Me.ForeColor = vbRed



Case 2



renk = False



Me.ForeColor = vbGreen



Case 3



renk = False



Me.ForeColor = vbBlue



Case 4



renk = False



Me.ForeColor = vbYellow



Case 5



renk = False



Me.ForeColor = vbMagenta



Case 6



renk = False



Me.ForeColor = vbWhite



End Select



End Sub







Private Sub Combo2_Click()



Me.DrawWidth = Combo2.ListIndex + 1



End Sub



----------------------------------------------------------------

Form Üzerinde rastgele Sağa Sola Çarpan Top

'formunuzun üzerine bir tane Timer1 yerleştirin sonra aşagıdaki kodları yazın.







Option Explicit







Private Const MERGEPAINT = &HBB0226



Private Const SRCAND = &H8800C6



Private Const SRCCOPY = &HCC0020



Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long











Private Const BallR = 10 



Private Const BallD = 2 * BallR + 1 



Private CurX As Single 



Private CurY As Single



Private OldX As Single



Private OldY As Single



Private VelX As Single 



Private VelY As Single



Private Xmax As Single 



Private Ymax As Single







Private Sub DrawBall()







BitBlt picCanvas.hDC, _



OldX - BallR, OldY - BallR, BallD, BallD, _



picHidden.hDC, OldX - BallR, OldY - BallR, SRCCOPY



OldX = CurX



OldY = CurY











picCanvas.Circle (CurX, CurY), BallR











picCanvas.Refresh



End Sub











Private Sub Form_Load()







Width = (Width - ScaleWidth) + picCanvas.Width



Height = (Height - ScaleHeight) + picCanvas.Height







Xmax = picCanvas.ScaleWidth - BallR



Ymax = picCanvas.ScaleHeight - BallR







Randomize



CurX = Int((Xmax - BallR + 1) * Rnd + BallR)



CurY = Int((Ymax - BallR + 1) * Rnd + BallR)



OldX = CurX



OldY = CurY



VelX = Int((10 - 5 + 1) * Rnd + 5)



VelY = Int((10 - 5 + 1) * Rnd + 5)







DrawBall



End Sub











Private Sub Timer1_Timer()



CurX = CurX + VelX



If (CurX > Xmax) Then



CurX = Xmax



VelX = -VelX



' Beep



ElseIf (CurX < BallR) Then



CurX = BallR



VelX = -VelX



' Beep



End If







CurY = CurY + VelY



If (CurY > Ymax) Then



CurY = Ymax



VelY = -VelY



' Beep



ElseIf (CurY < BallR) Then



CurY = BallR



VelY = -VelY



' Beep



End If







DrawBall



End Sub



--------------------------------------------------

Kapat Butonunu Pasif Yapma

Form alanına yazılacak







Option Explicit



Private Const MF_BYPOSITION = &H400



Private Const MF_REMOVE = &H1000



Private Declare Function DrawMenuBar Lib "user32" _



(ByVal hwnd As Long) As Long



Private Declare Function GetMenuItemCount Lib "user32" _



(ByVal hMenu As Long) As Long



Private Declare Function GetSystemMenu Lib "user32" _



(ByVal hwnd As Long, _



ByVal bRevert As Long) As Long



Private Declare Function RemoveMenu Lib "user32" _



(ByVal hMenu As Long, _



ByVal nPosition As Long, _



ByVal wFlags As Long) As Long



Private Sub Form_Load()



Dim hMenu As Long



Dim menuItemCount As Long



hMenu = GetSystemMenu(Me.hwnd, 0)



If hMenu Then



menuItemCount = GetMenuItemCount(hMenu)



Call RemoveMenu(hMenu, menuItemCount - 1, MF_REMOVE Or MF_BYPOSITION)



Call RemoveMenu(hMenu, menuItemCount - 2, MF_REMOVE Or MF_BYPOSITION)



Call DrawMenuBar(Me.hwnd)



End If



End Sub












----------------------------------------------------------
ADODB Bağlantısına Örnek

Dim dbMyDB As Database



Dim rsMyRS As Recordset







Private Sub Command1_Click()







rsMyRS.AddNew



rsMyRS!Ad = Text1.Text



lstRecords.AddItem rsMyRS!Ad



lstRecords.ItemData(lstRecords.NewIndex) = rsMyRS!Kimlik



rsMyRS!Telefon = Text2.Text



rsMyRS.Update



End Sub







Private Sub Form_Load()







Set dbMyDB = OpenDatabase("dbdb.mdb")



Set rsMyRS = dbMyDB.OpenRecordset("Tablo1", dbOpenDynaset)







If Not rsMyRS.EOF Then rsMyRS.MoveFirst



Do While Not rsMyRS.EOF



lstRecords.AddItem rsMyRS!Ad



lstRecords.ItemData(lstRecords.NewIndex) = rsMyRS!Kimlik



rsMyRS.MoveNext



Loop







End Sub







Private Sub lstRecords_Click()



rsMyRS.FindFirst "Kimlik=" & Str(lstRecords.ItemData(lstRecords.ListIndex))



Telefon.Text = rsMyRS!Telefon



End Sub







Private Sub cmdUpdate_Click()



rsMyRS.Edit



rsMyRS!Phone = Telefon.Text



rsMyRS.Update



End Sub







Private Sub cmdDelete_Click()



rsMyRS.Delete



lstRecords.RemoveItem lstRecords.ListIndex



End Sub







Private Sub cmdNew_Click()



Label3.Visible = True



Label4.Visible = True



Text1.Visible = True



Text2.Visible = True



Text1.Text = ""



Text2.Text = ""



Text1.SetFocus



End Sub