SAK 図書館
VB テクニック編10 - グラフ表示、グリッド、インターネット、外部出力 RDO, ADO
■SAK 関数利用規程
・テクニック編で紹介する関数は、私こと Y.SAK の開発関数である。
・著作権明示部分の改編は認めない。
・個人、企業がこれらの関数を使用したり、一部を使用して新たなシステムや
プログラムを開発することは自由です。
・但し、これらの関数を一部でも使用しているソフトウェアをシェアウェア、
その他有償プロダクトとして配布・販売するには、私の許可が必要です。
(無償のフリーソフトウェアなら、自由に配布しても良い。)
・これらの関数を使用して発生した、いかなる形での損害も私こと Y.SAK は
賠償しません。
■グラフ表示
・MSChart コンポートネントを使用すると、簡単にグラフ表示ができる。
チャートコンポーネントを MSChart1 として、フォームに配置したとして、
次のように使用する。
・この例では、コード内でグラフ配列を用意しているが、SQL のクエリレコー
ドセットをダイレクトに渡すこともできる。
レコードセットの場合、リクエリするとグラフも自動的に変更できる。
Dim xmx, ymx
Dim x, y
'** グラフ配列作成
xmx = 3
ymx = 6
ReDim c(ymx, xmx)
'** グラフ配列セット
c(0, 0) = "月"
c(0, 1) = "データ1"
c(0, 2) = "データ2"
c(0, 3) = "データ3"
c(1, 0) = "4 月"
c(2, 0) = "5 月"
c(3, 0) = "6 月"
c(4, 0) = "7 月"
c(5, 0) = "8 月"
c(6, 0) = "9 月"
For y = 1 To ymx
For x = 1 To xmx
c(y, x) = Int(Rnd(1) * 1000)
Next
Next
'** 折れ線グラフ表示
MSChart1.chartType = 3
MSChart1.ChartData = c
■データグリッド・階層フレキシブルグリッド (グリッドコントロール)
・MSHFlexGrid コンポートネントを使用すると、Excel のようなイメージで
データを表示することができる。
MSHFlexGrid は、旧コンポーネントの MSFlexGrid と上位互換がある。
MSFlexGrid から、MSHFlexGrid へのアップグレードにコード変更はなかっ
たと記憶している。
・尚、OLE DB 用のデータ編集可能な DataGrid は、VB5 から VB6 にアップ
グレードすると、かなりのコード変更が必要である。
また、DataGrid をコードでハンドリングするのは難しい。
クエリレコードセットをオートメーションリンクして、最小限のコードハン
ドリングにすると良い。
・MSHFlexGrid もクエリレコードセットをオートメーションリンクすることが
できる。しかし、ここでは、コードハンドリングでの表示例を紹介する。
フレキシブルグリッドコンポーネントを MSHFlexGrid1 として、フォームに
配置したとして、次のように使用する。
・MSHFlexGrid に対する行挿入、行削除、項目データ編集は、恐ろしいほどの
コードを記述しないと実現できない。
必要な機能を関数化して実装すると良い。
尚、データ入力、編集に耐える MSHFlexGrid 用の関数を開発していますが、
あまりにも大量のため、説明はご容赦願いたい。
Dim i As Long
Dim j As Long
'** グリッドセット
MSHFlexGrid1.Cols = 7
MSHFlexGrid1.Rows = 11
MSHFlexGrid1.TextArray(1) = "データ1"
MSHFlexGrid1.TextArray(2) = "データ2"
MSHFlexGrid1.TextArray(3) = "データ3"
MSHFlexGrid1.TextArray(4) = "データ4"
MSHFlexGrid1.TextArray(5) = "データ5"
MSHFlexGrid1.TextArray(6) = "データ6"
MSHFlexGrid1.FontSize = 10
'** 明細データ表示
i = MSHFlexGrid1.FixedRows
For j = i To i + 9
MSHFlexGrid1.TextArray(CalcGridIndex(MSHFlexGrid1, 0, j)) = "▽"
MSHFlexGrid1.TextArray(CalcGridIndex(MSHFlexGrid1, 1, j)) = Int(Rnd(1) * 1000000)
MSHFlexGrid1.TextArray(CalcGridIndex(MSHFlexGrid1, 2, j)) = Int(Rnd(1) * 1000000)
MSHFlexGrid1.TextArray(CalcGridIndex(MSHFlexGrid1, 3, j)) = Int(Rnd(1) * 1000000)
MSHFlexGrid1.TextArray(CalcGridIndex(MSHFlexGrid1, 4, j)) = Int(Rnd(1) * 1000000)
MSHFlexGrid1.TextArray(CalcGridIndex(MSHFlexGrid1, 5, j)) = Int(Rnd(1) * 1000000)
MSHFlexGrid1.TextArray(CalcGridIndex(MSHFlexGrid1, 6, j)) = Int(Rnd(1) * 1000000)
Next
Public Function CalcGridIndex(gd As Variant, c As Long, r As Long) As Long
'** グリッドインデックス計算
CalcGridIndex = c + gd.Cols * r
End Function
■インターネットトランスファコントロール (inet)
・internet Transfer コントロールを使用すると、HTTP 受信と FTP での転送
(送受信) を行うことができる。
フォームに Inet1 と配置したとして、次のように使用する。
Dim tout As Long
Dim bin() As Byte
Dim url As String
Dim fnm As String
'** タイムアウト値
tout = 60
'** inet 接続
Inet1.RequestTimeout = tout
Inet1.UserName = ""
Inet1.Password = ""
'** URL
url = "http://sak-main/w_test/test.htm"
fnm = "g:\tmp\test.htm"
'** HTTP ファイルダウンロード
bin() = Inet1.OpenURL(url, icByteArray)
Open fnm For Binary Access Write As #1 Len = 32000
Put #1, , bin()
Close #1
'** URL
url = "ftp://10.1.1.1/w_test/test.dat"
fnm = "g:\tmp\test.dat"
'** FTP ファイルダウンロード
bin() = Inet1.OpenURL(url, icByteArray)
Open fnm For Binary Access Write As #1 Len = 32000
Put #1, , bin()
Close #1
'** inet 解除
Inet1.Cancel
・FTP の PUT、GET を行うには、次のようにする。
Inet コントロールによる FTP 送受信には制約も多い。
BASP21 や FTPCNT.DLL を使用する方が簡単ではある。
Public InetState As Boolean
Public InetError As String
Public InetData As String
Private Sub Command1_Click()
'** inet 接続
Inet1.RequestTimeout = 2
Inet1.UserName = "anonymous"
Inet1.Password = ""
'** FTP ファイルダウンロード
Inet1.Execute "ftp://sak-design", "GET /ftp/aaa.txt g:\tmp\test.txt"
Do
DoEvents
Loop Until InetState
If InetError <> "" Then MsgBox InetError
Inet1.Execute "ftp://sak-design", "CLOSE"
Do
DoEvents
Loop Until InetState
Inet1.Execute "ftp://sak-design", "QUIT"
Do
DoEvents
Loop Until InetState
'** FTP ファイルアップロード
Inet1.Execute "ftp://sak-design", "PUT g:\tmp\test.txt /ftp/bbb.txt"
Do
DoEvents
Loop Until InetState
If InetError <> "" Then MsgBox InetError
Inet1.Execute "ftp://sak-design", "CLOSE"
Do
DoEvents
Loop Until InetState
Inet1.Execute "ftp://sak-design", "QUIT"
Do
DoEvents
Loop Until InetState
'** inet 解除
Inet1.Cancel
End Sub
Private Sub Inet1_StateChanged(ByVal State As Integer)
Dim w As String
Select Case State
Case icError
InetError = Inet1.ResponseCode & " - " & Inet1.ResponseInfo
InetState = True
Case icResponseCompleted
Do
w = Inet1.GetChunk(1024, icString)
DoEvents
If Len(w) = 0 Then
InetError = ""
InetState = True
Else
InetData = InetData & w
InetState = False
End If
Loop Until InetState
End Select
End Sub
■CSV 外部出力 (RDO 版)
・SQL による様々な問い合わせ結果をそのままテキストファイルなどに出力
することができる。
この例では CSV 形式でテキストファイルエクスポートする。
尚、先頭行に見出しも出力している。
見出しが不要の場合は、mds = false にする。
Dim RDBen As rdoEnvironment
Dim RDBcn As rdoConnection
Dim dsn As String
Dim sql As String
Dim fnm As String
Dim mds As boolean
Dim rs As rdoResultset
Dim fno As Integer
Dim cl As rdoColumn
Dim rec As String
Dim i As Integer
Dim dummy As Variant
Dim s As String
dsn = "dsn=SAK3;uid=SAK;pwd=SAK"
sql = "select * from sak.受注v1"
fnm = "g:\tmp\test.csv"
mds = true
Set RDBen = rdoEnvironments(0)
Set RDBcn = RDBen.OpenConnection("", rdDriverNoPrompt, False, dsn)
Set rs = RDBcn.OpenResultset(sql, rdOpenStatic, rdConcurReadOnly, rdExecDirect)
fno = FreeFile
Open fnm For Output As fno Len = 32000
if mds then
For Each cl In rs.rdoColumns
rec = rec & Chr(&H22) & cl.Name & Chr(&H22) & ","
Next cl
Print #fno, Left(rec, Len(rec) - 1)
end if
Do Until rs.EOF
rec = ""
For i = 0 To rs.rdoColumns.Count - 1
dummy = rs(i)
If IsNull(dummy) Then
s = ""
Else
s = dummy
End If
rec = rec & Chr(&H22) & RTrim(s) & Chr(&H22) & ","
Next
Print #fno, Left(rec, Len(rec) - 1)
rs.MoveNext
Loop
Close fno
rs.Close
RDBcn.Close
■CSV 外部出力 (ADO 版)
・SQL による様々な問い合わせ結果をそのままテキストファイルなどに出力
することができる。
この例では CSV 形式でテキストファイルエクスポートする。
尚、先頭行に見出しも出力している。
見出しが不要の場合は、mds = false にする。
Dim s3cn_ado
Dim dsn As String
Dim sql As String
Dim fnm As String
Dim mds As boolean
Dim rs As Variant
Dim fno As Integer
Dim rec As String
Dim i As Integer
Dim dummy As Variant
Dim s As String
dsn = "dsn=SAK3_ADO;uid=SAK;pwd=SAK"
sql = "select * from sak.受注v1"
fnm = "g:\tmp\test.csv"
mds = true
set s3cn_ado = CreateObject ("ADODB.Connection")
s3cn_ado.Open dsn
set rs = s3cn_ado.Execute(sql)
fno = FreeFile
Open fnm For Output As fno Len = 32000
if mds then
For i = 0 to rs.fields.count - 1
rec = rec & Chr(&H22) & rs(i).Name & Chr(&H22) & ","
Next
Print #fno, Left(rec, Len(rec) - 1)
end if
Do Until rs.EOF
rec = ""
For i = 0 to rs.fields.count - 1
dummy = rs(i)
If IsNull(dummy) Then
s = ""
Else
s = dummy
End If
rec = rec & Chr(&H22) & RTrim(s) & Chr(&H22) & ","
Next
Print #fno, Left(rec, Len(rec) - 1)
rs.MoveNext
Loop
Close fno
rs.Close
s3cn_ado.Close
■VB テクニック編資料
■VB 入門編資料
■VB 基礎編資料
■VB ビジュアル編資料