Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Idee eines möglichen Kerns eines Editors???? sehr unfertig!!!
| Uploader: |  Muttonhead |
| Datum/Zeit: | 22.06.2011 23:39:25 |
'UDT für Beschreibung einer Zeile
type TextRow
text as string 'enthält die Zeile
index as integer 'Zeilennummer
prevrow as TextRow ptr 'Zeiger auf vorhergehende Zeile, 0 wenn 1.Zeile
nextrow as TextRow ptr 'Zeiger auf nachfolgende Zeile, 0 wenn letzte Zeile
end type
'UDT für Beschreibung einer eindeutigen Textposition, für Cursor,Clipboardmarker
type TextMark
row as TextRow ptr
position as integer
end type
'"Objekt" zur Verwaltung und Editieren eines Textes
type TextObject
private:
cursor as TextMark 'Hmmm ;)
rows as integer 'Anzahl der Zeilen
firstrow as TextRow ptr 'Zeiger auf erste Zeile
lastrow as TextRow ptr 'Zeiger auf letzte Zeile
'kommt vielleicht später mal: ein internes Clipboard
' clipstart as TextMark
' clipend as TextMark
' clipboard as TextRow ptr
public:
declare constructor
declare destructor
'Editierfunktionen
declare sub KeyAddChar(c as string)
declare sub KeyBackspace
declare sub KeyDelete
declare sub KeyReturn
'Cursorsteuerung
declare sub KeyUp
declare sub KeyDown
declare sub KeyLeft
declare sub KeyRight
'Input/Output
'declare sub GetText (newline as string=chr(13)+chr(10))
'declare sub PutText (filename as string)
private:
'Speicherverwaltung
declare sub DeleteRows (byval row as TextRow ptr) 'Löscht alle Zeilen ab/einschließlich übergebene(r) Zeile
'Statistik
declare sub MakeIndex 'Versieht alle Zeilen mit einer Zeilennummer
'Zeilenlogik
declare sub AddRow 'Fügt eine Zeile ab Cursor hinzu
declare sub MeltUpRow 'Verschmelzen 2er Zeilen "nach oben" somit löschen
end type
constructor TextObject
'bei Erstellung eines TOs ist mindestens eine Zeile notwendig
'wird hiermit erledigt
dim tmptr as TextRow ptr
tmptr=new TextRow
if tmptr then
tmptr->text="" 'neue Zeile ist leer
tmptr->index=1 'da erste bekommt sie auch den Index 1
tmptr->prevrow=0 'keinen Vorgänger
tmptr->nextrow=0 'kein Nachfolger
firstrow=tmptr 'Zeile als erste im TO definieren
lastrow=tmptr 'Zeile als letzte im TO definieren... ist also beides!!!
cursor.row=tmptr 'Cursor in die erste Zeile setzen
cursor.position=1 'Cursor an erste Position setzen
end if
end constructor
destructor TextObject
DeleteRows firstrow
'DeleteRows clipboard
end destructor
sub TextObject.KeyAddChar(c as string)
cursor.row->text= left(cursor.row->text,cursor.position-1) & c & right(cursor.row->text,len(cursor.row->text)-cursor.position+1)
cursor.position +=1
end sub
sub TextObject.KeyBackspace
'an Position 1 in der ersten Zeile ist kein Backspace möglich
if cursor.position=1 and cursor.row<>firstrow then MeltUpRow
if cursor.position>1 then
cursor.row->text=left(cursor.row->text,cursor.position-2) & right(cursor.row->text,len(cursor.row->text)-cursor.position+1)
cursor.position -=1
end if
end sub
sub TextObject.KeyDelete
'wenn Cursor im Text wird Cursorzeichen gelöscht
if cursor.position>0 and cursor.position<=len(cursor.row->text) then _
cursor.row->text=left(cursor.row->text,cursor.position-1) & right(cursor.row->text,len(cursor.row->text)-cursor.position)
'wenn Cursor hinter dem Text dann die folgende Zeile nach oben holen
'nur möglich wenn sich der Cursor nicht am Ende der letzten Zeile befindet
if cursor.position>len(cursor.row->text) and cursor.row<>lastrow then
'xxxD
'Byyy
'Da ein Delete im Text von Position D aus das gleiche bewirkt wie ein Backspace von Position B
'und die Methode MeltUpRow eigentlich für Backspace gedacht ist, wird der Cursor im TO einfach an den Beginn
'der folgenden Zeile gesetzt und ein MeltUpRow aufgerufen!!!
cursor.row=cursor.row->nextrow
cursor.position=1
MeltUpRow
end if
end sub
sub TextObject.KeyReturn
AddRow
end sub
sub TextObject.KeyUp
'nicht über die erste Zeile hinaus
if cursor.row<>firstrow then
cursor.row=cursor.row->prevrow'damit sind wir schon in der vorhergehenden Zeile!!!
'Falls Zeile kürzer ist als aktuelle Cursorposition muß entsprechend angepaßt werden
'Cursor wird dann hinter der Zeile positioniert
if len(cursor.row->text)+1 < cursor.position then cursor.position=len(cursor.row->text)+1
end if
end sub
sub TextObject.KeyDown
'nicht über die letzte Zeile hinaus
if cursor.row<>lastrow then
cursor.row=cursor.row->nextrow'damit sind wir schon in der nachfolgenden Zeile!!!
'Falls Zeile kürzer ist als aktuelle Cursorposition muß entsprechend angepaßt werden
'Cursor wird dann hinter der Zeile positioniert
if len(cursor.row->text)+1 < cursor.position then cursor.position=len(cursor.row->text)+1
end if
end sub
sub TextObject.DeleteRows (byval row as TextRow ptr)
dim as TextRow ptr nrow
if row then 'wenn Zeile vorhanden(r>0), dann...
do
nrow=row->nextrow 'Hole aus der Zeile den Zeiger der nächsten Zeile (ist 0 wenn keine nächste Zeile existiert)
delete row 'Lösche aktuelle Zeile
row=nrow 'Erkläre nächste Zeile zur Aktuellen
loop until row=0 'wenn keine Zeile da dann raus aus Loop
end if
end sub
sub TextObject.MakeIndex
dim as TextRow ptr row,nrow
dim as integer counter=0
row=firstrow 'Hole erste Zeile
do
counter +=1
row->index=counter 'Schreibe Zeilennummer in Zeile
row=row->nextrow 'Hole aus der Zeile den Zeiger der nächsten Zeile
loop until row=0 'wenn keine Zeile da dann raus aus Loop
rows=counter 'Gesamtzeilenzahl im TO entspricht counter
end sub
sub TextObject.AddRow
'In der Regel wird durch Return eine neue Zeile geöffnet.
dim as TextRow ptr tmptr, ntr
dim as string newtext
tmptr=new TextRow 'Zeile erzeugen
if tmptr then 'wenn erfolgreich dann...
'String der Zeile in Abhängigkeit von der Cursorposition splitten *****************************
'
'1.Fall >>> Cursor ist an Position 1. Der gesamte String geht in die neue Zeile und die alte Zeile wird leer.
' Der Cursor ist in der neuen Zeile an Position 1
'2.Fall >>> Cursor ist im Bereich Position >1 bis Len(Zeile). String bleibt bis zur Position Cursor-1 in der alten
' Zeile, ab dem Cursor wandert der Rest des Strings in die neue Zeile. Der Cursor ist in der neuen
' Zeile an Position 1
'3.Fall >>> Cursor ist hinter dem String, also Len(Zeile)+1. Der String bleibt vollständig in der alten Zeile und
' es wird eine neue leere Zeile erzeugt.Der Cursor ist in der neuen Zeile an Position 1
'1.Fall
if cursor.position=1 then
newtext=cursor.row->text 'Zeilentext sichern
cursor.row->text="" 'Zeilentext der alten Zeile löschen
end if
'2.Fall
if cursor.position>1 and cursor.position<=len(cursor.row->text) then
newtext=right(cursor.row->text , (len(cursor.row->text)-cursor.position+1) )'Zeilentext ab Cursor sichern
cursor.row->text=left(cursor.row->text , cursor.position-1)'Zeilentext der alten Zeile verkürzen
end if
'3.Fall
if cursor.position>len(cursor.row->text) then newtext=""
tmptr->text=newtext ' Zeileninhalt der neuen Zeile zuweisen
'Verlinken ************************************************************************************
if cursor.row=lastrow then 'wenn die Zeile am Textende angefügt wird dann...
cursor.row->nextrow=tmptr 'neue Zeile in "Cursorzeile" als Nachfolger eintragen
tmptr->prevrow=cursor.row 'Cursorzeile in neuer Zeile als Vorgänger eintragen
lastrow=tmptr 'neue Zeile im TO als Letzte eintragen
else 'wenn die Zeile mittendrin eingefügt wird dann...
ntr=cursor.row->nextrow 'Nachfolger der Cursorzeile merken, wird zu Nachfolger der neuen Zeile
cursor.row->nextrow=tmptr 'neue Zeile in "Cursorzeile" als Nachfolger eintragen
tmptr->prevrow=cursor.row 'Cursorzeile in neuer Zeile als Vorgänger eintragen
tmptr->nextrow=ntr 'Nachfolger in neue Zeile als Nachfolger...
ntr->prevrow=tmptr 'neue Zeile als Vorgänger des Nachfolgers...
'öhhmm jahhh... die letzten 2 Kommentare lesen sich sehr blöd, ist aber so... XD !!!
end if
'Cursor in neue Zeile an Position 1 setzen ****************************************************
cursor.row=tmptr
cursor.position=1
MakeIndex'Zeilen neu durchzählen
end if
end sub
sub TextObject.MeltUpRow
'Zeilenverschmelzung "nach oben" zur Vorhergehenden
'Hilfsvariablen um zu lange Referenzierungen übersichtlicher zu gestalten
dim as TextRow ptr prevr,cursr,nextr
dim as string curstext
cursr=cursor.row 'aus TO noch aktuelle Cursorzeile merken
curstext=cursor.row->text 'String dieser Cursorzeile zwischenspeichern
prevr=cursr->prevrow 'Vorgänger
nextr=cursr->nextrow 'Nachfolger
'Cursorzeile aus der Verlinkung lösen, somit alte Cursorzeile freistellen
prevr->nextrow = nextr
nextr->prevrow = prevr
cursor.row=prevr 'im TO die vorhergehende Zeile als Cursorzeile definieren
cursor.position=len(cursor.row->text)+1 'im TO den Cursor hinter dem String der neuen Cursorzeile positionieren
cursor.row->text +=curstext 'Text aus alter Cursorzeile an neue Cursorzeile anhängen
'alte Cursorzeile entgültig löschen
delete cursr
MakeIndex 'Neu Durchzählen
end sub