'**********************************
'cookie作
'F-BASICで、システムカラーを使うルーチン
'プロパティーで「テキストモード」を「ピクセルモード」
'に切り換えて下さい。
'CLS命令で、WINDOW色がシステム色に変わります。
'CLS命令の後WINDOWを表示させるようにすると、
'よりきれいになります。
'**********************************
'使用例
'SETFORECOLOR SYS_COL(2)
'connect(X1,Y2-1)-(X1,Y1)-(X2,Y1)
'SETFORECOLOR SYS_COL(3)
'connect(X1+1,Y2)-(X2,Y2)-(X2,Y1+1)
'X1,X2,Y1,Y2に変数を代入してこれを実行すると、
'きれいな枠ができます。
'
'その他のグラフィック命令で使うときも、
'SETFORECOLORで色を設定し、命令文に色情報を入れずに書くと、
'使えます。詳しくは、cookie@kitcc.orgまで
'**********************************

#include "windows.bi"

'**********************************
'ファンクションの宣言
'**********************************
declare function REGOPENKEYEX& lib "ADVAPI32.DLL" alias "RegOpenKeyExA" ( byval HKEY&, byval KEYBUF$, byval RESERVE&, byval SAM&, HKEYADR& )
declare function REGQUERYVALUEEX& lib "ADVAPI32.DLL" alias "RegQueryValueExA" ( byval HKEY&, byval VALNAME$, byval RESERVEADR&, TYPEADR&, byval DATAADR$, DATASIZE& )
declare sub REGCLOSEKEY lib "ADVAPI32.DLL" alias "RegCloseKey" ( byval HKEY& )
declare sub GETSYSCOL bdecl (NAME$,NUM%)

'**********************************
'変数の宣言
'**********************************
var shared HKEY as long
var shared KEYBUF as string * 64
var shared TYPEADR as long
var shared DATAADR as string * 64
var shared DATASIZE as long
var shared VALNAME as string * 20
var shared RESULT as long
var shared MSG as string

SYS_RGB=-1
var shared SYS_COL(5) as long

'**********************************
'定数の宣言
'**********************************

#define HKEY_CURRENT_USER	-2147483647
#define KEY_QUERY_VALUE	1

'**************************************
'Winowsの色にするためのプログラム
'**************************************
'SYS_COL(n)変数
'0…バックカラー
'1…フォアカラー
'*2…陰影色
'*3…光沢色
'*4…アクティブウィンドウバーの色
'*5…非アクティブウィンドウバーの色

'レジストリが読めなかった時用
SYS_COL(0)=RGB(&H88,&H88,&H88)
SYS_COL(1)=RGB(&H0,&H0,&H0)
SYS_COL(2)=RGB(&H44,&H44,&H44)
SYS_COL(3)=RGB(&HBB,&HBB,&HBB)
SYS_COL(4)=RGB(&H0,&H0,&H88)
SYS_COL(5)=RGB(&H44,&H44,&H44)

'*変数設定
KEYBUF = "Control Panel\Colors"+chr$(0)
TYPEADR = 1
DATASIZE = len( DATAADR$ )
'*レジストリのオープン
RESULT = REGOPENKEYEX(HKEY_CURRENT_USER, KEYBUF, 0, KEY_QUERY_VALUE, HKEY)
if RESULT <> 0 then
	RESULT=MESSAGEBOX( GETWINDOWTEXT, "レジストリがオープンできません(NO_REG_ERR)", 0, 0 )
	SYS_RGB=0
	goto *NOREG
endif

'*******************
'画面背景色
'*******************
GETSYSCOL "ActiveBorder",0

'*バックとして設定後塗る。
SETBACKCOLOR SYS_COL(0)
cls

'*******************
'画面フォアカラー
'*******************
GETSYSCOL "WindowText",1

'*フォアカラーとして登録
SETFORECOLOR SYS_COL(1)
SETTEXTCOLOR SYS_COL(1)

'*******************
'画面３Ｄ陰影色
'*******************
GETSYSCOL "ButtonShadow",2

'*******************
'画面３Ｄ光沢色
'*******************
GETSYSCOL "ButtonHilight",3

'*******************
'画面アクティブウィンドウバー色
'*******************
GETSYSCOL "ActiveTitle",4

'*******************
'画面非アクティブウィンドウバー色
'*******************
GETSYSCOL "InactiveTitle",5

'*******************************
'システムカラーの設定
'*******************************
sub GETSYSCOL (NAME$,NUM%)
	TYPEADR = 1
	DATASIZE = len( DATAADR$ )
	VALNAME = NAME$+chr$(0)
	RESULT = REGQUERYVALUEEX(HKEY, VALNAME, 0, TYPEADR, DATAADR, DATASIZE)
	if RESULT <> 0 then
		RESULT=MESSAGEBOX( GETWINDOWTEXT, "レジストリが読み取れません(NO_REG_ERR_Key=0)", 0, 0 )
		SYS_RGB=0
		goto *NOREGK
	endif
	'*数値化して変数に登録
	for RG_TXT%=2 to 4
		if mid$(DATAADR,RG_TXT%,1)=" " then
			for GB_TXT%=RG_TXT%+2 to RG_TXT%+4
				if mid$(DATAADR,GB_TXT%,1)=" " then
					for RGBE_TXT%=GB_TXT%+2 to GB_TXT%+4
						if mid$(DATAADR,RGBE_TXT%,1)<>right$(str$(val(mid$(DATAADR,RGBE_TXT%,1))),1) then
							goto *RGB_TXT
						endif
					next RGBE_TXT%
				endif
			next GB_TXT%
		endif
	next RG_TXT%
	*RGB_TXT
	SYS_COL(NUM%)=RGB(val(mid$(DATAADR,1,RG_TXT%-1)),val(mid$(DATAADR,RG_TXT%+1,GB_TXT%-RG_TXT%-1)),val(mid$(DATAADR,GB_TXT%+1,RGBE_TXT%-GB_TXT%-1)))
	*NOREGK
end sub

'*******************
'レジストリを閉じる
REGCLOSEKEY HKEY

*NOREG

'**********************************
'**********************************
'ここより下に通常のプログラムを書く。
'**********************************