ラセン（Spiral）を描画         <TOP>

フォーム上にラセンを描画します。フォームのリサイズに連動させています。

PolylineTo 折れ線の描画

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

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

'現在位置を受け取るバッファをアドレス値で指定

Declare Function Api_MoveToEx& Lib "gdi32" Alias "MoveToEx" (ByVal hDC&, ByVal x&, ByVal y&, ByVal lpPoint&)
　

'================================================================
'= 螺旋(Spiral)を描画

'=    (PolylineTo.bas)

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

Type POINTAPI
    x As Long
    y As Long
End Type

' 折れ線の描画
Declare Function Api_PolylineTo& Lib "gdi32" Alias "PolylineTo" (ByVal hDC&, lppt As POINTAPI, ByVal cCount&)

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

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

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

'================================================================
'=
'================================================================
Declare Sub FormPaint edecl ()
Sub FormPaint()
    Var Pt(1000) As POINTAPI
    Var Ang As Single            '角度
    Var Rad As Single            '半径
    Var Num As Integer           '線の数
    Var XMid As Long             'フォームの横中心
    Var YMid As Long             'フォームの縦中心
    Var hDC As Long              'フォームのデバイスコンテキスト
    Var Ret As Long

    'デバイスコンテキストの取得
    hDC = Api_GetDC(GethWnd)

    XMid = GetClientWidth / 2
    YMid = GetClientHeight / 2

    'Pt(0〜1000)位置計算
    For Num = 1 To 1000
        Ang = Num * 0.1
        Rad = Rad + Ang * 0.01
        Pt(Num).x = XMid + Cos(Ang) * Rad
        Pt(Num).y = YMid - Sin(Ang) * Rad
    Next

    '最初の位置を決定
    Ret = Api_MoveToEx(hDC, XMid, YMid, ByVal 0&)

    'Pt(1) 〜 Pt(1000)まで連続した線を引く
    Ret = Api_PolylineTo(hDC, Pt(1), 1000)

    'デバイスコンテキストの解放
    Ret = Api_ReleaseDC(GethWnd, hDC)
End Sub

'================================================================
'= フォームリサイズ
'================================================================
Declare Sub Mainform_Resize edecl ()
Sub Mainform_Resize()
    Cls
    FormPaint
End Sub

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