[VB.NET] แจกโค้ดต้นฉบับและโปรแกรมการพิมพ์ไปรษณียบัตร ทายผลฟุตบอลโลก 2018
http://www.g2gnet.com/webboard/images/vbnet/FIFAPostcardSender.pnghttp://www.g2gnet.com/webboard/images/vbnet/FIFAPostcardChamp.png
http://www.g2gnet.com/webboard/images/vbnet/FIFAPostcardPrint.png
การวางไปรษณียบัตรเพื่อทำการพิมพ์ ...
สำหรับผู้ใช้งานทั่วไป คลิ๊กดาวน์โหลดโปรแกรมเพื่อใช้งานได้ที่นี่ ... :)
จะเป็นอะไรมั้ย ที่แอดมินจะลอกแนวคิดของการออกแบบมาจากความคิดของตัวเอง 5555+ ... สำหรับงานนี้ก็ยังคงยึดวิธีิคิดมาจาก VB6 อยู่เหมือนเดิม ในการปรับระยะการพิมพ์ และปรับฟอนต์และขนาดของตัวอักษร โดยใช้เทคนิคการเก็บข้อมูลเดิมกับการใช้งาน Registry ด้วยคำสั่ง (หรือฟังค์ชั่น) อย่างง่ายๆคือ GetSetting เพื่อทำการอ่านค่า และ SaveSetting เพื่อทำการเขียนค่าเข้าไปจัดเก็บครับผม ...
สำหรับท่านที่เผลอเข้ามา ดาวน์โหลด ActiveReports .NET Version 6.2.3681 (เฉพาะสมาชิกเท่านั้น)
http://www.g2gnet.com/webboard/images/vbnet/FIFAPostcardTitle.png
Application Title
เรียกคำสั่งจาก Run --> RegEdit เพื่อมาดูผลการบันทึกลง Registry ...
http://www.g2gnet.com/webboard/images/vbnet/FIFAPostcardRegistry.png
Computer\HKEY_CURRENT_USER\Software\VB and VBA Program Settings\ชื่อ Application
มาดูโค้ดในส่วนของฟอร์มหลัก ...
' / --------------------------------------------------------------------------------
' / Developer : Mr.Surapon Yodsanga (Thongkorn Tubtimkrob)
' / eMail : thongkorn@hotmail.com
' / URL: http://www.g2gnet.com (Khon Kaen - Thailand)
' / Facebook: https://www.facebook.com/g2gnet (For Thailand)
' / Facebook: https://www.facebook.com/commonindy (Worldwide)
' / Purpose : Print out postcard with ActiveReports.NET 6.0
' / Microsoft Visual Basic .NET (2010) SP1
' / This is open source code under @CopyLeft by Thongkorn Tubtimkrob.
' / You can modify and/or distribute without to inform the developer.
' / --------------------------------------------------------------------------------
Imports DataDynamics.ActiveReports
Public Class frmPrintPostcard
Private Sub frmPrintPostcard_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
txtSender.Text = _
"นายทองก้อน ทับทิมกรอบ" & vbCrLf & _
"142 ม.11 ซ.ฉัตรทอง 5 ถ.กลางเมือง" & vbCrLf & _
"ต.เมืองเก่า อ.เมืองขอนแก่น" & vbCrLf & _
"จ.ขอนแก่น 40000" & vbCrLf & "โทรศัพท์. 08-6862-6560"
txtChamp.Text = "ไทยแลนด์"
' ตั้งค่า ActiveReports
Viewer1.ReportViewer.Zoom = 1.0F ' Zoom
Viewer1.ReportViewer.DisplayUnits = Viewer.DisplayUnits.Metric
Viewer2.ReportViewer.Zoom = 1.0F ' Zoom
Viewer2.ReportViewer.DisplayUnits = Viewer.DisplayUnits.Metric
'// Minimum Size
Me.MinimumSize = New Size(832, 733)
'/ หากไม่มีค่าเดิม ให้ตั้งค่า Default แทน
numLeftMargin.Text = ReadAppRegistry("SetMargin", "LeftMargin", "42")
numTopMargin.Text = ReadAppRegistry("SetMargin", "TopMargin", "25")
numLeftMarginChamp.Text = ReadAppRegistry("SetMargin", "LeftMarginChamp", "13")
numTopMarginChamp.Text = ReadAppRegistry("SetMargin", "TopMarginChamp", "38")
'// Initialize Font Style
lblDataFont.Font = New Font(ReadAppRegistry("SetFont", "FontName", "BrowalliaUPC"), ReadAppRegistry("SetFont", "FontSize", "18"))
'// Font Style
' 0001 (ฐาน 2) : 1 (ฐาน 10)Bold
' 0010 (ฐาน 2) : 2 (ฐาน 10)Italic
' 0100 (ฐาน 2) : 4 (ฐาน 10)Underline
' 1000 (ฐาน 2) : 8 (ฐาน 10)Strikeout
'// ตั้งค่าเริ่มต้นเป็น 0 ให้หมด เพราะในเงื่อนไขด้านล่าง หากมีเงื่อนไขเป็นเท็จ จะได้ไม่ต้องมี Else ให้สิ้นเปลืองพลังงานการพิมพ์
Dim fntBold As Byte = 0
Dim fntItalic As Byte = 0
Dim fntUnderline As Byte = 0
Dim fntStrikeout As Byte = 0
'// พิมพ์ชื่อผู้ส่ง
If Convert.ToBoolean(ReadAppRegistry("SetFont", "FontBold", "False")) Then fntBold = 1
If Convert.ToBoolean(ReadAppRegistry("SetFont", "FontItalic", "False")) Then fntItalic = 2
If Convert.ToBoolean(ReadAppRegistry("SetFont", "FontUnderline", "False")) Then fntUnderline = 4
If Convert.ToBoolean(ReadAppRegistry("SetFont", "FontStrikeout", "False")) Then fntStrikeout = 8
'/ ใช้ลอจิก OR กระทำทางตรรกศาสตร์เลขฐาน 2
lblDataFont.Font = New Font(lblDataFont.Font, fntBold Or fntItalic Or fntUnderline Or fntStrikeout)
'/ แสดงผลตัวอย่าง และจะเก็บ Font Style เอาไว้ เพื่อทำการเขียนลง Registry
lblDataFont.Text = lblDataFont.Font.Name & ", " & lblDataFont.Font.Size
'// Initialize Font Style
lblDataFontChamp.Font = New Font(ReadAppRegistry("SetFontChamp", "FontName", "BrowalliaUPC"), ReadAppRegistry("SetFontChamp", "FontSize", "20"))
'// พิมพ์ชื่อแชมป์ (ใช้ตัวแปรเดิมได้โดยไม่ต้องประกาศใหม่)
fntBold = 0 : fntItalic = 0 : fntUnderline = 0 : fntStrikeout = 0
If Convert.ToBoolean(ReadAppRegistry("SetFontChamp", "FontBold", "False")) Then fntBold = 1
If Convert.ToBoolean(ReadAppRegistry("SetFontChamp", "FontItalic", "False")) Then fntItalic = 2
If Convert.ToBoolean(ReadAppRegistry("SetFontChamp", "FontUnderline", "False")) Then fntUnderline = 4
If Convert.ToBoolean(ReadAppRegistry("SetFontChamp", "FontStrikeout", "False")) Then fntStrikeout = 8
lblDataFontChamp.Font = New Font(lblDataFontChamp.Font, fntBold Or fntItalic Or fntUnderline Or fntStrikeout)
lblDataFontChamp.Text = lblDataFontChamp.Font.Name & ", " & lblDataFontChamp.Font.Size
End Sub
' / -----------------------------------------------------------------------------------------------
' / อ่านค่าจาก Registry และคืนค่าคุณสมบัตินั้นๆคืนกลับไป
' / Registry with VB.NET function
Function ReadAppRegistry(SectionName As String, _
KeyName As String, _
KeyValue As String _
) As String
' / -----------------------------------------------------------------------------------------------
' Application Title ...
Dim AppTitle As String = My.Application.Info.Title
If GetSetting(AppTitle, SectionName, KeyName) = "" Then _
Call SaveSetting(AppTitle, SectionName, KeyName, KeyValue)
' ส่งค่าคืนกลับไปแบบ String
ReadAppRegistry = GetSetting(AppTitle, SectionName, KeyName)
End Function
' / -----------------------------------------------------------------------------------------------
' / เป็นการบันทึกลง Registry ดังนั้นจึงไม่ต้องคืนค่ากลับไป เราจึงใช้ Sub Program
' / Registry with VB.NET function
' / เวลาที่เรา Write Registry มันจะไปอยู่ที่
' / Computer\HKEY_CURRENT_USER\Software\VB and VBA Program Settings\ชื่อแอพพลิเคชั่นที่เราตั้งไว้ ตัวอย่างเช่น FIFAPostCard
Sub WriteAppRegistry(SectionName As String, _
KeyName As String, _
KeyValue As String _
)
' Application Title ...
Dim AppTitle As String = My.Application.Info.Title
Call SaveSetting(AppTitle, SectionName, KeyName, KeyValue)
End Sub
Private Sub btnPreview_Click(sender As System.Object, e As System.EventArgs) Handles btnPreview.Click
If tabMain.SelectedTab Is TabPage1 Then
'/ Instance name ARDesigner มันจะชี้ไปที่ไฟล์ arBarcode.vb
Dim rpt As New arPrintPostcard()
'/ Run Report
rpt.Run()
'/ โหลดรายงาน document (arPrintEnvelope) เข้าสู่ ActiveReports Viewer
Me.Viewer1.Document = rpt.Document
Else
Dim rpt As New arPrintChamp()
rpt.Run()
Me.Viewer2.Document = rpt.Document
End If
End Sub
Private Sub btnFont_Click(sender As System.Object, e As System.EventArgs) Handles btnFont.Click
Dim FontDialog1 As FontDialog = New FontDialog
'/ FontDialog รับค่าปัจจุบันจาก lblDataFont
FontDialog1.Font = New Font(lblDataFont.Font.Name, lblDataFont.Font.Size, lblDataFont.Font.Style)
If FontDialog1.ShowDialog <> Windows.Forms.DialogResult.Cancel Then
lblDataFont.Font = FontDialog1.Font
lblDataFont.Text = lblDataFont.Font.Name & " " & lblDataFont.Font.Size
End If
'/ SaveSetting to Registry
Call WriteAppRegistry("SetFont", "FontName", lblDataFont.Font.Name)
Call WriteAppRegistry("SetFont", "FontSize", lblDataFont.Font.Size)
Call WriteAppRegistry("SetFont", "FontBold", Convert.ToBoolean(lblDataFont.Font.Bold))
Call WriteAppRegistry("SetFont", "FontItalic", Convert.ToBoolean(lblDataFont.Font.Italic))
Call WriteAppRegistry("SetFont", "FontStrikeout", Convert.ToBoolean(lblDataFont.Font.Strikeout))
Call WriteAppRegistry("SetFont", "FontUnderline", Convert.ToBoolean(lblDataFont.Font.Underline))
End Sub
Private Sub btnFontChamp_Click(sender As System.Object, e As System.EventArgs) Handles btnFontChamp.Click
Dim FontDialog1 As FontDialog = New FontDialog
' FontDialog รับค่าปัจจุบันจาก lblDataFontChamp
FontDialog1.Font = New Font(lblDataFontChamp.Font.Name, lblDataFontChamp.Font.Size, lblDataFontChamp.Font.Style)
If FontDialog1.ShowDialog <> Windows.Forms.DialogResult.Cancel Then
lblDataFontChamp.Font = FontDialog1.Font
lblDataFontChamp.Text = lblDataFontChamp.Font.Name & " " & lblDataFontChamp.Font.Size
End If
' SaveSetting to Registry
Call WriteAppRegistry("SetFontChamp", "FontName", lblDataFontChamp.Font.Name)
Call WriteAppRegistry("SetFontChamp", "FontSize", lblDataFontChamp.Font.Size)
Call WriteAppRegistry("SetFontChamp", "FontBold", Convert.ToBoolean(lblDataFontChamp.Font.Bold))
Call WriteAppRegistry("SetFontChamp", "FontItalic", Convert.ToBoolean(lblDataFontChamp.Font.Italic))
Call WriteAppRegistry("SetFontChamp", "FontStrikeout", Convert.ToBoolean(lblDataFontChamp.Font.Strikeout))
Call WriteAppRegistry("SetFontChamp", "FontUnderline", Convert.ToBoolean(lblDataFontChamp.Font.Underline))
End Sub
Private Sub frmPrintPostcard_KeyDown(sender As Object, e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
'/ ต้องตั้งค่าคุณสมบัติของฟอร์มแบบ Design Time --> KeyPreview = True
Select Case e.KeyCode
Case Keys.F7
Call btnPreview_Click(sender, New System.EventArgs())
Case Keys.F10
Call btnExit_Click(sender, New System.EventArgs())
End Select
End Sub
Private Sub btnExit_Click(sender As System.Object, e As System.EventArgs) Handles btnExit.Click
Me.Close()
End Sub
Private Sub frmPrintPostcard_FormClosed(sender As Object, e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
' ก่อนจบโปรแกรมก็บันทึกระยะขอบซ้ายและบนลง Registry
Call WriteAppRegistry("SetMargin", "LeftMargin", Val(numLeftMargin.Text))
Call WriteAppRegistry("SetMargin", "TopMargin", Val(numTopMargin.Text))
Call WriteAppRegistry("SetMargin", "LeftMarginChamp", Val(numLeftMarginChamp.Text))
Call WriteAppRegistry("SetMargin", "TopMarginChamp", Val(numTopMarginChamp.Text))
Me.Dispose()
Application.Exit()
End Sub
End Class
http://www.g2gnet.com/webboard/images/vbnet/FIFAPostCardARDesigner.png
โค้ดในส่วนของการพิมพ์ใน ActiveReports .NET ... อยากให้สังเกตการ Design และการใช้โค้ดด้วยนะครับ ว่ามีอะไรที่ผิดแผกแตกต่างไปจากงานเดิมๆอะไรบ้าง
Imports DataDynamics.ActiveReports
Imports DataDynamics.ActiveReports.Document
Public Class arPrintPostcard
'/ จะเริ่มต้นการทำงานที่โปรแกรมย่อยตัวนี้
Private Sub arPrintPostcard_ReportStart(sender As Object, e As System.EventArgs) Handles Me.ReportStart
' การตั้งค่าแบบ Run Time (มีหน่วยวัดเป็นนิ้ว)
With PageSettings
.Margins.Left = CmToInch(0.5)
.Margins.Right = CmToInch(0.5)
.Margins.Top = CmToInch(0.5)
.Margins.Bottom = CmToInch(0.5)
'// ตั้งค่ากระดาษแนวตั้ง
.Orientation = PageOrientation.Portrait
.PaperKind = Drawing.Printing.PaperKind.Custom
.PaperWidth = CmToInch(14.8) ' 14.8 ซม.
.PaperHeight = CmToInch(10.5)
End With
'/ ความสูงของการพิมพ์ Detail
Detail1.Height = CmToInch(10.5) ' วัดระยะโดยประมาณ 10.5 ซม แต่แปลงเป็นนิ้ว)
' กำหนดระยะการพิมพ์ที่อยู่ (รับค่าเป็นมิลลิเมตรเข้ามาหาร 10 เป็น ซม. แล้วแปลงเป็นนิ้ว)
txtSender.Top = ActiveReport.CmToInch(Val(frmPrintPostcard.numTopMargin.Text) / 10)
txtSender.Left = ActiveReport.CmToInch(Val(frmPrintPostcard.numLeftMargin.Text) / 10)
' กำหนดฟอนต์
txtSender.Font = frmPrintPostcard.lblDataFont.Font
End Sub
'// ส่วนของการพิมพ์รายละเอียด
Private Sub Detail1_Format(sender As System.Object, e As System.EventArgs) Handles Detail1.Format
'// อ้างอิงค่าใน TextBox จากฟอร์มหลักเข้ามา
txtSender.Text = frmPrintPostcard.txtSender.Text
End Sub
End Class
ดาวน์โหลดโค้ดต้นฉบับ VB.NET (2010) ได้ที่นี่
หน้า:
[1]