VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1
   Caption         =   "bmp2html by Wabsie E."
   ClientHeight    =   7335
   ClientLeft      =   2880
   ClientTop       =   4905
   ClientWidth     =   7920
   LinkTopic       =   "Form1"
   ScaleHeight     =   489
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   528
   Begin VB.OptionButton Option1
      Caption         =   "Random"
      Enabled         =   0   'False
      Height          =   255
      Index           =   1
      Left            =   3720
      TabIndex        =   27
      Top             =   1320
      Width           =   975
   End
   Begin VB.TextBox Text4
      Enabled         =   0   'False
      Height          =   255
      Left            =   3360
      TabIndex        =   24
      Text            =   "WABSIE"
      Top             =   840
      Width           =   1335
   End
   Begin VB.OptionButton Option1
      Caption         =   "Fixed"
      Enabled         =   0   'False
      Height          =   255
      Index           =   0
      Left            =   3720
      TabIndex        =   26
      Top             =   1080
      Value           =   -1  'True
      Width           =   855
   End
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   960
      Top             =   720
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.TextBox Text3
      Height          =   255
      Index           =   2
      Left            =   2880
      MaxLength       =   3
      TabIndex        =   23
      Text            =   "0"
      Top             =   1200
      Width           =   375
   End
   Begin VB.TextBox Text3
      Height          =   255
      Index           =   1
      Left            =   2880
      MaxLength       =   3
      TabIndex        =   22
      Text            =   "0"
      Top             =   960
      Width           =   375
   End
   Begin VB.HScrollBar HScroll1
      Height          =   255
      Index           =   2
      Left            =   2100
      Max             =   255
      TabIndex        =   21
      Top             =   1200
      Width           =   795
   End
   Begin VB.HScrollBar HScroll1
      Height          =   255
      Index           =   1
      Left            =   2100
      Max             =   255
      TabIndex        =   20
      Top             =   960
      Width           =   795
   End
   Begin VB.TextBox Text3
      Height          =   255
      Index           =   0
      Left            =   2880
      MaxLength       =   3
      TabIndex        =   16
      Text            =   "0"
      Top             =   720
      Width           =   375
   End
   Begin VB.HScrollBar HScroll1
      Height          =   255
      Index           =   0
      Left            =   2100
      Max             =   255
      TabIndex        =   15
      Top             =   720
      Width           =   795
   End
   Begin VB.CommandButton Command4
      Caption         =   "Save as html"
      Enabled         =   0   'False
      Height          =   375
      Left            =   120
      TabIndex        =   13
      Top             =   1080
      Width           =   1455
   End
   Begin VB.TextBox Text1
      Height          =   255
      Left            =   120
      TabIndex        =   12
      Top             =   840
      Width           =   1695
   End
   Begin VB.CommandButton Command5
      Caption         =   "1:1 (raw pixels)"
      Enabled         =   0   'False
      Height          =   255
      Left            =   3360
      TabIndex        =   8
      Top             =   600
      Width           =   1335
   End
   Begin VB.CommandButton Command3
      Caption         =   "Enlarge"
      Enabled         =   0   'False
      Height          =   255
      Left            =   3360
      TabIndex        =   4
      Top             =   360
      Width           =   1335
   End
   Begin VB.PictureBox Picture2
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   2640
      ScaleHeight     =   15
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   15
      TabIndex        =   5
      Top             =   1800
      Width           =   255
   End
   Begin VB.CommandButton Command2
      Caption         =   "Make smaller"
      Enabled         =   0   'False
      Height          =   255
      Left            =   3360
      TabIndex        =   3
      Top             =   120
      Width           =   1335
   End
   Begin VB.TextBox Text2
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   1695
   End
   Begin VB.CommandButton Command1
      Caption         =   "Open bmp"
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   360
      Width           =   1455
   End
   Begin VB.PictureBox Picture1
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   120
      ScaleHeight     =   15
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   15
      TabIndex        =   0
      Top             =   1800
      Width           =   255
   End
   Begin VB.Label Label10
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   4800
      TabIndex        =   29
      Top             =   1320
      Width           =   3015
   End
   Begin VB.Label Label9
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   4800
      TabIndex        =   28
      Top             =   1080
      Width           =   3015
   End
   Begin VB.Label Label8
      Caption         =   "The text of wich the picture is made of."
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   4800
      TabIndex        =   25
      Top             =   840
      Width           =   2655
   End
   Begin VB.Label Label7
      Caption         =   "B:"
      Height          =   255
      Index           =   2
      Left            =   1920
      TabIndex        =   19
      Top             =   1200
      Width           =   255
   End
   Begin VB.Label Label7
      Caption         =   "G:"
      Height          =   255
      Index           =   1
      Left            =   1920
      TabIndex        =   18
      Top             =   960
      Width           =   255
   End
   Begin VB.Label Label7
      Caption         =   "R:"
      Height          =   255
      Index           =   0
      Left            =   1920
      TabIndex        =   17
      Top             =   720
      Width           =   255
   End
   Begin VB.Label Label6
      BackColor       =   &H80000012&
      Caption         =   "Backgroundcolor (VB'sk Hex):"
      ForeColor       =   &H8000000E&
      Height          =   615
      Left            =   1920
      TabIndex        =   14
      Top             =   120
      Width           =   1335
   End
   Begin VB.Label Label5
      Caption         =   "No change."
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   4800
      TabIndex        =   11
      Top             =   600
      Width           =   3135
   End
   Begin VB.Label Label4
      Caption         =   "Half height, lenght is kept."
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   4800
      TabIndex        =   10
      Top             =   120
      Width           =   3015
   End
   Begin VB.Label Label3
      Caption         =   "Height is kept, double the lenght."
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   4800
      TabIndex        =   9
      Top             =   360
      Width           =   3135
   End
   Begin VB.Label Label2
      BackStyle       =   0  'Transparent
      Caption         =   "7x11 converted picture:"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   2640
      TabIndex        =   7
      Top             =   1560
      Width           =   1815
   End
   Begin VB.Label Label1
      BackStyle       =   0  'Transparent
      Caption         =   "Loaded picture:"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   6
      Top             =   1560
      Width           =   1095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim globe As Boolean
Private Sub Command1_Click()
With CommonDialog1
    .Filter = "Bitmap billede (*.bmp)|*.bmp"
    .ShowOpen
    Text2 = .FileName
    If .CancelError = True Then Exit Sub
End With
Picture2.Cls
Picture1.Picture = LoadPicture(Text2)
Label2.Left = Picture1.Left + Picture1.Width - 1
Picture2.Left = Picture1.Left + Picture1.Width - 1
Call Text4_Change
Command2.Enabled = True
Command3.Enabled = True
Command5.Enabled = True
Option1(0).Enabled = True
Option1(1).Enabled = True
Text4.Enabled = True
End Sub
Public Function funcC(reset As Boolean, inp As String) As String
Static a As Integer
    If reset = True Then
        a = 0
        Exit Function
    End If
    a = a + 1
    funcC = Mid(inp, a, 1)
    If a = Len(inp) Then
        a = 0
    End If
End Function
Public Function Vb2html(inp As String) As String
Dim a As Integer
Dim b As Integer
Dim s(2) As String
Dim BOOM As String
    For a = 1 To 6 Step 2
        s(b) = Mid(inp, a, 2)
        b = b + 1
    Next a
    For a = 1 To 3
        BOOM = BOOM & s(3 - a)
    Next a
    Vb2html = BOOM
End Function
Private Sub Command2_Click()    'G?r mindre
Dim X, Y As Long
Picture2.Width = Picture1.Width
Picture2.Height = Picture1.Height / 2 + 1
DoEvents
For X = 0 To Picture1.Width
    For Y = 0 To Picture1.Height
        Picture2.PSet (X, Y), Picture1.Point(X, Y * 2)
    Next Y
Next X
Me.Caption = "-ok"
Command4.Enabled = True
End Sub
Private Sub Command3_Click()    'St?rrer
Dim X, Y As Long
Picture2.Width = Picture1.Width * 2 - 3
Picture2.Height = Picture1.Height
DoEvents
For X = 0 To Picture1.Width * 4
    For Y = 0 To Picture1.Height
        Picture2.PSet (X / 2, Y), Picture1.Point(X / 4, Y)
    Next Y
Next X
Me.Caption = "-ok"
Command4.Enabled = True
End Sub
Private Sub Command4_Click()
Text4.Enabled = False
With CommonDialog1
Dim e As String
    e = .FileName
    e = Mid(e, InStrRev(e, "\") + 1)
    e = Mid(e, 1, InStrRev(e, ".") - 1)
    e = e & ".html"
    .FileName = e
    .Filter = "HTML (*.html)|*.html"
    .ShowSave
    Text1 = .FileName
    If .CancelError = True Then Exit Sub
End With
If Len(Text1) = 0 Then Exit Sub
Dim aFont As String
    aFont = "<font color=#"
Dim bFont As String
    bFont = ">"
Dim cFont As String
    cFont = "</font>"
Dim X, Y As Long
Dim bredde As Integer
Dim hoejde As Integer
'\##############
    bredde = Picture2.Height - 2
    hoejde = Picture2.Width - 2
'/##############
    Open Text1 For Output As #1
        Dim f As String
        f = RGB(Text3(0), Text3(1), Text3(2))
        f = Hex(f)
        f = String(6 - Len(f), "0") & f
        f = Vb2html(f)
        Print #1, "<html><head></head><body bgcolor=#" & f & "><basefont size=1><pre><center>"
            For X = 0 To bredde - 1
                Dim tStr As String
                    tStr = ""
                    For Y = 0 To hoejde - 1
                        Dim a As String
                        a = Hex(Picture2.Point(Y, X))
                        'If a = "FFFFFFFF" Then a = "FFFFFF" 'Gammel bug, ved ik' om det er n?dvendigt, men jeg er ikke 100% at den er v?k.
                        a = String(6 - Len(a), "0") & a
                        a = Vb2html(a)
                        Dim g As String
                        If Option1(0).Value = True Then
                            g = funcC(False, Text4)
                        Else
                            g = txtRand(Text4)
                        End If
                        tStr = tStr & aFont & a & bFont & g & cFont
                    Next Y
                Print #1, tStr
                DoEvents
                Me.Caption = X & "@" & (bredde - 1)
            Next X
        Print #1, "</pre></body></html>"
    Close #1
Call funcC(True, "")
Text4.Enabled = True
Me.Caption = ""
MsgBox "HTML succesfully written!", vbInformation
End Sub
Private Sub Command5_Click()    '1:1
Dim X, Y As Long
Picture2.Width = Picture1.Width
Picture2.Height = Picture1.Height
DoEvents
For X = 0 To Picture1.Width
    For Y = 0 To Picture1.Height
        Picture2.PSet (X, Y), Picture1.Point(X, Y)
    Next Y
Next X
Me.Caption = "-ok"
Command4.Enabled = True
End Sub
Private Sub Form_Load()
    globe = True
End Sub
Private Sub HScroll1_Change(Index As Integer)
    Text3(Index).Text = HScroll1(Index).Value
End Sub
Private Sub HScroll1_Scroll(Index As Integer)
    Call HScroll1_Change(Index)
End Sub

Private Sub Picture1_Click()
    If globe = False Then
        globe = True
    Else
        globe = False
    End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim d As String
    If globe = True Then
        d = "LOCKED"
    Else
        d = "UNLOCKED"
    End If
Picture1.ToolTipText = "The picture is: " & d & ". Click here to lock/unlock."
If globe = True Then Exit Sub
Dim a As String
    a = Picture1.Point(X, Y)
    a = Hex(a)
    a = String(6 - Len(a), "0") & a
Dim b As Integer
Dim c As Integer
    For c = 1 To 6 Step 2
        Text3(2 - b) = CLng("&H" & Mid(a, c, 2))
        b = b + 1
    Next c
End Sub
Private Sub Text3_Change(Index As Integer)
Dim str As String
    Text3(Index) = Val(Text3(Index))
    Label6.BackColor = RGB(Text3(0), Text3(1), Text3(2))
    Label6.ForeColor = RGB(255 - Text3(0), 255 - Text3(1), 255 - Text3(2))
    str = "Backgroundcolor (VB'sk Hex):" & vbCrLf & Hex(Label6.BackColor)
    Label6.Caption = str
    HScroll1(Index).Value = Text3(Index)
End Sub
Private Sub Text4_Change()
If Len(Text4) = 0 Then Text4 = "01"
If Len(Text4) = 1 Then
    Option1(0).Value = True
    Option1(1).Enabled = False
Else
    Option1(1).Enabled = True
End If
    Label9.Caption = "Eg.: " & Text4 & Text4 & "..."
Dim a As Integer
Dim s As String
    For a = 1 To Len(Text4) * 2
        s = s & txtRand(Text4)
    Next a
    s = "Eg.: " & s
    s = s & "..."
    Label10.Caption = s
End Sub
Public Function txtRand(inp As String) As String
Dim a As Integer
    Randomize
    a = Rnd * (Len(inp) - 1)
    a = a + 1
    txtRand = Mid(inp, a, 1)
End Function