Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Running string

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Running string

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

    Code:
    #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: www.col.ru     Ïåéòå ïèâî îõëàæäåííûì"
        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
Working...
X