Michael Cessna

unit NxHyperlinkColumn;

// -----------------------------------------------------------------------------
// Hyperlink column for NxGrid with support for visited history, etc.
// -----------------------------------------------------------------------------
// Author: Michael Cessna
// Date: 06/20/2008
// Version: 0.9
// -----------------------------------------------------------------------------
// Use at your own risk. Not exhaustively tested.
// If you find a bug please let me know via the bergsoft.net forum.
// -----------------------------------------------------------------------------

// -----------------------------------------------------------------------------
// Example
// -----------------------------------------------------------------------------
// var
//   oColumn : TNxCustomColumn;
// begin
//   oColumn := NextGrid1.Columns.Add(TNxHyperlinkColumn, 'Hyperlink');
//   oColumn.Width := 150;
//   (oColumn as TNxHyperlinkColumn).OnClick := HandleOnHyperlinkClick;
//   if FileExists('C:\Visited.txt') then
//     (oColumn as TNxHyperlinkColumn).LoadVisitedHyperlinksFromFile('C:\Visited.txt');
//   if FileExists('C:\Invalidated.txt') then
//     (oColumn as TNxHyperlinkColumn).LoadInvalidatedHyperlinksFromFile('C:\Invalidated.txt');
//   { etc. }
// end;
//
// procedure TfrmMain.HandleOnHyperlinkClick(Sender: TObject; ACol, ARow: Integer; AHyperlink: WideString);
// var
//   oColumn  : TNxCustomColumn;
//   oRequest : OleVariant;
//   iStatus  : Integer;
// begin
//   oColumn := NextGrid1.Columns[ACol];
//   if (oColumn is TNxHyperlinkColumn) then
//   begin
//     { Note : Just an example. Not real world. }
//     if AnsiPos('http', AnsiLowerCase(AHyperlink)) = 1 then
//     begin
//       oRequest := CreateOleObject('Microsoft.XMLHttp');
//       try
//         oRequest.open('GET', AHyperlink, False);
//         try
//           oRequest.send;
//           iStatus := oRequest.status;
//           case iStatus of
//             200 : (oColumn as TNxHyperlinkColumn).AddVisitedHyperlink(AHyperlink);
//             else
//               (oColumn as TNxHyperlinkColumn).AddInvalidatedHyperlink(AHyperlink); // This may be a redirect, etc...not a 404.
//           end;
//         except
//           (oColumn as TNxHyperlinkColumn).AddInvalidatedHyperlink(AHyperlink);
//         end;
//         { Refresh is useful if multiple hyperlinks with the same text are adjacent to one another }
//         NextGrid1.RefreshColumn(oColumn);
//       finally
//         oRequest := Unassigned;
//       end;
//     end
//     else
//      ; { etc. }
//   end;
// end;
// -----------------------------------------------------------------------------

{$I '..\NxSuite.inc'}

interface

uses
  Forms, Classes, Types, Windows, Graphics, Controls, SysUtils, NxColumns,
  NxClasses, NxEdit;

const
  { Hyperlink related colors }
  clDefaultHyperlink            = $00B36600; { Medium blue }
  clDefaultInvalidatedHyperlink = $000000FF; { Red }
  clDefaultVisitedHyperlink     = $00990066; { Purple }

type
  { TNxHyperlinkClickEvent }
  TNxHyperlinkClickEvent = procedure(Sender: TObject; ACol, ARow: Integer; AHyperlink: WideString) of object;

  { TNxHyperlinkColumn }
  TNxHyperlinkColumn = class(TNxCustomColumn)
  private
    { Private declarations }
    FInvalidatedLinkColor: TColor;
    FOnClick: TNxHyperlinkClickEvent;
    FVisitedLinkColor: TColor;
  protected
    { Protected declarations }
    { The lists are protected so that both can be managed correspondingly }
    FInvalidatedHyperlinks: TNxStringList;
    FVisitedHyperlinks: TNxStringList;
      function GetCellEditorClass: TCellEditorClass; override;
    function GetColumnDisplayClass: TColumnDisplayClass; override;
    function GetColumnPlayClass: TColumnPlayClass; override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AddInvalidatedHyperlink(AHyperlink: WideString); virtual;
    procedure AddVisitedHyperlink(AHyperlink: WideString); virtual;
    procedure ClearInvalidatedHyperlinks; virtual;
    procedure ClearVisitedHyperlinks; virtual;
    function HyperlinkHasBeenInvalidated(AHyperlink: WideString): Boolean; virtual;
    function HyperlinkHasBeenVisited(AHyperlink: WideString): Boolean; virtual;
    procedure LoadInvalidatedHyperlinksFromFile(AFileName: WideString); virtual;
    procedure LoadInvalidatedHyperlinksFromStream(AStream: TStream); virtual;
    procedure LoadVisitedHyperlinksFromFile(AFileName: WideString); virtual;
    procedure LoadVisitedHyperlinksFromStream(AStream: TStream); virtual;
    procedure RemoveInvalidatedHyperlink(AHyperlink: WideString); virtual;
    procedure RemoveVisitedHyperlink(AHyperlink: WideString); virtual;
    procedure SaveInvalidatedHyperlinksToFile(AFileName: WideString); virtual;
    procedure SaveInvalidatedHyperlinksToStream(AStream: TStream); virtual;
    procedure SaveVisitedHyperlinksToFile(AFileName: WideString); virtual;
    procedure SaveVisitedHyperlinksToStream(AStream: TStream); virtual;
  published
    { Published declarations }
    property InvalidatedLinkColor: TColor read FInvalidatedLinkColor write FInvalidatedLinkColor default clDefaultInvalidatedHyperlink;
    property VisitedLinkColor: TColor read FVisitedLinkColor write FVisitedLinkColor default clDefaultVisitedHyperlink;
    property OnClick: TNxHyperlinkClickEvent read FOnClick write FOnClick;
  end;

  { THyperlinkColumnDisplay }
  THyperlinkColumnDisplay = class(TColumnDisplay)
  public
    { Public declarations }
    function GetTextSize: TSize; override;
    procedure Paint; override;
  end;

  { THyperlinkColumnPlay }
  THyperlinkColumnPlay = class(TColumnPlay)
  protected
    { Protected declarations }
    function MouseIsOverHyperlink(X, Y: Integer): Boolean; virtual;
  public
    { Public declarations }
    procedure MouseLeave; override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  end;

implementation

{ TNxHyperlinkColumn }

procedure TNxHyperlinkColumn.AddInvalidatedHyperlink(AHyperlink: WideString);
var
  iIndex : Integer;
begin
  FInvalidatedHyperlinks.Add(AHyperlink);
  iIndex := FVisitedHyperlinks.IndexOf(AHyperlink);
  if (iIndex <> -1) then
    FVisitedHyperlinks.Delete(iIndex);
end;

procedure TNxHyperlinkColumn.AddVisitedHyperlink(AHyperlink: WideString);
var
  iIndex : Integer;
begin
  FVisitedHyperlinks.Add(AHyperlink);
  iIndex := FInvalidatedHyperlinks.IndexOf(AHyperlink);
  if (iIndex <> -1) then
    FInvalidatedHyperlinks.Delete(iIndex);
end;

procedure TNxHyperlinkColumn.ClearInvalidatedHyperlinks;
begin
  FInvalidatedHyperlinks.Clear;
end;

procedure TNxHyperlinkColumn.ClearVisitedHyperlinks;
begin
  FVisitedHyperlinks.Clear;
end;

constructor TNxHyperlinkColumn.Create(AOwner: TComponent);
begin
  inherited;
  SetSortType(stAlphabetic);
  SetColumnType(ctString);
  Options := [coCanClick, coCanInput, coCanSort, coEditing, coPublicUsing, coShowTextFitHint];
  { Font }
  Font.Color := clDefaultHyperlink;
  Font.Style := [fsUnderline];
  { Colors }
  FInvalidatedLinkColor := clDefaultInvalidatedHyperlink;
  FVisitedLinkColor := clDefaultVisitedHyperlink;
  { Invalidated Hyperlinks }
  FInvalidatedHyperlinks := TNxStringList.Create;
  FInvalidatedHyperlinks.Sorted := True;
  FInvalidatedHyperlinks.Duplicates := dupIgnore;
  { Visited Hyperlinks }
  FVisitedHyperlinks := TNxStringList.Create;
  FVisitedHyperlinks.Sorted := True;
  FVisitedHyperlinks.Duplicates := dupIgnore;
end;

destructor TNxHyperlinkColumn.Destroy;
begin
  FreeAndNil(FInvalidatedHyperlinks);
  FreeAndNil(FVisitedHyperlinks);
  inherited;
end;

function TNxHyperlinkColumn.GetCellEditorClass: TCellEditorClass;
begin
  Result := nil;
end;

function TNxHyperlinkColumn.GetColumnDisplayClass: TColumnDisplayClass;
begin
  Result := THyperlinkColumnDisplay;
end;

function TNxHyperlinkColumn.GetColumnPlayClass: TColumnPlayClass;
begin
  Result := THyperlinkColumnPlay;
end;

function TNxHyperlinkColumn.HyperlinkHasBeenInvalidated(
  AHyperlink: WideString): Boolean;
begin
  Result := FInvalidatedHyperlinks.IndexOf(AHyperlink) <> -1;
end;

function TNxHyperlinkColumn.HyperlinkHasBeenVisited(AHyperlink: WideString): Boolean;
begin
  Result := FVisitedHyperlinks.IndexOf(AHyperlink) <> -1;
end;

procedure TNxHyperlinkColumn.LoadInvalidatedHyperlinksFromFile(AFileName: WideString);
begin
  FInvalidatedHyperlinks.LoadFromFile(AFileName);
end;

procedure TNxHyperlinkColumn.LoadInvalidatedHyperlinksFromStream(AStream: TStream);
begin
  FInvalidatedHyperlinks.LoadFromStream(AStream);
end;

procedure TNxHyperlinkColumn.LoadVisitedHyperlinksFromFile(AFileName: WideString);
begin
  FVisitedHyperlinks.LoadFromFile(AFileName);
end;

procedure TNxHyperlinkColumn.LoadVisitedHyperlinksFromStream(AStream: TStream);
begin
  FVisitedHyperlinks.LoadFromStream(AStream);
end;

procedure TNxHyperlinkColumn.RemoveInvalidatedHyperlink(AHyperlink: WideString);
var
  iIndex : Integer;
begin
  iIndex := FInvalidatedHyperlinks.IndexOf(AHyperlink);
  if (iIndex <> -1) then
    FInvalidatedHyperlinks.Delete(iIndex);
end;

procedure TNxHyperlinkColumn.RemoveVisitedHyperlink(AHyperlink: WideString);
var
  iIndex : Integer;
begin
  iIndex := FVisitedHyperlinks.IndexOf(AHyperlink);
  if (iIndex <> -1) then
    FVisitedHyperlinks.Delete(iIndex);
end;

procedure TNxHyperlinkColumn.SaveInvalidatedHyperlinksToFile(AFileName: WideString);
begin
  FInvalidatedHyperlinks.SaveToFile(AFileName);
end;

procedure TNxHyperlinkColumn.SaveInvalidatedHyperlinksToStream(AStream: TStream);
begin
  FInvalidatedHyperlinks.SaveToStream(AStream);
end;

procedure TNxHyperlinkColumn.SaveVisitedHyperlinksToFile(AFileName: WideString);
begin
  FVisitedHyperlinks.SaveToFile(AFileName);
end;

procedure TNxHyperlinkColumn.SaveVisitedHyperlinksToStream(AStream: TStream);
begin
  FVisitedHyperlinks.SaveToStream(AStream);
end;

{ THyperlinkColumnDisplay }

function THyperlinkColumnDisplay.GetTextSize: TSize;
var
  iLength : Integer;
begin                                                
  Result.cx := 0;
  Result.cy := 0;
  iLength := Length(AsString);
  if (iLength > 0) then
  begin
    with (Column as TNxHyperlinkColumn) do
    begin
      if Display.Canvas.Handle > 0 then
      begin
        if UnicodeSupported then
          Windows.GetTextExtentPoint32W(Display.Canvas.Handle, PWideChar(AsString), iLength, Result)
        else
          Result := Display.Canvas.TextExtent(AsString);
      end;
    end;
  end;
end;

procedure THyperlinkColumnDisplay.Paint;
var
  Cell : TCellInfo;
begin
  with (Column as TNxHyperlinkColumn) do
  begin
    if HyperlinkHasBeenVisited(AsString) then
    begin
      if (VisitedLinkColor <> Display.Canvas.Font.Color) then
        Display.Canvas.Font.Color := VisitedLinkColor;
    end
    else if HyperlinkHasBeenInvalidated(AsString) then
    begin
      if (InvalidatedLinkColor <> Display.Canvas.Font.Color) then
        Display.Canvas.Font.Color := InvalidatedLinkColor;
    end;
  end;
  Cell.AsString := AsString;
  DrawTextRect(Column.GetDrawText(Cell), GetTextRect);
end;

{ THyperlinkColumnPlay }

function THyperlinkColumnPlay.MouseIsOverHyperlink(X, Y: Integer): Boolean;
var
    CellRect : TRect;
  Pt       : TPoint;
  Size     : TSize;
begin
  Result := False;
  if Length(AsString) > 0 then
  begin
    CellRect := ClientRect;
    OffsetRect(CellRect, -CellRect.Left, -CellRect.Top);
    Size := (Column as TNxHyperlinkColumn).Display.GetTextSize;
    CellRect := Bounds(CellRect.Left, CellRect.Top, Size.cx, CellRect.Bottom);
    Pt := Point(X, Y);
    Result := Types.PtInRect(CellRect, Pt);
  end;
end;

procedure THyperlinkColumnPlay.MouseLeave;
begin
  inherited;
end;

procedure THyperlinkColumnPlay.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if MouseIsOverHyperlink(X, Y) then
    Screen.Cursor := crHandPoint
  else
    Screen.Cursor := Column.Cursor;
end;

procedure THyperlinkColumnPlay.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if MouseIsOverHyperlink(X, Y) then
  begin
    with (Column as TNxHyperlinkColumn) do
    begin
      if Assigned(OnClick) then
        OnClick(Self, Col, Row, AsString);
    end;
  end;
end;

end.

var
FoundEqual: Boolean;
begin
FoundEqual := False;
...etc.
end else if (c = '=') and not FoundEqual then
begin
ParamValueReading := True;
ParamNameReading := False;
ParamValueBuffer := '';
FoundEqual := True;
end