Footstep illusion: Ảo ảnh bước chân

[tuhocvba]

Trong chủ đề này, chúng ta sẽ cùng nhau thực hiện một thí nghiệm vui làm rõ hiện tượng ảo ảnh bước chân.
Level Excel VBA: Cao cấp
Mục đích tạo ra thí nghiệm hoạt động như sau:

Bạn cần đăng nhập để thấy đính kèm

Độ tương phản càng cao, tốc độ di chuyển càng nhanh.
Khi quan sát các vật thể trắng và đen di chuyển với tốc độ không đổi trên nền xám nhạt và đen, ta có cảm nhận chúng đang di chuyển xen kẽ.
Ảo ảnh này (ảo ảnh bước chân) được cho là dựa trên thực tế là tốc độ xử lý của đối tượng thị giác tăng lên khi độ tương phản với nền tăng lên. Nói cách khác, tốc độ xử lý của các vật thể màu trắng cao hơn màu đen trên màu xám đen và tốc độ xử lý của vật thể màu đen nhanh hơn màu trắng trên màu xám nhạt. Chúng ta cảm nhận tốc độ có sự khác biệt (nhanh hơn và chậm hơn).
Trong bản demo này, các hình trắng và đen sẽ di chuyển ở với tốc độ khác nhau trong khi nền sọc có thể nhìn thấy và chúng sẽ xuất hiện để di chuyển với cùng tốc độ nếu mẫu sọc biến mất.
Thời gian của mẫu sọc càng cao (mẫu sọc càng mịn), ảo ảnh càng có xu hướng xảy ra.

Bạn cần đăng nhập để thấy đính kèm

Nguồn:

Bạn cần đăng nhập để thấy link

(Còn nữa)

 

[Euler]

Nhắc lại về vấn đề chúng ta muốn thí nghiệm:

Bạn cần đăng nhập để thấy đính kèm

Ở hình này các bạn sẽ thấy là khối màu trắng đang di chuyển nhanh hơn khối màu đen.
Đó là khi khối màu trắng đang di chuyển vào phần màu đen.
Ngược lại, khi khối màu trắng di chuyển vào phần màu trắng, ta lại có cảm giác là nó đang chậm hơn khối màu đen.

Bạn cần đăng nhập để thấy đính kèm

Chuẩn bị thực hiện thí nghiệm:
CODE:
Về thời gian: Không liên quan gì tới tốc độ xử lý của máy tính. Chúng ta sẽ điều chỉnh thời gian di chuyển bằng cách sẽ sử dụng hàm

Bạn cần đăng nhập để thấy link

mỗi lần chờ 0.03s, thực hiện 400 lần.
(Chúng ta cũng có thể sử dụng Application.Wait )
Application.Wait [Now()+"00:00:00.03"]
Nhắc lại SleepAPI (Ví dụ):

#If VBA7 And Win64 Then  'Office 64bit
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
Sub vidu1()
    Dim time As Long
    time = 500
    
    Sleep time
    
    MsgBox "Da cho " & time & "ms"
End Sub

Cấu trúc logic: Do　～　Loop While Not Stop
Sử dụng

Bạn cần đăng nhập để thấy link

: Nếu không sử dụng DoEvents, chúng ta sẽ không ấn được nút bấm Stop để dừng chương trình.

 

[vbano1]

Chuẩn bị thực hiện thí nghiệm:
Định dạng kẻ sọc cho Excel:

Bạn cần đăng nhập để thấy link

, chúng ta đã chuẩn bị xong kiến thức về Code. Bây giờ chúng ta cần chuẩn bị định dạng cho Excel. Mục đích là tạo ra thứ như dưới đây:

Bạn cần đăng nhập để thấy đính kèm

Người dùng tích vào ô checkbox thì kẻ sọc trắng hiện ra. Bỏ chọn thì kẻ sọc trắng biến mất.
Các bạn làm như sau:
1. Tạo cells tàng hình: Đặt tên cells B13 là tuhocvba.

Bạn cần đăng nhập để thấy đính kèm

Bạn cần đăng nhập để thấy link

.
2. Lấy ô checkbox:
Lấy chính xác đối tượng như hình dưới đây.

Bạn cần đăng nhập để thấy đính kèm

Chú ý không lấy nhầm ActiveX Controls nhé.
Chuột phải vào ô textbox chọn Format Control:

Bạn cần đăng nhập để thấy đính kèm

Trong thẻ Control, ở phần Cell link nhập là tuhocvba. Có nghĩa là giá trị của ô checkbox này sẽ được nhập vào ô B13 (tuhocvba).
Chú ý ô B13 đang để tàng hình, cho nên người dùng sẽ không quan sát được giá trị TRUE, FALSE của nó. Bạn có thể di chuyển ô checkbox đè lên ô B13 để người dùng khỏi sờ vào ô B13.

Bạn cần đăng nhập để thấy đính kèm

3. Dùng Rule: để tạo sọc đen trắng.

Bạn cần đăng nhập để thấy đính kèm

Bạn chỉ cần tạo Luật (Rule) cho ô E17. Sau đó copy ô này cho toàn bộ vùng E17:AC30
Ai quên ISODD thì đọc lại

Bạn cần đăng nhập để thấy link

.
Vậy là xong rồi đấy.
Bước chuẩn bị tới đây là kết thúc. Phần sau chúng ta bàn tới code nhé.

 

[giaiphapvba]

CODE hoàn chỉnh:

#If VBA7 And Win64 Then  'Office 64 bit
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
 
Dim flagstop As Boolean 'chi thi stop
 
Const vtbandau = 30
Const solan = 400

Private Sub cmdplay_Click()
 
    flagstop = False
    
    Dim i As Integer
    
    With ActiveSheet
        
        Do
            'Thiet dinh vi tri ban dau
            .Shapes("OBJ_A").Left = vtbandau
            .Shapes("OBJ_B").Left = vtbandau
            .Shapes("OBJ_C").Left = vtbandau
        
            For i = 1 To solan
            
                'Refresh dich chuyen sang trai (gia tang 1 don vi)
                .Shapes("OBJ_A").IncrementLeft 1
                .Shapes("OBJ_B").IncrementLeft 1
                .Shapes("OBJ_C").IncrementLeft 1
                
                Sleep 30    'Wait 0.03s
                
                DoEvents    'Cho phep doc su kien phat sinh（Button STOP）
                If flagstop Then Exit For
                
            Next i
        
        Loop While Not flagstop 'flagstop = False thi tiep tuc vong lap
    
    End With
 
End Sub
 
Private Sub cmdstop_Click()
    flagstop = True 'Nut bam Stop
End Sub

Bài tập về nhà:
Nhìn vào code trên, các bạn biết mình phải làm gì rồi chứ?
Bạn cần:
-Tạo ra hai nút bấm trên sheet. Tên nút bấm thì bạn nhìn vào code và thử đoán xem sao nhé.
-Tạo ra 3 shape trên sheet, đặt tên cho chúng lần lượt là: OBJ_A, OBJ_B, OBJ_C.
Đến đây là kết thúc. Code chạy biểu diễn như

Bạn cần đăng nhập để thấy link

được rồi đấy. Các bạn thử làm xem có tự làm được không nhé.

 

[Euler]

Tôi hi vọng cac bạn đều đã có thể tự làm được. Đây là file demo:

Bạn cần đăng nhập để thấy link