Source/TntClipBrd.pas

   1
   2 {*****************************************************************************}
   3 {                                                                             }
   4 {    Tnt Delphi Unicode Controls                                              }
   5 {      http://www.tntware.com/delphicontrols/unicode/                         }
   6 {        Version: 2.3.0                                                       }
   7 {                                                                             }
   8 {    Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com)       }
   9 {                                                                             }
  10 {*****************************************************************************}
  11
  12 unit TntClipBrd;
  13
  14 {$INCLUDE TntCompilers.inc}
  15
  16 interface
  17
  18 uses
  19   Windows, Clipbrd;
  20
  21 type
  22 {TNT-WARN TClipboard}
  23   TTntClipboard = class(TClipboard{TNT-ALLOW TClipboard})
  24   private
  25     function GetAsWideText: WideString;
  26     procedure SetAsWideText(const Value: WideString);
  27   public
  28     property AsWideText: WideString read GetAsWideText write SetAsWideText;
  29     property AsText: WideString read GetAsWideText write SetAsWideText;
  30   end;
  31
  32 {TNT-WARN Clipboard}
  33 function TntClipboard: TTntClipboard;
  34
  35 implementation
  36
  37 { TTntClipboard }
  38
  39 function TTntClipboard.GetAsWideText: WideString;
  40 var
  41   Data: THandle;
  42 begin
  43   Open;
  44   Data := GetClipboardData(CF_UNICODETEXT);
  45   try
  46     if Data <> 0 then
  47       Result := PWideChar(GlobalLock(Data))
  48     else
  49       Result := '';
  50   finally
  51     if Data <> 0 then GlobalUnlock(Data);
  52     Close;
  53   end;
  54   if (Data = 0) or (Result = '') then
  55     Result := inherited AsText
  56 end;
  57
  58 procedure TTntClipboard.SetAsWideText(const Value: WideString);
  59 begin
  60   Open;
  61   try
  62     inherited AsText := Value; {Ensures ANSI compatiblity across platforms.}
  63     SetBuffer(CF_UNICODETEXT, PWideChar(Value)^, (Length(Value) + 1) * SizeOf(WideChar));
  64   finally
  65     Close;
  66   end;
  67 end;
  68
  69 //------------------------------------------
  70
  71 var
  72   GTntClipboard: TTntClipboard;
  73
  74 function TntClipboard: TTntClipboard;
  75 begin
  76   if GTntClipboard = nil then
  77     GTntClipboard := TTntClipboard.Create;
  78   Result := GTntClipboard;
  79 end;
  80
  81 initialization
  82
  83 finalization
  84   GTntClipboard.Free;
  85
  86 end.