• 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

Add font TCVN3 một cách tự động và chính xác

Các thủ thuật về hệ thống, thư mục, tập tin và mạng
Giang Hồ
Thành viên năng nổ
Thành viên năng nổ
Bài viết: 50
Ngày tham gia: T.Bảy 12/05/2007 2:36 pm
Đến từ: http://vn-soft.net
Been thanked: 1 time
Liên hệ:

Add font TCVN3 một cách tự động và chính xác

Gửi bàigửi bởi Giang Hồ » CN 20/04/2008 3:29 pm

code tự add font VK Sans Serif và khai báo với windows

Mã: Chọn hết

  1. 'Coder: Tran Dai Nghia
  2. 'Email: gianghoplus@yahoo.com
  3. 'Website: http://giangho.biz
  4. 'This code in a module
  5. 'Add a font file to Resource (ID=101, Type="CUSTOM")
  6. 'This code Support for "VK Sans Serif" font
  7. 'In VB: Project -> Project Properties -> Startup Oject -> Sub Main()
  8. '--------------------------------------------
  9. Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  10. Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  11. Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
  12.  
  13. Const HWND_BROADCAST = &HFFFF&
  14. Const WM_FONTCHANGE = &H1D
  15. Const HKEY_LOCAL_MACHINE = &H80000002
  16. Const REG_SZ = 1
  17.  
  18. Sub Main()
  19. Dim sFontPath$, sFontName$
  20. Dim lResult&, hKey&
  21. sFontPath = Environ("windir") & "\Fonts\"
  22. sFontName = "vknt.fon"
  23.  
  24. If FileExists(sFontPath & sFontName) = False Then
  25. 'Get Font on Resource Data
  26. Dim bytResourceData() As Byte
  27. bytResourceData = LoadResData(101, "CUSTOM")
  28. 'Save Font as Directory
  29. Open sFontPath & sFontName For Binary Shared As #1
  30.     Put #1, 1, bytResourceData
  31. Close #1
  32. 'Add font
  33. lResult = AddFontResource(sFontPath & sFontName)
  34. If lResult = 0 Then MsgBox "Error Occured Calling AddFontResource"
  35. lResult = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts", hKey)
  36. lResult = RegSetValueEx(hKey, "VK Sans Serif 8,10,12,14,18,24 (VGA res)", 0, REG_SZ, ByVal sFontName, Len(sFontName))
  37. lResult = RegCloseKey(hKey)
  38. 'can reload their font list
  39. lResult = PostMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
  40. 'MsgBox "Font Added!"
  41. Shell "fontview.exe " & sFontPath & sFontName, vbHide
  42. End If
  43.  
  44. 'Call frmMain
  45. 'frmMain.Show
  46. End Sub
  47.  
  48. Public Function FileExists(sFile As String) As Boolean
  49. On Error Resume Next
  50. FileExists = ((GetAttr(sFile) And vbDirectory) = 0)
  51. End Function


Code chỉ một lần mà fix bug thì mãi mãi
-----------------------------------
VnSecurity 2008 - Bảo vệ máy tính theo phong cách của bạn
Website: http://vn-soft.net

PhongThanInfor
Thành viên chính thức
Thành viên chính thức
Bài viết: 31
Ngày tham gia: T.Hai 21/04/2008 11:01 pm

Re: Add font TCVN3 một cách tự động và chính xác

Gửi bàigửi bởi PhongThanInfor » T.Ba 22/04/2008 12:29 am

tại sao ta không bỏ vào Form_Initialize() mà phải tạo Sub main() chi cho cực vậy.code nhìn vào phức tạp hóa nhưng mà hay thiệt

noone2407
Thành viên chính thức
Thành viên chính thức
Bài viết: 10
Ngày tham gia: T.Sáu 02/05/2008 5:46 pm

Re: Add font TCVN3 một cách tự động và chính xác

Gửi bàigửi bởi noone2407 » T.Hai 01/02/2010 2:19 pm

bỏ vô sub main thì chương trình khi chạy nó sẽ nạp font trước rồi mới load cái form tránh việc load form khi chưa cài font cho form
có 1 việc mình muôn hỏi là tại sao khi code y như vậy thì bị avira báo là file virus

palkia111
Bài viết: 1
Ngày tham gia: T.Tư 20/06/2012 12:18 pm

Re: Add font TCVN3 một cách tự động và chính xác

Gửi bàigửi bởi palkia111 » T.Tư 18/07/2012 7:54 pm

Không hiểu vì sao mà em không bật cái sub main () được :-?....Vào properties, chọn sub main, xong ok....vậy thôi hay còn gì nữa không?

tuopipu
Bài viết: 2
Ngày tham gia: T.Bảy 11/04/2009 7:01 pm

Re: Add font TCVN3 một cách tự động và chính xác

Gửi bàigửi bởi tuopipu » T.Bảy 08/03/2014 7:52 pm

AddFontResource(sFontPath & sFontName) nó báo lỗi ngay hàm này :(

tuopipu
Bài viết: 2
Ngày tham gia: T.Bảy 11/04/2009 7:01 pm

Re: Add font TCVN3 một cách tự động và chính xác

Gửi bàigửi bởi tuopipu » T.Bảy 08/03/2014 7:58 pm

à tìm được rồi ham API. bổ sung khai báo cho các bạn bị thiếu:
Private Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal handle As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long


Quay về “[VB] Hệ thống - Tập tin - Thư mục và Mạng”

Đ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