CrystalReportでバーコード画像を表示する方法ＶＢ6 ― 2009/09/15 11:37
CrystalReportで画像を表示する方法のＶＢ6版 覚書
'===========================================
'ローカルのアクセステーブルに印刷用のファイルを登録し
'CrystalReportで表示する
'このバーコードはフリーのMiBarcode.EXEのＤＤＥ機能を利用して
'印刷している
'=======================================
Option Explicit
'アクセスのＯＬＥオブジェクト型のデータに登録する場合
'アクセスで表示する場合は、ＢＩＴMAPをそのまま、Ｂｙｔｅ
'変数に変換して登録すればよいが、クリスタルレポートでは
'先頭にダミーバイトを挿入する必要がある。
'そのためのおまじない変数宣言
Dim CHUNK_B(98) As Byte
'BITMAPをＢｙｔｅ変数に格納するための宣言
Dim CH_BG() As Byte
'==============================================
'データをローカルのアクセスＤＢに登録するルーチン
'==============================================
Private Sub OK_B_Click()
Dim i%, j%, FH%
Dim S, XDIR, strDummy As String
Dim xdb As New ADODB.Connection
Dim ds As New ADODB.Recordset
Dim TEMP As Object
XDIR = App.Path
'実行環境ディレクトリ以下のＤＡＴＡディレクトリにデータベース
'を保存
S = ""
S = S & "Provider=Microsoft.Jet.OLEDB.4.0;"
S = S & "Data Source=" & App.Path & "\data\WORK.mdb;"
S = S & "Persist Security Info=False"
xdb.ConnectionString = S
xdb.Open
'クリスタルレポート上では、商品とＰＩＭAGEの２つのテーブルを
'使用して表示させる。
'商品データの登録
S = "select * from 商品"
S = S & " where PNO=" & Xtext(SH_PNO.Text)
ds.Open S, xdb, adOpenDynamic, adLockPessimistic
On Error Resume Next
ds.MoveFirst
If Err.Number = 0 And Not ds.EOF Then
Else
ds.AddNew
End If
On Error GoTo 0
ds("PNO").Value = SH_PNO.Text
ds("名称").Value = SH_名称.Text
ds("品番").Value = SH_品番.Text
ds("型番").Value = SH_型番.Text
ds.Update
ds.Close
'----
'ＤＤＥをサポートしたバーコード表示ルーチンを使用して
'フォーム上に張り付けたＰｉｃｔｕｒｅ1にバーコードを表示させる
'ルーチン
Call OLE_DISP
SavePicture Picture1.Image, XDIR & "\QRBAR.BMP"
DoEvents
'
S = "select * from PIMAGE"
S = S & " where PNO=" & Xtext(SH_PNO.Text)
ds.Open S, xdb, adOpenDynamic, adLockPessimistic
On Error Resume Next
ds.MoveFirst
If Err.Number = 0 And Not ds.EOF Then
Else
ds.AddNew
End If
On Error GoTo 0
ds("PNO").Value = SH_PNO.Text
On Error GoTo 0
'ビットマップをバイナリでオープンして、Ｂｙｔｅ配列に読み込む
FH = FreeFile
Open XDIR & "\QRBAR.bmp" For Binary As #FH
ReDim CH_BG(LOF(FH))
Get #FH, , CH_BG
Close #FH
'画像データはＯＬＥオブジェクト型で設定
'クリスタルレポート用に、ダミー配列を登録
ds("PIMAGE").AppendChunk (CHUNK_B)
'実際のＢＩＴＭＡＰデータを登録
ds("PIMAGE").AppendChunk (CH_BG)
ds.Update
ds.Close
xdb.Close
End Sub
'=======================================================
'DDE機能を使用して、PicturerにバーコードＢｉｔMapを張り付ける
'=======================================================
Sub OLE_DISP()
Dim MiBar As New Mibarcd.Auto
With MiBar
.Show (0)
.Code = "" & SH_PNO.Text & "::" & SH_名称.Text & "::" & SH_型番.Text & "::" & SH_品番.Text & ";"
.CodeType = 12 'QR2"QR2"
.QRVersion = 8
.QRErrLevel = 1 '"M"
.HMargin = 5
.BarScale = 2
.CopyType = 1
.Execute
Picture1.Picture = Clipboard.GetData
End With
End Sub
'===========================================
'ローカルのアクセステーブルに印刷用のファイルを登録し
'CrystalReportで表示する
'このバーコードはフリーのMiBarcode.EXEのＤＤＥ機能を利用して
'印刷している
'=======================================
Option Explicit
'アクセスのＯＬＥオブジェクト型のデータに登録する場合
'アクセスで表示する場合は、ＢＩＴMAPをそのまま、Ｂｙｔｅ
'変数に変換して登録すればよいが、クリスタルレポートでは
'先頭にダミーバイトを挿入する必要がある。
'そのためのおまじない変数宣言
Dim CHUNK_B(98) As Byte
'BITMAPをＢｙｔｅ変数に格納するための宣言
Dim CH_BG() As Byte
'==============================================
'データをローカルのアクセスＤＢに登録するルーチン
'==============================================
Private Sub OK_B_Click()
Dim i%, j%, FH%
Dim S, XDIR, strDummy As String
Dim xdb As New ADODB.Connection
Dim ds As New ADODB.Recordset
Dim TEMP As Object
XDIR = App.Path
'実行環境ディレクトリ以下のＤＡＴＡディレクトリにデータベース
'を保存
S = ""
S = S & "Provider=Microsoft.Jet.OLEDB.4.0;"
S = S & "Data Source=" & App.Path & "\data\WORK.mdb;"
S = S & "Persist Security Info=False"
xdb.ConnectionString = S
xdb.Open
'クリスタルレポート上では、商品とＰＩＭAGEの２つのテーブルを
'使用して表示させる。
'商品データの登録
S = "select * from 商品"
S = S & " where PNO=" & Xtext(SH_PNO.Text)
ds.Open S, xdb, adOpenDynamic, adLockPessimistic
On Error Resume Next
ds.MoveFirst
If Err.Number = 0 And Not ds.EOF Then
Else
ds.AddNew
End If
On Error GoTo 0
ds("PNO").Value = SH_PNO.Text
ds("名称").Value = SH_名称.Text
ds("品番").Value = SH_品番.Text
ds("型番").Value = SH_型番.Text
ds.Update
ds.Close
'----
'ＤＤＥをサポートしたバーコード表示ルーチンを使用して
'フォーム上に張り付けたＰｉｃｔｕｒｅ1にバーコードを表示させる
'ルーチン
Call OLE_DISP
SavePicture Picture1.Image, XDIR & "\QRBAR.BMP"
DoEvents
'
S = "select * from PIMAGE"
S = S & " where PNO=" & Xtext(SH_PNO.Text)
ds.Open S, xdb, adOpenDynamic, adLockPessimistic
On Error Resume Next
ds.MoveFirst
If Err.Number = 0 And Not ds.EOF Then
Else
ds.AddNew
End If
On Error GoTo 0
ds("PNO").Value = SH_PNO.Text
On Error GoTo 0
'ビットマップをバイナリでオープンして、Ｂｙｔｅ配列に読み込む
FH = FreeFile
Open XDIR & "\QRBAR.bmp" For Binary As #FH
ReDim CH_BG(LOF(FH))
Get #FH, , CH_BG
Close #FH
'画像データはＯＬＥオブジェクト型で設定
'クリスタルレポート用に、ダミー配列を登録
ds("PIMAGE").AppendChunk (CHUNK_B)
'実際のＢＩＴＭＡＰデータを登録
ds("PIMAGE").AppendChunk (CH_BG)
ds.Update
ds.Close
xdb.Close
End Sub
'=======================================================
'DDE機能を使用して、PicturerにバーコードＢｉｔMapを張り付ける
'=======================================================
Sub OLE_DISP()
Dim MiBar As New Mibarcd.Auto
With MiBar
.Show (0)
.Code = "" & SH_PNO.Text & "::" & SH_名称.Text & "::" & SH_型番.Text & "::" & SH_品番.Text & ";"
.CodeType = 12 'QR2"QR2"
.QRVersion = 8
.QRErrLevel = 1 '"M"
.HMargin = 5
.BarScale = 2
.CopyType = 1
.Execute
Picture1.Picture = Clipboard.GetData
End With
End Sub
by 髯西 [バーコード] [CrystalReport] [DDE] [ＰＣ] [VB6] [コメント(0)｜トラックバック(0)]
CrystalReportで画像を表示する方法 ― 2009/09/15 11:15
ＶＳ2008でCrystalReportにバーコード画像を表示する場合の覚書
'デンソーウェーブのバーコードライブラリを使用している
'VS2005でも同様に使用できると思われる
'======================================================
'印刷用のルーチン
'======================================================
Sub PRLOOP(ByVal S99 As String, ByVal S00 As String, ByVal S11 As String)
Dim crExportOptions As CrystalDecisions.Shared.ExportOptions
Dim crDiskFileDestinationOptions As CrystalDecisions.Shared.DiskFileDestinationOptions
Dim fm As New PrintBase
Dim SQLC As New SqlClient.SqlConnection
Dim TR, DEF_P, S, S0, S9, PR_PATH, Fname, PPJ, D_NM, NOW_PRT As String
Dim i%
Dim DsP As New DataSet
With fm
'レポートファイルの実際の場所の特定
'実行時のディレクトリ以下の「ＲＰＴ」ディレクトリに格納
'
On Error GoTo 0
PPJ = AppName
i = InStr(AppName, ".")
If i > 0 Then
PPJ = Mid(PPJ, 1, i - 1)
End If
S = AppPath
i = InStr(UCase(S), UCase("\BIN\"))
If i > 0 Then
'DEBUG
S = Mid(AppPath, 1, i - 0) & "RPT\"
Else
S = AppPath & "\RPT\"
End If
'i = InStr(UCase(S), UCase(CStr(PPJ)))
'If i > 0 Then
'S = Mid(S, 1, i - 1) & PPJ & "\RPT\"
'End If
If Microsoft.VisualBasic.Right(S, 1) <> "\" Then S = S & "\"
PR_PATH = S
Fname = ""
D_NM = ""
S9 = ""
Fname = S & "QRTEST.rpt"
D_NM = "TESTDATA"
fm.Cr1.Load(Fname)
's = Cr1.FilePath
On Error Resume Next
S = ""
On Error GoTo 0
Dim tb2 As New DataTable
DsP.Tables.Add(tb2)
clmSet("PNO", DsP, "System.String")
'イメージはＢｙｔｅ配列で格納
clmSet("PIMAGE", DsP, "System.Byte[]")
clmSet("HNO", DsP, "System.String")
'印刷用テーブルにカラムをセット
fm.CR0.ReportSource = fm.Cr1
'------
For i = 1 To 5
Dim rr As DataRow = tb2.NewRow
S0 = nFormat(i, "000")
rr("PNO") = S0
'ＱＲコードは改行も受け付ける
S = S0 & "//0900-234" & vbCrLf
S = S & "漢字テスト" & vbCrLf
S = S & "品名ＯＫ" & Format(Now, "yyyy/MM/dd") & vbCrLf
rr("HNO") = S
Dim BB As New Bitmap(300, 300)
Dim memstream As MemoryStream = New MemoryStream
Call QRDISP(S, BB)
PictureBox1.Image = BB
Dim byteData As Byte()
BB.Save(memstream, Imaging.ImageFormat.Bmp)
byteData = memstream.ToArray
rr("PIMAGE") = byteData
DsP.Tables(0).Rows.Add(rr)
memstream.Close()
Next
'
If DsP.Tables(0).Rows.Count > 0 Then
Dim sds As New DataSet
Dim clm As New DataColumn
'===============================================
DsP.Tables(0).TableName = D_NM
.Cr1.Database.Tables(D_NM).SetDataSource(DsP.Tables(D_NM))
'===============================================
.CR0.Text = "一覧表"
.CR0.RefreshReport()
.Width = Me.Width
.Height = Me.Height
.Top = Me.Top
.Left = Me.Left
.CR0.DisplayGroupTree = False
.CR0.ShowGroupTreeButton = False
.CR0.Left = 0
.CR0.Top = 0
.CR0.DisplayBackgroundEdge = True
TR = ""
S = Prt_GET_REG("NO04", TR)
'デフォルトプリンターの確認
DEF_P = Get_Def_Printer()
If S = "" Then
.Cr1.PrintOptions.PrinterName = DEF_P
Else
.Cr1.PrintOptions.PrinterName = S
Call Set_Printer(S)
End If
NOW_PRT = .Cr1.PrintOptions.PrinterName
.Cr1.PrintOptions.PaperSize = CrystalDecisions.[Shared].PaperSize.PaperA4
.Cr1.PrintOptions.PaperOrientation = CrystalDecisions.[Shared].PaperOrientation.Landscape '= CrystalDecisions.[Shared].PaperOrientation.Landscape
.CR0.Width = fm.Width - 0
.CR0.Height = fm.Height '- Me.STAT.Height
.CR0.Visible = True
.CR0.ShowCloseButton = True
.Text = "一覧表表示印刷"
.Top = Me.Top
.Left = Me.Left
.WindowState = FormWindowState.Maximized
Me.Visible = False
.ShowDialog(Me)
Me.Visible = True
'もしデフォルトプリンターに変更があれば元に戻す。
If NOW_PRT <> DEF_P Then
On Error Resume Next
Call Set_Printer(DEF_P)
On Error GoTo 0
End If
Else
MsgBox("該当するデータはありません。")
End If
End With
End Sub
'==========================================================
'DataSetにカラムを追加するサブルーチン
'==========================================================
Sub clmSet(ByVal nm As String, ByVal Dsp As DataSet, ByVal Tp As String)
Dim clm As New DataColumn
clm.ColumnName = nm
clm.DataType = Type.GetType(Tp)
If InStr(UCase(Tp), "STRING") > 0 Then
clm.DefaultValue = ""
Else
clm.DefaultValue = DBNull.Value
End If
Dsp.Tables(0).Columns.Add(clm)
End Sub
'=======================================================
'QRコードをビットマップに表示するルーチン
'=======================================================
Sub QRDISP(ByVal QR_S As String, ByVal PP As Bitmap)
Dim bc1 As System.DotNetBarcode = New System.DotNetBarcode
Dim g As Graphics = Graphics.FromImage(PP)
g.Clear(Color.White)
bc1.Type = System.DotNetBarcode.Types.QRCode
bc1.PrintCheckDigitChar = True
bc1.WriteBar(QR_S, 0, 0, PP.Width, PP.Height, g)
End Sub
'デンソーウェーブのバーコードライブラリを使用している
'VS2005でも同様に使用できると思われる
'======================================================
'印刷用のルーチン
'======================================================
Sub PRLOOP(ByVal S99 As String, ByVal S00 As String, ByVal S11 As String)
Dim crExportOptions As CrystalDecisions.Shared.ExportOptions
Dim crDiskFileDestinationOptions As CrystalDecisions.Shared.DiskFileDestinationOptions
Dim fm As New PrintBase
Dim SQLC As New SqlClient.SqlConnection
Dim TR, DEF_P, S, S0, S9, PR_PATH, Fname, PPJ, D_NM, NOW_PRT As String
Dim i%
Dim DsP As New DataSet
With fm
'レポートファイルの実際の場所の特定
'実行時のディレクトリ以下の「ＲＰＴ」ディレクトリに格納
'
On Error GoTo 0
PPJ = AppName
i = InStr(AppName, ".")
If i > 0 Then
PPJ = Mid(PPJ, 1, i - 1)
End If
S = AppPath
i = InStr(UCase(S), UCase("\BIN\"))
If i > 0 Then
'DEBUG
S = Mid(AppPath, 1, i - 0) & "RPT\"
Else
S = AppPath & "\RPT\"
End If
'i = InStr(UCase(S), UCase(CStr(PPJ)))
'If i > 0 Then
'S = Mid(S, 1, i - 1) & PPJ & "\RPT\"
'End If
If Microsoft.VisualBasic.Right(S, 1) <> "\" Then S = S & "\"
PR_PATH = S
Fname = ""
D_NM = ""
S9 = ""
Fname = S & "QRTEST.rpt"
D_NM = "TESTDATA"
fm.Cr1.Load(Fname)
's = Cr1.FilePath
On Error Resume Next
S = ""
On Error GoTo 0
Dim tb2 As New DataTable
DsP.Tables.Add(tb2)
clmSet("PNO", DsP, "System.String")
'イメージはＢｙｔｅ配列で格納
clmSet("PIMAGE", DsP, "System.Byte[]")
clmSet("HNO", DsP, "System.String")
'印刷用テーブルにカラムをセット
fm.CR0.ReportSource = fm.Cr1
'------
For i = 1 To 5
Dim rr As DataRow = tb2.NewRow
S0 = nFormat(i, "000")
rr("PNO") = S0
'ＱＲコードは改行も受け付ける
S = S0 & "//0900-234" & vbCrLf
S = S & "漢字テスト" & vbCrLf
S = S & "品名ＯＫ" & Format(Now, "yyyy/MM/dd") & vbCrLf
rr("HNO") = S
Dim BB As New Bitmap(300, 300)
Dim memstream As MemoryStream = New MemoryStream
Call QRDISP(S, BB)
PictureBox1.Image = BB
Dim byteData As Byte()
BB.Save(memstream, Imaging.ImageFormat.Bmp)
byteData = memstream.ToArray
rr("PIMAGE") = byteData
DsP.Tables(0).Rows.Add(rr)
memstream.Close()
Next
'
If DsP.Tables(0).Rows.Count > 0 Then
Dim sds As New DataSet
Dim clm As New DataColumn
'===============================================
DsP.Tables(0).TableName = D_NM
.Cr1.Database.Tables(D_NM).SetDataSource(DsP.Tables(D_NM))
'===============================================
.CR0.Text = "一覧表"
.CR0.RefreshReport()
.Width = Me.Width
.Height = Me.Height
.Top = Me.Top
.Left = Me.Left
.CR0.DisplayGroupTree = False
.CR0.ShowGroupTreeButton = False
.CR0.Left = 0
.CR0.Top = 0
.CR0.DisplayBackgroundEdge = True
TR = ""
S = Prt_GET_REG("NO04", TR)
'デフォルトプリンターの確認
DEF_P = Get_Def_Printer()
If S = "" Then
.Cr1.PrintOptions.PrinterName = DEF_P
Else
.Cr1.PrintOptions.PrinterName = S
Call Set_Printer(S)
End If
NOW_PRT = .Cr1.PrintOptions.PrinterName
.Cr1.PrintOptions.PaperSize = CrystalDecisions.[Shared].PaperSize.PaperA4
.Cr1.PrintOptions.PaperOrientation = CrystalDecisions.[Shared].PaperOrientation.Landscape '= CrystalDecisions.[Shared].PaperOrientation.Landscape
.CR0.Width = fm.Width - 0
.CR0.Height = fm.Height '- Me.STAT.Height
.CR0.Visible = True
.CR0.ShowCloseButton = True
.Text = "一覧表表示印刷"
.Top = Me.Top
.Left = Me.Left
.WindowState = FormWindowState.Maximized
Me.Visible = False
.ShowDialog(Me)
Me.Visible = True
'もしデフォルトプリンターに変更があれば元に戻す。
If NOW_PRT <> DEF_P Then
On Error Resume Next
Call Set_Printer(DEF_P)
On Error GoTo 0
End If
Else
MsgBox("該当するデータはありません。")
End If
End With
End Sub
'==========================================================
'DataSetにカラムを追加するサブルーチン
'==========================================================
Sub clmSet(ByVal nm As String, ByVal Dsp As DataSet, ByVal Tp As String)
Dim clm As New DataColumn
clm.ColumnName = nm
clm.DataType = Type.GetType(Tp)
If InStr(UCase(Tp), "STRING") > 0 Then
clm.DefaultValue = ""
Else
clm.DefaultValue = DBNull.Value
End If
Dsp.Tables(0).Columns.Add(clm)
End Sub
'=======================================================
'QRコードをビットマップに表示するルーチン
'=======================================================
Sub QRDISP(ByVal QR_S As String, ByVal PP As Bitmap)
Dim bc1 As System.DotNetBarcode = New System.DotNetBarcode
Dim g As Graphics = Graphics.FromImage(PP)
g.Clear(Color.White)
bc1.Type = System.DotNetBarcode.Types.QRCode
bc1.PrintCheckDigitChar = True
bc1.WriteBar(QR_S, 0, 0, PP.Width, PP.Height, g)
End Sub
by 髯西 [バーコード] [CrystalReport] [ＰＣ] [VS2005] [コメント(0)｜トラックバック(0)]
最近のコメント