スクリーンセーバーの部分です。
MainWnd.abpに書きます。

'-----------------------------------------------------------------------------

'  イベント プロシージャ

'-----------------------------------------------------------------------------

' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。

' ウィンドウ ハンドル: hMainWnd



' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。



Const	PAI = 3.141592

Const	ID_TIMER = 100

Const	ELAPSE = 60		'タイマー間隔

Const	POS_MAX = 10

Const	POS_RING_MAX = 100

Const	SPEED_MAX = 20



Type POS

	mX As Single

	mY As Single

	mR As Single

End Type



Dim	gAPos[POS_MAX] As POS

Dim	gPos[POS_RING_MAX,POS_MAX] As POS

Dim	gPosNum = 5 As Integer

Dim	gRingNum = 10 As Integer

Dim	gSpeed = 5 As Single

Dim	gRing = 0 As Integer

Dim	gR = 128 As Integer, gG = 128 As Integer, gB = 128 As Integer



Dim	hMemDC As DWord

Dim	gCheckMouseMove As Long



'-----------------------------------------------------------------------------

' ここから下は、イベントプロシージャを記述するための領域になります。



Sub MainWnd_Destroy()

	ShowCursor( TRUE )

	if hMemDC <> 0 then	DeleteDC( hMemDC )

	プロジェクト名_DestroyObjects()

	PostQuitMessage(0)

End Sub



Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)

	gCheckMouseMove = 0

	hMemDC = 0



	'メモリデバイスコンテキスト(hMemDC)を作る

	Dim	hdc As DWord

	Dim	hBitmap As DWord

	hdc = GetDC( hMainWnd )

	hBitmap = CreateCompatibleBitmap( hdc, gRect.right, gRect.bottom )

	hMemDC = CreateCompatibleDC( hdc )

	ReleaseDC( hMainWnd, hdc )

	SelectObject( hMemDC, hBitmap )

	DeleteObject( hBitmap )



	Randomize



	Dim	i As Integer, j As Integer

	for i = 0 to POS_MAX - 1

		gAPos[i].mX = Rnd() * gRect.right

		gAPos[i].mY = Rnd() * gRect.bottom

		gAPos[i].mR = Rnd() * PAI * 2.0



		for j = 0 to POS_RING_MAX - 1

			gPos[j,i].mX = gAPos[i].mX

			gPos[j,i].mY = gAPos[i].mY

			gPos[j,i].mR = gAPos[i].mR

		next

	next



	'タイマー始動

	SetTimer( hMainWnd, ID_TIMER, ELAPSE, 0 )

End Sub



'タイマー処理

Sub MainWnd_Timer(TimerID As Long)

	Dim	i As Integer, j As Integer

	Dim	ppos As *POS



	ppos = VarPtr( gAPos[0] )



	Dim	aSpeed As Single

	aSpeed = gSpeed * 2 - 1



	'移動

	for i = 0 to gPosNum - 1

		Dim	px As Single, py As Single

		Dim	vx As Single, vy As Single

		Dim	ar As Single

		ar = ppos[i].mR

		vx = Cos( ar ) * aSpeed

		vy = Sin( ar ) * aSpeed

		px = ppos[i].mX + vx

		py = ppos[i].mY + vy

		if px <  0 then				ar = Rnd() * PAI - (PAI*0.5)

		if py <  0 then				ar = Rnd() * PAI

		if px >= gRect.right then	ar = Rnd() * PAI + (PAI*0.5)

		if py >= gRect.bottom then	ar = Rnd() * PAI + (PAI)

		if ar = ppos[i].mR then

			ppos[i].mX = px

			ppos[i].mY = py

		else

			ppos[i].mR = ar

			ppos[i].mX = ppos[i].mX + Cos( ar ) * aSpeed

			ppos[i].mY = ppos[i].mY + Sin( ar ) * aSpeed

		endif

	next



	'コピー

	ppos = VarPtr( gPos[gRing,0] )

	for i = 0 to gPosNum - 1

		ppos[i].mX = gAPos[i].mX

		ppos[i].mY = gAPos[i].mY

	next



	gRing = gRing + 1

	if gRing >= gRingNum then gRing = 0



	'再描画する

	InvalidateRect(hMainWnd,ByVal 0,0)

End Sub



'描画

Sub MainWnd_Paint(hDC As Long)

	Dim	hPen As DWord

	Dim	hOldPen As DWord



	'背景クリア

	SelectObject( hMemDC, GetStockObject(BLACK_BRUSH) )

	Rectangle( hMemDC, 0,0, gRect.right,gRect.bottom )



	Dim	ppos As *POS

	Dim	ri As Integer

	Dim	aBP[ POS_MAX * 3 ] As POINTAPI



	hPen = CreatePen( PS_SOLID, 1, RGB(gR,gG,gB) )

	hOldPen = SelectObject( hMemDC, hPen )



	for ri = 0 to gRingNum-1

		ppos = VarPtr( gPos[ri,0] )

		Dim	pcx0 As Single, pcy0 As Single

		Dim	pcx1 As Single, pcy1 As Single

		Dim	pcx2 As Single, pcy2 As Single

		pcx2 = ppos[0].mX + (ppos[1].mX - ppos[0].mX) * 0.5

		pcy2 = ppos[0].mY + (ppos[1].mY - ppos[0].mY) * 0.5

		MoveToEx( hMemDC, pcx2,pcy2, ByVal NULL )



		Dim	i = 1 As Integer

		Dim	j = 2 As Integer

		Dim	bp = 0 As Integer

		do

			pcx0 = pcx2

			pcy0 = pcy2

			pcx1 = ppos[i].mX

			pcy1 = ppos[i].mY

			pcx2 = pcx1 + (ppos[j].mX - pcx1) * 0.5

			pcy2 = pcy1 + (ppos[j].mY - pcy1) * 0.5



			aBP[bp].x = pcx0 + (pcx1 - pcx0) * 0.5

			aBP[bp].y = pcy0 + (pcy1 - pcy0) * 0.5

			bp = bp + 1

			aBP[bp].x = pcx1 + (pcx2 - pcx1) * 0.5

			aBP[bp].y = pcy1 + (pcy2 - pcy1) * 0.5

			bp = bp + 1

			aBP[bp].x = pcx2

			aBP[bp].y = pcy2

			bp = bp + 1



			i = i + 1

			j = j + 1

			i = i mod gPosNum

			j = j mod gPosNum

		loop while i <> 1

		PolyBezierTo( hMemDC, ByVal aBP, bp )

	next



	SelectObject( hMemDC, hOldPen )

	DeleteObject( hPen )



	'表画面へ転送

	BitBlt( hDC, 0,0, gRect.right,gRect.bottom, hMemDC, 0,0, SRCCOPY )

End Sub



'終了判定

Sub MainWnd_KeyUp(KeyCode As Long, flags As Long)

	if gChildView = 0 then

		PostQuitMessage( 0 )

	endif

End Sub



Sub MainWnd_MouseMove( flags As Long, x As Integer, y As Integer )

	if gChildView = 0 then

		gCheckMouseMove = gCheckMouseMove + 1

		if gCheckMouseMove > 4 then	PostQuitMessage( 0 )

	endif

End Sub

次へ