rm_jveditorcommon.pas

这是一个功能强大

   function IsIntf(AInstance: TObject; IID: TGUID): Boolean; overload;
   begin
     Result := (AInstance <> nil) and (AInstance.GetInterfaceEntry(IID) <> nil);
   end;

   function IsIntf(AClass: TClass; IID: TGUID): Boolean; overload;
   begin
     Result := (AClass <> nil) and (AClass.GetInterfaceEntry(IID) <> nil);
   end;

var
  UndoClass: TClass;
  Compound: Integer;
  IsOnlyCaret: Boolean;
  Selection: TJvSelectionRec;
  WasModified: Boolean;
begin
  if InUndo then
    Exit;

  Selection := FJvEditor.FSelection;
  WasModified := FJvEditor.Modified;

  IsOnlyCaret := True;
  InUndo := True;
  try
    if LastUndo <> nil then
    begin
      Compound := 0;
      UndoClass := LastUndo.ClassType;
      while (LastUndo <> nil) and
        ((UndoClass = LastUndo.ClassType) or
        {(LastUndo is TJvDeleteTrailUndo) or
        (LastUndo is TJvReLineUndo) or}
        IsIntf(LastUndo, IJvUndoCompound) or
        (Compound > 0)) or
        {((UndoClass = TJvBackspaceUndo) and
        (LastUndo is TJvBackspaceUnindentUndo)) do}
        IsIntf(UndoClass, IJvBackspaceUndo) and
        IsIntf(LastUndo, IJvBackspaceUnindentUndo) do
      begin
        if LastUndo.ClassType = TJvBeginCompoundUndo then
        begin
          Dec(Compound);
          UndoClass := nil;
        end
        else
        if LastUndo.ClassType = TJvEndCompoundUndo then
          Inc(Compound);
        LastUndo.Undo;
        if LastUndo <> nil then
        begin
          LastUndo.RestoreSelection;
          FJvEditor.Modified := LastUndo.FModified;
        end;
        Dec(FPtr);
        {if (UndoClass = TJvDeleteTrailUndo) or
          (UndoClass = TJvReLineUndo) then}
        if IsIntf(UndoClass, IJvUndoCompound) then
          UndoClass := LastUndo.ClassType;
        if (UndoClass <> TJvCaretUndo) and
          (UndoClass <> TJvSelectUndo) and
          (UndoClass <> TJvUnselectUndo) then
          IsOnlyCaret := False;
        if not FJvEditor.GroupUndo then
          Break;
      end;
      if not FJvEditor.Modified then
        IsOnlyCaret := True;

      // paint selection
      if not CompareMem(@Selection, @FJvEditor.FSelection, SizeOf(TJvSelectionRec)) then
        FJvEditor.PaintSelection;

      FJvEditor.UpdateEditorView;
      if FJvEditor.FUpdateLock = 0 then
        if not IsOnlyCaret then
          FJvEditor.Changed
        else
        if WasModified then
          FJvEditor.StatusChanged;
    end;
  finally
    InUndo := False;
  end;
end;

procedure TJvUndoBuffer.Redo;
begin
  if CanRedo then
  begin
    Inc(FPtr);
    LastUndo.Redo;
  end;
end;

procedure TJvUndoBuffer.Clear;
begin
  while Count > 0 do
  begin
    TJvUndo(Items[0]).Free;
    inherited Delete(0);
  end;
  inherited Clear;
end;

procedure TJvUndoBuffer.ClearRedo;
begin
  while (Count > 0) and (FPtr < Count - 1) do
  begin
    TJvUndo(Items[FPtr + 1]).Free;
    inherited Delete(FPtr + 1);
  end;
end;

procedure TJvUndoBuffer.Delete;
begin
  if Count > 0 then
  begin
    TJvUndo(Items[Count - 1]).Free;
    inherited Delete(Count - 1);
  end;
end;

function TJvUndoBuffer.LastUndo: TJvUndo;
begin
  if (FPtr >= 0) and (Count > 0) then
    Result := TJvUndo(Items[FPtr])
  else
    Result := nil;
end;

function TJvUndoBuffer.IsNewGroup(AUndo: TJvUndo): Boolean;
begin
  Result := (LastUndo = nil) or (LastUndo.ClassType <> AUndo.ClassType)
end;

function TJvUndoBuffer.IsCaretGroup: Boolean;
begin
  Result := (LastUndo <> nil) and (LastUndo.ClassType = TJvCaretUndo);
end;

function TJvUndoBuffer.CanUndo: Boolean;
begin
  Result := (LastUndo <> nil);
end;

function TJvUndoBuffer.CanRedo: Boolean;
begin
{
  Result := FPtr < Count;
}
  Result := False;
  ClearRedo;
end;

//=== { TJvUndo } ============================================================

constructor TJvUndo.Create(AJvEditor: TJvCustomEditorBase);
begin
  inherited Create;
  FJvEditor := AJvEditor;
  FModified := FJvEditor.FModified;
  UndoBuffer.Add(Self);
  FSelection := nil;
end;

destructor TJvUndo.Destroy;
begin
  if Assigned(FSelection) then
    Dispose(FSelection);
  // (rom) added inherited Destroy
  inherited Destroy;
end;

procedure TJvUndo.Redo;
begin
  RedoNotImplemented;
end;

procedure TJvUndo.RestoreSelection;
begin
  if Assigned(FSelection) then
  begin
    FJvEditor.FSelection := FSelection^;
    FJvEditor.SetSelUpdateRegion(FSelection^.SelBegY, FSelection^.SelEndY);
  end;
end;

procedure TJvUndo.SaveSelection;
begin
  if not Assigned(FSelection) then
    New(FSelection);
  FSelection^ := FJvEditor.FSelection;
end;

function TJvUndo.UndoBuffer: TJvUndoBuffer;
begin
  if FJvEditor <> nil then
    Result := FJvEditor.FUndoBuffer
  else
    Result := nil;
end;

//=== { TJvCaretUndo } =======================================================

constructor TJvCaretUndo.Create(AJvEditor: TJvCustomEditorBase;
  ACaretX, ACaretY: Integer);
begin
  inherited Create(AJvEditor);
  FCaretX := ACaretX;
  FCaretY := ACaretY;
end;

procedure TJvCaretUndo.Undo;
begin
  with UndoBuffer do
  begin
    Dec(FPtr);
    while JvEditor.FGroupUndo and (FPtr >= 0) and not IsNewGroup(Self) do
      Dec(FPtr);
    Inc(FPtr);
    with TJvCaretUndo(Items[FPtr]) do
      JvEditor.SetCaretInternal(FCaretX, FCaretY);
  end;
end;

//=== { TJvSelectUndo } ======================================================

constructor TJvSelectUndo.Create(AJvEditor: TJvCustomEditorBase;
  ACaretX, ACaretY: Integer);
begin
  inherited Create(AJvEditor, ACaretX, ACaretY);
  SaveSelection;
end;

procedure TJvSelectUndo.Undo;
var
  LastSel: TJvSelectUndo;
  LastCaret: TJvCaretUndo;
begin
  LastSel := Self;
  LastCaret := nil;
 { Undo TJvSelectUndo and TJvCaretUndo in one action. This prevents
   unnecessary caret movement with scolling. }
  with UndoBuffer do
  begin
    while (FPtr >= 0) and ((not IsNewGroup(Self)) or (IsCaretGroup)) do
    begin
      if LastUndo.ClassType = TJvCaretUndo then
        LastCaret := TJvCaretUndo(LastUndo)
      else
        LastSel := TJvSelectUndo(LastUndo);
      Dec(FPtr);
      if not FJvEditor.FGroupUndo then
        Break;
    end;
    Inc(FPtr);
  end;

  LastSel.RestoreSelection;

  if LastCaret <> nil then
    LastCaret.Undo
  else
    FJvEditor.SetCaretInternal(LastSel.FCaretX, LastSel.FCaretY);
end;

//=== { TJvBeginCompoundUndo } ===============================================

procedure TJvBeginCompoundUndo.Undo;
begin
  { nothing }
end;

//=== { TJvControlScrollBar95 } ==============================================

const
  SBKIND: array [TScrollBarKind] of Integer = (SB_HORZ, SB_VERT);

constructor TJvControlScrollBar95.Create;
begin
  inherited Create;
  FPage := 1;
  FSmallChange := 1;
  FLargeChange := 1;
end;

procedure TJvControlScrollBar95.SetParams(AMin, AMax, APosition, APage: Integer);
var
  ScrollInfo: TScrollInfo;
begin
  if AMax < AMin then
    raise EInvalidOperation.CreateRes(@SScrollBarRange);
  if APosition < AMin then
    APosition := AMin;
  if APosition > AMax then
    APosition := AMax;
  if Handle > 0 then
  begin
    with ScrollInfo do
    begin
      cbSize := SizeOf(TScrollInfo);
      fMask := SIF_DISABLENOSCROLL;
      if (AMin >= 0) or (AMax >= 0) then
        fMask := fMask or SIF_RANGE;
      if APosition >= 0 then
        fMask := fMask or SIF_POS;
      if APage >= 0 then
        fMask := fMask or SIF_PAGE;
      nPos := APosition;
      nMin := AMin;
      nMax := AMax;
      nPage := APage;
    end;
    SetScrollInfo(
      Handle, // handle of window with scroll bar
      SBKIND[Kind], // scroll bar flag
      ScrollInfo, // pointer to structure with scroll parameters
      True); // redraw flag
  end;
end;

procedure TJvControlScrollBar95.SetParam(Index, Value: Integer);
begin
  case Index of
    0:
      FMin := Value;
    1:
      FMax := Value;
    2:
      FPosition := Value;
    3:
      FPage := Value;
  end;
  if FMax < FMin then
    raise EInvalidOperation.CreateRes(@SScrollBarRange);
  if FPosition < FMin then
    FPosition := FMin;
  if FPosition > FMax then
    FPosition := FMax;
  SetParams(FMin, FMax, FPosition, FPage);
end;

procedure TJvControlScrollBar95.DoScroll(var Msg: TWMScroll);
var
  ScrollPos: Integer;
  NewPos: Longint;
  ScrollInfo: TScrollInfo;
begin
  with Msg do
  be