HOME → 情報 → ActiveBasic

■　ActiveBasic サンプルプログラム

「ヨウコのリバーシ」の開発言語ActiveBasic
昔ながらのN88BASICモードがあって、当時(1980年代)、BASICでプログラムを組んでいた私としては、そのままのコーディングが出来て便利です。

しかし、画像を画面に表示させたり音を鳴らしたりするのは、WindowsAPIを使用しなければならず結構敷居が高かったりします。

特に画像ファイルの取り扱いは難解でした。そんな悩みを一気に解決してくれたのが、淡幻星さんのライブラリです　→　AB淡幻ライブラリ
このライブラリにはサンプルプログラムも入っていてとても分かり易いです。
（N88BASICモードにてbmpファイル表示に不具合があった為、AB淡幻ライブラリ作者の淡幻星さんより、ご教授いただいきN88BASICスペシャル版(?)AB淡幻ライブラリとして利用しています）


さて、「ヨウコのリバーシ」を作成する上で、悩んだのは以下の通りです。

・画像ファイルの取り扱い  →  AB淡幻ライブラリで解決
・ウィンドウサイズやタイトルの設定
・マウス情報の取得
・タイマー情報の取得
・テキストファイルデータの高速読取
・音声ファイル(wav、mp3）の再生
・キーボード情報の読取 → 後にマウス操作になったため使用していません
・アイコンの設定

これらの事は、昔ながら（？）のプログラマーにとっては難しいのではないでしょうか？

汚いサンプルプログラムですが、以下に記載しておきます。

サンプルプログラムのダウンロード　
（以下の内容と同じですが、画像や音声ファイル込みのセットです）

program01.pjを開く事で、プログラムの編集が出来ます。
実行ファイルはprogram01.exeです。
実行するとmp3ファイルが再生され、カーソルキーでキャラが移動しスピースキーで音を再生する簡単なプログラムです）
このキャラと音を使っちゃって大丈夫？？

なお、これはお手本と言う代物ではありません。きっと詳しい人が見たら「あんた、理解してないね！」なんて言うレベルだと思います。まぁ自分のメモみたいなものです。

#include "program01.idx"

' ↓ ここからプログラムが実行されます

#N88BASIC
#include <api_mmsys.sbp>
#include <api_commctrl.sbp> 'プロジェクトオプション「コモン コントロールを使用する」と同等処理
#include <api_winsock2.sbp> 'プロジェクトオプション「ソケットAPIを使用する」と同等処理
#include <WSLib7_AB_Distrbution.sbp>

'*************************************************************************************
'前準備

'ウィンドウの設定

 Dim style As DWord
 SetWindowText(_PromptSys_hWnd, "タイトル名")
 '小さいアイコンを変更
 SendMessage(_PromptSys_hWnd,WM_SETICON,ICON_SMALL,LoadIcon(GetModuleHandle(0),IDI_ICON2))
 style=GetWindowLong(_PromptSys_hWnd,GWL_STYLE)
 style=style And Not (WS_THICKFRAME Or WS_MINIMIZEBOX) '最小化無効
 style=style And Not (WS_THICKFRAME Or WS_MAXIMIZEBOX) '最大化無効
 SetWindowLong(_PromptSys_hWnd,GWL_STYLE,style)
 '画面サイズ 640*460
 SetWindowPos(_PromptSys_hWnd,HWND_TOP ,0,0,640,460,SWP_DRAWFRAME)
 SetWindowPos(_PromptSys_hWnd,0,0,0,0,0,SWP_FRAMECHANGED Or SWP_NOSIZE Or SWP_NOMOVE)

'---------------------------------
 Dim lp As WsEasyBmp
 Dim w As Long
 Dim h As Long
 Dim x As Long
 Dim y As Long
 Dim mop As MCI_OPEN_PARMS

'ビットマップファイルを使うときの準備

 Dim objPic As WsEasyPics
 objPic.SetCpuSleepLevel(-1)
 objPic.SetBasic() 'N88プロンプト（N88BASIC互換モード）を画像の入出力先に指定します。
 '画像ファイルを読み込みます。

 objPic.BloadPics( "bmp\chr01.bmp" ) 'ビットマップの読み込み
' objPic.PutBmp( X1, Y1, NULL)  '画面へ描く

'----------------------------------------------------------------------------------
'マウス ON MOUSE GOSUBみたいな感じ

 'マウスボタンの状態がMB1% MB2%に代入される (押すと1、離すと0)

 Dim CursorPos As POINTAPI
 Dim lpPrevWndProc As VoidPtr
 Function MouseProc(hWnd As HWND,dwMsg As DWord,wParam As WPARAM,lParam As LPARAM) As LRESULT
     Select Case dwMsg
         Case WM_MOUSEMOVE
         Case WM_LBUTTONDOWN
    MB1%=1
         Case WM_RBUTTONDOWN
    MB2%=1
         Case WM_LBUTTONUP
     MB1%=0
         Case WM_RBUTTONUP
     MB2%=0
         Case Else
            MouseProc=CallWindowProc(lpPrevWndProc,hWnd,dwMsg,wParam,lParam)
     End Select
 End Function

 lpPrevWndProc=SetWindowLong(_PromptSys_hWnd,GWL_WNDPROC,AddressOf(MouseProc)) 'ON MOUSE GOSUB *LABEL

 lp.SetBasic()

'キーボード
 Dim hThre As HANDLE
 Dim ID As *DWord
 Dim code As DWord
 
 'キーが押されていれば0以外、押されていなければ0を返す
 Function Inp(key As Long) As Long
     Inp = GetAsyncKeyState(key) and &H8000
 End Function

'前準備終了
'*************************************************************************************

'----------------------------------------------------------------------------------
'ここからローカル変数定義
 Dim MB1%  AS Integer
 Dim MB2%  AS Integer
 Dim MX%   AS Integer
 Dim MY%   AS Integer
 Dim dwStart  AS int64
 Dim dwEnd  AS int64
 Dim TIMECOUNT AS int64
 Dim A$    AS STRING
 Dim bmpwidh  AS Integer 'bmpファイルのドット横サイズの取得
 Dim bmpheight AS Integer 'bmpファイルのドット縦サイズの取得
 Dim X1   AS Integer 
 Dim Y1   AS Integer
 Dim cnt   AS Integer
 Dim filename(255) AS BYTE
 Dim Flag1  AS Byte
 Dim Flag2  AS Byte

'----------------------------------------------------------------------------------
'ここからプログラムを書く

 X1=100
 Y1=200
 lstrcpy(filename,"sound\start.mp3") 'mp3のファイル名をセット
 Playsound2()      'mp3ファイルの再生

*LOOP1
 GetMouse()
  If Inp(VK_SPACE) Then
   If Flag1=0 Then PlaySound("sound\zapper.wav",NULL,SND_FILENAME or SND_ASYNC):Flag1=1
   Else
   Flag1=0
  EndIf
  If Inp(VK_UP)    and Y1>-30   Then Y1=Y1-2' "→" 
  If Inp(VK_DOWN)  and Y1<400 Then Y1=Y1+2' "←" 
  If Inp(VK_LEFT)  and X1>0   Then X1=X1-2' "→" 
  If Inp(VK_RIGHT) and X1<600 Then X1=X1+2' "←"
 objPic.PutBmp( X1, Y1, NULL)
 Sleep(1)
 goto *LOOP1

'*************************************************************************************
'以下　サンプル例

'定義済のbmpファイルを画面へ描画
 objPic.PutBmp( X1, Y1, NULL)  '画面へ描く

'wavファイルを鳴らす
 PlaySound("ファイル名.wav",NULL,SND_FILENAME or SND_ASYNC)

'タイマーの取得

 dwStart= GetTickCount()  '測定開始
 dwEnd  = GetTickCount()  '測定終了
 TIMECOUNT=(dwEnd-dwStart)/1000 '

'----------------------------------------------------------------------------------
'bmpファイルのサイズ取得

 A$="sample.bmp"
 If( TRUE=objPic.BloadPics( A$ ) )Then
  bmpwidh  =objPic.GetWidth() 'bmpファイルのドット横サイズの取得
  bmpheight=objPic.GetHeight() 'bmpファイルのドット縦サイズの取得
 ENDIF

'----------------------------------------------------------------------------------
'byte変数へ文字列を定義

 lstrcpy(filename,"sound.mp3")

'*************************************************************************************
'以下サブプログラム

'----------------------------------------------------------------------------------
'マウスカーソルの取得

Sub GetMouse()
 GetCursorPos(CursorPos)
 ScreenToClient(_PromptSys_hWnd, CursorPos)
 MX%=CursorPos.x
 MY%=CursorPos.y
End Sub

'----------------------------------------------------------------------------------
'csvファイルの読取
'一旦ファイル全体をメモリに格納してから、変数に代入する。
'ファイル容量が大きい時のスピードアップ

Sub ReadDBFile()

 Dim ReadData    As BytePtr
 Dim FileSize    As DWord
 Dim hFile    As HANDLE
 Dim RBytes    As Long
 Dim ST(255) AS BYTE

 hFile=CreateFile("ファイル名",GENERIC_READ,0,ByVal 0,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0)
 FileSize=GetFileSize(hFile,NULL)
 ReadData=HeapAlloc(GetProcessHeap(),HEAP_ZERO_MEMORY,FileSize+1)
 ReadFile(hFile,ReadData,FileSize,VarPtr(RBytes),ByVal 0)
 CloseHandle(hFile)

 I=0 'ループ変数
 J=0 'ファイルが最後であるかのフラグ

 *LOOP 
 GOSUB *LINELOAD :NO=Val(ST)  ':PRINT NO;" "; 
 GOSUB *LINELOAD :HEN%(NO,0)=Val(ST) ':PRINT HEN%(NO,0);" ";
 '読み込みパーセント表示
 'y=x:x=Int(NO/全体の行数*100):IF x<>y and NO>0 THEN LOCATE 14,9:PRINT x;"%"
 IF J=0 THEN *LOOP  'ファイルが最後でなければループ
 GOTO *LOOP2  '終了

 *LINELOAD
  STC=0 '
 *LINE_1
  A=ReadData(I):IF A=0 THEN J=1:RETURN 'ファイルが最後ならJ=1
  ST(STC)=A
  I=I+1
  STC=STC+1
  IF A=44 THEN RETURN 'ｶﾝﾏ(,)ならばリターン
  IF A=13 THEN ST(STC)=0:I=I+1:RETURN '改行ならば バイト文字列STを完了させてリターン
  GOTO *LINE_1

 *LOOP2
  '終了
End Sub

' ----------------------------------ここまで----------------------------------
'↑先頭部分には、MCIデバイスのオープン情報のための構造体を用意します。

Sub Openfile()
 Dim ofn As OPENFILENAME
 Dim buffer[MAX_PATH-1] As Byte
 'ファイル名を取得
 ofn.lStructSize=76
 ofn.hwndOwner=_PromptSys_hWnd'hMainWnd
 ofn.lpstrFilter=Ex"音楽 ファイル(*.wav;*.mid;*.mp3)\0*.wav;*.mid;*.mp3\0すべてのファイル(*.*)\0*\0\0"
 ofn.nFilterIndex=1
 ofn.nMaxFile=MAX_PATH
 ofn.lpstrFile=buffer
 GetOpenFileName(ofn)

 'テキストボックスにパスを設定する
 'SetWindowText(GetDlgItem(hMainWnd,Static_Path),ofn.lpstrFile)
 'SetWindowText(GetDlgItem(_PromptSys_hWnd,Static_Path),ofn.lpstrFile)
 lstrcpy(filename,buffer)
End Sub
'↑OPENボタンがクリックされたときに呼び出されるイベントです。GetOpenFileName関数でファイル名を取得し、テキストボックス（Static_Path）にファイルパスを表示します。

Sub Playsound2()
 Dim bErr As Long
 Dim mpp As MCI_PLAY_PARMS
 Dim buffer[MAX_PATH-1] As Byte

 '再生中の場合は停止させる
 If mop.wDeviceID Then Playstop()

 'サウンド ファイルのパスを設定します。
 mop.lpstrElementName=buffer
 'GetWindowText(GetDlgItem(_PromptSys_hWnd,Static_Path),mop.lpstrElementName,260)
 'メッセージ通知のためのウィンドウを指定
 mop.lpstrElementName=filename
 mop.dwCallback=_PromptSys_hWnd

 'MCIデバイスをオープン
 bErr=mciSendCommand(0,MCI_OPEN,MCI_OPEN_ELEMENT,mop)
 If bErr Then
         MessageBox(_PromptSys_hWnd,"デバイスのオープンに失敗","error",MB_OK)
         Exit Sub
 End If

 '再生
 mpp.dwCallback=_PromptSys_hWnd
 bErr=mciSendCommand(mop.wDeviceID,MCI_PLAY,MCI_NOTIFY,mpp)
 If bErr Then
  MessageBox(_PromptSys_hWnd,"デバイスの再生に失敗","error",MB_OK)
  Exit Sub
 End If
End Sub
'↑PLAYボタンがクリックされたときに呼び出されるイベントです。MCI_OPENコマンドでMCIデバイスを開き、MCI_PLAYコマンドでデバイスを再生します。

Sub Playstop()
 Dim bErr As Long
 Dim dwCallback As DWord
 '停止
 bErr=mciSendCommand(mop.wDeviceID,MCI_STOP,MCI_WAIT,dwCallback)
 If bErr Then
  MessageBox(_PromptSys_hWnd,"デバイスの停止に失敗","error",MB_OK)
  Exit Sub
 End If

 'デバイスを閉じる
 mciSendCommand(mop.wDeviceID,MCI_CLOSE,MCI_WAIT,dwCallback)

 mop.wDeviceID=0
End Sub
'↑STOPボタンがクリックされたときに呼び出されるイベントです。MCI_STOPコマンドでデバイスを停止させ、MCI_CLOSEコマンドでデバイスをクローズしています。

Sub MainWnd_MciNotify(flags As Long, DevID As Long)
 Dim dwCallback As DWord

 If flags=MCI_NOTIFY_SUCCESSFUL Then
  'デバイスを閉じる
  mciSendCommand(DevID,MCI_CLOSE,MCI_WAIT,dwCallback)

  mop.wDeviceID=0
  MessageBox(_PromptSys_hWnd,"再生終了","Sound test",MB_OK)
 End If
End Sub
/*
↑MciNotifyは、再生が終了した場合などにMCIコマンドから送られるイベントです。RADツールの「イベント処理」ダイアログのMMSYSタブで表示されています。