Visual Basic te MEnü işlemleri

[m@yny@ch]

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 caption'una 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

[eeisahin]

ellerine sağlık

[esdicien]

senin de:D