Ziele Untersuchung
mit Columbo Integrität von
Datenbanken Interaktion und
Portierbarkeit Ergonomie der
Schnittstellen

Angebot Produkte Projekt Beratung

Mittel Analytik Modellierung Sprachen Algebra Logik Hardware Denken Kreativität

Zusammenhänge Gesellschaft Wirtschaft Branche Firma


products/Sources/formale Sprachen/Delphi/Elbe 1.0/Sources/ (Columbo Version 0.7^©) Datei vom 17.0.2011 mit Größe 75 kB

Quelle Editor.pas 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

--> --------------------

quality86%

¤ Dauer der Verarbeitung: 0.66 Sekunden (vorverarbeitet) ¤

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

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.