* Keyboard and clipboard handling

src/win32/fresnel.win32.pas

@@ -10,7 +10,7 @@ interface
 
 uses
   Classes, SysUtils,
-  Windows, JwaWinGDI, System.UITypes,
+  Windows, JwaWinGDI, Types, System.UITypes,
   {$IFDEF FresnelSkia}
   // skia
   System.Skia, Fresnel.SkiaRenderer,
@@ -18,7 +18,7 @@ uses
   // fresnel
   UTF8Utils,
   Fresnel.keys, Fresnel.Classes, Fresnel.Forms, Fresnel.WidgetSet, Fresnel.DOM,
-  Fresnel.Events, FCL.Events;
+  Fresnel.Events, FCL.Events, fresnel.clipboard;
 
 type
   {$IFDEF FresnelSkia}
@@ -83,6 +83,28 @@ type
     property FontEngineWin32: TWin32FontEngine read FFontEngine;
   end;
 
+  { TWin32ClipBoard }
+
+  TWin32ClipBoard = class(TFresnelClipBoard)
+
+  private
+    procedure SetClipboardFromUTF8(aContents: TBytes);
+    procedure SetClipboardFromUnicode(aContents: TBytes);
+  protected
+    class function GetClipboardAsText: TBytes;
+    class function GetClipboardAsUnicodeText: TBytes;
+    class function GetStandardFormatName(aFormat: DWord): AnsiString;
+    procedure SetRawClipboardData(aFormat: DWord; aContents: TBytes;
+      TerminatingZeroes: Integer=0);
+    class function StringToStandardFormat(aFormat: AnsiString): DWord;
+    function DoGetClipboardAsType(const aMimeType: String; out aContents: TBytes
+      ): string; override;
+    function DoGetContentTypes: TStringDynArray; override;
+    function DoHasClipboardType(const aMimeType: String): boolean; override;
+    procedure DoSetClipboardAsType(const aMimeType: String; aContents: TBytes);
+      override;
+  end;
+
 type
   TWin32WindowInfo = record
     Form: TWin32WSForm;
@@ -482,9 +504,6 @@ end;
 Function WinKeyToFresnelKey(aKey,aFlags : WParam) : Integer;
 
 begin
-  Result:=KeyCodeToUnicode(aKey,aFlags);
-  if Result<>0 then
-    exit;
   Case aKey of
     VK_0..VK_9 :
       result:=Ord('0')+(aKey-VK_0);
@@ -577,7 +596,7 @@ begin
     VK_ZOOM 	: Result:=TKeyCodes.ZoomToggle ;
     VK_OEM_CLEAR 	: Result:=TKeyCodes.Clear ;
   else
-    Result:=0;
+    Result:=KeyCodeToUnicode(aKey,aFlags);
   { // Not supported
     // VK_CANCEL :      : Result:=TKeyCodes. ;
     // VK_IME_ON 	: Result:=TKeyCodes. ;
@@ -609,12 +628,10 @@ function TWin32WSForm.HandleKeyMsg(aKey,aFlags : WParam; IsDown : Boolean) : boo
 
 var
   lData : TFresnelKeyEventInit;
-  lShift : TShiftState;
   lInput : TFresnelInputEventInit;
 
 begin
   lData:=Default(TFresnelKeyEventInit);
-//  lShift:=WinKeyCodeToShiftState(aKey);
   lData.ShiftState:=KeyboardStateToShiftState;
   lData.NumKey:=WinKeyToFresnelKey(aKey,aFlags);
   
@@ -806,12 +823,281 @@ begin
   aWSForm.CreateWSWindow;
 end;
 
+{ TWin32ClipBoard }
+
+class function TWin32ClipBoard.GetClipboardAsUnicodeText : TBytes;
+
+var
+  hGlobal: HANDLE ;
+  pText : PWideChar;
+  len : integer;
+  error : DWord;
+begin
+  SetLength(Result,0);
+  if not IsClipboardFormatAvailable(CF_UNICODETEXT) then
+    exit;
+  hGlobal:=GetClipboardData(CF_UNICODETEXT);
+  if (hGlobal=NilHandle) then
+    begin
+    error:=GetLastError();
+    Writeln('Error: Could not get clipboard data. Error code: ', error);
+    exit;
+    end;
+  pText:=PUnicodeChar(GlobalLock(hGlobal));
+  if pText=Nil then
+    exit;
+  try
+    len:=strlen(pText);
+    if len>0 then
+      begin
+      SetLength(Result,len*2);
+      move(ptext^,Result[0],len*2);
+      end;
+  finally
+    globalUnlock(hglobal)
+  end;
+end;
+
+class function TWin32ClipBoard.GetClipboardAsText : TBytes;
+var
+  hGlobal: HANDLE ;
+  pText : PAnsiChar;
+  len : integer;
+begin
+  SetLength(Result,0);
+  if not IsClipboardFormatAvailable(CF_TEXT) then exit;
+  hGlobal:=GetClipboardData(CF_TEXT);
+  if (hGlobal=NilHandle) then
+    exit;
+  pText:=PAnsiChar(GlobalLock(hGlobal));
+  if pText=Nil then
+    exit;
+  try
+    len:=StrLen(pText);
+    if len>0 then
+      begin
+      SetLength(Result,len);
+      move(ptext^,Result[0],len);
+      end;
+  finally
+    globalUnlock(hglobal)
+  end;
+end;
+
+function TWin32ClipBoard.DoGetClipboardAsType(const aMimeType: String; out
+  aContents: TBytes): string;
+var
+  Fmt : DWord;
+begin
+  Result:='';
+  SetLength(aContents,0);
+  if not OpenClipBoard(NilHandle) then
+    exit;
+  try
+    Fmt:=StringToStandardFormat(aMimeType);
+    if Fmt=0 then
+      exit;
+    case fmt of
+      CF_UNICODETEXT:
+        begin
+        aContents:=GetClipboardAsUnicodeText;
+        result:='text/plain;charset=utf-16le';
+        end;
+      CF_TEXT :
+        begin
+        if IsClipboardFormatAvailable(CF_UNICODETEXT) then
+          aContents:=TEncoding.Convert(TEncoding.Unicode,TEncoding.UTF8,GetClipboardAsUnicodeText)
+        else
+          aContents:=TEncoding.Convert(TEncoding.ANSI,TEncoding.UTF8,GetClipboardAsText);
+        result:='text/plain';
+        end;
+    end;
+  finally
+    CloseClipBoard;
+  end;
+end;
+
+Class function TWin32ClipBoard.StringToStandardFormat(aFormat : AnsiString) : DWord;
+
+begin
+  case aformat of
+    'text/plain;charset=utf-16le' : Result:=CF_UNICODETEXT;
+    'text/plain' : Result:=CF_TEXT;
+    'image/bmp' : Result:=CF_BITMAP;
+    'image/tiff' : Result:=CF_TIFF;
+    'audio/wav' : Result:=CF_WAVE;
+  else
+    Result:=0;
+  end;
+end;
+
+Class function TWin32ClipBoard.GetStandardFormatName(aFormat : DWord) : AnsiString;
+
+const
+  CF_DIBV5 = 17;
+
+begin
+  Case aFormat of
+   CF_OEMTEXT,
+   CF_TEXT,
+   CF_DSPTEXT: Result:='text/plain';
+   CF_UNICODETEXT : Result:='text/plain;charset=utf-16le';
+   CF_DIB,
+   CF_BITMAP: Result:='image/bmp';
+   CF_TIFF: Result:='image/tiff';
+   CF_WAVE: Result:='audio/wav';
+  else
+    Result:='';
+  end;
+end;
+
+function TWin32ClipBoard.DoGetContentTypes: TStringDynArray;
+var
+  fmt : DWord;
+  fmtName : Ansistring;
+  count,len : integer;
+begin
+  //S:=CF_TEXT;
+  Result:=[];
+  Count:=0;
+  if Not OpenClipboard(NilHandle) then
+    exit;
+  Fmt:=EnumClipBoardFormats(0);
+  try
+    while (fmt<>0) do
+      begin
+      SetLength(fmtName,256);
+      FmtName:=GetStandardFormatName(Fmt);
+      if FmtName='' then
+        begin
+        len:=GetClipboardFormatName(Fmt,PAnsiChar(fmtName),Length(FmtName));
+        SetLength(FmtName,len);
+        end;
+      if (FmtName<>'') then
+        begin
+        if Count=Length(Result) then
+          SetLength(Result,Count+10);
+        Result[Count]:=FmtName;
+        inc(count);
+        end;
+      Fmt:=EnumClipBoardFormats(fmt);
+      end;
+    SetLength(Result,count);
+  finally
+    CloseClipBoard;
+  end;
+end;
+
+function TWin32ClipBoard.DoHasClipboardType(const aMimeType: String): boolean;
+var
+  Fmts : TStringDynArray;
+  Len,I,P : integer;
+  Fmt,S : String;
+begin
+  Result:=False;
+  Fmts:=GetContentTypes;
+  Len:=Length(Fmts);
+  I:=0;
+  While (Not Result) and (I<len) do
+    begin
+    Result:=SameText(aMimeType,Fmts[i]);
+    Inc(I);
+    end;
+  if Result then
+    exit;
+  P:=Pos('/',aMimeType);
+  if (P<>0) then
+    exit;
+  S:=Copy(aMimeType,1,P-1);
+  I:=0;
+  While (Not Result) and (I<len) do
+    begin
+    Fmt:=Fmts[i];
+    P:=Pos('/',Fmt);
+    if P<>0 then
+      SetLength(Fmt,P-1);
+    Result:=SameText(S,Fmt);
+    Inc(I);
+    end;
+end;
+
+procedure TWin32ClipBoard.SetRawClipboardData(aFormat : DWord; aContents : TBytes; TerminatingZeroes : Integer = 0);
+
+var
+  hGlobal: Handle;
+  i,Len : Integer;
+  PGlobal : PByte;
+
+begin
+  len:=Length(aContents);
+  hGlobal:=GlobalAlloc(GMEM_MOVEABLE, len+TerminatingZeroes);
+  try
+    pGlobal:=GlobalLock(hGlobal);
+    if assigned(pGlobal) then
+      move(aContents[0],PGlobal^,len);
+    for I:=0 to TerminatingZeroes-1 do
+      PGlobal[Len+I]:=0;
+    globalUnlock(hGlobal);
+    SetClipBoardData(aFormat,hGlobal);
+  finally
+    if hGlobal<>NilHandle then
+      GlobalFree(hGlobal);
+  end;
+end;
+
+procedure TWin32ClipBoard.SetClipboardFromUnicode(aContents : TBytes);
+
+var
+  lAnsi : TBytes;
+begin
+  SetRawClipboardData(CF_UNICODETEXT,aContents,2);
+  lAnsi:=TEncoding.Convert(TEncoding.Unicode,TEncoding.ANSI,aContents);
+  SetRawClipboardData(CF_TEXT,lAnsi,1);
+end;
+
+procedure TWin32ClipBoard.SetClipboardFromUTF8(aContents : TBytes);
+
+var
+  lRaw : TBytes;
+begin
+  lRaw:=TEncoding.Convert(TEncoding.UTF8,TEncoding.ANSI,aContents);
+  SetRawClipboardData(CF_TEXT,lRaw,1);
+  lRaw:=TEncoding.Convert(TEncoding.UTF8,TEncoding.Unicode,aContents);
+  SetRawClipboardData(CF_UNICODETEXT,lRaw,2);
+end;
+
+
+procedure TWin32ClipBoard.DoSetClipboardAsType(const aMimeType: String; aContents: TBytes);
+var
+  Fmt : DWord;
+begin
+  Fmt:=StringToStandardFormat(aMimeType);
+  if Fmt=0 then
+    exit;
+  if not OpenClipBoard(NilHandle) then
+    exit;
+  if not EmptyClipboard then
+    exit;
+  try
+    case fmt of
+      CF_UNICODETEXT:
+        SetClipboardFromUnicode(aContents);
+      CF_TEXT :
+        SetClipboardFromUTF8(aContents);
+    end;
+  finally
+    CloseClipBoard;
+  end;
+end;
+
+
 initialization
   WindowInfoAtom := Windows.GlobalAddAtom('WindowInfo');
   WindowInfoAtomStr:={%H-}lpcstr(PtrUint(WindowInfoAtom));
   TWin32WidgetSet.Create(nil);
-
+  TFresnelClipBoard._ClipboardClass:=TWin32Clipboard;
 finalization
+
   Windows.GlobalDeleteAtom(WindowInfoAtom);
   WindowInfoAtom := 0;
   WindowInfoAtomStr:=nil;