* GDI: Implemented the new Clipboard class in Windows. Again

  it needs some testing and debugging. But the basics seem 
  to work.
* Removed the old gfx_clipboard.pas unit.

4 files changed, 110 insertions, 75 deletions

diff --git a/src/corelib/gdi/fpgfx_package.lpk b/src/corelib/gdi/fpgfx_package.lpk
index b9f53dff..18dfe2bb 100644
--- a/src/corelib/gdi/fpgfx_package.lpk
+++ b/src/corelib/gdi/fpgfx_package.lpk
@@ -26,7 +26,7 @@
     <License Value="Modified LGPL
 "/>
     <Version Minor="5" Release="1"/>
-    <Files Count="16">
+    <Files Count="15">
       <Item1>
         <Filename Value="..\gfxbase.pas"/>
         <UnitName Value="gfxbase"/>
@@ -64,33 +64,29 @@
         <UnitName Value="gfx_cmdlineparams"/>
       </Item9>
       <Item10>
-        <Filename Value="..\gfx_clipboard.pas"/>
-        <UnitName Value="gfx_clipboard"/>
-      </Item10>
-      <Item11>
         <Filename Value="gfx_utils.pas"/>
         <UnitName Value="gfx_utils"/>
-      </Item11>
-      <Item12>
+      </Item10>
+      <Item11>
         <Filename Value="..\gfx_popupwindow.pas"/>
         <UnitName Value="gfx_popupwindow"/>
-      </Item12>
-      <Item13>
+      </Item11>
+      <Item12>
         <Filename Value="gfx_impl.pas"/>
         <UnitName Value="gfx_impl"/>
-      </Item13>
-      <Item14>
+      </Item12>
+      <Item13>
         <Filename Value="..\gfx_command_intf.pas"/>
         <UnitName Value="gfx_command_intf"/>
-      </Item14>
-      <Item15>
+      </Item13>
+      <Item14>
         <Filename Value="..\gfx_wuline.pas"/>
         <UnitName Value="gfx_wuline"/>
-      </Item15>
-      <Item16>
+      </Item14>
+      <Item15>
         <Filename Value="..\gfx_imagelist.pas"/>
         <UnitName Value="gfx_imagelist"/>
-      </Item16>    
+      </Item15>
     </Files>
     <RequiredPkgs Count="1">
       <Item1>
diff --git a/src/corelib/gdi/fpgfx_package.pas b/src/corelib/gdi/fpgfx_package.pas
index 8f347baa..e0a49cb4 100644
--- a/src/corelib/gdi/fpgfx_package.pas
+++ b/src/corelib/gdi/fpgfx_package.pas
@@ -8,9 +8,8 @@ interface
 
 uses
   gfxbase, fpgfx, gfx_gdi, gfx_stdimages, gfx_imgfmt_bmp, gfx_widget, 
-  gfx_UTF8utils, gfx_extinterpolation, gfx_cmdlineparams, gfx_clipboard, 
-  gfx_utils, gfx_popupwindow, gfx_impl, gfx_command_intf, gfx_wuline, 
-  gfx_imagelist; 
+    gfx_UTF8utils, gfx_extinterpolation, gfx_cmdlineparams, gfx_utils, 
+    gfx_popupwindow, gfx_impl, gfx_command_intf, gfx_wuline, gfx_imagelist; 
 
 implementation
 
diff --git a/src/corelib/gdi/gfx_gdi.pas b/src/corelib/gdi/gfx_gdi.pas
index 6d0c8c20..9fbbb029 100644
--- a/src/corelib/gdi/gfx_gdi.pas
+++ b/src/corelib/gdi/gfx_gdi.pas
@@ -197,6 +197,14 @@ type
   end;
 
 
+  TfpgClipboardImpl = class(TfpgClipboardBase)
+  protected
+    FClipboardText: string;
+    function    DoGetText: string; override;
+    procedure   DoSetText(const AValue: string); override;
+    procedure   InitClipboard; override;
+  end;
+
 implementation
 
 uses
@@ -442,6 +450,38 @@ begin
     w.FWinHandle := hwnd; // this is very important, because number of messages sent
     // before the createwindow returns the window handle
     Windows.SetWindowLong(hwnd, GWL_USERDATA, longword(w));
+  end
+  else if (uMsg = WM_RENDERALLFORMATS) or (uMsg = WM_RENDERFORMAT) then
+  begin
+//    writeln('cliboard rendering...');
+    if uMsg = WM_RENDERALLFORMATS then
+    begin
+//      writeln('ALL');
+      CloseClipboard;
+      OpenClipboard(0);
+    end;
+    // Windows seems unhappy unless I do these two steps. Documentation
+    // seems to vary on whether opening the clipboard is necessary or
+    // is in fact wrong:
+    // fall through...
+    h := GlobalAlloc(GHND, Length(fpgClipboard.FClipboardText)+1);
+    if (h <> 0) then
+    begin
+      p := GlobalLock(h);
+      Move(fpgClipboard.FClipboardText[1], p^, Length(fpgClipboard.FClipboardText));
+      inc(p, Length(fpgClipboard.FClipboardText));
+      p^ := #0;
+      GlobalUnlock(h);
+      SetClipboardData(CF_TEXT, h);
+    end;
+
+    // Windows also seems unhappy if I don't do this. Documentation very
+    // unclear on what is correct:
+    if uMsg = WM_RENDERALLFORMATS then
+      CloseClipboard;
+
+    Result := 1;
+    Exit; //==>
   end;
 
   w      := TfpgWindowImpl(Windows.GetWindowLong(hwnd, GWL_USERDATA));
@@ -1867,6 +1907,62 @@ begin
   SetDIBits(wapplication.display, FMaskHandle, 0, aheight, aimgdata, pbi^, DIB_RGB_COLORS);
 end;
 
+{ TfpgClipboardImpl }
+
+function TfpgClipboardImpl.DoGetText: string;
+var
+  h: THANDLE;
+  p: PChar;
+begin
+  Result := '';
+  if not Windows.OpenClipboard(0) then
+    Exit;
+
+  h := GetClipboardData(CF_TEXT);
+  if h <> 0 then
+  begin
+    p := Windows.GlobalLock(h);
+    FClipboardText := '';
+    while p^ <> #0 do
+    begin
+      FClipboardText := FClipboardText + p^;
+      inc(p);
+    end;
+    GlobalUnlock(h);
+  end;
+  CloseClipboard;
+  Result := FClipboardText;
+end;
+
+procedure TfpgClipboardImpl.DoSetText(const AValue: string);
+begin
+  FClipboardText := AValue;
+  if OpenClipboard(FClipboardWndHandle) then
+  begin
+    EmptyClipboard;
+    SetClipboardData(CF_TEXT, 0);
+    CloseClipboard;
+  end;
+end;
+
+procedure TfpgClipboardImpl.InitClipboard;
+begin
+  FClipboardWndHandle := Windows.CreateWindowEx(
+      0,			  // extended window style
+      'FPGUI',  // registered class name
+      nil,			// window name
+      0,			  // window style
+      0,			  // horizontal position of window
+      0,			  // vertical position of window
+      10,			  // window width
+      10,       // window height
+      0,        // handle to parent or owner window
+      0,        // menu handle or child identifier
+      MainInstance, // handle to application instance
+      nil       // window-creation data
+      );
+end;
+
 initialization
   wapplication   := nil;
   MouseFocusedWH := 0;
diff --git a/src/corelib/gfx_clipboard.pas b/src/corelib/gfx_clipboard.pas
deleted file mode 100644
index 76d54de0..00000000
--- a/src/corelib/gfx_clipboard.pas
+++ /dev/null
@@ -1,56 +0,0 @@
-unit gfx_clipboard;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils; 
-
-type
-  TfpgClipboard = class(TObject)
-  private
-    FClipboardData: string;
-    function    GetText: string;
-    procedure   SetText(const AValue: string);
-  public
-    property    Text: string read GetText write SetText;
-  end;
-  
-// singleton
-function fpgClipboard: TfpgClipboard;
-
-implementation
-
-var
-  uClipboard: TfpgClipboard;
-
-function fpgClipboard: TfpgClipboard;
-begin
-  if not Assigned(uClipboard) then
-    uClipboard := TfpgClipboard.Create;
-  Result := uClipboard;
-end;
-  
-  
-{ TfpgClipboard }
-
-function TfpgClipboard.GetText: string;
-begin
-  // this is just temporary!!
-  Result := FClipboardData;
-end;
-
-procedure TfpgClipboard.SetText(const AValue: string);
-begin
-  FClipboardData := AValue;
-end;
-
-initialization
-  uClipboard := nil;
-  
-finalization
-  uClipboard.Free;
-
-end.
-