skyedit.pas

SkyEdit是一个可用彩色语法来显示及编辑各种开发语言源代码的编辑器控件。

  FCurRow  := 0;            //当前行
  FLastCol := 0;            //上一次所在列标 2004.11.14
  FMaxCharInLine := 1024;   //编辑窗口内每行最多字符数
  FInsertMode    := True;   //初始化为插入模式
  FProgramMode   := True;   //初始化为编程编辑模式
  FCursorToLeft  := False;  //初始化为光标向右移动

  Cursor := crIBeam;
  FOriginCursor  := Cursor;
  //Text   := Self.Name;
  Font.Charset := DEFAULT_CHARSET;
  Font.Color   := clWindowText;
  Font.Name    := 'Courier New';
  Font.Size    := 10;
  //Font.Pitch := fpFixed;    确保每个字符的宽度一致！
  //用以下这种方法刷新有隐患!如果使用者覆盖了方法?!!!可用消息代替???!!!2004.2.28
  //Font.OnChange := FontChanged;
  FontChanged(nil);
  //用以下这种方法刷新有隐患!如果使用者覆盖了方法?!!! 2004.2.28
  //TStringList(FLines).OnChange := LinesChanged;

  FCharsInWindow := 25;
  FLinesInWindow := 10;

  FUseTabKey := True;
  FTabSpaces := 8;
  FPaintLock := 0;
  FBindLine  := 80;
  FGutterColor := clBtnFace;
  FGutterWidth := 30;
  FSelBkgColor := clHighlight;
  FSelFrgColor := clHighlightText;
  FBlockBegin  := Point(1, 1);    //用Point(0, 0);似乎不安全 2004.11.9
  FBlockEnd    := Point(1, 1);    //用Point(0, 0);似乎不安全 2004.11.9
  FShowLineNum := True;
  FLineNumFont := TFont.Create;
  with FLineNumFont do
  begin
    Color := clWindowText;
    Name  := 'Times New Roman';
    Size  := 10;
  end;

  FSelTimer := TTimer.Create(Self);
  FSelTimer.Interval := 100;
  FSelTimer.Enabled  := False;
  FSelTimer.OnTimer  := MouseSelOnTimer;

  FSelChanged  := False;

  FAlphabet := ALPHA;     //默认为标准字母表加_
end;

destructor TCustomSkyEdit.Destroy;
begin
  FSelTimer.Free;
  FLineNumFont.Free;
  FUndoList.Free;
  FLines.Free;
  inherited Destroy;
end;

procedure TCustomSkyEdit.FontChanged(Sender: TObject);
var
  aDC: HDC;
  hSave: THandle;
  Metrics: TTextMetric;
begin
  aDC := GetDC(0);
  hSave := SelectObject(aDC, Font.Handle);
  GetTextMetrics(aDC, Metrics);
  SelectObject(aDC, hSave);
  ReleaseDC(0, aDC);
  with Metrics do
  begin
    FCharWidth  := tmAveCharWidth;
    FTextHeight := tmHeight + tmExternalLeading; // + 2加2是为了显示时不出现锯齿
  end;
  if Font.Pitch <> fpFixed then
    Font.Pitch := fpFixed;    //确保每个字符的宽度一致！
end;

procedure TCustomSkyEdit.LinesChanged(Sender: TObject);
begin
  if HandleAllocated then
  begin
    IncPaintLock;
    UpdateScrollBars;
    if FLines.Count = 0 then  //文本全清空(即FLines.Clear或FLines.Text = '')
    begin
      GotoOriginLeftTop;
      if not (csDesigning in ComponentState) then
        FLines.Add('');       //编辑的需要（如一开始即按回车键:ProcessVK_RETURN() ）
    end;
    SetBlockBegin(Point(CurCol, CurRow));
    //以下用Paint则Paint方法中需先隐藏光标! 2004.3.3
    //Paint;
    DecPaintLock;
    Change;            //触发控件的Change事件
  end;
end;

procedure TCustomSkyEdit.ListAdded(Sender: TObject);
begin                    //文本变化时调整SkyParser   <2004.9.13>
  if Assigned(Parser) then
  begin
    ScanSyntaxType(Lines.Count - 1);
  end;
end;

procedure TCustomSkyEdit.ListDeleted(Index: Integer);
begin                    //文本变化时调整SkyParser   <2004.9.13>
  if Assigned(Parser) then
  begin
    if Index > 0 then
      Dec(Index);
    ScanSyntaxType(Index);
  end;
end;

procedure TCustomSkyEdit.ListInserted(Index: Integer);
begin                    //文本变化时调整SkyParser   <2004.9.13>
  if Assigned(Parser) then
  begin
    if Index > 0 then
      Dec(Index);
    ScanSyntaxType(Index);
  end;
end;

procedure TCustomSkyEdit.ListLoaded(Sender: TObject);
begin                    //文本变化时调整SkyParser   <2004.9.13>
  if Assigned(Parser) then
  begin

  end;
end;

procedure TCustomSkyEdit.ListPutted(Index: Integer);
begin                    //文本变化时调整SkyParser   <2004.9.13>
  if Assigned(Parser) then
  begin
    ScanSyntaxType(Index);
  end;
end;

procedure TCustomSkyEdit.AdjustCaretX(var CaretX: Integer; var ToLeft: Boolean);
var                      //校准由于汉字等双字节字符引起的显示误差
  i: Integer;
  CurrLineLen: Integer;
begin
  if FCurRow < FLines.Count then
  begin
    CurrLineLen := Length(FLines[FCurRow]);     //指向最后字节时还是要处理的!
    if (CaretX < CurrLineLen {- 1}) and           //指向该行最后字节时不需多处理
          (FLines[FCurRow][CaretX] > #127) then //FLines[FCurRow][CaretX]: byte!
    begin
      i := CaretX;
      while i >= 0 do
        if FLines[FCurRow][i] <= #127 then
          break
        else
          Dec(i);
      if (i >= 0) and ((CaretX - i) mod 2 = 1) then
      begin
        if ToLeft then   //光标向左移动
        begin
          Dec(CaretX);
          Dec(FShowCol); //2004.5.16为处理TAB键暂加到这里
        end
        else             //光标向右移动
        begin
          Inc(CaretX);
          Inc(FShowCol); //2004.5.16为处理TAB键暂加到这里
        end;
        AdjustLeftColByCurCol;
        {if (CaretX - FLeftCol) * FCharWidth > ClientWidth then
          LeftCol := LeftCol + 1;}
      end;
    end;
  end;
  if ToLeft then         //每次复位;凡需向左滚动的均应先设好标志!
    ToLeft := False;
end;

procedure TCustomSkyEdit.AdjustCurColOfCursorUpDown; //光标上下移动时调整其位置
begin
  if (FLastCol < FCurCol) then   //2004.11.14
  begin
    if (CurCol > Length(LineText)) or (Lines[FCurRow][FCurCol] < #127) then
      CurCol := CurCol - 1
    else if (FLastCol < FCurCol - 1) and (Lines[FCurRow][FCurCol] > #127) then
    begin
      FCursorToLeft := True;
      CurCol := CurCol - 1;
    end;
    if ((FBlockBegin.X <> FBlockEnd.X) or (FBlockBegin.Y <> FBlockEnd.Y))
        and (FBlockEnd.X <> CurCol) then  //2004.12.29 有选中文本时
      FBlockEnd.X := CurCol;              //调整因中文字显示而发生变化的列坐标
  end;
end;

procedure TCustomSkyEdit.AdjustLeftColByCurCol;
begin                    //水平滚动至可见
  if FCurCol < FLeftCol then
    LeftCol := CurCol
  else if FCurCol >= FLeftCol + FCharsInWindow then
    LeftCol := CurCol - FCharsInWindow + 1;
end;

function TCustomSkyEdit.AdjustTopRowByCurRow: Boolean;
begin                    //垂直滚动至可见
  Result := True;        //True: 改变了TopRow
  if FCurRow < FTopRow then
    TopRow  := CurRow
  else if FCurRow >= FTopRow + FLinesInWindow then
    TopRow  := CurRow - FLinesInWindow + 1
  else
    Result  := False;    //False: 未改变TopRow
end;

function TCustomSkyEdit.CalcColByXPix(iX: Integer): Integer;
begin                    //由X坐标计算所属列
  Result := (iX - FGutterWidth - LEFTBLANK) div FCharWidth  + LeftCol;
end;

function TCustomSkyEdit.CalcRowByYPix(iY: Integer): Integer;
begin                    //由Y坐标计算所属行
  Result := iY div FTextHeight + TopRow;
  if Result > FTopRow + FLinesInWindow then
    Dec(Result)          //加此行处理是为了最底行光标的显示
  else if Result <= 0 then
    Result := 1;         //2004.9.19 处理滚动时光标在可视区之上部导致<=0情况
end;

function TCustomSkyEdit.GetActualColByCaretX(iX, iRow: Integer; bCheck: Boolean): Integer;
var                      //由直接算出的虚拟列得到真实的列坐标
  idx, iLen: Integer;
begin
  Result := iX;
  if {UseTabKey and} (TabSpaces > 1) and (iRow < Lines.Count) then
  begin                  //用TAB键值而不是空格来处理TAB键
    idx  := Pos(#9, Lines[iRow]);
    if (idx > 0) and (idx < iX) then
    begin                //如果当前行有TAB键值表示的字符且当前列坐标前即可TAB键值
      iLen := Length(Lines[iRow]);
      idx  := 1;
      Result := 1;
      while (idx < iX) and (Result <= iLen) do
      begin
        if Lines[iRow][Result] = #9 then
          Inc(idx, TabSpaces)
        else
          Inc(idx);
        Inc(Result);
      end;
      if bCheck then     //鼠标经过时计算是否位于选择区时需精确定位用(CheckInSelArea)
      begin              //通过idx,iX,Result三者可判定很多东西!
        if idx > iX then //Result位于TAB键所显示第一个空白字符位置之后且处于TAB键显示区?
          Dec(Result);
      end
      else if idx - iX > TabSpaces div 2 then
        Dec(Result) ;    //上行判断光标是位于TAB键显示区的左半区?
      if idx < iX then
        Inc(Result, iX - idx);
    end;
  end;
end;

procedure TCustomSkyEdit.CalcCaretXY(X, Y: Integer);
var                      //由点数偏移计算当前行列
  iX{, idx, iLen, iActualCol}: Integer;
begin
  IncCaretLock;
  iX       := CalcColByXPix(X);
  CurRow   := CalcRowByYPix(Y);
  //FShowCol := iX - 1;  已在UpdateCaret()中统一处理
  {if UseTabKey and (TabSpaces > 1) then
  begin                  //用TAB键值而不是空格来处理TAB键
    idx  := Pos(#9, Lines[FCurRow]);
    if (idx > 0) and (idx < iX) then
    begin                //如果当前行有TAB键值表示的字符且当前列坐标前即可TAB键值
      iLen := Length(Lines[FCurRow]);
      idx  := 1;
      iActualCol := 1;
      while (idx < iX) and (iActualCol <= iLen) do
      begin
        if Lines[FCurRow][iActualCol] = #9 then
          Inc(idx, TabSpaces)
        else
          Inc(idx);
        Inc(iActualCol);
      end;
      if idx < iX then
        Inc(iActualCol, iX - idx);
      iX := iActualCol;
    end;
  end;}
  CurCol := GetActualColByCaretX(iX, FCurRow, False);
  DecCaretLock;
  //需放在上面两行之后，因其计算时用到FCurCol, FCurRow
  //AdjustCaretX(FCurCol, FCursorToLeft);
end;

function TCustomSkyEdit.GetLeftSpaces(const CurLine: String): Integer;
var                      //取得一行字符左边的空格数
  iLen: In