kodyaziyorum.com Ana Sayfa

@kodyaziyorum.com E-Posta Girişi @kodyaziyorum.com Giriş
  Aktif Konular Aktif Konular
  SSS SSS  Forumu Ara   Kayıt Ol Kayıt Ol  Giriş Giriş

Anasayfa Anasayfa » Programlama Dilleri » Görsel Programlama Dilleri » Visual Basic 6.0

Yüzlerce Visual Basic 6.0 Örnekleri

 Yanıt Yaz Yanıt Yaz
Yazar
Mesaj
  Konu Arama Konu Arama  Konu Seçenekleri Konu Seçenekleri
ahmet007 Açılır Kutu Gör
Süper Yazılımcı
Süper Yazılımcı
Simge

Kayıt Tarihi: 05 Aralık 2005
Aktif Durum: Aktif Değil
Gönderilenler: 415
  Alıntı ahmet007 Alıntı  Yanıt YazCevapla Mesajın Direkt Linki Konu: Yüzlerce Visual Basic 6.0 Örnekleri
    Gönderim Zamanı: 19 Mart 2006 Saat 08:21

Listbox'a degisik renklerde item nasil eklenir?
MSFlexGrid control kullanin


Form close butonu nasil çalistirilir?
dim bClose as Boolean
Form'un QueryUnload event'ine ekle:
If bClose = false then cancel = true


Text dosyasina çift tirnak isaretleri olmadan nasil string girisi yapilir?
Write # statement yerine Print # statement kullan
Print # statement stringlerin etrafina çift tirnak koymaz


Bir combo'nun içini diger bir combo'dan aldiklarinizla nasil doldurursunuz?
Sub comboA_click()
comboB.text = comboA.text
End sub

Eger ComboA'daki seçili degerlerin ComboB'ye aktarilmasini istiyorsaniz
Sub comboA_click()
comboB.AddItem comboA.text
end sub


Birden fazla sütun içeren combolar nasil yapilir?
Projenize Microsoft Forms 2.0 control ekleyin, oradaki
combo multi-column destekler.

Combo1.Clear
Combo1.ColumnCount = 2
Combo1.ListWidth = "6 cm" 'Total genislik
Combo1.ColumnWidths = "2 cm;4 cm" 'sütun genisligi
Combo1.AddItem "Ivir zivir"
Combo1.List(0, 1) = "Ivir zivir"

Dikine uzanan label nasil yapilir?
Private Sub Form_Activate()
Dim s As String
Label1.Caption = "Visual Basic 2000"
For i = 1 To Len(Label1)
s = s & Mid$(Label1, i, 1) & vbCrLf
Next
Label1 = s
End Sub
dikkat: Label'i dikine çekmelisiniz

Joker karakterler kullanarak string nasil aranir?
Dim Mystr As String
Mystr = "Hakan"
If Mystr Like "H*" Then
MsgBox "Bulundu"
Else
MsgBox "Bulunamadi"
End If

Her dile uyumlu tarih nasil formatlanir?
Command1.Caption = Format$(Date, "Short Date")

Uyari isareti olan (X) mesaj kutusu nasil yapilir?
MsgBox "Mesaj Buraya!!", vbCritical, "Önemli"

Sadece **** gösteren text kutusu nasil yapilir?
Textbox'un PasswordChar property'sini "*" karakterine esleyin.

Içine tab yerlestirebileceginiz text kutulari nasil yapilir?
Bir form içindeki tüm kontrollerin tabstoplarini False'e esitleyin

Text kutulari için kisayol tuslari nasil belirlenir?
Kisayol tusuna sahip bir label hazirlayin ve label'in tabindex'ini textbox'un tabindexinden
bir asagiya esitleyin.

Text1 içerigi Text2 içine nasil kopyalanir?
VB6.0 kullaniyorsaniz Replace Function ise yarar:

Text2 = Replace(Text1, vbCrLf, "" & vbCrLf)

Diger VB'lerde vbCrLf'leri bulmak için asagidaki kod kullanilir:

Dim sString As String
Dim sNewString As String
sString = Text1
While Instr(sString, vbCrLf)
sNewString = sNewString & Left(sString, _
Instr(sString, vbCrLf) - 1) & "" & vbCrLf
sString = Mid(sString, Instr(sString, vbCrLf) + 2)
Wend
Text2 = sNewString

Command butondan popup menü nasil yapilir?

Öncelikle menü editör ile bir menü yaratin.
Asagidaki gibi:

Button Menu (Menu name: mnuBtn, Visible: False - Unchecked)
....SubMenu Item 1 (Menu name: mnuSub, Index: 0)
....SubMenu Item 2 (Menu name: mnuSub, Index: 1)
....SubMenu Item 3 (Menu name: mnuSub, Index: 2)
....SubMenu Item 4 (Menu name: mnuSub, Index: 3)


ve bir tane de command button hazirlayin ve kodu yerlestirin:

Private Sub mnuSub_Click(Index As Integer)

Call MsgBox("Kliklenen menü: " & Index + 1, vbExclamation)

End Sub

Private Sub Command1_Click()
Call PopupMenu(mnuBtn)
End Sub

Not: Isterseniz daha güzel etki için "Call PopupMenu(mnuBtn)" çagrisi yerine

Call PopupMenu(Menu:=mnuBtn, X:=Command1.Left, Y:=Command1.Top + _
Command1.Height)

çagrisini yada;

Call PopupMenu(mnuBtn, vbPopupMenuCenterAlign, Command1.Left + _
(Command1.Width / 2), Command1.Top + Command1.Height)

çagrisini kullanin.


Text kutusunda olan degisiklik nasil farkedilir?

'Amaç kullaniciyi yaptigi degisiklikler konusunda programi kapatmadan uyarmaktir.

Public Degisti As Boolean 'Bu degisken textbox'ta herhangi bir degisiklik olup olmadigini tutar.
Private Sub Text1_Change()
Degisti= True
End SubPrivate

Sub Form_Unload(Cancel As Boolean)
If Degisti Then
If Msgbox("Degisiklikler kaydedilsin mi?", vbYesNo, "Kayit'") = vbYes Then
'Buraya kaydetme ile ilgili kodlar gelecek
Degisti = False
' Degisti degerini tekrar False yap ki bir sonraki degisiklikte tekrar çalisabilsin. (Bu Önemli!!!!)
'Bunu sadece buradaki If - End If blogu arasina yaz
End If
End If
End Sub

Çalisma aninda Statusbar içerigi nasil degistirilir?
Statusbar1.Panels(1).Text = "Ivir zivir"

Listbox'a bir text dosyasi içerigi nasil yüklenir?
Private Sub Command1_Click()
Dim BulunanKelimeler As String
Open "C:\test.txt" For Input As #1
List1.Clear
While Not EOF(1)
Input #1, StringHold
List1.AddItem BulunanKelimeler
Wend
Close #1
End Sub

Textbox ve Combobox için Undo (geri al) fonksiyonu nasil kullanilir?
'Bir Windows API undo islemi yapar

'asagidaki deklerasyonlari yaz
Declare Function SendMessage Lib "User" (ByVal hWnd As _
Integer, ByVal wMsg As Integer, ByVal wParam As _
Integer, lParam As Any) As Long

'asagidaki degismezleri yaz

Global Const WM_USER = &h400
Global Const EM_UNDO = WM_USER + 23

' Undo Sub 'lara asagidaki kodu yaz
UndoResult = SendMessage(myControl.hWnd, EM_UNDO, 0, 0)

'UndoResult = -1 olursa hata var demektir
'UndoResult sadece bir rakamdir ve hiç bir önemi yoktur. Sadece yer tutmasi için yazilir.
'VB'nin buna benzer gariplikleri vardir. Bir amaci varsa da ben bilmiyorum

Clipboard'dan text nasil kopyalanir?
'Textbox'ta texti isaretle ve isaretlenen yeri clipboard'dan kopyaladiginla degistir:

txtBox.SelText = Clipboard.GetText

'Yada tüm text'i clipboarddan aldiginla degistir.

txtBox.Text = Clipboard.GetText

Clipboard'a text nasil kopyalanir?
'Önce clipboard'u temizle
Clipboard.Clear

'Sonra kopyalanacak alani seç ve clipboard'a kopyala
Clipboard.SetText txtBox.Text, vbCFText

Toolbar'in click olayi nasil kodlanir?

Private Sub Toolbar1_ButtonClick(ByVal Button As Button)

'button clicklerini saptamak için:

Select Case Button.Key
Case Is = "Exit"
If MsgBox("Çikmak istiyor musunuz??", vbQuestion + vbYesNo + _
vbDefaultButton2, "Programdan çikiyorsunuz!") = vbNo Then Exit Sub
Call ExitProgram
Case Is = "Repair"
Call Repairdb
Case Is = "Delete"
Call DeleteRoutine
Case Is = "Edit"
Call EditRoutine
Case Is = "New"
Call NewRoutine
Case Is = "Copy"
Call CopyToClipboard
Case Is = "Help"
Call ShowHelpContents
End Select
End Sub

Cdbl ile Val fonksiyonlari arasindaki fark nedir?
print Val("12345")
12345

print Val("12,345")
12

print CDbl("12,345")
12345

print CDbl("12345")
12345

Dogum gününden kisinin yasi nasil hesaplanir?
'Text'i Date data türüne çevir

Dim Birth as Date
Birth = DateValue(txtDOB)

'Yasi hesapla
Dim Age as Integer
Age = Int(DateDiff("D", Birth, Now) / 365.25)

4 rakamli tarih nasil kontrol edilir?

Public Function ValidDate(MDate)

'Amaç: 4 digitli "yyyy" formatindaki tarihi kontrol etmek; hata var ise kullaniciyi uyarmaktir.
'Input: Texbox'tan string
'Output: True yada False
'Default : False

ValidDate = False

'Eger uzunluk "m/d/yyyy" 'den kisa ise fonkiyondan çik
If Len(MDate) < 8 Then Exit Function

'Geçerli bir tarih türü girilmemisse terket
If IsDate(MDate) = False Then Exit Function

'Sonu "yyyy" ile bitmiyorsa yada baslamiyorsa terket
Dim StartDate As String
Dim EndDate As String

EndDate = Right(MDate, 4)
StartDate = Left(MDate, 4)

If ValidChar(EndDate, "0123456789") = False And _

ValidChar(StartDate, "0123456789") = False Then Exit Function


'Tüm bu testlerden geçilirse True yükle
ValidDate = True
End Function

Hata kontrol bloklari nasil denetlenir?
'error kodunu baslat
On Error GoTo HataKontrol

'Buraya program kodlarini gir. Buradan sonrasi artik hata denetimine açiktir.
'Hata kontrolundan çikmak istersen 0 (sifir) a git
On Error GoTo 0 : Exit Function ' ve fonksiyonu terket

:HataKontrol
Dim strErr As String

'Kullaniciya olusan hata ve tanimini ver
strErr = "Hata olustu: " & Err.Number & " " & Err.Description
MsgBox strErr, vbCritical + vbOK, "Hata!"

Web adresleri nasil açilir?
'Asagidaki kodu bir kontrolun click event'ine yaz
Dim iRet As Long
Dim Cevap As Integer

Cevap = MsgBox("www.hakanersoz.com adresini açmak istiyor musunuz?", vbInformation + vbYesNo, "www.hakanersoz.com")

Select Case Cevap
Case vbYes
iRet = Shell("start.exe http://www.hakanersoz.com", vbNormal)
Case vbNo
Exit Sub
End Select

10, 100, 1000 gibi rakamlara en yakin sayi nasil yuvarlanir?

'Örnek 100' yuvarla:
Round(RatioBolus * Val(txtDW), 100)

'BAS module'ü içine yaz
Public Function Round(Dose, Factor)
'Amaç: Sayiyi yuvarlamak
'Girdi: Sayi, Factor (10, 100, 1000, etc)
'Çikti: Yuvarlanmis sayi

Dim Temp As Single
Temp = Int(Dose / Factor)
Round = Temp * Factor
End Function

Menüye 13x13 bitmaplar nasil eklenir?

'Bir Picturebox control ekle
'Autosize özelligini 'True' yap unutma: bitmap olacak (Icon degil)
'maximum 13X13 bitmap olmali.

'Asagidaki deklerasyonlari bir Bas modulune ekle:
'Bu örnek VB4 içindir

Private Declare Function VarPtr Lib "VB40032.DLL" (variable As Any) As Long
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long

Const MF_BYPOSITION = &H400&
'form load event içine asagidaki kodu yerlestir

Dim mHandle As Long, lRet As Long, sHandle As Long, sHandle2 As Long
mHandle = GetMenu(hwnd)
sHandle = GetSubMenu(mHandle, 0)
lRet = SetMenuItemBitmaps(sHandle, 0, MF_BYPOSITION, imOpen.Picture, imOpen.Picture)
lRet = SetMenuItemBitmaps(sHandle, 1, MF_BYPOSITION, imSave.Picture, imSave.Picture)
lRet = SetMenuItemBitmaps(sHandle, 3, MF_BYPOSITION, imPrint.Picture, imPrint.Picture)
lRet = SetMenuItemBitmaps(sHandle, 4, MF_BYPOSITION, imPrintSetup.Picture, imPrintSetup.Picture)
sHandle = GetSubMenu(mHandle, 1)
sHandle2 = GetSubMenu(sHandle, 0)
lRet = SetMenuItemBitmaps(sHandle2, 0, MF_BYPOSITION, imCopy.Picture, imCopy.Picture)

Çalisma aninda menü nasil olusturulur?

Dim index As Integer
index = mnuHook.Count
Load mnuHook(index)
mnuHook(index).Caption = "New Menu Entry"
mnuHook(index).Visible = True

'Yeni girdiler mnuHook 'dan sonra olusur. Ancak unutmayin mnuHook halihazirda varolan bir menü elemanidir.

Text nasil sifrelenir?
'encryption function :

Public Function Encrypt(ByVal Plain As String)
For I=1 To Len(Plain)
Letter=Mid(Plain,I,1)
Mid(Plain,I,1)=Chr(Asc(Letter)+1)
Next
Encrypt = Plain
End Sub

Public Function Decrypt(ByVal Encrypted As String)
For I=1 to Len(Encrypted)
Letter=Mid(Encrypted,I,1)
Mid(Encrypted,I,1)=Chr(Asc(Letter)-1)
Next
Decrypt = Encrypted
End Sub

Print Encrypt("This is just an example")
Print Decrypt("Uijt!jt!kvtu!bo!fybnqmf")

Form nasil yavas yavas karartilir? (Fade to black)

Sub FormFade(frm As Form)
' Formu yavas yavas karartir

For icolVal% = 255 To 0 Step -1
DoEvents
frm.BackColor = RGB(icolVal%, icolVal%, icolVal%)
Next icolVal%
End Sub

Formun caption'una nasil kayan yazi yazilir?

Sub KayanYazi(frm As Form)
Dim X As Integer
Dim current As Variant
Dim Y As String
Y = frm.Caption
frm.Caption = ""
frm.Show
For X = 0 To Len(Y)
    If X = 0 Then
    frm.Caption = ""
    current = Timer
        Do While Timer - current < 0.1
           DoEvents
        Loop
   GoTo bitti
Else: End If
frm.Caption = left(Y, X)
current = Timer
Do While Timer - current < 0.05
DoEvents
Loop
bitti:
Next X
End Sub

Verilen kredi karti numarasinin geçerli olup olmadigi nasil anlasilir?
'Asagidaki fonksiyonu bir BAS modulu içine kopyala
'Not: Tüm kredi kartlari belli bir algoritma ile üretilir. Rastgele sayilar bu algoritmaya uymaz. Bu fonksiyon bu hesaplamalari yapar
'Asagidaki Sub bir command butonuna ait olabilir. Kliklendiginde verilen kart numarasini kontrol eder.

Sub KartKontrolu_Click ( )
'KartGecerli degiskeni True olur eger fonksiyon dogru deger çevirirse
Dim KartGecerli as Boolean
KartGecerli = GecerliKartNumarasimi("4552012301230123")
If KartGecerli then
    Msgbox "Geçerli kart"
else
   Msgbox "Aman dikkat. Bu kart geçersiz!!!"
End if
End Sub

Public Function GecerliKartNumarasimi(ByVal pCardNumber As String) As Boolean

Dim CharPos As Integer
Dim CheckSum As Integer
Dim tChar As String

For CharPos = Len(pCardNumber) To 2 Step -2
    CheckSum = CheckSum + CInt(Mid(pCardNumber, CharPos, 1))
    tChar = CStr((Mid(pCardNumber, CharPos - 1, 1)) * 2)
    CheckSum = CheckSum + CInt(Left(tChar, 1))
    If Len(tChar) > 1 Then CheckSum = CheckSum + CInt(Right(tChar, 1))
Next

If Len(pCardNumber) Mod 2 = 1 Then CheckSum = CheckSum + CInt(Left(pCardNumber, 1))

If CheckSum Mod 10 = 0 Then
IsValidCreditCardNumber = True
Else
IsValidCreditCardNumber = False
End If

End Function


Ayin son günü nasil bulunur?
Public Function AyinSonGunu(ByVal GecerliTarih As Date) As Byte
Dim SonGun As Byte
SonGun = DatePart("d", DateAdd("d", -1, DateAdd("m", 1, _
DateAdd("d", -DatePart("d", GecerliTarih) + 1, Date))))
AyinSonGunu = SonGun
End Function

Private Sub Command1_Click()
MsgBox Date & " tarihine ait ayin son günü : " & AyinSonGunu(Date)
End Sub

VB6 projeleri VB5'te nasil açilir?
Notepad yada baska bir editör ile VB 6.vbp dosyasini açin ve bu dosyadaki
'Retained = 0' satirini silip dosyayi kaydedin.
Artik VB6 projelerini VB5'te açabilirsiniz.

MDB veritabanlarinda hataya neden olan Null field degerlerinden nasil kurtulunur?
Default deger olarak Access string alanlari NULL deger tasir (Çift tirnak yani bos string girilmedikçe)
Null deger tasiyan bir alani recordset araciligiyla bir string içine kopyalamak istediginizde (sanirim birçogunuz bunu görmüstür) runtime type-mismatch hatasi olusur. Bundan kurtulmanin en kolay yolu & karakteri kullanarak her alan basina çift tirnak (yani bos string) eklemektir. Asagidaki örnek gibi:

Dim DB As Database
Dim RS As Recordset
Dim sAd As String
Set DB = OpenDatabase("Test.mdb")
Set RS = DB.OpenRecordset("Ad")
sAd = "" & RS![Adi Soyadi] ' Adi Soyadi alani içine "" ekleniyor, böylece null deger yokediliyor.


Ekran çözünürlügü nasil bulunur?
Genelde ekran çözünürlügüne göre programlarinizdaki nesneleri resize etmek oldukça kullanisli bir yoldur.

Ekran çözünürlügünü söyle bulursunuz:
Asagidaki kodu form_load'a yazarsaniz her açilista ekran çözünürlügünü kontrol eder.

Genislik = Screen.Width \ Screen.TwipsPerPixelX
Yukseklik = Screen.Height \ Screen.TwipsPerPixelY

Ekran_Cozunurlugu = Genislik & "x" & Yukseklik

Sonuç asagidaki gibi olur:

800x600

Veritabanina nasil daha hizli ulasilir?

Bir recordset içinde daha hizli döngü çalistirmak için bir yol var. Genelde bir çok programci asagidaki kodu kullanir:

Do While Not Records.EOF   'Dosya sonuna kadar döngü baslat
Combo1.AddItem Records![Firma Adi]   'Combo'ya Records recordset'inin [Firma Adi] adli alanini ekle
Records.Movenext 'Bir sonraki kayda git
Loop

Buradaki problem her defasinda veritabaninin bir sonraki kayda gitmek için dosya sonuna ulasip ulasmadigini kontrol etmek zorunda olmasidir. Bu zorunluluk özellikle çok büyük veritabanlarinda büyük performans kayiplarina neden olur. Çözüm ise önce kayit adedini RecordCount ile bulmak ve For ---- Next döngüsü ile kayit okumaktir :

Records.MoveLast ' Recordset'in sonuna giderek kaç adet kayit oldugunu bulmalisiniz. Bu islemin bir kez yapilmasi yeterlidir.
KayitSayisi=Records.RecordCount   'Kayit sayisi bir long degisken içine alindi
Records.MoveFirst 'Ilk kayda gel

For i =1 To KayitSayisi    'Simdi kayitlari EOF telasi olmadan birer birer okuyalim
        Combo1.AddItem Records![Firma Adi]
        Records.MoveNext
Next

Iste size garantili %33'lük performans artisi

 

Gökkusagi renklerinde text nasil olusturulur?

1. Standart EXE projesi baslat
2. Asagidaki kodu Form'un Paint proc'una yaz:

Sub Form_Paint()
Dim I As Integer, X As Integer, Y As Integer
Dim C As String
Cls
For I = 0 To 91
X = CurrentX
Y = CurrentY
C = Chr(I)
Line -(X + TextWidth(C), Y = TextHeight(C)), QBColor(Rnd * 16), BF
CurrentX = X
CurrentY = Y
ForeColor = RGB(Rnd * 256, Rnd * 256, Rnd * 256)
Print "Merhaba Basic Programciligi"
Next
End Sub

3. Projeyi çalistirirsaniz formun degisik renklerde yaziyla kaplandigini görürsünüz.
and watch the form fill with lots of multi-coloured text


Text kutusundaki bosluklar nasil yokedilir?
Kullanicilarin text kutusuna bosluk karakteri girmelerini engellemek için :
Textbox 'un KeyPress olayina asagidaki kodu yaz:

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 32 Then
    KeyAscii = 0
End If
End Sub


Tek harekette text dosyasi nasil yüklenir?
FileText fonksiyonunu kullanarak istediginiz dosyayi açar ve textbox içine yerlestirirsiniz.
Fonksiyonu Bas modulu içine yaz

Function FileText (filename$) As String
Dim dosya As Integer
dosya = FreeFile
Open filename$ For Input As #dosya
FileText = Input$(LOF( dosya), dosya)
Close # dosya
End Function

Text1.Text = FileText("c:\autoexec.bat") 'Text1 textbox'una tek hamlede autoexec.bat içerigi yüklenir.


Windows Control Panel (Denetim masasi) uzantilari VB ile nasil açilir?

Option Explicit
Private strPanelAdi As String
Private Sub Command1_Click()

strPanelAdi = File1.filename
If strPanelAdi = "" Then
MsgBox "Bir .CPL dosyasi seçilmedi." & vbCrLf & _
"Windows Control Panel açiliyor.",vbInformation
End If
Shell "rundll32.exe shell32.dll,Control_RunDLL " & _
strPanelAdi, vbNormalFocus
End Sub

Private Sub Form_Load()
With File1
'Sadece Control Panel uzantili dosyalari göster
.Pattern = "*.CPL"
'FileListBox yalnizca System yada System32 dizinini hedef alsin:
.Filename = "C:\Windows\System"
End With
End Sub

Bellegi bosaltmak için tüm formlar nasil unload edilir?

Public Sub UnloadAllForms()
Dim Form As Form
For Each Form In Forms
   Unload Form
   Set Form = Nothing
Next Form
End Sub

Bu prosedürü çalistirmak için en uygun yer ana formun unload event'idir


Kontroller nasil tasinabilir? (Drag&Drop)

Burada bir picturebox form üzerinde drag&drop ile tasinmaktadir.

Option Explicit
Public globalX As Integer
Public globalY As Integer

Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
Picture1.Move X - globalX, Y - globalY
End Sub

Private Sub Picture1_MouseDown(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
Picture1.Drag vbBeginDrag
globalX = X
globalY = Y
End Sub

Kendi Popup menünüz bir textbox içinde nasil gösterilir?

Bu ipucu ile standart Windows pop up menüsünü bastirir kendi popup menünüzü çalistirirsinz.

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 2 Then
With Text1
.Enabled = False
PopupMenu {KendiMenunuz}
.Enabled = True
.SetFocus
End With
End If
End Sub

Mesaj kutusunun ileri özellikleri nasil kullanilir?

Dim Msg, Style, Title, Help, Ctxt, Cevap, MyString
Msg = "Devam edelim mi ?" ' Mesaji tanimla
Style = vbYesNo + vbCritical + vbDefaultButton2 'Butonlari tanimla
Title = "MsgBox Gösterimi" ' Title tanimla
Help = "DEMO.HLP" 'Bir help dosyasi bagla
Ctxt = 1000 ' Baslik tanimla

Cevap = MsgBox(Msg, Style, Title, Help, Ctxt) 'Masaji göster ve kullanici cevabini bekle
If Cevap = vbYes Then ' Kullanici evet'i seçti
      MsgBox "Kabul ettiniz" ' Karsilik ver
Else ' Tersi durumda kullanici hayir'i seçmis demektir
      MsgBox "Kabul etmediniz" ' Karsilik ver
End If


Menülerde seperatör (ayraç) nasil yapilir?

mnu.Caption="-"


Bir textboxta tüm harfler nasil küçükharfe çevirilir?

Eskiposizyon = Text1.SelStart
Text1.Text = LCase(Text1.Text) 'Üst karakter için UCase kullanilir
Text1.SelStart = Eskiposizyon


Listbox'taki tüm elemanlar nasil seçilir?

'Asagidaki kodu cmdYeniEkle_Click() yordamina yaz

List1.AddItem Text1.Text ' Yeni bir item ekle

'Asagidaki kodu cmdTumunuSec_Click() yordamina yaz

For x = 0 To List1.ListCount - 1
List1.Selected(x) = True ' item(x) seç
Next x

Listview'deki satirlarin kaç tane oldugu nasil sayilir?

lItemCount = lstCount.ListItems.Count

Msgbox lItemCount



Picturebox'a çalisma aninda nasil resim eklenir?

Picture1.Picture = LoadPicture("c:\xxxxxx.bmp")


Picturebox'tan çalisma aninda nasil resim silinir?

Picture1.Picture = LoadPicture("")


Form konfetti ile nasil doldurulur?


DrawWidth = 5 ' noktaciklarin genisligi
Dim x As Long
Dim y As Long
Dim r As Integer
Dim g As Integer
Dim b As Integer

Randomize
Do
x = Val(Screen.Width) * Rnd
y = Val(Screen.Height) * Rnd
bir sonraki noktacigin rengi rastgele seçilir
r = 255 * Rnd
g = 255 * Rnd
b = 255 * Rnd
Form1.PSet (x, y), RGB(r, g, b)
Loop

Form üzerindeki Picturebox nasil ortalanir?

Picture1.Left = (Form1.Width - Picture1.Width) / 2

Clipboard kullanarak bir Picturebox içerigi resim diger bir picturebox'a nasil kopyalanir?

Command1_Click()
Clipboard.Clear 'Clipboard'i mutlaka sil
Clipboard.SetData Picture1.Picture

Command2_Click()
Picture2.Picture = Clipboard.GetData ' Clipboard içerigini Picture2 içine yapistir.

Bir string'in uzunlugu nasil tespit edilir?

Dim i As Long
i = Len(sSizinStringiniz)

Mouse pointer nasil saklanir?
Bu is için ShowCursor API'si kullanilir. Asagidaki kodu bir module içine yaz:

Declare Function ShowCursor Lib "user32" (ByVal bShow
As Long) As Long

Bu kod mouse imlecini saklar:
FareImleci = ShowCursor(False)

Bu kod mouse imlecini görünür hale getirir:
FareImleci = ShowCursor(True)

Programiniz disinda keypress nasil saptanir?

GetAsyncKeyState API'si kullanilir. Asagidaki kodu module içine yazin

Declare Function GetAsyncKeyState Lib "user32"
(ByVal vKey As Long) As Integer


' Asagidaki constant TAB tusu için. Diger tuslar için
' API Text Viewer'i kullanin

Public Const VK_TAB = &H9

'Timer1_Timer() içine asagidaki kodu ekleyin

If GetAsyncKeyState(VK_TAB) Then
Beep ' TAB'a basilirsa beep
End If

 

Yazdirma islemi nasil iptal edilir?
'Bu örnekte ayrica birden fazla sayfanin nasil yazilacagi da gösteriliyor

Printer.Print "Page 1"
Printer.Newpage
Printer.Print "Page 2"
Printer.KillDoc


Resim nasil yazdirilir?

Printer.PaintPicture Picture1.Picture
Printer.EndDoc


Windows'un Belgeler içerigi nasil silinir?

Bir module asagidaki API deklerasyonunu ekle:

Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags As Long,
ByVal pv As String)

Herhangi bir click içine de asagidaki kodu ekle:

SHAddToRecentDocs(2,vbNullString)


Windows'un Belgeler içine nasil ekleme yapilir?

Bir module asagidaki API deklerasyonunu ekle:

Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags As Long,
ByVal pv As String)

Herhangi bir click içine de asagidaki kodu ekle:

Dim ekleme as String
ekleme="c:\falan dizin\filan dosya.txt"

SHAddToRecentDocs(2,ekleme)


Alan adina göre bir Recordset içindeki kayitlar nasil siraya konur?

'Bu kod tüm kayitlari Z-A (geriye dogru) siraya dizer

' A-Z (ileri dogru) sirasi isterseniz ,DESC yerine ASC kullanin.

Dim DB as Database
Dim Kayitlar as Recordset

Set Kayitlar = DB.OpenRecordset("SELECT * FROM _
Personel " & "ORDER BY Personel.Adi DESC;")

Personel tablosundan tüm kayitlari Adi (personel adi) field degerine göre azalan (Z-A ) sekilde siraya dizer


Listbox'u Access (mdb) veritabanina nasil baglarsiniz?

On Error GoTo Hata_Kontrol

Dim DB as Database
Dim Kayitlar as Recordset
Dim X as Long, record_count as Long

'Veritabanini açalim

Set DB = OpenDatabase("Ogrenci.mdb", dbOpenSnapshot)
Set Kayitlar = DB.OpenRecordset("Ogrenciler")

' Dikkat ederseniz asagida yapilan islem önce veritabaninin sonuna gitmek, RecordCount degerini
' ögrenmek ve sonra tekrar veritabani basina dönmektir. Veritabani sonuna gitmeden kaç adet kayit
' oldugunu ögrenemezsiniz.

Kayitlar.MoveLast
X = Kayitlar.RecordCount
Kayitlar.MoveFirst

' Listbox içine adlari yerlestirelim
' Ilk kayita geldikten sonra artik sirayla ögrenci adlarini listbox içine alabiliriz

Do
List1.AddItem Kayitlar!OgrenciAdi
Y = Y + 1
Kayitlar.MoveNext
Loop Until Y = X ' X = Recordcount, yani son kayit

Hata_Kontrol:
Select Case (Err)
Case 3021 ' Kayit yok
record_count = 0 'Kayit yoksa degeri 0 a esitleyelim.
Exit Sub
List1.Refresh
End Select


Iki integer degisken nasil swap (degistokus) edilir?

Asagidaki algoritma kullanilarak iki integer'in degerleri birbirine aktarilir

a = a Xor b

b = a Xor b

a = a Xor b




Bir form nasil asagi ve yukari katlanir? (açilista splash screen olarak kullanmak üzere..)

Sub FormuYukariKatla(frm As Form, yukari As Integer)

' Formunuzun Scalemode property'sine dikkat edin. Eger degeri pixel ise
' ve siz twip deger kullanirsaniz form sonsuz bir döngü içinde katllanir.
' formunuzun ne kadar katlanmasini istiyorsaniz yukari degerini o kadar yükseltin
' Açilista splash screen olarak kullanilir...

Dim NereyeKadar

NereyeKadar = frm.Height - yukari
If NereyeKadar <= 0 Then Exit Sub
If yukari < 0 Then Exit Sub

Do
frm.Height = frm.Height - 1
DoEvents
Loop Until frm.Height <= NereyeKadar
End Sub

Sub FormuAsagiKatla(frm As Form, asagi As Integer)

'Yine scalemode'a dikkatedin!
' Formun ne kadar asagi katlanmasini istiyorsaniz "asagi " degerini o kadar büyütün

Dim NereyeKadar

NereyeKadar = frm.Height + yukari
If yukari < 0 Then Exit Sub

Do
frm.Height = frm.Height + 1
DoEvents
Loop Until frm.Height >= NereyeKadar
End Sub

'Asagidaki sub yordamimiz çagirir
Private Sub Command1_Click()
Call FormuAsagiKatla(Form1, 100)
End Sub


isEven fonksiyonu nasil kullanilir?

'Bu fonksiyon tek sayilarda TRUE döndürür

Function isEven(n As Integer) As Boolean
isEven = True
If n And 1 Then isEven = False
End Function


Dosya boyutu nasil ögrenilir?

Aslinda dosya boyutu ögrenmek kolaydir. Buradaki ipucu kullanicinyn seçtigi dosyalarin boyutunu çalisma aninda buluyor.

Bir form üzerine bir dirlistbox (lstDizin) ve bir filelistbox (lstDosya) ve
bir Label (lblDosyaBoyutu) yerlestirin.
Kullanici istedigi dizine gidebilir ve dosya seçebilir. Bu program kullanicinin seçtigi dosyalarin boyutunu gösterecek:

Private Sub cmdDosyaBoyutunuGoster_Click()

Dim strDosyaTemp As String
Dim strBoyutTemp As String
Dim strDizin As String
Dim strDosya As String

' Kullanicinin seçtigi dizin ve dosya kutulari araciligiyla degiskenlerimize deger yüklüyoruz:
strDizin = lstDizin.Path
strDosya = lstDosya.File

' Yukaridan alinan degerlerle ulasilan path degerini geçici dosya degiskenine yükleyip
' o degiskenin dosya boyutunu hesaplatiyoruz.:
strDosyaTemp = strDizin & "\" & strDosya
strBoyutTemp = FileLen(strDosyaTemp)

lblDosyaBoyutu.Caption = strDosyaTemp & " adli dosya " & _
Format(strBoyutTemp, "#,##0") & " byte boyutundadir."

End Sub


Title bar nasil yanip söner?

Yeni bir EXE projesi aç ve bir modul içine asagidaki WinApi'yi yaz:

Public Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, _
ByVal bInvert As Long) As Long

Bir Form üzerine bir timer ve 2 commandbutton yerlestir (özellikleri sagida) :

command1.caption="Baslat"
command2.caption="Durdur"
timer1.interval=500 'yarim saniyede bir yanpi sönecek
timer1.enabled=false

Private Sub Timer1_Timer()
a& = FlashWindow(Me.hwnd, 1)
End Sub

Private Sub Command1_Click() 'Programi çalistirir ve form caption'u yanip söner
Timer1.Enabled = True
End Sub

Private Sub Command2_Click() 'Yanip sönme isini kapatir
Timer1.Enabled = False
End Sub


Ctrl-Alt-Delete ve Ctrl-Esc tus kombinasyonlarinin çalismasi nasil iptal edilir?


Asagidaki kodu projenizin declarations kismina yazin:

Private Declare Function SystemParametersInfo Lib _
"user32" Alias "SystemParametersInfoA" (ByVal uAction _
As Long, ByVal uParam As Long, ByVal lpvParam As Any, _
ByVal fuWinIni As Long) As Long


Sub CtrlAltDeleteKapat(Kapali As Boolean)
Dim X As Long
X = SystemParametersInfo(97, Kapali, CStr(1), 0)
End Sub


Ctrl-Alt-Delete kombinasyonunu kapatmak için:

Call CtrlAltDeleteKapat(True)


Ctrl-Alt-Delete kombinasyonunu açmak için:

Call CtrlAltDeleteKapat(False)


Sistemin bir ses kartina sahip olup olmadigi nasil bulunur?

Asagidaki kodu projenizin declarations kismina yazin:

Declare Function waveOutGetNumDevs Lib "winmm.dll" _
Alias "waveOutGetNumDevs" () As Long

Dim i As Integer

i = waveOutGetNumDevs()
If i > 0 Then
MsgBox "Sisteminiz ses dosyalarini çalabilir.", _
vbInformation, "Sound Card Test"
Else
MsgBox "Sisteminiz ses dosyalarini çalamaz.", _
vbInformation, "Sound Card Test"
End If

Hangi kullanicinin login yaptigi nasil anlasilir?

Dim s As String
Dim cnt As Long
Dim dl As Long
Dim AktifKullanici as String

cnt = 199
s = String$(200, 0)
dl = GetUserName(s, cnt)

If dl <> 0 Then AktifKullanici = Left$(s, cnt) Else AktifKullanici = ""


Asagidaki API fonksiyonunu ya formun decleration kismina yada bir modul içine yazacaksinz:

Declare Function GetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) _
As Long


Bos disk alani nasil saptanir?

GetDiskFreeSpace API fonksiyonunu kullanmalisiniz. Bu fonksiyonun declarasyonu söyledir:

Declare Function GetDiskFreeSpace Lib "kernel32" Alias _
"GetDiskFreeSpaceA" (ByVal lpRootPathName As String, _
lpSectorsPerCluster As Long, lpBytesPerSector As Long, _
lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters _
As Long) As Long

Dim SectorsPerCluster&
Dim BytesPerSector&
Dim NumberOfFreeClusters&
Dim TotalNumberOfClusters&
Dim BosAlan&

temp& = GetDiskFreeSpace("c:\", SectorsPerCluster, _
BytesPerSector, NumberOfFreeClusters, TotalNumberOfClusters)

' BosAlan degiskeni toplam bos byte degerini tutar:

BosAlan = NumberOfFreeClusters * SectorsPerCluster * _
BytesPerSector

Bir form altina nasil gölge eklenir ve form yukarida hissi verilir?

Formlarin altinda bulunan gölgeleri merak etmissinizdir. Formu sanki birkaç santimetre havada duruyormus hissi veren bu isleme "Dithering" denir:

Asagidaki kodu bir forma ekleyin.

Sub Dither(vForm As Form)

Dim intLoop As Integer

vForm.DrawStyle = vbInsideSolid
vForm.DrawMode = vbCopyPen
vForm.ScaleMode = vbPixels
vForm.DrawWidth = 2
vForm.ScaleHeight = 256

For intLoop = 0 To 255

vForm.Line (0, intLoop)-(Screen.Width, intLoop - 1), _
RGB(0, 0,255 -intLoop), B

Next intLoop

End Sub

Kodu çalistirmak için formun Activate olayina ise asagidaki kodu ekleyin:

Form_Activate ()
Dither Me

Kontroller nasil gölgelendirilir?


Yeni bir proje baslatip form üzerine bir textbox yerlestirin

Asagidakini bir module yerlestirin:

Global Const GFM_BACKSHADOW = 1
Global Const GFM_DROPSHADOW = 2

Public Sub ControlShadow(f As Form, C As Control, shadow_effect _
As Integer, shadow_width As Integer, shadow_color As Long)

Dim shColor As Long
Dim shWidth As Integer
Dim oldWidth As Integer
Dim oldScale As Integer
shWidth = shadow_width
shColor = shadow_color
oldWidth = f.DrawWidth
oldScale = f.ScaleMode

f.ScaleMode = 3
f.DrawWidth = 1

Select Case shadow_effect

Case GFM_DROPSHADOW
f.Line (C.Left + shWidth, C.Top + shWidth)-Step(C.Width - 1, _
C.Height - 1), shColor, BF

Case GFM_BACKSHADOW
f.Line (C.Left - shWidth, C.Top - shWidth)-Step(C.Width - 1, _
C.Height - 1), shColor, BF

End Select

f.DrawWidth = oldWidth
f.ScaleMode = oldScale

End Sub

Form'un Load procedurüne asagidaki kodu ekleyin:

Private Sub Form_Load()

Dim r
r = ControlShadow(me,text1,1,2,black)

End Sub

 

Title bar'in rengi nasil degistirilir?

Windows'un tüm desktop renklerini SetSysColors API fonksiyonu ile degistirebilirsiniz.
Bu fonksiyon 3 parametre alir :
1. Rengi degisecek elemanlarin sayisi
2. Color nesnesi degismezleri (const)
3. RGB degeri

API:

Declare Function SetSysColors Lib "user32" Alias _
"SetSysColors" (ByVal nChanges As Long, lpSysColor As _
Long, lpColorValues As Long) As Long



Degismezler:

Public Const COLOR_SCROLLBAR = 0 'Scrollbar rengi
Public Const COLOR_BACKGROUND = 1 'Duvarkagidi yokken masaüstü arkaplan rengi
Public Const COLOR_ACTIVECAPTION = 2 'Aktif pencere adi rengi
Public Const COLOR_INACTIVECAPTION = 3 'Aktif olmayan pencere adinin rengi
Public Const COLOR_MENU = 4 'Menu
Public Const COLOR_WINDOW = 5 'Windows arkaplan
Public Const COLOR_WINDOWFRAME = 6 'Pencere çerçevesi
Public Const COLOR_MENUTEXT = 7 'Pencere Texti
Public Const COLOR_WINDOWTEXT = 8 '3D koyu gölge (Win95)
Public Const COLOR_CAPTIONTEXT = 9 'Pencere caption text rengi
Public Const COLOR_ACTIVEBORDER = 10 'Aktif pencere sinirlari rengi
Public Const COLOR_INACTIVEBORDER = 11 'Inaktif pencere sinirlari rengi
Public Const COLOR_APPWORKSPACE = 12 'MDI desktop arkaplan rengi
Public Const COLOR_HIGHLIGHT = 13 ' seçili alan arkaplan rengi
Public Const COLOR_HIGHLIGHTTEXT = 14 'Seçili menü rengi
Public Const COLOR_BTNFACE = 15 'Button
Public Const COLOR_BTNSHADOW = 16 '3D buton gölgeleme
Public Const COLOR_GRAYTEXT = 17 'Gri text
Public Const COLOR_BTNTEXT = 18 'Button text
Public Const COLOR_INACTIVECAPTIONTEXT = 19 'Inactive pencere rengi
Public Const COLOR_BTNHIGHLIGHT = 20 'Butonun 3D isaretlenmesi rengi


Aktif pencere title bar rengini degistirmek için :

t& = SetSysColors(1, COLOR_ACTIVECAPTION, RGB(255,0,0))

Bu örnek kirmiziya çevirir.

Yukarı Dön
vekilori Açılır Kutu Gör
Yeni Yazılımcı
Yeni Yazılımcı


Kayıt Tarihi: 27 Mart 2006
Konum: Turkiye
Aktif Durum: Aktif Değil
Gönderilenler: 2
  Alıntı vekilori Alıntı  Yanıt YazCevapla Mesajın Direkt Linki Gönderim Zamanı: 27 Mart 2006 Saat 22:17

Yani ne deyim

Günlerdir arayypta teker teker çykarmaya çaly?ty?ym ?eyler tek yerde

Eme?e saygy. Payla?yma takdir

Hasan

Yukarı Dön
gmemik Açılır Kutu Gör
Moderatör
Moderatör
Simge

Kayıt Tarihi: 11 Şubat 2006
Konum: Türkiye
Aktif Durum: Aktif Değil
Gönderilenler: 203
  Alıntı gmemik Alıntı  Yanıt YazCevapla Mesajın Direkt Linki Gönderim Zamanı: 27 Mart 2006 Saat 22:22

te?ekkürler ahmet007 güzel bir kaynak olmu?
Safranbolu Evleri : http://akoren.com/photos/safranboluevleri/default.aspx
Yukarı Dön
karan Açılır Kutu Gör
Moderatör
Moderatör
Simge
Hasta Cimbomlu

Kayıt Tarihi: 17 Ocak 2006
Aktif Durum: Aktif Değil
Gönderilenler: 1414
  Alıntı karan Alıntı  Yanıt YazCevapla Mesajın Direkt Linki Gönderim Zamanı: 27 Mart 2006 Saat 22:24

ellerine sa?lyk Ahmet güzel kaynak..
kodyaziyorum.com
Yukarı Dön
kesema Açılır Kutu Gör
Yeni Yazılımcı
Yeni Yazılımcı


Kayıt Tarihi: 23 Ağustos 2006
Aktif Durum: Aktif Değil
Gönderilenler: 11
  Alıntı kesema Alıntı  Yanıt YazCevapla Mesajın Direkt Linki Gönderim Zamanı: 18 Aralık 2006 Saat 13:58

Paylasimin icin binlerce te?ekkürler ellerine ve emegine saglik

Yukarı Dön
kesema Açılır Kutu Gör
Yeni Yazılımcı
Yeni Yazılımcı


Kayıt Tarihi: 23 Ağustos 2006
Aktif Durum: Aktif Değil
Gönderilenler: 11
  Alıntı kesema Alıntı  Yanıt YazCevapla Mesajın Direkt Linki Gönderim Zamanı: 28 Şubat 2007 Saat 20:02

 eline,eme?ine ve klavyene sa?lyk arkadasym.
Yukarı Dön
ahmetveli Açılır Kutu Gör
Yeni Yazılımcı
Yeni Yazılımcı
Simge

Kayıt Tarihi: 27 Şubat 2007
Konum: Ystanbul
Aktif Durum: Aktif Değil
Gönderilenler: 11
  Alıntı ahmetveli Alıntı  Yanıt YazCevapla Mesajın Direkt Linki Gönderim Zamanı: 21 Mayıs 2007 Saat 21:10

 Abi Eline Sa?lyk Süper Bir Kaynak Valla 
คאк.ภєt รאรtє๓ {คђ๓єt שєlเ кєรкเภ}
Yukarı Dön
toonami Açılır Kutu Gör
Kıdemli Yazılımcı
Kıdemli Yazılımcı
Simge

Kayıt Tarihi: 06 Mayıs 2007
Aktif Durum: Aktif Değil
Gönderilenler: 84
  Alıntı toonami Alıntı  Yanıt YazCevapla Mesajın Direkt Linki Gönderim Zamanı: 21 Ocak 2008 Saat 21:25

te?ekkürler
Yukarı Dön
cankooo Açılır Kutu Gör
Yeni Yazılımcı
Yeni Yazılımcı
Simge

Kayıt Tarihi: 09 Nisan 2008
Aktif Durum: Aktif Değil
Gönderilenler: 1
  Alıntı cankooo Alıntı  Yanıt YazCevapla Mesajın Direkt Linki Gönderim Zamanı: 09 Nisan 2008 Saat 00:09

ya beyler syz bu i?ten anlyyonuz benym babamyn dos ortamynda kullanylar byr programy var.. ben pc ye format attym dosya d deydy ve syylynmedy acmaya calsytygymda ise ynput run-time module path katasy aldym nasyl yapabylyrym acylll plsss ???? msn adrseym caner--ozcan@hotmail.com acyll ltf
cacacascasc
Yukarı Dön
By KaRaCa Açılır Kutu Gör
Yeni Yazılımcı
Yeni Yazılımcı
Simge

Kayıt Tarihi: 19 Ağustos 2009
Aktif Durum: Aktif Değil
Gönderilenler: 6
  Alıntı By KaRaCa Alıntı  Yanıt YazCevapla Mesajın Direkt Linki Gönderim Zamanı: 19 Ağustos 2009 Saat 16:12

Nedense ben sadece 2-3 tanesinin nasyl yapyldy?yny anladym :S
Visual Basic Ö?reniyorum...
Lütfen Soraca?ym Sorulara Ayryntyly ve Do?ru Cevap Verin
Yukarı Dön
 Yanıt Yaz Yanıt Yaz

Forum Atla Forum İzinleri Açılır Kutu Gör

Akoren.com Kurtlar Vadisi Pusu