diff options
Diffstat (limited to 'src/corelib/x11/fpg_x11.pas')
| -rw-r--r-- | src/corelib/x11/fpg_x11.pas | 95 |
1 files changed, 83 insertions, 12 deletions
diff --git a/src/corelib/x11/fpg_x11.pas b/src/corelib/x11/fpg_x11.pas index 569772ae..ff6e7272 100644 --- a/src/corelib/x11/fpg_x11.pas +++ b/src/corelib/x11/fpg_x11.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -222,6 +222,7 @@ type TfpgX11Window = class(TfpgWindowBase) private QueueEnabledDrops: boolean; + procedure ApplyFormIcon; protected FWinFlags: TXWindowStateFlags; FWinHandle: TfpgWinHandle; @@ -315,6 +316,7 @@ type xia_wm_protocols: TAtom; xia_wm_delete_window: TAtom; xia_wm_state: TAtom; + xia_net_wm_icon: TAtom; xia_targets: TAtom; xia_save_targets: TAtom; netlayer: TNETWindowLayer; @@ -331,6 +333,7 @@ type procedure DoFlush; function GetScreenWidth: TfpgCoord; override; function GetScreenHeight: TfpgCoord; override; + function GetScreenPixelColor(APos: TPoint): TfpgColor; override; function Screen_dpi_x: integer; override; function Screen_dpi_y: integer; override; function Screen_dpi: integer; override; @@ -1068,19 +1071,19 @@ begin {$IFDEF DNDDEBUG} writeln(Format(' ver(%d) check-XdndTypeList(%s) data=%xh,%d,%d,%d,%d', [ FDNDVersion, - BoolToStr(fpgIsBitSet(ev.xclient.data.l[1], 0), True), + BoolToStr(fpgGetBit(ev.xclient.data.l[1], 0), True), ev.xclient.data.l[0], ev.xclient.data.l[1], ev.xclient.data.l[2], ev.xclient.data.l[3], ev.xclient.data.l[4] ])); writeln(Format(' * We will be using XDND v%d protocol *', [FDNDVersion])); - if fpgIsBitSet(ev.xclient.data.l[1], 0) then + if fpgGetBit(ev.xclient.data.l[1], 0) then writeln(' ** We need to fetch XdndTypeList (>3 types)'); {$ENDIF} // read typelist - if fpgIsBitSet(ev.xclient.data.l[1], 0) then + if fpgGetBit(ev.xclient.data.l[1], 0) then begin // now fetch the data XGetWindowProperty(Display, FSrcWinHandle, @@ -1483,6 +1486,7 @@ begin xia_wm_protocols := XInternAtom(FDisplay, 'WM_PROTOCOLS', TBool(False)); xia_wm_delete_window := XInternAtom(FDisplay, 'WM_DELETE_WINDOW', TBool(False)); xia_wm_state := XInternAtom(FDisplay, 'WM_STATE', TBool(False)); + xia_net_wm_icon := XInternAtom(FDisplay, '_NET_WM_ICON', TBool(False)); { initializa the XDND atoms } FDNDTypeList := TObjectList.Create; @@ -1685,7 +1689,7 @@ begin OnIdle(self); fpFD_ZERO(rfds); fpFD_SET(xfd, rfds); - r := fpSelect(xfd + 1, @rfds, nil, nil, {atimeoutms} 50); + r := fpSelect(xfd + 1, @rfds, nil, nil, Min(atimeoutms, 50)); if r <> 0 then // We got a X event or the timeout happened XNextEvent(display, @ev) else @@ -2240,6 +2244,28 @@ begin Result := wa.Height; end; +function TfpgX11Application.GetScreenPixelColor(APos: TPoint): TfpgColor; +var + Image: PXImage; + Pixel: Cardinal; + x_Color: TXColor; +begin + Result := 0; + Image := XGetImage(Display, FRootWindow, APos.X, APos.Y, 1, 1, $FFFFFFFF, ZPixmap); + if Image = nil then + raise Exception.Create('fpGFX/X11: Invalid XImage'); + try + Pixel := XGetPixel(Image, 0, 0); + x_Color.pixel := Pixel; + XQueryColor(Display, DefaultColorMap, @x_Color); + Result := TfpgColor(((x_Color.red and $00FF) shl 16) or + ((x_Color.green and $00FF) shl 8) or + (x_Color.blue and $00FF)); + finally + XDestroyImage(Image); + end; +end; + function TfpgX11Application.Screen_dpi_x: integer; var mm: integer; @@ -2278,6 +2304,45 @@ end; { TfpgX11Window } +procedure TfpgX11Window.ApplyFormIcon; +var + ico: TfpgImage; + ar1: array of longword; // 32 bit CPU's + ar2: array of qword; // 64 bit CPU's + ps: pbyte; + pd: ^TRGBTriple; + i: integer; + iconName: string; +begin + if self is TfpgForm then + iconName := TfpgForm(self).IconName; + if iconName = '' then + Exit; + ico := fpgImages.GetImage(iconName); + if Assigned(ico) then + begin + SetLength(ar1, 2 + (ico.Width * ico.Height)); + ar1[0] := ico.Width; + ar1[1] := ico.Height; + pd := @ar1[2]; + ps := ico.ImageData; + move(ps^,pd^, ico.ImageDataSize); + end + else + exit; // we don't have a icon to set + + {$ifdef cpu64} + setlength(ar2,length(ar1)); + for i := low(ar2) to high(ar2) do + ar2[i] := ar1[i]; // copy array data over + XChangeProperty(xapplication.display, FWinHandle, xapplication.xia_net_wm_icon, + XA_CARDINAL, 32, PropModeReplace, @ar2[0], Length(ar2)); + {$else} + XChangeProperty(xapplication.display, FWinHandle, xapplication.xia_net_wm_icon, + XA_CARDINAL, 32, PropModeReplace, @ar1[0], Length(ar1)); + {$endif} +end; + procedure TfpgX11Window.DoAllocateWindowHandle(AParent: TfpgWindowBase); var pwh: TfpgWinHandle; @@ -2290,11 +2355,13 @@ var WMHints: PXWMHints; prop: TAtom; mwmhints: TMWMHints; + IsToplevel: Boolean; begin if HandleIsValid then Exit; //==> - if AParent <> nil then + IsToplevel := (AParent = nil) or (FWindowType in [wtModalForm, wtPopup]); + if not IsToplevel then pwh := TfpgX11Window(AParent).WinHandle else pwh := xapplication.RootWindow; @@ -2333,16 +2400,16 @@ begin FWinHandle := wh; FBackupWinHandle := wh; - if AParent = nil then // is a toplevel window + if IsToplevel then // is a toplevel window begin { setup a window icon } - IconPixMap := XCreateBitmapFromData(fpgApplication.Display, FWinHandle, + + IconPixMap := XCreateBitmapFromData(xapplication.display, FWinHandle, @IconBitmapBits, IconBitmapWidth, IconBitmapHeight); WMHints := XAllocWMHints; WMHints^.icon_pixmap := IconPixmap; WMHints^.flags := IconPixmapHint; - { setup window grouping posibilities } if (not (waX11SkipWMHints in FWindowAttributes)) and (FWindowType = wtWindow) then begin @@ -2350,8 +2417,7 @@ begin WMHints^.window_group := xapplication.FLeaderWindow; end; - - XSetWMProperties(fpgApplication.Display, FWinHandle, nil, nil, nil, 0, nil, WMHints, nil); + XSetWMProperties(xapplication.display, FWinHandle, nil, nil, nil, 0, nil, WMHints, nil); if (not (waX11SkipWMHints in FWindowAttributes)) and (FWindowType = wtWindow) then begin @@ -2372,6 +2438,9 @@ begin begin DoDNDEnabled(True); end; + + if xapplication.xia_net_wm_icon <> 0 then + ApplyFormIcon; end; FillChar(hints, sizeof(hints), 0); @@ -2427,11 +2496,13 @@ begin // for modal windows, this is necessary if FWindowType = wtModalForm then begin - if Parent = nil then + if IsToplevel then begin lmwh := 0; if fpgApplication.PrevModalForm <> nil then lmwh := TfpgX11Window(fpgApplication.PrevModalForm).WinHandle + {else if AParent <> nil then + lmwh := TfpgX11Window(AParent).WinHandle} { 2011-03-24: Graeme Geldenhuys I commented code this code because it caused more problems that it solved when multiple modal dialogs or prompts are shown in succession. |