A Visual Basic Viewer Program

[ericmatteson...@hotmail.com]

' delete all lines above this line.
' Attempting to upgrade this
' by adding biclrused46 variable
' bexlview.vb Bitmap DIB file viewer program.
Imports System
Imports System.Reflection
Imports System.Runtime.InteropServices
Imports System.IO
Imports System.Collections
' Permission is granted to copy this file
' bexlview.vb and to publish it on the Internet
' And to use it at least for non profit use.
' This bexlview.vb was written by Eric Matteson.
Public Class bexspan
Public Shared cexthre() As Integer = _
{ 12,16,20,24,28,32,36,40,44, _
66,72,76,80,84,88,92,96,100, _
124,128,132,136,140,144,148,152,156, _
174,178,182,186,190,194,198,202,204, _
224,228,232,236,240,244,248,250,254, _
52,56,60,64,68,72,76,80,84, _
102,106,110,114,118,122,126,130,134, _
152,156,160,164,168,172,176,180,184, _
202,206,210,214,218,222,226,230,234, _
252,254,260,264,268,272,276,280,284, _
92,96,100,104,108,112,116,120,124, _
142,146,150,154,158,162,166,170,174, _
192,196,200,204,208,212,216,220,224, _
242,246,250,254,258,262,266,270,274, _
292,296,300,304,308,312,316,320,324, _
132,136,140,144,148,152,156,160,164, _
182,186,190,194,198,202,206,210,214, _
232,236,240,244,248,252,256,260,264, _
282,286,290,294,298,302,306,310,314, _
332,336,340,344,348,352,356,360,364, _
172,176,180,184,188,192,196,200,204, _
222,226,230,234,238,242,246,250,254, _
272,276,280,284,288,292,296,300,304, _
322,326,330,334,336,340,344,348,352, _
372,376,380,384,388,392,396,400,404, _
212,216,220,224,228,232,236,240,244, _
262,266,270,274,278,282,286,290,294, _
312,316,320,324,328,332,336,340,344, _
362,366,370,374,378,382,386,390,394, _
412,416,420,424,428,432,436,440,444, _
252,256,260,264,268,272,276,280,284, _
302,306,310,314,318,322,326,330,334, _
352,356,360,364,368,372,376,380,384, _
402,406,410,414,418,422,426,430,434, _
452,456,460,464,468,472,476,480,484, _
292,296,300,304,308,312,316,320,324, _
342,346,350,354,358,362,366,370,374, _
392,396,400,404,408,412,416,420,424, _
442,446,450,454,458,462,466,470,474, _
492,496,500,504,508,512,516,520,524, _
332,336,340,344,348,352,356,360,364, _
382,386,390,394,398,402,406,410,414, _
432,436,440,444,448,452,456,460,464, _
482,486,490,494,498,502,506,510,514, _
532,536,540,544,548,552,556,560,564 }
Public Shared bexthre() As Integer = _
{ 25,30,35,40,42,45,50,55,60, _
65,67,69,71,72,75,79,81,82, _
83,84,85,86,87,88,89,90,91, _
95,100,120,150,144,150,100,130,110, _
160,165,170,175,180,190,200,210,220, _
250,260,270,280,290,300,320,330,340, _
350,360,370,380,390,400,404,410,420, _
440,460,480,500,520,540,560,580,600, _
640,690,720,730,735,740,745,750,755 }
Public Shared bexbutop As String = _
" xxxx xxxx xxxx xxxx xxxx xxxx "
Public Shared bexbulab As String = _
" i x ; x , x r x c x . . "
Public Shared bexindiv As Integer
Public Shared bexshift As Integer
Public Shared bexkeyrz As Integer
Public Shared bexkeysr As String
Public Shared bexdagra As Integer
Public Shared bexfreddy As Integer
Public Shared bexfixsn As Integer
Public Shared bexfnary(6) As String
Public Shared bexrecent As String
Public Shared csnames() As String
Public Shared findlimit As Integer
Public Shared findsub As Integer
Public Shared bwthresb As Integer
Public Shared cothresb As Integer
Public Shared bwzur As Integer
' ----------------------------
Public Shared Sub vbdoskey()
Dim csdk,vbdr As Integer
Dim vbbr As Byte
Dim vbcr As Char
vbdr=4095
csdk=bexspan.bexindiv
If bexspan.bexshift = 0 Then
csdk=bexspan.bexindiv
If csdk >= 48 And csdk <= 57 Then vbdr=csdk
If csdk >= 96 And csdk <= 105 Then vbdr=csdk-48
If csdk >= 65 And csdk <= 91 Then vbdr=csdk+32
If csdk = 13 Then vbdr=13
If csdk = 10 Then vbdr=10
If csdk=32 Then vbdr=32
If csdk=8 Then vbdr=8
If csdk=27 Then vbdr=27
If csdk = 189 Then vbdr=45
If csdk = 187 Then vbdr=61
If csdk = 220 Then vbdr=92
If csdk = 219 Then vbdr=91
If csdk = 221 Then vbdr=93
If csdk = 186 Then vbdr=59
If csdk = 222 Then vbdr=39
If csdk = 188 Then vbdr=44
If csdk = 190 Then vbdr=46
If csdk = 191 Then vbdr=47
If csdk=36 Then vbdr=16384+71
If csdk=38 Then vbdr=16384+72
If csdk=33 Then vbdr=16384+73
If csdk=37 Then vbdr=16384+75
If csdk=39 Then vbdr=16384+77
If csdk=35 Then vbdr=16384+79
If csdk=40 Then vbdr=16384+80
If csdk=34 Then vbdr=16384+81
If csdk=45 Then vbdr=16384+82
If csdk=46 Then vbdr=16384+83
End If
If bexspan.bexshift = 1 Then
csdk=bexspan.bexindiv-65536
If csdk >= 65 And csdk <= 91 Then vbdr=csdk
If csdk = 189 Then vbdr=95
If csdk = 187 Then vbdr=43
If csdk = 220 Then vbdr=124
If csdk = 219 Then vbdr=123
If csdk = 221 Then vbdr=125
If csdk = 186 Then vbdr=58
If csdk = 222 Then vbdr=34
If csdk = 188 Then vbdr=60
If csdk = 190 Then vbdr=62
If csdk = 191 Then vbdr=63
If csdk=48 Then vbdr=41
If csdk=49 Then vbdr=33
If csdk=50 Then vbdr=64
If csdk=51 Then vbdr=35
If csdk=52 Then vbdr=36
If csdk=53 Then vbdr=37
If csdk=54 Then vbdr=94
If csdk=55 Then vbdr=38
If csdk=56 Then vbdr=42
If csdk=57 Then vbdr=40
End If
bexspan.bexkeyrz=vbdr
bexspan.bexkeysr=" "
If vbdr >= 32 And vbdr <= 126 Then
vbbr=Convert.ToByte(vbdr)
vbcr=Convert.ToChar(vbbr)
bexspan.bexkeysr=Convert.ToString(vbcr)
End If
End Sub
Public Shared Function redinext() As Integer
Dim fedxnext As Integer
Dim tkey As Integer
Dim dagi As Integer
Dim tlen As Integer
Dim bexbeyrz As Byte
Dim bexceyrz As Char
Dim tstr As String
Dim vstr As String
' -------------------
dagi=bexspan.bexdagra
fedxnext=dagi
tkey=bexspan.bexkeyrz
If dagi=967 Then
If tkey >= 32 And tkey <= 126 Then
bexspan.bexkeysr=" "
bexbeyrz=Convert.ToByte(tkey)
bexceyrz=Convert.ToChar(bexbeyrz)
bexspan.bexkeysr=Convert.ToString(bexceyrz)
vstr=bexspan.bexfnary(bexspan.bexfixsn)
vstr=vstr+bexspan.bexkeysr
bexspan.bexfnary(bexspan.bexfixsn)=vstr
End If
If tkey = 8 Then
tlen=(bexspan.bexfnary(bexspan.bexfixsn)).Length
If tlen >= 1 Then
tstr=bexspan.bexfnary(bexspan.bexfixsn)
vstr=tstr.Substring(0,tlen-1)
bexspan.bexfnary(bexspan.bexfixsn)=vstr
End If
End If
tlen=(bexspan.bexfnary(bexspan.bexfixsn)).Length
If tkey = 13 Then fedxnext=938
If tkey = 10 Then fedxnext=938
' If tlen > 59 Then fedxnext=938
If fedxnext=938 Then
bexspan.bexrecent=bexspan.bexfnary(bexspan.bexfixsn)
End If
End If
If dagi = 938 Then
' 73 I 105 i increment screen number
If tkey = 73 Or tkey = 105 Then
bexspan.bexfixsn=bexspan.bexfixsn+1
If bexspan.bexfixsn > 5 Then
bexspan.bexfixsn=1
End If
End If
' 67 C 99 c change colormode
If tkey = 67 Or tkey = 99 Then
bexspan.bwthresb=bexspan.bwthresb+9
If bexspan.bwthresb > 72 Then
bexspan.bwthresb=0
End If
bexspan.cothresb=bexspan.cothresb+45
If bexspan.cothresb > 360 Then
bexspan.cothresb=0
End If
End If
' 68 D 100 d decrement colormode
If tkey = 68 Or tkey = 100 Then
bexspan.bwthresb=bexspan.bwthresb-9
If bexspan.bwthresb < 0 Then
bexspan.bwthresb=72
End If
bexspan.cothresb=bexspan.cothresb-45
If bexspan.cothresb < 0 Then
bexspan.cothresb=360
End If
End If
' 86 V 118 v video mode
If tkey = 86 Or tkey = 118 Then
bexspan.bwzur=1-bexspan.bwzur
End If
' 59 ; find first file
If tkey = 59 Then
bexspan.findsub=0
bexspan.findlimit=0
bexspan.csnames=Directory.GetFiles(".")
If bexspan.csnames.Length > 0 Then
bexspan.findlimit=bexspan.csnames.Length
End If
End If
' 44 , Find Next File
If tkey = 44 Or tkey = 59 Then
If bexspan.findsub < bexspan.findlimit Then
bexspan.bexrecent=bexspan.csnames(bexspan.findsub)
bexspan.bexfnary(bexspan.bexfixsn)=bexspan.bexrecent
bexspan.findsub=bexspan.findsub+1
End If
End If
' 78 N 110 n new
If tkey = 78 Or tkey = 110 Then
bexspan.bexfnary(bexspan.bexfixsn)=""
End If
' 79 O 111 o open
If tkey = 79 Or tkey = 111 Then
bexspan.bexfnary(bexspan.bexfixsn)=""
fedxnext=967
End If
' 81 Q 113 q quit
If tkey = 81 Or tkey = 113 Then fedxnext=37
' 82 R 114 r redraw
If tkey = 82 Or tkey = 114 Then
vstr=bexspan.bexfnary(bexspan.bexfixsn)
tlen=vstr.Length
If tlen < 5 Then
bexspan.bexfnary(bexspan.bexfixsn)=bexspan.bexrecent
End If
End If
tlen=tkey-48
If tlen <= 5 And tlen >= 1 Then
bexspan.bexfixsn=tlen
End If
End If
' --------
redinext=fedxnext
End Function
End Class
Public Class bexread
Public chk19778 As Integer
' skip 18 or chk19778 + skip 16
Public biwidth18 As Integer
Public biheight22 As Integer
' skip 2 here then bibitcount half size
Public bibitcount28 As Integer
' At 30 after half size
' *** ERROR *** no bicolorUSED skip 24 here
' skip 16
Public biclrused46 As Integer
' skip 4
Public colortab54(1024) As Integer
' ---------------------------------
Public vbr,vbg,vbb As Integer
Public ythre As Integer
Public bexctr As Integer
Public bexii As Integer
Public bexic As Byte
Public bexsave(8) As Integer
Public bexdenom As Integer
Public bexdode As Integer
Public widallow As Integer
Public wiballow As Integer
Public hgtallow As Integer
Public bexwase As Integer
Public bexwrid As Integer
Public bexrase As Integer
Public bexrrwd As Integer
Public bexcurscr As Integer
Public xdelta As Integer
Public ydelta As Integer
Public yalimit As Integer
Public xalimit As Integer
Public iexdrwcr As Integer
Public bexbuff(49152) As Integer
Public bexladr As String
Public bexfont As String
Public salley As String
' -------------------------
Sub New()
Me.bexctr=8
Me.bexdenom=2
Me.bexwase=10
Me.bexwrid=10
Me.bexrase=16
Me.bexrrwd=1
Me.bexcurscr=5
End Sub
Sub New(newscrh As Integer)
Me.bexctr=8
Me.bexdenom=2
Me.bexwase=10
Me.bexwrid=10
Me.bexrase=16
Me.bexrrwd=1
Me.bexcurscr=newscrh
End Sub
Public Function bwwri(awwri As Integer) As String
Dim swwre As String
Dim swwrt As String
Dim swwrc As Char
Dim swwrb As Byte
Dim aawa(40) As Integer
Dim cwwtr As Integer
Dim bwwrr As Integer
Dim awwfrac As Integer
Dim awwProd As Integer
Dim awwrem As Integer
cwwtr=Me.bexwrid-1
bwwrr=awwri
If awwri < 0 Then bwwrr=0-(awwri+1)
While(cwwtr >= 0)
awwfrac=bwwrr/Me.bexwase
awwrem=0-1
While(awwrem < 0)
awwprod=awwfrac*Me.bexwase
awwrem=bwwrr-awwprod
If awwrem < 0 Then awwfrac=awwfrac-1
End While
If awwri < 0 Then awwrem=(Me.bexwase-1)-awwrem
awwrem=awwrem+48
If awwrem > 57 Then awwrem=awwrem+39
aawa(cwwtr)=awwrem
bwwrr=awwfrac
cwwtr=cwwtr-1
End While
swwre=""
cwwtr=0
While(cwwtr < Me.bexwrid)
awwrem=aawa(cwwtr)
swwrb=Convert.ToByte(awwrem)
swwrc=Convert.ToChar(swwrb)
swwrt=Convert.ToString(swwrc)
swwre = swwre & swwrt
cwwtr=cwwtr+1
End While
bwwri=swwre
End Function
Public Function getdval(sgdv As String, _
igdv As Integer) As Integer
Dim gdvres As Integer
Dim gdvs As String
Dim gdvc As Char
Dim gdvb As Byte
Dim gdvi As Integer
gdvres=18
gdvs=sgdv.substring(igdv,1)
gdvc=Convert.ToChar(gdvs)
gdvb=Convert.ToByte(gdvc)
gdvi=Convert.ToInt32(gdvb)
If gdvi >= 48 And gdvi <= 57 Then gdvres=gdvi-48
If gdvi >= 65 And gdvi <= 70 Then gdvres=gdvi-55
If gdvi >= 97 And gdvi <= 102 Then gdvres=gdvi-87
getdval=gdvres
End Function
Public Function getii(subr As Integer, _
sgetr As String) As Integer
Dim subctr,subtot,getirz,getidig As Integer
Dim tase,geta As Integer
subctr=0
getirz=0
tase=Me.bexrase-1
geta=1
While(geta > 0)
subtot=subctr+subr
getidig=getdval(sgetr,subtot)
If getidig < Me.bexrase Then geta=0
If geta > 0 Then subctr=subctr+1
If subctr >= Me.bexrrwd Then geta=0
End While
geta=0
If subctr < Me.bexrrwd Then geta=1
While(geta > 0)
subtot=subctr+subr
getidig=getdval(sgetr,subtot)
If getidig > tase Then geta=0
If geta > 0 Then
getirz=getirz*Me.bexrase
getirz=getirz+getidig
subctr=subctr+1
If subctr >= Me.bexrrwd Then geta=0
End If
End While
getii=getirz
End Function
Public Function vbdiv(benumer As Integer) As Integer
Dim bexfrac,bexprod,bexrem As Integer
Dim bexdest As Integer
bexrem=0-1
bexfrac=benumer/Me.bexdenom
While(bexrem < 0)
bexprod=Me.bexdenom*bexfrac
bexrem=benumer-bexprod
If bexrem < 0 Then bexfrac=bexfrac-1
End While
bexdest=bexfrac
If Me.bexdode > 0 Then bexdest=bexrem
vbdiv=bexdest
End Function
Public Function evodd(beonumer As Integer) As Integer
Dim evores As Integer
Me.bexdode=1
evores=vbdiv(beonumer)
evodd=evores
End Function
Public Function ehalf(behnumer As Integer) As Integer
Dim evhres As Integer
Me.bexdode=0
evhres=vbdiv(behnumer)
ehalf=evhres
End Function
Public Sub foad()
Dim fr As String
Dim bt As String
fr=""
fr=fr+"02020200h, 02060204h--020a0208h, 020e020ch--"
fr=fr+"02120210h, 02160214h, 021a0218h, 021e021ch--"
fr=fr+"02220220h, 02260224h, 022a0228h, 022e022ch--"
fr=fr+"02320230h, 02360234h, 023a0238h, 023e023ch--"
fr=fr+"02420240h, 025c024bh, 0282026dh, 02ac0297h--"
fr=fr+"02c202b5h, 02dc02cfh, 02ee02e5h, 02fc02f3h--"
fr=fr+"03120301h, 0330031bh, 034e0341h, 03780363h--"
fr=fr+"03960381h, 03b403abh, 03ca03c1h, 03dc03d3h--"
fr=fr+"040203edh, 04280413h, 044a0435h, 0468045bh--"
fr=fr+"048a047dh, 04a00497h, 04b604adh, 04d404c7h--"
fr=fr+"04fa04e9h, 0520050bh, 053e0535h, 055c054bh--"
fr=fr+"0576056dh, 05900583h, 05a2059dh, 05bc05afh--"
fr=fr+"05cb05c1h, 05f105e0h, 060f05feh, 06310624h--"
fr=fr+"064f0642h, 06650658h, 067b0672h, 0699068ch--"
fr=fr+"06bb06aah, 06d906d0h, 06f706eeh, 070d0704h--"
fr=fr+"0727071eh, 07410734h, 075b0752h, 0779076ch--"
fr=fr+"02020200h, 02060204h, 020a0208h, 020e020ch--"
fr=fr+"02120210h, 02160214h, 021a0218h, 021e021ch--"
fr=fr+"02220220h, 02260224h, 022a0228h, 022e022ch--"
fr=fr+"02320230h, 02360234h, 023a0238h, 023e023ch--"
fr=fr+"02020200h, 02060204h, 020a0208h, 020e020ch--"
fr=fr+"02120210h, 02160214h, 021a0218h, 021e021ch--"
fr=fr+"02220220h, 02260224h, 022a0228h, 022e022ch--"
fr=fr+"02320230h, 02360234h, 023a0238h, 023e023ch--"
fr=fr+"02020200h, 02060204h, 020a0208h, 020e020ch--"
fr=fr+"02120210h, 02160214h, 021a0218h, 021e021ch--"
fr=fr+"02220220h, 02260224h, 022a0228h, 022e022ch--"
fr=fr+"02320230h, 02360234h, 023a0238h, 023e023ch--"
fr=fr+"02020200h, 02060204h, 020a0208h, 020e020ch--"
fr=fr+"02120210h, 02160214h, 021a0218h, 021e021ch--"
fr=fr+"02220220h, 02260224h, 022a0228h, 022e022ch--"
fr=fr+"02320230h, 02360234h, 023a0238h, 023e023ch--"
' top of font 5*7 letter on 7*9 box
' xpos 1-5 within 0-6
' ypos 1-7 within 0-8
' x y size drawtype
' drawtype direction
' 1 right
' 2 down
' 3 upperleft lowerright
' 4 lowerleft upperright
bt=""
bt=bt+"0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-"
bt=bt+"0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-"
' 32 blank ! doublequotes #
bt=bt+"0-31423612-"
bt=bt+"2222422213214321-2172417213511551-"
'; 36 $ %
bt=bt+"11511122125317513172-16543122132153323731-"
'; 38 & singlequote ( )
bt=bt+"13421451175151622334-13111422-133415331332-"
bt=bt+"313353323734-"
'; 42 * + , - . /
bt=bt+"165412533252-14513252-55114621-"
bt=bt+"1441-36224622-1654-"
'; 48 0 1 2
bt=bt+"1172517221312731-41622224-"
bt=bt+"51421442114124312741-"
'; 51 3 4 5
bt=bt+"1141144117415172-114224315172-"
bt=bt+"11425442214124312731-"
'; 54 6 7 8
bt=bt+"54421172214124312731-"
bt=bt+"11511654-21312431273151721172-"
'; 57 9 : ;
bt=bt+"21312431273151721142-"
bt=bt+"33113511-331125213611-"
'; 60 < = > ?
bt=bt+"14441443-13411541-17441143-"
bt=bt+"3431513211413532-"
'; 64 @ A
bt=bt+"33323533517211511172-"
bt=bt+"2131243111725172-"
'; 66 B C D
bt=bt+"21432443244127411172-115117511252-"
bt=bt+"31335322273411721121-"
'; 69 E F G
bt=bt+"2141244127411172-117221412441-"
bt=bt+"34331421274121411172-"
'; 72 H I J K
bt=bt+"243151721172-213127313252-"
bt=bt+"17415172-244435331172-"
'; 76 L M N
bt=bt+"27411172-3334113352621262-"
bt=bt+"233351721172-"
'; 79 O P Q
bt=bt+"13344223544214422731-"
bt=bt+"2431113151421172-1151124215543333-"
'; 82 R S T
bt=bt+"24311141514211721443-"
bt=bt+"21213731145154421142-11513262-"
'; 85 U V W
bt=bt+"273151721172-3734144312225232-"
bt=bt+"1744343351621162-"
'; 88 X Y Z [
bt=bt+"16541253-333411333442-"
bt=bt+"165411511751-113117311252-"
'; 92 \ ] ^ _ graveaccentbackwardssinglequote
bt=bt+"1253-313137315252-"
bt=bt+"311122114211-1751-211132111-"
'; 97 a b c
bt=bt+"11411441174115225172-"
bt=bt+"2431273154421172-244127411442-"
'; 100 d e f
bt=bt+"1442243127315172-"
bt=bt+"24315142213111722731-214124211162-"
'; 103 g h i j
bt=bt+"1334133351722731-244155321172-"
bt=bt+"33423111-273153525111-"
'; 107 k l m n
bt=bt+"343434332252-22523631-"
bt=bt+"3634143315325532-134314325332-"
'; 111 o p q
bt=bt+"1534373415333333-4332232125211352-"
bt=bt+"11511451514211423342-"
'; 114 r s t u
bt=bt+"14411532-12411232143127341741-"
bt=bt+"13513352-144254422731-"
'; 115 v w x y
bt=bt+"37341533-3533173414425442-"
bt=bt+"17441443-353413333532-"
'; 122 z { | }
bt=bt+"174414312731-3131373114213172-"
bt=bt+"31323532-1131317234311731-"
'; 126 ~
bt=bt+"222131235111-0-0-0-0-0-0-0-"
bt=bt+"0-0-0-0-0-0-0-0-0-0-0-0-0"
'; -- end of vector font
Me.bexfont=bt
Me.bexladr=fr
End Sub
Public Function egetbit( _
egethan As BinaryReader) As Integer
Dim egctr As Integer
Dim egot As Integer
If Me.bexctr > 7 Then
Me.bexic=egethan.ReadByte()
Me.bexii=Convert.ToInt32(Me.bexic)
If Me.bexii < 0 Then Me.bexii=Me.bexii+256
egctr=7
While(egctr >= 0)
Me.bexsave(egctr)=evodd(Me.bexii)
Me.bexii=ehalf(Me.bexii)
egctr=egctr-1
End While
Me.bexctr=0
End If
egot=Me.bexsave(Me.bexctr)
Me.bexctr=Me.bexctr+1
egetbit=egot
End Function
Function egarterm(fgethan As BinaryReader) As Integer
Dim egarval,egarlimit,egarctr As Integer
egarval=0
egarctr=0
egarlimit=8
If Me.bibitcount28 < 8 Then egarlimit=Me.bibitcount28
While(egarctr < egarlimit)
egarval=egarval+egarval
egarval=egarval+egetbit(fgethan)
egarctr=egarctr+1
End While
egarterm=egarval
End Function
Sub egrgb(hgethan As BinaryReader)
Dim egrsub As Integer
If Me.bibitcount28 < 10 Then
egrsub=egarterm(hgethan)*4
Me.vbr=Me.colortab54(egrsub)
Me.vbg=Me.colortab54(egrsub+1)
Me.vbb=Me.colortab54(egrsub+2)
End If
If Me.bibitcount28 > 10 Then
Me.vbr=egarterm(hgethan)
Me.vbg=egarterm(hgethan)
Me.vbb=egarterm(hgethan)
End If
End Sub
Public Function ebyterem() As Integer
Dim ebyteres As Integer
Dim edensave As Integer
edensave=Me.bexdenom
ebyteres=0
Me.bexdode=0
Me.bexdenom=0
If bibitcount28=1 Then Me.bexdenom=8
If bibitcount28=4 Then Me.bexdenom=2
If bibitcount28=8 Then Me.bexdenom=1
If Me.bexdenom > 0 Then
ebyteres=vbdiv(Me.biwidth18+Me.bexdenom-1)
End If
If Me.bexdenom < 1 Then ebyteres=Me.biwidth18*3
Me.bexdenom=4
Me.bexdode=1
ebyteres=4-vbdiv(ebyteres)
If ebyteres > 3 Then ebyteres=0
Me.bexdenom=edensave
ebyterem=ebyteres
End Function
Public Function rgetshort( _
rgtctr As Integer,cgethan As BinaryReader) As Integer
Dim rso,rsh,rstctr,rstres As Integer
rstres=0
rso=0
rsh=0
rstctr=0
While(rstctr < 8)
rso=rso+rso
rso=rso+egetbit(cgethan)
rstctr=rstctr+1
End While
If rgtctr < 2 Then rstres=rso
If rgtctr > 1 Then
rstctr=0
While(rstctr < 8)
rsh=rsh+rsh
rsh=rsh+egetbit(cgethan)
rstctr=rstctr+1
End While
rstres=(rsh*256)+rso
End If
rso=(rgtctr*8)-16
rstctr=0
While(rstctr < rso)
rsh=egetbit(cgethan)
rstctr=rstctr+1
End While
rgetshort=rstres
End Function
Public Function rescale() As Integer
Dim scaleres,prow,proh As Integer
prow=Me.widallow
proh=Me.hgtallow
scaleres=1
While(prow < Me.biwidth18 Or proh < Me.biheight22)
scaleres=scaleres+1
prow=Me.widallow*scaleres
proh=Me.hgtallow*scaleres
End While
rescale=scaleres
End Function
Public Sub bexfill(bexfh As BinaryReader)
Dim bxol As Integer
Dim bxil As Integer
Dim limxol As Integer
Dim bexosub As Integer
Dim axil As Integer
Dim ixil As Integer
axil=ebyterem() * 8
limxol=rescale()
bxol=0
bexosub=0
While(bxol < limxol)
bxil=0
While(bxil < Me.biwidth18)
Call egrgb(bexfh)
Me.bexbuff(bexosub)=Me.vbr
Me.bexbuff(bexosub+1)=Me.vbg
Me.bexbuff(bexosub+2)=Me.vbb
bexosub=bexosub+3
bxil=bxil+1
End While
bxil=0
While(bxil < axil)
ixil=egetbit(bexfh)
bxil=bxil+1
End While
bxol=bxol+1
End While
End Sub
sub bexdl(ydl As Integer, _
gdl As System.Windows.Forms.PaintEventArgs)
Dim dlol As Integer
Dim xthre As Integer
Dim tothre As Integer
Dim dloj As Integer
Dim dlbase As Integer
Dim dlrep As Integer
Dim dlml As Integer
Dim dlmsub As Integer
Dim dlwidth As Integer
Dim dldens As Integer
Dim bigthre(89) As Integer
Dim cigthre(410) As Integer
Dim bigcm5 As Integer
Dim dlisub As Integer
Dim clisub As Integer
Dim clictr As Integer
Dim cothre As Integer
Dim dlil As Integer
Dim dlij As Integer
Dim sbepr As New System.Drawing.SolidBrush( _
System.Drawing.Color.Black)
Dim sbep1 As New System.Drawing.SolidBrush( _
System.Drawing.Color.Brown)
Dim sbep2 As New System.Drawing.SolidBrush( _
System.Drawing.Color.Gray)
Dim sbep3 As New System.Drawing.SolidBrush( _
System.Drawing.Color.Red)
Dim sbep4 As New System.Drawing.SolidBrush( _
System.Drawing.Color.Yellow)
Dim sbepg As New System.Drawing.SolidBrush( _
System.Drawing.Color.White)
dlrep=rescale()
dldens=Me.bexdenom
Me.bexdenom=dlrep
Me.bexdode=0
dlwidth=ehalf(Me.biwidth18)
Me.bexdenom=dldens
dlol=0
While(dlol < 405)
cigthre(dlol)=bexspan.cexthre(dlol)
cigthre(dlol)=cigthre(dlol)*dlrep*dlrep
dlol=dlol+1
End While
dlol=0
While(dlol < 81)
bigthre(dlol)=bexspan.bexthre(dlol)
bigthre(dlol)=bigthre(dlol)*dlrep
bigthre(dlol)=bigthre(dlol)*dlrep
dlol=dlol+1
End While
dlol=0
xthre=0
While(dlol < dlwidth)
bigcm5=0
dlml=0
While(dlml < dlrep)
dlil=0
While(dlil < dlrep)
dlbase=dlml*Me.biwidth18*3
dlmsub=(dlol*dlrep*3)+(dlil*3)
dlmsub=dlmsub+dlbase
bigcm5=bigcm5+Me.bexbuff(dlmsub)
bigcm5=bigcm5+Me.bexbuff(dlmsub+1)
bigcm5=bigcm5+Me.bexbuff(dlmsub+2)
dlil=dlil+1
End While
dlml=dlml+1
End While
dlisub=0
clisub=0
tothre=xthre+Me.ythre+bexspan.bwthresb
If bigcm5 > bigthre(tothre) Then
dlisub=dlisub+1
End If
cothre=xthre+Me.ythre+bexspan.cothresb
clictr=0
While(clictr < 5)
If bigcm5 > cigthre(cothre) Then clisub=clisub+1
cothre=cothre+9
clictr=clictr+1
End While
dloj=dlol+Me.xdelta
dlij=ydl+Me.ydelta
If bexspan.bwzur = 0 Then
If dlisub = 0 Then
gdl.Graphics.FillRectangle(sbepr,dloj,dlij,1,1)
End If
If dlisub = 1 Then
gdl.Graphics.FillRectangle(sbepg,dloj,dlij,1,1)
End If
End If
If bexspan.bwzur = 1 Then
If clisub = 0 Then
gdl.Graphics.FillRectangle(sbepr,dloj,dlij,1,1)
End If
If clisub = 1 Then
gdl.Graphics.FillRectangle(sbep1,dloj,dlij,1,1)
End If
If clisub = 2 Then
gdl.Graphics.FillRectangle(sbep2,dloj,dlij,1,1)
End If
If clisub = 3 Then
gdl.Graphics.FillRectangle(sbep3,dloj,dlij,1,1)
End If
If clisub = 4 Then
gdl.Graphics.FillRectangle(sbep4,dloj,dlij,1,1)
End If
If clisub = 5 Then
gdl.Graphics.FillRectangle(sbepg,dloj,dlij,1,1)
End If
End If
xthre=xthre+1
If xthre > 2 Then xthre=0
dlol=dlol+1
End While
End Sub
Public Sub onechar( _
cda As System.Windows.Forms.PaintEventArgs)
Dim xcx,cy,cw,cmo As Integer
Dim yanext,xanext,dchallow As Integer
Dim iexdcrem,iexdcsub As Integer
Dim zdctr As Integer
yanext=Me.yalimit+9
xanext=Me.xalimit+7
dchallow=1
xcx=Me.Widallow-6
cy=Me.hgtallow-30
If Me.bexcurscr = 5 Then cy=Me.hgtallow-30
If yanext >= cy Then dchallow=0
If xanext >= xcx Then dchallow=0
Dim sw As New System.Drawing.SolidBrush( _
System.drawing.Color.White)
Dim sb As New System.Drawing.SolidBrush( _
System.drawing.Color.Black)
xcx=Me.xalimit+Me.xdelta
cy=Me.yalimit+Me.ydelta
If dchallow > 0 Then
cda.Graphics.FillRectangle(sw,xcx,cy,7,9)
End If
iexdcsub=ehalf(Me.iexdrwcr)*11
iexdcrem=(4-(evodd(Me.iexdrwcr)*4))+iexdcsub
Me.bexrrwd=4
Me.bexrase=16
iexdcsub=getii(iexdcrem,Me.bexladr)-512
Me.bexrrwd=1
While(dchallow > 0)
xcx=getii(iexdcsub,Me.bexfont)
If xcx > 7 Then dchallow=0
If xcx < 1 Then dchallow=0
If dchallow > 0 Then
xcx=xcx+Me.xalimit+Me.xdelta
cy=getii(iexdcsub+1,Me.bexfont)+Me.yalimit+Me.ydelta
cw=getii(iexdcsub+2,Me.bexfont)
cmo=getii(iexdcsub+3,Me.bexfont)
zdctr=0
While(zdctr < cw)
If cmo=1 Then
cda.Graphics.FillRectangle(sb,xcx+zdctr,cy,1,1)
End If
If cmo=2 Then
cda.Graphics.FillRectangle(sb,xcx,cy+zdctr,1,1)
End If
If cmo=3 Then
cda.Graphics.FillRectangle(sb,xcx+zdctr,cy+zdctr,1,1)
End If
If cmo=4 Then
cda.Graphics.FillRectangle(sb,xcx+zdctr,cy-zdctr,1,1)
End If
zdctr=zdctr+1
End While
iexdcsub=iexdcsub+4
End If
End While
' remove Me.yalimit=yanext
Me.xalimit=xanext
End Sub
Public Sub vbdraws(cds As String, _
cdb As System.Windows.Forms.PaintEventArgs)
Dim vbslen,vbdtr,vbival As Integer
Dim cdd As String
Dim cdbb As Byte
Dim cdcc As Char
vbslen=cds.Length
vbdtr=0
While(vbdtr < vbslen)
cdd=cds.Substring(vbdtr,1)
cdcc=Convert.ToChar(cdd)
cdbb=Convert.ToByte(cdcc)
vbival=Convert.ToInt32(cdbb)
If vbival < 0 Then vbival=vbival+256
Me.iexdrwcr=vbival
Call onechar(cdb)
vbdtr=vbdtr+1
End While
Me.yalimit=Me.yalimit+9
Me.xalimit=0
End Sub
Public Sub bexdh( _
vg As System.Windows.Forms.PaintEventArgs)
Dim yal As Integer
Dim yafrac As Integer
Dim yasave As Integer
Dim dhfn As String
Dim yalley As Integer
Dim ydsave,xdsave,wdsave As Integer
Dim scb As New System.Drawing.SolidBrush( _
System.drawing.Color.Black)
If evodd(Me.bexcurscr) = 0 Then
vg.Graphics.FillRectangle(scb,Me.xdelta, _
Me.ydelta,Me.widallow,Me.hgtallow)
End If
ydsave=Me.ydelta
xdsave=Me.xdelta
wdsave=Me.widallow
Me.xalimit=0
Me.yalimit=0
Me.xdelta=2
Me.ydelta=0
Me.widallow=Me.wiballow
' -----------------------
' Draw buttons here 941
Call vbdraws(bexspan.bexbutop,vg)
Call vbdraws(bexspan.bexbulab,vg)
Call vbdraws(bexspan.bexbutop,vg)
' -----------------------
Me.xalimit=0
Me.yalimit=0
Me.widallow=wdsave
Me.xdelta=xdsave
Me.ydelta=ydsave
Me.biwidth18=0
Me.biheight22=0
yafrac=0
Me.bibitcount28=0
dhfn=bexspan.bexfnary(Me.bexcurscr)
If bexspan.bexfreddy = 938 Then
If dhfn.Length >= 5 Then
Dim yffs As New FileStream(dhfn, _
FileMode.Open,FileAccess.Read)
Dim dhbin As New BinaryReader(yffs)
Me.chk19778=rgetshort(18,dhbin)
If Me.chk19778=19778 Then
Me.biwidth18=rgetshort(4,dhbin)
Me.biheight22=rgetshort(6,dhbin)
Me.bibitcount28=rgetshort(18,dhbin)
Me.biclrused46=rgetshort(8,dhbin)
yasave=0
If Me.bibitcount28=1 Then yasave=8
If Me.bibitcount28=4 Then yasave=64
If Me.bibitcount28=8 Then
If Me.biclrused46=0 Then yasave=1024
If Me.biclrused46 <> 0 Then yasave=Me.biclrused46*4
End If
yal=0
While(yal < yasave)
Me.colortab54(yal)=rgetshort(1,dhbin)
yal=yal+1
End While
yasave=Me.bexdenom
yafrac=rescale()
Me.bexdenom=yafrac
Me.yalimit=ehalf(Me.biheight22)
Me.xalimit=0
Me.bexdenom=yasave
yal=Me.yalimit-1
Me.ythre=0
While(yal >= 0)
call bexfill(dhbin)
yalley=yal
call bexdl(yalley,vg)
Me.ythre=Me.ythre+3
If Me.ythre > 6 Then Me.ythre=0
yal=yal-1
End While
End If
dhbin.Close()
yffs.Close()
End If
End If
Me.salley=""
Me.bexwase=10
Me.bexwrid=10
yalley=(Me.biwidth18 * 10000)+Me.biheight22
Me.salley=Me.salley+bwwri(yalley)+" "
yalley=(yafrac * 100)+Me.bibitcount28
yalley=yalley+(bexspan.bexkeyrz * 10000)
Me.salley=Me.salley+bwwri(yalley)+" "
Me.salley=Me.salley+bexspan.bexkeysr+" "
yalley=bexspan.bexindiv
yalley=yalley+(bexspan.bexfixsn * 1048576)
yalley=yalley+(Me.bexcurscr * 16777216)
Me.bexwase=16
Me.bexwrid=8
Me.salley=Me.Salley+bwwri(yalley)+" &"
Me.bexwase=10
Me.bexwrid=10
Call vbdraws(Me.salley,vg)
Me.salley=dhfn
Call vbdraws(Me.salley,vg)
Call vbdraws("q quit r redraw recent n new",vg)
Call vbdraws("o open FILENAME 1 2 small",vg)
Call vbdraws(" 5 large screen 3 4 screen",vg)
Call vbdraws("; Find First , get Next file",vg)
Call vbdraws("c change threshold or d ",vg)
Call vbdraws("v video mode ",vg)
Call vbdraws(" i increment screen number ",vg)
Call vbdraws("Vote for an all volunteer jury",vg)
Call vbdraws("system for every court in U.S.",vg)
Call vbdraws("bexlview.vb Bitmap *.bmp DIB ",vg)
Call vbdraws("picture file viewer program. ",vg)
End Sub
End Class
' bexread bottom
Partial Public Class bexlview
Inherits System.Windows.Forms.Form
Protected Overrides Sub OnMouseDown( _
ByVal mvg As System.Windows.Forms.MouseEventArgs)
Dim ymmp,xmmp As Integer
ymmp=mvg.Y
xmmp=mvg.X
If ymmp < 27 Then
bexspan.bexkeyrz=32
If xmmp < (6*42) Then bexspan.bexkeyrz=32
If xmmp < (5*42) Then bexspan.bexkeyrz=99
If xmmp < (4*42) Then bexspan.bexkeyrz=114
If xmmp < (3*42) Then bexspan.bexkeyrz=44
If xmmp < (2*42) Then bexspan.bexkeyrz=59
If xmmp < (1*42) Then bexspan.bexkeyrz=105
bexspan.bexfreddy=bexspan.redinext()
bexspan.bexdagra=bexspan.bexfreddy
End If
Me.Invalidate()
End Sub
Protected Overrides Sub OnKeyUp( _
ByVal kug As System.Windows.Forms.KeyEventArgs)
Dim ikug As Integer
ikug=kug.KeyData
If ikug=16 Then bexspan.bexshift=0
End Sub
Protected Overrides Sub OnKeyDown( _
ByVal keg As System.Windows.Forms.KeyEventArgs)
Dim ikeg As Integer
ikeg=keg.KeyData
If ikeg=(65536+16) Then bexspan.bexshift=1
If ikeg <> (65536+16) Then
bexspan.bexindiv=ikeg
Call bexspan.vbdoskey()
bexspan.bexfreddy=bexspan.redinext()
bexspan.bexdagra=bexspan.bexfreddy
' -----------------------
Me.Invalidate()
End If
End Sub
Protected Overrides Sub OnPaint( _
ByVal tvg As System.Windows.Forms.PaintEventArgs)
Dim teeba As Integer
Dim ohio As New bexread(bexspan.bexfixsn)
Call ohio.foad()
' bexspan.bexindiv=0
' bexspan.bexshift=0
' bexspan.bexkeyrz=0
teeba=1
If ohio.bexcurscr < 5 Then ohio.bexcurscr = 1
While(teeba > 0)
ohio.wiballow=Me.width-6
If ohio.bexcurscr=5 Then
ohio.widallow=Me.Width-6
ohio.hgtallow=Me.Height-45
ohio.xdelta=2
ohio.ydelta=36
End If
If ohio.bexcurscr=1 Then
ohio.widallow=ohio.ehalf(Me.width-6)
ohio.hgtallow=ohio.ehalf(Me.height-45)
ohio.xdelta=2
ohio.ydelta=36
End If
If ohio.bexcurscr=2 Then
ohio.widallow=ohio.ehalf(Me.width-6)
ohio.hgtallow=ohio.ehalf(Me.height-45)
ohio.xdelta=ohio.widallow+4
ohio.ydelta=36
End If
If ohio.bexcurscr=3 Then
ohio.widallow=ohio.ehalf(Me.width-6)
ohio.hgtallow=ohio.ehalf(Me.height-45)
ohio.xdelta=2
ohio.ydelta=ohio.hgtallow+18
End If
If ohio.bexcurscr=4 Then
ohio.widallow=ohio.ehalf(Me.width-6)
ohio.hgtallow=ohio.ehalf(Me.height-45)
ohio.xdelta=ohio.widallow+4
ohio.ydelta=ohio.hgtallow+18
End If
' ------------------------
Call ohio.bexdh(tvg)
If ohio.bexcurscr < 5 Then
ohio.bexcurscr=ohio.bexcurscr+1
End If
If ohio.bexcurscr >= 5 Then teeba=0
End While
If bexspan.bexdagra = 37 Then
Me.close()
End If
End Sub
Shared Sub Main(sst() As String)
Dim mtt As String
Dim mto As String
Dim ito As Integer
Dim cto As Char
Dim bto As Byte
bexspan.bexindiv=0
bexspan.bexshift=0
bexspan.bexkeyrz=0+53
bexspan.bexkeysr=" "
bexspan.bexdagra=938
bexspan.bexfixsn=5
bexspan.bexfnary(0)=""
bexspan.bexfnary(1)="."
bexspan.bexfnary(2)="."
bexspan.bexfnary(3)="."
bexspan.bexfnary(4)="."
bexspan.bexfnary(5)=""
bexspan.bexrecent="."
bexspan.findsub=0
bexspan.findlimit=0-1
bexspan.bwzur=0
bexspan.bwthresb=36
bexspan.cothresb=90
mtt=""
If sst.Length > 0 Then
mtt=sst(0)
End If
If mtt.Length > 4 Then
ito=0
mto="o"
cto=Convert.ToChar(mto)
bto=Convert.ToByte(cto)
bexspan.bexkeyrz=Convert.ToInt32(bto)
bexspan.bexfreddy=bexspan.redinext()
bexspan.bexdagra=bexspan.bexfreddy
While(ito < mtt.Length)
mto=mtt.Substring(ito,1)
cto=Convert.ToChar(mto)
bto=Convert.ToByte(cto)
bexspan.bexkeyrz=Convert.ToInt32(bto)
bexspan.bexfreddy=bexspan.redinext()
bexspan.bexdagra=bexspan.bexfreddy
ito=ito+1
End While
bexspan.bexkeyrz=13
bexspan.bexfreddy=bexspan.redinext()
bexspan.bexdagra=bexspan.bexfreddy
End If
System.Windows.Forms.Application.Run(New bexlview())
End Sub
End Class
' This is the last line of this program bexlview.vb
' delete all lines below this line.
' ------------------------------------------------