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

HSP 【HSP3】Ping送信 v2

#module
#uselib "ws2_32.dll"
#cfunc WSAStartup "WSAStartup" int, sptr
#func WSACleanup "WSACleanup"
#cfunc inet_addr "inet_addr" str
#cfunc gethostbyname "gethostbyname" str
#uselib "icmp.dll"
#cfunc IcmpCreateFile "IcmpCreateFile"
#cfunc IcmpSendEcho "IcmpSendEcho" int, int, str, int, int, var, int, int
#func IcmpCloseHandle "IcmpCloseHandle" int
#deffunc InitPing
	sdim WSAData, 400
	if WSAStartup(0x0101, varptr(WSAData)) != 0{
		return -1
	}
	SetPingSendData "ICMP SEND DATA"
return 0
#deffunc ExitPing onexit
	WSACleanup
return
#deffunc SetPingSendData str data
	send_data = data
	recv_size = 28 + strlen(send_data) + 1
return 0
#defcfunc GetAddr str addr
	int_addr = 0
	int_addr = inet_addr(addr)
	if int_addr != 0{
		ret = gethostbyname(addr)
		if ret != 0{
			dupptr tmp, ret + 12, 4
			dupptr ret, tmp, 4
			dupptr int_addr, ret, 4
		}else{
			return 0
		}
	}
return int_addr
#deffunc Ping var ms, int _int_addr, int timeout
	dim recv_data, (recv_size / 4) + 1
	hIcmp = IcmpCreateFile()
	ret = IcmpSendEcho(hIcmp, _int_addr, send_data, strlen(send_data), 0, recv_data, recv_size, timeout)
	if (ret != 0) {
		ms = recv_data.2
	}else{
		return -1
	}
	IcmpCloseHandle hIcmp
return 0
#global
	// IPv6には非対応です

	// 初期化
	InitPing

	// xn--n8j3azcmra9bymod5gnkxgnr.com -> こんなアドレスないってばよ.com
	ping_addr_list.0 = "127.0.0.1", "www.google.co.jp", "www.yahoo.co.jp"
	ping_addr_list.3 = "www.microsoft.com", "329.932.129.848", "::1"
	ping_addr_list.6 = "xn--n8j3azcmra9bymod5gnkxgnr.com"

	repeat length(ping_addr_list)
		mes ping_addr_list(cnt) + " に ping を送信しています..."
		// ping してみる
		Ping time, GetAddr(ping_addr_list(cnt)), 1000	// タイムアウト1秒
		if stat != -1{
			mes "-> " + time + " ms"
		}else{
			mes "-> ping 失敗"
		}
		mes "------------------------------------------"
	loop

HSP 【HSP3】Ping送信

// 改造はご自由に
#module
#uselib "ws2_32.dll"
#cfunc WSAStartup "WSAStartup" int, sptr
#cfunc inet_addr "inet_addr" str
#cfunc gethostbyname "gethostbyname" str
#uselib "icmp.dll"
#cfunc IcmpCreateFile "IcmpCreateFile"
#cfunc IcmpSendEcho "IcmpSendEcho" int, int, str, int, int, var, int, int
#func IcmpCloseHandle "IcmpCloseHandle" int
#deffunc InitPing
	sdim WSAData, 400
	if WSAStartup(0x0101, varptr(WSAData)) != 0{
		return -1
	}
	SetPingSendData "ICMP SEND DATA"
return 0
#deffunc SetPingSendData str data
	send_data = data
	recv_size = 28 + strlen(send_data) + 1
return 0
#defcfunc GetAddr str addr
	int_addr = 0
	int_addr = inet_addr(addr)
	if int_addr != 0{
		ret = gethostbyname(addr)
		if ret != 0{
			dupptr tmp, ret + 12, 4
			dupptr ret, tmp, 4
			dupptr int_addr, ret, 4
		}else{
			return 0
		}
	}
return int_addr
#deffunc Ping var ms, int _int_addr, int timeout
	dim recv_data, (recv_size / 4) + 1
	hIcmp = IcmpCreateFile()
	ret = IcmpSendEcho(hIcmp, _int_addr, send_data, strlen(send_data), 0, recv_data, recv_size, timeout)
	if (ret != 0) {
		ms = recv_data.2
	}else{
		return -1
	}
	IcmpCloseHandle hIcmp
return 0
#global
	// IPv6には非対応です

	// 初期化
	InitPing

	// xn--n8j3azcmra9bymod5gnkxgnr.com -> こんなアドレスないってばよ.com
	ping_addr_list.0 = "127.0.0.1", "www.google.co.jp", "www.yahoo.co.jp"
	ping_addr_list.3 = "www.microsoft.com", "329.932.129.848", "::1"
	ping_addr_list.6 = "xn--n8j3azcmra9bymod5gnkxgnr.com"

	repeat length(ping_addr_list)
		mes ping_addr_list(cnt) + " に ping を送信しています..."
		// ping してみる
		Ping time, GetAddr(ping_addr_list(cnt)), 1000	// タイムアウト1秒
		if stat != -1{
			mes "-> " + time + " ms"
		}else{
			mes "-> ping 失敗"
		}
		mes "------------------------------------------"
	loop

HSP ファイルの所有者を変更してみる

// ファイルの所有者を変更してみる by ake260

// ※管理者権限で実行してください

#uselib "advapi32.dll"
#func OpenProcessToken "OpenProcessToken" int, int, var
#func LookupPrivilegeValue "LookupPrivilegeValueA" int, sptr, var
#func AdjustTokenPrivileges "AdjustTokenPrivileges" int, int, var, int, int, int
#func LookupAccountName "LookupAccountNameA" sptr, str, sptr, var, str, var, var
#cfunc SetNamedSecurityInfo "SetNamedSecurityInfoA" str, int, int, sptr, sptr, sptr, sptr

#uselib "kernel32.dll"
#cfunc GetCurrentProcess "GetCurrentProcess"
#func Closehandle "CloseHandle" int
#func FormatMessage "FormatMessageA" int, int, int, int, var, int, int

#define FALSE	0
#define NULL	0
#define ERROR_SUCCESS	$00000000

#define TOKEN_ADJUST_PRIVILEGES	$00000020
#define SE_PRIVILEGE_ENABLED	$00000002

#define SE_FILE_OBJECT 1
#define OWNER_SECURITY_INFORMATION	$00000001

#define FORMAT_MESSAGE_FROM_SYSTEM	$00001000
#define FORMAT_MESSAGE_IGNORE_INSERTS	$00000200

sdim DomainName, 256
DomainNameSize = 256

// 新しい所有者のユーザー名 (要管理者権限のユーザー)
AccountName = "Administrators"

// テスト用のファイルを指定 (作成しておいてください)
file = "test_owner.txt"

// プロセスに特権を付加 (一応) (いらないかも)
OpenProcessToken GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES, hToken
LookupPrivilegeValue 0, "SeTakeOwnershipPrivilege", Luid
tp = 1, Luid, 0, SE_PRIVILEGE_ENABLED
AdjustTokenPrivileges hToken, FALSE, tp, 0, NULL, NULL
CloseHandle hToken

// 指定されたユーザーのSIDのサイズを取得
LookupAccountName 0, AccountName, NULL, SidSize, DomainName, DomainNameSize, snu

// バッファの確保 本来はLocalAllocを使うようだが、sdimでもいいようだ
sdim Sid, SidSize

// 指定されたユーザーのSIDを取得
LookupAccountName 0, AccountName, varptr(Sid), SidSize, DomainName, DomainNameSize, snu

// 所有者を設定
ret = SetNamedSecurityInfo(file, SE_FILE_OBJECT, OWNER_SECURITY_INFORMATION, varptr(Sid), NULL, NULL, NULL)
if (ret == ERROR_SUCCESS) {
	mes "所有者の設定が完了しました。"
} else {
	mes "所有者の設定に失敗しました。"

	// エラーメッセージを表示 (一応)
	sdim ErrorBuf, 260
	FormatMessage FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS, NULL, ret, 0, ErrorBuf, 260, NULL
	mes ErrorBuf
}

stop

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

// 一部のみ
#deffunc RESTAPI var p1, var p2, int p3, str p4, array p5
//  引数チェック&初期化
	sdim p1
	sdim p2
	API = p4
	if vartype(p5) != 2 : return 0
	hConnect = 0		//InternetConnectのハンドル
	hRequest = 0		//HttpOpenRequestのハンドル
	API_statcode = 0	//リクエストの結果コード
	API_p1Length = 0	//データ長
	API_rsize = 1024	//バッファ初期値
	API_hsize = 0		//取得したバイト数が代入される変数
//  メソッドの設定
	if (p3 = 1) {
		Method = "POST"
	} else {
		Method = "GET"
	}
//  ポート&フラグの設定
	UsePort = 443/*80*/ : RequestFlag = -2139082752// - 0x00800000
	VersionStr = "1.1/"
	TokenStr = TS_AccessToken
	SigKey = TS_Consumer_Secret+" "+TS_AccessTokenSecret
	if (strmid(API,0,5) = "oauth") {
		VersionStr = ""
		if (API = "oauth/access_token") {
			//OAuth認証だったら、
			repeat length(p5)
				if (p5(cnt) = "x_auth_mode=client_auth") : break
				if cnt = length(p5)-1 : TokenStr = TS_RequestToken : SigKey = TS_Consumer_Secret+" "+TS_RequestTokenSecret
			loop
		}
	}
//  シグネチャ生成
	SigArrayMax = 6 + length(p5)
	sdim SigArray, 500, SigArrayMax
	SigNonce = RandomString(8,32)
	_time SigTime
	SigArray(0) = "oauth_consumer_key=" + TS_Consumer_Key
	SigArray(1) = "oauth_nonce=" + SigNonce
	SigArray(2) = "oauth_signature_method=HMAC-SHA1"
	SigArray(3) = "oauth_timestamp=" + SigTime
	SigArray(4) = "oauth_token="+ TokenStr
	SigArray(5) = "oauth_version=1.0"
	repeat SigArrayMax - 6
		SigArray(6+cnt) = p5(cnt)
	loop
	//ソート
	SortString SigArray
	//"&"で連結
	TransStr = ""+ Method +" https://api.twitter.com/"+ VersionStr + API +" "
	repeat SigArrayMax
		if SigArray(cnt) = "" : continue
		TransStr += SigArray(cnt) +"&"
	loop
	TransStr = strmid(TransStr, 0, strlen(TransStr)-1)
	Signature = SignatureEncode(TransStr, SigKey)
//  データ整形
	if (p3 = 1) {
		//POST
		sdim PostStr, 1024; = ""
		repeat SigArrayMax
			PostStr += SigArray(cnt) +"&"
		loop
		PostStr += "oauth_signature="+ Signature
		PostStrLen = strlen(PostStr)
		AddUrl = ""
	} else {
		//GET
		PostStr = 0
		PostStrLen = 0
		AddUrl = "?"
		repeat SigArrayMax
			AddUrl += SigArray(cnt) +"&"
		loop
		AddUrl += "oauth_signature="+ Signature
	}
	//サーバへ接続
	hConnect = _InternetConnect(TS_hInet, "api.twitter.com", UsePort, 0, 0, 3, 0, 0)
	if (hConnect) {
		//リクエストの初期化
		hRequest = _HttpOpenRequest(hConnect, Method, VersionStr+API+AddUrl, "HTTP/1.1", 0, 0, RequestFlag, 0)
		if (hRequest) {
			//サーバへリクエスト送信
			if ( _HttpSendRequest(hRequest, "Accept-Encoding: gzip, deflate;\nContent-Type: application/x-www-form-urlencoded", -1, PostStr, PostStrLen)) {
				//ヘッダを取得する変数の初期化
				p2Size = 3000
				sdim p2, p2Size
				//ヘッダの取得
				if ( _HttpQueryInfo(hRequest, 22, p2, p2Size, 0) ) {
					//ヘッダの解析
					notesel p2
					logmes p2
					repeat notemax
						noteget API_BufStr, cnt
						API_BufStr = getpath(API_BufStr, 16)
						API_buf = instr(API_BufStr, 0, getpath("Status: ", 16))				//ステータスコード
						if (API_Buf != -1) : API_statcode = int(strmid(API_BufStr, API_buf+8, 3))
						API_buf = instr(API_BufStr, 0, getpath("Content-Length: ", 16))		//長さ
						if (API_Buf != -1) : API_p1Length = int(strmid(API_BufStr, -1, strlen(API_BufStr)-API_buf+16))
						API_buf = instr(API_BufStr, 0, getpath("X-RateLimit-Limit: ", 16))		//60分間にAPIを実行できる回数
						if (API_Buf != -1) : TS_RateLimit(0) = int(strmid(API_BufStr, -1, strlen(API_BufStr)-(API_buf+19)))
						API_buf = instr(API_BufStr, 0, getpath("X-RateLimit-Remaining: ", 16))	//APIを実行できる残り回数
						if (API_Buf != -1) : TS_RateLimit(1) = int(strmid(API_BufStr, -1, strlen(API_BufStr)-(API_buf+23)))
						API_buf = instr(API_BufStr, 0, getpath("X-RateLimit-Reset: ", 16))		//リセットする時間
						if (API_Buf != -1) : TS_RateLimit(2) = int(strmid(API_BufStr, -1, strlen(API_BufStr)-(API_buf+19)))
					loop
					noteunsel
					//入手可能なデータ量を取得
					_InternetQueryDataAvailable hRequest, API_rsize, 0, 0
					//バッファの初期化
					sdim API_bufStr, API_rsize+1
					sdim p1, API_p1Length+1
					repeat
						_InternetReadFile hRequest, API_bufStr, API_rsize, API_hsize
						if (API_hsize = 0) : break
						p1 += strmid(API_bufStr, 0, API_hsize)
						await 0
					loop
					logmes p1
				} else {
					//ヘッダの取得ができなかった場合
					API_statcode = -1
				}
			} else {
				//サーバへリクエスト送信できなかった場合
				API_statcode = -2
			}
			//Requestハンドルの破棄
			_InternetCloseHandle hRequest
		} else {
			//Requestハンドルを取得できなかった場合
			API_statcode = -3
		}
		//Connectハンドルの破棄
		_InternetCloseHandle hConnect
	} else {
		//Connectハンドルを取得できなかった場合
		API_statcode = -4
	}
return API_statcode

HSP TsubuyakiSoup.as 認証できない不具合

#deffunc RESTAPI var p1, var p2, int p3, str p4, array p5

// ~略~
					repeat notemax
						noteget API_BufStr, cnt
						API_BufStr = getpath(API_BufStr, 16)
						API_buf = instr(API_BufStr, 0, getpath("Status: ", 16))				//ステータスコード
						if (API_Buf != -1) : API_statcode = int(strmid(API_BufStr, API_buf+8, 3))
						API_buf = instr(API_BufStr, 0, getpath("Content-Length: ", 16))		//長さ
						if (API_Buf != -1) : API_p1Length = int(strmid(API_BufStr, -1, strlen(API_BufStr)-API_buf+16))
						API_buf = instr(API_BufStr, 0, getpath("X-RateLimit-Limit: ", 16))		//60分間にAPIを実行できる回数
						if (API_Buf != -1) : TS_RateLimit(0) = int(strmid(API_BufStr, -1, strlen(API_BufStr)-(API_buf+19)))
						API_buf = instr(API_BufStr, 0, getpath("X-RateLimit-Remaining: ", 16))	//APIを実行できる残り回数
						if (API_Buf != -1) : TS_RateLimit(1) = int(strmid(API_BufStr, -1, strlen(API_BufStr)-(API_buf+23)))
						API_buf = instr(API_BufStr, 0, getpath("X-RateLimit-Reset: ", 16))		//リセットする時間
						if (API_Buf != -1) : TS_RateLimit(2) = int(strmid(API_BufStr, -1, strlen(API_BufStr)-(API_buf+19)))
					loop

// ~略~

HSP ボタンのジャンプ先を入れ替えてみる (コントロールID書き換え)

#uselib "user32.dll"
#cfunc GetWindowLong "GetWindowLongA" int, int
#func SetWindowLong "SetWindowLongA" int, int, int

#define GWL_ID	-12

button "ボタン1", *button1
hButton1 = objinfo(stat, 2)                  ; ボタン1のウィンドウハンドルを取得
Button1_id = GetWindowLong(hButton1, GWL_ID) ; コントロールIDを取得

button "ボタン2", *button2
hButton2 = objinfo(stat, 2)                  ; ボタン2のウィンドウハンドルを取得
Button2_id = GetWindowLong(hButton2, GWL_ID) ; コントロールIDを取得

button "入れ替え", *change
flag = 0
stop

*button1
	mes "ボタン1"
	stop

*button2
	mes "ボタン2"
	stop

*change
	if (flag == 0) {
		SetWindowLong hButton1, GWL_ID, Button2_id ; コントロールIDをボタン2のものに書き換え
		SetWindowLong hButton2, GWL_ID, Button1_id ; コントロールIDをボタン1のものに書き換え
	} else {
		SetWindowLong hButton1, GWL_ID, Button1_id ; コントロールIDをボタン1のものに書き換え (元の状態)
		SetWindowLong hButton2, GWL_ID, Button2_id ; コントロールIDをボタン2のものに書き換え (元の状態)
	}
	flag ^ 1
	mes "入れ替え"
	stop

HSP HSPでドロネー三角形分割してみたよ

;
;[ Infomation ]
; Name      : ドロネー三角形分割
; SubName   :
; Version   :
; copyright :
;
;[ Update history ]
;yyyy/mm/dd : ver : comment
;

;#ifndef __MODULE_NAME__
;#define global __MODULE_NAME__
#module
;---------------------------------------------------------------------------------------------------

;///////////////////////////////////////////////////////////////////////////////////////////////////
;
;	定数の定義
;
;#const global
;#enum global 

;///////////////////////////////////////////////////////////////////////////////////////////////////
;
;	外接円の中心座標と半径を取得
;
;[ Infomation ]
;	GetCircumcircle double ptx1, double pty1, double ptx2, double pty2, double ptx3, double pty3, var resPtx, var resPty, var resR
;	double ptx1, double pty1 : [IN] 1点目のx,y座標
;	double ptx2, double pty2 : [IN] 2点目のx,y座標
;	double ptx3, double pty3 : [IN] 3点目のx,y座標
;	var resPtx, var resPty : [OUT]外接円の中心座標
;	var resR : [OUT]外接円の半径
;
;	return : 成功判定
;
;[ comment ]
; 3点を通る外接円の中心座標と半径を算出します。
;
; statの値で外接円の作成に成功したかどうかの判定ができます。
;
; stat = 0 :
; 外接円の作成に成功しました。
;
; stat = 1 :
; 外接円の作成に失敗しました。
; 3点が直線上に並んでいたり、2点以上が同じ場所にある場合、外接円は作れません。
; 半径 resR には0.0が返ります。
;
#deffunc GetCircumcircle double ptx1, double pty1, double ptx2, double pty2, double ptx3, double pty3, var resPtx, var resPty, var resR
	;resPt 中心座標
	;resR  半径
	;
	;式1:2 * x * (x2-x1) + 2 * y * (y2-y1) = (x2*x2 - x1*x1 + y2*y2 - y1*y1)
	;式2:2 * x * (x3-x1) + 2 * y * (y3-y1) = (x3*x3 - x1*x1 + y3*y3 - y1*y1)
	;	次のように置き換える
	;式1:2*x * a + 2*y * b = c
	;式2:2*x * d + 2*y * e = f
	;
	a = ptx2 - ptx1
	d = ptx3 - ptx1

	b = pty2 - pty1
	e = pty3 - pty1

	c = ptx2*ptx2 - ptx1*ptx1 + pty2*pty2 - pty1*pty1
	f = ptx3*ptx3 - ptx1*ptx1 + pty3*pty3 - pty1*pty1

	;
	;	3点が同一直線上にあるかチェック
	;
	n = 2.0 * ( b*d - a*e)
	if n = 0.0 {
		;	3点が同一直線上に並ぶ場合は点1をそのまま返す
		resPty = ptx1
		resPtx = pty1
		resR = 0.0
		return 1
	}

	;
	;	中心座標
	;
	resPty = (c*d - a*f) / n

	if a ! 0.0 {
		resPtx = (0.5*c - b*resPty) / a
	} else {
		;	直線には並んでいないので、aもdも0.0はありえない。
		resPtx = (0.5*f - e*resPty) / d
	}

	;
	;	半径
	;
	x = resPtx - ptx1
	y = resPty - pty1
	resR = sqrt( x * x + y * y )
	return 0

;///////////////////////////////////////////////////////////////////////////////////////////////////
;
;	指定範囲を包む三角形の座標を取得
;
;[ Infomation ]
;	GetHugeTriangle double ltx, double lty, double rux, double ruy, var tx0, var ty0, var tx1, var ty1, var tx2, var ty2
;	double ltx : 左上座標X
;	double lty : 左上座標Y
;	double rux : 右下座標X
;	double ruy : 右下座標Y
;	tx0, ty0 : 三角形頂点座標 0
;	tx1, ty1 : 三角形頂点座標 1
;	tx2, ty2 : 三角形頂点座標 2
;
;	return : 0
;
;[ comment ]
;指定した矩形領域(ltx, lty)-(rux, ruy)の外接円を内接円とした正三角形の3点の座標を取得します。
;ドロネー三角形を求める際の外部三角形の作成に利用できます。(無駄が多いけど気にしない)
;
#deffunc GetHugeTriangle double ltx, double lty, double rux, double ruy, var tx0, var ty0, var tx1, var ty1, var tx2, var ty2

	hw = (rux - ltx)/2.0
	hh = (ruy - lty)/2.0
	r = sqrt( hw * hw + hh * hh )
	r3 = r * sqrt(3)

	tx0 = ltx + hw - r3
	ty0 = lty + hh - r
	tx1 = ltx + hw
	ty1 = lty + hh + r*2
	tx2 = rux - hw + r3
	ty2 = ty0

	return

;-------------------------------------------------------------------------------

;---------------------------------------------------------------------------------------------------
#global
;#endif	;__MODULE_NAME__

;#################################################
;	モジュール型を作成
;三角形:triangle
;外接円:circumcircle
;
#module modTriangle tri0, tri1, tri2, ccm_x, ccm_y, ccm_r

;------------------------
;	コンストラクタ
;	モジュール変数に値を登録
#modinit int t0, int t1, int t2, array pts
	tri0 = t0
	tri1 = t1
	tri2 = t2

	;	外接円取得
	GetCircumcircle pts( 0, t0), pts( 1, t0), pts( 0, t1), pts( 1, t1), pts( 0, t2), pts( 1, t2), xx, yy, rr
	ccm_x = xx
	ccm_y = yy
	ccm_r = rr

	return

;------------------------
;	デストラクタ
;	モジュール変数を開放したときの処理
#modterm
;	mes "削除しました。"
	return

;------------------------
;	外接円の内側にあるか調べる
;0:外側
;1:内側
#modfunc modTri_IsInsideCircumcircle double ptx, double pty
	x = ptx - ccm_x
	y = pty - ccm_y
	if (x*x + y*y) < ccm_r*ccm_r : return 1	;内側
	return 0	;外側

;------------------------
;	三角形の頂点を取得
#modfunc modTri_GetPoints var tt0, var tt1, var tt2
	;	三角形の頂点番号を返す
	tt0 = tri0
	tt1 = tri1
	tt2 = tri2
	return

;------------------------
;	三角形の一致判定
;引数3点と三角形の頂点三点が一致するか知らべる。
;一致する場合1を返す。
#modfunc modTri_IsEquals int t0, int t1, int t2
	f  = (tri0 = t0) & (tri1 = t1) & (tri2 = t2)
	f |= (tri0 = t0) & (tri1 = t2) & (tri2 = t1)
	f |= (tri0 = t1) & (tri1 = t0) & (tri2 = t2)
	f |= (tri0 = t2) & (tri1 = t0) & (tri2 = t1)
	f |= (tri0 = t1) & (tri1 = t2) & (tri2 = t0)
	f |= (tri0 = t2) & (tri1 = t1) & (tri2 = t0)
	return f

#global

;#################################################
;	モジュール
;
#module

;------------------------
;	モジュール初期化
#deffunc DelaunayIni
	ddim points, 2, 1000
	pointsCount = 0		;有効な点の数

	;	点の追加可能領域
	;とりあえず固定領域とした
	pointAreaX = 0
	pointAreaY = 0
	pointAreaW = ginfo_winx
	pointAreaH = ginfo_winy

	;	外部三角形取得
	GetHugeTriangle pointAreaX, pointAreaY, pointAreaX + pointAreaW - 1, pointAreaY + pointAreaH - 1, tx0, ty0, tx1, ty1, tx2, ty2
	points( 0, 0) = double(tx0), double(ty0)
	points( 0, 1) = double(tx1), double(ty1)
	points( 0, 2) = double(tx2), double(ty2)
	pointsCount = 3
	;三角形登録
	newmod Triangle, modTriangle, 0,1,2, points

	return

;------------------------
;	点の追加
#deffunc DelaunayAddPoint double tx, double ty
	;	点リストに追加
	points( 0, pointsCount) = tx, ty
	pc = pointsCount
	pointsCount++

	;
	;	すべての三角形リストから点が外接円に入っているか調べる
	;	内側にある場合は、三角形を再分割
	;
	foreach Triangle
		modTri_IsInsideCircumcircle Triangle(cnt), tx, ty
		if stat {
			;	点が三角形の外接円に入っている場合

			;	三角形削除
			modTri_GetPoints Triangle(cnt), t0, t1, t2	;	再分割のため頂点取得
			delmod Triangle(cnt)

			;	点を中心に三角形に再分割
			;	無限ループ回避、重複チェックのため仮領域に一旦登録
			newmod TriangleSub, modTriangle, pc, t0, t1, points
			newmod TriangleSub, modTriangle, pc, t1, t2, points
			newmod TriangleSub, modTriangle, pc, t2, t0, points
		}
	loop

	;	再分割三角形で重複するものは削除
	;	比較して一致する場合は両方削除
	foreach TriangleSub
		modTri_GetPoints TriangleSub(cnt), t0, t1, t2
		i = cnt
		foreach TriangleSub
			;	自分以外と比較する
			if i ! cnt {
				modTri_IsEquals TriangleSub(cnt), t0, t1, t2
				if stat {
					delmod TriangleSub(cnt)
					delmod TriangleSub(i)
					;mes "("+cnt+", "+i+")"+t0+", "+t1+", "+t2
				}
			}
		loop
	loop

	;	再分割三角形を三角形リストに登録
	;	本登録
	foreach TriangleSub
		modTri_GetPoints TriangleSub(cnt), t0, t1, t2
		newmod Triangle, modTriangle, t0, t1, t2, points
		;	仮領域削除
		delmod TriangleSub(cnt)
	loop

	return pointsCount

;------------------------
;	描画
#deffunc DelaunayDraw
	dim gx, 4
	dim gy, 4
	dim gc, 4
	gc = $FF0000, $00FF00, $0000FF, $0000FF

	;	点を描画
	r = 2
	repeat pointsCount
		x = points( 0, cnt)
		y = points( 1, cnt)
		circle x-r, y-r,  x+r, y+r, 1

		pos x, y
		;mes ""+cnt
	loop

	;	三角形描画
	;境界線は重複してもお構いなしで描画します。
	i = 0
	foreach Triangle
		modTri_GetPoints Triangle(cnt), t0, t1, t2
		;	外部三角形につながる三角形は採用しない
		if (t0 = 0)|(t0 = 1)|(t0 = 2) | (t1 = 0)|(t1 = 1)|(t1 = 2) | (t2 = 0)|(t2 = 1)|(t2 = 2) : continue

		;	面に色付けしてみる
		gx = int(points( 0, t0)), int(points( 0, t1)), int(points( 0, t2)), int(points( 0, t2))
		gy = int(points( 1, t0)), int(points( 1, t1)), int(points( 1, t2)), int(points( 1, t2))
		;gsquare -257, gx, gy, gc

		;	辺を描画
		line points( 0, t0), points( 1, t0), points( 0, t1), points( 1, t1)
		line points( 0, t1), points( 1, t1), points( 0, t2), points( 1, t2)
		line points( 0, t2), points( 1, t2), points( 0, t0), points( 1, t0)
		i++
	loop

	pos 0,0
	mes "三角形個数:"+i

	return

#global
;#################################################

;-------------------------------------------------------------------------------
;
;	仮実行スクリプト(デバッグ作業用)
;

;#####################################################################
;ここにはデバッグ作業用のスクリプトを記述します。
;ここを有効にするとこのファイル単独での実行が可能になります。
;
;0	:リリースモード 本体側から#includeで連結して動作させる場合です。
;1	:デバッグモード このファイル単品で動作確認が出来ます。
#if 1
	;	ここにデバッグ用コードを記述する

DelaunayIni
#define POINT_MAX 50

;
;	座標データを登録しながら分割
;
randomize
repeat POINT_MAX
;	x = double( rnd( ginfo_winx/2 )+ginfo_winx/4 )
;	y = double( rnd( ginfo_winy/2 )+ginfo_winy/4 )
	x = double( rnd( ginfo_winx/2 ) )*2.0
	y = double( rnd( ginfo_winy/2 ) )*2.0
	DelaunayAddPoint x, y
loop

;	作成したドロネー三角形を描画
DelaunayDraw

#endif
;#####################################################################

HSP 【HSP3】この文法でも動くことに驚いた

// これでも動く驚き
button : gosub "btn", *btn
// 普通はこれかと
;button gosub "btn", *btn
stop
*btn
	mes "click!"
return

HSP ツイートボタンの代わりをしてみるテスト

;
;	ツイートボタンの代わりをしてみるテスト
;
#include "shell32.as"
#define SW_SHOWDEFAULT 10

#include "hspinet.as"
#include "encode.as"

twitterUrl = "https://twitter.com/intent/tweet"
twUrl  = "http://www.google.co.jp/"
twText = "ツイート内に含める文字"
twVia  = "ツイート内に含まれるユーザー名"
twHashtags = "ハッシュタグ"

input twUrl,  ginfo_winx
input twText, ginfo_winx
input twVia,  ginfo_winx
input twHashtags, ginfo_winx
button "ツイート", *twt
stop

;	ツイートを実行
*twt
	dest = ""
	url = ""

	;	Shift_JISをUTF-8にしてからパーセントエンコーディング
	sjis2utf8n dest, twText
	urlencode urlTwText, dest
	sjis2utf8n dest, twVia
	urlencode urlTwVia, dest
	sjis2utf8n dest, twHashtags
	urlencode urlTwHashtags, dest
	;	ツイート用URLを作成
	url = twitterUrl +"?url="+ twUrl +"&text="+ urlTwText +"&via="+ urlTwVia +"&hashtags="+ twHashtags

	mes url
	ShellExecuteA 0, 0, varptr(url), "", "", SW_SHOWDEFAULT
	stop

HSP 【HSP3】ShellExecute

#include "shell32.as"
#define SW_SHOWDEFAULT 10

	url = "http://www.google.co.jp/search?q=ABCDEFGHIJKLMNOPQRSTUVWXYZ"
	url += "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
	url += "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
	url += "ABCDEFGHIJKLMNOPQRSTUVWXWZ"
	url += "ABCDEFGHIJKLMNOPQRSTUVWXWZ"
	url += "ABCDEFGHIJKLMNOPQRSTUVWXWZ"
	url += "ABCDEFGHIJKLMNOPQRSTUVWXWZ"
	url += "ABCDEFGHIJKLMNOPQRSTUVWXWZ"
	url += "ABCDEFGHIJKLMNOPQRSTUVWXWZ"
	url += "ABCDEFGHIJKLMNOPQRSTUVWXWZ"
	url += "0123456789"
	mes "size:"+strlen(url)
	ShellExecuteA 0, 0, varptr(url), "", "", SW_SHOWDEFAULT
Total Pages: 10 / 22« 先頭...8910111220...最後 »

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

タグ

最近投稿されたコード