Visual Basic 6.0 (VB6) 程式語言案例學習 (01. 證照套印系統)
Visual Basic 6.0 (VB6) 程式語言案例學習 (01. 證照套印系統)¶
1.1 問題¶
一般而言，有大量證照製作通常是交給印刷公司，而會採用印表機列印的證照，基本上除了特殊需求外，就數量不多也不少，約略幾百張，例如會員證、社團證、會場證，除非必要，一般使用磅數較厚的紙張列印即可。由於數位化的關係，現在的相片沖洗店或相片館都支援數位檔案，也就是免底片的方式，使用影像檔格式儲存大頭照，當我們蒐集了許多大頭照，將檔名依照編號及人名命名存檔，基本上就完成了照片基本整理的工作了。
某單位因為時常舉辦會場，而應邀者都配有一張會員照，核對會員照之後方可入場，因此須要能夠套印的程式。以往的方式就是採用繪圖軟體編輯，由於繪圖軟體本身就不是套印程式，因此有諸多的不便，例如輸入會員碼及姓名。需求者希望能夠印一次就可以達到證照正反面的效果。而會員編碼會因為不同的會場需要，而有所不同，因此要能夠配合不同編碼長短而修正。
1.2 需求¶
表格 1 「證照套印系統」系統目的分析表
| 版本：1.0 . | 要做什麼 . | 不要做什麼（不要做不代表不會做） |
|---|---|---|
| 能做什麼 | （第一格：必要項目） | （第二格：次要項目） |
| 以檔案形式管理照片目錄。 | 能夠將照片檔匯入資料庫中。 | |
| 透過檔案命名取得會員編碼及姓名。 | 能夠針對圖案做縮放調整的功能。 | |
| 能夠記錄每次設定照片目錄的路徑。 | ||
| 能夠設定會員證正反面圖形。 | ||
| 能夠預覽會員證列印情形。 | ||
| 能夠直接列印會員證。 | ||
| 不能做什麼（不能做代表不需要做） | （第三格：不必要項目） | （第四格：不需要項目） |
| 能夠結合會員資料管理。 | 提供更細部的印刷調整。 |
表格 2 「證照套印系統」系統目標分析表
| 版本： | 重要 | 不重要 |
|---|---|---|
| 優先 . | （重） . | （急） |
| 以檔案形式管理照片目錄。 | 能夠設定會員證正反面圖形。 | |
| 透過檔案命名取得會員編碼及姓名。 | ||
| 能夠直接列印會員證。 | ||
| 不急迫 . | （輕） . | （緩） |
| 能夠記錄每次設定照片目錄的路徑。 | 能夠預覽會員證列印情形。 |
表格 3 「證照套印系統」系統規格表
| 規格項目 | 規格內容 | 備註 |
|---|---|---|
| 取得照片 . | 以檔案型式管理照片目錄。 | … |
| 會員編號 . | 可自由調整會員編號字元數，以檔名前幾碼為準。 | … |
| 會員姓名 . | 會員編號之後就是會員姓名，可以取得檔名內的會員姓名。 | … |
| 儲存目錄 . | 能夠紀錄照片目錄位置，並於程式啟動時帶出。 | … |
| 直接列印 . | 能夠直接列印所有會員證。 | … |
| 預覽列印 . | 能夠預覽列印所有會員證。 | … |
| 載入圖形 . | 能夠載入會員證的正面及反面圖案。 | … |
1.3 特色¶
特點就是管理及套印程式，原本每學期都必須手動作業的部分，透過電腦化變成一件非常輕鬆的事情。
可應用於會員卡製作的程式。
1.4 使用工具¶
| 語言 | 軟體 |
|---|---|
| Visual Basic 6.0 | MS Visual Basic 6.0、MS Access |
1.5 系統架構¶
設計的時候筆者曾思考是否要將照片匯入資料庫，而後發現所收集的照片皆是檔案，事實上最快的方式就是直接對檔案做處理，而且能夠節省許多程式碼，而且還可以藉由網路磁碟機的方式，讓程式變成網路版。
因而簡化了程式設計時的複雜度，而程式架構基本上是跟著按鈕而跑的，按鈕內的程式碼掌控了整個程式的運作，也就是說這是一支以介面為模式的程式，當介面安排好之後，設計者只需要將程式碼填寫完畢即可。
特別的一點就是筆者利用VB 6.0所提供的報表功能，來作為列印的工具，這個報表功能本身就提供預覽及直接列印的模式，甚至還提供匯出的功能，善用的話可以讓設計程式變得相當簡單。
其次就是使用串流的方式處理圖檔，這個部分比較少人嘗試，因此讀者可以仔細的看程式的註解說明，筆者把每一行程式碼的用途都加以說明。
最後是錯誤處理，讀者可以發現這程式的錯誤處理花了不少心思，原因是使用網路磁碟機的時候，有可能因為網路傳輸品質而造成錯誤，特別採用等待的方式，獲得影像檔。
1.6 程式實作¶
程式只有短短的幾百行，因本教材是介紹系統為主，因此呼叫目錄共通視窗的部分，並沒有詳述，只有介紹如何使用，有興趣鑽研的朋友可以查詢筆者提示的API關鍵字。
‘設定所有變數必須宣告才能使用
Option Explicit
'主資料庫連線物件
Public objCnn_LTYD As ADODB.Connection
'主資料庫連結字串
Public strCnn_LTYD As String
'證件圖形資料錄物件
Public objRst_LTYD_Card As ADODB.Recordset
'設定 Stream Object 空間
Public objStm As ADODB.Stream
'檔案存取物件
Public objFso As FileSystemObject
'控制項物件
Public objControl As Control
‘宣告資料庫路徑字串變數
Public strLTYD_FN As String
‘宣告錯誤計數整數變數
Public intERR_objRst_LTYD_Card As Integer
'請在宣告區中加入以下宣告：
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260
Private Declare Function SHBrowseForFolder Lib "shell32" _
(lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" _
(ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
(ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Enum BrowseForFolderFlags
ReturnFileSystemFoldersOnly = &H1
DontGoBelowDomain = &H2
IncludeStatusText = &H4
BrowseForComputer = &H1000
BrowseForPrinter = &H2000
BrowseIncludeFiles = &H4000
IncludeTextBox = &H10
ReturnFileSystemAncestors = &H8
End Enum
Enum Folders
Desktop = &H0
Internet = &H1
Programs = &H2
ControlsFolder = &H3
Printers = &H4
Personal = &H5
Favorites = &H6
StartUp = &H7
Recent = &H8
SendTo = &H9
RecycleBin = &HA
StartMenu = &HB
DesktopDirectory = &H10
Drives = &H11
Network = &H12
Nethood = &H13
Fonts = &H14
Templates = &H15
Common_StartMenu = &H16
Common_Programs = &H17
Common_StartUp = &H18
Common_DesktopDirectory = &H19
ApplicationData = &H1A
PrintHood = &H1B
AltStartUp = &H1D
Common_AltStartUp = &H1E
Common_Favorites = &H1F
InternetCache = &H20
Cookies = &H21
History = &H22
End Enum
'16 位元版本：Sub 無傳回值
'Private Declare Sub ReleaseCapture Lib "User" ()
'Private Declare Sub SendMessage Lib "User" _
'(ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Long)
'32 位元版本：Function 有傳回值，Integer 改成 Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'共用常數：
Const WM_SYSCOMMAND = &H112
Const SC_MOVE = &HF012
'開啟存放照片目錄的按鈕點選事件副程式
Private Sub Command1_Click()
‘宣告pid常整數變數
Dim lpIDList As Long
‘宣告儲存路徑的緩衝區字串變數
Dim sBuffer As String
‘宣告標題字串變數
Dim szTitle As String
‘宣告目錄共用視窗資料結構
Dim tBrowseInfo As BrowseInfo
‘設定標題文字
szTitle = "請選擇資料夾或檔案"
With tBrowseInfo
‘設定視窗代碼
.hWndOwner = Me.hwnd
‘設定標題文字
.lpszTitle = lstrcat(szTitle, "")
‘設定資料夾根目錄為桌面
.pIDLRoot = Folders.Desktop
End With
‘呼叫API函數，開啟目錄共用視窗
lpIDList = SHBrowseForFolder(tBrowseInfo)
‘假若有資料
If (lpIDList) Then
‘填充緩衝區
sBuffer = Space(MAX_PATH)
‘獲得路徑
SHGetPathFromIDList lpIDList, sBuffer
‘修正路徑長度
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
‘將路徑顯示到文字框中
txtMM_PD.Text = sBuffer
‘將路徑儲存到系統登錄中
Call SaveSetting("人事室", "證照套印", "存照片目錄", sBuffer)
End If
‘修正路徑字串，去除空白字元
txtMM_PD.Text = Trim(txtMM_PD.Text)
‘將路徑設定給檔案控制項
File1.Path = Trim(txtMM_PD.Text)
End Sub
‘預覽列印按鈕事件副程式
Private Sub Command2_Click()
‘錯誤處理
On Error GoTo ere
‘宣告a為計數變數，b為頁面變數
Dim a, b As Integer
'巡覽所有檔案
For a = 0 To File1.ListCount
'利用數學計算讓數字循環
b = (((a + 1) - 1) Mod 5) + 1
'當檔案名稱存在時
If Len(File1.List(a)) > 0 Then
'循序在報表中設定證照正面圖檔
Set drt_Member_Card.Sections("Section1").Controls("drt_Member_Card_Fg" & Trim(Str(b))).Picture = imgCLASS_Card_F.Picture
'循序在報表中設定證照背面圖檔
Set drt_Member_Card.Sections("Section1").Controls("drt_Member_Card_Bg" & Trim(Str(b))).Picture = imgCLASS_Card_B.Picture
'循序在報表中設定照片圖檔
Set drt_Member_Card.Sections("Section1").Controls("drt_Member_Card_Photo" & Trim(Str(b))).Picture = LoadPicture(File1.Path & "\" & File1.List(a))
'當有設定編碼字元數時
If Slider5.Value > 0 Then
'循序在報表中設定姓名字元
drt_Member_Card.Sections("Section1").Controls("drt_Member_Card_Name" & Trim(Str(b))).Caption = Left$(File1.List(a), Slider5.Value)
End If
'循序在報表中設定以檔名前幾字元為編碼
drt_Member_Card.Sections("Section1").Controls("drt_Member_Card_Num" & Trim(Str(b))).Caption = Mid$(File1.List(a), (Slider5.Value + 1), (Len(File1.List(a)) - 4) - (Slider5.Value))
End If
'當每循環五次
If (b Mod 5) = 0 Then
'設定報表資料來源
Set drt_Member_Card.DataSource = objRst_LTYD_Card.DataSource
'呼叫預覽列印
drt_Member_Card.Show 1
'當小於五筆資料而且計數變數等於檔案數目時
ElseIf (b < 5) And (a = File1.ListCount) Then
'設定報表資料來源
Set drt_Member_Card.DataSource = objRst_LTYD_Card.DataSource
'呼叫預覽列印
drt_Member_Card.Show 1
End If
Next a
'跳離副程式
Exit Sub
'錯誤處理標籤
ere:
End Sub
'直接列印按鈕事件副程式
Private Sub Command3_Click()
'錯誤處理
On Error GoTo ere
'宣告a為計數變數，b為頁面變數
Dim a, b As Integer
'巡覽所有檔案
For a = 0 To File1.ListCount
'利用數學計算讓數字循環
b = (((a + 1) - 1) Mod 5) + 1
'當檔案名稱存在時
If Len(File1.List(a)) > 0 Then
'循序在報表中設定證照正面圖檔
Set drt_Member_Card.Sections("Section1").Controls("drt_Member_Card_Fg" & Trim(Str(b))).Picture = imgCLASS_Card_F.Picture
'循序在報表中設定證照背面圖檔
Set drt_Member_Card.Sections("Section1").Controls("drt_Member_Card_Bg" & Trim(Str(b))).Picture = imgCLASS_Card_B.Picture
'循序在報表中設定照片圖檔
Set drt_Member_Card.Sections("Section1").Controls("drt_Member_Card_Photo" & Trim(Str(b))).Picture = LoadPicture(File1.Path & "\" & File1.List(a))
'當有設定編碼字元數時
If Slider5.Value > 0 Then
'循序在報表中設定姓名字元
drt_Member_Card.Sections("Section1").Controls("drt_Member_Card_Name" & Trim(Str(b))).Caption = Left$(File1.List(a), Slider5.Value)
End If
'循序在報表中設定以檔名前幾字元為編碼
drt_Member_Card.Sections("Section1").Controls("drt_Member_Card_Num" & Trim(Str(b))).Caption = Mid$(File1.List(a), (Slider5.Value + 1), (Len(File1.List(a)) - 4) - (Slider5.Value))
End If
'當每循環五次
If (b Mod 5) = 0 Then
'設定報表資料來源
Set drt_Member_Card.DataSource = objRst_LTYD_Card.DataSource
'呼叫直接列印
drt_Member_Card.PrintReport
'當小於五筆資料而且計數變數等於檔案數目時
ElseIf (b < 5) And (a = File1.ListCount) Then
'設定報表資料來源
Set drt_Member_Card.DataSource = objRst_LTYD_Card.DataSource
'呼叫直接列印
drt_Member_Card.PrintReport
End If
Next a
'跳離副程式
Exit Sub
'錯誤處理標籤
ere:
End Sub
'結束程式按鈕事件副程式
Private Sub Command4_Click()
'結束程式
End
End Sub
'檔案控制項點選事件副程式
Private Sub File1_Click()
'當檔案名稱存在時
If Len(File1.FileName) > 0 Then
'設定載入照片檔
Image1.Picture = LoadPicture(File1.Path & "\" & File1.FileName)
'當有設定編碼字元數時
If Slider5.Value > 0 Then
'抓取檔名作為編號
Label8.Caption = Left$(File1.FileName, Slider5.Value)
End If
'抓取檔名作為姓名
Label6.Caption = Mid$(File1.FileName, (Slider5.Value + 1), (Len(File1.FileName) - 4) - (Slider5.Value))
End If
End Sub
'程式初始化事件副程式
Private Sub Form_Initialize()
'當照片目錄文字框為空時
If Len(txtMM_PD.Text) <= 0 Then
'預設應用程式路徑加上\IMG為照片目錄
txtMM_PD.Text = App.Path & "\IMG"
End If
End Sub
'程式起始載入事件副程式
Private Sub Form_Load()
'設定檔案管理物件
Set objFso = New FileSystemObject
'設定串流物件
Set objStm = New ADODB.Stream
'設定資料庫路徑
strLTYD_FN = App.Path & "\db1.mdb"
'呼叫資料庫連結設定自訂函式
Call mdiMM_Setup_cnnDB
'讀取系統登錄，取得照片目錄位置，否則以應用程式路徑加上\IMG代替
txtMM_PD.Text = GetSetting("人事室", "證照套印", "存照片目錄", App.Path & "\IMG")
'修正照片目錄路徑字串
txtMM_PD.Text = Trim(txtMM_PD.Text)
'設定照片目錄路徑給檔案控制項
File1.Path = Trim(txtMM_PD.Text)
'呼叫載入證照照片正面自訂函式
Call frmCLASS_Load_imgCLASS_Card_F
'呼叫載入證照照片背面自訂函式
Call frmCLASS_Load_imgCLASS_Card_B
End Sub
'宣告載入證照照片背面自訂函式
Private Sub cmdCLASS_Card_B_Click()
'錯誤處理
On Error GoTo cmdCLASS_Card_B_Click_ER:
'圖形檔暫存路徑
Dim strPT As String
'錯誤計數器
Dim intERR_Count As Integer
'設定圖形暫存檔路徑
strPT = App.Path & "LTY-PicTmp.WOK"
If Right$(App.Path, 1) <> "\" Then
strPT = App.Path & "\LTY-PicTmp.WOK"
End If
'如果圖形暫存檔已存在，為防止寫入暫存檔時出現唯獨無法寫入的情況．先設定為一般屬性．
If objFso.FileExists(strPT) = True Then
'設定圖形檔案屬性為一般
SetAttr strPT, vbArchive
End If
'開啟檔案對話盒
With cdlCLASS
.FileName = ""
.CancelError = False
.Filter = "所有圖檔 (*.bmp;*.ico;*.wmf;*.jpg;*.gif) |*.bmp;*.ico;*.wmf;*.jpg;*.gif|" & _
"點陣圖 (*.bmp)|*.bmp|" & _
"圖示檔 (*.ico)|*.ico|" & _
"中繼檔 (*.wmf)|*.wmf|" & _
"JPG 檔 (*.jpg)|*.jpg|" & _
"GIF 檔 (*.gif)|*.gif|"
.Flags = cdlOFNFileMustExist Or _
cdlOFNHideReadOnly Or _
cdlOFNLongNames Or _
cdlOFNPathMustExist
.InitDir = App.Path
.ShowOpen
End With
'沒有選取圖形檔案則結束載入
If Len(cdlCLASS.FileName) <= 0 Then
Exit Sub
End If
'若圖形檔案大於 500KB 則拒絕載入
If objFso.GetFile(cdlCLASS.FileName).Size >= 512000 Then
MsgBox "抱歉，" & Chr$(13) & _
"您所選擇的圖形檔超過 500 KB ，" & Chr$(13) & _
"請重新選擇小於 500 KB 的檔案。", _
vbOKOnly, _
"提示"
Exit Sub
'若圖形檔案小於 500KB 則載入
ElseIf objFso.GetFile(cdlCLASS.FileName).Size < 512000 Then
'檢查檔案是否存在
If objFso.FileExists(strLTYD_FN) = True Then
'拷貝圖形檔至圖形暫存檔
objFso.CopyFile cdlCLASS.FileName, strPT, True
'設定圖形檔案屬性為一般
SetAttr strPT, vbArchive
'載入證件圖形
objRst_LTYD_Card.Filter = "[證索] LIKE '001'"
'更新[證件圖形]
If objRst_LTYD_Card.EOF = True Then
objRst_LTYD_Card.AddNew
objRst_LTYD_Card!證索 = "001"
objRst_LTYD_Card!證名 = "學員證"
objRst_LTYD_Card.Update
End If
'寫入圖檔
objRst_LTYD_Card.Requery
'有此成員則寫入正面圖檔
If objRst_LTYD_Card.EOF = False Then
'寫入圖形檔案至證件圖形庫
With objStm
'設定資料型態為 adTypeBinary
.Type = adTypeBinary
'開啟 Stream Object
.Open
'載入檔案
.LoadFromFile strPT
'讀入資料至證反欄位
objRst_LTYD_Card!證反 = .Read
'寫入資料至證件圖形
objRst_LTYD_Card.Update
'關閉 Stream Object
.Close
End With
'載入圖形至影像框
imgCLASS_Card_B.Picture = LoadPicture(cdlCLASS.FileName)
'無此成員則出現提示訊息
ElseIf objRst_LTYD_Card.EOF = True Then
MsgBox "抱歉，" & Chr$(13) & _
"無法將圖形檔載入至指定的證件圖形中，" & Chr$(13) & _
"可能該證件圖形正在修改或是已被刪除。", _
vbOKOnly, _
"提示"
End If
'刪除圖形佔存檔
objFso.DeleteFile strPT, True
End If
End If
Exit Sub
'錯誤處理
cmdCLASS_Card_B_Click_ER:
'按下 Cancel 鍵離開
If Err.Number = cdlCancel Then
Exit Sub
'其他錯誤處理 : 顯示錯誤訊息，後離開
Else
'錯誤次數累計
intERR_Count = intERR_Count + 1
'錯誤次數處理
Select Case intERR_Count
'錯誤 20 次
Case 0 To 19
Call frmPPE_Delay(1)
Resume
'錯誤 11 次
Case 20 To 30
Select Case MsgBox("很抱歉，程式正繁忙，" & Chr$(13) & _
"稍後才能執行您的工作，" & Chr$(13) & _
"您願意稍後再試嗎？" & Chr$(13) & Chr$(13) & _
"Yes(是): 等待三秒後重新執行。" & Chr$(13) & _
"No (否): 重新操作一遍。", _
vbYesNo + vbCritical, "程式通知")
Case vbYes
Call frmPPE_Delay(3)
Resume Next
Case vbNo
Call frmPPE_Delay(1)
Exit Sub
End Select
'嚴重錯誤
Case Else
'錯誤
On Error GoTo 0
Exit Sub
End Select
End If
End Sub
'學員證之學員證正面圖形載入按鈕被按下
Private Sub cmdCLASS_Card_F_Click()
'錯誤處理
On Error GoTo cmdCLASS_Card_F_Click_ER:
'圖形檔暫存路徑
Dim strPT As String
'錯誤計數器
Dim intERR_Count As Integer
'設定圖形暫存檔路徑
strPT = App.Path & "LTY-PicTmp.WOK"
If Right$(App.Path, 1) <> "\" Then
strPT = App.Path & "\LTY-PicTmp.WOK"
End If
'如果圖形暫存檔已存在，為防止寫入暫存檔時出現唯獨無法寫入的情況．先設定為一般屬性．
If objFso.FileExists(strPT) = True Then
'設定圖形檔案屬性為一般
SetAttr strPT, vbArchive
End If
'開啟檔案對話盒
With cdlCLASS
.FileName = ""
.CancelError = False
.Filter = "所有圖檔 (*.bmp;*.ico;*.wmf;*.jpg;*.gif) |*.bmp;*.ico;*.wmf;*.jpg;*.gif|" & _
"點陣圖 (*.bmp)|*.bmp|" & _
"圖示檔 (*.ico)|*.ico|" & _
"中繼檔 (*.wmf)|*.wmf|" & _
"JPG 檔 (*.jpg)|*.jpg|" & _
"GIF 檔 (*.gif)|*.gif|"
.Flags = cdlOFNFileMustExist Or _
cdlOFNHideReadOnly Or _
cdlOFNLongNames Or _
cdlOFNPathMustExist
.InitDir = App.Path
.ShowOpen
End With
'沒有選取圖形檔案則結束載入
If Len(cdlCLASS.FileName) <= 0 Then
Exit Sub
End If
'若圖形檔案大於 500KB 則拒絕載入
If objFso.GetFile(cdlCLASS.FileName).Size >= 512000 Then
MsgBox "抱歉，" & Chr$(13) & _
"您所選擇的圖形檔超過 500 KB ，" & Chr$(13) & _
"請重新選擇小於 500 KB 的檔案。", _
vbOKOnly, _
"提示"
Exit Sub
'若圖形檔案小於 500KB 則載入
ElseIf objFso.GetFile(cdlCLASS.FileName).Size < 512000 Then
'檢查檔案是否存在
If objFso.FileExists(strLTYD_FN) = True Then
'拷貝圖形檔至圖形暫存檔
objFso.CopyFile cdlCLASS.FileName, strPT, True
'設定圖形檔案屬性為一般
SetAttr strPT, vbArchive
'載入證件圖形
objRst_LTYD_Card.Filter = "[證索] LIKE '001'"
'更新證件圖形
If objRst_LTYD_Card.EOF = True Then
objRst_LTYD_Card.AddNew
objRst_LTYD_Card!證索 = "001"
objRst_LTYD_Card!證名 = "學員證"
objRst_LTYD_Card.Update
End If
'寫入圖檔
objRst_LTYD_Card.Requery
'有此成員則寫入正面圖檔
If objRst_LTYD_Card.EOF = False Then
'寫入圖形檔案至證件圖形庫
With objStm
'設定資料型態為 adTypeBinary
.Type = adTypeBinary
'開啟 Stream Object
.Open
'載入檔案
.LoadFromFile strPT
'讀入資料至證正欄位
objRst_LTYD_Card!證正 = .Read
'寫入資料至證件圖形
objRst_LTYD_Card.Update
'關閉 Stream Object
.Close
End With
'載入圖形至影像框
imgCLASS_Card_F.Picture = LoadPicture(cdlCLASS.FileName)
'無此成員則出現提示訊息
ElseIf objRst_LTYD_Card.EOF = True Then
MsgBox "抱歉，" & Chr$(13) & _
"無法將圖形檔載入至指定的證件圖形中，" & Chr$(13) & _
"可能該證件圖形正在修改或是已被刪除。", _
vbOKOnly, _
"提示"
End If
'刪除圖形暫存檔
objFso.DeleteFile strPT, True
End If
End If
Exit Sub
'錯誤處理
cmdCLASS_Card_F_Click_ER:
'按下 Cancel 鍵離開
If Err.Number = cdlCancel Then
Exit Sub
'其他錯誤處理 : 顯示錯誤訊息，後離開
Else
'錯誤次數累計
intERR_Count = intERR_Count + 1
'錯誤次數處理
Select Case intERR_Count
'錯誤 20 次
Case 0 To 19
Call frmPPE_Delay(1)
Resume
'錯誤 11 次
Case 20 To 30
Select Case MsgBox("很抱歉，程式正繁忙，" & Chr$(13) & _
"稍後才能執行您的工作，" & Chr$(13) & _
"您願意稍後再試嗎？" & Chr$(13) & Chr$(13) & _
"Yes(是): 等待三秒後重新執行。" & Chr$(13) & _
"No (否): 重新操作一遍。", _
vbYesNo + vbCritical, "程式通知")
Case vbYes
Call frmPPE_Delay(3)
Resume Next
Case vbNo
Call frmPPE_Delay(1)
Exit Sub
End Select
'嚴重錯誤
Case Else
'錯誤
On Error GoTo 0
Exit Sub
End Select
End If
End Sub
'時間延遲
'siePT : 設定暫停時間
Public Sub frmPPE_Delay(siePT As Single)
'錯誤處理
On Error Resume Next
'設定起始時間
Dim sieST As Single
'循環迴圈至結束
'設定開始暫停的時刻
sieST = Timer
'開始計時
Do While Timer < sieST + siePT
DoEvents
Loop
End Sub
'載入證件圖形至學員證之學員證正面
Public Sub frmCLASS_Load_imgCLASS_Card_F()
'錯誤處理
On Error GoTo frmCLASS_Load_imgCLASS_Card_F_ER
'設定圖形暫存檔案路徑
Dim strPT As String
'錯誤計數器
Dim intERR_Count As Integer
'設定圖形暫存檔路徑
strPT = App.Path & "LTY-PicTmp.WOK"
If Right$(App.Path, 1) <> "\" Then
strPT = App.Path & "\LTY-PicTmp.WOK"
End If
'如果圖形暫存檔已存在，為防止寫入暫存檔時出現唯獨無法寫入的情況．先設定為一般屬性．
If objFso.FileExists(strPT) = True Then
'設定圖形檔案屬性為一般
SetAttr strPT, vbArchive
End If
'檢查檔案是否存在
If objFso.FileExists(strLTYD_FN) = True Then
'載入證件圖形
objRst_LTYD_Card.Filter = "[證索] LIKE '001' AND [證名] LIKE '學員證'"
If objRst_LTYD_Card.EOF = False Then
With Me
'有證件圖形正面
If IsNull(objRst_LTYD_Card!證正) = False Then
With objStm
' 指明儲存在資料串流物件的資料型態
.Type = adTypeBinary
' 開啟資料串流物件
.Open
' 將二進位資料附加到資料串流
.Write (objRst_LTYD_Card!證正)
'將資料流串中的圖形資料轉存到圖形暫存檔中
.SaveToFile strPT, adSaveCreateOverWrite
'關閉
.Close
End With
'若有圖形檔資料則載入
If objFso.GetFile(strPT).Size > 0 Then
'載入圖形檔至影像框
.imgCLASS_Card_F.Picture = LoadPicture(strPT)
'若沒有圖形檔資料則清除影像框
ElseIf objFso.GetFile(strPT).Size <= 0 Then
'清除影像框
.imgCLASS_Card_F.Picture = LoadPicture()
End If
' 刪除暫除檔。
objFso.DeleteFile strPT, True
'無證件圖形正面
ElseIf IsNull(objRst_LTYD_Card!證正) = True Then
'清除影像框
.imgCLASS_Card_F.Picture = LoadPicture()
End If
End With
'若無證件圖形
ElseIf objRst_LTYD_Card.EOF = True Then
'清除影像框
imgCLASS_Card_F.Picture = LoadPicture()
End If
End If
Exit Sub
'錯誤處理
frmCLASS_Load_imgCLASS_Card_F_ER:
'錯誤次數累計
intERR_Count = intERR_Count + 1
'錯誤次數處理
Select Case intERR_Count
'錯誤 20 次
Case 0 To 19
Call frmPPE_Delay(1)
Resume
'錯誤 11 次
Case 20 To 30
Select Case MsgBox("很抱歉，網路正繁忙，" & Chr$(13) & _
"稍後才能執行您的工作，" & Chr$(13) & _
"您願意稍後再試嗎？" & Chr$(13) & Chr$(13) & _
"Yes(是): 等待三秒後重新執行。" & Chr$(13) & _
"No (否): 重新操作一遍。", _
vbYesNo + vbCritical, "程式通知")
Case vbYes
Call frmPPE_Delay(3)
Resume Next
Case vbNo
Call frmPPE_Delay(1)
Exit Sub
End Select
'嚴重錯誤
Case Else
'錯誤
On Error GoTo 0
Exit Sub
End Select
End Sub
'載入證件圖形至學員證之學員證反面
Public Sub frmCLASS_Load_imgCLASS_Card_B()
'錯誤處理
On Error GoTo frmCLASS_Load_imgCLASS_Card_B_ER
'設定圖形暫存檔案路徑
Dim strPT As String
'錯誤計數器
Dim intERR_Count As Integer
'設定圖形暫存檔路徑
strPT = App.Path & "LTY-PicTmp.WOK"
If Right$(App.Path, 1) <> "\" Then
strPT = App.Path & "\LTY-PicTmp.WOK"
End If
'如果圖形暫存檔已存在，為防止寫入暫存檔時出現唯獨無法寫入的情況．先設定為一般屬性．
If objFso.FileExists(strPT) = True Then
'設定圖形檔案屬性為一般
SetAttr strPT, vbArchive
End If
'檢查檔案是否存在
If objFso.FileExists(strLTYD_FN) = True Then
'載入證件圖形
objRst_LTYD_Card.Filter = "[證索] LIKE '001' AND [證名] LIKE '學員證'"
If objRst_LTYD_Card.EOF = False Then
With Me
'有證件圖形反面
If IsNull(objRst_LTYD_Card!證反) = False Then
With objStm
' 指明儲存在資料串流物件的資料型態
.Type = adTypeBinary
' 開啟資料串流物件
.Open
' 將二進位資料附加到資料串流
.Write (objRst_LTYD_Card!證反)
'將資料流串中的圖形資料轉存到圖形暫存檔中
.SaveToFile strPT, adSaveCreateOverWrite
'關閉
.Close
End With
'若有圖形檔資料則載入
If objFso.GetFile(strPT).Size > 0 Then
'載入圖形檔至影像框
.imgCLASS_Card_B.Picture = LoadPicture(strPT)
'若沒有圖形檔資料則清除影像框
ElseIf objFso.GetFile(strPT).Size <= 0 Then
'清除影像框
.imgCLASS_Card_B.Picture = LoadPicture()
End If
' 刪除暫除檔。
objFso.DeleteFile strPT, True
'無證件圖形反面
ElseIf IsNull(objRst_LTYD_Card!證反) = True Then
'清除影像框
.imgCLASS_Card_B.Picture = LoadPicture()
End If
End With
'若無證件圖形
ElseIf objRst_LTYD_Card.EOF = True Then
'清除影像框
imgCLASS_Card_B.Picture = LoadPicture()
End If
End If
Exit Sub
'錯誤處理
frmCLASS_Load_imgCLASS_Card_B_ER:
'錯誤次數累計
intERR_Count = intERR_Count + 1
'錯誤次數處理
Select Case intERR_Count
'錯誤 20 次
Case 0 To 19
Call frmPPE_Delay(1)
Resume
'錯誤 11 次
Case 20 To 30
Select Case MsgBox("很抱歉，網路正繁忙，" & Chr$(13) & _
"稍後才能執行您的工作，" & Chr$(13) & _
"您願意稍後再試嗎？" & Chr$(13) & Chr$(13) & _
"Yes(是): 等待三秒後重新執行。" & Chr$(13) & _
"No (否): 重新操作一遍。", _
vbYesNo + vbCritical, "程式通知")
Case vbYes
Call frmPPE_Delay(3)
Resume Next
Case vbNo
Call frmPPE_Delay(1)
Exit Sub
End Select
'嚴重錯誤
Case Else
'呼叫錯誤紀錄函式, 設定 錯誤回應紀錄檔名
On Error GoTo 0
Exit Sub
End Select
End Sub
'設定資料庫相關連結
Public Sub mdiMM_Setup_cnnDB()
'錯誤處理
On Error GoTo mdiMM_Setup_cnnDB_ER:
'主資料庫錯誤計數器
Dim intERR_objCnn_LTYD As Integer
'錯誤計數器
Dim intERR_Count As Integer
'物件區
Set objCnn_LTYD = New ADODB.Connection
'開啟主資料庫連線
intERR_objCnn_LTYD = 0
strCnn_LTYD = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strLTYD_FN & ";" & _
"Mode=Read|Write|Share Deny None;" & _
"Persist Security Info=False;" ' & _
'"Jet OLEDB:Database Password=" & ""
Do
objCnn_LTYD.Open strCnn_LTYD
DoEvents
If objCnn_LTYD.Errors.Count > 0 Then
Select Case intERR_objCnn_LTYD
Case 0 To 10
Call frmPPE_Delay(1)
Case Else
MsgBox "很抱歉，" & Chr$(13) & _
"您要連線的資料庫別人正在使用中，" & Chr$(13) & _
"請您稍後再試。請見諒。", _
vbOKOnly, "通知"
End
End Select
intERR_objCnn_LTYD = intERR_objCnn_LTYD + 1
End If
Loop Until objCnn_LTYD.State = 1
'證件圖形SQL字串
Dim strSQL_LTYD_Card As String
Set objRst_LTYD_Card = New ADODB.Recordset
'證件圖形
strSQL_LTYD_Card = "SELECT * FROM [證件圖形] ORDER BY [證索]"
objRst_LTYD_Card.CacheSize = 1
objRst_LTYD_Card.CursorLocation = adUseClient
Do
objRst_LTYD_Card.Open strSQL_LTYD_Card, objCnn_LTYD, adOpenDynamic, adLockOptimistic
DoEvents
If objCnn_LTYD.Errors.Count > 0 Then
Select Case intERR_objRst_LTYD_Card
Case 0 To 10
Call frmPPE_Delay(1)
Case Else
MsgBox "很抱歉，" & Chr$(13) & _
"您要連線的資料錄別人正在使用中，" & Chr$(13) & _
"請您稍後再試。請見諒。", _
vbOKOnly, "通知"
End
End Select
intERR_objRst_LTYD_Card = intERR_objRst_LTYD_Card + 1
End If
Loop Until objRst_LTYD_Card.State = 1
Exit Sub
'錯誤處理
mdiMM_Setup_cnnDB_ER:
'錯誤次數累計
intERR_Count = intERR_Count + 1
'錯誤次數處理
Select Case intERR_Count
'錯誤 11 次
Case 0 To 10
Resume
'錯誤 9 次
Case 11 To 20
Select Case MsgBox("很抱歉，程式正繁忙，" & Chr$(13) & _
"稍後才能執行您的工作，" & Chr$(13) & _
"您願意稍後再試嗎？" & Chr$(13) & Chr$(13) & _
"Yes(是): 等待三秒後重新執行。" & Chr$(13) & _
"No (否): 結束程式，返回系統。", _
vbYesNo + vbCritical, "程式通知")
Case vbYes
Resume Next
Case vbNo
End
End Select
'嚴重錯誤
Case Else
End
End Select
End Sub
我們來看看這短短的幾百行程式能夠帶來甚麼便利的功能。如圖1、2。
圖 1 證照套印程式介面
圖 2 證照套印程式之預覽列印
1.7 修改重點¶
修改本程式基本上可以參考證照套印系統系統目的分析表，因為本程式已具備基礎功能，與其說是修改，不如說是擴充功能，若要成為真正網路版的系統，可以使得各地的店家能夠自行製作會員證，那麼就必須將所有照片檔匯入至SQL SERVER上，並加入會員資料管理功能，這樣就可以達到遠端製卡的目的。而將圖形檔匯入資料庫的程式碼已經在本程式中，稍做修改變成連結到SQL SERVER上，加上基本資料處理，程式碼不多，就可成為真正網路版的應用程式。
1.8 結論¶
由於需求者的需求十分明顯，只要能夠製卡，因此在分析設計的時候，要掌握的重點在於製卡，可以完全忽略掉會員管理的功能，一般來說分析的時候功能常常會東加西加，只要能切卻掌握重點，這支程式不用一天就完成了。而且能夠符合使用者的需求。並且善用現成的資源，就是照片是以檔案形式儲存，那又何必多去設計資料庫呢？只要以檔案名稱取碼，而這個動作權限釋放給使用者，您就可以省去會員基本資料的程式碼，而且照片檔案經過使用者整理之後，使用者要做備份動作也顯得容易，只要燒成光碟就完成了。而程式顯得小巧又實用。
版權聲明¶
Lai Tai-Yu (賴岱佑)
