VERSION 5.00
Begin VB.Form Form1
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
ClientHeight = 6000
ClientLeft = 1590
ClientTop = 450
ClientWidth = 6720
FillColor = &H000000FF&
ForeColor = &H00FFFFFF&
Icon = "lexicon.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
PaletteMode = 1 'UseZOrder
ScaleHeight = 400
ScaleMode = 3 'Pixel
ScaleWidth = 448
Begin VB.ListBox Sw
Enabled = 0 'False
Height = 255
Left = 720
Sorted = -1 'True
TabIndex = 16
Top = 5160
Visible = 0 'False
Width = 615
End
Begin VB.Timer PopGap
Enabled = 0 'False
Left = 1920
Top = 5160
End
Begin VB.TextBox Abc
BorderStyle = 0 'None
Enabled = 0 'False
Height = 375
Index = 2
Left = 5160
TabIndex = 15
TabStop = 0 'False
Text = "Text1"
Top = 5280
Visible = 0 'False
Width = 1455
End
Begin VB.ListBox UniListBox
BackColor = &H00FF8080&
Enabled = 0 'False
Height = 840
Index = 2
Left = 5520
TabIndex = 14
TabStop = 0 'False
Top = 3240
Visible = 0 'False
Width = 1215
End
Begin VB.TextBox Enscribe
Enabled = 0 'False
Height = 375
Left = 6000
TabIndex = 13
TabStop = 0 'False
Text = "Text1"
Top = 720
Visible = 0 'False
Width = 495
End
Begin VB.Timer Id
Enabled = 0 'False
Left = 360
Top = 4200
End
Begin VB.Timer Timer5
Enabled = 0 'False
Left = 3120
Top = 720
End
Begin VB.PictureBox AdjustSize
AutoRedraw = -1 'True
BorderStyle = 0 'None
Enabled = 0 'False
Height = 375
Index = 2
Left = 5160
ScaleHeight = 25
ScaleMode = 3 'Pixel
ScaleWidth = 81
TabIndex = 12
TabStop = 0 'False
Top = 5520
Visible = 0 'False
Width = 1215
End
Begin VB.PictureBox AdjustSize
AutoRedraw = -1 'True
BorderStyle = 0 'None
Enabled = 0 'False
Height = 375
Index = 1
Left = 3600
ScaleHeight = 25
ScaleMode = 3 'Pixel
ScaleWidth = 89
TabIndex = 11
TabStop = 0 'False
Top = 5520
Visible = 0 'False
Width = 1335
End
Begin VB.Timer Timer4
Enabled = 0 'False
Left = 4080
Top = 4440
End
Begin VB.TextBox Abc
BorderStyle = 0 'None
Enabled = 0 'False
Height = 375
Index = 1
Left = 5040
TabIndex = 10
TabStop = 0 'False
Text = "Text1"
Top = 4920
Visible = 0 'False
Width = 1455
End
Begin VB.ListBox UniListBox
Enabled = 0 'False
Height = 840
Index = 1
Left = 4320
TabIndex = 9
TabStop = 0 'False
Top = 3240
Visible = 0 'False
Width = 1215
End
Begin VB.PictureBox Cover
BorderStyle = 0 'None
Enabled = 0 'False
FontTransparent = 0 'False
ForeColor = &H000000C0&
Height = 255
Left = 1680
ScaleHeight = 17
ScaleMode = 3 'Pixel
ScaleWidth = 73
TabIndex = 8
TabStop = 0 'False
Top = 5160
Visible = 0 'False
Width = 1095
End
Begin VB.TextBox SaveAs
Enabled = 0 'False
ForeColor = &H00FFFFFF&
Height = 375
Left = 3840
TabIndex = 7
TabStop = 0 'False
Text = "Text1"
Top = 600
Visible = 0 'False
Width = 2055
End
Begin VB.FileListBox File1
Archive = 0 'False
Enabled = 0 'False
Height = 285
Left = 3840
TabIndex = 6
TabStop = 0 'False
Top = 120
Visible = 0 'False
Width = 2055
End
Begin VB.Timer Timer3
Enabled = 0 'False
Left = 1920
Top = 480
End
Begin VB.Timer Timer2
Enabled = 0 'False
Left = 1200
Top = 480
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 1
Left = 480
Top = 480
End
Begin VB.PictureBox Pic
AutoRedraw = -1 'True
BorderStyle = 0 'None
FontTransparent = 0 'False
Height = 2175
Index = 1
Left = 3480
ScaleHeight = 145
ScaleMode = 3 'Pixel
ScaleWidth = 169
TabIndex = 1
TabStop = 0 'False
Top = 1080
Width = 2535
Begin VB.PictureBox Sbar
AutoRedraw = -1 'True
BackColor = &H0000C000&
BorderStyle = 0 'None
Height = 375
Index = 1
Left = 0
ScaleHeight = 25
ScaleMode = 3 'Pixel
ScaleWidth = 169
TabIndex = 3
TabStop = 0 'False
Top = 360
Width = 2535
Begin VB.TextBox Spell
BorderStyle = 0 'None
Height = 375
Index = 2
Left = 0
TabIndex = 5
TabStop = 0 'False
Text = "Text2"
Top = 0
Visible = 0 'False
Width = 2535
End
End
End
Begin VB.PictureBox Pic
AutoRedraw = -1 'True
BorderStyle = 0 'None
FontTransparent = 0 'False
Height = 2175
Index = 0
Left = 480
ScaleHeight = 145
ScaleMode = 3 'Pixel
ScaleWidth = 169
TabIndex = 0
TabStop = 0 'False
Top = 1080
Width = 2535
Begin VB.PictureBox Sbar
AutoRedraw = -1 'True
BackColor = &H000000C0&
BorderStyle = 0 'None
Height = 375
Index = 0
Left = 0
ScaleHeight = 25
ScaleMode = 3 'Pixel
ScaleWidth = 169
TabIndex = 2
TabStop = 0 'False
Top = 360
Width = 2535
Begin VB.TextBox Spell
BackColor = &H00008000&
BorderStyle = 0 'None
ForeColor = &H00FFFFFF&
Height = 375
Index = 1
Left = 0
TabIndex = 4
TabStop = 0 'False
Text = "Text1"
Top = 0
Visible = 0 'False
Width = 2535
End
End
Begin VB.Line Line1
Visible = 0 'False
X1 = 48
X2 = 168
Y1 = 120
Y2 = 80
End
End
Begin VB.Line Line2
Visible = 0 'False
X1 = 112
X2 = 304
Y1 = 288
Y2 = 240
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public interval, normal, gnormal, size, PLsize, p, i, i1, I2, i3 As Integer
Public c, all, exist, total, check As Integer ', realkiLed
Public countmin, countpls, ratiNg, bEst As Integer
Public column, assi, ent As Integer
Dim table(21, 2) As Integer
Dim shadtrc() As Integer
Public stc, stci As Integer
Dim wtable(21, 2) As String
Dim slimstream() As Integer 'TRACE SLIMING STREAMS POSITIONS
Dim gslim() As Integer
Dim cursor(2) As Integer
Dim word() As String
Dim lab() As Integer
Dim ass() As Integer
Dim slimexist(2) As Integer
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CYCAPTION = 4
Private Const SM_CYBORDER = 6
Private Const SM_CYFIXEDFRAME = 8
Private Const SM_CXBORDER = 5
Private Const SM_CXFIXEDFRAME = 7
Public AddHeight As Integer
Public AddWidth As Integer
Public firmcursor As Integer
Public tw, fh As Integer 'TeXT WiDTH, FoNT' FiELD HeIGHT
Public xsize, ysize, xpos, ypos, pictop As Single
Public ist, repair, exhinf As String
Public BaseName As String
Public chs As Integer
Public idmyname, iddy As Integer
Public myname As String
Public picvar, stirpic, stirsbar As Integer
Public firmup, firmdn As Integer 'FOR MOUSE ORIENTATION
Public tmp, tmp1, tim As Integer
Public tmps As String
Public ssize As Integer
Dim stable(21, 2) As Integer
Dim swtable(21, 2) As String
Dim scursor(2) As Integer
Public reg, sreg, prereg, schs, scolumn, dpage, dpos As Integer
Public pain As Long
Public alph As Integer
Public st, st1 As Integer
Public changed, valid As Boolean
Public bicursor As Integer
Public predp, prebi As Integer
Public Ystate, scroll As Integer
Public mousechoice As Boolean
Public eRASemode As Integer
Public filechoosen As String
Public fc As Integer
Public GivenFont As String ', ChoosenFont
Dim ChoosenFont(2), FSize(2), FTmp(2) As Integer
Public ActFDial, ActFDStr, FScrollBar As Integer 'FSize, Ftmp,
Public CenterX As Integer
Public Guide, MouseInfo As Boolean
Dim GuideContent(10) As String
Public Gcount As Integer
Public ypre As Single
Dim Pal(115) As Long
Dim tongfile() As String
Public tongcount, tongnumber, tongpos As Integer
Dim tong() As Variant
Public descRp As String
'Public ReVerS As Integer
Public PopS As String
Public Sub Form_Load()
'MsgBox GetSystemMetrics(SM_CXFIXEDFRAME)
AddHeight = GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYBORDER) + GetSystemMetrics(SM_CYFIXEDFRAME)
AddWidth = GetSystemMetrics(SM_CXBORDER) + GetSystemMetrics(SM_CXFIXEDFRAME) * 2
'ChoosenFont = "Courier New Cyr"
GivenFont = "Courier New Cyr"
'interval = 40 'BETWEEN MESSAGE STRING/STATUS BAR
'FSize = 12
'descRp = "Original"
p = Val(Mid$(Time$, 1, 2) + Mid$(Time$, 4, 2) + Mid$(Time$, 7, 2))
Randomize (p)
'INITIALIZE
Open "data\files\lexicon.cfg" For Input As #1
Input #1, xpos
Input #1, ypos
Input #1, BaseName
Input #1, idmyname
Input #1, PLsize
Input #1, tmp
If tmp = 1 Then Guide = True
Input #1, ypre
Input #1, tongnumber
tongcount = 0
While Not EOF(1)
tongcount = tongcount + 1
ReDim Preserve tongfile(tongcount)
Input #1, tongfile(tongcount)
Wend
Close
ReDim tong(200, tongcount)
For i = 1 To tongcount
Open "data\files\" + tongfile(i) For Input As 1
tmp = 0
While Not EOF(1)
Line Input #1, tmps
If Mid(tmps, 1, 4) <> "Rem:" Then
tmp = tmp + 1
tong(tmp, i) = tmps
End If
Wend
Close
Next
Form1.BackColor = &HFF8080
xsize = 9000
pictop = 60
normal = 15 'DEFAULT SIZE OF LIST
gnormal = 15
'PLsize = 15
fh = 17 'INTERVAL BETWEEN STRINGS
ActFDial = 1
ActFDStr = 1
'MsgBox GetSystemMetrics(SM_CYCAPTION)
ysize = (pictop + fh * normal + pictop + AddHeight) * Screen.TwipsPerPixelY '5947 '6300
'ysize = (pictop + fh * normal + pictop + 21) * Screen.TwipsPerPixelY '5947 '6300
If xpos + xsize > Screen.Width Or ypos + ysize > Screen.Height Or xpos < 0 Or ypos < 0 Then
Form1.Left = (Screen.Width - xsize) / 2
Form1.Top = (Screen.Height - ysize) / 2
Else
Form1.Left = xpos
Form1.Top = ypos
End If
Form1.Width = xsize
Form1.Height = ysize
'AddHeight = (Form1.Height - Form1.ScaleHeight) - (Form1.Width - Form1.ScaleWidth) / 2 '(Form.height-Form.ScaleHeight) - (Form.Width-Form.ScaleWidth) / 2
'Form1.Icon = LoadPicture("data\files\lexicon.vis")
File1.Path = "data\files"
Open "data\files\lexicon.col" For Input As 1
Input #1, tmps
For i = 0 To 44
Input #1, Pal(i)
Next
Input #1, tmps
For i = 0 To 25
Input #1, Pal(i + 45)
Next
Input #1, tmps
For i = 0 To 44
Input #1, Pal(i + 71)
Next
Close
For i1 = 1 To 2
For i = 0 To 25
AdjustSize(i1).Line (0, i)-(70, i), Pal(i + 45)
Next
Next
For i = 1 To 2
AdjustSize(i).Font = tong(1, tongnumber) 'GivenFont
AdjustSize(i).FontSize = tong(2, tongnumber) 'FSize73
AdjustSize(i).ForeColor = tong(3, tongnumber) '&H40C0&3
AdjustSize(i).FontBold = tong(4, tongnumber) 'False 'Mark
AdjustSize(i).FontItalic = tong(5, tongnumber) 'False
AdjustSize(i).FontStrikethru = tong(6, tongnumber) 'False
AdjustSize(i).FontUnderline = tong(7, tongnumber) 'False78
AdjustSize(i).Height = 25
AdjustSize(i).Width = 70
AdjustSize(i).Top = pictop + (gnormal - 1) * fh
AdjustSize(i).Left = 10 + (i - 1) * (600 - 2 * 10 - 70) '150 + (i - 1) * 220
AdjustSize(i).CurrentX = 20
AdjustSize(i).CurrentY = 4
If i = 1 Then AdjustSize(i).Print "<->" Else AdjustSize(i).Print "<+>"
Next
LoadBase
Sign
Information
If Guide = False Then BottomStatus Else GuideTru
PlayList
ListOut
KeyPreview = True
End Sub
Public Sub LoadBase()
' size = normal 'SIZE OF LIST
bicursor = 1
For i = 1 To 2
ChoosenFont(i) = tong(1, tongnumber)
FSize(i) = 12
Next
column = 1
chs = 0
c = 0
exist = 0
total = 0
ratiNg = 0
changed = False
Line1.Visible = False
Line2.Visible = False
'DETECT ENTRIES NUMBER
Open "data\files\" + BaseName + ".lex" For Input As #1
While Not EOF(1)
Line Input #1, ist
c = c + 1
Wend
Close
check = 0
If c / 2 <> Int(c / 2) Then
msg = tong(86, tongnumber) '" - нечётное количество записей, проверьте, пожалуйста, последние"'"В базе - "
Style = vbOKCancel + vbCritical + vbDefaultButton2 ' Define buttons.
Title = tong(87, tongnumber) + BaseName + tong(88, tongnumber) '"Ошибка"
response = MsgBox(msg, Style, Title)
Timer2.interval = 500
Timer2.Enabled = True
check = 1
End If
If check = 0 Or response = vbOK Then
all = Int(c / 2)
'real = all
'FILL DIMENSION
' If check = 1 Then all = all + 1
ReDim word(2, all) As String
ReDim gslim(2, all)
ReDim slimstream(21, 2)
ReDim shadtrc(21, 2)
ReDim lab(all) As Integer
ReDim ass(all) As Integer
Open "data\files\" + BaseName + ".cfg" For Input As #1
Input #1, alph
Input #1, dpos
Input #1, bicursor
Input #1, ChoosenFont(1)
Input #1, ChoosenFont(2)
Input #1, FSize(1)
Input #1, FSize(2)
Input #1, bEst
Input #1, descRp
' Input #1, ReVerS
Input #1, ActFDStr
Close
Open "data\files\" + BaseName + ".lex" For Input As #1
For i = 1 To all
' If ReVerS = 0 Then
For i1 = 1 To 2
Line Input #1, word(i1, i)
Next
' Else
' For i1 = 2 To 1 Step -1
' Line Input #1, word(i1, i)
' Next
' End If
Next
If check = 1 Then
all = all + 1
' If ReVerS = 0 Then
Line Input #1, word(1, all)
word(2, all) = tong(89, tongnumber)
' Else
' Line Input #1, word(2, all)
' word(1, all) = tong(89, tongnumber)
' End If
End If
Close
' If ReVerS = -1 Then
' tmps = ChoosenFont(1)
' ChoosenFont(1) = ChoosenFont(2)
' ChoosenFont(2) = tmps
' tmp = FSize(1)
' FSize(1) = FSize(2)
' FSize(2) = tmp
' End If
' i1 = 0
' For i = 0 To c - 1
' i1 = i1 + 1
' If i1 > 2 Then i1 = 1
' Line Input #1, word$(i1, 1 + Int(i / 2))
' Next
' Close
' If check = 1 Then word$(2, 1 + Int(i / 2)) = tong(89, tongnumber)
i1 = 0
Open "data\files\" + BaseName + ".sts" For Input As #1
While Not EOF(1) And i1 < all
Input #1, i
i1 = i1 + 1
lab(i1) = i
Wend
Close
For i1 = 1 To all
If lab(i1) = 0 Then exist = exist + 1: total = total + 1
Next
Else
BaseName = "UnTitled"
End If
End Sub
'Public Sub form_activate()
'Activation
'trans(1).Visible = False
'trans(1).Enabled = True
'trans(1).Picture = Image
'Form1.Cls
'trans(1).Visible = True
'trans(1).Enabled = True
'trans(1).Top = 0
'trans(1).Left = 0
'While 0 = 0
'Wend
'End Sub
'Public Sub Activation() 'Loads what cannot be load during form loading
' For i1 = 1 To 2
'' For i = 0 To 25
' adjustsize(i1).Line (0, i)-(70, i), Pal(i + 45)
' Next
' Next
' For i = 1 To 2
' adjustsize(i).Font = tong(1, tongnumber) 'GivenFont
' adjustsize(i).FontSize = tong(2, tongnumber) 'FSize73
'' adjustsize(i).ForeColor = tong(3, tongnumber) '&H40C0&3
' adjustsize(i).FontBold = tong(4, tongnumber) 'False 'Mark
' adjustsize(i).FontItalic = tong(5, tongnumber) 'False
' adjustsize(i).FontStrikethru = tong(6, tongnumber) 'False
' adjustsize(i).FontUnderline = tong(7, tongnumber) 'False78
' adjustsize(i).Height = 25
' adjustsize(i).Width = 70
' adjustsize(i).Top = pictop + (gnormal - 1) * fh
' adjustsize(i).Left = 150 + (i - 1) * 220
' adjustsize(i).CurrentX = 20
' adjustsize(i).CurrentY = 4
' If i = 1 Then adjustsize(i).Print "<->" Else adjustsize(i).Print "<+>"
' Next
'
' 'Information
'
' If Guide = False Then BottomStatus Else GuideTru
'
'End Sub
Public Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If Timer2.Enabled = False Then
If reg = 0 Then
If KeyCode = vbKeyR And Shift = 2 Then
' MsgBox 1
Form_New
' tmp = exist
' total = 0
' ratiNg = 0
' For i = 1 To all
' If lab(i) = 13 Then
' lab(i) = 0
' exist = exist + 1
' End If
' If lab(i) = 21 Then lab(i) = 8
' If lab(i) = 679 Then lab(i) = 666
' If lab(i) = 0 Then total = total + 1
' Next
' If tmp = 0 Then PlayList
' Information
' ListOut
End If
If exist > 0 Then
If KeyCode = vbKeyDelete Then
ToggleOff
End If
End If
ElseIf reg = 1 Then
If KeyCode = vbKeyEscape Then Overturn
' If KeyCode = vbKeyDelete Then
' Delete
' End If
If KeyCode = vbKeyA And Shift = 2 Then
If alph = 1 Then alph = 0 Else alph = 1
If alph = 1 Then Order Else Disord
GlobOut
End If
If KeyCode = vbKeyReturn Then Spelling
ElseIf reg = 2 Then
If KeyCode = vbKeyEscape Then Spelleave
If KeyCode = vbKeyReturn Then Spellconf
ElseIf reg = 3 Then
If KeyCode = vbKeyEscape Then LoadLexLeave
If KeyCode = vbKeyReturn Then LoadLexCfirm
ElseIf reg = 4 Then
If KeyCode = vbKeyEscape Then SaveLexLeave
If KeyCode = vbKeyReturn Then SaveLexCfirm
ElseIf reg = 5 Then
If KeyCode = vbKeyEscape Then FontSetLeave
If KeyCode = vbKeyReturn Then FontSetCfirm
End If
End If
If reg >= 0 And reg <= 1 And KeyCode = vbKeySpace Then ReVerPer
If KeyCode = vbKeyL And Shift = 2 And reg <> 3 Then
If reg = 4 Then
SaveLexLeave
ElseIf reg = 5 Then
FontSetLeave
End If
total = 0
countpls = 0
countmin = 0
ratiNg = 0
LoadLex
End If
If KeyCode = vbKeyS And Shift = 2 And reg <> 4 Then
If reg = 3 Then
LoadLexLeave
ElseIf reg = 5 Then
FontSetLeave
End If
SaveLex
End If
If KeyCode = vbKeyF And Shift = 2 And reg <> 5 Then
If reg = 3 Then
LoadLexLeave
ElseIf reg = 4 Then
SaveLexLeave
End If
FontChoose
End If
If KeyCode = vbKeyS And Shift = 4 And reg < 3 Then QuickSave
If KeyCode = vbKeyF1 Then
Guide = Not Guide
If Guide = True Then
GuideTru
Else
BottomStatus
End If
End If
If KeyCode = vbKeyL And Shift = 4 Then
tongnumber = tongnumber + 1
If tongnumber > tongcount Then tongnumber = 1
If reg = 1 Or reg = 2 Then
word(1, all + 1) = tong(70, tongnumber)
word(2, all + 1) = tong(70, tongnumber)
If dpos > all - gnormal Then GlobOut
End If
Sign
Information
If Guide = False Then BottomStatus Else GuideTru
' Activation
Beep
End If
If KeyCode = vbKeyN And Shift = 2 Then
If reg = 2 Then
Spelleave
ElseIf reg = 3 Then
LoadLexLeave
ElseIf reg = 4 Then
SaveLexLeave
ElseIf reg = 5 Then
FontSetLeave
End If
BaseName = "UnTitled"
descRp = "UndeScribed"
ReDim lab(0)
ReDim word(2, 0)
ReDim gslim(2, 0)
ReDim slimstream(21, 2)
ReDim shadtrc(21, 2)
ReDim ass(0)
size = normal 'SIZE OF LIST
dpos = 0
bicursor = 1
column = 1
chs = 0
all = 0
'real = all
'realkiLed = 0
exist = 0
total = 0
ratiNg = 0
bEst = 0
Line1.Visible = False
Line2.Visible = False
reg = 1
Recycle
Sign
GlobOut
changed = True
End If
If Shift = 4 Then
If KeyCode = vbKeyN Then
iddy = 1
Id.interval = 1000
Id.Enabled = True
End If
If KeyCode = vbKeyA And iddy = 1 Then
iddy = 2
End If
If KeyCode = vbKeyM And iddy = 2 Then
iddy = 3
End If
If KeyCode = vbKeyE And iddy = 3 Then
If idmyname = 0 Then idmyname = 1977 Else idmyname = 0
Sign
Beep
End If
End If
' If Shift = 2 And KeyCode = 78 Then
' If idmyname = 0 Then idmyname = 1977 Else idmyname = 0
' Sign
' Beep
' End If
End Sub
Public Sub id_timer()
iddy = 0
Id.Enabled = False
End Sub
Public Sub form_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyTab Then
If reg = 0 Then
stci = 0
reg = 1
StoreMainList
Recycle
GlobOut
ElseIf reg = 1 Then
Overturn
End If
End If
If reg = 0 Then
If KeyAscii = vbKeyEscape Then Unload Form1
If KeyAscii = vbKeyBack Then
If stc > stci Then
For i = 1 To 2
Pic(i - 1).CurrentX = 0
Pic(i - 1).CurrentY = (shadtrc(stc - stci, i) - 1) * fh
Pic(i - 1).ForeColor = &HE0E0E0
Pic(i - 1).Print wtable(shadtrc(stc - stci, i), i)
Next
stci = stci + 1
Else
Beep
End If
End If
If exist > 0 Then
If KeyAscii = vbKeyReturn Then Pickword
If KeyAscii = 45 Then 'MINUS
If size > 2 Then
size = size - 1
PLsize = size
PlayList
ListOut
End If
End If
If KeyAscii = 43 Then 'PLUS
If size < normal Then
size = size + 1
PLsize = size
PlayList
ListOut
End If
End If
Else
If KeyAscii = vbKeyReturn Then Form_New
End If
ElseIf reg = 1 Then
If KeyAscii = vbKeyBack Then
tmp = predp
tmp1 = prebi
predp = dpos
prebi = bicursor
dpos = tmp
bicursor = tmp1
GlobOut
ElseIf KeyAscii > 32 Then
PopGap.Enabled = False
PopS = PopS + Chr(KeyAscii)
Information
For i = 1 To assi
If StrComp(Left(word(1, ass(i)), Len(PopS)), PopS, 1) = 0 Then
If assi <= gnormal Then
bicursor = i
Else
dpos = i - 1
bicursor = 1
If dpos + gnormal > assi Then
bicursor = bicursor + dpos - (assi - gnormal)
dpos = assi - gnormal
End If
End If
GlobOut
Exit For
End If
Next
PopGap.interval = 500
PopGap.Enabled = True
End If
ElseIf reg = 5 Then
If KeyAscii = 43 Then 'herevbKeyAdd
FScrollBar = 2
ScrollFont
End If
If KeyAscii = 45 Then 'vbKeySubtract
FScrollBar = 1
ScrollFont
End If
End If
If reg > 1 Then 'Spell SaveAs Fields
If KeyAscii = vbKeyEscape Or KeyAscii = vbKeyReturn Or KeyAscii = vbKeyTab Or KeyAscii = 14 Or KeyAscii = 12 Or KeyAscii = 19 Or KeyAscii = 6 Then
KeyAscii = 0
End If
End If
End Sub
Public Sub popgap_timer()
PopS = ""
PopGap.Enabled = False
Information
End Sub
Public Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Timer3.Enabled = False 'scroll off
If reg = 0 Then
If KeyCode = vbKeyUp Or KeyCode = vbKeyDown Or KeyCode = vbKeyLeft Or KeyCode = vbKeyRight Then
FallDown
End If
End If
If reg = 0 And exist > 0 Then
If KeyCode = vbKeyUp Then
DeSel
check = 0
While check = 0
cursor(column) = cursor(column) - 1
If table(cursor(column), column) > 0 Then check = 1
If cursor(column) < 1 Then cursor(column) = size + 1
Wend
Sel
End If
If KeyCode = vbKeyDown Then Slim
If KeyCode = vbKeyRight Then
chs = 0
Shft
End If
If KeyCode = vbKeyLeft Then
chs = 0
Shft
End If
If KeyCode = vbKeyHome Then
firmcursor = 0
check = 0
While check = 0
firmcursor = firmcursor + 1
If table(firmcursor, column) > 0 Then check = 1
Wend
If cursor(column) > firmcursor Then
DeSel
cursor(column) = firmcursor
Sel
End If
End If
If KeyCode = vbKeyEnd Then
firmcursor = size + 1
check = 0
While check = 0
firmcursor = firmcursor - 1
If table(firmcursor, column) > 0 Then check = 1
Wend
If cursor(column) < firmcursor Then
DeSel
cursor(column) = firmcursor
Sel
End If
End If
ElseIf reg = 1 Then
If KeyCode = vbKeyDelete And Shift = 0 Then
mousechoice = False
eRASemode = 0
doublePick
End If
If KeyCode = vbKeyDelete And Shift = 1 Then
mousechoice = False
eRASemode = 1
doublePick
End If
If KeyCode = vbKeyDelete And Shift = 2 Then
mousechoice = False
eRASemode = 2
doublePick
End If
If KeyCode = vbKeyUp Then
If bicursor > 1 Then
dDeSel
bicursor = bicursor - 1
dSel
ElseIf dpos > 0 Then
dpos = dpos - 1
GlobOut
Else
Beep
End If
End If
If KeyCode = vbKeyDown Then
If bicursor < size Then
dDeSel
bicursor = bicursor + 1
dSel
ElseIf dpos < assi - gnormal Then
dpos = dpos + 1
GlobOut
Else
Beep
End If
End If
If KeyCode = vbKeyHome And Shift = 2 Then CtrlHome
If KeyCode = vbKeyHome Then
dDeSel
bicursor = 1
dSel
End If
If KeyCode = vbKeyEnd And Shift = 2 Then CtrlEnd
If KeyCode = vbKeyEnd Then
dDeSel
bicursor = size
dSel
End If
If KeyCode = vbKeyPrior Then Prior
If KeyCode = vbKeyNext Then PgDown
End If
End Sub
Public Sub Slim()
DeSel
check = 0
While check = 0
cursor(column) = cursor(column) + 1
If table(cursor(column), column) > 0 Then check = 1
If cursor(column) > size Then cursor(column) = 0
Wend
Sel
End Sub
Public Sub DeSel()
Pic(column - 1).CurrentY = (cursor(column) - 1) * fh
If table(cursor(column), column) <> 0 Then
Pic(column - 1).ForeColor = &HE0E0E0
Pic(column - 1).CurrentX = -slimstream(cursor(column), column)
If Pic(column - 1).TextWidth(wtable(cursor(column), column)) > 280 Then
Pic(column - 1).Print wtable(cursor(column), column) + " | " + wtable(cursor(column), column)
Else
Pic(column - 1).Print wtable(cursor(column), column)
End If
Else
Pic(column - 1).CurrentX = 0
Pic(column - 1).ForeColor = Form1.BackColor
'i = 0
'While pic(column - 1).TextWidth(wtable(cursor(column), column)) > i
' tmps = tmps + " "
' i = pic(column - 1).TextWidth(tmps)
'Wend
Pic(column - 1).Print wtable(cursor(column), column) 'tmps'Space(Len(wtable(cursor(column), column)) * 1)
End If
End Sub
Public Sub Shft()
'DESELECT SELECTION BAR
Sbar(column - 1).Top = (cursor(column) - 1) * fh
tw = Sbar(column - 1).TextWidth(wtable(cursor(column), column))
If tw > 280 Then tw = 280
Sbar(column - 1).Width = tw
Sbar(column - 1).BackColor = &HC000&
Sbar(column - 1).Cls 'CLEAN CONTENT & RELOCATE INITIAL X,Y POSITIONS
Sbar(column - 1).Print wtable(cursor(column), column)
Chcol
'SELECT SELECTION BAR
Sbar(column - 1).BackColor = &HC0&
Sel
End Sub
Public Sub FallDown()
If stci > 0 Then
For i = stci To 1 Step -1
Pic(0).CurrentX = 0
Pic(0).CurrentY = (shadtrc(stc - i + 1, 1) - 1) * fh
Pic(0).ForeColor = Form1.BackColor
Pic(0).Print wtable(shadtrc(stc - i + 1, 1), 1)
Pic(1).CurrentX = 0
Pic(1).CurrentY = (shadtrc(stc - i + 1, 2) - 1) * fh
Pic(1).ForeColor = Form1.BackColor
Pic(1).Print wtable(shadtrc(stc - i + 1, 2), 2)
Next
stci = 0
End If
End Sub
Public Sub Sel()
If chs = 1 Then
Line1.Visible = True
Line1.X1 = Sbar(0).TextWidth(wtable(cursor(1), 1))
Line1.Y1 = (cursor(1) - 1) * fh + Int(fh / 2)
Line1.X2 = 300
Line1.Y2 = (cursor(2) - 1) * fh + Int(fh / 2)
Line2.Visible = True
Line2.X1 = Line1.X1 + 10
Line2.Y1 = Line1.Y1 + pictop
Line2.X2 = Line1.X2 + 10
Line2.Y2 = Line1.Y2 + pictop
Else
Line1.Visible = False
Line2.Visible = False
End If
Sbar(column - 1).Top = (cursor(column) - 1) * fh
Sbar(column - 1).Cls 'CLEAN CONTENT & RELOCATE INITIAL X,Y POSITIONS
Sbar(column - 1).CurrentX = -slimstream(cursor(column), column)
If Sbar(column - 1).TextWidth(wtable(cursor(column), column)) > 280 Then
Sbar(column - 1).Width = 280
Sbar(column - 1).Print wtable(cursor(column), column) + " | " + wtable(cursor(column), column)
Timer1.interval = 1
Timer1.Enabled = True
Else
Sbar(column - 1).Width = Sbar(column - 1).TextWidth(wtable(cursor(column), column))
Sbar(column - 1).Print wtable(cursor(column), column)
End If
End Sub
Public Sub Information()
If prereg <> reg Then
If Guide = True Then GuideTru
prereg = reg
End If
'INFORMATION7
For i = 0 To 44
Form1.Line (0, i)-(xsize, i), Pal(i)
Next
Form1.Font = tong(1, tongnumber) 'GivenFont
Form1.FontSize = tong(2, tongnumber) '12 'FSize
Form1.ForeColor = tong(3, tongnumber) '&H40C0&
Form1.FontBold = tong(4, tongnumber) 'True
Form1.FontItalic = tong(5, tongnumber) 'False
Form1.FontStrikethru = tong(6, tongnumber) 'False
Form1.FontUnderline = tong(7, tongnumber) 'False
If reg = 0 Then
'tmps = "Demo"
tmps = tong(8, tongnumber) + Str(exist) + " " + tong(9, tongnumber) + Str(total) + " " + tong(10, tongnumber) + Str(countpls) + " " + tong(11, tongnumber) + Str(countmin) + " " + tong(12, tongnumber) + Str(ratiNg)
ElseIf reg = 1 Then
If PopS = "" Then
tmps = tong(8, tongnumber) + Str(exist) + " " + tong(9, tongnumber) + Str(total) + " " + tong(13, tongnumber) + Str(all) '' - realkiLed
Else
tmps = PopS
End If
ElseIf reg = 2 Then
tmps = tong(8, tongnumber) + Str(exist) + " " + tong(9, tongnumber) + Str(total) + " " + tong(13, tongnumber) + Str(all) '' - realkiLed
ElseIf reg = 3 Then
tmps = tong(14, tongnumber) '"Загрузка"
ElseIf reg = 4 Then
tmps = tong(15, tongnumber) '"Сохранение"
ElseIf reg = 5 Then
tmps = tong(16, tongnumber) '"Шрифт"
End If
Centring
Form1.CurrentY = 21 - Int(Form1.TextHeight(tmps) / 2) '10
Form1.CurrentX = CenterX
Form1.Print tmps
End Sub
Public Sub PlayList()
'10: '<RE>GEN PLAYLIST
'assi = 0
'all = 0
'total = all ' - 1
'total = 0
'If assi = 0 Then ' Or all = 10
' msg = tong(82, tongnumber)
' Style = vbOKOnly + vbExclamation + vbDefaultButton1 ' Define buttons.
' Title = tong(83, tongnumber) '"Лексикон"
' Response = MsgBox(msg, Style, Title)
'Else
'CLEAN
Timer1.Enabled = False
chs = 0
Line1.Visible = False
Line2.Visible = False
stc = 0
stci = 0
If exist > 0 Then
assi = 0
For i = 1 To all
If lab(i) = 0 Then
assi = assi + 1
ass(assi) = i
End If
Next
size = PLsize
If size < 2 Then size = normal
If size > exist Then size = exist
For i = 1 To 20
For i1 = 1 To 2
table(i, i1) = 0
wtable(i, i1) = ""
slimstream(i, i1) = 0
Next
Next
'BEGIN FILL TABLE
For i = 1 To size
'GET FREE NUMBER IN BASE
check = 0
While check = 0
ent = Int(Rnd(p) * assi) + 1
check = 1
For i1 = 1 To size
If table(i1, 1) = ass(ent) Then check = 0
Next
Wend
table(i, 1) = ass(ent)
'DELETED
'GET FREE FIELD IN RIGHT COLUMN
' check = 0
' While check = 0
' ent = Int(Rnd(p) * size) + 1
' If table(ent, 2) = 0 Then check = 1
' Wend
'ASSIGN CONSEQUENSED LEFT FIELD TO RANDOM RIGHT
' table(ent, 2) = table(i, 1)
' wtable(i, 1) = word(1, table(i, 1))
' wtable(ent, 2) = word(2, table(ent, 2))
table(i, 2) = table(i, 1)
wtable(i, 1) = word(1, table(i, 1))
wtable(i, 2) = word(2, table(i, 2))
Next
For i1 = 1 To 2
Sw.Clear
For i = 0 To size
Sw.AddItem wtable(i, i1)
Sw.ItemData(Sw.NewIndex) = table(i, i1)
Next
For i = 1 To size
wtable(i, i1) = Sw.List(i)
table(i, i1) = Sw.ItemData(i)
Next
Next
' For i1 = 2 To size
' For i = 2 To size
' If StrComp(word(1, table(i - 1, 1)), word(1, table(i, 1)), 1) = 1 Then
' tmp = table(i - 1, 1)
' table(i - 1, 1) = table(i, 1)
' table(i, 1) = tmp
' tmps = wtable(i - 1, 1)
' wtable(i - 1, 1) = wtable(i, 1)
' wtable(i, 1) = tmps
' End If
'
' If StrComp(word(2, table(i - 1, 2)), word(2, table(i, 2)), 1) = 1 Then
' tmp = table(i - 1, 2)
' table(i - 1, 2) = table(i, 2)
' table(i, 2) = tmp
' tmps = wtable(i - 1, 2)
' wtable(i - 1, 2) = wtable(i, 2)
' wtable(i, 2) = tmps
' End If
'
' Next
' Next
cursor(1) = 1
cursor(2) = 1
End If
End Sub
Public Sub ListOut()
CleanWindowS
If exist > 0 Then
For i = 1 To size
For i1 = 1 To 2
tw = Sbar(i1 - 1).TextWidth(wtable(i, i1))
If tw > 280 Then tw = 280
If table(i, i1) <> 0 Then
Pic(i1 - 1).CurrentY = (i - 1) * fh
Pic(i1 - 1).CurrentX = 0
Pic(i1 - 1).Print wtable(i, i1)
End If
Next
Next
Chcol
Sel
Shft
Else
For i = 1 To 2
Sbar(i - 1).Visible = False
Next
End If
End Sub
Public Sub Chcol()
If column = 1 Then column = 2 Else column = 1
End Sub
Public Sub Sign()
If Right(tongfile(tongnumber), 3) = "rus" Then
If idmyname = 0 Then myname = "SAVAGE HEART"
If idmyname = 1977 Then myname = Chr(196) + Chr(236) + Chr(232) + Chr(242) + Chr(240) + Chr(232) + Chr(233) + Chr(32) + Chr(204) + Chr(224) + Chr(240) + Chr(234) + Chr(232) + Chr(247) + Chr(229) + Chr(226) '"Дмитрий Маркичев"
Else
If idmyname = 0 Then myname = "SAVAGE HEART"
If idmyname = 1977 Then myname = "Dmitrij Markichev"
End If
Form1.Caption = tong(79, tongnumber) + " + " + Mid$(Str(all), 2) + " <" + BaseName + " - " + descRp + "> " + tong(80, tongnumber) + " " + myname + " <2001" + tong(81, tongnumber) + ">"
End Sub
Public Sub Pic_MouseMove(picvar As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Timer3.Enabled = False
'Form1.SetFocus
If Abs(Y - stirpic) > 0 Then
stirpic = Y
If reg = 0 Then FallDown
If reg = 0 And exist > 0 Then
If picvar + 1 <> column And chs = 0 Then
Shft
End If
If Int(Y / fh) + 1 <> cursor(column) Then
If table(Int(Y / fh) + 1, column) = 0 Then
firmup = 1
check = 0
i = Int(Y / fh) + 1
While check = 0
i = i - 1
If table(i, column) <> 0 Then
check = 1
Else
firmup = firmup + 1
End If
If i = 0 Then
check = 1
firmup = 21 'size + 1
End If
Wend
firmdn = 1
check = 0
i = Int(Y / fh) + 1
While check = 0
i = i + 1
If table(i, column) <> 0 Then
check = 1
Else
firmdn = firmdn + 1
End If
If i > size Then
check = 1
firmdn = 21 'size + 1
End If
Wend
DeSel
i = Int(Y / fh) + 1
If firmup < firmdn Then
cursor(column) = i - firmup
Else
cursor(column) = i + firmdn
End If
Sel
Else
If Int(Y / fh) + 1 <= size Then
DeSel
cursor(column) = Int(Y / fh) + 1
Sel
End If
End If
End If
End If
If reg = 1 Then
If Int(Y / fh) + 1 <> bicursor And Int(Y / fh) + 1 <= size Then
dDeSel
bicursor = Int(Y / fh) + 1
dSel
End If
End If
If MouseInfo = True And Guide = False Then
MouseInfo = False
BottomStatus
'Beep
End If
End If
End Sub
Public Sub form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Ystate = Y 'for Click
If Abs(Y - stirpic) > 0 Then 'LOOK here
stirpic = Y
If reg = 1 Then
If Y > pictop + gnormal * fh Then
If dpos < assi - gnormal Then
scroll = 1
Timer3.interval = 500
Timer3.Enabled = True
End If
ElseIf Y < pictop Then
If dpos > 0 Then
scroll = 0
Timer3.interval = 100
Timer3.Enabled = True
End If
Else
Timer3.Enabled = False
End If
End If
If Guide = False Then
If Y > pictop + fh * normal + pictop - 45 Then 'Guide - MouseCheck
If MouseInfo = False Then
MouseInfo = True
BottomStatus
'Beep
End If
Else
If MouseInfo = True Then
MouseInfo = False
BottomStatus
'Beep
End If
End If
End If
'qw1
End If
End Sub
Public Sub Form_New()
If reg = 0 Then
' tmp = exist
total = 0
countpls = 0
countmin = 0
ratiNg = 0
For i = 1 To all
If lab(i) = 13 Then
lab(i) = 0
exist = exist + 1
End If
If lab(i) = 21 Then lab(i) = 8
If lab(i) = 679 Then lab(i) = 666
If lab(i) = 0 Then total = total + 1
Next
' tmp = 0
' If tmp = 0 Then
PlayList
Information
ListOut
End If
End Sub
Public Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
If exist = 0 Then
Form_New
End If
If reg = 1 Then
If Timer2.Enabled = False Then
If Ystate > pictop + gnormal * fh Then PgDown
If Ystate < pictop Then Prior
Timer3.Enabled = False
Timer2.interval = 250
Timer2.Enabled = True
Else
If Ystate > pictop + gnormal * fh Then CtrlEnd
If Ystate < pictop Then CtrlHome
Timer3.Enabled = False
Timer2.Enabled = False
End If
End If
End If
If Button = 2 Then
If Y > pictop + fh * normal + pictop - 45 Then 'Guide - Invert
Guide = Not Guide
If Guide = True Then
GuideTru
Else
BottomStatus
End If
End If
End If
End Sub
Public Sub timer3_timer()
If reg = 1 Then
Timer3.interval = 100
If scroll = 1 Then
If dpos < assi - gnormal Then
dpos = dpos + 1
GlobOut
Else
Beep
Timer3.Enabled = False
End If
Else
If dpos > 0 Then
dpos = dpos - 1
GlobOut
Else
Beep
Timer3.Enabled = False
End If
End If
Else
Timer3.Enabled = False
End If
End Sub
Public Sub Sbar_MouseMove(picvar As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Timer3.Enabled = False
If reg = 0 Then
If Abs(Y - stirsbar) > 0 Then
stirsbar = Y
If picvar + 1 <> column And chs = 0 Then
Shft
End If
End If
ElseIf reg = 1 Then
End If
End Sub
Public Sub Pic_MouseUp(picvar As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If reg = 0 Then
If Button = 1 Then
If exist = 0 Then
Form_New
Else
Pickword
End If
End If
If Button = 2 And chs = 1 Then
chs = 0
Shft
Line1.Visible = False
Line2.Visible = False
End If
'ElseIf reg = 1 Then
End If
End Sub
Public Sub Sbar_MouseUp(picvar As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If reg = 0 Then
If Button = 1 Then
Pickword
End If
If Button = 2 And chs = 1 Then
chs = 0
Line1.Visible = False
Line2.Visible = False
End If
ElseIf reg = 1 Then
If Button = 2 Then
If Shift = 0 Then
mousechoice = True
eRASemode = 0
doublePick
ElseIf Shift = 1 Then
mousechoice = True
eRASemode = 1
doublePick
ElseIf Shift = 2 Then
mousechoice = True
eRASemode = 2
doublePick
End If
End If
If Button = 1 Then Spelling
End If
End Sub
Public Sub Pickword()
If chs = 0 Then
chs = 1
Shft
Else
chs = 0
End If
If chs = 0 Then
If table(cursor(1), 1) = table(cursor(2), 2) Then
exist = exist - 1
countpls = countpls + 1
lab(table(cursor(1), 1)) = 13
stc = stc + 1
shadtrc(stc, 1) = cursor(1)
shadtrc(stc, 2) = cursor(2)
table(cursor(1), 1) = 0
table(cursor(2), 2) = 0
check = 0
For i = 1 To size
If table(i, 1) > 0 Then check = check + 1
Next
ratiNg = ratiNg + check
Information
If check = 0 Then
Chcol
PlayList
ListOut
If exist = 0 Then
If ratiNg > 0 Then
If ratiNg > bEst Then
msg = tong(82, tongnumber) + Str(ratiNg - bEst)
bEst = ratiNg
Style = vbOKOnly + vbExclamation
Else
msg = tong(83, tongnumber) + Str(Abs(ratiNg - bEst))
Style = vbOKOnly + vbInformation
End If
Else
msg = tong(84, tongnumber)
Style = vbOKOnly + vbCritical
End If
'msg = tmps + Abs(Str(ratiNg - bEst)) 'tong(82, tongnumber) 'Clean"
'+ vbDefaultButton2 ' Define buttons.
Title = tong(85, tongnumber) '
response = MsgBox(msg, Style, Title)
Timer2.interval = 500
Timer2.Enabled = True
End If
Else
Slim 'SLIM DOWN IN CURRENT COLUMN
'CHANGE COLUMN AND DO SAME
Chcol
Slim
Chcol 'ReTuRN POSITION
Shft 'DESELECT SEL BAR 'ND RETURN
End If
Else
Beep 'Wrong Answer
countmin = countmin + 1
check = 0
For i = 1 To size
If table(i, 1) > 0 Then check = check + 1
Next
ratiNg = ratiNg - (normal + 1 - check)
Information
Shft 'ReTuRN POSITION
End If
End If
End Sub
Public Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'SAVE BASE
SaveBase
'SAVE CONFIGURATION
If reg = 1 Then size = ssize 'IF QUIT PERFORMED WHEN RECYCLE ACTIVE & SIZE CHANGED
Open "data\files\lexicon.cfg" For Output As #1
Print #1, Form1.Left
Print #1, Form1.Top
Print #1, BaseName
Print #1, idmyname
Print #1, PLsize
If Guide = True Then Print #1, 1 Else Print #1, 0
Print #1, ypre
Print #1, tongnumber
For i = 1 To tongcount
Print #1, tongfile(i)
Next
Close
'END
End
End Sub
Public Sub SaveBase()
For i = 1 To all
If lab(i) >= 666 Then
changed = True
Exit For
End If
Next
If changed Then
Open "data\files\" + BaseName + ".lex" For Output As #1
For i = 1 To all
If lab(i) < 666 Then
For i1 = 1 To 2
Print #1, word$(i1, i)
Next
End If
Next
Close
End If
Open "data\files\" + BaseName + ".sts" For Output As #1
For i = 1 To all
If lab(i) < 666 Then If lab(i) = 8 Or lab(i) = 21 Then Print #1, 8 Else Print #1, 0
Next
Close
Open "data\files\" + BaseName + ".cfg" For Output As #1
Print #1, alph
Print #1, dpos
Print #1, bicursor
Print #1, ChoosenFont(1)
Print #1, ChoosenFont(2)
Print #1, FSize(1)
Print #1, FSize(2)
Print #1, bEst
Print #1, descRp
' Print #1, ReVerS
Print #1, ActFDStr
Close
End Sub
Public Sub timer1_timer()
If reg = 0 Then
check = 0
For i = 1 To 2
If Sbar(i - 1).TextWidth(wtable(cursor(i), i)) > 280 Then
check = 1
Sbar(i - 1).Width = 280
Sbar(i - 1).Cls 'CLEAN CONTENT & RELOCATE INITIAL X,Y POSITIONS
slimstream(cursor(i), i) = slimstream(cursor(i), i) + 2
If slimstream(cursor(i), i) >= Sbar(i - 1).TextWidth(wtable(cursor(i), i) + " | ") Then slimstream(cursor(i), i) = slimstream(cursor(i), i) - Sbar(i - 1).TextWidth(wtable(cursor(i), i) + " | ")
Sbar(i - 1).CurrentX = -slimstream(cursor(i), i)
Sbar(i - 1).Print wtable(cursor(i), i) + " | " + wtable(cursor(i), i)
End If
Next
If check = 0 Then Timer1.Enabled = False
ElseIf reg = 1 Then
Timer1.interval = 1
For i = 1 To 2
If Sbar(i - 1).TextWidth(word(i, ass(bicursor + dpos))) > 280 Then
Sbar(i - 1).Width = 280
Sbar(i - 1).Cls 'CLEAN CONTENT & RELOCATE INITIAL X,Y POSITIONS
gslim(i, ass(dpos + bicursor)) = gslim(i, ass(dpos + bicursor)) + 2
If gslim(i, ass(dpos + bicursor)) >= Sbar(i - 1).TextWidth(word(i, ass(bicursor + dpos)) + " | ") Then gslim(i, ass(dpos + bicursor)) = gslim(i, ass(dpos + bicursor)) - Sbar(i - 1).TextWidth(word(i, ass(bicursor + dpos)) + " | ")
Sbar(i - 1).CurrentX = -gslim(i, ass(dpos + bicursor))
Sbar(i - 1).Print word(i, ass(bicursor + dpos)) + " | " + word(i, ass(bicursor + dpos))
End If
Next
End If
End Sub
Public Sub Recycle()
Timer1.Enabled = False
Information
'10: '<RE>GEN PLAYLIST
'CLEAN
chs = 0
For i = 1 To 2
Pic(i - 1).FontTransparent = True
Next
'FILL ENTIRE LIST
dGen
If alph = 1 Then
alph = 2 'Cease off Replacing
Order
alph = 1
End If
End Sub
Public Sub dGen()
assi = 0
For i = 1 To all
' If lab(i) < 666 Then
assi = assi + 1
ass(assi) = i
' End If
Next
AddFreeField
If dpos + gnormal > assi Then dpos = assi - gnormal
size = gnormal
If size > assi Then
dpos = 0
size = assi
End If
End Sub
Public Sub dSel()
For i = 1 To 2
Sbar(i - 1).Width = 280
Sbar(i - 1).Top = (bicursor - 1) * fh
Sbar(i - 1).Cls 'CLEAN CONTENT & RELOCATE INITIAL X,Y POSITIONS
Sbar(i - 1).CurrentX = -gslim(i, ass(dpos + bicursor))
If lab(ass(dpos + bicursor)) = 8 Or lab(ass(dpos + bicursor)) = 21 Then
Sbar(i - 1).BackColor = &H404080
ElseIf lab(ass(dpos + bicursor)) = 666 Or lab(ass(dpos + bicursor)) = 679 Then
Sbar(i - 1).BackColor = &H800080
Else
Sbar(i - 1).BackColor = &HC0&
End If
If Sbar(i - 1).TextWidth(word(i, ass(bicursor + dpos))) < 280 Then
Sbar(i - 1).Print word(i, ass(bicursor + dpos))
Else
Sbar(i - 1).Print word(i, ass(bicursor + dpos)) + " | " + word(i, ass(bicursor + dpos))
Timer1.interval = 500
Timer1.Enabled = True
End If
Next
End Sub
Public Sub doublePick()
If dpos + bicursor < assi Then
If eRASemode = 0 Then
If lab(ass(bicursor + dpos)) = 8 Or lab(ass(bicursor + dpos)) = 666 Then
lab(ass(bicursor + dpos)) = 0
exist = exist + 1
total = total + 1
ElseIf lab(ass(bicursor + dpos)) = 21 Or lab(ass(bicursor + dpos)) = 679 Then
lab(ass(bicursor + dpos)) = 13
End If
ElseIf eRASemode = 1 Then
'If lab(ass(bicursor + dpos)) = 8 Then
' lab(ass(bicursor + dpos)) = 0
' exist = exist + 1
' total = total + 1
'Else
If lab(ass(bicursor + dpos)) = 0 Then
exist = exist - 1
total = total - 1
lab(ass(bicursor + dpos)) = 8
ElseIf lab(ass(bicursor + dpos)) = 666 Then
lab(ass(bicursor + dpos)) = 8
ElseIf lab(ass(bicursor + dpos)) = 13 Or lab(ass(bicursor + dpos)) = 679 Then
lab(ass(bicursor + dpos)) = 21
'ElseIf lab(ass(bicursor + dpos)) = 21 Then
' lab(ass(bicursor + dpos)) = 13
End If
ElseIf eRASemode = 2 Then
If lab(ass(bicursor + dpos)) = 8 Then
lab(ass(bicursor + dpos)) = 666
ElseIf lab(ass(bicursor + dpos)) = 0 Then
lab(ass(bicursor + dpos)) = 666
exist = exist - 1
total = total - 1
'ElseIf lab(ass(bicursor + dpos)) = 666 Then
' lab(ass(bicursor + dpos)) = 0
' exist = exist + 1
' total = total + 1
ElseIf lab(ass(bicursor + dpos)) = 21 Or lab(ass(bicursor + dpos)) = 13 Then
lab(ass(bicursor + dpos)) = 679
'ElseIf lab(ass(bicursor + dpos)) = 679 Then
' lab(ass(bicursor + dpos)) = 13
End If
End If
Information
If Not mousechoice Then
dDeSel
bicursor = bicursor + 1
If bicursor > size Then
bicursor = size
'If dpos + gnormal < assi Then
dpos = dpos + 1
GlobOut
'Else
' Beep
'End If
Else
dSel
End If
Else
dSel
End If
End If
End Sub
Public Sub Delete()
If dpos + bicursor <> assi Then
msg = tong(68, tongnumber) '"Действительно удалить?"
Style = vbOKCancel + vbQuestion + vbDefaultButton2 ' Define buttons.
Title = tong(69, tongnumber) '"Удаление (НАВСЕГДА)"
response = MsgBox(msg, Style, Title)
If response = vbOK Then
changed = True
Real = Real - 1
If lab(ass(bicursor + dpos)) <> 8 Then
total = total - 1
exist = exist - 1
End If
lab(ass(bicursor + dpos)) = 666
Information
Sign
For i = dpos + bicursor To assi - 1
ass(i) = ass(i + 1)
Next
assi = assi - 1
If dpos + gnormal > assi And dpos > 0 Then
dpos = dpos - 1 'assi - gnormal
bisursor = bicursor - 1
End If
'bicursor still cause of it never exist last position
GlobOut
End If
Timer2.interval = 1000
Timer2.Enabled = True
End If
End Sub
Public Sub timer2_timer()
Timer2.Enabled = False
End Sub
Public Sub dDeSel()
For i = 1 To 2
If lab(ass(dpos + bicursor)) = 8 Or lab(ass(dpos + bicursor)) = 21 Then
pain = &HFF0000
ElseIf lab(ass(dpos + bicursor)) = 666 Or lab(ass(dpos + bicursor)) = 679 Then
pain = &H800000
Else
pain = Form1.BackColor
End If
Pic(i - 1).Line (0, (bicursor - 1) * fh)-(279, bicursor * fh), pain, BF
Pic(i - 1).CurrentX = -gslim(i, ass(dpos + bicursor))
Pic(i - 1).CurrentY = (bicursor - 1) * fh
If Pic(i - 1).TextWidth(word(i, ass(bicursor + dpos))) < 280 Then
Pic(i - 1).Print word(i, ass(bicursor + dpos))
Else
Pic(i - 1).Print word(i, ass(bicursor + dpos)) + " | " + word(i, ass(bicursor + dpos))
End If
Next
Timer1.Enabled = False
End Sub
Public Sub Spelling()
' KeyPreview = False
Timer1.Enabled = False
reg = 2
Information
column = 1
For i = 1 To 2
Spell(i).Font = ChoosenFont(i)
Spell(i).FontBold = False 'Mark
Spell(i).FontItalic = False
Spell(i).FontStrikethru = False
Spell(i).FontUnderline = False
Spell(i).FontSize = FSize(i)
Spell(i).Width = 280
' Spell(i).Height = fh + 1
If lab(ass(bicursor + dpos)) = 0 Or lab(ass(bicursor + dpos)) = 13 Then
Spell(i).BackColor = &HC0&
ElseIf lab(ass(bicursor + dpos)) = 8 Or lab(ass(bicursor + dpos)) = 21 Then
Spell(i).BackColor = &H404080
Else
Spell(i).BackColor = &H800080
End If
Spell(i).ForeColor = &HFFFFFF
If dpos + bicursor = assi Then Spell(i).Text = "" Else Spell(i).Text = word(i, ass(bicursor + dpos))
Spell(i).TabStop = True
Spell(i).Visible = True
Spell(i).Enabled = True
Next
Spell(column).SetFocus
End Sub
Public Sub Spelleave()
reg = 1
Information
' KeyPreview = True
For i = 1 To 2
Spell(i).TabStop = False
Spell(i).Visible = False
Spell(i).Enabled = False
Next
dSel
End Sub
Public Sub Spellconf() 'aaa
changed = True
For i = 1 To 2
gslim(i, ass(dpos + bicursor)) = 0
word(i, ass(bicursor + dpos)) = Spell(i).Text
Spell(i).TabStop = False
Spell(i).Visible = False
Spell(i).Enabled = False
Next
If alph = 1 Then
check = 0 'Don't try understand- too complex even for me-self
'In simple- fast sort- cause of one word
For i = bicursor + dpos To 1 Step -1
If StrComp(word(1, ass(i - 1)), word(1, ass(i)), 1) = 1 Then
check = 1
tmp = ass(i - 1)
ass(i - 1) = ass(i)
ass(i) = tmp
tmp1 = i - 1
Else
Exit For
End If
Next
If check = 0 Then
For i = bicursor + dpos To assi - 2
If StrComp(word(1, ass(i)), word(1, ass(i + 1)), 1) = 1 Then
tmp = ass(i + 1)
ass(i + 1) = ass(i)
ass(i) = tmp
tmp1 = i + 1
Else
Exit For
End If
Next
End If
End If
If assi > gnormal Then
predp = tmp1 - Int(gnormal / 2)
prebi = Int(gnormal / 2)
If predp < 0 Then
prebi = prebi - Abs(predp)
predp = 0
End If
If predp + gnormal > assi Then
prebi = prebi + (predp - (assi - gnormal))
predp = assi - gnormal
End If
Else
predp = 0
prebi = tmp1
End If
If assi = dpos + bicursor Then
all = all + 1
exist = exist + 1
total = total + 1
'real = real + 1
'Information
AddFreeField
If bicursor = gnormal Then
dpos = dpos + 1
Else
bicursor = bicursor + 1
If bicursor > size Then size = bicursor
End If
End If
reg = 1
Information
GlobOut
End Sub
Public Sub Order()
If assi > 1 Then
' tmp1 = ass(dpos + bicursor)
' For i1 = 2 To assi - 1
' For i = 2 To assi - 1
' If StrComp(word(1, ass(i - 1)), word(1, ass(i)), 1) = 1 Then
' tmp = ass(i - 1)
' ass(i - 1) = ass(i)
' ass(i) = tmp
' End If
' Next
' Next
Sw.Clear
' For i = 0 To assi - 1
' Sw.AddItem ""
' Next
For i = 0 To assi - 1
' Sw.List(i) = word(1, ass(i)) ' + Right("000000" + Mid(Str(ass(i)), 2), 7)
Sw.AddItem word(1, ass(i))
Sw.ItemData(Sw.NewIndex) = ass(i)
Next
For i = 1 To assi - 1
ass(i) = Sw.ItemData(i)
Next
If alph = 1 Then PlaceAsBefore
Else
If alph = 1 Then Beep
End If
End Sub
Public Sub Disord()
If assi > 1 Then
assi = 0
tmp1 = ass(dpos + bicursor)
For i = 1 To all
'If lab(i) <> 666 Then
assi = assi + 1
ass(assi) = i
'End If
Next
assi = assi + 1
PlaceAsBefore
Else
Beep
End If
End Sub
Public Sub PlaceAsBefore()
For i = 1 To assi - 1
If ass(i) = tmp1 Then
dpos = i - bicursor
If dpos + gnormal > assi Then
bicursor = bicursor + (dpos + gnormal - assi)
dpos = assi - gnormal
End If
If dpos < 0 Then
bicursor = bicursor + dpos
dpos = 0
End If
Exit For
End If
Next
End Sub
Public Sub StoreMainList()
Line1.Visible = False
Line2.Visible = False
ssize = size
scolumn = column
schs = chs
End Sub
Public Sub ToggleOff()
tmp = table(cursor(column), column)
Chcol
For i = 1 To size
If tmp = table(i, column) Then
If i <> cursor(column) Then 'STORE PREVIOUS CURSOR
tmp = cursor(column) 'IF IT DIF FROM NEW
cursor(column) = i
Else
tmp = 0
End If
End If
Next
lab(table(cursor(1), 1)) = 8
stc = stc + 1
shadtrc(stc, 1) = cursor(1)
shadtrc(stc, 2) = cursor(2)
table(cursor(1), 1) = 0
table(cursor(2), 2) = 0
check = 0
For i = 1 To size
If table(i, 1) > 0 Then check = check + 1
Next
exist = exist - 1
total = total - 1
Information
If check = 0 Then
Chcol
PlayList
ListOut
Else
Slim
Chcol
Slim
Chcol
If tmp <> 0 Then cursor(column) = tmp
Shft
End If
End Sub
Public Sub Overturn()
reg = 0
Information
size = ssize
column = scolumn
chs = schs
For I2 = 1 To all
If lab(I2) = 8 Then
For i3 = 1 To size
If table(i3, 1) = I2 Then
stc = stc + 1
For i = 1 To size
If table(i, 2) = I2 Then
shadtrc(stc, 2) = i
table(i, 2) = 0
Exit For
End If
Next
shadtrc(stc, 1) = i3
table(i3, 1) = 0
Exit For
End If
Next
End If
Next
For i = 1 To 2
Pic(i - 1).FontTransparent = False
Next
check = 0
For i = 1 To size
If table(i, 1) > 0 Then check = check + 1
Next
If check = 0 Then
PlayList
ListOut
Else
For i = 1 To 2
If table(cursor(i), i) = 0 Then
If chs = 1 Then
chs = 0
Chcol
End If
check = 0
While check = 0
cursor(i) = cursor(i) + 1
If table(cursor(i), i) > 0 Then check = 1
If cursor(i) > size Then cursor(i) = 0
Wend
End If
Next
ListOut
End If
End Sub
Public Sub AddFreeField()
ReDim Preserve word(2, all + 1)
ReDim Preserve gslim(2, all + 1)
ReDim Preserve lab(all + 1)
ReDim Preserve ass(all + 1)
assi = assi + 1
ass(assi) = all + 1
word(1, all + 1) = tong(70, tongnumber) '"Free field - type here"
word(2, all + 1) = tong(70, tongnumber) '"Свободное поле для ввода"
End Sub
Public Sub GlobOut()
CleanWindowS
tmp = bicursor
For tmp1 = 1 To size
bicursor = tmp1
dDeSel
Next
bicursor = tmp
dSel
End Sub
Public Sub CleanWindowS()
For i = 1 To 2
Pic(i - 1).Font = ChoosenFont(i)
Pic(i - 1).FontBold = False 'Mark
Pic(i - 1).FontItalic = False
Pic(i - 1).FontStrikethru = False
Pic(i - 1).FontUnderline = False
Pic(i - 1).FontSize = FSize(i)
Pic(i - 1).ForeColor = &HE0E0E0
Pic(i - 1).BackColor = Form1.BackColor
Pic(i - 1).Cls
Pic(i - 1).Height = (gnormal - 1) * fh + Pic(i - 1).TextHeight("A") '271
Pic(i - 1).Width = 280
Pic(i - 1).Top = pictop
Pic(i - 1).Left = 10 + (i - 1) * 300
Sbar(i - 1).Font = ChoosenFont(i)
Sbar(i - 1).FontBold = False
Sbar(i - 1).FontItalic = False
Sbar(i - 1).FontStrikethru = False
Sbar(i - 1).FontUnderline = False
Sbar(i - 1).FontSize = FSize(i)
Sbar(i - 1).ForeColor = &HFFFFFF
Sbar(i - 1).Cls
Sbar(i - 1).Height = Sbar(i - 1).TextHeight("A") 'fh + 1 '
Sbar(i - 1).Visible = True
Next
End Sub
Public Sub Prior()
If dpos > 0 Then
dpos = dpos - gnormal
If dpos < 0 Then dpos = 0
GlobOut
ElseIf bicursor > 1 Then
dDeSel
bicursor = 1
dSel
Else
Beep
End If
End Sub
Public Sub PgDown()
If dpos >= assi - gnormal Then
If bicursor <> size Then
dDeSel
bicursor = size
dSel
Else
Beep
End If
Else
dpos = dpos + gnormal
If dpos + gnormal > assi Then dpos = assi - gnormal
GlobOut
End If
End Sub
Public Sub CtrlHome()
If dpos <> 0 Then
dpos = 0
bicursor = 1
dpos = 0
GlobOut
ElseIf bicursor <> 1 Then
dDeSel
bicursor = 1
dSel
Else
Beep
End If
End Sub
Public Sub CtrlEnd()
If dpos < assi - gnormal Then
dpos = assi - gnormal
bicursor = gnormal
GlobOut
ElseIf bicursor <> size Then
dDeSel
bicursor = size
dSel
Else
Beep
End If
End Sub
Public Sub LoadLex()
File1.Pattern = "*.lex"
File1.Refresh
If File1.ListCount > 0 Then
sreg = reg
reg = 3
Information
UniListBox(1).Clear
For i = 0 To File1.ListCount - 1
UniListBox(1).AddItem Left(File1.List(i), Len(File1.List(i)) - 4), i
Next
UniListBox(1).Font = tong(1, tongnumber) 'ChoosenFont
UniListBox(1).FontSize = tong(62, tongnumber) 'FSize
UniListBox(1).ForeColor = tong(63, tongnumber) '&HE0E0E0
UniListBox(1).FontBold = tong(64, tongnumber) 'False 'Mark
UniListBox(1).FontItalic = tong(65, tongnumber) 'False
UniListBox(1).FontStrikethru = tong(66, tongnumber) 'False
UniListBox(1).FontUnderline = tong(67, tongnumber) 'False
UniListBox(1).BackColor = RGB(100, 120, 254) 'Form1.BackColor
UniListBox(1).Height = (gnormal - 2) * fh
UniListBox(1).Width = 290
UniListBox(1).Top = pictop
UniListBox(1).Left = 150
UniListBox(1).Selected(0) = True
Enscribe.Font = tong(1, tongnumber) 'ChoosenFont
Enscribe.FontSize = tong(62, tongnumber) 'FSize
Enscribe.ForeColor = &HFFFFFF 'tong(63, tongnumber) '&HE0E0E0
Enscribe.FontBold = tong(64, tongnumber) 'False 'Mark
Enscribe.FontItalic = tong(65, tongnumber) ' False
Enscribe.FontStrikethru = tong(66, tongnumber) 'False
Enscribe.FontUnderline = tong(67, tongnumber) 'False
Enscribe.BackColor = Form1.BackColor
Enscribe.Height = fh
Enscribe.Width = 290
Enscribe.Top = pictop + (gnormal - 1) * fh - 16
Enscribe.Left = 150
'Enscribe.Text = descRp
EnScrPer
' Enscribe.ReadOnly = True
' unilistbox(1).TabStop = True
' Enscribe.TabStop = True
UniListBox(1).Visible = True
UniListBox(1).Enabled = True
Enscribe.Visible = True
Enscribe.Enabled = True
UniListBox(1).SetFocus
Else
msg = tong(71, tongnumber) '"Файлы данных отсутствуют"
Style = vbOKOnly + vbExclamation + vbDefaultButton1 ' Define buttons.
Title = tong(72, tongnumber) '"Лексикон"
response = MsgBox(msg, Style, Title)
Timer2.interval = 500
Timer2.Enabled = True
End If
End Sub
'Public Sub unilistbox_GotFocus(Index As Integer)
'End Sub
Public Sub SaveLex()
File1.Pattern = "*.lex"
File1.Refresh
sreg = reg
reg = 4
Information
UniListBox(1).Clear
For i = 0 To File1.ListCount - 1
UniListBox(1).AddItem Left(File1.List(i), Len(File1.List(i)) - 4), i
Next
UniListBox(1).Font = tong(1, tongnumber) 'ChoosenFont
UniListBox(1).FontSize = tong(62, tongnumber) 'FSize
UniListBox(1).ForeColor = tong(63, tongnumber) '&HE0E0E0
UniListBox(1).FontBold = tong(64, tongnumber) 'False 'Mark
UniListBox(1).FontItalic = tong(65, tongnumber) 'False
UniListBox(1).FontStrikethru = tong(66, tongnumber) 'False
UniListBox(1).FontUnderline = tong(67, tongnumber) 'False
UniListBox(1).BackColor = Form1.BackColor
UniListBox(1).Height = (gnormal - 3) * fh
UniListBox(1).Width = 290
UniListBox(1).Top = pictop
UniListBox(1).Left = 150
UniListBox(1).Selected(0) = True
SaveAs.Font = tong(1, tongnumber) 'ChoosenFont
SaveAs.FontSize = tong(62, tongnumber) 'FSize
SaveAs.ForeColor = &HFFFFFF 'tong(63, tongnumber) '&HE0E0E0
SaveAs.FontBold = tong(64, tongnumber) 'False 'Mark
SaveAs.FontItalic = tong(65, tongnumber) ' False
SaveAs.FontStrikethru = tong(66, tongnumber) 'False
SaveAs.FontUnderline = tong(67, tongnumber) 'False
SaveAs.BackColor = Form1.BackColor
SaveAs.Height = fh
SaveAs.Width = 290
SaveAs.Top = pictop + (gnormal - 3) * fh
SaveAs.Left = 150
If Len(BaseName) > 0 Then SaveAs.Text = BaseName Else SaveAs.Text = ""
Enscribe.Font = tong(1, tongnumber) 'ChoosenFont
Enscribe.FontSize = tong(62, tongnumber) 'FSize
Enscribe.ForeColor = &HFFFFFF 'tong(63, tongnumber) '&HE0E0E0
Enscribe.FontBold = tong(64, tongnumber) 'False 'Mark
Enscribe.FontItalic = tong(65, tongnumber) ' False
Enscribe.FontStrikethru = tong(66, tongnumber) 'False
Enscribe.FontUnderline = tong(67, tongnumber) 'False
Enscribe.BackColor = Form1.BackColor
Enscribe.Height = fh
Enscribe.Width = 290
Enscribe.Top = pictop + (gnormal - 1) * fh - 4
Enscribe.Left = 150
Enscribe.Text = descRp
' Enscribe.ReadOnly = False
SaveAs.TabStop = True
UniListBox(1).TabStop = True
Enscribe.TabStop = True
SaveAs.Visible = True
SaveAs.Enabled = True
'If File1.ListCount > 0 Then File1.Selected(0) = True
UniListBox(1).Visible = True
UniListBox(1).Enabled = True
Enscribe.Visible = True
Enscribe.Enabled = True
SaveAs.SetFocus
End Sub
Public Sub QuickSave()
SaveBase
End Sub
'Public Sub unilistbox(1)_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'End Sub
'Public Sub File1_KeyDown(KeyCode As Integer, Shift As Integer)
' If reg = 4 Then
' timer5.interval = 10 'if Move not performed yet - wait
' timer5.Enabled = True
' End If
'End Sub
Public Sub LoadLexLeave()
' unilistbox(1).TabStop = False
' Enscribe.TabStop = False
UniListBox(1).Enabled = False
UniListBox(1).Visible = False
Enscribe.Enabled = False
Enscribe.Visible = False
reg = sreg
Information
End Sub
Public Sub SaveLexLeave()
SaveAs.TabStop = False
UniListBox(1).TabStop = False
Enscribe.TabStop = False
SaveAs.Enabled = False
SaveAs.Visible = False
UniListBox(1).Enabled = False
UniListBox(1).Visible = False
Enscribe.Enabled = False
Enscribe.Visible = False
reg = sreg
Information
End Sub
Public Sub LoadLexCfirm()
'unilistbox(1).Enabled = False
'unilistbox(1).Visible = False
'filechoosen = Left(filechoosen, Len(filechoosen) - 4)
If BaseName <> UniListBox(1).List(UniListBox(1).ListIndex) Then
SaveBase
BaseName = UniListBox(1).List(UniListBox(1).ListIndex) 'filechoosen
End If
LoadBase
'reg = sreg
LoadLexLeave
Sign
'Information
If reg = 0 Then
PlayList
ListOut
Else
PlayList
Recycle
GlobOut
End If
End Sub
Public Sub SaveLexCfirm()
If SaveAs.Text <> "" Then
tmps = SaveAs.Text 'Store for preprocess
tmp = InStr(1, tmps, ".")
If tmp > 0 Then tmps = Mid(tmps, 1, tmp - 1)
check = 0
If BaseName <> tmps Then
For i = 0 To File1.ListCount - 1 'Check if overwrite
If UniListBox(1).List(i) = tmps Then ' + ".lex"
check = 1
Open "data\files\" + UniListBox(1).List(i) + ".lex" For Input As #1
tmp = 0
While Not EOF(1)
Line Input #1, ist
tmp = tmp + 1
Wend
tmp = Int(tmp / 2)
Close
msg = tong(73, tongnumber) + " - " + UniListBox(1).List(i) + " <" + Mid(Str(tmp), 2) + " " + tong(74, tongnumber) + ">"
Style = vbOKCancel + vbQuestion + vbDefaultButton2 ' Define buttons.
Title = tong(75, tongnumber) '"Перезапись файла"
response = MsgBox(msg, Style, Title)
If response = vbOK Then check = 0
Timer2.interval = 500
Timer2.Enabled = True
Exit For
End If
Next
End If
If check = 0 Then
If BaseName <> tmps Then
changed = True
BaseName = tmps
End If
descRp = Enscribe.Text
SaveBase
SaveLexLeave
'reg = sreg
Sign
'Information
End If
End If
End Sub
Public Sub KillBase()
If Len(UniListBox(1).List(UniListBox(1).ListIndex)) > 0 Then
filechoosen = UniListBox(1).List(UniListBox(1).ListIndex) 'Left(File1.FileName, Len(File1.FileName) - 4)
Open "data\files\" + filechoosen + ".lex" For Input As #1
tmp = 0
While Not EOF(1)
Line Input #1, ist
tmp = tmp + 1
Wend
tmp = Int(tmp / 2)
Close
msg = tong(76, tongnumber) + " - " + filechoosen + " <" + Mid(Str(tmp), 2) + " " + tong(77, tongnumber) + ">"
Style = vbOKCancel + vbQuestion + vbDefaultButton2 ' Define buttons.
Title = tong(78, tongnumber)
response = MsgBox(msg, Style, Title)
If response = vbOK Then
Kill filechoosen + ".lex"
Kill filechoosen + ".sts"
Kill filechoosen + ".cfg"
If filechoosen = BaseName Then
BaseName = "UnTitled"
descRp = "UndeScribed"
changed = True
Sign
End If
File1.Refresh
If File1.ListCount > 0 Then
If UniListBox(1).ListIndex > File1.ListCount - 1 Then tmp = File1.ListCount - 1 Else tmp = UniListBox(1).ListIndex
UniListBox(1).Clear
For i = 0 To File1.ListCount - 1
UniListBox(1).AddItem Left(File1.List(i), Len(File1.List(i)) - 4), i
Next
UniListBox(1).Selected(tmp) = True
EnScrPer
UniListBox(1).SetFocus
Else
If reg = 3 Then LoadLexLeave Else SaveAs.SetFocus
End If
Else
UniListBox(1).SetFocus
End If
Timer2.interval = 500
Timer2.Enabled = True
End If
End Sub
Public Sub FontChoose()
sreg = reg
reg = 5
Information
fc = Screen.FontCount
For i = 1 To 2
UniListBox(i).Font = tong(1, tongnumber) 'GivenFont 'ChoosenFont
UniListBox(i).FontSize = tong(62, tongnumber) 'FSize
UniListBox(i).ForeColor = tong(63, tongnumber) '&HE0E0E0
UniListBox(i).FontBold = tong(64, tongnumber) 'False 'Mark
UniListBox(i).FontItalic = tong(65, tongnumber) 'False
UniListBox(i).FontStrikethru = tong(66, tongnumber) 'False
UniListBox(i).FontUnderline = tong(67, tongnumber) 'False
UniListBox(i).BackColor = Form1.BackColor
UniListBox(i).Height = (gnormal - 1) * fh
UniListBox(i).Width = 285 '290
UniListBox(i).Top = pictop
UniListBox(i).Left = 10 + (i - 1) * 295 '150
UniListBox(i).Clear
For i1 = 0 To fc - 1
UniListBox(i).AddItem Screen.Fonts(i1), i1
If Screen.Fonts(i1) = ChoosenFont(i) Then tmp = i1
Next
UniListBox(i).TopIndex = tmp
UniListBox(i).Selected(tmp) = True
Abc(i).Font = ChoosenFont(i)
Abc(i).FontBold = False 'Mark
Abc(i).FontItalic = False
Abc(i).FontStrikethru = False
Abc(i).FontUnderline = False
Abc(i).FontSize = FSize(i)
FTmp(i) = FSize(i)
Abc(i).ForeColor = &HFFFFFF '&HE0E0E0
Abc(i).BackColor = Form1.BackColor
Abc(i).Height = fh
Abc(i).Width = 215
Abc(i).Top = pictop + (gnormal - 1) * fh
Abc(i).Left = 80 + (i - 1) * (600 - 2 * 80 - 215) '300 '220
' Abc(i).TabStop = True
If all = 0 Then
Abc(i).Text = "Abc Абв " + Mid(Str(FTmp(i)), 2)
Else
Abc(i).Text = Left(word(i, 1), 12) + " " + Mid(Str(FTmp(i)), 2)
End If
Abc(i).Visible = True
Abc(i).Enabled = True
UniListBox(i).TabStop = True
UniListBox(i).Visible = True
UniListBox(i).Enabled = True
AdjustSize(i).Visible = True
AdjustSize(i).Enabled = True
Next
ActFDial = ActFDStr
UniListBox(ActFDial).SetFocus
' For i = 1 To 2
' Next
End Sub
Public Sub FontSetLeave()
ActFDStr = ActFDial
For i = 1 To 2
' Abc.TabStop = False
UniListBox(1).TabStop = False
Abc(i).Enabled = False
Abc(i).Visible = False
UniListBox(i).Enabled = False
UniListBox(i).Visible = False
' adjustsize(i).TabStop = False
AdjustSize(i).Visible = False
AdjustSize(i).Enabled = False
Next
reg = sreg
Information
End Sub
Public Sub FontSetCfirm()
FontSetLeave
check = 0
For i = 1 To 2
If UniListBox(i).Text <> ChoosenFont(i) Or FSize(i) <> FTmp(i) Then 'List(unilistbox(1).ListIndex)
check = 1
ReDim gslim(2, assi)
ReDim slimstream(21, 2)
FSize(i) = FTmp(i)
ChoosenFont(i) = UniListBox(i).Text
End If
Next
reg = sreg
Sign
Information
If check = 1 Then
If reg = 0 Then
'PlayList
ListOut
Else
'Recycle
GlobOut
End If
End If
End Sub
Public Sub unilistbox_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If reg = 3 Then
If Button = 1 Then
If Timer2.Enabled = False Then
filechoosen = UniListBox(1).List(UniListBox(1).ListIndex) 'File1.FileName
EnScrPer
' Open "data\files\" + unilistbox(1).List(unilistbox(1).ListIndex) + ".cfg" For Input As #1
' For i = 1 To 7
' Input #1, ist
' Next
' Enscribe.Text = ist
' Close
Timer2.interval = 1000
Timer2.Enabled = True
Else
Timer2.Enabled = False
If filechoosen = UniListBox(1).List(UniListBox(1).ListIndex) Then LoadLexCfirm 'File1.FileName
End If
End If
If Button = 2 Then LoadLexLeave
If Button = 4 Then KillBase
ElseIf reg = 4 Then
If Button = 1 Then
If Timer2.Enabled = False Then
filechoosen = UniListBox(1).List(UniListBox(1).ListIndex) 'File1.FileName
SaveAs.Text = filechoosen
EnScrPer
' Open "data\files\" + unilistbox(1).List(unilistbox(1).ListIndex) + ".cfg" For Input As #1
' For i = 1 To 7
' Input #1, ist
' Next
' Enscribe.Text = ist
' Close
Timer2.interval = 1000
Timer2.Enabled = True
Else
Timer2.Enabled = False
If filechoosen = UniListBox(1).List(UniListBox(1).ListIndex) Then
SaveLexCfirm
End If
End If
End If
If Button = 2 Then SaveLexLeave
If Button = 4 Then KillBase
ElseIf reg = 5 Then
If Button = 1 Then
If Timer2.Enabled = False Then
AbcShow
tmps = UniListBox(ActFDial).Text
Timer2.interval = 500
Timer2.Enabled = True
Else
Timer2.Enabled = False
If tmps = UniListBox(ActFDial).Text Then
FontSetCfirm
Else
AbcShow
End If
End If
ElseIf Button = 2 Then
FontSetLeave
End If
End If
End Sub
Public Sub unilistbox_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If reg = 4 Or reg = 3 Then
Timer5.interval = 10 'if Move not performed yet - wait
Timer5.Enabled = True
ElseIf reg = 5 Then
Timer4.interval = 1 'if Move not performed yet - repeat
Timer4.Enabled = True
'AbcShow
End If
End Sub
Public Sub unilistbox_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
If reg = 3 Or reg = 4 Then If KeyCode = vbKeyDelete Then KillBase
End Sub
Public Sub timer5_timer()
If reg = 4 Then SaveAs.Text = UniListBox(1).List(UniListBox(1).ListIndex) 'File1.FileName
EnScrPer 'assign description from ?.cfg
Timer5.Enabled = False
End Sub
Public Sub EnScrPer()
Open "data\files\" + UniListBox(1).List(UniListBox(1).ListIndex) + ".cfg" For Input As #1
For i = 1 To 9
Input #1, ist
Next
Enscribe.Text = ist
Close
End Sub
Public Sub SaveAs_KeyPress(KeyAscii As Integer)
If KeyAscii = Asc("?") Or KeyAscii = Asc("*") Then KeyAscii = 0
End Sub
Public Sub unilistbox_GotFocus(Index As Integer)
If reg = 4 Then
UniListBox(1).BackColor = RGB(100, 120, 254)
Enscribe.BackColor = Form1.BackColor
SaveAs.BackColor = Form1.BackColor
End If
If reg = 5 Then
UniListBox(ActFDial).BackColor = Form1.BackColor
Abc(ActFDial).BackColor = Form1.BackColor
ActFDial = Index
UniListBox(ActFDial).BackColor = RGB(100, 120, 254)
Abc(ActFDial).BackColor = RGB(100, 120, 254)
End If
End Sub
Public Sub Enscribe_GotFocus()
If reg = 4 Then
UniListBox(1).BackColor = Form1.BackColor
Enscribe.BackColor = RGB(100, 120, 254)
SaveAs.BackColor = Form1.BackColor
End If
End Sub
Public Sub SaveAs_GotFocus()
If reg = 4 Then
UniListBox(1).BackColor = Form1.BackColor
Enscribe.BackColor = Form1.BackColor
SaveAs.BackColor = RGB(100, 120, 254)
End If
End Sub
Public Sub timer4_timer()
tim = tim + 1
AbcShow
If tim > 10 Then Timer4.Enabled = False
End Sub
Public Sub AbcShow()
Abc(ActFDial).FontBold = False 'Mark
Abc(ActFDial).FontItalic = False
Abc(ActFDial).FontStrikethru = False
Abc(ActFDial).FontUnderline = False
Abc(ActFDial).FontSize = FTmp(ActFDial)
Abc(ActFDial).Font = UniListBox(ActFDial).Text
End Sub
Public Sub adjustsize_Click(Index As Integer)
FScrollBar = Index
ScrollFont
End Sub
Public Sub adjustsize_dblClick(Index As Integer)
FScrollBar = Index
ScrollFont
End Sub
Public Sub ScrollFont()
If FScrollBar = 1 Then
If FTmp(ActFDial) > 8 Then FTmp(ActFDial) = FTmp(ActFDial) - 1
Else
If FTmp(ActFDial) < 18 Then FTmp(ActFDial) = FTmp(ActFDial) + 1
End If
If all = 0 Then
Abc(ActFDial).Text = "Abc Абв " + Mid(Str(FTmp(ActFDial)), 2)
Else
Abc(ActFDial).Text = Left(word(ActFDial, 1), 12) + " " + Mid(Str(FTmp(ActFDial)), 2)
End If
AbcShow
End Sub
Public Sub Centring()
CenterX = Int(xsize / Screen.TwipsPerPixelX - Form1.TextWidth(tmps)) / 2
End Sub
Public Sub BottomStatus()
Form1.Font = tong(1, tongnumber) 'GivenFont
Form1.FontSize = tong(2, tongnumber) '12 'FSize17
Form1.ForeColor = tong(3, tongnumber) '&H40C0&
Form1.FontBold = tong(4, tongnumber) 'True
Form1.FontItalic = tong(5, tongnumber) 'False
Form1.FontStrikethru = tong(6, tongnumber) 'False
Form1.FontUnderline = tong(7, tongnumber) 'False22
If ypre <> 0 Then
Form1.Top = ypre
ypre = 0
End If
ysize = (pictop + fh * normal + pictop + AddHeight) * Screen.TwipsPerPixelY
Form1.Height = ysize
For i = 0 To 44
Form1.Line (0, i + pictop + fh * normal + pictop - 45)-(xsize, i + pictop + fh * normal + pictop - 45), Pal(i + 71)
Next
If MouseInfo = False Then
tmps = tong(17, tongnumber) '"...для активации проводника нажмите - <F1>"
Centring
Else
tmps = tong(18, tongnumber) '"...или правую кнопку мыши"
Centring
End If
Form1.CurrentX = CenterX
Form1.CurrentY = pictop + fh * normal + pictop - 23 - Int(Form1.TextHeight(tmps) / 2)
Form1.Print tmps
End Sub
Public Sub GuideTru()
If ypre <> 0 Then
Form1.Top = ypre
End If
For i = 0 To tong(20 + reg * 7, tongnumber)
GuideContent(i) = tong(21 + reg * 7 + i, tongnumber)
Next
Gcount = tong(20 + reg * 7, tongnumber)
tmp = 17
ysize = (pictop + fh * normal + pictop + AddHeight - 45 + tmp * Gcount + 2 + 1) * Screen.TwipsPerPixelY
If Form1.Top + ysize > Screen.Height - 30 * Screen.TwipsPerPixelY Then
ypre = Form1.Top
Form1.Top = (Screen.Height - ysize - 30 * Screen.TwipsPerPixelY) '/ 2
End If
Form1.Height = ysize + AddHeight
Cover.Top = pictop + fh * normal + pictop - 45
Cover.Left = 0
Cover.Height = tmp * Gcount + 2
Cover.Width = xsize
Cover.Visible = True
Form1.Line (0, pictop + fh * normal + pictop - 45)-(xsize, pictop + fh * normal + pictop - 45 + tmp * Gcount + 2), vbWhite, BF
Form1.Line (0, pictop + fh * normal + pictop - 45)-(Int(xsize / Screen.TwipsPerPixelX) - AddWidth, pictop + fh * normal + pictop - 45 + tmp * Gcount + 2), vbBlack, B
Form1.FontSize = tong(19, tongnumber) '10 'FSize
Form1.ForeColor = 0 'tong(26, tongnumber) 'vbBlack26
Form1.FontBold = False 'tong(27, tongnumber)
Form1.FontItalic = False ' tong(28, tongnumber)
Form1.FontStrikethru = False 'tong(29, tongnumber)
Form1.FontUnderline = False 'tong(30, tongnumber)
For i = 0 To Gcount - 1
spos = 1
lpos = 0
cxps = 10
For I2 = 1 To Len(GuideContent(i))
If Mid(GuideContent(i), I2, 1) = "\" Then
If Form1.FontSize <= tong(19, tongnumber) Then Form1.FontSize = Form1.FontSize + 1.75 Else Form1.FontSize = tong(19, tongnumber)
Form1.FontItalic = Not Form1.FontItalic
Form1.FontUnderline = Not Form1.FontUnderline
' Form1.FontBold = Not Form1.FontBold
Else
Form1.CurrentY = pictop + fh * normal + pictop - 45 + 1 + i * tmp
Form1.CurrentX = cxps
Form1.Print Mid(GuideContent(i), I2, 1)
cxps = cxps + Form1.TextWidth(Mid(GuideContent(i), I2, 1))
End If
Next
Next
Cover.Visible = False
End Sub
Public Sub ReVerPer()
ReVerS = -Abs(Abs(ReVerS) - 1)
For i = 1 To size
tmp = table(i, 1)
table(i, 1) = table(i, 2)
table(i, 2) = tmp
tmps = wtable(i, 1)
wtable(i, 1) = wtable(i, 2)
wtable(i, 2) = tmps
tmp = slimstream(i, 1)
slimstream(i, 1) = slimstream(i, 2)
slimstream(i, 2) = tmp
tmps = shadtrc(i, 1)
shadtrc(i, 1) = shadtrc(i, 2)
shadtrc(i, 2) = tmps
Next
tmp = cursor(1)
cursor(1) = cursor(2)
cursor(2) = tmp
stci = 0
For i = 1 To all
tmps = word(1, i)
word(1, i) = word(2, i)
word(2, i) = tmps
tmp = gslim(1, i)
gslim(1, i) = gslim(2, i)
gslim(2, i) = tmp
Next
tmps = ChoosenFont(1)
ChoosenFont(1) = ChoosenFont(2)
ChoosenFont(2) = tmps
tmp = FSize(1)
FSize(1) = FSize(2)
FSize(2) = tmp
If ActFDStr = 1 Then ActFDStr = 2 Else ActFDStr = 1
changed = True
If alph = 1 Then Order
If reg = 0 Then ListOut Else GlobOut
End Sub