mirror of
https://git.do.srb2.org/STJr/UltimateZoneBuilder.git
synced 2024-12-13 05:30:58 +00:00
194 lines
5.7 KiB
Text
194 lines
5.7 KiB
Text
|
VERSION 5.00
|
||
|
Begin VB.Form frmChars
|
||
|
BorderStyle = 1 'Fixed Single
|
||
|
Caption = "Bitmap Font Generator"
|
||
|
ClientHeight = 8910
|
||
|
ClientLeft = 45
|
||
|
ClientTop = 330
|
||
|
ClientWidth = 8715
|
||
|
ClipControls = 0 'False
|
||
|
BeginProperty Font
|
||
|
Name = "Arial"
|
||
|
Size = 8.25
|
||
|
Charset = 0
|
||
|
Weight = 400
|
||
|
Underline = 0 'False
|
||
|
Italic = 0 'False
|
||
|
Strikethrough = 0 'False
|
||
|
EndProperty
|
||
|
Icon = "Form1.frx":0000
|
||
|
MaxButton = 0 'False
|
||
|
MinButton = 0 'False
|
||
|
ScaleHeight = 594
|
||
|
ScaleMode = 3 'Pixel
|
||
|
ScaleWidth = 581
|
||
|
StartUpPosition = 3 'Windows Default
|
||
|
Begin VB.PictureBox picChar
|
||
|
AutoRedraw = -1 'True
|
||
|
BackColor = &H00000000&
|
||
|
BorderStyle = 0 'None
|
||
|
CausesValidation= 0 'False
|
||
|
ClipControls = 0 'False
|
||
|
FillColor = &H00FFFFFF&
|
||
|
BeginProperty Font
|
||
|
Name = "Arial"
|
||
|
Size = 24
|
||
|
Charset = 0
|
||
|
Weight = 700
|
||
|
Underline = 0 'False
|
||
|
Italic = 0 'False
|
||
|
Strikethrough = 0 'False
|
||
|
EndProperty
|
||
|
ForeColor = &H00FFFFFF&
|
||
|
Height = 510
|
||
|
Left = 7890
|
||
|
ScaleHeight = 34
|
||
|
ScaleMode = 3 'Pixel
|
||
|
ScaleWidth = 34
|
||
|
TabIndex = 0
|
||
|
Top = 60
|
||
|
Visible = 0 'False
|
||
|
Width = 510
|
||
|
End
|
||
|
Begin VB.PictureBox picBitmap
|
||
|
AutoRedraw = -1 'True
|
||
|
BackColor = &H00000000&
|
||
|
BorderStyle = 0 'None
|
||
|
CausesValidation= 0 'False
|
||
|
ClipControls = 0 'False
|
||
|
FillColor = &H00FFFFFF&
|
||
|
ForeColor = &H00FFFFFF&
|
||
|
Height = 3840
|
||
|
Left = 45
|
||
|
ScaleHeight = 256
|
||
|
ScaleMode = 3 'Pixel
|
||
|
ScaleWidth = 512
|
||
|
TabIndex = 2
|
||
|
Top = 45
|
||
|
Width = 7680
|
||
|
End
|
||
|
Begin VB.Label lblChars
|
||
|
Caption = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+=-[]:;'"",.<>/?\"
|
||
|
BeginProperty Font
|
||
|
Name = "Arial Black"
|
||
|
Size = 24
|
||
|
Charset = 0
|
||
|
Weight = 700
|
||
|
Underline = 0 'False
|
||
|
Italic = 0 'False
|
||
|
Strikethrough = 0 'False
|
||
|
EndProperty
|
||
|
Height = 1095
|
||
|
Left = 60
|
||
|
TabIndex = 1
|
||
|
Top = 7785
|
||
|
UseMnemonic = 0 'False
|
||
|
Visible = 0 'False
|
||
|
Width = 8475
|
||
|
End
|
||
|
End
|
||
|
Attribute VB_Name = "frmChars"
|
||
|
Attribute VB_GlobalNameSpace = False
|
||
|
Attribute VB_Creatable = False
|
||
|
Attribute VB_PredeclaredId = True
|
||
|
Attribute VB_Exposed = False
|
||
|
Option Explicit
|
||
|
|
||
|
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
|
||
|
Sub DrawChar(Char As String)
|
||
|
|
||
|
picChar.Width = picChar.TextWidth(Char)
|
||
|
|
||
|
DoEvents
|
||
|
|
||
|
picChar.Height = picChar.TextHeight(Char)
|
||
|
|
||
|
DoEvents
|
||
|
|
||
|
Set picChar.Picture = Nothing
|
||
|
picChar.Cls
|
||
|
|
||
|
picChar.Print Char
|
||
|
|
||
|
DoEvents
|
||
|
End Sub
|
||
|
|
||
|
Private Sub Form_Load()
|
||
|
Dim i
|
||
|
Dim CharX As Integer
|
||
|
Dim CharY As Integer
|
||
|
Dim LargestY As Integer
|
||
|
Dim cfg As New clsConfiguration
|
||
|
Dim settings As Dictionary
|
||
|
Dim chars As New Dictionary
|
||
|
|
||
|
Show
|
||
|
Refresh
|
||
|
|
||
|
picChar.Font = lblChars.Font
|
||
|
picChar.FontSize = lblChars.FontSize
|
||
|
|
||
|
''Adjustment (in pixels) per character
|
||
|
Const u1 As Single = -4 '-2
|
||
|
Const v1 As Single = -4 '-2
|
||
|
Const u2 As Single = 4 '2
|
||
|
Const v2 As Single = 5 '5
|
||
|
|
||
|
''Spacing
|
||
|
Const sx As Long = 10
|
||
|
Const sy As Long = 6
|
||
|
|
||
|
''Offset
|
||
|
Const ox As Long = 10
|
||
|
Const oy As Long = 3
|
||
|
|
||
|
''Start values
|
||
|
CharY = oy
|
||
|
CharX = ox
|
||
|
LargestY = 0
|
||
|
|
||
|
cfg.NewConfiguration
|
||
|
|
||
|
'Render all chars
|
||
|
For i = 1 To Len(lblChars)
|
||
|
|
||
|
'Get the bitmap char
|
||
|
DrawChar Mid$(lblChars, i, 1)
|
||
|
|
||
|
If (picChar.Height - 3) > LargestY Then LargestY = (picChar.Height - 3)
|
||
|
If CharX + picChar.Width >= (picBitmap.Width - sx / 2) Then
|
||
|
'Go to next character position
|
||
|
CharY = CharY + LargestY + sy
|
||
|
LargestY = 0
|
||
|
CharX = ox
|
||
|
End If
|
||
|
|
||
|
'Draw on bitmap
|
||
|
picBitmap.PaintPicture picChar.Image, CharX, CharY - 2
|
||
|
|
||
|
'Make settings
|
||
|
Set settings = New Dictionary
|
||
|
settings.Add "width", CLng(picChar.Width)
|
||
|
settings.Add "height", CLng((picChar.Height - 3))
|
||
|
settings.Add "u1", (CSng(CharX) + u1) / CSng(picBitmap.Width)
|
||
|
settings.Add "v1", (CSng(CharY) + v1) / CSng(picBitmap.Height)
|
||
|
settings.Add "u2", (CSng(CharX + picChar.Width) + u2) / CSng(picBitmap.Width)
|
||
|
settings.Add "v2", (CSng(CharY + (picChar.Height - 3)) + v2) / CSng(picBitmap.Height)
|
||
|
chars.Add Asc(Mid$(lblChars, i, 1)), settings
|
||
|
Set settings = Nothing
|
||
|
|
||
|
'Go to next character position
|
||
|
CharX = CharX + picChar.Width + sx
|
||
|
Next i
|
||
|
|
||
|
'save bitmap
|
||
|
SavePicture picBitmap.Image, "font.bmp"
|
||
|
|
||
|
'save config
|
||
|
cfg.WriteSetting "count", CLng(Len(lblChars))
|
||
|
cfg.WriteSetting "chars", chars, True
|
||
|
cfg.SaveConfiguration "font.cfg"
|
||
|
|
||
|
End Sub
|
||
|
|