Running string

[Semen Matusovski]

I like to add visual/sound effects.
This is an attempt to create "running string"

#Compile Exe
#Dim All
#Register None
#Include "win32api.inc"

Global _
   Rs_Text As Asciiz * 1024, _  ' Text of "running string"
   Rs_Long As Long, _           ' Duration of demo-regime, ms
   Rs_Delay As Long, _          ' Duration of delay, ms
   Rs_FontName As String, _     ' Font: facename
   Rs_FontBold As Long, _       ' Font: Weight (0, 400, 700 ...)
   Rs_FontItalic As Long, _     ' Font: Italic (%True, %False)
   Rs_Foreground As Long, _     ' RGB for foreground
   Rs_Background As Long        ' RGB for background

CallBack Function Rs_Proc()
   %ID_Rs = 1001
   %nPhoto = 25 ' changes per second
   Dim hFont As Static Long, _
       hWnd As Static Long, _
       hBrush As Static Long, _
       sizeA As Static SizeL, _
       nTick As Static Long, _
       r As Static Rect
   Local lf As LOGFONT, hDc As Long, Lb As LOGBRUSH

   Select Case CbMsg
      Case %WM_INITDIALOG
         Lb.lbStyle = %BS_SOLID
         Lb.lbColor = Rs_Background
         hBrush = CreateBrushIndirect(Lb)
         GetClientRect CbHndl, r
         GetObject GetStockObject(%ANSI_VAR_FONT), SizeOf(lf), ByVal VarPtr(lf)
         lf.lfHeight = r.nBottom
         lf.lfWeight = Rs_FontBold
         lf.lfItalic = Rs_FontItalic
         lf.lfFaceName = Rs_FontName$
         lf.lfCharset = %RUSSIAN_CHARSET
         hFont = CreateFontIndirect(lf)
         Control Add Label, CbHndl, %ID_Rs, Rs_Text$, 0, 0, 0, 0
         hWnd = GetDlgItem(CbHndl, %ID_Rs)
         SendMessage hWnd, %WM_SETFONT, hFont, 0
         hDc = GetDC(hWnd)
         SelectObject hdc, hFont
         GetTextExtentPoint32 hdc, Rs_Text$, Len(Rs_Text), SizeA
         ReleaseDC hWnd, hDc
         SetTimer CbHndl, 1, 1000 / %nPhoto, ByVal 0
         Function = %TRUE

      Case %WM_TIMER
         Incr nTick
         If nTick > (r.nRight / sizeA.cx * Rs_Long + _
                    Rs_Long + Rs_Delay) / %nPhoto Then nTick = 0
         SetWindowPos hWnd, 0, r.nRight - nTick / Rs_Long * _
             %nPhoto * sizeA.cx, 0, sizeA.cx, sizeA.cy, 0

      Case %WM_DESTROY
         KillTimer CbHndl, 1
         DeleteObject hBrush
         DeleteObject hFont
      Case %WM_CTLCOLORDLG
         Function = hBrush

      Case %WM_CTLCOLORSTATIC, %WM_CTLCOLOREDIT
         Select Case GetDlgCtrlId(CbLparam)
            Case %ID_Rs
               SetTextColor CbWparam, Rs_Foreground
               SetBkColor CbWparam, Rs_Background
               Function = hBrush
            End Select
   End Select
End Function

Sub Rs_Start (hWndParent As Long, x As Long, y As Long, cx As Long, cy As Long)
   Local hDlg As Long
   Dialog New hWndParent, "", x, y, cx, cy, %WS_CHILD Or %WS_BORDER, %WS_EX_CLIENTEDGE To hDlg
   Dialog Show Modeless hDlg, Call Rs_Proc
End Sub

Function PbMain
    Local hDlg As Long
    Dialog New 0, "Test", , , 400, 200 To hDlg
    Control Add TextBox, hDlg, 101, "", 10, 10, 380, 160, %ES_MULTILINE  Or %ES_WANTRETURN, %WS_EX_CLIENTEDGE
    Rs_FontName$ = "Arial"
    Rs_Text$ = "Ñåìåí Ìàòóñîâñêèé    Òåë. (095) 123-4567     HTTP: [url="http://www.col.ru"]www.col.ru[/url]     Ïåéòå ïèâî îõëàæäåííûì"
    Rs_Foreground = %White: Rs_Background = %Blue
    Rs_FontBold = 400: Rs_FontItalic = %True
    Rs_Long = 10000: Rs_Delay = 1000
    Rs_Start hDlg, 10, 180, 377, 12
    
    Dialog Show Modal hDlg

End Function