12 replies to this topic

[Michael Cessna]

Below is a column type I created for working with hyperlinks. It can be used to track and display both visited and invalidated hyperlinks, etc.

Please let me know via this forum if you find any bugs.

CODE

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.

[Boki (Berg)]

Hello Michael,

It looks good. If others agree, I may add it into official list of columns.

Thank you for your contribution.

Best regards

[Michael Cessna]

Yes, absolutely, that would be fine. Please feel free to modify it to your coding style, etc.

Hello Michael,

It looks good. If others agree, I may add it into official list of columns.

Thank you for your contribution.

Best regards

[Boki (Berg)]

Hello Michael,

I will include it for next release. Thank you again.

Best regards

[Boki (Berg)]

Hello Michael,

IF you have a little bit of time, can you please write small article about how using your column type (in Word or some similar program)?

Best regards

[Michael Cessna]

Yes, I will do that in the next couple of days.

Thanks

Mike

Hello Michael,

IF you have a little bit of time, can you please write small article about how using your column type (in Word or some similar program)?

Best regards

[dreel]

Yes, I will do that in the next couple of days.
Thanks
Mike

Articles are not present till now. (((

I have found a bug, the cursor does not change back to the pointer after an exit for table borders, it and remains in the form of a hand.
Moving cursor from TNxHyperlinkColumn over the table doesn't change it view to normal, it staying "hand", even if it leave the boundaries of table.

[Boki (Berg)]

Hello Dreel,

I will work on it to fix it.

Best regards

[flavsouvou]

Hi Boki,

it seems that the cursor problem was still there 1 year ago !

[Boki (Berg)]

Hello,

I have fix this bug. It will be included in next release.

Best regards

[flavsouvou]

Hi Boki,

Thanks for your work !

[nosx]

@Boki

What happend to this Hyperlink Column type. Was it incorperated into the HTMLColumn type ? I need this functionallity for my program (using nextdbgrid) and have set the field in my database to something like this

<a href="http://example.com"> Text For Link Here </a>

and it shows up as a blue underlined link in my application, but the cursor never changes to a handcursor when I hover my mouse over it so I am either missing something or the HTMLColumn does not work properly. Any ideas ?

UPDATE

I just noticed that only the nextgrid component has the hyperlink column type. Why was this left out of the NextDBGrid? Could you add support for this type to the DBGrid as well in the next update, I could definitly use this feature.

[Boki (Berg)]

Hi,

I will add it, not sure why I didn't add it. In HTML column you also have links, but maybe link column is better for simple uses.