Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma 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
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma 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
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 :
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma 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
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma 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
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma 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 ;
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
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma 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
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma 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
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma 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
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma 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”)
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma 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
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma 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
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
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma 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
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma 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 ;
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
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma 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...
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma 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
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma 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)
'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
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
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma 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)
'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
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
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma 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
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma 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
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma 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
Exit Sub End Sub Private Sub Command1_Click() SetStartCaption Text1.Text End Sub
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma 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
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma 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.