diff options
| -rw-r--r-- | prototypes/fpgui2/tests/edittest.lpi | 9 | ||||
| -rw-r--r-- | src/corelib/gdi/fpgfx_package.lpk | 28 | ||||
| -rw-r--r-- | src/corelib/gdi/fpgfx_package.pas | 5 | ||||
| -rw-r--r-- | src/corelib/gdi/gfx_gdi.pas | 96 | ||||
| -rw-r--r-- | src/corelib/gfx_clipboard.pas | 56 |
5 files changed, 115 insertions, 79 deletions
diff --git a/prototypes/fpgui2/tests/edittest.lpi b/prototypes/fpgui2/tests/edittest.lpi index 2879bbde..8b8c2d24 100644 --- a/prototypes/fpgui2/tests/edittest.lpi +++ b/prototypes/fpgui2/tests/edittest.lpi @@ -1,15 +1,15 @@ <?xml version="1.0"?> <CONFIG> <ProjectOptions> - <PathDelim Value="/"/> - <Version Value="6"/> + <PathDelim Value="\"/> + <Version Value="5"/> <General> <Flags> <SaveOnlyProjectUnits Value="True"/> </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <IconPath Value="./"/> + <IconPath Value=".\"/> <TargetFileExt Value=""/> </General> <VersionInfo> @@ -23,7 +23,7 @@ <RunParams> <local> <FormatVersion Value="1"/> - <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/> </local> </RunParams> <RequiredPackages Count="1"> @@ -47,6 +47,7 @@ </ProjectOptions> <CompilerOptions> <Version Value="5"/> + <PathDelim Value="\"/> <CodeGeneration> <Generate Value="Faster"/> </CodeGeneration> 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. - |