skyedit.pas

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

    FLastMerge := bMerge;
end;

function TSkyUndoList.GetChange(Index: Integer): TChangeMode;
begin
  if (FList.Count > 0) and (Index >= 0) and (Index < FList.Count) then
    Result := PChangeRec(FList.Items[Index])^.ChangeMode
  else
    Result := cmNone;
end;

function TSkyUndoList.GetChange(Index: Integer; var ChgBegin, ChgEnd: TPoint
                 ): TChangeMode;
begin
  if (FList.Count > 0) and (Index >= 0) and (Index < FList.Count) then
  begin
    with PChangeRec(FList.Items[Index])^ do
    begin
      ChgBegin := ChangeBegin;
      ChgEnd   := ChangeEnd;
      Result   := ChangeMode;
    end;
  end
  else
    Result := cmNone;
end;

function TSkyUndoList.GetChange(Index: Integer; var ChgBegin, ChgEnd: TPoint;
                 var ChgStr: PChar): TChangeMode;
begin
  if (FList.Count > 0) and (Index >= 0) and (Index < FList.Count) then
  begin
    with PChangeRec(FList.Items[Index])^ do
    begin
      ChgBegin := ChangeBegin;
      ChgEnd   := ChangeEnd;
      ChgStr   := StrNew(ChangeStr);
      Result   := ChangeMode;
    end;
  end
  else
    Result := cmNone;
end;

function TSkyUndoList.GetUndoChange(var ChgBegin, ChgEnd: TPoint;
                 var ChgStr: PChar): TChangeMode;
begin              //取得“撤消”信息
  if FLastMerge then                //2004.12.26 若上次AddChange.bMerge = True
    FLastMerge := False;            //则“撤消”后应开始新一轮“合并”
  Result := GetChange(FCurUndoTop - 1, ChgBegin, ChgEnd, ChgStr);
  if Result <> cmNone then
    CurUndoTop := FCurUndoTop - 1;  //执行“撤消”只是将Undo推入Redo栈
end;

function TSkyUndoList.GetRedoChange(var ChgBegin, ChgEnd: TPoint;
                 var ChgStr: PChar): TChangeMode;
begin              //取得“重做”信息
  Result := GetChange(FCurUndoTop, ChgBegin, ChgEnd, ChgStr);
  if Result <> cmNone then
    CurUndoTop := FCurUndoTop + 1;  //执行“重做”只是将Redo推入Undo栈
end;

function TSkyUndoList.GetTopUndoChangeMode: TChangeMode;
begin              //取得“撤消”栈顶之 ChangeMode 且不退栈
  Result := GetChange(FCurUndoTop - 1);
end;

function TSkyUndoList.GetTopRedoChangeMode: TChangeMode;
begin              //取得“重做”栈顶之 ChangeMode 且不退栈
  Result := GetChange(FCurUndoTop);
end;

procedure TSkyUndoList.UpdateChgStr(Index: Integer; UpStr: PChar);
begin
  with PChangeRec(FList.Items[Index])^ do
  begin
    StrDispose(ChangeStr);
    ChangeStr := StrNew(UpStr);
  end;
end;

procedure TSkyUndoList.UpdatePopUndoChgStr(UpStr: PChar);
begin              //在GetUndoChange之后执行，确保Redo时正常重做
  UpdateChgStr(FCurUndoTop, UpStr);
end;

procedure TSkyUndoList.UpdatePopRedoChgStr(UpStr: PChar);
begin              //在GetRedoChange之后执行，确保Undo时正常撤消
  UpdateChgStr(FCurUndoTop - 1, UpStr);
end;

procedure TSkyUndoList.UpdateChgPos(Index: Integer; ptBegin, ptEnd: TPoint);
begin
  with PChangeRec(FList.Items[Index])^ do
  begin
    ChangeBegin := ptBegin;
    ChangeEnd   := ptEnd;
  end;
end;

procedure TSkyUndoList.UpdatePopUndoChgPos(ptBegin, ptEnd: TPoint);
begin              //在GetUndoChange之后执行，确保Redo时正常重做(cmLineBreak)
  UpdateChgPos(FCurUndoTop, ptBegin, ptEnd);
end;

procedure TSkyUndoList.UpdatePopRedoChgPos(ptBegin, ptEnd: TPoint);
begin              //在GetRedoChange之后执行，确保Undo时正常撤消(cmLineBreak)
  UpdateChgPos(FCurUndoTop - 1, ptBegin, ptEnd);
end;


{******************************************************************************
*               以下是 TSkyStringList 的实现                                  *
******************************************************************************}
constructor TSkyStringList.Create(AOwner: TCustomSkyEdit);
begin
  inherited Create;
  FModified := False;
  FOwner    := AOwner;
end;

procedure TSkyStringList.Changed;
begin
  inherited;
  if not FModified then
    FModified := True;

  if UpdateCount = 0 then//必须加本行判断，否则...系统就有得忙了
    if FOwner <> nil then
      FOwner.LinesChanged(Self);
end;

procedure TSkyStringList.Put(Index: Integer; const S: string);
begin                    //本函数自TStringList重载而来
  if (FOwner <> nil) and FOwner.ReadOnly then Exit;

  BeginUpdate;
  try
    inherited Put(Index, S);
    if Assigned(FOnPutted) then FOnPutted(Index);
  finally
    EndUpdate;
  end;
end;

procedure TSkyStringList.SetTextStr(const Value: String);
var                      //本函数自TStrings重载而来
  P, Start, pEnd: PChar;
  S: string;
begin
  if FOwner.ReadOnly then Exit;

  BeginUpdate;
  try
    Clear;
    P := Pointer(Value);
    if P <> nil then
    begin
      pEnd := P + Length(Value);// FStreamSize; 用Lines.Text := string 时只能用Length(Value) 2004.11.9
      while P < pEnd do  //P^ <> #0 do
      begin
        Start := P;
        //以下循环忽略掉 #0 是为了用于处理某些含 #0 字符的文本 2004.4.16  sky
        while (P < pEnd) and not (P^ in [{#0,} #10, #13]) do //(P < pEnd)不能少!
          Inc(P);
        SetString(S, Start, P - Start);
        Add(S);
        if P^ = #13 then Inc(P);
        if P^ = #10 then Inc(P);
      end;
    end;

    if Assigned(FOnLoaded) then FOnLoaded(Self);

  finally
    EndUpdate;
  end;
end;

procedure TSkyStringList.LoadFromStream(Stream: TStream);
begin
  if FOwner <> nil then
  begin
    FOwner.IncPaintLock;
    FOwner.GotoOriginLeftTop;
    if FOwner.ReadOnly then//如果不复位，则不能正常载入文件
      FOwner.ReadOnly := False;
  end;

  //FStreamSize := Stream.Size - Stream.Position;
  inherited;               //TStrings.LoadFromStream()中会调用SetTextStr()
  FModified := False;      //2004.11.28

  if FOwner <> nil then
  begin
    FOwner.DecPaintLock;
    FOwner.ClearUndo;
    FOwner.Change;         //为了改变FModified后能立即得知，故调一下Change
  end;
end;

procedure TSkyStringList.SaveToStream(Stream: TStream);
begin
  inherited;
  FModified := False;
  if FOwner <> nil then
  begin
    FOwner.ClearUndo;
    FOwner.Change;         //为了改变FModified后能立即得知，故调一下Change
  end;
end;

procedure TSkyStringList.Clear;
begin
  if (FOwner <> nil) and FOwner.ReadOnly then
  begin                    //如果SkyEdit为只读，则什么也不做
    MessageBeep(MB_OK);
    Exit;
  end;

  inherited;
  if (FOwner <> nil) and (UpdateCount = 0) then
  begin                    //加UpdateCount = 0的判断是为了在批量更新时不清空Undo
    FOwner.ClearUndo;      //即可用BeginUpdate,EndUpdate避开这里的清空Undo 2004.12.16
    FOwner.Change;         //为了改变FModified后能立即得知，故调一下Change
  end;
end;

function TSkyStringList.Add(const S: string): Integer;
begin                    
  Result := -1;          //本函数自TStringList重载而来

  if (FOwner <> nil) and FOwner.ReadOnly then Exit;

  BeginUpdate;
  try
    Result := inherited Add(S);
    if Assigned(FOnAdded) then FOnAdded(Self);
  finally
    EndUpdate;
  end;
end;

procedure TSkyStringList.Delete(Index: Integer);
begin                    //本函数自TStringList重载而来
  if (FOwner <> nil) and FOwner.ReadOnly then Exit;

  BeginUpdate;
  try
    inherited Delete(Index);
    if Assigned(FOnDeleted) then fOnDeleted(Index);
  finally
    EndUpdate;
  end;
end;

procedure TSkyStringList.Insert(Index: Integer; const S: string);
begin                    //本函数自TStringList重载而来
  if (FOwner <> nil) and FOwner.ReadOnly then Exit;

  BeginUpdate;
  try
    inherited Insert(Index, S);
    if Assigned(FOnInserted) then fOnInserted(Index);
  finally
    EndUpdate;
  end;
end;

{******************************************************************************
*               以下是 TCustomSkyEdit 的实现                                  *
******************************************************************************}
constructor TCustomSkyEdit.Create(AOwner: TComponent);
const
  EditStyle = [csClickEvents, csSetCaption, csDoubleClicks, csFixedHeight];
begin
  FLines := TSkyStringList.Create(Self);  //此句应在inherited Create之前,因SetName()用到!

  FUndoList := TSkyUndoList.Create;       //“撤消”栈

  inherited Create(AOwner);

  if not (csDesigning in ComponentState) then
    FLines.Add('');              //编辑的需要（如一开始即按回车键:ProcessVK_RETURN() ）

  TSkyStringList(FLines).OnAdded    := ListAdded;
  TSkyStringList(FLines).OnDeleted  := ListDeleted;
  TSkyStringList(FLines).OnInserted := ListInserted;
  TSkyStringList(FLines).OnLoaded   := ListLoaded;
  TSkyStringList(FLines).OnPutted   := ListPutted;

  if NewStyleControls then
    ControlStyle := EditStyle
  else
    ControlStyle := EditStyle + [csFramed];
  Width  := 200;
  Height := 160;
  TabStop        := True;
  ParentColor    := False;
  FBorderStyle   := bsSingle;
  FHideSelection := True;
  FScrollBars    := ssBoth;

  FWordWrap      := True;
  FWantReturns   := True;
  FWantTabs      := True;

  FLeftCol := 0;            //当前最左列
  FTopRow  := 0;            //当前最上行
  FCurCol  := 0;            //当前列