ActiveBasic4でスクリーンセーバーを作ります

適当なプロジェクトを作成
>新規作成
->プロジェクト(*.pj)
->EXE - ノーマル ウインドウ ベース

スクリーンセーバー用のウインドウは自分で作るので
>Materialタブ->Window
の
->MainWnd
を削除

>Fileタブ->プロジェクト名.abp
を開いて

#include "プロジェクト名.idx"



Const	WINDOW_CLASS_NAME = "アプリの名前"

Const	INI_NAME = "プロジェクト名.ini"



Dim	hDispWnd As DWord

Dim	gRect As RECT

Dim	gChildView As Integer 'プレビューかどうか



'デバッグ用

Dim	deb As Integer

deb = 0	'1:設定ウインドウを出さない



'関数の宣言

Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (

	pSAttr As Long, 

	fOwner As Long, 

	sMutexName As String

) As Long



Declare Function IsDialogMessage Lib "user32" (ByVal hWnd As Long, ByRef lpMsg As MSG) As Long



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

hDispWnd = 0



'二重起動チェック

CreateMutex( 0,0,WINDOW_CLASS_NAME )

If GetLastError()=183 Then

	'二重起動時の処理

	ExitProcess( 0 )

End If



'引数のチェック

Dim	aCCmd As Integer

aCCmd = CheckCmdLine()



'INIファイルから設定を読み込み

GetINIParameter( INI_NAME )



if deb = 0 then

	if aCCmd = 1 then

		'設定ウインドウを開いて終了

		Dim	hParent As DWord

		hParent = GetParent( hDispWnd )

		DialogBoxEx( hParent, "PropertyWnd" )

		SetINIParameter( INI_NAME )

		ExitProcess( 0 )

	endif

endif



'スクリーンセーバーウインドウを作成

Dim	hInstance As Dword

hInstance = GetModuleHandle(0)



Dim	aWndClass As WNDCLASSEX

ZeroMemory( VarPtr(aWndClass), Len(aWndClass) )

With aWndClass

	.cbSize = Len( aWndClass )

	.style = CS_VREDRAW Or CS_HREDRAW

	.lpfnWndProc = AddressOf( OwnerWndProc )

	.hInstance = hInstance

	.hIcon = LoadIcon( NULL, IDI_ICON1 )

	.hCursor = LoadCursor( NULL, IDC_ARROW )

	.hbrBackground = GetStockObject( LTGRAY_BRUSH )

	.lpszClassName = WINDOW_CLASS_NAME

	.hIconSm = LoadIcon( NULL, IDI_ICON1 )

End With

If RegisterClassEx( aWndClass ) = 0 Then ExitProcess( 0 )



Dim	aWndStyle As DWord

if hDispWnd <> 0 then

	'プレビュー画面の場合

	GetWindowRect( hDispWnd, gRect )

	aWndStyle = WS_CHILD or WS_VISIBLE or SS_LEFT

	ShowCursor( TRUE )

	gChildView = 1

else

	'フル画面にリサイズする

	gRect.left = 0

	gRect.top = 0

	gRect.right = GetSystemMetrics(SM_CXSCREEN)

	gRect.bottom = GetSystemMetrics(SM_CYSCREEN)

	aWndStyle = WS_VISIBLE or WS_POPUP

	ShowCursor( FALSE )

	gChildView = 0

EndIf



With gRect

	.right = .right - .left

	.bottom = .bottom - .top

	.left = 0

	.top = 0

End With



Dim	hMainWnd As Dword

hMainWnd = CreateWindowEx(

	WS_EX_TOPMOST,

	WINDOW_CLASS_NAME,

	"lines saver",

	aWndStyle,

	gRect.left,

	gRect.top,

	gRect.right,

	gRect.bottom,

	hDispWnd,

	NULL,

	hInstance,

	NULL

)

If hMainWnd = NULL Then ExitProcess( 0 )



ShowWindow( hMainWnd, SW_SHOW )

UpdateWindow( hMainWnd )



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

'  Window Message Loop

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

Dim	lpMsg As MSG

Dim	nGetMsg As Long

Do

	nGetMsg = GetMessage( lpMsg, NULL, 0, 0 )

	If ( nGetMsg = 0 ) Or ( nGetMsg = -1 ) Then Exit Do

	TranslateMessage( lpMsg )

	DispatchMessage( lpMsg )

Loop

ExitProcess( 0 )



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

' ウィンドウプロシージャ

Function OwnerWndProc( hWnd As Dword, Msg As Dword, wParam As Dword, lParam As Dword ) As Long

	Select Case ( Msg )

		Case WM_DESTROY

			MainWnd_Destroy()

		Case WM_CREATE

			hMainWnd=hWnd

			MainWnd_Create(ByVal lParam)

		Case WM_TIMER

			MainWnd_Timer(wParam)

		Case WM_PAINT

			Dim ps As PAINTSTRUCT

			Dim hDC As DWord

			hDC=BeginPaint(hWnd,ps)

			MainWnd_Paint(hDC)

			EndPaint(hWnd,ps)

		Case WM_KEYUP

			MainWnd_KeyUp(wParam,lParam)

		Case WM_MOUSEMOVE

			MainWnd_MouseMove(wParam,LOWORD(lParam),HIWORD(lParam))

		Case Else

			OwnerWndProc = DefWindowProc( hWnd, Msg, wParam, lParam )

			Exit Function

	End Select

	OwnerWndProc = 0

End Function



'RADツールが作ったもの(Callback.wbp)をコピーしてきて編集

Function DialogBoxEx(hOwnerWnd As DWord, TemplateName As String) As Long

	Select Case TemplateName

		Case "PropertyWnd"

			'親の位置を取得

			Dim aRect As RECT

			GetWindowRect( hDispWnd, aRect )



			hPropertyWnd=CreateWindowEx(&H00000000,"NORMALDLG","設定",&H90c80000,aRect.left,aRect.top,355,332,hOwnerWnd,0,GetModuleHandle(0),0)

			SetWindowLong(hPropertyWnd,GWL_WNDPROC,AddressOf(PropertyWndProc))

			SendMessage(hPropertyWnd,WM_INITDIALOG,0,0)

			SendMessage(hPropertyWnd,WM_SETICON,ICON_SMALL,LoadIcon(GetModuleHandle(0),IDI_ICON1))

			ShowWindow(hPropertyWnd,SW_SHOW)

		Case Else

			Exit Function

	End Select

	EnableWindow(hOwnerWnd,0)

	Dim msg As MSG, iResult As Long

	Do

		iResult=GetMessage(msg,0,0,0)

		If iResult=0 or iResult=-1 Then Exit Do

		If IsDialogMessage(hPropertyWnd, msg) Then Continue 'Tabキーを使えるようにする

		TranslateMessage(msg)

		DispatchMessage(msg)

	Loop

	DialogBoxEx=msg.wParam

End Function



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

'コマンドライン解析

Function CheckCmdLine() As Integer

	Dim	aCmdLine As String

	Dim	aCmd As String

	Dim	aCmdLen As Integer

	Dim	i As Integer

	Dim	ahit As Integer

	Dim	aProperty As Integer



	aCmdLine = GetCommandLine()

	aCmdLen = Len( aCmdLine )



	'オプションがついているか探す

	ahit = 0

	for i = 1 to aCmdLen

		if Mid$( aCmdLine, i, 1 ) = "/" then

			aCmdLine = Right$( aCmdLine, aCmdLen - i+1 )

			ahit = 1

			Exit For

		EndIf

	next



	aProperty = 1

	aCmdLine = aCmdLine + " "



	if ahit <> 0 then

		Dim	aType As Integer

		aCmd = ""

		aType = 0

		for i = 1 to aCmdLen

			if Mid$( aCmdLine, i, 1 ) = " " then

				aProperty = 0

				if aType = 1 then

					hDispWnd = Val( aCmd )

				endif

				if Left$( aCmd, 3 ) = "/c:" or Left$( aCmd, 3 ) = "/C:" then

					aProperty = 1

					aCmd = Right$( aCmd, Len(aCmd) - 3 )

					hDispWnd = Val( aCmd )

				endif



				aCmd = Left$( aCmd, 2 )

				if aCmd = "/p" or aCmd = "/P" then aType = 1

				aCmd = ""

			Else

				aCmd = aCmd + Mid$( aCmdLine, i, 1 )

			EndIf

		next

	endif



	CheckCmdLine = 0

	if aProperty = 1 then CheckCmdLine = 1

End Function

スクリーンセーバーが起動されるときの引数は、
/c:呼び出したウインドウのハンドル
/p プレビューを表示するハンドル

scrファイルの右クリックから構成を選んだときは引数がありません。
ので、引数がないときは設定ウインドウを開きます。
デバッグの実行時も引数がないので、debを1にして。

'RADツールが作ったものをコピーしてきて編集
Function DialogBoxEx
は、設定ウインドウでTabキーの移動を利用するためと、ウインドウが表示される位置を指定するため、Callback.wbpからコピーして編集しました。

次へ