URLLabelUnit.pas 2.2 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889
  1. {
  2. This Delphi component is part of TIGCC IDE.
  3. Copyright (C) 2000-2004 Sebastian Reichelt
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2, or (at your option)
  7. any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software Foundation,
  14. Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  15. }
  16. unit URLLabelUnit;
  17. interface
  18. uses
  19. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  20. StdCtrls;
  21. type
  22. TShowWindowStyle = (swHide, swShowNormal, swShowMinimized, swShowMaximized, swMaximize, swShowNoActivate, swShow, swMinimize, swShowMinNoActivate, swShowNA, swRestore, swShowDefault);
  23. TURLLabel = class(TStaticText)
  24. private
  25. FURL: string;
  26. FShowWindow: TShowWindowStyle;
  27. protected
  28. procedure CreateWnd; override;
  29. public
  30. constructor Create(AOwner: TComponent); override;
  31. procedure Click; override;
  32. published
  33. property URL: string read FURL write FURL;
  34. property ShowWindow: TShowWindowStyle read FShowWindow write FShowWindow;
  35. end;
  36. procedure Register;
  37. implementation
  38. uses
  39. ShellAPI;
  40. procedure Register;
  41. begin
  42. RegisterComponents('User', [TURLLabel]);
  43. end;
  44. { TURLLabel }
  45. procedure TURLLabel.Click;
  46. begin
  47. inherited;
  48. if Length (URL) > 0 then
  49. ShellExecute (0, nil, PChar (URL), nil, nil, Integer (ShowWindow));
  50. end;
  51. constructor TURLLabel.Create(AOwner: TComponent);
  52. begin
  53. inherited;
  54. Font.Color := clHighlight;
  55. Font.Style := Font.Style + [fsUnderline];
  56. FURL := '';
  57. FShowWindow := swShow;
  58. end;
  59. procedure TURLLabel.CreateWnd;
  60. var
  61. NewCursor: HCursor;
  62. begin
  63. inherited;
  64. if HandleAllocated and not (csDesigning in ComponentState) then begin
  65. NewCursor := LoadCursor (0, idc_Hand);
  66. if NewCursor = 0 then
  67. NewCursor := Screen.Cursors [crHandPoint];
  68. SetClassLong (Handle, gcl_HCursor, NewCursor);
  69. end;
  70. end;
  71. end.