Форум: "Начинающим";
Текущий архив: 2009.04.19;
Скачать: [xml.tar.bz2];

Вниз

Гиперссылка в Static Text   Найти похожие ветки 

← →
Rouse_ ©   (2009-03-03 11:42) [1]

Для этого есть специальный класс, называется SysLinc. Вот пример работы с ним:

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, CommCtrl;

// ====== SysLink control =========================================

const
 { For Windows >= XP }
 {$EXTERNALSYM INVALID_LINK_INDEX}
 INVALID_LINK_INDEX  = -1;
 {$EXTERNALSYM MAX_LINKID_TEXT}
 MAX_LINKID_TEXT     = 48;
 {$EXTERNALSYM L_MAX_URL_LENGTH}
 L_MAX_URL_LENGTH    = 2048 + 32 + sizeof("://");

 { For Windows >= XP }
 {$EXTERNALSYM WC_LINK}
 WC_LINK         = "SysLink";

 { For Windows >= XP }
 {$EXTERNALSYM LWS_TRANSPARENT}
 LWS_TRANSPARENT     = $0001;
 {$EXTERNALSYM LWS_IGNORERETURN}
 LWS_IGNORERETURN    = $0002;
 { For Windows >= Vista }
 {$EXTERNALSYM LWS_NOPREFIX}
 LWS_NOPREFIX        = $0004;
 {$EXTERNALSYM LWS_USEVISUALSTYLE}
 LWS_USEVISUALSTYLE  = $0008;
 {$EXTERNALSYM LWS_USECUSTOMTEXT}
 LWS_USECUSTOMTEXT   = $0010;
 {$EXTERNALSYM LWS_RIGHT}
 LWS_RIGHT           = $0020;

 { For Windows >= XP }
 {$EXTERNALSYM LIF_ITEMINDEX}
 LIF_ITEMINDEX    = $00000001;
 {$EXTERNALSYM LIF_STATE}
 LIF_STATE        = $00000002;
 {$EXTERNALSYM LIF_ITEMID}
 LIF_ITEMID       = $00000004;
 {$EXTERNALSYM LIF_URL}
 LIF_URL          = $00000008;

 { For Windows >= XP }
 {$EXTERNALSYM LIS_FOCUSED}
 LIS_FOCUSED         = $00000001;
 {$EXTERNALSYM LIS_ENABLED}
 LIS_ENABLED         = $00000002;
 {$EXTERNALSYM LIS_VISITED}
 LIS_VISITED         = $00000004;
 { For Windows >= Vista }
 {$EXTERNALSYM LIS_HOTTRACK}
 LIS_HOTTRACK        = $00000008;
 {$EXTERNALSYM LIS_DEFAULTCOLORS}
 LIS_DEFAULTCOLORS   = $00000010; // Don"t use any custom text colors

type
 { For Windows >= XP }
 { $EXTERNALSYM tagLITEM}
 tagLITEM = packed record
   mask: UINT;
   iLink: Integer;
   state: UINT;
   stateMask: UINT;
   szID: packed array[0..MAX_LINKID_TEXT-1] of WCHAR;
   szUrl: packed array[0..L_MAX_URL_LENGTH-1] of WCHAR;
 end;
 PLItem = ^TLItem;
 TLItem = tagLITEM;

 { For Windows >= XP }
 { $EXTERNALSYM tagLHITTESTINFO}
 tagLHITTESTINFO = packed record
   pt: TPoint;
   item: TLItem;
 end;
 PLHitTestInfo = ^TLHitTestInfo;
 TLHitTestInfo = tagLHITTESTINFO;

 { For Windows >= XP }
 { $EXTERNALSYM tagNMLINK}
 tagNMLINK = packed record
   hdr: NMHDR;
   item: TLItem;
 end;
 PNMLink = ^TNMLink;
 TNMLink = tagNMLINK;

//  SysLink notifications
//  NM_CLICK   // wParam: control ID, lParam: PNMLINK, ret: ignored.

//  LinkWindow messages
const
 { For Windows >= XP }
 {$EXTERNALSYM LM_HITTEST}
 LM_HITTEST         = WM_USER+$300;    // wParam: n/a, lparam: PLHITTESTINFO, ret: BOOL
 {$EXTERNALSYM LM_GETIDEALHEIGHT}
 LM_GETIDEALHEIGHT  = WM_USER+$301;    // wParam: cxMaxWidth, lparam: n/a, ret: cy
 {$EXTERNALSYM LM_SETITEM}
 LM_SETITEM         = WM_USER+$302;    // wParam: n/a, lparam: LITEM*, ret: BOOL
 {$EXTERNALSYM LM_GETITEM}
 LM_GETITEM         = WM_USER+$303;    // wParam: n/a, lparam: LITEM*, ret: BOOL
 {$EXTERNALSYM LM_GETIDEALSIZE}
 LM_GETIDEALSIZE    = LM_GETIDEALHEIGHT;   // wParam: cxMaxWidth, lparam: SIZE*, ret: cy

type
 TForm1 = class(TForm)
   procedure FormCreate(Sender: TObject);
 private
   hControl: THandle;
   procedure WMNotify(var Msg: TMessage); message WM_NOTIFY;
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

uses
 ShellAPI;

const
 linkID = 123321;
 LinkInfo =
   "For more information, <A HREF="http://msdn.microsoft.com/en-us/library/bb760706(VS.85).aspx">click here</A> " +
       "or <A HREF="http://www.microsoft.com">here</A>.";

procedure TForm1.FormCreate(Sender: TObject);
begin
 hControl := CreateWindow(WC_LINK, PChar(LinkInfo), WS_CHILD or WS_VISIBLE or WS_TABSTOP,
   10, 10, 300, 100, Handle, linkID, HInstance, nil);
 SendMessage(hControl, WM_SETFONT, Integer(Canvas.Font.Handle), 1);
end;

procedure TForm1.WMNotify(var Msg: TMessage);
begin
 if Msg.WParam = linkID then
 begin
   case PNMLink(Msg.LParam)^.hdr.code of
     NM_CLICK:
       ShellExecuteW(Handle, "open",
         PNMLink(Msg.LParam)^.item.szUrl, nil, nil, SW_SHOWDEFAULT);
   end;
 end;
end;

end.

---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2009.04.19;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.45 MB
Время: 0.04 c