ab.com コミュニティ

by **ganas** » 2006年7月02日(日) 19:30

「未知の文字列が開放・・・」というエラーを解消するため、ZeroStringなしで、String型をすべてBytePtrで処理しました(callocなどは一切使用せず)。「未知の文字列」エラーは解消されたのですが、相変わらずこのコンパイラクラッシュは解決しませんでした。

しかしMakeStr内部でZeroStringが動いているとはおもいませんでした。
ありがとうございます。

by **イグトランス** » 2006年7月02日(日) 18:40

その前に，そのコードではZeroStringを行う必要がありません。
なぜならMakeStrは内部で文字列のメモリを確保してくるためです。

ただZeroStringを取り除いたからと言ってコンパイラが黙りこくるのが直るかどうか自信はありませんが。
MakeStrだって結局はZeroStringを呼んでいることに変わりはありませんし。

by **ganas** » 2006年7月02日(日) 17:28

現在、次のような文字列処理用のプログラムを作っています。

ZeroStringを使って可変長文字列を処理しようとしたのですが、文字列の長さ(バイト数)が一定の長さ(バイト数)を超えた時点(その長さは未計測)で、BasicCompiler.exeが、エラーも出さずに、いきなりクラッシュしてコンパイルが停止します。

上記の条件を満たさない(一定の長さよりも短い)と、まったくエラーは発生しません。

このプログラムは、指定された文字列を、プログラムで解析して、StrPutに送り、TextOutで出力しています(ゲームなどである、色が途中で変わったり、太字になったりする処理を実現するためのプログラムで、StrPutは内部処理用の関数で、画面へ出力するにはStrOutを使用)。

[ここをクリックすると内容が表示されます]

※コード内の"\@"などと書かれているところは、正確には"￥@"と記述されています。

コード: 全て選択


'文字の描画

Sub StrPut(hTargetDC As HDC,dstr As BytePtr,x As Long,y As Long,fontName As BytePtr,fontSize As Integer,fontItalic As BOOL,fontUl As BOOL,fontStk As BOOL,col As Dword)
	Dim new_font As HFONT
	Dim old_font As HFONT

	'フォント作成
	new_font=CreateFont(
		fontSize,	'高さ
		0,		'横幅
		0,		'角度
		0,		' 文字単位の角度
		0,		'太さ
		fontItalic,		'斜体
		fontUl,		'下線
		fontStk,		'打ち消し
		SHIFTJIS_CHARSET,OUT_DEFAULT_PRECIS,CLIP_DEFAULT_PRECIS,
		DEFAULT_QUALITY,DEFAULT_PITCH,fontName)

	SetBkMode(hTargetDC,TRANSPARENT)			'背景モード設定
	old_font=SelectObject(hTargetDC,new_font)	'フォント選択
	SetTextColor(hTargetDC,col)					'フォントカラー設定
	TextOut(hTargetDC,x,y,dstr,lstrlen(dstr))	'出力
	SelectObject(hTargetDC,old_font)			'フォント復元
	DeleteObject(new_font)					'フォント消去
End Sub

'文字列の描画

Sub StrOut(hTargetDC As HDC,dstr As BytePtr,x As Long,y As Long,fontSize As Integer,outLine As BOOL,olCol As Dword)
	Dim tstr As String '取得した文字列
	Dim strCnt As Long '文字数ループ
	Dim strSX As Long '取得開始位置
	Dim retCnt As Long '改行の回数
	Dim strX As Long '現在のX位置
	Dim flgCmdExt As BytePtr '特殊コマンドフラグ
	Dim strCol As Dword '文字色
	Dim strBold As BOOL '太字フラグ
	Dim strItalic As BOOL '斜体フラグ
	Dim strUl As BOOL '下線フラグ
	Dim strStk As BOOL '取り消し線フラグ
	Dim fontList(1) As BytePtr 'フォントリスト
	Dim cExtFontname As Integer 'フォントリスト番号
	tstr = ZeroString(lstrlen(dstr))
	tstr = MakeStr(dstr)
	fontList(0) = "ＭＳ ゴシック"
	fontList(1) = "ＭＳ 明朝"
	cExtFontname = 0
	strCol = RGB(255,255,255)
	strX = 0
	strSX = 1
	For strCnt = 1 To lstrlen(tstr) \ 2
		'特殊コマンドチェック ---
			'通常のコマンドを検出する
			Select Case Mid$(MakeStr(tstr),strSX,2)
				Case "\@" '改行
					strX = 0
					retCnt = retCnt + 1
					Goto *SkipOutChar
				Case "\%" '太字にするか(このコマンドが実行されるたび、設定が変わる)
					If strBold = TRUE Then 
						strBold = FALSE
					ElseIf strBold = FALSE Then 
						strBold = TRUE
					End If
					Goto *SkipOutChar
				Case "\/" '斜体にするか(このコマンドが実行されるたび、設定が変わる)
					If strItalic = TRUE Then 
						strItalic = FALSE
					ElseIf strItalic = FALSE Then 
						strItalic = TRUE
					End If
					Goto *SkipOutChar
				Case "\_" '下線をつけるか(このコマンドが実行されるたび、設定が変わる)
					If strUl = TRUE Then 
						strUl = FALSE
					ElseIf strUl = FALSE Then 
						strUl = TRUE
					End If
					Goto *SkipOutChar
				Case "\-" '取り消し線をつけるか(このコマンドが実行されるたび、設定が変わる)
					If strStk = TRUE Then 
						strStk = FALSE
					ElseIf strStk = FALSE Then 
						strStk = TRUE
					End If
					Goto *SkipOutChar
				Case "\r" '文字色を赤に
					strCol = RGB(255,0,0)
					Goto *SkipOutChar
				Case "\g" '文字色を緑に
					strCol = RGB(0,255,0)
					Goto *SkipOutChar
				Case "\b" '文字色を青に
					strCol = RGB(0,0,255)
					Goto *SkipOutChar
				Case "\y" '文字色を黄色に
					strCol = RGB(255,255,0)
					Goto *SkipOutChar
				Case "\a" '文字色を水色に
					strCol = RGB(105,180,255)
					Goto *SkipOutChar
				Case "\o" '文字色をオレンジに
					strCol = RGB(255,125,0)
					Goto *SkipOutChar
				Case "\d" '文字色を黒に
					strCol = RGB(0,0,0)
					Goto *SkipOutChar
				Case "\h" '文字色を灰色に
					strCol = RGB(155,155,155)
					Goto *SkipOutChar
				Case "\w" '文字色を白に
					strCol = RGB(255,255,255)
					Goto *SkipOutChar
				Case "\*" 'フォント名(番号指定)
					flgCmdExt = "fontname"
					'コマンドヘッダがない
					If Mid$(MakeStr(tstr),strSX + 2,1) <> "{" Then
						Goto *DrawMsg
					End If
					strSX = strSX + 2
				Case Else
					Goto *DrawMsg
			End Select

			'値を直接指定できるコマンドを検出する
			If MakeStr(flgCmdExt) <> "" Then
				'要素を取り出す
				Dim getCmdExt As BytePtr,cntSPos As Long,CEStartPos As Long
				For cntSPos = strSX To lstrlen(tstr)
					'コマンドフッタ発見
					If Mid$(tstr,cntSPos + 1,1) = "}" Then
						CEStartPos = InStr(1,Mid$(MakeStr(tstr),strSX + 1,cntSPos),"}") - 1
						getCmdExt = StrPtr(ByVal Left$(Mid$(MakeStr(tstr),strSX + 1,CEStartPos),CEStartPos))
						Exit For
					End If
					'コマンドフッタ無し
					If cntSPos >= lstrlen(tstr) Then
						Goto *SkipOutChar
					End If
					Sleep(1)
				Next cntSPos
				'要素のチェック
				Select Case MakeStr(flgCmdExt)
					Case "fontname"
						cExtFontname = Val(MakeStr(getCmdExt))
				End Select
				flgCmdExt = ""
				If (lstrlen(MakeStr(getCmdExt)) Mod 2) = 0 Then
					strSX = strSX + CEStartPos
					Goto *SkipOutChar
				Else
					strSX = strSX + (CEStartPos + 2)
					Goto *SkipOutChar2
				End If
			Else
				flgCmdExt = ""
				Goto *SkipOutChar
			End If
		'---

		'描画
		*DrawMsg
		If outLine = TRUE And strBold = FALSE Then
			StrPut(hTargetDC,Mid$(MakeStr(tstr),strSX,2),x + ((strX * fontSize) - 1),y + (retCnt * fontSize),fontList(cExtFontname),fontSize,strItalic,strUl,strStk,olCol)
			StrPut(hTargetDC,Mid$(MakeStr(tstr),strSX,2),x + (strX * fontSize),y + ((retCnt * fontSize) - 1),fontList(cExtFontname),fontSize,strItalic,strUl,strStk,olCol)
			StrPut(hTargetDC,Mid$(MakeStr(tstr),strSX,2),x + ((strX * fontSize) + 1),y + (retCnt * fontSize),fontList(cExtFontname),fontSize,strItalic,strUl,strStk,olCol)
			StrPut(hTargetDC,Mid$(MakeStr(tstr),strSX,2),x + (strX * fontSize),y + ((retCnt * fontSize) + 1),fontList(cExtFontname),fontSize,strItalic,strUl,strStk,olCol)		
		End If
		StrPut(hTargetDC,Mid$(MakeStr(tstr),strSX,2),x + (strX * fontSize),y + (retCnt * fontSize),fontList(cExtFontname),fontSize,strItalic,strUl,strStk,strCol)
		If strBold = TRUE Then 
			StrPut(hTargetDC,Mid$(MakeStr(tstr),strSX,2),x + ((strX * fontSize) + 1),y + (retCnt * fontSize),fontList(cExtFontname),fontSize,strItalic,strUl,strStk,strCol)
		End If
		strX = strX + 1

	 	*SkipOutChar
		strSX = strSX + 2
		*SkipOutChar2
		Sleep(1)
		If strSX > lstrlen(tstr) Then Exit For
	Next strCnt
End Sub

ab.com コミュニティ

可変長文字列の処理がうまくいってない？

返信する

展開ビュートピックのレビュー: 可変長文字列の処理がうまくいってない？

可変長文字列の処理がうまくいってない？

可変長文字列の処理がうまくいってない？

返信する

展開ビュー トピックのレビュー: 可変長文字列の処理がうまくいってない？

可変長文字列の処理がうまくいってない？

展開ビュートピックのレビュー: 可変長文字列の処理がうまくいってない？