|
とりあえず必要そうなパターンを列挙!!
'-----------------------------------------------------------------------
' 関数名 ： SequentialOutput
' 機能 ： １行ずつ健気に書き込む
' 引数 ： なし
' 戻り値 ： True…正常終了 False…異常終了
' 備考 ： 上書きモードと追加書き込みモードを併記しておく
'-----------------------------------------------------------------------
Public Function SequentialOutput() As Boolean
On Error GoTo ErrHandler
Dim FileNum As Integer
'ファイル番号取得
FileNum = FreeFile
'↓上書きモードでファイルを開いて出力する場合
Open "Sample01.txt" For Output As #FileNum
'↓追加書き込みモードでファイルを開いて出力する場合
'Open "Sample01.txt" For Append As #FileNum
Print #FileNum, "あいうえお"
',(カンマ)で区切ると何故かスペースが出力されてしまう
Print #FileNum, "かきくけこ", "さしすせそ"; ","; "ざじずぜぞ"
Print #FileNum, "たちつ";
Print #FileNum, "てと"
Print #FileNum, "なにぬねの"
'Writeとするとカンマ区切りで出力される
'出力される文字は ""(ダブル・クォーテーション)で囲まれる
Write #FileNum, "はひふへほ", "まみむめも", "やゐゆゑよ"
Close #FileNum
NormalExit:
SequentialOutput = True
Exit Function
ErrHandler:
Call MsgBox("エラーNo." & Err.Number & vbCrLf & vbCrLf & _
Err.Description, vbExclamation, "XXXXXXX - エラー")
End Function
[出力結果]
あいうえお
かきくけこ さしすせそ,ざじずぜぞ
たちつてと
なにぬねの
"はひふへほ","まみむめも","やゐゆゑよ"
'-----------------------------------------------------------------------
' 関数名 ： SequentialInput
' 機能 ： １行ずつ健気に読み込む
' 引数 ： なし
' 戻り値 ： True…正常終了 False…異常終了
' 備考 ： 読み込み方法をそれぞれ書いておく
'-----------------------------------------------------------------------
Public Function SequentialInput() As Boolean
On Error GoTo ErrHandler
Dim FileNum As Integer
Dim ReadLine1 As String
Dim ReadLine2 As String
Dim ReadLine3 As String
Dim ReadLine4 As String
Dim ReadLine5 As String
'ファイル番号取得
FileNum = FreeFile
'ファイルを開いて入力
Open "Sample01.txt" For Input As #FileNum
If Not EOF(FileNum) Then
'Input は「改行」または「カンマ」単位で読み込む
'CSVファイルを読むときは Input を使う
Input #FileNum, ReadLine1, ReadLine2, ReadLine3
Input #FileNum, ReadLine4
Input #FileNum, ReadLine5
End If
Debug.Print "=-=-=-=-=-=- Inputでの読み込み -=-=-=-=-=-="
Debug.Print "? 1：" & ReadLine1
Debug.Print "? 2：" & ReadLine2
Debug.Print "? 3：" & ReadLine3
Debug.Print "? 4：" & ReadLine4
Debug.Print "? 5：" & ReadLine5
'先頭にシーク
Seek #FileNum, 1
If Not EOF(FileNum) Then
'Line Input は「改行」単位で読み込む
Line Input #FileNum, ReadLine1
Line Input #FileNum, ReadLine2
Line Input #FileNum, ReadLine3
Line Input #FileNum, ReadLine4
Line Input #FileNum, ReadLine5
End If
Debug.Print "=-=-=-=-=-=- Line Inputでの読み込み -=-=-=-=-=-="
Debug.Print "? 1：" & ReadLine1
Debug.Print "? 2：" & ReadLine2
Debug.Print "? 3：" & ReadLine3
Debug.Print "? 4：" & ReadLine4
Debug.Print "? 5：" & ReadLine5
'先頭にシーク
Seek #FileNum, 1
Debug.Print "=-=-=-=-=-=- ループで１行ずつの読み込み -=-=-=-=-=-="
Do Until EOF(FileNum)
Line Input #FileNum, ReadLine1
Debug.Print "? 0：" & ReadLine1
Loop
Close #FileNum
NormalExit:
SequentialInput = True
Exit Function
ErrHandler:
Call MsgBox("エラーNo." & Err.Number & vbCrLf & vbCrLf & _
Err.Description, vbExclamation, "XXXXXXX - エラー")
End Function
[イミディエイトウィンドウの表示結果]
=-=-=-=-=-=- Inputでの読み込み -=-=-=-=-=-=
? 1：あいうえお
? 2：かきくけこ さしすせそ
? 3：ざじずぜぞ
? 4：たちつてと
? 5：なにぬねの
=-=-=-=-=-=- Line Inputでの読み込み -=-=-=-=-=-=
? 1：あいうえお
? 2：かきくけこ さしすせそ,ざじずぜぞ
? 3：たちつてと
? 4：なにぬねの
? 5："はひふへほ","まみむめも","やゐゆゑよ"
=-=-=-=-=-=- ループで１行ずつの読み込み -=-=-=-=-=-=
? 0：あいうえお
? 0：かきくけこ さしすせそ,ざじずぜぞ
? 0：たちつてと
? 0：なにぬねの
? 0："はひふへほ","まみむめも","やゐゆゑよ"
'-------------------------------------------------------------------
' 関数名：BinaryInput
' 機能 ：ファイル全体を一気に読み込む
' 引数 ：なし
' 返り値：なし
' 備考 ：エラー処理は面倒なので省略
'-------------------------------------------------------------------
Public Sub BinaryInput()
Dim TextDataBuff As String '文字列格納用バッファ
Dim FileNum As Integer 'ファイルナンバー
'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'バイナリモードで開いてString変数に一気に読み込む方法(３番目に速い)
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
'ファイル番号取得
FileNum = FreeFile
'Access Read を宣言すると読み込み専用となる
Open "Sample01.txt" For Binary Access Read As #FileNum
TextDataBuff = Input$(LOF(FileNum), #FileNum)
Close #FileNum
Debug.Print "[" & TextDataBuff & "]"
'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'バイナリモードで開いてByte配列変数に一気に読み込む方法(２番目に速い)
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Dim TextByteData() As Byte '文字列格納用バッファ(バイト配列)
Dim FileSize As Long
'ファイル番号取得
FileNum = FreeFile
Open "Sample01.txt" For Binary Access Read As #FileNum
FileSize = LOF(FileNum)
'ファイルサイズ分メモリー再確保
ReDim TextByteData(FileSize - 1) As Byte
TextByteData() = InputB(FileSize, #FileNum)
Close #FileNum
'ANSI → Unicode 変換
Debug.Print "[" & StrConv(TextByteData(), vbUnicode) & "]"
'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'バイナリモードで開いてGetメソッドで読み込む方法(１番速い)
'String変数でも出来るが、Byte配列変数を使用する。Byteの方が速いし!!
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
'ファイル番号取得
FileNum = FreeFile
Open "Sample01.txt" For Binary Access Read As #FileNum
'ファイルサイズ分メモリー再確保
ReDim TextByteData(FileSize - 1) As Byte
Get #FileNum, , TextByteData()
Close #FileNum
'ANSI → Unicode 変換
Debug.Print "[" & StrConv(TextByteData(), vbUnicode) & "]"
End Sub
[イミディエイトウィンドウの表示結果]
[あいうえお
かきくけこ さしすせそ,ざじずぜぞ
たちつてと
なにぬねの
"はひふへほ","まみむめも","やゐゆゑよ"
]
[あいうえお
かきくけこ さしすせそ,ざじずぜぞ
たちつてと
なにぬねの
"はひふへほ","まみむめも","やゐゆゑよ"
]
[あいうえお
かきくけこ さしすせそ,ざじずぜぞ
たちつてと
なにぬねの
"はひふへほ","まみむめも","やゐゆゑよ"
]
↓Putメソッドで可変データを出力するサンプル。
↓ここでは以下のビットマップを出力する。コーディングは極めてベタ書き。
■■■■■■■■■■■■■■■□
Private Type BITMAPFILEHEADER
bfType As Integer 'この構造体のタイプ
bfSize As Long 'ビットマップのファイルサイズ
bfReserved1 As Integer '予約、常に０
bfReserved2 As Integer '予約、常に０
bfOffBits As Long 'この構造体からビットマップデータまでのオフセット
End Type
Private Type BITMAPINFOHEADER
biSize As Long 'この構造体のサイズ
biWidth As Long 'ピクセルデータの幅
biHeight As Long 'ピクセルデータの高さ
biPlanes As Integer 'カラープレーンの高さ
biBitCount As Integer 'ピクセルあたりのビット数(1,4,8,24のどれか)
biCompression As Long 'ピクセルデータの圧縮形式
biSizeImage As Long 'ピクセルデータのサイズ
biXPelsPerMeter As Long '１mあたりの水平解像度
biYPelsPerMeter As Long '１mあたりの垂直解像度
biClrUsed As Long '使用するカラーインデックスの数
biClrImportant As Long '表示に使用するカラーインデックスの数(通常は０)
End Type
'16色用パレット
Private Type RGBQUAD
b As Byte
g As Byte
r As Byte
p As Byte '予約(0でよい)
End Type
'-------------------------------------------------------------------
' 関数名：OutputBitmap
' 機能 ：16色ビットマップを適当に出力
' 引数 ：なし
' 返り値：なし
' 備考 ：黒から白まで16色を出力する適当なサンプル
'-------------------------------------------------------------------
Public Sub OutputBitmap()
Dim udtBitmapFileHeader As BITMAPFILEHEADER
Dim udtBitmapInfoHeader As BITMAPINFOHEADER
Dim udtRGBQUAD(15) As RGBQUAD
Dim Colors(7) As Byte
Dim FileNum As Integer
Dim i As Long
With udtBitmapFileHeader
.bfType = &H4D42 '保存時に「BM」となる
'↓BITMAPFILEHEADER(40) + BITMAPINFOHEADER(14) + RGBQUAD(4*16)
.bfOffBits = 118
'↓udtBitmapFileHeader.bfOffBits + 8(要するにファイルサイズ)
.bfSize = udtBitmapFileHeader.bfOffBits + 8
End With
With udtBitmapInfoHeader
.biSize = Len(udtBitmapInfoHeader) '40バイト
.biWidth = 16 '幅
.biHeight = 1 '高さ
.biPlanes = 1 '常に１
.biBitCount = 4 '16色なので４ビット
.biSizeImage = 8 '16色なので８バイト
'↑１バイトで２ピクセル保持するので
End With
'16色パレット作成
With udtRGBQUAD(0) '黒
.r = 0: .g = 0: .b = 0
End With
With udtRGBQUAD(1) '茶色
.r = 128: .g = 0: .b = 0
End With
With udtRGBQUAD(2) '緑
.r = 0: .g = 128: .b = 0
End With
With udtRGBQUAD(3) 'オリーヴ
.r = 128: .g = 128: .b = 0
End With
With udtRGBQUAD(4) '紺
.r = 0: .g = 0: .b = 128
End With
With udtRGBQUAD(5) '紫
.r = 128: .g = 0: .b = 128
End With
With udtRGBQUAD(6) '深緑
.r = 0: .g = 128: .b = 128
End With
With udtRGBQUAD(7) '銀色
.r = 192: .g = 192: .b = 192
End With
With udtRGBQUAD(8) '灰色
.r = 128: .g = 128: .b = 128
End With
With udtRGBQUAD(9) '赤
.r = 255: .g = 0: .b = 0
End With
With udtRGBQUAD(10) '黄緑
.r = 0: .g = 255: .b = 0
End With
With udtRGBQUAD(11) '黄色
.r = 255: .g = 255: .b = 0
End With
With udtRGBQUAD(12) '青
.r = 0: .g = 0: .b = 255
End With
With udtRGBQUAD(13) '桃色
.r = 255: .g = 0: .b = 255
End With
With udtRGBQUAD(14) '水色
.r = 0: .g = 255: .b = 255
End With
With udtRGBQUAD(15) '白
.r = 255: .g = 255: .b = 255
End With
'16色ビットマップは２ピクセルを１バイトで保持する
Colors(0) = &H0 * &H10 + &H1
Colors(1) = &H2 * &H10 + &H3
Colors(2) = &H4 * &H10 + &H5
Colors(3) = &H6 * &H10 + &H7
Colors(4) = &H8 * &H10 + &H9
Colors(5) = &HA * &H10 + &HB
Colors(6) = &HC * &H10 + &HD
Colors(7) = &HE * &H10 + &HF
FileNum = FreeFile
Open "Color16.bmp" For Binary As #FileNum
Put #FileNum, , udtBitmapFileHeader
Put #FileNum, , udtBitmapInfoHeader
Put #FileNum, , udtRGBQUAD()
For i = 0 To UBound(Colors)
Put #FileNum, , Colors(i)
Next i
Close #FileNum
End Sub
'-------------------------------------------------------------------
' 関数名：InputBitmap
' 機能 ：16色ビットマップを適当に入力
' 引数 ：なし
' 返り値：なし
' 備考 ：白から黒まで16色を入力する適当なサンプル
'-------------------------------------------------------------------
Public Sub InputBitmap()
Dim udtBitmapFileHeader As BITMAPFILEHEADER
Dim udtBitmapInfoHeader As BITMAPINFOHEADER
Dim udtRGBQUAD(15) As RGBQUAD
Dim Colors(7) As Byte
Dim FileNum As Integer
Dim i As Long
FileNum = FreeFile
Open "Color16.bmp" For Binary As FileNum
Get #FileNum, , udtBitmapFileHeader
Get #FileNum, , udtBitmapInfoHeader
Get #FileNum, , udtRGBQUAD()
For i = 0 To UBound(Colors)
Get #FileNum, , Colors(i)
Next i
Close FileNum
End Sub
|