Jump to content


Photo

TNxHyperlinkColumn


  • Please log in to reply
12 replies to this topic

#1 Michael Cessna

Michael Cessna
  • Members
  • 10 posts

Posted 21 June 2008 - 06:37 AM

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.


#2 Boki (Berg)

Boki (Berg)

    Boki (Berg)

  • Forum Admin
  • PipPipPipPipPip
  • 7,543 posts
  • Gender:Male

Posted 21 June 2008 - 12:18 PM

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@bergsoft.net | LinkedIn Profile
--
BergSoft Home Page: www.bergsoft.net
Members Section: bms.bergsoft.net
Articles and Tutorials: dn.bergsoft.net (Developers Network)
--
BergSoft Facebook page
--
Send us applications made with our components and we will submit them on: www.bergsoft.net/apps.htm. Link to this page will be also set on home page too.

#3 Michael Cessna

Michael Cessna
  • Members
  • 10 posts

Posted 21 June 2008 - 07:33 PM

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

QUOTE (Boki (Berg) @ Jun 21 2008, 06:18 AM) <{POST_SNAPBACK}>
Hello Michael,

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

Thank you for your contribution.

Best regards


#4 Boki (Berg)

Boki (Berg)

    Boki (Berg)

  • Forum Admin
  • PipPipPipPipPip
  • 7,543 posts
  • Gender:Male

Posted 21 June 2008 - 08:24 PM

Hello Michael,

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

Best regards
boki@bergsoft.net | LinkedIn Profile
--
BergSoft Home Page: www.bergsoft.net
Members Section: bms.bergsoft.net
Articles and Tutorials: dn.bergsoft.net (Developers Network)
--
BergSoft Facebook page
--
Send us applications made with our components and we will submit them on: www.bergsoft.net/apps.htm. Link to this page will be also set on home page too.

#5 Boki (Berg)

Boki (Berg)

    Boki (Berg)

  • Forum Admin
  • PipPipPipPipPip
  • 7,543 posts
  • Gender:Male

Posted 21 June 2008 - 09:25 PM

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
boki@bergsoft.net | LinkedIn Profile
--
BergSoft Home Page: www.bergsoft.net
Members Section: bms.bergsoft.net
Articles and Tutorials: dn.bergsoft.net (Developers Network)
--
BergSoft Facebook page
--
Send us applications made with our components and we will submit them on: www.bergsoft.net/apps.htm. Link to this page will be also set on home page too.

#6 Michael Cessna

Michael Cessna
  • Members
  • 10 posts

Posted 22 June 2008 - 06:02 AM

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

Thanks

Mike

QUOTE (Boki (Berg) @ Jun 21 2008, 03:25 PM) <{POST_SNAPBACK}>
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


#7 dreel

dreel
  • Members
  • 12 posts

Posted 26 February 2009 - 11:21 AM

QUOTE (Michael Cessna @ Jun 22 2008, 06:02 AM) <{POST_SNAPBACK}>
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.

#8 Boki (Berg)

Boki (Berg)

    Boki (Berg)

  • Forum Admin
  • PipPipPipPipPip
  • 7,543 posts
  • Gender:Male

Posted 26 February 2009 - 05:56 PM

Hello Dreel,

I will work on it to fix it.

Best regards
boki@bergsoft.net | LinkedIn Profile
--
BergSoft Home Page: www.bergsoft.net
Members Section: bms.bergsoft.net
Articles and Tutorials: dn.bergsoft.net (Developers Network)
--
BergSoft Facebook page
--
Send us applications made with our components and we will submit them on: www.bergsoft.net/apps.htm. Link to this page will be also set on home page too.

#9 flavsouvou

flavsouvou

    Senior Member

  • Members
  • PipPip
  • 204 posts

Posted 27 February 2010 - 03:00 PM

Hi Boki,

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




#10 Boki (Berg)

Boki (Berg)

    Boki (Berg)

  • Forum Admin
  • PipPipPipPipPip
  • 7,543 posts
  • Gender:Male

Posted 27 February 2010 - 06:53 PM

Hello,

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

Best regards
boki@bergsoft.net | LinkedIn Profile
--
BergSoft Home Page: www.bergsoft.net
Members Section: bms.bergsoft.net
Articles and Tutorials: dn.bergsoft.net (Developers Network)
--
BergSoft Facebook page
--
Send us applications made with our components and we will submit them on: www.bergsoft.net/apps.htm. Link to this page will be also set on home page too.

#11 flavsouvou

flavsouvou

    Senior Member

  • Members
  • PipPip
  • 204 posts

Posted 28 February 2010 - 01:04 AM


Hi Boki,

Thanks for your work !




#12 nosx

nosx
  • Members
  • 11 posts

Posted 16 August 2014 - 11:20 PM

@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.

#13 Boki (Berg)

Boki (Berg)

    Boki (Berg)

  • Forum Admin
  • PipPipPipPipPip
  • 7,543 posts
  • Gender:Male

Posted 21 August 2014 - 06:04 PM

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.
boki@bergsoft.net | LinkedIn Profile
--
BergSoft Home Page: www.bergsoft.net
Members Section: bms.bergsoft.net
Articles and Tutorials: dn.bergsoft.net (Developers Network)
--
BergSoft Facebook page
--
Send us applications made with our components and we will submit them on: www.bergsoft.net/apps.htm. Link to this page will be also set on home page too.




0 user(s) are reading this topic

0 members, 0 guests, 0 anonymous users