cls

Dim draArgs As Graphics
draArgs = Me.CreateGraphics
Dim draColor As Color
draColor = System.Drawing.ColorTranslator.FromOle(QBColor(14))
draArgs.Clear(draColor)

TextHeight

Dim draFont As New Font(C(12), F(25))
Yth = draFont.Height
Xtw = Int(draFont.Height * 0.6)
Yth = VB6.PixelsToTwipsX(draFont.Height)
Xtw = VB6.PixelsToTwipsY(Int(draFont.Height * 0.6))

Print

Private Sub draPrint(ByVal draX1 As Single, ByVal draY1 As Single, ByVal draString As String)
Dim draArgs As Graphics
draArgs = Me.CreateGraphics
Dim draColor As Color
draColor = System.Drawing.ColorTranslator.FromOle(QBColor(14))
Dim draBrush As New SolidBrush(draColor)
Dim draFont As New Font(C(12), F(25))
draX1 = VB6.TwipsToPixelsX(draX1)
draY1 = VB6.TwipsToPixelsY(draY1)
draArgs.DrawString(draString, draFont, draBrush, draX1, draY1)
End Sub

Line BF

Private Sub draLineBF(ByVal draX1 As Single, ByVal draY1 As Single, ByVal draX2 As Single, ByVal draY2 As Single, ByVal draQB As Integer)
Dim draArgs As Graphics
draArgs = Me.CreateGraphics
Dim draColor As Color
draColor = System.Drawing.ColorTranslator.FromOle(QBColor(draQB))
Dim draBrush As New SolidBrush(draColor)
draX2 = draX2 - draX1
draY2 = draY2 - draY1
If draX2 < 0 Then
draX1 = draX1 + draX2
draX2 = draX2 * -1
End If
If draY2 < 0 Then
draY1 = draY1 + draY2
draY2 = draY2 * -1
End If
draX2 = VB6.TwipsToPixelsX(draX2 - draX1)
draY2 = VB6.TwipsToPixelsY(draY2 - draY1)
draX1 = VB6.TwipsToPixelsX(draX1)
draY1 = VB6.TwipsToPixelsY(draY1)
draArgs.FillRectangle(draBrush, New RectangleF(draX1, draY1, draX2, draY2))
End Sub

Line

Private Sub draLine(ByVal draX1 As Single, ByVal draY1 As Single, ByVal draX2 As Single, ByVal draY2 As Single, ByVal draQB As Integer)
Dim draArgs As Graphics
draArgs = Me.CreateGraphics
Dim draColor As Color
draColor = System.Drawing.ColorTranslator.FromOle(QBColor(draQB))
Dim draPen As New Pen(draColor, 1)
draArgs.DrawLine(draPen, draX1, draY1, draX2, draY2)
End Sub

Line B

Private Sub draRectangle(ByVal draX1 As Single, ByVal draY1 As Single, ByVal draX2 As Single, ByVal draY2 As Single, ByVal draQB As Integer)
Dim draArgs As Graphics
draArgs = Me.CreateGraphics
Dim draColor As Color
draColor = System.Drawing.ColorTranslator.FromOle(QBColor(draQB))
Dim draPen As New Pen(draColor, 1)
draArgs.DrawRectangle(draPen, New Rectangle(draX1, draY1, draX2, draY2))
End Sub

Screen.Fonts

Dim draFF As FontFamily
For Each draFF In System.Drawing.FontFamily.Families
draFont = draFF.Name
Next

Clipboard.SetText(draString)

Dim datobj As New System.Windows.Forms.DataObject()
datobj.SetData(System.Windows.Forms.DataFormats.Text, draString)
System.Windows.Forms.Clipboard.SetDataObject(datobj)

カラー

ForeColor = System.Drawing.SystemColors.WindowText
BackColor = System.Drawing.SystemColors.Window

HTMLの表示

System.Diagnostics.Process.Start("index.html")

印刷

Private Sub draSettings()
Dim draDocument As New System.Drawing.Printing.PrintDocument()
AddHandler draDocument.PrintPage, AddressOf Me.draPage ' 印刷内容
draDocument.PrinterSettings.DefaultPageSettings.Landscape = True ' 横置き
Dim draHeight As Single
Dim draWidth As Single
draHeight = draDocument.PrinterSettings.DefaultPageSettings.Bounds.Height
draWidth = draDocument.PrinterSettings.DefaultPageSettings.Bounds.Width
Dim draPaper As String
draPaper = draDocument.PrinterSettings.DefaultPageSettings.PaperSize.Kind
' PaperName = B5 182 x 257 mm ' Kind = 13
' PaperName = A4 210 x 297 mm ' Kind = 9
draDocument.Print() ' 印刷開始
draDocument.Dispose() ' キャンセル
End Sub

Private Sub draPage(ByVal sender As Object, ByVal draArgs As System.Drawing.Printing.PrintPageEventArgs)
Dim draX1 As Integer
Dim draX2 As Integer
Dim draY1 As Integer
Dim draY2 As Integer
Dim draString As String
Dim draColor As Color
draColor = System.Drawing.ColorTranslator.FromOle(QBColor(0))
Dim draBrush As New SolidBrush(draColor)
Dim draFont As New Font(C(12), F(25))
Dim draPen As New Pen(draColor, 1)
draArgs.Graphics.DrawString(draString, draFont, draBrush, draX1, draY1)
draArgs.Graphics.DrawLine(draPen, draX1, draY1, draX2, draY2)
draArgs.HasMorePages = False
draArgs.Cancel = True ' キャンセル
End Sub

mmをPixelsに変換

Function mmToPix(ByRef mm As Single) As Single
Dim M As Double
M = mm * 1440 / 25.4
mmToPix = VB6.TwipsToPixelsX(M)
End Function