- assigned_to: nobody --> graemeg
may be this will be useful
{ TfpgGDIClipboard }
function TfpgGDIClipboard.DoGetText: TfpgString;
var
h: THANDLE;
w:boolean;
i:dword;
ans:pansichar;
ws:pwidechar absolute ans;// :)
begin
Result := '';
if not Windows.OpenClipboard(0) then
Exit;
w:=IsClipboardFormatAvailable(CF_UNICODETEXT);
if w then
h := GetClipboardData(CF_UNICODETEXT)
else
h := GetClipboardData(CF_TEXT);
if h <> 0 then
begin
i:=GlobalSize(h); //????
if w then
ws := Windows.GlobalLock(h)
else
ans := Windows.GlobalLock(h);
FClipboardText := '';
if w then
begin
writeln(' w');
SetLength(FClipboardText, i*2 ); // ????
i:=UnicodeToUtf8(pchar(FClipboardText),ws,(i+1)*2);
writeln(i);
setlength(FClipboardText,i);
end
else
begin
writeln('not w');
SetLength(FClipboardText, i+1); // ????
CopyMemory(pchar(FClipboardText),ans,i);
FClipboardText:= AnsiToUtf8(FClipboardText);
end;
GlobalUnlock(h);
end;
CloseClipboard;
Result := FClipboardText;
end;
procedure TfpgGDIClipboard.DoSetText(const AValue: TfpgString);
var
h: THANDLE;
w:boolean;
i:SizeUInt;
ans:pansichar;
ws:pwidechar absolute ans;
begin
FClipboardText := AValue;
if OpenClipboard(FClipboardWndHandle) then
begin
EmptyClipboard;
w:=IsClipboardFormatAvailable(CF_UNICODETEXT) or UnicodeEnabledOS;
if w then
begin
writeln(' w');
i:=Length(FClipboardText);
writeln('i=',i);
h := GlobalAlloc(GMEM_DDESHARE or GMEM_MOVEABLE or GMEM_ZEROINIT, i+1);
if h=0 then raise EOutOfMemory.Create('no global memory');
ws := GlobalLock(h);
i:=Utf8ToUnicode(ws,i+1,pchar(FClipboardText),i);//??
// if i>0 then ws[i]:=#0;
GlobalUnlock(h);
SetClipboardData(CF_UNICODETEXT, h);
end
else
begin
writeln('not w');
FClipboardText:= Utf8ToAnsi(FClipboardText); //not worked
i:=Length(FClipboardText); //ansilength
h := GlobalAlloc(GMEM_DDESHARE or GMEM_MOVEABLE or GMEM_ZEROINIT, i+1);
if h=0 then raise EOutOfMemory.Create('no global memory');
ans := GlobalLock(h);
CopyMemory(ans,pchar(FClipboardText),i);
writeln(ans);
GlobalUnlock(h);
SetClipboardData(CF_TEXT, h);
end;
CloseClipboard;
end;
end