HSPに投稿されたコード一覧

HSP 【HSP3】F10/Altキー、メニュー表示時、タイトルのクリック・ドラッグ時の検出

#define WM_NCLBUTTONDOWN 0x00A1
#define WM_NCLBUTTONUP 0x00A2
#define WM_MOVING 0x0216
#define WM_EXITSIZEMOVE 0x0232
#define WM_SYSKEYDOWN 0x104
#define WM_SYSKEYUP 0x105
#define WM_NCACTIVATE 0x0086
#define WM_INITMENU 0x0116
#define WM_EXITMENULOOP 0x0212
#define WM_NCMOUSELEAVE 0x02A2
#define WM_NCMOUSEMOVE 0x00A0
#define WM_NCRBUTTONDOWN 0x00A4
#define WM_INITMENUPOPUP 0x0117

#define MF_SYSMENU 0x00002000

#define ctype HIWORD(%1) (%1 >> 16 & $FFFF)

oncmd gosub *onNCLBUTTONDOWN, WM_NCLBUTTONDOWN
oncmd gosub *onNCRBUTTONDOWN, WM_NCRBUTTONDOWN
oncmd gosub *onMOVING, WM_MOVING
oncmd gosub *onNCMOUSELEAVE, WM_NCMOUSELEAVE
oncmd gosub *onNCMOUSEMOVE, WM_NCMOUSEMOVE

oncmd gosub *onINITMENU, WM_INITMENU
oncmd gosub *onINITMENUPOPUP, WM_INITMENUPOPUP
oncmd gosub *onEXITMENULOOP, WM_EXITMENULOOP

s = "通常", "ポーズ中(マウスによる)", "ポーズ中(メニューによる)"
repeat

	pos 0, 0 : color 255, 255, 255 : boxf : color

	mes cnt
	gosub *update

	wait 12
loop

stop

*update
	title s(pause)
return

// メニューが表示されたときに飛んでくる
*onINITMENU
	pause = 2
	gosub *update
return

// ポップアップメニューが表示されたときに飛んでくる
*onINITMENUPOPUP
	// システムメニューかどうか?
	if HIWORD(wparam) && MF_SYSMENU{
		pause = 2
		gosub *update
	}
return

// メニューが閉じられた時に飛んでくる
*onEXITMENULOOP
	pause = 0
	gosub *update
return

// 非クライアント領域(タイトルバー)が左クリックで押されたとき
*onNCLBUTTONDOWN
	if pause != 2{
		pause = 1
		gosub *update
	}
return

// 非クライアント領域(タイトルバー)が右クリックで押されたとき
*onNCRBUTTONDOWN
	if pause != 2{
		pause = 1
		gosub *update
	}
return

// ウィンドウが移動中の時(WM_MOVEだと移動中は飛んでこない?)
*onMOVING
	if pause != 2{
		pause = 1
		gosub *update
	}
return

// 非クライアント領域(タイトルバー)のクリックが離されたとき
*onNCMOUSELEAVE
	if pause != 2{
		pause = 0
		gosub *update
	}
return

// 非クライアント領域(タイトルバー)上でマウスが移動したとき
*onNCMOUSEMOVE
	if pause != 2{
		pause = 0
		gosub *update
	}
return

HSP 【HSP3】Media Foundationを使用しての動画再生(修正)

#define IID_IMFPMediaPlayer "{A714590A-58AF-430a-85BF-44F5EC838D85}"
#usecom IMFPMediaPlayer IID_IMFPMediaPlayer "{}"
#comfunc IMFPMediaPlayer_Play 3
#comfunc IMFPMediaPlayer_Pause 4
#comfunc IMFPMediaPlayer_Stop 5
#comfunc IMFPMediaPlayer_FrameStep 6
#comfunc IMFPMediaPlayer_SetRate 10 float
#comfunc IMFPMediaPlayer_Shutdown 38
newcom iMFPlayer,IMFPMediaPlayer
#uselib "Mfplay"
#func MFPCreateMediaPlayer "MFPCreateMediaPlayer" wstr,int,int,int,int,var
#uselib "Mfplat"
#func MFStartup "MFStartup" int,int
#func MFShutdown "MFShutdown"
#define MFSTARTUP_NOSOCKET 0x1
#define MFSTARTUP_LITE (MFSTARTUP_NOSOCKET)
#define MFSTARTUP_FULL 0

	screen 0,800,800
	title "Media Foundation (1.3倍速再生サンプル)"
	LOADED=0
	onexit *lEnd
	objsize 100,24
	pos ginfo_winx-500,0
	button gosub "Load",*lFileLoad
	pos ginfo_winx-400,0
	button gosub "Play",*lPlay
	pos ginfo_winx-300,0
	button gosub "Pause",*lPause
	pos ginfo_winx-200,0
	button gosub "Stop",*lStop
	pos ginfo_winx-100,0
	button gosub "Step",*lStep
	gosub *lFileLoad
	stop
*lFileLoad
	dialog "mp4;*.avi;*.mpg;*.mpeg",16
	if stat=0{
		if LOADED{
			return
		}else{
			stop
		}
	}
	file=refstr
	gosub *lLoad
	IMFPMediaPlayer_SetRate iMFPlayer,1.3	;1.3倍速再生
	return
*lLoad
	if LOADED{
		gosub *lRelease
	}
	MFStartup
	MFPCreateMediaPlayer file, 1,0,0,hwnd,iMFPlayer
	;                         ↑0にすると自動再生しない
	LOADED=1
	return
*lRelease
	gosub *lStop
	IMFPMediaPlayer_Shutdown iMFPlayer
	MFShutdown
	return
*lPlay
	if LOADED : IMFPMediaPlayer_Play iMFPlayer
	return
*lPause
	if LOADED : IMFPMediaPlayer_Pause iMFPlayer
	return
*lStop
	if LOADED : IMFPMediaPlayer_Stop iMFPlayer
	return
*lStep
	if LOADED : IMFPMediaPlayer_FrameStep iMFPlayer
	return
*lEnd
	if LOADED{
		gosub *lRelease
	}
	mes "MFShutdown:"+stat
	end

HSP 【HSP3】ファイルがロックされているかチェック

// http://support.microsoft.com/kb/172240/ja
#include "kernel32.as"

#module
#define OF_READ 0
#define OF_SHARE_EXCLUSIVE 16
#define HFILE_ERROR (-1)
#define ERROR_SHARING_VIOLATION 32
#defcfunc IsFileAlreadyOpen str p1
	_lopen p1, OF_READ | OF_SHARE_EXCLUSIVE
	theFile = stat
	if theFile == -1{
		GetLastError
		lastErr = stat
	}else{
		_lclose theFile
	}
return ((theFile == HFILE_ERROR) && (lastErr == ERROR_SHARING_VIOLATION))
#global

	dialog "*",16
	if stat == 0 : end
	if IsFileAlreadyOpen(refstr){
		mes "オープン済みです"
	}else{
		mes "オープンされていません"
	}

HSP OBAQで「ニュートンのゆりかご」

;
;	OBAQ 「ニュートンのゆりかご」
;
;	スペースキーで動かし始める。
;	調整がうまく行っていないのか途中でバラバラになってしまいます。
;
#include "obaq.as"

;内積
#define global ctype DotProduct2D(%1,%2,%3,%4) (double(%1)*(%3) + double(%2)*(%4))

#module
;	振り子	pendulum
;	num      : オブジェクトID
;	x,y      : アンカー座標
;	distance : 距離
;	const_k  : バネ定数
;	damping  : 減衰
#deffunc qAttach int p_num, double p_x, double p_y, double p_distance, double p_const_k, double p_damping
	qgetreq@ rpr, REQ_PHYSICS_RATE	; 1フレームあたりの物理計算回数

	;	オブジェクトの状態を取得
	qgetpos@    p_num, hx1, hy1, hr1
	qgetspeed@  p_num, vx, vy, vr
	qgetweight@ p_num, weiht, mt

	;	オブジェクトからアンカーまでの距離ベクトル
	dx = p_x - hx1
	dy = p_y - hy1
	;cos	-(dx,dy)と(vx,vy)とがなす角のcos値
	dd = sqrt(dx*dx + dy*dy)
	vv = sqrt(vx*vx + vy*vy)
	if (dd=0.0) | (vv=0.0) {
		c = 1.0
	} else {
		c = DotProduct2D( vx, vy, -dx, -dy ) / vv / dd
	}
	;梁正規化
	ix = dx / dd
	iy = dy / dd

	;	減衰
	v = vv * c
	bvx = ix * -v
	bvy = iy * -v
	cvx = 0.0
	cvy = 0.0
	if bvx>0 {
		cvx = -p_damping
		if (bvx - p_damping)<0 : cvx = -bvx
	} else {
		if bvx<0 {
			cvx = p_damping
			if (bvx + p_damping)>0 : cvx = -bvx
		}
	}
	if bvy>0 {
		cvy = -p_damping
		if (bvy - p_damping)<0 : cvy = -bvy
	} else {
		if bvy<0 {
			cvy = p_damping
			if (bvy + p_damping)>0 : cvy = -bvy
		}
	}

	;	バネ
	;バネの伸び
	dl = sqrt(dx*dx + dy*dy) - p_distance
	; a = x * k / m
	vx = ix * dl * p_const_k / weiht
	vy = iy * dl * p_const_k / weiht
	vx *= rpr	;加速度を速度に置き換え
	vy *= rpr
	qspeed@ p_num, vx + cvx, vy + cvy, 0.0

	return

#global

	qreset			; OBAQの初期化

	;	オブジェクト配置
	dim myball, 5
	repeat 5
		qaddpoly myball(cnt), 100, 60.0+10.0*cnt, 60.0, 0, 5.0,5.0, 0
		qweight  myball(cnt), 6.0
		qdamper  myball(cnt), 0.0, 0.0
		qinertia myball(cnt), 1.0
		qtype    myball(cnt), 0x100
	loop

	;----------
	;	梁
	;----------
	; 硬いバネと大きな減衰で梁を表現します。

	; 梁長さ
	lg = 30.0

	; バネ定数
	; 値が小さいほどバネが柔らかく、よく伸びるようになります。
	;k = 0.01
	k = 0.4

	; 減衰
	; 値が大きいほど振動が速く収まります。
	;cv = 0.0001
	cv = 0.2

	;----------
	;	環境
	;----------
	qgravity 0, 0.005

;	メインループ
qgetpos mybox, px,py,pr
*main
	redraw 0		; 画面の更新を開始
	color 0,0,0:boxf	; 画面をクリア
	qexec			; OBAQによるオブジェクトの更新

	;	最初に動かす
	stick key
	if key&16 : qspeed myball(0), -0.5
	color 255,255,255
	pos 50,50
	mes "スペースキーを押してください。"

	;----------
	;	振り子
	;----------
	repeat 5
		qAttach myball(cnt), 60.0+10.0*cnt, 30.0, lg, k, cv
	loop

	;	紐を描画
	color 255,255,255
	repeat 5
		qgetpos myball(cnt), px,py,pa
		qcnvaxis lpx, lpy, px, py, 0
		x = 60.0+10.0*cnt
		y = 30.0
		qcnvaxis lx, ly, x, y, 0
		line lx, ly, lpx, lpy
	loop

	qdraw			; オブジェクトの描画
	redraw 1		; 画面の更新を終了
	await 12		; 一定時間待つ
	goto *main

HSP 【HSP3】HSPでWindows8のトースト通知(WinRTAPI使用)をしてみるサンプル(日本語対応版)

#include "user32.as"
#include "kernel32.as"
#include "shell32.as"
// HString
#module mHString
#uselib "msvcrt"
#func calloc "calloc" int, int
#func free "free" int
#uselib "api-ms-win-core-winrt-string-l1-1-0.dll"
#func WindowsCreateString "WindowsCreateString" wptr, int, sptr
#func WindowsDeleteString "WindowsDeleteString" wptr
// 文字列の長さ
#func WindowsGetStringLen "WindowsGetStringLen" sptr
// HSTRING_HEADERが返ってくるバージョンみたい?
#func WindowsCreateStringReference "WindowsCreateStringReference" wptr, int, sptr, sptr
#func WindowsGetStringRawBuffer "WindowsGetStringRawBuffer" sptr, sptr
#defcfunc Unicode2HString str as
/*
	sdim ws, strlen(as)*2 + 2
	cnvstow ws, as
//*/
	_as=as
	ws=""
	MultiByteToWideChar 0x00,0,varptr(_as),strlen(_as),varptr(ws),0:len=stat
	sdim ws,len*2
	MultiByteToWideChar 0x00,0,varptr(_as),strlen(_as),varptr(ws),len
	hString = 0
	WindowsCreateString varptr(ws), len, varptr(hString)
return hString
// 未使用のため
#defcfunc Unicode2HStringEx str as, var HSTRING_HEADER
	sdim ws, strlen(as)*2 + 2
	cnvstow ws, as
	hString = 0
	dim HSTRING_HEADER, 6
	WindowsCreateStringReference varptr(ws), strlen(as), varptr(HSTRING_HEADER), varptr(hString)
return hString
#deffunc DeleteHString int _hString
	WindowsDeleteString _hString
return stat
#defcfunc GetHStringLength int _hString
	WindowsGetStringLen _hString
return stat
#defcfunc HString2Unicode int _hString
	if _hString == 0 : return ""
	size = GetHStringLength(_hString) * 2
	if size <= 0 : return ""
	WindowsGetStringRawBuffer _hString, varptr(size)
	dupptr buf, stat, GetHStringLength(_hString) * 2, 2
return cnvwtos(buf)
#global
#module mCOMOBJMACRO
#define global ctype SUCCEEDED(%1) ((%1) >= 0)
#define global SafeRelease(%1) if ((varuse(%1)) && (vartype(%1) == 6)){ \
	delcom %1: \
	%1 = 0 \
}
#global
// ショートカット作成
#module mSHORTCUT
#uselib "Propsys"
#func InitPropVariantFromStringVector "InitPropVariantFromStringVector" wptr, int, sptr
#uselib "Ole32"
#func PropVariantClear "PropVariantClear" sptr
#define CLSID_ShellLink "{00021401-0000-0000-C000-000000000046}"
#define IID_IShellLink "{000214EE-0000-0000-C000-000000000046}"
#usecom IShellLink IID_IShellLink CLSID_ShellLink
#comfunc IShellLink_SetArguments 11 str
#comfunc IShellLink_SetIconLocation 17 str, int
#comfunc IShellLink_SetPath 20 str
#define IID_IPersistFile "{0000010b-0000-0000-C000-000000000046}"
#usecom IPersistFile IID_IPersistFile
#comfunc IPersistFile_Save 6 wstr, int
#define IID_IPropertyStore "{886d8eeb-8cf2-4446-8d02-cdba1dbdcf99}"
#define CLSID_PropertyStore "{e4796550-df61-448b-9193-13fc1341b163}"
#usecom IPropertyStore IID_IPropertyStore CLSID_PropertyStore
#comfunc IPropertyStore_SetValue 6 sptr, sptr
#comfunc IPropertyStore_Commit 7
#deffunc CreateShortcut str file_path, str arg, str icon_path, int icon_idx, str AppUserModelID, str out_path, \
	local pShellLink, \
	local pPropStore, \
	local wstring, \
	local wstrings, \
	local ppropvar, \
	local PKEY_AppUserModel_ID, \
	local hr

	hr = 0
	pShellLink = 0
	pPropStore = 0

	newcom pShellLink, IShellLink
	if varuse(pShellLink) == 0 : return -1

	IShellLink_SetPath pShellLink, file_path : hr = stat
	if SUCCEEDED(hr){
		IShellLink_SetArguments pShellLink, arg : hr = stat
		if SUCCEEDED(hr){
			IShellLink_SetIconLocation pShellLink, icon_path, icon_idx : hr = stat
			if SUCCEEDED(hr){
				querycom pPropStore, pShellLink, IPropertyStore
				if varuse(pPropStore){
					// Unicodeに変換
					sdim wstring, strlen(AppUserModelID) * 2 + 2
					cnvstow wstring, AppUserModelID
					// 配列なので(今回は1つしかないけど)
					wstrings = varptr(wstring)
					// PROPVARIANT 構造体
					dim ppropvar, 4
					// Unicode文字列→PROPVARIANT に変換
					InitPropVariantFromStringVector varptr(wstrings), 1/*今回は1つだけなので*/, varptr(ppropvar) : hr = stat
					if SUCCEEDED(hr){
						PKEY_AppUserModel_ID = 0x9F4C2855, 0x4B399F79, 0xD4E1D0A8, 0xF3D5E12D, 5
						IPropertyStore_SetValue pPropStore, varptr(PKEY_AppUserModel_ID), varptr(ppropvar) : hr = stat
						if SUCCEEDED(hr){
							IPropertyStore_Commit pPropStore : hr = stat
							if SUCCEEDED(hr){
								IPersistFile_Save pShellLink, out_path, 1 : hr = stat
							}
						}
						PropVariantClear varptr(ppropvar)
					}
				}
			}
		}
	}
	// SafeRelease
	SafeRelease pPropStore
	SafeRelease pShellLink
return hr
#global
// AppUserModel_IDを設定(任意のタイミングで変更可能)
#module mAPPIDS
#uselib "shell32"
#func SHGetPropertyStoreForWindow "SHGetPropertyStoreForWindow" sptr, sptr, sptr
#func GetCurrentProcessExplicitAppUserModelID "GetCurrentProcessExplicitAppUserModelID" wptr
#func SetCurrentProcessExplicitAppUserModelID "SetCurrentProcessExplicitAppUserModelID" wstr
#uselib "Propsys"
#func InitPropVariantFromString "InitPropVariantFromString" wstr, sptr
#func InitPropVariantFromStringVector "InitPropVariantFromStringVector" wptr, int, sptr
#func PropVariantToStringAlloc "PropVariantToStringAlloc" sptr, wptr
#uselib "Ole32"
#func PropVariantClear "PropVariantClear" sptr
#define IID_IPropertyStore "{886d8eeb-8cf2-4446-8d02-cdba1dbdcf99}"
#define CLSID_PropertyStore "{e4796550-df61-448b-9193-13fc1341b163}"
#usecom IPropertyStore IID_IPropertyStore CLSID_PropertyStore
#comfunc IPropertyStore_SetValue 6 sptr, sptr
#comfunc IPropertyStore_Commit 7
#deffunc SetAppUserModelID int _hwnd, str AppUserModelID, \
	local propStorePtr, \
	local IID_IPropertyStore_Array, \
	local pPropStore, \
	local wstring, \
	local wstrings, \
	local ppropvar, \
	local hr

	hr = 0
	pPropStore = 0
	propStorePtr = 0
	IID_IPropertyStore_Array = 0x886d8eeb, 0x44468cf2, 0xbacd028d, 0x99cfbd1d
	PKEY_AppUserModel_ID = 0x9F4C2855, 0x4B399F79, 0xD4E1D0A8, 0xF3D5E12D, 5

	SHGetPropertyStoreForWindow _hwnd, varptr(IID_IPropertyStore_Array), varptr(propStorePtr)
	if stat == 0 && propStorePtr != 0{
		newcom pPropStore, IPropertyStore, -1, propStorePtr
		if varuse(pPropStore){
			// Win7 では廃止されているらしい
			// propsys.dll 7.0
			/*
			mes varptr(InitPropVariantFromString)
			InitPropVariantFromString "net.hinekure.test.hsp3", varptr(ppropvar)
			*/

			// Unicodeに変換
			sdim wstring, strlen(AppUserModelID) * 2 + 2
			cnvstow wstring, AppUserModelID
			// 配列なので(今回は1つしかないけど)
			wstrings = varptr(wstring)

			// PROPVARIANT 構造体
			dim ppropvar, 4
			// Unicode文字列→PROPVARIANT に変換
			InitPropVariantFromStringVector varptr(wstrings), 1, varptr(ppropvar) : hr = stat
			if SUCCEEDED(hr){
				IPropertyStore_SetValue pPropStore, varptr(PKEY_AppUserModel_ID), varptr(ppropvar) : hr = stat
				if SUCCEEDED(hr){
					IPropertyStore_Commit pPropStore : hr = stat
				}
				PropVariantClear varptr(ppropvar)
			}
		}
	}

	// SafeRelease
	SafeRelease pPropStore

return hr
#global
#module mToast
#uselib "Combase.dll"
#func RoGetActivationFactory "RoGetActivationFactory" sptr, sptr, sptr
#func RoActivateInstance "RoActivateInstance" sptr, sptr
#func RoInitialize "RoInitialize" int
#func RoUninitialize "RoUninitialize"

#define IID_IToastNotificationManagerStatics "{50ac103f-d235-4598-bbef-98fe4d1a3ad4}"
#define CLSID_ToastNotificationManagerStatics "{6db7cd52-e3b7-4ecc-bb1f-388aeef6bb50}"
#usecom IToastNotificationManagerStatics IID_IToastNotificationManagerStatics CLSID_ToastNotificationManagerStatics
// WinRT は0~5まで使ってる
#comfunc IToastNotificationManagerStatics_CreateToastNotifier 6 sptr
#comfunc IToastNotificationManagerStatics_CreateToastNotifierWithId 7 sptr, sptr
#comfunc IToastNotificationManagerStatics_GetTemplateContent 8 int, sptr

;#define CLSID_XMLDocument "{CFC399AF-D876-11d0-9C10-00C04FC99C8E}"
;#define IID_IXMLDocument "{F52E2B61-18A1-11d1-B105-00805F49916B}"
#define CLSID_XMLDocument "{AF75D6AD-E307-4052-8CB1-BF2052E734F0}"
#define IID_IXMLDocument "{F7F3A506-1E87-42D6-BCFB-B8C809FA5494}"
#usecom IXMLDocument IID_IXMLDocument CLSID_XMLDocument
// WinRT は0~5まで使ってる
#comfunc IXMLDocument_CreateTextNode 11 sptr, sptr
#comfunc IXMLDocument_GetElementsByTagName 16 sptr, sptr

#define CLSID_XmlNodeList "{AF75D6AD-E307-4052-8CB1-BF2052E734F0}"
#define IID_IXmlNodeList "{8C60AD77-83A4-4EC1-9C54-7BA429E13DA6}"
#usecom IXmlNodeList IID_IXmlNodeList CLSID_XmlNodeList
// WinRT は0~5まで使ってる
#comfunc IXmlNodeList_get_Length 6 sptr
#comfunc IXmlNodeList_Item 7 int, sptr

#define CLSID_XmlNode "{AF75D6AD-E307-4052-8CB1-BF2052E734F0}"
#define IID_IXmlNode "{1C741D59-2122-47D5-A856-83F3D4214875}"
#usecom IXmlNode IID_IXmlNode CLSID_XmlNode
#comfunc IXmlNode_get_NodeValue 6 sptr
#comfunc IXmlNode_get_NodeType 8 sptr
#comfunc IXmlNode_AppendChild 22 sptr, sptr

#define CLSID_XmlText "{AF75D6AD-E307-4052-8CB1-BF2052E734F0}"
#define IID_IXmlText "{F931A4CB-308D-4760-A1D5-43B67450AC7E}"
#usecom IXmlText IID_IXmlText CLSID_XmlText
#comfunc IXmlText_QueryInterface 0 sptr, sptr

// IToastNotificationManager のことらしい
#define IID_IToastNotifier "{75927B93-03F3-41EC-91D3-6E5BAC1B38E7}"
#define CLSID_ToastNotifier "{6db7cd52-e3b7-4ecc-bb1f-388aeef6bb50}"
#usecom IToastNotifier IID_IToastNotifier CLSID_ToastNotifier
#comfunc IToastNotifier_Show 6 sptr
#comfunc IToastNotifier_Hide 7 sptr

#define IID_IToastNotificationFactory "{04124B20-82C6-4229-B109-FD9ED4662B53}"
#define CLSID_ToastNotificationFactory "{6db7cd52-e3b7-4ecc-bb1f-388aeef6bb50}"
#usecom IToastNotificationFactory IID_IToastNotificationFactory CLSID_ToastNotificationFactory
#comfunc IToastNotificationFactory_CreateToastNotification 6 sptr, sptr

#define IID_IToastNotification "{997E2675-059E-4E60-8B06-1760917C8B80}"
#define CLSID_ToastNotification "{6db7cd52-e3b7-4ecc-bb1f-388aeef6bb50}"
#usecom IToastNotification IID_IToastNotification CLSID_ToastNotification

#define IID_IXmlNodeSerializer "{5CC5B382-E6DD-4991-ABEF-06D8D2E7BD0C}"
#define CLSID_XmlNodeSerializer "{AF75D6AD-E307-4052-8CB1-BF2052E734F0}"
#usecom IXmlNodeSerializer IID_IXmlNodeSerializer CLSID_XmlNodeSerializer
#comfunc IXmlNodeSerializer_GetXml 6 sptr
#comfunc IXmlNodeSerializer_get_InnerText 7 sptr
#comfunc IXmlNodeSerializer_put_InnerText 8 sptr

#deffunc WinRTAPIInit
	RoInitialize 1
return stat
#deffunc WinRTAPIUnInit
	RoUninitialize
return stat
#deffunc CreateToastXml var _pTnms_, int _Template, var _pXml_, \
	local inputXmlPtr, \
	local _pTnms, \
	local hr

	_pXml = _pXml_
	_pTnms = _pTnms_
	inputXmlPtr = 0
	// ToastTemplateType_ToastText01 = 4
	IToastNotificationManagerStatics_GetTemplateContent _pTnms, _Template/*4*/, varptr(inputXmlPtr) : hr = stat
	if SUCCEEDED(hr){
		newcom _pXml, IXMLDocument, -1, inputXmlPtr
		if varuse(_pXml){
			hr = 0
		}else{
			hr = -1
		}
		_pXml_ = _pXml
	}
	/*
	querycom pXns, _pXml_, IXmlNodeSerializer
	hString_test = 0
	IXmlNodeSerializer_GetXml pXns, varptr(hString_test)
	dialog strf("0x%08x, %d", stat, stat)
	dialog HString2Unicode(hString_test)
	*/
return hr
#deffunc SetImageSrc str _ImagePath, var _pXml2_
	if _ImagePath == "" : return 0
return
#deffunc SetTextValues array Text, var _pXml_, \
	local num, \
	local nodeListPtr, \
	local hString2, \
	local pNodeList, \
	local nodeListLength, \
	local hString3, \
	local textNodePtr, \
	local pTextNode, \
	local pInputText, \
	local AppendedChildPtr, \
	local inputTextPtr, \
	local pTmp, \
	local hr

	pNodeList = 0
	nodeListPtr = 0
	hString2 = Unicode2HString("text")

	IXMLDocument_GetElementsByTagName _pXml_, hString2, varptr(nodeListPtr) : hr = stat
	if SUCCEEDED(hr){
		newcom pNodeList, IXmlNodeList, -1, nodeListPtr
		if varuse(pNodeList){
			nodeListLength = 0
			IXmlNodeList_get_Length pNodeList, varptr(nodeListLength) : hr = stat
			if SUCCEEDED(hr){
				// 短いほうを選ぶ
				if nodeListLength < length(Text){
					num = nodeListLength
				}else{
					num = length(Text)
				}
				repeat limit(num, 1, 3)
					hString3 = Unicode2HString(Text(cnt))
					;dialog HString2Unicode(hString3)
					textNodePtr = 0
					IXmlNodeList_Item pNodeList, cnt, varptr(textNodePtr) : hr = stat
					if SUCCEEDED(hr){
						newcom pTextNode, IXmlNode, -1, textNodePtr
						if varuse(pTextNode){
							inputTextPtr = 0
							IXMLDocument_CreateTextNode _pXml_, hString3, varptr(inputTextPtr) : hr = stat
							if SUCCEEDED(hr){
								newcom pInputText, IXmlText, -1, inputTextPtr
								if varuse(pInputText){
									AppendedChildPtr = 0
									// varptrじゃなくてlpeekでcomポインタ取得 → やめた
									IXmlNode_AppendChild pTextNode, inputTextPtr/*lpeek(pInputText, 0)*/, varptr(AppendedChildPtr) : hr = stat
									if SUCCEEDED(hr){
										newcom pTmp, IXmlNode, -1, AppendedChildPtr

										;querycom pXns2, pTmp, IXmlNodeSerializer

										// innerTextで日本語が挿入できない
										;hString6 = Unicode2HString("test")	// ←これはOK
										;hString6 = Unicode2HString("testだよ!")
										;IXmlNodeSerializer_put_InnerText pXns2, hString6
										;dialog strf("0x%08x, %d", stat, stat)

										// 挿入したのを見てみる
										;hString_test = 0
										;IXmlNodeSerializer_get_InnerText pXns2, varptr(hString_test)
										;dialog strf("0x%08x, %d", stat, stat)
										;dialog "Debug:"+HString2Unicode(hString_test)

										SafeRelease pTmp
									}
								}
							}
						}
					}
					SafeRelease pInputText
					SafeRelease pTextNode
					DeleteHString hString3
				loop
			}
		}
	}

	//
	SafeRelease pNodeList
	DeleteHString hString2

	// みてみる?
	/*
	querycom pXns, _pXml_, IXmlNodeSerializer
	hString_test = 0
	IXmlNodeSerializer_GetXml pXns, varptr(hString_test)
	dialog strf("0x%08x, %d,\n %s", stat, stat, HString2Unicode(hString_test))
	*/

return hr
#deffunc ShowToast array _Text, str _ImagePath, int Template, str AppUserModelID, \
	local pTnms, \
	local hString, \
	local hString4, \
	local guid, \
	local toastStaticsPtr, \
	local hString_APPsID, \
	local pXml, \
	local notifierPtr, \
	local pNotifier, \
	local factoryPtr, \
	local pFactory, \
	local toastPtr, \
	local pToast, \
	local hr

	pTnms = 0
	pXml = 0
	pNotifier = 0
	pFactory = 0
	pToast = 0

	// Unicode文字列からHStringに変換するみたいよ
	hString = Unicode2HString("Windows.UI.Notifications.ToastNotificationManager")
	hString4 = Unicode2HString("Windows.UI.Notifications.ToastNotification")
	hString_APPsID = Unicode2HString(AppUserModelID)

	// IToastNotificationManagerStatics
	guid = 0x50ac103f, 0x4598d235, 0xfe98efbb, 0xd43a1a4d
	toastStaticsPtr = 0
	RoGetActivationFactory hString, varptr(guid), varptr(toastStaticsPtr) : hr = stat
	;dialog HString2Unicode(hString)
	if hr == 0 && toastStaticsPtr != 0{
		newcom pTnms, IToastNotificationManagerStatics, -1, toastStaticsPtr
		CreateToastXml pTnms, Template, pXml : hr = stat
		if SUCCEEDED(hr){
			SetTextValues _Text, pXml : hr = stat
			if SUCCEEDED(hr){
				// 未実装
				SetImageSrc _ImagePath, pXml : hr = stat
				if SUCCEEDED(hr){
					notifierPtr = 0
					IToastNotificationManagerStatics_CreateToastNotifierWithId pTnms, hString_APPsID, varptr(notifierPtr) : hr = stat
					if SUCCEEDED(hr){
						newcom pNotifier, IToastNotifier, -1, notifierPtr
						if varuse(pNotifier){
							factoryPtr = 0
							// IToastNotificationFactory
							guid = 0x04124B20, 0x422982C6, 0x9EFD09B1, 0x532B66D4
							RoGetActivationFactory hString4, varptr(guid), varptr(factoryPtr) : hr = stat
							if hr == 0 && factoryPtr != 0{
								newcom pFactory, IToastNotificationFactory, -1, factoryPtr
								if varuse(pFactory){
									toastPtr = 0
									IToastNotificationFactory_CreateToastNotification pFactory, lpeek(pXml, 0), varptr(toastPtr) : hr = stat
									if SUCCEEDED(hr){
										newcom pToast, IToastNotification, -1, toastPtr
										if varuse(pToast){
											IToastNotifier_Show pNotifier, toastPtr
											if SUCCEEDED(hr){

											}
										}
									}
								}
							}
						}
					}
				}
			}
		}
	}

	SafeRelease pToast
	SafeRelease pFactory
	SafeRelease pNotifier
	SafeRelease pXml
	SafeRelease pTnms

	DeleteHString hString_APPsID
	DeleteHString hString4
	DeleteHString hString
return hr
#global
#enum ToastTemplateType_ToastImageAndText01 = 0
#enum ToastTemplateType_ToastImageAndText02
#enum ToastTemplateType_ToastImageAndText03
#enum ToastTemplateType_ToastImageAndText04
#enum ToastTemplateType_ToastText01
#enum ToastTemplateType_ToastText02
#enum ToastTemplateType_ToastText03
#enum ToastTemplateType_ToastText04

	// Win8 のトースト通知を使用するには、アプリ一覧に
	// AppUserModelIDを設定したショートカットを配置する必要がある

	// 初期化するのん
	WinRTAPIInit

	// 適当なAppUserModelIDを指定する
	// CompanyName.ProductName.SubProduct.VersionInformation な形式が良い
	// http://msdn.microsoft.com/ja-jp/library/windows/apps/dd378459.aspx
	AppUserModelID = "net.hinekure.hsp.test"

	// 現在の実行ファイルのパス名
	sdim exepath, 1024 + 1
	GetModuleFileNameA 0, varptr(exepath), 1024

	// ショートカット作成先のパス名(?:\Users\xxx\AppData\Roaming\)
	lnkpath = dirinfo($1001A) + "\\Microsoft\\Windows\\Start Menu\\Programs\\"+"HSP3Test.lnk"

	// ショートカット作成(アプリ一覧に)
	CreateShortcut exepath, "", exepath, 0, AppUserModelID, lnkpath
	mes stat

	// 現在のウィンドウに 指定したAppUserModelID を設定する
	SetAppUserModelID hwnd, AppUserModelID
	mes stat

	text = "日本語の", "通知", "試験!!!!"

	// トースト通知してみる

	// 第1引数は、表示したい文字列を最大3つまでの配列変数で指定
	// 3つ使えるのは、
	// ToastTemplateType_ToastImageAndText04
	// ToastTemplateType_ToastText04
	// です。
	// 第2引数は、画像パスを指定(ただし未実装)
	// 第3引数は、テンプレートIDを指定
	// 第4引数は、AppUserModelIDを指定
	ShowToast text, "", ToastTemplateType_ToastText04, AppUserModelID
	mes strf("0x%08x, %d", stat, stat)

	// 終了時にでも実行
	WinRTAPIUnInit

HSP OBAQで振り子

#include "obaq.as"

;内積
#define ctype DotProduct2D(%1,%2,%3,%4) (double(%1)*(%3) + double(%2)*(%4))

	qreset			; OBAQの初期化

	;	オブジェクト追加
	qaddpoly mybox,   4, 80,30,0, 3.0,3.0
	qaddpoly myball, 20, 80,60,0, 3.0,3.0

	;qgravity 0,0
	qtype mybox, type_bind
	qinertia myball, 1.0

	qgetpos mybox, px,py,pr

*main
	redraw 0		; 画面の更新を開始
	color 0,0,0:boxf	; 画面をクリア
	qexec			; OBAQによるオブジェクトの更新

	;	キー入力
	stick key,15		; キーの取得
	if key&128 : end	; [ESC]キーで終了
	if key&1 : px -= 0.5
	if key&4 : px += 0.5
	if key&2 : py -= 0.5
	if key&8 : py += 0.5

	;	操作用オブジェクトを移動
	qpos mybox, px,py,0

	;	振り子
	qgetpos mybox,  hx0, hy0, hr0
	qgetpos myball, hx1, hy1, hr1
	qgetspeed myball, vx,vy,vr
	;ballからbox
	dx = hx0 - hx1
	dy = hy0 - hy1
	;cos
	dd = sqrt(dx*dx + dy*dy)
	vv = sqrt(vx*vx + vy*vy)
	c = DotProduct2D( vx, vy, -dx, -dy ) / vv / dd
	;紐正規化
	ix = dx / dd
	iy = dy / dd

	;減衰
	v = vv * c
	bvx = ix * -v
	bvy = iy * -v
	cv = 0.1
	cvx = 0.0
	cvy = 0.0
	if bvx>0 {
		cvx = -cv
		bvx -= cv
		if bvx<0 : cvx = 0.0
	} else {
		if bvx<0 {
			cvx = cv
			bvx += cv
			if bvx>0 : cvx = 0.0
		}
	}
	if bvy>0 {
		cvy = -cv
		bvy -= cv
		if bvy<0 : cvy = 0.0
	} else {
		if bvy<0 {
			cvy = cv
			bvy += cv
			if bvy>0 : cvy = 0.0
		}
	}
	qspeed myball, cvx, cvy, 0.0

	;	バネ
	;バネの伸び
	dl = sqrt(dx*dx + dy*dy) - 10.0
	vx = ix * dl / 4
	vy = iy * dl / 4
	qspeed myball, vx, vy

/*
	pos 50,50
	color 255,255,255
	mes ""+dy
	mes ""+vy
	mes vv
	mes c
	mes "cvx = " + cvx
	mes "cvy = " + cvy
*/

	qdraw			; オブジェクトの描画
	redraw 1		; 画面の更新を終了
	await 12		; 一定時間待つ
	goto *main

HSP 数値を2進数(文字列)に変換するモジュール

#module
#defcfunc tobit int num
	s=""
	repeat 32
		s = str((num & 1<<cnt)!0) + s
	loop
	return s
#global

ss=""
mesbox ss, ginfo_winx, ginfo_winy
objid = stat

s=""
s += tobit( 2 ) + "\n"
s += tobit( 3 ) + "\n"
s += tobit( 5 ) + "\n"
s += tobit( 7 ) + "\n"
s += tobit( 11 ) + "\n"
s += tobit( 13 ) + "\n"
s += tobit( 17 ) + "\n"
s += tobit( 19 ) + "\n"
s += tobit( 23 ) + "\n"
s += tobit( 29 ) + "\n"
s += tobit( 31 ) + "\n"
s += tobit( 37 ) + "\n"
s += tobit( 41 ) + "\n"
s += tobit( 43 ) + "\n"
s += tobit( 47 ) + "\n"
s += tobit( 53 ) + "\n"
s += tobit( 59 ) + "\n"
s += tobit( 61 ) + "\n"

objprm objid, s

HSP TaskDialog Sample

// TaskDialog.hsp

// TaskDialog Sample by akk026

#uselib "comctl32.dll"
#func TaskDialog "TaskDialog" int, int, wstr, wstr, wstr, int, wptr, var

#define TDCBF_OK_BUTTON		0x0001
#define TDCBF_YES_BUTTON	0x0002
#define TDCBF_NO_BUTTON		0x0004
#define TDCBF_CANCEL_BUTTON	0x0008
#define TDCBF_RETRY_BUTTON	0x0010
#define TDCBF_CLOSE_BUTTON	0x0020

#define TD_WARNING_ICON		0xFFFF
#define TD_ERROR_ICON		0xFFFE
#define TD_INFORMATION_ICON	0xFFFD
#define TD_SHIELD_ICON		0xFFFC

TaskDialog hwnd, hinstance, "TaskDialog Sample", "HSPから使用しています", "ここにはメッセージが表示されます。", TDCBF_OK_BUTTON, TD_INFORMATION_ICON, ret
mes "stat: " + stat
mes "ret : " + ret

HSP TsubuyakiSoup.as 認証できない不具合修正&API 1.1 対応化 その3

#defcfunc GetAuthorizeAdress
	// アクセストークン取得
	sdim Argument
	RESTAPI ResponseBody, ResponseHeader, METHOD_GET, "oauth/request_token", Argument
	if stat != 200 : return "Error"
	// トークンの取り出し
	;request_token
	TokenStart = instr(ResponseBody, 0, "oauth_token=") + 12
	TokenEnd = instr(ResponseBody, TokenStart, "&")
	TS_RequestToken = strmid(ResponseBody, TokenStart, TokenEnd)
	;request_token_secret
	Token_SecretStart = instr(ResponseBody, 0, "oauth_token_secret=") + 19
	Token_SecretEnd = instr(ResponseBody, Token_SecretStart, "&")
	TS_RquestTokenSecret = strmid(ResponseBody, Token_SecretStart, Token_SecretEnd)
return "https://api.twitter.com/oauth/authorize?oauth_token="+ TS_RequestToken

HSP 【HSP3】HSPでMP3/WMAのアルバムアート(ジャケット画像)を書き込むサンプル

#define IID_IWMMetadataEditor 	"{96406bd9-2b2b-11d3-b36b-00c04f6108ff}"
#define IID_IWMMetadataEditor2 	"{203cffe3-2e18-4fdf-b59d-6e71530534cf}"
#define IID_IWMHeaderInfo		"{96406bda-2b2b-11d3-b36b-00c04f6108ff}"
#define IID_IWMHeaderInfo2		"{15cf9781-454e-482e-b393-85fae487a810}"
#define IID_IWMHeaderInfo3		"{15CC68E3-27CC-4ecd-B222-3F5D02D80BD5}"
#define IID_IWMImageInfo		"{9F0AA3B6-7267-4D89-88F2-BA915AA5C4C6}"
#usecom IWMMetadataEditor IID_IWMMetadataEditor
#comfunc IWMMetadataEditor_Open 3 wptr
#comfunc IWMMetadataEditor_Close 4
#comfunc IWMMetadataEditor_Flush 5
#usecom IWMHeaderInfo3 IID_IWMHeaderInfo3
#comfunc IWMHeaderInfo3_GetAttributeByName 5 sptr, wstr, sptr, sptr, sptr
#comfunc IWMHeaderInfo3_GetAttributeCountEx 17 sptr, sptr
#comfunc IWMHeaderInfo3_GetAttributeByIndexEx 19 sptr, sptr, sptr, sptr, sptr, sptr, sptr, sptr
#comfunc IWMHeaderInfo3_ModifyAttribute 20 sptr, sptr, sptr, sptr, sptr, sptr
#comfunc IWMHeaderInfo3_AddAttribute 21 sptr, wstr, sptr, sptr, sptr, sptr, sptr

#uselib "Wmvcore.dll"
#func WMCreateEditor "WMCreateEditor" sptr

	pEditor = 0
	WMCreateEditor varptr(pEditor)
	newcom pWMEdit, IID_IWMMetadataEditor, -1, pEditor

	dialog "jpg", 16
	fname = refstr
	exist fname
	fsize = strsize
	notesel img
	noteload fname

	dialog "mp3;*.wma", 16
	IWMMetadataEditor_Open pWMEdit, refstr
	if stat != 0 : dialog "失敗" : end

	querycom pHeaderInfo, pWMEdit, IID_IWMHeaderInfo

	cAttributes = 0
	IWMHeaderInfo3_GetAttributeCountEx pHeaderInfo, 0xFFFF, varptr(cAttributes)

	idx = -1
	repeat cAttributes
		sdim szName, 1024 + 2
		NameLen = 1024
		Type = 0
		LangIndex = 0
		DataLength = 0
		IWMHeaderInfo3_GetAttributeByIndexEx pHeaderInfo, 0, cnt, varptr(szName), varptr(NameLen), varptr(Type), varptr(LangIndex), 0, varptr(DataLength)
		if cnvwtos(szName) == "WM/Picture"{
			idx = cnt
		}
	loop

	s_des = ""
	s_mime = "image/jpeg"
	size_des = (strlen(s_des)*2 + 2)
	size_mime = (strlen(s_mime)*2 + 2)

	// WM_PICTURE構造体(17bytes) + MIME文字列(Unicode) + 説明用文字列(Unicode)
	sSize = 17 + size_mime + size_des + fsize
	sdim WM_PICTURE, sSize
	sdim mime, size_mime : cnvstow mime, s_mime
	sdim description, size_des : cnvstow description, s_des

	ptr = varptr(WM_PICTURE) + 17
	lpoke WM_PICTURE, 0, ptr
	memcpy WM_PICTURE, mime, size_mime, ptr - varptr(WM_PICTURE), 0

	poke WM_PICTURE, 4, 0

	ptr += size_mime
	lpoke WM_PICTURE, 5, ptr
	memcpy WM_PICTURE, description, size_des, ptr - varptr(WM_PICTURE), 0

	lpoke WM_PICTURE, 9, fsize

	ptr += size_des
	lpoke WM_PICTURE, 13, ptr
	memcpy WM_PICTURE, img, fsize, ptr - varptr(WM_PICTURE), 0

	// ない場合
	if idx == -1 {
		IWMHeaderInfo3_AddAttribute pHeaderInfo, 0, "WM/Picture", varptr(Index), 2/*WMT_TYPE_BINARY*/, 0, varptr(WM_PICTURE), sSize
		mes strf("0x%08x, %08d", stat, stat)
	}else{
		// 既にある場合は上書き
		IWMHeaderInfo3_ModifyAttribute pHeaderInfo, 0, idx, 2/*WMT_TYPE_BINARY*/, 0, varptr(WM_PICTURE), sSize
		mes strf("0x%08x, %08d", stat, stat)
	}

	IWMMetadataEditor_Flush pWMEdit
	IWMMetadataEditor_Close pWMEdit
Total Pages: 5 / 22« 先頭...345671020...最後 »

よく投稿されているコード

タグ

最近投稿されたコード