home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
High Voltage Shareware
/
high1.zip
/
high1
/
DIR3
/
LANG20.ZIP
/
FORM1.FRM
< prev
next >
Wrap
Text File
|
1993-11-08
|
10KB
|
487 lines
Version 1.00
BEGIN Form Form1
AutoRedraw = 0
BackColor = QBColor(7)
BorderStyle = 1
Caption = "Language 2.00"
ControlBox = 0
Enabled = -1
ForeColor = QBColor(0)
Height = Char(25)
Left = Char(0)
MaxButton = 0
MinButton = 0
MousePointer = 0
Tag = ""
Top = Char(0)
Visible = -1
Width = Char(80)
WindowState = 0
BEGIN Label Lbl
Alignment = 0
AutoSize = 0
BackColor = QBColor(7)
BorderStyle = 0
Caption = "0 Kb."
DragMode = 0
Enabled = -1
ForeColor = QBColor(0)
Height = Char(1)
Index = 1
Left = Char(63)
MousePointer = 0
TabIndex = 4
Tag = ""
Top = Char(1)
Visible = -1
Width = Char(10)
END
BEGIN Label Lbl
Alignment = 0
AutoSize = 0
BackColor = QBColor(7)
BorderStyle = 0
Caption = ""
DragMode = 0
Enabled = -1
ForeColor = QBColor(0)
Height = Char(1)
Index = 2
Left = Char(15)
MousePointer = 0
TabIndex = 5
Tag = ""
Top = Char(3)
Visible = -1
Width = Char(60)
END
BEGIN Label Lbl
Alignment = 0
AutoSize = 0
BackColor = QBColor(7)
BorderStyle = 0
Caption = "File Size:"
DragMode = 0
Enabled = -1
ForeColor = QBColor(0)
Height = Char(1)
Index = 0
Left = Char(52)
MousePointer = 0
TabIndex = 3
Tag = ""
Top = Char(1)
Visible = -1
Width = Char(10)
END
BEGIN TextBox Txt
BackColor = QBColor(7)
BorderStyle = 1
DragMode = 0
Enabled = -1
ForeColor = QBColor(0)
Height = Char(3)
Index = 1
Left = Char(2)
MousePointer = 0
MultiLine = 0
ScrollBars = 0
TabIndex = 2
TabStop = 0
Tag = ""
Text = ""
Top = Char(4)
Visible = -1
Width = Char(12)
END
BEGIN TextBox Txt
BackColor = QBColor(7)
BorderStyle = 1
DragMode = 0
Enabled = -1
ForeColor = QBColor(0)
Height = Char(3)
Index = 0
Left = Char(15)
MousePointer = 0
MultiLine = 0
ScrollBars = 0
TabIndex = 1
TabStop = -1
Tag = ""
Text = ""
Top = Char(4)
Visible = -1
Width = Char(60)
END
BEGIN ListBox Lst
BackColor = QBColor(7)
DragMode = 0
Enabled = -1
ForeColor = QBColor(0)
Height = Char(15)
Left = Char(2)
MousePointer = 0
Sorted = 0
TabIndex = 0
TabStop = -1
Tag = ""
Top = Char(7)
Visible = -1
Width = Char(73)
END
BEGIN Menu File
Caption = "&File"
Checked = 0
Enabled = -1
Separator = 0
Tag = ""
Visible = -1
BEGIN Menu OpenFile
Caption = "&Open File"
Checked = 0
Enabled = -1
Separator = 0
Tag = ""
Visible = -1
END
BEGIN Menu OptimizeFile
Caption = "&Crunch File"
Checked = 0
Enabled = -1
Separator = 0
Tag = ""
Visible = -1
END
BEGIN Menu s1
Caption = ""
Checked = 0
Enabled = -1
Separator = -1
Tag = ""
Visible = -1
END
BEGIN Menu Quit
Caption = "&Quit"
Checked = 0
Enabled = -1
Separator = 0
Tag = ""
Visible = -1
END
END
BEGIN Menu Statement
Caption = "&Statement"
Checked = 0
Enabled = -1
Separator = 0
Tag = ""
Visible = -1
BEGIN Menu AddStatement
Caption = "&Add"
Checked = 0
Enabled = -1
Separator = 0
Shortcut = {F1}
Tag = ""
Visible = -1
END
BEGIN Menu ChangeStatement
Caption = "&Change"
Checked = 0
Enabled = -1
Separator = 0
Shortcut = {F2}
Tag = ""
Visible = -1
END
BEGIN Menu InsertStatement
Caption = "&Insert"
Checked = 0
Enabled = -1
Separator = 0
Shortcut = {F3}
Tag = ""
Visible = -1
END
BEGIN Menu DeleteStatement
Caption = "&Delete"
Checked = 0
Enabled = -1
Separator = 0
Shortcut = {F4}
Tag = ""
Visible = -1
END
BEGIN Menu s2
Caption = ""
Checked = 0
Enabled = -1
Separator = -1
Tag = ""
Visible = -1
END
BEGIN Menu List2File
Caption = "&Write List to LANGOUT.TXT"
Checked = 0
Enabled = -1
Separator = 0
Tag = ""
Visible = -1
END
END
END
DEFINT A-Z
'$INCLUDE: 'lang.bi'
'$DYNAMIC
DECLARE FUNCTION Coded$ (h$)
DECLARE FUNCTION Readstr$ (index&, fil%)
DECLARE SUB Lst_Dblclick ()
DECLARE SUB AddStr (s$, index&, fil%, Beginstr&)
DECLARE SUB FileSave (FileName AS STRING, PathName AS STRING, DefaultExt AS STRING, DialogTitle AS STRING, ForeColor AS INTEGER, BackColor AS INTEGER, Flags AS INTEGER, Cancel AS INTEGER)
DECLARE SUB RebuildLst ()
REM $STATIC
SUB AddStatement_click ()
a$ = form1.Txt(0).Text
IF a$ = "" THEN
form1.Txt(0).SETFOCUS
EXIT SUB
ELSE
g& = 0
AddStr RTRIM$(a$), g&, (f%), 0
RebuildLst
form1.Txt(0).Text = ""
form1.Txt(1).Text = ""
ON LOCAL ERROR RESUME NEXT
form1.Lst.Listindex = g& - 1
ON LOCAL ERROR GOTO 0
form1.Lst.SETFOCUS
END IF
END SUB
SUB ChangeStatement_click ()
a$ = form1.Txt(0).Text
IF a$ = "" THEN
Lst_Dblclick
EXIT SUB
ELSE
g& = VAL(form1.Txt(1).Text)
AddStr RTRIM$(a$), g&, (f%), 0
RebuildLst
form1.Txt(0).Text = ""
form1.Txt(1).Text = ""
ON LOCAL ERROR RESUME NEXT
form1.Lst.Listindex = g& - 1
ON LOCAL ERROR GOTO 0
form1.Lst.SETFOCUS
END IF
END SUB
SUB DeleteStatement_Click ()
a$ = form1.Lst.List(form1.Lst.Listindex)
a& = VAL(LTRIM$(a$))
a$ = MID$(a$, 10)
GET f%, 401, numstr&
FOR i& = a& TO numstr& - 1
AddStr Readstr$(i& + 1, (f%)), i&, (f%), 0
NEXT i&
AddStr "", numstr&, (f%), 0
numstr& = numstr& - 1
PUT f%, 401, numstr&
RebuildLst
form1.Lst.SETFOCUS
END SUB
SUB Form_Load ()
RebuildLst
form1.Lst.Listindex = 0
END SUB
SUB InsertStatement_Click ()
a$ = form1.Lst.List(form1.Lst.Listindex)
a& = VAL(LTRIM$(a$))
a$ = MID$(a$, 10)
GET f%, 401, numstr&
AddStr Readstr$(numstr&, (f%)), 0, (f%), 0
FOR i& = numstr& TO a& STEP -1
AddStr Readstr$(i& - 1, (f%)), i&, (f%), 0
NEXT i&
AddStr "", a&, (f%), 0
RebuildLst
form1.Txt(0).Text = ""
form1.Txt(1).Text = STR$(a&)
form1.Txt(0).SETFOCUS
END SUB
SUB List2File_Click ()
b$ = "LANGOUT.TXT"
t = FREEFILE
OPEN b$ FOR OUTPUT AS #t
GET f%, 401, numstr&
FOR i& = 1 TO numstr&
a$ = Readstr$(i&, (f%))
IF a$ <> "" THEN
a$ = STR$(i&) + " " + a$
a$ = LEFT$(a$, 78)
PRINT #t, a$
END IF
NEXT
CLOSE #t
END SUB
SUB Lst_Dblclick ()
a$ = form1.Lst.List(form1.Lst.Listindex)
a2$ = LTRIM$(a$)
a1$ = LEFT$(a2$, INSTR(a2$, " "))
a& = VAL(LTRIM$(a1$))
a$ = RTRIM$(MID$(a$, 6))
form1.Txt(0).Text = a$
form1.Txt(1).Text = STR$(a&)
form1.Txt(0).SETFOCUS
END SUB
SUB Lst_KeyPress (KeyAscii AS INTEGER)
IF KeyAscii = 13 THEN
Lst_Dblclick
END IF
END SUB
SUB OpenFile_Click ()
FileSave FilNam$, Pad$, "*.LNO", "FileName", 0, 7, 0, Cancel
IF Cancel <> 0 THEN EXIT SUB
Lang_Bestand$ = Pad$ + "\" + FilNam$
CLOSE f%
f% = FREEFILE
OPEN Lang_Bestand$ FOR BINARY AS f%
RebuildLst
END SUB
SUB OptimizeFile_Click ()
b$ = Lang_BestandLeft$ + ".LNG"
IF DIR$(b$) <> "" THEN
KILL b$
END IF
g% = FREEFILE
OPEN b$ FOR BINARY AS g%
' write first 5 lines at beginning of file
' these first lines won't be encrypted and can be used as a description
' and copyright-message of the file
FOR lns% = 1 TO 5
u$ = Readstr$((lns%), (f%))
u1$ = RTRIM$(u$)
IF LEN(u1$) < 80 THEN
u1$ = u1$ + SPACE$(80 - LEN(u1$))
END IF
u1$ = LEFT$(u1$, 78) + CHR$(13) + CHR$(10)
posn& = (1 + ((lns% - 1) * 80))
PUT g%, posn&, u1$
NEXT
GET f%, 401, numstr&
FOR i& = 6 TO numstr& STEP 1
u$ = Readstr$((i&), (f%))
u1$ = LTRIM$(RTRIM$(u$))
' ┼┼┼
' here you can encrypt u1$
' don't forget to de-encrypt it in PROGRAM.BAS:Message$
AddStr u1$, 0, (g%), ((numstr& * 4) + 420)
form1.Lbl(1).Caption = FORMAT$((LOF(g%) / 1024), "#####.0") + " Kb."
NEXT
CLOSE g%
f% = FREEFILE
OPEN Lang_Bestand$ FOR BINARY AS f%
END SUB
SUB Quit_Click ()
CLOSE
screen.HIDE
END
END SUB
SUB RebuildLst ()
FOR i = 1 TO form1.Lst.Listcount
form1.Lst.REMOVEITEM 0
NEXT
GET f%, 401, numstr&
IF numstr& = 0 THEN
AddStr "---", 0, (f%), 0
numstr& = numstr& + 1
END IF
FOR i& = 1 TO numstr&
a$ = Readstr$(i&, (f%))
IF a$ <> "" THEN
b$ = STR$(i&)
b$ = b$ + SPACE$(5 - LEN(b$))
form1.Lst.ADDITEM b$ + a$
END IF
NEXT
form1.Lbl(1).Caption = FORMAT$((LOF(f%) / 1024), "#####.0") + " Kb."
form1.Lbl(2).Caption = Lang_Bestand$
END SUB