Xin được giúp về chữ chạy trên label

hoanganhdl · 22/12/12

Xin thầy và các bạn xem giúp file đính kèm, vì chiều dài label ngắn mà dòng chữ dài nên khi hiện lên chữ sẽ bị mất nên mình nghĩ nên cắt bớt bằng hàm left nhưng khi thêm hàm left thì thấy dòng chữ ko chạy nữa +-+-+-+

siwtom · 23/12/12

hoanganhdl đã viết:
Xin thầy và các bạn xem giúp file đính kèm, vì chiều dài label ngắn mà dòng chữ dài nên khi hiện lên chữ sẽ bị mất nên mình nghĩ nên cắt bớt bằng hàm left nhưng khi thêm hàm left thì thấy dòng chữ ko chạy nữa

Nếu bạn dùng Left thì code của bạn thành:

Mã:

dongchu = Label1.Caption
Label1.Caption = Left(Mid(dongchu, 2) & Left(dongchu, 1), 15)

Bạn có Label1.Caption = " Xin ..."
Tổng cộng 47 dấu cách ở đầu

Vậy thì Mid(dongchu, 2) = " Xin ..." - có 46 dấu cách ở đằu
=> Mid(dongchu, 2) & Left(dongchu, 1) = " Xin ... " - có 46 dấu cách ở đằu
=> Label1.Caption = Left(Mid(dongchu, 2) & Left(dongchu, 1), 15) = " " - có 15 dấu cách
=> Bạn chả nhìn thấy gì cả. Tôi cũng không có "kính xịn" để nhìn được dấu cách.

Nếu trong cửa sổ Properties bạn đặt Label1.Caption = "Xin ..."
Thì bạn sẽ nhìn thấy chữ chạy nhưng chỉ 15 ký tự đầu mà thôi.
---------------
Không Left gì cả.
Trong cửa sổ Properties hoặc trong code bạn đặt WordWrap cho Label1 = FALSE

ndu96081631 · 23/12/12

hoanganhdl đã viết:
Xin thầy và các bạn xem giúp file đính kèm, vì chiều dài label ngắn mà dòng chữ dài nên khi hiện lên chữ sẽ bị mất nên mình nghĩ nên cắt bớt bằng hàm left nhưng khi thêm hàm left thì thấy dòng chữ ko chạy nữa

Chạy chữ kiểu đó.. mệt chết được
Tặng bạn kiểu khác nè:
1> Trong Module

PHP:

Function TimeProc(ByVal H As Long, ByVal nMSG As Long, ByVal nID As Long, ByVal nTsys As Long)
  Dim Text As String
  On Error Resume Next
  Text = fchaychu.Label1.Caption
  Text = Mid(Text, 2, Len(Text)) & Left(Text, 1)
  fchaychu.Label1.Caption = Text
End Function

2> Trong UserForm

PHP:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
   (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetTimer Lib "user32" _
   (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private hWnd As Long

Mã:

Private Sub UserForm_Initialize()
  hWnd = FindWindow("ThunderDFrame", Me.Caption)
End Sub

Mã:

Sub StartTimer()
  StopTimer
  SetTimer Application.hWnd, 1, [COLOR=#ff0000]50[/COLOR], AddressOf TimeProc
End Sub

Mã:

Sub StopTimer()
  KillTimer Application.hWnd, 1
End Sub

Mã:

Private Sub UserForm_Activate()
  On Error Resume Next
  StartTimer
End Sub

Mã:

Private Sub UserForm_Terminate()
  StopTimer
End Sub

Điều kiện chạy chữ nằm trong code của Module còn tốc độ là số màu đỏ trong UserForm ---> Số càng lớn, tốc độ chạy càng chậm và ngược lại

ndu96081631 · 24/12/12

ndu96081631 đã viết:
Chạy chữ kiểu đó.. mệt chết được
Tặng bạn kiểu khác nè:

Code bị sai mấy chổ mà chẳng thấy ai nói gì hen!
Ẹc... Ẹc...

Hoàng Trọng Nghĩa · 24/12/12

ndu96081631 đã viết:
Code bị sai mấy chổ mà chẳng thấy ai nói gì hen!
Ẹc... Ẹc...

Thật tình mà nói thì cái bài Thầy gửi lên em check lại không thấy lỗi, vậy sai ở chỗ nào vậy ạ? Kể cả em đã bỏ đi các On Error .. rồi mà vẫn không báo lỗi?

ndu96081631 · 24/12/12

Hoàng Trọng Nghĩa đã viết:
Thật tình mà nói thì cái bài Thầy gửi lên em check lại không thấy lỗi, vậy sai ở chỗ nào vậy ạ? Kể cả em đã bỏ đi các On Error .. rồi mà vẫn không báo lỗi?

Thông số hWnd đưa vào sai
Cái cần lấy là hWnd của UserForm chứ không phải hWnd của Application

Mã:

SetTimer [COLOR=#ff0000]Application.hWnd[/COLOR], 1, 50, AddressOf TimeProc

Chổ màu đỏ ấy!
Bây giờ hên nó chạy được nhưng nếu đưa vào 1 chương trình lớn có thể bị lỗi nghiêm trọng (treo Excel luôn). Lúc đó chẳng biết đường nào mà lần

Hoàng Trọng Nghĩa · 24/12/12

ndu96081631 đã viết:
Thông số hWnd đưa vào sai
Cái cần lấy là hWnd của UserForm chứ không phải hWnd của Application

Mã:

SetTimer [COLOR=#ff0000]Application.hWnd[/COLOR], 1, 50, AddressOf TimeProc

Chổ màu đỏ ấy!
Bây giờ hên nó chạy được nhưng nếu đưa vào 1 chương trình lớn có thể bị lỗi nghiêm trọng (treo Excel luôn). Lúc đó chẳng biết đường nào mà lần

Ờ ha, khi Thầy nói mới kiểm tra kỹ lại, như load form đã dùng:

Mã:

Private Sub UserForm_Initialize()
 [COLOR=#ff0000][B] hWnd [/B][/COLOR]= FindWindow("ThunderDFrame", Me.Caption)
End Sub

Nhưng lại thực hiện là Application.hWnd

Đúng là trùng hợp, không thôi là "đuối" rồi.

Hoàng Trọng Nghĩa · 24/12/12

ndu96081631 đã viết:
Code bị sai mấy chổ mà chẳng thấy ai nói gì hen!
Ẹc... Ẹc...

À, Thầy ơi, em cũng thử gán cho Form Caption vào hàm, nó vẫn chạy ào ào, có điều làm sao để cho nó có chữ Unicode hả Thầy?

Mã:

Function TimeProc(ByVal H As Long, ByVal nMSG As Long, ByVal nID As Long, ByVal nTsys As Long)
  Dim Text As String
  'On Error Resume Next
  Text = fchaychu.Label1.Caption
  Text = Mid(Text, 2, Len(Text)) & Left(Text, 1)
  fchaychu.Label1.Caption = Text
  [COLOR=#ff0000][B]fchaychu.Caption = Text[/B][/COLOR]
End Function

ndu96081631 · 24/12/12

Hoàng Trọng Nghĩa đã viết:
À, Thầy ơi, em cũng thử gán cho Form Caption vào hàm, nó vẫn chạy ào ào, có điều làm sao để cho nó có chữ Unicode hả Thầy?

Mã:

Function TimeProc(ByVal H As Long, ByVal nMSG As Long, ByVal nID As Long, ByVal nTsys As Long) Dim Text As String 'On Error Resume Next Text = fchaychu.Label1.Caption Text = Mid(Text, 2, Len(Text)) & Left(Text, 1) fchaychu.Label1.Caption = Text [COLOR=#ff0000][B]fchaychu.Caption = Text[/B][/COLOR] End Function

Nhớ không lầm thì vấn đề Unicode trên Title bar Nghĩa đã nghiên cứu lâu rồi còn gì
(Phải xử lý thêm vài món nữa mới ăn được anh Title này)

Hoàng Trọng Nghĩa · 24/12/12

ndu96081631 đã viết:
Nhớ không lầm thì vấn đề Unicode trên Title bar Nghĩa đã nghiên cứu lâu rồi còn gì
(Phải xử lý thêm vài món nữa mới ăn được anh Title này)

Thật tình em cũng bó tay khi kết hợp với cái này, nó dù thế nào đi nữa nó cũng hoặc là đứng im và hiện đúng font, hai là nó chạy mà font bị lỗi

Với mảng em đã thấy nó khá trừu tượng rồi, với các API này em tưởng tượng còn không ra đừng nói chi đến trừu tượng!

Em thường dùng các thủ tục dưới đây, với óc sáng tạo của Thầy, em tin có thể Thầy cho nó chạy hoành tráng.

Mã:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcW" _
        (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Sub SetUnicodeCaption(ByVal frm As UserForm, ByVal UnicodeString As String)
    Dim hWnd&
    hWnd = FindWindow("ThunderDFrame", frm.Caption)
    DefWindowProc hWnd, &HC, 0, StrPtr(UnicodeString)
End Sub

Thủ tục chạy code trên form:

Mã:

Private Sub UserForm_Initialize()
    SetUnicodeCaption Me, Sheet1.[D11].Value
End Sub

siwtom · 24/12/12

ndu96081631 đã viết:
Code bị sai mấy chổ mà chẳng thấy ai nói gì hen!
Ẹc... Ẹc...

Cũng có thể không ai quan tâm tới code vì cái chuyện chạy chữ này nó chẳng hay ho gì cả.

ndu96081631 đã viết:
Thông số hWnd đưa vào sai
Cái cần lấy là hWnd của UserForm chứ không phải hWnd của Application

Mã:

SetTimer [COLOR=#ff0000]Application.hWnd[/COLOR], 1, 50, AddressOf TimeProc

Chổ màu đỏ ấy!
Bây giờ hên nó chạy được nhưng nếu đưa vào 1 chương trình lớn có thể bị lỗi nghiêm trọng (treo Excel luôn). Lúc đó chẳng biết đường nào mà lần

Tuấn yên tâm đi. Trong trường hợp Tuấn cung cấp TimerProc thì thông điệp WM_TIMER không được gửi tới hàm cửa sổ nên Tuấn có nhập hWnd (của UserForm1) hay Application.hWnd, hay cái gì thì cũng thế thôi.

Có lần tôi đã viết về TimerProc và cơ cấu thông điệp nhưng lúc đó tôi bị "gạt" đi vì lý do: "Có viết cũng không ai hiểu. Có viết thì cũng không ai cần".
Các cụ đã nói: ăn có mời, làm có khiến. Không được mời ăn cỗ mà cứ đến, không khiến làm mà cứ làm thì vô duyên lắm. Tôi không có nhu cầu viết tới mức phải vô duyên.

Nếu các bạn copy code của người khác nhưng các bạn không tìm đọc để hiểu được code đó thì các bạn chỉ biết dùng. Nếu người ta viết chưa chuẩn thì các bạn cũng không biết.

SetTimer? Tôi đính kèm hình chụp help

View attachment 94538

Các bạn chú ý chỗ tôi nhấn mạnh trong phần Remarks. Và những chỗ khoanh vùng ở trên. Các bạn có hiểu không?

Có thể thiết lập Timer bằng 2 cách:
1. Ta truyền vào SetTimer handle của cửa sổ được gán cho Timer và truền vào chỗ lpTimerFunc giá trị 0. Tức ta không truyền địa chỉ của sub TimerProc mà chỉ truyền handle của cửa sổ nào đó. Lúc đó thì trong những khoảng thời gian mà ta xác lập ở thông số thứ ba Windows sẽ gửi thông điệp WM_TIMER tới cửa sổ có handle nói trên. Nói chính xác thì Windows đặt thông điệp vào hàng đợi (message queue). Handle cần để Windows biết phải gửi thông điệp tới cửa sổ nào.

2. Ta không truyền handle của cửa sổ nào mà truyền địa chỉ của TimerProc. Lúc này thì trong khoảng thời gian được xác định bởi thông số thứ ba thì Windows sẽ gọi TimerProc.
Trường hợp 2 tương tự như khi trong Excel các bạn dùng Application.OnTime: các bạn phải "chỉ" ra sub sẽ được thực hiện. Chỉ khác là trong Excel sub kia chỉ được thực hiện 1 lần, muốn thực hiện tiếp thì lại phải xác lập tiếp trong khi với SetTimer thì TimerProc sẽ được thực hiện đều đặn cho tới khi Timer bị hủy - KillTimer
--------------
Các bạn sẽ hỏi: Thế nếu không sảy ra 2 trường hợp trên mà sảy ra trường hợp như code của Tuấn đưa lên, tức ta truyền cả handle và cả địa chỉ của TimerProc?
Nếu các bạn đọc kỹ phần Remarks trong hình ở trên thì các bạn phải biết rằng: khi đã truyền địa chỉ TimerProc thì thông điệp WM_TIMER không được gửi tới bất cứ cửa sổ nào cho dù ta truyền nó vào thông số thứ nhất của SetTimer. Nói cách khác thì: khi đã truyền địa chỉ của TimerProc thì thông số thứ nhất (window handle) sẽ bị "lờ" đi, vô dụng - vậy có thể truyền bất cứ giá trị nào kể cả những giá trị không phải là handle của bất cứ cửa sổ nào trong system, ví dụ truyền vào giá trị 0.
-----------------
Nếu các bạn còn nghi ngờ thì tôi đính kèm code. Để có thể kiểm tra xem liệu thông điệp WM_TIMER có được gửi tới cửa sổ hay không thì tôi dùng subclassing.

Module1
[GPECODE=vb]
Sub Button1_Click()
UserForm1.Show
End Sub

Sub Button2_Click()
UserForm2.Show
End Sub

Sub Button3_Click()
UserForm3.Show
End Sub
[/GPECODE]

Module2
[GPECODE=vb]
Public Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Private Const GWL_WNDPROC = (-4)
Private Const WM_TIMER = &H113

Private OldWindowProc As Long

Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
On Error GoTo end_

If uMsg = WM_TIMER Then Debug.Print "Print in WindowProc"
end_:
WindowProc = CallWindowProc(OldWindowProc, hwnd, uMsg, wParam, lParam)
End Function

Sub SetWindowProc(ByVal hWin As Long, ByVal DoSet As Boolean)
If DoSet Then
If OldWindowProc = 0 Then
OldWindowProc = SetWindowLong(hWin, GWL_WNDPROC, AddressOf WindowProc)
End If
ElseIf OldWindowProc <> 0 Then
SetWindowLong hWin, GWL_WNDPROC, OldWindowProc
OldWindowProc = 0
End If
End Sub

Function TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
Dim Text As String * 128, size As Long
On Error Resume Next
Debug.Print "Print in TimerProc"
End Function
[/GPECODE]

UserForm1
[GPECODE=vb]
Private hwnd As Long

Private Sub UserForm_Activate()
StartTimer
End Sub

Private Sub UserForm_Initialize()
Debug.Print "Bat dau vi du UserForm1"

hwnd = FindWindow("ThunderDFrame", Me.Caption)
SetWindowProc hwnd, True
End Sub

Sub StartTimer()
StopTimer
SetTimer hwnd, 1000, 50, 0
End Sub

Sub StopTimer()
KillTimer hwnd, 1000
End Sub

Private Sub UserForm_Terminate()
StopTimer
SetWindowProc hwnd, False

Debug.Print "Ket thuc vi du UserForm1"
End Sub
[/GPECODE]

UserForm2
[GPECODE=vb]
Private hwnd As Long

Private Sub UserForm_Activate()
StartTimer
End Sub

Private Sub UserForm_Initialize()
Debug.Print "Bat dau vi du UserForm2"

hwnd = FindWindow("ThunderDFrame", Me.Caption)
SetWindowProc hwnd, True
End Sub

Sub StartTimer()
StopTimer
SetTimer hwnd, 1000, 50, AddressOf TimerProc
End Sub

Sub StopTimer()
KillTimer hwnd, 1000
End Sub

Private Sub UserForm_Terminate()
StopTimer
SetWindowProc hwnd, False

Debug.Print "Ket thuc vi du UserForm2"
End Sub
[/GPECODE]
----------------
Khi các bạn nhấn Button1 thì các bạn có đại loại:

Bat dau vi du UserForm1
Print in WindowProc
Print in WindowProc
Print in WindowProc
Print in WindowProc
Print in WindowProc
Ket thuc vi du UserForm1

Dễ hiểu thôi vì các bạn chỉ truyền handle của UserForm1 nên thông điệp WM_TIMER được gửi tới hàm cửa sổ WindowProc nên ta có "Print in WindowProc".

Khi các bạn nhấn Button2 thì các bạn có đại loại:

Bat dau vi du UserForm2
Print in TimerProc
Print in TimerProc
Print in TimerProc
Print in TimerProc
Print in TimerProc
Ket thuc vi du UserForm2

Tại sao thế? Tại sao chỉ có "Print in TimerProc" mà không có "Print in WindowProc" mặc dù các bạn truyền cả handle của UserForm2?

Vậy tôi nhắc lại: khi đã truyền địa chỉ TimerProc thì thông điệp WM_TIMER không được gửi tới bất cứ cửa sổ nào cho dù ta truyền nó vào thông số thứ nhất của SetTimer. Nói cách khác thì: khi đã truyền địa chỉ của TimerProc thì thông số thứ nhất (window handle) sẽ bị "lờ" đi. Vậy ta nhập 0 thôi. Và lúc đó thì trong KillTimer phải dùng giá trị trả về bởi SetTimer. Để test code mới này tôi dùng code:

UserForm3
[GPECODE=vb]
Private ID As Long

Private Sub UserForm_Activate()
StartTimer
End Sub

Private Sub UserForm_Initialize()
Debug.Print "Bat dau vi du UserForm3"
End Sub

Sub StartTimer()
StopTimer
ID = SetTimer(0, 0, 50, AddressOf TimerProc)
End Sub

Sub StopTimer()
KillTimer 0, ID
End Sub

Private Sub UserForm_Terminate()
StopTimer

Debug.Print "Ket thuc vi du UserForm3"
End Sub
[/GPECODE]

Tức code cho th dùng TimerProc là (không có hạn dle hay 1000 (timer identifier):
[GPECODE=vb]
Private ID As Long

Private Sub UserForm_Activate()
StartTimer
End Sub

Sub StartTimer()
StopTimer
ID = SetTimer(0, 0, 50, AddressOf TimerProc)
End Sub

Sub StopTimer()
KillTimer 0, ID
End Sub

Private Sub UserForm_Terminate()
StopTimer
End Sub
[/GPECODE]

Cũng cần chú ý là thường thì các hàm API khi có lỗi thì nó "chả làm gì cả" mà chỉ trả về kết quả 0 hoặc/và thiết lập code của lỗi (đọc ra bằng hàm GetLastError)
------------
Cũng cần nói thêm: khi mào dùng code như UserForm3 và khi nào dùng code UserForm1?
Khi ta chỉ cần Timer thôi thì dùng code UserForm3 vì chả lý gì phải dùng subclassing. Khi ta cần xử lý nhiều thông điệp (vd. WM_MOUSEWHEEL) thì ta dùng code UserForm1 nhưng bỏ TimerProc vì thông điệp WM_TIMER ta xử lý luôn ở WindowProc chứ sao lại lập thêm TimerProc làm gì. Đằng nào cũng phải dùng WindowProc (subclassing) để xử lý các thông điệp khác (vd. WM_MOUSEWHEEL) nữa mà

ndu96081631 · 24/12/12

Hoàng Trọng Nghĩa đã viết:
Thật tình em cũng bó tay khi kết hợp với cái này, nó dù thế nào đi nữa nó cũng hoặc là đứng im và hiện đúng font, hai là nó chạy mà font bị lỗi

Với mảng em đã thấy nó khá trừu tượng rồi, với các API này em tưởng tượng còn không ra đừng nói chi đến trừu tượng!

Em thường dùng các thủ tục dưới đây, với óc sáng tạo của Thầy, em tin có thể Thầy cho nó chạy hoành tráng.

Mã:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcW" _ (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Sub SetUnicodeCaption(ByVal frm As UserForm, ByVal UnicodeString As String) Dim hWnd& hWnd = FindWindow("ThunderDFrame", frm.Caption) DefWindowProc hWnd, &HC, 0, StrPtr(UnicodeString) End Sub

Thủ tục chạy code trên form:

Mã:

Private Sub UserForm_Initialize() SetUnicodeCaption Me, Sheet1.[D11].Value End Sub

Đoạn code quan trọng để hiện Unicode text của bạn là: DefWindowProc hWnd, &HC, 0, StrPtr(Text) ---> Vậy thì cho nó vào Function TimeProc là xong chứ gì
Làm lại toàn bộ:
1> Code trong Module:

PHP:

Private Declare Function SetTimer Lib "user32" _
   (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcW" _
        (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public hWnd As Long

Mã:

Private Function TimeProc(ByVal H As Long, ByVal nMSG As Long, ByVal nID As Long, ByVal nTsys As Long)
  Dim Text As String
  On Error Resume Next
  Text = frm.Label1.Caption  '<--- frm là tên của UserForm nha
  Text = Mid(Text, 2, Len(Text)) & Left(Text, 1)
  frm.Label1.Caption = Text
  [COLOR=#ff0000]DefWindowProc hWnd, [/COLOR][COLOR=#0000cd]12[/COLOR][COLOR=#ff0000], 0, StrPtr(Text)[/COLOR] ''<--- &HC viết cha nó thành số 12 cho rồi
End Function

Mã:

Sub StartTimer()
  StopTimer
  SetTimer hWnd, 1, 50, AddressOf TimeProc
End Sub

Mã:

Sub StopTimer()
  KillTimer hWnd, 1
End Sub

2> Code trong UserForm:

PHP:

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

Mã:

Private Sub UserForm_Initialize()
  On Error Resume Next
  hWnd = FindWindow("ThunderDFrame", Me.Caption)
  StartTimer
End Sub

Mã:

Private Sub UserForm_Terminate()
  StopTimer
End Sub

Chổ màu đỏ là chổ mới thêm vào

Hoàng Trọng Nghĩa · 24/12/12

ndu96081631 đã viết:
Đoạn code quan trọng để hiện Unicode text của bạn là: DefWindowProc hWnd, &HC, 0, StrPtr(Text) ---> Vậy thì cho nó vào Function TimeProc là xong chứ gì

Eo ui, sao mà hoành tráng thế! Nhưng thật sự em đã thử như vậy mấy lần rồi, nó cứ như bị treo máy, thậm chí bấm thoát cái VBE nó cũng không cho, bấm nút Stop nó cũng không cho. Chắc lúc thử nó bị công đoạn nào lỗi chăng ta?

Tuy nhiên, có một lệ thuộc vào Label, nếu không có label chạy thì caption đứng im re, vậy mình thực hiện trực tiếp sẽ như thế nào ạ? Và nếu được thì có thể làm cái hàm đó tổng quát cho nhiều Form có thể thực hiện được không ạ?

Em cám ơn Thầy rất nhiều!

Hoàng Trọng Nghĩa · 24/12/12

À, nhìn vào hàm nó như một vòng lặp, nó cứ lặp đi lặp lại nên không thể không lệ thuộc cái label, vì vậy ta phải sử dụng thêm một biến (public) để cho biến này chạy trong hàm thì không lệ thuộc label nữa!

Mã:

Option Explicit
Private Declare Function SetTimer Lib "user32" _
    (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" _
    (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcW" _
    (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public hWnd As Long, [COLOR=#ff0000][B]fCaption As String[/B][/COLOR]

Sub Button1_Click()
    frm.Show
End Sub

Private Function TimeProc(ByVal H As Long, ByVal nMSG As Long, ByVal nID As Long, ByVal nTsys As Long)
    Dim Text As String
    On Error Resume Next
    Text = [COLOR=#ff0000][B]fCaption [/B][/COLOR]
    Text = Mid(Text, 2, Len(Text)) & Left(Text, 1)
    [COLOR=#ff0000][B]fCaption [/B][/COLOR]= Text
    DefWindowProc hWnd, 12, 0, StrPtr(Text)
End Function

Sub StartTimer()
    StopTimer
    SetTimer hWnd, 1, 50, AddressOf TimeProc
End Sub

Sub StopTimer()
    KillTimer hWnd, 1
End Sub

Và khi show form mình chỉ việc chạy thêm thủ tục gán chuỗi cho biến đó thôi:

Mã:

Private Sub UserForm_Initialize()
    On Error Resume Next
    [COLOR=#ff0000][B]fCaption = Label1.Caption[/B][/COLOR]
    hWnd = FindWindow("ThunderDFrame", Me.Caption)
    StartTimer
End Sub

Đã giải quyết được vấn đề 1, còn vấn đề tổng quát cho tất cả các form phải như thế nào đây ta? Mò tiếp xem sao!

ndu96081631 · 24/12/12

Hoàng Trọng Nghĩa đã viết:
Đã giải quyết được vấn đề 1, còn vấn đề tổng quát cho tất cả các form phải như thế nào đây ta? Mò tiếp xem sao!

Không hiểu là vấn đề gì nữa
Biến Text bạn gán cho nó là chuổi gì chả được
Ví dụ:

Mã:

Public hWnd As Long, Text As String 
Sub Button1_Click()
  Text = "Cong hòa xa hoi chu nghia Viet Nam"
  frm.Show
End Sub

Mã:

Private Function TimeProc(ByVal H As Long, ByVal nMSG As Long, ByVal nID As Long, ByVal nTsys As Long)
  On Error Resume Next
  Text = Mid(Text, 2, Len(Text)) & Left(Text, 1)
  frm.Label1.Caption = Text   ''(1)
  DefWindowProc hWnd, 12, 0, StrPtr(Text)  ''(2)
  '' Đoạn (1) và (2) là gán Marquee vào Label và Title
End Function

Hoàng Trọng Nghĩa · 24/12/12

ndu96081631 đã viết:
Không hiểu là vấn đề gì nữa
Biến Text bạn gán cho nó là chuổi gì chả được
Ví dụ:

Mã:

Public hWnd As Long, Text As String Sub Button1_Click() Text = "Cong hòa xa hoi chu nghia Viet Nam" frm.Show End Sub

Mã:

Private Function TimeProc(ByVal H As Long, ByVal nMSG As Long, ByVal nID As Long, ByVal nTsys As Long) On Error Resume Next Text = Mid(Text, 2, Len(Text)) & Left(Text, 1) frm.Label1.Caption = Text ''(1) DefWindowProc hWnd, 12, 0, StrPtr(Text) ''(2) '' Đoạn (1) và (2) là gán Marquee vào Label và Title End Function

Ý em muốn nói vấn đề 1 là cho Form.Caption chạy thôi, không cho Label chạy, 1 form mà chạy từa lưa thì kinh dị lắm.

----------------------------------------------------

Ah ah, em hiểu rồi, cái thằng DefWindowProc hWnd, 12, 0, StrPtr(Text) ''(2) này nó chạy trên mọi form khi mình khởi động form nếu có thủ tục ban đầu.

Ngáo ộp rồi! Cám ơn Thầy nhiều nhiều.

Hoàng Trọng Nghĩa · 25/12/12

Có một đặc điểm mà em thử nhiều cách vẫn không làm được, nếu như dùng form1 để mở form2 rồi đóng form1 (unload) và cũng như vậy đối với form2 thì khi mở đi mở lại trên form thì OK. Song nếu ta không dùng Unload mà dùng Me.Hide thì form1 mở xong rồi hide và cho hiện form2, rồi từ form2 cho hiện lại form1 thì form1 không chạy chữ!

[GPECODE=vb]Private Sub UserForm_Activate()
fCaption = Sheet1.Range("D11").Value
StartTimer
End Sub

Private Sub UserForm_Deactivate()
StopTimer
End Sub

Private Sub UserForm_Initialize()
hWnd = FindWindow("ThunderDFrame", Me.Caption)
End Sub

Private Sub UserForm_Terminate()
StopTimer
Unload UserForm1
End Sub

Private Sub CommandButton1_Click()
'Unload Me
Me.Hide
UserForm1.Show
End Sub
[/GPECODE]

Với các thủ tục trên, em đã sai ở đâu ạ?

siwtom · 25/12/12

Hoàng Trọng Nghĩa đã viết:
Có một đặc điểm mà em thử nhiều cách vẫn không làm được, nếu như dùng form1 để mở form2 rồi đóng form1 (unload) và cũng như vậy đối với form2 thì khi mở đi mở lại trên form thì OK. Song nếu ta không dùng Unload mà dùng Me.Hide thì form1 mở xong rồi hide và cho hiện form2, rồi từ form2 cho hiện lại form1 thì form1 không chạy chữ!

[GPECODE=vb]Private Sub UserForm_Activate()
fCaption = Sheet1.Range("D11").Value
StartTimer
End Sub

Private Sub UserForm_Deactivate()
StopTimer
End Sub

Private Sub UserForm_Initialize()
hWnd = FindWindow("ThunderDFrame", Me.Caption)
End Sub

Private Sub UserForm_Terminate()
StopTimer
Unload UserForm1
End Sub

Private Sub CommandButton1_Click()
'Unload Me
Me.Hide
UserForm1.Show
End Sub
[/GPECODE]

Với các thủ tục trên, em đã sai ở đâu ạ?

Kịch bản là như thế này:
1. frm được kích hoạt --> handle của frm được xác định trong UserForm_Initialize và được nhập vào hWnd --> Timer được kích hoạt và Caption của cửa sổ có hWnd, tức cửa sổ frm, được thay đổi
2. click Button --> hide frm --> UserForm1 được kích hoạt --> handle của UserForm1 được xác định trong UserForm_Initialize và được nhập vào hWnd
--> Timer được kích hoạt và Caption của cửa sổ có hWnd, tức cửa sổ UserForm1, được thay đổi
3. click Button --> hide UserForm1 --> Active frm.
Ở bước 3 không có thao tác xác định lại hWnd nữa do không sẩy ra sự kiện Initialize. Vậy hWnd hiện hành và cho tới ngày tận thế chính là handle của UserForm1. DefWindowProc vẫn thay đổi Caption nhưng là Caption của UserForm1 (hiện hide nên ta không thấy chữ chạy) vì hWnd hiện hành là của nó. Vậy chỉ khi UserForm1 hiển thị thì mới nhìn thấy dòng chữ chạy. Cứ thế cho tới ngày tận thế.

Hoàng Trọng Nghĩa · 25/12/12

siwtom đã viết:
Kịch bản là như thế này:
1. frm được kích hoạt --> handle của frm được xác định trong UserForm_Initialize và được nhập vào hWnd --> Timer được kích hoạt và Caption của cửa sổ có hWnd, tức cửa sổ frm, được thay đổi
2. click Button --> hide frm --> UserForm1 được kích hoạt --> handle của UserForm1 được xác định trong UserForm_Initialize và được nhập vào hWnd
--> Timer được kích hoạt và Caption của cửa sổ có hWnd, tức cửa sổ UserForm1, được thay đổi
3. click Button --> hide UserForm1 --> Active frm.
Ở bước 3 không có thao tác xác định lại hWnd nữa do không sẩy ra sự kiện Initialize. Vậy hWnd hiện hành và cho tới ngày tận thế chính là handle của UserForm1. DefWindowProc vẫn thay đổi Caption nhưng là Caption của UserForm1 (hiện hide nên ta không thấy chữ chạy) vì hWnd hiện hành là của nó. Vậy chỉ khi UserForm1 hiển thị thì mới nhìn thấy dòng chữ chạy. Cứ thế cho tới ngày tận thế.

Vậy ý Thầy là chỉ sử dụng được nó khi Unload và không được Hide phải không ạ?

siwtom · 25/12/12

Hoàng Trọng Nghĩa đã viết:
Vậy ý Thầy là chỉ sử dụng được nó khi Unload và không được Hide phải không ạ?

Bạn thử chuyển FindWindow vào Activate xem sao. Nhưng sẽ có trở ngại đấy. Cứ tự tìm trước, không được thì tôi sẽ "mách nước" cho

Xin được giúp về chữ chạy trên label

Thành viên hoạt động

Thành viên gắn bó

Huyền thoại GPE

File đính kèm

Huyền thoại GPE

Chuyên gia GPE

Huyền thoại GPE

Chuyên gia GPE

Chuyên gia GPE

Huyền thoại GPE

Chuyên gia GPE

Thành viên gắn bó

File đính kèm

Huyền thoại GPE

File đính kèm

Chuyên gia GPE

Chuyên gia GPE

File đính kèm

Huyền thoại GPE

Chuyên gia GPE

File đính kèm

Chuyên gia GPE

File đính kèm

Thành viên gắn bó

Chuyên gia GPE

Thành viên gắn bó

Facebook

Group