VisualBasic_menu_islemleri.htm
Menüye 13x13 bitmaplar nasyl 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

 
Kod Alanı:

 
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ü nasyl olusturulur?

 

Kod Alanı:

 
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 hali hazirda varolan bir menü elemanidir.

Text nasyl sifrelenir?
encryption function :

 

Kod Alanı:

 
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 nasyl yavas yavas karartilir? (Fade to black )

Sub FormFade(frm As Form )
Formu yavas yavas karartir

 

Kod Alanı:

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



 


Formun captionuna nasyl kayan yazy yazylyr?

 

Kod Alanı:

 
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



 

 

Yardım İçin Sadece Bir Tık Yeter
 
Sponsor
 
.tk
 
Bu web sitesi ücretsiz olarak Bedava-Sitem.com ile oluşturulmuştur. Siz de kendi web sitenizi kurmak ister misiniz?
Ücretsiz kaydol