[UserForm] Hiện ảnh biểu tượng trên Title (Caption) của userform

tuhocvba

Administrator
Thành viên BQT
Ngay từ đầu, người ta nói Iphone đẹp. Mình phải thừa nhận là đẹp từ phần cứng cho tới phần mềm. Nếu mọi người để ý giao diện bên trong của chiếc điện thoại iphone, chúng ta thấy cách thiết kế của họ rất mượt mà. Nếu chịu khó quan sát, chúng ta sẽ học hỏi được những cái làm nên vẻ đẹp ấy.
Điều mà mình ấn tượng, đó là với mỗi danh sách hiện ra, bên trái nó luôn có các biểu tượng nhỏ nhắn xinh xắn, bắt mắt. Apple đã rất trau chuốt và tỉ mỉ trong thiết kế của họ.

Trên diễn đàn đã có một chủ đề về đặt hình ảnh vào trong nút bấm, hoặc sử dụng chính đối tượng image có vai trò như nút bấm. Mình vẫn thấy thiếu, vì vậy mà topic này được lập ra. Làm thế nào để hiển thị hình ảnh icon vào title (caption) của Userform.
Bạn cần đăng nhập để thấy đính kèm

Mã:
Private Declare PtrSafe Function FindWindow _
    Lib "user32" Alias "FindWindowA" _
   (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long

Private Declare PtrSafe Function ExtractIcon _
    Lib "shell32.dll" Alias "ExtractIconA" _
   (ByVal hInst As Long, _
    ByVal lpszExeFileName As String, _
    ByVal nIconIndex As Long) As Long

Private Declare PtrSafe Function SendMessage _
    Lib "user32" Alias "SendMessageA" _
   (ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Integer, _
    ByVal lParam As Long) As Long

Private Const WM_SETICON = &H80

Private Sub UserForm_Initialize()
    Dim strIconPath As String
    Dim lngIcon As Long
    Dim lnghWnd As Long
    ' Change to the path and filename of an icon file
    strIconPath = "D:\VBA\file_type_license_icon_130482.ico"
    ' Get the icon from the source
    lngIcon = ExtractIcon(0, strIconPath, 0)
    ' Get the window handle of the userform
    lnghWnd = FindWindow("ThunderDFrame", Me.Caption)
    'Set the big (32x32) and small (16x16) icons
    'SendMessage lnghWnd, WM_SETICON, True, lngIcon '32x32
    SendMessage lnghWnd, WM_SETICON, False, lngIcon '16x16
End Sub
Nguồn tham khảo code:
Icon mọi người có thể tham khảo và download từ trang này:
 

giaiphapvba

Administrator
Thành viên BQT
, sẽ có bạn bất mãn, vậy tôi muốn phát hành Tools thì phải đi kèm thư mục chứa ảnh đi kèm hay sao?
Mã:
strIconPath = "D:\VBA\file_type_license_icon_130482.ico"
Tôi muốn gắn trực tiếp ảnh vào file Tools và sau đó sử dụng thì có được không?
Nào, chúng ta hãy nhớ lại chủ đề , tôi nghĩ rằng chúng ta có rất nhiều thứ để học hỏi từ code đó.

Sau đây tôi xin trình bày giải pháp của mình dựa vào sự bắt chước cách làm của TreeView tự tạo.
1. Tôi nới rộng UserForm ra.
Bạn cần đăng nhập để thấy đính kèm

Thực tế độ rộng UserForm cần thiết chỉ tới đường kẻ đứt màu đỏ. Nhưng tôi sẽ nới rộng UserForm ra. Tại phần thừa ra đó, tôi sẽ dùng Image1 để lưu trữ hình ảnh vào đây.
2. Code
Tôi sẽ cho load ảnh từ Image1, đồng thời co lại độ rộng của UserForm về đúng đường kẻ đứt màu đỏ trước khi hiện UserForm.
Mã:
#If VBA7 And Win64 Then
    Private Declare PtrSafe Function FindWindow _
        Lib "user32" Alias "FindWindowA" _
       (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
    
    Private Declare PtrSafe Function ExtractIcon _
        Lib "shell32.dll" Alias "ExtractIconA" _
       (ByVal hInst As Long, _
        ByVal lpszExeFileName As String, _
        ByVal nIconIndex As Long) As Long
    
    Private Declare PtrSafe Function SendMessage _
        Lib "user32" Alias "SendMessageA" _
       (ByVal hWnd As Long, _
        ByVal wMsg As Long, _
        ByVal wParam As Integer, _
        ByVal lParam As Long) As Long
#Else
    Private Declare Function FindWindow _
    Lib "user32" Alias "FindWindowA" _
   (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
 
Private Declare Function ExtractIcon _
    Lib "shell32.dll" Alias "ExtractIconA" _
   (ByVal hInst As Long, _
    ByVal lpszExeFileName As String, _
    ByVal nIconIndex As Long) As Long
 
Private Declare Function SendMessage _
    Lib "user32" Alias "SendMessageA" _
   (ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Integer, _
    ByVal lParam As Long) As Long
 

#End If

Private Const WM_SETICON = &H80

Private Sub UserForm_Initialize()
    
    Dim lnghWnd As Long

    lnghWnd = FindWindow("ThunderDFrame", Me.Caption)
    'Set the big (32x32) and small (16x16) icons
    'SendMessage lnghWnd, WM_SETICON, True, lngIcon '32x32
    SendMessage lnghWnd, WM_SETICON, False, Me.Image1.Picture '16x16
    Me.Width = 240 'Co lai chieu rong cua UserForm
End Sub
Bạn cần đăng nhập để thấy đính kèm
 
@USA_Covid19 : Không chạy được cũng không cung cấp thông tin code thì chịu, không ai dò lỗi cho bạn được.
Bạn download file demo dưới đây và tự kiểm tra so sánh nhé.
file demo: .
 
D

Deleted member 1294

Guest
@vanthanhVBA code mình lấy từ @giaiphapvba đây là file demo
file bạn mình mở lên bị lỗi như hình
Bạn cần đăng nhập để thấy hình ảnh
 
Bạn cho code của bạn vào làm rối. Để tìm lỗi thì hãy bỏ những đoạn code không cần thiết đi.
Đối với file bạn cung cấp thì máy tính của tôi không báo lỗi gì cả. Tuy nhiên hình ảnh không hiển thị tốt.
Bạn cần đăng nhập để thấy hình ảnh

Bạn nên chọn ảnh có kích thước 16x16, đây là kích thước icon phổ biến và tiêu chuẩn để hiện trên title.
 
Các trang cung cấp icon free đều có định dạng chuẩn là 16x16, cần gì sửa đâu.
Bạn download icon này về xài thử xem.
Link download:
 
D

Deleted member 1294

Guest
@Yukino Ichikawa mà sao mình chèn định dạng ảnh .ico, image control không nhận nhỉ chắc không hỗ trợ định dạng này, mình office 2010 32bit
 
Theo mình biết thì có hỗ trợ ico.
Các định dạng được hỗ trợ là:
Mã:
    *.bmp
    *.cur
    *.gif
    *.ico
    *.jpg
    *.wmf
Nguồn:
 
D

Deleted member 1294

Guest
@Yukino Ichikawa vô lý mình thử trên máy 64bit thì ok với office cùng phiên bản thì được, hay không hỗ trợ win 7 32 bit nhỉ
 
Hiện chưa rõ nguyên nhân tại sao bị lỗi.
Win 10 Office16 64bit thì không sao.
Win7 Office2013 64bit thì lỗi. Và cũng không chèn được ico.
Về icon, bạn có thể tham khảo trang sau và download kích cỡ tuỳ ý.
 
D

Deleted member 1294

Guest
Như dậy khả năng không hỗ trợ cho win 7 rồi huuu !
 
Như dậy khả năng không hỗ trợ cho win 7 rồi huuu !
Đầu tiên, khẳng định là code hiển thị không sai. Code của admin tuhocvba hoạt động OK (link ảnh từ thư mục, ico hay jpg đều OK).
Bây giờ vấn đề là lấy ảnh từ Image thì đang gặp vấn đề với một số máy tính. Để bình tĩnh nghiên cứu.
 

PTHhn

Yêu THVBA như điếu đổ
Load ảnh từ image gặp vấn đề gì đó mà chưa hiển thị được.
Tôi thấy có khoảng trống ở title.
Hình bên trái là hiển thị bình thường, không có code cho title.
Hình bên phải là hiển thị có code cho title, load ảnh từ image nhưng không hiển thị được.
Bạn cần đăng nhập để thấy hình ảnh
 

BKKBG

Yêu THVBA nhất
Đầu tiên, khẳng định là code hiển thị không sai. Code của admin tuhocvba hoạt động OK (link ảnh từ thư mục, ico hay jpg đều OK).
Tôi chỉ thấy nó hoạt động với ico. Còn với jpg thì không.
Tôi sử dụng code của admin tuhocvba.
Win7 Office 2007
Bạn cần đăng nhập để thấy hình ảnh
 

BKKBG

Yêu THVBA nhất
Tôi nghĩ phải tìm hiểu nguyên nhân tại sao không chèn ico vào image được. (Về lý thuyết thì phải chèn được và trong topic này một số bạn cũng đã chèn được).
 
Top