VBA Tái Tạo Cửa Sổ Chương Trình Từ System Tray? (5 người xem)

CEO76 · 5/1/13

Tôi có một ứng dụng dạng portable (Lịch Vạn Sự), tất nhiên tôi không viết chương trình này và cũng không phải là người đóng gói nó thành portable.

Tôi dùng API shellexecute để mở trương trình này từ excel qua một command button. Tuy nhiên sau khi được mở thì chương trình lại ở chế độ ẩn và nằm ở trong system tray.
Tôi dùng hàm API FindWindowLike và biết được Caption của chương trình lịch vạn sự là "Lich Van Su Dien Tu v2.0"

Tôi đã thử dùng một số hàm API như ShowWindow, SetForegroundWindow, SetWindowPos, BringWindowToTop tuy nhiên không thể hiển thị được cửa sổ của chương trình Lịch Vạn Sự.

Chương trình có thể được hiển thị bằng nhấp đúp vào biểu tượng ngôi sao ở thanh system tray, tuy nhiên tôi muốn biết có cách nào để thể hiện cửa sổ chương trình dùng VBA.

Kèm theo bài viết này là tập tin excel và chương trình Lịch vạn sự Portable.

Liệu VBA có thể giải quyết được vấn đề mà tôi muốn thực hiện? Rất mong các bạn cho tôi biết cách nếu có thể

Xin chân thành cảm ơn

CEO76

siwtom · 5/1/13

CEO76 đã viết:
Tôi có một ứng dụng dạng portable (Lịch Vạn Sự), tất nhiên tôi không viết chương trình này và cũng không phải là người đóng gói nó thành portable.

Tôi dùng API shellexecute để mở trương trình này từ excel qua một command button. Tuy nhiên sau khi được mở thì chương trình lại ở chế độ ẩn và nằm ở trong system tray.
Tôi dùng hàm API FindWindowLike và biết được Caption của chương trình lịch vạn sự là "Lich Van Su Dien Tu v2.0"

Tôi đã thử dùng một số hàm API như ShowWindow, SetForegroundWindow, SetWindowPos, BringWindowToTop tuy nhiên không thể hiển thị được cửa sổ của chương trình Lịch Vạn Sự.

Chương trình có thể được hiển thị bằng nhấp đúp vào biểu tượng ngôi sao ở thanh system tray, tuy nhiên tôi muốn biết có cách nào để thể hiện cửa sổ chương trình dùng VBA.

Kèm theo bài viết này là tập tin excel và chương trình Lịch vạn sự Portable.

Liệu VBA có thể giải quyết được vấn đề mà tôi muốn thực hiện? Rất mong các bạn cho tôi biết cách nếu có thể

Xin chân thành cảm ơn

CEO76

Bạn lấy ở đâu cái tiêu đề "Lich Van Su Dien Tu v2.0"?
Tôi kiểm tra thì cửa sổ mà ta quan tâm không có tiêu đề - tiêu đề rỗng.
Nhưng cửa sổ có class là "ThunderRT6FormDC"
Chỉ có phiền hà nho nhỏ là có tận 3 cửa sổ có class là "ThunderRT6FormDC".
Vậy ta phải tìm điểm khác biệt của cửa sổ mà ta quan tâm.
Cửa sổ mà ta quan tâm có "con" thuộc class "ThunderRT6UserControlDC", còn 2 cửa sổ cùng class "ThunderRT6FormDC" thì lại không có "con" nào thuộc "ThunderRT6UserControlDC"
----------------
Tôi sửa code của bạn
[GPECODE=vb]
Sub Show_Systemtray_Window()
Dim mycap As String
Dim myfile As String
Dim hWndCtlApp As Long
Dim showresult As Long
Dim currWinP As WINDOWPLACEMENT
mycap = "Lich Van Su Dien Tu v2.0"
mywdhandle = FindWindow(vbNullString, mycap)
If mywdhandle <> 0 Then
showresult = ShowWindow(mywdhandle, 9)
showresult = ShowWindow(mywdhandle, 5)
showresult = SetWindowPos(mywdhandle, -1, 0, 0, 1, 1, &H40)
End If
currWinP.Length = Len(currWinP)
currWinP.flags = 0&
currWinP.showCmd = SW_SHOWMAXIMIZED
Call SetWindowPlacement(mywdhandle, currWinP)

'on screen, so assure visible
Call SetForegroundWindow(mywdhandle)
Call BringWindowToTop(mywdhandle)
End Sub
[/GPECODE]

thành

[GPECODE=vb]
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

...

Sub Show_Systemtray_Window()
mywdhandle = FindWindowEx(0, 0, "ThunderRT6FormDC", vbNullString)
Do While mywdhandle <> 0
If FindWindowEx(mywdhandle, 0, "ThunderRT6UserControlDC", vbNullString) <> 0 Then
ShowWindow mywdhandle, SW_SHOWNORMAL
Exit Do
End If
mywdhandle = FindWindowEx(0, mywdhandle, "ThunderRT6FormDC", vbNullString)
Loop
End Sub
[/GPECODE]

CEO76 · 6/1/13

Chào switom
Tôi dùng đoạn code sau để tìm caption của chương trình Lịch vạn sự. Sử dụng Intemmediate Window tôi thấy được caption này.

Nếu như trong trường hợp ở system tray có nhiều hơn 1 app được minimized ỏ đó thì code của siwtom sẽ show cửa sổ đầu tiên thỏa mãn điều kiện
[GPECODE=vb]FindWindowEx(mywdhandle, 0, "ThunderRT6UserControlDC", vbNullString) <> 0[/GPECODE]

Cám ơn siwtom nhiều

[GPECODE=vb]
Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetForegroundWindow Lib "user32.dll" () As Long
Public Const GW_HWNDNEXT = 2
Public Const GW_CHILD = 5

Function FindWindowLike(strPartOfCaption As String) As Long
Dim hwnd As Long
Dim strCurrentWindowText As String
Dim r As Integer
hwnd = GetForegroundWindow
Do Until hwnd = 0
strCurrentWindowText = Space$(255)
r = GetWindowText(hwnd, strCurrentWindowText, 255)
strCurrentWindowText = Left$(strCurrentWindowText, r)
Debug.Print strCurrentWindowText
hwnd = GetWindow(hwnd, GW_HWNDNEXT)
Loop
End Function

[/GPECODE]

siwtom · 6/1/13

CEO76 đã viết:

PHP:

Chào switom


Tôi dùng đoạn code sau để tìm caption của chương trình Lịch vạn sự. Sử dụng Intemmediate Window tôi thấy được caption này.


Nếu như trong trường hợp ở system tray có nhiều hơn 1 app được minimized ỏ đó thì code của siwtom sẽ show cửa sổ đầu tiên thỏa mãn điều kiện "FindWindowEx(mywdhandle, 0, "ThunderRT6UserControlDC", vbNullString) <> 0 "


[/QUOTE]

Cửa sổ có tiêu đề là "Lich Van Su Dien Tu v2.0" có class là "ThunderRT6Main", và chắc chắn không phải cửa sổ mà ta quan tâm. Cửa sổ mà ta quan tâm có class là "ThunderRT6FormDC"
--------------
Xin lỗi.  Thực ra có thể có nhiều cửa sổ với class là ThunderRT6FormDC mà cũng có cửa sổ "con" với class ThunderRT6UserControlDC. Ví dụ nếu user kích hoạt ApiViewer của VB thì cửa sổ của ApiViewer có class là ThunderRT6FormDC, và nó có cửa sổ con cũng là ThunderRT6UserControlDC.
Trong trường hợp như thế ta không biết phải Show cửa sổ nào. Nếu ta Exit Do khi gặp cửa sổ đầu tiên thỏa đk thì rất có thể ta chỉ Show ApiViewer. Còn nếu ta không Exit Do thì chả nhẽ ta Show tất cả các cửa sổ thỏa đk? Vì biết đâu có nhiều cửa sổ đang ẩn thỏa đk.

Nếu ta sửa code thành
[GPECODE=vb]
Sub Show_Systemtray_Window()
    mywdhandle = FindWindowEx(0, 0, "ThunderRT6FormDC", vbNullString)
    Do While mywdhandle <> 0
        If FindWindowEx(mywdhandle, 0, "ThunderRT6UserControlDC", vbNullString) <> 0 And _
            (IsWindowVisible(mywdhandle) = 0) Then
            ShowWindow mywdhandle, SW_SHOWNORMAL
            SetWindowPos mywdhandle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
            Exit Do
        End If
        mywdhandle = FindWindowEx(0, mywdhandle, "ThunderRT6FormDC", vbNullString)
    Loop
End Sub
[/GPECODE]

thì ta hạn chế được "rủi ro" một cách đáng kể, tức loại các cửa sổ có class như thế nhưng đang hiển thị - IsWindowVisible <> 0

Nhưng để có chắc chắn 100% hoặc ít nhất 99,99% thì tôi nghĩ phải dùng cách khác.

[GPECODE=vb]
Sub Show_Systemtray_Window()
Dim hwnd As Long, hMenu As Long, hSubMenu As Long, MenuID As Long, text As String, r As Long
    hwnd = FindWindowEx(0, 0, "ThunderRT6FormDC", vbNullString)
    Do While hwnd <> 0
        hMenu = GetMenu(hwnd)
        If hMenu <> 0 Then
            text = String(64, Chr(0))
            r = GetMenuString(hMenu, 0, text, 64, MF_BYPOSITION)
            text = Left(text, r)
            If text = "&PopupMenu" Then
                hSubMenu = GetSubMenu(hMenu, 0)
                MenuID = GetMenuItemID(hSubMenu, 0)
                SetForegroundWindow hwnd
                PostMessage hwnd, WM_COMMAND, MenuID, 0
                Exit Do
            End If
        End If
        hwnd = FindWindowEx(0, hwnd, "ThunderRT6FormDC", vbNullString)
    Loop
End Sub
[/GPECODE]

Chú ý: hwnd trong sub ở trên không phải là handle của cửa sổ lịch. Tác giả lịch này tạo thêm 1 cửa sổ ẩn có class là ThunderRT6FormDC và nó có 1 mục duy nhất trong menu (window menu) có tên là "PopupMenu". Mục menu này có các mục menu con mà bạn nhìn thấy khi chuột phải vào icon trong khay hệ thống. Như vậy có thể đoán là tác giả lấy menu của cửa sổ này làm menu chuột phải trong khay hệ thống. Thực ra có thể tạo menu này bằng các hàm API, tôi không dám cho là tác giả không biết làm mà chỉ cho là tác giả lười.
Tóm lại hwnd trong sub trên là handle của cửa sổ ẩn có menu. Do có menu nên tôi đọc menu đó ra và simulate "chọn" mục menu đầu (vị trí 0) của nó tức mục "Hiện chương trình"
----------------
Bạn tự thêm khai báo các hàm và hằng số API

siwtom · 6/1/13

Nhưng nếu là tôi thì tôi sẽ dùng cách dưới đây - món ngon ăn cuối cùng mà.
Nôm na là ta không kích hoạt Lịch bằng ShellExecute mà hoặc dùng CreateProcess (bạn tự nghiên cứu) hoặc dùng Shell của VBA để có được ProcessId của process tạo ra Lịch. Sau đó trong code của tôi ở bài #2 trong block IF ... END IF trước tiên ta đọc ProcessId của process tạo ra cửa sổ có handle hiện hành mywdhandle. Nếu cửa sổ hiện hành đúng là thuộc process tạo Lịch thì cửa sổ đó chính là cửa sổ Lịch, vậy ta Show nó và Exit Do.

Toàn bộ code của Module
[GPECODE=vb]
Option Explicit
Private Const SWP_NOSIZE = 1
Private Const SWP_NOMOVE = 2
Private Const HWND_TOPMOST As Long = -1
Public Const SW_SHOWNORMAL = 1

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

Private Declare Function GetWindowThreadProcessId Lib "user32.dll" (ByVal hwnd As Long, ByRef lpdwProcessId As Long) As Long

Private Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Private Declare Function SetWindowPos Lib "user32.dll" (ByVal hwnd As _
Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As _
Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Public mywdhandle As Long
Dim ProcessId As Long ' processID của process Lịch

Sub ShellExec()
Dim strFile As String, RetVal
strFile = ThisWorkbook.Path & Application.PathSeparator & "Lichvansu20.exe"
ProcessId = Shell(strFile)
End Sub

Sub Show_Systemtray_Window()
Dim ProcID As Long
mywdhandle = FindWindowEx(0, 0, "ThunderRT6FormDC", vbNullString)
Do While mywdhandle <> 0
If FindWindowEx(mywdhandle, 0, "ThunderRT6UserControlDC", vbNullString) <> 0 Then
' đọc ProcessID của process tạo ra cửa sổ có handle là mywdhandle
GetWindowThreadProcessId mywdhandle, ProcID
If ProcID = ProcessId Then
' process tạo ra cửa sổ mywdhandle cũng chính là process của Lịch, vậy
' mywdhandle chính là handle của cửa sổ Lịch. Vậy Show nó và ra khỏi vòng lặp
ShowWindow mywdhandle, SW_SHOWNORMAL
SetWindowPos mywdhandle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
Exit Do
End If
End If
mywdhandle = FindWindowEx(0, mywdhandle, "ThunderRT6FormDC", vbNullString)
Loop
End Sub
[/GPECODE]
---------------
Tôi nghĩ rằng đã mổ xẻ cái Lịch này bằng nhiều phương pháp rồi. Bạn tự test cho thấm nhuần các phương pháp.
----------------
Cũng cần nói thêm là sub Show_Systemtray_Window ta chỉ gọi 1 lần là sẽ có handle mywdhandle của cửa sổ Lịch. Các lần sau muốn Show nó thì dùng luôn ShowWindow thôi.

CEO76 · 6/1/13

Rất cụ thể và chuyên nghiệp ở code dùng GetWindowThreadProcessId. Tôi rất thích các post của bạn với thread này đặc biệt là post số 5.

Rất khâm phục trình độ hiểu biết sâu và rộng của siwtom về hệ thống, về Subclassing and Hooking và các hàm API. Chắc chắn bạn là một coder chuyên nghiêp.

Rất mong có thể học hỏi từ bạn từ những bài viết trả lời tới các thành viên của forum như bài này.

Xin chân thành cảm ơn.

CEO76

ndu96081631 · 6/1/13

CEO76 đã viết:
Rất khâm phục trình độ hiểu biết sâu và rộng của siwtom về hệ thống, về Subclassing and Hooking và các hàm API. Chắc chắn bạn là một coder chuyên nghiêp.

Cái đó KHỎI PHẢI NÓI
Bạn tham gia GPE thường xuyên sẽ có những trải nghiệm thú vị đấy!
Ẹc... Ẹc...
(Ôi... chủ nhật chả có cóc khô gì để làm... Chơi Vice City thôi)

CEO76 · 6/1/13

Vì cửa sổ con của chương trình theo như tôi đoán tác giả muốn thể hiện splash screen và thông tin vạn sự của ngày hiện tại ( góc dưới phía phải của màn hình) khoảng 10 giây, cho nên tôi chèn thêm một đoạn Application.wait khoảng 12 giây để có thể hiện được cửa sổ của lịch vạn sự.

Tôi cũng thêm một đoạn code nhỏ nữa để kiểm tra ProcID với ProcessID trong trường hợp người sư dụng đóng chương trình lịch vạn sự, quá trình mở lịch vạn sự lại được bắt đầu từ đầu.

Các khai báo khác của API và thủ tục (sub) Show_Systemtray_Window giống như ở bài 5

===============

Sub ShellExec()
Dim strFile As String, RetVal
Dim ProcID As Long
strFile = ThisWorkbook.Path & Application.PathSeparator & "Lichvansu20.exe"
startcode:
If ProcessId = 0 Then
ProcessId = Shell(strFile)
Application.Wait (Now + TimeValue("00:00:12"))
Show_Systemtray_Window
Else
GetWindowThreadProcessId mywdhandle, ProcID
If ProcID = ProcessId Then
RetVal = ShowWindow(mywdhandle, SW_SHOWNORMAL)
Else
ProcessId = 0
GoTo startcode
End If
End If
End Sub

VBA Tái Tạo Cửa Sổ Chương Trình Từ System Tray? (5 người xem)

Người dùng đang xem chủ đề này

CEO76

Thành viên mới

siwtom

Thành viên gắn bó

CEO76

Thành viên mới

siwtom

Thành viên gắn bó

siwtom

Thành viên gắn bó

CEO76

Thành viên mới

ndu96081631

Huyền thoại GPE

CEO76

Thành viên mới

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian