ชุมชนคนรักภาษาเบสิค - Visual Basic Community

 ลืมรหัสผ่าน
 ลงทะเบียน
ค้นหา
ดู: 5654|ตอบกลับ: 0

[VB.NET] แจกโค้ดต้นฉบับและโปรแกรมการพิมพ์ไปรษณียบัตร ทายผลฟุตบอลโลก 2018

[คัดลอกลิงก์]

320

กระทู้

512

โพสต์

6583

เครดิต

ผู้ดูแลระบบ

ทองก้อน ทับทิมกรอบ

Rank: 9Rank: 9Rank: 9

เครดิต
6583






การวางไปรษณียบัตรเพื่อทำการพิมพ์ ...

สำหรับผู้ใช้งานทั่วไป คลิ๊กดาวน์โหลดโปรแกรมเพื่อใช้งานได้ที่นี่ ...

จะเป็นอะไรมั้ย ที่แอดมินจะลอกแนวคิดของการออกแบบมาจากความคิดของตัวเอง 5555+ ... สำหรับงานนี้ก็ยังคงยึดวิธีิคิดมาจาก VB6 อยู่เหมือนเดิม ในการปรับระยะการพิมพ์ และปรับฟอนต์และขนาดของตัวอักษร โดยใช้เทคนิคการเก็บข้อมูลเดิมกับการใช้งาน Registry ด้วยคำสั่ง (หรือฟังค์ชั่น) อย่างง่ายๆคือ GetSetting เพื่อทำการอ่านค่า และ SaveSetting เพื่อทำการเขียนค่าเข้าไปจัดเก็บครับผม ...

สำหรับท่านที่เผลอเข้ามา ดาวน์โหลด ActiveReports .NET Version 6.2.3681 (เฉพาะสมาชิกเท่านั้น)


Application Title

เรียกคำสั่งจาก Run --> RegEdit เพื่อมาดูผลการบันทึกลง Registry ...

Computer\HKEY_CURRENT_USER\Software\VB and VBA Program Settings\ชื่อ Application

มาดูโค้ดในส่วนของฟอร์มหลัก ...
  1. ' / --------------------------------------------------------------------------------
  2. ' / Developer : Mr.Surapon Yodsanga (Thongkorn Tubtimkrob)
  3. ' / eMail : thongkorn@hotmail.com
  4. ' / URL: http://www.g2gnet.com (Khon Kaen - Thailand)
  5. ' / Facebook: https://www.facebook.com/g2gnet (For Thailand)
  6. ' / Facebook: https://www.facebook.com/commonindy (Worldwide)
  7. ' / Purpose : Print out postcard with ActiveReports.NET 6.0
  8. ' / Microsoft Visual Basic .NET (2010) SP1

  9. ' / This is open source code under @CopyLeft by Thongkorn Tubtimkrob.
  10. ' / You can modify and/or distribute without to inform the developer.
  11. ' / --------------------------------------------------------------------------------
  12. Imports DataDynamics.ActiveReports

  13. Public Class frmPrintPostcard

  14.     Private Sub frmPrintPostcard_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
  15.         txtSender.Text = _
  16.             "นายทองก้อน ทับทิมกรอบ" & vbCrLf & _
  17.             "142 ม.11 ซ.ฉัตรทอง 5 ถ.กลางเมือง" & vbCrLf & _
  18.             "ต.เมืองเก่า อ.เมืองขอนแก่น" & vbCrLf & _
  19.             "จ.ขอนแก่น 40000" & vbCrLf & "โทรศัพท์. 08-6862-6560"
  20.         txtChamp.Text = "ไทยแลนด์"

  21.         ' ตั้งค่า ActiveReports
  22.         Viewer1.ReportViewer.Zoom = 1.0F   ' Zoom
  23.         Viewer1.ReportViewer.DisplayUnits = Viewer.DisplayUnits.Metric
  24.         Viewer2.ReportViewer.Zoom = 1.0F   ' Zoom
  25.         Viewer2.ReportViewer.DisplayUnits = Viewer.DisplayUnits.Metric
  26.         '// Minimum Size
  27.         Me.MinimumSize = New Size(832, 733)
  28.         '/ หากไม่มีค่าเดิม ให้ตั้งค่า Default แทน
  29.         numLeftMargin.Text = ReadAppRegistry("SetMargin", "LeftMargin", "42")
  30.         numTopMargin.Text = ReadAppRegistry("SetMargin", "TopMargin", "25")
  31.         numLeftMarginChamp.Text = ReadAppRegistry("SetMargin", "LeftMarginChamp", "13")
  32.         numTopMarginChamp.Text = ReadAppRegistry("SetMargin", "TopMarginChamp", "38")

  33.         '// Initialize Font Style
  34.         lblDataFont.Font = New Font(ReadAppRegistry("SetFont", "FontName", "BrowalliaUPC"), ReadAppRegistry("SetFont", "FontSize", "18"))
  35.         '// Font Style
  36.         ' 0001 (ฐาน 2) : 1 (ฐาน 10)  Bold
  37.         ' 0010 (ฐาน 2) : 2 (ฐาน 10)  Italic
  38.         ' 0100 (ฐาน 2) : 4 (ฐาน 10)  Underline
  39.         ' 1000 (ฐาน 2) : 8 (ฐาน 10)  Strikeout
  40.         '// ตั้งค่าเริ่มต้นเป็น 0 ให้หมด เพราะในเงื่อนไขด้านล่าง หากมีเงื่อนไขเป็นเท็จ จะได้ไม่ต้องมี Else ให้สิ้นเปลืองพลังงานการพิมพ์
  41.         Dim fntBold As Byte = 0
  42.         Dim fntItalic As Byte = 0
  43.         Dim fntUnderline As Byte = 0
  44.         Dim fntStrikeout As Byte = 0
  45.         '// พิมพ์ชื่อผู้ส่ง
  46.         If Convert.ToBoolean(ReadAppRegistry("SetFont", "FontBold", "False")) Then fntBold = 1
  47.         If Convert.ToBoolean(ReadAppRegistry("SetFont", "FontItalic", "False")) Then fntItalic = 2
  48.         If Convert.ToBoolean(ReadAppRegistry("SetFont", "FontUnderline", "False")) Then fntUnderline = 4
  49.         If Convert.ToBoolean(ReadAppRegistry("SetFont", "FontStrikeout", "False")) Then fntStrikeout = 8
  50.         '/ ใช้ลอจิก OR กระทำทางตรรกศาสตร์เลขฐาน 2
  51.         lblDataFont.Font = New Font(lblDataFont.Font, fntBold Or fntItalic Or fntUnderline Or fntStrikeout)
  52.         '/ แสดงผลตัวอย่าง และจะเก็บ Font Style เอาไว้ เพื่อทำการเขียนลง Registry
  53.         lblDataFont.Text = lblDataFont.Font.Name & ", " & lblDataFont.Font.Size

  54.         '// Initialize Font Style
  55.         lblDataFontChamp.Font = New Font(ReadAppRegistry("SetFontChamp", "FontName", "BrowalliaUPC"), ReadAppRegistry("SetFontChamp", "FontSize", "20"))
  56.         '// พิมพ์ชื่อแชมป์ (ใช้ตัวแปรเดิมได้โดยไม่ต้องประกาศใหม่)
  57.         fntBold = 0 : fntItalic = 0 : fntUnderline = 0 : fntStrikeout = 0
  58.         If Convert.ToBoolean(ReadAppRegistry("SetFontChamp", "FontBold", "False")) Then fntBold = 1
  59.         If Convert.ToBoolean(ReadAppRegistry("SetFontChamp", "FontItalic", "False")) Then fntItalic = 2
  60.         If Convert.ToBoolean(ReadAppRegistry("SetFontChamp", "FontUnderline", "False")) Then fntUnderline = 4
  61.         If Convert.ToBoolean(ReadAppRegistry("SetFontChamp", "FontStrikeout", "False")) Then fntStrikeout = 8
  62.         lblDataFontChamp.Font = New Font(lblDataFontChamp.Font, fntBold Or fntItalic Or fntUnderline Or fntStrikeout)
  63.         lblDataFontChamp.Text = lblDataFontChamp.Font.Name & ", " & lblDataFontChamp.Font.Size
  64.     End Sub

  65.     ' / -----------------------------------------------------------------------------------------------
  66.     ' / อ่านค่าจาก Registry และคืนค่าคุณสมบัตินั้นๆคืนกลับไป
  67.     ' / Registry with VB.NET function
  68.     Function ReadAppRegistry(SectionName As String, _
  69.         KeyName As String, _
  70.         KeyValue As String _
  71.     ) As String
  72.         ' / -----------------------------------------------------------------------------------------------
  73.         ' Application Title ...
  74.         Dim AppTitle As String = My.Application.Info.Title

  75.         If GetSetting(AppTitle, SectionName, KeyName) = "" Then _
  76.             Call SaveSetting(AppTitle, SectionName, KeyName, KeyValue)
  77.         ' ส่งค่าคืนกลับไปแบบ String
  78.         ReadAppRegistry = GetSetting(AppTitle, SectionName, KeyName)

  79.     End Function

  80.     ' / -----------------------------------------------------------------------------------------------
  81.     ' / เป็นการบันทึกลง Registry ดังนั้นจึงไม่ต้องคืนค่ากลับไป เราจึงใช้ Sub Program
  82.     ' / Registry with VB.NET function
  83.     ' / เวลาที่เรา Write Registry มันจะไปอยู่ที่
  84.     ' / Computer\HKEY_CURRENT_USER\Software\VB and VBA Program Settings\ชื่อแอพพลิเคชั่นที่เราตั้งไว้ ตัวอย่างเช่น FIFAPostCard
  85.     Sub WriteAppRegistry(SectionName As String, _
  86.         KeyName As String, _
  87.         KeyValue As String _
  88.         )
  89.         ' Application Title ...
  90.         Dim AppTitle As String = My.Application.Info.Title
  91.         Call SaveSetting(AppTitle, SectionName, KeyName, KeyValue)
  92.     End Sub

  93.     Private Sub btnPreview_Click(sender As System.Object, e As System.EventArgs) Handles btnPreview.Click
  94.         If tabMain.SelectedTab Is TabPage1 Then
  95.             '/ Instance name ARDesigner มันจะชี้ไปที่ไฟล์ arBarcode.vb
  96.             Dim rpt As New arPrintPostcard()
  97.             '/ Run Report
  98.             rpt.Run()
  99.             '/ โหลดรายงาน document (arPrintEnvelope) เข้าสู่ ActiveReports Viewer
  100.             Me.Viewer1.Document = rpt.Document
  101.         Else
  102.             Dim rpt As New arPrintChamp()
  103.             rpt.Run()
  104.             Me.Viewer2.Document = rpt.Document
  105.         End If
  106.     End Sub

  107.     Private Sub btnFont_Click(sender As System.Object, e As System.EventArgs) Handles btnFont.Click
  108.         Dim FontDialog1 As FontDialog = New FontDialog
  109.         '/ FontDialog รับค่าปัจจุบันจาก lblDataFont
  110.         FontDialog1.Font = New Font(lblDataFont.Font.Name, lblDataFont.Font.Size, lblDataFont.Font.Style)

  111.         If FontDialog1.ShowDialog <> Windows.Forms.DialogResult.Cancel Then
  112.             lblDataFont.Font = FontDialog1.Font
  113.             lblDataFont.Text = lblDataFont.Font.Name & " " & lblDataFont.Font.Size
  114.         End If
  115.         '/ SaveSetting to Registry
  116.         Call WriteAppRegistry("SetFont", "FontName", lblDataFont.Font.Name)
  117.         Call WriteAppRegistry("SetFont", "FontSize", lblDataFont.Font.Size)
  118.         Call WriteAppRegistry("SetFont", "FontBold", Convert.ToBoolean(lblDataFont.Font.Bold))
  119.         Call WriteAppRegistry("SetFont", "FontItalic", Convert.ToBoolean(lblDataFont.Font.Italic))
  120.         Call WriteAppRegistry("SetFont", "FontStrikeout", Convert.ToBoolean(lblDataFont.Font.Strikeout))
  121.         Call WriteAppRegistry("SetFont", "FontUnderline", Convert.ToBoolean(lblDataFont.Font.Underline))
  122.     End Sub

  123.     Private Sub btnFontChamp_Click(sender As System.Object, e As System.EventArgs) Handles btnFontChamp.Click
  124.         Dim FontDialog1 As FontDialog = New FontDialog
  125.         ' FontDialog รับค่าปัจจุบันจาก lblDataFontChamp
  126.         FontDialog1.Font = New Font(lblDataFontChamp.Font.Name, lblDataFontChamp.Font.Size, lblDataFontChamp.Font.Style)

  127.         If FontDialog1.ShowDialog <> Windows.Forms.DialogResult.Cancel Then
  128.             lblDataFontChamp.Font = FontDialog1.Font
  129.             lblDataFontChamp.Text = lblDataFontChamp.Font.Name & " " & lblDataFontChamp.Font.Size
  130.         End If
  131.         ' SaveSetting to Registry
  132.         Call WriteAppRegistry("SetFontChamp", "FontName", lblDataFontChamp.Font.Name)
  133.         Call WriteAppRegistry("SetFontChamp", "FontSize", lblDataFontChamp.Font.Size)
  134.         Call WriteAppRegistry("SetFontChamp", "FontBold", Convert.ToBoolean(lblDataFontChamp.Font.Bold))
  135.         Call WriteAppRegistry("SetFontChamp", "FontItalic", Convert.ToBoolean(lblDataFontChamp.Font.Italic))
  136.         Call WriteAppRegistry("SetFontChamp", "FontStrikeout", Convert.ToBoolean(lblDataFontChamp.Font.Strikeout))
  137.         Call WriteAppRegistry("SetFontChamp", "FontUnderline", Convert.ToBoolean(lblDataFontChamp.Font.Underline))
  138.     End Sub

  139.     Private Sub frmPrintPostcard_KeyDown(sender As Object, e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
  140.         '/ ต้องตั้งค่าคุณสมบัติของฟอร์มแบบ Design Time --> KeyPreview = True
  141.         Select Case e.KeyCode
  142.             Case Keys.F7
  143.                 Call btnPreview_Click(sender, New System.EventArgs())
  144.             Case Keys.F10
  145.                 Call btnExit_Click(sender, New System.EventArgs())
  146.         End Select
  147.     End Sub

  148.     Private Sub btnExit_Click(sender As System.Object, e As System.EventArgs) Handles btnExit.Click
  149.         Me.Close()
  150.     End Sub

  151.     Private Sub frmPrintPostcard_FormClosed(sender As Object, e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
  152.         ' ก่อนจบโปรแกรมก็บันทึกระยะขอบซ้ายและบนลง Registry
  153.         Call WriteAppRegistry("SetMargin", "LeftMargin", Val(numLeftMargin.Text))
  154.         Call WriteAppRegistry("SetMargin", "TopMargin", Val(numTopMargin.Text))
  155.         Call WriteAppRegistry("SetMargin", "LeftMarginChamp", Val(numLeftMarginChamp.Text))
  156.         Call WriteAppRegistry("SetMargin", "TopMarginChamp", Val(numTopMarginChamp.Text))
  157.         Me.Dispose()
  158.         Application.Exit()
  159.     End Sub

  160. End Class
คัดลอกไปที่คลิปบอร์ด


โค้ดในส่วนของการพิมพ์ใน ActiveReports .NET ... อยากให้สังเกตการ Design และการใช้โค้ดด้วยนะครับ ว่ามีอะไรที่ผิดแผกแตกต่างไปจากงานเดิมๆอะไรบ้าง
  1. Imports DataDynamics.ActiveReports
  2. Imports DataDynamics.ActiveReports.Document

  3. Public Class arPrintPostcard

  4.     '/ จะเริ่มต้นการทำงานที่โปรแกรมย่อยตัวนี้
  5.     Private Sub arPrintPostcard_ReportStart(sender As Object, e As System.EventArgs) Handles Me.ReportStart
  6.         ' การตั้งค่าแบบ Run Time (มีหน่วยวัดเป็นนิ้ว)
  7.         With PageSettings
  8.             .Margins.Left = CmToInch(0.5)
  9.             .Margins.Right = CmToInch(0.5)
  10.             .Margins.Top = CmToInch(0.5)
  11.             .Margins.Bottom = CmToInch(0.5)
  12.             '// ตั้งค่ากระดาษแนวตั้ง
  13.             .Orientation = PageOrientation.Portrait
  14.             .PaperKind = Drawing.Printing.PaperKind.Custom
  15.             .PaperWidth = CmToInch(14.8) ' 14.8 ซม.
  16.             .PaperHeight = CmToInch(10.5)
  17.         End With
  18.         '/ ความสูงของการพิมพ์ Detail
  19.         Detail1.Height = CmToInch(10.5) ' วัดระยะโดยประมาณ 10.5 ซม แต่แปลงเป็นนิ้ว)
  20.         ' กำหนดระยะการพิมพ์ที่อยู่ (รับค่าเป็นมิลลิเมตรเข้ามาหาร 10 เป็น ซม. แล้วแปลงเป็นนิ้ว)
  21.         txtSender.Top = ActiveReport.CmToInch(Val(frmPrintPostcard.numTopMargin.Text) / 10)
  22.         txtSender.Left = ActiveReport.CmToInch(Val(frmPrintPostcard.numLeftMargin.Text) / 10)

  23.         ' กำหนดฟอนต์
  24.         txtSender.Font = frmPrintPostcard.lblDataFont.Font
  25.     End Sub

  26.     '// ส่วนของการพิมพ์รายละเอียด
  27.     Private Sub Detail1_Format(sender As System.Object, e As System.EventArgs) Handles Detail1.Format
  28.         '// อ้างอิงค่าใน TextBox จากฟอร์มหลักเข้ามา
  29.         txtSender.Text = frmPrintPostcard.txtSender.Text
  30.     End Sub
  31. End Class
คัดลอกไปที่คลิปบอร์ด

ดาวน์โหลดโค้ดต้นฉบับ VB.NET (2010) ได้ที่นี่


ขออภัย! โพสต์นี้มีไฟล์แนบหรือรูปภาพที่ไม่ได้รับอนุญาตให้คุณเข้าถึง

คุณจำเป็นต้อง ลงชื่อเข้าใช้ เพื่อดาวน์โหลดหรือดูไฟล์แนบนี้ คุณยังไม่มีบัญชีใช่ไหม? ลงทะเบียน

x
สิ่งที่ดีกว่าการให้ คือการให้แบบไม่มีที่สิ้นสุด
ขออภัย! คุณไม่ได้รับสิทธิ์ในการดำเนินการในส่วนนี้ กรุณาเลือกอย่างใดอย่างหนึ่ง ลงชื่อเข้าใช้ | ลงทะเบียน

รายละเอียดเครดิต

ข้อความล้วน|อุปกรณ์พกพา|ประวัติการแบน|G2GNet.com  

GMT+7, 2024-11-27 22:39 , Processed in 0.181785 second(s), 4 queries , File On.

Powered by Discuz! X3.4, Rev.62

Copyright © 2001-2020 Tencent Cloud.

ตอบกระทู้ ขึ้นไปด้านบน ไปที่หน้ารายการกระทู้