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 |
|
|
|
|
|
|
|