URLLabelUnit.pas 1.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869
  1. unit URLLabelUnit;
  2. interface
  3. uses
  4. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  5. StdCtrls;
  6. type
  7. TShowWindowStyle = (swHide, swShowNormal, swShowMinimized, swShowMaximized, swMaximize, swShowNoActivate, swShow, swMinimize, swShowMinNoActivate, swShowNA, swRestore, swShowDefault);
  8. TURLLabel = class(TStaticText)
  9. private
  10. FURL: string;
  11. FShowWindow: TShowWindowStyle;
  12. protected
  13. procedure CreateWnd; override;
  14. public
  15. constructor Create(AOwner: TComponent); override;
  16. procedure Click; override;
  17. published
  18. property URL: string read FURL write FURL;
  19. property ShowWindow: TShowWindowStyle read FShowWindow write FShowWindow;
  20. end;
  21. procedure Register;
  22. implementation
  23. uses
  24. ShellAPI;
  25. procedure Register;
  26. begin
  27. RegisterComponents('User', [TURLLabel]);
  28. end;
  29. { TURLLabel }
  30. procedure TURLLabel.Click;
  31. begin
  32. inherited;
  33. if Length (URL) > 0 then
  34. ShellExecute (0, nil, PChar (URL), nil, nil, Integer (ShowWindow));
  35. end;
  36. constructor TURLLabel.Create(AOwner: TComponent);
  37. begin
  38. inherited;
  39. Font.Color := clHighlight;
  40. Font.Style := Font.Style + [fsUnderline];
  41. FURL := '';
  42. FShowWindow := swShow;
  43. end;
  44. procedure TURLLabel.CreateWnd;
  45. var
  46. NewCursor: HCursor;
  47. begin
  48. inherited;
  49. if HandleAllocated and not (csDesigning in ComponentState) then begin
  50. NewCursor := LoadCursor (0, idc_Hand);
  51. if NewCursor = 0 then
  52. NewCursor := Screen.Cursors [crHandPoint];
  53. SetClassLong (Handle, gcl_HCursor, NewCursor);
  54. end;
  55. end;
  56. end.