'================================================================
'= デスクトップに線・点を描画
'=    (CreatePen3.bas)
'================================================================
#include "Windows.bi"

' 論理ペンを作成
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_CreateDC& Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName$, ByVal lpDeviceName$, ByVal lpOutput$, ByVal lpInitData As Any)

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

' 指定されたデバイスコンテキストを削除
Declare Function Api_DeleteDC& Lib "gdi32" Alias "DeleteDC" (ByVal hDC&)

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

' 論理オブジェクトを削除し、そのオブジェクトに関連付けられていたすべてのシステムリソースを解放
Declare Function Api_DeleteObject& Lib "gdi32" Alias "DeleteObject" (ByVal hObject&)

' 指定した座標に点を配置する
Declare Function Api_SetPixel& Lib "gdi32" Alias "SetPixel" (ByVal hDC&, ByVal X&, ByVal Y&, ByVal crColor&)

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

' ビットブロック転送を行う。コピー元からコピー先のデバイスコンテキストへ、指定された長方形内の各ピクセルの色データをコピー
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&)

#define SRCCOPY &HCC0020                'そのまま転送

Var Shared Radio1 As Object
Var Shared Radio2 As Object
Var Shared Button1 As Object

Radio1.Attach GetDlgItem("Radio1") : Radio1.SetFontSize 14
Radio2.Attach GetDlgItem("Radio2") : Radio2.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

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

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var hDC As Long
    Var hDCBuffer As Long
    Var hBmp As Long
    Var hPen As Long
    Var hObject As Long
    Var DeskWidth As Long
    Var DeskHeight As Long
    Var i As Long
    Var Col As Long
    Var Max As Long
    Var Ret As Long

    Max = 5000 + Index * 100000

    'デスクトップサイズを取得
    DeskWidth = GetDeviceCaps(8)
    DeskHeight = GetDeviceCaps(10)
    
    'デスクトップにビットマップを描画
    hDC = Api_CreateDC("DISPLAY", ByVal 0, ByVal 0, 0)
    hDCBuffer = Api_CreateCompatibleDC(hDC)
    hBmp = Api_CreateCompatibleBitmap(hDC, DeskWidth, DeskHeight)
    Ret = Api_SelectObject(hDCBuffer, hBmp)
    Ret = Api_BitBlt(hDCBuffer, 0, 0, DeskWidth, DeskHeight, hDC, 0, 0, SRCCOPY)

    '色・線・点を設定
    For i = 1 To Max
        Col = RGB(CInt(255 * Rnd), CInt(255 * Rnd), CInt(255 * Rnd))
        If Index = 0 Then
            hPen = Api_CreatePen(0, 10, Col)
            hObject = Api_SelectObject(hDC, hPen)
            Ret = Api_LineTo(hDC, CInt(DeskWidth * Rnd), CInt(DeskHeight * Rnd))
            Ret = Api_DeleteObject(hObject)
        Else
            Ret = Api_SetPixel(hDC, CInt(DeskWidth * Rnd), CInt(DeskHeight * Rnd), Col)
        End If
    Next i
    
    'デスクトップに描画
    Ret = Api_BitBlt(hDC, 0, 0, DeskWidth, DeskHeight, hDCBuffer, 0, 0, SRCCOPY)
    
    'デバイスコンテキストの解放
    Ret = Api_DeleteDC(hDCBuffer)
    Ret = Api_DeleteDC(hDC)
End Sub

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