'WWW.GENCLİKATESİTEAM.TK
Would you like to react to this message? Create an account in a few clicks or log in to continue.

'WWW.GENCLİKATESİTEAM.TK

SanaL Alemde Üstleri Kademeleri Görebilmek İçin Paylaşım Yapalım ..
 
AnasayfaAnasayfa AramaLatest imagesKayıt OlGiriş yap

 

 İşe Yarayan Kod Arşivi Burada

Aşağa gitmek 
Sayfaya git : Önceki  1, 2, 3  Sonraki
YazarMesaj
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:47 am

-------------------------------------------------
Hesap Makinesi
--------------------------------------------------------------------------------
Formumuza 3 tane textbox ve 1 tane combobox,3 tane label ve 2 tanede buton ekliyoruz.Label'ın birine 1.sayı diğerine 2.sayı ve üçüncüsünede işlem yazıyoruz.1. sayı yazan textbox1'in üst kısmına 2.sayı yazantextbox2'nin üst kısmına diğerini de combobox'ın üst kısmına yerleştiriyoruz. 1.Butona hesapla 2.butonada temizle yazıyoruz.
Public Class Form1
Dim sayi, sayi1 As Double

Public Class Form1
Dim sayi, sayi1 As Double
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
sayi = Val(TextBox1.Text)
sayi1 = Val(TextBox2.Text)
If ComboBox1.Text = "+" Then
TextBox3.Text = sayi + sayi1
End If
If ComboBox1.Text = "-" Then
TextBox3.Text = sayi - sayi1
End If
If ComboBox1.Text = "*" Then
TextBox3.Text = sayi * sayi1
End If
If ComboBox1.Text = "/" Then
TextBox3.Text = sayi / sayi1
End If
If ComboBox1.Text = "" Then
MessageBox.Show("Lütfen yapacağınız işlemi seçiniz", "UYARI")
End If
If TextBox1.Text = "" Then
MessageBox.Show("Lütfen birinci sayıyı giriniz...", "UYARI")
End If
If TextBox2.Text = "" Then
MessageBox.Show("Lütfen ikinci sayıyı giriniz...", "UYARI")
End If
End Sub

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
ComboBox1.Items.Add("+")
ComboBox1.Items.Add("-")
ComboBox1.Items.Add("*")
ComboBox1.Items.Add("/")
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
TextBox1.Clear()
TextBox2.Clear()
TextBox3.Clear()
ComboBox1.Text = ""
End Sub
End Class
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:47 am

-----------------------------------
MSN'e Hükmedelim
--------------------------------------------------------------------------------
MSN'de oturum açma, nick değiştirme, durum değiştirme, mesaj yazma

Bu kodlar ile messenger a hükmedebilirsiniz

[Nickimizi değiştirme / Durumumuzu Değiştirme / Listemizdeki Kullanıcıları ListBox a ekleme / Listemizdeki Kullanıcılara Mesaj Gönderme]

Messenger ı kullanabilmek için ilk olarak messenger apilerini projemize ekliyelim (Nasıl yapacağınız ilk makalemizde yazıyor...)

MSN deki Nickimizi Değiştirelim
Formumuza;
1 adet Label (name : lblNewNickName)
1 adet TextBox (name : txtNewNickName)
1 adet CommandButton (name: cmdChangeNickName)
ekliyelim ve aşağıdaki kodları yazalım :
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:48 am

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

Private MSN As New MsgrObject

Private Sub cmdChangeNickName_Click()
If MSN.LocalState = MSTATE_OFFLINE Then
MsgBox "You are not Signed In"
Else
MSN.Services.PrimaryService.FriendlyName = txtNewNickName.Text
txtNewNickName.Text = ""
End If
End Sub
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:48 am

---------------------------------------------
(Bu kodun detaylı açıklamasını ilk makeleden öğrenebilirsiniz...)

MSN deki Durumumuzu Değiştirelim
Formumuza;
7 adet OptionButton (Name özellikleri : optOnline, optBusy, optBeRightBack, optAway, optOnThePhone, optOutToLunch ve optAppearOffline olarak ayarlıyalım).
ve aşağıdaki kodları yazalım :
---------------------------------------------
Private MSN As New MsgrObject

Private Sub Form_Load()
Select Case MSN.LocalState
Case MSTATE_ONLINE
optOnline.Value = True
Case MSTATE_BUSY
optBusy.Value = True
Case MSTATE_BE_RIGHT_BACK
optBeRightBack.Value = True
Case MSTATE_AWAY
optAway.Value = True
Case MSTATE_ON_THE_PHONE
optOnThePhone.Value = True
Case MSTATE_OUT_TO_LUNCH
optOutToLunch.Value = True
Case MSTATE_INVISIBLE
optAppearOffline.Value = True
End Select
End Sub

Private Sub optAppearOffline_Click()
MSN.LocalState = MSTATE_INVISIBLE
End Sub

Private Sub optAway_Click()
MSN.LocalState = MSTATE_AWAY
End Sub

Private Sub optBeRightBack_Click()
MSN.LocalState = MSTATE_BE_RIGHT_BACK
End Sub

Private Sub optBusy_Click()
MSN.LocalState = MSTATE_BUSY
End Sub

Private Sub optOnline_Click()
MSN.LocalState = MSTATE_ONLINE
End Sub

Private Sub optOnThePhone_Click()
MSN.LocalState = MSTATE_ON_THE_PHONE
End Sub

Private Sub optOutToLunch_Click()
MSN.LocalState = MSTATE_OUT_TO_LUNCH
End Sub
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:48 am

---------------------------------------------
Açıklama : MSN.LocalState bizim msn imizin durumunun gösterildiği bi kod parçasıdır.Burda bulunan değerler ;

MSTATE_AWAY
MSTATE_BE_RIGHT_BACK
MSTATE_BUSY
MSTATE_IDLE
MSTATE_INVISIBLE
MSTATE_LOCAL_CONNECTING_TO_SERVER
MSTATE_LOCAL_DISCONNECTING_FROM_SERVER
MSTATE_LOCAL_FINDING_SERVER
MSTATE_LOCAL_SYNCHRONIZING_WITH_SERVER
MSTATE_OFFLINE
MSTATE_ON_THE_PHONE
MSTATE_ONLINE
MSTATE_OUT_TO_LUNCH
MSTATE_UNKNOWN'dır.

Listemizdeki Kullanıcıları Görelim (Kullanıcıları ListBox'a Ekleme)
Formumuza;
2 adet Label (name : lblOnlineContacts ve lblOfflineContacts)
2 adet ListBox (name : lstOnlineContacts ve lstOfflineContacts)
1 adet CommandButton (name: cmd*******List)
ekliyelim ve aşağıdaki kodları yazalım :
---------------------------------------------
Private MSN As New MsgrObject

Private Sub *******List()
lstOfflineContacts.Visible = False
lstOnlineContacts.Visible = False

Dim User As IMsgrUser

lstOnlineContacts.Clear

lstOfflineContacts.Clear

For Each User In MSN.List(MLIST_CONTACT)
If User.State = MSTATE_OFFLINE Then
lstOfflineContacts.AddItem (User.EmailAddress)
Else
lstOnlineContacts.AddItem (User.EmailAddress)
End If
Next

lstOfflineContacts.Visible = True
lstOnlineContacts.Visible = True
End Sub

Private Sub cmd*******List_Click()
If MSN.LocalState <> MSTATE_OFFLINE Then *******List
End Sub

Private Sub Form_Load()
cmd*******List_Click
End Sub
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:48 am

---------------------------------------------
Açıklama : Formumuz yüklenirken msn listemizdeki kullanıcıları listbox nesnesine eklicek...(Mail adresleri şeklinde.Siz isterseniz bunu kullanıcıların nickleri olarak değiştirebilirsiniz...)

Listemdeki Kullanıcılar!Ben Burdayım! (Mesaj gönderme)
Formumuza;
1 adet Label (name : lblOnlineContacts)
1 adet ListBox (name : lstOnlineContacts)
2 adet CommandButton (name: cmd*******List ve cmdSendIM)
ekliyelim ve aşağıdaki kodları yazalım :
---------------------------------------------
Private MSN As New MsgrObject

Private Sub *******List()
lstOnlineContacts.Visible = False

Dim User As IMsgrUser

lstOnlineContacts.Clear

For Each User In MSN.List(MLIST_CONTACT)
If User.State <> MSTATE_OFFLINE Then lstOnlineContacts.AddItem (User.EmailAddress)
Next

lstOnlineContacts.Visible = True
End Sub

Private Sub cmd*******List_Click()
If MSN.LocalState <> MSTATE_OFFLINE Then *******List
End Sub

Private Sub cmdSendIM_Click()
Dim User As IMsgrUser
Dim bstrMsgHeader As String
Dim bstrMsgText As String

If MSN.LocalState = MSTATE_OFFLINE Then
MsgBox "Oturumunuz Açık Değil!"
Else
If MSN.LocalState = MSTATE_INVISIBLE Then
MsgBox "Durumunuzu Değiştirmeniz Gerekiyor!"
Else
Set User = MSN.CreateUser(lstOnlineContacts.Text, MSN.Services.PrimaryService)
bstrMsgText = InputBox("Lütfen Mesajınızı Giriniz : ?", "Mesaj Girişi", "Merhaba ", Me.Left, Me.Top)
User.SendText bstrMsgHeader, bstrMsgText, MMSGTYPE_NO_RESULT
MsgBox "Mesajınız " & User.EmailAddress & " 'a " & bstrMsgText & " olarak iletildi."
End If
End If
End Sub

Private Sub Form_Load()
cmd*******List_Click
End Sub
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:49 am

Açıklama : lstOnlineContacts (Listbox) da seçilen olan kişiye mesajımız gönderilecektir...

----------------------------------------------------------
Alan Hesaplama
--------------------------------------------------------------------------------
Üçgen.kare,dikdörtgen ve dairenin alanını hesaplayan program.Karenin ve dairenin tek alanı yazılacağından textbox2 false görünecektir.Öncelikle combobox'ın name özelliğini "c" yapıyoruz ve programın kodlarını yazmaya başlıyoruz.

Dim x As New Control
Dim d As Double

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
c.Text = "Lütfen seçiniz..."
c.Items.Add("Kare")
c.Items.Add("Dikdörtgen")
c.Items.Add("Üçgen")
c.Items.Add("Daire")
End Sub

Private Function hesapla(ByVal t1 As Double, ByVal t2 As Double) As Double
If c.SelectedItem = "Kare" Then
d = t1 * t1
End If
If c.SelectedItem = "Üçgen" Then
d = (t1 * t2) / 2
End If
If c.SelectedItem = "Daire" Then
d = 3.14 * t1 * t1
End If
If c.SelectedItem = "Dikdörtgen" Then
d = t1 * t2
End If
Return d
End Function

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Label2.Text = hesapla(Val(TextBox1.Text), Val(TextBox2.Text))
End Sub

Private Sub c_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles c.SelectedIndexChanged
If c.SelectedItem = "Üçgen" Then
TextBox2.Enabled = True
End If
If c.SelectedItem = "Kare" Then
TextBox2.Enabled = False
End If
If c.SelectedItem = "Dikdörtgen" Then
TextBox2.Enabled = True
End If
If c.SelectedItem = "Daire" Then
TextBox2.Enabled = False
End If
End Sub
Private Sub temizle()
For Each x In Controls
If TypeOf x Is TextBox Then
x.Text = ""
End If
Next x
End Sub

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
temizle()
End Sub

Private Sub CIKIS()
Me.Close()
End Sub

Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
CIKIS()
End Sub
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:49 am

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

Yazı Rengi Değiştirme
--------------------------------------------------------------------------------
Eklenecek Nesneler;
CommonDialog1, Text1 (yazı buraya yazılacak)
(Yazı yazıldıktan sonra text kutusuna tek tıklamada renk paleti geliyor ve istediğimiz rengi seçip yazı rengini değiştirebiliyoruz...)
Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
CommonDialog1.Flags = &H2
CommonDialog1.Action = 3
If Button = 1 Then 'Sol Tus Basılı İse
Text1.ForeColor = CommonDialog1.Color
Else
Text1.BackColor = CommonDialog1.Color
End If
End Sub
--------------------------------------------------------------
Kayan Saniye
--------------------------------------------------------------------------------
Saniye ilerledikçe saniyeyi gösteren Label nesnesi kayıyor..
Eklenecek Nesneler; Label1, Timer1
(Timer1'in Interval özelliğini 1000 yapıyoruz)
Private Sub Form_Load()
Form1.Caption = Time
Label1.Caption = Second(Time)
End Sub

Private Sub Timer1_Timer()
Form1.Caption = Time
Label1.Caption = Second(Time)
show:
Label1.Top = Label1.Top + 50
Label1.Left = Label1.Left + 50
Cls
End Sub
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:49 am

--------------------------------------------------------
İsim Yazdırma
--------------------------------------------------------------------------------
10 Sayısını değiştirip istediğiniz kadar yapabilirsiniz.
Public Class Form1
Dim i as integer
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
For i =1 to 10
Msgbox(“blsmfade=Fatih”)
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:49 am

-----------------------------------
Hesap Makinesi
--------------------------------------------------------------------------------
Formumuza 3 tane textbox ve 1 tane combobox,3 tane label ve 2 tanede buton ekliyoruz.Label'ın birine 1.sayı diğerine 2.sayı ve üçüncüsünede işlem yazıyoruz.1. sayı yazan textbox1'in üst kısmına 2.sayı yazantextbox2'nin üst kısmına diğerini de combobox'ın üst kısmına yerleştiriyoruz. 1.Butona hesapla 2.butonada temizle yazıyoruz.
Public Class Form1
Dim sayi, sayi1 As Double

Public Class Form1
Dim sayi, sayi1 As Double
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
sayi = Val(TextBox1.Text)
sayi1 = Val(TextBox2.Text)
If ComboBox1.Text = "+" Then
TextBox3.Text = sayi + sayi1
End If
If ComboBox1.Text = "-" Then
TextBox3.Text = sayi - sayi1
End If
If ComboBox1.Text = "*" Then
TextBox3.Text = sayi * sayi1
End If
If ComboBox1.Text = "/" Then
TextBox3.Text = sayi / sayi1
End If
If ComboBox1.Text = "" Then
MessageBox.Show("Lütfen yapacağınız işlemi seçiniz", "UYARI")
End If
If TextBox1.Text = "" Then
MessageBox.Show("Lütfen birinci sayıyı giriniz...", "UYARI")
End If
If TextBox2.Text = "" Then
MessageBox.Show("Lütfen ikinci sayıyı giriniz...", "UYARI")
End If
End Sub

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
ComboBox1.Items.Add("+")
ComboBox1.Items.Add("-")
ComboBox1.Items.Add("*")
ComboBox1.Items.Add("/")
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
TextBox1.Clear()
TextBox2.Clear()
TextBox3.Clear()
ComboBox1.Text = ""
End Sub
End Class
-------------------------------------------------
Hesap Makinesi
--------------------------------------------------------------------------------
Formumuza 3 tane textbox ve 1 tane combobox,3 tane label ve 2 tanede buton ekliyoruz.Label'ın birine 1.sayı diğerine 2.sayı ve üçüncüsünede işlem yazıyoruz.1. sayı yazan textbox1'in üst kısmına 2.sayı yazantextbox2'nin üst kısmına diğerini de combobox'ın üst kısmına yerleştiriyoruz. 1.Butona hesapla 2.butonada temizle yazıyoruz.
Public Class Form1
Dim sayi, sayi1 As Double

Public Class Form1
Dim sayi, sayi1 As Double
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
sayi = Val(TextBox1.Text)
sayi1 = Val(TextBox2.Text)
If ComboBox1.Text = "+" Then
TextBox3.Text = sayi + sayi1
End If
If ComboBox1.Text = "-" Then
TextBox3.Text = sayi - sayi1
End If
If ComboBox1.Text = "*" Then
TextBox3.Text = sayi * sayi1
End If
If ComboBox1.Text = "/" Then
TextBox3.Text = sayi / sayi1
End If
If ComboBox1.Text = "" Then
MessageBox.Show("Lütfen yapacağınız işlemi seçiniz", "UYARI")
End If
If TextBox1.Text = "" Then
MessageBox.Show("Lütfen birinci sayıyı giriniz...", "UYARI")
End If
If TextBox2.Text = "" Then
MessageBox.Show("Lütfen ikinci sayıyı giriniz...", "UYARI")
End If
End Sub

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
ComboBox1.Items.Add("+")
ComboBox1.Items.Add("-")
ComboBox1.Items.Add("*")
ComboBox1.Items.Add("/")
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
TextBox1.Clear()
TextBox2.Clear()
TextBox3.Clear()
ComboBox1.Text = ""
End Sub
End Class
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:49 am

-----------------------------------
MSN'e Hükmedelim
--------------------------------------------------------------------------------
MSN'de oturum açma, nick değiştirme, durum değiştirme, mesaj yazma

Bu kodlar ile messenger a hükmedebilirsiniz

[Nickimizi değiştirme / Durumumuzu Değiştirme / Listemizdeki Kullanıcıları ListBox a ekleme / Listemizdeki Kullanıcılara Mesaj Gönderme]

Messenger ı kullanabilmek için ilk olarak messenger apilerini projemize ekliyelim (Nasıl yapacağınız ilk makalemizde yazıyor...)

MSN deki Nickimizi Değiştirelim
Formumuza;
1 adet Label (name : lblNewNickName)
1 adet TextBox (name : txtNewNickName)
1 adet CommandButton (name: cmdChangeNickName)
ekliyelim ve aşağıdaki kodları yazalım :
---------------------------------------------

Private MSN As New MsgrObject

Private Sub cmdChangeNickName_Click()
If MSN.LocalState = MSTATE_OFFLINE Then
MsgBox "You are not Signed In"
Else
MSN.Services.PrimaryService.FriendlyName = txtNewNickName.Text
txtNewNickName.Text = ""
End If
End Sub
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:50 am

---------------------------------------------
(Bu kodun detaylı açıklamasını ilk makeleden öğrenebilirsiniz...)

MSN deki Durumumuzu Değiştirelim
Formumuza;
7 adet OptionButton (Name özellikleri : optOnline, optBusy, optBeRightBack, optAway, optOnThePhone, optOutToLunch ve optAppearOffline olarak ayarlıyalım).
ve aşağıdaki kodları yazalım :
---------------------------------------------
Private MSN As New MsgrObject

Private Sub Form_Load()
Select Case MSN.LocalState
Case MSTATE_ONLINE
optOnline.Value = True
Case MSTATE_BUSY
optBusy.Value = True
Case MSTATE_BE_RIGHT_BACK
optBeRightBack.Value = True
Case MSTATE_AWAY
optAway.Value = True
Case MSTATE_ON_THE_PHONE
optOnThePhone.Value = True
Case MSTATE_OUT_TO_LUNCH
optOutToLunch.Value = True
Case MSTATE_INVISIBLE
optAppearOffline.Value = True
End Select
End Sub

Private Sub optAppearOffline_Click()
MSN.LocalState = MSTATE_INVISIBLE
End Sub

Private Sub optAway_Click()
MSN.LocalState = MSTATE_AWAY
End Sub

Private Sub optBeRightBack_Click()
MSN.LocalState = MSTATE_BE_RIGHT_BACK
End Sub

Private Sub optBusy_Click()
MSN.LocalState = MSTATE_BUSY
End Sub

Private Sub optOnline_Click()
MSN.LocalState = MSTATE_ONLINE
End Sub

Private Sub optOnThePhone_Click()
MSN.LocalState = MSTATE_ON_THE_PHONE
End Sub

Private Sub optOutToLunch_Click()
MSN.LocalState = MSTATE_OUT_TO_LUNCH
End Sub
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:50 am

---------------------------------------------
Açıklama : MSN.LocalState bizim msn imizin durumunun gösterildiği bi kod parçasıdır.Burda bulunan değerler ;

MSTATE_AWAY
MSTATE_BE_RIGHT_BACK
MSTATE_BUSY
MSTATE_IDLE
MSTATE_INVISIBLE
MSTATE_LOCAL_CONNECTING_TO_SERVER
MSTATE_LOCAL_DISCONNECTING_FROM_SERVER
MSTATE_LOCAL_FINDING_SERVER
MSTATE_LOCAL_SYNCHRONIZING_WITH_SERVER
MSTATE_OFFLINE
MSTATE_ON_THE_PHONE
MSTATE_ONLINE
MSTATE_OUT_TO_LUNCH
MSTATE_UNKNOWN'dır.

Listemizdeki Kullanıcıları Görelim (Kullanıcıları ListBox'a Ekleme)
Formumuza;
2 adet Label (name : lblOnlineContacts ve lblOfflineContacts)
2 adet ListBox (name : lstOnlineContacts ve lstOfflineContacts)
1 adet CommandButton (name: cmd*******List)
ekliyelim ve aşağıdaki kodları yazalım :
---------------------------------------------
Private MSN As New MsgrObject

Private Sub *******List()
lstOfflineContacts.Visible = False
lstOnlineContacts.Visible = False

Dim User As IMsgrUser

lstOnlineContacts.Clear

lstOfflineContacts.Clear

For Each User In MSN.List(MLIST_CONTACT)
If User.State = MSTATE_OFFLINE Then
lstOfflineContacts.AddItem (User.EmailAddress)
Else
lstOnlineContacts.AddItem (User.EmailAddress)
End If
Next

lstOfflineContacts.Visible = True
lstOnlineContacts.Visible = True
End Sub

Private Sub cmd*******List_Click()
If MSN.LocalState <> MSTATE_OFFLINE Then *******List
End Sub

Private Sub Form_Load()
cmd*******List_Click
End Sub
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:50 am

---------------------------------------------
Açıklama : Formumuz yüklenirken msn listemizdeki kullanıcıları listbox nesnesine eklicek...(Mail adresleri şeklinde.Siz isterseniz bunu kullanıcıların nickleri olarak değiştirebilirsiniz...)

Listemdeki Kullanıcılar!Ben Burdayım! (Mesaj gönderme)
Formumuza;
1 adet Label (name : lblOnlineContacts)
1 adet ListBox (name : lstOnlineContacts)
2 adet CommandButton (name: cmd*******List ve cmdSendIM)
ekliyelim ve aşağıdaki kodları yazalım :
---------------------------------------------
Private MSN As New MsgrObject

Private Sub *******List()
lstOnlineContacts.Visible = False

Dim User As IMsgrUser

lstOnlineContacts.Clear

For Each User In MSN.List(MLIST_CONTACT)
If User.State <> MSTATE_OFFLINE Then lstOnlineContacts.AddItem (User.EmailAddress)
Next

lstOnlineContacts.Visible = True
End Sub

Private Sub cmd*******List_Click()
If MSN.LocalState <> MSTATE_OFFLINE Then *******List
End Sub

Private Sub cmdSendIM_Click()
Dim User As IMsgrUser
Dim bstrMsgHeader As String
Dim bstrMsgText As String

If MSN.LocalState = MSTATE_OFFLINE Then
MsgBox "Oturumunuz Açık Değil!"
Else
If MSN.LocalState = MSTATE_INVISIBLE Then
MsgBox "Durumunuzu Değiştirmeniz Gerekiyor!"
Else
Set User = MSN.CreateUser(lstOnlineContacts.Text, MSN.Services.PrimaryService)
bstrMsgText = InputBox("Lütfen Mesajınızı Giriniz : ?", "Mesaj Girişi", "Merhaba ", Me.Left, Me.Top)
User.SendText bstrMsgHeader, bstrMsgText, MMSGTYPE_NO_RESULT
MsgBox "Mesajınız " & User.EmailAddress & " 'a " & bstrMsgText & " olarak iletildi."
End If
End If
End Sub

Private Sub Form_Load()
cmd*******List_Click
End Sub

Açıklama : lstOnlineContacts (Listbox) da seçilen olan kişiye mesajımız gönderilecektir...
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:51 am

----------------------------------------------------------
Alan Hesaplama
--------------------------------------------------------------------------------
Üçgen.kare,dikdörtgen ve dairenin alanını hesaplayan program.Karenin ve dairenin tek alanı yazılacağından textbox2 false görünecektir.Öncelikle combobox'ın name özelliğini "c" yapıyoruz ve programın kodlarını yazmaya başlıyoruz.

Dim x As New Control
Dim d As Double

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
c.Text = "Lütfen seçiniz..."
c.Items.Add("Kare")
c.Items.Add("Dikdörtgen")
c.Items.Add("Üçgen")
c.Items.Add("Daire")
End Sub

Private Function hesapla(ByVal t1 As Double, ByVal t2 As Double) As Double
If c.SelectedItem = "Kare" Then
d = t1 * t1
End If
If c.SelectedItem = "Üçgen" Then
d = (t1 * t2) / 2
End If
If c.SelectedItem = "Daire" Then
d = 3.14 * t1 * t1
End If
If c.SelectedItem = "Dikdörtgen" Then
d = t1 * t2
End If
Return d
End Function

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Label2.Text = hesapla(Val(TextBox1.Text), Val(TextBox2.Text))
End Sub

Private Sub c_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles c.SelectedIndexChanged
If c.SelectedItem = "Üçgen" Then
TextBox2.Enabled = True
End If
If c.SelectedItem = "Kare" Then
TextBox2.Enabled = False
End If
If c.SelectedItem = "Dikdörtgen" Then
TextBox2.Enabled = True
End If
If c.SelectedItem = "Daire" Then
TextBox2.Enabled = False
End If
End Sub
Private Sub temizle()
For Each x In Controls
If TypeOf x Is TextBox Then
x.Text = ""
End If
Next x
End Sub
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:51 am

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
temizle()
End Sub

Private Sub CIKIS()
Me.Close()
End Sub

Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
CIKIS()
End Sub
----------------------------------------------------------

Sürücü Bilgi Formu
--------------------------------------------------------------------------------
C ve benzeri bilgisayar sürücülerinde ki boş ve kullanılan alanları gösterir.Yeni sürücü eklendiği zaman program kapatılıp açıldığında o sürücüyüde algılar.

Imports System.IO

Public Class Form1
Private surucu_bilgi As DirectoryInfo
Private toplam_alan As Long
Private bos_alan As Long
Private kullanilan_alan As Long
Private tara As Single
Private alan_bilgi As Boolean


Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.surucu_durum.Text = ""

Dim drives As System.IO.DriveInfo() = System.IO.DriveInfo.GetDrives
suruculer.Items.AddRange(drives)
End Sub

Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
Dim rect As Rectangle = New Rectangle(370, 20, 200, 200)
Dim rect2 As Rectangle = New Rectangle(310, 10, 320, 320)
Dim bos_alan_2 As Rectangle = New Rectangle(320, 275, 20, 20)
Dim kullanılan_alan_2 As Rectangle = New Rectangle(320, 300, 20, 20)

e.Graphics.DrawRectangle(Pens.Red, rect2)

If alan_bilgi = True Then

'pastayı çiz
e.Graphics.FillPie(Brushes.Yellow, rect, 0, tara)
e.Graphics.FillPie(Brushes.Red, rect, tara, 360 - tara)

'kareyi çiz
e.Graphics.FillRectangle(Brushes.Red, bos_alan_2)
e.Graphics.FillRectangle(Brushes.Yellow, kullanılan_alan_2)


'yazıları ekle
e.Graphics.DrawString("kapasite;", New Font("arial", 10, FontStyle.Regular), Brushes.Red, New PointF(335, 230))
e.Graphics.DrawString("kullanılan alan:", New Font("arial", 10, FontStyle.Regular), Brushes.Red, New PointF(350, 275))
e.Graphics.DrawString("bos alan:", New Font("arial", 10, FontStyle.Regular), Brushes.Red, New PointF(350, 300))
e.Graphics.DrawString(toplam_alan.ToString("N3") + " " + "byte", New Font("arial", 10, FontStyle.Regular), Brushes.Red, New PointF(450, 230))
e.Graphics.DrawString(kullanilan_alan.ToString("N0 ") + " " + "byte", New Font("arial", 10, FontStyle.Regular), Brushes.Red, New PointF(450, 275))
e.Graphics.DrawString(bos_alan.ToString("N0") + " " + "byte", New Font("arial", 10, FontStyle.Regular), Brushes.Red, New PointF(450, 300))
End If
End Sub
Private Sub suruculer_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles suruculer.SelectedIndexChanged

'seçilen sürücüye göre yeniden yükle
surucu_yukle(suruculer.Items(suruculer.SelectedInd ex).ToString)

'grafiği yeniden çiz
Me.Invalidate()

End Sub

Private Sub surucu_yukle(ByVal surucu_harf As String)
Dim surucu_bilgisi As System.IO.DriveInfo

'geçerli sürücüleri doğrula
Try
surucu_bilgisi = New System.IO.DriveInfo(surucu_harf)

Catch ex As Exception
MessageBox.Show("Sürücü Harfi Boş Olamaz./a/z" + ex.Message, "Sürücü Harfi Hatalı", MessageBoxButtons.OK, MessageBoxIcon.Error)
Return
Catch ex2 As ArgumentException
MessageBox.Show("Sürücü Harfi a-z arasında Olmalı/a/z" + ex2.Message, "Sürücü Harfi Hatası", MessageBoxButtons.OK, MessageBoxIcon.Error)
Return


End Try
Me.surucuismitext.Text = surucu_bilgisi.Name
Try
If surucu_bilgisi.VolumeLabel.Length > 0 Then
Me.surucutiptext.Text = surucu_bilgisi.VolumeLabel
Else
Me.surucutiptext.Text = "Etiket Yok"
End If
Me.dosyasistemtext.Text = surucu_bilgisi.DriveFormat
toplam_alan = surucu_bilgisi.TotalSize
bos_alan = surucu_bilgisi.TotalFreeSpace
kullanilan_alan = toplam_alan - bos_alan
tara = 360.0F * bos_alan / toplam_alan
alan_bilgi = True


Catch
Me.surucuetikettext.Text = "Erişilemiyor"
Me.dosyasistemtext.Text = "Erişilemiyor"
alan_bilgi = False

End Try

Me.surucutiptext.Text = surucu_bilgisi.DriveType.ToString

Me.kokdizintext.Text = surucu_bilgisi.RootDirectory.ToString
surucu_bilgi = surucu_bilgisi.RootDirectory


If surucu_bilgisi.IsReady = True Then

Me.surucu_durum.Text = "sürücü hazır"
Else

Me.surucu_durum.Text = "sürücü hazır değil"


End If


End Sub

Private Function ConvertBytesToMB(ByVal bytes As Int64) As String
Dim mb As Long = bytes / 1048576
Return mb.tostring("N")

End Function


Private Function ConvertBytesToGB(ByVal bytes As Int64) As String
Dim gb As Long = bytes / 1073741824
Return gb.ToString("N")



End Function
End Class
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:51 am

-------------------------------------
Sürücü Bilgi Formu
--------------------------------------------------------------------------------
C ve benzeri bilgisayar sürücülerinde ki boş ve kullanılan alanları gösterir.Yeni sürücü eklendiği zaman program kapatılıp açıldığında o sürücüyüde algılar.

Imports System.IO

Public Class Form1
Private surucu_bilgi As DirectoryInfo
Private toplam_alan As Long
Private bos_alan As Long
Private kullanilan_alan As Long
Private tara As Single
Private alan_bilgi As Boolean


Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.surucu_durum.Text = ""

Dim drives As System.IO.DriveInfo() = System.IO.DriveInfo.GetDrives
suruculer.Items.AddRange(drives)
End Sub

Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
Dim rect As Rectangle = New Rectangle(370, 20, 200, 200)
Dim rect2 As Rectangle = New Rectangle(310, 10, 320, 320)
Dim bos_alan_2 As Rectangle = New Rectangle(320, 275, 20, 20)
Dim kullanılan_alan_2 As Rectangle = New Rectangle(320, 300, 20, 20)

e.Graphics.DrawRectangle(Pens.Red, rect2)

If alan_bilgi = True Then

'pastayı çiz
e.Graphics.FillPie(Brushes.Yellow, rect, 0, tara)
e.Graphics.FillPie(Brushes.Red, rect, tara, 360 - tara)

'kareyi çiz
e.Graphics.FillRectangle(Brushes.Red, bos_alan_2)
e.Graphics.FillRectangle(Brushes.Yellow, kullanılan_alan_2)


'yazıları ekle
e.Graphics.DrawString("kapasite;", New Font("arial", 10, FontStyle.Regular), Brushes.Red, New PointF(335, 230))
e.Graphics.DrawString("kullanılan alan:", New Font("arial", 10, FontStyle.Regular), Brushes.Red, New PointF(350, 275))
e.Graphics.DrawString("bos alan:", New Font("arial", 10, FontStyle.Regular), Brushes.Red, New PointF(350, 300))
e.Graphics.DrawString(toplam_alan.ToString("N3") + " " + "byte", New Font("arial", 10, FontStyle.Regular), Brushes.Red, New PointF(450, 230))
e.Graphics.DrawString(kullanilan_alan.ToString("N0 ") + " " + "byte", New Font("arial", 10, FontStyle.Regular), Brushes.Red, New PointF(450, 275))
e.Graphics.DrawString(bos_alan.ToString("N0") + " " + "byte", New Font("arial", 10, FontStyle.Regular), Brushes.Red, New PointF(450, 300))
End If
End Sub
Private Sub suruculer_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles suruculer.SelectedIndexChanged

'seçilen sürücüye göre yeniden yükle
surucu_yukle(suruculer.Items(suruculer.SelectedInd ex).ToString)

'grafiği yeniden çiz
Me.Invalidate()

End Sub

Private Sub surucu_yukle(ByVal surucu_harf As String)
Dim surucu_bilgisi As System.IO.DriveInfo

'geçerli sürücüleri doğrula
Try
surucu_bilgisi = New System.IO.DriveInfo(surucu_harf)

Catch ex As Exception
MessageBox.Show("Sürücü Harfi Boş Olamaz./a/z" + ex.Message, "Sürücü Harfi Hatalı", MessageBoxButtons.OK, MessageBoxIcon.Error)
Return
Catch ex2 As ArgumentException
MessageBox.Show("Sürücü Harfi a-z arasında Olmalı/a/z" + ex2.Message, "Sürücü Harfi Hatası", MessageBoxButtons.OK, MessageBoxIcon.Error)
Return


End Try
Me.surucuismitext.Text = surucu_bilgisi.Name
Try
If surucu_bilgisi.VolumeLabel.Length > 0 Then
Me.surucutiptext.Text = surucu_bilgisi.VolumeLabel
Else
Me.surucutiptext.Text = "Etiket Yok"
End If
Me.dosyasistemtext.Text = surucu_bilgisi.DriveFormat
toplam_alan = surucu_bilgisi.TotalSize
bos_alan = surucu_bilgisi.TotalFreeSpace
kullanilan_alan = toplam_alan - bos_alan
tara = 360.0F * bos_alan / toplam_alan
alan_bilgi = True


Catch
Me.surucuetikettext.Text = "Erişilemiyor"
Me.dosyasistemtext.Text = "Erişilemiyor"
alan_bilgi = False

End Try

Me.surucutiptext.Text = surucu_bilgisi.DriveType.ToString

Me.kokdizintext.Text = surucu_bilgisi.RootDirectory.ToString
surucu_bilgi = surucu_bilgisi.RootDirectory


If surucu_bilgisi.IsReady = True Then

Me.surucu_durum.Text = "sürücü hazır"
Else

Me.surucu_durum.Text = "sürücü hazır değil"


End If


End Sub

Private Function ConvertBytesToMB(ByVal bytes As Int64) As String
Dim mb As Long = bytes / 1048576
Return mb.tostring("N")

End Function


Private Function ConvertBytesToGB(ByVal bytes As Int64) As String
Dim gb As Long = bytes / 1073741824
Return gb.ToString("N")



End Function
End Class
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:52 am

-----------------------------------------
Öğrenci Notu Hesaplayan Program
--------------------------------------------------------------------------------
4 adet textbox ve 3 adet command açın. Aşağıdaki kodu yapıştırın. 1 ve sayı 2 olan yer dönem notu olarakta değerlendirilir.


Private Sub Command1_Click()
sayi = Val(Text1.Text) + Val(Text2.Text)
Text3.Text = sayi / 2
End Sub

Private Sub Command2_Click()
Select Case Text3.Text
Case Is < 44
Text4.Text = "Kaldiniz/YOU STAYED "
Case Else
Text4.Text = "Geçtiniz/YOU PASSED "
End Select
End Sub

Private Sub Command3_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
End Sub
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:52 am

---------------------------------------
4 İşlem Yaptırma
--------------------------------------------------------------------------------
Visual Basic'de 4 işlem yaptıran küçük bir hesap makinesi. Forma 3 textbox ve 5 button ekleyip kodları yazın.


Public Class Form1

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim x As Integer
Dim y As Integer
x = TextBox1.Text
y = TextBox2.Text
TextBox3.Text = x + y

End Sub

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

End Sub

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Dim x As Integer
Dim y As Integer
x = TextBox1.Text
y = TextBox2.Text
TextBox3.Text = x - y

End Sub

Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
Dim x As Integer
Dim y As Integer
x = TextBox1.Text
y = TextBox2.Text
TextBox3.Text = x * y
End Sub

Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
Dim x As Integer
Dim y As Integer
x = TextBox1.Text
y = TextBox2.Text
TextBox3.Text = x / y
End Sub

Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""


End Sub
End Class
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:52 am

------------------------------------------
Başlat Yazısını Değiştiren Program
--------------------------------------------------------------------------------
Forma 1 adet command button 1 adet textbox ekleyin. textboxa başlat yazısının yerinde ne yazmasını istiyorsanız onu yazın. Ardından command buttona tıklayın. Pc kapatılıp açıldığında yazı eski haline döner. Yani tekrar başlat yazar. kod kısmına da aşağıdaki kodu olduğu gibi yapıştırın.

Private Const WM_SETTEXT = &HC
Private Const WM_GETTEXT = &HD
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessageSTRING Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long

Public Sub SetStartCaption(str As String)
Dim StartBar As Long
Dim StartBarText As Long
Dim sCaption As String

StartBar = FindWindow("Shell_TrayWnd", vbNullString)
StartBarText = FindWindowEx(StartBar, 0&, "button", vbNullString)
sCaption = Left(str, 6)
SendMessageSTRING StartBarText, WM_SETTEXT, 256, sCaption


Exit Sub
End Sub
Private Sub Command1_Click()
SetStartCaption Text1.Text
End Sub
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:52 am

---------------------------------------------------------------
PC Yeniden Başlatma
--------------------------------------------------------------------------------
PC Yeniden Başlatma

Önce Formunuza bir tane command1 butonu ekleyin. Aşağıya yazmış olduğum kodu yazın.

Private Sub Command1_click()
Shell("C:\Windows\Rundll.exe user.exe,exitwindow***ec")
unload me
End
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:52 am

-----------------------------------------------------
Internet TV ve Radyo Programı
--------------------------------------------------------------------------------
Verdigim IP'ler ile tv ve radyo kanallarını izleyebiliesiniz

İlk önce ctrl+t basıp çıkan components'den windows media player bulup ve şeçtikten sonra tamama basın.böylece
windows medıa player toolbox kutusunu yüklenmiştir.
windows medıa player şeçip formda bir tane yerleştiriniz.
sonra 1 tanede buton ekleyin.butona çift tıklayın ve içine aşagıdaki kadu kopyalayın

Windows Medıa Player 1.URL=("http://212.175..166.3/TV1")

şimdi butona basınca artık trt1'i izleyebilirsiniz

aşagıda çeçitli kanaların ve rodya kanallarının ıpleri mevcuttur.

Tv Kanalları ;

TRT 1 = http://212.175.166.3/TV1
TRT 2 = http://212.175.166.3/TV2
TRT 2 = http://212.175.166.3/TV4
TRT INT = http://212.175.166.3/TRTINT
Show Tv = http://195.175.9.14/TV-ShowTv
ATV = http://213.194.117.8/atv
TJK Tv = http://pointers.audiovideoweb.com/as...inlive7102.asx
SKY Türk = http://213.74.22.66/skyturk.asx
Kanal 1 = http://213.194.117.6/k1
NTV = http://144.122.56.15/odtutv
STV = http://canli.samanyolu.tv/stv
Çay Tv = http://66.90.118.66/caytv
Doğu Tv = http://66.90.118.66/dogutv
Karedeniz Tv = http://www.yayinnet.com/asx_Files/karadeniztv.asx
Gelişim Tv = http://81.214.70.75:8090
Kaçkar Tv = http://66.90.118.66/kackartv
Karesi Tv = http://67.19.43.164/karesitv
Haber 24 = http://www.haber24.com/temp/manset.asx
Dost Tv = Dost TV (Biz Dostuz)
Genç Tv = http://66.90.118.66/genctv
Kanal 23 = http://66.90.118.66/kanal23
Hilal Tv = http://66.90.118.66/hilaltv
BRT = http://brt.emu.edu.tr/bayraktv
Türkmen Tv = http://66.90.101.25/turkmentv
Alfa Tv = http://www.yayinnet.com/asx_Files/SamsunAlfaTV.asx
MMC Tv = http://67.15.179.32:81/mmctv
Azeri Tv = http://62.212.234.212/aztv
Elif Tv = http://66.90.118.66/eliftv
ODTÜTV = http://bote.ceit.metu.edu.tr
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:52 am

Radyolar ;

Best FM = http://www.showtvnet.com/asx/turppas...duct=rd-bestfm
Power FM = Test Yayını
Number One FM = http://www.showtvnet.com/asx/turppas...rd-numberonefm
Understation = http://216.40.226.222:804
Micbeatz FM = http://72.232.33.253:1978
Klas FM = http://www.showtvnet.com/asx/turppas...t=rd-radyoklas
Nostalji FM = http://84.16.235.95/rn
ODTÜ FM = Radyo-ODTU,103.1 (CEIT419-ONLINE)
Maydanoz FM = http://www.showtvnet.com/asx/turppas...yomydonoseturk
Samanyolu FM = http://www.radyosamanyolu.de/RadyoSa...oSamanyolu.asx
Vakit FM = RADYO VAKİT
Şafak FM = http://www.showtvnet.com/asx/turppas...uct=rd-safakfm
Ülkü FM = http://www.showtvnet.com/asx/turppas...duct=rd-ulkufm
Aşk FM = http://70.85.138.142/askfm
Yazgülü FM = http://yayin.selcuklu.net:7373
Radyo 5 = http://84.16.235.95/r5
NTV Radyo = http://www.showtvnet.com/asx/turppas...duct=rd-bestfm
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:53 am

---------------------------------------------------------------------------
MSN Programında Oturum Açma
--------------------------------------------------------------------------------
Shell'le program açma sleep program bekletme sendkeysle tuş gönderme

formunuza timer1 , combo1, 2 text ve bir de buton koymanız yeterli

text1 kullanıcı adı text2 şifre girilecek


Shell("C:\Program Files\MSN Messenger\msnmsgr.exe", 3) satırını MSN'niniz nerede kuruluysa orayı gösterecek şekilde değiştirmelisiniz!

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

Private Sub Command1_Click()

a = Shell("C:\Program Files\MSN Messenger\msnmsgr.exe", 3)
Sleep (10000)
SendKeys Text1, True
Sleep (2000)
SendKeys "{TAB}", True
Sleep (1500)
SendKeys Text2, True
Sleep (200)
Select Case Combo1.Text
Case "ÇEVRİMİÇİ"
Sleep (800)
SendKeys "{ENTER}", True
Case "MEŞGUL"
Sleep (400)
SendKeys "{TAB}", True
Sleep (400)
SendKeys "{ENTER}", True
Sleep (400)
SendKeys "{DOWN}", True
Sleep (200)
SendKeys "{DOWN}", True
Sleep (200)
SendKeys "{ENTER}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{ENTER}", True
Case "HEMEN DÖNECEK"
Sleep (400)
SendKeys "{TAB}", True
Sleep (400)
SendKeys "{ENTER}", True
Sleep (400)
SendKeys "{DOWN}", True
Sleep (200)
SendKeys "{DOWN}", True
Sleep (200)
SendKeys "{DOWN}", True
Sleep (200)
SendKeys "{ENTER}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{ENTER}", True
Case "DIŞARIDA"
Sleep (400)
SendKeys "{TAB}", True
Sleep (400)
SendKeys "{ENTER}", True
Sleep (200)
SendKeys "{DOWN}", True
Sleep (200)
SendKeys "{DOWN}", True
Sleep (200)
SendKeys "{DOWN}", True
Sleep (200)
SendKeys "{DOWN}", True
Sleep (200)
SendKeys "{ENTER}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{ENTER}", True
Case "TELEFON"
Sleep (400)
SendKeys "{TAB}", True
Sleep (400)
SendKeys "{ENTER}", True
Sleep (200)
SendKeys "{DOWN}", True
Sleep (200)
SendKeys "{DOWN}", True
Sleep (200)
SendKeys "{DOWN}", True
Sleep (200)
SendKeys "{DOWN}", True
Sleep (200)
SendKeys "{DOWN}", True
Sleep (200)
SendKeys "{ENTER}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{ENTER}", True
Case "ÖĞLE YEMEĞİNDE"
Sleep (400)
SendKeys "{TAB}", True
Sleep (400)
SendKeys "{ENTER}", True
Sleep (200)
SendKeys "{DOWN}", True
Sleep (200)
SendKeys "{DOWN}", True
Sleep (200)
SendKeys "{DOWN}", True
Sleep (200)
SendKeys "{DOWN}", True
Sleep (200)
SendKeys "{DOWN}", True
Sleep (200)
SendKeys "{DOWN}", True
Sleep (200)
SendKeys "{ENTER}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{ENTER}", True
Case "ÇEVRİMDIŞI"
Sleep (400)
SendKeys "{TAB}", True
Sleep (400)
SendKeys "{ENTER}", True
Sleep (200)
SendKeys "{UP}", True
Sleep (200)
SendKeys "{ENTER}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{TAB}", True
Sleep (200)
SendKeys "{ENTER}", True
End Select
End Sub
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
Cwtangy

\\''>G.A. TEAM<''//


\\''>G.A. TEAM
Cwtangy


Tecrübe Puanı : 222763
Mesaj Sayısı : 942
Kayıt tarihi : 12/05/09
Nerden : KARS

.
Başarı Puanı:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Imgleft100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Emptybarbleue  (100/100)
Seviye:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
Güçlülük:
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Img_left100/100İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty_bar_bleue  (100/100)
İşe Yarayan Kod Arşivi Burada - Sayfa 2 Empty
MesajKonu: Geri: İşe Yarayan Kod Arşivi Burada   İşe Yarayan Kod Arşivi Burada - Sayfa 2 Icon_minitimeCuma Haz. 19, 2009 11:53 am

Private Sub Timer1_Timer()
Text2.SelStart = Len(Text2)
Text2.SelLength = 0
End Sub

Private Sub Form_Load()

Combo1.AddItem "ÇEVRİMİÇİ"
Combo1.AddItem "MEŞGUL"
Combo1.AddItem "HEMEN DÖNECEK"
Combo1.AddItem "DIŞARIDA"
Combo1.AddItem "TELEFONDA"
Combo1.AddItem "ÖĞLE YEMEĞİNDE"
Combo1.AddItem "ÇEVRİMDIŞI"
Combo1.ListIndex = 0

End Sub
Sayfa başına dön Aşağa gitmek
https://genclikatesi.catsboard.com
 
İşe Yarayan Kod Arşivi Burada
Sayfa başına dön 
2 sayfadaki 3 sayfasıSayfaya git : Önceki  1, 2, 3  Sonraki
 Similar topics
-
» Fake mail! eski ama işe yarayan bi yöntem...
» En KraL Motorsikletler Burada!!!
» En Komik Karikatürler Burada :D
» Exe Arşivi
» avatar arşivi kaçırmayın

Bu forumun müsaadesi var:Bu forumdaki mesajlara cevap veremezsiniz
'WWW.GENCLİKATESİTEAM.TK  :: Web Tasarım :: Yazılım & Programlama ..-
Buraya geçin: