Soft Taprix

HSP研究室

目次

以下のソースコードの著作権

CC0
To the extent possible under law, PG_MANA with this work has waived all copyright and related or neighboring rights to this work.

hsp.htmlに存在するソースコードはすべて、CC0においてライセンスされています。簡単に言えば「どうぞ勝手に自己責任で使ってください。」という意味です。

備考

なお以下のコードは HSP 3.4での動作を確認しております。

HSPで最大化・最小化制御

最大化ボタンが押されたらbgscrにするなど、最大化・最小化を感知するプログラム。

2014/05/19:return TRUE を使い、改正

/*
 * *最大化の時bgscrにする&最小化の後すぐ復帰する*
 * **変数**
 *   default_x = 初期のウィンドウ位置
 *   default_y = 初期のウィンドウ位置
 *   buffer = oncmdで飛ばされた先で作業するとおかしくなるので記憶用(そのため、起動処理が終わってstopsに入るようにする)
 *
 */
#include    "user32.as"
#define     WM_SIZE     0x0005
#define     TRUE        1
#define     FALSE       0

default_x = ginfo(4)
default_y = ginfo(5)

screen 0, ginfo_dispx, ginfo_dispy, 0, default_x, default_y, 640, 480//サイズ変更用
oncmd gosub *size, WM_SIZE
title "通常"

GetWindowLong hwnd, -16
SetWindowLong hwnd, -16, stat | $10000 | $40000

*stop_loop
            stop
            goto *stop_loop//誤動作防止用

*change_size
            if wparam = 1 {
            	sendmsg hwnd, $112, $F120//最小化復帰
            	title "最小化"
                return TRUE
            }
            if wparam = 2 {
            	bgscr 0, ginfo_dispx, ginfo_dispy, 0, 0, 0
            	gsel 0
            	title "最大化"
            	pos 0,0
            	button "戻す", *restore
            	return TRUE
            }
            if wparam = 0 {
	            color 255, 255, 255
            	boxf
            	title "" + ginfo_sizex + "x" + ginfo_sizey
            	return TRUE
            }
            return FALSE

*restore
            screen 0, ginfo_dispx, ginfo_dispy, 0, default_x, default_y, 640, 480//↑
            GetWindowLong hwnd, -16
            SetWindowLong hwnd, -16, stat | $10000 | $40000
            goto *stop_loop

HSPでモーダルダイアログを複数出す

タイマー割り込みを使用してます。

/*
 * *ある意味危険なプログラム*
 * 50回表示すると停止します。OKを押して、ダイアログを閉じてください。
 *
 */
#include    "user32.as"
#define     WM_TIMER    0x0113
#define     ID          1

oncmd gosub *timer, WM_TIMER
counter = 51//最初に一引くので
title "Multi Dialog"

SetTimer hwnd, ID, 1000, 0

stop

*Timer
	if counter > 0 {
		counter--
		dialog "タイマー割り込みです。\nモーダルダイアログです。\n残り"+endcnt+"回で停止します。"
	} else {
		KillTimer hwnd, TIMER_ID
		end //全部ダイアログを閉じると,動作する。
	}
	return

パレットカラー

OSを作って思ったんですが、パレットカラーは、あらかじめ使う色を指定するのでしょう。実用性はないかな…

screen 0, 255, 480, 1//パレットカラー設定
title "パレットカラー"

//パレット設定
repeat 255
palette cnt, 0, cnt, 0, 0//緑のグラデーション
wait 1
loop
palette -1, 0, 0, 0, 1//画面上に反映
repeat 255
palcolor cnt
boxf cnt, 0, cnt+10, 480
wait 1
loop
stop

線織面

参考までに...

#define WINDOW_SIZE 700
#define LINE_SIZE 10
#define NUM_REPEAT WINDOW_SIZE / LINE_SIZE

screen 0, WINDOW_SIZE, WINDOW_SIZE, 0, 0
title "線織面"
color 0, 0, 0
boxf

repeat NUM_REPEAT
color 0, cnt * 2, 0
line 0, cnt * LINE_SIZE, cnt * LINE_SIZE, WINDOW_SIZE
loop

FIFOモジュール

HSOでFIFOモジュール作った。

/*
 * *FIFO.asとして保存してください*
 *
 */

#module //FIFO_init,FIFO_enqueueは命令形式

    #define global FIFO_init(%1, %2) dim %1, 4:%1(0) = %2 //0:size, 1:rnext, 2:wnext, 3:stock

	#deffunc FIFO_enqueue array FIFO_buf, array FIFO_buf_info, int FIFO_data
		FIFO_buf(FIFO_buf_info(2)) = FIFO_data
		if FIFO_buf_info(2) = (FIFO_buf_info(0) - 1) {
			FIFO_buf_info(2) = 0
		} else {
			FIFO_buf_info(2)++
		}
		FIFO_buf_info(3)++
		return

	#defcfunc FIFO_dequeue array FIFO_buf, array FIFO_buf_info
		if FIFO_buf_info(3) = 0 {
			return 0
		}
		FIFO_buf_info(3)--
		data = FIFO_buf(FIFO_buf_info(1))
		if FIFO_buf_info(1) = (FIFO_buf_info(0) - 1) {
			FIFO_buf_info(1) = 0
		} else {
			FIFO_buf_info(1)++
		}
		return data
		//return FIFO_buf(FIFO_buf_info(1)-1)[0だったら...?演算子でも...]

	#defcfunc FIFO_empty array FIFO_buf_info//まあ一応0,1で返す
		if FIFO_buf_info(3) =0 {
            return 0
        }
		return 1

	#defcfunc FIFO_stock array FIFO_buf_info
		return FIFO_buf_info(3)
#global

Windows10を含めたOSをHSPで判定する方法

Windows10では、ややこしいことにマニフェストファイルにWin10対応宣言してないとsysinfoでもWindows 8のバージョンしか返しません。マニフェストファイル書き換えるめんどいし...

最初はIsWindowsVersionOrGreaterを実装しようとしてましたが、64bit関係をいじろうとして、失敗しました...

ということでレジストリを覗くことにしました。と言ってもほとんどレジストリ関係の処理で、ほかのところから拝借しました。

/*
 * *Windows10対応のWindows名取得*
 * **関数**
 *  GetWindowsName()
 *      Windows **の文字列を返します。
 *      これは互換性のオプションに左右されます。
 *
 *  GetWindowsEditionName()
 *      エディションを含めた文字を返します。
 *      (XPの場合Microsoftが先頭に入ります。)
 *
 *  なたでさんのレジストリ操作モジュールを使用させてもらいました。ありがとうございます。
 *      http://www.placeark.com/program_hsp_sample.html
 *
 */

#ifndef _GetWindowsVer_
#define _GetWindowsVer_
#module

/*ここから*/
#uselib "ADVAPI32.DLL"
#cfunc RegCloseKey "RegCloseKey" sptr
#cfunc RegOpenKeyExA "RegOpenKeyExA" sptr,sptr,sptr,sptr,sptr
#cfunc RegQueryValueExA "RegQueryValueExA" sptr,sptr,sptr,sptr,sptr,sptr
#cfunc RegCreateKeyExA "RegCreateKeyExA" sptr,sptr,sptr,sptr,sptr,sptr,sptr,sptr,sptr
#cfunc RegSetValueExA "RegSetValueExA" sptr,sptr,sptr,sptr,sptr,sptr
#cfunc RegDeleteValueA "RegDeleteValueA" sptr,sptr
#cfunc RegQueryInfoKeyA "RegQueryInfoKeyA" sptr,sptr,sptr,sptr,sptr,sptr,sptr,sptr,sptr,sptr,sptr,sptr
#cfunc RegEnumKeyExA "RegEnumKeyExA" sptr,sptr,sptr,sptr,sptr,sptr,sptr,sptr
#cfunc RegEnumValueA "RegEnumValueA" sptr,sptr,sptr,sptr,sptr,sptr,sptr,sptr
#uselib "shlwapi.dll"
#cfunc SHDeleteKeyA "SHDeleteKeyA" sptr,sptr
#define NULL					0x00000000
#define ERROR_SUCCESS			0x00000000
#define REG_NONE				0x00000000
#define REG_SZ					0x00000001
#define REG_BINARY				0x00000003
#define REG_DWORD				0x00000004
#define KEY_READ				0x00020019
#define KEY_ALL_ACCESS			0x000F003F
#define HKEY_CLASSES_ROOT		0x80000000
#define HKEY_CURRENT_USER		0x80000001
#define HKEY_LOCAL_MACHINE		0x80000002
#define HKEY_USERS				0x80000003
#define HKEY_CURRENT_CONFIG		0x80000005
#define REG_OPTION_NON_VOLATILE 0x00000000
#define HKEY_CLASSES_ROOT_STR	"HKEY_CLASSES_ROOT"
#define HKEY_CURRENT_USER_STR	"HKEY_CURRENT_USER"
#define HKEY_LOCAL_MACHINE_STR	"HKEY_LOCAL_MACHINE"
#define HKEY_USERS_STR			"HKEY_USERS"
#define HKEY_CURRENT_CONFIG_STR	"HKEY_CURRENT_CONFIG"
#define ERROR_NO_MORE_ITEMS		259
/**
	キー名から定義済みキーを返す
	@param	key	キー名
	@return	定義済みキーの定数,0で失敗
*/
#defcfunc getHKeyByKey str key,local h
	h = key
	getstr h,h,0,'\\'
	if(h==HKEY_CLASSES_ROOT_STR) {
		return(HKEY_CLASSES_ROOT)
	}else:if(h==HKEY_CURRENT_USER_STR) {
		return(HKEY_CURRENT_USER)
	}else:if(h==HKEY_LOCAL_MACHINE_STR) {
		return(HKEY_LOCAL_MACHINE)
	}else:if(h==HKEY_USERS_STR) {
		return(HKEY_USERS)
	}else:if(h==HKEY_CURRENT_CONFIG_STR) {
		return(HKEY_CURRENT_CONFIG)
	}else{
		return(0)
	}
/**
	キー名から値の名前を返す
	@param	key	キー名
	@return	値の名前,0文字で失敗
*/
#defcfunc getValueNameByKey str key,local h,local c
	h = key
	c = instr(h,0,"\\")
	h = strmid(h,-1,strlen(h)-c-1)
	c = 0
	repeat(strlen(h))
		if(peek(h,strlen(h)-cnt-1)=='\\') {
			c = cnt
			break
		}
	loop
	if(c==0) {
		return ""
	}
	h = strmid(h,-1,c)
	return h
/**
	キー名からサブキーを返す
	@param	key	キー名
	@return	サブキー,0文字で失敗
*/
#defcfunc getSubKeyByKey str key,local h,local c
	h = key
	c = instr(h,0,"\\")
	h = strmid(h,-1,strlen(h)-c-1)
	if(peek(h,strlen(h)-1)=='\\') {
		return strmid(h,0,strlen(h)-1)
	}
	repeat(strlen(h))
		if(peek(h,strlen(h)-cnt-1)=='\\') {
			c = cnt
			break
		}
	loop
	if(c==0) {
		return h
	}
	h = strmid(h,0,strlen(h)-c-1)
	return h
/**
	サブキー及び、キーの値が存在するか調べる
	@param	key キー名
	@return	1で成功,0で失敗
*/
#defcfunc isRegistry str key,local hkey,local subkey,local valuename,local handle,local flag,local size,local data
	hkey		= getHKeyByKey(key)
	subkey		= getSubKeyByKey(key)
	valuename	= getValueNameByKey(key)
	if((hkey==0)||(subkey=="")) {
		return 0
	}
	handle = 0
	flag = RegOpenKeyExA(hkey,varptr(subkey),0,KEY_READ,varptr(handle))
	if(flag!=ERROR_SUCCESS) {
		return 0
	}
	//キーの値を調べる
	if(valuename!="") {
		size = 0
		flag = RegQueryInfoKeyA(handle,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,varptr(size),NULL,NULL)
		sdim data,size
		flag = RegQueryValueExA(handle,varptr(valuename),0,NULL,varptr(data),varptr(size))
	}
	else {
		flag = ERROR_SUCCESS
	}
	size = RegCloseKey(handle)
	if(flag!=ERROR_SUCCESS) {
		return 0
	}else {
		return 1
	}
/**
	サブキーの中のサブキーの数を取得します
	@param	key キー名
	@return	1で成功,0で失敗
*/
#defcfunc getSubKeysRegistry str key,local hkey,local subkey,local valuename,local handle,local flag,local size
	hkey		= getHKeyByKey(key)
	subkey		= getSubKeyByKey(key)
	if((hkey==0)||(subkey=="")) {
		return 0
	}
	handle = 0
	flag = RegOpenKeyExA(hkey,varptr(subkey),0,KEY_READ,varptr(handle))
	if(flag!=ERROR_SUCCESS) {
		return 0
	}
	size = 0
	flag = RegQueryInfoKeyA(handle,NULL,NULL,NULL,varptr(size),NULL,NULL,NULL,NULL,NULL,NULL,NULL)
	flag = RegCloseKey(handle)
	return size
/**
	サブキーの中のキーが持つデータの長さで最長の長さを取得します
	@param	key キー名
	@return	最長の長さ
*/
#defcfunc getMaxDataSizeRegistry str key,local hkey,local subkey,local valuename,local handle,local flag,local size
	if(isRegistry(key)==0) {
		return 0
	}
	hkey		= getHKeyByKey(key)
	subkey		= getSubKeyByKey(key)
	valuename	= getValueNameByKey(key)
	handle = 0
	size   = 0
	flag = RegOpenKeyExA(hkey,varptr(subkey),0,KEY_READ,varptr(handle))
	flag = RegQueryInfoKeyA(handle,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,varptr(size),NULL,NULL)
	flag = RegCloseKey(handle)
	return(size)
/**
	文字列をキーから取得します
	@param	key キー名
	@return	文字列
*/
#defcfunc getStringRegistry str key,local hkey,local subkey,local valuename,local handle,local flag,local size,local out
	hkey		= getHKeyByKey(key)
	subkey		= getSubKeyByKey(key)
	valuename	= getValueNameByKey(key)
	handle = 0
	flag = RegOpenKeyExA(hkey,varptr(subkey),0,KEY_READ,varptr(handle))
	size = getMaxDataSizeRegistry(key)
	sdim out,size
	flag = RegQueryValueExA(handle,varptr(valuename),0,NULL,varptr(out),varptr(size))
	flag = RegCloseKey(handle)
	return(out)

/*ここまで*/

/*ここからが本番*/
#defcfunc GetWindowsName
    name = getStringRegistry("HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\ProductName")
    if name = "" { //Win9x系
	       name = getStringRegistry("HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\ProductName")
       }

       //恐らく(すべて確認はしてないため)Windows(スペース)10とか8とか(スペース)エディションとなる。
       //追記:XPはMicrosoftが入る
       start = 0 //切り取り開始位置
       if strmid(name, 0, 1) = "M" {
           space = instr(name, 16, " ")
           if space = -1 {
               return name//対象外
           }
           return strmid(name, 10, space + 16)
       } else {
           space = instr(name, 8, " ")
           if space = -1 {
               return name//対象外
           }
           return strmid(name, 0, space + 8)
       }

#defcfunc GetWindowsEditionName
    name = getStringRegistry("HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\ProductName")
    if name = "" { //Win9x系
	       name = getStringRegistry("HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\ProductName")
    }
    return name
#global
#endif

HSPでモジュールなしでコンソールをいじる

そのままですね。AllocConsoleを使用しています。このプログラムはGUIウィンドウを動かしたとき座標をコンソール(コマンドプロンプト)に表示しています。

GUIウィンドウを消してCUIウィンドウだけにしたい場合は gsel 0,-1でもすればよいでしょう。ちなみにCUIウィンドウの閉じるボタンを押した場合 onexitを通さずそのまま終了するのでご注意。

#uselib "KERNEL32.DLL"
#cfunc AllocConsole "AllocConsole"
#cfunc GetStdHandle "GetStdHandle" int
#cfunc WriteFile "WriteFile" int, str, int, var, nullptr

onexit *close_window
oncmd gosub *move_window,3

result = AllocConsole()
if result = 0 {
    mes "失敗"
    stop
}
handle = GetStdHandle(-11)
if handle = -1 {
    mes "失敗"
    stop
}

lp_number_of_bytes_written = 0 //わざとスネークケースにした
string = "こんにちは\n"
result = WriteFile(handle, string, strlen(string), lp_number_of_bytes_written)
if result = 0{
    mes "失敗"
    stop
}
mes "123"
stop

*close_window
	gsel 0, -1
	string = "消えると思ったか!!\n"
	result = WriteFile(handle, string, strlen(string), lp_number_of_bytes_written)
	stop

*move_window
	string = strf("X:%d Y:%d\n",lParam & $FFFF, (lParam >> 16) & $FFFF)
	result = WriteFile(handle, string, strlen(string), lp_number_of_bytes_written)
	return

Info

Soft.Taprix.org
Taprix.org