At 04:29 �� 1/2/2002 +0100, you wrote:
>On 31 Jan 2002, at 15:10, Phoebus R. Dokos wrote:
>
> > Hi all,
> > After lots of trial and error (Mainly because I had to relearn binary
> > arithmetic ;-) My BMP2SCR-Win program is updated to official version 1.1
> >
>Hi, let me have the sources (or at least some doc on the windows
>BMP format), I'll try to see whather we can't have the same thing
>under SMSQ...
>Wolfgang
>-----------------
>www.wlenerz.com
Sending them over...
Careful the source is not fully (well not at all) commented... I'll add
some comments and send it over (Don't be alarmed by the string handling
though because VB can handle HUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUGE
strings (1 Mbyte long strings is common!)
Phoebus
P.S. Remarks are noted with a "'" (single quote)
------------------------VB Source
begins-------------------------------------------------------------
'*************************************************************************************************
'* BMP to QL Pointer Environment PIC File Converter for
GD2 *
'*
==============================================================
*
'* � 2001 Phoebus R. Dokos - Original Program � 2001 Malcolm
Lear *
'* This Program is
Freeware *
'*************************************************************************************************
Public glbFlagOk As Boolean
Sub ConvertFile32(BMPFile As String, PicFile As String)
Dim glbWidth As Long
Dim glbHeight As Long
Dim glbX As Long
Dim glbY As Long
Dim glbAddress As Long
Dim InputFileLength As Long
Dim OutFileLength As Long
Dim Remaining As Long
Dim Maximum As Long
Dim glbBlue As Integer
Dim glbUgreen As Integer
Dim glblGreen As Integer
Dim glbRed As Integer
Dim glbLoadedBytes(3932214) As Integer
Dim glbSavingBytes(3932160) As Integer
Dim glbCounter As Long
Dim BytesIn As String
Dim BytesOut As String
Dim TempText As String
Dim Counter As Long
Dim ReadMsg As String
Dim ConvertMsg As String
Dim SaveMsg As String
Close 'Close all files in case we forgot something
main.sbrStatus.Panels(1).Text = "Input File: " & BMPFile & " - Output File:
" & PicFile 'Put info on status bar on name window
'Initialise Variables
ReadMsg = "Reading File: " & BMPFile 'Messages for the Progress bar
(frmProgress)
ConvertMsg = "Converting"
SaveMsg = "Saving File: " & PicFile
frmProgress.Show 'Show the Progress Form
Open BMPFile For Binary As 1 'Open the file... Opening in binary format
because it is faster than reading text streams
InputFileLength = LOF(1) 'Calculating Length
Remaining = InputFileLength 'Calculating Remaining and initializing
Maximum = Int(InputFileLength / 6) 'Assigning the size of the read block to
1/6 of the size of the file.
'This is done solely because we want to show some progress on the screen
with the progress bar. It could be adapted not to show progress at all.
'If we remove all progress crap then we can speed reading by 50%!!!!
frmProgress.ProgressBar1.Min = 0 'Set limits on the progress bar values
frmProgress.ProgressBar1.Max = 100 'same
Do Until EOF(1) 'Loop until we reach the end of the bmp file
frmProgress.ProgressBar1.Value = Int(Abs((InputFileLength - Remaining) *
100) / InputFileLength) 'We set the value as a percentage
'of the progress
frmProgress.Caption = ReadMsg & " (" & frmProgress.ProgressBar1.Value & "%
completed)" 'This changes the progress windows title according to how much
% of the file we read
TempText = Input$(Maximum, 1) 'We read the file in chunks of "Maximum" from
channel 1 and assign it to the temporary variable 'Text'
BytesIn = BytesIn + TempText 'We add the read part to the string BytesIn
(Don't be confused, the $ sign must not be included since the variable was
dimensioned as string above
Remaining = Remaining - Maximum 'Now we update the remaining variable
If Remaining < Maximum Then Maximum = Remaining 'Pretty self explanatory...
If Remaining = 0 Then Exit Do 'Get out of the loop immediately (if you
don't put that it will crash) if no file remains
Loop 'Loop's end
Close 'Close the file
'Below we check absolute byte 28 (Strings in VBasic start from 1 not 0
hence the 28 + 1) for the decimal value 24
'If it doesn't exist Show a Critical Error message box and exit
'The actual functions are:
'ASC (it's like CODE in S*Basic): Returns the Decimal value of a character
'MID($): Performs string slicing (Similar to the "TO" in Sbasic which is a
lot more elegant) The $ identifier can be ommited (Only with VB DOS 1.0 and
above
'In GWBASIC, QBASIC, QuickBASIC and PDS it has to be there
If Asc(Mid(BytesIn, 28 + 1, 1)) <> 24 Then MsgBox "NOT a 24 bit Image",
vbCritical, "Colour Depth error": bmp2scrWin.glbFlagOk = False: Unload
frmProgress: Exit Sub
'Now we get file information
'First Width
glbWidth = ((Asc(Mid(BytesIn, 19 + 1, 1))) * 256) + (Asc(Mid(BytesIn, 18 +
1, 1)))
'Then Height
glbHeight = ((Asc(Mid(BytesIn, 23 + 1, 1))) * 256) + (Asc(Mid(BytesIn, 22 +
1, 1)))
'Then we set the length of the output file (it's of course type 2 since
there are two bytes per pixel)
OutFileLength = glbWidth * glbHeight * 2
'Now we prepare the temporary string that will handle the output. Sort of
like RESPR (size)
'We can't do that with a DIM statement since string dimensioning goes up to 255
'So the way we do it is by using the String$ function that writes a number
of characters "x" in an other string
'In this case we put white space... (Stay in line with the ASCII code)
BytesOut = BytesOut & String$(OutFileLength, 32)
'Again some setup for the progress bar
frmProgress.ProgressBar1.Max = OutFileLength
frmProgress.ProgressBar1.Min = 0
frmProgress.ProgressBar1.Value = 1
'We initialize the counter - REMEMBER BMP files have reverse scan lines
(bottom to top) that's why we are going upside down
'... in case you noticed! :-)
Counter = 0
main.sbrStatus.Panels(2).Text = "Conversion in Progress...." 'Same old,
same old for main window
frmProgress.Caption = ConvertMsg & " and " & SaveMsg 'Blah.. blah..'
For glbY = glbHeight - 1 To 0 Step -1
For glbX = 0 To glbWidth - 1
glbAddress = glbX * 3 + glbY * 3 * glbWidth + 54 'we set the
address. Since it's 24 bit (3 bytes)
'we multiply by 3... and add an offset of 54 from the beginning
of the file (skipping the file header that is)
glbBlue = (Asc(Mid(BytesIn, glbAddress + 1, 1))) And 248: 'Now we
grab using are string functions the value for blue
'The binary ADD actually masks the MSB first 5 bits (Mode 32 has
5 bit blue)
glbUgreen = (Asc(Mid(BytesIn, glbAddress + 2, 1))) And 224 'The
same with the green with the following reservations:
'1: We need to chop it in two pieces Since half goes to the first
byte and half to the left
'2: We get 6 bits in total (The original code grabbed only 5 and
left the 6th bit
glblGreen = (Asc(Mid(BytesIn, glbAddress + 2, 1))) And 28 'And
here it is 28 (Binary mask of 00011100) instead of 24 (Binary mask of 00011000)
glbRed = (Asc(Mid(BytesIn, glbAddress + 3, 1))) And 248 'And the
Red (as in the blue)
'Note that as I discuss above BMP scans from the bottom up and
that's why the byte order is reversed... Instead of RGB it's BGR :-)
'Now we shift the bits around if needed and replace the white
space in the output string using the Mid$ function
'First we write the first byte (Shift the three bits of Lower
green bits left by 3 positions), shift the Blue right by 3)
'Essentially if we wrote them out as we had we would have a big
mess in our hands since(L=Lower Green, B is blue):
'BBBBB000 occupies the left five bits and 000LLL00 occupies part
of the left five bits...
'Our resulting byte is LLLBBBBB (which is the correct one ;-)
'Note division shifts to the right, multiplication to the left :-)
Mid$(BytesOut, Counter + 1, 1) = Chr$((glblGreen * 8) + (glbBlue
/ 8))
'We do the same for the next byte but by shifting the UG five
places to the right. The red remains as is
'We then have RRRRRGGG
Mid$(BytesOut, Counter + 2, 1) = Chr$((glbUgreen / 32) + glbRed)
Counter = Counter + 2
Next glbX
frmProgress.ProgressBar1.Value = Counter 'A little more progress bar
crap to show that we are professionals
main.sbrStatus.Panels(2).Text = "Conversion in Progress.... Now
converting Byte: " & Counter
Next glbY
frmProgress.Caption = SaveMsg
'We then open the output file, write the one string and close it... All done!
Open PicFile For Output As #2
Print #2, BytesOut;
Close #2
main.sbrStatus.Panels(2).Text = ""
Unload frmProgress
bmp2scrWin.glbFlagOk = True
End Sub
Sub ConvertFile33(BMPFile As String, PicFile As String)
'The only differences between this and the previous procedure is in the
conversion. See the remarks there
Dim glbWidth As Long
Dim glbHeight As Long
Dim glbX As Long
Dim glbY As Long
Dim glbAddress As Long
Dim InputFileLength As Long
Dim OutFileLength As Long
Dim Remaining As Long
Dim Maximum As Long
Dim glbBlue As Integer
Dim glbGreen As Integer
Dim glbRed As Integer
Dim glbLoadedBytes(3932214) As Integer
Dim glbSavingBytes(3932160) As Integer
Dim glbCounter As Long
Dim BytesIn As String
Dim BytesOut As String
Dim TempText As String
Dim Counter As Long
Dim ReadMsg As String
Dim ConvertMsg As String
Dim SaveMsg As String
Close 'Close all files in case we forgot something
main.sbrStatus.Panels(1).Text = "Input File: " & BMPFile & " - Output File:
" & PicFile
'Initialise Variables
ReadMsg = "Reading File: " & BMPFile
ConvertMsg = "Converting"
SaveMsg = "Saving File: " & PicFile
frmProgress.Show 'Show the Progress Form
Open BMPFile For Binary As 1
InputFileLength = LOF(1)
Remaining = InputFileLength
Maximum = Int(InputFileLength / 6)
frmProgress.ProgressBar1.Min = 0
frmProgress.ProgressBar1.Max = 100
Do Until EOF(1)
frmProgress.ProgressBar1.Value = Int(Abs((InputFileLength - Remaining) *
100) / InputFileLength)
frmProgress.Caption = ReadMsg & " (" & frmProgress.ProgressBar1.Value & "%
completed)"
TempText = Input$(Maximum, 1)
BytesIn = BytesIn + TempText
Remaining = Remaining - Maximum
If Remaining < Maximum Then Maximum = Remaining
If Remaining = 0 Then Exit Do
Loop
Close
If Asc(Mid(BytesIn, 28 + 1, 1)) <> 24 Then MsgBox "NOT a 24 bit Image",
vbCritical, "Colour Depth error": bmp2scrWin.glbFlagOk = False: Unload
frmProgress: Exit Sub
glbWidth = ((Asc(Mid(BytesIn, 19 + 1, 1))) * 256) + (Asc(Mid(BytesIn, 18 +
1, 1)))
glbHeight = ((Asc(Mid(BytesIn, 23 + 1, 1))) * 256) + (Asc(Mid(BytesIn, 22 +
1, 1)))
OutFileLength = glbWidth * glbHeight * 2
BytesOut = BytesOut & String$(OutFileLength, 32)
frmProgress.ProgressBar1.Max = OutFileLength
frmProgress.ProgressBar1.Min = 0
frmProgress.ProgressBar1.Value = 1
Counter = 0
main.sbrStatus.Panels(2).Text = "Conversion in Progress...."
frmProgress.Caption = ConvertMsg & " and " & SaveMsg
For glbY = glbHeight - 1 To 0 Step -1
For glbX = 0 To glbWidth - 1
glbAddress = glbX * 3 + glbY * 3 * glbWidth + 54
glbBlue = (Asc(Mid(BytesIn, glbAddress + 1, 1))) And 248 'Same as
above (5 bits for blue)
Blue6 = ((Asc(Mid(BytesIn, glbAddress + 1, 1))) And 4) / 4 'Aha
difference!. That's the 6th bit (see below)
glbGreen = (Asc(Mid(BytesIn, glbAddress + 2, 1))) And 248 'Same
as above but we don't slice and we have one less bit (5 bits for Green)
Green6 = ((Asc(Mid(BytesIn, glbAddress + 2, 1))) And 4) / 4 'The
same as above. See below
glbURed = (Asc(Mid(BytesIn, glbAddress + 3, 1))) And 224 'Now we
chop off the red
glbLred = (Asc(Mid(BytesIn, glbAddress + 3, 1))) And 24 'And its
bottom part
Red6 = ((Asc(Mid(BytesIn, glbAddress + 3, 1))) And 4) / 4 'And
the 6th bit
If Blue6 + Green6 + Red6 >= 2 Then Intensity = 1 Else Intensity = 0
'Here's the trick. If at least TWO of the 6th bits are set, then
we set the Intensity bit
'else we leave it blank. Since the I bit is connected to all
three it's better to have an approximation
'of sorts...
Mid$(BytesOut, Counter + 1, 1) = Chr$((glbGreen) + (glbURed / 32))
'As above with the difference of the colour placement for each
byte and the intensity bit
Mid$(BytesOut, Counter + 2, 1) = Chr$((glbBlue / 4) + (glbLred *
8) + Intensity)
Counter = Counter + 2
Next glbX
frmProgress.ProgressBar1.Value = Counter
main.sbrStatus.Panels(2).Text = "Conversion in Progress.... Now
converting Byte: " & Counter
Next glbY
frmProgress.Caption = SaveMsg
Open PicFile For Output As #2
Print #2, BytesOut;
Close #2
main.sbrStatus.Panels(2).Text = ""
Unload frmProgress
bmp2scrWin.glbFlagOk = True
End Sub
