frmPrintHex.frm
Upload User: szlzy8
Upload Date: 2007-04-25
Package Size: 6k
Code Size: 5k
Category:

Graph program

Development Platform:

Visual Basic

  1. VERSION 5.00
  2. Begin VB.Form frmPrintHex 
  3.    Caption         =   "Print Hex Map"
  4.    ClientHeight    =   885
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   4650
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   885
  10.    ScaleWidth      =   4650
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin VB.Frame Frame2 
  13.       Caption         =   "Line Width "
  14.       Height          =   615
  15.       Left            =   2400
  16.       TabIndex        =   4
  17.       Top             =   120
  18.       Width           =   1095
  19.       Begin VB.TextBox txtDrawWidth 
  20.          Alignment       =   1  'Right Justify
  21.          Height          =   285
  22.          Left            =   120
  23.          TabIndex        =   5
  24.          Text            =   "1"
  25.          Top             =   240
  26.          Width           =   735
  27.       End
  28.    End
  29.    Begin VB.CommandButton cmdPrint 
  30.       Caption         =   "Print"
  31.       Height          =   495
  32.       Left            =   3600
  33.       TabIndex        =   2
  34.       Top             =   240
  35.       Width           =   855
  36.    End
  37.    Begin VB.Frame Frame1 
  38.       Caption         =   "Hex Width "
  39.       Height          =   615
  40.       Left            =   120
  41.       TabIndex        =   0
  42.       Top             =   120
  43.       Width           =   2175
  44.       Begin VB.ComboBox cboScaleMode 
  45.          Height          =   315
  46.          Left            =   960
  47.          TabIndex        =   3
  48.          Top             =   240
  49.          Width           =   1095
  50.       End
  51.       Begin VB.TextBox txtHexWidth 
  52.          Alignment       =   1  'Right Justify
  53.          Height          =   285
  54.          Left            =   120
  55.          TabIndex        =   1
  56.          Text            =   "0.25"
  57.          Top             =   240
  58.          Width           =   735
  59.       End
  60.    End
  61. End
  62. Attribute VB_Name = "frmPrintHex"
  63. Attribute VB_GlobalNameSpace = False
  64. Attribute VB_Creatable = False
  65. Attribute VB_PredeclaredId = True
  66. Attribute VB_Exposed = False
  67. Option Explicit
  68. Private Sub cmdPrint_Click()
  69.     Dim Xmax As Long
  70.     Dim Ymax As Long
  71.     Dim XCount As Long
  72.     Dim YCount As Long
  73.     On Error GoTo Error_cmdPrint
  74.     
  75.     Dim X1 As Long
  76.     Dim Y1 As Long
  77.     Dim X2 As Long
  78.     Dim Y2 As Long
  79.     Dim X As Long
  80.     Dim U As Long   'Half of Hex width horizontally
  81.     Dim V As Long   'Half of hex width vertically
  82.     Dim r As Long   'horizontal distance from left most point of hex to top left edge of hex
  83.     ' --- |-R-/---U---             /---
  84.     '  |  |  /                    /
  85.     '  V  | /                    /
  86.     ' _|_ |/             _______/
  87.     '                   /       
  88.     '                  /         
  89.     '                 /           
  90.     '         -------/             ---
  91.     
  92.     Dim HexWidth As Double
  93.     Me.Caption = "Print Hex Map Printing..."
  94.     Me.MousePointer = vbHourglass
  95.     HexWidth = Val(Me.txtHexWidth)
  96.     
  97.     'Convert Hexwidth taking into account Printer Scale
  98.     V = Printer.ScaleY(HexWidth, Me.cboScaleMode.ItemData(Me.cboScaleMode.ListIndex), Printer.ScaleMode) / 2
  99.     r = Printer.ScaleX(HexWidth, Me.cboScaleMode.ItemData(Me.cboScaleMode.ListIndex), Printer.ScaleMode) / 2
  100.     
  101.     
  102.     U = Tan(DegToRad(30)) * r
  103.     
  104.     Xmax = Printer.ScaleWidth / (2 * (U + r))
  105.     Ymax = Printer.ScaleHeight / (V * 2)
  106.     
  107.     Printer.DrawWidth = Val(Me.txtDrawWidth)
  108.     For XCount = 0 To Xmax
  109.         For YCount = 0 To Ymax
  110.             Printer.Line (XCount * 2 * (U + r) + U, YCount * V * 2 + 0)-(XCount * 2 * (U + r) + U + r, YCount * V * 2 + 0)
  111.             Printer.Line -(XCount * 2 * (U + r) + 2 * U + r, YCount * V * 2 + V)
  112.             Printer.Line -(XCount * 2 * (U + r) + U + r, YCount * V * 2 + 2 * V)
  113.             Printer.Line -(XCount * 2 * (U + r) + U, YCount * V * 2 + 2 * V)
  114.             Printer.Line -(XCount * 2 * (U + r) + 0, YCount * V * 2 + V)
  115.             Printer.Line -(XCount * 2 * (U + r) + U, YCount * V * 2 + 0)
  116.             Printer.Line (XCount * 2 * (U + r) + 2 * U + r, YCount * V * 2 + V)-(XCount * 2 * (U + r) + 2 * (U + r), YCount * V * 2 + V)
  117.         Next YCount
  118.     Next XCount
  119.     Printer.EndDoc
  120.     Me.Caption = "Print Hex Map"
  121.     Me.MousePointer = vbNormal
  122.     Exit Sub
  123.     
  124. Error_cmdPrint:
  125.     Printer.KillDoc
  126.     Printer.EndDoc
  127. End Sub
  128. Private Sub Form_Load()
  129.     Dim cbo As ComboBox
  130.     
  131.     Set cbo = Me.cboScaleMode
  132.     cbo.Clear
  133.     cbo.AddItem "Inches"
  134.     cbo.ItemData(cbo.NewIndex) = vbInches
  135.     cbo.AddItem "Pixels"
  136.     cbo.ItemData(cbo.NewIndex) = vbPixels
  137.     cbo.AddItem "Centimeters"
  138.     cbo.ItemData(cbo.NewIndex) = vbCentimeters
  139.     cbo.AddItem "Millimeters"
  140.     cbo.ItemData(cbo.NewIndex) = vbMillimeters
  141.     cbo.AddItem "Points"
  142.     cbo.ItemData(cbo.NewIndex) = vbPoints
  143.     cbo.AddItem "Twips"
  144.     cbo.ItemData(cbo.NewIndex) = vbTwips
  145.     Me.cboScaleMode = "Inches"
  146.     Me.cboScaleMode.ListIndex = 0
  147.     Debug.Print Me.cboScaleMode.ItemData(Me.cboScaleMode.ListIndex)
  148. End Sub