'スタイルシートON/OFF切替
'代替スタイルシートがタイトル付で用意されている場合は選択できます。
'設定フォルダの直下にあるresourceフォルダ下のscript フォルダに
' 通常版：C:\Documents and Settings\ユーザ名\Application Data\Lunascape\Lunascape5\resource\script
' アーカイブ版：UserSetting\2.0\resource\script
'LunaUser.css と言うファイル名でスタイルシートを用意し、選択時に 99
'と入力すればそのスタイルシートが適用されます。
'（以後、同じアクティブタブで更新をしない限り、スタイルシートのリストの
'　最後に LunaUser と言うタイトルが表示されます。その番号を選択すれば
'　LunaUser.css が適用されます）
'99 でのスタイルシート追加は、一度だけにして下さい。


Option Explicit
Dim luna,dcid,document,window,ssNumber,i
Dim fNumber,iNumber,f,sstitle,seltitle,strmess

main()

'-------------------------------------------------------------------------------
' Sub main
'-------------------------------------------------------------------------------
Sub main()
	Dim lunascape,nActiveIndex,idDocument
	Set lunascape = CreateObject("Lunascape2.LunascapeAPI")
	nActiveIndex = lunascape.ActiveIndex
	idDocument = lunascape.GetDocumentID(nActiveIndex)
	If lunascape.EngineType(nActiveIndex) = "{248B8F5D-FAE2-4f0e-9EC9-3B408DBF0B2B}" Then
		' Tridentの場合はGetDocumentObjectを利用します
		SwichCSSWithGetDocumentObject lunascape, idDocument
	Else
		' Gecko,WebKitの場合はjsでDOMを操作します
		SwichCSSWithExecuteJavaScript lunascape, idDocument
	End If
End Sub

'-------------------------------------------------------------------------------
' Sub SwichCSSWithGetDocumentObject
'-------------------------------------------------------------------------------
Sub SwichCSSWithGetDocumentObject( lunascape, idDocument)

	On Error Resume Next
	Set luna = lunascape
	dcid = idDocument
	Set document = luna.GetDocumentObject(dcid)
	Set window = luna.GetWindowObject(dcid)
	If Err.Number <> 0 Then fin



	If document Is Nothing Then
			Call luna.MessageBox("无法创建文档对象。")
	Else

		iNumber = document.all.tags("IFRAME").length
		fNumber = document.Frames.length - iNumber

		If fNumber = 0 Then 

			On Error Resume Next
			ssNumber = document.styleSheets.length -1
			If Err.Number <> 0 Then fin

			ssselect
				For i = 0 To ssNumber
					document.styleSheets(i).disabled = true
				Next
			If seltitle = 99 Then addss
			If seltitle <> 0 and seltitle <> 99 Then
				document.styleSheets(seltitle - 1).disabled = false
			End If

		Else

			fNumber = document.Frames.length

			For f = 0 To fNumber-1

				On Error Resume Next
				ssNumber = window.Frames(f).document.styleSheets.length -1
				If Err.Number <> 0 Then fin

				ssselectf(f)
				If seltitle <> "" and IsNumeric(seltitle) = true Then

					For i = 0 To ssNumber
						window.Frames(f).document.styleSheets(i).disabled = true
					Next
					If seltitle = 99 Then addssf(f)
					If seltitle <> 0 and seltitle <> 99 Then
						window.Frames(f).document.styleSheets(seltitle - 1).disabled = false
					End If
				End If
			Next

		End If

	End If

	Set window = Nothing
	Set document = Nothing
	Set luna = Nothing
End Sub

Sub fin
	Set window = Nothing
	Set document = Nothing
	Set luna = Nothing
	WScript.Quit
End Sub

Sub ssselect
	strmess = "0 : 样式表关闭" & chr(13)

	If ssNumber > -1 Then
		For i = 0 To ssNumber
			sstitle = document.styleSheets(i).title
			if sstitle = "" Then
				sstitle = "样式表" & i +1
			End If
			strmess = strmess & i + 1 & " : " & sstitle & chr(13)
		Next
	End If

	seltitle = InputBox(strmess,"样式表选择",0)
	If seltitle = "" or IsNumeric(seltitle) = false Then fin
End Sub

Sub ssselectf(f)
	strmess = "0 : 样式表关闭" & chr(13)

	If ssNumber > -1 Then
		For i = 0 To ssNumber
			sstitle = window.Frames(f).document.styleSheets(i).title
			if sstitle = "" Then
				sstitle = "样式表" & i +1
			End If
			strmess = strmess & i +1 & " : " & sstitle & chr(13)
		Next
	End If

	seltitle = InputBox(strmess,"Frames No." & f & " : 样式表选择",0)
End Sub

Sub addss
	On Error Resume Next
	document.createStyleSheet(luna.ScriptPath & "LunaUser.css").title = "LunaUser"
	If Err.Number <> 0 Then fin
End Sub

Sub addssf(f)
	On Error Resume Next
	window.Frames(f).document.createStyleSheet(luna.ScriptPath & "LunaUser.css").title = "LunaUser"
	If Err.Number <> 0 Then fin
End Sub
'-------------------------------------------------------------------------------
' ここまで SwichCSSWithGetDocumentObject 関連
'-------------------------------------------------------------------------------


'-------------------------------------------------------------------------------
' Sub SwichCSSWithExecuteJavaScript
'-------------------------------------------------------------------------------
Sub SwichCSSWithExecuteJavaScript(lunascape,idDocument)
	' アクティブなタブでJavaScriptを実行します。
	Dim UserCss, UserCssPath
	UserCssPath = "" & lunascape.ScriptPath & "LunaUser.css"

	Dim ForReading
	ForReading = 1

	Dim objFileSys
	Dim objInFile

	'ファイルシステムオブジェクトの作成
	Set objFileSys = CreateObject("Scripting.FileSystemObject")
	If objFileSys Is Nothing Then
		' ユーザーCSSが読めない場合は空のCSS（Trident準拠）
		UserCss = ""	
	Else
		'ファイルの存在確認
		If objFileSys.FileExists(UserCssPath) Then
			'ファイルのオープン
			Set objInFile = objFileSys.OpenTextFile(UserCssPath,ForReading)
			'ファイルのオープンが成功のときはErr.Numberが0
			If Err.Number=0 Then
				'ファイルの全ての内容をすべて読む
				UserCss = objInFile.ReadAll
				'ファイルのクローズ
				objInFile.Close

				' js命令文字列中に現れるとまずい文字をエスケープ
				Dim reg
				Set reg = New RegExp
				' js命令文字列が途中で終わらないように "→"" '→"" 
				reg.Pattern = "[""']"
				reg.Global  = true
				UserCss = reg.Replace(UserCss, """""")
				' 代入行が途中で終わらないように改行を削除
				reg.Pattern = "[\n\r]"
				reg.Global  = true
				UserCss = reg.Replace(UserCss, "")

			'ファイルのオープンが失敗のときはErr.Numberが0以外
			Else
				' ユーザーCSSが読めない場合は空のCSS（Trident準拠）
				UserCss = ""
			End If
		Else
			' ユーザーCSSがない場合は空のCSS（Trident準拠）
			UserCss = ""
		End If
	End If

	'オブジェクトの破棄
	Set objFileSys = Nothing
	Set objInFile = Nothing

	' CjsでDOM操作をしてCSSを切り替え
	' StyleSheet,Alternate StyleSheetのリストを作ってユーザーに選択させる
	' 選択値が有効範囲内の場合、一度すべてのスタイルシートを無効化する
	' 99=ユーザー定義す対スリーとが選択された場合、読み込んだテキストをそのままスタイルシートとして追加する
	' 既存のスタイルシートが選択された場合、選択されたものを有効化する
	lunascape.ExecuteJavaScript idDocument, "var sslen = document.styleSheets.length;var promptext = '样式表选择\n0 : 样式表关闭';for(var i = 0; i < sslen; i++){var sstitle = document.styleSheets[i].title;if((sstitle=='')||((sstitle==null)))sstitle='样式表' + (i+1);promptext += '\n' + (i+1) + ' : ' + sstitle;}var selectedss = window.prompt(promptext, '');var fNumber = window.frames.length;var iNumber = document.getElementsByTagName('IFRAME').length;if((0 <= selectedss && selectedss <= sslen)||(selectedss==99)){for(var i = 0; i < sslen; i++){document.styleSheets[i].disabled = true;}var usercss = document.getElementById('LunaUsercss');if(usercss!=null){usercss.parentNode.removeChild(usercss);}if(selectedss == 99){var el = document.createElement('style');el.type = 'text/css';el.id = 'LunaUsercss';el.title = 'LunaUser';var ssbody = document.createTextNode('" & UserCss & "');el.appendChild(ssbody);document.getElementsByTagName('head')[0].appendChild(el);el.disabled = false;}else{document.styleSheets[(selectedss-1)].disabled = false;}}void(null);"
End Sub
