Option Explicit
Public Type BMFH
    head As Integer
    size As Long
    res1 As Integer
    res2 As Integer
    ofst As Long
End Type
Public Type BMIH
    sz As Long
    width As Long
    height As Long
    planes As Integer
    bitcnt As Integer
    comp As Long
    imsz As Long
    xpels As Long
    ypels As Long
    colours As Long
    colim As Long
End Type
Public Type RGB
	red As Byte
	green As Byte
	blue As Byte
End Type

Public Const tbmpAC90 As Integer = 1 'anticlockwise 90 degrees
Public Const tbmpC90 As Integer = 2 'clockwise 90 degrees
Public Const tbmpFH As Integer = 3 'flip about vertical axis
Public Const tbmpFV As Integer = 4 'flip about horizontal axis
Public Const tbmp180 As Integer = 5 'rotate 180 degrees

Function TransformBitmap(iflnm As String, oflnm As String, op As Integer) As
Boolean
Dim i As Long, j As Long, tmpl As Long, rgbdata(256) As Long, x As Long
Dim idatal() As RGB, odatal() As RGB
Dim F1 As Integer, F2 As Integer
Dim bmpfh As BMFH
Dim bmpih As BMIH
Dim tmps As Byte, xs As Byte, idatas() As Byte, odatas() As Byte
TransformBitmap = False
If op < 1 Or op > 4 Then
    i = MsgBox("Unsupported transform", vbOKOnly, "Bitmap Widget")
    Exit Function
End If
F1 = FreeFile(0)
Open iflnm For Binary Access Read Shared As F1
F2 = FreeFile(0)
Open oflnm For Binary Access Write Lock Read Write As F2
Get F1, 1, bmpfh
If bmpfh.head <> 19778 Then
    i = MsgBox("Input file was NOT a bitmap", vbOKOnly, "Bitmap Widget")
    Close
    Exit Function
End If
Get F1, 15, bmpih
If (bmpih.sz < 0) Or (bmpih.comp <> 0) Then
    i = MsgBox("Can only handle smallish uncompressed images", vbOKOnly,
"Bitmap Widget")
    Close
    Exit Function
End If
If bmpih.bitcnt = 8 Then '8BPP 256 colours
    ReDim idatas(bmpih.width, bmpih.height)
    tmpl = (bmpih.width \ 4) * 4
    If (bmpih.width Mod 4) > 0 Then
        tmpl = tmpl + 4
    End If
    For i = 0 To 255
        Get F1, (55 + (i * 4)), rgbdata(i)
    Next
    For i = 0 To (bmpih.height - 1)
        For j = 0 To (bmpih.width - 1)
            Get F1, (1079 + (i * tmpl) + j), idatas(j, i)
        Next
    Next
    If op = tbmpAC90 Or op = tbmpC90 Then
        tmpl = (bmpih.height \ 4) * 4
        If (bmpih.height Mod 4) > 0 Then
            tmpl = tmpl + 4
        End If
        bmpfh.size = 1078 + (tmpl * bmpih.width) 'update filesize member
        ReDim odatas(tmpl, bmpih.width)
        i = bmpih.width
        bmpih.width = bmpih.height
        bmpih.height = i
    End If
    ReDim odatas(bmpih.width, bmpih.height)
    If op = tbmpAC90 Then
        For i = 0 To (bmpih.width - 1)
            For j = 0 To (bmpih.height - 1)
                odatas(bmpih.width - i - 1, j) = idatas(j, i)
            Next
        Next
    ElseIf op = tbmpC90 Then
        For i = 0 To (bmpih.width - 1)
            For j = 0 To (bmpih.height - 1)
                odatas(i, bmpih.height - 1 - j) = idatas(j, i)
            Next
        Next
    ElseIf op = tbmpFH Then
        For i = 0 To (bmpih.height - 1)
            For j = 0 To (bmpih.width - 1)
                odatas(bmpih.width - 1 - j, i) = idatas(j, i)
            Next
        Next
    ElseIf op = tbmpFV Then
        For i = 0 To (bmpih.height - 1)
            For j = 0 To (bmpih.width - 1)
                odatas(j, i) = idatas(j, bmpih.height - 1 - i)
            Next
        Next
    ElseIf op = tbmp180 Then
        For i = 0 To (bmpih.height - 1)
            For j = 0 To (bmpih.width - 1)
                odatas(j, i) = idatas(bmpih.width - 1 - j, bmpih.height - 1
- i)
            Next
        Next
    End If
    Put F2, 1, bmpfh
    Put F2, 15, bmpih
    For i = 0 To 255
        Put F2, (55 + (i * 4)), rgbdata(i)
    Next
    For i = 0 To (bmpih.height - 1)
        For j = 0 To (bmpih.width - 1)
            Put F2, (1079 + (i * tmpl) + j), odatas(j, i)
        Next
    Next
    If bmpih.width < tmpl Then
    tmps = 0
        Put F2, bmpfh.size + 1, tmps
    End If
ElseIf bmpih.bitcnt = 24 Then  '24BPP true colour
    ReDim idatal(bmpih.width, bmpih.height)
	tmpl = ((bmpih.width*3) \ 4) * 4
    If ((bmpih.width*3) Mod 4) > 0 Then
        tmpl = tmpl + 4
    End If
    For i = 0 To (bmpih.height - 1)
        For j = 0 To (bmpih.width - 1)
            Get F1, (55 + (i * tmpl) + (j * 3)), idatal(j, i)
        Next
    Next
    If op = tbmpAC90 Or op = tbmpC90 Then
	tmpl = ((bmpih.height*3) \ 4) * 4
        If ((bmpih.height*3) Mod 4) > 0 Then
            tmpl = tmpl + 4
        End If
        bmpfh.size = 55 + (tmpl * bmpih.width) 'update filesize member
        ReDim odatas(tmpl, bmpih.width)
        i = bmpih.width
        bmpih.width = bmpih.height
        bmpih.height = i
    End If
    ReDim odatal(bmpih.width, bmpih.height)
    If op = tbmpAC90 Then
        For i = 0 To (bmpih.width - 1)
            For j = 0 To (bmpih.height - 1)
                odatal(bmpih.width - i - 1, j) = idatal(j, i)
            Next
        Next
    ElseIf op = tbmpC90 Then
        For i = 0 To (bmpih.width - 1)
            For j = 0 To (bmpih.height - 1)
                odatal(i, bmpih.height - 1 - j) = idatal(j, i)
            Next
        Next
    ElseIf op = tbmpFH Then
        For i = 0 To (bmpih.height - 1)
            For j = 0 To (bmpih.width - 1)
                odatal(bmpih.width - 1 - j, i) = idatal(j, i)
            Next
        Next
    ElseIf op = tbmpFV Then
        For i = 0 To (bmpih.height - 1)
            For j = 0 To (bmpih.width - 1)
                odatal(j, i) = idatal(j, bmpih.height - 1 - i)
            Next
        Next
    ElseIf op = tbmp180 Then
        For i = 0 To (bmpih.height - 1)
            For j = 0 To (bmpih.width - 1)
                odatas(j, i) = idatas(bmpih.width - 1 - j, bmpih.height - 1
- i)
            Next
        Next
    End If
    Put F2, 1, bmpfh
    Put F2, 15, bmpih
    For i = 0 To (bmpih.height - 1)
        For j = 0 To (bmpih.width - 1)
            Put F2, 55 + (tmpl * i)+(j*3), odatal(i, j)
        Next
    Next
    If (bmpih.width*3) < tmpl Then
    tmps = 0
        Put F2, bmpfh.size + 1, tmps
    End If
ElseIf bmpih.bitcnt = 4 Then  '4BPP 16 Colours
    ReDim idatas(bmpih.width, bmpih.height)
    tmpl = (bmpih.width \ 8) * 4
    If (bmpih.width Mod 8) > 0 Then
        tmpl = tmpl + 4
    End If
    For i = 0 To 15
        Get F1, (55 + (i * 4)), rgbdata(i)
    Next
    For i = 0 To (bmpih.height - 1)
        For j = 0 To (bmpih.width - 1)
            x = ((i * tmpl) + (j \ 2))
            Get F1, 119 + x, tmps
            If (j Mod 2 <> 0) Then
                idatas(j, i) = tmps And &hf
            Else
                idatas(j, i) = tmps \ 16
            End If
        Next
    Next
    If op = tbmpC90 Or op = tbmpAC90 Then
        i = bmpih.width
        bmpih.width = bmpih.height
        bmpih.height = i
        tmpl = (bmpih.width \ 8) * 4
        If (bmpih.width Mod 8) > 0 Then
            tmpl = tmpl + 4
        End If
        bmpfh.size = (tmpl * bmpih.height) + 118
    End If
    ReDim odatas(bmpih.width, bmpih.height)
    If op = tbmpAC90 Then
        For i = 0 To (bmpih.width - 1)
            For j = 0 To (bmpih.height - 1)
                odatas(bmpih.width - i - 1, j) = idatas(j, i)
            Next
        Next
    ElseIf op = tbmpC90 Then
        For i = 0 To (bmpih.width - 1)
            For j = 0 To (bmpih.height - 1)
                odatas(i, bmpih.height - 1 - j) = idatas(j, i)
            Next
        Next
    ElseIf op = tbmpFH Then
        For i = 0 To (bmpih.height - 1)
            For j = 0 To (bmpih.width - 1)
                odatas(bmpih.width - 1 - j, i) = idatas(j, i)
            Next
        Next
    ElseIf op = tbmpFV Then
        For i = 0 To (bmpih.height - 1)
            For j = 0 To (bmpih.width - 1)
                odatas(j, i) = idatas(j, bmpih.height - 1 - i)
            Next
        Next
    ElseIf op = tbmp180 Then
        For i = 0 To (bmpih.height - 1)
            For j = 0 To (bmpih.width - 1)
                odatas(j, i) = idatas(bmpih.width - 1 - j, bmpih.height - 1
- i)
            Next
        Next
    End If
    Put F2, 1, bmpfh
    Put F2, 15, bmpih
    For i = 0 To 15
        Put F2, (i * 4) + 55, rgbdata(i)
    Next
    For i = 0 To (bmpih.height - 1)
        For j = 0 To (bmpih.width - 1)
            If (j Mod 2) <> 0 Then
                tmps = tmps Or odatas(j, i)
            Else
                tmps = odatas(j, i) * 16
            End If
            If j = (bmpih.width - 1) Or ((j Mod 2) <> 0) Then
                Put F2, (i * tmpl) + (j \ 2) + 119, tmps
            End If
        Next
    Next
    i = bmpih.width \ 2
    i = i + (bmpih.width Mod 2)
    If i < tmpl Then
    tmps = 0
        Put F2, bmpfh.size + 1, tmps
    End If
ElseIf bmpih.bitcnt = 1 Then  '1BPP Monochrome
    ReDim idatas(bmpih.width, bmpih.height)
    tmpl = (bmpih.width \ 32) * 4
    If (bmpih.width Mod 32) > 0 Then
        tmpl = tmpl + 4
    End If
    Get F1, 55, rgbdata(0)
    Get F1, 59, rgbdata(1)
    For i = 0 To (bmpih.height - 1)
        For j = 0 To (bmpih.width - 1)
            x = (i * tmpl) + (j \ 8)
            Get F1, (63 + x), tmps
            If (tmps And (2 ^ (7 - (j Mod 8)))) <> 0 Then
                idatas(j, i) = 255
            End If
        Next
    Next
    If op = tbmpC90 Or op = tbmpAC90 Then
        i = bmpih.width
        bmpih.width = bmpih.height
        bmpih.height = i
        tmpl = (bmpih.width \ 32)
        If (bmpih.width Mod 32) > 0 Then
            tmpl = tmpl + 4
        End If
        bmpfh.size = 62 + (tmpl * bmpih.height)
    End If
    ReDim odatas(bmpih.width, bmpih.height)
    If op = tbmpAC90 Then
        For i = 0 To (bmpih.width - 1)
            For j = 0 To (bmpih.height - 1)
                odatas(bmpih.width - i - 1, j) = idatas(j, i)
            Next
        Next
    ElseIf op = tbmpC90 Then
        For i = 0 To (bmpih.width - 1)
            For j = 0 To (bmpih.height - 1)
                odatas(i, bmpih.height - 1 - j) = idatas(j, i)
            Next
        Next
    ElseIf op = tbmpFH Then
        For i = 0 To (bmpih.height - 1)
            For j = 0 To (bmpih.width - 1)
                odatas(bmpih.width - 1 - j, i) = idatas(j, i)
            Next
        Next
    ElseIf op = tbmpFV Then
        For i = 0 To (bmpih.height - 1)
            For j = 0 To (bmpih.width - 1)
                odatas(j, i) = idatas(j, bmpih.height - 1 - i)
            Next
        Next
    ElseIf op = tbmp180 Then
        For i = 0 To (bmpih.height - 1)
            For j = 0 To (bmpih.width - 1)
                odatas(j, i) = idatas(bmpih.width - 1 - j, bmpih.height - 1
- i)
            Next
        Next
    End If
    Put F2, 1, bmpfh
    Put F2, 15, bmpih
    Put F2, 55, rgbdata(0)
    Put F2, 59, rgbdata(1)
    For i = 0 To (bmpih.height - 1)
        For j = 0 To (bmpih.width - 1)
            If (j Mod 8) = 0 Then
                tmps = 0
            End If
            xs = 2 ^ (7 - (j Mod 8))
            tmps = tmps Or (xs And odatas(j, i))
            If ((j Mod 8) = 7) Or (j = (bmpih.width - 1)) Then
                x = 63 + (i * tmpl) + (j \ 8)
                Put F2, x, tmps
            End If
        Next
    Next
    i = bmpih.width \ 8
    If (bmpih.width Mod 8) <> 0 Then
        i = i + 1
    End If
    If i < tmpl Then
    tmps = 0
        Put F2, bmpfh.size + 1, tmps
    End If
End If
Close
TransformBitmap = True
End Function