|
แจกไปแล้วสำหรับสาย 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 มาให้ศึกษากันด้วยนะขอรับกระผม ...
ข้อมูลตัวอย่างจาก Excel โดยแอดมินจะให้ทำการโหลดเข้าสู่ตารางกริดของ FarPoint Spread จากนั้นก็ทำการพิมพ์ข้อมูลออก ActiveReports เป็นการดึงข้อมูลจากแถว แต่มาพิมพ์เป็นหลักแทน ... เอ้า เริ่มงงกันล่ะซิ ก็ต้องตามไปดูครับผม
ดาวน์โหลดชุดติดตั้ง FarPoint Spread ActiveX และ Update 8.0.21 ล่าสุดจากผู้ผลิต (เฉพาะสมาชิกเท่านั้น)
ดาวน์โหลดชุดติดตั้ง ActiveReports 2.0 (เฉพาะสมาชิกเท่านั้น)
เริ่มต้นสร้างโปรเจค ...
VB6 Designer ...
Project --> References ...
Project --> Components ...
ActiveReports Designer ...
การประยุกต์ใช้ Initialized File (INI) เพื่อจัดเก็บข้อมูลขนาดเล็ก
ข้อมูลของ INI ... ซึ่งจะประกอบไปด้วย
[Section]
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", "[1] กรุณาชำระเงินภายในวันที่ 5 ของทุกเดือน"
- sWriteINI strFileINI, "Config", "Remark2", "[2] ชำระค่าปรับล่าช้าวันละ 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 = "[1] กรุณาชำระเงินภายในวันที่ 5 ของทุกเดือน"
- txtRemark2.Text = "[2] ชำระค่าปรับล่าช้าวันละ 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 ได้ที่นี่ ...
|
ขออภัย! โพสต์นี้มีไฟล์แนบหรือรูปภาพที่ไม่ได้รับอนุญาตให้คุณเข้าถึง
คุณจำเป็นต้อง ลงชื่อเข้าใช้ เพื่อดาวน์โหลดหรือดูไฟล์แนบนี้ คุณยังไม่มีบัญชีใช่ไหม? ลงทะเบียน
x
|