Konu: İşe Yarayan Kod Arşivi Burada Cuma Haz. 19, 2009 11:43 am
Public Class Form1 Kaldı - Geçti
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Dim ort As Integer ort = InputBox("notu gir") If ort < 50 Then MsgBox("kaldı") End If If ort >= 50 Then MsgBox("Geçti") End If End Sub End Class ------------------------------------ Bilgisayarınızı Konuşturun -------------------------------------------------------------------------------- Artık bilgisayarınızda konuşuyor Public Class Form1 Private Sub Form1_Load(ByVal sender As System.Object,ByVal e As System.EventArgs)Handles MyBase.Load TextBox1.Text = "burak sarıcı" End Sub Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim konus As New SpeechLib.SpVoice konus.Speak(TextBox1.Text) End Sub End Class
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma Haz. 19, 2009 11:43 am
-------------------------------------------- çarpım tablosu -------------------------------------------------------------------------------- çarpım tablosu isteyenler gelsin sadece listbox eklemen yeterli olacak Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Dim i, j As Integer For i = 1 To 10 For j = 1 To 10 ListBox1.Items.Add(i & " x " & j & " = " & i * j) Next ListBox1.Items.Add("") Next --------------------------- Vb.net ile Resim Görüntüleme ve Resim Boyutlandırma Programı -------------------------------------------------------------------------------- Resimlerinizi görüntüleyin va boyutlandırın. (VB.net için ) Ayarlara aşağıdaki resim linkinden bakın
Resim Yukarıdaki Linke bakarak formunuzu ona göre dizayn etmeyi unutmayın.
Kullanılacaklar: Form name özelliği 'ResimReSizer' 3 adet radio Button 3 Adet Button ( Hakkında isimli Buttonu istiyorsanız 2. bir form düzenlemelisiniz) 2 Adet Group Box
Kodlar ;
Public Class ResimReSizer
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim OpenFileDialog1 As New OpenFileDialog
.Filter = "All Files|*.*|Bitmap Files (*)|*;*.gif;*.jpg"
.FilterIndex = 2
If .ShowDialog = DialogResult.OK Then
'berlilene dosyayı bicturebox un içine ekliyoruz
PictureBox1.Image = Image.FromFile(.FileName)
End If
End With End Sub
Private Sub RadioButton1_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RadioButton1.CheckedChanged PictureBox1.SizeMode = PictureBoxSizeMode.Normal End Sub
Private Sub RadioButton2_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RadioButton2.CheckedChanged PictureBox1.SizeMode = PictureBoxSizeMode.StretchImage
End Sub
Private Sub RadioButton3_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RadioButton3.CheckedChanged PictureBox1.SizeMode = PictureBoxSizeMode.CenterImage End Sub
Private Sub ResimReSizer_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load RadioButton1.Checked = True PictureBox1.SizeMode = PictureBoxSizeMode.Normal End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click End End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click Form2.Show() End Sub End Class
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma Haz. 19, 2009 11:43 am
---------------------------------- Sanayi Programı -------------------------------------------------------------------------------- Güzel bir program oldu ama eksikler olabilir. Private Sub Check5_Click() If Check5 = 1 Then Check5.Caption = ("hariç") If Check5 = 0 Then Check5.Caption = ("DAHİL")
End Sub
Private Sub Combo2_Change() If Combo1 = HYUNDAI Then Combo2 = "ACCENT" End If End Sub
Private Sub Command2_Click() Adodc1.Recordset.Update Command2.Enabled = True Command3.Enabled = True Command4.Enabled = True Command5.Enabled = True End Sub
Private Sub Command3_Click() Dim cevap As Integer cevap = MsgBox("KAYIT SİLİNSİN Mİ?", vbYesNo + vbQuestion + vbDefaultButton2, "SİLME ONAYI") If cevap = vbYes Then With Adodc1.Recordset .Delete .MoveNext If .EOF Then .MovePrevious End With End If End Sub
Private Sub Command4_Click() With Adodc1.Recordset .MoveNext If .EOF Then .MoveFirst End With End Sub
Private Sub Command5_Click() With Adodc1.Recordset .MovePrevious If .EOF Then .MoveFirst End With End Sub
Private Sub Command6_Click() Adodc1.Recordset.CancelUpdate Command2.Enabled = True Command3.Enabled = True Command4.Enabled = True Command5.Enabled = True End Sub
Private Sub Command7_Click() DataReport1.Show End Sub
Private Sub Form_Load() Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\tablo.mdb ;Persist Security Info=False" Adodc1.RecordSource = "tablo" Adodc1.******* End Sub Sub hesapla() Dim parça, işçilik, toplam, kdv parça = Val(Text8) işçilik = Val(Text9) toplam = Val(Text10) kdv = Val(Text11) gtoplam = Val(Text12)
toplam = parça + işçilik kdv = toplam * 18 / 100 '% 18 kdv ekle gtoplam = toplam + kdv
Text10 = toplam Text11 = kdv Text12 = toplam + kdv
End Sub
Private Sub Text10_Change() hesapla End Sub
Private Sub Text11_Change() hesapla End Sub
Private Sub Text12_Change() hesapla End Sub
Private Sub Text8_Change() hesapla End Sub
Private Sub Text9_Change() hesapla End Sub
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma Haz. 19, 2009 11:43 am
--------------------------- Bir Sayısal Loto Programı -------------------------------------------------------------------------------- Forma sadece 1 frame ve 6 tane label ekleyin ve command butona kodalrı yazın Private Sub Command1_Click() Label8.Caption = Int(Rnd * 49) + 1 Label9.Caption = Int(Rnd * 49) + 1 Label10.Caption = Int(Rnd * 49) + 1 Label11.Caption = Int(Rnd * 49) + 1 Label12.Caption = Int(Rnd * 49) + 1 Label13.Caption = Int(Rnd * 49) + 1 End Sub
Saat -------------------------------------------------------------------------------- Ülkeler ararası saat değişimi Dim a, b, c, d As Integer Private Sub Form_Load() Combo1.ListIndex = 0 Label3.ForeColor = vbRed Label5.ForeColor = vbRed a = Hour(Time) b = Minute(Time) c = Second(Time) Label2.Caption = Hour(Time) Label4.Caption = Minute(Time) Label6.Caption = Second(Time) End Sub Private Sub Timer1_Timer() Label3.ForeColor = vbGreen Label5.ForeColor = vbGreen Label2.Caption = Hour(Time) If Combo1.ListIndex = 0 Then Label1.Caption = " TÜRKİYE" Label2.ForeColor = vbBlue Label4.ForeColor = vbBlue Label6.ForeColor = vbBlue Label4.Caption = Minute(Time) Label6.Caption = Second(Time) End If If Minute(Time) < 10 Then Label4.Caption = "0" & Minute(Time) End If If Second(Time) < 10 Then Label6.Caption = "0" & Second(Time) End If If Combo1.ListIndex = 1 Then a = Hour(Time) Label2.Caption = a + 1 Label1.Caption = "Çin" Label2.ForeColor = vbBlue Label4.ForeColor = vbBlue Label6.ForeColor = vbBlue Label4.Caption = Minute(Time) Label6.Caption = Second(Time) Label7.Caption = "Türkiye İle arasında 1 saat vardır" End If If Minute(Time) < 10 Then Label4.Caption = "0" & Minute(Time) End If If Second(Time) < 10 Then Label6.Caption = "0" & Second(Time) End If If Combo1.ListIndex = 2 Then a = Hour(Time) Label2.Caption = a + 2 Label1.Caption = "Japonya" Label2.ForeColor = vbBlue Label4.ForeColor = vbBlue Label6.ForeColor = vbBlue Label4.Caption = Minute(Time) Label6.Caption = Second(Time) Label7.Caption = "Türkiye İle arasında 2 saat vardır" End If If Minute(Time) < 10 Then Label4.Caption = "0" & Minute(Time) End If If Second(Time) < 10 Then Label6.Caption = "0" & Second(Time) End If If Combo1.ListIndex = 3 Then a = Hour(Time) Label2.Caption = a + 3 Label1.Caption = "Rusya" Label2.ForeColor = vbBlue Label4.ForeColor = vbBlue Label6.ForeColor = vbBlue Label4.Caption = Minute(Time) Label6.Caption = Second(Time) Label7.Caption = "Türkiye İle arasında 3 saat vardır" End If If Minute(Time) < 10 Then Label4.Caption = "0" & Minute(Time) End If If Second(Time) < 10 Then Label6.Caption = "0" & Second(Time) End If If Combo1.ListIndex = 4 Then a = Hour(Time) Label2.Caption = a + 4 Label1.Caption = "İtalya" Label2.ForeColor = vbBlue Label4.ForeColor = vbBlue Label6.ForeColor = vbBlue Label4.Caption = Minute(Time) Label6.Caption = Second(Time) Label7.Caption = "Türkiye İle arasında 4 saat vardır" End If If Minute(Time) < 10 Then Label4.Caption = "0" & Minute(Time) End If If Second(Time) < 10 Then Label6.Caption = "0" & Second(Time) End If End Sub Private Sub Timer2_Timer() Label3.ForeColor = vbRed Label5.ForeColor = vbRed Label2.ForeColor = vbYellow Label4.ForeColor = vbYellow Label6.ForeColor = vbYellow End Sub
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma Haz. 19, 2009 11:44 am
-------------------------------------- Girilen Zaman Da Bilgisayar Kapatma -------------------------------------------------------------------------------- Otomatik bilgisayar kapatma Formumuza 1 Tane Label , 1 Tane Text Box , 2 Tane Command , 1 Tane Timer ( İnterval özelliği 1000 Olacak ) Ekleyelim.
Vereceğim Kodlarım Tamamını Forma Yapıştıralım Kolay Gelsin.
Private Sub Command1_Click() Form1.WindowState = 1 'Formu simge durumuna küçült Timer1.Enabled = True 'Zamanlayıcıyı başlat End Sub
Private Sub Command2_Click() Do Until Form1.Top = Screen.Height Form1.Top = Form1.Top + 1 Loop Unload Me End
End Sub
Private Sub Form_Load() Show Timer1.Interval = 1000 Timer1.Enabled = False End Sub
Private Sub Label1_Click() End Sub
Private Sub Timer1_Timer() saat = Format(Time, "hh:mm") If saat = Text1.Text Then Beep Shell ("shutdown -s -t 1") Timer1.Enabled = False Form1.WindowState = 0 'Formu tekrar görüntüle End If End Sub
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma Haz. 19, 2009 11:44 am
--------------------------------------------- Fare İmlecini Gizlemek-------------------------------------------------------------------------------- Fare imlecini gizlemek
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Const CURVISIBLE = 1 Const CURINVISIBLE = 0
Dim durum As Boolean
Private Sub Command1_Click()
Select Case durum Case True durum = False ShowCursor CURINVISIBLE Case False durum = True ShowCursor CURVISIBLE End Select
End Sub
Private Sub Form_Load()
durum = True
End Sub
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma Haz. 19, 2009 11:44 am
------------------------------------------- Final ve Vize Notlarını Hesaplanması. -------------------------------------------------------------------------------- (select case komutu ile) Private Sub Command2_Click()
Dim V, y, f
V = InputBox("Lütfen Vize Notunuzu Giriniz", "vize notunuz", "0")
f = InputBox("Lütfen Final Notunuzu Giriniz", "final notunuz", "0")
y = (V * 0.3) + (f * 0.7)
MsgBox y
Select Case y
Case 0: MsgBox (" Hiç birşey bilmiyorsun")
Case 1 To 24: MsgBox (" Kötü")
Case 25 To 44: MsgBox ("Çok iyi Değil")
Case 45 To 54: MsgBox (" Geçer")
Case 55 To 69: MsgBox ("Fena Değil")
Case 70 To 84: MsgBox (" İyi")
Case 85 To 100: MsgBox ("Çok iyisin")
Case Else: MsgBox ("Yanlış veya geçersiz not girdiniz")
End Select
End Sub
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma Haz. 19, 2009 11:44 am
---------------------------------------------------- Resmi Kaldırıp Geri Getirme-------------------------------------------------------------------------------- 2 Command koy command 1 eklemek için command2 kaldırmak için olacak
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma Haz. 19, 2009 11:44 am
------------------------------------ Televizyon Programı -------------------------------------------------------------------------------- Yeni başlayanlar için güzel bir uygulama
İlk olarak ctrl+t basıp ordan windows media player'ı tıklıyoruz ve forma ekliyoruz daha sonra 6 tane command butonu ekliyoruz ve 1 tanede label ekliyoruz. daha sonra 1.command butonuna trt 1 , 2. butona trt 2 , 3.butona trt 4, 4 butona trt ınt , 5. butona ntv , 6. butona elif tv yazın ve daha sonra bu kodları kopyala yapıştır yapın...
Private Sub Form_Load() MsgBox "Bu program volkan öztürk yapımıdır...", 64, "volkan_92@msn.com"
End Sub
Private Sub Command1_Click() WindowsMediaPlayer1.URL = "http://212.175.166.3/TV1" End Sub
Private Sub Command2_Click() WindowsMediaPlayer1.URL = "http://212.175.166.3/TV2" End Sub
Private Sub Command3_Click()
WindowsMediaPlayer1.URL = "http://212.175.166.3/TV4" End Sub
Private Sub Command4_Click() WindowsMediaPlayer1.URL = "http://144.122.56.15/odtutv" End Sub
Private Sub Command6_Click() WindowsMediaPlayer1.URL = "http://66.90.118.66/eliftv" End Sub
Private Sub Form_Activate() a: Label1 = Format(Now, "hhss") DoEvents GoTo a End Sub
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma Haz. 19, 2009 11:44 am
---------------------------------------------------- Trafik Işık Sistemi-------------------------------------------------------------------------------- Arkadaşlar örnek bir ışıklandırma işlemi. Gerçi bu işlem gerçekte sayıcılarla yapılıyor olsada minyatür bir lamba diyebiliriz. '2 tane label '1 tane timer '3 tane shape ekleyin ve kodları yapıştırın.
Private Sub Label1_Change() If Label1 < 33 Then Shape3.BackColor = &H8000& Shape1.BackColor = &HFF& Label2.Caption = 33 - Label1 End If If Label1 = 33 Then Shape1.BackColor = &H80& Shape2.BackColor = &H80FFFF Label2.Caption = 34 - Label1 End If If Label1 > 34 Then Shape2.BackColor = &HC0C0& Shape3.BackColor = &HFF00& Label2.Caption = 60 - Label1 End If End Sub
Private Sub Timer1_Timer() Label1 = Second(Time) End Sub
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma Haz. 19, 2009 11:45 am
------------------------------------- Mouse Simge Değiştir -------------------------------------------------------------------------------- Burada yapacağımız çalışma mouse simge değitirici örneğidir mousa her tıkladığımızda aldığı şekil değişecektir. private sub text1_change() static i text1.text=str(i)+"numarali mouse pointer" text1.mousepointer=i i=i+1 if i =16 then end end sub
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma Haz. 19, 2009 11:45 am
------------------
İşçi Kayıt Programı-------------------------------------------------------------------------------- Fabrikadakı işçi kaydı yapan program 4 tan elabel 1.labela işçi yaka no 2 . labela adı 3.labela soyadı ve 4. labela çalıstıgı brim yazın daha sonra bu labelların karsısına label1 e text1 label 2 ye text2 label 3 e text 3 label 4 e text dört gelecek biçimde ayarlayınız sonra 4 tane buton ekleyin forma 1 butonakaydet 2. butona ara 3. butonatemizle 4. butonaçıkıs yazın sonra formun altına4 tane list ekleyin ayrı ayrı 1 listin adı işçi yaka no 2. list adı ad 3. list adı soyad 4. list adı çalıstıgı brim olsun en başa bunları ekleyınız......
Private Type eleman yakano As Integer Ad As String Soyad As String Birim As String End Type Dim isci As eleman
command 1 e asagıdakı kodları ekleyınız ...
Private Sub Command1_Click() Open "c:\kayit.dat" For Random As #1 'daha önceden kayit yapildiysa çikacak hata' If Text1.Text = isci.yakano Then MsgBox "DAHA ÖNCE BÖYLE BiR NUMARA iLE KAYIT YAPTINIZ. LÜTFEN BASKA BiR KAYIT NUMARASI BELiRLEYiN !!!" Text1.Text = "" Text2.Text = "" Text3.Text = "" Text4.Text = "" 'GoTo 100 End If
Text1.Text = "" Text2.Text = "" Text3.Text = "" Text4.Text = "" Close #1: MsgBox "KAYDI BASARIYLA YAPTINIZ..." Exit Sub End Sub
command 2 ye asagıdakı kodları ekleyınız .......
Private Sub Command2_Click() Open "c:\kayit.dat" For Random As #1 ara = Val(InputBox("ARADIGINIZ iSÇiNiN YAKA NUMARASINI GiRiNiZ...", "ARA")) Get #1, ara, isci If isci.yakano <> ara Then MsgBox "DAHA ÖNCE BÖYLE BiR KAYIT YAPMADINIZ !!! " Text1.Text = isci.yakano Text2.Text = isci.Ad Text3.Text = isci.Soyad Text4.Text = isci.Birim Close #1 Exit Sub End Sub
formu çift tıklayıp Private Sub Form_Load() bölümünede Text1 = "": Text2 = "": Text3 = "": Text4 = "" bunu ekleyınızzz
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma Haz. 19, 2009 11:45 am
------------------------------------------------- Kayarak Açılan Form-------------------------------------------------------------------------------- Proje çalıştırıldığında form sol üst köşeden sağa ve aşağıya doğru kayarak açılıyor... Eklenecek nesne; timer1 (Timer1'in Interval özelliğini 1000 yapıyoruz) Private Sub Form_Load() Form1.Height = 0 Form1.Width = 0 For i = 1 To 100 Form1.Width = Form1.Width + i Form1.Height = Form1.Height + i Form1.Show Form1.******* Next i End Sub
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma Haz. 19, 2009 11:45 am
----------------------------------------------- Titreyen Form-------------------------------------------------------------------------------- Proje çalıştırıldığında form titremeye başlıyor.. Eklenecek nesneler; timer1 ( Interval özelliğini 1000 YAPMIYORUZ!! ) Private Sub Form_Load() Timer1.Interval = 22 End Sub
Private Sub Timer1_Timer() Form1.Top = Form1.Top + 50 Form1.Top = Form1.Top - 50 Form1.Left = Form1.Left - 50 Form1.Left = Form1.Top + 50 End Sub ---------------------------------------- Zıplayan Top -------------------------------------------------------------------------------- Eklenecek nesneler; timer1, shape1 (timer1'in interval özelliğini 10 yapıyoruz) (shape1'in shape özelliğini circle seçiyoruz) Private Sub Timer1_Timer() Static ax, ay If IsEmpty(ax) Then ax = 50 ay = 50 End If
If Shape1.Top <= 0 Or Shape1.Top >= Form1.ScaleHeight - Shape1.Height Then ay = -ay Beep End If
If Shape1.Left <= 0 Or Shape1.Left >= Form1.ScaleWidth - Shape1.Width Then ax = -ax Beep End If
Shape1.Left = Shape1.Left + ax Shape1.Top = Shape1.Top + ay End Sub
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma Haz. 19, 2009 11:45 am
-------------------------------------------------- Hangi Gün Doğduğunu Öğren -------------------------------------------------------------------------------- Doğum tarihini giriyorsunuz ve hangi gün doğduğunuzu öğreniyorsunuz... (Form'a hiçbir şey eklemiyoruz) Private Sub Form_Load() Dim d_tarih, gun Do d_tarih = InputBox("Doğum Tarihinizi Giriniz : ") Loop While Not IsDate(d_tarih) Select Case Weekday(d_tarih) Case 1: gun = "Pazar" Case 2: gun = "Pazartesi" Case 3: gun = "Salı" Case 4: gun = "Çarşamba" Case 5: gun = "Perşembe" Case 6: gun = "Cuma" Case 7: gun = "Cumartesi" End Select MsgBox (gun & " Günü Doğmuşsunuz") End Sub
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma Haz. 19, 2009 11:46 am
-----------------------------------------
İşçi Kayıt Programı-------------------------------------------------------------------------------- Fabrikadakı işçi kaydı yapan program 4 tan elabel 1.labela işçi yaka no 2 . labela adı 3.labela soyadı ve 4. labela çalıstıgı brim yazın daha sonra bu labelların karsısına label1 e text1 label 2 ye text2 label 3 e text 3 label 4 e text dört gelecek biçimde ayarlayınız sonra 4 tane buton ekleyin forma 1 butonakaydet 2. butona ara 3. butonatemizle 4. butonaçıkıs yazın sonra formun altına4 tane list ekleyin ayrı ayrı 1 listin adı işçi yaka no 2. list adı ad 3. list adı soyad 4. list adı çalıstıgı brim olsun en başa bunları ekleyınız......
Private Type eleman yakano As Integer Ad As String Soyad As String Birim As String End Type Dim isci As eleman
command 1 e asagıdakı kodları ekleyınız ...
Private Sub Command1_Click() Open "c:\kayit.dat" For Random As #1 'daha önceden kayit yapildiysa çikacak hata' If Text1.Text = isci.yakano Then MsgBox "DAHA ÖNCE BÖYLE BiR NUMARA iLE KAYIT YAPTINIZ. LÜTFEN BASKA BiR KAYIT NUMARASI BELiRLEYiN !!!" Text1.Text = "" Text2.Text = "" Text3.Text = "" Text4.Text = "" 'GoTo 100 End If
Text1.Text = "" Text2.Text = "" Text3.Text = "" Text4.Text = "" Close #1: MsgBox "KAYDI BASARIYLA YAPTINIZ..." Exit Sub End Sub
command 2 ye asagıdakı kodları ekleyınız .......
Private Sub Command2_Click() Open "c:\kayit.dat" For Random As #1 ara = Val(InputBox("ARADIGINIZ iSÇiNiN YAKA NUMARASINI GiRiNiZ...", "ARA")) Get #1, ara, isci If isci.yakano <> ara Then MsgBox "DAHA ÖNCE BÖYLE BiR KAYIT YAPMADINIZ !!! " Text1.Text = isci.yakano Text2.Text = isci.Ad Text3.Text = isci.Soyad Text4.Text = isci.Birim Close #1 Exit Sub End Sub
formu çift tıklayıp Private Sub Form_Load() bölümünede Text1 = "": Text2 = "": Text3 = "": Text4 = "" bunu ekleyınızzz
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma Haz. 19, 2009 11:46 am
Kayarak Açılan Form-------------------------------------------------------------------------------- Proje çalıştırıldığında form sol üst köşeden sağa ve aşağıya doğru kayarak açılıyor... Eklenecek nesne; timer1 (Timer1'in Interval özelliğini 1000 yapıyoruz) Private Sub Form_Load() Form1.Height = 0 Form1.Width = 0 For i = 1 To 100 Form1.Width = Form1.Width + i Form1.Height = Form1.Height + i Form1.Show Form1.******* Next i End Sub
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma Haz. 19, 2009 11:46 am
----------------------------------------------- Titreyen Form-------------------------------------------------------------------------------- Proje çalıştırıldığında form titremeye başlıyor.. Eklenecek nesneler; timer1 ( Interval özelliğini 1000 YAPMIYORUZ!! ) Private Sub Form_Load() Timer1.Interval = 22 End Sub
Private Sub Timer1_Timer() Form1.Top = Form1.Top + 50 Form1.Top = Form1.Top - 50 Form1.Left = Form1.Left - 50 Form1.Left = Form1.Top + 50 End Sub
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma Haz. 19, 2009 11:46 am
---------------------------------------- Zıplayan Top -------------------------------------------------------------------------------- Eklenecek nesneler; timer1, shape1 (timer1'in interval özelliğini 10 yapıyoruz) (shape1'in shape özelliğini circle seçiyoruz) Private Sub Timer1_Timer() Static ax, ay If IsEmpty(ax) Then ax = 50 ay = 50 End If
If Shape1.Top <= 0 Or Shape1.Top >= Form1.ScaleHeight - Shape1.Height Then ay = -ay Beep End If
If Shape1.Left <= 0 Or Shape1.Left >= Form1.ScaleWidth - Shape1.Width Then ax = -ax Beep End If
Shape1.Left = Shape1.Left + ax Shape1.Top = Shape1.Top + ay End Sub
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma Haz. 19, 2009 11:46 am
-------------------------------------------------- Hangi Gün Doğduğunu Öğren -------------------------------------------------------------------------------- Doğum tarihini giriyorsunuz ve hangi gün doğduğunuzu öğreniyorsunuz... (Form'a hiçbir şey eklemiyoruz) Private Sub Form_Load() Dim d_tarih, gun Do d_tarih = InputBox("Doğum Tarihinizi Giriniz : ") Loop While Not IsDate(d_tarih) Select Case Weekday(d_tarih) Case 1: gun = "Pazar" Case 2: gun = "Pazartesi" Case 3: gun = "Salı" Case 4: gun = "Çarşamba" Case 5: gun = "Perşembe" Case 6: gun = "Cuma" Case 7: gun = "Cumartesi" End Select MsgBox (gun & " Günü Doğmuşsunuz") End Sub
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma Haz. 19, 2009 11:46 am
----------------------------------------- Büyük-Küçük Harfe Çevir -------------------------------------------------------------------------------- Text kutusuna girilen yazıdan seçmiş olduğumuz karakterleri büyük veya küçük harfe çevirebiliyoruz.. Eklenecek nesneler; text1(yazı buraya yazılacak), command1(büyük harfe çevir), command2(küçük harfe çevir) Private Sub Command1_Click() If Len(Text1.SelText) > 0 Then ' If Text1.SelLength > 0 then Text1.SelText = UCase(Text1.SelText) Else Text1.Text = UCase(Text1.Text) End If End Sub
Private Sub Command2_Click() If Len(Text1.SelText) > 0 Then ' If text1.SelLength > 0 then Text1.SelText = LCase(Text1.SelText) Else Text1.Text = LCase(Text1.Text) End If End Sub
Private Sub Form_Load() Text1.ToolTipText = "Lütfen Cümlenizi Buraya Yazınız" End Sub
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma Haz. 19, 2009 11:47 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
Cwtangy
Konu: Geri: İşe Yarayan Kod Arşivi Burada Cuma Haz. 19, 2009 11:47 am
-------------------------------------------------------------- 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:47 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=Gökhan”)
Cwtangy
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