HSP研究室
目次
- HSPで最大化・最小化制御
- HSPでモーダルダイアログを複数出す
- パレットカラー
- 線織面
- FIFOモジュール
- HSPでWindows10を含めたOS判定をする
- HSPでモジュールなしでコンソールをいじる
以下のソースコードの著作権
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での動作を確認しております。
- 2018/03/03:現在の自分の文法に合わせ改正
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_loopHSPでモーダルダイアログを複数出す
タイマー割り込みを使用してます。
/*
* *ある意味危険なプログラム*
* 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
loopFIFOモジュール
/*
* *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)
#globalWindows10を含めた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
#endifHSPでモジュールなしでコンソールをいじる
そのままですね。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