VB - Si te Modifikojme nje Message Box ne VB6

[Borix]

Si te Modifikojme nje Message Box ne VB6

Funksioni MsgBox ne Visual Basic 6.0 (e me pare), ngarkon ne memorie nje forme te paracaktuar, e cila eshte standarde. Per shembull, nese therrasim proceduren e meposhtme:

Pergjigje = MsgBox("Po apo Jo?", vbYesNo + vbQuestion, App.Title)

atehere forma qe shfaqet permban nje imazh 'pikepyetje' dhe dy butona me tekstin "Yes" dhe "No". Megjithate, shpeshhere lind nevoja per modifikimin e Message Box-eve. Ne kete artikull do te jepet kodi i pershtatur, i cili permban (sic mund te prisni) funksione API. Paskesaj, do ta mbyll kete tutorial me disa vrojtime.

Modifikimi i Message Box ne Vb6

Option Explicit

' Struktura e meposhtme nevojitet:
Private Type CWPSTRUCT
       lParam As Long
       wParam As Long
       message As Long
       hwnd As Long
End Type

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
         (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
         (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long

Private Declare Function CallNextHookEx Lib "user32" _
         (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
         (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
         (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
         (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
         (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Const WH_CALLWNDPROC = 4
Private Const GWL_WNDPROC = (-4)
Private Const WM_CTLCOLORBTN = &H135
Private Const WM_DESTROY = &H2
Private Const WM_SETTEXT = &HC
Private Const WM_CREATE = &H1

Private lHook As Long
Private lPrevWnd As Long

Private bCustom As Boolean ' modifikim i paraqitjes se formes
Private sButtons() As String ' emrat e butonave mbi Message Box
Private lButton As Long
Private sHwnd As String

Public Function SubMsgBox(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, _
                          ByVal lParam As Long) As Long
   Dim sText As String
   
   Select Case Msg
     Case WM_CTLCOLORBTN
       ' Ketu do te modifikohen butonat e MsgBox-it:       
       ' Vizato butonin:
       SubMsgBox = CallWindowProc(lPrevWnd, hwnd, Msg, wParam, ByVal lParam)
       
       ' Ndrysho tekstin e butonit...
       If Not bCustom Then Exit Function
       If lButton = 0 Then sHwnd = vbNullString
       ' ... nese teksti nuk eshte modifikuar njehere:
       If InStr(sHwnd, " " & Trim(str(lParam)) & " ") Then Exit Function
       
       sText = sButtons(lButton)  ' vektori sButtons permban emrat
       sHwnd = sHwnd & " " & Trim(str(lParam)) & " "
       lButton = lButton + 1
       
       ' Dergoji sistemit mesazhin me modifikimet e bera me lart:
       SendMessage lParam, WM_SETTEXT, Len(sText), ByVal sText
       
       Exit Function
       
     Case WM_DESTROY
       ' Shkaterro formen e ngarkuar kur perdoruesi mbaron pune me te:
       Call SetWindowLong(hwnd, GWL_WNDPROC, lPrevWnd)
   End Select
   
   ' Shfaq msgbox-in
   SubMsgBox = CallWindowProc(lPrevWnd, hwnd, Msg, wParam, ByVal lParam)
   
End Function

Private Function HookWindow(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Dim tCWP As CWPSTRUCT  ' struktura e deklaruar ne fillim
   Dim sClass As String
   
   CopyMemory tCWP, ByVal lParam, Len(tCWP)
   
   If tCWP.message = WM_CREATE Then
       sClass = Space(255)
       sClass = Left(sClass, GetClassName(tCWP.hwnd, ByVal sClass, 255))
       
       If sClass = "#32770" Then
           lPrevWnd = SetWindowLong(tCWP.hwnd, GWL_WNDPROC, AddressOf SubMsgBox)
       End If
   End If
   
   HookWindow = CallNextHookEx(lHook, nCode, wParam, ByVal lParam)
   
End Function

Public Function MsgBoxEx(ByVal Prompt As String, Optional ByVal Buttons As Long = vbOKOnly, _
                  Optional ByVal Title As String, Optional ByVal HelpFile As String, _
                  Optional ByVal Context As Long, Optional ByRef CustomButtons As Variant) As Long
   
   On Error GoTo err_log
   
   Dim lReturn As Long
   
   bCustom = (Buttons = vbCustom)
   
   If bCustom And IsMissing(CustomButtons) Then
       GoTo err_log
       Exit Function
   End If
   
   lHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf HookWindow, App.hInstance, App.ThreadID)
   
   If Len(Title) = 0 Then Title = App.Title
   
   If bCustom Then
       If TypeName(CustomButtons) = "String" Then
           ReDim sButtons(0)
           sButtons(0) = CustomButtons
           Buttons = 0
       Else
           sButtons = CustomButtons
           Buttons = UBound(sButtons)
       End If
   End If
   
   lButton = 0
   
   lReturn = MsgBox(Prompt, Buttons, Title, HelpFile, Context)
   
   Call UnhookWindowsHookEx(lHook)
   
   If bCustom Then lReturn = lReturn - (UBound(CustomButtons) + 1)
   
   bCustom = False
   MsgBoxEx = lReturn
   
   Exit Function
   
err_log:
   Call AppendToLog("modMsgBox :: MsgBoxEx(), Gabimi " & Err.Number & ": " & Err.Description, ERR_LOG_FILE)
   
End Function

Menyra se si therritet kodi i mesiperm nga cdo module tjeter e projektit eshte si me poshte.

Fillimisht, deklarohet nje vektor i tipit String, i cili do te permbaje emrat e butonave. Vektori mund te deklarohet ne module, brenda nje procedure/funksioni te caktuar.

   ' Deklarojme nje vektor me dy elemente:
   Dim butonat(1) As String, lPergjigje as Long

Me tej, duhet te japim vlerat per cdo indeks te vektorit. Per shembull:

   butonat(0) = "Po"
   butonat(1) = "Jo"

Paskesaj mund te therrasim kodin

   lPergjigje = MsgBoxEx("Te mbyllet programi?", _
                   vbCustom, App.Title, , , butonat)

   If lPergjigje = -1 Then ' Po
      MsgBox "po" 
   Else ' nese perdoruesi e mbyll ose klikon mbi butonin "Jo":
      MsgBox "jo"  
   End If

Disa Vrojtime

Verehet se kodi i mesiperm therret funksionin MsgBoxEx, i cili eshte percaktuar me lart, duke i dhene si parametra konstantet vbCustom (qe informon gjuhen se perdoruesi ka vendosur te modifikoje MsgBox-in), si dhe adresen e vektorit te tipit String, butonat. Ne ekran do te shfaqet menjehere nje Message Box i modifikuar me butonat "Po" dhe "Jo".

Nga eksperienca ime, vlerat qe kthen MsgBoxEx nuk jane gjithnje -1, 0, 1, 2, ... per cdo buton qe ne shtojme ne vektorin butonat(). Per kete arsye, funksioni MsgBoxEx mund te therritet brenda vektorit butonat, e cila eshte ekuivalente me vendosjen e variablit lPergjigje si nje indeks i vektorit ne fjale:

 Debug.Print butonat(lPergjigje)

Sigurisht, mundesite e modifikimit jane te pafundme, prandaj sugjeroj qe kembengulesit te testojne mundesi te ndryshme.