• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Một số hộp thoại tiếng Việt

Các mẹo vặt linh tinh khác, không thuộc nhóm nào
QuangHoa
Guru
Guru
Bài viết: 542
Ngày tham gia: T.Năm 27/03/2008 9:02 am
Đến từ: Quê hương Đại tướng Võ Nguyên Giáp
Been thanked: 5 time
Liên hệ:

Một số hộp thoại tiếng Việt

Gửi bàigửi bởi QuangHoa » T.Ba 07/10/2008 8:18 am

Thủ thuật: Hiển thị hộp thoại bằng tiếng Việt
Tác giả: Võ Quang Hòa
Mô tả: Một số hộp thoại tiếng Việt


Giới thiệu cách hiển thị Hộp thoại (Msgbox, Chọn Màu, Open...) bằng tiếng Viêt. Các bạn có thể lưu thành một Module để sau này xài =D>


朋友
这些年一个人风也过雨也走,有过泪有过错还记得坚持什么。
真爱过才会懂会记没会回手,终有梦中有你在心中。
朋友一生一起走那些日子不再有,一句话一辈子一生情一杯九。
朋友不曾孤单过一声朋友你会懂,还有伤还有痛还要走还有我。

QuangHoa
Guru
Guru
Bài viết: 542
Ngày tham gia: T.Năm 27/03/2008 9:02 am
Đến từ: Quê hương Đại tướng Võ Nguyên Giáp
Been thanked: 5 time
Liên hệ:

1: Hộp Thoại MSGBOX

Gửi bàigửi bởi QuangHoa » T.Ba 07/10/2008 8:19 am

Cái này của ThuongAll, mình thấy nó trong Mã nguồn của VBLIB. =D> :-?

Mã: Chọn hết

  1. Option Explicit
  2. '
  3. ' Module:       Unicode Message Box (mUniMsgBox.bas)
  4. ' Yeu cau:      Ham VniStrToUni (mUniFunc.bas)
  5. ' Nguoi viet:   thuongall
  6. ' Email:        thuongall@yahoo.com
  7. ' Website:      www.caulacbovb.com
  8. ' Su dung:      Call UniMsgBox(VniStrToUni("Ca6u la5c bo65 VB"), vbInformation, VniStrToUni("Cha2o ba5n!"), Me.hWnd)
  9. '
  10. Private hDlgHook As Long
  11.  
  12. Private Const FONT_FACE = "Tahoma"
  13.  
  14. Private Const WH_CBT = 5
  15. Private Const HCBT_ACTIVATE = 5
  16. Private Const WM_SETFONT = &H30
  17.  
  18. Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal h As Long, ByVal w As Long, ByVal E As Long, ByVal O As Long, ByVal w As Long, ByVal i As Long, ByVal U As Long, ByVal s As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
  19. Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal ParenthWnd As Long, ByVal ChildhWnd As Long, ByVal ClassName As String, ByVal Caption As String) As Long
  20. 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
  21. Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  22. Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
  23. Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  24. Declare Function GetCurrentThreadId Lib "kernel32" () As Long
  25. Declare Function SetWindowTextW Lib "user32" (ByVal hWnd As Long, ByVal lpString As Long) As Long
  26. Declare Function MessageBoxW Lib "user32.dll" (ByVal hWnd As Long, ByVal lpText As Long, ByVal lpCaption As Long, ByVal uType As Long) As Long
  27.  
  28. Function UniMsgBox(strText As String, Optional iButtons As VbMsgBoxStyle = vbOKOnly, Optional strTitle As String, Optional hWnd As Long = &H0) As VbMsgBoxResult
  29.     hDlgHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, App.hInstance, GetCurrentThreadId())
  30.     UniMsgBox = MessageBoxW(hWnd, StrPtr(strText), StrPtr(strTitle), iButtons)
  31. End Function
  32.  
  33. Private Function HookProc(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  34.     Dim hStatic1 As Long, hStatic2 As Long, hButton As Long, hFont As Long
  35.     HookProc = CallNextHookEx(hDlgHook, ncode, wParam, lParam)
  36.     If ncode = HCBT_ACTIVATE Then
  37.         hFont = CreateFont(13, 0, 0, 0, 500, 0, 0, 0, 0, 0, 0, 0, 0, FONT_FACE)
  38.    
  39.         hStatic1 = FindWindowEx(wParam, 0&, "Static", vbNullString)
  40.         hStatic2 = FindWindowEx(wParam, hStatic1, "Static", vbNullString)
  41.         If hStatic2 = 0 Then hStatic2 = hStatic1
  42.         SendMessage hStatic2, WM_SETFONT, hFont, ByVal 1&
  43.    
  44.         hButton = FindWindowEx(wParam, 0&, "Button", "OK")
  45.         SendMessage hButton, WM_SETFONT, hFont, 0
  46.         SetWindowTextW hButton, StrPtr(ChrW(&H110) & "óng")
  47.    
  48.         hButton = FindWindowEx(wParam, 0&, "Button", "&Yes")
  49.         SendMessage hButton, WM_SETFONT, hFont, 0
  50.         SetWindowTextW hButton, StrPtr("Có")
  51.    
  52.         hButton = FindWindowEx(wParam, 0&, "Button", "&No")
  53.         SendMessage hButton, WM_SETFONT, hFont, 0
  54.         SetWindowTextW hButton, StrPtr("Không")
  55.    
  56.          hButton = FindWindowEx(wParam, 0&, "Button", "&Retry")
  57.         SendMessage hButton, WM_SETFONT, hFont, 0
  58.         SetWindowTextW hButton, StrPtr("Th" & ChrW(&H1EED) & " l" & ChrW(&H1EA1) & "i")
  59.    
  60.         hButton = FindWindowEx(wParam, 0&, "Button", "Cancel")
  61.         SendMessage hButton, WM_SETFONT, hFont, 0
  62.         SetWindowTextW hButton, StrPtr("Thoát")
  63.        
  64.        UnhookWindowsHookEx hDlgHook
  65.     End If
  66. End Function
  67.  
  68.  
朋友
这些年一个人风也过雨也走,有过泪有过错还记得坚持什么。
真爱过才会懂会记没会回手,终有梦中有你在心中。
朋友一生一起走那些日子不再有,一句话一辈子一生情一杯九。
朋友不曾孤单过一声朋友你会懂,还有伤还有痛还要走还有我。

QuangHoa
Guru
Guru
Bài viết: 542
Ngày tham gia: T.Năm 27/03/2008 9:02 am
Đến từ: Quê hương Đại tướng Võ Nguyên Giáp
Been thanked: 5 time
Liên hệ:

2: Hộp thoại Chọn thư mục

Gửi bàigửi bởi QuangHoa » T.Ba 07/10/2008 8:21 am

Mã: Chọn hết

  1. '***==========================================================================***|
  2. '*                 HOP THOAI BROWSE FOR FOLDER BANG TIENG VIET                  *|
  3. '*                       Tac gia: Vo Quang Hoa                                  *|
  4. '*                        voquanghoa@Gmail.com                                  *|
  5. '*                                                                              *|
  6. '*       Dung trong Form a=ChonThuMuc(Me,["Chuoi tieu de"],["Chuoi label"])     *|
  7. '***==========================================================================***|
  8. Private Type BrowseInfo
  9.     hWndOwner As Long
  10.     pIDLRoot As Long
  11.     pszDisplayName As Long
  12.     lpszTitle As Long
  13.     ulFlags As Long
  14.     lpfnCallback As Long
  15.     lParam As Long
  16.     iImage As Long
  17. End Type
  18. Private Const WM_SETFONT = &H30
  19. Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal h As Long, ByVal w As Long, ByVal E As Long, ByVal O As Long, ByVal w As Long, ByVal i As Long, ByVal U As Long, ByVal s As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
  20. ' Tao font Unicode cho tieng Viet
  21. Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal ParenthWnd As Long, ByVal ChildhWnd As Long, ByVal ClassName As String, ByVal Caption As String) As Long
  22. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  23. ' Tim cua so
  24. Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  25. Declare Function SetWindowTextW Lib "user32" (ByVal hWnd As Long, ByVal lpString As Long) As Long
  26. ' Gui thong diep doi  font va doi van ban
  27. Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
  28. Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
  29. Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
  30. Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
  31. ' Cac ham API dung cho hop thoai Browse
  32. Private DialogTit$
  33. Private DialogTxt$
  34. Private Han As Long
  35. Private Function Address(ByVal Add As Long) As Long
  36. Address = Add
  37. End Function
  38. Private Function Browse() As String
  39.     Dim iNull As Integer, lpIDList As Long, lResult As Long
  40.     Dim sPath As String, udtBI As BrowseInfo
  41.     With udtBI
  42.         .hWndOwner = Han
  43.         .lpfnCallback = Address(AddressOf BrowseCallbackProc)
  44.         .lpszTitle = lstrcat("CCC", "")
  45.         .ulFlags = 1
  46.     End With
  47.     lpIDList = SHBrowseForFolder(udtBI)
  48.     If lpIDList Then
  49.         sPath = String$(256, 0)
  50.         SHGetPathFromIDList lpIDList, sPath
  51.         CoTaskMemFree lpIDList
  52.         iNull = InStr(sPath, vbNullChar)
  53.         If iNull Then
  54.             sPath = Left$(sPath, iNull - 1)
  55.         End If
  56.     End If
  57.  
  58.     Browse = sPath
  59. End Function
  60. Public Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpdata As Long) As Long
  61. On Error Resume Next
  62.         hFont = CreateFont(13, 0, 0, 0, 300, 0, 0, 0, 0, 0, 0, 0, 0, "Tahoma")
  63.        
  64.         hButton = FindWindowEx(hWnd, 0&, "Button", "OK")
  65.         SendMessage hButton, WM_SETFONT, hFont, 0
  66.         SetWindowTextW hButton, StrPtr(Telex2Uni("Chän"))
  67.        
  68.         hButton = FindWindowEx(hWnd, 0&, "Button", "Cancel")
  69.         SendMessage hButton, WM_SETFONT, hFont, 0
  70.         SetWindowTextW hButton, StrPtr(Telex2Uni("Bá qua"))
  71.        
  72.         hButton = FindWindowEx(hWnd, 0&, "static", "CCC")
  73.         SendMessage hWnd, WM_SETFONT, hFont, 0
  74.         SetWindowTextW hButton, StrPtr(DialogTxt)
  75.        
  76.         SendMessage hWnd, WM_SETFONT, hFont, 0
  77.         SetWindowTextW hWnd, StrPtr(DialogTit)
  78. End Function
  79. Private Function Telex2Uni(sTelex$) As String
  80. Dim sT$, SU$
  81. Static sTmp$, i
  82. sTmp$ = ""
  83. sT$ = vbLf & vbCr & "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789(),./:[]<>*&!$|\?@# ;'~}{-=+_" & _
  84.     "µ¶·¸¹»¼½¾ÆÇÈÉÊËÌÎÏÐÑÒÓÔÕÖ×ØÜÝÞßáâãäåæçèéêëìíîïñòóôõö÷øùúûüýþ§¡¢£¤¥¦®¨©ª«¬­"
  85. SU$ = vbLf & vbCr & "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789(),./:[]<>*&!$|\?@# ;'~}{-=+_" & _
  86. ChrW(224) & ChrW(7843) & ChrW(227) & ChrW(225) & ChrW(7841) & ChrW(7857) & ChrW(7859) & ChrW(7861) & _
  87. ChrW(7855) & ChrW(7863) & ChrW(7847) & ChrW(7849) & ChrW(7851) & ChrW(7845) & ChrW(7853) & ChrW(232) & _
  88. ChrW(7867) & ChrW(7869) & ChrW(233) & ChrW(7865) & ChrW(7873) & ChrW(7875) & ChrW(7877) & ChrW(7871) & _
  89. ChrW(7879) & ChrW(236) & ChrW(7881) & ChrW(297) & ChrW(237) & ChrW(7883) & ChrW(242) & ChrW(7887) & _
  90. ChrW(245) & ChrW(243) & ChrW(7885) & ChrW(7891) & ChrW(7893) & ChrW(7895) & ChrW(7889) & ChrW(7897) & _
  91. ChrW(7901) & ChrW(7903) & ChrW(7905) & ChrW(7899) & ChrW(7907) & ChrW(249) & ChrW(7911) & ChrW(361) & _
  92. ChrW(250) & ChrW(7909) & ChrW(7915) & ChrW(7917) & ChrW(7919) & ChrW(7913) & ChrW(7921) & ChrW(7923) & _
  93. ChrW(7927) & ChrW(7929) & ChrW(253) & ChrW(7925) & ChrW(272) & ChrW(258) & ChrW(194) & ChrW(202) & _
  94. ChrW(212) & ChrW(416) & ChrW(431) & ChrW(273) & ChrW(259) & ChrW(226) & ChrW(234) & ChrW(244) & ChrW(417) & ChrW(432)
  95.  
  96. For i = 1 To Len(sTelex$)
  97.     sTmp$ = sTmp$ & Mid(SU$, InStr(1, sT$, Mid$(sTelex$, i, 1)), 1)
  98. Next i
  99. Telex2Uni = sTmp$
  100. End Function
  101. Public Function ChonThuMuc(YouForm As Form, Optional title$, Optional txt$) As String
  102. If title <> "" Then
  103.     DialogTit = Telex2Uni(title)
  104. Else
  105.     DialogTit = Telex2Uni("Chän th­ môc")
  106. End If
  107. If txt <> "" Then
  108.     DialogTxt = Telex2Uni(txt)
  109. Else
  110.     DialogTxt = Telex2Uni("Chän th­ môc råi bÊm nót ") & ChrW(34) & Telex2Uni("Chän") & ChrW(34)
  111. End If
  112. Han = YouForm.hWnd
  113.  ChonThuMuc = Browse()
  114. End Function
朋友
这些年一个人风也过雨也走,有过泪有过错还记得坚持什么。
真爱过才会懂会记没会回手,终有梦中有你在心中。
朋友一生一起走那些日子不再有,一句话一辈子一生情一杯九。
朋友不曾孤单过一声朋友你会懂,还有伤还有痛还要走还有我。

QuangHoa
Guru
Guru
Bài viết: 542
Ngày tham gia: T.Năm 27/03/2008 9:02 am
Đến từ: Quê hương Đại tướng Võ Nguyên Giáp
Been thanked: 5 time
Liên hệ:

3: Hộp thoại Open File

Gửi bàigửi bởi QuangHoa » T.Ba 07/10/2008 8:22 am

Mã: Chọn hết

  1. '***==========================================================================***|
  2. '*                    HOP THOAI OPEN FILE BANG TIENG VIET                       *|
  3. '*                       Tac gia: Vo Quang Hoa                                  *|
  4. '*                        voquanghoa@Gmail.com                                  *|
  5. '*              Su dung ham Telex2uni trong http://www.caulacbovb.com           *|
  6. '*            Dung trong Form file =  MoFile(Me,[Tieude],[Filte],[Indir])       *|
  7. '***==========================================================================***|
  8. Option Explicit
  9. Private Const WH_CBT = 5
  10. Private Const WM_SETFONT = &H30
  11.  
  12.  
  13. Public Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal w As Long, ByVal E As Long, ByVal O As Long, ByVal w As Long, ByVal i As Long, ByVal U As Long, ByVal s As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal f As String) As Long
  14. Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
  15. Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal ParenthWnd As Long, ByVal ChildhWnd As Long, ByVal ClassName As String, ByVal Caption As String) As Long
  16. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  17. ' Tim cua so
  18. Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  19. Declare Function SetWindowTextW Lib "user32" (ByVal hwnd As Long, ByVal lpString As Long) As Long
  20. Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
  21. 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
  22.  
  23.  
  24.  
  25. Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
  26.          "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
  27.  
  28. Private Type OPENFILENAME
  29.     lStructSize As Long
  30.     hwndOwner As Long
  31.     hInstance As Long
  32.     lpstrFilter As String
  33.     lpstrCustomFilter As String
  34.     nMaxCustFilter As Long
  35.     nFilterIndex As Long
  36.     lpstrFile As String
  37.     nMaxFile As Long
  38.     lpstrFileTitle As String
  39.     nMaxFileTitle As Long
  40.     lpstrInitialDir As String
  41.     lpstrTitle As String
  42.     flags As Long
  43.     nFileOffset As Integer
  44.     nFileExtension As Integer
  45.     lpstrDefExt As String
  46.     lCustData As Long
  47.     lpfnHook As Long
  48.     lpTemplateName As String
  49. End Type
  50. Private hHook As Long
  51. Private Tit As String
  52. Private fi As String
  53. Private i As Long
  54. Private di As String
  55. Private Function OpenFile() As String
  56.     Dim hOpenFile As OPENFILENAME
  57.     Dim retval As Long
  58.     With hOpenFile
  59.         .lStructSize = Len(hOpenFile)
  60.         .hwndOwner = Form1.hwnd
  61.         .hInstance = App.hInstance
  62.         .lpstrFilter = fi
  63.         .nFilterIndex = 1
  64.         .lpstrFile = String(257, 0)
  65.         .nMaxFile = Len(hOpenFile.lpstrFile) - 1
  66.         .lpstrFileTitle = hOpenFile.lpstrFile
  67.         .nMaxFileTitle = hOpenFile.nMaxFile
  68.         .lpstrInitialDir = di
  69.         .lpstrTitle = "CCCCC"
  70.         .flags = &H2 Or &H8
  71.         i = 0
  72.     End With
  73.     hHook = SetWindowsHookEx(WH_CBT, AddressOf OpenHookProc, App.hInstance, GetCurrentThreadId())
  74.     retval = GetOpenFileName(hOpenFile)
  75.     UnhookWindowsHookEx hHook
  76.     If retval = 0 Then
  77.         OpenFile = ""
  78.     Else
  79.         OpenFile = Trim(hOpenFile.lpstrFile)
  80.     End If
  81. End Function
  82. Private Function OpenHookProc(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  83. On Error Resume Next
  84. Dim hButton As Long, hOp As Long, hFont As Long
  85.  
  86.  
  87. If ncode <> 6 Then Exit Function
  88. i = i + 1
  89. If i > 5 Then UnhookWindowsHookEx hHook
  90. hFont = CreateFont(13, 0, 0, 0, 500, 0, 0, 0, 0, 0, 0, 0, 0, "Tahoma")
  91.  
  92. hOp = FindWindow("#32770", "CCCCC")
  93. SendMessage hOp, WM_SETFONT, hFont, 0
  94. SetWindowTextW hOp, StrPtr(Tit)
  95.  
  96. hButton = FindWindowEx(hOp, 0&, "Button", "&Open")
  97. SendMessage hButton, WM_SETFONT, hFont, 0
  98. SetWindowTextW hButton, StrPtr(Telex2Uni("&Më"))
  99.  
  100. hButton = FindWindowEx(hOp, 0&, "Button", "Cancel")
  101. SendMessage hButton, WM_SETFONT, hFont, 0
  102. SetWindowTextW hButton, StrPtr(Telex2Uni("&Bá qua"))
  103.  
  104. hButton = FindWindowEx(hOp, 0&, "Button", "Open as &read-only")
  105. SendMessage hButton, WM_SETFONT, hFont, 0
  106. SetWindowTextW hButton, StrPtr(Telex2Uni("Më &chØ ®äc"))
  107.  
  108. hButton = FindWindowEx(hOp, 0&, "Static", "Files of &type:")
  109. SendMessage hButton, WM_SETFONT, hFont, 0
  110. SetWindowTextW hButton, StrPtr(Telex2Uni("&KiÓu tËp tin :"))
  111.  
  112. hButton = FindWindowEx(hOp, 0&, "Static", "File &name:")
  113. SendMessage hButton, WM_SETFONT, hFont, 0
  114. SetWindowTextW hButton, StrPtr(Telex2Uni("&Tªn tËp tin :"))
  115.    
  116. hButton = FindWindowEx(hOp, 0&, "Static", "Look &in:")
  117. SendMessage hButton, WM_SETFONT, hFont, 0
  118. SetWindowTextW hButton, StrPtr(Telex2Uni("T×m t&rong :"))
  119.  
  120. End Function
  121. Public Function MoFile(FormOner As Form, Optional Title As String, Optional Filte As String, Optional Dir As String) As String
  122. If Title <> "" Then
  123.     Tit = Telex2Uni(Title)
  124. Else
  125.     Tit = Telex2Uni("H·y chän tËp tin")
  126. End If
  127. If Filte = "" Then
  128.     fi = Replace("All file (*.*)|*.*", "|", Chr(0)) & Chr(0)
  129. Else
  130.     fi = Replace(Filte, "|", Chr(0)) & Chr(0)
  131. End If
  132. di = Dir
  133. MoFile = OpenFile
  134. End Function
  135. Public Function Telex2Uni(sTelex$) As String
  136. Dim sT$, SU$
  137. Static sTmp$, i
  138. sTmp$ = ""
  139. sT$ = vbLf & vbCr & "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789(),./:[]<>*&!$|\?@# ;'~}{-=+_" & _
  140.     "µ¶·¸¹»¼½¾ÆÇÈÉÊËÌÎÏÐÑÒÓÔÕÖ×ØÜÝÞßáâãäåæçèéêëìíîïñòóôõö÷øùúûüýþ§¡¢£¤¥¦®¨©ª«¬­"
  141. SU$ = vbLf & vbCr & "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789(),./:[]<>*&!$|\?@# ;'~}{-=+_" & _
  142. ChrW(224) & ChrW(7843) & ChrW(227) & ChrW(225) & ChrW(7841) & ChrW(7857) & ChrW(7859) & ChrW(7861) & _
  143. ChrW(7855) & ChrW(7863) & ChrW(7847) & ChrW(7849) & ChrW(7851) & ChrW(7845) & ChrW(7853) & ChrW(232) & _
  144. ChrW(7867) & ChrW(7869) & ChrW(233) & ChrW(7865) & ChrW(7873) & ChrW(7875) & ChrW(7877) & ChrW(7871) & _
  145. ChrW(7879) & ChrW(236) & ChrW(7881) & ChrW(297) & ChrW(237) & ChrW(7883) & ChrW(242) & ChrW(7887) & _
  146. ChrW(245) & ChrW(243) & ChrW(7885) & ChrW(7891) & ChrW(7893) & ChrW(7895) & ChrW(7889) & ChrW(7897) & _
  147. ChrW(7901) & ChrW(7903) & ChrW(7905) & ChrW(7899) & ChrW(7907) & ChrW(249) & ChrW(7911) & ChrW(361) & _
  148. ChrW(250) & ChrW(7909) & ChrW(7915) & ChrW(7917) & ChrW(7919) & ChrW(7913) & ChrW(7921) & ChrW(7923) & _
  149. ChrW(7927) & ChrW(7929) & ChrW(253) & ChrW(7925) & ChrW(272) & ChrW(258) & ChrW(194) & ChrW(202) & _
  150. ChrW(212) & ChrW(416) & ChrW(431) & ChrW(273) & ChrW(259) & ChrW(226) & ChrW(234) & ChrW(244) & ChrW(417) & ChrW(432)
  151.  
  152. For i = 1 To Len(sTelex$)
  153.     sTmp$ = sTmp$ & Mid(SU$, InStr(1, sT$, Mid$(sTelex$, i, 1)), 1)
  154. Next i
  155. Telex2Uni = sTmp$
  156. End Function
  157.  
朋友
这些年一个人风也过雨也走,有过泪有过错还记得坚持什么。
真爱过才会懂会记没会回手,终有梦中有你在心中。
朋友一生一起走那些日子不再有,一句话一辈子一生情一杯九。
朋友不曾孤单过一声朋友你会懂,还有伤还有痛还要走还有我。

QuangHoa
Guru
Guru
Bài viết: 542
Ngày tham gia: T.Năm 27/03/2008 9:02 am
Đến từ: Quê hương Đại tướng Võ Nguyên Giáp
Been thanked: 5 time
Liên hệ:

4: Hộp thoại chọn màu

Gửi bàigửi bởi QuangHoa » T.Ba 07/10/2008 8:24 am

Mã: Chọn hết

  1. '***===================================================================***|
  2. '*                 HOP THOAI CHON MAU BANG TIENG VIET                    *|
  3. '*                       Tac gia: Vo Quang Hoa                           *|
  4. '*                        voquanghoa@Gmail.com                           *|
  5. '*           Su dung ham Telex2uni trong http://www.caulacbovb.com       *|
  6. '*              Dung trong Form a=ChonMau(me,"H·y chän mµu")             *|
  7. '*   Ket qua tra ve la mot so tu &H0 ~ &HFFFFFF neu nguoi dung chon mau  *|
  8. '*                   Hoac la -1 meu nguoi dung bo qua                    *|
  9. '*              Neu thay hay thi Thank phat nghen !!!                    *|
  10. '***===================================================================***|
  11.  
  12.  
  13.  
  14. Option Explicit
  15. Private Const WM_SETFONT = &H30
  16.    Private Type CHOOSECOLOR
  17.      lStructSize As Long
  18.      hwndOwner As Long
  19.      hInstance As Long
  20.      rgbResult As Long
  21.      lpCustColors As String
  22.      flags As Long
  23.      lCustData As Long
  24.      lpfnHook As Long
  25.      lpTemplateName As String
  26.    End Type
  27. Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal I As Long, ByVal u As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
  28. Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
  29. 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
  30. Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long
  31. Private Declare Function SetWindowTextW Lib "user32" (ByVal hWnd As Long, ByVal lpString As Long) As Long
  32. Private Declare Function ChooseColorAPI Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
  33.  
  34. Private CustomColors() As Byte
  35. Dim tit As String
  36. Public Function ChonMau(hwndOwner As Form, Optional title As String) As Long
  37. If title = "" Then
  38.     tit = Telex2Uni("Xin h·y chän mµu")
  39. Else
  40.     tit = Telex2Uni(title)
  41. End If
  42.        Dim cc As CHOOSECOLOR
  43.        Dim Custcolor(16) As Long
  44.        
  45.        ReDim CustomColors(0 To 16 * 4 - 1) As Byte
  46.        Dim I As Integer
  47.  
  48.        For I = LBound(CustomColors) To UBound(CustomColors)
  49.            CustomColors(I) = 0
  50.        Next I
  51.        Dim lReturn As Long
  52.        cc.lCustData = 1
  53.        cc.lStructSize = Len(cc)
  54.        cc.hwndOwner = hwndOwner.hWnd
  55.        cc.hInstance = 0
  56.        cc.lpfnHook = Address(AddressOf CCHookProc)
  57.        cc.lpCustColors = StrConv(CustomColors, vbUnicode)
  58.        cc.flags = &H10 Or &H2
  59.        lReturn = ChooseColorAPI(cc)
  60.        ChonMau = cc.rgbResult
  61.        If lReturn <> 0 Then
  62.             ChonMau = cc.rgbResult
  63.        Else
  64.             ChonMau = -1
  65.        End If
  66. End Function
  67. Private Function Address(ByVal Add As Long) As Long
  68. Address = Add
  69. End Function
  70. Public Function CCHookProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpdata As Long) As Long
  71. Dim hbutton As Long
  72. If uMsg <> 133 Then Exit Function
  73. On Error Resume Next
  74. Dim hFont As Long
  75.         hFont = CreateFont(13, 0, 0, 0, 300, 0, 0, 0, 0, 0, 0, 0, 0, "Tahoma")
  76.  
  77.         hbutton = FindWindowEx(hWnd, 0&, "Button", "OK")
  78.         SendMessage hbutton, WM_SETFONT, hFont, 0
  79.         SetWindowTextW hbutton, StrPtr(Telex2Uni("Chän"))
  80.  
  81.         hbutton = FindWindowEx(hWnd, 0&, "Button", "Cancel")
  82.         SendMessage hbutton, WM_SETFONT, hFont, 0
  83.         SetWindowTextW hbutton, StrPtr(Telex2Uni("Bá qua"))
  84.  
  85.         hbutton = FindWindowEx(hWnd, 0&, "Button", "&Define Custom Colors >>")
  86.         SendMessage hWnd, WM_SETFONT, hFont, 0
  87.         SetWindowTextW hbutton, StrPtr(Telex2Uni("§Þnh b¶ng mµu riªng"))
  88.  
  89.         hbutton = FindWindowEx(hWnd, 0&, "Static", "&Custom colors:")
  90.         SendMessage hWnd, WM_SETFONT, hFont, 0
  91.         SetWindowTextW hbutton, StrPtr(Telex2Uni("B¶ng mµu riªng"))
  92.  
  93.         hbutton = FindWindowEx(hWnd, 0&, "Button", "&Add to Custom Colors")
  94.         SendMessage hWnd, WM_SETFONT, hFont, 0
  95.         SetWindowTextW hbutton, StrPtr(Telex2Uni("Thªm vµo b¶ng mµu riªng"))
  96.      
  97.         hbutton = FindWindowEx(hWnd, 0&, "Static", "&Basic colors:")
  98.         SendMessage hWnd, WM_SETFONT, hFont, 0
  99.         SetWindowTextW hbutton, StrPtr(Telex2Uni("Mµu c¬ b¶n"))
  100.        
  101.         hbutton = FindWindowEx(hWnd, 0&, "Static", "Color")
  102.         SendMessage hWnd, WM_SETFONT, hFont, 0
  103.         SetWindowTextW hbutton, StrPtr(Telex2Uni("Mµu "))
  104.        
  105.         hbutton = FindWindowEx(hWnd, 0&, "Static", "|S&olid")
  106.         SendMessage hWnd, WM_SETFONT, hFont, 0
  107.         SetWindowTextW hbutton, StrPtr(Telex2Uni("®Æc "))
  108.        
  109.         hbutton = FindWindowEx(hWnd, 0&, "Static", "Hu&e:")
  110.         SendMessage hWnd, WM_SETFONT, hFont, 0
  111.         SetWindowTextW hbutton, StrPtr(Telex2Uni("Mµu "))
  112.    
  113.         hbutton = FindWindowEx(hWnd, 0&, "Static", "&Sat:")
  114.         SendMessage hWnd, WM_SETFONT, hFont, 0
  115.         SetWindowTextW hbutton, StrPtr(Telex2Uni("§Ëm"))
  116.    
  117.         hbutton = FindWindowEx(hWnd, 0&, "Static", "&Lum:")
  118.         SendMessage hWnd, WM_SETFONT, hFont, 0
  119.         SetWindowTextW hbutton, StrPtr(Telex2Uni("S¸ng"))
  120.  
  121.         hbutton = FindWindowEx(hWnd, 0&, "Static", "&Red:")
  122.         SendMessage hWnd, WM_SETFONT, hFont, 0
  123.         SetWindowTextW hbutton, StrPtr(Telex2Uni("§á"))
  124.        
  125.         hbutton = FindWindowEx(hWnd, 0&, "Static", "&Green:")
  126.         SendMessage hWnd, WM_SETFONT, hFont, 0
  127.         SetWindowTextW hbutton, StrPtr(Telex2Uni("Xanh l¸"))
  128.        
  129.          hbutton = FindWindowEx(hWnd, 0&, "Static", "Bl&ue:")
  130.         SendMessage hWnd, WM_SETFONT, hFont, 0
  131.         SetWindowTextW hbutton, StrPtr(Telex2Uni("Da trêi"))
  132.  
  133.         SendMessage hWnd, WM_SETFONT, hFont, 0
  134.         SetWindowTextW hWnd, StrPtr(tit)
  135. End Function
  136. Private Function Telex2Uni(sTelex$) As String
  137. Dim sT$, SU$
  138. Static sTmp$, I
  139. sTmp$ = ""
  140. sT$ = vbLf & vbCr & "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789(),./:[]<>*&!$|\?@# ;'~}{-=+_" & _
  141.     "µ¶·¸¹»¼½¾ÆÇÈÉÊËÌÎÏÐÑÒÓÔÕÖ×ØÜÝÞßáâãäåæçèéêëìíîïñòóôõö÷øùúûüýþ§¡¢£¤¥¦®¨©ª«¬­"
  142. SU$ = vbLf & vbCr & "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789(),./:[]<>*&!$|\?@# ;'~}{-=+_" & _
  143. ChrW(224) & ChrW(7843) & ChrW(227) & ChrW(225) & ChrW(7841) & ChrW(7857) & ChrW(7859) & ChrW(7861) & _
  144. ChrW(7855) & ChrW(7863) & ChrW(7847) & ChrW(7849) & ChrW(7851) & ChrW(7845) & ChrW(7853) & ChrW(232) & _
  145. ChrW(7867) & ChrW(7869) & ChrW(233) & ChrW(7865) & ChrW(7873) & ChrW(7875) & ChrW(7877) & ChrW(7871) & _
  146. ChrW(7879) & ChrW(236) & ChrW(7881) & ChrW(297) & ChrW(237) & ChrW(7883) & ChrW(242) & ChrW(7887) & _
  147. ChrW(245) & ChrW(243) & ChrW(7885) & ChrW(7891) & ChrW(7893) & ChrW(7895) & ChrW(7889) & ChrW(7897) & _
  148. ChrW(7901) & ChrW(7903) & ChrW(7905) & ChrW(7899) & ChrW(7907) & ChrW(249) & ChrW(7911) & ChrW(361) & _
  149. ChrW(250) & ChrW(7909) & ChrW(7915) & ChrW(7917) & ChrW(7919) & ChrW(7913) & ChrW(7921) & ChrW(7923) & _
  150. ChrW(7927) & ChrW(7929) & ChrW(253) & ChrW(7925) & ChrW(272) & ChrW(258) & ChrW(194) & ChrW(202) & _
  151. ChrW(212) & ChrW(416) & ChrW(431) & ChrW(273) & ChrW(259) & ChrW(226) & ChrW(234) & ChrW(244) & ChrW(417) & ChrW(432)
  152.  
  153. For I = 1 To Len(sTelex$)
  154.     sTmp$ = sTmp$ & Mid(SU$, InStr(1, sT$, Mid$(sTelex$, I, 1)), 1)
  155. Next I
  156. Telex2Uni = sTmp$
  157. End Function
  158.  

=D> =D> =D> =D>
朋友
这些年一个人风也过雨也走,有过泪有过错还记得坚持什么。
真爱过才会懂会记没会回手,终有梦中有你在心中。
朋友一生一起走那些日子不再有,一句话一辈子一生情一杯九。
朋友不曾孤单过一声朋友你会懂,还有伤还有痛还要走还有我。

Hình đại diện của người dùng
clarkkent
Mạnh Thường Quân
Mạnh Thường Quân
Bài viết: 1641
Ngày tham gia: T.Tư 16/04/2008 11:25 am
Đến từ: Chợ Lách - Bến Tre
Been thanked: 31 time
Liên hệ:

Re: Một số hộp thoại tiếng Việt

Gửi bàigửi bởi clarkkent » T.Sáu 10/10/2008 8:10 am

Hay đấy! nhưng có lẽ tui ít xài :D
• Hôm bây: www.tinsoftware.com ^ ^
Cố gắng lên...

dta4c
Bài viết: 2
Ngày tham gia: T.Tư 02/04/2008 12:29 am

Re: Một số hộp thoại tiếng Việt

Gửi bàigửi bởi dta4c » T.Bảy 25/10/2008 1:48 am

Hay quá bác có bản demo của chúng nó không send cho mọi người đi

QuangHoa
Guru
Guru
Bài viết: 542
Ngày tham gia: T.Năm 27/03/2008 9:02 am
Đến từ: Quê hương Đại tướng Võ Nguyên Giáp
Been thanked: 5 time
Liên hệ:

Re: Một số hộp thoại tiếng Việt

Gửi bàigửi bởi QuangHoa » CN 26/10/2008 7:47 am

Trời: bạn muốn thử cái nào thì cho đoạn mã tương ứng vào 1 Module, sau đó, thêm Code vào Form là đc mà! Bó tay.
朋友
这些年一个人风也过雨也走,有过泪有过错还记得坚持什么。
真爱过才会懂会记没会回手,终有梦中有你在心中。
朋友一生一起走那些日子不再有,一句话一辈子一生情一杯九。
朋友不曾孤单过一声朋友你会懂,还有伤还有痛还要走还有我。

noname9999
Bài viết: 1
Ngày tham gia: T.Ba 14/10/2008 8:52 am

Re: Một số hộp thoại tiếng Việt

Gửi bàigửi bởi noname9999 » T.Sáu 07/11/2008 8:37 am

Sao không Post hàm : VniStrToUni

Làm sao dùng được nhey? :(

Hình đại diện của người dùng
giaiphap
Thành viên tích cực
Thành viên tích cực
Bài viết: 187
Ngày tham gia: T.Sáu 06/06/2008 8:35 am

Re: Một số hộp thoại tiếng Việt

Gửi bàigửi bởi giaiphap » T.Sáu 09/01/2009 9:33 am

Hộp thoại Open File của QuangHoa nếu chọn được nhiều tập tin cùng lúc thì rất hay, nhưng rất tiếc ... :-?

Hình đại diện của người dùng
NoBi
Quản trị
Quản trị
Bài viết: 948
Ngày tham gia: T.Ba 18/03/2008 1:22 pm
Đến từ: Sài Gòn
Has thanked: 50 time
Been thanked: 66 time
Liên hệ:

Re: Một số hộp thoại tiếng Việt

Gửi bàigửi bởi NoBi » T.Sáu 09/01/2009 11:58 pm

Sửa chổ này: .flags = OFN_ALLOWMULTISELECT Or OFN_EXPLORER

Mã: Chọn hết

  1. Private Function OpenFile() As String
  2.     Dim hOpenFile As OPENFILENAME
  3.     Dim retval As Long
  4.     With hOpenFile
  5.         .lStructSize = Len(hOpenFile)
  6.         .hwndOwner = Form1.hwnd
  7.         .hInstance = App.hInstance
  8.         .lpstrFilter = fi
  9.         .nFilterIndex = 1
  10.         .lpstrFile = String(257, 0)
  11.         .nMaxFile = Len(hOpenFile.lpstrFile) - 1
  12.         .lpstrFileTitle = hOpenFile.lpstrFile
  13.         .nMaxFileTitle = hOpenFile.nMaxFile
  14.         .lpstrInitialDir = di
  15.         .lpstrTitle = "CCCCC"
  16.         .flags = OFN_ALLOWMULTISELECT Or OFN_EXPLORER
  17.         i = 0
  18.     End With
  19.     hHook = SetWindowsHookEx(WH_CBT, AddressOf OpenHookProc, App.hInstance, GetCurrentThreadId())
  20.     retval = GetOpenFileName(hOpenFile)
  21.     UnhookWindowsHookEx hHook
  22.     If retval = 0 Then
  23.         OpenFile = ""
  24.     Else
  25.         OpenFile = Trim(hOpenFile.lpstrFile)
  26.     End If
  27. End Function

Với:

Mã: Chọn hết

  1. Private Const OFN_ALLOWMULTISELECT = &H200
  2. Private Const OFN_EXPLORER = &H80000
:>

Hình đại diện của người dùng
giaiphap
Thành viên tích cực
Thành viên tích cực
Bài viết: 187
Ngày tham gia: T.Sáu 06/06/2008 8:35 am

Re: Một số hộp thoại tiếng Việt

Gửi bàigửi bởi giaiphap » T.Hai 27/07/2009 8:26 pm

Bác QuangHoa viết tiếp luôn hộp thoại Open Save luôn đi, mình đang cần sử dụng nhưng mình còn gà quá. Cám ơn bác trước nhé !


Quay về “[VB] Mẹo vặt khác”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.0 khách