動的スクロールグラフの作成          <TOP>

スクロールするサインウェーウェーブを描画します。

CreateCompatibleDC 関連するデバイスと互換性のあるデバイスコンテキストを作成

CreateCompatibleBitmap デバイスコンテキストと互換性のあるビットマップを作成

SelectObject 指定されたデバイスコンテキストのオブジェクトを選択

CreatePen 論理ペンを作成

LineTo 現在の位置から終点までを直線で描画

MoveToEx 現在位置を受け取るバッファを参照で指定

BitBlt 指定された長方形内の各ピクセルの色データをコピー

GetDC デバイスコンテキストのハンドルを取得

ReleaseDC デバイスコンテキストを解放

参照
http://support.microsoft.com/kb/183333/ja
　

'================================================================
'= 動的スクロールグラフの作成
'=    (CreateCompatibleBitmap.bas)

'=    参照 http://support.microsoft.com/kb/183333/ja

'================================================================
#include "Windows.bi"

' 指定されたデバイスコンテキストに関連するデバイスと互換性のあるメモリデバイスコンテキストを作成
Declare Function Api_CreateCompatibleDC& Lib "gdi32" Alias "CreateCompatibleDC" (ByVal hDC&)

' デバイスコンテキストと互換性のあるビットマップを作成
Declare Function Api_CreateCompatibleBitmap& Lib "gdi32" Alias "CreateCompatibleBitmap" (ByVal hDC&, ByVal nWidth&, ByVal nHeight&)

' 指定されたデバイスコンテキストのオブジェクトを選択
Declare Function Api_SelectObject& Lib "gdi32" Alias "SelectObject" (ByVal hDC&, ByVal hObject&)

' 論理ペンを作成
Declare Function Api_CreatePen& Lib "gdi32" Alias "CreatePen" (ByVal nPenStyle&, ByVal nWidth&, ByVal crColor&)

' 現在の位置から終点までを直線で描画
Declare Function Api_LineTo& Lib "gdi32" Alias "LineTo" (ByVal hDC&, ByVal x&, ByVal y&)

' 現在位置を受け取るバッファを参照で指定
Declare Function Api_MoveToEx& Lib "gdi32" Alias "MoveToEx" (ByVal hDC&, ByVal x&, ByVal y&, ByVal lpPoint&)

' ビットブロック転送を行う。コピー元からコピー先のデバイスコンテキストへ、指定された長方形内の各ピクセルの色データをコピー
Declare Function Api_BitBlt& Lib "gdi32" Alias "BitBlt" (ByVal hDestDC&, ByVal X&, ByVal Y&, ByVal nWidth&, ByVal nHeight&, ByVal hSrcDC&, ByVal xSrc&, ByVal ySrc&, ByVal dwRop&)

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

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

#define SRCCOPY &HCC0020                'そのまま転送
#define PS_SOLID 0                      '実線のペンを作成

#define pWidth 210                      'ピクチャボックス幅
#define pHeight 84                      'ピクチャボックス高さ
#define pHeightHalf 40                  'Y軸(高さの半分)
#define pGrid 21                        'グリッド幅、高さ
#define tInterval 10                    'タイマーインターバル
#define vbGray &HC0C0C0                 '灰色のカラーコード
#define vbRed &H0000FF                  '赤のカラーコード

Var Shared counter As Long              'カウンター
Var Shared oldY As Long                 '元のY座標
Var Shared hDCh As Long                 '
Var Shared phDC As Long                 'ピクチャボックスのデバイスコンテキスト
Var Shared hPenBlack As Long            '黒ペン
Var Shared hPenRed As Long              '赤ペン

Var Shared Picture1 As Object
Var Shared Timer1 As Object

Picture1.Attach GetDlgItem("Picture1")
Timer1.Attach GetDlgItem("Timer1")

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

    phDC = Api_GetDC(Picture1.GethWnd)

    Picture1.MoveWindow 10, 10
    Picture1.SetWindowSize 215, 85

    counter = 0
    hDCh = Api_CreateCompatibleDC(phDC)
    hBmp = Api_CreateCompatibleBitmap(phDC, pWidth, pHeight)
    Ret = Api_SelectObject(hDCh, hBmp)
    hPenBlack = Api_CreatePen(PS_SOLID, 0, vbGray)
    hPenRed = Api_CreatePen(PS_SOLID, 0, vbRed)
    Ret = Api_SelectObject(hDCh, hPenBlack)

    '水平グリッドライン
    For i = pGrid To pHeight - 1 Step pGrid
        Picture1.Line (0, i)-(pWidth, i),, 14
    Next

    '垂直グリッドライン
    For i = pGrid - (counter Mod pGrid) To pWidth - 1 Step pGrid
        Picture1.Line (i, 0)-(i, pHeight - 1),, 14
    Next

    Ret = Api_BitBlt(hDCh, 0, 0, pWidth, pHeight, phDC, 0, 0, SRCCOPY)

    Timer1.SetInterval 10
    Timer1.Enable -1
    oldY = pHeightHalf
End Sub

'================================================================
'=
'================================================================
Declare Sub Timer1_Timer edecl ()
Sub Timer1_Timer()
    Var i As Integer

    Ret = Api_BitBlt(hDCh, 0, 0, pWidth - 1, pHeight, hDCh, 1, 0, SRCCOPY)

    If counter Mod pGrid = 0 Then
        Ret = Api_MoveToEx(hDCh, pWidth - 2, 0, 0)
        Ret = Api_LineTo(hDCh, pWidth - 2, pHeight)
    End If

    i = Sin(0.1 * counter) * (pHeightHalf - 1) + pHeightHalf

    Ret = Api_SelectObject(hDCh, hPenRed)
    Ret = Api_MoveToEx(hDCh, pWidth - 3, oldY, 0)
    Ret = Api_LineTo(hDCh, pWidth - 2, i)
    Ret = Api_SelectObject(hDCh, hPenBlack)
    Ret = Api_BitBlt(phDC, 0, 0, pWidth, pHeight, hDCh, 0, 0, SRCCOPY)

    counter = counter + 1
    oldY = i
End Sub

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

    Ret = Api_ReleaseDC(Picture1.GethWnd, phDC)
End Sub

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