| products/sources/formale sprachen/Delphi/Elbe 1.0/Sources/ |
|
Quellcode-Bibliothek© Kompilation durch diese Firma[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]Datei: mpb003.mco Sprache: Delphi |
|
||||||
|
//----------------------------------------------------------
// //---------------------------------------------------------- unit Editor; interface uses //---------------------------------------------------------- //local //---------------------------------------------------------- GenDefs,Language,CodeCompletion,Undo, //---------------------------------------------------------- //global //---------------------------------------------------------- SysUtils,Classes,Controls,StdCtrls,ComCtrls,Messages, Graphics,Types,ShellAPI,RichEdit; //---------------------------------------------------------- // //---------------------------------------------------------- const maxinputbuffer=100000; leastmargin=5; CH_Blank=' '; CH_Return=chr(Key_Return); CH_LineFeed=chr(Key_LineFeed); CH_Tab=chr(Key_Tab); unallowedchars:set of ansichar=[CH_Blank,CH_Return,CH_LineFeed,CH_Tab]; {$I ownconsts.inc} //---------------------------------------------------------------------------- //rtf formats //---------------------------------------------------------------------------- RtfParagraph='\par'; SetSize='\f1\fs'; SetColor='\cf'; SetNoColor='\cf0'; Underline='\ul '; UnderLineOff='\ulnone'; Bold='\b'; BoldOff='\b0 '; Subscript='\sub '; SubscriptOff='\nosupersub '; Superscript='\super '; SuperscriptOff='\nosupersub '; Strike='\strike'; StrikeOff='\strike0'; Italic='\i'; ItalicOff='\i0'; Font0='\i\f0 '; Font1='\i\f1 '; Font2='\i\f2 '; Font3='\i\f3'; SetBackColor='\f1\cb1\cf'; SetNoBackColor='';//funktioniert nicht Omega='\u963?';//Achtung: Zahl (963) ist dezimal Landau-Symbol Summenzeichen='\u931?';//dito Produktzeichen='\u928?';//dito //---------------------------------------------------------- // //---------------------------------------------------------- type {$I owntypes.inc} //---------------------------------------------------------------------------- //Longtexts of Trees //---------------------------------------------------------------------------- TSingleAttribute= record yyfil:JString40; yylin:integer; yycol:integer; yylen:integer; yycolor:JString8; yyindent:integer; end; TAttrList= record Y: array of TSingleAttribute; AttrCount:integer; end; LineMemory= record lines: array of integer; count:integer end; //---------------------------------------------------------- // //---------------------------------------------------------- TEde= Class(TRichEdit)private // protected procedure CreateWnd; override; published constructor Create(AOwner:TComponent);override; destructor Destroy;override; function printablechar(ch:char):boolean; procedure SaveToUndoBuffer(); procedure LoadFromUndoBuffer(); procedure InitUndoBuffer(); function SetRtfAttributes(Efs:JString;streamin:TStream; var streamout:TStream):boolean; function CreateHighlited(Nr:integer):TimeTripel; procedure Mark(); procedure CreatePlain(Nr:integer); procedure CreateString(Stdout,Stderr:JString); procedure CreateBin(Nr:integer); procedure SaveRtfTo(S:JString); procedure initLinearray(Anz:integer); procedure markLinePos(L,C:integer); procedure markWord(L,C,LL:integer); procedure setCharPos(P,L:integer); function getFirstVisibleLine():integer; function getLastVisibleLine():integer; function getLineHeight():integer; function getRectBottom():integer; function getFileNumber(TFile:JString):integer; function getNumberofVisibleLines():integer; function getLinefromCharIndex(C:integer):integer; function getCharIndexfromLine(L:integer):integer; function GetTextRange(BeginPos,EndPos:integer):JString; function getDotFromChar(C:integer):TPoint; procedure getCurrentWord(); function getWordBounds(P:integer):TPoint; function getPos():TPoint; function Occurrence(S:JString):integer; procedure CreateDummyFile(); procedure errorn(n:integer;S:JString); function ask(n:integer;S,Z:JString):integer; function inform(n:integer;S,Z:JString):boolean; function Save(askhim:boolean):integer; procedure makeLineBlockNumbers(); procedure searchreplace(Kind:SeaRepFun); procedure WindProc(var Message:TMessage); procedure OnMouse(var Message:TMessage); procedure OnMouseDbl(var Message:TMessage); procedure OnKey(var Message:TMessage); procedure Indenting(var Message:TMessage); procedure Bracketing(); procedure PositEditor; procedure PositioningCorrect(from,num:integer); procedure Scroller(WheelDelta:integer); function RtfHeader():AnsiString; procedure LoadAttributes(TC:PAnsiChar); procedure LoadHighLites(Hi: array of TColor); procedure LoadNames(Ar: array of String); function getVScrollPos():integer; function getScrollPos():TPoint; procedure setScrollPos(P:TPoint); function getPosMod(R:TPoint):TPoint; procedure setl(var a: array of char;S:JString); procedure Representation(var S:JString;var streamout:TStream); function getCharat(pos:integer):char; procedure ShowRedraw(); procedure HideRedraw(); procedure CreateRtfReadOnly(Nr:integer); function findsingle(Start:integer):TRegInfo; function findregular(Rex:TRegExp;Start:integer):TRegInfo; function findset(Start:integer;se:ansiset):TRegInfo; function findmeta(Start:integer;ch:ansichar):TRegInfo; procedure setSearchString(Str:JString;regex:boolean); procedure parse(Str:JString); procedure addmeta(var Reg:TRegExp;ch:char); procedure addset(var Reg:TRegExp;Str:JString); procedure ScrollLeft(); procedure InsertStream(const Stream:TStream); procedure clearUndoBuffer(); procedure settabs(); procedure flushstreams(); procedure clearstreams(); published procedure CNNotify(var Msg:TMessage); public //technical fields linemargin:integer; KeyFound:boolean; CreateBackup:boolean; hasRepresentation:boolean; SearchString,ReplaceString:TextString; MinCol,NumCol,MaxCol:integer; MaxColFound,MaxLineCount:integer; FoundAt,RegularStartPos:integer; Wrapped:boolean; brack1,brack2:integer; LoadedFile:String; LoadedFileNumber:integer; LoadedFormat:SourceTypes; InputFormat:SourceFormats; TA:TAttrList; Syntaxbold,SyntaxHighlight,ShowSpaces:boolean; Blocknumbers,LineNumbers:boolean; Highlites: array [Highlite] of TColor; oldwinproc:TWndMethod; Uli,Ulibuf:TUndoList; Regexp:TRegExp; Regexplength:integer; Parsecheck:boolean; CodeCompleter:TCodeWindow; Sources: array of String; Buffer:JString; Buffillled,Super,Sub:boolean; CurrentWord:JString; lang:Naturallanguages; casesensitive:boolean; dowordwrap:boolean; regexpsearch:boolean; indentingpossible:boolean; doindent:boolean; indentchars:integer; Artificiallines:boolean; reloading:boolean; showURL:boolean; Linearray:LineMemory; Blockarray:LineMemory; streamatt:TStream; streamfile:TFileStream; streamorig:TFileStream; end; //---------------------------------------------------------- // //---------------------------------------------------------- procedure Register; implementation uses Windows,Variants,Forms,Dialogs,jpeg,ExtCtrls,Menus,ToolWin, Buttons,Math,StrUtils,ImgList,Printers,CheckLst,Clipbrd, DateUtils,Tabs; //---------------------------------------------------------- // //---------------------------------------------------------- procedure Register; begin RegisterComponents('cococo.de',[TEde]); end; //---------------------------------------------------------- // //---------------------------------------------------------- constructor TEde.Create(AOwner:TComponent); begin inherited Create(AOwner); LoadedFile:=''; LoadedFormat:=RTF; MinCol:=1;//do not shift NumCol:=6;//do not shift MaxCol:=72; brack1:=0; brack2:=0; clearUndoBuffer(); Regexp:=nil; Paragraph.FirstIndent:=margin; CodeCompleter:=TCodeWindow.Create(self); hasRepresentation:=false; casesensitive:=false; regexpsearch:=false; reloading:=false; showURL:=true; doindent:=false; streamatt:=nil; streamfile:=nil; indentchars:=1; Artificiallines:=false; indentingpossible:=false end; //---------------------------------------------------------- // //---------------------------------------------------------- destructor TEde.Destroy; begin if CodeCompleter.Visible then CodeCompleter.setInvisible; WindowProc:=oldwinproc; CodeCompleter.Free; Uli.Free; inherited; end; //---------------------------------------------------------- //set tab stops //---------------------------------------------------------- procedure TEde.settabs(); var i,DialogUnitsX,PixelsX,sels,sell:integer; modi:boolean; begin modi:=Modified; DialogUnitsX:=LoWord(GetDialogBaseUnits); PixelsX:=25; WantTabs:=true; TabStop:=true; Paragraph.TabCount:=10; for i:=1 to Paragraph.TabCount do Paragraph.Tab[i-1]:=((PixelsX*i)*4)div DialogUnitsX; sels:=SelStart; sell:=SelLength; selectall(); SelStart:=sels; SelLength:=Sell; Modified:=modi; end; //---------------------------------------------------------- //experimental: insert stream into rtf //---------------------------------------------------------- procedure TEde.InsertStream(const Stream:TStream); var EditStream:TEditStream;//callback used to read inserted RTF //call back function function EditStreamReader(dwCookie:DWORD;pBuff:Pointer;cb:LongInt; pcb:PLongInt):DWORD;stdcall; begin Result:=$0000;//assume no error try pcb^:=TStream(dwCookie).Read(pBuff^,cb);//read data from stream except Result:=$FFFF;//indicates error to calling routine end; end; begin lines.BeginUpdate; try //Make sure rich edit is large enough to take inserted code MaxLength:=MaxLength+Stream.Size; //Stream in the RTF via EM_STREAMIN message EditStream.dwCookie:=DWORD(Stream); EditStream.dwError:=$0000; EditStream.pfnCallback:=@EditStreamReader; Perform(EM_STREAMIN,SFF_SELECTION or SF_RTF or SFF_PLAINRTF, LPARAM(@EditStream)); //Report any errors as a bug if EditStream.dwError<>$0000 then raise Exception.Create('RTFInsertStream: Error inserting stream'); finally lines.EndUpdate; end; end; //---------------------------------------------------------- // //---------------------------------------------------------- function TEde.printablechar(ch:char):boolean; var ok:boolean; begin ok:=(ch>=' ')or(ord(ch)=9)or(ord(ch)=10)or(ord(ch)=13); Result:=ok end; //---------------------------------------------------------- //bfi file size //---------------------------------------------------------- function getFileLength(F:JString;var binfile:boolean):integer; var Strin:TFileStream; CS:LongInt; begin CS:=0; binfile:=false; If FileExists(F) then begin Strin:=TFileStream.Create(F,fmOpenRead or fmShareDenyNone); CS:=Strin.Size; binfile:=binfile or(pos('.exe',F)>0)or(pos('.dll',F)>0)or(pos('.com',F)>0)or (pos('.ico',F)>0); Strin.Free; end; getFileLength:=CS; end; //------------------------------------------------------------------ //Procedure Setl //moving of short arrays //------------------------------------------------------------------ procedure TEde.setl(var a: array of char;S:JString); var i,sa,ls:integer; begin sa:=sizeof(a); ls:=length(S); for i:=0 to length(a)-1 do a[i]:=chr(0); i:=0; if ls>=sa then errorn(101,'fataler Fehler') else while (i<ls)and(i<sa) do begin a[i]:=S[i+1]; i:=i+1 end; end; //---------------------------------------------------------- //Init //---------------------------------------------------------- procedure TEde.errorn(n:integer;S:JString); begin showmessage(IntToStr(n)+': '+S); end; //---------------------------------------------------------- //Init //---------------------------------------------------------- function TEde.ask(n:integer;S,Z:JString):integer; var MS:JString; begin MS:=trans(lang,n,S)+Z; Result:=MessageDlg(MS,mtInformation,[mbYes,mbNo,mbCancel],0); end; //---------------------------------------------------------- //Init //---------------------------------------------------------- function TEde.inform(n:integer;S,Z:JString):boolean; begin S:=trans(lang,n,S)+Z; Result:=MessageDlg(S,mtInformation,[mbOK],0)=mrOk; end; //---------------------------------------------------------- //Init //---------------------------------------------------------- procedure TEde.LoadNames(Ar: array of String); var i,LL:integer; begin LL:=length(Ar); setlength(Sources,LL); for i:=0 to pred(LL) do Sources[i]:=Ar[i]; end; //------------------------------------------------------------------ //-- //get the files of a compilation/analysis -- //-- //------------------------------------------------------------------ function TEde.Occurrence(S:JString):integer; var P,C,R:integer; begin P:=0; C:=0; setSearchString(S,regexpsearch); repeat R:=findsingle(P).pos; if R>0 then begin C:=C+1; P:=R+1; end; until R<0; Occurrence:=C; end; //------------------------------------------------------------------ //-- //get the files of a compilation/analysis -- //-- //------------------------------------------------------------------ function TEde.getFileNumber(TFile:JString):integer; var P:integer; begin getFileNumber:=1; for P:=0 to length(Sources)-1 do if Sources[P]=TFile then getFileNumber:=P; end; //------------------------------------------------------------------ //-- //------------------------------------------------------------------ function TEde.getScrollPos():TPoint; const EM_getScrollPos=WM_User+221; var P:TPoint; begin SendMessage(Handle,EM_getScrollPos,0,LPARAM(@P)); getScrollPos:=P; end; //------------------------------------------------------------------ //-- //------------------------------------------------------------------ procedure TEde.setScrollPos(P:TPoint); const EM_setScrollPos=WM_User+222; begin SendMessage(Handle,EM_setScrollPos,0,LPARAM(@P)); end; //------------------------------------------------------------------ //-- //------------------------------------------------------------------ procedure TEde.ScrollLeft(); var P:TPoint; begin P:=getScrollPos(); P.X:=0; setScrollPos(P); end; //------------------------------------------------------------------ //-- //------------------------------------------------------------------ function TEde.getVScrollPos():integer; const EM_getScrollPos=WM_User+221; var P:TPoint; begin SendMessage(Handle,EM_getScrollPos,0,LPARAM(@P)); getVScrollPos:=P.Y; end; //------------------------------------------------------------------ // //------------------------------------------------------------------ procedure TEde.parse(Str:JString); var P,ls:integer; Reg:TRegExp; ch:char; sets:JString; begin Reg:=nil; P:=1; ls:=length(Str); while (P<=ls)and(Str[P]<>']') do begin ch:=Str[P]; case ch of '^': addmeta(Reg,ch); '.': addmeta(Reg,ch); '$': addmeta(Reg,ch); '[':begin sets:=''; while (P<=ls)and(Str[P]<>']') do begin sets:=sets+Str[P]; P:=P+1; if (P<=ls)and(Str[P]='\') then begin sets:=sets+Str[P]; P:=P+1; sets:=sets+Str[P]; P:=P+1; end; end; if (P<=ls)and(Str[P]=']') then sets:=sets+Str[P]; addset(Reg,sets); end else Parsecheck:=false end; P:=P+1 end; Regexp:=Reg; end; //------------------------------------------------------------------ // //------------------------------------------------------------------ procedure TEde.setSearchString(Str:JString;regex:boolean); begin regexpsearch:=regex; setl(SearchString.S,Str); SearchString.Regular:=regex; if regexpsearch then parse(Str); end; //------------------------------------------------------------------ // //------------------------------------------------------------------ procedure TEde.addmeta(var Reg:TRegExp;ch:char); var n:TRegExp; begin n:=TRegExp.Create(); n.R:=single; n.ch:=ansichar(ch); if Reg<>nil then Reg.append(n) else Reg:=n; end; //------------------------------------------------------------------ // //------------------------------------------------------------------ procedure TEde.addset(var Reg:TRegExp;Str:JString); var n:TRegExp; last,prelast:char; i,j,ls:integer; begin n:=TRegExp.Create(); n.R:=Regset; n.inset:=[]; i:=2; last:=chr(0); prelast:=chr(0); ls:=length(Str); while (i<=ls)and(Str[i]<>']') do begin if Str[i]='\' then begin i:=i+1; if i>ls then Parsecheck:=false end; if last='-' then begin for j:=ord(prelast)+1 to ord(Str[i]) do n.inset:=n.inset+[chr(j)] end else if Str[i]<>'-' then n.inset:=n.inset+[Str[i]]; prelast:=last; last:=Str[i]; i:=i+1 end; Parsecheck:=Parsecheck and(i<=ls)and(Str[i]=']'); if Reg<>nil then Reg.append(n) else Reg:=n; end; //------------------------------------------------------------------ // //------------------------------------------------------------------ function TEde.findset(Start:integer;se:ansiset):TRegInfo; var res:TRegInfo; ch:ansichar; Min,F,LL:integer; Str:JString; begin res.pos:=-1; res.len:=1; LL:=length(lines.Text); if (Start<LL)and(Start>=0) then begin Min:=LL+1; for ch in se do begin Str:=ch; if casesensitive then F:=FindText(Str,Start,LL,[stMatchCase]) else F:=FindText(Str,Start,LL,[]); if F>=0 then if F<Min then Min:=F; end; if Min<=LL then res.pos:=Min; end; Result:=res; end; //------------------------------------------------------------------ // //------------------------------------------------------------------ function TEde.findmeta(Start:integer;ch:ansichar):TRegInfo; var res:TRegInfo; Str:JString; LL,ci:integer; begin res.pos:=-1; res.len:=1; LL:=length(Text); if (Start<LL)and(Start>=0) then begin case ch of '^':begin res.len:=0; if Start=0 then res.pos:=0 else if getLinefromCharIndex(Start)=lines.count then res.pos:=-1 else if GetTextRange(Start-1,Start-1)=chr(Key_Return) then res.pos:=Start else begin Str:=chr(Key_Return); res.pos:=FindText(Str,Start,LL,[stMatchCase]); if res.pos>=0 then begin ci:=getLinefromCharIndex(res.pos); if ci+1>=lines.count then res.pos:=-1 else res.pos:=res.pos+1; end; end; end; '$':begin res.len:=1; Str:=chr(Key_Return); res.pos:=FindText(Str,Start,LL,[stMatchCase]); ci:=getLinefromCharIndex(res.pos); if ci+1>=lines.count then res.pos:=-1 end; '.':begin res.ch:=getCharat(Start); res.pos:=Start; res.len:=1; end else res.pos:=-1; end; end; Result:=res; end; //------------------------------------------------------------------ //regular expression search //------------------------------------------------------------------ function TEde.findregular(Rex:TRegExp;Start:integer):TRegInfo; var this,last,first:TRegInfo; R:TRegExp; pos,LL,overalllen,lenbefore,minpos:integer; allfound,collating:boolean; function findone():TRegInfo; var res:TRegInfo; begin if R.R=single then res:=findmeta(pos,R.ch) else res:=findset(pos,R.inset); minpos:=max(minpos,res.pos-lenbefore); pos:=pos+1; lenbefore:=lenbefore+res.len; R:=R.next; Result:=res end; begin pos:=Start; LL:=length(lines.Text); allfound:=true; minpos:=pos; repeat collating:=true; lenbefore:=0; R:=Rex; first:=findone(); last:=first; while (R<>nil)and allfound and collating and(pos<LL)and(last.pos>=0) do begin pos:=last.pos+last.len; this:=findone(); allfound:=allfound and(this.pos>=0); collating:=last.pos+last.len=this.pos; last:=this; end; overalllen:=lenbefore; pos:=max(minpos-1,first.pos+1); until (collating and allfound)or(pos>=LL)or not allfound; if collating and allfound then begin first.len:=overalllen; Result:=first; end else begin first.pos:=-1; first.len:=0; Result:=first end end; //------------------------------------------------------------------ // //------------------------------------------------------------------ function TEde.findsingle(Start:integer):TRegInfo; var res:TRegInfo; begin if not regexpsearch then begin res.len:=length(String(SearchString.S)); if casesensitive then res.pos:=FindText(SearchString.S,Start,length(lines.Text),[stMatchCase]) else res.pos:=FindText(SearchString.S,Start,length(lines.Text),[]); end else res:=findregular(Regexp,Start); Result:=res; end; //------------------------------------------------------------------ //current word including '.' //------------------------------------------------------------------ procedure TEde.getCurrentWord(); var LeftPos,OrigStart,RightPos:integer; begin LeftPos:=SelStart; OrigStart:=SelStart; //go to the left LeftPos:=SendMessage(Handle,EM_FINDWORDBREAK,WB_MOVEWORDLEFT,LeftPos); CurrentWord:=GetTextRange(LeftPos,OrigStart); if CurrentWord>'' then begin while CurrentWord[1]='.' do begin LeftPos:=SendMessage(Handle,EM_FINDWORDBREAK,WB_MOVEWORDLEFT,LeftPos); CurrentWord:=GetTextRange(LeftPos,OrigStart); end; end; if LeftPos<=0 then LeftPos:=OrigStart; //go to the right RightPos:=SendMessage(Handle,EM_FINDWORDBREAK,WB_MOVEWORDRIGHT,OrigStart+1); if RightPos>-1 then CurrentWord:=GetTextRange(LeftPos,RightPos-1); if CurrentWord>'' then begin while CurrentWord[length(CurrentWord)]='.' do begin RightPos:=SendMessage(Handle,EM_FINDWORDBREAK,WB_MOVEWORDLEFT,RightPos); CurrentWord:=GetTextRange(LeftPos,RightPos); end; end; end; //------------------------------------------------------------------ //current word including '.' //------------------------------------------------------------------ function TEde.getWordBounds(P:integer):TPoint; var LeftPos,OrigStart,RightPos:integer; R:TPoint; begin LeftPos:=P; OrigStart:=P; R.X:=P; R.Y:=P; //go to the left LeftPos:=SendMessage(Handle,EM_FINDWORDBREAK,WB_MOVEWORDLEFT,LeftPos); if LeftPos<=0 then LeftPos:=OrigStart; R.X:=LeftPos; //go to the right RightPos:=SendMessage(Handle,EM_FINDWORDBREAK,WB_MOVEWORDRIGHT,LeftPos); R.Y:=RightPos; Result:=R end; //------------------------------------------------------------------ //-- //------------------------------------------------------------------ function TEde.getFirstVisibleLine():integer; begin getFirstVisibleLine:=Perform(EM_GETFIRSTVISIBLELINE,0,0)+1; end; //------------------------------------------------------------------ //-- //------------------------------------------------------------------ function TEde.getLinefromCharIndex(C:integer):integer; begin getLinefromCharIndex:=Perform(EM_LINEFROMCHAR,C,0); end; //------------------------------------------------------------------ //-- //------------------------------------------------------------------ function TEde.getCharIndexfromLine(L:integer):integer; begin getCharIndexfromLine:=Perform(EM_LINEINDEX,L,0) end; //------------------------------------------------------------------ //-- //------------------------------------------------------------------ function TEde.getNumberofVisibleLines():integer; var hdc:THandle; EditRect:TRect; RectHeight:integer; tm:TextMetric; begin hdc:=GetDC(Handle); Perform(EM_GETRECT,0,EditRect); RectHeight:=EditRect.bottom-EditRect.top; GetTextMetrics(hdc,tm); getNumberofVisibleLines:=(RectHeight div font.Size)+1; end; //------------------------------------------------------------------ //-- //------------------------------------------------------------------ function TEde.getLastVisibleLine():integer; var EditRect:TRect; RectHeight,MaxNumberofLines:integer; FirstVisibleLine:integer; begin Perform(EM_GETRECT,0,EditRect); RectHeight:=EditRect.bottom-EditRect.top; MaxNumberofLines:=(RectHeight div font.Size)+1; FirstVisibleLine:=getFirstVisibleLine(); getLastVisibleLine:=FirstVisibleLine+MaxNumberofLines end; //------------------------------------------------------------------ //-- //------------------------------------------------------------------ function TEde.getLineHeight():integer; var EditRect:TRect; RectHeight:integer; begin Perform(EM_GETRECT,0,EditRect); RectHeight:=EditRect.bottom-EditRect.top; getLineHeight:=(RectHeight div font.Size)+1; end; //------------------------------------------------------------------ //-- //------------------------------------------------------------------ function TEde.getDotFromChar(C:integer):TPoint; var P:TPoint; begin Perform(EM_POSFROMCHAR,Wparam(@P),C); getDotFromChar:=P end; //------------------------------------------------------------------ //-- //------------------------------------------------------------------ function TEde.getPos():TPoint; begin Result.X:=CaretPos.X+1; Result.Y:=CaretPos.Y+1 end; //------------------------------------------------------------------ //-- //------------------------------------------------------------------ function TEde.getRectBottom():integer; var EditRect:TRect; begin Perform(EM_GETRECT,0,EditRect); getRectBottom:=EditRect.bottom; end; //------------------------------------------------------------------ //-- //------------------------------------------------------------------ function TEde.getPosMod(R:TPoint):TPoint; var L,i,LL:integer; E:TPoint; begin E.X:=R.X; E.Y:=R.Y; L:=R.Y; LL:=Linearray.count; if LL>=L then if Linearray.lines[L]<>L then begin i:=0; while i<LL-1 do begin if Linearray.lines[i]=L then begin L:=i; i:=LL end; i:=i+1 end; R.Y:=L; end else R.Y:=L; getPosMod:=E end; //------------------------------------------------------------------ //-- //------------------------------------------------------------------ procedure TEde.markLinePos(L,C:integer); var FirstVisible,Diff,Inx,in1,LL,lb:integer; Buf: record Siz:Word; cont: array [0..100] of char; end; P : TPoint; begin FirstVisible:=getFirstVisibleLine(); LL:=Linearray.count; if L<LL then begin L:=Linearray.lines[L]; Diff:=L-FirstVisible; Perform(EM_LINESCROLL,C,Diff); //show selected Perform(EM_HIDESELECTION,0,0); //fetch index Inx:=getCharIndexfromLine(L-1)+C-1; //inspect line Buf.Siz:=length(Buf.cont); Perform(EM_GETLINE,L-1,@Buf); in1:=C; lb:=length(Buf.cont); while (in1<lb)and(Buf.cont[in1]<>' ')and(Buf.cont[in1]>'') do in1:=in1+1; //now posit Perform(EM_SETSEL,Inx,Inx+in1-C+1); P:=getWordBounds(Inx+in1-C); if P.Y>P.X then Perform(EM_SETSEL,P.X,P.Y); end; end; //------------------------------------------------------------------ //-- //------------------------------------------------------------------ procedure TEde.markWord(L,C,LL:integer); var FirstVisible,Diff,Inx:integer; begin FirstVisible:=getFirstVisibleLine(); if L<Linearray.count then begin L:=Linearray.lines[L]; Diff:=L-FirstVisible; Perform(EM_LINESCROLL,C,Diff); //show selected Perform(EM_HIDESELECTION,0,0); //fetch index Inx:=getCharIndexfromLine(L-1); //now posit Perform(EM_SETSEL,Inx+C-1,Inx+C-1+LL); end; end; //------------------------------------------------------------------ //-- //------------------------------------------------------------------ procedure TEde.setCharPos(P,L:integer); var FirstVisible,Target,Diff:integer; begin FirstVisible:=getFirstVisibleLine(); Target:=Perform(EM_LINEFROMCHAR,P,0); Diff:=Target-FirstVisible; Perform(EM_LINESCROLL,L,Diff); SelStart:=P; SelLength:=L; end; //---------------------------------------------------------- //save //---------------------------------------------------------- procedure TEde.SaveToUndoBuffer(); var i,LL:integer; begin if Uli=nil then Uli:=TUndoList.Create(MaxLength,SelStart,SelLength) else begin Uli.next:=TUndoList.Create(MaxLength,SelStart,SelLength); Uli.next.Previous:=Uli; Uli:=Uli.next; end; //Reset buffer and save data Uli.UndoBuffer.SetSize(0); Uli.UndoBuffer.Position:=0; lines.SaveToStream(Uli.UndoBuffer); //save also Line- and Blockarray LL:=Linearray.count; setlength(Uli.Linearray,LL); for i:=0 to LL-1 do Uli.Linearray[i]:=Linearray.lines[i]; setlength(Uli.Blockarray,LL); for i:=0 to LL-1 do Uli.Blockarray[i]:=Blockarray.lines[i]; //Store graphical information (cursor position etc.) Uli.FirstVisibleLine:=getFirstVisibleLine(); Uli.UndoSelStart:=SelStart; Uli.UndoSelLength:=SelLength; Uli.UndoModified:=Modified; end; //---------------------------------------------------------- //save //---------------------------------------------------------- procedure TEde.InitUndoBuffer(); begin clearUndoBuffer(); SaveToUndoBuffer(); end; //---------------------------------------------------------- //save //---------------------------------------------------------- procedure TEde.clearUndoBuffer(); begin Uli:=nil; end; //---------------------------------------------------------- //load //---------------------------------------------------------- procedure TEde.LoadFromUndoBuffer(); var indentnow,i,LL,sels,sell:integer; begin //cu:=Perform(EM_CANUNDO,0,0); //if Modified and(cu<>0) then begin //Perform(EM_UNDO,0,0); //Refresh(); //end; if Uli<>nil then begin indentnow:=Paragraph.leftIndent; lines.BeginUpdate; Uli.UndoBuffer.Position:=0; lines.LoadFromStream(Uli.UndoBuffer); //save also Line- and Blockarray LL:=length(Uli.Linearray); setlength(Linearray.lines,LL); for i:=0 to LL-1 do Linearray.lines[i]:=Uli.Linearray[i]; setlength(Blockarray.lines,LL); for i:=0 to LL-1 do Blockarray.lines[i]:=Uli.Blockarray[i]; //repair indent sels:=SelStart; sell:=SelLength; selectall(); SelStart:=sels; SelLength:=Sell; Paragraph.Alignment:=taLeftJustify; Paragraph.leftIndent:=indentnow; Paragraph.FirstIndent:=indentnow; SelLength:=0; markLinePos(Uli.FirstVisibleLine,0); lines.EndUpdate; Refresh(); SelStart:=Uli.UndoSelStart; SelLength:=Uli.UndoSelLength; Modified:=Uli.UndoModified; if Uli.Previous<>nil then begin Uli.UndoBuffer.Free; Uli.UndoBuffer:=nil; Uli:=Uli.Previous; end else Modified:=false; Uli.next:=nil; end; end; //----------------------------------------------------------------- //external Representation //Isabelle special characters //------------------------------------------------------------------ procedure TEde.Representation(var S:JString;var streamout:TStream); var suboff:boolean; i,j,k,hex:integer; CC,DD:JString; begin suboff:=Super or Sub; if (S='\\') then //prettyprint is uncomplete!!! Buffillled:=true; if Buffillled then begin if (Buffer='\\')and(S<>'<') then begin //ignore S:=Buffer+Buffer+' '+S; Buffillled:=false; Buffer:=''; for i:=2 to length(S) do streamout.WriteBuffer(S[i],1); end else if (S<>'>')and(S<>'\') then Buffer:=Buffer+S //add to buffer else begin //empty buffer CC:=midstr(Buffer,4,length(Buffer)-1); if (CC='^isup')or(CC='^sup') then begin S:='\up'+IntToStr(font.Size div 2)+' '; Buffillled:=false; Buffer:=''; for i:=1 to length(S) do streamout.WriteBuffer(S[i],1); Super:=true; end else if (CC='^isub')or(CC='^sub') then begin S:='\dn'+IntToStr(font.Size div 2)+' '; Buffillled:=false; Buffer:=''; for i:=1 to length(S) do streamout.WriteBuffer(S[i],1); Sub:=true; end else for j:=1 to length(Isabelle) do begin k:=10; while (k<length(Isabelle[j]))and(Isabelle[j][k]<>'>') do k:=k+1; DD:=midstr(Isabelle[j],10,k-10); if CC=DD then begin hex:=0; S:=midstr(Isabelle[j],38,8); TryStrtoInt(S,hex); S:=Font2+'\u'+IntToStr(hex)+'?'+Font0; Buffillled:=false; Buffer:=''; for i:=1 to length(S) do streamout.WriteBuffer(S[i],1); end; end; if Buffillled then begin S:=Buffer+S; Buffillled:=false; Buffer:=''; for i:=1 to length(S) do streamout.WriteBuffer(S[i],1); end; end; end else for i:=1 to length(S) do streamout.WriteBuffer(S[i],1); if suboff and not Buffillled then begin Super:=false; Sub:=false; if Sub then S:='\dn0 ' else S:='\up0 '; for i:=1 to length(S) do streamout.WriteBuffer(S[i],1); end; end; //------------------------------------------------------------------ //-- //set Attributes -- //-- //------------------------------------------------------------------ function TEde.SetRtfAttributes(Efs:JString;streamin:TStream; var streamout:TStream):boolean; var Line,RealColumn,NextColumn,Att,ccol,klauf,klzu,lastgrey:integer; ch,prevchar:char; Lineend:JString; ind:Highlite; Oneopen,Beginofline:boolean; EFsnumber:JString; allok:boolean; columncorrect,indentlength,linecorrect:integer; //----------------------------------------------------------------- function Virtcolumn():integer; begin Result:=RealColumn-columncorrect end; //----------------------------------------------------------------- function VirtLine():integer; begin Result:=Line-linecorrect end; //----------------------------------------------------------------- procedure app(S:JString); var i,LL:integer; begin if hasRepresentation then begin Representation(S,streamout); end else begin LL:=length(S); for i:=1 to LL do streamout.WriteBuffer(S[i],1); end; end; //----------------------------------------------------------------- procedure CloseColor(); begin if ((Virtcolumn()>=NextColumn)or(ord(ch) in [Key_Return,Key_LineFeed])) and Oneopen then begin if Syntaxbold then app(BoldOff+' ') else app(SetNoColor+' '); klzu:=klzu+1; Oneopen:=false; NextColumn:=99999; end end; //----------------------------------------------------------------- procedure Skipbeginofline(); var rp:integer; begin columncorrect:=0; //skip linefeed if ch=chr(Key_LineFeed) then streamin.Read(ch,1); repeat if charinset(ch,[' ',chr(Key_Tab)]) then columncorrect:=columncorrect-1 else streamin.Position:=streamin.Position-1; rp:=streamin.Read(ch,1); until not charinset(ch,[' ',chr(Key_Tab)])or(rp<0); end; //----------------------------------------------------------------- procedure ParAdd(); begin CloseColor(); app(RtfParagraph); app(chr(Key_Return)+chr(Key_LineFeed)); Line:=Line+1; RealColumn:=1; Beginofline:=true; end; //----------------------------------------------------------------- procedure makeIndent(); begin indentlength:=TA.Y[Att].yyindent*indentchars; end; //----------------------------------------------------------------- procedure InsertIndent(); var i:integer; begin if Beginofline then begin if doindent and(streamin.Position+1<streamin.Size) then begin for i:=indentlength downto 1 do app(' '); Skipbeginofline(); end; Beginofline:=false; end; end; //----------------------------------------------------------------- procedure ArtificialLineBreaks(); begin //look for indent if Artificiallines and doindent and(Att>1) then begin if (TA.Y[Att].yylin=TA.Y[Att-1].yylin)and(TA.Y[Att-1].yyindent>0)and (TA.Y[Att].yyindent>TA.Y[Att-1].yyindent) then begin //linecorrect:=linecorrect+1; app(RtfParagraph); app(chr(Key_Return)+chr(Key_LineFeed)); makeIndent(); Beginofline:=true; InsertIndent(); Beginofline:=false; end; end; end; //----------------------------------------------------------------- begin allok:=true; EFsnumber:=IntToStr(getFileNumber(Efs)); Att:=1; Line:=1; RealColumn:=1; NextColumn:=1; Oneopen:=false; lastgrey:=-1; streamout.Position:=0; streamin.Position:=0; klauf:=0; klzu:=0; PlainText:=false; Beginofline:=true; app(RtfHeader()); streamin.Position:=0; Lineend:=''; MaxColFound:=0; MaxLineCount:=0; Buffer:=''; Buffillled:=false; Super:=false; Sub:=false; columncorrect:=0; indentlength:=0; linecorrect:=0; prevchar:=chr(0); while (streamin.Read(ch,1)>0) do begin allok:=allok and printablechar(ch); if not allok then allok:=false; InsertIndent(); //must be > linefeed if (ord(ch)=Key_Return) then begin if Virtcolumn()>MaxColFound then MaxColFound:=Virtcolumn(); MaxLineCount:=MaxLineCount+1; ParAdd(); end else if (ord(ch)=Key_LineFeed) then begin if not (prevchar=chr(Key_Return)) then ParAdd(); if (klauf<>klzu) then errorn(25,'zuviele Farbmarker in Zeile'+IntToStr(Line)); end else begin CloseColor(); if SyntaxHighlight and(TA.AttrCount>0) then begin makeIndent(); while (Att<TA.AttrCount)and(TA.Y[Att].yyfil<>EFsnumber) do Att:=Att+1; while (Att<TA.AttrCount)and(TA.Y[Att].yylin<Line) do Att:=Att+1; while (Att<TA.AttrCount)and(TA.Y[Att].yylin=Line)and (TA.Y[Att].yycol<Virtcolumn()) do Att:=Att+1; if not Oneopen and(Att<=TA.AttrCount)and(TA.Y[Att].yylin=VirtLine())and (TA.Y[Att].yycol=Virtcolumn()) then begin if EFsnumber=TA.Y[Att].yyfil then begin ArtificialLineBreaks(); NextColumn:=Virtcolumn()+TA.Y[Att].yylen; klauf:=klauf+1; if Syntaxbold then begin if TA.Y[Att].yycolor=highlitekey[H_Keyword] then app(Bold+' '); end else begin app(SetColor); ccol:=0; for ind:= Low(Highlite) to High(Highlite) do if TA.Y[Att].yycolor=highlitekey[ind] then ccol:=ord(ind); if (ccol>=0)and(ccol<=ord( High(Highlite))) then app(chr(ord('0')+ccol+1)) else app('1'); app(' '); end; Oneopen:=true; Att:=Att+1; end; end; end; //correct strange codes if ch='\' then app('\\') else if ord(ch)=Key_Tab then app(ch) else if ch='{' then app('\{') else if ch='}' then app('\}') else if ch<>' ' then begin app(ch); end else if (ch=' ') then begin if ShowSpaces then begin if (Virtcolumn()-1<>lastgrey)and(klauf=klzu) then app(SetColor+'7'+'.') else app('.'); lastgrey:=Virtcolumn() end else app(ch); end else app(ch); RealColumn:=RealColumn+1; end; prevchar:=ch; end; app('}'); streamout.Position:=0; Result:=allok; end; //------------------------------------------------------------------ //-- //load Attributes -- //-- //------------------------------------------------------------------ procedure TEde.LoadHighLites(Hi: array of TColor); var h:Highlite; o:integer; C:TColor; begin for h:= low(Highlite) to high(Highlite) do begin o:=ord(h); C:=Hi[o]; Highlites[h]:=C; end; end; //------------------------------------------------------------------ //-- //load Attributes -- //-- //------------------------------------------------------------------ procedure TEde.LoadAttributes(TC:PAnsiChar); var S,SI:JString; flen,rlen,i,j:integer; CP,newlength:integer; err:boolean; lev,lastlev,offs:integer; next,count:integer; eofs:boolean; Temp:TSingleAttribute; //------------------------------------------------------------------ //-- //open Stream/String -- //-- //------------------------------------------------------------------ procedure OpenStream(); begin offs:=0; eofs:=false; //Reset Stream count:=0; lev:=0; lastlev:=0;//Reset Tree end; procedure GetNextRec(); begin rlen:=offs; next:=offs; lastlev:=lev; lev:=0; while (TC[next]=chr(9))and(next<=flen) do begin lev:=lev+1; next:=next+1; end; S:=''; while (TC[next]>chr(15))and(next<=flen) do begin S:=S+String(TC[next]); next:=next+1; end; rlen:=next-rlen; eofs:=(TC=nil)or(TC='')or(TC[next]=chr(0))or(TC[next+1]=chr(0)); offs:=next+1; count:=count+1; end; begin TA.AttrCount:=0; indentingpossible:=false; flen:=length(TC); if (TC<>nil)and(flen>0) then begin err:=false; setlength(TA.Y,max(16,flen)); with TA do begin OpenStream(); repeat GetNextRec(); if (AttrCount>=length(TA.Y)-1) then begin newlength:=floor(AttrCount*3/2); errorn(9,'Setze neue Länge Attributes'); setlength(TA.Y,newlength); err:=true; end; AttrCount:=AttrCount+1; CP:=pos(',',S); SI:=midstr(S,1,CP-1); setl(Y[AttrCount].yyfil,SI); S:=midstr(S,CP+1,length(S)); CP:=pos(',',S); SI:=midstr(S,1,CP-1); TryStrtoInt(SI,Y[AttrCount].yylin); S:=midstr(S,CP+1,length(S)); CP:=pos(',',S); SI:=midstr(S,1,CP-1); TryStrtoInt(SI,Y[AttrCount].yycol); S:=midstr(S,CP+1,length(S)); CP:=pos(',',S); SI:=midstr(S,1,CP-1); TryStrtoInt(SI,Y[AttrCount].yylen); S:=midstr(S,CP+1,length(S)); CP:=pos(',',S); SI:=midstr(S,1,CP-1); setl(Y[AttrCount].yycolor,SI); SI:=midstr(S,CP+1,length(S)); TryStrtoInt(SI,Y[AttrCount].yyindent); indentingpossible:=indentingpossible or (Y[Attrcount].yyindent<>0); until eofs or err; //--------------------------------------- //sort the attributes, necessary //--------------------------------------- if not err then for i:=1 to TA.AttrCount-1 do for j:=i+1 to TA.AttrCount do if TA.Y[i].yylin*10000+TA.Y[i].yycol>TA.Y[j].yylin*10000+TA.Y[j] .yycol then begin Temp:=TA.Y[j]; TA.Y[j]:=TA.Y[i]; TA.Y[i]:=Temp end; end; end; end; //------------------------------------------------------------------------------ //-- //create RTF file -- //-- //------------------------------------------------------------------------------ procedure TEde.initLinearray(Anz:integer); var i:integer; begin Anz:=(Anz div 4)*4+8; setlength(Blockarray.lines,Anz+1); setlength(Linearray.lines,Anz+1); Blockarray.count:=lines.count; Linearray.count:=lines.count; for i:=1 to Anz do Linearray.lines[i]:=i; end; //------------------------------------------------------------------------------ // //create RTF file -- //-- //------------------------------------------------------------------------------ function TEde.CreateHighlited(Nr:integer):TimeTripel; var TimeSet:TDateTime; Trtf,TEde,TLin,sels,sell:integer; begin Screen.Cursor:=crHourGlass; Trtf:=0; TEde:=0; TLin:=0; sels:=SelStart; sell:=SelLength; reloading:=true; if length(Sources)>0 then try Screen.Cursor:=crHourGlass; if (LoadedFile<>'')and(LoadedFile<>Sources[Nr]) then Save(true); clearstreams(); streamfile:=TFileStream.Create(Sources[Nr],fmShareDenyNone or fmOpenRead); //streamfile:=readFiletoStream(Sources[nr]); streamatt:=TMemoryStream.Create(); streamatt.Position:=0; TimeSet:=Now; if not SetRtfAttributes(Sources[Nr],streamfile,streamatt) then begin inform(168,'Datei mit Binärdaten, angezeigt als ?',''); CreateBin(Nr); end else begin Trtf:=MilliSecondsBetween(Now,TimeSet); TimeSet:=Now; //---------------------------------------------------------- //set attributes //---------------------------------------------------------- ReadOnly:=false; PlainText:=false; WordWrap:=false; ScrollBars:=ssBoth; if doindent then SaveToUndoBuffer() else clearUndoBuffer(); lines.Clear; //wichtig!! MaxLength:=streamatt.Size+maxinputbuffer; streamatt.Position:=0; lines.LoadFromStream(streamatt); TEde:=MilliSecondsBetween(Now,TimeSet); TimeSet:=Now; initLinearray(lines.count); TLin:=MilliSecondsBetween(Now,TimeSet); //make sure positioning works LoadedFile:=Sources[Nr]; LoadedFileNumber:=Nr; LoadedFormat:=RTF; end; settabs(); Modified:=doindent; Screen.Cursor:=crDefault; except On E:Exception do CreateDummyFile(); end else CreateDummyFile(); SelStart:=sels; SelLength:=Sell; Screen.Cursor:=crDefault; Mark(); ReadOnly:=ShowSpaces; Result.T1:=Trtf; Result.T2:=TEde; Result.T3:=TLin; reloading:=false; end; //------------------------------------------------------------------------------ // //create RTF file -- //-- //------------------------------------------------------------------------------ procedure TEde.CreateRtfReadOnly(Nr:integer); var lengthfile:integer; isbin:boolean; begin Screen.Cursor:=crHourGlass; if length(Sources)>0 then try Screen.Cursor:=crHourGlass; //get content of file //---------------------------------------------------------- //set attributes //---------------------------------------------------------- ReadOnly:=false; WordWrap:=true; PlainText:=false; if dowordwrap then begin WordWrap:=true; ScrollBars:=ssVertical; end else begin WordWrap:=false; ScrollBars:=ssBoth; end; //wichtig!! lengthfile:=getFileLength(Sources[Nr],isbin); MaxLength:=lengthfile+maxinputbuffer; lines.Clear; clearUndoBuffer(); lines.LoadFromFile(Sources[Nr]); initLinearray(lines.count); //make sure positioning works LoadedFile:=Sources[Nr]; LoadedFileNumber:=Nr; LoadedFormat:=RTF; Modified:=false; indentingpossible:=false; Screen.Cursor:=crDefault; //SelStart:=0; //SelLength:=0; ReadOnly:=true; except On E:Exception do CreateDummyFile(); end else CreateDummyFile(); Mark(); settabs(); Screen.Cursor:=crDefault; end; //------------------------------------------------------------------------------ //-- //modify to show line numbers -- //-- //------------------------------------------------------------------------------ procedure TEde.Mark(); var modif:boolean; sell,sels:integer; Indent,numberdigits:integer; begin Screen.Cursor:=crHourGlass; HideRedraw(); modif:=Modified; ReadOnly:=false; //decide upon indent Indent:=leastmargin; numberdigits:=floor(log10(max(lines.count,1)))+1; linemargin:=(numberdigits+1)*font.Size; if linemargin>leastmargin then if LineNumbers or Blocknumbers then Indent:=linemargin; //SetFocus(); if not(LoadedFormat=Bin) then begin if (lines.count>=0) then begin sels:=SelStart; sell:=SelLength; selectall(); Paragraph.Alignment:=taLeftJustify; Paragraph.leftIndent:=Indent; Paragraph.FirstIndent:=Indent; //now make numbers makeLineBlockNumbers(); SelStart:=sels; SelLength:=Sell; end; //done Modified:=modif; end; ShowRedraw(); Screen.Cursor:=crDefault; end; //------------------------------------------------------------------------------ //-- //create BIN file -- //-- //------------------------------------------------------------------------------ procedure TEde.CreateBin(Nr:integer); var ch:ansichar; Oneopen:boolean; //----------------------------------------------------------------- procedure app(S:JString); var i,LL:integer; begin LL:=length(S); for i:=1 to LL do streamatt.WriteBuffer(S[i],1); end; //----------------------------------------------------------------- procedure ParAdd(); begin app(SetNoColor+' '); Oneopen:=false; app(RtfParagraph); app(chr(Key_Return)+chr(Key_LineFeed)); end; //----------------------------------------------------------------- begin reloading:=true; if FileExists(Sources[Nr]) then begin if (LoadedFile<>'')and(LoadedFile<>Sources[Nr]) then Save(true); ReadOnly:=false; PlainText:=true; WordWrap:=true; ScrollBars:=ssVertical; // streamfile:=TFileStream.Create(Sources[Nr],fmOpenRead or fmShareDenyWrite); streamatt:=TMemoryStream.Create(); streamfile.Position:=0; streamatt.Position:=0; //prepare lines.Clear; clearUndoBuffer(); MaxLength:=(3*streamfile.Size)div 2; //add chars while streamfile.Read(ch,1)>0 do begin if (ch<' ') then app('?') else app(ch); end; streamatt.Position:=0; lines.LoadFromStream(streamatt); initLinearray(lines.count); LoadedFile:=Sources[Nr]; LoadedFileNumber:=Nr; LoadedFormat:=Bin; Mark(); Modified:=false; ReadOnly:=true; indentingpossible:=false; end else begin CreateDummyFile(); end; Modified:=false; reloading:=false; end; //------------------------------------------------------------------------------ //-- //create RTF file -- //-- //------------------------------------------------------------------------------ procedure TEde.CreatePlain(Nr:integer); var isbin:boolean; FE:JString; begin reloading:=true; if FileExists(Sources[Nr]) then begin if (LoadedFile<>'')and(LoadedFile<>Sources[Nr]) then Save(true); ReadOnly:=false; font.Color:=clBlack; if dowordwrap then begin WordWrap:=true; ScrollBars:=ssVertical; end else begin WordWrap:=false; ScrollBars:=ssBoth; end; PlainText:=true; //wichtig!! Sonst gibt es Murks im RichEditor lines.Clear; FE:=ExtractFileExt(Sources[Nr]); MaxLength:=getFileLength(Sources[Nr],isbin)+maxinputbuffer; if not isbin then begin streamfile:=TFileStream.Create(Sources[Nr], fmOpenRead or fmShareDenyWrite); lines.LoadFromStream(streamfile); clearUndoBuffer(); initLinearray(lines.count); LoadedFile:=Sources[Nr]; LoadedFileNumber:=Nr; LoadedFormat:=Plain; indentingpossible:=false; Mark(); end else CreateBin(Nr); end else begin CreateDummyFile(); end; settabs(); Modified:=false; reloading:=false; end; //------------------------------------------------------------------------------ //-- //create RTF file -- //-- //------------------------------------------------------------------------------ procedure TEde.CreateString(Stdout,Stderr:JString); begin reloading:=true; Save(true); ReadOnly:=false; PlainText:=true; lines.Clear; //wichtig!! Sonst gibt es Murks im RichEditor MaxLength:=length(Stdout)+length(Stderr)+maxinputbuffer; WordWrap:=false; ScrollBars:=ssBoth; lines.Clear; clearUndoBuffer(); font.Color:=clBlue; DefAttributes.Color:=clBlue; SelAttributes.Color:=clBlue; lines.Add(Stdout); lines.Add(Stderr); initLinearray(lines.count); LoadedFile:=''; LoadedFileNumber:=0; LoadedFormat:=Plain; indentingpossible:=false; Mark(); ReadOnly:=true; Modified:=false; reloading:=false; end; //------------------------------------------------------------------ //-- //flush streams -- //-- //------------------------------------------------------------------ procedure TEde.clearstreams(); begin flushstreams(); if streamfile<>nil then streamfile.Free; if streamatt<>nil then streamatt.Free; if streamorig<>nil then streamorig.Free; streamfile:=nil; streamatt:=nil; streamorig:=nil; end; //------------------------------------------------------------------ //-- //flush streams -- //-- //------------------------------------------------------------------ procedure TEde.flushstreams(); begin if (streamfile<>nil) then FlushFileBuffers(streamfile.Handle); end; //------------------------------------------------------------------ //-- //save Sources to file -- //-- //------------------------------------------------------------------ function TEde.Save(askhim:boolean):integer; const Rev='_r'; var doit:boolean; Nam,Path,Ext,Sav:JString; P,r1,r2,T,Revisions:integer; mresult:integer; begin doit:=not askhim; mresult:=mrYes; if not ShowSpaces and Modified then begin if LoadedFile='' then doit:=false else if askhim then begin mresult:=ask(30,'Datei Sichern?', ExtractFileName(ExtractFileName(LoadedFile))); doit:=mresult=mrYes; end; if doit or not askhim then begin //first flush buffers!! flushstreams(); if (LoadedFile<>'')and CreateBackup then begin //saves to history Nam:=ExtractFileName(LoadedFile); Path:=ExtractFilePath(LoadedFile)+'history\'; Ext:=ExtractFileExt(Nam); if not DirectoryExists(Path) then CreateDir(Path); P:=pos('.',Nam)-1; Nam:=midstr(Nam,1,P); r1:=pos(Rev,Nam); r2:=length(Nam)-r1-1; if (r1>0)and(r2>0) then begin T:=0; TryStrtoInt(midstr(Nam,r1+2,r2),T); Revisions:=T; Nam:=midstr(Nam,1,r1-1); end else Revisions:=0; repeat Revisions:=Revisions+1; Sav:=Path+Nam+Rev+IntToStr(Revisions)+Ext; until not FileExists(Sav); streamorig:=TFileStream.Create(LoadedFile, fmOpenRead or fmShareDenyNone); streamorig.Position:=0; streamfile:=TFileStream.Create(Sav,fmCreate); streamfile.CopyFrom(streamorig,streamorig.Size); end; PlainText:=true; //streamfile is still open, so //exchange contents of streamfile by freeing and reloading streamfile.Free; streamfile:=TFileStream.Create(LoadedFile,fmOpenWrite+fmShareDenyWrite); streamfile.Position:=0; streamfile.Size:=0; lines.SaveToStream(streamfile); Modified:=false end end else if Modified and ShowSpaces then begin mresult:=mrNo; inform(32,'bitte zuerst Leerzeichen ausschalten',''); end; Result:=mresult end; //------------------------------------------------------------------------------ //-- //a dummy file -- //-- //------------------------------------------------------------------------------ procedure TEde.CreateDummyFile(); begin //Setlength(Blockarray,1024); Clear; lines.Add(''); lines.Add(''); lines.Add(trans(lang,226,' Sage nicht immer, was Du weißt,')); lines.Add(trans(lang,227,' aber wisse immer, was Du sagst.')); lines.Add(''); lines.Add(' Matthias Claudius'); Mark(); LoadedFile:=''; indentingpossible:=false; LoadedFormat:=Plain; ReadOnly:=true; PlainText:=true; end; //----------------------------------------------------------------- //catch messages of zeilennummern //----------------------------------------------------------------- procedure TEde.makeLineBlockNumbers(); var hdc:THandle; CurRect:TRect; modif:boolean; readon:boolean; function getmark(L:integer):String; var S:String; i:integer; begin if Blocknumbers then begin if (Blockarray.count>L) then begin S:=' '; if Blockarray.lines[L]>0 then S:=midstr(' '+Format('[%d]',[Blockarray.lines[L]])+' ',1,6) end end else begin S:=Format('%6.6d',[L]); i:=1; while i<6 do begin if S[i]='0' then S[i]:=' ' else i:=6; i:=i+1 end; end; getmark:=midstr(S,1,6); end; procedure makethem(); var LineChar,LineNumber,MaxNumberofLines,FirstVisibleLine:integer; LineMark:JString; P:TPoint; ForeG,BackG:TColor; begin MaxNumberofLines:=getNumberofVisibleLines(); FirstVisibleLine:=getFirstVisibleLine(); ForeG:=RGB(164,164,164); BackG:=RGB(255,255,255); SetTextColor(hdc,ForeG); SetBkColor(hdc,BackG); for LineNumber:=FirstVisibleLine-1 to FirstVisibleLine+MaxNumberofLines-1 do begin LineChar:=getCharIndexfromLine(LineNumber); if LineChar<>-1 then begin LineMark:=getmark(LineNumber+1); P:=getDotFromChar(LineChar); with CurRect do begin left:=0; right:=linemargin; top:=P.Y; bottom:=getRectBottom(); end; DrawText(hdc,pwidechar(LineMark),length(LineMark),&CurRect,DT_RIGHT); end; end; end; begin hdc:=GetDC(Handle); if not(LoadedFormat=Bin)and(hdc<>0)and(getScrollPos().X=0)and (LineNumbers or Blocknumbers) then begin modif:=Modified; readon:=ReadOnly; ReadOnly:=false; makethem(); ReadOnly:=readon; Modified:=modif; end; ReleaseDC(Handle,hdc); end; //------------------------------------------------------------------ //-- //on key down in Sources -- //-- //------------------------------------------------------------------ procedure TEde.searchreplace(Kind:SeaRepFun); var fin:TRegInfo; FoundText,ReplaceText:JString; procedure SearchAndReplace(var X:integer;InSearch:JString); begin if FoundAt>=0 then begin if regexpsearch then begin if (InSearch='^') then begin //only ^ X:=fin.pos; FoundText:='' end else if (InSearch='$') then begin //only $ X:=fin.pos; FoundText:=chr(Key_Return) end else begin X:=fin.pos; FoundText:=GetTextRange(fin.pos,fin.pos+fin.len-1); end; end else begin X:=SelStart; FoundText:=Seltext; end; SetFocus; SelStart:=X; SelLength:=length(FoundText); ReplaceText:=StringReplace(ReplaceString.S,'\0',FoundText,[rfReplaceAll]); Seltext:=ReplaceText; end; end; begin FoundAt:=-1; if Kind in [FuncSearch,FuncReplace,FuncContReplace] then begin if (SearchString.S='') then setl(SearchString.S,Seltext); if (SearchString.S>'') then begin fin:=findsingle(SelStart); FoundAt:=fin.pos; Wrapped:=false; if FoundAt<0 then Wrapped:=true; if (FoundAt>=0) then Perform(EM_SETSEL,fin.pos,fin.pos+fin.len); //replace the string? if Kind<>FuncSearch then SearchAndReplace(FoundAt,SearchString.S); end; end; end; //------------------------------------------------------------------------------ //-- //correct after insert delete -- //-- //------------------------------------------------------------------------------ procedure TEde.PositioningCorrect(from,num:integer); var i,Anz,newfrom,oldcount:integer; lineold,blockold: array of integer; begin //insert erfolgt if lines.count>Linearray.count then begin //save state //allocate buffer oldcount:=Linearray.count; Anz:=(4*lines.Count) div 4 + 4; setlength(lineold,Anz); setlength(blockold,Anz); for i:=1 to oldcount do begin lineold[i]:=Linearray.lines[i]; blockold[i]:=Blockarray.lines[i] end; //allocate new Anz:=(4*lines.count) div 4*+4; setlength(Blockarray.lines,Anz); setlength(Linearray.lines,Anz); Blockarray.count:=lines.count; Linearray.count:=lines.count; //initialize for i:=1 to Anz-1 do begin Linearray.lines[i]:=i; Blockarray.lines[i]:=i end; //transfer to new for i:=1 to oldcount do begin Linearray.lines[i]:=lineold[i]; Blockarray.lines[i]:=blockold[i] end; //now correct newfrom:=from; i:=0; while i<Linearray.count do begin if Linearray.lines[i]=from then newfrom:=i; i:=i+1; end; from:=newfrom; //num:=newnum; for i:=from to Linearray.count-num do begin Linearray.lines[i]:=Linearray.lines[i+num]; Blockarray.lines[i]:=Blockarray.lines[i+num]; end; end //cut erfolgt else if lines.count<Linearray.count then begin for i:=Linearray.count downto from-num do begin Linearray.lines[i]:=Linearray.lines[i-num]; Blockarray.lines[i]:=Blockarray.lines[i-num]; end; end; end; //------------------------------------------------------------------------------ // //save RTF file nonexlusively -- //-- //------------------------------------------------------------------------------ procedure TEde.SaveRtfTo(S:JString); var Orig:TFileStream; begin Orig:=nil; try flushstreams(); if FileExists(S) then Orig:=TFileStream.Create(S,fmOpenWrite+fmShareDenyNone) else Orig:=TFileStream.Create(S,fmCreate); except errorn(11,'Datei kann nicht angelegt werden:'+S); end; if Orig<>nil then begin lines.SaveToStream(Orig); Orig.Free; end; end; //----------------------------------------------------------------- //show redraw //----------------------------------------------------------------- procedure TEde.ShowRedraw(); begin Perform(WM_SETREDRAW,Wparam(true),0); Repaint; end; //----------------------------------------------------------------- //show redraw //----------------------------------------------------------------- procedure TEde.HideRedraw(); begin Perform(WM_SETREDRAW,Wparam(false),0); end; //----------------------------------------------------------------- //filter messages of Sources //----------------------------------------------------------------- procedure TEde.OnMouseDbl(var Message:TMessage); var LL:integer; Filnam:JString; Begin getCurrentWord(); if CurrentWord>'' then begin Filnam:=ExtractFilePath(LoadedFile)+CurrentWord; if FileExists(Filnam) then begin LL:=length(Sources); setlength(Sources,LL+1); Sources[LL]:=Filnam; CreatePlain(LL); end; end; End; //----------------------------------------------------------------- //filter messages of Sources //----------------------------------------------------------------- procedure TEde.OnMouse(var Message:TMessage); Begin if CodeCompleter.Visible then CodeCompleter.setInvisible(); End; //----------------------------------------------------------------- //filter messages of Sources //----------------------------------------------------------------- procedure TEde.OnKey(var Message:TMessage); var KeyState:TKeyboardState; Key,LL:integer; Begin Indenting(Message); GetKeyboardState(KeyState); Key:=Message.Wparam; //Ctrl:=KeyState[VK_CONTROL]; //Shift:=KeyState[VK_SHIFT]; if Key in [VK_SPACE,VK_RETURN,VK_BACK,VK_CLEAR,VK_DELETE] then SaveToUndoBuffer() else if (Key=VK_DOWN) then begin LL:=getLinefromCharIndex(SelStart); if LL+1=lines.count then begin lines.Add(''); SelStart:=length(lines.Text); SelLength:=0; end; end; if Key in [VK_RETURN,VK_BACK,VK_DELETE] then PositioningCorrect(CaretPos.Y,1); End; //----------------------------------------------------------------- //filter messages of Sources //----------------------------------------------------------------- procedure TEde.Indenting(var Message:TMessage); var Indent:JString; P,LL,i:integer; found:boolean; ch:char; prefix:JString; begin if (message.Wparam=Key_Enter)and(Message.Msg=WM_KEYUP) then begin P:=CaretPos.Y; //calculate Indent i:=1; Indent:=''; if (InputFormat=FixedFormat) then begin Indent:=' '; i:=7; --> -------------------- --> maximum size reached --> -------------------- ¤ Dauer der Verarbeitung: 0.53 Sekunden (vorverarbeitet) ¤ |
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:Die farbliche Syntaxdarstellung ist noch experimentell.Bot Zugriff |
