hyperlink2.pas

一个经典的读写Excel的控件

unit Hyperlink2;

{
********************************************************************************
******* XLSReadWriteII V2.00                                             *******
*******                                                                  *******
******* Copyright(C) 1999,2004 Lars Arvidsson, Axolot Data               *******
*******                                                                  *******
******* email: [e-mail]                                     *******
******* URL:   http://www.axolot.com                                     *******
********************************************************************************
** Users of the XLSReadWriteII component must accept the following            **
** disclaimer of warranty:                                                    **
**                                                                            **
** XLSReadWriteII is supplied as is. The author disclaims all warranties,     **
** expressedor implied, including, without limitation, the warranties of      **
** merchantability and of fitness for any purpose. The author assumes no      **
** liability for damages, direct or consequential, which may result from the  **
** use of XLSReadWriteII.                                                     **
********************************************************************************
}

{$B-}

interface

uses Classes, SysUtils, Contnrs, BIFFRecsII2, XLSStream2, XLSUtils2,
     Windows, FormulaHandler2;

type THyperlinkType = (hltUnknown, hltURL, hltFile, hltUNC, hltWorkbook);
type THyperlinkEncoding = (hleUnknown, hleURL, hleFile, hleUNC, hleWorkbook);

type
//: Object for handling hyperlinks (clickable texts) in cells. A THyperlink
//: only determins what shall happends when the text is clicked, it don't
//: have any settings for how the text in the cell is displayed. If you want
//: to have the text in classic hyperlink look, blue and underlined, it has
//: to be formmated in that way.
  THyperlink = class(TCollectionItem)
private
     FHyperlinkType: THyperlinkType;
     FHyperlinkEncoding: THyperlinkEncoding;
     FCol1,FCol2: word;
     FRow1,FRow2: word;
     FOptions: longword;
     FDescription: WideString;
     FTargetFrame: WideString;
     FAddress: WideString;
     FScreenTip: WideString;
     FToolTip: WideString;
     FBuf: PByteArray;
     FBufLen: integer;
     FChanged: boolean;
     procedure SetAddress(const Value: WideString);
     procedure SetDescription(const Value: WideString);
     procedure SetToolTip(const Value: WideString);
protected
     procedure StoreUnknown(Len: integer; PBuf: PByteArray);
public
     constructor Create(Collection: TCollection); override;
     destructor Destroy; override;
published
     //:# First column for the hyperlink area.
     property Col1: word read FCol1 write FCol1;
     //:# Last column for the hyperlink area.
     property Col2: word read FCol2 write FCol2;
     //:# Top row for the hyperlink area.
     property Row1: word read FRow1 write FRow1;
     //:# Bottom row the hyperlink area.
     property Row2: word read FRow2 write FRow2;
     //:# The hyperlink address, i.e. where the user is taken when the text is
     //:# clicked.
     //: What kind of of hyperlink address that is used is determined according
     //: to the following rules:<br>
     //: <b>URL</b> (internet address) - If the text starts with any of the following
     //: strings: http://, https://, www., ftp://, mailto:<br>
     //: UNC (network address, such as \\server\path\file.txt) - If the text
     //: starts with a double backslash.<br>
     //: Workbook - If the text can be parsed as a cell reference, such as:
     //: Sheet3!D8<br>
     //: A local file - If none of the above matches the text, it is considered
     //: to be a local file.<br>
     property Address: WideString read FAddress write SetAddress;
     //:# Text that is shown instead of the real address.
     property Description: WideString read FDescription write SetDescription;
     //:# Optional tooltip (hint) that is shown when the user holds the mouse
     //:# pointer above the text.
     property ToolTip: WideString read FToolTip write SetToolTip;
     //:# The type of the hyperlink.
     property HyperlinkType: THyperlinkType read FHyperlinkType;
     end;

type
//: List with THyperlink objects.
     THyperlinks =  class(TCollection)
private
     FOwner: TPersistent;
     FFormulaHandler: TFormulaHandler;

     function GetItems(Index: integer): THyperlink;
protected
     function GetOwner: TPersistent; override;
public
     constructor Create(AOwner: TPersistent; FormulaHandler: TFormulaHandler);
     //:# Add a new THyperlink.
     function  Add: THyperlink;
     //: @exclude
     procedure LoadFromStream(Stream: TXLSStream; Len: integer; PBuf: PByteArray);
     //: @exclude
     procedure SaveToStream(Stream: TXLSStream; PBuf: PByteArray);

     //:# The items in the list.
     property Items[Index: integer]: THyperlink read GetItems; default;
     end;

implementation

const
  GUID_STDLINK: array[0..15] of byte = ($D0,$C9,$EA,$79,$F9,$BA,$CE,$11,$8C,$82,$00,$AA,$00,$4B,$A9,$0B);
  GUID_URL:     array[0..15] of byte = ($E0,$C9,$EA,$79,$F9,$BA,$CE,$11,$8C,$82,$00,$AA,$00,$4B,$A9,$0B);
  GUID_FILE:    array[0..15] of byte = ($03,$03,$00,$00,$00,$00,$00,$00,$C0,$00,$00,$00,$00,$00,$00,$46);

{ THyperlinks }

function THyperlinks.Add: THyperlink;
begin
  Result := THyperlink(inherited Add);
end;

constructor THyperlinks.Create(AOwner: TPersistent; FormulaHandler: TFormulaHandler);
begin
  inherited Create(THyperlink);
  FFormulaHandler := FormulaHandler;
  FOwner := AOwner;
end;

function THyperlinks.GetItems(Index: integer): THyperlink;
begin
  Result := THyperlink(inherited Items[Index]);
end;

function THyperlinks.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

procedure THyperlinks.LoadFromStream(Stream: TXLSStream; Len: integer; PBuf: PByteArray);
var
  P,P2: PByteArray;
  S: string;
  WS: WideString;
  HLink: THyperlink;
  Header: TBIFFHeader;
  DirUpCnt: word;
begin
  HLink := Add;

  HLink.FCol1 := PRecHLINK(PBuf).Col1;
  HLink.FCol2 := PRecHLINK(PBuf).Col2;
  HLink.FRow1 := PRecHLINK(PBuf).Row1;
  HLink.FRow2 := PRecHLINK(PBuf).Row2;
  HLink.FOptions := PRecHLINK(PBuf).Options;

  if ((HLink.FOptions and $0160) = 0) and ((HLink.FOptions and $0003) = $0003) then
    HLink.FHyperlinkType := hltURL
  else if ((HLink.FOptions and $0160) = 0) and ((HLink.FOptions and $0001) = $0001) then
    HLink.FHyperlinkType := hltFile
  else if ((HLink.FOptions and $0060) = 0) and ((HLink.FOptions and $0103) = $0103) then
    HLink.FHyperlinkType := hltUNC
  else if (HLink.FOptions and $0008) = $0008 then
    HLink.FHyperlinkType := hltWorkbook
  else begin
    HLink.FHyperlinkType := hltUnknown;
    HLink.StoreUnknown(Len,PBuf);
    Exit;
  end;

  HLink.FHyperlinkEncoding := THyperlinkEncoding(HLink.FHyperlinkType);

  P := PByteArray(Integer(PBuf) + SizeOf(TRecHLINK));
  if (HLink.FOptions and $0014) = $0014 then begin
    HLink.FDescription := BufUnicodeZToWS(@P[4],PLongwordArray(P)[0] * 2);
    P := PByteArray(Longword(P) + 4 + PLongwordArray(P)[0] * 2);
  end;
  if (HLink.FOptions and $0080) = $0080 then begin
    HLink.FTargetFrame := BufUnicodeZToWS(@P[4],PLongwordArray(P)[0] * 2);
    P := PByteArray(Longword(P) + 4 + PLongwordArray(P)[0] * 2);
  end;

  if HLink.FHyperlinkType in [hltURL,hltFile] then begin
    if CompareMem(P,@GUID_URL,SizeOf(GUID_URL)) then
      HLink.FHyperlinkEncoding := hleURL
    else if CompareMem(P,@GUID_FILE,SizeOf(GUID_FILE)) then
      HLink.FHyperlinkEncoding := hleFile;
  end;

  case HLink.FHyperlinkEncoding of
    hleUnknown: begin
    end;
    hleURL: begin
      P := PByteArray(Integer(P) + 16);
      HLink.FAddress := BufUnicodeZToWS(@P[4],PLongwordArray(P)[0]);
      P := PByteArray(Longword(P) + 4 + PLongwordArray(P)[0]);
    end;
    hleFile: begin
      P := PByteArray(Integer(P) + 16);
      DirUpCnt := PWordArray(P)[0];
      P := PByteArray(Integer(P) + 2);
      SetLength(S,PLongwordArray(P)[0] - 1);
      P := PByteArray(Integer(P) + 4);
      Move(P^,Pointer(S)^,Length(S));
      P := PByteArray(Integer(P) + Length(S) + 1 + 24);
      if PLongwordArray(P)[0] > 0 then begin
        P2 := PByteArray(Integer(P) + 4);
        SetLength(WS,PLongwordArray(P2)[0] div 2);
        Move(P2[6],Pointer(WS)^,PLongwordArray(P2)[0]);
        HLink.FAddress := WS;
        while DirUpCnt > 0 do begin
          HLink.FAddress := HLink.FAddress + '..\';
          Dec(DirUpCnt);
        end;
      end;
      P := PByteArray(Longword(P) + PLongwordArray(P)[0]);
    end;
    hleUNC: begin
      HLink.FAddress := BufUnicodeZToWS(@P[4],PLongwordArray(P)[0] * 2);
      P := PByteArray(Longword(P) + 4 + PLongwordArray(P)[0] * 2);
    end;
    hleWorkbook: begin

    end;
  end;
  if (HLink.FOptions and $0008) = $0008 then begin
    HLink.FScreenTip := BufUnicodeZToWS(@P[4],PLongwordArray(P)[0] * 2);
    if HLink.FHyperlinkEncoding = hleWorkbook then
      HLink.FAddress := HLink.FScreenTip;
  end;

  // Assume that the HLINKTOOLTIP belongs to the hyperlink.
  if Stream.PeekHeader = BIFFRECID_HLINKTOOLTIP then begin