ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2024年3月29日(金) 11:38

全ての表示時間は UTC+09:00 です




新しいトピックを投稿する  トピックへ返信する  [ 7 件の記事 ] 
作成者 メッセージ
 記事の件名: 初めまして
投稿記事Posted: 2005年7月04日(月) 19:40 
オフライン

登録日時: 2005年7月04日(月) 19:29
記事: 18
お住まい: 愛知県
初めまして、刈谷です。
.txtファイルの文字を読み込んで、文字により実行する内容を変えるプログラムを作っておりますが、8文字以上.txtファイルに書き込むとアプリケーションエラーが出でしまいます。
何故なのか教えて下さい。

-------------------------------------------------------
Dim Buf As String
Dim tmp As String
Dim i As Long

Open "a.txt" For Input As 1
Field #1,Lof(1) 'ファイル内のデータをすべて読み込む
Get #1,1,Buf
Close 1

For i=1 to Len(Buf)
tmp = Mid$(Buf,i,1) '読み込んだデータから一文字ずつ取り出す
Select Case tmp
Case "a"
'aの時にすること
Case "b
   'bの時にすること
Case "c
   'cの時にすること
   End Select
Next


通報する
ページトップ
 記事の件名:
投稿記事Posted: 2005年7月04日(月) 22:46 
こちらでは正常に動作してますが・・・どのバージョンのABでしょうか?
私はAB4.02.01です。


通報する
ページトップ
   
 記事の件名: Re.
投稿記事Posted: 2005年7月05日(火) 20:56 
オフライン

登録日時: 2005年7月04日(月) 19:29
記事: 18
お住まい: 愛知県
> こちらでは正常に動作してますが・・・どのバージョンのABでしょうか?

私もAB4.02.01を使っております。他のコードがいけないのでしょうか?
かなり目茶目茶ですが、指摘してください。お願いします。

-------------------------------------------------
Function MakeSolidBmp(ByRef pColor As RGBQUAD, ByVal dwWidth As DWord, ByVal dwHeight As DWord, ByRef lpFileData As BytePtr) As DWord
' 変数の宣言
Dim pBmpFileHeader As BITMAPFILEHEADER ' BITMAPFILEHEADER構造体
Dim pBmpInfoHeader As BITMAPINFOHEADER ' BITMAPINFOHEADER構造体
Dim dwLineLen As DWord ' 1走査線のサイズ
Dim lpLineData As BytePtr ' 1走査線の画像データ
Dim i As Long

' 1走査線のサイズを求める
dwLineLen = Raise(dwWidth * 3 / 4) * 4

' 1走査線の画像データの生成
lpLineData = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, dwLineLen)
For i = 0 To dwWidth - 1
memcpy(lpLineData + i * 3, VarPtr(pColor), 3)
Next

' BITMAPFILEHEADER構造体の設定
FillMemory(VarPtr(pBmpFileHeader), Len(pBmpFileHeader), 0) ' 構造体の初期化
With pBmpFileHeader
memcpy(VarPtr(.bfType), "BM", 2) ' ファイルタイプ
.bfSize = dwLineLen * dwHeight + &H36 ' ファイルサイズ
.bfOffBits = &H36 ' 画像データまでのオフセット
End With

' BITMAPINFOHEADER構造体の設定
FillMemory(VarPtr(pBmpInfoHeader), Len(pBmpInfoHeader), 0) ' 構造体の初期化
With pBmpInfoHeader
.biSize = 1 ' ヘッダサイズ
.biWidth = dwWidth ' BMPの幅
.biHeight = dwHeight ' BMPの高さ
.biPlanes = 1 ' プレーン数
.biBitCount = 24 ' ビット数
.biCompression = BI_RGB ' 圧縮の種類
.biSizeImage = dwLineLen * dwHeight ' 画像データ部のサイズ
End With

' ファイルヘッダのコピー
lpFileData = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, pBmpFileHeader.bfSize) ' ヒープ領域の確保
memcpy(lpFileData, VarPtr(pBmpFileHeader), 14) ' BITMAPFILEHEADER構造体のデータをコピー
memcpy(lpFileData + 14, VarPtr(pBmpInfoHeader), 40) ' BITMAPINFOHEADER構造体のデータをコピー

' 画像データの生成
For i = 0 To dwHeight - 1
memcpy(lpFileData + 54 + i * dwLineLen, lpLineData, dwLineLen)
Next
Dim x As Long
Dim y As Long
Dim Color As RGBQUAD
x = -1
y = 0

Dim Buf As String
Dim tmp As String
Dim io As Long

Open "a.txt" For Input As 1
Field #1,Lof(1) 'ファイル内のデータをすべて読み込む
Get #1,1,Buf
Close 1

For io=1 to Len(Buf)
tmp = Mid$(Buf,io,1) '読み込んだデータから一文字ずつ取り出す
Select Case tmp
Case "a"
With Color
.rgbBlue = 0 ' BLUE
.rgbGreen = 0 ' GREEN
.rgbRed = 255 'RED
End With

Case "b"
With Color
.rgbBlue = 0 ' BLUE
.rgbGreen = 255 ' GREEN
.rgbRed = 0 'RED
End With

Case "c"
With Color
.rgbBlue = 255 ' BLUE
.rgbGreen = 0 ' GREEN
.rgbRed = 0 'RED
End With
End Select

x = x + 1 ' 色を変えたい部分のx座標
y = y ' 色を変えたい部分のy座標
If x = 100 Then
y = y + 1
x = 0
End If
memcpy(lpFileData + 54 + dwLineLen * (dwHeight - y - 1) + x * 3, VarPtr(Color), 3)

' ヒープ領域の解放
HeapFree(GetProcessHeap(), 0, lpLineData)

' 戻り値
MakeSolidBmp = pBmpFileHeader.bfSize
Next
End Function

' 切り上げ関数
'
' 【引数】
' dbNum: 切り上げする数値
' 【戻り値】
' 切り上げされた数値
Function Raise(ByVal dbNum As Double) As Long
If Fix(dbNum) = dbNum or dbNum < 0 Then
Raise = Fix(dbNum)
Else
Raise = Fix(dbNum) + 1
End If
End Function

' 使用 (100×100のBMPの保存)
' 変数の宣言
Dim pColor As RGBQUAD
Dim lpFileData As BytePtr ' ファイルデータ
Dim dwFileSize As DWord ' BMPファイルのサイズ
Dim hFile As DWord ' ファイルハンドル
Dim lpNumberOfBytesWritten As DWord ' 書き込まれたファイルサイズ

' 色の設定
With pColor
.rgbBlue = 0 ' BLUE
.rgbGreen = 0 ' GREEN
.rgbRed = 0 'RED
End With

' BMPの生成
dwFileSize = MakeSolidBmp(pColor, 100, 100, lpFileData)

' ファイルの保存(同フォルダの"test.bmp"に保存)
hFile = CreateFile("test.bmp", GENERIC_WRITE, 0, ByVal NULL, CREATE_ALWAYS, FILE_FLAG_RANDOM_ACCESS, 0) ' ファイルの作成
WriteFile(hFile, lpFileData, dwFileSize, VarPtr(lpNumberOfBytesWritten), ByVal NULL) ' ファイル書き込み
SetEndOfFile(hFile) ' ファイルサイズの調整
CloseHandle(hFile) ' ファイルハンドルを閉じる

' ヒープ領域を開放
HeapFree(GetProcessHeap(), 0, lpFileData)

Close #1
' プログラムの終了
End


通報する
ページトップ
 記事の件名: Re: Re.
投稿記事Posted: 2005年7月06日(水) 00:48 
オフライン

登録日時: 2005年5月31日(火) 17:59
記事: 899
お住まい: 東京都
1走査線の大きさを求める所やその他少々おかしい点を直してみました。
元のコードと見比べてみて下さい。

もう少し改良の余地はありますが,見比べやすいよう敢えてそのままにしています。
Function MakeSolidBmp(ByRef InitColor As RGBQUAD, ByVal dwWidth As DWord, ByVal dwHeight As DWord, ByRef lpFileData As BytePtr) As DWord
' 変数の宣言
Dim BmpFileHeader As BITMAPFILEHEADER ' BITMAPFILEHEADER構造体
Dim BmpInfoHeader As BITMAPINFOHEADER ' BITMAPINFOHEADER構造体
Dim dwLineLen As DWord ' 1走査線のサイズ
Dim lpLineData As BytePtr ' 1走査線の画像データ
Dim pBitmap As BytePtr
Dim i As Long

' 1走査線のサイズを求める
dwLineLen = ((dwWidth * 3 - 1) And (Not &h3)) + 4

' 1走査線の画像データの生成
lpLineData = calloc(dwLineLen)
For i = 0 To dwWidth - 1
memcpy(lpLineData + i * 3, VarPtr(InitColor), 3)
Next

' BITMAPFILEHEADER構造体の設定
ZeroMemory(VarPtr(BmpFileHeader), Len(BmpFileHeader)) ' 構造体の初期化
With BmpFileHeader
.bfType = GetWord("BM") ' ファイルタイプ
.bfSize = dwLineLen * dwHeight + SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER) ' ファイルサイズ
.bfOffBits = SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER) ' 画像データまでのオフセット
End With

' BITMAPINFOHEADER構造体の設定
ZeroMemory(VarPtr(BmpInfoHeader), Len(BmpInfoHeader)) ' 構造体の初期化
With BmpInfoHeader
.biSize = SizeOf(BITMAPINFOHEADER) ' ヘッダサイズ
.biWidth = dwWidth ' BMPの幅
.biHeight = dwHeight ' BMPの高さ
.biPlanes = 1 ' プレーン数
.biBitCount = 24 ' ビット数
.biCompression = BI_RGB ' 圧縮の種類
.biSizeImage = dwLineLen * dwHeight ' 画像データ部のサイズ
End With

' ファイルヘッダのコピー
lpFileData = calloc(BmpFileHeader.bfSize) ' ヒープ領域の確保
pBitmap = lpFileData + BmpFileHeader.bfOffBits
memcpy(lpFileData, VarPtr(BmpFileHeader), Len(BmpFileHeader)) ' BITMAPFILEHEADER構造体のデータをコピー
memcpy(lpFileData + Len(BmpFileHeader), VarPtr(BmpInfoHeader), Len(BmpInfoHeader)) ' BITMAPINFOHEADER構造体のデータをコピー

' 画像データの生成
For i = 0 To dwHeight - 1
memcpy(lpFileData + SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER) + i * dwLineLen, lpLineData, dwLineLen)
Next
Dim x = 0 As Long
Dim y = 0 As Long
Dim Color As RGBQUAD

Dim Buf As String
Dim tmp As String
Dim io As Long

Open "c:\temp\test.txt" For Input As 1
Field #1,Lof(1) 'ファイル内のデータをすべて読み込む
Get #1,1,Buf
Close 1

With Color
For io=0 to Len(Buf)
tmp = Chr$(Buf[io]) '読み込んだデータから一文字ずつ取り出す
Select Case tmp
Case "a"
.rgbBlue = 0
.rgbGreen = 0
.rgbRed = 255
Case "b"
.rgbBlue = 0
.rgbGreen = 255
.rgbRed = 0

Case "c"
.rgbBlue = 255
.rgbGreen = 0
.rgbRed = 0
End Select

If x = dwWidth Then
y = y + 1
x = 0
If y = dwHeight Then
Exit For
End If
End If
memcpy(pBitmap + dwLineLen * (dwHeight - y - 1) + x * 3, VarPtr(Color), 3)
x = x + 1 ' 色を変えたい部分のx座標
Next
End With

' ヒープ領域の解放
free(lpLineData)

' 戻り値
MakeSolidBmp = BmpFileHeader.bfSize
End Function

' 使用 (100×100のBMPの保存)
' 変数の宣言
Dim Color As RGBQUAD
Dim lpFileData As BytePtr ' ファイルデータ
Dim dwFileSize As DWord ' BMPファイルのサイズ
Dim hFile As DWord ' ファイルハンドル
Dim NumberOfBytesWritten As DWord ' 書き込まれたファイルサイズ

' 色の設定
With Color
.rgbBlue = 0
.rgbGreen = 127
.rgbRed = 0
End With

' BMPの生成
dwFileSize = MakeSolidBmp(Color, 100, 100, lpFileData)
' ファイルの保存
hFile = CreateFile("c:\temp\test.bmp", GENERIC_WRITE, 0, ByVal NULL, CREATE_ALWAYS, 0, 0) ' ファイルの作成
WriteFile(hFile, lpFileData, dwFileSize, VarPtr(NumberOfBytesWritten), ByVal NULL) ' ファイル書き込み
CloseHandle(hFile) ' ファイルハンドルを閉じる

' ヒープ領域を開放
free(lpFileData)

' プログラムの終了
End


通報する
ページトップ
 記事の件名: Re.
投稿記事Posted: 2005年7月06日(水) 21:14 
オフライン

登録日時: 2005年7月04日(月) 19:29
記事: 18
お住まい: 愛知県
イグトランス様、ありがとう御座います。

早速試させてもらいましたが、2行目以降が2マスずれてしまいます。
何故なのですか?教えてください。


通報する
ページトップ
 記事の件名:
投稿記事Posted: 2005年7月06日(水) 22:15 
オフライン

登録日時: 2005年5月31日(火) 17:59
記事: 899
お住まい: 東京都
もしかして改行を入れてませんか?
元のコードが改行文字を扱っていないようでしたのでそのままにしていました。
ならばyを増やすときに改行文字の判定を組み込めばいいと言うことになります。

'ここまでは元と同じ。
For io=0 to Len(Buf)
If x = dwWidth Then
y = y + 1
x = 0
If y = dwHeight Then
Exit For
ElseIf Mid$(Buf, io + 1, 2) = Ex"\r\n" Then
io = io + 2
Else
free(lpFileData)
free(lpLineData)
lpFileData = NULL
MakeSolidBmp = 0
Exit Function
End If
End If
tmp = Chr$(Buf[io]) '読み込んだデータから一文字ずつ取り出す
Select Case tmp ' 以下同じ
もちろん呼ぶほうもたとえばこのようにエラーを検知する必要があります。
dwFileSize = MakeSolidBmp(Color, 100, 100, lpFileData)
If dwFileSize = 0 Then
MessageBox(0, "ファイル形式が異常です。", 0, MB_ICONSTOP)
End
End If


通報する
ページトップ
 記事の件名: Re.
投稿記事Posted: 2005年7月07日(木) 13:52 
オフライン

登録日時: 2005年7月04日(月) 19:29
記事: 18
お住まい: 愛知県
> もしかして改行を入れてませんか?

はい、入れていました。
> ならばyを増やすときに改行文字の判定を組み込めばいいと言うことになります。

なるほど、そういう風にするのですか。

うまくできました、詳しい解説ありがとう御座います。


通報する
ページトップ
期間内表示:  ソート  
新しいトピックを投稿する  トピックへ返信する  [ 7 件の記事 ] 

全ての表示時間は UTC+09:00 です


オンラインデータ

このフォーラムを閲覧中のユーザー: Ahrefs [Bot] & ゲスト[23人]


トピック投稿:  可
返信投稿:  可
記事編集: 不可
記事削除: 不可
ファイル添付: 不可

検索:
ページ移動:  
Powered by phpBB® Forum Software © phpBB Limited
Japanese translation principally by ocean