| 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
| ///////////////////////////////////////////////////////////////////////////
// //
// Copyright (c) 2015 by Charta Software B.V. //
// All rights reserved //
// //
// Version: 1.7.0.83525 //
// Web site: https://pascal.chartasoftware.com/ //
// //
// This code and information are provided "as is" without warranty of //
// any kind. Dissemination of this information or reproduction of //
// this material is strictly forbidden unless prior written permission //
// is obtained from Charta Software B.V.. //
// //
///////////////////////////////////////////////////////////////////////////
unit Windows.ClipBoard;
interface
uses
Text,
UserInterface.ClipBoard;
type
TWindowsClipBoard = class(TClipBoard)
public
function GetAsText(): TText; override;
procedure SetAsText(const Value: TText); override;
end;
implementation
uses
Character,
Character.Encoding,
Memory.Pointer,
Windows.Api.Error,
Windows.Api.Kernel.Memory,
Windows.Api.Type_,
Windows.Api.UserInterface.ClipBoard;
{ TWindowsClipBoard }
function TWindowsClipBoard.GetAsText(): TText;
var
Data: THandle;
Value: TPointer;
begin
if not OpenClipboard(NULL) then
EWindows32.RaiseLast();
try
Data := GetClipboardData(CF_TEXT);
if Data <> 0 then
begin
try
Value := GlobalLock(Data);
if Value = nil then
EWindows32.RaiseLast();
Result := PAnsiCharacter(Value);
finally
if not GlobalUnlock(Data) then
EWindows32.RaiseLastOnError();
end;
end
else
Result := '';
finally
if not CloseClipBoard() then
EWindows32.RaiseLast();
end;
end;
procedure TWindowsClipBoard.SetAsText(const Value: TText);
var
Handle: THandle;
Target: TPointer;
begin
if not OpenClipboard(NULL) then
EWindows32.RaiseLast();
try
if not EmptyClipBoard() then
EWindows32.RaiseLast();
Handle := GlobalAlloc(GMEM_MOVEABLE, Value.Count + 1);
if Handle = NULL then
EWindows32.RaiseLast();
Target := GlobalLock(Handle);
if Target = nil then
EWindows32.RaiseLast();
try
Value.Recode(TCharacterEncoding.Windows1252).CopyToNullTerminated(Target);
finally
if not GlobalUnlock(Handle) then
EWindows32.RaiseLastOnError();
end;
if SetClipBoardData(CF_TEXT, Handle) = NULL then
EWindows32.RaiseLast();
finally
if not CloseClipBoard() then
EWindows32.RaiseLast();
end;
end;
end.
|