Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
MuhEdit 0.9.X (final)
| Uploader: |  The_Muh |
| Datum/Zeit: | 03.12.2008 20:01:22 |
'--------------Credits--------------'
' MuhEdit, version 0.9.X Final
' Programming and idea by The_Muh.
'-----------------------------------'
'declares:
declare sub search()
declare sub correct_cur()
declare sub laden(seite as string)
declare sub speichern(file as string = "")
declare sub text(ByVal wahl As Integer, title as string = "")
declare sub anzeige(anzeigetext() as string, X as integer, Y as integer)
declare sub tab_correct(old_width as integer)
declare sub menu()
declare function decoder(txt as string, key as string) as string
declare function encoder (txt_crypt as string, key as string) as string
declare function byte_2_x(B as ulongint) as string
declare function new_file() as string
declare function conv(key as string) as string
declare function directory(FL as integer) as string
declare function gen_row(number as integer, biggest as integer) as string
declare function exist(BYREF DateiName AS STRING, Attr AS INTEGER=&h27)AS INTEGER
declare function eingabe(ByVal frage As String ,vorgabe As String, X as integer,Y as integer, title as string = "") as string
declare function Max(array() as string) as integer
declare Function str_replace(ByVal V_Data As String, ByVal V_Expression As String, ByVal V_ReplaceBy As String) As String
'variablen:
Dim as integer einf = 1
dim as string Li, Re
dim as integer ascL, ascR
dim as integer mzeile, mspalte, buttons
dim d as string
dim i as integer
dim L as integer
dim rest as string
dim shared crypt_key as string
dim shared dirs as string
dim shared a as integer
dim shared b as integer
dim shared ba as integer = 0
dim shared pot_spalte as integer = 1
dim shared as string tZeile()
dim shared as string seite
dim shared as integer zeile=3, spalte=1
dim clip as integer
REDIM tzeile(1) AS STRING 'Der Text
'Options-variablen:
type options
nam as string
value as integer
min as integer
max as integer
end type
dim shared opt(1 to 5) as options
opt(1).nam = "Tab width:"
opt(1).value = 4
opt(1).min = 4
opt(1).max = 12
opt(2).nam = "Print row-numbers?"
opt(2).value = 0
opt(2).min = 0
opt(2).max = 1
opt(3).nam = "Print all row-numbers?"
opt(3).value = 0
opt(3).min = 0
opt(3).max = 1
opt(4).nam = "Window-height:"
opt(4).value = 40
opt(4).min = 22
opt(4).max = 100
opt(5).nam = "Window-width:"
opt(5).value = 55
opt(5).min = 55
opt(5).max = 120
'ende der options-variablen
'makros:
#macro datei (array2,endung,flag)
K = DIR("*." & endung,flag)
do
if len(k) > 0 and k <> "." and k <> ".." then
redim preserve array2(i)
array2(i) = K
i += 1
end if
K = DIR("")
LOOP until LEN(K) = 0' solange noch ein nicht gelistetes Verzeichnis existiert
#endmacro
#macro blubb(array)
dim key as string
c = 0
do
cls
locate 1, 1 : PRINT "MuhEdit Directory";
if flag = &h10 then print " | Set Directory = ESC";
locate 2, 1 : Print String(opt(5).value, asc("_"));
locate 3, 1 : Print right(Curdir,50);
locate opt(4).value,1 :Print "Switch between File / Directory = F2 or F4 ";
text(5)
for sh as integer = lbound(array) to opt(4).value-6 'text anzeigen...
if SH + A <= ubound(array) then
locate sh+4 ,1
if sh = c then
print "X "& sh + A &") /"& array(sh+A);
else
print " "& sh + A &") /"& array(sh+A);
end if
else
exit for
end if
next sh
do : sleep 1 : key = inkey : loop until key <> ""
select case asc(right(key,1))
case 60, 62
if flag = &h10 then
flag = &h00
else
flag = &h10
end if
exit do
case 73
if A > 0 then
A -= 1
end if
case 81
if c + a < ubound(array) then A += 1
case 72 'oben
if c > 0 then c -= 1
if A > 0 and c = 0 then a -= 1
case 80 'unten
if c < opt(4).value -6 and c < ubound(array) then
c += 1
else
if c + a < ubound(array) then A += 1
end if
end select
select case asc(left(key,1))
case 27
if flag = &h10 then
weiter = 0
else
C = -1
weiter = 0
end if
exit do
case 14
redim preserve array(ubound(array) +1)
array(ubound(array)) = new_file
cls
case 13
if flag = &h10 then
if c = 0 then
dirs = ".."
else
dirs = dirname(c)
end if
chdir(dirs)
else
seite = filename(c)
weiter = 0
end if
exit do
end select
loop
#endmacro
'subs und funktionen:
sub angleichen()
if ubound(tzeile) < zeile + A then redim preserve tzeile(zeile + A) as string
end sub
function gen_row(number as integer, biggest as integer) as string
dim l_num as integer
dim l_big as integer
dim row as string
l_num = len(str(number))
l_big = len(str(biggest))
row = string( (l_big - l_num), " ") & str(number) & "|"
return row
end function
sub anzeige(anzeigetext() as string, X as integer,Y as integer)
for sh as integer = 3 to (opt(4).value - 2) 'text anzeigen...
if SH + X <= ubound(anzeigetext) then
locate sh, 1
if opt(2).value = 1 then
if ubound(anzeigetext) < opt(4).value -2 and opt(3).value = 1 then
print gen_row(sh + x -2, opt(4).value -2) & mid(anzeigetext(sh+X),Y +1,opt(5).value)
ba = len(gen_row(0,opt(4).value -2))
else
print gen_row(sh + x -2, ubound(anzeigetext)) & mid(anzeigetext(sh+X),Y +1,opt(5).value)
ba = len(gen_row(0,ubound(anzeigetext)))
end if
else
print mid(anzeigetext(sh+X),Y +1,opt(5).value)
end if
else
exit for
end if
next sh
if ubound(anzeigetext) < opt(4).value -2 and opt(2).value = 1 and opt(3).value = 1 then
for i as integer = ubound(anzeigetext) +1 to opt(4).value -2
print gen_row(i -2, opt(4).value -2)
next
end if
end sub
function byte_2_x(B as ulongint) as string
dim KiB as ulongint
dim MiB as ulongint
dim biggest as string
dim stamp as string
if B >= 1024 then
KiB = int(B / 1024)
B -= KiB * 1024
Biggest = "KiB"
end if
if KiB >= 1024 then
MiB = int(KiB / 1024)
KiB -= MiB * 1024
Biggest = "MiB"
end if
select case biggest
case "KiB":
stamp = Kib & " KiB, " & B & " Byte"
case "MiB":
stamp = Mib & "MiB, " & KiB & " KiB"
end select
return stamp
end function
function conv(key as string) as string
dim con as string
dim ascl as integer
ascL = asc(left(key,1))
select case ascL
'case 167 : con = chr(245) '§
case 228 : con = chr(132) 'ä
case 196 : con = chr(142)
case 246 : con = chr(148) 'ö
case 214 : con = chr(153)
case 252 : con = chr(129) 'ü
case 220 : con = chr(154)
case 223 : con = chr(225) 'ß
case else: con = chr(ascl)
end select
return con
end function
sub correct_curs()
angleichen()
if len(tzeile(zeile + A)) >= pot_spalte and len(tzeile(zeile + a)) > 1 then
spalte = pot_spalte
end if
if len(tzeile(zeile + A)) < pot_spalte then
spalte = len(tzeile(zeile + A)) + 1
if len(tzeile(zeile + A)) = 0 then spalte = 1
end if
if spalte + ba > opt(5).value then
B = spalte - (opt(5).value + ba)
spalte -= B
else
b = 0
end if
end sub
sub counter()
dim code as integer
dim blank as integer
dim i as integer
for i = 1 to ubound(tzeile)-1
if len(ltrim(tzeile(i))) = 0 or len(ltrim(tzeile(i),chr(9))) = 0 then blank += 1
if len(ltrim(tzeile(i),chr(9))) <> 0 and len(ltrim(tzeile(i))) <> 0 then code += 1
next i
locate 5,1
print "Textlines: "& code' - blank
print "Blanklines: "& blank
print "Lines total: "& code + blank
end sub
function encoder (txt_crypt as string, key as string) as string
dim txt as string
dim txt_dummy() as integer
dim key_int as integer
dim dummy as integer
dim fail as integer
dim i2 as integer = 1
for i as integer = 1 to len(key)
dummy = asc(mid(key,i,1))
dummy = dummy + (val(right(str(dummy),2))+ i)
key_int += dummy
next
for i as integer = 1 to len(txt_crypt) step +3
i2 += len(key)
if i2 >= len(key) + 33 then
i2 = 1
end if
redim preserve txt_dummy(i)
txt_dummy(i) = val("&h" & mid(txt_crypt,i,3))
txt = txt & chr(txt_dummy(i) - key_int - i2)
next
return txt
end function
function decoder(txt as string, key as string) as string
dim txt_dummy() as integer
dim txt_crypt as string
dim key_int as integer
dim dummy as integer
dim fail as integer
dim i2 as integer = 1
for i as integer = 1 to len(key)
dummy = asc(mid(key,i,1))
dummy = dummy + (val(right(str(dummy),2))+ i)
key_int += dummy
next
for i as integer = 1 to len(txt)
i2 += len(key)
if i2 >= len(key) +33 then
i2 = 1
end if
dummy = asc(mid(txt,i,1))
redim preserve txt_dummy(i)
txt_dummy(i) += dummy + key_int + i2
next
for i as integer = 1 to ubound(txt_dummy)
if len(str(hex(txt_dummy(i)))) <> 3 then
print "alert"
fail = 1
exit for
end if
txt_crypt += str(hex(txt_dummy(i)))
next
if fail <> 1 then
return txt_crypt
Print "Text Crypted."
else
print "Crypt Failure"
end if
end function
function directory(FL as integer) as string
dim dirs as string
DIM AS STRING dirname()
dim filename() as string
dim as integer i = 1
dim c as integer
dim K as string
dim key as string
dim flag as integer
dim weiter as integer
weiter = 1
Locate 4,1
flag = fl
do
if flag = &h10 then
i = 1
redim dirname(1)
dirname(0) = ".."
datei(dirname,"*",flag)
else
i = 0
redim filename(1)
datei(filename,"txt",&h00)
datei(filename,"*ml",&h00)
datei(filename,"bas",&h00)
datei(filename,"mct",&h00)
end if
text(5) 'linie
if flag = &h10 then
blubb(dirname)
if c > ubound(dirname) then continue do
else
blubb(filename)
if c > ubound(filename) then continue do
end if
loop until weiter = 0
if flag = &h00 then laden(seite)
if flag = &h10 then
text 2
locate opt(4).value,1 : print "Accepted";
getkey
end if
return dirs
end function
function eingabe(ByVal frage As String ,vorgabe As String, X as integer,Y as integer, title as string = "") as string
dim zeichen as string
dim zeichenkette as string
dim L as integer
dim Li as string
dim Re as string
dim ascR as integer
dim ascL as integer
dim einf as integer
dim spalte as integer
dim rest as string
einf = 1
zeichenkette = vorgabe
locate x, 1
print frage & Zeichenkette;
spalte = len(zeichenkette) +1
y = len(frage) +1
do
text(2)
text(6, title)
locate x,1: print frage;
locate x,len(frage) + 1: print Zeichenkette;
DRAW STRING ((y + spalte-2)*8 , (x-1)*8), "_" 'Cursor anzeigen
do : sleep 1 : zeichen = inkey : loop while zeichen = ""
Li = mid(zeichen, 1,1)
Re = mid(zeichen, 2.1)
ascL = asc(Li)
ascR = asc(Re)
L = len(zeichenkette)
select case ascR
case 82 'testen ob "einf" gedrückt wurde
if einf = 1 then 'der umschalter
einf = 0
else
einf = 1
end if
case 75: 'links
if spalte > 1 then spalte -= 1
case 77: 'rechts
if spalte < L then spalte += 1
#ifndef __fb_linux__
case 83 'entf
if L >= spalte then
zeichenkette = left(zeichenkette,spalte-1) + right(zeichenkette,L -(spalte))
end if
#endif
end select
if ascL <> 255 then
select case ascL
case 8 'backspace
if L > spalte then
zeichenkette = left(zeichenkette,spalte-2) + right(zeichenkette,L -(spalte-1))
else
zeichenkette=left(zeichenkette,len(zeichenkette)-1)
end if
if spalte <> 1 then spalte -= 1
pot_spalte = spalte
case 13 'enter
return zeichenkette
locate 3,1
exit function
case 27
return vorgabe
locate 3,1
exit function
#ifdef __fb_linux__
case 127 'entf
if L >= spalte then
zeichenkette = left(zeichenkette,spalte-1) + right(zeichenkette,L -(spalte))
end if
#endif
case else
if L >= spalte then
if einf = 0 then
MID(zeichenkette, spalte, 1) = zeichen
else
zeichenkette = left(zeichenkette, spalte-1) + zeichen + right(zeichenkette, (L - spalte +1) )
end if
else
zeichenkette = zeichenkette + zeichen
end if
spalte += 1
end select
end if
loop until zeichen = chr(13)
end function
FUNCTION exist(BYREF DateiName AS STRING, Attr AS INTEGER=&h27)AS INTEGER
RETURN DIR(DateiName, Attr)<>""
END FUNCTION
sub info()
cls
text(1)
dim array as integer
dim zeilen as integer
dim zeichen as integer
dim filesize as integer
OPEN seite FOR BINARY AS #1
filesize = LOF(1)
CLOSE #1
array = ubound(tzeile)
for i1 as integer = 1 to array
if len(tzeile(i1)) > 0 then
zeilen += 1
end if
next i1
for i2 as integer = 1 to array
zeichen += len(tzeile(i2))
next
if len(seite) > 1 then
locate 3,1:print "Filename: "& seite;
locate 4,1:print "Letters: "& zeichen;
locate 8,1:print "Filesize: "& byte_2_x(filesize)
else
Locate 3,1:print "No File loaded / File not saved"
locate 4,1:print "Letters: "& zeichen;
end if
counter()
end sub
#ifdef __fb_Linux__
DECLARE FUNCTION GetFromClipboard() AS INTEGER
DECLARE SUB SendToClipboard(ClipStr() AS STRING)
if shell("xclip -version") = 0 then
clip = 1
end if
cls
SUB sendtoclipboard(ClipStr() AS STRING)
DIM AS INTEGER i,ff
DIM AS STRING helper, file
file=EXEPATH+"/xcliptmp"
ff=FREEFILE
OPEN file FOR OUTPUT AS #ff
for i as integer = lbound(ClipStr) +3 to max(Clipstr())
PRINT #ff,ClipStr(i)
Next
CLOSE #ff
helper="less "+file+" | xclip -sel clip"
SHELL helper
END SUB
FUNCTION getfromclipboard() AS INTEGER
DIM AS STRING helper,file,dummy
DIM AS INTEGER i,j,ff
dim paste() as string
dim l as integer
file=EXEPATH+"/xcliptmp"
helper="xclip -o -sel clip > "+file
SHELL helper
IF exist(file) THEN
ff=FREEFILE
OPEN file FOR INPUT AS #ff
WHILE NOT EOF(ff)
i+=1
LINE INPUT #ff,dummy
redim preserve paste(i)
paste(i)=dummy
Wend
CLOSE #ff
ELSE
i=0
END IF
if len(paste(i)) > 0 then
redim preserve tzeile(ubound(tzeile) + ubound(paste))
for x as integer = max(tzeile()) to zeile + 1 step -1
tzeile(x + ubound(paste) -1) = tzeile(x)
next
L = Len(tzeile(zeile + a))
tzeile(zeile +A) = left(tzeile(zeile +A), spalte +B-1) + paste(1) + right(tzeile(zeile +A), (L - spalte -B +1))
for x as integer = lbound(paste) +2 to ubound(paste)
tzeile(x+zeile-1) = paste(x)
next
end if
zeile += ubound(paste) -1
if zeile > opt(4).value - 2 then
A += (zeile - opt(4).value - 2)
zeile -= (zeile - opt(4).value -2)
end if
if ubound(paste) >= 1 then
spalte = len(tzeile(zeile)) +1
if spalte > opt(5).value then
b = spalte - opt(5).value
spalte -= b
end if
pot_spalte = spalte
end if
kill file
RETURN i
END FUNCTION
#endif
sub laden(filename as string)
dim as integer i = 2
dim dummy as string
redim tzeile(1) as string
if right(filename,3) = "mct" then
crypt_key = eingabe("Password:","",opt(4).value,1)
end if
OPEN filename FOR INPUT AS #1
if right(filename,3) = "mct" then
line INPUT #1, dummy
dummy = encoder(dummy,crypt_key)
end if
while not EOF(1)
i += 1
REDIM Preserve tzeile(i) AS STRING
line INPUT #1, dummy
if right(filename,3) = "mct" then
dummy = encoder(dummy,crypt_key)
end if
tzeile(i) = rtrim(str_replace(dummy, chr(9), string(opt(1).value," ")))
wend
CLOSE #1
redim preserve tzeile(max(tzeile())) 'leere zeilen am ende der datei "abschneiden"
end sub
sub menu
dim key as string
dim c as integer = 1
do
cls
text (6,"Use the Arrow-keys to change the values")
locate opt(4).value, 1
print "Press Enter or ESC to confirm";
for sh as integer = 1 to ubound(opt) 'text anzeigen...
if SH <= ubound(opt) then
locate sh+2 ,1
if sh = c then
print "X "& opt(sh).nam & string(50 - len(opt(sh).nam), " ") & opt(sh).value
else
print " "& opt(sh).nam & string(50 - len(opt(sh).nam), " ") & opt(sh).value
end if
else
exit for
end if
if sh = 50 then exit for
next sh
do : sleep 1 : key = inkey : loop until key <> ""
select case key
case chr(255,77) ' rechts
if opt(c).value < opt(c).max then
opt(c).value += 1
end if
case chr(255,75) 'links
if opt(c).value > opt(c).min then
opt(c).value -= 1
end if
case chr(255,72) 'oben
if c = 1 then
c = ubound(opt)
else
c -= 1
end if
case chr(255,80) 'unten
if c < ubound(opt) then
c += 1
else
c = 1
end if
case chr(27), chr(13)
exit do
end select
loop
if old_w <> opt(5).value or old_h <> opt(4).value then
screenres opt(5).value *8, opt(4).value * 8
COLOR 0, 15
end if
if old_tw <> opt(1).value then tab_correct(old_tw)
end sub
function max(array() as string) as integer
dim m as integer
for i as integer = 3 to ubound(array)
if len(ltrim(array(i))) <> 0 then
m = i
end if
next
return m
end function
function new_file() as string
dim filename as string
dim key as string
cls
text (6,"Create a new File")
if seite <> "" then
locate opt(4).value, 1 : print "Save old file? (J/N)";
do : sleep 1 : key = inkey: loop until key <> ""
if lcase(key) = "j" then
speichern(seite)
end if
end if
filename = eingabe("New Filename: ", "new.txt", opt(4).value, 1, "Create a new File")
if exist(filename) then
locate opt(4).value, 1 : print "File already exists, overwrite? (J/N)";
do : sleep 1 : key = inkey: loop until lcase(key) = "j" or lcase(key) = "n"
if lcase(key) = "j" then
open filename for output as #1
close #1
redim tzeile(0)
elseif lcase(key) = "n" then
exit function
end if
elseif len(filename) <> 0 then
open filename for output as #1
close #1
redim tzeile(0)
end if
return filename
end function
Function str_replace(ByVal V_Data As String, ByVal V_Expression As String, ByVal V_ReplaceBy As String) As String
Dim X As Long
Dim SL As Long
Dim D as String
D = V_Data
SL = Len(V_Expression)
X = 0
Do
X = X + 1
If X > Len(D) - SL + 1 Then Exit Do
If Mid(D, X, SL) = V_Expression Then
D = Mid(D, 1, X - 1) & V_ReplaceBy & Mid(D, X + SL)
X = X - (SL - 1)
If X < 0 then X = 0
End If
Loop
Return D
End Function
sub replace()
cls
dim keyword as string
dim positionX(1 to 46) as integer
dim positionY(1 to 46) as integer
dim repl as string
dim hit as integer
locate 1,1 : print "Search";
locate 2, 1 : Print String(opt(5).value , asc("_"));
text 5
keyword = eingabe("Keyword:","",opt(4).value,1)
repl = eingabe("Replace with:","",opt(4).value,1)
locate 3,1
for i as integer = 1 to ubound(tzeile)
hit = instr(tzeile(i),keyword)
if hit > 0 then
tzeile(i) = left(tzeile(i),hit-1) + repl + right(tzeile(i), len(tzeile(i)) - hit -len(keyword) +1 )
end if
next
end sub
sub search()
cls
dim as integer count = 1
dim keyword as string
dim positionX(1 to 46) as integer
dim positionY(1 to 46) as integer
dim hitnum as integer
dim suchpos as integer
dim as integer hit = 1
locate 1,1 : print "Search";
locate 2, 1 : Print String(opt(5).value , asc("_"));
text 5
keyword = eingabe("Keyword:","",opt(4).value,1)
locate 3,1
for i as integer = 1 to ubound(tzeile)
suchpos = 0
do
hit = instr(suchpos+1,tzeile(i),keyword)
if hit > 0 then
if count < 46 then
print count & ") Hit in Line: "& i - 2 &" Row: "& hit
positionX(count) = i
positionY(count) = hit
count += 1
else
print "Too much hits";
end if
end if
suchpos = hit + len(keyword) -1
loop until hit = 0
next
locate opt(4).value, 1
if positionX(1) <> 0 then
input "Jump to hit number: ", hitnum
zeile = positionX(hitnum)
spalte = positionY(hitnum)
end if
end sub
sub speichern(file as string = "")
cls
dim x as integer
dim as integer i = 3
dim K as string
dim filename() as string
dim dummy as string
text (6,"MuhEdit Saver")
if file = "" then
redim filename(i)
anzeige(filename(), 0, 0)
if len(seite) > 0 then
seite = eingabe("Filename:",seite,opt(4).value,1)
else
seite = eingabe("Filename:","example.txt",opt(4).value,1)
end if
else
seite = file
end if
if lcase(right(seite,3)) <> "mct" then
text 5
print "Do you want to Crypt the file? (Y/N)";
do : sleep 1 : k = inkey : k = lcase(k) : loop until k = "y" or k = "n"
if k = "y" then
seite = left(seite, len(seite)-3) & "mct"
end if
else
k = "y"
end if
if k = "y" then
crypt_key = eingabe("Password:","",opt(4).value,1)
OPEN seite FOR OUTPUT AS #1
print #1, decoder(crypt_key, crypt_key)
close #1
OPEN seite FOR APPEND AS #1
else
OPEN seite FOR OUTPUT AS #1
end if
For x = 3 to max(tzeile())
dummy = str_replace(tzeile(x), string(opt(1).value, " "), chr(9))
if k = "y" then
dummy = decoder(dummy,crypt_key)
end if
PRINT #1, rtrim(dummy)
next
CLOSE #1
if file = "" then text(3) : getkey
end sub
sub tab_correct(old_width as integer)
for i as integer = 1 to ubound(tzeile)
tzeile(i) = str_replace(tzeile(i), string(old_width, " "), chr(9))
tzeile(i) = str_replace(tzeile(i), chr(9), string(opt(1).value, " "))
next
end sub
sub text(ByVal wahl As Integer, title as string = "")
select case wahl
case 1
locate 1, 1 : PRINT "Load = F2 / Save = F3 / Directory = F4 / Quit = ESC";
locate 2, 1 : Print String(opt(5).value , asc("_"));
Locate (opt(4).value-1),1 : Print String(opt(5).value , asc("_"));
Locate (opt(4).value),1 : Print String(opt(5).value , asc(" "));
Locate (opt(4).value),1 : Print "File: "& right(seite,30) &" / Line: "& Zeile + A - 2 &" / Row:"& spalte+b;
case 2
locate (opt(4).value),1 : Print String(opt(5).value, asc(" "));
case 3
locate (opt(4).value),1 : Print String(opt(5).value, asc(" "));
Locate (opt(4).value),1 : Print "Accepted";
locate 3,1
case 4
locate (opt(4).value), 1 : Print String(opt(5).value, asc(" "));
Locate (opt(4).value), 1 : Print "False";
locate 3,1
case 5
Locate (opt(4).value-1),1 : Print String(opt(5).value, asc("_"));
case 6
locate 1, 1 : PRINT title;
locate 2, 1 : Print String(opt(5).value, asc("_"));
Locate (opt(4).value-1),1 : Print String(opt(5).value, asc("_"));
Locate (opt(4).value),1 : Print String(opt(5).value, asc(" "));
case else
exit sub
end select
end sub
'------WIndows-Speziefisch:------'
#ifndef __fb_linux__
#include "windows.bi"
Declare Sub WriteClipboard(Text As String)
Declare Function ReadClipboard() As String
declare sub s_t_a(text as string)
dim text2 as string
sub s_t_a(text2 as string)
dim paste() as string
dim suchpos as integer
dim n_zeile as integer
dim count as integer
dim old as integer
dim L as integer
dim as integer hit = 0
do
hit = instr(suchpos+1,text2,chr(13,10))
if hit > 0 then
count += 1
redim preserve paste(count)
if old > 0 then
paste(count) = mid(text2,old+2,hit - old -1 )
else
paste(count) = left(text2,hit)
end if
old = hit
end if
suchpos = hit + 1
loop until hit = 0
redim preserve paste(count+1)
if old = 0 then
paste(count+1) = mid(text2,old+1,hit - old -1)
else
paste(count+1) = mid(text2,old+2,hit - old -1)
end if
print "-----"
print "test" + paste(count+1)
redim preserve tzeile(ubound(tzeile) + ubound(paste))
for x as integer = max(tzeile()) to zeile + 1 step -1
tzeile(x + ubound(paste) -1) = tzeile(x)
next
L = Len(tzeile(zeile + a))
tzeile(zeile +A) = left(tzeile(zeile +A), spalte +B-1) + paste(1) + right(tzeile(zeile +A), (L - spalte -B +1))
for x as integer = lbound(paste) +2 to ubound(paste)
tzeile(x+zeile-1) = paste(x)
next
n_zeile += ubound(paste) -1
if n_zeile > opt(4).value - 4 then
A += n_zeile - opt(4).value -4
zeile = n_zeile - opt(4).value -4
end if
if zeile > opt(4).value - 2 then
A += (zeile - opt(4).value - 2)
zeile -= A
end if
if ubound(paste) = 1 then
spalte = len(tzeile(zeile)) +1
if spalte > opt(5).value then
b = spalte - opt(5).value
spalte -= b
end if
pot_spalte = spalte
end if
end sub
Function readClipboard() As String
Dim As Any Ptr hGlobal, pGlobal
Dim As String txt
OpenClipboard(0)
hGlobal=GetClipboardData(1)
If hGlobal then
pGlobal=GlobalLock(hGlobal)
txt=Space(lstrlen(pGlobal)) ' txt auf die Länge des Clipboards bringen
lstrcpy(strptr(txt), pGlobal)
ReadClipboard=txt
End If
CloseClipboard()
End Function
Sub writeClipboard(Txt As String)
Dim As Any Ptr lpMem, hGlobalClip
hGlobalClip=GlobalAlloc(GMEM_MOVEABLE Or GMEM_SHARE, Len(Txt)+1)
OpenClipboard(0)
EmptyClipboard()
lpMem=GlobalLock(hGlobalClip)
lstrcpy(lpMem, strptr(Txt))
GlobalUnlock(lpMem)
SetClipboardData(CF_TEXT, hGlobalClip)
CloseClipboard()
End Sub
#endif
'----Ende Windows-teil----'
'------------------Aufruf-flags auswerten------------------'
dim s as integer
if command(1) = "-S" then
opt(4).value = HIWORD(WIDTH)
opt(5).value = LOWORD(WIDTH)
if command(2) <> "" then
seite = command(2)
laden(seite)
end if
CLS
elseif command(1) <> "-S" then
seite = command(1)
laden(seite)
screenres opt(5).value*8, opt(4).value * 8
COLOR 0, 15
CLS
end if
'------------------------hauptprogramm----------------------'
dirs = curdir
locate 3, 0
DO
'------ verwaltung + anzeige ------'
angleichen()
L = len(tzeile(zeile + A))
anzeige(tzeile(), A, B)
text 1
locate zeile ,spalte,1
DRAW STRING ((spalte-1 + ba)*8 , (zeile -1)*8), "_", 'Cursor anzeigen
'------ Eingabe ------':
do : sleep 1 'auf eingabe warten
d = inkey
getmouse mspalte, mzeile,,buttons
mzeile = mzeile / 8
mspalte = mspalte / 8
if buttons = 1 and mzeile <= (opt(4).value - 2) and mzeile > 3 then
if zeile <> mzeile or spalte <> mspalte then
DRAW STRING ((spalte-1 + ba)*8 , (zeile -1)*8), "_",15
end if
zeile = mzeile
spalte = mspalte
'Begin Mouse-Check Code
if ubound(tZeile) < zeile + A then
if ubound(tzeile) > opt(4).value -4 then
A = (ubound(tzeile) -opt(4).value +4)
zeile = (ubound(tzeile) - A)
else
zeile = (ubound(tzeile))
end if
end if
tZeile(zeile + A) = rtrim(tZeile(zeile + A))
if mspalte > len(tZeile(zeile + A)) then
spalte = len(tZeile(zeile + A)) + 1
else
spalte = mspalte
end if
'End Mouse-Check Code
pot_spalte = spalte
d = ""
exit do
end if
loop until d<>""
locate zeile ,spalte,1
if d = "" then continue do
Re = mid(d, 2,1)
ascR = asc(Re)
if command(1) <> "-S" then D = conv(D)
Li = mid(d, 1,1)
ascL = asc(Li)
'------ Verarbeitung teil 1 ------':
SELECT CASE ascR
case 72 'oben
if zeile > 3 then
zeile -= 1
else
if A > 0 then A -= 1
end if
if zeile <> 2 then
correct_curs
end if
case 80 'unten
if zeile + a < ubound(tzeile) then
if zeile < (opt(4).value - 2) then
zeile += 1
else
A += 1
end if
correct_curs
end if
case 75 'links
if spalte > 1 then 'nicht am zeilenanfang
spalte-=1
pot_spalte = spalte + b
else 'am zeilenanfang
if zeile > 3 and zeile < (opt(4).value - 2) then
if B = 0 then
zeile -= 1
spalte = len(tzeile(zeile)) +1
if spalte > opt(5).value then
B = spalte - opt(5).value
spalte -= b
end if
else
B -= 1
end if
elseif zeile = 3 or zeile = (opt(4).value-2) then
if B <> 0 then
B -= 1
elseif B = 0 then
if zeile = opt(4).value-2 then zeile -= 1
if A > 0 then A -= 1
end if
end if
end if
case 77 'rechts
'erklärung:
'wenn spalten-pos kleiner ist als zeilenlänge +2
' und (spaltenpost kleiner ist als zeilenlänge +2 oder zeile kleiner
' als array-größe dann:
if spalte + b < L + 2 and spalte + b < L +1 orelse zeile + a < ubound(tzeile) then
if spalte < opt(5).value then
spalte += 1
pot_spalte = spalte + b
elseif spalte = opt(5).value then
b += 1
end if
end if
if spalte + b >= l +2 then
spalte = 1
B = 0
if zeile < (opt(4).value - 2) then
zeile += 1
else
A += 1
end if
end if
case 107 'das X oben
exit do
case 59 'F1
tzeile(zeile + a) = left(tzeile(zeile + a), spalte + b)
correct_curs
case 63 'F5, fileinfos
info()
sleep
case 64 'F6, Menü
menu
if opt(2).value = 0 then ba = 0
case 65 'F7 Zeilennummern
if opt(2).value = 1 then
opt(2).value = 0
ba = 0
else
opt(2).value = 1
end if
case 62 'F4 (verzeichnis wechseln)
dirs = directory(&h10)
text(1)
case 61 'seite speichern(F3)
speichern()
text(1)
case 60 'Laden (F2)
dirs = directory(&h00)
text(1)
spalte =1
zeile = 3
case 82 'einfügen
if einf = 1 then
einf = 0
else
einf = 1
end if
case 73 'bild hoch
if A > 0 then
A -= 1
end if
correct_curs
case 81 'bild runter
if ubound(tzeile) > (zeile + A) then
a += 1
correct_curs
end if
case 71
pot_spalte = 1
b = 0
correct_curs
case 79
pot_spalte = len(tzeile(zeile +A)) +1
if spalte > opt(5).value then
B = pot_spalte - opt(5).value
pot_spalte -= B
end if
correct_curs
#ifndef __fb_linux__
case 83 'entf
if L >= spalte + B then
tzeile(zeile+A) = left(tzeile(zeile+A),B + spalte-1) + right(tzeile(zeile+A),L -(spalte+B))
elseif L < spalte + B then
redim preserve tzeile(ubound(tzeile) + 1)
rest = tzeile(zeile + a +1)
tzeile(zeile +a ) = tzeile(zeile + a) + rest
for x as integer = zeile + a +1 TO max(tzeile())
tzeile(x) = tzeile(x+1)
next
redim preserve tzeile(ubound(tzeile) -1)
end if
#endif
end select
'------ Verarbeitung teil 2 ------':
if ascL <> 255 then
select case ascL
case 6
search()
if zeile > 46 then
A = zeile - 46
zeile -= A
end if
case 8 'backspace
if spalte > 1 then 'nicht am zeilenanfang
if B = 0 then
spalte-=1
else
b -= 1
end if
locate zeile,spalte
L = len(tzeile(zeile +A))
if L >= spalte+B then
tzeile(zeile+A) = left(tzeile(zeile+A),B + spalte-1) + right(tzeile(zeile+A),L -(spalte+B))
else
tzeile(zeile +A)=left(tzeile(zeile +A),len(tzeile(zeile +A))-1)
end if
else 'am zeilenanfang
if zeile + A <= max(tzeile()) and zeile + A > 3 then
spalte = len(tzeile(zeile +A -1)) +1
redim preserve tzeile(ubound(tzeile) + 1)
rest = tzeile(zeile + A)
tzeile(zeile + A -1) = tzeile(zeile + A -1) + rest
for x as integer = (zeile + A) TO max(tzeile())
tzeile(x) = tzeile(x+1)
next
redim preserve tzeile(ubound(tzeile) -1)
zeile -= 1
end if
if zeile +a > max(tzeile()) and zeile > 3 then
zeile -= 1
spalte = len(rtrim(tzeile(zeile + A)))+1
end if
if zeile = 3 and a > 0 then
if A > 0 then A -= 1
spalte = len(rtrim(tzeile(zeile+a)))+1
end if
pot_spalte = spalte
if max(tzeile()) < ubound(tzeile) then redim preserve tzeile(max(tzeile()))
end if
case 13 'enter
if L >= (spalte + b)-1 and zeile + a < max(tzeile()) then
redim preserve tzeile(ubound(tzeile) + 1)
for x as integer = ubound(tzeile) to (zeile +a +1) step -1
tzeile(x) = tzeile(x-1)
next
rest = right(tzeile(zeile +A), (L - (spalte + B))+1)
tzeile(zeile+A) = left(tzeile(zeile+A), (Spalte +B) -1)
tzeile(Zeile+A+1) = rest
elseif zeile + a < max(tzeile()) and L = 0 then
redim preserve tzeile(ubound(tzeile) + 1)
for x as integer = ubound(tzeile)-1 to (zeile + a) step -1
tzeile(x+1) = tzeile(x)
next
end if
if zeile < (opt(4).value - 2) then
zeile += 1
spalte = 1
B = 0
else
spalte = 1
B = 0
A += 1
end if
pot_spalte = spalte
case 14
seite = new_file
cls
#IFdef __fb_linux__
case 127 'ENTF
if L >= spalte + B then
tzeile(zeile+A) = left(tzeile(zeile+A),B + spalte-1) + right(tzeile(zeile+A),L -(spalte+B))
elseif L < spalte + B then
redim preserve tzeile(ubound(tzeile) + 1)
rest = tzeile(zeile + a +1)
tzeile(zeile +a ) = tzeile(zeile + a) + rest
for x as integer = zeile + a +1 TO max(tzeile())
tzeile(x) = tzeile(x+1)
next
redim preserve tzeile(ubound(tzeile) -1)
end if
#endif
'------ Copy und Paste ------':
case 3
#ifdef __fb_linux__
if clip = 1 then sendtoclipboard(tzeile())
#else
text2=""
for i as integer = 3 to max(tzeile())
text2 = text2 + tzeile(i) + chr(13,10)
next
text2=left(text2,len(text2)-2)
WriteClipboard(Text2)
#endif
case 22
#ifdef __fb_linux__
if clip = 1 then getfromclipboard()
#else
text2 = ReadClipboard
s_t_a(text2)
#endif
'-----------------------------'
case 18
replace()
case 19
speichern()
text(1)
case 27 'escape
exit do
case 32 to 127,9,245, 132,142,148,153,129,154,225
if D = chr(9) then
D = string(opt(1).value, " ")
if spalte <= opt(5).value -4 then
spalte += len(D) -1
else
B += len(D) -1 - (opt(5).value - spalte)
end if
end if
L = len(tzeile(zeile +A))
if L >= spalte + B then
if einf = 0 then
MID(tzeile(zeile + A), spalte +B, 1) = d
else
tzeile(zeile +A) = left(tzeile(zeile +A), spalte +B-1) + d + right(tzeile(zeile +A), (L - spalte -B +1))
end if
else
tzeile(zeile +A) = tzeile(zeile +A) + d
end if
if spalte = opt(5).value then
b += 1
else
spalte += 1
end if
pot_spalte = spalte + b
end select
end if
cls
loop
end