'================================================================
'= 電光掲示板(デバイスコンテキストのスクロール)
'=    (ScrollDC.bas)
'================================================================
#include "Windows.bi"

Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type

' システムが起動してからの経過時間を取得
Declare Function Api_GetTickCount& Lib "kernel32" Alias "GetTickCount" ()

' RECT構造体の値を設定
Declare Function Api_SetRect& Lib "user32" Alias "SetRect" (lpRect As RECT, ByVal X1&, ByVal Y1&, ByVal X2&, ByVal Y2&)

' 矩形領域の補正
Declare Function Api_OffsetRect& Lib "user32" Alias "OffsetRect" (lpRect As RECT, ByVal x&, ByVal y&)

' デバイスコンテキストをスクロール
Declare Function Api_ScrollDC& Lib "user32" Alias "ScrollDC" (ByVal hDC&, ByVal dx&, ByVal dy&, lprcScroll As RECT, lprcClip As RECT, ByVal hrgnUpdate&, lprcUpdate As RECT)

' 文字列を指定領域に出力
Declare Function Api_DrawText& Lib "user32" Alias "DrawTextA" (ByVal hDC&, ByVal lpStr$, ByVal nCount&, lpRect As RECT, ByVal wFormat&)

' 指定されたウィンドウのクライアント領域または画面全体を表すディスプレイデバイスコンテキストのハンドルを取得
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

' デバイスコンテキストを解放
Declare Function Api_ReleaseDC& Lib "user32" Alias "ReleaseDC" (ByVal hWnd&, ByVal hDC&)

Var Shared Button1 As Object
Var Shared Button2 As Object
Var Shared Button3 As Object
Var Shared Picture1 As Object

Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14
Button2.Attach GetDlgItem("Button2") : Button2.SetFontSize 14
Button3.Attach GetDlgItem("Button3") : Button3.SetFontSize 14
Picture1.Attach GetDlgItem("Picture1")

Var Shared txtLine(100) As String
Var Shared Max As Integer
Var Shared Scrolling As Integer
Var Shared t As Long
Var Shared Index As Long
Var Shared rText As RECT
Var Shared rClip As RECT
Var Shared rUpdate As RECT
Var Shared hDC As Long
Var Shared CrLf As String

'================================================================
'=
'================================================================
Declare Function Alignment bdecl () As Integer
Function Alignment()
    Alignment = Val(Mid$(GetDlgRadioSelect("Radio1"), 6)) - 1
End Function

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Var Ret As Long

    CrLf = Chr$(13, 10)

    'ピクチャボックスDC取得
    hDC = Api_GetDC(Picture1.GethWnd)

    '矩形範囲を設定
    Ret = Api_SetRect(rClip, 0, 1, Picture1.GetWidth, Picture1.GetHeight)
    Ret = Api_SetRect(rText, 0, Picture1.GetHeight, Picture1.GetWidth, Picture1.GetHeight + GetFontSize)
End Sub

'================================================================
'=
'================================================================
Declare Sub Scroll edecl ()
Sub Scroll()
    Var txt As String
    Var Ret As Long

    do
        '周期的な枠
        If Api_GetTickCount - t > 25 Then
             t = Api_GetTickCount
            If rText.Bottom < Picture1.GetHeight Then
                Ret = Api_OffsetRect(rText, 0, GetFontSize)

                If Alignment = &H1 Then
                    txt = Trim$(txtLine(Index))
                Else
                    txt = txtLine(Index)
                End If

                Index = Index + 1
            End If

            Ret = Api_DrawText(hDC, txt, Len(txt), rText, Alignment)
            Ret = Api_OffsetRect(rText, 0, -1)
            Ret = Api_ScrollDC(hDC, 0, -1, rClip, rClip, 0, rUpdate)

            Picture1.Line(0, Picture1.GetHeight - 1) - (Picture1.GetWidth, Picture1.GetHeight - 1) , , 15
        End If

        CallEvent
    Loop Until Scrolling = 0 Or Index >= Max

    Button1.EnableWindow -1
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var FileName As String
    Var sFile As String
    Var FF As Integer

    FF = FreeFile
    FileName = WinOpenDlg("ファイルのオープン", "*.txt", "テキスト(*.txt)", 0)
    If FileName <> Chr$(&H1B) Then
        Open FileName For Input As #FF
    Else
        Close #FF
        Exit Sub
    End If

    Index = 0

    While Not eof(FF)
        Line Input #FF, sFile
        Index = Index + 1
        If Index > 100 Then Max = Index : Close #FF : Exit Sub
        txtLine(Index) = sFile
    Wend

    Close #FF
    Max = Index
End Sub

'================================================================
'=
'================================================================
Declare Sub Button2_on edecl ()
Sub Button2_on()
    Button1.EnableWindow 0
    Scrolling = -1
    Index = 0
    Scroll
End Sub

'================================================================
'=
'================================================================
Declare Sub Button3_on edecl ()
Sub Button3_on()
    Scrolling = 0
    Button2.EnableWindow -1
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_QueryClose edecl (Cancel%, Mode%)
Sub MainForm_QueryClose(Cancel%, Mode%)
    Scrolling = 0
    Ret = Api_ReleaseDC(Picture1.GethWnd, hDC)    
    End
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End