{ *************************************************************************** }
{                                                                             }
{ EControl Syntax Editor SDK                                                  }
{                                                                             }
{ Copyright (c) 2004 - 2008 EControl Ltd., Zaharov Michael                    }
{     www.econtrol.ru                                                         }
{     support@econtrol.ru                                                     }
{                                                                             }
{ *************************************************************************** }
{$I ecSyntEdit.INC}

unit ecSmartTags;

interface

uses Windows, Messages, Classes, Controls, ImgList, Menus, Graphics,
     ecSyntAnal, ecSyntMemo;

type

  TSmartTagKind = (stShrinked, stNormal, stExpanded);
  TSmartTagState = (stsNone, stsOver, stsPressed);

  TSmartTagManager = class;

  TSmartTagStyle = class(TCollectionItem)
  private
    FImageIndex: TImageIndex;
    FColor_MouseOver: TColor;
    FColor_MouseDown: TColor;
    FColor: TColor;
    FBorderColor: TColor;
    FPopupMenu: TPopupMenu;
    FKind: TSmartTagKind;
    FDeleteOnChange: Boolean;
    FHideOutOfRange: Boolean;
    procedure SetBorderColor(const Value: TColor);
    procedure SetColor(const Value: TColor);
    procedure SetColor_MouseDown(const Value: TColor);
    procedure SetColor_MouseOver(const Value: TColor);
    procedure SetImageIndex(const Value: TImageIndex);
    procedure SetKind(const Value: TSmartTagKind);
    procedure SetPopupMenu(const Value: TPopupMenu);
    procedure SetHideOutOfRange(const Value: Boolean);
  public
    constructor Create(Collection: TCollection); override;
  published
    property Kind: TSmartTagKind read FKind write SetKind default stShrinked;
    property BorderColor: TColor read FBorderColor write SetBorderColor default clNavy;
    property Color: TColor read FColor write SetColor default clWindow;
    property Color_MouseOver: TColor read FColor_MouseOver write SetColor_MouseOver;
    property Color_MouseDown: TColor read FColor_MouseDown write SetColor_MouseDown;
    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default - 1;
    property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
    property DeleteOnChange: Boolean read FDeleteOnChange write FDeleteOnChange default True;
    property HideOutOfRange: Boolean read FHideOutOfRange write SetHideOutOfRange default False;
  end;

  TSmartTagStyles = class(TOwnedCollection)
  private
    function GetItem(Index: integer): TSmartTagStyle;
  protected
    procedure Update(Item: TCollectionItem); override;
    function HasStyle(Stl: TSmartTagStyle): Boolean;
  public
    function Add: TSmartTagStyle;
    property Items[Index: integer]: TSmartTagStyle read GetItem; default;
  end;

  TSmartTagWnd = class(TCustomControl)
  private
    FStyle: TSmartTagStyle;
    FState: TSmartTagState;
    FPosition: TPoint;
    FManager: TSmartTagManager;
    FHltStart: integer;
    FHltLength: integer;
    FTextPos: TPoint;
    procedure CMMouseenter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseleave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure SetPosition(const Value: TPoint);
    procedure SetState(const Value: TSmartTagState);
    procedure UpdatePosition;
    procedure SetHltLength(const Value: integer);
    procedure SetHltStart(const Value: integer);
    procedure SetTextPos(const Value: TPoint);
  protected
    procedure Paint; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X: Integer; Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure RecalcPosition;

    property State: TSmartTagState read FState write SetState;
    property Position: TPoint read FPosition write SetPosition;
  public
    constructor CreateStyled(AStyle: TSmartTagStyle);
    destructor Destroy; override;

    property Style: TSmartTagStyle read FStyle;
    property TextPos: TPoint read FTextPos write SetTextPos;
    property HltStart: integer read FHltStart write SetHltStart;
    property HltLength: integer read FHltLength write SetHltLength;
    property Hint;
  end;

  TSmartTagClickEvent = procedure(Sender: TSmartTagManager; Tag: TSmartTagWnd; Button: TMouseButton) of object;

  TSmartTagManager = class(TComponent, IecTextClient, IecSyntMemoPlugIn, IecSyntMemoPlugIn2, IecExternalFormatter)
  private
    FImages: TCustomImageList;
    FEditor: TCustomSyntaxMemo;
    FStyles: TSmartTagStyles;
    FSmartTags: TList;
    FClearOnEscape: Boolean;
    FHltStyle: TSyntaxFormat;
    FCurHlt: TPoint;
    FOnSmartTagClick: TSmartTagClickEvent;
    // IecTextClient
    procedure TextChanged(Sender: TObject; Pos, Count, LineChange: integer);
    // IecSyntMemoPlugIn2
    function HandleKeyStroke(AShortCut: TShortCut): Boolean;
    function HandleMouse(Button: TMouseButton; Shift: TShiftState; X, Y: Integer): Boolean;
    procedure UpdateCursor(X, Y: Integer; Shift: TShiftState; var Cursor: TCursor);
    procedure ScrollPosChanged;
    // IecExternalFormatter
    function GetStyleList(CurPos: integer; List: TStyleEntries): integer; // Formatting
    procedure AnalyzeToPos(APos: integer);                        // Analyzing

    procedure SetEditor(const Value: TCustomSyntaxMemo);
    procedure SetImages(const Value: TCustomImageList);
    procedure SetStyles(const Value: TSmartTagStyles);
    function GetCount: integer;
    function GetItem(Index: integer): TSmartTagWnd;
    procedure SetHltStyle(const Value: TSyntaxFormat);
  protected
    procedure StyleChanged(Style: TSmartTagStyle);
    procedure UpdateHltRange(Tag: TSmartTagWnd);
    procedure SetHighlightRange(Start, Len: integer);
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Clear;

    function Add(Style: integer; Pos: integer; HltStart: integer = 0; HltLength: integer = 0): TSmartTagWnd;

    property Count: integer read GetCount;
    property Items[Index: integer]: TSmartTagWnd read GetItem; default;
  published
    property Images: TCustomImageList read FImages write SetImages;
    property Editor: TCustomSyntaxMemo read FEditor write SetEditor;
    property Styles: TSmartTagStyles read FStyles write SetStyles;
    property HltStyle: TSyntaxFormat read FHltStyle write SetHltStyle;
    property ClearOnEscape: Boolean read FClearOnEscape write FClearOnEscape default False;
    property OnSmartTagClick: TSmartTagClickEvent read FOnSmartTagClick write FOnSmartTagClick;
  end;


implementation

uses SysUtils, Math{$IFDEF EC_DOTNET}, Types{$ENDIF};

{ TSmartTagStyle }

constructor TSmartTagStyle.Create(Collection: TCollection);
begin
  inherited;
  FDeleteOnChange := True;
  FColor := clWindow;
  FBorderColor := clNavy;
  FKind := stShrinked;
  FImageIndex := -1;
end;

procedure TSmartTagStyle.SetBorderColor(const Value: TColor);
begin
  if FBorderColor <> Value then
    begin
      FBorderColor := Value;
      Changed(False);
    end;
end;

procedure TSmartTagStyle.SetColor(const Value: TColor);
begin
  if FColor <> Value then
    begin
      FColor := Value;
      Changed(False);
    end;
end;

procedure TSmartTagStyle.SetColor_MouseDown(const Value: TColor);
begin
  if FColor_MouseDown <> Value then
    begin
      FColor_MouseDown := Value;
      Changed(False);
    end;
end;

procedure TSmartTagStyle.SetColor_MouseOver(const Value: TColor);
begin
  if FColor_MouseOver <> Value then
    begin
      FColor_MouseOver := Value;
      Changed(False);
    end;
end;

procedure TSmartTagStyle.SetHideOutOfRange(const Value: Boolean);
begin
  if FHideOutOfRange <> Value then
    begin
      FHideOutOfRange := Value;
      Changed(False);
    end;
end;

procedure TSmartTagStyle.SetImageIndex(const Value: TImageIndex);
begin
  if FImageIndex <> Value then
    begin
      FImageIndex := Value;
      Changed(False);
    end;
end;

procedure TSmartTagStyle.SetKind(const Value: TSmartTagKind);
begin
  if FKind <> Value then
    begin
      FKind := Value;
      Changed(False);
    end;
end;

procedure TSmartTagStyle.SetPopupMenu(const Value: TPopupMenu);
begin
  if FPopupMenu <> Value then
    begin
      FPopupMenu := Value;
      if Assigned(FPopupMenu) then
        FPopupMenu.FreeNotification(TSmartTagStyles(Collection).GetOwner as TSmartTagManager);
      Changed(False);
    end;
end;

{ TSmartTagStyles }

function TSmartTagStyles.Add: TSmartTagStyle;
begin
  Result := TSmartTagStyle(inherited Add);
end;

function TSmartTagStyles.GetItem(Index: integer): TSmartTagStyle;
begin
  Result := TSmartTagStyle(inherited Items[Index]);
end;

function TSmartTagStyles.HasStyle(Stl: TSmartTagStyle): Boolean;
var i: integer;
begin
  for i := 0 to Count - 1 do
    if Items[i] = Stl then
      begin
        Result := True;
        Exit;
      end;
  Result := False;
end;

procedure TSmartTagStyles.Update(Item: TCollectionItem);
begin
  (GetOwner as TSmartTagManager).StyleChanged(TSmartTagStyle(Item));
end;

{ TSmartTagWnd }

constructor TSmartTagWnd.CreateStyled(AStyle: TSmartTagStyle);
begin
  inherited Create(nil);
  FStyle := AStyle;
  FManager := TSmartTagStyles(FStyle.Collection).GetOwner as TSmartTagManager;
end;

procedure TSmartTagWnd.CMMouseenter(var Message: TMessage);
begin
  State := stsOver;
end;

procedure TSmartTagWnd.CMMouseleave(var Message: TMessage);
begin
  State := stsNone;
end;

procedure TSmartTagWnd.CreateParams(var Params: TCreateParams);
begin
  inherited;
  with Params do
    begin
      Style := Style and not WS_BORDER;
      WindowClass.Style := CS_SAVEBITS or CS_DBLCLKS;
    end;
end;

procedure TSmartTagWnd.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var p: TPoint;
begin
  State := stsPressed;
  if Assigned(FManager.OnSmartTagClick) then
    FManager.OnSmartTagClick(FManager, Self, Button);
  if FStyle.PopupMenu <> nil then
    begin
      p := ClientToScreen(Point(0, Height));
      FStyle.PopupMenu.Popup(p.X, p.Y);
      State := stsNone;
    end;
end;

procedure TSmartTagWnd.Paint;
var p: TPoint;
begin
  with Canvas do
    begin
      Pen.Width := 1;
      if FStyle.FBorderColor = clNone then
        Pen.Style := psClear
      else
        begin
          Pen.Style := psSolid;
          Pen.Color := FStyle.FBorderColor;
        end;
      Brush.Style := bsSolid;
      case FState of
        stsNone: Brush.Color := FStyle.Color;
        stsOver: Brush.Color := FStyle.Color_MouseOver;
        stsPressed: Brush.Color := FStyle.Color_MouseDown;
      end;
      Rectangle(ClientRect);
      // Draw image
      if ((FState <> stsNone) or (FStyle.Kind <> stShrinked)) and
         (FStyle.ImageIndex <> -1) and (FManager.Images <> nil) then
        begin
          FManager.Images.Draw(Canvas, 3, 3, FStyle.ImageIndex);
        end;
      // Draw arrow
       if (FState <> stsNone) or (FStyle.Kind = stExpanded) then
         begin
           Pen.Color := clBlack;
           Brush.Color := clBlack;
           p.X := Width - 10;
           p.Y := Height div 2 - 2;
           Polygon([p, Point(p.X + 6, p.Y), Point(p.X + 3, p.Y + 3)]);
         end;
    end;
end;

procedure TSmartTagWnd.SetPosition(const Value: TPoint);
begin
  if (FPosition.X <> Value.X) or (FPosition.Y <> Value.Y) then
    begin
      FPosition := Value;
      UpdatePosition;
    end;
end;

procedure TSmartTagWnd.SetState(const Value: TSmartTagState);
begin
  if FState <> Value then
    begin
      FState := Value;
      if HltLength > 0 then
        if FState <> stsNone then
          FManager.SetHighlightRange(HltStart, HltLength)
        else
          FManager.SetHighlightRange(0, 0);
      UpdatePosition;
    end;
end;

procedure TSmartTagWnd.UpdatePosition;
var R: TRect;
    ImgW, ImgH: integer;
begin
  R.TopLeft := FPosition;
  if FManager.Images = nil then
    begin
      ImgW := 16;
      ImgH := 16;
    end else
  with FManager.Images do
    begin
      ImgW := Width;
      ImgH := Height;
    end;

  if (FState <> stsNone) or (FStyle.Kind = stExpanded) then
    begin
      R.Bottom := R.Top + ImgH + 6;
      R.Right := R.Left + ImgW + 6 + 12;
    end else
  if FStyle.Kind = stNormal then
    begin
      R.Bottom := R.Top + ImgH + 6;
      R.Right := R.Left + ImgW + 6;
    end else
    begin
      R.Bottom := R.Top + 5;
      R.Right := R.Left + 14;
    end;

  BoundsRect := R;
  Invalidate;
end;

procedure TSmartTagWnd.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
end;

destructor TSmartTagWnd.Destroy;
begin
  FManager.FSmartTags.Remove(Self);
  inherited;
end;

procedure TSmartTagWnd.SetHltLength(const Value: integer);
begin
  if FHltLength <> Value then
    begin
      FHltLength := Value;
      FManager.UpdateHltRange(Self);
    end;
end;

procedure TSmartTagWnd.SetHltStart(const Value: integer);
begin
  if FHltStart <> Value then
    begin
      FHltStart := Value;
      if FHltLength > 0 then
        FManager.UpdateHltRange(Self);
    end;
end;

procedure TSmartTagWnd.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  if State = stsPressed then
    State := stsOver;
end;

procedure TSmartTagWnd.SetTextPos(const Value: TPoint);
begin
  FTextPos := Value;
  RecalcPosition;
end;

procedure TSmartTagWnd.RecalcPosition;
var p: TPoint;
    Lh: integer;
begin
  if FManager.Editor <> nil then
    with FManager.Editor do
      begin
        Lh := LineHeight(FTextPos);
        p := CaretToMouse(FTextPos.X, FTextPos.Y);
        p.Y := p.Y + Lh;
        Self.Position := p;
      end;
end;

{ TSmartTagManager }

constructor TSmartTagManager.Create(AOwner: TComponent);
begin
  inherited;
  FSmartTags := TList.Create;
  FStyles := TSmartTagStyles.Create(Self, TSmartTagStyle);
  FHltStyle := TSyntaxFormat.Create(nil);
end;

destructor TSmartTagManager.Destroy;
begin
  Clear;
  FreeAndNil(FSmartTags);
  FreeAndNil(FStyles);
  FreeAndNil(FHltStyle);
  inherited;
end;

procedure TSmartTagManager.Clear;
var i: integer;
begin
  for i := FSmartTags.Count - 1 downto 0 do
    TObject(FSmartTags[i]).Free;
end;

procedure TSmartTagManager.Notification(AComponent: TComponent;
  Operation: TOperation);
var i: integer;
begin
  inherited;
  if Operation = opRemove then
    begin
      if AComponent = FImages then
        FImages := nil else
      if AComponent = FEditor then
        FEditor := nil else
      if AComponent is TPopupMenu then
        for i := 0 to FStyles.Count - 1 do
          if FStyles[i].PopupMenu = AComponent then
            FStyles[i].FPopupMenu := nil;
    end;
end;

procedure TSmartTagManager.SetEditor(const Value: TCustomSyntaxMemo);
begin
  if FEditor <> Value then
    begin
      if Assigned(FEditor) then
        FEditor.RemoveClient(Self);
      FEditor := Value;
      if Assigned(FEditor) then
        begin
          FEditor.FreeNotification(Self);
          FEditor.AddClient(Self);
        end;
      Clear;
    end;
end;

procedure TSmartTagManager.SetImages(const Value: TCustomImageList);
begin
  if FImages <> Value then
    begin
      FImages := Value;
      if Assigned(FImages) then
        FImages.FreeNotification(Self);
    end;
end;

procedure TSmartTagManager.SetStyles(const Value: TSmartTagStyles);
begin
  FStyles.Assign(Value);
end;

function TSmartTagManager.GetCount: integer;
begin
  Result := FSmartTags.Count;
end;

function TSmartTagManager.GetItem(Index: integer): TSmartTagWnd;
begin
  Result := TSmartTagWnd(FSmartTags[Index]);
end;

procedure TSmartTagManager.TextChanged(Sender: TObject; Pos, Count,
  LineChange: integer);
var i: integer;
begin
  for i := Self.Count - 1 downto 0 do
    if Items[i].Style.DeleteOnChange then
      Items[i].Free;
end;

function TSmartTagManager.Add(Style: integer; Pos: integer; HltStart: integer; HltLength: integer): TSmartTagWnd;
var p: integer;
begin
  if Assigned(FEditor) then
    begin
      Result := TSmartTagWnd.CreateStyled(FStyles[Style]);
      Result.Parent := FEditor;
      FSmartTags.Add(Result);
      Result.TextPos := FEditor.StrPosToCaretPos(Pos);
      Result.HltStart := HltStart;
      Result.HltLength := HltLength;
      if Result.Style.HideOutOfRange then
        with FEditor, ScreenToClient(Mouse.CursorPos) do
          begin
            p := CaretPosToStrPos(MouseToCaret(X, Y));
            if (p < Result.HltStart) or (p - Result.HltStart > Result.HltLength) then
              begin
                Result.Hide;
                Exit; // do not show
              end;
          end;
      Result.Show;
    end else
      Result := nil;
end;

procedure TSmartTagManager.UpdateHltRange(Tag: TSmartTagWnd);
begin

end;

procedure TSmartTagManager.StyleChanged(Style: TSmartTagStyle);
var I: integer;
begin
  for i := Count - 1 downto 0 do
    begin
      if Style = Items[i].Style then
        Items[i].UpdatePosition else
      if (Style = nil) and not FStyles.HasStyle(Items[i].Style) then
        Items[i].Free;
    end;
end;

function TSmartTagManager.HandleKeyStroke(AShortCut: TShortCut): Boolean;
begin
  Result := False;
  if ClearOnEscape and (AShortCut = VK_ESCAPE) then
    Clear;
end;

function TSmartTagManager.HandleMouse(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer): Boolean;
begin
  Result := False;
end;

procedure TSmartTagManager.ScrollPosChanged;
var i: integer;
begin
  for i := 0 to Count - 1 do
    Items[i].RecalcPosition;
end;

procedure TSmartTagManager.UpdateCursor(X, Y: Integer; Shift: TShiftState;
  var Cursor: TCursor);
var i, p: integer;
begin
  if Assigned(FEditor) then
    begin
      p := -1;
      for i := 0 to Count - 1 do
        if Items[i].Style.HideOutOfRange then
          begin
            if p = -1 then
              p := FEditor.CaretPosToStrPos(FEditor.MouseToCaret(X, Y));
            Items[i].Visible := (p >= Items[i].HltStart) and (p - Items[i].HltStart <= Items[i].HltLength);
          end;
    end;
end;

procedure TSmartTagManager.SetHltStyle(const Value: TSyntaxFormat);
begin
  FHltStyle.Assign(Value);
end;

procedure TSmartTagManager.SetHighlightRange(Start, Len: integer);
var inv_s, inv_e: integer;
begin
  if (FCurHlt.X <> Start) or (FCurHlt.Y <> Start + Len) then
    begin
      if FCurHlt.Y = 0 then
        begin
          inv_s := Start;
          inv_e := Start + Len;
        end else
      if Len = 0 then
        begin
          inv_s := FCurHlt.X;
          inv_e := FCurHlt.Y;
        end else
        begin
          inv_s := min(FCurHlt.X, Start);
          inv_e := max(FCurHlt.Y, Start + Len);
        end;

      FCurHlt.X := Start;
      FCurHlt.Y := Start + Len;
      if Assigned(FEditor) and (inv_e > 0) then
        FEditor.InvalidateTextRange(inv_s, inv_e, False);
    end;
end;

procedure TSmartTagManager.AnalyzeToPos(APos: integer);
begin
end;

function TSmartTagManager.GetStyleList(CurPos: integer;
  List: TStyleEntries): integer;
begin
  Result := -1;
  if (FCurHlt.Y > 0) and (CurPos < FCurHlt.Y) then
    begin
      if FCurHlt.X > CurPos then Result := FCurHlt.X else
       begin
         List.Add(FHltStyle, FCurHlt.X, FCurHlt.Y);
         Result := FCurHlt.Y;
       end;
    end;
end;

end.
