CLICK HERE FOR THOUSANDS OF FREE BLOGGER TEMPLATES »

12 Ekim 2008 Pazar

Visual basic freevbcode

visual Basic ve Diğer diller için kaynak yabancı bir site

http://www.freevbcode.com/


Buda bir başka http://www.csmsu.com/ajax/index4658.html?page=2

14 Nisan 2008 Pazartesi

visual basic de VERİ ERİŞİM YÖNTEMLERİ

VERİ ERİŞİM YÖNTEMLERİ

Veri erişim yöntemleri (data access object) programlama aracılığıyla veri tabanı dosyalarına erişmek için kullanılırlar.


VERİ ERİŞİM YÖNTEMLERİ

DAO (Data Access Objects)
RDO (Remote Data Objects)
ADO (ActiveX Data Object)
VB - SQL


VBSQL

Microsoft SQL server için geliştirilmiş bir arabirimdir.
Microsoft SQL Server ve Sybase SQL Server’ a erişim sağlar.


DAO

Microsoft Jet veritabanına erişmek için geliştirilmiş ilk nesne temelli arabirimdir.
ISAM ve ODBC veritabanlarına erişim için kullanılır.


RDO

Remote Data Object, ODBC üzerinden ilişkisel verilere erişim için kullanılır.
Jet ve ISAM veritabanlarına erişim için kullanılmaz.


ADO

ActiveX Data Object veri erişim yöntemi OLE DB ‘ ye arabirim olan bir veri erişim yöntemidir. OLE DB ve ODBC sürücülerini kullanılır.


ODBC

Çok sayıda ilişkisel veritabanına erişim için geliştirilmiş bir arabirimdir.
Nesne temelli erişimlerde kullanılır.


OLE DB

Alt düzey bir veri erişim yöntemidir.
Her hangi bir veri tabanı tipi ile sınırlı değildir.
ODBC’ nin gelişmiş biçimidir.

Yerel ve Uzak Veritabanı

Verilere dosya sistemi aracılığıyla erişiliyorsa yerel veritabanından erişim sağlanıyor demektir. Uzak veriler ise uygulamanın yanısıra başka bir işlem ile ulaşılan verilerdir.
Clint / server uygulamaları aracılığıyla uzak verilere erişilebilir.



CURSOR TİPLERİ

Veri erişim nesnesinin, cursor tipi verilere erişimin şeklini belirlemek ve erişim performansını arttırmak için kullanılan öğedir.


CURSOR TİPLERİ

Dynamic Cursor
Keyset Cursor
Static Cursor
Forward – Only Cursor


CURSOR TİPLERİ
Dynamic Cursor

Diğer kullanıcılar tarafından yapılan eklentilerin görülmesini sağlar.
Veri seti üzerinde yapılan tüm değişiklikleri izin verir.


CURSOR TİPLERİ
Keyset Cursor

Diğer kullanıcıların eklediği kayıtların görülmesini engeller.
Recordset içindeki her türlü harekete izin verir.


CURSOR TİPLERİ
Static Cursor

Belli bir verinin bulunması ya da raporların üretilmesi için kullanılacak veri setinin değişmeyen bir kopyasını yaratır. Veri nesnesi üzerindeki her türlü harekete izin verir.


CURSOR TİPLERİ
Forwart - Only Cursor

Sabit gösterici gibi çalışır. Kayıtlar arasında sadece ileriye doğru hareket eder.



ODBC(Open Database Connectivity)

Visual Basic kullanarak yerel ve uzak clint/server veritabanlarına erişmek için bir yöntemdir.ODBC ile SQL server ya da diğer uyumlu birçok sunucuda duran verilere erişmek mümkündür.


ODBC Sürücüsünün Temel Görevleri

Veri tabanına Bağlantıyı sağlar
SQL deyimlerini hazırlar ve işletir
Sonuç bilgiyi üretir.
Uygulama hataları hakkında bilgi verir.


ODBC Mimarisi

Uygulama : ODBC fonksiyonlarını çağırarak onları SQL deyimlerine gönderir ve sonuçları elde eder.

Sürücü Yöneticisi : Bir uygulama yerine sürücüleri yükler.

Sürücü : ODBC fonksiyon çağırmalarını işler. SQL deyimlerini belli verilere yönlendirir.

Veri kaynağı : Kullanıcının erişeceği veri


ODBC Sürücüleri

Tek Katlı(Single Tier) : Hem ODBC çağrılarını hemde SQL deyimlerini işler.Daha çok SQL olmayan veri tabanları için kullanılıar.

Çok Katlı (Multiple tier): Sürücü isteğini hizmet birimine (server) gönderir. Bu istek SQL ya da özel veritabanı biçiminde olabilir.


ODBC Veri Erişimi

ODBC veritabanına bağlanabilmek için;
Kaynak veri adı

Sürücü ve diğer ilgili yazılım (Gerekli olan DLL’ lerdir.)

Time-out değeri (Login Timeout değeri, ODBC hizmet biriminden gelen yanıtın beklendiği süreyi belirtir. Query Timeout değeri sorgunun tanımlanması sırasında bekleme süresini belirler.)



ODBC DSN leri

System DSN : Win NT de kullanılır. Bütün uygulamalar ve servisler ulaşabilir.

File DSN : Bilgisini Text dosyada saklar (INI) Bu dosya veritabanı sürücüsü ve yeri hakkında bilgi içerir.

User DSN : Belli bir kullanıcı profili için kullanılır. DSN bilgisi lokal bilgisayarın registry’ sinde saklanır.

ADO VERİ ERİŞİMİ

ADO
(ActiveX Data Objects)
VERİ ERİŞİMİ

ADO

ADO clint uygulamaların server veri tabanlarına erişimini ve veri işlemesini sağlar.

Web uygulamaları ve clint/server uygulamaları geliştirmek için kullanılan ADO, OLE db veya başka provider’ ı kullanır.

ADO hiyerarşik olmayan ve bağımsız olarak kullanılan nesneleriyle verilere kolayca ulaşmayı sağlar

Daha iyi performans sağlamasının yanı sıra daha az sistem kaynağına gereksinim duyar.

Hızlı çalışarak veri tabanı uygulamalarının daha etkin kullanımını sağlar.

ADO verileri OLE DB aracılığıyla sağlar. ADO için data provider OLE DB dir.


ADO’ nun clint/server ve web uygulamaları için yeni özellikleri

 Düz ve basit nesne modelidir. Karmaşık nesnelerin kullanılması gerektiğinde daha verimli kullanılmasını sağlar.
 Bağımsız oluşturulan nesneler. DAO ve RDO da olduğu gibi hiyerarşik gösterimin aksine ADO nesneleri bağımsız yaratılır.
 Clint tarafından kullanılabilecek cusor kütüphanesine sahiptir. Seek, Find ve Sort metotlarını destekler.
 Stored procedure’ ları giriş ve çıkış parametreleriyle destekler.


ADO NESNELERİ

Command : Bir veri kaynağı üzerinde bir sorgu ya da deyimi işletir. Sorgu tanımının saklanmasını sağlar. SQL cümlesi, stored procedure,tablo adı ya da komut metni parametrelerini içerir.

Connection : Bir veri kaynağına doğrudan bağlantı kurar. Data provider hakkında bilgi verir. Cursor type, Connect string, sorgu ve komut zamanı ve diğer ADO özelliklerine sahiptir.

Error : Veri kaynağında oluşan bir hatayı geri döndürür.

Field : Bir kayıt içindeki alanı belirtir.

Parameter : Çalışacak bir komut için parametre tutar. Parmetreli Command nesnesi için parametre belirler.

Recordset : Bir komut tarafından üretilen verileri içerir.Bir query sonucu dönen bir ya da daha fazla kaydı gösterir.Bir kayıt seti bir bağlantı yaratmadan da açılabilir. Ancak bir bağlantı (Connection) oluşturulursa, bu bağlantıya göre birden fazla kayıt seti oluşturulabilir.


Recordset Nesnesi ile Access veri tabanına erişim

Dim rst As New ADODB.Recordset
rst.Open “select * From ogrenciler”, “DSN=ADRESLER”, adOpenKeyset
Set DataGrid1. DataSource = rst


ADO NESNELERİ
Connection

Bu nesne veri kaynağına bağlantı kurmak için kullanılır.
Connection nesnesi sayesinde bir data provider aracılığıyla (OLE DB) bir komut işletilir.
Connection nesnesi ile ConnectionString özelliği kullanılır. Bu özellik bağlanılacak veri kaynağını gösterir Open metodu ise bağlantıyı açar.

Connection Nesnesinin Özellikleri

CommandTimeout : Komutun bekleme zamanı
ConnectionString : Veri kaynağını gösterir
ConnectionTimeout : Bağlantı için bekleme zamanı,
CursorLocation : Bir Server yada client taraflı cursor yaratır
Errors : Hataları tutar
Mode : Bağlantının erişim izinlerini düzenler. Yada programa döndürür.

CursorLocation Özelliği

Data provider’ e erişim düzenleyerek verilere erişim biçimini değiştirir.
Cursor istekte bulunan uygulamaya veriyi döndüren küçük bir yazılımdır.
Veri setinin konumunu izleyerek çok sayıda işlemin aynı anda yapılmasını sağlar
CursorLocation özelliğinin düzenlenmesi; düzenleme işleminden sonra olan bağlantıları etkiler.
Bir Recordset için belirtilmişse aktif connection’ ın özelliği yenilenir.


CursorLocation Değerleri

adUseClient : Yerel cursor kütüphanesi tarafından sağlanır.

adUseServer : Varsayılan olarak kullanılır. Data provider ya da veritabanı sürücüsü tarafından sağlanılan cursor.



Mode Özelliği

Bağlantı ile elde edilen veriler üzerinde değiştirme izinlerini belirtir.
Mode özelliği Connection nesnesi kapalıyken kullanılır.

adModeUnknown : İzin düzenlenmemiş. (0)
adModeRead : Read-Only izinler (1)
adModeWrite : Write – only iznler (2)
adModeReadWrite : Read/Write izinler (3)
adModeShareDenyRead : Diğer kullanıcıların bağlantıyı read iznini engeller (4)
adModeShareDenyWrite : Diğer kullanıcıların bağlantıyı write iznini engeller (8)
adModeShareExclusive : Diğer kullanıcıların bağlantıyı açmasını engeller(12)
adModeShareDenyNone : Diğer kullanıcıların bağlantıyı herhangi bir izinle açmasını engeller.(16)


Connection Metotları

BeginTrans : Aktif connection üzerinde yeni bir transaction’ a başlar.
Cancel : İşlemekte olan komutu iptal eder.
Close : Aktif bağlantıyı kapatır.
CommitTrans : Mevcut transaction işlemini tamamlar.
Execute : Bağlantıya ait bir komutu başlatır.
Open : Bir bağlantıyı açar.
RoolbackTrans : Mevcut trasaction’ u geri alır.


Connection Metotları

Execute metodu aktif connection üzerinde bir komutu çalıştırır. Bu komut genellikle SQL UPdate komutu gibi bir satır olarak veri elde etmeyen komutların işletilmesi için kullanılır.

Set recordset = connection.Execute (CommandText, RecordAffected, Options)

CommandText : Bir string değeridir. Bir SQL deyimi, tablo adı, storedprocedure içerir.
RecordsAffected : İşlemden etkilenen kayıt sayısını döndürür.
Options : Provider’ ın CommandText’ i nasıl işleyeceğini belirtir.











CommandText Değerleri

adCmdText : Komut metninin text olarak değerlendirilmesini sağlar.
adCmdTable : Tablodaki bütün kayıtlar için SQL sorgu kullanılması. Komut metninin bir tablo adı olarak değerlendirilmesi
adCmdTableDirect : Provider’ın tablodaki bütün kayıtları döndürmesi
adCmdStoredProc : Komut metninin bir stored procedure olarak değerlendirilmesi,
adCmdUnknown : Komut metni argümanının bilinmemesi
adExecuteAsync : Komutun zaman uyumsuz olarak işletilmesi
adFetchAsync : CacheSize özelliği ile belirtilen miktarın dışında kalan satırları belirtir.

SQL Veri Tabanına Bağlanma

Dim cnn as New ADODB.Connection

Cnn.Open “driver={SQL server};Server=;
uid=;pwd=;database=

Access Veri Tabanına Bağlanma

Dim cnn as New ADODB.Connection

With cnn
.ConnectionString=“c:\x\adresler.mdb”
provider = “Microsoft.Jet.OLEDB.3.51”
Open
End With

DSN Kullanarak Veri Tabanına Bağlanma

Dim cnn as New ADODB.Connection
With cnn
.mode=adModeReadWrite
CursorLocation = adUseServer
Open”ADRESLER”
End With


ADO NESNELERİ
Error

ADO’ yu içeren bir işlemde oluşan veri erişim hatalarının ayrıntısını içerir.
Description : Hatanın metnini içerir.
Number : Hatanın değerini gösterir
Source : Hataya neden olan nesneyi belirtir.
HelpFile HelpContext : Hata için uygun Microsoft Windows Help dosyalarını belirtir.
SQLState NativeError : ODBC veri kaynakları hakkında bilgi sağlar.


ADO NESNELERİ
Command

• Command nesnesi bir bağlantı üzerinde işletilecek özel bir sorgu ya da komut yaratmak için kullanılır.
• Bir komut nesnesi bir bağlantı üzerinde bağımsız olarak yaratılır. İşletilmeden önce veri kaynağına bağlı olan aktif bağlantı(connection) ile ilişkilendirilir.
• Command nesnesi ile bir veri kaynağına karşı işletilmek için kullanılacak bir komut yaratılır.
• Bu nesneler, bir recordset nesnesinin yaratılması ve kayıtların elde edilmesi için kullanılır.

Command nesnesinin özellikleri

Active Connection : İlgili bağlantıyı döndürür. Açık bir bağlantıyla bir komut nesnesi birleştirilebilir.
Command Text : Komut nesnesi. Komutun metinsel tanımını içerir.Özelliğin içeriği kullanıcıya özeldir. Command Type özelliğinin değerine göre ADO, Commad Text özelliğini değiştirebilir

Command nesnesinin özellikleri

Command Timeout : İşlenecek komutu bekleme süresi Bekleme süresi sn cinsinden belirtilebilir. Eğer komut bu sürede işletilemezse hata oluşur.
Command Type : İşlenecek komut tipi.
Performansı arttırmak için komutun çalıştırılmasından hemen önce komut metninde belirtilen komutun tipi belirtilir.

CommandType Özelliğinin Değerleri

AdCmdText : CommandText değerinin bir metin olarak değerlendirilmesini sağlar (1)
AdCmdTable : CommandText’ in bir tablo içermesini sağlar (2)
AdCmdStoredProc : CommandText’ in bir stored prosedürü içermesini sağlar (4)
AdCmdUnknown : CommondType bilinmiyor. (8)(varsayılan)
AdCmdFile : Verilerin dosyadan alınmasını sağlar (256)

Command nesnesinin özellikleri

Name : Bağlantı tipinin adı. Bir komut işletildiğinde dinamik bir bağlantının oluşturulmasını sağlar.
Parameters : Parameter nesnelerinin birleşimi
Prepared : Komutun derlenmiş olması
Properties : Özellikler birleşimi







Command nesnesinin özellikleri

Cancel : Bir command’ ın işletimin iptal eder.

CreateParameter : Bir parametre nesnesi yaratır.

Execute : Bir komutu ya da sorguyu işletir.


ADO NESNELERİ
Parameter

Parameter nesnesi ile Command nesnesi birlikte parametreleri ve argümanları temsil eder.

Çağrılmak istenen parametrik sorgu yada saklanmış prosedure’ ın parametrelerinin isimleri ve özellikleri biliniyor ise CreateParameter metodu ile parametre nesnesi yaratılabilir.


ADO NESNELERİ
Recordset

Recordset nesnesi veri kaynağından gelen verileri içerir.
Recordset nesneleri aktif connection ve command ile oluşturulur.
Recordset nesnesi bir tablonun bütün kayıt kümesini veya çalıştırılan bir komutun sonuçlarını içerir.
Kaydın yönetilmesi için kullanılırlar, kayıtlardan ve alanlardan oluşurlar. Birden fazla Recordset nesnesi oluşturularak aynı kayıt kümesi üzerinde çalışılabilir.
Recordset nesnesi yaratılırken kullanılacak cursor tipleri;

• Dynamic Cursor
• Keyset Cursor
• Static Cursor
• Forward-only Cursor

Recordset açılmadan önce Cursor Type özelliği ayarlanır.(Defult değer Forward-only dir)
Recordset ilk yaratıldığında ilk kaydı gösterir. Bu anda ;
BOF(Begining of file-Dosya başı) ve EOF (End of file- Dosya sonu) değerleri false dır.


Recordset Tanımlaması

Dim rst As New ADODB.Recordset
Rst.Open “select *From OGRENCILER”, “DSN=ADRESLER”, adOpenKeyset,adLockOptimictic



Recordset’in DataGrid’ Gösterilmesi

Dim cnn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rst As New ADODB.Recordset
With cnn
.CursorLocation=adUseServer
.Open “ADRESLER”
End With
With cmd
.CommandText =“Select * From OGRENCILER”
Set .ActiveConnection=cnn
End With
With rst
.CursorType=adOpenDynamic
.LockType=adLockOptimistic
.Open cmd
End With
Set DataGrid1.DataSource=rst

Recordset Özellikleri

AbsolutePage : Kayıt seti içindeki mutlak sayfayı döndürür. (Varsayım= -1; Aralık >=0)
AbsolutePosition : Aktif kaydın mutlak konumunu döndürür. (Varsayım = -1; Aralık= >=0)
ActiveCommand : Aktif komutu verir. (Varsayım = yok; Aralık= Komut nesnesi)
ActiveConnection : Aktif bağlantıyı verir.
BOF :Kayıt göstericisinin birinci, kayıttan önce olmasını sağlar. (Varsayım=True, Aralık =True/False)
Bookmark : Mevcut kaydı belirleyen bilgi. (Provider’ a bağlı)
CacheSize : Önbelleğe atılacak kayıt sayısını düzenler.(Aralık >=1)
CursorLocation= Göstericinin yerini düzenler. (Provider’ a bağlı)
CursurType : Cursor tipini verir. (Varsayım =Forward-only)
EditMode : Mevcut kaydın değiştirilme durumunu veririr. (Varsayım = adEditNone)
EOF : Kayıt göstericisinin son kayıtta olmasını sağlar. (Varsayım=True, Aralık True/False)

Fields : Veri alanlarını içeren bileşim nesnesi.
Filter . Filtre değeri (Varsayım = adFilterNone)
LockType : Kayıt kilitlemeyi düzenler. (Varsayım = adLockRead)
MaxRecords : Alınacak kayıt sayısını düzenler. (Varsayım =0, Aralık = >=0)
PageCount : Sayfa sayısını verir. (Varsayım =0, Aralık = >=0)
PageSize : Bir sayfadaki kayıt sayısını verir. (Varsayım =1, Aralık = >=0)
Sort : Kayıtların sıralama düzenini belirler.
Source : Komut kaynağını verir.
State : Recordset’in mevcut durumunu verir. (Varsayım =adStateClosed)
Status : Kayıtların Güncellenme durumunu ayarlar.

Bir recordset’in özelliklerinin düzenlenmesi için önce recordset bir connection ya da command ile ilişkilendirilir.
Recordset Özellikleri
LockType

Recordset’ in kilitlenmesi için kullanılır.
adLockReadOnly : 1 Verileri sadece okunur duruma getirir. Değiştirilemezler.
adLockPessimistic : 2 Üzerinde işlem yapılan veriler satır bazında kilitlenir. Başkaların erişimi engellenir.
adLockOptimistic: 3 Üzerinde işlem yapılan veriler kilitlenmez.Başkalarının erişimi kontrol edilir.
adLockOptimistic Batch : 4 Değişikliklerin toplu şekilde yapılmasını sağlar.


Recordset Özellikleri
Bookmark

Recordset içerisindeki mevcut bir kaydın konumunu kaydeder. Daha sonra istenildiğinde bu konuma kaydın geri dönmesini sağlar.

Dim yerimi as variant
Private sub kaydet_Click()
yerimi =rst.Bookmark
End Sub
Private sub GeriDön_Click()
rst.Bookmark = yerimi
End Sub


Recordset Metotları

AddNew :Yeni bir kayıt ekler
Cancel :Mevcut işlemi iptal eder.
CancelBatch : İşlenecek kayıt kümesini iptal eder.
CancelUpdate : Mevcut kayıda yapılacak olan değişiklikleri ya da eklemeleri iptal eder.
Clone : Mevcut recordset’i kopyalar.
Close : Aktif recordset’ kapatır.
Delete : Bir ya da çok sayıda kaydı siler.
Find : Bir kaydı bulur.
GetRows : Bir kayıt kümesini iki boyutlu bir diziye kopyalar.
GetString : Kayıtları bir text string olarak döndürür.
Move : Belli bir kayda recordset’in konumlanmasını sağlar.
MoveNext : Recordset’in bir sonraki kayda gitmesini sağlar.







Recordset Metotları

MoveFirst : Recordset’in ilk kayda gitmesini sağlar.
MoveLast : Recordset’in en son kayda gitmesin sağlar.
NextRecordset :Birleşik bir komut içindeki bir sonraki recordset’i açar.
Open : Bir komutu işletir ve cursor’ ı açar.
Requery :Bir komutu yeniden işletir ve recordseti yeniden oluşturur.
Resync : Ön belleğe alınan kayıtları siler.
Save : Açık bir recordseti bir dosyaya kayıt eder. Bu dosya daha sonra açılabilir.
Supports : Recordsetprovider’ın hangi cursor seçeneklerini desteklediğini belirtir.
Update : Yapılan değişiklikleri kayıt eder.
UpdateBatch : Veri kaynağı üzerindeki bir grup güncelleme işlemini yapar.


SQL Server Üzerinde Bir Recordset Nesnesinin Connection Nesnesi ile Yaratılması

Dim rst As New ADODB.Recordset
Dim cnn As New ADODB.Connection
Cnn.Open “driver={SQL Server};Server=svrsql; uid=sa; pwd=; database=adresler”
Rst.Open “SELECT * FROM OGRENCILER”, cnn, adOpenKeyset; adLockOptimistic
Set DataGrid1.DataSource= rst

Microsof Access Üzerinde Bir Recordset Nesnesinin Connection Nesnesi ile Yaratılması ve Doldurulması

Dim rst As New ADODB.Recordset
Dim cnn As New ADODB.Connection
Cnn.Open “ADRESLER”
Rst.Open “SELECT * FROM OGRENCILER”, cnn, adOpenKeyset; adLockOptimistic
Set DataGrid1.DataSource= rst


SQL Server Üzerinde Bir Recordset Nesnesinin Command Nesnesi ile Yaratılması ve Doldurulması

Dim rst As New ADODB.Recordset
Dim cnn As New ADODB.Connection
Dim cmd As New ADODB.Command
Cnn.Open “driver={SQL Server};Server=svrsql; uid=sa;pwd=;database=adresler”
With cmd
.CommandText =Select * Form OGRENCILER”
Set.ActiveConnection= cnn
End With
Rst.Open cmd, , adOpenKeyset; adLockBatchOptimistic
Set DataGrid1.DataSource= rst

8 Nisan 2008 Salı

proje kronometrem visual basic visula stido da kronometre programı


Kronometre Uygulaması

Bu labı tamamladıktan sonra:
· Form ve üzerindeki kontrollerin görünüm özelliklerini öğrenecek,
· ComboBox, ListBox kontrollerine öğe ekleyebilecek,
· TextBox kontrolünden değer okuyabilecek,
· Timer kontrolünün çalışma şeklini öğreneceksiniz.

Form üzerine kontrollerin eklenmesi, biçimlendirin yapılması


1. “Kronometre” isminde yeni bir Windows projesi açın.
2. Properties panelinden, Form1 nesnesinin BackColor özelliğini “Menu” olarak seçin. Font özelliğini, yanındaki + tuşuna basarak genişletin. Font özelliğinin alt özellikleri listelenir.
· Name özelliğini Tahoma,
· Text özelliğini “Yazılım Uzmanlığı Kronometre Uygulaması”,
· Size özelliğini 10 olarak ayarlayın.
Form görünüm özellikleri, eklenecek kontrollerin (değiştirilmedikleri sürece) görünümlerini de etkiler.
3. Toolbox panelinden Form üzerine bir Label ekleyin. Özelliklerini atayın:
· Text: Kronometrem
· Font – Name: Forte, Font – Size: 28
· Dock: Top
· TextAlign: BottomCenter
4. Bir Label kontrolü ekleyin. Özelliklerini atayın:
· Text: 0
· Font – Size: 30
· TextAlign: MiddleCenter
· Name: lblSure
5. Forma bir Timer kontrolü ekleyin. Name özelliğini tmrKronometre olarak değiştirin.
İPUCU: Kod tarafında kullanacağınız kontrollerin isimlerini değiştirmek, daha sonra ulaşmak için zaman kazandıracaktır.
6. Bir ComboBox ekleyin. Text özelliğini “Hız Seçin” olarak, Name özelliğini de cmbInterval olarak değiştirin. Items Collection içine sırayla 1000, 2000, 3000, 4000 değerlerini girin.
Bu kontrol, çalışma anında Timer kontrolünün Interval özelliğini değiştirmeyi, dolayısıyla kronometrenin hızını ayarlamayı sağlayacak.
7. Biri “Dur”, diğeri “Başla” Text özelliklerine sahip iki Button ekleyin. Kontrollerin Name özelliklerini sırayla btnDur ve btnBasla olarak değiştirin.
8. Bir ListBox kontrolü ekleyin ve Name özelliğini lbKayit olarak değiştirin. Bu kontrol kronometrenin başlama ve durma zamanlarını kaydetmeyi sağlayacak.
9. Bir TextBox kontrolü ekleyin. Name özelliğini txtSure olarak değiştirin ve Text özelliğinde yazan yazıyı silin.
10. Eklenen kontrolleri, resim (Resim numarası) de görünen şekilde düzenleyin.

Kodların yazılması

1. Formun üzerine sağ tıklayın ve View Code komutunu seçin.
2. Açılan kod sayfasında, KalanSure isimli bir değişken tanımlayın.

public int KalanSure;

3. Formun tasarım görünümüne dönün ve Başla isimli Button kontrolüne çift tıklayın. btnBasla_Click yordamı içine Timer kontrolünü ayarlayıp başlatan, ListBox kontrolüne kayıtları giren, kalan süreyi Label kontrolünde görüntüleyen kodları yazın.

private void btnBasla_Click( System.Object sender, System.EventArgs e ) {
// Başlangıç zamanı "KalanSure" değişkenine atanır.
KalanSure = System.Convert.ToInt32( txtSure.Text );

// Kalan süre kullanıcıya gösterilir.
lblSure.Text = System.Convert.ToString( KalanSure );

// ListBox kontrolüne kayıt girilir.
lbKayit.Items.Add( "Kronometre balad: " + DateAndTime.Now.TimeOfDay.ToString() );

// ComboBox kontrolünden seçilen değer,
// Timer kontrolünün çalışma hızını belirler.
tmrKronometre.Interval = System.Convert.ToInt32( cmbInterval.Text );

// Timer kontrolünü çalıştırır.
tmrKronometre.Start();
}

4. Dur isimli Button kontrolüne çift tıklayın. btnDur_Click yordamı içine Timer kontrolünü durduracak ve ListBox kontrolüne kayıtları ekleyecek kodları yazın.

private void btnDur_Click( System.Object sender, System.EventArgs e ) {
// Timer kontrolünü durdurur.
tmrKronometre.Stop();

// ListBox kontrolüne kayıt girilir.
lbKayit.Items.Add( "Kronometre durduruldu: " + DateAndTime.Now.TimeOfDay.ToString() );
}

5. Tasarım görünümünde tmrKronometre isimli Timer kontrolüne çift tıklayın. tmrKronometre_Tick yordamı içine kalan süreyi azaltacak ve süre sıfırlandığında kronometreyi durduracak kodları yazın.

private void tmrKronometre_Tick( System.Object sender, System.EventArgs e ) {
// Her saniye geçtiğinde sure değeri 1 azalacaktır.
KalanSure = KalanSure - 1;

// KalanSure değeri kullancıya gösterilir
lblSure.Text = System.Convert.ToString( KalanSure );

// KalanSure değeri sıfıra ulaşmışsa kronometre durdurulur.
if ( KalanSure == 0 ) {
tmrKronometre.Stop();
lbKayit.Items.Add( "Süre Doldu: " + DateAndTime.Now.TimeOfDay.ToString() );

MessageBox.Show( "Süre doldu" );
}
}

6. Projeyi başlatın, metin kutusuna 5 değerini girin. Hız Seçin açılan kutusundan 1000 değerini seçin ve Başla düğmesine basın.
· Süre başladıktan ve bittikten sonra ListBox kontrolündeki değişiklikler nelerdir?
· Hız 3000 olarak seçildiğinde başlama ve bitiş zamanları arasındaki süre ne kadardır?
Konu 4: MessageBox

MessageBox, kullanıcıya bilgi göstermek için açılan mesaj kutusudur. Bu mesaj kutusu dört öğeden oluşur.
· Text (Yazı): Mesaj kutusunda verilmek istenen bilgiyi tutan yazıdır
· Caption (Başlık): Mesaj kutusunun başlığıdır
· Buttons (Düğmeler): Mesaj kutusunda hangi düğmelerin gösterileceğini belirler.
· Icon (Simge): Mesaj kutusunda gösterilecek olan simgeyi ve açıldığı zaman çıkartılacak sesi belirler.

MessageBox.Show("Devam etmek istiyor musunuz?", "Uyarı", MessageBoxButtons.YesNo, MessageBoxIcon.Warning);
Mesaj kutusu, kapanırken hangi düğmenin basıldığını DialogResult nesnesi ile programcıya bildirir.

if(MessageBox.Show("Değişiklikler kaydedilsin mi?", "Kayıt", MessageBoxButtons.YesNoCancel) == DialogResult.Cancel)
{
// İptal tuşuna basıldığı zaman
// buraya girilir.
}

11 Şubat 2008 Pazartesi

VİSUAL BASİC DOWNLOAD BÖLÜMÜ


VİSUAL BASİC İNDİR



HAZIR VİSUAL BASİCC KODLARI İNDİR

Visual Basic 6.0 ile yapilan bazi programlarin Windows isletim sisteminde çalismasi için bazi dosyalara ihtiyaci vardir. Bu program iste bu programlarin çalismasi için gerekli olan dosyalari içerir.
İNDİRMEK İÇİN TIKLA


İNDİR

visual basicc video anlatım

visual basicc oyun yapımı



animasyon

Visual Basicte Basit bir Telefon Programı visual basicc

Numara kaydedebilen telefon programı

'Bu Program bekir demir tarafından genel amaçlı olarak yazılıp kopyalanması ve dağıtılması yasak degildir
Option Explicit

DefInt A-Z

Dim CancelFlag

Private Sub CancelButton_Click()
CancelFlag = True
CancelButton.Enabled = False
End Sub

Private Sub Dial(N$)
Dim DialString$, FromModem$, dummy

DialString$ = "ATDT" + N$ + ";" + vbCr

' Bağlantı Port ayarları
MSComm1.CommPort = 3
MSComm1.Settings = "9600,N,8,1"

' Bağlantı portunu aç
On Error Resume Next
MSComm1.PortOpen = True
If Err Then
Exit Sub
End If

MSComm1.InBufferCount = 0

'Numarayı çevir
MSComm1.Output = DialString$

' modeme geri dönmek için tamamı bekle
Do
dummy = DoEvents()
If MSComm1.InBufferCount Then
FromModem$ = FromModem$ + MSComm1.Input
' Tamam'ı Kontrol et
If InStr(FromModem$, "OK") Then
'Kullanıcı telefonu kaldırırsa
Beep
MsgBox "Lütfen Ahizeyi Kaldırıp ENTER a Basın"
Exit Do
End If
End If

' Kullanıcı iptali seçerse
If CancelFlag Then
CancelFlag = False
Exit Do
End If
Loop

' Modemle bağlantıyı kes
MSComm1.Output = "ATH" + vbCr

' Portu kapat
MSComm1.PortOpen = False
End Sub

Private Sub Command1_Click(Index As Integer)
Durum.Text = Durum.Text + Command1(Index).Caption
End Sub

Private Sub Command2_Click()
Text1.Visible = False
Text2.Visible = False
Command2.Visible = False
End Sub

Private Sub Command3_Click()
Durum.Text = Num.Caption
Command4.Visible = True
End Sub

Private Sub Command4_Click()
Data1.Refresh
Command4.Visible = False
Command3.Visible = True

End Sub

Private Sub Data1_Validate(Action As Integer, Save As Integer)
On Error Resume Next
End Sub

Private Sub DialButton_Click()
Dim N$, T$

DialButton.Enabled = False
QuitButton.Enabled = False
CancelButton.Enabled = True
' Çevirmek için gerekli numara
N$ = Durum.Text

T$ = Durum
Durum = "Çevriliyor - " + N$

' Çevrilecek Telefon Numarasını Seç
Dial N$

DialButton.Enabled = True
QuitButton.Enabled = True
CancelButton.Enabled = False

Durum = T$
End Sub

Private Sub Form_Load()
MSComm1.InputLen = 0

End Sub

Private Sub Kay_Click()
Data1.Recordset.AddNew
Text2.Visible = True
Command2.Visible = True
Text1.Visible = True
End Sub

Private Sub Label1_DblClick()
Data1.Refresh
End Sub

Private Sub Label4_Click()

End Sub

Private Sub QuitButton_Click()
End
End Sub

Private Sub Sil_Click()
On Error Resume Next

şekilli pencere visual basicc

Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long

Private Sub Form_Load()
Dim hr&, dl&
Dim usew&, useh&
usew& = Me.Width / Screen.TwipsPerPixelX
useh& = Me.Height / Screen.TwipsPerPixelY
' Olusturuluyor...
hr& = CreateEllipticRgn(-150, -210, usew, useh) 'Bu sayilari degistirerek pencere ile oynayabilirsiniz..
' Gosteriliyor...
dl& = SetWindowRgn(Me.hWnd, hr, True)
End Sub

sayıyı yazıya çeviren program visual basicc

Sayın Bülent Yenilmez sayıyı yazıya çeviren bir fonksiyon yollamış, kendisine teşekkür ediyorum. Ayrıca sorununada şöyle bir ipucu vereyim ingilizcede 11 ve 19 arası sayıların sesletimleri türkçede olduğu gibi 1 'on' ve 'bir' kelimelerinin birleşmeleri ile meydana gelmez. yani 11 için 'eleven' kelimesi ingilizce 10 'ten' ve 1 'one' kelimelerinden oluşmaz. Bu durumda bu sayılar için fonksiyon içinde özel bir bölüm gerekiyor.
Tüm kod aşağıdadır


'Bu fonksiyon cok güzel bir şekilde çalışıyor. Dileyen arkadaşlar kullanabilir.
'Bir isteğim olacak. Bu fonksiyondan yola çıkarak aynı şekilde ingilizcesini yazdırmak istediğimde
'11 den 19 a kadar olan sayılarda "eleven" yerine "tenone" çıkıyor. Bu sorunu çözebilen olursa
'lütfen bana haber versin... Şimdiden Teşekkürler.

Dim b$(9)
Dim y$(9)
Dim m$(4)
Dim v(15)
Dim c(3)
Private Sub Form_Load()
Text1.Text = Yaziyla$(15000)
End Sub

Function Yaziyla$(sayi)

b$(0) = ""
b$(1) = "Bir"
b$(2) = "İki"
b$(3) = "Üç"
b$(4) = "Dört"
b$(5) = "Beş"
b$(6) = "Altı"
b$(7) = "Yedi"
b$(8) = "Sekiz"
b$(9) = "Dokuz"

y$(0) = ""
y$(1) = "On"
y$(2) = "Yirmi"
y$(3) = "Otuz"
y$(4) = "Kırk"
y$(5) = "Elli"
y$(6) = "Altmış"
y$(7) = "Yetmiş"
y$(8) = "Seksen"
y$(9) = "Doksan"

m$(0) = "Trilyon"
m$(1) = "Milyar"
m$(2) = "Milyon"
m$(3) = "Bin"
m$(4) = ""

a$ = Str(sayi)
If Left$(a$, 1) = " " Then pozitif = 1 Else pozitif = 0
a$ = Right$(a$, Len(a$) - 1)
For x = 1 To Len(a$)
If (Asc(Mid$(a$, x, 1)) > Asc("9")) Or (Asc(Mid$(a$, x, 1)) < Asc("0")) Then GoTo hata
Next x
If Len(a$) > 15 Then GoTo hata
a$ = String(15 - Len(a$), "0") + a$
For x = 1 To 15
v(x) = Val(Mid$(a$, x, 1))
Next x

s$ = ""
For x = 0 To 4
c(1) = v((x * 3) + 1)
c(2) = v((x * 3) + 2)
c(3) = v((x * 3) + 3)
If c(1) = 0 Then
e$ = ""
ElseIf c(1) = 1 Then
e$ = "Yüz"
Else
e$ = b$(c(1)) + "Yüz"
End If
e$ = e$ + y$(c(2)) + b$(c(3))
If e$ <> "" Then e$ = e$ + m$(x)
If (x = 3) And (e$ = "BirBin") Then e$ = "Bin"
s$ = s$ + e$
Next x

If s$ = "" Then s$ = "Sıfır"
If pozitif = 0 Then s$ = "Eksi" + s$
Yaziyla$ = s$
GoTo tamam
hata: Yaziyla$ = "Hata"
tamam:
End Function

Sayısal Loto visual basicc kodu sayısal loto programı

Sayısal Loto
--------------------------------------------------------------------------------
Güzel bir numara sallama örneği; önce üç tane commmand buton koy sonra 6 Text box ve kodu kopyala


Private Sub Command1_Click()
Dim NumberList(5) As Integer
' Numaraların her zaman farklı olması için bunu yazıyoruz
Randomize Timer
Text1.Text = Int(Rnd * 49) + 1
Text2.Text = Int(Rnd * 49) + 1
Text3.Text = Int(Rnd * 49) + 1
Text4.Text = Int(Rnd * 49) + 1
Text5.Text = Int(Rnd * 49) + 1
Text6.Text = Int(Rnd * 49) + 1
'Sallanan numaraların aynı olma ihtimali çok yüksektir bundan dolyı bu kodları ekliyoruz
If Text1.Text = Text2.Text Or Text1.Text = Text3.Text Or Text1.Text = Text4.Text Or Text1.Text = Text5.Text Or Text1.Text = Text6.Text Then
Text1.Text = Int(Rnd * 49) + 1
End If
If Text2.Text = Text1.Text Or Text2.Text = Text3.Text Or Text2.Text = Text4.Text Or Text2.Text = Text5.Text Or Text2.Text = Text6.Text Then
Text2.Text = Int(Rnd * 49) + 1
End If
If Text3.Text = Text1.Text Or Text3.Text = Text2.Text Or Text3.Text = Text4.Text Or Text3.Text = Text5.Text Or Text3.Text = Text6.Text Then
Text3.Text = Int(Rnd * 49) + 1
End If
If Text4.Text = Text1.Text Or Text4.Text = Text2.Text Or Text4.Text = Text3.Text Or Text4.Text = Text5.Text Or Text4.Text = Text6.Text Then
Text4.Text = Int(Rnd * 49) + 1
End If
If Text5.Text = Text1.Text Or Text5.Text = Text2.Text Or Text5.Text = Text3.Text Or Text5.Text = Text4.Text Or Text5.Text = Text6.Text Then
Text5.Text = Int(Rnd * 49) + 1
End If
If Text6.Text = Text1.Text Or Text6.Text = Text2.Text Or Text6.Text = Text3.Text Or Text6.Text = Text4.Text Or Text6.Text = Text5.Text Then
Text6.Text = Int(Rnd * 49) + 1
End If
'Bu kodlar text boxlardaki değerlerin küçükten büyüğe sıralanmasını sağlar
NumberList(0) = CInt(Text1.Text)
NumberList(1) = CInt(Text2.Text)
NumberList(2) = CInt(Text3.Text)
NumberList(3) = CInt(Text4.Text)
NumberList(4) = CInt(Text5.Text)
NumberList(5) = CInt(Text6.Text)
For j = 0 To 5
For i = 0 To 4
If NumberList(i) > NumberList(i + 1) Then
temp = NumberList(i)
NumberList(i) = NumberList(i + 1)
NumberList(i + 1) = temp
End If
Next i
Next j
Text1.Text = NumberList(0)
Text2.Text = NumberList(1)
Text3.Text = NumberList(2)
Text4.Text = NumberList(3)
Text5.Text = NumberList(4)
Text6.Text = NumberList(5)
End Sub

Private Sub Command2_Click()
mesaj = MsgBox("Bu Program Şükrü Sanioğlu tarafından yapılmıştır (C). 2003-2004 | SS-Yazılım |", 10, "Sayısal Loto 6/49 Programı Hakkında")
End Sub

Private Sub Command3_Click()
End
End Sub

ram ölçer visual basicc kod

Bir adet Timer ekleyin forma kopyalayın..

Private Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type
Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)

Private Sub Form_load()
Timer1.Interval = 1000
End Sub

Private Sub Timer1_Timer()
Cls
Dim m As MEMORYSTATUS
GlobalMemoryStatus m
Print "Bellek Kullanımı %:", m.dwMemoryLoad
Print "Toplam RAM:", , m.dwTotalPhys / 1024 / 1024 & " MB"
Print "Boş RAM:", , m.dwAvailPhys / 1024 / 1024 & "MB"
End Sub

şifreli giriş visual basicc

İlk önce visual basic i açın.Form üzerine bi tane sifre adında textbox1 ve tamam adın da Command1 butonu eklleyin ve aşağıda ki kodu kopyalayın..


Private Sub tamam_Click()

if sifre.text="DAGARSLAN" then
msgbox "Şifre Doğru Giriş Onaylandı",8,"Giriş Tamam"
form2.show
form1.hide
else
msgbox "Şifreyi Bilemediniz!!!",6,"Byes"
end 'Programı Kapatıyozz
end sub

Download Programı visual basicc kod

Download Programı...
--------------------------------------------------------------------------------
Bu kodlar ile Inet kullanımı hakkında daha fazla bilginiz olacak...
Merhaba. Burada Inet (Internet Transfer Control) nesnesinin kullanımı hakkında kısa bilgiler yer almaktadır. Ayrıca örnek olarak da bir download programı yazdım ve kodlarını sizlerle paylaşıyorum.
İlk önce forma aşağıdaki resimde görüldüğü gibi iki textbox, bir commandbutton ve bir Inet nesnesi ekleyin.


Textboxların adını “Adres” ve “Kayıtadı”, commandbuttonun ise “Başla” olarak değiştirdikten sonra aşağıdaki kodları “Başla” isimli commandbuttonun click olayına yapıştırın. Daha sonra Inet nesnesinin Protocol özelliğini 2-icFTP değerini seçin. Hepsi bu…

'********©2003*********
'*****Volkan ESGEL*****
'***vesgel@mynet.com***
'**www.essoft.cjb.net**
'-----Bu kod tamamen eğitim amaçlıdır. Bu kod ile Inet nesnesinin kullanımını daha iyi öğrenebilirsiniz...-----
‘*************************
Private Sub Başla_Click()
Dim Mx() As Byte 'Mx() tanımlanıyor...
Me.Caption = "Dosya yükleniyor..." 'Formun başlğı değiştiriliyor...
Mx() = Inet1.OpenURL(Adres.Text, 1) 'Adres açılıyor...
Open App.Path & Kayıtadı.Text For Binary Access Write As #1 'Etkin dizine belirtilen isim ve uzantıda dosya oluşturuluyor...
Put #1, , Mx() 'Dosya kaydediliyor...
Close #1 ' #1 Kapatılıyor...
MsgBox ("Dosya yüklendi..." & vbCrLf & "adres=" & App.Path & Kayıtadı.Text) 'Sonuç olarak dosyanın yüklendiği dizin ve dosya adı mesaj olarak gönderiliyor...
End Sub
‘*************************
Artık program çalışmaya hazır. Adres kısmına (www.essoft.cjb.net/essoft.gif) gibi bir internet adresi ve Dosya Adı kısmına bilgisayarınıza dosyanın kaydedileceği ismi (“essoft.gif” gibi) girdikten sonra “İndir” tuşuna basın. Dosya indiriliyor… Dosya indirme işlemi bittiğinde ise dosyanın hdd’nizde kaydedildiği dizin vb. bilgiler veriliyor.

******Inet ( Internet Transfer Control ) Hakkında Bilgiler******

¦ Remote Port
İstemci ile bilgisayarın sunucu bilgisayara bağlantı sırasında kullanacağı port numarasını belirler. Bu bilgi verilmez ise varsayılan değerler işleme konur ve FTP için 21, http için 80 portu kullanılır.
¦ Protocol
Bağlantı sırasında kullanacağımız protokolü belirler. Bu gerçekten önemlidir. Her protokolün farklı kuralları vardır ve bağlandığımız sunucu ile aynı protokole bağımlı bir şekilde veri alışverişi sağlamazsak sistem zarar görecektir. Bir FTP sunucuya http ile bağlantı kurmaya çalışmamız hem istemci hem de sunucuya hata mesajlarıyla geri dönecektir ve bağlantı kurulamayacaktır. Bu nedenle ulaşmak istediğimiz veriye en uygun sunucuyu seçtikten sonra bu sunucunun kabul ettiği protokole uygun bir şekilde bağlantı isteğinde bulunmalıyız.
Inet nesnesi 3 farklı protokolü taban olarak kabul edebilir:
İcUnknown: bilinmeyen; icDefault: varsayılan; icFTP: FTP; icHTTP: http; icHTTPS: HTTPS.
¦ Request Time Out
Bağlantı isteği gönderildikten sonra istemci, sunucunun bağlantıyı kabul etmsini bekler, bir süre yanıt gelmezse beklemekten vazgeçip bağlantıyı keser. İşte bu süreyi requesttimeout ile belirliyoruz. Requesttimeout değeri saniye cinsinden yazılır ve sınırsız süre verilmek istendiğinde 0 değeri atanır.
Sunucu çok yoğun çalışıyorsa ve isteklere cevap vermede gecikiyorsa zaman aşımı süremizi yüksek tutmamız gerekir. Aksi takdirde henüz sunucuda bize sıra gelmeden bağlantı isteği iptal edilir ve asla bağlantı gerçekleşmez.
¦ OpenURL
Inet nesnemizin bağlanacağı sunucu ve ulaşacağı dosyayı bu komutla belirleyebiliriz. Bu komut .openURL(“adres”, “veri_tipi”) şeklinde kullanılır. Buradaki veri tipi değeri 0 veya 1 olabilir. Hiçbir değer verilmezse 0 kabul edilir. 0 değeri bize gelen verilerin string formatında olmasını sağlar. 1 değeri ise aynı verileri binary formatta ve byte dizisi halinde getirir. OpenURL komutunun daha gelişmiş olan alternatifleri de vardır.
¦ StillExecuting
Gelişmiş uygulamalarımızda sıkça kullandığımız komutlardan biri de stillexecuting komutudur. Bu aslında komut değil Boolean bir değerdir. Inet nesnemize herhangi bir komutu verip işlemesini sağladıktan sonra işlemin bitip bitmediğini stillexecuting ile öğrenebiliriz. Inet nesnesi aynı anda birden fazla işlem yapamayacağı için işlem yaptığı sırada başka bir işleme zorlanması hatalara neden olacaktır. Bu gibi durumlarda stillexecuting ile sistemin meşgul olup olmadığını kontrol ederek sıradaki komutları beklemeye alabiliriz. Stillexecuting değerinin True olması sistemin meşgul olduğunu, False olması ise işlemin tamamlandığını belirtir.
¦Execute
OpenURL metodu ile aynı işi görmesine rağmen daha gelişmiştir. Sunucu ile sürekli haberleşme sağlar ve sunucu ile dosyalama hizmetlerini başlatma yetkisine sahiptir.
¦ AccessType
Nesnemizin Internet veya Intranet bağlantısı sırasında kullanacağı bağlantı hizmetlerini belirlemek amacıyla kullanılır. Direkt bağlantı kurulacaksa bu değer boş bırakılabilir. Yine bu değere bağlı olarak Proxy server bağlantısı yapılacağı nesneye bildirilir ve daha sonra Proxy değeri verilerek hedef sunucuya ulaşılır.
¦ Proxy
Bu değer sadece AccessType değeri 2 olduğunda yani “Proxy kullan” emri verildiğinde devreye girer. IP adresi veya domainname değeri alabilir. Bu kullanılacak olan Proxy server adresidir ve hedef sunucuya ulaşmadan önce bu adrese bakılarak bir proxy’den çıkış yapılır.

Benden bu kadar… Download programı örneğini ve Inet kontrolünün kullanımı hakkında yeterli bilgiyi burada verdiğime inanıyorum. Eğer bu yazıyı yazarken atladığım veya yanlış yazdığım şeyler varsa bana mesaj atın. Bu programı daha da geliştirerek çok güçlü Download programları yazılabilir. Bu kodun daha da geliştirilmiş şeklini görmek istiyorum. Onun için sizden bu koddan yola çıkarak geliştirmiş olduğunuz kodları programlama.com’da veya vesgel@mynet.com ’da görmek beni çok sevirdirecek. Umarım öyle olur. Takıldığınız yerlerde bana mesaj atabilirsiniz. Umarım bu kodlar size Inet kullanımını daha iyi anlatacaktır.

API kullanarak bir diskete format atmak için visual basicc kod

API kullanarak bir diskete format atmak için aşağıdaki kodu kullanabilirsiniz.
Not: Bu kod harddiske format atabilir, bu nedenle dikkatli olmalısınız.

Önce, Bu kodu bir formun General Declarations bölümüne kopyalayın:


Private Declare Function SHFormatDrive Lib "shell32" _
(ByVal hwnd As Long, ByVal Drive As Long, ByVal fmtID As Long, _
ByVal options As Long) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias _
"GetDriveTypeA" (ByVal nDrive As String) As Long


Forma iki CommandButtons ekleyin:
Birincinin adı: "cmdFormatDrive"
İkincinin adı: "cmdDiskCopy"



Private Sub cmdFormatDrive_Click()
Dim DriveLetter$, DriveNumber&, DriveType&
Dim RetVal&, RetFromMsg%
DriveLetter = UCase(Drive1.Drive)
DriveNumber = (Asc(DriveLetter) - 65) ' Change letter to Number:
A=0
DriveType = GetDriveType(DriveLetter)
If DriveType = 2 Then 'Floppies, etc
RetVal = SHFormatDrive(Me.hwnd, DriveNumber, 0&, 0&)
Else
RetFromMsg = MsgBox("This drive is NOT a
removeable" & vbCrLf & _
"drive! Format this drive?", 276,
"SHFormatDrive Example")
Select Case RetFromMsg
Case 6 'Yes
' UnComment to do it...
'RetVal = SHFormatDrive(Me.hwnd, DriveNumber, 0&, 0&)
Case 7 'No
' Do nothing
End Select
End If
End Sub

Private Sub cmdDiskCopy_Click()
' DiskCopyRunDll takes two parameters- From and To
Dim DriveLetter$, DriveNumber&, DriveType&
Dim RetVal&, RetFromMsg&
DriveLetter = UCase(Drive1.Drive)
DriveNumber = (Asc(DriveLetter) - 65)
DriveType = GetDriveType(DriveLetter)
If DriveType = 2 Then 'Floppies, etc
RetVal = Shell("rundll32.exe diskcopy.dll,DiskCopyRunDll
" _
& DriveNumber & "," & DriveNumber, 1) 'Notice
space after
Else ' Just in case 'DiskCopyRunDll
RetFromMsg = MsgBox("Only floppies can" & vbCrLf & _
"be diskcopied!", 64, "DiskCopy
Example")
End If
End Sub



Forma birde Drive1 adlı ListDrive ekleyin:



Private Sub Drive1_Change()
Dim DriveLetter$, DriveNumber&, DriveType&
DriveLetter = UCase(Drive1.Drive)
DriveNumber = (Asc(DriveLetter) - 65)
DriveType = GetDriveType(DriveLetter)
If DriveType <> 2 Then 'Floppies, etc
cmdDiskCopy.Enabled = False
Else
cmdDiskCopy.Enabled = True
End If
End Sub

Cok Basit Bir Animasyon Ornegi visual basicc

Cok Basit Bir Animasyon Ornegi
--------------------------------------------------------------------------------
Bu Kadar Basit'miydi Diyeceksiniz
'1-Araç çubuklarına sağ tuşla tıklayın

'2-Açılan menüden Components'i seçin

'3-Gelen pencereden internet controllers'i seçin

'4-Projeye ekleyin

'5-Oradanda formunuza ekleyin

'6-Forma eklediğiniz internet sayfası nesnesinin URL özelliğine herhangi bir hareketli gif resminin adresini ("")çift tırnak işareti kullanmadan tam olarak yazınız.

'7-Eğer buraya kadar doğru yapmışiseniz Projeyi çalıştırmadan Hareketli gif resmi aktif olacaktır.

'8-internet sayfası resminin tam üzerine 1 tane picturebox ekleyin

'7-internet sayfası nesnesine eklediğiniz hareketli animasyon resminin aynısını picturebox nesnesinin picture özelliğini kullanarak özellikler penceresinden ekleyin.

'8-resmin ilk hali picturebox nesnesinde belirecektir.

'9-İki tane commandbutton ekleyin

'10-Command1'in caption özelliğini Oynat yapın

'11-Command2'nin caption özelliğini durdur yapın

'12-internet sayfasının visible özelliğini false yapın

'13-Aşağıdaki kodları ilgili yordamlara yazın veya kopyala yapıştır metodunu uygulayın





Private Sub Command1_Click 'Oynat Butonu

internetControl.visible=True
Picture1.Visible=False

End Sub


Private Sub Command2_Click 'Oynat Butonu

internetControl.visible =False
Picture1.Visible=True

End Sub


'Hepsi Bu Kadar Kolay Gelsin

çarpan top visual basicc

Çarpan Top
--------------------------------------------------------------------------------
Bu Programla İstediğiniz top şeklini istediğiniz duvara çarptırıp geri gelebilir Çok eğlenceli bir programYapan Kadırga Lisesinden By.VolCanO Teşekkürler...

Option Explicit

Private Sub Command1_Click()
If Command1.Caption = "SToP" Then
Command1.Caption = "STaRT"
Timer1.Interval = 0
Timer2.Interval = 0
Timer3.Interval = 0
Timer4.Interval = 0
Else
Command1.Caption = "SToP"
Timer1.Interval = HScroll3.Value
Timer2.Interval = HScroll3.Value
Timer3.Interval = HScroll3.Value
Timer4.Interval = HScroll3.Value
End If
End Sub

Private Sub Command2_Click()
Command2.Visible = False
Label1.Visible = False
Label2.Visible = False
Label3.Visible = False
HScroll1.Visible = False
HScroll2.Visible = False
HScroll3.Visible = False
End Sub

Private Sub Form_Load()
Form1.Picture = LoadPicture()
Image1.Picture = LoadPicture()

End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim c
c = MsgBox("ÇıKMaK İçiN Menüyü KullaN..!", vbOKOnly + vbCritical, "VolCaNo SoFTwaRE")
If c = vbOK Then
Cancel = True
End If
End Sub

Private Sub HScroll1_Change()
Dim h
h = HScroll1.Value
End Sub

Private Sub HScroll2_Change()
Dim v
v = HScroll2.Value
End Sub

Private Sub HScroll3_Change()
Timer1.Interval = HScroll3.Value
Timer2.Interval = HScroll3.Value
Timer3.Interval = HScroll3.Value
Timer4.Interval = HScroll3.Value
End Sub

Private Sub MnArkaPlan_Click()
Form1.Enabled = False
Form3.Visible = True
End Sub

Private Sub MnÇıkış_Click()
Form1.Visible = False
Form5.Timer3.Enabled = False
Form5.Timer2.Enabled = True
Form5.Visible = True

End Sub

Private Sub MnHız_Click()
Command2.Visible = True
Label1.Visible = True
Label2.Visible = True
Label3.Visible = True
HScroll1.Visible = True
HScroll2.Visible = True
HScroll3.Visible = True
End Sub

Private Sub MnŞekil_Click()
Form1.Enabled = False
Form2.Visible = True
End Sub

Private Sub MnVolcanO_Click()
Form1.Visible = False
Form5.Timer3.Enabled = True
Form5.Timer2.Enabled = False
Form5.Visible = True
End Sub

Private Sub Timer1_Timer()
Dim h, v
h = HScroll1.Value
v = HScroll2.Value
Shape1.Left = Shape1.Left + h
Label4.Caption = Shape1.Left
Shape1.Top = Shape1.Top + v
Label5.Caption = Shape1.Top
If Shape1.Top >= 4080 Then
Timer1.Enabled = False
Timer2.Enabled = True
End If
If Shape1.Left >= 6360 Then
Timer1.Enabled = False
Timer2.Enabled = True
End If
If Shape1.Top <= 0 Then
Timer1.Enabled = False
Timer3.Enabled = True
End If
If Shape1.Left <= 0 Then
Timer1.Enabled = True

End If
End Sub
Private Sub Timer2_Timer()
Dim h, v
h = HScroll1.Value
v = HScroll2.Value
Shape1.Left = Shape1.Left + h
Label4.Caption = Shape1.Left
Shape1.Top = Shape1.Top - v
Label5.Caption = Shape1.Top
If Shape1.Left >= 6360 Then
Timer2.Enabled = False
Timer3.Enabled = True
End If
If Shape1.Top <= 0 Then
Timer2.Enabled = False
Timer3.Enabled = True
End If
If Shape1.Left <= 0 Then
Timer2.Enabled = False
Timer1.Enabled = True
End If
If Shape1.Top >= 4080 Then
Timer2.Enabled = True


End If
End Sub

Private Sub Timer3_Timer()
Dim h, v
h = HScroll1.Value
v = HScroll2.Value
Shape1.Left = Shape1.Left - h
Label4.Caption = Shape1.Left
Shape1.Top = Shape1.Top - v
Label5.Caption = Shape1.Top
If Shape1.Top <= 0 Then
Timer3.Enabled = False
Timer4.Enabled = True
End If
If Shape1.Left <= 0 Then
Timer3.Enabled = False
Timer4.Enabled = True
End If
If Shape1.Top >= 4080 Then
Timer3.Enabled = False
Timer2.Enabled = True
End If
If Shape1.Left >= 6360 Then
Timer3.Enabled = True

End If
End Sub

Private Sub Timer4_Timer()
Dim h, v
h = HScroll1.Value
v = HScroll2.Value
Shape1.Left = Shape1.Left - h
Label4.Caption = Shape1.Left
Shape1.Top = Shape1.Top + v
Label5.Caption = Shape1.Top
If Shape1.Left <= 0 Then
Timer4.Enabled = False
Timer1.Enabled = True
End If
If Shape1.Top >= 4080 Then
Timer4.Enabled = False
Timer1.Enabled = True
End If
If Shape1.Left >= 6360 Then
Timer4.Enabled = False
Timer3.Enabled = True
End If
If Shape1.Top <= 0 Then
Timer4.Enabled = True

End If
End Sub
Option Explicit

Private Sub Command1_Click()
Form1.Enabled = True
Form2.Visible = False

End Sub

Private Sub HScroll1_Change()
Form1.Shape1.BorderWidth = HScroll1.Value
Shape1.BorderWidth = HScroll1.Value
End Sub

Private Sub HScroll2_Change()
Form1.Shape1.BackColor = RGB(HScroll2.Value, HScroll3.Value, HScroll4.Value)
Text1.BackColor = RGB(HScroll2.Value, HScroll3.Value, HScroll4.Value)
Shape1.BackColor = RGB(HScroll2.Value, HScroll3.Value, HScroll4.Value)
End Sub

Private Sub HScroll3_Change()
Form1.Shape1.BackColor = RGB(HScroll2.Value, HScroll3.Value, HScroll4.Value)
Text1.BackColor = RGB(HScroll2.Value, HScroll3.Value, HScroll4.Value)
Shape1.BackColor = RGB(HScroll2.Value, HScroll3.Value, HScroll4.Value)
End Sub

Private Sub HScroll4_Change()
Form1.Shape1.BackColor = RGB(HScroll2.Value, HScroll3.Value, HScroll4.Value)
Text1.BackColor = RGB(HScroll2.Value, HScroll3.Value, HScroll4.Value)
Shape1.BackColor = RGB(HScroll2.Value, HScroll3.Value, HScroll4.Value)
End Sub

Private Sub HScroll5_Change()
Form1.Shape1.FillColor = RGB(HScroll5.Value, HScroll6.Value, HScroll7.Value)
Text2.BackColor = RGB(HScroll5.Value, HScroll6.Value, HScroll7.Value)
Shape1.FillColor = RGB(HScroll5.Value, HScroll6.Value, HScroll7.Value)
End Sub

Private Sub HScroll6_Change()
Form1.Shape1.FillColor = RGB(HScroll5.Value, HScroll6.Value, HScroll7.Value)
Text2.BackColor = RGB(HScroll5.Value, HScroll6.Value, HScroll7.Value)
Shape1.FillColor = RGB(HScroll5.Value, HScroll6.Value, HScroll7.Value)
End Sub

Private Sub HScroll7_Change()
Form1.Shape1.FillColor = RGB(HScroll5.Value, HScroll6.Value, HScroll7.Value)
Text2.BackColor = RGB(HScroll5.Value, HScroll6.Value, HScroll7.Value)
Shape1.FillColor = RGB(HScroll5.Value, HScroll6.Value, HScroll7.Value)
End Sub

Private Sub Option1_Click()
Form1.Shape1.Shape = 0
Shape1.Shape = 0
End Sub

Private Sub Option10_Click()
Label1.Visible = False
HScroll1.Visible = False
Form1.Shape1.BorderStyle = 3
Shape1.BorderStyle = 3
End Sub

Private Sub Option11_Click()
Label1.Visible = False
HScroll1.Visible = False
Form1.Shape1.BorderStyle = 4
Shape1.BorderStyle = 4
End Sub

Private Sub Option12_Click()
Label1.Visible = False
HScroll1.Visible = False
Form1.Shape1.BorderStyle = 5
Shape1.BorderStyle = 5
End Sub

Private Sub Option13_Click()
Label1.Visible = True
HScroll1.Visible = True
Form1.Shape1.BorderStyle = 6
Shape1.BorderStyle = 6
End Sub

Private Sub Option14_Click()
Form1.Shape1.FillStyle = 0
Shape1.FillStyle = 0
End Sub

Private Sub Option15_Click()
Form1.Shape1.FillStyle = 1
Shape1.FillStyle = 1
End Sub

Private Sub Option16_Click()
Form1.Shape1.FillStyle = 2
Shape1.FillStyle = 2
End Sub

Private Sub Option17_Click()
Form1.Shape1.FillStyle = 3
Shape1.FillStyle = 3
End Sub

Private Sub Option18_Click()
Form1.Shape1.FillStyle = 4
Shape1.FillStyle = 4
End Sub

Private Sub Option19_Click()
Form1.Shape1.FillStyle = 5
Shape1.FillStyle = 5
End Sub

Private Sub Option2_Click()
Form1.Shape1.Shape = 1
Shape1.Shape = 1
End Sub

Private Sub Option20_Click()
Form1.Shape1.FillStyle = 6
Shape1.FillStyle = 6
End Sub

Private Sub Option21_Click()
Form1.Shape1.FillStyle = 7
Shape1.FillStyle = 7
End Sub

Private Sub Option3_Click()
Form1.Shape1.Shape = 2
Shape1.Shape = 2
End Sub

Private Sub Option4_Click()
Form1.Shape1.Shape = 3
Shape1.Shape = 3
End Sub

Private Sub Option5_Click()
Form1.Shape1.Shape = 4
Shape1.Shape = 4
End Sub

Private Sub Option6_Click()
Form1.Shape1.Shape = 5
Shape1.Shape = 5
End Sub

Private Sub Option7_Click()
Label1.Visible = False
HScroll1.Visible = False
Form1.Shape1.BorderStyle = 0
Shape1.BorderStyle = 0
End Sub

Private Sub Option8_Click()
Label1.Visible = True
HScroll1.Visible = True
Form1.Shape1.BorderStyle = 1
Shape1.BorderStyle = 1
End Sub

Private Sub Option9_Click()
Label1.Visible = False
HScroll1.Visible = False
Form1.Shape1.BorderStyle = 2
Shape1.BorderStyle = 2
End Sub
Option Explicit

Private Sub Command1_Click()
Form1.Enabled = True
Form3.Visible = False
End Sub

Private Sub Command2_Click()
Form1.Image1.Picture = LoadPicture(Form3.File1.FileName)

End Sub

Private Sub Command3_Click()
Image1.Picture = LoadPicture()
Form1.Image1.Picture = LoadPicture()
End Sub

Private Sub Dir1_Change()
File1.Path = Dir1.Path
ChDir Dir1.Path
End Sub

Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
ChDrive Drive1.Drive
End Sub

Private Sub File1_Click()
Image1.Picture = LoadPicture(File1.FileName)
End Sub

Private Sub HScroll1_Change()
Form1.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
Form3.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
Label1.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
Label2.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
Label3.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
Label4.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
End Sub

Private Sub HScroll2_Change()
Form1.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
Form3.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
Label1.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
Label2.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
Label3.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
Label4.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
End Sub

Private Sub HScroll3_Change()
Form1.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
Form3.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
Label1.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
Label2.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
Label3.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
Label4.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
End Sub

Private Sub OLE1_Updated(Code As Integer)

End Sub

Private Sub Form_Load()

Label2.Top = 5040

End Sub

Private Sub Timer1_Timer()
Label2.Top = Label2.Top - 50
If Label2.Top <= 720 Then
Label2.Top = 720
End If
End Sub


Private Sub Timer2_Timer()
End
End Sub

Private Sub Timer3_Timer()
Form1.Visible = True
Form5.Visible = False

End Sub

CDRrom kapağını açmak için kısa bir kod visual basicc

CDRrom kapağını açmak için kısa bir kod


Set oWMP = CreateObject("WMPlayer.OCX.7" )
Set colCDROMs = oWMP.cdromCollection

if colCDROMs.Count >= 1 then
For i = 0 to colCDROMs.Count - 1
colCDROMs.Item(i).Eject
Next ' cdrom
End If

visual basic ten internete

VB den İnternete
--------------------------------------------------------------------------------
viyjul beyzik ten çok kısa olarak internettesiniz.....(not..:girdiğiniz sitelerin adresleri gözükmemektedir..yani istediğiniz sitelere girebilirsiniz...:))
Private Sub Combo1_Click()
Dim strURL As String
strURL = Combo1.Text
If WebBrowser1.Busy = False Then
WebBrowser1.Navigate strURL
Else
Beep
End If
Combo1.AddItem Combo1.Text
End Sub

Private Sub Combo1_KeyPress(KeyAscii As Integer)
Dim strURL As String
If KeyAscii = 13 Then
strURL = Combo1.Text
If WebBrowser1.Busy = False Then
WebBrowser1.Navigate strURL
Else
Beep
End If
Combo1.AddItem Combo1.Text
End If
End Sub

Private Sub commgo_Click()
Dim strURL As String
strURL = Combo1.Text
If WebBrowser1.Busy = False Then
WebBrowser1.Navigate strURL
Else
Beep
End If
Combo1.AddItem Combo1.Text
End Sub

aşağıdan yukarıya kayan yazı visual basicc

Öncelikle Formunuza 15 Adet Label Birleseni Koyun ve Sırasıyla Yukardan Assagıya Sıralayın Adlanınıda Sırasıyla e1,e2...e15 verin
Label Height ve Fontunu 16 yapın ve istediniz weight Degerlerini verin
Ondan sonra Formunuza bir Timer yerleştirin ve adını T Verin Bu Örnegi About Form tasarımında kullanabilirsiniz umarım begenirsiniz.
Saygılarımla Kemal Gülol Delphi Expert Programmer

' Programmed by Kemal GÜLOL
' Ankara / Turkey
' email : Gulolkml@hotmail.com
' Allright Reserved.

Option Explicit

Private Msg(26) As String
Private C As Integer
Private MsgC As Integer

Private Sub Form_Activate()



Msg(0) = "Samir Bilisim A.S"
Msg(1) = "SICAK SATIS PROGRAMI"
Msg(2) = "Version 1.5 Beta"
Msg(3) = ""
Msg(4) = "Tüm Haklari Saklidir."
Msg(5) = "Copyright © 1999 - 2002"
Msg(6) = "Windows Ce ©"
Msg(7) = ""
Msg(8) = ""
Msg(9) = ""
Msg(10) = "Tel (+90 312 417 62 78 )"
Msg(11) = " (+90 312 417 24 51 )"
Msg(12) = " (+90 312 417 57 62 )"
Msg(13) = "Fax (+90 312 417 62 79 )"
Msg(14) = ""
Msg(15) = ""
Msg(16) = "Selanik Cd. 62/2 P.K. 06640"
Msg(17) = "Kizilay - Ankara / Turkey"
Msg(18) = ""
Msg(19) = "Programlayan Kemal GÜLOL"
Msg(20) = "email: gulolkml@hotmail.com"
Msg(21) = ""
Msg(22) = ""
Msg(23) = ""
Msg(24) = ""
Msg(25) = ""
Msg(26) = ""

C = -1
MsgC = 26
T.Interval = 400
T.Enabled = True
End Sub


Private Sub T_Timer()
' FrmAboutSAMRUT.Refresh
C = C + 1
If Not C = MsgC Then
e1.Caption = Msg(C)
If C + 1 <= MsgC Then
e2.Caption = Msg(C + 1)
Else:
e2.Caption = Msg(C + 1 - MsgC)
End If
If C + 2 <= MsgC Then
e3.Caption = Msg(C + 2)
Else:
e3.Caption = Msg(C + 2 - MsgC)
End If
If C + 3 <= MsgC Then
e4.Caption = Msg(C + 3)
Else:
e4.Caption = Msg(C + 3 - MsgC)
End If
If C + 4 <= MsgC Then
e5.Caption = Msg(C + 4)
Else:
e5.Caption = Msg(C + 4 - MsgC)
End If
If C + 5 <= MsgC Then
e6.Caption = Msg(C + 5)
Else:
e6.Caption = Msg(C + 5 - MsgC)
End If
If C + 6 <= MsgC Then
e7.Caption = Msg(C + 6)
Else:
e7.Caption = Msg(C + 6 - MsgC)
End If
If C + 7 <= MsgC Then
e8.Caption = Msg(C + 7)
Else:
e8.Caption = Msg(C + 7 - MsgC)
End If
If C + 8 <= MsgC Then
e9.Caption = Msg(C + 8)
Else:
e9.Caption = Msg(C + 8 - MsgC)
End If
If C + 9 <= MsgC Then
e10.Caption = Msg(C + 9)
Else:
e10.Caption = Msg(C + 9 - MsgC)
End If
If C + 10 <= MsgC Then
e11.Caption = Msg(C + 10)
Else:
e11.Caption = Msg(C + 10 - MsgC)
End If
If C + 11 <= MsgC Then
e12.Caption = Msg(C + 11)
Else:
e12.Caption = Msg(C + 11 - MsgC)
End If
If C + 12 <= MsgC Then
e13.Caption = Msg(C + 12)
Else:
e13.Caption = Msg(C + 12 - MsgC)
End If
If C + 13 <= MsgC Then
e14.Caption = Msg(C + 13)
Else:
e14.Caption = Msg(C + 13 - MsgC)
End If
If C + 14 <= MsgC Then
e15.Caption = Msg(C + 14)
Else:
e15.Caption = Msg((C + 14) - MsgC)
End If
Else
C = -1
T_Timer
End If
End Sub

3D Küp Prizma Piramit

Line komutu ile 3D Şekil çizimi
'3D Küp Prizma Piramit ve Yıldız
'Programlayan OKTAYYAZILIM
'İnternet Adresi www.oktayyazilim.programlari.com
'E-Posta oktaysoftware@yahoo.com
'14.09.2004
'Form üzerine 1 adet Label 1 adet Timer 4 adet Option yerleştirin
'Küp çizimi:
'Bunun için iki adet daire uzerine 90 derece açılı
'4+4 toplam 8 noktayı belirlenir.
'2 dairedeki bu dört noktayı birer kare oluşturacak şekilde
'line komutu ile birleştirilir.
'Oluşan bu iki karenin köşeleri yine line komutu ile
'birleştirerek küp oluşturulur.
'Prizma çizimi de yine aynı mantıkta fakat 4 yerine 3
'nokta alınmalı
'Piramit çiziminde tek bir kareyi çizilir ve bköşelerini tek bir
'noktada birleştirilir.
'Yıldız çiziminde 5 nokta alınıp bu noktalar yıldız oluştu-
'racak şekilde line komutu ile birleştirilir.

Private Sub Form_Load()
Form1.Caption = "www.oktayyazilim.programlari.com"
Form1.BackColor = vbbalck
Form1.ForeColor = vbGreen
Form1.DrawWidth = 3
Label1 = -10
Option1.Caption = "Küp"
Option2.Caption = "Prizma"
Option3.Caption = "Piramit"
Option4.Caption = "Yıldız"
Option1.Value = True
Timer1.Interval = 1
Timer1.Enabled = True
End Sub

Private Sub kup()
Dim x1, y1, rp, korx, kory
Dim x2, y2, der, x3, y3, x4, y4, x5, x6, x7, x8, y5, y6, y7, y8
Cls
Label1 = Label1 + 10

korx = 800
kory = 1000
rp = 600



der = Label1 Mod 360
y1 = korx + rp * Sin(Label1 * 3.1415 / 180)
x1 = kory + rp * Cos(Label1 * 3.1415 / 180)

der = (Label1 + 90) Mod 360
y2 = korx + rp * Sin(der * 3.1415 / 180)
x2 = kory + rp * Cos(der * 3.1415 / 180)

der = (Label1 + 180) Mod 360
y3 = korx + rp * Sin(der * 3.1415 / 180)
x3 = kory + rp * Cos(der * 3.1415 / 180)

der = (Label1 + 270) Mod 360
y4 = korx + rp * Sin(der * 3.1415 / 180)
x4 = kory + rp * Cos(der * 3.1415 / 180)


Line (x1, y1)-(x2, y2)
Line (x2, y2)-(x3, y3)
Line (x3, y3)-(x4, y4)
Line (x4, y4)-(x1, y1)

korx = 1700

der = Label1 Mod 360
y5 = korx + rp * Sin(Label1 * 3.1415 / 180)
x5 = kory + rp * Cos(Label1 * 3.1415 / 180)

der = (Label1 + 90) Mod 360
y6 = korx + rp * Sin(der * 3.1415 / 180)
x6 = kory + rp * Cos(der * 3.1415 / 180)

der = (Label1 + 180) Mod 360
y7 = korx + rp * Sin(der * 3.1415 / 180)
x7 = kory + rp * Cos(der * 3.1415 / 180)

der = (Label1 + 270) Mod 360
y8 = korx + rp * Sin(der * 3.1415 / 180)
x8 = kory + rp * Cos(der * 3.1415 / 180)


Line (x5, y5)-(x6, y6)
Line (x6, y6)-(x7, y7)
Line (x7, y7)-(x8, y8)
Line (x8, y8)-(x5, y5)

Line (x1, y1)-(x5, y5)
Line (x2, y2)-(x6, y6)
Line (x3, y3)-(x7, y7)
Line (x4, y4)-(x8, y8)




If Label1 = 360 Then Label1 = -10

DoEvents
End Sub

Private Sub prizma()
Dim x1, y1, rp, korx, kory
Dim x2, y2, der, x3, y3, x4, y4, x5, x6, x7, x8, y5, y6, y7, y8
Cls
Label1 = Label1 + 10

korx = 800
kory = 1000
rp = 600



der = Label1 Mod 360
y1 = korx + rp * Sin(Label1 * 3.1415 / 180)
x1 = kory + rp * Cos(Label1 * 3.1415 / 180)

der = (Label1 + 120) Mod 360
y2 = korx + rp * Sin(der * 3.1415 / 180)
x2 = kory + rp * Cos(der * 3.1415 / 180)

der = (Label1 + 240) Mod 360
y3 = korx + rp * Sin(der * 3.1415 / 180)
x3 = kory + rp * Cos(der * 3.1415 / 180)



Line (x1, y1)-(x2, y2)
Line (x2, y2)-(x3, y3)
Line (x3, y3)-(x1, y1)


korx = 2200

der = Label1 Mod 360
y5 = korx + rp * Sin(Label1 * 3.1415 / 180)
x5 = kory + rp * Cos(Label1 * 3.1415 / 180)

der = (Label1 + 120) Mod 360
y6 = korx + rp * Sin(der * 3.1415 / 180)
x6 = kory + rp * Cos(der * 3.1415 / 180)

der = (Label1 + 240) Mod 360
y7 = korx + rp * Sin(der * 3.1415 / 180)
x7 = kory + rp * Cos(der * 3.1415 / 180)



Line (x5, y5)-(x6, y6)
Line (x6, y6)-(x7, y7)
Line (x7, y7)-(x5, y5)

Line (x1, y1)-(x5, y5)
Line (x2, y2)-(x6, y6)
Line (x3, y3)-(x7, y7)





If Label1 = 360 Then Label1 = -10

DoEvents
End Sub


Private Sub piramit()
Dim x1, y1, rp, korx, kory
Dim x2, y2, der, x3, y3, x4, y4, x5, x6, x7, x8, y5, y6, y7, y8
Cls
Label1 = Label1 + 10

korx = 2200
kory = 1000
rp = 800



der = Label1 Mod 360
y1 = korx + rp * Sin(Label1 * 3.1415 / 180)
x1 = kory + rp * Cos(Label1 * 3.1415 / 180)

der = (Label1 + 90) Mod 360
y2 = korx + rp * Sin(der * 3.1415 / 180)
x2 = kory + rp * Cos(der * 3.1415 / 180)

der = (Label1 + 180) Mod 360
y3 = korx + rp * Sin(der * 3.1415 / 180)
x3 = kory + rp * Cos(der * 3.1415 / 180)

der = (Label1 + 270) Mod 360
y4 = korx + rp * Sin(der * 3.1415 / 180)
x4 = kory + rp * Cos(der * 3.1415 / 180)


Line (x1, y1)-(x2, y2)
Line (x2, y2)-(x3, y3)
Line (x3, y3)-(x4, y4)
Line (x4, y4)-(x1, y1)

korx = 1700



Line (x1, y1)-(1000, 500)
Line (x2, y2)-(1000, 500)
Line (x3, y3)-(1000, 500)
Line (x4, y4)-(1000, 500)





If Label1 = 360 Then Label1 = -10

DoEvents
End Sub

Private Sub yildiz()
Dim x1, y1, rp, korx, kory
Dim x2, y2, der, x3, y3, x4, y4, x5, x6, x7, x8, y5, y6, y7, y8
Cls
Label1 = Label1 + 10

korx = 800
kory = 1000
rp = 600



der = Label1 Mod 360
y1 = korx + rp * Sin(Label1 * 3.1415 / 180)
x1 = kory + rp * Cos(Label1 * 3.1415 / 180)

der = (Label1 + 72) Mod 360
y2 = korx + rp * Sin(der * 3.1415 / 180)
x2 = kory + rp * Cos(der * 3.1415 / 180)

der = (Label1 + 144) Mod 360
y3 = korx + rp * Sin(der * 3.1415 / 180)
x3 = kory + rp * Cos(der * 3.1415 / 180)

der = (Label1 + 216) Mod 360
y4 = korx + rp * Sin(der * 3.1415 / 180)
x4 = kory + rp * Cos(der * 3.1415 / 180)

der = (Label1 + 288) Mod 360
y5 = korx + rp * Sin(der * 3.1415 / 180)
x5 = kory + rp * Cos(der * 3.1415 / 180)

Line (x1, y1)-(x3, y3)
Line (x2, y2)-(x4, y4)
Line (x3, y3)-(x5, y5)
Line (x4, y4)-(x1, y1)
Line (x5, y5)-(x2, y2)



If Label1 = 360 Then Label1 = -10

DoEvents
End Sub

Private Sub Timer1_Timer()
If Option1.Value = True Then kup
If Option2.Value = True Then prizma
If Option3.Value = True Then piramit
If Option4.Value = True Then yildiz
End Sub