home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
table120.zip
/
source.zip
/
Table.rxx
< prev
Wrap
Text File
|
2001-08-07
|
30KB
|
1,136 lines
/*-----------------------------------------------------------------------------+
| |
| REXX source code listing for DrRexx application: |
| G:\Goran\Table120\English\Table.res |
| |
| File last modified on: 08/07/01 at: 05:05pm |
| Listing produced on: 08/07/01 at: 05:05pm |
| |
+-----------------------------------------------------------------------------*/
SIGNAL ON SYNTAX
SIGNAL ON HALT
SIGNAL INIT
RETURN:
SIGNAL VALUE DrRexxEvent()
L1:
EXIT -1
L2:
INTERPRET DrRexxInterpret()
SIGNAL RETURN
/*-----------------------------------------------------------------------------+
| |
| Event handlers for dialog: Table |
| |
+-----------------------------------------------------------------------------*/
/* Event handlers for: Table (DIALOG) */
Table_Key:
CALL EventData
preskey = EventData.1
preskey = TRANSLATE(preskey)
SELECT
WHEN preskey = 'F1' THEN '@START /F View.exe Table.inf'
WHEN preskey = 'F3' THEN CALL TheEnd
WHEN preskey = 'F5' THEN DO
IF C102.Select() > 0 & C115.Select() = 1 THEN DO
oldText = C116.Text()
sel1 = C102.Item(C102.Select())
seld = WORD(sel1,2)
CALL C116.Text oldText||X2C(D2X(seld))
END
END
OTHERWISE NOP
END
SIGNAL RETURN
Table_Exit:
CALL TheEnd
SIGNAL RETURN
Table_Move:
PARSE VALUE Table.Position() WITH tabx taby tabxs tabys
SIGNAL RETURN
Table_Init:
PARSE ARG isclip
PARSE VALUE ScreenSize() WITH cx cy
PARSE VALUE Table.Frame() WITH fl fb fr ft
progname = 'Table 1.2.0'
IF RxFuncQuery('SysLoadFuncs') THEN DO
CALL RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
CALL SysLoadFuncs
END
CALL LoadCfg
CALL Language
CALL LoadCP
CALL ShowTable
CALL C199.IsDefault('C')
CALL C102.Hint h.102
DO i = 111 TO 119
INTERPRET 'CALL C'||i||'.Text b.i'
INTERPRET 'CALL C'||i||'.Hint h.i'
END
DO i = 122 TO 123
INTERPRET 'CALL C'||i||'.Text b.i'
INTERPRET 'CALL C'||i||'.Hint h.i'
END
DO i = 131 TO 133
INTERPRET 'CALL C'||i||'.Text b.i'
INTERPRET 'CALL C'||i||'.Hint h.i'
END
CALL C139.Hint h.139
CALL C102.Select 1
CALL C115.Select 1
CALL ShowChars showchars
CALL Table.Show
IF isclip = 1 THEN DO
CALL C116.Text Clipboard()
END
CALL C116.Focus
SIGNAL RETURN
/* Event handlers for: C123 (PUSHBUTTON) */
Table_C123_Click:
CALL TheEnd
SIGNAL RETURN
Table_C123_:
SIGNAL RETURN
/* Event handlers for: C119 (PUSHBUTTON) */
Table_C119_Click:
myerr = 0
c2bin = ''
c2dec = ''
c2oct = ''
c2hex = ''
c2asc = ''
SELECT
WHEN LENGTH(C116.Text()) = 0 THEN DO
IF RxMessageBox(msg.1182,msg.1181,,'ERROR') = 1 THEN DO
END
END
OTHERWISE DO
SELECT
WHEN C111.Select() = 1 THEN CALL ConvertBIN
WHEN C112.Select() = 1 THEN CALL ConvertDEC
WHEN C113.Select() = 1 THEN CALL ConvertOCT
WHEN C114.Select() = 1 THEN CALL ConvertHEX
WHEN C115.Select() = 1 THEN CALL ConvertASC
OTHERWISE NOP
END
IF myerr = 0 THEN DO
CALL Result.Open
END
END
END
SIGNAL RETURN
Table_C119_:
SIGNAL RETURN
/* Event handlers for: C122 (PUSHBUTTON) */
Table_C122_Click:
'@START /F View.exe Table.inf'
SIGNAL RETURN
/* Event handlers for: C118 (PUSHBUTTON) */
Table_C118_Click:
CALL C116.Text ''
SIGNAL RETURN
/* Event handlers for: C121 (PUSHBUTTON) */
Table_C121_Click:
isclip = 0
IF LENGTH(C116.Text()) > 0 THEN DO
isclip = 1
CALL Clipboard C116.Text()
END
CALL Table.Hide
'@START /B /C /MIN TableCP.cmd '||Table.C121.Text()||' '||isclip
Exit
SIGNAL RETURN
/* Event handlers for: C117 (PUSHBUTTON) */
Table_C117_Click:
oldText = C116.Text()
CALL C116.Text oldText||Clipboard()
SIGNAL RETURN
/* Event handlers for: C133 (PUSHBUTTON) */
Table_C133_Click:
selchars = STRIP(C139.Text())
CALL SysIni inifile, 'Settings', 'SelectedChars', selchars
IF selchars <> '' THEN DO
CALL ShowCharsSel
END
SIGNAL RETURN
/* Event handlers for: C132 (RADIOBUTTON) */
Table_C132_Click:
CALL ShowChars 2
SIGNAL RETURN
/* Event handlers for: C131 (RADIOBUTTON) */
Table_C131_Click:
CALL ShowChars 1
SIGNAL RETURN
/* Event handlers for: C102 (LISTBOX) */
Table_C102_Enter:
sel1 = C102.Item(C102.Select())
seld = WORD(sel1,2)
CALL Clipboard X2C(D2X(seld))
CALL BeepMe
SIGNAL RETURN
/*-----------------------------------------------------------------------------+
| |
| Event handlers for dialog: Result |
| |
+-----------------------------------------------------------------------------*/
/* Event handlers for: Result (DIALOG) */
Result_Key:
CALL EventData
presskey = EventData.1
presskey = TRANSLATE(presskey)
IF presskey = 'ESC' THEN DO
CALL ResultClose
END
SIGNAL RETURN
Result_Init:
CALL Result.Text progname||' - '||b.200
DO i = 201 TO 205
INTERPRET 'CALL C'||i||'.Font monoFont'
INTERPRET 'CALL C'||i||'.Hint h.i'
j = i+10
INTERPRET 'CALL C'||j||'.Text b.j'
INTERPRET 'CALL C'||j||'.Hint h.j'
END
DO i = 208 TO 209
INTERPRET 'CALL C'||i||'.Text b.i'
INTERPRET 'CALL C'||i||'.Hint h.i'
END
rxp = xp
ryp = yp+ft+fb
rxs = xs
rys = ys-ft-fb
strw = rxs*4%5
CALL Result.Position rxp, ryp, rxs, rys
CALL C208.Position fl, fb, rxs%3, ft+fb
CALL C209.Position rxs*2%3-fr, fb, rxs%3, ft+fb
xp205 = fl
yp205 = fb*3+ft
xs205 = strw
ys205 = ft*2
CALL C205.Position xp205, yp205, xs205, ys205
CALL C215.Position fl*2+strw, yp205, rxs-strw-fl*3, ys205
xp204 = xp205
yp204 = yp205+ys205+fb
xs204 = strw
ys204 = ft*2
CALL C204.Position xp204, yp204, xs204, ys204
CALL C214.Position fl*2+strw, yp204, rxs-strw-fl*3, ys204
xp203 = xp204
yp203 = yp204+ys204+fb
xs203 = strw
ys203 = ft*2
CALL C203.Position xp203, yp203, xs203, ys203
CALL C213.Position fl*2+strw, yp203, rxs-strw-fl*3, ys203
xp202 = xp204
yp202 = yp203+ys203+fb
xs202 = strw
ys202 = ft*2
CALL C202.Position xp202, yp202, xs202, ys202
CALL C212.Position fl*2+strw, yp202, rxs-strw-fl*3, ys202
xp201 = xp204
yp201 = yp202+ys202+fb
xs201 = strw
ys201 = ft*2
CALL C201.Position xp201, yp201, xs201, ys201
CALL C211.Position fl*2+strw, yp201, rxs-strw-fl*3, ys201
CALL C201.Text STRIP(c2bin)
CALL C202.Text STRIP(c2dec)
CALL C203.Text STRIP(c2oct)
CALL C204.Text STRIP(c2hex)
c2asc = TRANSLATE(c2asc,' ','00'x)
CALL C205.Text c2asc
CALL Table.Disable
CALL Result.Show
SIGNAL RETURN
/* Event handlers for: C209 (PUSHBUTTON) */
Result_C209_Click:
CALL ResultClose
SIGNAL RETURN
/* Event handlers for: C208 (PUSHBUTTON) */
Result_C208_Click:
CALL WriteMe.Open
SIGNAL RETURN
/* Event handlers for: C215 (PUSHBUTTON) */
Result_C215_Click:
CALL Clipboard c2asc
CALL BeepMe
SIGNAL RETURN
/* Event handlers for: C214 (PUSHBUTTON) */
Result_C214_Click:
CALL Clipboard STRIP(c2hex)
CALL BeepMe
SIGNAL RETURN
/* Event handlers for: C213 (PUSHBUTTON) */
Result_C213_Click:
CALL Clipboard STRIP(c2oct)
CALL BeepMe
SIGNAL RETURN
/* Event handlers for: C212 (PUSHBUTTON) */
Result_C212_Click:
CALL Clipboard STRIP(c2dec)
CALL BeepMe
SIGNAL RETURN
/* Event handlers for: C211 (PUSHBUTTON) */
Result_C211_Click:
CALL Clipboard STRIP(c2bin)
CALL BeepMe
SIGNAL RETURN
/*-----------------------------------------------------------------------------+
| |
| Event handlers for dialog: WriteMe |
| |
+-----------------------------------------------------------------------------*/
/* Event handlers for: WriteMe (DIALOG) */
WriteMe_Key:
CALL EventData
presskey = EventData.1
presskey = TRANSLATE(presskey)
IF presskey = 'ESC' THEN DO
CALL WriteMe.Close
END
SIGNAL RETURN
WriteMe_Init:
wxs = rxs*2%3
wxp = rxp+rxs%6
CALL WriteMe.Position wxp, ryp, wxs, ft*10+fb*6
CALL WriteMe.Text progname||' - '||b.400
CALL C408.Position fl, fb, wxs%3, ft+fb
CALL C409.Position wxs*2%3-fr, fb, wxs%3, ft+fb
DO i = 408 TO 409
btnid = i-200
INTERPRET 'CALL C'||i||'.Text b.btnid'
INTERPRET 'CALL C'||i||'.Hint h.btnid'
END
xp420 = fl
yp420 = fb*3+ft
xs420 = wxs-fl-fr
ys420 = ft*2
CALL C420.Position xp420, yp420, xs420, ys420
DO i = 421 TO 425
INTERPRET 'CALL C'||i||'.Position xp420+fl+xs420%5*(i-421), yp420+fb, xs420%5-fl*2, ft'
btnid = i-310
INTERPRET 'CALL C'||i||'.Text b.btnid'
INTERPRET 'CALL C'||i||'.Hint h.i'
INTERPRET 'CALL C'||i||'.Select 1'
END
CALL C420.Text b.420
xp410 = xp420
yp410 = yp420+ys420
xs410 = xs420
ys410 = ft*6+fb*3
CALL C410.Position xp410, yp410, xs410, ys410
CALL C411.Position xp410+fl, yp410+fb*4+ft*4, xs420-fl*2, ft
CALL C412.Position xp410+fl, yp410+fb*3+ft*3, xs420-fl*2, ft
CALL C414.Position xp410+fl, yp410+fb*2+ft*2, ft*2, ft
CALL C415.Position xp410+fl*2+ft*2, yp410+fb*2+ft*2, xs420-fl*3-ft*2, ft
CALL C416.Position xp410+fl, yp410+fb+ft, xs420-fl*2, ft
CALL C417.Position xp410+fl, yp410+fb, xs420-fl*2, ft
CALL C414.Range 1,99
CALL C410.Text b.410
CALL C411.Text b.411
CALL C412.Hint h.412
CALL C414.Hint h.414
DO i = 415 TO 417
INTERPRET 'CALL C'||i||'.Text b.i'
INTERPRET 'CALL C'||i||'.Hint h.i'
END
CALL C412.Text Directory()||'\table.txt'
CALL WriteMe.Show
CALL C414.Select 4
CALL C416.Select 1
CALL C417.Select 1
CALL CalcLineLen
SIGNAL RETURN
/* Event handlers for: C409 (PUSHBUTTON) */
WriteMe_C409_Click:
CALL WriteMe.Close
SIGNAL RETURN
/* Event handlers for: C408 (PUSHBUTTON) */
WriteMe_C408_Click:
CALL CalcLineLen
myFile = C412.Text()
writeLine = 0
cols = 0
binLine = ''
decLine = ''
octLine = ''
hexLine = ''
ascLine = ''
binText = Result.C201.Text()
decText = Result.C202.Text()
octText = Result.C203.Text()
hexText = Result.C204.Text()
IF myspace = 0 THEN DO
binText = SPACE(Result.C201.Text(),0)
decText = SPACE(Result.C202.Text(),0)
octText = SPACE(Result.C203.Text(),0)
hexText = SPACE(Result.C204.Text(),0)
END
ascText = TRANSLATE(Result.C205.Text(),' ','0D0A'x)
'type nul >'||myfile
rc = STREAM(myfile,"c","OPEN")
myTxt = msg.4080||' '||progname||' - '||DATE()||' - '||TIME()
CALL LINEOUT myFile,myTxt
CALL LINEOUT myFile,' '
myTxt = ''
IF bin2col = 1 THEN DO
myTxt = myTxt||LEFT('BIN',binlen)
END
IF dec2col = 1 THEN DO
myTxt = myTxt||LEFT('DEC',declen)
END
IF oct2col = 1 THEN DO
myTxt = myTxt||LEFT('OCT',octlen)
END
IF hex2col = 1 THEN DO
myTxt = myTxt||LEFT('HEX',hexlen)
END
IF asc2col = 1 THEN DO
myTxt = myTxt||LEFT('ASC',asclen)
END
IF num2col = 1 THEN DO
myTxt = ' Chars '||myTxt
END
CALL LINEOUT myFile,myTxt
mylen = LENGTH(ascText)
mystep = mylen%chr2col
IF mylen//chr2col > 0 THEN DO
mystep = mystep+1
END
DO i = 1 TO mystep
binPart = i*(binlen-1)-binlen+2
octPart = i*(octlen-1)-octlen+2
decPart = i*(declen-1)-declen+2
hexPart = i*(hexlen-1)-hexlen+2
ascPart = i*asclen-asclen+1
statLine = RIGHT(i*chr2col-chr2col+1,4,'0')||'-'||RIGHT(MIN(mylen,(i*chr2col)),4,'0')||' '
IF bin2col= 1 THEN DO
binLine = SUBSTR(binText,binPart,binlen-1)||' '
END
IF dec2col = 1 THEN DO
decLine = SUBSTR(decText,decPart,declen-1)||' '
END
IF oct2col = 1 THEN DO
octLine = SUBSTR(octText,octPart,octlen-1)||' '
END
IF hex2col = 1 THEN DO
hexLine = SUBSTR(hexText,hexPart,hexlen-1)||' '
END
IF asc2col = 1 THEN DO
ascLine = SUBSTR(ascText,ascPart,asclen)
END
myText = binLine||decLine||octLine||hexLine||ascLine
IF num2col = 1 THEN DO
myText = statLine||myText
END
CALL LINEOUT myFile,myText
writeLine = writeLine + 1
IF RIGHT(writeLine,1) = '0' THEN DO
CALL Table.C199.Text 'Writing line: '||writeLine
END
END
CALL LINEOUT myFile,' '
rc = STREAM(myfile,"c","CLOSE")
CALL BeepMe
IF RxMessageBox(myFile||'0D0A'x||msg.4082,msg.4081,'OKCANCEL','INFORMATION') = 1 THEN DO
'START /F E.exe '||myFile
END
CALL WriteMe.Close
SIGNAL RETURN
/* Event handlers for: C425 (CHECKBOX) */
WriteMe_C425_Click:
CALL CalcLineLen
SIGNAL RETURN
/* Event handlers for: C424 (CHECKBOX) */
WriteMe_C424_Click:
CALL CalcLineLen
SIGNAL RETURN
/* Event handlers for: C423 (CHECKBOX) */
WriteMe_C423_Click:
CALL CalcLineLen
SIGNAL RETURN
/* Event handlers for: C422 (CHECKBOX) */
WriteMe_C422_Click:
CALL CalcLineLen
SIGNAL RETURN
/* Event handlers for: C421 (CHECKBOX) */
WriteMe_C421_Click:
CALL CalcLineLen
SIGNAL RETURN
/* Event handlers for: C417 (CHECKBOX) */
WriteMe_C417_Click:
CALL CalcLineLen
SIGNAL RETURN
/* Event handlers for: C416 (CHECKBOX) */
WriteMe_C416_Click:
CALL CalcLineLen
SIGNAL RETURN
/* Event handlers for: C414 (SPINBUTTON) */
WriteMe_C414_Done:
CALL CalcLineLen
SIGNAL RETURN
/*-----------------------------------------------------------------------------+
| |
| Global procedures: |
| |
+-----------------------------------------------------------------------------*/
ShowChars:
PARSE ARG showchars
SELECT
WHEN showchars = 1 THEN DO
CALL Table.C131.Select 1
CALL Table.C133.Disable
CALL Table.C139.Disable
CALL ShowCharsAll
END
WHEN showchars = 2 THEN DO
CALL Table.C132.Select 1
CALL Table.C133.Enable
CALL Table.C139.Enable
selchars = STRIP(Table.C139.Text())
IF selchars <> '' THEN DO
CALL ShowCharsSel
END
END
OTHERWISE NOP
END
RETURN
ResultClose:
c2bin = ''
c2dec = ''
c2hex = ''
c2asc = ''
CALL C201.Text ''
CALL C202.Text ''
CALL C203.Text ''
CALL C204.Text ''
CALL Result.Close
CALL Table.Enable
RETURN
TheEnd:
PARSE VALUE Table.Position() WITH xp yp xs ys
CALL Table.Hide
CALL SysIni inifile, 'Settings', 'Position', xp||' '||yp
CALL SysIni inifile, 'Settings', 'FixedFont', STRIP(TRANSLATE(C102.Font(),' ','00'x))
SELECT
WHEN C131.Select() = 1 THEN CALL SysIni inifile, 'Settings', 'ShowChars', '1'
OTHERWISE CALL SysIni inifile, 'Settings', 'ShowChars', '2'
END
Exit
RETURN
CheckDEC:
PARSE ARG dec2chk
SELECT
WHEN DATATYPE(dec2chk) <> 'NUM' THEN decerr = 1
WHEN dec2chk//1 <> 0 THEN decerr = 1
WHEN dec2chk < 0 THEN decerr = 1
WHEN dec2chk > 255 THEN decerr = 1
OTHERWISE decerr = 0
END
RETURN decerr
ShowCharsSel:
scnum = 0
selchar.0 = 0
DO c = 1 TO WORDS(selchars)
i = WORD(selchars,c)
IF CheckDEC(i) = 0 THEN DO
scnum = scnum+1
selchar.scnum = RIGHT(X2B(D2X(i)),8,'0')||' '||RIGHT(i,3,'0')||' '||RIGHT(B2O(X2B(D2X(i))),3,'0')||' '||D2X(i,2)||' '||X2C(D2X(i))
END
END
selchar.0 = scnum
IF selchar.0 > 0 THEN DO
CALL Table.C102.Delete
DO i = 1 TO selchar.0
CALL Table.C102.Add selchar.i
END
END
RETURN
ShowCharsAll:
CALL Table.C102.Delete
CALL Table.C102.Add '00000000'||' '||'000'||' '||'000'||' '||'00'||' '||'NULL'
DO i = 1 TO 254
CALL Table.C102.Add RIGHT(X2B(D2X(i)),8,'0')||' '||RIGHT(i,3,'0')||' '||RIGHT(B2O(X2B(D2X(i))),3,'0')||' '||D2X(i,2)||' '||X2C(D2X(i))
END
CALL Table.C102.Add '11111111'||' '||'255'||' '||'377'||' '||'FF'||' '||'BLANK'
RETURN
ConvertOCT:
/* Convert OCTAL */
errtype = 'OCT'
oct2conv = Table.C116.Text()
chars2conv = WORDS(oct2conv)
DO i = 1 TO chars2conv
ochar = WORD(oct2conv,i)
IF LENGTH(ochar) > 3 THEN DO
CALL IsErr errtype ochar
LEAVE
END
ochar = RIGHT(ochar,3,'0')
myerr = VERIFY(ochar,valoct)
SELECT
WHEN myerr = 0 THEN DO
bchar = RIGHT(O2B(ochar),8,'0')
hchar = RIGHT(B2X(bchar),2,'0')
dchar = RIGHT(X2D(hchar),3,'0')
achar = X2C(hchar)
CALL Strings
END
OTHERWISE DO
CALL IsErr errtype dchar
LEAVE
END
END
IF ochar > 377 THEN DO
CALL IsErr errtype ochar
LEAVE
END
END
oct2conv = ''
RETURN
O2B:
/* OCTAL to BINARY */
PARSE ARG oct2bin
myb = ''
DO o = 1 TO LENGTH(oct2bin)
myb = myb||RIGHT(X2B(SUBSTR(oct2bin,o,1)),3,'0')
END
myb = RIGHT(myb,8,'0')
RETURN myb
B2O:
/* BINARY to OCTAL */
PARSE ARG bin2oct
myo = ''
DO WHILE LENGTH(bin2oct) > 3
myo = X2D(B2X(RIGHT(bin2oct,3)))||myo
bin2oct = LEFT(bin2oct,LENGTH(bin2oct)-3)
END
IF LENGTH(bin2oct) > 0 THEN DO
myo = X2D(B2X(bin2oct))||myo
END
RETURN myo
Language400:
/* Print options */
b.400 = 'Write result to file'
b.410 = 'Output options'
b.411 = 'File name:'
b.415 = 'characters in line; line length ='
b.416 = '~Character numbers in output'
b.417 = '~Spaces in BIN DEC OCT HEX'
b.420 = 'Include following formats in output'
h.412 = 'Write output to this file'
h.414 = 'Number of characters in line'
h.415 = 'Number of characters in line and line length'
h.416 = 'Display character numbers in output'
h.417 = 'Display spaces in BIN DEC OCT HEX format'
h.421 = 'Include BINARY format in output'
h.422 = 'Include DECIMAL format in output'
h.423 = 'Include OCTAL format in output'
h.424 = 'Include HEXADECIMAL format in output'
h.425 = 'Include ASCII format in output'
RETURN
Language200:
/* Conversion result */
b.200 = 'Conversion result'
b.208 = '~Write'
b.209 = '~Cancel'
b.211 = '~BIN Clip'
b.212 = '~DEC Clip'
b.213 = '~OCT Clip'
b.214 = '~HEX Clip'
b.215 = '~ASC Clip'
h.208 = 'Write result to file table.txt'
h.209 = 'Return to program (Esc)'
h.201 = 'Conversion result in BINARY format'
h.202 = 'Conversion result in DECIMAL format'
h.203 = 'Conversion result in OCTAL format'
h.204 = 'Conversion result in HEXADECIMAL format'
h.205 = 'Conversion result in ASCII format'
h.211 = 'Copy result in BINARY format to Clipboard'
h.212 = 'Copy result in DECIMAL format to Clipboard'
h.213 = 'Copy result in OCTAL format to Clipboard'
h.214 = 'Copy result in HEXADECIMAL format to Clipboard'
h.215 = 'Copy result in ASCII format to Clipboard'
RETURN
Language:
CALL Language100
CALL Language200
CALL Language400
msg.1181 = 'Error!'
msg.1182 = 'Nothing to convert. Enter string to convert and try again!'
msg.4080 = 'Conversion result, generated with'
msg.4081 = 'Result is saved to:'
msg.4082 = 'To view file with OS/2 System editor press OK. To return to program press Cancel.'
RETURN
Language100:
/* Main window */
b.111 = 'BIN'
b.112 = 'DEC'
b.113 = 'OCT'
b.114 = 'HEX'
b.115 = 'ASC'
b.116 = ''
b.117 = '~Paste'
b.118 = '~Delete'
b.119 = '~Convert'
b.122 = '~Help'
b.123 = 'E~xit'
b.131 = '~All'
b.132 = '~Selected'
b.133 = '~Refresh'
h.100 = 'Active code page:'
h.102 = 'DblClick = copy selected ASCII char to Clipboard; F5 = append selected ASCII char to string'
h.111 = 'Select BINARY format as source'
h.112 = 'Select DECIMAL format as source'
h.113 = 'Select OCTAL format as source'
h.114 = 'Select HEXADECIMAL format as source'
h.115 = 'Select ASCII format as source'
h.116 = 'Enter string to convert here'
h.117 = 'Paste string from Clipboard (append to existing string)'
h.118 = 'Delete this string'
h.119 = 'Convert this string to other formats'
h.121 = 'Select alternate code page'
h.122 = 'Show help for '||progname||' (F1)'
h.123 = 'Leave program '||progname||' (F3)'
h.131 = 'Show all 256 characters in the list'
h.132 = 'Show only selected characters (in entry field) in the list'
h.133 = 'Refresh characters list (after you changed characters in entry field)'
h.139 = 'DECIMAL representation of selected characters to show in the list'
RETURN
LoadCP:
/* Check system code pages */
'@del codepage.txt'
'@CHCP > codepage.txt'
dummy = STREAM('codepage.txt', 'c', 'open')
selpage = LINEIN('codepage.txt',1,1)
prepage = LINEIN('codepage.txt')
dummy = STREAM('codepage.txt', 'c', 'close')
'@del codepage.txt'
selpage = STRIP(SPACE(selpage,1))
prepage = STRIP(SPACE(prepage,1))
thispage = WORD(selpage,WORDS(selpage))
altpages = SUBSTR(prepage,POS(':',prepage)+1)
altpages = TRANSLATE(altpages, ,',')
IF WORDS(altpages) > 1 THEN DO
selpage1 = WORD(altpages,1)
selpage2 = WORD(altpages,2)
CALL Table.C121.Show
SELECT
WHEN selpage1 = thispage THEN DO
CALL Table.C121.Text '~'||selpage2
CALL Table.C121.Hint h.121||' '||selpage2
END
WHEN selpage2 = thispage THEN DO
CALL Table.C121.Text '~'||selpage1
CALL Table.C121.Hint h.121||' '||selpage1
END
OTHERWISE NOP
END
END
CALL Table.Text progname||', '||h.100||' '||thispage||' (Prepared: '||altpages||')'
RETURN
CalcLineLen:
/* Calculate line length in output */
chr2col = WriteMe.C414.Select()
num2col = WriteMe.C416.Select()
myspace = WriteMe.C417.Select()
bin2col = WriteMe.C421.Select()
dec2col = WriteMe.C422.Select()
oct2col = WriteMe.C423.Select()
hex2col = WriteMe.C424.Select()
asc2col = WriteMe.C425.Select()
numlen = num2col*9+num2col
SELECT
WHEN myspace = 1 THEN DO
binlen = chr2col*bin2col*9+bin2col
declen = chr2col*dec2col*4+dec2col
octlen = chr2col*oct2col*4+oct2col
hexlen = chr2col*hex2col*3+hex2col
END
OTHERWISE DO
binlen = chr2col*bin2col*8+bin2col
declen = chr2col*dec2col*3+dec2col
octlen = chr2col*oct2col*3+oct2col
hexlen = chr2col*hex2col*2+hex2col
END
END
asclen = chr2col*asc2col
linelen = numlen+binlen+declen+octlen+hexlen+asclen
CALL WriteMe.C415.Text b.415||' '||linelen
RETURN
BeepMe:
dummy = BEEP(450,150)
RETURN
Strings:
/* Update conversion */
c2bin = c2bin||' '||bchar
c2dec = c2dec||' '||dchar
c2hex = c2hex||' '||hchar
c2oct = c2oct||' '||ochar
c2asc = c2asc||achar
IF RIGHT(i,1) = 0 THEN DO
CALL Table.C199.Text i||'/ '||chars2conv
END
RETURN
IsErr:
PARSE ARG errtype errchar
myerr = 1
IF RxMessageBox(errchar||' is not valid '||errtype||' character.'||'0D'x||'Please enter correct values.','Error in character '||i,,'WARNING') = 1 THEN DO
CALL Table.C116.Text ''
END
RETURN
ShowTable:
/* Size and position of main window */
CALL Table.Position xp, yp, xs, ys
CALL Table.C199.Position fl, fb, xs-fl-fr, ft
xp104 = fl
yp104 = fb+ft
xs104 = 260
ys104 = ys-fb-ft*2-2
CALL Table.C104.Position xp104, yp104, xs104, ys104
CALL Table.C102.Position xp104+fl, yp104+fb*4+ft*2, xs104-fl-fr, ys104-fb*5-ft*3
CALL Table.C131.Position xp104+fl, yp104+fb*2+ft, xs104%3, ft
CALL Table.C132.Position xp104+fl*2+xs104%3, yp104+fb*2+ft, xs104%3, ft
CALL Table.C133.Position xp104+fl*3+xs104*2%3, yp104+fb*2+ft, xs104%3-fl*4, ft+fb
CALL Table.C139.Position xp104+fl, yp104+fb, xs104-fl-fr, ft
xp103 = fl+xs104
yp103 = yp104
xs103 = xs-xs104-fl-fr
ys103 = ys104
xs111 = (xs103-fl*2)%5
xs121 = (xs103-fl)%3
CALL Table.C103.Position xp103, yp103, xs103, ys103
CALL Table.C110.Position xp103+fl-2, yp103+ys103-ft-3, xs103-fl , ft+2
DO i = 1 TO 5
INTERPRET 'CALL Table.C11'||i||'.Position xp103+fl+xs111*(i-1), yp103+ys103-ft-2, xs111, ft'
END
CALL Table.C116.Position xp103+fl, yp103+fb*4+ft*2, xs103-fl-fr, ys103-fb*5-ft*3
DO i = 7 TO 9
INTERPRET 'CALL Table.C11'||i||'.Position xp103+fl+xs121*(i-7), yp103+fb*2+ft+2, xs121-fr, ft+fb'
END
DO i = 1 TO 3
INTERPRET 'CALL Table.C12'||i||'.Position xp103+fl+xs121*(i-1), yp103+fb, xs121-fr, ft+fb'
END
CALL Table.C199.Position fl, fb, xs-fl-fr, ft
RETURN
LoadCfg:
/* Configuration */
ishelp = 0
xs = 500
ys = ft*13+fb*9
ys1 = ft
valbin = '01'
valoct = '01234567'
valdec = '0123456789'
valhex = '0123456789ABCDEFabcdef'
propFont = "9.WarpSans"
CALL Table.Font propFont
inifile = 'TABLE.INI'
monoFont = SysIni(inifile,'Settings','FixedFont')
IF monoFont = 'ERROR:' THEN DO
monoFont = "10.System VIO"
END
mypos = SysIni(inifile,'Settings','Position')
IF WORDS(mypos) <> 2 THEN DO
mypos = (cx-xs)%2||' '||(cy-ys)%2
END
PARSE VALUE mypos WITH xp yp
showchars = LEFT(SysIni(inifile,'Settings','ShowChars'),1)
IF POS(showchars,'12') = 0 THEN DO
showchars = 1
END
selchars = SysIni(inifile,'Settings','SelectedChars')
IF selchars = 'ERROR:' THEN DO
selchars = ''
END
CALL Table.C139.Text selchars
CALL Table.C102.Font monoFont
CALL Table.C104.Font monoFont
CALL Table.C116.Font monoFont
RETURN
ConvertASC:
/* Convert ASCII */
asc2conv = Table.C116.Text()
chars2conv = LENGTH(asc2conv)
DO i = 1 TO chars2conv
achar = SUBSTR(asc2conv,i,1)
hchar = RIGHT(C2X(achar),2,'0')
bchar = RIGHT(X2B(hchar),8,'0')
dchar = RIGHT(X2D(hchar),3,'0')
ochar = RIGHT(B2O(bchar),3,'0')
CALL Strings
END
asc2conv = ''
RETURN
ConvertHEX:
/* Convert HEXADECIMAL */
errtype = 'HEX'
hex2conv = Table.C116.Text()
chars2conv = WORDS(hex2conv)
DO i = 1 TO chars2conv
hchar = WORD(hex2conv,i)
IF LENGTH(hchar) > 2 THEN DO
CALL IsErr errtype hchar
LEAVE
END
hchar = RIGHT(hchar,2,'0')
myerr = VERIFY(hchar,valhex)
SELECT
WHEN myerr = 0 THEN DO
bchar = RIGHT(X2B(hchar),8,'0')
dchar = RIGHT(X2D(hchar),3,'0')
ochar = RIGHT(B2O(bchar),3,'0')
achar = X2C(hchar)
CALL Strings
END
OTHERWISE DO
CALL IsErr errtype hchar
LEAVE
END
END
END
hex2conv = ''
RETURN
ConvertDEC:
/* Convert DECIMAL */
errtype = 'DEC'
dec2conv = Table.C116.Text()
chars2conv = WORDS(dec2conv)
DO i = 1 TO chars2conv
dchar = WORD(dec2conv,i)
IF LENGTH(dchar) > 3 THEN DO
CALL IsErr errtype dchar
LEAVE
END
dchar = RIGHT(dchar,3,'0')
myerr = VERIFY(dchar,valdec)
SELECT
WHEN myerr = 0 THEN DO
hchar = D2X(dchar,2)
bchar = RIGHT(X2B(hchar),8,'0')
ochar = RIGHT(B2O(bchar),3,'0')
achar = X2C(hchar)
CALL Strings
END
OTHERWISE DO
CALL IsErr errtype dchar
LEAVE
END
END
IF dchar > 255 THEN DO
CALL IsErr errtype dchar
LEAVE
END
END
dec2conv = ''
RETURN
ConvertBIN:
/* Convert BINARY */
errtype = 'BIN'
bin2conv = Table.C116.Text()
chars2conv = WORDS(bin2conv)
DO i = 1 TO chars2conv
bchar = WORD(bin2conv,i)
IF LENGTH(bchar) > 8 THEN DO
CALL IsErr errtype bchar
LEAVE
END
bchar = RIGHT(bchar,8,'0')
myerr = VERIFY(bchar,valbin)
SELECT
WHEN myerr = 0 THEN DO
hchar = RIGHT(B2X(bchar),2,'0')
dchar = RIGHT(X2D(hchar),3,'0')
ochar = RIGHT(B2X(bchar),3,'0')
achar = X2C(hchar)
CALL Strings
END
OTHERWISE DO
CALL IsErr errtype bchar
LEAVE
END
END
END
bin2conv = ''
RETURN
/*-----------------------------------------------------------------------------+
| |
| Default initialization: |
| |
+-----------------------------------------------------------------------------*/
INIT:
SIGNAL RETURN
/*-----------------------------------------------------------------------------+
| |
| Default error handlers: |
| |
+-----------------------------------------------------------------------------*/
SYNTAX:
SAY 'SYNTAX ERROR:' errortext( rc ) 'in:'
SAY sourceline( sigl )
SIGNAL ON SYNTAX
SIGNAL RETURN
HALT:
SAY 'HALT occurred in:'
SAY sourceline( sigl )
SIGNAL ON HALT
SIGNAL RETURN