|
//----------------------------------------------------------
//
//----------------------------------------------------------
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
--> --------------------
¤ Diese beiden folgenden Angebotsgruppen bietet das Unternehmen0.131Angebot
Wie Sie bei der Firma Beratungs- und Dienstleistungen beauftragen können
¤
|
Lebenszyklus
Die hierunter aufgelisteten Ziele sind für diese Firma wichtig
Ziele
Entwicklung einer Software für die statische Quellcodeanalyse
|
