75 Soru ve Cevap - Baskı Önizleme +- AccessTr.neT (https://accesstr.net) +-- Forum: Visual Basic 6 (https://accesstr.net/forum-visual-basic-6.html) +--- Forum: Visual Basic 6 Dersleri (https://accesstr.net/forum-visual-basic-6-dersleri.html) +--- Konu Başlığı: 75 Soru ve Cevap (/konu-75-soru-ve-cevap.html) Sayfalar:
1
2
|
75 Soru ve Cevap - chopper07 - 21/12/2008 Listbox'a degisik renklerde item nasıl eklenir? MSFlexGrid control kullanın Form close butonu nasıl çalistirilir? dim bClose as Boolean Form'un QueryUnload event'ine ekle: If bClose = false then cancel = true Text dosyasina çift tirnak isaretleri olmadan nasıl string girisi yapılır? Write # statement yerine Print # statement kullan Print # statement stringlerin etrafina çift tirnak koymaz Bir combo'nun içini diger bir combo'dan aldiklarinizla nasıl 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 nasıl yapılır? 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 nasıl yapılır? 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 nasıl aranir? Dim Mystr As String Mystr = "Hakan" If Mystr Like "H*" Then MsgBox "Bulundu" Else MsgBox "Bulunamadi" End If Her dile uyumlu tarih nasıl formatlanir? Command1.Caption = Format$(Date, "Short Date") Uyari isareti olan (X) mesaj kutusu nasıl yapılır? MsgBox "Mesaj Buraya!!", vbCritical, "Önemli" Sadece **** gösteren text kutusu nasıl yapılır? Textbox'un PasswordChar property'sini "*" karakterine esleyin. Içine tab yerlestirebileceginiz text kutulari nasıl yapılır? Bir form içindeki tüm kontrollerin tabstoplarini False'e esitleyin Text kutulari için kisayol tuslari nasıl belirlenir? Kisayol tusuna sahip bir label hazirlayin ve label'in tabindex'ini textbox'un tabindexinden bir asagiya esitleyin. Text1 içerigi Text2 içine nasıl 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ü nasıl yapılır? Ö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 nasıl 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 nasıl degistirilir? Statusbar1.Panels(1).Text = "Ivir zivir" Listbox'a bir text dosyasi içerigi nasıl 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 nasıl 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 nasıl 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 nasıl kopyalanir? 'Önce clipboard'u temizle Clipboard.Clear 'Sonra kopyalanacak alani seç ve clipboard'a kopyala Clipboard.SetText txtBox.Text, vbCFText Toolbar'in click olayi nasıl 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 kişinin yaşı nasıl hesaplanır? '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 rakamlı tarih nasıl 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 blokları nasıl 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 nasıl açılır? '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 yakın sayı nasıl yuvarlanır? 'Ö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 nasıl 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ü nasıl 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 nasıl 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 nasıl 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 nasıl kayan yazı yazılır? 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 nasıl 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ü nasıl 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 nasıl 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 nasıl 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ü nasıl 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 yazarsanız her açılışta ekran çözünürlüğünü kontrol eder. Genislik = Screen.Width \ Screen.TwipsPerPixelX Yukseklik = Screen.Height \ Screen.TwipsPerPixelY Ekran_Cozunurlugu = Genislik & "x" & Yukseklik Sonuç asagidaki gibi olur: 800x600 Veritabanina nasıl daha hizli ulasilir? Bir recordset içinde daha hızlı döngü çalıstırmak için bir yol var. Genelde bir çok programcı aşagidaki kodu kullanır: 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 'Kayıt sayısı bir long değişken içine alındı Records.MoveFirst 'Ilk kayda gel For i =1 To KayitSayisi 'Şimdi kayıtları EOF telaşı olmadan birer birer okuyalim Combo1.AddItem Records![Firma Adi] Records.MoveNext Next İşte size garantili %33'lük performans artışı Gökkusagi renklerinde text nasıl 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©, Y = TextHeight©), 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 nasıl 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 nasıl 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 nasıl 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 nasıl 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 nasıl taşınabilir? (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 nasıl 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 nasıl 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ç) nasıl yapılır? mnu.Caption="-" Bir textboxta tüm harfler nasıl 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 nasıl 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 nasıl sayilir? lItemCount = lstCount.ListItems.Count Msgbox lItemCount Picturebox'a çalisma aninda nasıl resim eklenir? Picture1.Picture = LoadPicture("c:\xxxxxx.bmp") Picturebox'tan çalisma aninda nasıl resim silinir? Picture1.Picture = LoadPicture("") Form konfetti ile nasıl 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 nasıl ortalanir? Picture1.Left = (Form1.Width - Picture1.Width) / 2 Clipboard kullanarak bir Picturebox içerigi resim diger bir picturebox'a nasıl 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 nasıl tespit edilir? Dim i As Long i = Len(sSizinStringiniz) Mouse pointer nasıl 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 nasıl 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 nasıl iptal edilir? 'Bu örnekte ayrica birden fazla sayfanin nasıl yazilacagi da gösteriliyor Printer.Print "Page 1" Printer.Newpage Printer.Print "Page 2" Printer.KillDoc Resim nasıl yazdırılır? Printer.PaintPicture Picture1.Picture Printer.EndDoc Windows'un Belgeler içerigi nasıl 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 nasıl ekleme yapılır? 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 nasıl 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 nasıl 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 nasıl 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 nasıl 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 nasıl 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 nasıl ö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 nasıl yanıp 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 nasıl 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 nasıl 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 nasıl 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 alanı nasıl saptanır? 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 nasıl 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 nasıl 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'ın rengi nasıl değiştirilir? 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)) alıntıdır. Cvp: 75 Soru ve Cevap - alpeki99 - 21/12/2008 Soru cevap tarzı olması çok iyi. Teşekkürler sayın chopper07 Cvp: 75 Soru ve Cevap - karam - 21/12/2008 Eline ve Emeğine sağlık Çok Teşekür Ederim Cvp: 75 Soru ve Cevap - chopper07 - 21/12/2008 (21/12/2008, 19:11)alpeki99 yazdı: Soru cevap tarzı olması çok iyi. Teşekkürler sayın chopper07 rica ederim. (21/12/2008, 19:11)karam yazdı: Eline ve Emeğine sağlık Çok Teşekür Ederim rica ederim. Cvp: 75 Soru ve Cevap - mehmetdemiral - 22/12/2008 Sevgili chopper, eline sağlık. Güzel bir çalışma. Keşke Numaralandırsaydın ya da SORU - CEVAP ibarelerini başına getirseydin. O zaman daha da süper olurdu. Örnek: SORU 1: Listbox'a degisik renklerde item nasıl eklenir? CEVAP 1: MSFlexGrid control kullanın SORU 2: Form close butonu nasıl çalistirilir? CEVAP 2: dim bClose as Boolean Form'un QueryUnload event'ine ekle: If bClose = false then cancel = true SORU 3: Text dosyasina çift tirnak isaretleri olmadan nasıl string girisi yapılır? CEVAP 3: Write # statement yerine Print # statement kullan Print # statement stringlerin etrafina çift tirnak koymaz SORU 4: Bir combo'nun içini diger bir combo'dan aldiklarinizla nasıl doldurursunuz? CEVAP:4 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 . . . . gibi.... Daha güzel olurdu gibi geliyor. Ne dersiniz? Cvp: 75 Soru ve Cevap - shopen66 - 02/05/2009 Eline sağlık hocam güzel çalışma |