diff options
author | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2008-03-21 23:21:00 +0000 |
---|---|---|
committer | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2008-03-21 23:21:00 +0000 |
commit | 66b5a5ab7249eff995f9927d8172f62081979437 (patch) | |
tree | 626c35b5bb447a9a2d371c588cfa80765992bcc9 /src/corelib | |
parent | ad532a0858d4e362b96f543a2c1ffe4f47b5da05 (diff) | |
download | fpGUI-66b5a5ab7249eff995f9927d8172f62081979437.tar.xz |
* new method in Canvas class called ClipLine() which clips the coordinates
of a line based on a given clipping rectangle. This doesn't not use the
Canvas's internal ClipRegion. It uses the well known Cohen-Sutherland line
clipping algorithm, and performance is very good.
* new method in Canvas class called DrawLineClipped() which uses the ClipLine
method.
* Converted some C headers for the Motif Window Manager hints support under
X11.
* Introduced a new Window Attribute type called waBorderless. This allows use
create borderless windows that can handle keyboard input. Currently
borderless windows are only implemented in X11. It past 01:15 here and I
need sleep, so will tackle GDI support on Monday.
* Extended some of the types to be used for the new Style/Theme Manager.
* Fixed a bug where TfpgForm.OnClose event did not fire when you call .Close
method.
Diffstat (limited to 'src/corelib')
-rw-r--r-- | src/corelib/gfxbase.pas | 99 | ||||
-rw-r--r-- | src/corelib/x11/fpgfx_package.pas | 7 | ||||
-rw-r--r-- | src/corelib/x11/gfx_x11.pas | 68 |
3 files changed, 169 insertions, 5 deletions
diff --git a/src/corelib/gfxbase.pas b/src/corelib/gfxbase.pas index 5129fbb3..427cd07e 100644 --- a/src/corelib/gfxbase.pas +++ b/src/corelib/gfxbase.pas @@ -24,7 +24,7 @@ type TWindowType = (wtChild, wtWindow, wtModalForm, wtPopup); - TWindowAttribute = (waSizeable, waAutoPos, waScreenCenterPos, waStayOnTop, waFullScreen); + TWindowAttribute = (waSizeable, waAutoPos, waScreenCenterPos, waStayOnTop, waFullScreen, waBorderless); TWindowAttributes = set of TWindowAttribute; TMouseCursor = (mcDefault, mcArrow, mcCross, mcIBeam, mcSizeEW, mcSizeNS, @@ -267,6 +267,8 @@ type procedure DrawRectangle(x, y, w, h: TfpgCoord); overload; procedure DrawRectangle(r: TfpgRect); overload; procedure DrawLine(x1, y1, x2, y2: TfpgCoord); + procedure DrawLineClipped(var x1, y1, x2, y2: TfpgCoord; const AClipRect: TfpgRect); + procedure ClipLine(var x1, y1, x2, y2: TfpgCoord; const AClipRect: TfpgRect; out FallsOutsideRegion: Boolean); procedure DrawImage(x, y: TfpgCoord; img: TfpgImageBase); procedure DrawImagePart(x, y: TfpgCoord; img: TfpgImageBase; xi, yi, w, h: integer); procedure DrawArc(x, y, w, h: TfpgCoord; a1, a2: double); @@ -1000,6 +1002,101 @@ begin DoDrawLine(x1, y1, x2, y2); end; +procedure TfpgCanvasBase.DrawLineClipped(var x1, y1, x2, y2: TfpgCoord; + const AClipRect: TfpgRect); +var + OutOfRegion: boolean; +begin + ClipLine(X1, Y1, X2, Y2, AClipRect, OutOfRegion); + if not OutOfRegion then + DrawLine(X1, Y1, X2, Y2); { Draw the new line! } +end; + +{ DrawLineClipped - This procedure clips a line to the AClipRect boundaries and + then calls the DrawLine procedure with the clipped coordinates. If the line + lies completely outside of the clip boundary, then the Line routine is not + called. This procedure uses the well known Cohen-Sutherland line clipping + algorithm to clip each coordinate. + + Use this if you did not what to change the Canvas.ClipRegion for some reason. + For a detailed explanation see: + http://www.nondot.org/~sabre/graphpro/line6.html } +procedure TfpgCanvasBase.ClipLine(var x1, y1, x2, y2: TfpgCoord; + const AClipRect: TfpgRect; out FallsOutsideRegion: Boolean); +CONST + CodeBottom = 1; CodeTop = 2; { BitFields for output codes } + CodeLeft = 4; CodeRight = 8; + + FUNCTION CompOutCode(X, Y : INTEGER) : integer; { Nested function } + VAR Code : integer; + BEGIN + Code := 0; + IF Y > AClipRect.Bottom THEN Code := CodeBottom + ELSE IF Y < AClipRect.Top THEN Code := CodeTop; + IF X > AClipRect.Right THEN Code := Code+CodeRight + ELSE IF X < AClipRect.Left THEN Code := Code+CodeLeft; + Result := Code; + END; + +VAR + OutCode0, { The code of the first endpoint } + OutCode1, { The code of the second endpoint } + OutCodeOut : integer; + X, Y : INTEGER; +BEGIN + FallsOutsideRegion := False; + OutCode0 := CompOutCode(X1, Y1); { Compute the original codes } + OutCode1 := CompOutCode(X2, Y2); + + WHILE (OutCode0 <> 0) OR (OutCode1 <> 0) DO { While not Trivially Accepted } + BEGIN + IF (OutCode0 AND OutCode1) <> 0 THEN { Trivial Reject } + begin + FallsOutsideRegion := True; + Exit; //==> + end + ELSE + BEGIN { Failed both tests, so calculate the line segment to clip } + IF OutCode0 > 0 THEN + OutCodeOut := OutCode0 { Clip the first point } + ELSE + OutCodeOut := OutCode1; { Clip the last point } + + IF (OutCodeOut AND CodeBottom) = CodeBottom THEN + BEGIN { Clip the line to the bottom of the viewport } + Y := AClipRect.Bottom; + X := X1+LONGINT(X2-X1)*LONGINT(Y-Y1) DIV (Y2 - Y1); + END + ELSE IF (OutCodeOut AND CodeTop) = CodeTop THEN + BEGIN { Clip the line to the top of the viewport } + Y := AClipRect.Top; + X := X1+LONGINT(X2-X1)*LONGINT(Y-Y1) DIV (Y2 - Y1); + END + ELSE IF (OutCodeOut AND CodeRight) = CodeRight THEN + BEGIN { Clip the line to the right edge of the viewport } + X := AClipRect.Right; + Y := Y1+LONGINT(Y2-Y1)*LONGINT(X-X1) DIV (X2-X1); + END + ELSE IF (OutCodeOut AND CodeLeft) = CodeLeft THEN + BEGIN { Clip the line to the left edge of the viewport } + X := AClipRect.Left; + Y := Y1+LONGINT(Y2-Y1)*LONGINT(X-X1) DIV (X2-X1); + END; + + IF (OutCodeOut = OutCode0) THEN { Modify the first coordinate } + BEGIN + X1 := X; Y1 := Y; { Update temporary variables } + OutCode0 := CompOutCode(X1, Y1); { Recalculate the OutCode } + END + ELSE { Modify the second coordinate } + BEGIN + X2 := X; Y2 := Y; { Update temporary variables } + OutCode1 := CompOutCode(X2, Y2); { Recalculate the OutCode } + END; + END; + END; { while } +end; + procedure TfpgCanvasBase.DrawImage(x, y: TfpgCoord; img: TfpgImageBase); begin if img = nil then diff --git a/src/corelib/x11/fpgfx_package.pas b/src/corelib/x11/fpgfx_package.pas index d7813dee..ea32e8cc 100644 --- a/src/corelib/x11/fpgfx_package.pas +++ b/src/corelib/x11/fpgfx_package.pas @@ -8,10 +8,9 @@ interface uses x11_xft, x11_keyconv, gfxbase, gfx_x11, fpgfx, gfx_stdimages, gfx_imgfmt_bmp, - gfx_widget, gfx_UTF8utils, gfx_extinterpolation, gfx_cmdlineparams, - gfx_utils, gfx_popupwindow, gfx_impl, gfx_command_intf, gfx_wuline, - gfx_imagelist, gfx_constants, gfx_pofiles, gfx_translations, - gfx_stringhashlist; + gfx_widget, gfx_UTF8utils, gfx_extinterpolation, gfx_cmdlineparams, gfx_utils, + gfx_popupwindow, gfx_impl, gfx_command_intf, gfx_wuline, gfx_imagelist, + gfx_constants, gfx_pofiles, gfx_translations, gfx_stringhashlist; implementation diff --git a/src/corelib/x11/gfx_x11.pas b/src/corelib/x11/gfx_x11.pas index 49b58825..7fea5804 100644 --- a/src/corelib/x11/gfx_x11.pas +++ b/src/corelib/x11/gfx_x11.pas @@ -12,6 +12,7 @@ uses X, Xlib, XUtil, + ctypes, x11_xft, _netlayer, gfxbase, @@ -50,6 +51,45 @@ type end; PXdbeSwapInfo = ^TXdbeSwapInfo; + // MWM support + TMWMHints = record + flags: culong; + functions: culong; + decorations: culong; + input_mode: longint; + status: culong; + end; + + +const +// Motif window hints + MWM_HINTS_FUNCTIONS = 1 shl 0; + MWM_HINTS_DECORATIONS = 1 shl 1; + MWM_HINTS_INPUT_MODE = 1 shl 2; + MWM_HINTS_STATUS = 1 shl 3; +// bit definitions for MwmHints.functions */ + MWM_FUNC_ALL = 1 shl 0; + MWM_FUNC_RESIZE = 1 shl 1; + MWM_FUNC_MOVE = 1 shl 2; + MWM_FUNC_MINIMIZE = 1 shl 3; + MWM_FUNC_MAXIMIZE = 1 shl 4; + MWM_FUNC_CLOSE = 1 shl 5; +// bit definitions for MwmHints.decorations */ + MWM_DECOR_ALL = 1 shl 0; + MWM_DECOR_BORDER = 1 shl 1; + MWM_DECOR_RESIZEH = 1 shl 2; + MWM_DECOR_TITLE = 1 shl 3; + MWM_DECOR_MENU = 1 shl 4; + MWM_DECOR_MINIMIZE = 1 shl 5; + MWM_DECOR_MAXIMIZE = 1 shl 6; +// bit definitions for MwmHints.inputMode */ + MWM_INPUT_MODELESS = 0; + MWM_INPUT_PRIMARY_APPLICATION_MODAL = 1; + MWM_INPUT_SYSTEM_MODAL = 2; + MWM_INPUT_FULL_APPLICATION_MODAL = 3; + PROP_MWM_HINTS_ELEMENTS = 5; + +type TXWindowStateFlag = (xwsfMapped); TXWindowStateFlags = set of TXWindowStateFlag; @@ -1266,6 +1306,9 @@ var IconPixmap: TPixmap; WMHints: PXWMHints; + + prop: TAtom; + mwmhints: TMWMHints; begin if HandleIsValid then Exit; //==> @@ -1370,6 +1413,31 @@ begin // we have a Splash screen fpgApplication.netlayer.WindowSetType(FWinHandle, [nwtSplash]); + // process Borderless forms + if (FWindowType = wtWindow) and (waBorderless in FWindowAttributes) then + begin + prop := X.None; + prop := XInternAtom(xapplication.display, '_MOTIF_WM_INFO', longbool(0)); + if prop = X.None then + begin + writeln('Window Manager does not support MWM hints. Bypassing window manager control for borderless window.'); + // Set Override Redirect here! + mwmhints.flags := 0; + end + else + begin + mwmhints.flags := MWM_HINTS_DECORATIONS; + mwmhints.decorations := 0; + + if xapplication.xia_motif_wm_hints <> X.None then + begin + + prop := xapplication.xia_motif_wm_hints; + XChangeProperty(xapplication.display, FWinHandle, prop, prop, 32, PropModeReplace, @mwmhints, PROP_MWM_HINTS_ELEMENTS); + end; + end; + end; + { TODO : We could optimise this for non-focusable widgets } XSelectInput(xapplication.Display, wh, KeyPressMask or KeyReleaseMask or ButtonPressMask or ButtonReleaseMask or |