Reklamlar
İşe Yarayan Kod Arşivi Burada 1

İşe Yarayan Kod Arşivi Burada 1 » 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

Gönderen Konu: İşe Yarayan Kod Arşivi Burada 1  (Okunma sayısı 2056 defa)

0 Üye ve 1 Ziyaretçi konuyu incelemekte.

Çevrimdışı administrator

  • Administrator
  • General
  • *****
  • İleti: 24517
  • Karma: +3/-1
    • Profili Görüntüle
    • Toplist Ekle Site Ekle

İşe Yarayan Kod Arşivi Burada 1
« : Nisan 30, 2009, 06:03:58 ÖÖ »
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
--------------------------------------------
ç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

RadioButton1.Checked = True
PictureBox1.SizeMode = PictureBoxSizeMode.Normal


With OpenFileDialog1

.CheckFileExists = True

.ShowReadOnly = False

.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
----------------------------------
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 Command1_Click()
Adodc1.Recordset.AddNew
Text1.SetFocus
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
Command5.Enabled = False

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.Refresh
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
---------------------------
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
--------------------------------------
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.

Command 1 Caption Özelliğine Başla Yazalım
Command 2 Caption Özelliğine Çıkış Yazalım

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
---------------------------------------------
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
-------------------------------------------
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
----------------------------------------------------
Resmi Kaldırıp Geri Getirme--------------------------------------------------------------------------------
2 Command koy command 1 eklemek için command2 kaldırmak için olacak

command1_clıck
Image1.visible=true
command2_clıck
Image1.visible=false
------------------------------------
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, "hh:mm:ss")
DoEvents
GoTo a
End Sub
----------------------------------------------------
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 Form_Load()
Label2.Caption = ""
Timer1.Interval = 1000
Form1.Height = 3255
Form1.Width = 2025
Form1.BorderStyle = 5
Shape1.BackStyle = 1
Shape2.BackStyle = 1
Shape3.BackStyle = 1
Shape1.BackColor = &H80&
Shape2.BackColor = &HC0C0&
Shape3.BackColor = &H8000&
Shape1.Top = 720
Shape1.Left = 280
Shape2.Top = 1440
Shape2.Left = 280
Shape3.Top = 2160
Shape3.Left = 280
Form1.Caption = "asimom@msn.com"
Shape1.Shape = 3
Shape2.Shape = 3
Shape3.Shape = 3
Label1.Top = 1200
Label1.Left = 3600
Label2.FontSize = 22
Label2.FontBold = True
Label2.Top = 120
Label2.Left = 240
Label2.Alignment = 2
End Sub

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
-------------------------------------
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
------------------

İşç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

isci.yakano = Text1.Text
isci.Ad = Text2.Text
isci.Soyad = Text3.Text
isci.Birim = Text4.Text
Put #1, isci.yakano, isci

'100:

List1.AddItem isci.yakano
List2.AddItem isci.Ad
List3.AddItem isci.Soyad
List4.AddItem isci.Birim

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

command 3 e asagıdakı kodları ekleyınız........

Private Sub Command3_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""

End Sub


command 4 easgıdakı kodları ekleyınız..........

Private Sub Command4_Click()
End
End Sub

formu çift tıklayıp Private Sub Form_Load() bölümünede
Text1 = "": Text2 = "": Text3 = "": Text4 = ""
bunu ekleyınızzz
-------------------------------------------------
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.Refresh
Next i
End Sub
-----------------------------------------------
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
--------------------------------------------------
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
-----------------------------------------

İşç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

isci.yakano = Text1.Text
isci.Ad = Text2.Text
isci.Soyad = Text3.Text
isci.Birim = Text4.Text
Put #1, isci.yakano, isci

'100:

List1.AddItem isci.yakano
List2.AddItem isci.Ad
List3.AddItem isci.Soyad
List4.AddItem isci.Birim

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

command 3 e asagıdakı kodları ekleyınız........

Private Sub Command3_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""

End Sub


command 4 easgıdakı kodları ekleyınız..........

Private Sub Command4_Click()
End
End Sub

formu çift tıklayıp Private Sub Form_Load() bölümünede
Text1 = "": Text2 = "": Text3 = "": Text4 = ""
bunu ekleyınızzz
-------------------------------------------------
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.Refresh
Next i
End Sub
-----------------------------------------------
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
--------------------------------------------------
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
-----------------------------------------
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
----------------------------------------------------------------------

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
--------------------------------------------------------
İ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”)
-----------------------------------
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
-----------------------------------
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


---------------------------------------------
(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

---------------------------------------------
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: cmdRefreshList)
ekliyelim ve aşağıdaki kodları yazalım :
---------------------------------------------
Private MSN As New MsgrObject

Private Sub RefreshList()
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 cmdRefreshList_Click()
If MSN.LocalState <> MSTATE_OFFLINE Then RefreshList
End Sub

Private Sub Form_Load()
cmdRefreshList_Click
End Sub



Not: Konular İnternet Sitelerinden derlenerek alıntı yapılmıştır.








BilX.Net

 

Related Topics

  Konu / Başlatan Yanıt Son İleti
0 Yanıt
1721 Gösterim
Son İleti Nisan 30, 2009, 06:04:34 ÖÖ
Gönderen: administrator
0 Yanıt
542 Gösterim
Son İleti Ağustos 25, 2018, 02:34:12 ÖÖ
Gönderen: thecreeper
0 Yanıt
232 Gösterim
Son İleti Aralık 11, 2018, 07:10:41 ÖS
Gönderen: thecreeper
0 Yanıt
231 Gösterim
Son İleti Mart 06, 2019, 06:41:54 ÖS
Gönderen: thecreeper
1 Yanıt
73 Gösterim
Son İleti Eylül 28, 2019, 11:57:52 ÖS
Gönderen: Sadiebrild