پیغام سفارشی فارسی با استفاده از دستور ویژوال بیسیک

Collapse
این تاپیک قفل است.
X
X
 
  • زمان
  • نمایش
حذف همه
new posts
  • look20

    • 2013/10/28
    • 20

    [حل شده] پیغام سفارشی فارسی با استفاده از دستور ویژوال بیسیک

    سلام
    توی انجمن گشتم و مورد خاصی پیدا نکردم
    توی ویژوال بیسیک میشه پیغام msgbox رو بصورت سفارشی تغییر داد این کد:

    کد PHP:
    Private SourceGozar As Long
    Private m_hHook As Long
    Private Const IDOK 1
    Private Const IDCANCEL 2
    Private Const IDABORT 3
    Private Const IDRETRY 4
    Private Const IDIGNORE 5
    Private Const IDYES 6
    Private Const IDNO 7

    Private Const WH_CBT 5
    Private Const GWL_HINSTANCE = (-6)
    Private Const 
    HCBT_ACTIVATE 5

    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongByVal nIndex As Long) As Long
    Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As LongByVal nIDDlgItem As LongByVal lpString As String) As Long
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongByVal lpfn As LongByVal hmod As LongByVal dwThreadId As Long) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    Public Sub MessageBoxH(hwndThreadOwner As Long)
        
        
    Dim hInstance As Long
        Dim hThreadId 
    As Long
        
        hInstance 
    GetWindowLong(hwndThreadOwnerGWL_HINSTANCE)
        
    hThreadId GetCurrentThreadId()
        
        
    m_hHook SetWindowsHookEx(WH_CBTAddressOf MsgBoxHookProchInstancehThreadId)
        
    End Sub
    Private Function MsgBoxHookProc(ByVal uMsg As LongByVal wParam As LongByVal lParam As Long) As Long
        
        
    If uMsg HCBT_ACTIVATE Then
            SetDlgItemText wParam
    IDOK"ÊÃííÏ"
            
    SetDlgItemText wParamIDCANCEL"áÛæ"
            
    SetDlgItemText wParamIDABORT"ÞØÚ Úãá"
            
    SetDlgItemText wParamIDRETRY"ÓÚí ãÌÏÏ"
            
    SetDlgItemText wParamIDIGNORE"ÕÑÝ äÙÑ"
            
    SetDlgItemText wParamIDYES"Èáå"
            
    SetDlgItemText wParamIDNO"äå"
            
            
    UnhookWindowsHookEx m_hHook
        End 
    If
        
    MsgBoxHookProc False
        
    End 
    Function
    Public Function 
    MsgBox2(Form1 As Formprompt As Stringstyle As VbMsgBoxStyletitle As String) As Long
            MessageBoxH Form1
    .hwnd
        MsgBox2 
    MsgBox(promptstyletitle)
    End Function
    Public Function 
    MsgBox3(Form1 As Formprompt As Stringstyle As VbMsgBoxStyletitle As String) As Long
            MessageBoxH Form1
    .hwnd
        MsgBox3 
    MsgBox(promptstyle vbMsgBoxRtlReading vbMsgBoxRighttitle)
    End Function 
    این کد رو هم برای فراخوانی استفاده میشه کرد :
    کد PHP:
    Private Sub Command1_Click()
    MsgBox3 Me"کادر پيام فارسي"vbCritical vbYesNo"VB6 Source"
    End Sub 
    حالا من سوال داشتم میشه همین کد ها رو توی vba اجرا کرد خود کد api روی توی ماژول کپی میکنم بدون مشکل هست ولی دستور اجرای دکمه خطا میگیره
    ممنون
  • look20

    • 2013/10/28
    • 20

    #2
    پیغام فارسی صددر صد کاربردی اکسل

    بچه ها مشکل حل شد تشکر یادتون نره
    لطفا مدیران محترم قسمت دوم این پست بهمراه فایل رو به قسمت addons انتقال بدید ممنون
    فایل های پیوست شده

    کامنت

    چند لحظه..