[VB6] แจกฟรีโค้ดการพิมพ์ใบแจ้งค่าใช้จ่าย แบบกระดาษครึ่ง A4 ด้วย FarPoint Spread และ ActiveReports 2.0
http://www.g2gnet.com/webboard/images/vb6/FPAR2PaymentRun.pngแจกไปแล้วสำหรับสาย Dot Net ฟรีโค้ด VB.NET + ActiveReports.NET การพิมพ์ใบแจ้งค่าใช้จ่าย สำหรับหอพัก ห้องเช่า อพาร์ทเมนท์ แบบกระดาษครึ่ง A4 ... ประเดี๋ยวมิตรรักแฟนคลับ VB6 จะน้อยเนื้อต่ำใจหาว่าแอดมินทอดทิ้งเมียเก่าเมียแก่อย่าง VB6 ที่อยู่ด้วยกันมาอย่างยาวนาน สิ่งที่แอดมินอยากจะกล่าวถึงก็คือ เรื่องที่หลายต่อหลายคนมักชอบผูกข้อมูล (Bound Data) จากแหล่งจ่าย (Data Source) ยึดติดเข้าไว้กับบรรดา Control ต่างๆ เช่น TexBox หรือ DataGrid แน่นอนว่ามันเป็นวิธีการที่ค่อนข้างง่ายดายมากๆ แต่ในกรณีที่ไม่มี Data Source หรือไม่ใช่บรรดาพวก Relation DataBase ล่ะจะทำอย่างไร หรือมีแต่ต้องไปติดต่อผ่าน OLEDB (อ่านว่า โอเล่ดีบี) มาก่อน ก็จะทำให้เสียเวลาอีกนั่นแหละ ...
หากเรามีแหล่งข้อมูลอะไรก็ได้ เช่น XLS, CSV, XML หรืออื่นๆ ที่สามารถโหลดข้อมูลเข้าสู่ตารางกริด เพื่อต้องการจะพิมพ์งาน หรือต้องการนำข้อมูลไปใช้ในงานอื่นๆ เช่น ทำกราฟแสดงผล มันก็จะเกิดปัญหาขึ้น เพราะเราไม่สามารถผูกโยงฟิลด์ข้อมูลเข้าหา Control ได้ ดังนั้นเราจึงจำเป็นจะต้องใช้วิธีการ Unbound Data แทน นั่นก็คือการ Loop ข้อมูลจากตารางกริดมาใช้งานแทนซิครับทั่นผู้ชม นอกจากนี้แล้วแอดมินเลยรวบรัดแถมท้าย การจัดเก็บข้อมูลขนาดเล็กเอาไว้ใน Initialized File หรือ INI มาให้ศึกษากันด้วยนะขอรับกระผม ...
http://www.g2gnet.com/webboard/images/vb6/FPAR2PaymentExcel.png
ข้อมูลตัวอย่างจาก Excel โดยแอดมินจะให้ทำการโหลดเข้าสู่ตารางกริดของ FarPoint Spread จากนั้นก็ทำการพิมพ์ข้อมูลออก ActiveReports เป็นการดึงข้อมูลจากแถว แต่มาพิมพ์เป็นหลักแทน ... เอ้า เริ่มงงกันล่ะซิ ก็ต้องตามไปดูครับผม
ดาวน์โหลดชุดติดตั้ง FarPoint Spread ActiveX และ Update 8.0.21 ล่าสุดจากผู้ผลิต (เฉพาะสมาชิกเท่านั้น)
ดาวน์โหลดชุดติดตั้ง ActiveReports 2.0 (เฉพาะสมาชิกเท่านั้น)
เริ่มต้นสร้างโปรเจค ...
http://www.g2gnet.com/webboard/images/vb6/FPAR2PaymentDesign.png
VB6 Designer ...
http://www.g2gnet.com/webboard/images/vb6/FPAR2PaymentRef.png
Project --> References ...
http://www.g2gnet.com/webboard/images/vb6/FPAR2PaymentCom.png
Project --> Components ...
http://www.g2gnet.com/webboard/images/vb6/FPAR2PaymentARDesign.png
ActiveReports Designer ...
http://www.g2gnet.com/webboard/images/vb6/FPAR2PaymentINI.png
การประยุกต์ใช้ Initialized File (INI) เพื่อจัดเก็บข้อมูลขนาดเล็ก
http://www.g2gnet.com/webboard/images/vb6/FPAR2PaymentINIData.png
ข้อมูลของ INI ... ซึ่งจะประกอบไปด้วย
Key = Value
มาดูโค้ดกันเถอะ ... เป็นฟอร์มหลัก frmPaymentRoomMain.frm
Option Explicit
Dim XLSFile As String
Dim fpHandle As Integer
Dim fpFileName As String
'//
Dim rptPrint As Object
Private Sub cmbWorkSheet_Click()
Dim lRet As Long
If Not cmbWorkSheet.ListIndex = 0 Then _
lRet = fp.ImportExcelSheet(fpHandle, cmbWorkSheet.ListIndex - 1)
'/ ปกติเราควรไปตั้งค่าจากโปรแกรมย่อยแทน
'/ แสดงแถบแสงหรือไม่แสดง
fp.OperationMode = OperationModeSingle ' แถบ Selection
'fp.OperationMode = OperationModeNormal ' เอาไว้ป้อนข้อมูล
'fpSpread.OperationMode = OperationModeRead ' ไม่มีแถบ
'fpSpread.OperationMode = OperationModeRow
'/ ไม่แสดงชื่อหลัก
fp.ColHeadersShow = False
End Sub
' / --------------------------------------------------------------------------------
' / เริ่มต้นการเปิดไฟล์ Excel
Private Sub cmdOpenXLS_Click()
'/ แบบไม่สนใจ Error สั่งให้ทำงานต่อ ... แบบนี้ไม่ค่อยดีเท่าไรนักหรอกครับ
'On Error Resume Next
'/ อันนี้คอยดัก Trap Error
On Error GoTo ErrorHandler ' Enable error-handling routine.
Dim List() As String
Dim ListCount As Integer
Dim blnXLS As Boolean
ReDim List(1)
With dlgOpenFile
.FileName = "*.xls"
.DialogTitle = "Select Excel file to open"
.Filter = "Excel 97-2003 files (*.xls)|*.xls"
.FilterIndex = 0
.InitDir = App.Path
.Flags = cdlOFNHideReadOnly
.ShowOpen
If .FileName = "*.xls" Then Exit Sub
txtFileXLS.Text = .FileName
'/ GetExcelSheetList is a method and return boolean value.
blnXLS = fp.GetExcelSheetList(.FileName, List, ListCount, "", fpHandle, True)
End With
cmbWorkSheet.Clear
'/ Clear Rows
fp.MaxRows = 0
'/
If blnXLS Then
'/ Open XLS File
fp.OpenExcel2007File txtFileXLS.Text, "", -1, -1, ""
'/
Me.cmbWorkSheet.AddItem ("")
Dim i As Integer
For i = 0 To ListCount - 1
Me.cmbWorkSheet.AddItem (List(i))
Next
End If
ExitProc:
Exit Sub
ErrorHandler: ' Error-handling routine.
MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
Resume ExitProc
End Sub
' / --------------------------------------------------------------------------------
' / เหตุการณ์ดับเบิ้ลคลิกเมาส์ มีการระบุตำแหน่งของหลักและแถว
Private Sub fp_DblClick(ByVal Col As Long, ByVal Row As Long)
' / --------------------------------------------------------------------------------
' รับค่าหลักและแถวที่ส่งมา เพื่อระบุตำแหน่งเซลล์
fp.Col = Col: fp.Row = Row
If fp.Text = "" Or Len(fp.Text) = 0 Or fp.Row = 1 Then Exit Sub
'MsgBox "คุณเลือกรายการที่หลัก " & fp.Col & " แถว " & fp.Row & vbCrLf & "ข้อมูลในเซลล์ = " & fp.Text
'// ActiveReports Setup
Set rptPrint = New arSlipHalfA4
Set Me.ARViewerSlip.object = rptPrint
ARViewerSlip.Zoom = 90
End Sub
Private Sub fp_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Call fp_DblClick(fp.ActiveCol, fp.ActiveRow)
End Sub
' / --------------------------------------------------------------------------------
Private Sub Form_Load()
' / --------------------------------------------------------------------------------
Me.Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
txtFileXLS.Text = ""
cmbWorkSheet.Clear
fp.ColHeadersShow = False
End Sub
Private Sub Form_Resize()
On Error Resume Next
'//
fraOpenExcel.Width = Me.ScaleWidth - 30
cmdExit.Left = fraOpenExcel.Width - cmdExit.Width - 75
fraFP.Move 15, 1200
fraFP.Width = Me.ScaleWidth - 30
fraFP.Height = fp.Top - fraPrint.Top
fp.Width = fraFP.Width - 75
'//
fraPrint.Width = Me.ScaleWidth - 15
fraPrint.Height = Me.ScaleHeight - fraFP.Height - fraOpenExcel.Height
ARViewerSlip.Move 15, 120, fraPrint.Width - 60, fraPrint.Height - 180
End Sub
Private Sub Form_Unload(Cancel As Integer)
' ลบไฟล์ Temporary ออกให้หมด
If Dir$(App.Path & "\*.tmp") <> "" Then Kill App.Path & "\*.tmp"
'//
Set frmPaymentRoomMain = Nothing
End
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub mnuFileExit_Click()
Unload Me
End Sub
Private Sub mnuFileSetup_Click()
frmSetup.Show vbModal
End Sub
โค้ดในส่วนของการพิมพ์รายงาน (arSlipHalfA4.dsr)
Option Explicit
Dim ItemNo As Integer
'// รับค่าแถวในการพิมพ์จากฟอร์มหลัก
Dim sRow As Integer
'//
Dim GrandTotal As Double
' / --------------------------------------------------------------------------------
Private Sub ActiveReport_FetchData(EOF As Boolean)
ItemNo = ItemNo + 1
' ตรวจสอบจำนวนการพิมพ์ตามหลักแล้วให้ลบออก 2 เพราะหลักแรกคือชื่อผู้เช่า หลักที่ 2 คือหมายเลขห้อง
If ItemNo > frmPaymentRoomMain.fp.DataColCnt - 2 Then
EOF = True
Exit Sub
Else
EOF = False
End If
End Sub
' / --------------------------------------------------------------------------------
Private Sub ActiveReport_Initialize()
'/ พิมพ์ตามแนวตั้ง
PageSettings.Orientation = ddOPortrait
'/ ขนาดกระดาษแบบกำหนดเอง
PageSettings.PaperSize = 256
PageSettings.LeftMargin = 500
PageSettings.RightMargin = 60
PageSettings.BottomMargin = 100
PageSettings.TopMargin = 600
'/ ขนาดปัจจุบันครึ่ง A4 (หรือ A5) มีหน่วยวัดเป็น Twip โดยที่ 1440 Twip = 1 นิ้ว หรือ 2.54 ซม.
'/ (14.5 * 1440 / 2.54) คือการเทียบบัญญัติไตรยางค์กับหน่วยวัดเซนติเมตร
PageSettings.PaperHeight = (14.5 * 1440 / 2.54)
PageSettings.PaperWidth = (21 * 1440 / 2.54)
'
txtCname.Text = ""
txtRoomNo.Text = ""
txtDate.Text = ""
txtDateMonth.Text = ""
txtItem.Text = ""
txtDesc.Text = ""
txtQTY.Text = ""
txtUnitPrice.Text = ""
txtAmount.Text = ""
txtGrandTotal.Text = 0
'// รับค่าจากฟอร์มหลัก
' รับค่าหลักและแถวที่ส่งมา เพื่อระบุตำแหน่งเซลล์
With frmPaymentRoomMain.fp
.Col = .Col: .Row = .Row
'// เก็บค่า Select Row
sRow = .Row
End With
'// อ่านค่า INI File
Dim strFileINI As String
strFileINI = App.Path & "\Config.ini"
'// เช็คว่ามีไฟล์ Config.ini อยู่หรือไม่???
'// หากไม่มีก็ตั้งค่าเริ่มต้นให้ก่อน
If Dir(strFileINI) = "" Then
sWriteINI strFileINI, "Config", "HeaderBill", "- ใบแจ้งค่าใช้จ่าย -"
sWriteINI strFileINI, "Config", "Owner", "ทองก้อน อพาร์ทเมนท์ แอนด์ โฮมเพลย์สเตชั่น"
sWriteINI strFileINI, "Config", "Address", "123/456 ถ.กลางเมือง ต.เมืองเก่า อ.เมือง จ.ขอนแก่น โทร.043-XXX-XXX"
sWriteINI strFileINI, "Config", "Remark1", " กรุณาชำระเงินภายในวันที่ 5 ของทุกเดือน"
sWriteINI strFileINI, "Config", "Remark2", " ชำระค่าปรับล่าช้าวันละ 50 บาท"
End If
'// อ่านค่า Config ต่างๆเข้ามา
lblHeaderBill.Caption = sReadINI(strFileINI, "Config", "HeaderBill", "")
txtOwner.Text = sReadINI(strFileINI, "Config", "Owner", "")
txtAddress.Text = sReadINI(strFileINI, "Config", "Address", "")
lblRemark1.Caption = sReadINI(strFileINI, "Config", "Remark1", "")
lblRemark2.Caption = sReadINI(strFileINI, "Config", "Remark2", "")
End Sub
' / --------------------------------------------------------------------------------
'// การวนรอบโดยนับตามจำนวนหลัก แต่แถวเป็นค่าเดิมตลอด (sRow)
Private Sub Detail_Format()
txtItem.Text = ItemNo & "."
With frmPaymentRoomMain
'// อ่านแถวแรกสุด นั่นก็คือ Header เพื่อพิมพ์รายการหัวข้อ (Description)
.fp.Col = ItemNo + 2
.fp.Row = 1
txtDesc.Text = .fp.Text
'//
txtQTY.Text = "1"
'// ใช้หลักเดิมแต่เปลี่ยนแถว เพื่ออ่านค่าจำนวนเงินในการพิมพ์
.fp.Col = ItemNo + 2: .fp.Row = sRow
txtUnitPrice.Text = Format(.fp.Text, "#,##0.00")
txtAmount.Text = Format(txtUnitPrice.Text, "#,##0.00")
End With
' หาจำนวนเงินรวม
GrandTotal = Format(GrandTotal + CDbl(txtAmount.Text), "#,##0.00")
'// กระโดดไปโปรแกรมย่อย FetchData เข้ามาใหม่
End Sub
' / --------------------------------------------------------------------------------
Private Sub GroupFooter1_Format()
txtGrandTotal.Text = "รวมจำนวนเงินทั้งสิ้น: " & Format(GrandTotal, "#,##0.00") & ""
End Sub
' / --------------------------------------------------------------------------------
' / พิมพ์ส่วนหัว
Private Sub PageHeader_Format()
With frmPaymentRoomMain
'// เลือกหลัก 1
.fp.Col = 1
'// แถวที่เลือก
.fp.Row = sRow
'// รับค่าจากหลัก 1 แถวที่เลือก เพื่อพิมพ์ชื่อผู้เช่า
txtCname.Text = "" & .fp.Text
.fp.Col = 2
'// รับค่าจากหลัก 2 แถวที่เลือก เพื่อพิมพ์หมายเลขห้อง
txtRoomNo.Text = "" & .fp.Text
End With
txtDate.Text = Format(Now(), "dd/mm/yyyy") & " เวลา: " & Format(Now(), "HH:MM")
Dim strDate As String
'// อ่านชื่อ WorkSheet และทำการตัดค่าบางตัวทิ้งไป คือ $ และ '
strDate = frmPaymentRoomMain.cmbWorkSheet.Text
strDate = Replace$(strDate, "[ DISCUZ_CODE_1 ]quot;, "")
strDate = Replace$(strDate, "'", "")
txtDateMonth.Text = strDate
End Sub
โค้ดในส่วนของ INI เพื่อทำการตั้งค่าหัวข้อและรายละเอียดการพิมพ์
Option Explicit
Dim strFileINI As String
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdSave_Click()
strFileINI = App.Path & "\Config.ini"
'// เก็บค่า Config เอาไว้ใน INI ก่อนที่จะไปทำงานอื่นต่อ
sWriteINI strFileINI, "Config", "HeaderBill", txtHeaderBill.Text
sWriteINI strFileINI, "Config", "Owner", txtOwner.Text
sWriteINI strFileINI, "Config", "Address", txtAddress.Text
sWriteINI strFileINI, "Config", "Remark1", txtRemark1.Text
sWriteINI strFileINI, "Config", "Remark2", txtRemark2.Text
MsgBox "บันทึกข้อมูลเรียบร้อย.", vbOKOnly + vbInformation, "รายงานสถานะ"
Unload Me
End Sub
' / --------------------------------------------------------------------------------
Private Sub Form_Load()
'/
strFileINI = App.Path & "\Config.ini"
'// เช็คว่ามีไฟล์ Config.ini อยู่หรือไม่???
'// หากไม่มีก็ตั้งค่าเริ่มต้นให้ก่อน
If Dir(strFileINI) = "" Then
txtHeaderBill.Text = "- ใบแจ้งค่าใช้จ่าย -"
txtOwner.Text = "ทองก้อน อพาร์ทเมนท์ แอนด์ โฮมเพลย์สเตชั่น"
txtAddress.Text = "123/456 ถ.กลางเมือง ต.เมืองเก่า อ.เมือง จ.ขอนแก่น โทร.043-XXX-XXX"
txtRemark1.Text = " กรุณาชำระเงินภายในวันที่ 5 ของทุกเดือน"
txtRemark2.Text = " ชำระค่าปรับล่าช้าวันละ 50 บาท"
'// เก็บค่า Config เอาไว้ใน INI ก่อนที่จะไปทำงานอื่นต่อ
sWriteINI strFileINI, "Config", "HeaderBill", txtHeaderBill.Text
sWriteINI strFileINI, "Config", "Owner", txtOwner.Text
sWriteINI strFileINI, "Config", "Address", txtAddress.Text
sWriteINI strFileINI, "Config", "Remark1", txtRemark1.Text
sWriteINI strFileINI, "Config", "Remark2", txtRemark2.Text
Else
'// อ่านค่า Config ต่างๆเข้ามา
txtHeaderBill.Text = sReadINI(strFileINI, "Config", "HeaderBill", "")
txtOwner.Text = sReadINI(strFileINI, "Config", "Owner", "")
txtAddress.Text = sReadINI(strFileINI, "Config", "Address", "")
txtRemark1.Text = sReadINI(strFileINI, "Config", "Remark1", "")
txtRemark2.Text = sReadINI(strFileINI, "Config", "Remark2", "")
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
' ลบไฟล์ Temporary ออกให้หมด
If Dir$(App.Path & "\*.tmp") <> "" Then Kill App.Path & "\*.tmp"
Set frmSetup = Nothing
Unload Me
End Sub
โมดูล (Module) ฟังค์ชั่นในการปฏิบัติการกับ Initialized File (modINI.bas) ...
Option Explicit
'API DECLARATIONS
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" ( _
ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long, _
ByVal lpFileName As String _
) As Long
Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" ( _
ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, _
ByVal lpString As Any, _
ByVal lpFileName As String _
) As Long
Public Function sReadINI(sINIFile As String, sSection As String, sKey As String, sDefault As String) As String
Dim sTemp As String * 256
Dim nLength As Integer
sTemp = Space$(256)
nLength = GetPrivateProfileString(sSection, sKey, sDefault, sTemp, 255, sINIFile)
sReadINI = Left$(sTemp, nLength)
End Function
Public Sub sWriteINI(sINIFile As String, sSection As String, sKey As String, sValue As String)
Dim n As Integer
Dim sTemp As String
sTemp = sValue
'/ Replace any CR/LF characters with spaces
For n = 1 To Len(sValue)
If Mid$(sValue, n, 1) = vbCr Or Mid$(sValue, n, 1) = vbLf Then Mid$(sValue, n) = " "
Next n
n = WritePrivateProfileString(sSection, sKey, sTemp, sINIFile)
End Sub
Conclusion: แอดมินไม่ได้ข้ามขั้นตอนสอนวิธีการใช้งาน FarPoint และ ActiveReports แบบเบื้องต้นมาก่อนหรอกครับ แต่มันอยู่ในเว็บบอร์ดตัวเดิมก่อนที่จะย้ายโอสติ้งใหม่ หาก FC VB6 ที่ติดตามแอดมินมาโดยตลอดก็คงจะทราบดีกันอยู่แล้ว แต่สำหรับสมาชิกใหม่หรือท่านที่พึ่งรู้จักกับเว็บบอร์ดของแอดมิน หากมีข้อสงสัยประการใด ก็ขอเรียนเชิญถามมาได้ที่เว็บบอร์ด หรือที่เฟซบุ๊คของแอดมินแทนไปก่อนล่ะกันครับ ...
ดาวน์โหลดโค้ดต้นฉบับแบบเต็ม VB6 ได้ที่นี่ ...
สุดยอดครับ แอดมิน ขอบคุณอีกครั้งครับ กำลังจะตามไปเป็นมือใหม่ที่ Dot Net อาจารย์เดินหน้าไปเลยไม่ต้องห่วงหลัง ขอบคุณครับ ผมเริ่มกลับมาสนใจตัว FarPoint grapecity อย่างมากๆ แต่ก็ชั่งใจจะถอยกลับไป vb6 :D downrung ตอบกลับเมื่อ 2023-10-31 17:45
ผมเริ่มกลับมาสนใจตัว FarPoint grapecity อย่างมากๆ แต่ก็ชั่งใจจะถอยกลับไป vb6
ผมจำได้ว่าผมเคยใช้ FarPoint ActiveX บน VB.NET ได้นะครับ
หน้า:
[1]