david
7ebea5ffa7
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jvcl@12 7f62d464-2af8-f54e-996c-e91b33f51cbe
8878 lines
249 KiB
ObjectPascal
8878 lines
249 KiB
ObjectPascal
{-------------------------------------------------------------------------------
|
||
QWindows.pas
|
||
|
||
Copyright (c) 2003,2004, Andre Snepvangers (asn att xs4all dott nl),
|
||
|
||
All rights reserved.
|
||
|
||
Version 1.0
|
||
Description: Qt based wrappers for common MS Windows API's
|
||
Purpose: Reduce coding effort for porting VCL based components to VisualCLX
|
||
compatible components. Simplify VCL code sharing.
|
||
|
||
Contributor(s): Andreas Hausladen [Andreas dott Hausladen att gmx dott de]
|
||
|
||
Permission is hereby granted, free of charge, to any person obtaining a copy of
|
||
this software and associated documentation files(the "Software"), to deal in
|
||
the Software without restriction, including without limitation the rights
|
||
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||
copies of the Software, and to permit persons to whom the Software is furnished
|
||
to do so, subject to the following conditions:
|
||
|
||
The above copyright notice and this permission notice shall be included in
|
||
all copies or substantial portions of the Software.
|
||
|
||
The origin of this software must not be misrepresented, you must
|
||
not claim that you wrote the original software. If you use this
|
||
software in a product, an acknowledgment in the product documentation
|
||
would be appreciated but is not required.
|
||
|
||
Altered source versions must be plainly marked as such, and must not
|
||
be misrepresented as being the original software.
|
||
|
||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
|
||
THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
|
||
THE SOFTWARE.
|
||
--------------------------------------------------------------------------------
|
||
|
||
Known Issues:
|
||
- Covers only a small part of the Windows APIs
|
||
- Not all functionality is supported
|
||
{-----------------------------------------------------------------------------}
|
||
// $Id: QWindows.pas 11641 2007-12-24 16:34:00Z outchy $
|
||
|
||
unit QWindows;
|
||
|
||
interface
|
||
|
||
uses
|
||
{$IFDEF MSWINDOWS}
|
||
Windows,
|
||
{$ENDIF MSWINDOWS}
|
||
{$IFDEF LINUX}
|
||
Libc, DateUtils,
|
||
{$ENDIF LINUX}
|
||
Types, StrUtils, SysUtils, Classes, Math, Contnrs, SyncObjs, QDialogs,
|
||
QTypes, Qt, QConsts, QGraphics, QControls, QForms, QExtCtrls, QStdCtrls,
|
||
QButtons, QImgList, QStyle;
|
||
|
||
type
|
||
IPerformControl = interface
|
||
['{B11AA73D-D7C2-43E5-BED8-8F82DE6152AB}']
|
||
function Perform(Msg: Cardinal; WPar, LPar: Longint): Longint;
|
||
end;
|
||
|
||
{$IFDEF LINUX}
|
||
resourcestring
|
||
SFCreateError = 'Unable to create file %s';
|
||
SFOpenError = 'Unable to open file %s';
|
||
SReadError = 'Error reading file';
|
||
SWriteError = 'Error writing file';
|
||
SQThreadError = 'Thread Error in QWindows: %s (%d)';
|
||
{$ENDIF LINUX}
|
||
|
||
var
|
||
NewStyleControls: Boolean = True;
|
||
|
||
const
|
||
{ SetBkMode: background modes }
|
||
TRANSPARENT = 1; // BGMode_TransparentMode
|
||
OPAQUE = 2; // BGMode_OpaqueMode
|
||
|
||
{ constants for CreateDIBitmap }
|
||
CBM_INIT = 4; { initialize bitmap }
|
||
DIB_RGB_COLORS = 0;
|
||
// DIB_PAL_COLORS = 1; // not supported by CreateDIBitmap
|
||
|
||
{ windows symbolic colors } { mapping VisualCLX Symbolic colors}
|
||
COLOR_SCROLLBAR = 0; // clNormalButton
|
||
COLOR_BACKGROUND = 1; // clNormalBackground
|
||
COLOR_ACTIVECAPTION = 2; // clActiveHighlightedText
|
||
COLOR_INACTIVECAPTION = 3; // clDisabledHighlightedText
|
||
COLOR_MENU = 4; // clNormalMid
|
||
COLOR_WINDOW = 5; // clNormalBase
|
||
COLOR_WINDOWFRAME = 6; // clNormalHighlight
|
||
COLOR_MENUTEXT = 7; // clNormalButtonText
|
||
COLOR_WINDOWTEXT = 8; // clNormalText
|
||
COLOR_CAPTIONTEXT = 9; // clNormalHighlightedText
|
||
COLOR_ACTIVEBORDER = 10; // clActiveHighlight
|
||
COLOR_INACTIVEBORDER = 11; // clDisabledHighlight
|
||
COLOR_APPWORKSPACE = 12; // clNormalMid
|
||
COLOR_HIGHLIGHT = 13; // clNormalHighlight
|
||
COLOR_HIGHLIGHTTEXT = 14; // clNormalHighlightedText
|
||
COLOR_BTNFACE = 15; // clNormalButton
|
||
COLOR_BTNSHADOW = $10; // clNormalDark
|
||
COLOR_GRAYTEXT = 17; // clNormalDisabledText
|
||
COLOR_BTNTEXT = 18; // clNormalButtonText
|
||
COLOR_INACTIVECAPTIONTEXT = 19; // clDisabledHighlightedText
|
||
COLOR_BTNHIGHLIGHT = 20; // clActiveLight
|
||
COLOR_3DDKSHADOW = 21; // clNormalMid
|
||
COLOR_3DLIGHT = 22; // clNormalMidLight
|
||
COLOR_INFOTEXT = 23; // clNormalText
|
||
COLOR_INFOBK = 24; // TColor($E1FFFF)
|
||
// = 25; // ?? (asn: defined as clBlack for now)
|
||
COLOR_HOTLIGHT = 26; // clActiveHighlight (asn: ??)
|
||
COLOR_GRADIENTACTIVECAPTION = 27; // clActiveHighLight (asn: ??)
|
||
COLOR_GRADIENTINACTIVECAPTION = 28; // clDisabledHighlight (asn: ??)
|
||
|
||
COLOR_ENDCOLORS = COLOR_GRADIENTINACTIVECAPTION;
|
||
(*
|
||
COLOR_MENUHILIGHT = 29;
|
||
COLOR_MENUBAR = 30;
|
||
COLOR_ENDCOLORS = COLOR_MENUBAR;
|
||
*)
|
||
|
||
COLOR_DESKTOP = COLOR_BACKGROUND;
|
||
COLOR_3DFACE = COLOR_BTNFACE;
|
||
COLOR_3DSHADOW = COLOR_BTNSHADOW;
|
||
COLOR_3DHIGHLIGHT = COLOR_BTNHIGHLIGHT;
|
||
COLOR_3DHILIGHT = COLOR_BTNHIGHLIGHT;
|
||
COLOR_BTNHILIGHT = COLOR_BTNHIGHLIGHT;
|
||
|
||
{ CombineRgn return values }
|
||
NULLREGION = 1; // Region is empty
|
||
SIMPLEREGION = 2; // Region is a rectangle
|
||
COMPLEXREGION = 3; // Region is not a rectangle
|
||
ERROR = 0; // Region error
|
||
RGN_ERROR = ERROR;
|
||
|
||
{ constants for CreatePolygon }
|
||
ALTERNATE = 1;
|
||
WINDING = 2;
|
||
|
||
{ flags for DrawFrameControl }
|
||
DFC_CAPTION = 1;
|
||
DFC_MENU = 2;
|
||
DFC_SCROLL = 3;
|
||
DFC_BUTTON = 4;
|
||
DFC_POPUPMENU = 5;
|
||
|
||
DFCS_CAPTIONCLOSE = 0;
|
||
DFCS_CAPTIONMIN = 1;
|
||
DFCS_CAPTIONMAX = 2;
|
||
DFCS_CAPTIONRESTORE = 3;
|
||
DFCS_CAPTIONHELP = 4;
|
||
|
||
DFCS_MENUARROW = 0;
|
||
DFCS_MENUCHECK = 1;
|
||
DFCS_MENUBULLET = 2;
|
||
DFCS_MENUARROWRIGHT = 4;
|
||
|
||
DFCS_SCROLLUP = 0;
|
||
DFCS_SCROLLDOWN = 1;
|
||
DFCS_SCROLLLEFT = 2;
|
||
DFCS_SCROLLRIGHT = 3;
|
||
DFCS_SCROLLCOMBOBOX = 5;
|
||
DFCS_SCROLLSIZEGRIP = 8;
|
||
DFCS_SCROLLSIZEGRIPRIGHT = $10;
|
||
|
||
DFCS_BUTTONCHECK = 0;
|
||
DFCS_BUTTONRADIOIMAGE = 1;
|
||
DFCS_BUTTONRADIOMASK = 2;
|
||
DFCS_BUTTONRADIO = 4;
|
||
DFCS_BUTTON3STATE = 8;
|
||
DFCS_BUTTONPUSH = $10;
|
||
|
||
DFCS_INACTIVE = $100;
|
||
DFCS_PUSHED = $200;
|
||
DFCS_CHECKED = $400;
|
||
DFCS_TRANSPARENT = $800;
|
||
DFCS_HOT = $1000;
|
||
DFCS_ADJUSTRECT = $2000;
|
||
DFCS_FLAT = $4000;
|
||
DFCS_MONO = $8000;
|
||
|
||
{ 3D border styles }
|
||
BDR_RAISEDOUTER = 1;
|
||
BDR_SUNKENOUTER = 2;
|
||
BDR_RAISEDINNER = 4;
|
||
BDR_SUNKENINNER = 8;
|
||
|
||
BDR_OUTER = BDR_SUNKENOUTER or BDR_RAISEDOUTER;
|
||
BDR_INNER = BDR_SUNKENINNER or BDR_SUNKENOUTER;
|
||
BDR_RAISED = BDR_RAISEDINNER or BDR_RAISEDOUTER;
|
||
BDR_SUNKEN = BDR_SUNKENINNER or BDR_SUNKENOUTER;
|
||
|
||
EDGE_RAISED = BDR_RAISEDOUTER or BDR_RAISEDINNER;
|
||
EDGE_SUNKEN = BDR_SUNKENOUTER or BDR_SUNKENINNER;
|
||
EDGE_ETCHED = BDR_SUNKENOUTER or BDR_RAISEDINNER;
|
||
EDGE_BUMP = BDR_RAISEDOUTER or BDR_SUNKENINNER;
|
||
|
||
{ Border flags }
|
||
BF_LEFT = 1;
|
||
BF_TOP = 2;
|
||
BF_RIGHT = 4;
|
||
BF_BOTTOM = 8;
|
||
BF_DIAGONAL = $10;
|
||
|
||
BF_TOPLEFT = BF_TOP or BF_LEFT;
|
||
BF_TOPRIGHT = BF_TOP or BF_RIGHT;
|
||
BF_BOTTOMLEFT = BF_BOTTOM or BF_LEFT;
|
||
BF_BOTTOMRIGHT = BF_BOTTOM or BF_RIGHT;
|
||
BF_RECT = BF_TOPLEFT or BF_BOTTOMRIGHT;
|
||
|
||
{ For diagonal lines, the BF_RECT flags specify the end point of the}
|
||
{ vector bounded by the rectangle parameter.}
|
||
BF_DIAGONAL_ENDTOPRIGHT = BF_DIAGONAL or BF_TOP or BF_RIGHT;
|
||
BF_DIAGONAL_ENDTOPLEFT = BF_DIAGONAL or BF_TOP or BF_LEFT;
|
||
BF_DIAGONAL_ENDBOTTOMLEFT = BF_DIAGONAL or BF_BOTTOM or BF_LEFT;
|
||
BF_DIAGONAL_ENDBOTTOMRIGHT = BF_DIAGONAL or BF_BOTTOM or BF_RIGHT;
|
||
|
||
BF_MIDDLE = $800; { Fill in the middle }
|
||
BF_SOFT = $1000; { For softer buttons }
|
||
BF_ADJUST = $2000; { Calculate the space left over }
|
||
BF_FLAT = $4000; { For flat rather than 3D borders }
|
||
BF_MONO = $8000; { For monochrome borders }
|
||
|
||
{ DrawIconEx diFlags }
|
||
DI_MASK = 1;
|
||
DI_IMAGE = 2;
|
||
DI_NORMAL = 3;
|
||
// DI_COMPAT = 4; not supported
|
||
DI_DEFAULTSIZE = 8;
|
||
|
||
{ DrawText format (windows) flags }
|
||
DT_TOP = 0;
|
||
DT_LEFT = 0;
|
||
DT_CENTER = 1;
|
||
DT_RIGHT = 2;
|
||
DT_VCENTER = 4;
|
||
DT_BOTTOM = 8;
|
||
DT_WORDBREAK = $10;
|
||
DT_SINGLELINE = $20;
|
||
DT_EXPANDTABS = $40;
|
||
DT_TABSTOP = $80;
|
||
DT_NOCLIP = $100;
|
||
(* DT_EXTERNALLEADING = $200; // not supported *)
|
||
DT_CALCRECT = $400;
|
||
DT_NOPREFIX = $800;
|
||
DT_INTERNAL = $1000; // Uses the system font to calculate text metrics.
|
||
DT_EDITCONTROL = $2000; // ignored
|
||
DT_PATH_ELLIPSIS = $4000;
|
||
DT_ELLIPSIS = $8000;
|
||
DT_END_ELLIPSIS = DT_ELLIPSIS;
|
||
DT_MODIFYSTRING = $10000;
|
||
DT_RTLREADING = $20000; // ignored
|
||
DT_WORD_ELLIPSIS = $40000;
|
||
DT_HIDEPREFIX = $100000;
|
||
DT_PREFIXONLY = $200000;
|
||
|
||
{ ExtTextOut format flags }
|
||
ETO_OPAQUE = 2;
|
||
ETO_CLIPPED = 4;
|
||
ETO_RTLREADING = $80; // ignored
|
||
|
||
{ font metrics }
|
||
DEFAULT_PITCH = 0;
|
||
FIXED_PITCH = 1;
|
||
VARIABLE_PITCH = 2;
|
||
DEFAULT_CHARSET = 1;
|
||
|
||
{$IFDEF LINUX}
|
||
HINSTANCE_ERROR = 0;
|
||
HINSTANCE_OK = HINSTANCE_ERROR + 1;
|
||
{$ENDIF LINUX}
|
||
|
||
{ BrushStyle mappings}
|
||
HS_BDIAGONAL = BrushStyle_BDiagPattern; // 45-degree downward left-to-right hatch
|
||
HS_CROSS = BrushStyle_CrossPattern; // Hor. and vertical crosshatch
|
||
HS_DIAGCROSS = BrushStyle_DiagCrossPattern;// 45-degree crosshatch
|
||
HS_FDIAGONAL = BrushStyle_FDiagPattern; // 45-degree upward left-to-right hatch
|
||
HS_HORIZONTAL = BrushStyle_HorPattern; // Horizontal hatch
|
||
HS_VERTICAL = BrushStyle_VerPattern; // Vertical hatch
|
||
|
||
HWND_TOP = Cardinal(0);
|
||
HWND_BOTTOM = Cardinal(1);
|
||
HWND_TOPMOST = Cardinal(-1);
|
||
HWND_NOTOPMOST = Cardinal(-2);
|
||
|
||
{$IFDEF LINUX}
|
||
{ GlobalMemory }
|
||
GMEM_FIXED = 0;
|
||
GMEM_MOVEABLE = 2;
|
||
GMEM_NOCOMPACT = $10;
|
||
GMEM_NODISCARD = $20;
|
||
GMEM_ZEROINIT = $40; // only supported flag
|
||
GMEM_MODIFY = $80;
|
||
GMEM_DISCARDABLE = $100;
|
||
GMEM_NOT_BANKED = $1000;
|
||
GMEM_SHARE = $2000;
|
||
GMEM_DDESHARE = $2000;
|
||
GMEM_NOTIFY = $4000;
|
||
GMEM_LOWER = GMEM_NOT_BANKED;
|
||
GMEM_VALID_FLAGS = 32626;
|
||
GMEM_INVALID_HANDLE = $8000;
|
||
|
||
GHND = GMEM_MOVEABLE or GMEM_ZEROINIT;
|
||
GPTR = GMEM_FIXED or GMEM_ZEROINIT;
|
||
|
||
{$ENDIF LINUX}
|
||
|
||
|
||
INFINITE = Longword($FFFFFFFF); // Infinite timeout
|
||
INVALID_HANDLE_VALUE = DWORD(-1);
|
||
MaxWord = High(Cardinal);
|
||
|
||
{ MessageBox() return values }
|
||
IDCLOSE = 0;
|
||
IDOK = 1;
|
||
IDCANCEL = 2;
|
||
IDYES = 3;
|
||
IDNO = 4;
|
||
IDABORT = 5;
|
||
IDRETRY = 6;
|
||
IDIGNORE = 7;
|
||
{ aliases }
|
||
ID_OK = IDOK;
|
||
ID_CANCEL = IDCANCEL;
|
||
ID_ABORT = IDABORT;
|
||
ID_RETRY = IDRETRY;
|
||
ID_IGNORE = IDIGNORE;
|
||
ID_YES = IDYES;
|
||
ID_NO = IDNO;
|
||
ID_CLOSE = IDCLOSE;
|
||
IDHELP = 9; // not supported
|
||
ID_HELP = IDHELP; // not supported
|
||
IDTRYAGAIN = IDRETRY;
|
||
IDCONTINUE = IDIGNORE;
|
||
|
||
{$EXTERNALSYM LB_OKAY}
|
||
LB_OKAY = 0;
|
||
{$EXTERNALSYM LB_ERR}
|
||
LB_ERR = -1;
|
||
{$EXTERNALSYM LB_ERRSPACE}
|
||
LB_ERRSPACE = -2;
|
||
{$EXTERNALSYM CB_OKAY}
|
||
CB_OKAY = 0;
|
||
{$EXTERNALSYM CB_ERR}
|
||
CB_ERR = -1;
|
||
{$EXTERNALSYM CB_ERRSPACE}
|
||
CB_ERRSPACE = -2;
|
||
|
||
|
||
MAX_COMPUTERNAME_LENGTH = 15;
|
||
|
||
{ MessageBox() WinFlags }
|
||
MB_OK = $0000;
|
||
MB_OKCANCEL = $0001;
|
||
MB_ABORTRETRYIGNORE = $0002;
|
||
MB_YESNOCANCEL = $0003;
|
||
MB_YESNO = $0004;
|
||
MB_RETRYCANCEL = $0005;
|
||
MB_HELP = $4000; { Help Button not supported}
|
||
MB_ICONHAND = $0010;
|
||
MB_ICONQUESTION = $0020;
|
||
MB_ICONEXCLAMATION = $0030;
|
||
MB_ICONASTERISK = $0040;
|
||
MB_USERICON = $0080;
|
||
MB_DEFBUTTON1 = $0000;
|
||
MB_DEFBUTTON2 = $0100;
|
||
MB_DEFBUTTON3 = $0200;
|
||
MB_DEFBUTTON4 = $0300;
|
||
MB_ICONWARNING = MB_ICONEXCLAMATION;
|
||
MB_ICONERROR = MB_ICONHAND;
|
||
MB_ICONINFORMATION = MB_ICONASTERISK;
|
||
MB_ICONSTOP = MB_ICONHAND;
|
||
|
||
{ MouseKeys }
|
||
MK_LBUTTON = 1;
|
||
MK_RBUTTON = 2;
|
||
MK_SHIFT = 4;
|
||
MK_CONTROL = 8;
|
||
MK_MBUTTON = $10;
|
||
|
||
{ TDrawItemStruct itemstate }
|
||
ODS_DISABLED = 1;
|
||
ODS_SELECTED = 2;
|
||
ODS_FOCUS = 4;
|
||
|
||
{ Pen Styles }
|
||
PS_NULL = 0; // PenStyle_NoPen
|
||
PS_SOLID = 1; // PenStyle_SolidLine
|
||
PS_DASH = 2; // PenStyle_DashLine
|
||
PS_DOT = 3; // PenStyle_DotLine
|
||
PS_DASHDOT = 4; // PenStyle_DashDotLine
|
||
PS_DASHDOTDOT = 5; // PenStyle_DashDotDotLine
|
||
PS_STYLE_MASK = 15; // PenStyle_MPenStyle
|
||
{caps}
|
||
PS_ENDCAP_FLAT = 0; // PenCapStyle_FlatCap
|
||
PS_ENDCAP_SQUARE = 16; // PenCapStyle_SquareCap
|
||
PS_ENDCAP_ROUND = 32; // PenCapStyle_RoundCap
|
||
PS_ENDCAP_MASK = 48; // PenCapStyle_MPenCapStyle
|
||
{join}
|
||
PS_JOIN_MITER = 0; // PenJoinStyle_MiterJoin
|
||
PS_JOIN_BEVEL = 64; // PenJoinStyle_BevelJoin
|
||
PS_JOIN_ROUND = 128; // PenJoinStyle_RoundJoin
|
||
PS_JOIN_MASK = $C0; // PenCapStyle_MPenCapStyle
|
||
|
||
{ BitBlt/StretchBlt: supported windows dwRop Raster OPerations }
|
||
BLACKNESS = $00000042; // RasterOp_ClearROP
|
||
DSTINVERT = $00550009; // RasterOp_NotROP
|
||
MERGECOPY = $00C000CA; // RasterOp_OrROP
|
||
MERGEPAINT = $00BB0226; // RasterOp_NotOrRop
|
||
NOTSRCCOPY = $00330008; // RasterOp_NotCopyROP
|
||
NOTSRCERASE = $001100A6; // RasterOp_NorROP
|
||
SRCAND = $008800C6; // RasterOp_AndROP
|
||
SRCCOPY = $00CC0020; // RasterOp_CopyROP
|
||
SRCERASE = $00440328; // RasterOp_AndNotROP
|
||
SRCINVERT = $00660046; // RasterOp_XorROP
|
||
SRCPAINT = $00EE0086; // RasterOp_OrROP;
|
||
WHITENESS = $00FF0062; // RasterOp_SetROP
|
||
PATCOPY = $00F00021; // dest = pattern
|
||
PATPAINT = $00FB0A09; // dest = DPSnoo = PDSnoo
|
||
PATINVERT = $005A0049; // dest = pattern XOR dest
|
||
ROP_DSPDxax = $00E20746; // dest = ((pattern XOR dest) AND source) XOR Dest
|
||
ROP_DSna = $00220326; // RasterOp_NotAndROP
|
||
ROP_DSno = MERGEPAINT;
|
||
ROP_DPSnoo = PATPAINT;
|
||
ROP_D = $00AA0029; // RasterOp_NopROP
|
||
ROP_Dn = DSTINVERT; // DSTINVERT
|
||
ROP_SDna = SRCERASE; // SRCERASE
|
||
ROP_SDno = $00DD0228; // RasterOp_OrNotROP
|
||
ROP_DSan = $007700E6; // RasterOp_NandROP
|
||
ROP_DSon = $001100A6; // NOTSRCERASE
|
||
//ROP_Pn = $000F0001; //
|
||
|
||
{ SetROP2: windows ROP2 values }
|
||
R2_BLACK = 9; // RasterOp_ClearROP: Pixel is always 0.
|
||
R2_WHITE = 10; // RasterOp_SetROP:Pixel is always 1.
|
||
R2_NOP = 11; // RasterOp_NopROP: Pixel remains unchanged.
|
||
R2_NOT = 8; // RasterOp_NotROP: inverse of the screen color.
|
||
R2_COPYPEN = 0; // RasterOp_CopyROP: Pixel is the pen color.
|
||
R2_NOTCOPYPEN = 4; // RasterOp_NotCopyROP; inverse of the pen color.
|
||
R2_MERGEPENNOT = 13; // RasterOp_OrNotROP: combination of the pen color and the inverse of the screen color.
|
||
R2_MASKPENNOT = 12; // RasterOp_AndNotROP: combination of the colors common to both the pen and the inverse of the screen.
|
||
R2_MERGEPEN = 1; // RasterOp_OrROP: combination of the pen color and the screen color.
|
||
R2_NOTMERGEPEN = 15; // RasterOp_NorROP: inverse of the R2_MERGEPEN color.
|
||
R2_MASKPEN = 7; // RasterOp_AndROP: combination of the colors common to both the pen and the screen.
|
||
R2_NOTMASKPEN = 14; // RasterOp_NandROP: inverse of the R2_MASKPEN color.
|
||
R2_XORPEN = 2; // RasterOp_XorROP: combination of the colors in the pen and in the screen, but not in both.
|
||
R2_NOTXORPEN = 6; // RasterOp_NotXorROP: inverse of the R2_XORPEN color.
|
||
R2_MASKNOTPEN = 3; // RasterOp_NotAndROP: combination of the colors common to both the screen and the inverse of the pen.
|
||
R2_MERGENOTPEN = 5; // RasterOp_NotOrROP: combination of the screen color and the inverse of the pen color.
|
||
|
||
RT_RCDATA = Types.RT_RCDATA;
|
||
RT_BITMAP = PChar(2);
|
||
|
||
{ WM_xSCROLL ScrollCodes }
|
||
SB_BOTTOM = 1;
|
||
SB_ENDSCROLL = 2;
|
||
SB_LINEDOWN = 3;
|
||
SB_LINEUP = 4;
|
||
SB_PAGEDOWN = 5;
|
||
SB_PAGEUP = 6;
|
||
SB_THUMBPOSITION = 7;
|
||
SB_THUMBTRACK = 8;
|
||
SB_TOP = 9;
|
||
|
||
SB_HORZ = 1;
|
||
SB_VERT = 2;
|
||
SB_BOTH = SB_HORZ or SB_VERT;
|
||
|
||
|
||
{ semaphores }
|
||
STATUS_WAIT_0 = $00000000;
|
||
STATUS_ABANDONED_WAIT_0 = $00000080;
|
||
STATUS_TIMEOUT = $00000102;
|
||
WAIT_FAILED = Longword($FFFFFFFF);
|
||
WAIT_OBJECT_0 = STATUS_WAIT_0;
|
||
WAIT_ABANDONED = STATUS_ABANDONED_WAIT_0;
|
||
WAIT_ABANDONED_0 = STATUS_ABANDONED_WAIT_0;
|
||
WAIT_TIMEOUT = STATUS_TIMEOUT;
|
||
MAXIMUM_WAIT_OBJECTS = 64;
|
||
|
||
{ ShowWindow() Commands }
|
||
SW_HIDE = 0;
|
||
SW_SHOWNORMAL = 1;
|
||
SW_NORMAL = 1;
|
||
SW_SHOWMINIMIZED = 2;
|
||
SW_SHOWMAXIMIZED = 3;
|
||
SW_MAXIMIZE = 3;
|
||
SW_SHOWNOACTIVATE = 4;
|
||
SW_SHOW = 5;
|
||
SW_MINIMIZE = 6;
|
||
SW_SHOWMINNOACTIVE = 7;
|
||
SW_SHOWNA = 8;
|
||
SW_RESTORE = 9;
|
||
SW_SHOWDEFAULT = 10;
|
||
SW_MAX = 10;
|
||
|
||
{ SetWindowPos Flags }
|
||
SWP_NOSIZE = 1;
|
||
SWP_NOMOVE = 2;
|
||
SWP_NOZORDER = 4;
|
||
SWP_NOREDRAW = 8;
|
||
SWP_NOACTIVATE = $10;
|
||
SWP_FRAMECHANGED = $20; { The frame changed: send WM_NCCALCSIZE }
|
||
SWP_SHOWWINDOW = $40;
|
||
SWP_HIDEWINDOW = $80;
|
||
SWP_NOCOPYBITS = $100; // ignored
|
||
SWP_NOOWNERZORDER = $200; { Don't do owner Z ordering }
|
||
SWP_NOSENDCHANGING = $400; // ignores
|
||
SWP_DRAWFRAME = SWP_FRAMECHANGED;
|
||
SWP_NOREPOSITION = SWP_NOOWNERZORDER;
|
||
SWP_DEFERERASE = $2000;
|
||
SWP_ASYNCWINDOWPOS = $4000; // ignored
|
||
|
||
TA_LEFT = Integer(AlignmentFlags_AlignLeft);
|
||
TA_RIGHT = Integer(AlignmentFlags_AlignRight);
|
||
TA_CENTER = Integer(AlignmentFlags_AlignHCenter);
|
||
TA_TOP = Integer(AlignmentFlags_AlignTop);
|
||
TA_BOTTOM = Integer(AlignmentFlags_AlignBottom);
|
||
VTA_CENTER = Integer(AlignmentFlags_AlignVCenter);
|
||
TA_NOUPDATECP = 0;
|
||
TA_UPDATECP = $8000;
|
||
TA_BASELINE = $4000;
|
||
VTA_BASELINE = TA_BASELINE;
|
||
|
||
{$IFDEF LINUX}
|
||
{virtual memory handling}
|
||
PAGE_NOACCESS = 0;
|
||
PAGE_READONLY = PROT_READ;
|
||
PAGE_READWRITE = PROT_READ or PROT_WRITE;
|
||
//PAGE_WRITECOPY = PROT_ ; // not implemented
|
||
PAGE_EXECUTE = PROT_EXEC;
|
||
PAGE_EXECUTE_READ = PAGE_EXECUTE or PAGE_READONLY;
|
||
PAGE_EXECUTE_READWRITE = PAGE_EXECUTE or PAGE_READWRITE;
|
||
//PAGE_EXECUTE_WRITECOPY = PAGE_EXECUTE or PAGE_WRITECOPY;
|
||
{$ENDIF LINUX}
|
||
|
||
|
||
{ Windows VK_ keycodes to Qt key }
|
||
VK_BACK = Key_Backspace;
|
||
VK_TAB = Key_Tab;
|
||
VK_RETURN = Key_Enter; //Key_Return = Enter key from keypad
|
||
VK_SHIFT = Key_Shift;
|
||
VK_CONTROL = Key_Control;
|
||
VK_MENU = Key_Alt;
|
||
VK_PAUSE = Key_Pause;
|
||
VK_CAPITAL = Key_CapsLock;
|
||
VK_ESCAPE = 4096;
|
||
VK_SPACE = Key_Space;
|
||
VK_PRIOR = Key_Prior;
|
||
VK_NEXT = Key_Next;
|
||
VK_END = Key_End;
|
||
VK_HOME = Key_Home;
|
||
VK_LEFT = Key_Left;
|
||
VK_UP = Key_Up;
|
||
VK_RIGHT = Key_Right;
|
||
VK_DOWN = Key_Down;
|
||
{ VK_SELECT = 41; }
|
||
VK_PRINT = Key_Print;
|
||
{ VK_EXECUTE = 43; }
|
||
VK_SNAPSHOT = Key_Print;
|
||
VK_INSERT = Key_Insert;
|
||
VK_DELETE = Key_Delete;
|
||
VK_HELP = Key_Help;
|
||
{ VK_LWIN = 91; }
|
||
{ VK_RWIN = 92; }
|
||
VK_APPS = Key_Menu;
|
||
VK_NUMPAD0 = Key_0;
|
||
VK_NUMPAD1 = Key_1;
|
||
VK_NUMPAD2 = Key_2;
|
||
VK_NUMPAD3 = Key_3;
|
||
VK_NUMPAD4 = Key_4;
|
||
VK_NUMPAD5 = Key_5;
|
||
VK_NUMPAD6 = Key_6;
|
||
VK_NUMPAD7 = Key_7;
|
||
VK_NUMPAD8 = Key_8;
|
||
VK_NUMPAD9 = Key_9;
|
||
VK_MULTIPLY = Key_Asterisk;
|
||
VK_ADD = Key_Plus;
|
||
VK_SUBTRACT = Key_Minus;
|
||
VK_DECIMAL = Key_Period;
|
||
VK_DIVIDE = Key_Slash;
|
||
VK_F1 = Key_F1;
|
||
VK_F2 = Key_F2;
|
||
VK_F3 = Key_F3;
|
||
VK_F4 = Key_F4;
|
||
VK_F5 = Key_F5;
|
||
VK_F6 = Key_F6;
|
||
VK_F7 = Key_F7;
|
||
VK_F8 = Key_F8;
|
||
VK_F9 = Key_F1;
|
||
VK_F10 = Key_F10;
|
||
VK_F11 = Key_F11;
|
||
VK_F12 = Key_F12;
|
||
VK_F13 = Key_F13;
|
||
VK_F14 = Key_F14;
|
||
VK_F15 = Key_F15;
|
||
VK_F16 = Key_F16;
|
||
VK_F17 = Key_F17;
|
||
VK_F18 = Key_F18;
|
||
VK_F19 = Key_F19;
|
||
VK_F20 = Key_F20;
|
||
VK_F21 = Key_F21;
|
||
VK_F22 = Key_F22;
|
||
VK_F23 = Key_F23;
|
||
VK_F24 = Key_F24;
|
||
VK_NUMLOCK = Key_NumLock;
|
||
VK_SCROLL = Key_ScrollLock;
|
||
{ VK_L.. & VK_R.. mapping: }
|
||
{ Alt, Ctrl and Shift keys produce same keycode }
|
||
VK_LSHIFT = Key_Shift;
|
||
VK_RSHIFT = Key_Shift;
|
||
VK_LCONTROL = Key_Control;
|
||
VK_RCONTROL = Key_Control;
|
||
VK_LMENU = Key_Alt;
|
||
VK_RMENU = Key_Alt;
|
||
|
||
{ Qt alignment flags, (as used by Canvas.TextRect) }
|
||
AlignLeft = $1;
|
||
AlignRight = $2;
|
||
AlignHCenter = $4;
|
||
AlignTop = $8;
|
||
AlignBottom = $10;
|
||
AlignVCenter = $20;
|
||
AlignCenter = $24;
|
||
SingleLine = $40;
|
||
DontClip = $80;
|
||
ExpandTabs = $100;
|
||
ShowPrefix = $200;
|
||
WordBreak = $400;
|
||
BreakAnywhere = $800;
|
||
// DontPrint = $1000; not used
|
||
{ Additional constanst for Qt text alignments used by DrawText }
|
||
QtAlignMask = $FFF;
|
||
CalcRect = $10000;
|
||
ClipPath = $20000;
|
||
ClipName = $40000;
|
||
ClipToWord = $100000;
|
||
ModifyString = $200000;
|
||
|
||
pf24bit = pf32bit;
|
||
clSystemColor = $FF000000;
|
||
clMoneyGreen = TColor($C0DCC0);
|
||
clSkyBlue = TColor($F0CAA6);
|
||
clCream = TColor($F0FBFF);
|
||
clMedGray = TColor($A4A0A0);
|
||
clWindowFrame = cl3DDkShadow;
|
||
|
||
crColorTo = crNoRole;
|
||
clColorTo = TColor(-15);
|
||
clNormalColorTo = TColor(clColorTo - cloNormal);
|
||
clActiveColorTo = TColor(clColorTo - cloActive);
|
||
clDisabledColorTo = TColor(clColorTo - cloDisabled);
|
||
|
||
clNoRole = TColor(-15);
|
||
clNormalNoRole = TColor(clNoRole - cloNormal);
|
||
clDisabledNoRole = TColor(clNoRole - cloDisabled);
|
||
clActiveNoRole = TColor(clNoRole - cloActive);
|
||
clDesktop = clDisabledNoRole;
|
||
clColor0 = clMask;
|
||
clColor1 = clDontMask;
|
||
|
||
// Windows symbolic colors to mapping VisualCLX symbolic colors
|
||
Win2TColor: array [0..COLOR_ENDCOLORS] of TColor = (
|
||
clNormalButton, clNormalBackground, clActiveHighlightedText, // 0
|
||
clDisabledHighlightedText, clNormalMid, clNormalBase, // 3
|
||
clNormalHighlight, clNormalButtonText, clNormalText, // 6
|
||
clNormalHighlightedText, clActiveHighlight, clDisabledHighlight, // 9
|
||
clNormalMid, clNormalHighlight, clNormalHighlightedText, // 12
|
||
clNormalButton, clNormalDark, clDisabledText, // 15
|
||
clNormalButtonText, clDisabledHighlightedText, clActiveLight, // 18
|
||
clNormalMid, clNormalMidLight, clNormalText, // 21
|
||
clInfoBk, clBlack, clActiveHighlight, // 24
|
||
clActiveHighLight, clDisabledHighlight // 27
|
||
);
|
||
|
||
{ SendMessage / PostMessage }
|
||
QEventType_Message = QEventType(2105);
|
||
{ Timer message id}
|
||
WM_TIMER = $0113; { 275 }
|
||
|
||
type
|
||
TAppEventHook = class(TComponent)
|
||
private
|
||
FHook: QApplication_hookH;
|
||
protected
|
||
function EventFilter(Receiver: QObjectH; Event: QEventH): Boolean; cdecl;
|
||
public
|
||
constructor Create(AOwner: TComponent); override;
|
||
destructor Destroy; override;
|
||
end;
|
||
|
||
TMsg = packed record
|
||
hwnd: QWidgetH;
|
||
message: Integer;
|
||
wParam: Integer;
|
||
lParam: Integer;
|
||
case integer of
|
||
0:
|
||
(
|
||
time: Cardinal;
|
||
pt: TPoint;
|
||
);
|
||
1: ( Result: Integer);
|
||
2: ( Handled: LongBool);
|
||
end;
|
||
PMsg = ^TMsg;
|
||
|
||
TMessage = packed record
|
||
Msg: Cardinal;
|
||
case Integer of
|
||
0:
|
||
(
|
||
WParam: Longint;
|
||
LParam: Longint;
|
||
Result: Longint;
|
||
);
|
||
1:
|
||
(
|
||
WParamLo: Word;
|
||
WParamHi: Word;
|
||
LParamLo: Word;
|
||
LParamHi: Word;
|
||
ResultLo: Word;
|
||
ResultHi: Word
|
||
);
|
||
end;
|
||
PMessage = ^TMessage;
|
||
|
||
{ Provided to simplify VCL source sharing }
|
||
HWND = QWidgetH;
|
||
HCURSOR = QCursorH;
|
||
HRGN = QRegionH;
|
||
HBRUSH = QBrushH;
|
||
HBITMAP = QPixmapH;
|
||
HDC = QPainterH;
|
||
HFONT = QFontH;
|
||
UINT = Cardinal;
|
||
ULONG = Cardinal;
|
||
DWORD = Cardinal;
|
||
BOOL = LongBool;
|
||
WPARAM = Integer;
|
||
LPARAM = Integer;
|
||
LRESULT = Integer;
|
||
TPointL = TPoint;
|
||
COLORREF = Integer;
|
||
TColorRef = COLORREF;
|
||
|
||
TWinControlActionLink = TWidgetControlActionLink;
|
||
TControlClass = class of TControl;
|
||
|
||
{$EXTERNALSYM TCaption}
|
||
TCaption = QTypes.TCaption;
|
||
|
||
{$EXTERNALSYM TOwnerDrawState}
|
||
TOwnerDrawState = QStdCtrls.TOwnerDrawState;
|
||
|
||
{$EXTERNALSYM PPoint}
|
||
{$EXTERNALSYM TPoint}
|
||
PPoint = Types.PPoint;
|
||
TPoint = Types.TPoint;
|
||
|
||
{$EXTERNALSYM PRect}
|
||
{$EXTERNALSYM TRect}
|
||
PRect = Types.PRect;
|
||
TRect = Types.TRect;
|
||
|
||
{$EXTERNALSYM PSize}
|
||
{$EXTERNALSYM TSize}
|
||
TSize = Types.TSize;
|
||
PSize = Types.PSize;
|
||
|
||
PSmallPoint = Types.PSmallPoint;
|
||
TSmallPoint = Types.TSmallPoint;
|
||
{$EXTERNALSYM PSmallPoint}
|
||
{$EXTERNALSYM TSmallPoint}
|
||
|
||
TTime = type TDateTime;
|
||
TDate = type TDateTime;
|
||
{$EXTERNALSYM TDate}
|
||
{$EXTERNALSYM TTime}
|
||
|
||
{ colors }
|
||
TRGBQuad = packed record
|
||
rgbBlue: Byte;
|
||
rgbGreen: Byte;
|
||
rgbRed: Byte;
|
||
rgbReserved: Byte;
|
||
end;
|
||
TRGBTriple = TRGBQuad; // Qt does not support 24 bit pixmaps
|
||
|
||
{ fonts }
|
||
tagTEXTMETRICA = record
|
||
tmHeight: Longint;
|
||
tmAscent: Longint;
|
||
tmDescent: Longint;
|
||
//tmInternalLeading: Longint; // not supported
|
||
tmExternalLeading: Longint;
|
||
tmAveCharWidth: Longint;
|
||
tmMaxCharWidth: Longint;
|
||
tmWeight: Longint;
|
||
//tmOverhang: Longint; // not supported
|
||
tmDigitizedAspectX: Longint;
|
||
tmDigitizedAspectY: Longint;
|
||
tmFirstChar: AnsiChar;
|
||
tmLastChar: AnsiChar;
|
||
tmDefaultChar: AnsiChar;
|
||
tmBreakChar: AnsiChar;
|
||
tmItalic: Byte;
|
||
tmUnderlined: Byte;
|
||
tmStruckOut: Byte;
|
||
tmPitchAndFamily: Byte;
|
||
tmCharSet: Byte;
|
||
end;
|
||
TTextMetric = tagTEXTMETRICA;
|
||
TEXTMETRIC = TTextMetric;
|
||
|
||
{ Logical Pen }
|
||
PLogPen = ^TLogPen;
|
||
tagLOGPEN = packed record
|
||
lopnStyle: UINT;
|
||
lopnWidth: TPoint;
|
||
lopnColor: COLORREF;
|
||
end;
|
||
TLogPen = tagLOGPEN;
|
||
LOGPEN = tagLOGPEN;
|
||
|
||
{ Logical Palette }
|
||
PPaletteEntry = ^TPaletteEntry;
|
||
tagPALETTEENTRY = packed record
|
||
peRed: Byte;
|
||
peGreen: Byte;
|
||
peBlue: Byte;
|
||
peFlags: Byte;
|
||
end;
|
||
TPaletteEntry = tagPALETTEENTRY;
|
||
PALETTEENTRY = tagPALETTEENTRY;
|
||
|
||
PLogPalette = ^TLogPalette;
|
||
tagLOGPALETTE = packed record
|
||
palVersion: Word;
|
||
palNumEntries: Word;
|
||
palPalEntry: array[0..0] of TPaletteEntry;
|
||
end;
|
||
TLogPalette = tagLOGPALETTE;
|
||
LOGPALETTE = tagLOGPALETTE;
|
||
|
||
PMaxLogPalette = ^TMaxLogPalette;
|
||
TMaxLogPalette = packed record
|
||
palVersion: Word;
|
||
palNumEntries: Word;
|
||
palPalEntry: array[Byte] of TPaletteEntry;
|
||
end;
|
||
|
||
PtagBITMAP = ^tagBITMAP;
|
||
tagBITMAP = packed record
|
||
//bmType: Longint;
|
||
bmWidth: Longint;
|
||
bmHeight: Longint;
|
||
//bmWidthBytes: Longint;
|
||
//bmPlanes: Word;
|
||
bmBitsPixel: Word;
|
||
//bmBits: Pointer;
|
||
end;
|
||
|
||
PBitmapInfoHeader = ^TBitmapInfoHeader;
|
||
tagBITMAPINFOHEADER = packed record
|
||
biSize: DWORD;
|
||
biWidth: Longint;
|
||
biHeight: Longint;
|
||
biPlanes: Word;
|
||
biBitCount: Word;
|
||
biCompression: DWORD;
|
||
biSizeImage: DWORD;
|
||
biXPelsPerMeter: Longint;
|
||
biYPelsPerMeter: Longint;
|
||
biClrUsed: DWORD;
|
||
biClrImportant: DWORD;
|
||
end;
|
||
TBitmapInfoHeader = tagBITMAPINFOHEADER;
|
||
BITMAPINFOHEADER = tagBITMAPINFOHEADER;
|
||
|
||
PBitmapInfo = ^TBitmapInfo;
|
||
tagBITMAPINFO = packed record
|
||
bmiHeader: TBitmapInfoHeader;
|
||
bmiColors: array[0..0] of TRGBQuad;
|
||
end;
|
||
TBitmapInfo = tagBITMAPINFO;
|
||
BITMAPINFO = tagBITMAPINFO;
|
||
|
||
PBitmapFileHeader = ^TBitmapFileHeader;
|
||
tagBITMAPFILEHEADER = packed record
|
||
bfType: Word;
|
||
bfSize: DWORD;
|
||
bfReserved1: Word;
|
||
bfReserved2: Word;
|
||
bfOffBits: DWORD;
|
||
end;
|
||
TBitmapFileHeader = tagBITMAPFILEHEADER;
|
||
BITMAPFILEHEADER = tagBITMAPFILEHEADER;
|
||
|
||
tagDRAWITEMSTRUCT = packed record
|
||
CtlType: Cardinal;
|
||
CtlID: Cardinal;
|
||
itemID: Cardinal;
|
||
itemAction: Cardinal;
|
||
itemState: Cardinal;
|
||
hwndItem: QWidgetH;
|
||
hDC: QPainterH;
|
||
rcItem: TRect;
|
||
itemData: Cardinal;
|
||
end;
|
||
TDrawItemStruct = tagDRAWITEMSTRUCT;
|
||
DRAWITEMSTRUCT = tagDRAWITEMSTRUCT;
|
||
|
||
type
|
||
TDeviceCap = (
|
||
HORZSIZE, {Horizontal size in millimeters}
|
||
VERTSIZE, {Vertical size in millimeters}
|
||
HORZRES, {Horizontal width in pixels}
|
||
VERTRES, {Vertical height in pixels}
|
||
BITSPIXEL, {Number of bits per pixel}
|
||
PLANES, {Number of planes}
|
||
NUMCOLORS,
|
||
LOGPIXELSX, {Logical pixelsinch in X}
|
||
LOGPIXELSY, {Logical pixelsinch in Y}
|
||
PHYSICALWIDTH, {Physical Width in device units}
|
||
PHYSICALHEIGHT, {Physical Height in device units}
|
||
PHYSICALOFFSETX, {Physical Printable Area X margin}
|
||
PHYSICALOFFSETY {Physical Printable Area Y margin}
|
||
);
|
||
|
||
{ Mapping Modes }
|
||
TMapMode = (
|
||
MM_TEXT = 1,
|
||
MM_LOMETRIC = 2,
|
||
MM_HIMETRIC = 3,
|
||
MM_LOENGLISH = 4,
|
||
MM_HIENGLISH = 5,
|
||
MM_TWIPS = 6,
|
||
MM_ISOTROPIC = 7,
|
||
MM_ANISOTROPIC = 8
|
||
);
|
||
|
||
const
|
||
{ Min and Max Mapping Mode values }
|
||
MM_MIN = MM_TEXT;
|
||
MM_MAX = MM_ANISOTROPIC;
|
||
MM_MAX_FIXEDSCALE = MM_TWIPS;
|
||
|
||
type
|
||
TMinMaxInfo = packed record
|
||
ptReserved: TPoint;
|
||
ptMaxSize: TPoint;
|
||
ptMaxPosition: TPoint;
|
||
ptMinTrackSize: TPoint;
|
||
ptMaxTrackSize: TPoint;
|
||
end;
|
||
|
||
(*)
|
||
PPaintStruct = ^TPaintStruct;
|
||
tagPAINTSTRUCT = packed record
|
||
hdc: HDC;
|
||
fErase: BOOL;
|
||
rcPaint: TRect;
|
||
fRestore: BOOL;
|
||
fIncUpdate: BOOL;
|
||
rgbReserved: array[0..31] of Byte;
|
||
end;
|
||
TPaintStruct = tagPAINTSTRUCT;
|
||
PAINTSTRUCT = tagPAINTSTRUCT;
|
||
(*)
|
||
|
||
{ regions }
|
||
type
|
||
TCombineMode = (
|
||
RGN_AND, // Creates the intersection of the two combined regions.
|
||
RGN_COPY, // Creates a copy of the region identified by hrgnSrc1.
|
||
RGN_DIFF, // Combines the parts of hrgnSrc1 that are not part of hrgnSrc2.
|
||
RGN_OR, // Creates the union of two combined regions.
|
||
RGN_XOR // Creates the union of two combined regions except for any overlapping areas.
|
||
);
|
||
|
||
PSecurityAttributes = Pointer;
|
||
|
||
{ StretchBlt() Modes }
|
||
TStretchMode = (
|
||
BLACKONWHITE = 1,
|
||
WHITEONBLACK = 2,
|
||
COLORONCOLOR = 3,
|
||
HALFTONE = 4
|
||
);
|
||
|
||
const
|
||
MAXSTRETCHBLTMODE = 4;
|
||
STRETCH_ANDSCANS = BLACKONWHITE;
|
||
STRETCH_ORSCANS = WHITEONBLACK;
|
||
STRETCH_DELETESCANS = COLORONCOLOR;
|
||
STRETCH_HALFTONE = HALFTONE;
|
||
|
||
{ Stock Logical Objects }
|
||
type
|
||
TStockObjectBrush = (
|
||
WHITE_BRUSH = 0,
|
||
LTGRAY_BRUSH = 1,
|
||
GRAY_BRUSH = 2,
|
||
DKGRAY_BRUSH = 3,
|
||
BLACK_BRUSH = 4,
|
||
NULL_BRUSH = 5,
|
||
DC_BRUSH = 18
|
||
);
|
||
|
||
TStockObjectPen = (
|
||
WHITE_PEN = 6,
|
||
BLACK_PEN = 7,
|
||
NULL_PEN = 8,
|
||
DC_PEN = 19
|
||
);
|
||
|
||
TStockObjectFont = (
|
||
OEM_FIXED_FONT = 10,
|
||
ANSI_FIXED_FONT = 11,
|
||
ANSI_VAR_FONT = 12,
|
||
SYSTEM_FONT = 13,
|
||
DEVICE_DEFAULT_FONT = 14,
|
||
DEFAULT_PALETTE = 15,
|
||
SYSTEM_FIXED_FONT = $10,
|
||
DEFAULT_GUI_FONT = 17
|
||
);
|
||
|
||
const
|
||
HOLLOW_BRUSH = NULL_BRUSH;
|
||
STOCK_LAST = DC_PEN;
|
||
|
||
type
|
||
TSysMetrics = (
|
||
SM_CXSCREEN, SM_CYSCREEN,
|
||
SM_CXVSCROLL, SM_CYVSCROLL,
|
||
SM_CXHSCROLL, SM_CYHSCROLL,
|
||
SM_CXSMICON, SM_CYSMICON,
|
||
SM_CXICON, SM_CYICON,
|
||
SM_CXBORDER, SM_CYBORDER,
|
||
SM_CXFRAME, SM_CYFRAME,
|
||
SM_CYCAPTION, SM_CXDLGFRAME,
|
||
SM_CYDLGFRAME
|
||
);
|
||
|
||
{$IFDEF LINUX}
|
||
TSystemTime = record
|
||
wYear: Word;
|
||
wMonth: Word;
|
||
wDayOfWeek: Word;
|
||
wDay: Word;
|
||
wHour: Word;
|
||
wMinute: Word;
|
||
wSecond: Word;
|
||
wMilliseconds: Word;
|
||
end;
|
||
{$ENDIF LINUX}
|
||
|
||
{ threads }
|
||
type
|
||
TThreadPriority = Integer;
|
||
|
||
const
|
||
tpIdle: TThreadPriority = 0;
|
||
THREAD_PRIORITY_ERROR_RETURN = 255;
|
||
|
||
type { wait for object}
|
||
TWOHandleArray = array[0..MAXIMUM_WAIT_OBJECTS - 1] of THandle;
|
||
PWOHandleArray = ^TWOHandleArray;
|
||
|
||
TWindowPlacement = packed record
|
||
length: Cardinal;
|
||
flags: Integer;
|
||
showCmd: UInt;
|
||
ptMinPosition: TPoint;
|
||
ptMaxPosition: TPoint;
|
||
rcNormalPosition: TRect;
|
||
end;
|
||
PWindowPlacement = ^TWindowPlacement;
|
||
|
||
type
|
||
TTimerProc = procedure(Widget: QWidgetH; Msg: Cardinal; WMTimerId: Cardinal; TickCount: Cardinal);
|
||
TAppEventFilterMethod = function (Sender: QObjectH; Event: QEventH): Boolean; cdecl;
|
||
PAppEventFilterMethod = ^TAppEventFilterMethod;
|
||
|
||
function InstallApplicationEventHook(EventFilter: TEventFilterMethod): QApplication_hookH;
|
||
|
||
procedure WakeUpGuiThread;
|
||
{
|
||
Dummies for ... VCL
|
||
asn: AFAIK use of RightToLeft or LeftToRight is automatic
|
||
}
|
||
const
|
||
BiDiMode: TBiDiMode = bdLeftToRight; // asn: var?
|
||
|
||
function DrawTextBiDiModeFlagsReadingOnly: Longint;
|
||
function DrawTextBiDiModeFlags(Flags: Longint): Longint;
|
||
procedure ChangeBiDiModeAlignment(var Alignment: TAlignment);
|
||
function UseRightToLeftAlignment: Boolean;
|
||
|
||
{ Palette colors }
|
||
function GetSysColor(SysColor: Integer): TColorRef; // windows SysColor !!
|
||
function SetSysColor(RefColor: TColor; TrueColor: TColorRef): Boolean;
|
||
function SetSysColors(Elements: Integer; const lpaElements;
|
||
const lpaRgbValues): LongBool;
|
||
|
||
{
|
||
QGraphics.ColorToRGB supports only
|
||
TMappedColor = clActiveHighlightedText..clNormalForeground
|
||
Returns clBlack for any other color !
|
||
|
||
This implementation uses Instance.Palette and supports all colors
|
||
if Instance = nil then it will use Application.MainForm, in that
|
||
case clHighlightedText..clForeground is mapped to clNormalHighlightedText..clNormalForeground
|
||
If the Color is an RGB value, clDefault, clNone, it returns the Color itself.
|
||
}
|
||
function ColorToRGB(Color: TColor; Instance: TWidgetControl = nil): TColor;
|
||
|
||
function RGB(Red, Green, Blue: Integer): TColorRef;
|
||
function GetBValue(Col: TColorRef): Byte;
|
||
function GetGValue(Col: TColorRef): Byte;
|
||
function GetRValue(Col: TColorRef): Byte;
|
||
function pfDevice: TPixelFormat;
|
||
|
||
function SetRect(var R: TRect; Left, Top, Right, Bottom: Integer): LongBool;
|
||
function IsRectEmpty(R: TRect): LongBool;
|
||
function EqualRect(R1, R2: TRect): LongBool;
|
||
function UnionRect(var Dst: TRect; R1, R2: TRect): LongBool;
|
||
function CopyRect(var Dst: TRect; const Src: TRect): LongBool; overload;
|
||
function SubtractRect(var dR: TRect; const R1, R2: TRect): LongBool;
|
||
function CenterRect(InnerRect, OuterRect: TRect): TRect;
|
||
function PtInRect(const R: TRect; pt: TPoint): LongBool; overload;
|
||
function PtInRect(const R: TRect; X, Y: integer): LongBool; overload;
|
||
function IntersectRect(var R: TRect; const R1, R2: TRect): LongBool;
|
||
function PointInEllipse(pt: TPoint; BoundingRect: TRect): boolean;
|
||
function PtInEllipse(const R: TRect; pt: TPoint): LongBool;
|
||
|
||
{ brushes }
|
||
function CreateSolidBrush(Color: TColor): QBrushH;
|
||
function CreateHatchBrush(bStyle: BrushStyle; Color: TColor): QBrushH;
|
||
function DeleteObject(Handle: QBrushH): LongBool; overload;
|
||
|
||
function CreatePen(Style, Width: Integer; Color: TColor): QPenH;
|
||
function DeleteObject(Handle: QPenH): LongBool; overload;
|
||
|
||
function DPtoLP(Handle: QPainterH; var Points; Count: Integer): LongBool;
|
||
function LPtoDP(Handle: QPainterH; var Points; Count: Integer): LongBool;
|
||
function SetWindowOrgEx(Handle: QPainterH; X, Y: Integer; OldOrg: PPoint): LongBool;
|
||
function GetWindowOrgEx(Handle: QPainterH; Org: PPoint): LongBool; overload;
|
||
function GetWindowOrgEx(Handle: QPainterH; var Org: TPoint): LongBool; overload;
|
||
{ limited implementations of }
|
||
function BitBlt(DestDC: QPainterH; X, Y, Width, Height: Integer; SrcDC: QPainterH;
|
||
XSrc, YSrc: Integer; Rop: RasterOp; IgnoreMask: Boolean = true): LongBool; overload;
|
||
function BitBlt(DestDC: QPainterH; X, Y, Width, Height: Integer; SrcDC: QPainterH;
|
||
XSrc, YSrc: Integer; WinRop: Cardinal; IgnoreMask: Boolean = true): LongBool; overload;
|
||
{
|
||
does the required start/stop painting if needed
|
||
adjust x,y & XSrc,YSrc ico TControlCanvas (as used by TGraphicControl)
|
||
}
|
||
function BitBlt(DestCanvas: TCanvas; X, Y, Width, Height: Integer; SrcCanvas: TCanvas;
|
||
XSrc, YSrc: Integer; WinRop: Cardinal; IgnoreMask: Boolean = true): LongBool; overload;
|
||
|
||
{
|
||
// Calculates coord of TopLeft in Paintdevice coordinates
|
||
// ((0,0) for bitmaps and TWidgetControl derived classes)
|
||
}
|
||
function PainterOffset(Canvas: TCanvas): TPoint;
|
||
|
||
function PatBlt(Handle: QPainterH; X, Y, Width, Height: Integer;
|
||
WinRop: Cardinal): LongBool; overload;
|
||
function PatBlt(Canvas: TCanvas; X, Y, Width, Height: Integer;
|
||
WinRop: Cardinal): LongBool; overload;
|
||
|
||
procedure CopyRect(DstCanvas: TCanvas; const Dest: TRect; Canvas: TCanvas;
|
||
const Source: TRect); overload;
|
||
procedure BrushCopy(DstCanvas: TCanvas; const Dest: TRect; Bitmap: TBitmap;
|
||
const Source: TRect; Color: TColor);
|
||
|
||
function StretchBlt(DestDC: QPainterH; dx, dy, dw, dh: Integer;
|
||
SrcDC: QPainterH; sx, sy, sw, sh: Integer; WinRop: Cardinal;
|
||
IgnoreMask: Boolean = True): LongBool; overload;
|
||
function StretchBlt(DestDC: QPainterH; dx, dy, dw, dh: Integer;
|
||
SrcDC: QPainterH; sx, sy, sw, sh: Integer; Rop: RasterOp;
|
||
IgnoreMask: Boolean = True): LongBool; overload;
|
||
function StretchBlt(DestCanvas: TCanvas; dx, dy, dw, dh: Integer;
|
||
SrcCanvas: TCanvas; sx, sy, sw, sh: Integer; WinRop: Cardinal;
|
||
IgnoreMask: Boolean = True): LongBool; overload;
|
||
function ScrollDC(Handle: QPainterH; dx, dy: Integer; var Scroll, Clip: TRect;
|
||
Rgn: QRegionH; Update: PRect): LongBool;
|
||
|
||
{ TODO -oahuser : StretchBlt function should use the flag }
|
||
function GetStretchBltMode(DC: QPainterH): TStretchMode;
|
||
function SetStretchBltMode(DC: QPainterH; StretchMode: TStretchMode): TStretchMode;
|
||
|
||
function SetROP2(Handle: QPainterH; Rop: Integer): Integer; overload;
|
||
function GetROP2(Handle: QPainterH): Integer; overload;
|
||
function GetPixel(Handle: QPainterH; X, Y: Integer): TColorRef;
|
||
function SetPixel(Handle: QPainterH; X, Y: Integer; Color: TColor): TColorRef;
|
||
function SetTextColor(Handle: QPainterH; color: TColor): TColorRef;
|
||
function SetBkColor(Handle: QPainterH; color: TColor): TColorRef;
|
||
function GetBkMode(Handle: QPainterH): Integer;
|
||
function SetBkMode(Handle: QPainterH; BkMode: Integer): Integer;
|
||
function SetDCBrushColor(Handle: QPainterH; Color: TColor): TColorRef;
|
||
function SetDCPenColor(Handle: QPainterH; Color: TColor): TColorRef;
|
||
function SetPenColor(Handle: QPainterH; Color: TColor): TColorRef;
|
||
procedure SetPainterFont(Handle: QPainterH; Font: TFont);
|
||
|
||
function CreateCompatibleDC(Handle: QPainterH; Width: Integer = 1; Height: Integer = 1): QPainterH;
|
||
function CreateCompatibleBitmap(Handle: QPainterH; Width, Height: Integer): QPixmapH;
|
||
function CreateBitmap(Width, Height: Integer; Planes, BitCount: Longint; Bits: Pointer): QPixmapH;
|
||
function CreateDIBitmap(Handle: QPainterH; var InfoHeader: TBitmapInfoHeader;
|
||
dwUsage: Longword; InitBits: PChar; var InitInfo: TBitmapInfo; wUsage: Cardinal): QPixmapH;
|
||
|
||
function GetBitmapBits(Bitmap: QPixmapH; Count: Longint; Bits: Pointer): Longint;
|
||
function SetBitmapBits(Bitmap: QPixmapH; Count: Longint; Bits: Pointer): Longint;
|
||
|
||
function GetObject(Handle: QPixmapH; Size: Cardinal; Data: PtagBITMAP): Boolean; overload;
|
||
function GetObject(Handle: QPenH; Size: Cardinal; Data: PLogPen): Boolean; overload;
|
||
|
||
function GetStockObject(fnObject: TStockObjectBrush): QBrushH; overload;
|
||
function GetStockObject(fnObject: TStockObjectPen): QPenH; overload;
|
||
function GetStockObject(fnObject: TStockObjectFont): QFontH; overload;
|
||
|
||
function GetMapMode(Handle: QPainterH): TMapMode;
|
||
function SetMapMode(Handle: QPainterH; MapMode: TMapMode): TMapMode;
|
||
|
||
// DeleteObject is intended to destroy the Handle returned by CreateCompatibleBitmap
|
||
// (it destroys the Painter AND PaintDevice)
|
||
function DeleteObject(Handle: QPainterH): LongBool; overload;
|
||
function DeleteObject(Handle: QPixmapH): LongBool; overload;
|
||
function GetDC(Handle: QWidgetH): QPainterH; overload;
|
||
function GetDC(Handle: Integer): QPainterH; overload;
|
||
function GetWindowDC(Handle: QWidgetH): QPainterH;
|
||
|
||
function ReleaseDC(wdgtH: QWidgetH; Handle: QPainterH): Integer; overload;
|
||
function ReleaseDC(wdgtH: Integer; Handle: QPainterH): Integer; overload;
|
||
function DeleteDC(Handle: QPainterH): LongBool;
|
||
|
||
function SaveDC(Handle: QPainterH): Integer;
|
||
{ only negative and zero values of nSaveDC are supported }
|
||
function RestoreDC(Handle: QPainterH; nSavedDC: Integer): LongBool;
|
||
|
||
function ExtTextOut(Handle: QPainterH; X, Y: Integer; WinFlags: Cardinal;
|
||
R: PRect; const Text: WideString; Len: Integer; lpDx: Pointer): LongBool; overload;
|
||
function ExtTextOut(Handle: QPainterH; X, Y: Integer; WinFlags: Cardinal;
|
||
R: PRect; pText: PChar; Len: Integer; lpDx: Pointer): LongBool; overload;
|
||
function ExtTextOutW(Handle: QPainterH; X, Y: Integer; WinFlags: Cardinal;
|
||
R: PRect; pText: PWideChar; Len: Integer; lpDx: Pointer): LongBool;
|
||
|
||
{ TODO -oahuser : text functions (ExtTextOut, TextOut) should use these flags }
|
||
function SetTextAlign(Handle: QPainterH; Mode: Cardinal): Cardinal;
|
||
function GetTextAlign(Handle: QPainterH): Cardinal;
|
||
|
||
function FillRect(Handle: QPainterH; const R: TRect; Brush: QBrushH): LongBool;
|
||
|
||
function GetCurrentPositionEx(Handle: QPainterH; pos: PPoint): LongBool;
|
||
function GetTextExtentPoint32(Handle: QPainterH; const Text: WideString; Len: Integer;
|
||
var Size: TSize): LongBool; overload;
|
||
function GetTextExtentPoint32(Handle: QPainterH; pText: PChar; Len: Integer;
|
||
var Size: TSize): LongBool; overload;
|
||
function GetTextExtentPoint32W(Handle: QPainterH; pText: PWideChar; Len: Integer;
|
||
var Size: TSize): LongBool;
|
||
function GetTextExtentPoint32(Canvas: TCanvas; const Text: WideString; Len: Integer;
|
||
var Size: TSize): LongBool; overload;
|
||
|
||
function FrameRect(Handle: QPainterH; const R: TRect; Brush: QBrushH): LongBool; overload;
|
||
procedure FrameRect(Canvas: TCanvas; const R: TRect); overload;
|
||
function FrameRgn(Handle: QPainterH; Region: QRegionH; Brush: QBrushH; Width, Height: integer): LongBool;
|
||
|
||
function DrawFocusRect(Handle: QPainterH; const R: TRect): LongBool;
|
||
function InvertRect(Handle: QPainterH; const R: TRect): LongBool;
|
||
function Rectangle(Handle: QPainterH; Left, Top, Right, Bottom: Integer): LongBool;
|
||
function RoundRect(Handle: QPainterH; Left, Top, Right, Bottom, X3, Y3: Integer): LongBool;
|
||
function Ellipse(Handle: QPainterH; Left, Top, Right, Bottom: Integer): LongBool;
|
||
function LineTo(Handle: QPainterH; X, Y: Integer): LongBool;
|
||
function MoveToEx(Handle: QPainterH; X, Y: Integer; Point: PPoint): LongBool;
|
||
function DrawIcon(Handle: QPainterH; X, Y: Integer; hIcon: QPixmapH): LongBool;
|
||
function DrawIconEx(Handle: QPainterH; X, Y: Integer; hIcon: QPixmapH;
|
||
W, H: Integer; istepIfAniCur: Integer; hbrFlickerFreeDraw: QBrushH;
|
||
diFlags: Cardinal): LongBool;
|
||
|
||
function DrawFrameControl(Handle: QPainterH; const Rect: TRect; uType,
|
||
uState: Longword): LongBool; overload;
|
||
{ missing DrawFrameControl flags:
|
||
DFC_SCROLL: DFCS_SCROLLSIZEGRIP, DFCS_SCROLLSIZEGRIPRIGHT
|
||
DFC_BUTTON: DFCS_BUTTONRADIOIMAGE, DFCS_BUTTONRADIOMASK, DFCS_BUTTON3STATE
|
||
DFC_POPUPMENU: all }
|
||
function DrawFrameControl(Canvas: TCanvas; const Rect: TRect; uType,
|
||
uState: Longword): LongBool; overload;
|
||
function DrawEdge(Handle: QPainterH; var Rect: TRect; Edge: Cardinal;
|
||
Flags: Cardinal): LongBool;
|
||
|
||
procedure RequiredState(ACanvas: TCanvas; State: TCanvasState);
|
||
|
||
{ limited implementation of }
|
||
function DrawText2(Handle: QPainterH; var Text: WideString; Len: Integer;
|
||
var R: TRect; WinFlags: Integer): Integer; overload;
|
||
function DrawText(Handle: QPainterH; Text: PAnsiChar; Len: Integer;
|
||
var R: TRect; WinFlags: Integer; Angle: Integer = 0): Integer; overload;
|
||
function DrawText(Handle: QPainterH; Text: TCaption; Len: Integer;
|
||
var R: TRect; WinFlags: Integer; Angle: Integer = 0): Integer; overload;
|
||
function DrawTextW(Handle: QPainterH; Text: PWideChar; Len: Integer;
|
||
var R: TRect; WinFlags: Integer; Angle: Integer = 0): Integer; overload;
|
||
function DrawText(Handle: QPainterH; var Text: WideString; Len: Integer;
|
||
x,y, w, h: Integer; WinFlags: Integer; Angle: Integer = 0): Integer; overload;
|
||
function DrawText(Handle: QPainterH; var Text: WideString; Len: Integer;
|
||
var R: TRect; WinFlags: Integer; Angle: Integer = 0): Integer; overload;
|
||
{
|
||
additional functionality DrawText(Canvas, .....
|
||
- canvas start/stop
|
||
- sets painterfont
|
||
}
|
||
function DrawText(Canvas :TCanvas; Text: TCaption; Len: Integer;
|
||
var R: TRect; WinFlags: Integer; Angle: integer = 0): Integer; overload;
|
||
function DrawText(Canvas: TCanvas; Text: PAnsiChar; Len: Integer;
|
||
var R: TRect; WinFlags: Integer; Angle: Integer = 0): Integer; overload;
|
||
function DrawTextW(Canvas :TCanvas; Text: PWideChar; Len: Integer;
|
||
var R: TRect; WinFlags: Integer; Angle: Integer = 0): Integer; overload;
|
||
function DrawTextEx(Handle: QPainterH; var Text: WideString; Len: Integer;
|
||
var R: TRect; WinFlags: Integer; DTParams: Pointer): Integer; overload;
|
||
function DrawTextEx(Handle: QPainterH; Text: PChar; Len: Integer;
|
||
var R: TRect; WinFlags: Integer; DTParams: Pointer): Integer; overload;
|
||
|
||
{ limited implementation of }
|
||
function GetSystemMetrics(PropItem: TSysMetrics): Integer;
|
||
|
||
{ (very) limited implementations of }
|
||
function GetDeviceCaps(Handle: QPainterH; devcap: TDeviceCap): Integer; overload;
|
||
function GetDeviceCaps(Handle: QPaintDeviceH; devcap: TDeviceCap): Integer; overload;
|
||
|
||
function GetTextMetrics(Handle: QPainterH; var tt: TTextMetric): Integer;
|
||
// widget related function
|
||
function BringWindowToTop(Handle: QWidgetH): LongBool;
|
||
function CloseWindow(Handle: QWidgetH): LongBool;
|
||
function DestroyWindow(Handle: QWidgetH): LongBool;
|
||
function EnableWindow(Handle: QWidgetH; Value: Boolean): LongBool;
|
||
function GetClientRect(Handle: QWidgetH; var R: TRect): LongBool;
|
||
function GetFocus: QWidgetH;
|
||
function GetParent(Handle: QWidgetH): QWidgetH;
|
||
function SetParent(hWndChild, hWndNewParent: QWidgetH): QWidgetH;
|
||
function GetWindowPlacement(Handle: QWidgetH; W: PWindowPlacement): LongBool;
|
||
function GetWindowRect(Handle: QWidgetH; var R: TRect): LongBool;
|
||
function WindowFromDC(Handle: QPainterH): QWidgetH; overload;
|
||
function WindowFromDC(Handle: QPaintDeviceH): QWidgetH; overload;
|
||
|
||
{ hWndParent is ignored under Linux }
|
||
function ChildWindowFromPoint(hWndParent: QWidgetH; Point: TPoint): QWidgetH;
|
||
|
||
function WindowFromPoint(Point: TPoint): QWidgetH;
|
||
function FindCLXWindow(const Point: TPoint): TWidgetControl;
|
||
function FindVCLWindow(const Point: TPoint): TWidgetControl;
|
||
function GetClassName(Handle: QWidgetH; Buffer: PChar; MaxCount: Integer): Integer;
|
||
function IsIconic(Handle: QWidgetH): LongBool;
|
||
|
||
function HWND_DESKTOP: QWidgetH;
|
||
function GetDesktopWindow: QWidgetH;
|
||
function GetActiveWindow: QWidgetH;
|
||
function GetForegroundWindow: QWidgetH;
|
||
procedure SetActiveWindow(Handle: QWidgetH);
|
||
function InvalidateRect(Handle: QWidgetH; R: PRect; EraseBackground: Boolean): LongBool;
|
||
function ValidateRect(hWnd: QWidgetH; R: PRect): LongBool;
|
||
function UpdateWindow(Handle: QWidgetH): LongBool;
|
||
function IsChild(ParentHandle, ChildHandle: QWidgetH): LongBool;
|
||
function IsWindowEnabled(Handle: QWidgetH): LongBool;
|
||
function IsWindowVisible(Handle: QWidgetH): LongBool;
|
||
function MapWindowPoints(WidgetTo, WidgetFrom: QWidgetH; var Points; nr: Cardinal): Integer;
|
||
function SetFocus(Handle: QWidgetH): QWidgetH;
|
||
function SetForegroundWindow(Handle: QWidgetH): LongBool;
|
||
function SetWindowPlacement(Handle: QWidgetH; W: PWindowPlacement): LongBool;
|
||
function SwitchToThisWindow(Handle: QWidgetH; Restore: Boolean): LongBool;
|
||
|
||
function ClientToScreen(Handle: QWidgetH; var Point: TPoint): LongBool;
|
||
function ScreenToClient(Handle: QWidgetH; var Point: TPoint): LongBool;
|
||
function SmallPointToPoint(const P: TSmallPoint): TPoint;
|
||
function PointToSmallPoint(const P: TPoint): TSmallPoint;
|
||
|
||
function SetWindowPos(Wnd, WndInsertAfter: QWidgetH; X, Y, cx, cy: Integer;
|
||
uFlags: Longword): LongBool; overload;
|
||
function SetWindowPos(Wnd, WndInsertAfter: Cardinal; X, Y, cx, cy: Integer;
|
||
uFlags: Longword): LongBool; overload;
|
||
function SetWindowPos(Wnd: QWidgetH; WndInsertAfter: Cardinal; X, Y, cx, cy: Integer;
|
||
uFlags: Longword): LongBool; overload;
|
||
|
||
{ Controls.pas implements, so we need it, too }
|
||
procedure MoveWindowOrg(DC: QPainterH; DX, DY: Integer);
|
||
|
||
function ShowWindow(Handle: QWidgetH; showCmd: UInt): LongBool;
|
||
|
||
function MessageBox(parent: QWidgetH; Text, Caption: string; WinFlags: Cardinal): Integer; overload;
|
||
function MessageBox(parent: QWidgetH; Text, Caption: WideString; WinFlags: Cardinal): Integer; overload;
|
||
function MessageBox(parent: QWidgetH; pText, pCaption: PChar; WinFlags: Cardinal): Integer; overload;
|
||
//function MessageBoxW(parent: QWidgetH; pText, pCaption: PWideChar; WinFlags: Cardinal): Integer;
|
||
|
||
function SelectObject(Handle: QPainterH; Font: QFontH): QFontH; overload;
|
||
function SelectObject(Handle: QPainterH; Brush: QBrushH): QBrushH; overload;
|
||
function SelectObject(Handle: QPainterH; Pen: QPenH): QPenH; overload;
|
||
// limited to CreateCompatibleDC Handles.
|
||
function SelectObject(Handle: QPainterH; Bitmap: QPixmapH): QPixmapH; overload;
|
||
|
||
function CombineRgn(DestRgn, Source1, Source2: QRegionH; Operation: TCombineMode): Integer;
|
||
function CreateEllipticRgn(Left, Top, Right, Bottom: Integer): QRegionH;
|
||
function CreateEllipticRgnIndirect(Rect: TRect): QRegionH;
|
||
//function CreatePolygonRgn(p1: TPointArray; FillMode: Integer): QRegionH;
|
||
function CreatePolygonRgn(const Points; Count, FillMode: Integer): QRegionH;
|
||
function CreateRectRgn(Left, Top, Right, Bottom: Integer): QRegionH;
|
||
function CreateRectRgnIndirect(Rect: TRect): QRegionH;
|
||
function CreateRoundRectRgn(x1, y1, x2, y2, WidthEllipse, HeightEllipse: Integer): QRegionH;
|
||
function DeleteObject(Region: QRegionH): LongBool; overload;
|
||
function EqualRgn(Rgn1, Rgn2: QRegionH): LongBool;
|
||
function FillRgn(Handle: QPainterH; Region: QRegionH; Brush: QBrushH): LongBool;
|
||
function GetClipRgn(Handle: QPainterH; rgn: QRegionH): Integer;
|
||
function ExcludeClipRect(Handle: QPainterH; X1, Y1, X2, Y2: Integer): Integer; overload;
|
||
function ExcludeClipRect(Handle: QPainterH; const R: TRect): Integer; overload;
|
||
function IntersectClipRect(Handle: QPainterH; X1, Y1, X2, Y2: Integer): Integer; overload;
|
||
function IntersectClipRect(Handle: QPainterH; const R: TRect): Integer; overload;
|
||
function InvertRgn(Handle: QPainterH; Region: QRegionH): LongBool;
|
||
function OffsetClipRgn(Handle: QPainterH; X, Y: Integer): Integer;
|
||
function OffsetRgn(Region: QRegionH; X, Y: Integer): Integer;
|
||
function PtInRegion(Rgn: QRegionH; X, Y: Integer): Boolean;
|
||
function RectInRegion(RGN: QRegionH; const Rect: TRect): LongBool;
|
||
function SelectClipRgn(Handle: QPainterH; Region: QRegionH): Integer; overload;
|
||
function SelectClipRgn(Handle: QPainterH; Region: Integer): Integer; overload;
|
||
function SetRectRgn(Rgn: QRegionH; X1, Y1, X2, Y2: Integer): LongBool;
|
||
function SetWindowRgn(Handle: QWidgetH; Region: QRegionH; Redraw: LongBool): Integer;
|
||
{ SetWindowRgn limitation: The region must have negative top coordinate in
|
||
order to contain the window's caption bar. }
|
||
{ asn: Qt operates on the client rectangle of the form: windows/x11 titlebar
|
||
and windows/x11 borders are not included, hence the negative values }
|
||
function GetWindowRgn(Handle: QWidgetH; Region: QRegionH): Integer;
|
||
|
||
{ viewports }
|
||
function SetViewportExtEx(Handle: QPainterH; XExt, YExt: Integer; Size: PSize): LongBool;
|
||
function SetViewPortOrgEx(Handle: QPainterH; X, Y: Integer; OldOrg: PPoint): LongBool;
|
||
function GetViewportExtEx(Handle: QPainterH; Size: PSize): LongBool;
|
||
|
||
{ Text clipping }
|
||
function TruncatePath(const FilePath: string; Canvas: TCanvas; MaxLen: Integer): string;
|
||
function TruncateName(const Name: WideString; Canvas: TCanvas; MaxLen: Integer; QtFlags: integer = 0): WideString;
|
||
|
||
procedure TextOutAngle(Handle: QPainterH; Angle, Left, Top: Integer; Text: WideString); overload;
|
||
procedure TextOutAngle(ACanvas: TCanvas; Angle, Left, Top: Integer; Text: WideString); overload;
|
||
|
||
procedure CopyMemory(Dest: Pointer; Src: Pointer; Len: Cardinal);
|
||
procedure FillMemory(Dest: Pointer; Len: Cardinal; Fill: Byte);
|
||
procedure MoveMemory(Dest: Pointer; Src: Pointer; Len: Cardinal);
|
||
procedure ZeroMemory(Dest: Pointer; Len: Cardinal);
|
||
|
||
{ ------------ Caret -------------- }
|
||
function CreateCaret(Widget: QWidgetH; Pixmap: QPixmapH; Width, Height: Integer): Boolean; overload;
|
||
function CreateCaret(Widget: QWidgetH; ColorCaret: Cardinal; Width, Height: Integer): Boolean; overload;
|
||
function GetCaretBlinkTime: Cardinal;
|
||
function SetCaretBlinkTime(uMSeconds: Cardinal): LongBool;
|
||
function HideCaret(Widget: QWidgetH): Boolean;
|
||
function ShowCaret(Widget: QWidgetH): Boolean;
|
||
function SetCaretPos(X, Y: Integer): Boolean;
|
||
function GetCaretPos(var Pt: TPoint): Boolean;
|
||
function DestroyCaret: Boolean;
|
||
|
||
procedure SetCursorPos(X, Y: integer);
|
||
function GetCursorPos(var P: TPoint): LongBool;
|
||
|
||
function GetDoubleClickTime: Cardinal;
|
||
function SetDoubleClickTime(Interval: Cardinal): LongBool;
|
||
function ReleaseCapture: LongBool;
|
||
function SetCapture(Widget: QWidgetH): QWidgetH;
|
||
function GetCapture: QWidgetH;
|
||
function SetCursor(Handle: QCursorH; Save: Boolean = False): QCursorH;
|
||
function Win2QtAlign(Flags: Integer): Integer;
|
||
function QtStdAlign(Flags: Integer): Word;
|
||
|
||
function IsCharAlpha(Ch: Char): LongBool;
|
||
function IsCharAlphaNumeric(Ch: Char): LongBool;
|
||
|
||
{ Messaging }
|
||
function Perform(Control: TControl; Msg: Cardinal; WPar, LPar: Longint): Longint;
|
||
function PostMessage(Receiver: QWidgetH; MsgId: Integer; WPar, LPar: Longint): LongBool; overload;
|
||
function PostMessage(AControl: TWidgetControl; MsgId: Integer; WPar, LPar: Longint): LongBool; overload;
|
||
{ SendMessage synchronizes with the main (event handling) thread. }
|
||
function SendMessage(Receiver: QWidgetH; MsgId: Integer; WPar, LPar: Longint): Integer; overload;
|
||
function SendMessage(AControl: TWidgetControl; MsgId: Integer; WPar, LPar: Longint): Integer; overload;
|
||
|
||
// procedure IgnoreNextEvents(Handle: QObjectH; const Events: array of QEventType);
|
||
{ equivalent to "while PeekMessage(h, evstart, evend, PM_REMOVE" }
|
||
//procedure IgnoreMouseEvents(Handle: QObjectH);
|
||
function IgnoreMouseEvents(Handle: QObjectH; Event: QEventH): boolean;
|
||
|
||
function SetTimer(Wnd: QWidgetH; WMTimerID, Elapse: Cardinal;
|
||
TimerFunc: TTimerProc): Cardinal; overload;
|
||
function SetTimer(Instance: TWidgetControl; WMTimerID, Elapse: Cardinal;
|
||
TimerFunc: TTimerProc): Cardinal; overload;
|
||
function KillTimer(Wnd: QWidgetH; WMTimerId: Cardinal): LongBool; overload;
|
||
function KillTimer(Instance: TWidgetControl; WMTimerId: Cardinal): LongBool; overload;
|
||
|
||
function MAKEIPRANGE(low, high: Byte): integer;
|
||
function MAKEIPADDRESS(b1, b2, b3, b4: cardinal): integer;
|
||
function FIRST_IPADDRESS(x: cardinal): cardinal;
|
||
function SECOND_IPADDRESS(x: cardinal): cardinal;
|
||
function THIRD_IPADDRESS(x: cardinal): cardinal;
|
||
function FOURTH_IPADDRESS(x: cardinal): cardinal;
|
||
|
||
{ wrappers for Windows, implementations for Linux}
|
||
function ShellExecute(Handle: QWidgetH; Operation, FileName, Parameters,
|
||
Directory: PChar; ShowCmd: Integer): THandle; overload;
|
||
function ShellExecute(Handle: QWidgetH; const Operation, FileName, Parameters,
|
||
Directory: string; ShowCmd: Integer): THandle; overload;
|
||
function ShellExecute(Handle: Integer; Operation, FileName, Parameters,
|
||
Directory: PChar; ShowCmd: Integer): THandle; overload;
|
||
|
||
{ Platform dependendant wrappers}
|
||
function GetTickCount: Cardinal;
|
||
function GetUserName(Buffer: PChar; var Size: Cardinal): LongBool;
|
||
function GetComputerName(Buffer: PChar; var Size: Cardinal): LongBool;
|
||
procedure OutputDebugString(lpOutputString: PAnsiChar); overload;
|
||
procedure OutputDebugString(OutputString: AnsiString); overload;
|
||
function InterlockedIncrement(var I: Integer): Integer;
|
||
function InterlockedDecrement(var I: Integer): Integer;
|
||
function InterlockedExchange(var A: Integer; B: Integer): Integer;
|
||
function InterlockedExchangeAdd(var A: Integer; B: Integer): Integer;
|
||
function QueryPerformanceCounter(var PerformanceCount: int64): LongBool;
|
||
function QueryPerformanceFrequency(var Frequency: int64): LongBool;
|
||
|
||
{$IFDEF MSWINDOWS}
|
||
function GetKeyState(nVirtKey: Integer): SmallInt;
|
||
//
|
||
// Taken from QDialogs
|
||
//
|
||
procedure EnableTaskWindows(WindowList: Pointer);
|
||
function DisableTaskWindows(ActiveWindow: Windows.HWnd): Pointer;
|
||
{$ENDIF MSWINDOWS}
|
||
|
||
function CopyFile(lpExistingFileName, lpNewFileName: PChar;
|
||
bFailIfExists: LongBool): LongBool; overload;
|
||
|
||
function CopyFileA(lpExistingFileName, lpNewFileName: PAnsiChar;
|
||
bFailIfExists: LongBool): LongBool;
|
||
function CopyFileW(lpExistingFileName, lpNewFileName: PWideChar;
|
||
bFailIfExists: LongBool): LongBool;
|
||
{$IFDEF LINUX}
|
||
function CopyFile(const Source, Destination: string;
|
||
FailIfExists: Boolean): LongBool; overload;
|
||
|
||
function FileGetSize(const FileName: string): Cardinal;
|
||
function FileGetAttr(const FileName: string): Integer;
|
||
function FileGetTime(const FileName: string): Integer;
|
||
function MakeIntResource(Value: Integer): PChar;
|
||
function MakeWord(A, B: Byte): Word;
|
||
function MakeLong(A, B: Word): Longint;
|
||
function HiWord(L: DWORD): Word;
|
||
function HiByte(W: Word): Byte;
|
||
|
||
procedure GetLocalTime(var st: TSystemTime);
|
||
|
||
procedure MessageBeep(Value: Integer); // value ignored
|
||
|
||
function CoCreateGUID(out Guid: TGUID): HResult;
|
||
|
||
function Succeeded(Res: HResult): Boolean;
|
||
function Failed(Res: HResult): Boolean;
|
||
function ResultCode(Res: HResult): Integer;
|
||
|
||
function GetCurrentProcess: THandle;
|
||
|
||
function TerminateThread(ThreadID: TThreadID; RetVal: Integer): LongBool;
|
||
{
|
||
NOTE:
|
||
The Windows API's SuspendThread & ResumeThread are functions.
|
||
With QWindows / Linux these are procedures
|
||
}
|
||
function SuspendThread(ThreadID: TThreadID): LongBool;
|
||
function ResumeThread(ThreadID: TThreadID): LongBool;
|
||
function GetThreadPolicy(ThreadID: TThreadID): Integer;
|
||
procedure SetThreadPolicy(ThreadID: TThreadID; value: Integer);
|
||
function GetThreadPriority(ThreadID: TThreadID): Integer;
|
||
function SetThreadPriority(ThreadID: TThreadID; priority: Integer): LongBool;
|
||
|
||
function VirtualProtect(lpAddress: Pointer; dwSize, flNewProtect: Cardinal;
|
||
lpflOldProtect: Pointer): LongBool; overload;
|
||
function VirtualProtect(lpAddress: Pointer; dwSize, flNewProtect: Cardinal;
|
||
var OldProtect: Cardinal): LongBool; overload;
|
||
|
||
function ReadProcessMemory(hProcess: THandle; const lpBaseAddress: Pointer;
|
||
lpBuffer: Pointer; nSize: LongWord; var lpNumberOfBytesRead: Longword): LongBool;
|
||
function WriteProcessMemory(hProcess: THandle; const lpBaseAddress: Pointer;
|
||
lpBuffer: Pointer; nSize: LongWord; var lpNumberOfBytesWritten: Longword): LongBool;
|
||
procedure FlushInstructionCache(PID: cardinal; OrgCalProc: Pointer; size: Integer);
|
||
|
||
{ Limitations:
|
||
- GetKeyState calls GetAsyncKeyState
|
||
- GetAsyncKeyState only supports VK_SHIFT, VK_CONTROL and VK_MENU }
|
||
function GetKeyState(nVirtKey: Integer): SmallInt;
|
||
function GetAsyncKeyState(vKey: Integer): SmallInt;
|
||
|
||
// events are limited to the process
|
||
function CreateEvent(EventAttributes: PSecurityAttributes;
|
||
ManualReset, InitialState: LongBool; Name: PChar): THandle;
|
||
function OpenEvent(DesiredAccess: Longword; InheritHandle: LongBool;
|
||
Name: PChar): THandle;
|
||
{$ENDIF LINUX}
|
||
function SetEvent(Event: THandle): LongBool;
|
||
function ResetEvent(Event: THandle): LongBool;
|
||
function PulseEvent(Event: THandle): LongBool; // calls SetEvent()
|
||
|
||
{$IFDEF LINUX}
|
||
function CreateMutex(MutexAttributes: PSecurityAttributes; InitialOwner: LongBool;
|
||
Name: PChar): THandle;
|
||
function OpenMutex(DesiredAccess: Longword; InheritHandle: Boolean;
|
||
Name: PChar): THandle;
|
||
function ReleaseMutex(Mutex: THandle): LongBool;
|
||
|
||
function CreateSemaphore(SemaphoreAttributes: PSecurityAttributes;
|
||
InitialCount, MaximumCount: Longint; Name: PChar): THandle;
|
||
function OpenSemaphore(DesiredAccess: Longword; InheritHandle: LongBool;
|
||
Name: PChar): THandle;
|
||
function ReleaseSemaphore(Semaphore: THandle; ReleaseCount: Longint;
|
||
PreviousCount: PInteger): LongBool;
|
||
|
||
function semtimedop(semid: Integer; sops: PSemaphoreBuffer;
|
||
nsops: size_t; timeout: PTimeSpec): Integer; {$IFDEF DEBUG}cdecl;{$ENDIF}
|
||
|
||
function WaitForSingleObject(Handle: THandle; Milliseconds: Cardinal): Cardinal;
|
||
|
||
{ Operate on semaphore. }
|
||
|
||
function WaitForMultipleObjects(Count: Cardinal; Handles: PWOHandleArray;
|
||
WaitAll: LongBool; Milliseconds: Cardinal): Cardinal;
|
||
|
||
{ all Handles are TObject derived classes }
|
||
|
||
function CloseHandle(hObject: THandle): LongBool;
|
||
|
||
{ memory management }
|
||
function GlobalAllocPtr(Flags: Integer; Bytes: Longint): Pointer;
|
||
function GlobalReAllocPtr(P: Pointer; Bytes: Longint; Flags: Integer): Pointer;
|
||
function GlobalFreePtr(P: Pointer): THandle;
|
||
|
||
function GlobalAlloc(uFlags: Cardinal; dwBytes: Longword): Cardinal;
|
||
function GlobalReAlloc(hMem: Cardinal; dwBytes: Longword; uFlags: Cardinal): Cardinal;
|
||
function GlobalSize(hMem: Cardinal): Longword;
|
||
function GlobalLock(hMem: Cardinal): Pointer;
|
||
function GlobalHandle(Mem: Pointer): Cardinal;
|
||
function GlobalUnlock(hMem: Cardinal): LongBool;
|
||
function GlobalFree(hMem: Cardinal): Cardinal;
|
||
{$ENDIF LINUX}
|
||
|
||
|
||
{$IFDEF LINUX}
|
||
var
|
||
Shell: string = 'kfmclient exec'; // KDE. Gnome equivalent ?
|
||
IpcDirectory: string = '/tmp/kylix/ipc'; // for named semaphores/mutex
|
||
{$ENDIF LINUX}
|
||
|
||
implementation
|
||
|
||
{$IFDEF MSWINDOWS}
|
||
uses
|
||
ShellAPI, DateUtils;
|
||
{$ENDIF MSWINDOWS}
|
||
{$IFDEF LINUX}
|
||
uses
|
||
Xlib;
|
||
{$ENDIF LINUX}
|
||
|
||
const
|
||
VersionInfo = '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/branches/JVCL3_36_PREPARATION/archive/QWindows.pas $' + #13 + '$Revision: 11641 $' + #13 + '$Date: 2007-12-24 17:34:00 +0100 (lun., 24 déc. 2007) $' + #13;
|
||
|
||
type
|
||
THackCanvas = class(TCanvas);
|
||
TOpenWidgetControl = class(TWidgetControl);
|
||
|
||
var
|
||
AppEventHook: TAppEventHook = nil;
|
||
|
||
procedure AppEventHookNeeded;
|
||
begin
|
||
if not Assigned(AppEventHook) then
|
||
AppEventHook := TAppEventHook.Create(nil);
|
||
end;
|
||
{ used internally }
|
||
|
||
procedure MapPainterLP(Handle: QPainterH; var x, y: Integer); overload;
|
||
begin
|
||
QWMatrix_map(QPainter_worldMatrix(Handle), x, y, @x, @y);
|
||
end;
|
||
|
||
procedure MapPainterLP(Handle: QPainterH; var x0, y0, x1, y1: Integer); overload;
|
||
var
|
||
Matrix: QWMatrixH;
|
||
begin
|
||
Matrix := QPainter_worldMatrix(Handle);
|
||
QWMatrix_map(Matrix, x0, y0, @x0, @y0);
|
||
QWMatrix_map(Matrix, x1, y1, @x1, @y1);
|
||
end;
|
||
|
||
procedure MapPainterLP(Handle: QPainterH; var Pt: TPoint); overload;
|
||
begin
|
||
QWMatrix_map(QPainter_worldMatrix(Handle), PPoint(@Pt), PPoint(@Pt));
|
||
end;
|
||
|
||
procedure MapPainterLP(Handle: QPainterH; var R: TRect); overload;
|
||
begin
|
||
QWMatrix_map(QPainter_worldMatrix(Handle), PRect(@R), PRect(@R));
|
||
end;
|
||
|
||
procedure MapPainterLPwh(Handle: QPainterH; var Width, Height: Integer); overload;
|
||
var
|
||
Matrix: QWMatrixH;
|
||
begin
|
||
Matrix := QPainter_worldMatrix(Handle);
|
||
|
||
Matrix := QWMatrix_create(QWMatrix_m11(Matrix), QWMatrix_m12(Matrix),
|
||
QWMatrix_m21(Matrix), QWMatrix_m22(Matrix), 0, 0); // no translation
|
||
try
|
||
QWMatrix_map(Matrix, Width, Height, @Width, @Height);
|
||
finally
|
||
QWMatrix_destroy(Matrix);
|
||
end;
|
||
end;
|
||
|
||
function CreateMappedRegion(Handle: QPainterH; Region: QRegionH): QRegionH;
|
||
var
|
||
Matrix, RelativeMatrix: QWMatrixH;
|
||
Bmp1, Bmp2: QBitmapH;
|
||
Painter: QPainterH;
|
||
R, FillR: TRect;
|
||
Brush: QBrushH;
|
||
begin
|
||
Result := QRegion_create(Region);
|
||
Matrix := QPainter_worldMatrix(Handle);
|
||
|
||
if (QWMatrix_m11(Matrix) = 1) and (QWMatrix_m12(Matrix) = 0) and
|
||
(QWMatrix_m21(Matrix) = 0) and (QWMatrix_m22(Matrix) = 1) then
|
||
begin
|
||
if (QWMatrix_dx(Matrix) <> 0) or (QWMatrix_dy(Matrix) <> 0) then
|
||
QRegion_translate(Result, Round(QWMatrix_dx(Matrix)), Round(QWMatrix_dy(Matrix)));
|
||
end
|
||
else
|
||
begin
|
||
RelativeMatrix := QWMatrix_create(
|
||
QWMatrix_m11(Matrix), QWMatrix_m12(Matrix),
|
||
QWMatrix_m21(Matrix), QWMatrix_m22(Matrix),
|
||
0, 0
|
||
);
|
||
QRegion_boundingRect(Result, @R);
|
||
QRegion_translate(Result, -R.Left, -R.Top);
|
||
|
||
Bmp1 := QBitmap_create(Abs(R.Right - R.Left), Abs(R.Bottom - R.Top), True,
|
||
QPixmapOptimization_DefaultOptim);
|
||
try
|
||
FillR := R;
|
||
OffsetRect(FillR, -R.Left, -R.Top);
|
||
|
||
Painter := QPainter_create(Bmp1);
|
||
try
|
||
QPainter_setClipRegion(Painter, Result);
|
||
QPainter_setClipping(Painter, True);
|
||
|
||
Brush := GetStockObject(BLACK_BRUSH);
|
||
QPainter_fillRect(Painter, @FillR, Brush);
|
||
DeleteObject(Brush);
|
||
finally
|
||
QPainter_destroy(Painter);
|
||
end;
|
||
QRegion_destroy(Result);
|
||
|
||
QWMatrix_map(RelativeMatrix, PRect(@R), PRect(@R));
|
||
|
||
Bmp2 := QBitmap_create(Abs(R.Right - R.Left), Abs(R.Bottom - R.Top), False,
|
||
QPixmapOptimization_DefaultOptim);
|
||
try
|
||
QPixmap_xForm(Bmp1, Bmp2, RelativeMatrix);
|
||
Result := QRegion_create(Bmp2);
|
||
finally
|
||
QBitmap_destroy(Bmp2);
|
||
end;
|
||
finally
|
||
QBitmap_destroy(Bmp1);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
{---------------------------------------}
|
||
type
|
||
PPainterInfo = ^TPainterInfo;
|
||
TPainterInfo = record
|
||
Painter: QPainterH;
|
||
IsCompatibleDC: Boolean;
|
||
TextAlignment: Cardinal;
|
||
StetchBltMode: TStretchMode;
|
||
MapMode: TMapMode;
|
||
end;
|
||
|
||
var
|
||
PainterInfos: TList = nil;
|
||
|
||
function GetPainterInfo(Handle: QPainterH; var Info: PPainterInfo): Boolean;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
Result := False;
|
||
Info := nil;
|
||
if PainterInfos <> nil then
|
||
begin
|
||
for i := 0 to PainterInfos.Count - 1 do
|
||
if PPainterInfo(PainterInfos[i])^.Painter = Handle then
|
||
begin
|
||
Result := True;
|
||
Info := PPainterInfo(PainterInfos[i]);
|
||
Exit;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function NewPainterInfo(Handle: QPainterH): PPainterInfo;
|
||
begin
|
||
New(Result);
|
||
Result^.Painter := Handle;
|
||
Result^.IsCompatibleDC := False;
|
||
Result^.TextAlignment := TA_LEFT or TA_TOP;
|
||
Result^.StetchBltMode := STRETCH_DELETESCANS;
|
||
Result^.MapMode := MM_TEXT;
|
||
|
||
if PainterInfos = nil then
|
||
PainterInfos := TList.Create;
|
||
PainterInfos.Add(Result);
|
||
end;
|
||
|
||
function SetPainterInfo(Handle: QPainterH): PPainterInfo;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
Result := nil;
|
||
if PainterInfos <> nil then
|
||
begin
|
||
for i := 0 to PainterInfos.Count - 1 do
|
||
if PPainterInfo(PainterInfos[i])^.Painter = Handle then
|
||
begin
|
||
Result := PPainterInfo(PainterInfos[i]);
|
||
Exit;
|
||
end;
|
||
end;
|
||
if Result = nil then
|
||
Result := NewPainterInfo(Handle);
|
||
end;
|
||
|
||
procedure DeletePainterInfo(Handle: QPainterH);
|
||
var
|
||
P: PPainterInfo;
|
||
begin
|
||
if PainterInfos <> nil then
|
||
begin
|
||
if GetPainterInfo(Handle, P) then
|
||
begin
|
||
PainterInfos.Delete(PainterInfos.IndexOf(P));
|
||
Dispose(P);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure FreePainterInfos;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
if PainterInfos <> nil then
|
||
begin
|
||
for i := 0 to PainterInfos.Count - 1 do
|
||
Dispose(PPainterInfo(PainterInfos[i]));
|
||
PainterInfos.Free;
|
||
end;
|
||
end;
|
||
{----------------------------------------}
|
||
|
||
procedure WakeUpGuiThread;
|
||
begin
|
||
QApplication_wakeUpGuiThread(Application.Handle);
|
||
end;
|
||
|
||
function DrawTextBiDiModeFlagsReadingOnly: Longint;
|
||
begin
|
||
Result := 0;
|
||
end;
|
||
|
||
function DrawTextBiDiModeFlags(Flags: Longint): Longint;
|
||
begin
|
||
Result := Flags;
|
||
end;
|
||
|
||
procedure ChangeBiDiModeAlignment(var Alignment: TAlignment);
|
||
begin
|
||
end;
|
||
|
||
function UseRightToLeftAlignment: Boolean;
|
||
begin
|
||
Result := False;
|
||
end;
|
||
|
||
function GetSysColor(SysColor: Integer): TColorRef;
|
||
// VCL / windows colors
|
||
begin
|
||
if (SysColor >= 0) and (SysColor <= COLOR_ENDCOLORS) then
|
||
SysColor := GetSysColor( Win2TColor[SysColor] );
|
||
case SysColor of
|
||
clInfoBk:
|
||
Result := TColorRef(Application.HintColor);
|
||
clDeskTop:
|
||
Result := TColorRef(QColorColor(QWidget_BackgroundColor(QApplication_desktop)));
|
||
else
|
||
Result := TColorRef(Application.Palette.GetColor(SysColor));
|
||
end;
|
||
end;
|
||
|
||
const
|
||
ColorRoles: array[1..15] of TColorRole =(
|
||
crForeground, crButton, crLight, crMidlight, crDark, crMid,
|
||
crText, crBrightText, crButtonText, crBase, crBackground, crShadow,
|
||
crHighlight, crHighlightText, crNoRole);
|
||
|
||
function SetSysColor(RefColor: TColor; TrueColor: TColorRef): Boolean;
|
||
begin
|
||
with Application.Palette do // asn: positive values or only rgb values?
|
||
if TrueColor >= TColor(0) then
|
||
begin
|
||
Result := True;
|
||
case RefColor of
|
||
clNormalNoRole..clNormalForeground:
|
||
SetColor(cgInactive, ColorRoles[-(RefColor+cloNormal)], TrueColor);
|
||
clDisabledHighlightedText..clDisabledForeground:
|
||
SetColor(cgDisabled, ColorRoles[-(RefColor+cloDisabled)], TrueColor);
|
||
clActiveNoRole..clActiveForeground:
|
||
SetColor(cgActive, ColorRoles[-(RefColor+cloActive)], TrueColor);
|
||
else
|
||
Result := False
|
||
end;
|
||
end
|
||
else // if
|
||
Result := False; // only rgb values are accepted (asn: see remark above)
|
||
|
||
end;
|
||
|
||
function SetSysColors(Elements: Integer; const lpaElements;
|
||
const lpaRgbValues): LongBool;
|
||
var
|
||
i: Integer;
|
||
refcolor : PColor;
|
||
realcolor : PColor;
|
||
begin
|
||
Result := True;
|
||
refcolor := PColor(lpaElements);
|
||
realcolor := PColor(lpaRGBvalues);
|
||
Application.Palette.BeginUpdate;
|
||
try
|
||
for i := 0 to Elements-1 do
|
||
begin
|
||
if not SetSysColor( refcolor^, realcolor^)
|
||
then
|
||
Result := False;
|
||
inc(refcolor);
|
||
inc(realcolor);
|
||
end;
|
||
finally
|
||
Application.Palette.EndUpdate;
|
||
end;
|
||
end;
|
||
|
||
type
|
||
TStockObjectResource = class(TObject)
|
||
private
|
||
FStockObject: Integer;
|
||
FHandle: Pointer;
|
||
FRefCount: Integer;
|
||
public
|
||
constructor Create(AHandle: Pointer; AStockObject: Integer);
|
||
destructor Destroy; override;
|
||
function AddRef: Pointer;
|
||
procedure Release;
|
||
|
||
property Handle: Pointer read FHandle;
|
||
property StockObject: Integer read FStockObject;
|
||
end;
|
||
|
||
TStockObjectList = class(TObjectList)
|
||
public
|
||
function FindStockObject(AStockObject: Integer): TStockObjectResource;
|
||
class function ReleaseStockObject(AHandle: Pointer): Boolean;
|
||
end;
|
||
|
||
var
|
||
StockObjectList: TStockObjectList = nil;
|
||
StockObjectListCritSect: TRTLCriticalSection;
|
||
|
||
constructor TStockObjectResource.Create(AHandle: Pointer; AStockObject: Integer);
|
||
begin
|
||
inherited Create;
|
||
AddRef;
|
||
FHandle := AHandle;
|
||
FStockObject := AStockObject;
|
||
end;
|
||
|
||
destructor TStockObjectResource.Destroy;
|
||
type
|
||
Int = Integer;
|
||
begin
|
||
case StockObject of
|
||
Int(WHITE_BRUSH)..Int(NULL_BRUSH), Int(DC_BRUSH):
|
||
QBrush_destroy(QBrushH(Handle));
|
||
Int(WHITE_PEN)..Int(NULL_PEN), Int(DC_PEN):
|
||
QPen_destroy(QPenH(Handle));
|
||
Int(OEM_FIXED_FONT)..Int(DEVICE_DEFAULT_FONT), Int(SYSTEM_FIXED_FONT), Int(DEFAULT_GUI_FONT):
|
||
QFont_destroy(QFontH(Handle));
|
||
end;
|
||
StockObjectList.Extract(Self);
|
||
inherited Destroy;
|
||
end;
|
||
|
||
function TStockObjectResource.AddRef: Pointer;
|
||
begin
|
||
Inc(FRefCount);
|
||
Result := Handle;
|
||
end;
|
||
|
||
procedure TStockObjectResource.Release;
|
||
begin
|
||
Dec(FRefCount);
|
||
if FRefCount = 0 then
|
||
Free;
|
||
end;
|
||
|
||
function TStockObjectList.FindStockObject(AStockObject: Integer): TStockObjectResource;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
for i := 0 to Count - 1 do
|
||
begin
|
||
Result := TStockObjectResource(Items[i]);
|
||
if Result.StockObject = AStockObject then
|
||
Exit;
|
||
end;
|
||
Result := nil;
|
||
end;
|
||
|
||
class function TStockObjectList.ReleaseStockObject(AHandle: Pointer): Boolean;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
EnterCriticalSection(StockObjectListCritSect);
|
||
try
|
||
if Assigned(StockObjectList) then
|
||
begin
|
||
for i := 0 to StockObjectList.Count - 1 do
|
||
if TStockObjectResource(StockObjectList.Items[i]).Handle = AHandle then
|
||
begin
|
||
TStockObjectResource(StockObjectList.Items[i]).Release;
|
||
Result := True;
|
||
Exit;
|
||
end;
|
||
end;
|
||
Result := False;
|
||
finally
|
||
LeaveCriticalSection(StockObjectListCritSect);
|
||
end;
|
||
end;
|
||
|
||
function GetStockObject(fnObject: Integer): Pointer; overload;
|
||
const
|
||
BrushColors: array[WHITE_BRUSH..BLACK_BRUSH] of TColor =
|
||
(clWhite, clLtGray, clGray, clDkGray, clBlack);
|
||
{$IFDEF MSWINDOWS}
|
||
SystemFont: WideString = 'System';
|
||
GuiFont: array[Boolean] of WideString = ('MS Sans Serife', 'Tahoma');
|
||
{$ENDIF MSWINDOWS}
|
||
{$IFDEF LINUX}
|
||
SystemFont: WideString = 'Fixed'; // asn: is not always True
|
||
// GuiFont: array[Boolean] of WideString = ('Verdana', 'Verdana');
|
||
//asn: in JVCL units Helvetica is used. Why introduce another?
|
||
GuiFont: array[Boolean] of WideString = ('Helvetica', 'Helvetica');
|
||
{$ENDIF LINUX}
|
||
type
|
||
Int = Integer;
|
||
var
|
||
Resource: TStockObjectResource;
|
||
GuiFontSelector: Boolean;
|
||
begin
|
||
{$IFDEF MSWINDOWS}
|
||
GuiFontSelector := Win32MajorVersion >= 5;
|
||
{$ELSE}
|
||
GuiFontSelector := True;
|
||
{$ENDIF MSWINDOWS}
|
||
EnterCriticalSection(StockObjectListCritSect);
|
||
try
|
||
if not Assigned(StockObjectList) then
|
||
StockObjectList := TStockObjectList.Create;
|
||
Resource := StockObjectList.FindStockObject(fnObject);
|
||
if Resource <> nil then
|
||
Result := Resource.AddRef
|
||
else
|
||
begin
|
||
case fnObject of
|
||
Int(WHITE_BRUSH)..Int(BLACK_BRUSH):
|
||
Result := CreateSolidBrush(BrushColors[TStockObjectBrush(fnObject)]);
|
||
Int(NULL_BRUSH):
|
||
Result := QBrush_create(BrushStyle_NoBrush);
|
||
Int(DC_BRUSH):
|
||
Result := CreateSolidBrush(clWhite);
|
||
Int(WHITE_PEN):
|
||
Result := CreatePen(PS_SOLID, 1, clWhite);
|
||
Int(BLACK_PEN):
|
||
Result := CreatePen(PS_SOLID, 1, clBlack);
|
||
Int(NULL_PEN):
|
||
Result := CreatePen(PS_NULL, 1, clWhite);
|
||
Int(DC_PEN):
|
||
Result := CreatePen(PS_SOLID, 1, clWhite);
|
||
Int(OEM_FIXED_FONT), Int(ANSI_FIXED_FONT), Int(SYSTEM_FONT), Int(SYSTEM_FIXED_FONT):
|
||
Result := QFont_create(@SystemFont, 8, 1, False);
|
||
Int(ANSI_VAR_FONT), Int(DEVICE_DEFAULT_FONT), Int(DEFAULT_GUI_FONT):
|
||
Result := QFont_create(@GuiFont[GuiFontSelector], 8, 1, False);
|
||
else
|
||
Result := nil;
|
||
end;
|
||
if Result <> nil then
|
||
StockObjectList.Add(TStockObjectResource.Create(Result, fnObject));
|
||
end;
|
||
finally
|
||
LeaveCriticalSection(StockObjectListCritSect);
|
||
end;
|
||
end;
|
||
|
||
function GetStockObject(fnObject: TStockObjectBrush): QBrushH;
|
||
begin
|
||
Result := QBrushH(GetStockObject(Integer(fnObject)));
|
||
end;
|
||
|
||
function GetStockObject(fnObject: TStockObjectPen): QPenH;
|
||
begin
|
||
Result := QPenH(GetStockObject(Integer(fnObject)));
|
||
end;
|
||
|
||
function GetStockObject(fnObject: TStockObjectFont): QFontH;
|
||
begin
|
||
Result := QFontH(GetStockObject(Integer(fnObject)));
|
||
end;
|
||
|
||
function GetMapMode(Handle: QPainterH): TMapMode;
|
||
var
|
||
P: PPainterInfo;
|
||
begin
|
||
if GetPainterInfo(Handle, P) then
|
||
Result := P.MapMode
|
||
else
|
||
Result := MM_TEXT;
|
||
end;
|
||
|
||
function SetMapMode(Handle: QPainterH; MapMode: TMapMode): TMapMode;
|
||
var
|
||
Matrix: QWMatrixH;
|
||
dpi: TSize;
|
||
m11, m22: Double;
|
||
dx, dy: Double;
|
||
|
||
procedure SetM(const Am11, Am22: Double);
|
||
begin
|
||
m11 := Am11;
|
||
m22 := Am22;
|
||
end;
|
||
|
||
begin
|
||
dpi.cx := GetDeviceCaps(Handle, LOGPIXELSX);
|
||
dpi.cy := GetDeviceCaps(Handle, LOGPIXELSY);
|
||
|
||
Result := GetMapMode(Handle);
|
||
case MapMode of
|
||
MM_TEXT:
|
||
SetM(1, 1);
|
||
|
||
MM_LOMETRIC:
|
||
SetM((dpi.cx / 2.54) / 100, -(dpi.cy / 2.54) / 100);
|
||
MM_HIMETRIC:
|
||
SetM((dpi.cx / 2.54) / 1000, -(dpi.cy / 2.54) / 1000);
|
||
|
||
MM_LOENGLISH:
|
||
SetM(dpi.cx / 10, -dpi.cy / 10);
|
||
MM_HIENGLISH:
|
||
SetM(dpi.cx / 100, -dpi.cy / 100);
|
||
|
||
MM_TWIPS:
|
||
SetM(dpi.cx / 1440, -dpi.cy / 1440);
|
||
|
||
MM_ISOTROPIC:
|
||
|
||
end;
|
||
// translate matrix
|
||
if QPainter_hasWorldXForm(Handle) then
|
||
begin
|
||
dx := QWMatrix_dx(QPainter_worldMatrix(Handle));
|
||
dy := QWMatrix_dy(QPainter_worldMatrix(Handle));
|
||
end
|
||
else
|
||
begin
|
||
dx := 0;
|
||
dy := 0;
|
||
end;
|
||
Matrix := QWMatrix_create(m11, 0, 0, m22, dx, dy);
|
||
QPainter_setWorldMatrix(Handle, Matrix, False);
|
||
QWMatrix_destroy(Matrix);
|
||
SetPainterInfo(Handle).MapMode := MapMode;
|
||
end;
|
||
|
||
function CreatePen(Style, Width: Integer; Color: TColor): QPenH;
|
||
var
|
||
QC: QColorH;
|
||
begin
|
||
QC := QColor(Color);
|
||
Result := QPen_create(QC, Width, PenStyle(Style));
|
||
QColor_destroy(QC);
|
||
end;
|
||
|
||
function DeleteObject(Handle: QPenH): LongBool;
|
||
begin
|
||
try
|
||
// if not TStockObjectList.ReleaseStockObject(Handle) then
|
||
QPen_destroy(Handle);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function CreateSolidBrush(Color: TColor): QBrushH;
|
||
var
|
||
QC: QColorH;
|
||
begin
|
||
QC := QColor(Color);
|
||
Result := QBrush_create(QC, BrushStyle_SolidPattern);
|
||
QColor_destroy(QC);
|
||
end;
|
||
|
||
function CreateHatchBrush(bStyle: BrushStyle; Color: TColor): QBrushH;
|
||
var
|
||
QC: QColorH;
|
||
begin
|
||
QC := QColor(Color);
|
||
Result := QBrush_create(QC, bStyle);
|
||
QColor_destroy(QC);
|
||
end;
|
||
|
||
function DeleteObject(Handle: QBrushH): LongBool;
|
||
begin
|
||
Result := False;
|
||
if Handle <> nil then
|
||
begin
|
||
try
|
||
// if not TStockObjectList.ReleaseStockObject(Handle) then
|
||
QBrush_destroy(Handle);
|
||
Result := True;
|
||
except
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function EnableWindow(Handle: QWidgetH; Value: Boolean): LongBool;
|
||
begin
|
||
try
|
||
QWidget_setEnabled(Handle, Value);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function SetWindowPlacement(Handle: QWidgetH; W: PWindowPlacement): LongBool;
|
||
begin
|
||
try
|
||
Result := ShowWindow(Handle, W.ShowCmd);
|
||
with W.rcNormalPosition do
|
||
QWidget_setGeometry(Handle, Left, Top, Right - Left, Bottom - Top);
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function GetWindowPlacement(Handle: QWidgetH; W: PWindowPlacement): LongBool;
|
||
var
|
||
R: TRect;
|
||
begin
|
||
try
|
||
QWidget_geometry(Handle, @R);
|
||
W.rcNormalPosition.Left := R.Left;
|
||
W.rcNormalPosition.Top := R.Top;
|
||
W.rcNormalPosition.Right := R.Right;
|
||
W.rcNormalPosition.Bottom := R.Bottom;
|
||
if QWidget_isMinimized(Handle) then
|
||
W.showCmd := SW_SHOWMINIMIZED
|
||
else if QWidget_isMaximized(Handle) then
|
||
W.showCmd := SW_SHOWMAXIMIZED
|
||
else if not QWidget_isVisible(Handle) then
|
||
W.showCmd := SW_HIDE
|
||
else
|
||
W.showCmd := SW_SHOWNORMAL;
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function GetWindowRect(Handle: QWidgetH; var R: TRect): LongBool;
|
||
begin
|
||
try
|
||
QWidget_frameGeometry(Handle, @R);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function GetClientRect(Handle: QWidgetH; var R: TRect): LongBool;
|
||
begin
|
||
try
|
||
QWidget_rect(Handle, @R);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function ShowWindow(Handle: QWidgetH; showCmd: UInt): LongBool;
|
||
var
|
||
ActWidget: QWidgetH;
|
||
begin
|
||
try
|
||
case ShowCmd of
|
||
SW_MINIMIZE, SW_SHOWMINIMIZED:
|
||
QWidget_showMinimized(Handle);
|
||
SW_MAXIMIZE:
|
||
QWidget_showMaximized(Handle);
|
||
SW_HIDE:
|
||
QWidget_hide(Handle);
|
||
SW_SHOWNOACTIVATE, SW_SHOWMINNOACTIVE:
|
||
begin
|
||
ActWidget := QApplication_activeWindow(Application.Handle);
|
||
if ShowCmd = SW_SHOWNOACTIVATE then
|
||
QWidget_showNormal(Handle)
|
||
else
|
||
QWidget_showMinimized(Handle);
|
||
if Assigned(ActWidget) then
|
||
QWidget_setActiveWindow(ActWidget);
|
||
end;
|
||
else
|
||
QWidget_showNormal(Handle);
|
||
end;
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
type
|
||
THackedWidgetControl = class(TWidgetControl);
|
||
|
||
function SetWindowPos(Wnd, WndInsertAfter: QWidgetH; X, Y, cx, cy: Integer;
|
||
uFlags: Longword): LongBool;
|
||
var
|
||
R, Geometry: TRect;
|
||
WidgetFlags: Cardinal;
|
||
Control: THackedWidgetControl;
|
||
LastActiveWidget: QWidgetH;
|
||
LastActiveWinId: Cardinal;
|
||
begin
|
||
Result := False;
|
||
if Wnd = nil then
|
||
Exit;
|
||
try
|
||
LastActiveWidget := QApplication_activeWindow(Application.Handle);
|
||
if LastActiveWidget <> nil then
|
||
LastActiveWinId := QWidget_winId(LastActiveWidget)
|
||
else
|
||
LastActiveWinId := 0;
|
||
|
||
// we must use CLX methods or CLX will be a pain.
|
||
Control := THackedWidgetControl(FindControl(Wnd));
|
||
|
||
if Control <> nil then
|
||
Geometry := Control.BoundsRect
|
||
else
|
||
QWidget_geometry(Wnd, @Geometry);
|
||
|
||
if uFlags and SWP_HIDEWINDOW <> 0 then
|
||
begin
|
||
if Control <> nil then
|
||
Control.Hide
|
||
else
|
||
QWidget_hide(Wnd);
|
||
end;
|
||
|
||
if uFlags and SWP_NOSIZE <> 0 then
|
||
begin
|
||
cx := Geometry.Right - Geometry.Left;
|
||
cy := Geometry.Bottom - Geometry.Top;
|
||
end;
|
||
if uFlags and SWP_NOMOVE <> 0 then
|
||
begin
|
||
X := Geometry.Left;
|
||
Y := Geometry.Top;
|
||
end;
|
||
R := Rect(X, Y, X + cx, Y + cy);
|
||
if not EqualRect(R, Geometry) then
|
||
begin
|
||
if Control <> nil then
|
||
Control.BoundsRect := R
|
||
else
|
||
QWidget_setGeometry(Wnd, X, Y, cx, cy);
|
||
end;
|
||
|
||
if uFlags and SWP_FRAMECHANGED <> 0 then
|
||
begin
|
||
QWidget_adjustSize(Wnd);
|
||
if Control <> nil then
|
||
Control.AdjustSize;
|
||
end;
|
||
|
||
if (uFlags and SWP_NOOWNERZORDER = 0) and (uFlags and SWP_NOZORDER = 0) and
|
||
(Cardinal(WndInsertAfter) <> HWND_TOP) and (Cardinal(WndInsertAfter) <> HWND_BOTTOM) and
|
||
(Cardinal(WndInsertAfter) <> HWND_TOPMOST) then
|
||
if (not QWidget_isTopLevel(Wnd)) and (QWidget_parentWidget(Wnd) <> nil) then
|
||
SetWindowPos(QWidget_parentWidget(Wnd), WndInsertAfter, 0, 0, 0, 0,
|
||
SWP_NOSIZE or SWP_NOMOVE or SWP_NOREDRAW or SWP_NOACTIVATE or
|
||
SWP_NOCOPYBITS or SWP_NOSENDCHANGING);
|
||
|
||
if (uFlags and SWP_NOZORDER = 0) then
|
||
begin
|
||
WidgetFlags := QOpenWidget_getWFlags(QOpenWidgetH(Wnd));
|
||
|
||
case Cardinal(WndInsertAfter) of
|
||
HWND_TOP:
|
||
QWidget_raise(Wnd);
|
||
HWND_BOTTOM:
|
||
QWidget_lower(Wnd);
|
||
HWND_TOPMOST:
|
||
if (Control <> nil) and (TWidgetControl(Control) is TForm) then
|
||
TForm(Control).FormStyle := fsStayOnTop
|
||
else
|
||
QOpenWidget_setWFlags(QOpenWidgetH(Wnd),
|
||
WidgetFlags or Cardinal(WidgetFlags_WStyle_StaysOnTop));
|
||
HWND_NOTOPMOST:
|
||
if (Control <> nil) and (TWidgetControl(Control) is TForm) then
|
||
TForm(Control).FormStyle := fsNormal
|
||
else
|
||
QOpenWidget_setWFlags(QOpenWidgetH(Wnd),
|
||
WidgetFlags and not Cardinal(WidgetFlags_WStyle_StaysOnTop));
|
||
else
|
||
// remove top most state
|
||
if WidgetFlags and Cardinal(WidgetFlags_WStyle_StaysOnTop) <> 0 then
|
||
begin
|
||
if (Control <> nil) and (TWidgetControl(Control) is TForm) then
|
||
TForm(Control).FormStyle := fsNormal
|
||
else
|
||
QOpenWidget_setWFlags(QOpenWidgetH(Wnd),
|
||
WidgetFlags and not Cardinal(WidgetFlags_WStyle_StaysOnTop));
|
||
end;
|
||
// after widget
|
||
QWidget_stackUnder(Wnd, WndInsertAfter);
|
||
end;
|
||
end;
|
||
|
||
if uFlags and SWP_SHOWWINDOW <> 0 then
|
||
begin
|
||
if Control <> nil then
|
||
Control.Show
|
||
else
|
||
QWidget_show(Wnd);
|
||
end;
|
||
|
||
if (uFlags and SWP_NOACTIVATE = 0) and (QWidget_isVisible(Wnd)) then
|
||
QWidget_setActiveWindow(Wnd);
|
||
|
||
if (uFlags and SWP_NOREDRAW = 0) and (QWidget_isVisible(Wnd)) then
|
||
QWidget_update(Wnd);
|
||
|
||
if (uFlags and SWP_NOACTIVATE <> 0) and Assigned(LastActiveWidget) then
|
||
if QWidget_find(LastActiveWinId) = LastActiveWidget then // valid LastActiveWidget
|
||
QWidget_setActiveWindow(LastActiveWidget);
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function SetWindowPos(Wnd, WndInsertAfter: Cardinal; X, Y, cx, cy: Integer;
|
||
uFlags: Longword): LongBool;
|
||
begin
|
||
Result := SetWindowPos(QWidgetH(Wnd), QWidgetH(WndInsertAfter), X, Y, cx, cy, uFlags);
|
||
end;
|
||
|
||
function SetWindowPos(Wnd: QWidgetH; WndInsertAfter: Cardinal; X, Y, cx, cy: Integer;
|
||
uFlags: Longword): LongBool;
|
||
begin
|
||
Result := SetWindowPos(Wnd, QWidgetH(WndInsertAfter), X, Y, cx, cy, uFlags);
|
||
end;
|
||
|
||
procedure MoveWindowOrg(DC: QPainterH; DX, DY: Integer);
|
||
var
|
||
P: TPoint;
|
||
begin
|
||
GetWindowOrgEx(DC, P);
|
||
SetWindowOrgEx(DC, P.X - DX, P.Y - DY, nil);
|
||
end;
|
||
|
||
function IsWindowVisible(Handle: QWidgetH): LongBool;
|
||
begin
|
||
Result := QWidget_isVisible(Handle);
|
||
end;
|
||
|
||
function IsWindowEnabled(Handle: QWidgetH): LongBool;
|
||
begin
|
||
Result := QWidget_isEnabled(Handle);
|
||
end;
|
||
|
||
function SetFocus(Handle: QWidgetH): QWidgetH;
|
||
begin
|
||
try
|
||
Result := GetFocus;
|
||
QWidget_setFocus(Handle);
|
||
except
|
||
Result := nil;
|
||
end;
|
||
end;
|
||
|
||
function GetFocus: QWidgetH;
|
||
begin
|
||
Result := QApplication_focusWidget(Application.Handle);
|
||
end;
|
||
|
||
function GetBkMode(Handle: QPainterH): Integer;
|
||
begin
|
||
case QPainter_BackgroundMode(Handle) of
|
||
BGMode_TransparentMode:
|
||
Result := TRANSPARENT; // BGMode_TransparentMode
|
||
BGMode_OpaqueMode:
|
||
Result := OPAQUE; // BGMode_OpaqueMode
|
||
else
|
||
Result := OPAQUE;
|
||
end;
|
||
end;
|
||
|
||
function SetBkMode(Handle: QPainterH; BkMode: Integer): Integer;
|
||
begin
|
||
Result := GetBkMode(Handle);
|
||
case BkMode of
|
||
TRANSPARENT:
|
||
QPainter_setBackgroundMode(Handle, BGMode_TransparentMode);
|
||
OPAQUE:
|
||
QPainter_setBackgroundMode(Handle, BGMode_OpaqueMode);
|
||
end;
|
||
end;
|
||
|
||
function SetPenColor(Handle: QPainterH; Color: TColor): TColorRef;
|
||
var
|
||
QC: QColorH;
|
||
begin
|
||
Result := QColorColor(QPen_color(QPainter_pen(Handle)));
|
||
QC := QColor(Color);
|
||
QPainter_setPen(Handle, QC);
|
||
QColor_destroy(QC);
|
||
end;
|
||
|
||
function SetTextColor(Handle: QPainterH; Color: TColor): TColorRef;
|
||
begin
|
||
Result := SetPenColor(Handle, Color);
|
||
end;
|
||
|
||
function SetBkColor(Handle: QPainterH; Color: TColor): TColorRef;
|
||
var
|
||
QC: QColorH;
|
||
begin
|
||
Result := QColorColor(QPainter_backgroundColor(Handle));
|
||
QC := QColor(Color);
|
||
QPainter_setBackgroundColor(Handle, QC);
|
||
QColor_destroy(QC);
|
||
end;
|
||
|
||
function SetDCBrushColor(Handle: QPainterH; Color: TColor): TColorRef;
|
||
var
|
||
QC: QColorH;
|
||
begin
|
||
Result := QColorColor(QBrush_color(QPainter_brush(Handle)));
|
||
QC := QColor(Color);
|
||
QPainter_setBrush(Handle, QC);
|
||
QColor_destroy(QC);
|
||
end;
|
||
|
||
function SetDCPenColor(Handle: QPainterH; Color: TColor): TColorRef;
|
||
begin
|
||
Result := SetPenColor(Handle, Color);
|
||
end;
|
||
|
||
procedure SetPainterFont(Handle: QPainterH; Font: QGraphics.TFont);
|
||
begin
|
||
QPainter_setFont(Handle, Font.Handle);
|
||
QPainter_setPen(Handle, Font.FontPen);
|
||
end;
|
||
|
||
function GetParent(Handle: QWidgetH): QWidgetH;
|
||
begin
|
||
Result := QWidget_parentWidget(Handle);
|
||
end;
|
||
|
||
function SetParent(hWndChild, hWndNewParent: QWidgetH): QWidgetH;
|
||
var
|
||
Pt: TPoint;
|
||
begin
|
||
try
|
||
Result := GetParent(hWndChild);
|
||
QWidget_pos(hWndChild, @Pt);
|
||
QWidget_reparent(hWndChild, hWndNewParent, @Pt, QWidget_isVisible(hWndChild));
|
||
except
|
||
Result := nil;
|
||
end;
|
||
end;
|
||
|
||
function RasterOpToWinRop(Rop: RasterOp): cardinal;
|
||
begin
|
||
case Rop of
|
||
RasterOp_ClearROP : Result := BLACKNESS;
|
||
RasterOp_NotROP : Result := DSTINVERT;
|
||
RasterOp_NotOrRop : Result := MERGEPAINT;
|
||
RasterOp_NotCopyROP : Result := NOTSRCCOPY;
|
||
RasterOp_NorROP : Result := NOTSRCERASE;
|
||
RasterOp_AndROP : Result := SRCAND;
|
||
RasterOp_CopyROP : Result := SRCCOPY;
|
||
RasterOp_AndNotROP : Result := SRCERASE;
|
||
RasterOp_XorROP : Result := SRCINVERT;
|
||
RasterOp_OrROP : Result := SRCPAINT;
|
||
RasterOp_SetROP : Result := WHITENESS;
|
||
RasterOp_NotAndROP : Result := ROP_DSna;
|
||
RasterOp_NopROP : Result := ROP_D;
|
||
RasterOp_OrNotROP : Result := ROP_SDno;
|
||
RasterOp_NandROP : Result := ROP_DSan;
|
||
else
|
||
Result := 0; // to satisfy compiler
|
||
end;
|
||
end;
|
||
|
||
function WinRopToRasterOp(WinRop: Cardinal; var Rop: RasterOp): Boolean;
|
||
begin
|
||
Result := True;
|
||
case WinRop of
|
||
BLACKNESS : Rop := RasterOp_ClearROP;
|
||
DSTINVERT : Rop := RasterOp_NotROP;
|
||
// MERGECOPY : Rop := RasterOp_OrROP; {DSa}
|
||
MERGEPAINT : Rop := RasterOp_NotOrRop;
|
||
NOTSRCCOPY : Rop := RasterOp_NotCopyROP;
|
||
NOTSRCERASE: Rop := RasterOp_NorROP;
|
||
SRCAND : Rop := RasterOp_AndROP;
|
||
SRCCOPY : Rop := RasterOp_CopyROP;
|
||
SRCERASE : Rop := RasterOp_AndNotROP;
|
||
SRCINVERT : Rop := RasterOp_XorROP;
|
||
SRCPAINT : Rop := RasterOp_OrROP;
|
||
WHITENESS : Rop := RasterOp_SetROP;
|
||
ROP_DSna : Rop := RasterOp_NotAndROP;
|
||
ROP_D : Rop := RasterOp_NopROP;
|
||
ROP_SDno : Rop := RasterOp_OrNotROP;
|
||
ROP_DSan : Rop := RasterOp_NandROP;
|
||
else
|
||
Rop := RasterOp(-1);
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function PatternPaint(DestDC: QPainterH; X, Y, W, H: Integer; rop: RasterOp): LongBool;
|
||
var
|
||
trop: RasterOp;
|
||
bkmode: Integer;
|
||
begin
|
||
try
|
||
trop := QPainter_rasterOp(DestDC);
|
||
bkmode := SetBkMode(DestDC, OPAQUE);
|
||
try
|
||
QPainter_setRasterOp(DestDC, rop); // asn: or use current ?
|
||
QPainter_fillRect(DestDC, X, Y, W, H, QPainter_brush(DestDC)); // current brush
|
||
finally
|
||
QPainter_setRasterOp(DestDC, trop);
|
||
SetBkMode(DestDC, bkmode);
|
||
end;
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function BitBlt(DestDC: QPainterH; X, Y, Width, Height: Integer; SrcDC: QPainterH;
|
||
XSrc, YSrc: Integer; WinRop: Cardinal; IgnoreMask: Boolean): LongBool;
|
||
var
|
||
TempDC: QPainterH;
|
||
Rop: RasterOp;
|
||
begin
|
||
if WinRopToRasterOp(WinRop, Rop) then // directly maps ?
|
||
Result := BitBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, Rop, IgnoreMask)
|
||
else // no
|
||
begin
|
||
case WinRop of
|
||
MERGECOPY: { PSa: Dest := Pattern AND Source }
|
||
begin
|
||
try
|
||
TempDC := CreateCompatibleDC(DestDC, Width, Height);
|
||
try
|
||
PatternPaint(TempDc, 0, 0, Width, Height, RasterOp_CopyROP); // Create Pattern
|
||
BitBlt(TempDc, 0, 0, Width, Height, SrcDC, XSrc, YSrc, RasterOp_AndRop); {PSa}
|
||
Result := BitBlt(DestDc, X, Y, Width, Height, tempDC, XSrc, YSrc, RasterOp_CopyROP);
|
||
except
|
||
Result := False;
|
||
end;
|
||
QPainter_destroy(tempDC);
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
PATCOPY:
|
||
Result := PatternPaint(DestDC, X, Y, Width, Height, RasterOp_CopyROP);
|
||
|
||
PATINVERT:
|
||
Result := PatternPaint(DestDC, X, Y, Width, Height, RasterOp_XorROP);
|
||
|
||
PATPAINT:
|
||
begin // DPSnoo = PDSnoo
|
||
Result := BitBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc,
|
||
RasterOp_NotOrRop); // DSno
|
||
if Result then
|
||
Result := PatternPaint(DestDC, X, Y, Width, Height, RasterOp_XOrROP);
|
||
end;
|
||
|
||
ROP_DSPDxax:
|
||
begin
|
||
TempDC := CreateCompatibleDC(DestDC, Width, Height);
|
||
try
|
||
// copy DestDC to pixmap
|
||
BitBlt(TempDC, 0, 0, Width, Height, DestDC, X, Y, RasterOp_XorROP);
|
||
BitBlt(TempDC, 0, 0, Width, Height, TempDC, 0, 0, PATINVERT); // PDx
|
||
BitBlt(TempDC, 0, 0, Width, Height, SrcDC, XSrc, YSrc, RasterOp_AndROP); // SPDxa
|
||
Result := BitBlt(DestDC, X, Y, Width, Height, TempDC, 0, 0, RasterOp_XorROP); // DSPDxax
|
||
except
|
||
Result := False;
|
||
end;
|
||
DeleteObject(TempDC);
|
||
end;
|
||
else
|
||
Result := False;
|
||
end;
|
||
end
|
||
end;
|
||
|
||
function BitBlt(DestDC: QPainterH; X, Y, Width, Height: Integer; SrcDC: QPainterH;
|
||
XSrc, YSrc: Integer; Rop: RasterOp; IgnoreMask: Boolean): LongBool;
|
||
var
|
||
d_dx, d_dy, d_sx, d_sy, d_sw, d_sh, d_dw, d_dh: Integer;
|
||
begin
|
||
if (DestDC = nil) or (SrcDC = nil) then
|
||
Result := False
|
||
else
|
||
begin
|
||
Result := True;
|
||
try
|
||
// Windows's BitBlt uses logical units
|
||
d_dx := X;d_dy := Y;d_dw := Width;d_dh := Height;
|
||
d_sx := XSrc; d_sy := YSrc;d_sw := Width; d_sh := Height;
|
||
|
||
MapPainterLP(DestDC, d_dx, d_dy);
|
||
MapPainterLPwh(DestDC, d_dw, d_dh);
|
||
MapPainterLP(SrcDC, d_sx, d_sy);
|
||
MapPainterLPwh(SrcDC, d_sw, d_sh);
|
||
|
||
if (d_dw = d_sw) and (d_dh = d_sh) then // device bitBlt possible
|
||
Qt.bitBlt(QPainter_device(DestDC), d_dx, d_dy, QPainter_device(SrcDC),
|
||
d_sx, d_sy, d_sw, d_sh, Rop,
|
||
IgnoreMask) // ignore the Mask because Windows's BitBlt does not use Masks
|
||
else
|
||
StretchBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, Width, Height,
|
||
Rop, IgnoreMask);
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function PainterOffset(Canvas: TCanvas): TPoint;
|
||
var
|
||
aControl: TControl;
|
||
begin
|
||
Result.X := 0;
|
||
Result.Y := 0;
|
||
if Canvas is TControlCanvas then
|
||
begin
|
||
AControl := TControlCanvas(Canvas).Control;
|
||
if AControl = nil then
|
||
Exit;
|
||
if not (AControl is TWidgetControl) then
|
||
begin
|
||
Result.X := aControl.Left;
|
||
Result.Y := aControl.Top;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function BitBlt(DestCanvas: TCanvas; X, Y, Width, Height: Integer; SrcCanvas: TCanvas;
|
||
XSrc, YSrc: Integer; WinRop: Cardinal; IgnoreMask: boolean): LongBool;
|
||
begin
|
||
DestCanvas.Start;
|
||
SrcCanvas.Start;
|
||
Result := BitBlt(DestCanvas.Handle, X, Y , Width, Height, SrcCanvas.Handle,
|
||
XSrc, YSrc, WinRop, IgnoreMask);
|
||
SrcCanvas.Stop;
|
||
DestCanvas.Stop;
|
||
end;
|
||
|
||
const
|
||
CopyModeToRasterOp: array[TCopyMode] of RasterOp = (
|
||
{cmBlackness} RasterOp_ClearROP, {cmDstInvert} RasterOp_NotROP,
|
||
{cmMergeCopy} RasterOp_AndROP, {cmMergePaint} RasterOP_NotOrROP,
|
||
{cmNotSrcCopy} RasterOp_NotCopyROP, {cmNotSrcErase}RasterOp_NorROP,
|
||
{cmPatCopy} RasterOp_NopROP, {cmPatInvert} RasterOp_NopROP,
|
||
{cmPatPaint} RasterOp_NotOrROP, {cmSrcAnd} RasterOp_AndROP,
|
||
{cmSrcCopy} RasterOp_CopyROP, {cmSrcErase} RasterOp_AndNotROP,
|
||
{cmSrcInvert} RasterOp_XorROP, {cmSrcPaint} RasterOP_OrROP,
|
||
{cmWhiteness} RasterOp_SetROP, {cmCreateMask} RasterOp_NopROP);
|
||
|
||
|
||
procedure CopyRect(DstCanvas: TCanvas; const Dest: TRect; Canvas: TCanvas;
|
||
const Source: TRect);
|
||
begin
|
||
StretchBlt(DstCanvas, Dest.Left, Dest.Top,
|
||
Dest.Right - Dest.Left, Dest.Bottom - Dest.Top,
|
||
Canvas, Source.Left, Source.Top,
|
||
Source.Right - Source.Left, Source.Bottom - Source.Top,
|
||
RasterOpToWinRop(CopyModeToRasterOp[DstCanvas.CopyMode]));
|
||
end;
|
||
|
||
procedure BrushCopy(DstCanvas: TCanvas; const Dest: TRect; Bitmap: TBitmap;
|
||
const Source: TRect; Color: TColor);
|
||
var
|
||
Bmp: TBitmap;
|
||
X, Y: integer;
|
||
begin
|
||
Bmp := TBitmap.Create;
|
||
with Bmp do
|
||
begin
|
||
Width := Source.Right - Source.Left;
|
||
Height := Source.Bottom - Source.Top;
|
||
Canvas.Start;
|
||
Canvas.Draw( -Source.Left, -Source.Top, Bitmap);
|
||
TransparentColor := Color;
|
||
Transparent := True;
|
||
Canvas.Stop;
|
||
end;
|
||
with DstCanvas do
|
||
begin
|
||
Start;
|
||
FillRect(Dest);
|
||
X := Dest.Left;
|
||
while X < Dest.Right do
|
||
begin
|
||
Y := Dest.Top;
|
||
while Y < Dest.Bottom do
|
||
begin
|
||
Draw(X, Y, Bmp);
|
||
Y := Y + Bmp.Height;
|
||
end;
|
||
X := X + Bmp.Width;
|
||
end;
|
||
Stop;
|
||
end;
|
||
Bmp.Free;
|
||
end;
|
||
|
||
function PatBlt(Handle: QPainterH; X, Y, Width, Height: Integer; WinRop: Cardinal): LongBool;
|
||
begin
|
||
Result := BitBlt(Handle, X, Y, Width, Height, Handle, X, Y, WinRop);
|
||
end;
|
||
|
||
function PatBlt(Canvas: TCanvas; X, Y, Width, Height: Integer; WinRop: Cardinal): LongBool;
|
||
begin
|
||
Canvas.Start;
|
||
Result := BitBlt(Canvas.Handle, X, Y, Width, Height, Canvas.Handle, X, Y, WinRop);
|
||
Canvas.Stop;
|
||
end;
|
||
|
||
function StretchBlt(DestDC: QPainterH; dx, dy, dw, dh: Integer;
|
||
SrcDC: QPainterH; sx, sy, sw, sh: Integer; WinRop: Cardinal;
|
||
IgnoreMask: Boolean): LongBool;
|
||
var
|
||
Bmp1, Bmp2: QPixmapH;
|
||
Painter : QPainterH;
|
||
d_sx, d_sy, d_sw, d_sh: Integer;
|
||
d_dx, d_dy, d_dw, d_dh: Integer;
|
||
begin
|
||
Result := False;
|
||
if (DestDC = nil) and (QPainter_isActive(DestDC)) then
|
||
Exit;
|
||
|
||
// Windows's StretchBlt uses logical units
|
||
d_sx := sx;d_sy := sy;d_sw := sw;d_sh := sh;
|
||
d_dx := dx;d_dy := dy;d_dw := dw;d_dh := dh;
|
||
|
||
MapPainterLP(DestDC, d_dx, d_dy);
|
||
MapPainterLPwh(DestDC, d_dw, d_dh);
|
||
MapPainterLP(SrcDC, d_sx, d_sy);
|
||
MapPainterLPwh(SrcDC, d_sw, d_sh);
|
||
|
||
if (d_dw = d_sw) and (d_dh = d_sh) then // device bitBlt possible
|
||
Result := BitBlt(DestDC, dx, dy, dw, dh, SrcDC, sx, sy, WinRop, IgnoreMask)
|
||
else
|
||
begin
|
||
if not QPainter_isActive(SrcDC) then
|
||
Exit;
|
||
try
|
||
Bmp1 := nil;
|
||
Bmp2 := nil;
|
||
try
|
||
// temporary bitmaps are in device units
|
||
Bmp1 := CreateCompatibleBitmap(SrcDC, d_sw, d_sh);
|
||
Bmp2 := CreateCompatibleBitmap(DestDC, d_dw, d_dh);
|
||
Qt.bitBlt(Bmp1, 0, 0, QPainter_device(SrcDC), d_sx, d_sy, d_sw, d_sh,
|
||
RasterOp_CopyROP, IgnoreMask); // use device units
|
||
Painter := QPainter_create(Bmp2);
|
||
QPainter_save(Painter);
|
||
QPainter_scale(Painter, d_dw/d_sw, d_dh/d_sh);
|
||
QPainter_drawPixmap(Painter, 0, 0, Bmp1, 0, 0, d_sw, d_sh);
|
||
QPainter_restore(Painter);
|
||
Result := BitBlt(DestDC, dx, dy, dw, dh, Painter, 0, 0, WinRop, IgnoreMask); // maps logical units
|
||
QPainter_destroy(Painter);
|
||
finally
|
||
if Assigned(Bmp1) then
|
||
QPixmap_destroy(Bmp1);
|
||
if Assigned(Bmp2) then
|
||
QPixmap_destroy(Bmp2);
|
||
end;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function StretchBlt(DestDC: QPainterH; dx, dy, dw, dh: Integer;
|
||
SrcDC: QPainterH; sx, sy, sw, sh: Integer; Rop: RasterOp; IgnoreMask: Boolean): LongBool;
|
||
begin
|
||
Result := StretchBlt(DestDC, dx, dy, dw, dh, SrcDC, sx, sy, sw, sh,
|
||
RasterOpToWinRop(Rop), IgnoreMask);
|
||
end;
|
||
|
||
function StretchBlt(DestCanvas: TCanvas; dx, dy, dw, dh: Integer;
|
||
SrcCanvas: TCanvas; sx, sy, sw, sh: Integer; WinRop: Cardinal; IgnoreMask: Boolean): LongBool;
|
||
//var
|
||
// d,s :TPoint;
|
||
begin
|
||
DestCanvas.Start;
|
||
SrcCanvas.Start;
|
||
// d := PainterOffset(DestCanvas);
|
||
// s := PainterOffset(SrcCanvas);
|
||
// Result := StretchBlt(DestCanvas.Handle, dx + d.x, dy + d.y, dw, dh, SrcCanvas.Handle,
|
||
// sx + s.x, sy + s.y, sw, sh, WinRop, IgnoreMask);
|
||
Result := StretchBlt(DestCanvas.Handle, dx, dy, dw, dh, SrcCanvas.Handle,
|
||
sx, sy, sw, sh, WinRop, IgnoreMask);
|
||
SrcCanvas.Stop;
|
||
DestCanvas.Stop;
|
||
end;
|
||
|
||
function GetStretchBltMode(DC: QPainterH): TStretchMode;
|
||
var
|
||
P: PPainterInfo;
|
||
begin
|
||
if DC <> nil then
|
||
begin
|
||
if GetPainterInfo(DC, P) then
|
||
Result := P.StetchBltMode
|
||
else
|
||
Result := STRETCH_DELETESCANS;
|
||
end
|
||
else
|
||
Result := STRETCH_DELETESCANS;
|
||
end;
|
||
|
||
function SetStretchBltMode(DC: QPainterH; StretchMode: TStretchMode): TStretchMode;
|
||
begin
|
||
try
|
||
Result := GetStretchBltMode(DC);
|
||
SetPainterInfo(DC).StetchBltMode := StretchMode;
|
||
except
|
||
Result := STRETCH_DELETESCANS;
|
||
end;
|
||
end;
|
||
|
||
function ScrollDC(Handle: QPainterH; dx, dy: Integer; var Scroll, Clip: TRect;
|
||
Rgn: QRegionH; Update: PRect): LongBool;
|
||
var
|
||
R1, R2: TRect;
|
||
rg1, rg2: QRegionH;
|
||
begin
|
||
// assume device units = pixels
|
||
IntersectRect(R2, Scroll, Clip); // clipped source rectangle
|
||
OffsetRect(R2, dx, dy);
|
||
IntersectRect(R2, R2, Clip); // R2: clipped destination rectangle
|
||
if not isRectEmpty(R2) then
|
||
begin
|
||
R1 := R2;
|
||
OffsetRect(R1, -dx, -dy); // R1: adjusted source rectangle
|
||
Result := BitBlt(Handle, R2.Left, R2.Top, R2.Right-R2.Left, R2.Bottom-R2.Top,
|
||
Handle, R1.Left, R1.Top, SRCCOPY);
|
||
end
|
||
else
|
||
Result := False; // asn: or True ?
|
||
if (Rgn <> nil) or (Update <> nil) then
|
||
begin
|
||
rg1 := CreateRectRgnIndirect(Scroll);
|
||
rg2 := CreateRectRgnIndirect(R2);
|
||
CombineRgn(rg2, rg1, rg2, RGN_DIFF);
|
||
if Rgn <> nil then
|
||
CombineRgn(Rgn, Rg2, Rg2, RGN_OR);
|
||
if Update <> nil then
|
||
QRegion_boundingRect(rg2, Update);
|
||
QRegion_destroy(rg2);
|
||
QRegion_destroy(rg1);
|
||
end;
|
||
end;
|
||
|
||
function SetROP2(Handle: QPainterH; Rop: Integer): Integer;
|
||
var
|
||
rop2: RasterOp;
|
||
begin
|
||
case Rop of
|
||
R2_BLACK : rop2 := RasterOp_ClearROP;
|
||
R2_WHITE : rop2 := RasterOp_SetROP;
|
||
R2_NOP : rop2 := RasterOp_NopROP;
|
||
R2_NOT : rop2 := RasterOp_NotROP;
|
||
R2_COPYPEN : rop2 := RasterOp_CopyROP;
|
||
R2_NOTCOPYPEN : rop2 := RasterOp_NotCopyROP;
|
||
R2_MERGEPENNOT: rop2 := RasterOp_OrNotROP;
|
||
R2_MASKPENNOT : rop2 := RasterOp_AndNotROP;
|
||
R2_MERGEPEN : rop2 := RasterOp_OrROP;
|
||
R2_NOTMERGEPEN: rop2 := RasterOp_NorROP;
|
||
R2_MASKPEN : rop2 := RasterOp_AndROP;
|
||
R2_NOTMASKPEN : rop2 := RasterOp_NandROP;
|
||
R2_XORPEN : rop2 := RasterOp_XorROP;
|
||
R2_NOTXORPEN : rop2 := RasterOp_NotXorROP;
|
||
R2_MASKNOTPEN : rop2 := RasterOp_NotAndROP;
|
||
R2_MERGENOTPEN: rop2 := RasterOp_NotOrROP;
|
||
else
|
||
Result := -1;
|
||
Exit;
|
||
end;
|
||
Result := GetROP2(Handle);
|
||
QPainter_setRasterOp(Handle, rop2);
|
||
end;
|
||
|
||
function GetROP2(Handle: QPainterH): Integer;
|
||
var
|
||
rop2: RasterOp;
|
||
begin
|
||
rop2 := QPainter_rasterOp(Handle);
|
||
case rop2 of
|
||
RasterOp_ClearROP : Result := R2_BLACK;
|
||
RasterOp_SetROP : Result := R2_WHITE;
|
||
RasterOp_NopROP : Result := R2_NOP;
|
||
RasterOp_NotROP : Result := R2_NOT;
|
||
RasterOp_CopyROP : Result := R2_COPYPEN;
|
||
RasterOp_NotCopyROP: Result := R2_NOTCOPYPEN;
|
||
RasterOp_OrNotROP : Result := R2_MERGEPENNOT;
|
||
RasterOp_AndNotROP : Result := R2_MASKPENNOT;
|
||
RasterOp_OrROP : Result := R2_MERGEPEN;
|
||
RasterOp_NorROP : Result := R2_NOTMERGEPEN;
|
||
RasterOp_AndROP : Result := R2_MASKPEN;
|
||
RasterOp_NandROP : Result := R2_NOTMASKPEN;
|
||
RasterOp_XorROP : Result := R2_XORPEN;
|
||
RasterOp_NotXorROP : Result := R2_NOTXORPEN;
|
||
RasterOp_NotAndROP : Result := R2_MASKNOTPEN;
|
||
RasterOp_NotOrROP : Result := R2_MERGENOTPEN;
|
||
else
|
||
Result := -1;
|
||
end;
|
||
end;
|
||
|
||
function SetForegroundWindow(Handle: QWidgetH): LongBool;
|
||
begin
|
||
try
|
||
Result := QWidget_isTopLevel(Handle);
|
||
if Result then
|
||
QWidget_raise(Handle);
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function BringWindowToTop(Handle: QWidgetH): LongBool;
|
||
begin
|
||
try
|
||
while not QWidget_isTopLevel(Handle) do
|
||
Handle := QWidget_parentWidget(Handle);
|
||
Result := Handle <> nil;
|
||
if Result then
|
||
begin
|
||
QWidget_show(Handle);
|
||
QWidget_raise(Handle);
|
||
end;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function SwitchToThisWindow(Handle: QWidgetH; Restore: Boolean): LongBool;
|
||
begin
|
||
try
|
||
Result := QWidget_isTopLevel(Handle);
|
||
if Result then
|
||
begin
|
||
if Restore then
|
||
QWidget_show(Handle);
|
||
QWidget_setActiveWindow(Handle);
|
||
end;
|
||
except
|
||
Result:= True;
|
||
end;
|
||
end;
|
||
|
||
function CloseWindow(Handle: QWidgetH): LongBool;
|
||
begin
|
||
try
|
||
Result := QWidget_isTopLevel(Handle);
|
||
if Result then
|
||
QWidget_close(Handle)
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function DestroyWindow(Handle: QWidgetH): LongBool;
|
||
begin
|
||
try
|
||
Result := QWidget_isTopLevel(Handle);
|
||
if Result then
|
||
QWidget_destroy(Handle);
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function WindowFromDC(Handle: QPaintDeviceH): QWidgetH;
|
||
var
|
||
WidgetList: QObjectListH;
|
||
Widget: QWidgetH;
|
||
I: integer;
|
||
begin
|
||
Result := nil;
|
||
WidgetList := QObject_queryList(Application.AppWidget, 'QWidget','*', true, true);
|
||
for I := 0 to QObjectList_count(WidgetList) - 1 do
|
||
begin
|
||
Widget := QWidgetH(QObjectList_at(WidgetList, I));
|
||
if QWidget_isVisible(Widget) and (QWidget_to_QPaintDevice(Widget) = Handle) then
|
||
begin
|
||
Result := Widget;
|
||
break;
|
||
end;
|
||
end;
|
||
QObjectList_destroy(WidgetList);
|
||
end;
|
||
|
||
function WindowFromDC(Handle: QPainterH): QWidgetH;
|
||
begin
|
||
Result := nil;
|
||
if QPainter_isActive(Handle) then
|
||
Result := WindowFromDC(QPainter_device(Handle));
|
||
end;
|
||
|
||
|
||
function ChildWindowFromPoint(hWndParent: QWidgetH; Point: TPoint): QWidgetH;
|
||
begin
|
||
try
|
||
Result := QApplication_widgetAt(@Point, True);
|
||
except
|
||
Result := nil;
|
||
end;
|
||
end;
|
||
|
||
function WindowFromPoint(Point: TPoint): QWidgetH;
|
||
begin
|
||
try
|
||
Result := QApplication_widgetAt(@Point, False);
|
||
except
|
||
Result := nil;
|
||
end;
|
||
end;
|
||
|
||
function FindCLXWindow(const Point: TPoint): TWidgetControl;
|
||
var
|
||
Handle: QWidgetH;
|
||
begin
|
||
Handle := WindowFromPoint(Point);
|
||
Result := nil;
|
||
while Handle <> nil do
|
||
begin
|
||
Result := FindControl(Handle);
|
||
if Result <> nil
|
||
then
|
||
Exit;
|
||
Handle := GetParent(Handle);
|
||
end;
|
||
end;
|
||
|
||
function FindVCLWindow(const Point: TPoint): TWidgetControl;
|
||
begin
|
||
Result := FindCLXWindow(Point);
|
||
end;
|
||
|
||
function GetClassName(Handle: QWidgetH; Buffer: PChar; MaxCount: Integer): Integer;
|
||
begin
|
||
Result := 0;
|
||
if Handle <> nil then
|
||
begin
|
||
Result := Length(QObject_className(Handle));
|
||
if Buffer <> nil then
|
||
StrLCopy(Buffer, QObject_className(Handle), MaxCount);
|
||
end;
|
||
end;
|
||
|
||
function IsIconic(Handle: QWidgetH): LongBool;
|
||
begin
|
||
Result := False;
|
||
if Handle = nil then
|
||
Exit;
|
||
try
|
||
Result := QWidget_isMinimized(Handle);
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function ClientToScreen(Handle: QWidgetH; var Point: TPoint): LongBool;
|
||
begin
|
||
try
|
||
QWidget_mapToGlobal(Handle, @Point, @Point);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function ScreenToClient(Handle: QWidgetH; var Point: TPoint): LongBool;
|
||
begin
|
||
try
|
||
QWidget_mapFromGlobal(Handle, @Point, @Point);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function SmallPointToPoint(const P: TSmallPoint): TPoint;
|
||
begin
|
||
Result := Point(P.x, P.y);
|
||
end;
|
||
|
||
function PointToSmallPoint(const P: TPoint): TSmallPoint;
|
||
begin
|
||
Result.x := SmallInt(P.X);
|
||
Result.y := SmallInt(P.Y);
|
||
end;
|
||
|
||
function MapWindowPoints(WidgetTo, WidgetFrom: QWidgetH; var Points; nr: Cardinal): Integer;
|
||
var
|
||
i: Integer;
|
||
p1: PPoint;
|
||
p2: TPoint;
|
||
begin
|
||
p1 := @Points;
|
||
try
|
||
if (IsChild(WidgetTo, WidgetFrom)) and (nr > 0) then
|
||
begin
|
||
QWidget_mapTo(WidgetFrom, p1, WidgetTo, @p2);
|
||
TSmallPoint(Result).x := p2.X - p1.X;
|
||
TSmallPoint(Result).y := p2.Y - p1.Y;
|
||
for i:= 0 to nr - 1 do
|
||
begin
|
||
QWidget_mapTo(WidgetFrom, p1, WidgetTo, p1);
|
||
Inc(p1);
|
||
end;
|
||
end
|
||
else
|
||
Result := 0;
|
||
except
|
||
Result := 0;
|
||
end;
|
||
end;
|
||
|
||
function InvalidateRect(Handle: QWidgetH; R: PRect; EraseBackground: Boolean): LongBool;
|
||
var
|
||
Control: TWidgetControl;
|
||
begin
|
||
Result := False;
|
||
if Handle = nil then
|
||
Exit;
|
||
try
|
||
Control := FindControl(Handle);
|
||
if Control <> nil then
|
||
Control.InvalidateRect(R^, EraseBackGround);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function ValidateRect(hWnd: QWidgetH; R: PRect): LongBool;
|
||
var
|
||
Event: QPaintEventH;
|
||
begin
|
||
Event := QPaintEvent_create(R, false);
|
||
try
|
||
Result := QApplication_sendEvent(hWnd, QEventH(Event));
|
||
finally
|
||
QPaintEvent_destroy(Event);
|
||
end;
|
||
end;
|
||
|
||
function UpdateWindow(Handle: QWidgetH): LongBool;
|
||
begin
|
||
Result := False;
|
||
if Handle <> nil then
|
||
Exit;
|
||
try
|
||
QWidget_update(Handle);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function IsChild(ParentHandle, ChildHandle: QWidgetH): LongBool;
|
||
var
|
||
ParentH: QWidgetH;
|
||
begin
|
||
Result := False;
|
||
ParentH := QWidget_parentWidget(ChildHandle);
|
||
while (ParentH <> nil) and (not Result) do
|
||
begin
|
||
Result := ParentH = ParentHandle;
|
||
ParentH := QWidget_parentWidget(ParentH);
|
||
end;
|
||
end;
|
||
|
||
function MessageBox(parent: QWidgetH; Text, Caption: WideString; WinFlags: Cardinal): Integer; overload;
|
||
var
|
||
Button0, Button1, Button2: Integer;
|
||
const
|
||
ButtonOk = 1;
|
||
ButtonCancel = 2;
|
||
ButtonYes = 3;
|
||
ButtonNo = 4;
|
||
ButtonAbort = 5;
|
||
ButtonRetry = 6;
|
||
ButtonIgnore = 7;
|
||
ButtonDefault = $100;
|
||
ButtonEscape = $200;
|
||
begin
|
||
case (WinFlags and $7) of
|
||
MB_OKCANCEL:
|
||
begin
|
||
Button0 := ButtonOk;
|
||
Button1 := ButtonCancel or ButtonEscape;
|
||
Button2 := 0;
|
||
end;
|
||
MB_ABORTRETRYIGNORE:
|
||
begin
|
||
Button0 := ButtonAbort;
|
||
Button1 := ButtonRetry or ButtonDefault;
|
||
Button2 := ButtonIgnore;
|
||
end;
|
||
MB_YESNOCANCEL:
|
||
begin
|
||
Button0 := ButtonYes;
|
||
Button1 := ButtonNo;
|
||
Button2 := ButtonCancel or ButtonEscape;
|
||
end;
|
||
MB_YESNO:
|
||
begin
|
||
Button0 := ButtonYes;
|
||
Button1 := ButtonNo or ButtonEscape;
|
||
Button2 := 0;
|
||
end;
|
||
MB_RETRYCANCEL:
|
||
begin
|
||
Button0 := ButtonRetry;
|
||
Button1 := ButtonCancel or ButtonEscape;
|
||
Button2 := 0;
|
||
end;
|
||
else // MB_OK and non supported
|
||
begin
|
||
Button0 := ButtonOk or ButtonEscape;
|
||
Button1 := 0;
|
||
Button2 := 0;
|
||
end;
|
||
end;
|
||
case (WinFlags and $300) of
|
||
MB_DEFBUTTON2: Button1 := Button1 or ButtonDefault;
|
||
MB_DEFBUTTON3: Button2 := Button2 or ButtonDefault;
|
||
else
|
||
// MB_DEFBUTTON1:
|
||
Button0 := Button0 or ButtonDefault;
|
||
end;
|
||
case (WinFlags and $F0) of
|
||
MB_ICONINFORMATION:
|
||
Result := QMessageBox_information(parent, @caption, @text,
|
||
button0, button1, button2);
|
||
MB_ICONWARNING:
|
||
Result := QMessageBox_warning(parent, @caption, @text,
|
||
button0, button1, button2);
|
||
MB_ICONQUESTION:
|
||
Result := QMessageBox_information(parent, @caption, @text,
|
||
button0, button1, button2);
|
||
else
|
||
// MB_ICONSTOP:
|
||
Result := QMessageBox_critical(parent, @caption, @text,
|
||
button0, button1, button2);
|
||
end;
|
||
end;
|
||
|
||
function MessageBox(parent: QWidgetH; pText, pCaption: PChar; WinFlags: Cardinal): Integer;
|
||
var
|
||
wsText, wsCaption: WideString;
|
||
begin
|
||
wsText := pText;
|
||
wsCaption := pCaption;
|
||
Result := MessageBox(parent, wsText, wsCaption, WinFlags);
|
||
end;
|
||
|
||
function MessageBox(parent: QWidgetH; Text, Caption: String; WinFlags: Cardinal): Integer; overload;
|
||
begin
|
||
Result := MessageBox(parent, Text, Caption, WinFlags);
|
||
end;
|
||
|
||
function MessageBoxW(parent: QWidgetH; pText, pCaption: PWideChar; WinFlags: Cardinal): Integer;
|
||
var
|
||
wsText, wsCaption: WideString;
|
||
begin
|
||
wsText := pText;
|
||
wsCaption := pCaption;
|
||
Result := MessageBox(parent, wsText, wsCaption, WinFlags);
|
||
end;
|
||
|
||
function SelectObject(Handle: QPainterH; Font: QFontH): QFontH;
|
||
begin
|
||
Result := QPainter_font(Handle);
|
||
QPainter_setFont(Handle, Font);
|
||
end;
|
||
|
||
function SelectObject(Handle: QPainterH; Brush: QBrushH): QBrushH;
|
||
begin
|
||
Result := QPainter_brush(Handle);
|
||
QPainter_setBrush(Handle, Brush);
|
||
end;
|
||
|
||
function SelectObject(Handle: QPainterH; Pen: QPenH): QPenH;
|
||
begin
|
||
Result := QPainter_pen(Handle);
|
||
QPainter_setPen(Handle, Pen);
|
||
end;
|
||
|
||
function SelectObject(Handle: QPainterH; Bitmap: QPixmapH): QPixmapH;
|
||
var
|
||
P: PPainterInfo;
|
||
begin
|
||
if GetPainterInfo(Handle, P) and (P.IsCompatibleDC) then
|
||
begin
|
||
Result := QPixmapH(QPainter_device(Handle)); // IsCompatibleDC -> device is QPixmapH
|
||
if QPainter_isActive(Handle) then
|
||
QPainter_end(Handle);
|
||
|
||
QPainter_begin(Handle, Bitmap);
|
||
end
|
||
else
|
||
//Result := nil;
|
||
raise Exception.Create('SelectObject(HBITMAP) is limited to CreateCompatibleDC handles');
|
||
end;
|
||
|
||
function GetRegionType(rgn: QRegionH): Integer;
|
||
var
|
||
R: TRect;
|
||
begin
|
||
try
|
||
if QRegion_isEmpty(rgn) then
|
||
Result := NULLREGION
|
||
else
|
||
begin
|
||
QRegion_boundingRect(rgn, @R);
|
||
if QRegion_contains(rgn, PRect(@R)) then
|
||
Result := SIMPLEREGION
|
||
else
|
||
Result := COMPLEXREGION;
|
||
end;
|
||
except
|
||
Result := RGN_ERROR;
|
||
end;
|
||
end;
|
||
|
||
function CreateEllipticRgn(Left, Top, Right, Bottom: Integer): QRegionH;
|
||
begin
|
||
Result := QRegion_create(Left, Top, Right - Left, Bottom - Top, QRegionRegionType_Ellipse);
|
||
end;
|
||
|
||
function CreateEllipticRgnIndirect(Rect: TRect): QRegionH;
|
||
begin
|
||
Result := QRegion_create(@Rect, QRegionRegionType_Ellipse);
|
||
end;
|
||
|
||
function CreateRectRgn(Left, Top, Right, Bottom: Integer): QRegionH;
|
||
var
|
||
R: TRect;
|
||
begin
|
||
SetRect(R, Left, Top, Right, Bottom);
|
||
Result := QRegion_create(@R, QRegionRegionType_Rectangle);
|
||
end;
|
||
|
||
function CreateRectRgnIndirect(Rect: TRect): QRegionH;
|
||
begin
|
||
Result := QRegion_create(@Rect, QRegionRegionType_Rectangle);
|
||
end;
|
||
|
||
function CreateRoundRectRgn(x1, y1, x2, y2, WidthEllipse, HeightEllipse: Integer): QRegionH;
|
||
var
|
||
Bmp: QBitmapH;
|
||
Painter: QPainterH;
|
||
begin
|
||
Bmp := QBitmap_create(x2-x1+1, y2-y1+1, True, QPixmapOptimization_DefaultOptim);
|
||
Painter := QPainter_create(Bmp);
|
||
QPainter_setBrush(Painter, QPen_color(QPainter_pen(painter)));
|
||
QPainter_drawRoundRect(Painter, 0, 0, x2-x1, y2-y1, WidthEllipse, HeightEllipse);
|
||
QPainter_destroy(Painter);
|
||
Result := QRegion_create(Bmp);
|
||
QBitmap_destroy(Bmp);
|
||
QRegion_translate(Result, x1, y1);
|
||
end;
|
||
|
||
function CreatePolygonRgn(const Points; Count, FillMode: Integer): QRegionH;
|
||
var
|
||
pts: TPointArray;
|
||
i: Integer;
|
||
p: PPoint;
|
||
begin
|
||
SetLength(pts, Count);
|
||
p := PPoint(@Points);
|
||
for i := 0 to Count - 1 do
|
||
begin
|
||
pts[i].X := p.X;
|
||
pts[i].Y := p.Y;
|
||
Inc(p);
|
||
end;
|
||
Result := QRegion_create(@pts[0], Fillmode = WINDING);
|
||
end;
|
||
|
||
function SelectClipRgn(Handle: QPainterH; Region: QRegionH): Integer;
|
||
var
|
||
Clipping: Boolean;
|
||
begin
|
||
Result := RGN_ERROR;
|
||
if Handle = nil then
|
||
Exit;
|
||
try
|
||
Clipping := Region <> nil;
|
||
if Clipping then
|
||
begin
|
||
Region := CreateMappedRegion(Handle, Region);
|
||
try
|
||
QPainter_setClipRegion(Handle, Region);
|
||
Result := GetRegionType(Region);
|
||
finally
|
||
QRegion_destroy(Region);
|
||
end;
|
||
end
|
||
else
|
||
Result := NULLREGION;
|
||
QPainter_setClipping(Handle, Clipping);
|
||
except
|
||
Result := RGN_ERROR;
|
||
end;
|
||
end;
|
||
|
||
function SelectClipRgn(Handle: QPainterH; Region: Integer): Integer;
|
||
begin
|
||
Result := SelectClipRgn(Handle, QRegionH(Region));
|
||
end;
|
||
|
||
function ExcludeClipRect(Handle: QPainterH; X1, Y1, X2, Y2: Integer): Integer;
|
||
var
|
||
ExcludeRgn, Rgn: QRegionH;
|
||
begin
|
||
MapPainterLP(Handle, X1, Y1, X2, Y2);
|
||
ExcludeRgn := QRegion_create(X1, Y1, X2 - X1, Y2 - Y1, QRegionRegionType_Rectangle);
|
||
try
|
||
Rgn := QPainter_clipRegion(Handle);
|
||
QRegion_subtract(Rgn, Rgn, ExcludeRgn);
|
||
QPainter_setClipRegion(Handle, Rgn); // otherwide the new clip region is not accepter
|
||
QPainter_setClipping(Handle, True);
|
||
Result := GetRegionType(Rgn);
|
||
except
|
||
Result := RGN_ERROR;
|
||
end;
|
||
QRegion_destroy(ExcludeRgn);
|
||
end;
|
||
|
||
function ExcludeClipRect(Handle: QPainterH; const R: TRect): Integer;
|
||
begin
|
||
with R do
|
||
Result := ExcludeClipRect(Handle, Left, Top, Right, Bottom);
|
||
end;
|
||
|
||
function IntersectClipRect(Handle: QPainterH; X1, Y1, X2, Y2: Integer): Integer;
|
||
var
|
||
IntersectRgn, Rgn: QRegionH;
|
||
begin
|
||
MapPainterLP(Handle, X1, Y1, X2, Y2);
|
||
IntersectRgn := QRegion_create(X1, Y1, X2 - X1, Y2 - Y1, QRegionRegionType_Rectangle);
|
||
try
|
||
if QPainter_hasClipping(Handle) then
|
||
begin
|
||
Rgn := QPainter_clipRegion(Handle);
|
||
if QRegion_isNull(Rgn) then
|
||
QRegion_unite(Rgn, Rgn, IntersectRgn)
|
||
else
|
||
QRegion_intersect(Rgn, Rgn, IntersectRgn);
|
||
end
|
||
else
|
||
begin
|
||
QPainter_setClipRegion(Handle, InterSectRgn);
|
||
Rgn := QPainter_clipRegion(Handle);
|
||
end;
|
||
QPainter_setClipping(Handle, True);
|
||
Result := GetRegionType(Rgn);
|
||
except
|
||
Result := RGN_ERROR;
|
||
end;
|
||
QRegion_destroy(IntersectRgn);
|
||
end;
|
||
|
||
function IntersectClipRect(Handle: QPainterH; const R: TRect): Integer;
|
||
begin
|
||
with R do
|
||
Result := IntersectClipRect(Handle, Left, Top, Right, Bottom);
|
||
end;
|
||
|
||
function SetRectRgn(Rgn: QRegionH; X1, Y1, X2, Y2: Integer): LongBool;
|
||
var
|
||
rgn2: QRegionH;
|
||
R: TRect;
|
||
begin
|
||
SetRect(R, X1, Y1, X2, Y2);
|
||
rgn2 := QRegion_create(@R, QRegionRegionType_Rectangle);
|
||
try
|
||
QRegion_unite(rgn2, rgn, rgn2);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
QRegion_destroy(rgn2);
|
||
end;
|
||
|
||
function EqualRgn(Rgn1, Rgn2: QRegionH): LongBool;
|
||
var
|
||
tmpRgn: QRegionH;
|
||
begin
|
||
tmpRgn := QRegion_create;
|
||
try
|
||
Result := CombineRgn(tmpRgn, Rgn1, Rgn2, RGN_XOR) = NULLREGION
|
||
except
|
||
Result := False;
|
||
end;
|
||
QRegion_destroy(tmpRgn);
|
||
end;
|
||
|
||
function GetClipRgn(Handle: QPainterH; rgn: QRegionH): Integer;
|
||
begin
|
||
if QPainter_hasClipping(Handle)
|
||
then
|
||
begin
|
||
QRegion_unite(QPainter_clipRegion(Handle), rgn, QPainter_clipRegion(Handle));
|
||
Result := GetRegionType(rgn);
|
||
end
|
||
else
|
||
Result := NULLREGION;
|
||
end;
|
||
|
||
function CombineRgn(DestRgn, Source1, Source2: QRegionH;
|
||
Operation: TCombineMode): Integer;
|
||
begin
|
||
try
|
||
case Operation of
|
||
RGN_OR:
|
||
QRegion_unite(Source1, DestRgn, Source2);
|
||
RGN_AND:
|
||
QRegion_intersect(Source1, DestRgn, Source2);
|
||
// RGN_DIFF Subtracts Source2 from Source1
|
||
RGN_DIFF:
|
||
QRegion_subtract(Source1, DestRgn, Source2);
|
||
// RGN_XOR creates the union of two combined regions except for any
|
||
// overlapping areas.
|
||
RGN_XOR:
|
||
QRegion_eor(Source1, DestRgn, Source2);
|
||
// RGN_COPY: Creates a copy of the region identified by Source1.
|
||
RGN_COPY:
|
||
QRegion_unite(Source1, DestRgn, Source1)
|
||
else
|
||
Result := RGN_ERROR;
|
||
Exit;
|
||
end;
|
||
Result := GetRegionType(DestRgn);
|
||
except
|
||
Result := RGN_ERROR;
|
||
end;
|
||
end;
|
||
|
||
function OffsetRgn(Region: QRegionH; X, Y:Integer): Integer;
|
||
begin
|
||
QRegion_translate(Region, X, Y);
|
||
Result := GetRegionType(Region);
|
||
end;
|
||
|
||
function OffsetClipRgn(Handle: QPainterH; X, Y: Integer): Integer;
|
||
begin
|
||
try
|
||
if QPainter_hasClipping(Handle) then
|
||
begin
|
||
OffsetRgn(QPainter_clipRegion(Handle), X, Y);
|
||
Result := GetRegionType(QPainter_clipRegion(Handle));
|
||
end
|
||
else
|
||
Result := RGN_ERROR;
|
||
except
|
||
Result := RGN_ERROR;
|
||
end;
|
||
end;
|
||
|
||
function InvertRgn(Handle: QPainterH; Region: QRegionH): LongBool;
|
||
var
|
||
Rgn: QRegionH;
|
||
R: TRect;
|
||
begin
|
||
try
|
||
QPainter_window(Handle, @R);
|
||
OffsetRect(R, -R.Left, -R.Top);
|
||
rgn := QRegion_create(@R, QRegionRegionType_Rectangle);
|
||
try
|
||
QRegion_subtract(rgn, Region, Region);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
QRegion_destroy(rgn);
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function FillRgn(Handle: QPainterH; Region: QRegionH; Brush: QBrushH): LongBool;
|
||
var
|
||
OldRgn: QRegionH;
|
||
R: TRect;
|
||
hasClipping: Boolean;
|
||
begin
|
||
OldRgn := nil;
|
||
Result := False;
|
||
QPainter_save(Handle);
|
||
try
|
||
hasClipping := QPainter_hasClipping(Handle);
|
||
if hasClipping then
|
||
OldRgn := QPainter_clipRegion(Handle);
|
||
if SelectClipRgn(Handle, Region) <> RGN_ERROR then
|
||
begin
|
||
QRegion_boundingRect(Region, @R);
|
||
QPainter_fillRect(Handle, @R, Brush);
|
||
if hasClipping then
|
||
SelectClipRgn(Handle, OldRgn);
|
||
Result := True;
|
||
end;
|
||
finally
|
||
QPainter_restore(Handle);
|
||
end;
|
||
end;
|
||
|
||
function FrameRgn(Handle: QPainterH; Region: QRegionH; Brush: QBrushH; Width, Height: integer): LongBool;
|
||
var
|
||
R: TRect;
|
||
X, Y: integer;
|
||
Pen: QPenH;
|
||
|
||
function IsBorderPoint(X, Y: integer): Boolean;
|
||
var
|
||
I, J, K: integer;
|
||
begin
|
||
Result := False;
|
||
if PtInRegion(Region, X, Y) then
|
||
begin
|
||
K := 0;
|
||
For I := -Width to Width do
|
||
For J := -Height to Height do
|
||
begin
|
||
If not PtInRegion(Region, X + I , Y + J) then
|
||
begin
|
||
Inc(K);
|
||
if K > 1 then // 2 points required windows uses 1 point
|
||
begin
|
||
Result := True;
|
||
exit;
|
||
end;
|
||
end;
|
||
end
|
||
end;
|
||
end;
|
||
begin
|
||
// Result := false;
|
||
QPainter_save(Handle);
|
||
try
|
||
QRegion_boundingRect(Region, @R);
|
||
Pen := QPen_create(QBrush_color(Brush), 1, PenStyle_SolidLine);
|
||
try
|
||
QPainter_setPen(Handle, Pen);
|
||
finally
|
||
QPen_destroy(Pen);
|
||
end;
|
||
for X := R.Left to R.Right do
|
||
for Y := R.Top to R.Bottom do
|
||
if IsBorderPoint(X, Y) then
|
||
QPainter_drawPoint(Handle, X, Y);
|
||
Result := True;
|
||
finally
|
||
QPainter_restore(Handle);
|
||
end;
|
||
end;
|
||
|
||
function DeleteObject(Region: QRegionH): LongBool;
|
||
begin
|
||
try
|
||
// if not TStockObjectList.ReleaseStockObject(Region) then
|
||
QRegion_destroy(Region);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function PtInRegion(Rgn: QRegionH; X, Y: Integer): Boolean;
|
||
var
|
||
P :TPoint;
|
||
begin
|
||
P.X := X;
|
||
P.Y := Y;
|
||
Result := QRegion_contains(Rgn, PPoint(@P));
|
||
end;
|
||
|
||
function RectInRegion(Rgn: QRegionH; const Rect: TRect): LongBool;
|
||
begin
|
||
try
|
||
Result := QRegion_contains(Rgn, PRect(@Rect));
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function SetWindowRgn(Handle: QWidgetH; Region: QRegionH; Redraw: LongBool): Integer;
|
||
begin
|
||
Result := 0;
|
||
if Handle <> nil then
|
||
try
|
||
if Region <> nil then
|
||
begin
|
||
QWidget_setMask(Handle, Region);
|
||
DeleteObject(Region); // Windows owns the window region
|
||
end
|
||
else
|
||
QWidget_clearMask(Handle);
|
||
if Redraw then
|
||
UpdateWindow(Handle);
|
||
Result := 1;
|
||
except
|
||
Result := 0;
|
||
end;
|
||
end;
|
||
|
||
function GetWindowRgn(Handle: QWidgetH; Region: QRegionH): Integer;
|
||
begin
|
||
if (Region <> nil) and (Handle <> nil) then
|
||
begin
|
||
try
|
||
// there is no QWidget_mask() function
|
||
// asn: note region without windows/X11 decoration
|
||
QWidget_childrenRegion(Handle, Region);
|
||
Result := GetRegionType(Region);
|
||
except
|
||
Result := ERROR;
|
||
end;
|
||
end
|
||
else
|
||
Result := ERROR;
|
||
end;
|
||
|
||
function LPtoDP(Handle: QPainterH; var Points; Count: Integer): LongBool;
|
||
var
|
||
P: PPoint;
|
||
begin
|
||
Result := True;
|
||
try
|
||
P := @Points;
|
||
while Count > 0 do
|
||
begin
|
||
Dec(Count);
|
||
QPainter_xForm(Handle, P, P);
|
||
Inc(P);
|
||
end;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function DPtoLP(Handle: QPainterH; var Points; Count: Integer): LongBool;
|
||
var
|
||
P: PPoint;
|
||
begin
|
||
Result := True;
|
||
try
|
||
P := @Points;
|
||
while Count > 0 do
|
||
begin
|
||
Dec(Count);
|
||
QPainter_xFormDev(Handle, P, P);
|
||
Inc(P);
|
||
end;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function SetViewPortOrgEx(Handle: QPainterH; X, Y: Integer; OldOrg: PPoint): LongBool;
|
||
var
|
||
R :TRect;
|
||
begin
|
||
try
|
||
QPainter_viewport(Handle, @R);
|
||
if OldOrg <> nil then
|
||
begin
|
||
OldOrg.X := R.Left;
|
||
OldOrg.Y := R.Top;
|
||
end;
|
||
QPainter_setViewport(Handle, X, Y, R.Right - R.Left, R.Bottom - R.Top);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function SetViewportExtEx(Handle: QPainterH; XExt, YExt: Integer; Size: PSize): LongBool;
|
||
var
|
||
R :TRect;
|
||
begin
|
||
Result := True;
|
||
try
|
||
QPainter_viewport(Handle, @R);
|
||
if size <> nil then
|
||
begin
|
||
Size.cx := R.Right - R.Left;
|
||
Size.cy := R.Bottom - R.Top;
|
||
end;
|
||
QPainter_setViewport(Handle, R.Left, R.Top, XExt, YExt);
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function GetViewportExtEx(Handle: QPainterH; Size: PSize): LongBool;
|
||
var
|
||
R :TRect;
|
||
begin
|
||
Result := True;
|
||
try
|
||
QPainter_viewport(Handle, @R);
|
||
Size.cx := R.Right - R.Left;
|
||
Size.cy := R.Bottom - R.Top;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function GetWindowOrgEx(Handle: QPainterH; Org: PPoint): LongBool;
|
||
var
|
||
R :TRect;
|
||
begin
|
||
try
|
||
QPainter_window(Handle, @R);
|
||
Org.X := R.Left;
|
||
Org.Y := R.Top;
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function GetWindowOrgEx(Handle: QPainterH; var Org: TPoint): LongBool;
|
||
begin
|
||
Result := GetWindowOrgEx(Handle, @Org);
|
||
end;
|
||
|
||
function SetWindowOrgEx(Handle: QPainterH; X, Y: Integer; OldOrg: PPoint): LongBool;
|
||
var
|
||
R :TRect;
|
||
begin
|
||
try
|
||
QPainter_window(Handle, @R);
|
||
with R do
|
||
begin
|
||
if OldOrg <> nil then
|
||
begin
|
||
OldOrg.X := Left;
|
||
OldOrg.Y := Top;
|
||
end;
|
||
QPainter_setWindow(Handle, X, Y, Right - Left, Bottom - Top);
|
||
end;
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
procedure CopyMemory(Dest: Pointer; Src: Pointer; Len: Cardinal);
|
||
begin
|
||
Move(Src^, Dest^, Len);
|
||
end;
|
||
|
||
procedure FillMemory(Dest: Pointer; Len: Cardinal; Fill: Byte);
|
||
begin
|
||
FillChar(Dest^, Len, Fill);
|
||
end;
|
||
|
||
procedure MoveMemory(Dest: Pointer; Src: Pointer; Len: Cardinal);
|
||
begin
|
||
Move(Src^, Dest^, Len);
|
||
end;
|
||
|
||
procedure ZeroMemory(Dest: Pointer; Len: Cardinal);
|
||
begin
|
||
FillChar(Dest^, Len, 0);
|
||
end;
|
||
|
||
function GetDoubleClickTime: Cardinal;
|
||
begin
|
||
Result := QApplication_doubleClickInterval;
|
||
end;
|
||
|
||
function SetDoubleClickTime(Interval: Cardinal): LongBool;
|
||
begin
|
||
try
|
||
QApplication_setDoubleClickInterval(Interval);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function ReleaseCapture: LongBool;
|
||
var
|
||
Handle: QWidgetH;
|
||
begin
|
||
Handle := QWidget_mouseGrabber;
|
||
if Handle <> nil then
|
||
begin
|
||
QWidget_releaseMouse(Handle);
|
||
SetMouseGrabControl(nil); // inform CLX
|
||
Result := True;
|
||
end
|
||
else
|
||
Result := False;
|
||
end;
|
||
|
||
function SetCapture(Widget: QWidgetH): QWidgetH;
|
||
begin
|
||
Result := QWidget_mouseGrabber;
|
||
ReleaseCapture;
|
||
if Widget <> nil then
|
||
QWidget_grabMouse(Widget);
|
||
end;
|
||
|
||
function GetCapture: QWidgetH;
|
||
begin
|
||
Result := QWidget_mouseGrabber;
|
||
end;
|
||
|
||
function SetCursor(Handle: QCursorH; Save: Boolean): QCursorH;
|
||
begin
|
||
Result := QApplication_overrideCursor;
|
||
if Handle <> nil then
|
||
QApplication_setOverrideCursor(Handle, Save)
|
||
else
|
||
QApplication_restoreOverrideCursor;
|
||
end;
|
||
|
||
// limited implementation of
|
||
function GetSystemMetrics(PropItem: TSysMetrics): Integer;
|
||
var
|
||
size: TSize;
|
||
begin
|
||
case PropItem of
|
||
SM_CXVSCROLL, SM_CXHSCROLL:
|
||
begin
|
||
QStyle_scrollBarExtent(QApplication_Style, @size);
|
||
Result := size.cx;
|
||
end;
|
||
SM_CYVSCROLL, SM_CYHSCROLL:
|
||
begin
|
||
QStyle_scrollBarExtent(QApplication_Style, @size);
|
||
Result := size.cy;
|
||
end;
|
||
SM_CXSMICON, SM_CYSMICON:
|
||
Result := 16;
|
||
SM_CXICON, SM_CYICON:
|
||
Result := 32;
|
||
SM_CXSCREEN:
|
||
Result := QWidget_width(QApplication_desktop);
|
||
SM_CYSCREEN:
|
||
Result := QWidget_height(QApplication_desktop);
|
||
SM_CXBORDER, SM_CYBORDER:
|
||
Result := 1;
|
||
// (ahuser) Windows returns "1"
|
||
//QStyle_DefaultFrameWidth(QApplication_style); // (probably) wrong ?
|
||
SM_CXFRAME, SM_CYFRAME, SM_CXDLGFRAME, SM_CYDLGFRAME:
|
||
Result := QStyle_DefaultFrameWidth(QApplication_style); // or this one
|
||
SM_CYCAPTION:
|
||
Result := 19;
|
||
else
|
||
raise Exception.Create('GetSystemMetrics: unsupported property')
|
||
end;
|
||
end;
|
||
|
||
{ limited implementation of}
|
||
|
||
function GetDeviceCaps(Handle: QPainterH; devcap: TDeviceCap): Integer;
|
||
begin
|
||
Result := GetDeviceCaps(QPainter_device(Handle), devcap);
|
||
end;
|
||
|
||
function GetDeviceCaps(Handle: QPaintDeviceH; devcap: TDeviceCap): Integer;
|
||
var
|
||
pdm: QPaintDeviceMetricsH;
|
||
begin
|
||
Result := 0;
|
||
pdm := QPaintDeviceMetrics_create(Handle);
|
||
if pdm <> nil then
|
||
begin
|
||
try
|
||
case devcap of
|
||
HORZSIZE:
|
||
Result := QPaintDeviceMetrics_widthMM(pdm);
|
||
VERTSIZE:
|
||
Result := QPaintDeviceMetrics_heightMM(pdm);
|
||
PHYSICALWIDTH, HORZRES:
|
||
Result := QPaintDeviceMetrics_width(pdm); // Horizontal width in pixels
|
||
BITSPIXEL:
|
||
Result := QPaintDeviceMetrics_Depth(pdm); // Number of bits per pixel
|
||
PLANES:
|
||
Result := 1;
|
||
NUMCOLORS:
|
||
Result := QPaintDeviceMetrics_numColors(pdm);
|
||
LOGPIXELSX:
|
||
Result := QPaintDeviceMetrics_logicalDpiX(pdm); // Logical pixelsinch in X
|
||
LOGPIXELSY:
|
||
Result := QPaintDeviceMetrics_logicalDpiY(pdm); // Logical pixelsinch in Y
|
||
PHYSICALOFFSETX:
|
||
Result := 0;
|
||
PHYSICALOFFSETY:
|
||
Result := 0;
|
||
PHYSICALHEIGHT, VERTRES:
|
||
Result := QPaintDeviceMetrics_height(pdm); // Vertical height in pixels
|
||
else
|
||
raise Exception.Create('QWindows.GetDeviceCaps: unsupported capability');
|
||
end;
|
||
finally
|
||
QPaintDeviceMetrics_destroy(pdm);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function pfDevice: TPixelFormat;
|
||
var
|
||
DC: QPaintDeviceH;
|
||
begin
|
||
DC := QWidget_to_QPaintDevice(QApplication_desktop);
|
||
case GetDeviceCaps(DC, BITSPIXEL) of
|
||
1: Result := pf1bit;
|
||
8: Result := pf8bit;
|
||
16: Result := pf16bit;
|
||
24: Result := pf24bit;
|
||
32: Result := pf32bit;
|
||
else
|
||
Result := pfCustom;
|
||
end;
|
||
end;
|
||
|
||
{ a very limited implementation of }
|
||
function GetTextMetrics(Handle: QPainterH; var tt: TTextMetric): Integer;
|
||
var
|
||
fm: QFontMetricsH;
|
||
fi: QFontInfoH;
|
||
begin
|
||
FillChar(tt, SizeOf(tt), 0);
|
||
with tt do
|
||
begin
|
||
fm := QFontMetrics_create(QPainter_font(Handle));
|
||
try
|
||
tmHeight := QFontMetrics_height(fm);
|
||
tmAscent := QFontMetrics_ascent(fm);
|
||
tmDescent := QFontMetrics_descent(fm);
|
||
tmAveCharWidth := QFontMetrics_width(fm, 'x');
|
||
tmMaxCharWidth := QFontMetrics_maxWidth(fm);
|
||
//tmInternalLeading := 0;
|
||
tmExternalLeading := QFontMetrics_leading(fm);
|
||
//tmOverhang := 0;
|
||
finally
|
||
QFontMetrics_destroy(fm);
|
||
end;
|
||
|
||
fi := QFontInfo_create(QPainter_font(Handle));
|
||
try
|
||
QPainter_fontInfo(Handle, fi);
|
||
case QFontInfo_weight(fi) of
|
||
25: // Light
|
||
tmWeight := 300;
|
||
50: // Normal:
|
||
tmWeight := 400;
|
||
63: // DemiBold
|
||
tmWeight := 600;
|
||
75: // Bold
|
||
tmWeight := 700;
|
||
87: // Black
|
||
tmWeight := 900;
|
||
else
|
||
tmWeight := Round(QFontInfo_weight(fi) * 9.5);
|
||
end;
|
||
|
||
tmItalic := Ord(QFontInfo_italic(fi));
|
||
tmUnderlined := Ord(QFontInfo_underline(fi));
|
||
tmStruckOut := Ord(QFontInfo_strikeOut(fi));
|
||
if QFontInfo_fixedPitch(fi) then
|
||
tmPitchAndFamily := FIXED_PITCH
|
||
else
|
||
tmPitchAndFamily := VARIABLE_PITCH;
|
||
tmCharSet := DEFAULT_CHARSET;
|
||
finally
|
||
QFontInfo_destroy(fi);
|
||
end;
|
||
end;
|
||
Result := 0;
|
||
end;
|
||
|
||
function ColorToRGB(Color: TColor; Instance: TWidgetControl = nil): TColor;
|
||
var
|
||
FColor: QColorH;
|
||
FColorGroup: QPaletteColorGroup;
|
||
|
||
FColorRole: QColorGroupColorRole;
|
||
FPalette: QPaletteH;
|
||
|
||
function GetPaletteHandle(Widget: TWidgetControl): QPaletteH;
|
||
begin
|
||
if Widget = nil then
|
||
Result := Application.Palette.Handle
|
||
else
|
||
begin
|
||
Result := THackedWidgetControl(Widget).Palette.Handle;
|
||
while (Result = nil) and (Widget.Parent <> nil) do
|
||
begin
|
||
Widget := Widget.Parent;
|
||
Result := THackedWidgetControl(Widget).Palette.Handle;
|
||
end;
|
||
if Result = nil then
|
||
Result := Application.Palette.Handle;
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
case Color of
|
||
clColorTo..clForeground:
|
||
begin
|
||
if assigned(Instance) then
|
||
if not Instance.Enabled then
|
||
FColorGroup := QPaletteColorGroup_Disabled
|
||
else
|
||
if Instance.Focused then
|
||
FColorGroup := QPaletteColorGroup_Active
|
||
else
|
||
FColorGroup := QPaletteColorGroup_InActive
|
||
else
|
||
FColorGroup := QPaletteColorGroup_InActive ;
|
||
end;
|
||
clActiveColorTo..clActiveForeground,
|
||
clNormalColorTo..clNormalForeground,
|
||
clDisabledColorTo..clDisabledForeground:
|
||
FColorGroup := ColorGroup(Color);
|
||
else
|
||
Result := Color;
|
||
Exit;
|
||
end;
|
||
FColorRole := ColorRole(Color); {1..15}
|
||
FPalette := GetPaletteHandle(Instance);
|
||
FColor := QPalette_color(FPalette, FColorGroup, FColorRole);
|
||
Result := QColorColor(FColor);
|
||
// QColor_destroy(FColor); {not owned}
|
||
end;
|
||
|
||
|
||
function RGB(Red, Green, Blue: Integer): TColorRef;
|
||
begin
|
||
Result := (Blue shl 16) or (Green shl 8) or Red;
|
||
end;
|
||
|
||
function GetBValue(Col: TColorRef): Byte;
|
||
begin
|
||
Result := Byte((Col shr 16) and $FF);
|
||
end;
|
||
|
||
function GetGValue(Col: TColorRef): Byte;
|
||
begin
|
||
Result := Byte((Col shr 8) and $FF);
|
||
end;
|
||
|
||
function GetRValue(Col: TColorRef): Byte;
|
||
begin
|
||
Result := Byte(Col and $FF);
|
||
end;
|
||
|
||
function SetRect(var R: TRect; Left, Top, Right, Bottom: Integer): LongBool;
|
||
begin
|
||
R := Rect(Left, Top, Right, Bottom);
|
||
Result := True;
|
||
end;
|
||
|
||
function CopyRect(var Dst: TRect; const Src: TRect): LongBool;
|
||
begin
|
||
Dst := Src;
|
||
Result := True;
|
||
end;
|
||
|
||
function UnionRect(var Dst: TRect; R1, R2: TRect): LongBool;
|
||
begin
|
||
Result := True;
|
||
if IsRectEmpty(R1) then
|
||
begin
|
||
if IsRectEmpty(R2) then
|
||
Result := False // both empty
|
||
else
|
||
begin
|
||
Dst := R2;
|
||
Result := True;
|
||
end;
|
||
end
|
||
else if IsRectEmpty(R2) then
|
||
Dst := R1
|
||
else
|
||
with Dst do
|
||
begin
|
||
Left := Min(R1.Left, R2.Left);
|
||
Top := Min(R1.Top, R2.Top);
|
||
Right := Max(R1.Right, R2.Right);
|
||
Bottom := Max(R1.Bottom, R2.Bottom);
|
||
end;
|
||
end;
|
||
|
||
function IsRectEmpty(R: TRect): LongBool;
|
||
begin
|
||
with R do
|
||
Result := (Right <= Left) or (Bottom <= Top);
|
||
end;
|
||
|
||
function EqualRect(R1, R2: TRect): LongBool;
|
||
begin
|
||
Result := (R1.Left = R2.Left) and (R1.Right = R2.Right) and
|
||
(R1.Top = R2.Top) and (R1.Bottom = R2.Bottom)
|
||
end;
|
||
|
||
function EqualPoints(const P1: TPoint; const P2: TPoint): Boolean;
|
||
begin
|
||
Result := (P1.X = P2.X) and (P1.Y = P2.Y);
|
||
end;
|
||
|
||
function CenterRect(InnerRect, OuterRect: TRect): TRect;
|
||
var
|
||
w,h : Integer;
|
||
begin
|
||
w := InnerRect.Right - InnerRect.Left;
|
||
h := InnerRect.Bottom - InnerRect.Top;
|
||
Result.Left := (OuterRect.Right + OuterRect.Left - w)div 2;
|
||
Result.Top := (OuterRect.Bottom + OuterRect.Top - h)div 2;
|
||
Result := Bounds( Result.Left, Result.Top, w, h );
|
||
end;
|
||
|
||
function SubtractRect(var dR: TRect; const R1, R2: TRect): LongBool;
|
||
var
|
||
R3: TRect;
|
||
begin
|
||
try
|
||
dR := R1;
|
||
if IntersectRect(R3, R1, R2) then
|
||
begin
|
||
if EqualPoints(R3.BottomRight, R1.BottomRight) then
|
||
begin
|
||
if R3.Top = R1.Top
|
||
then
|
||
dR.Right := R3.Left
|
||
else if R3.Left = R1.Left
|
||
then
|
||
dR.Bottom := R3.Top
|
||
end
|
||
else
|
||
if EqualPoints(R3.TopLeft, R1.TopLeft) then
|
||
begin
|
||
if R3.Bottom = R1.Bottom
|
||
then
|
||
dR.Left := R3.Right
|
||
else if R3.Right = R1.Right
|
||
then
|
||
dR.Bottom := R3.Top;
|
||
end;
|
||
end;
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function IntersectRect(var R: TRect; const R1, R2: TRect): LongBool;
|
||
begin
|
||
Result := Types.IntersectRect(R, R1, R2);
|
||
end;
|
||
|
||
function PtInRect(const R: TRect; X, Y: integer): LongBool;
|
||
begin
|
||
with R do
|
||
Result := (X >= Left) and (X <= Right) and
|
||
(Y >= Top) and (Y <= Bottom);
|
||
end;
|
||
|
||
function PtInRect(const R: TRect; pt: TPoint): LongBool;
|
||
begin
|
||
Result := PtInRect(R, pt.X, Pt.Y);
|
||
end;
|
||
|
||
function PtInEllipse(const R: TRect; pt: TPoint): LongBool;
|
||
begin
|
||
Result := PointInEllipse(pt, R);
|
||
end;
|
||
|
||
function PointInEllipse(pt: TPoint; BoundingRect: TRect): boolean;
|
||
var
|
||
p, q, r, s: integer;
|
||
begin
|
||
with BoundingRect do
|
||
begin
|
||
p := 2 * pt.X - (Left + Right);
|
||
p := p * p;
|
||
q := 2 * pt.Y - (Top + Bottom);
|
||
q := q * q;
|
||
r := Right - Left;
|
||
r := r * r;
|
||
s := Bottom - Top;
|
||
s := s * s;
|
||
Result := p * s + q * r <= s * r ;
|
||
end;
|
||
end;
|
||
|
||
procedure TextOutAngle(Handle: QPainterH; Angle, Left, Top: Integer; Text: WideString);
|
||
{ deprecated use DrawText instead }
|
||
begin
|
||
try
|
||
QPainter_save(Handle);
|
||
QPainter_translate(Handle, Left, Top);
|
||
QPainter_rotate(Handle, -Angle);
|
||
QPainter_drawText(Handle, 0, 0, @Text, -1);
|
||
finally
|
||
QPainter_restore(Handle);
|
||
end;
|
||
end;
|
||
|
||
procedure RequiredState(ACanvas: TCanvas; State: TCanvasState);
|
||
begin
|
||
THackCanvas(Acanvas).RequiredState(State);
|
||
end;
|
||
|
||
procedure TextOutAngle(ACanvas: TCanvas; Angle, Left, Top: Integer; Text: WideString);
|
||
{ deprecated use DrawText instead }
|
||
begin
|
||
ACanvas.Start;
|
||
RequiredState(ACanvas, [csHandleValid, csFontValid, csBrushValid]);
|
||
TextOutAngle(ACanvas.Handle, Angle, Left, Top, Text);
|
||
ACanvas.Stop;
|
||
end;
|
||
|
||
function TextWidth(Handle: QPainterH; Caption: WideString;
|
||
QtFlags: Integer = 0): Integer;
|
||
var
|
||
R :TRect;
|
||
begin
|
||
QPainter_boundingRect(Handle, @R, @R, QtFlags, PWideString(@Caption), -1, nil);
|
||
Result := R.Right - R.Left;
|
||
end;
|
||
|
||
function TextHeight(Handle: QPainterH; Caption: WideString; R: TRect;
|
||
QtFlags: Integer = 0): Integer;
|
||
var
|
||
R1, R2: TRect;
|
||
begin
|
||
R1 := R;
|
||
R1.Bottom := MaxInt;
|
||
QPainter_boundingRect(Handle, @R1, @R2, QtFlags, PWideString(@Caption), -1, nil);
|
||
Result := R2.Bottom - R2.Top;
|
||
end;
|
||
|
||
function GetTextExtentPoint32(Handle: QPainterH; const Text: WideString; Len: Integer;
|
||
var Size: TSize): LongBool;
|
||
var
|
||
R: TRect;
|
||
begin
|
||
try
|
||
QPainter_boundingRect(Handle, @R, @R, 0, @Text, Len, nil);
|
||
with R do
|
||
begin
|
||
Size.cx := Right - Left;
|
||
Size.cy := Bottom - Top;
|
||
end;
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function GetTextExtentPoint32(Handle: QPainterH; pText: PChar; Len: Integer;
|
||
var Size: TSize): LongBool;
|
||
var
|
||
Text: WideString;
|
||
begin
|
||
Text := pText;
|
||
Result := GetTextExtentPoint32(Handle, Text, Len, Size);
|
||
end;
|
||
|
||
function GetTextExtentPoint32(Canvas: TCanvas; const Text: WideString; Len: Integer;
|
||
var Size: TSize): LongBool;
|
||
begin
|
||
Canvas.Start;
|
||
RequiredState(Canvas, [csHandleValid, csFontValid, csBrushValid]);
|
||
Result := GetTextExtentPoint32W(Canvas.Handle, PWideChar(Text), Len, Size);
|
||
Canvas.Stop;
|
||
end;
|
||
|
||
function GetTextExtentPoint32W(Handle: QPainterH; pText: PWideChar; Len: Integer;
|
||
var Size :TSize): LongBool;
|
||
var
|
||
Text: WideString;
|
||
begin
|
||
Text := pText;
|
||
Result := GetTextExtentPoint32(Handle, Text, Len, Size);
|
||
end;
|
||
|
||
function TextExtent(Handle: QPainterH; const Caption: WideString; R: TRect;
|
||
QtFlags: Integer): TRect;
|
||
var
|
||
R2: TRect;
|
||
begin
|
||
R2 := R;
|
||
R2.Bottom := MaxInt;
|
||
QPainter_boundingRect(Handle, @R2, @Result, QtFlags, PWideString(@Caption), -1, nil);
|
||
|
||
// QPainter_boundingRect(Handle, @Result, @Result, Flags, PWideString(@Caption), -1, nil);
|
||
end;
|
||
|
||
const
|
||
Ellipses = '...';
|
||
|
||
function NameEllipsis(const Name: WideString; Handle: QPainterH;
|
||
MaxLen: Integer; QtFlags: integer = 0): WideString;
|
||
var
|
||
I: Integer;
|
||
begin
|
||
if TextWidth(Handle, Name, QtFlags) > MaxLen then
|
||
begin
|
||
Result := Ellipses;
|
||
I := 0;
|
||
while TextWidth(Handle, Result, QtFlags) <= MaxLen do
|
||
begin
|
||
Inc(I);
|
||
Result := LeftStr(Name, I) + Ellipses;
|
||
end;
|
||
if I <> 0 then
|
||
Result := LeftStr(Name, I-1) + Ellipses;
|
||
end
|
||
else
|
||
Result := name;
|
||
end;
|
||
|
||
function WordEllipsis(Words: WideString; Handle: QPainterH; const R: TRect;
|
||
QtFlags: Integer = 0): WideString;
|
||
var
|
||
R2, R1: TRect;
|
||
ShortedText: WideString;
|
||
I: Integer;
|
||
|
||
function RectInsideRect(const R1, R2: TRect): Boolean;
|
||
begin
|
||
with R1 do
|
||
Result := (Left >= R2.Left) and (Right <= R2.Right) and
|
||
(Top >= R2.Top) and (Bottom <= R2.Bottom);
|
||
end;
|
||
|
||
begin
|
||
Result := ShortedText;
|
||
R1 := R;
|
||
R1.Bottom := MaxInt;
|
||
QPainter_boundingRect(Handle, @R1, @R2, QtFlags, PWideString(@Result), -1, nil);
|
||
if not RectInsideRect(R2, R) then
|
||
begin
|
||
I := 1;
|
||
ShortedText := '';
|
||
while RectInsideRect(R2, R) and (I <= Length(Words)) do
|
||
begin
|
||
repeat // one more word
|
||
ShortedText := LeftStr(Words, I);
|
||
if Words[I] = ' ' then
|
||
Break;
|
||
Inc(I);
|
||
until I > Length(Words);
|
||
Result := ShortedText + '...';
|
||
QPainter_boundingRect(Handle, @R1, @R2, QtFlags, PWideString(@Result), -1, nil);
|
||
end;
|
||
While not RectInsideRect(R2, R) and (I > 0) do
|
||
begin
|
||
repeat // one word less
|
||
Dec(I);
|
||
ShortedText := LeftStr(Words, I);
|
||
if ShortedText[I] = ' ' then
|
||
Break;
|
||
until I <= 1;
|
||
Result := ShortedText + Ellipses;
|
||
QPainter_boundingRect(Handle, @R1, @R2, QtFlags, PWideString(@Result), -1, nil);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function FileEllipsis(const FilePath: AnsiString; Handle: QPainterH; MaxLen: Integer): string;
|
||
var
|
||
Paths: TStrings;
|
||
k, i, Start: Integer;
|
||
CurPath, F: AnsiString;
|
||
begin
|
||
if TextWidth(Handle, FilePath, SingleLine) <= MaxLen then
|
||
Result := FilePath
|
||
else
|
||
begin // FilePath too long
|
||
F := FilePath;
|
||
{$IFDEF LINUX}
|
||
CurPath := IncludeTrailingPathDelimiter(GetEnvironmentVariable('HOME'));
|
||
if AnsiStartsStr(CurPath, FilePath) then
|
||
begin
|
||
F := '~/' + AnsiRightStr(FilePath, Length(FilePath) - Length(CurPath));
|
||
if TextWidth(Handle, F, SingleLine) <= MaxLen then
|
||
begin
|
||
Result := F;
|
||
Exit;
|
||
end
|
||
end;
|
||
{$ENDIF LINUX}
|
||
Paths := TStringList.Create;
|
||
try
|
||
Paths.Delimiter := PathDelim;
|
||
Paths.DelimitedText := F; // splits the filepath
|
||
if Paths[0] = '' then
|
||
Start := 1 // absolute path
|
||
else
|
||
Start := 0; // relative path
|
||
for k := Start to Paths.Count - 2 do
|
||
begin
|
||
CurPath := Paths[k];
|
||
if Length(CurPath) > 2 then // this excludes '~' '..'
|
||
begin
|
||
Paths[k] := CurPath; // replace with ellipses
|
||
I := Length(CurPath);
|
||
while (I > 0) and (TextWidth(Handle, Paths.DelimitedText, SingleLine) > MaxLen) do
|
||
begin
|
||
Dec(I);
|
||
Paths[k] := LeftStr(CurPath, I) + Ellipses;// remove a character
|
||
end;
|
||
if TextWidth(Handle, Paths.DelimitedText, SingleLine) <= MaxLen then
|
||
begin
|
||
Result := Paths.DelimitedText;
|
||
Exit;
|
||
end;
|
||
end
|
||
end;
|
||
// not succeeded.
|
||
// replace /.../.../.../<filename> with .../<filename>
|
||
// before starting to minimize filename
|
||
for k := Paths.Count - 2 downto 1 do
|
||
Paths.Delete(k);
|
||
Paths[0] := Ellipses;
|
||
if TextWidth(Handle, Paths.DelimitedText, SingleLine) > MaxLen then
|
||
begin
|
||
CurPath := Paths[1];
|
||
Paths[1] := Ellipses; // replace with ellipses
|
||
//I := 1;
|
||
//Paths[1] := CurPath; // replace with ellipses
|
||
I:= Length(CurPath);
|
||
while (I > 0) and (TextWidth(Handle, Paths.DelimitedText, SingleLine) > MaxLen) do
|
||
begin
|
||
Dec(I);
|
||
Paths[I] := LeftStr(CurPath, I) + Ellipses;// remove a character
|
||
end;
|
||
end;
|
||
Result := Paths.DelimitedText; // will be something .../Progr...
|
||
finally
|
||
Paths.Free;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function TruncatePath(const FilePath: string; Canvas: TCanvas; MaxLen: Integer): string;
|
||
begin
|
||
Canvas.Start;
|
||
try
|
||
Result := FileEllipsis(FilePath, Canvas.Handle, MaxLen);
|
||
finally
|
||
Canvas.Stop;
|
||
end;
|
||
end;
|
||
|
||
function TruncateName(const Name: WideString; Canvas: TCanvas; MaxLen: Integer; QtFlags: integer = 0): WideString;
|
||
begin
|
||
Canvas.Start;
|
||
try
|
||
Result := NameEllipsis(Name, Canvas.Handle, MaxLen, QtFlags);
|
||
finally
|
||
Canvas.Stop;
|
||
end;
|
||
end;
|
||
|
||
function DrawText2(Handle: QPainterH; var Text: WideString; Len: Integer;
|
||
var R: TRect; WinFlags: Integer): Integer;
|
||
var
|
||
Flags: Integer;
|
||
R2: TRect; // bliep bliep bl...
|
||
Caption: WideString;
|
||
FontSaved, FontSet: QFontH;
|
||
|
||
function HidePrefix(const Text: WideString): WideString;
|
||
var
|
||
i, Len: Integer;
|
||
begin
|
||
Result := Text;
|
||
Len := Length(Result);
|
||
i := 1;
|
||
while i <= Len do
|
||
begin
|
||
if (Result[i] = '&') then
|
||
begin
|
||
Delete(Result, i, 1);
|
||
Dec(Len);
|
||
if (Result[i] = '&') and (Result[i + 1] = '&') then
|
||
begin
|
||
Delete(Result, i, 1);
|
||
Dec(Len);
|
||
end;
|
||
end;
|
||
Inc(i);
|
||
end;
|
||
end;
|
||
|
||
function OnlyPrefix(const Text: WideString): WideString;
|
||
var
|
||
i, Len: Integer;
|
||
begin
|
||
Result := Text;
|
||
Len := Length(Result);
|
||
i := 1;
|
||
while i <= Len do
|
||
begin
|
||
if (Result[i] = '&') then
|
||
begin
|
||
Delete(Result, i, 1);
|
||
Dec(Len);
|
||
if (Result[i] = '&') and (Result[i + 1] = '&') then
|
||
begin
|
||
Delete(Result, i, 1);
|
||
Dec(Len);
|
||
end;
|
||
Result[i] := '&';
|
||
end
|
||
else
|
||
Result[i] := ' ';
|
||
Inc(i);
|
||
end;
|
||
end;
|
||
|
||
function CheckTabStop(WinFlags: Integer): Integer;
|
||
var
|
||
Size: Integer;
|
||
begin
|
||
if WinFlags and DT_TABSTOP <> 0 then
|
||
begin
|
||
Size := WinFlags and $FF00;
|
||
WinFlags := WinFlags - Size;
|
||
Size := (Size shr 8) and $FF;
|
||
QPainter_setTabStops(Handle, Size);
|
||
end;
|
||
Result := WinFlags;
|
||
end;
|
||
|
||
begin
|
||
FontSaved := nil;
|
||
FontSet := nil;
|
||
if len > 0 then
|
||
Caption := LeftStr(Text, len)
|
||
else
|
||
Caption := Text;
|
||
if WinFlags and DT_INTERNAL <> 0 then
|
||
begin
|
||
FontSaved := QPainter_Font(Handle);
|
||
QApplication_font(FontSet, nil);
|
||
QPainter_setFont(Handle, FontSet);
|
||
end;
|
||
Flags := Win2QtAlign(CheckTabStop(WinFlags));
|
||
if WinFlags and DT_PREFIXONLY <> 0 then
|
||
begin
|
||
Flags := Flags or ShowPrefix;
|
||
Caption := OnlyPrefix(Caption);
|
||
end
|
||
else if WinFlags and DT_HIDEPREFIX <> 0 then
|
||
begin
|
||
Flags := Flags and not ShowPrefix;
|
||
Caption := HidePrefix(Caption);
|
||
end;
|
||
if WinFlags and DT_CALCRECT = 0 then
|
||
begin
|
||
if Flags and ClipName <> 0 then
|
||
Caption := NameEllipsis(Caption, Handle, R.Right - R.Left, Flags)
|
||
else if Flags and ClipPath <> 0 then
|
||
Caption := FileEllipsis(Caption, Handle, R.Right - R.Left)
|
||
else if Flags and ClipToWord <> 0 then
|
||
Caption := WordEllipsis(Caption, Handle, R, Flags);
|
||
QPainter_save(Handle);
|
||
if Flags and DontClip = 0 then // clipping
|
||
IntersectClipRect(Handle, R); // QPainter::drawText() does not clip left/top border
|
||
QPainter_DrawText(Handle, @R, Flags, PWideString(@Caption), -1, @R2, nil);
|
||
QPainter_restore(Handle);
|
||
if ModifyString and Flags <> 0 then
|
||
begin
|
||
if len > 0 then
|
||
Caption := Caption + RightStr(Text, Length(Text)-len);
|
||
Text := Caption;
|
||
end;
|
||
Result := R2.Bottom - R2.Top;
|
||
end
|
||
else
|
||
begin
|
||
R2.Left := R.Left;
|
||
R2.Top := R.Top;
|
||
QPainter_boundingRect(Handle, @R, @R, Flags and not $3F{Alignment},
|
||
PWideString(@Caption), -1, nil);
|
||
if R.Left <> R2.Left then
|
||
OffsetRect(R, R2.Left, 0);
|
||
if R.Top <> R2.Top then
|
||
OffsetRect(R, 0, R2.Top);
|
||
// QPainter_boundingRect(Handle, @R, @R, Flags and not $3F{Alignment},
|
||
// @Caption, -1, nil);
|
||
Result := R.Bottom - R.Top;
|
||
end;
|
||
if WinFlags and DT_INTERNAL <> 0 then
|
||
QPainter_setFont(Handle, FontSaved);
|
||
end;
|
||
|
||
function DrawText(Handle :QPainterH; Text: PAnsiChar; Len: Integer;
|
||
var R: TRect; WinFlags: Integer; Angle: Integer = 0): Integer;
|
||
var
|
||
WText: WideString;
|
||
AText: string;
|
||
begin
|
||
WText := Text;
|
||
Result := DrawTextW(Handle, PWideChar(WText), Len, R, WinFlags, 0);
|
||
if (DT_MODIFYSTRING and WinFlags <> 0) and (Text <> nil) then
|
||
begin
|
||
AText := WText;
|
||
StrCopy(Text, PChar(AText));
|
||
end;
|
||
end;
|
||
|
||
function DrawText(Handle: QPainterH; var Text: WideString; Len: Integer;
|
||
x,y, w, h: Integer; WinFlags: Integer; Angle: Integer): Integer;
|
||
var
|
||
R2: TRect;
|
||
begin
|
||
R2 := Bounds(x,y,w,h);
|
||
Result := DrawTextW(Handle, PWideChar(Text), Len, R2, WinFlags, Angle);
|
||
end;
|
||
|
||
function DrawTextW(Handle :QPainterH; Text: PWideChar; Len: Integer;
|
||
var R: TRect; WinFlags: Integer; Angle: integer = 0): Integer;
|
||
var
|
||
WText: WideString;
|
||
R2: TRect;
|
||
begin
|
||
WText := Text;
|
||
|
||
R2:= R;
|
||
OffsetRect(R2, -R.Left, -R.Top);
|
||
try
|
||
QPainter_save(Handle);
|
||
QPainter_translate(Handle, R.Left, R.Top);
|
||
QPainter_rotate(Handle, -Angle);
|
||
Result := DrawText2(Handle, WText, Len, R2, WinFlags);
|
||
finally
|
||
QPainter_restore(Handle);
|
||
end;
|
||
OffsetRect(R2, R.Left, R.Top);
|
||
R := R2;
|
||
if (DT_MODIFYSTRING and WinFlags <> 0) and (Text <> nil) then
|
||
begin
|
||
Move(WText[1], Text^, Length(WText) * SizeOf(WideChar));
|
||
//WStrCopy(Text, PChar(AText));
|
||
end;
|
||
end;
|
||
|
||
function DrawTextW(Canvas :TCanvas; Text: PWideChar; Len: Integer;
|
||
var R: TRect; WinFlags: Integer; Angle: integer = 0): Integer;
|
||
begin
|
||
with Canvas do
|
||
begin
|
||
Start;
|
||
RequiredState(Canvas, [csHandleValid, csBrushValid, csFontValid]);
|
||
Result := DrawTextW(Handle, Text, Len, R, WinFlags, Angle);
|
||
Stop;
|
||
end;
|
||
end;
|
||
|
||
function DrawText(Canvas :TCanvas; Text: PAnsiChar; Len: Integer;
|
||
var R: TRect; WinFlags: Integer; Angle: Integer = 0): Integer;
|
||
begin
|
||
with Canvas do
|
||
begin
|
||
Start;
|
||
RequiredState(Canvas, [csHandleValid, csBrushValid, csFontValid]);
|
||
Result := DrawText(Handle, Text, Len, R, WinFlags, Angle);
|
||
Stop;
|
||
end;
|
||
end;
|
||
|
||
function DrawText(Handle: QPainterH; var Text: WideString; Len: Integer;
|
||
var R: TRect; WinFlags: Integer; Angle: Integer = 0): Integer;
|
||
var
|
||
R2: TRect;
|
||
begin
|
||
R2:= R;
|
||
OffsetRect(R2, -R.Left, -R.Top);
|
||
try
|
||
QPainter_save(Handle);
|
||
QPainter_translate(Handle, R.Left, R.Top);
|
||
QPainter_rotate(Handle, -Angle);
|
||
Result := DrawText2(Handle, Text, Len, R2, WinFlags);
|
||
finally
|
||
QPainter_restore(Handle);
|
||
end;
|
||
OffsetRect(R2, R.Left, R.Top);
|
||
R := R2;
|
||
end;
|
||
|
||
function DrawText(Canvas: TCanvas; Text: TCaption; Len: Integer;
|
||
var R: TRect; WinFlags: Integer; Angle: integer = 0): Integer;
|
||
begin
|
||
with Canvas do
|
||
begin
|
||
Start;
|
||
RequiredState(Canvas, [csHandleValid, csBrushValid, csFontValid]);
|
||
Result := DrawTextW(Handle, PWideChar(Text), Len, R, WinFlags, Angle);
|
||
Stop;
|
||
end;
|
||
end;
|
||
|
||
function DrawText(Handle: QPainterH; Text: TCaption; Len: Integer;
|
||
var R: TRect; WinFlags: Integer; Angle: Integer = 0): Integer; overload;
|
||
begin
|
||
Result := DrawTextW(Handle, PWideChar(Text), Len, R, WinFlags, Angle);
|
||
end;
|
||
|
||
function DrawTextEx(Handle: QPainterH; var Text: WideString; Len: Integer;
|
||
var R: TRect; WinFlags: Integer; DTParams: Pointer): Integer;
|
||
begin
|
||
Result := DrawTextW(Handle, PWideChar(Text), Len, R, WinFlags);
|
||
end;
|
||
|
||
function DrawTextEx(Handle: QPainterH; Text: PChar; Len: Integer;
|
||
var R: TRect; WinFlags: Integer; DTParams: Pointer): Integer;
|
||
begin
|
||
Result := DrawText(Handle, Text, Len, R, WinFlags);
|
||
end;
|
||
|
||
function ExtTextOut(Handle: QPainterH; X, Y: Integer; WinFlags: Cardinal;
|
||
R: PRect; const Text: WideString; Len: Integer; lpDx: Pointer): LongBool;
|
||
var
|
||
WS: WideString;
|
||
Index, Width: Integer;
|
||
Dx: PInteger;
|
||
RR{, CellRect}: TRect;
|
||
TextLen: Integer;
|
||
Canvas: TCanvas;
|
||
TextFlags: Integer;
|
||
CursorPos: TPoint;
|
||
begin
|
||
Result := False;
|
||
if (Text = '') then
|
||
Exit;
|
||
if (WinFlags and ETO_CLIPPED <> 0) and (R = nil) then
|
||
WinFlags := WinFlags and not ETO_CLIPPED;
|
||
|
||
TextFlags := GetTextAlign(Handle);
|
||
|
||
QPainter_save(Handle);
|
||
Canvas := TCanvas.Create;
|
||
try
|
||
Canvas.Handle := Handle;
|
||
Canvas.Start(False);
|
||
with Canvas do
|
||
begin
|
||
Result := True;
|
||
if WinFlags and ETO_OPAQUE <> 0 then
|
||
begin
|
||
if Brush.Style <> bsSolid then
|
||
Brush.Style := bsSolid;
|
||
if R <> nil then
|
||
FillRect(R^);
|
||
end
|
||
else
|
||
if Brush.Style = bsSolid then
|
||
Brush.Style := bsClear;
|
||
|
||
if lpDx = nil then
|
||
begin
|
||
if (WinFlags and ETO_CLIPPED <> 0) then
|
||
TextRect(R^, X, Y, Text, TextFlags and $0FFF)
|
||
else
|
||
TextOut(X, Y, Text);
|
||
end
|
||
else
|
||
begin
|
||
// put each char into its cell
|
||
TextLen := Length(Text);
|
||
if (WinFlags and ETO_OPAQUE <> 0) and (R = nil) then
|
||
begin
|
||
Dx := lpDx;
|
||
Width := 0;
|
||
for Index := 1 to TextLen do
|
||
begin
|
||
Inc(Width, Dx^);
|
||
Inc(Dx);
|
||
end;
|
||
RR.Left := X;
|
||
RR.Right := X + Width;
|
||
RR.Top := Y;
|
||
RR.Bottom := Y + TextHeight(Text);
|
||
FillRect(RR);
|
||
end;
|
||
|
||
Dx := lpDx;
|
||
SetLength(WS, 1);
|
||
for Index := 1 to TextLen do
|
||
begin
|
||
if (R <> nil) and (X >= R^.Right) then
|
||
Break;
|
||
|
||
WS[1] := Text[Index];
|
||
if WinFlags and ETO_CLIPPED <> 0 then
|
||
begin
|
||
{CellRect.Left := X;
|
||
CellRect.Right := X + Dx^;
|
||
CellRect.Top := R^.Top;
|
||
CellRect.Bottom := R^.Bottom;
|
||
if CellRect.Right > R^.Right then
|
||
CellRect.Right := R^.Right;}
|
||
TextRect(RR, X, Y, WS, TextFlags and $0FFF);
|
||
end
|
||
else
|
||
TextOut(X, Y, WS);
|
||
|
||
if Index = TextLen then
|
||
Break;
|
||
|
||
Inc(X, Dx^);
|
||
Inc(Dx);
|
||
end;
|
||
end;
|
||
end;
|
||
finally
|
||
Canvas.Stop;
|
||
Canvas.Free;
|
||
QPainter_pos(Handle, @CursorPos);
|
||
QPainter_restore(Handle);
|
||
if WinFlags and TA_UPDATECP <> 0 then
|
||
QPainter_moveTo(Handle, @CursorPos);
|
||
end;
|
||
end;
|
||
|
||
function ExtTextOut(Handle: QPainterH; X, Y: Integer; WinFlags: Cardinal;
|
||
R: PRect; pText: PChar; Len: Integer; lpDx: Pointer): LongBool;
|
||
var
|
||
ws: WideString;
|
||
begin
|
||
ws := pText;
|
||
Result := ExtTextOut(Handle, X, Y, WinFlags, R, ws, Len, lpDx);
|
||
end;
|
||
|
||
function ExtTextOutW(Handle: QPainterH; X, Y: Integer; WinFlags: Cardinal;
|
||
R: PRect; pText: PWideChar; Len: Integer; lpDx: Pointer): LongBool;
|
||
var
|
||
ws: WideString;
|
||
begin
|
||
ws := pText;
|
||
Result := ExtTextOut(Handle, X, Y, WinFlags, R, ws, Len, lpDx);
|
||
end;
|
||
|
||
function GetTextAlign(Handle: QPainterH): Cardinal;
|
||
var
|
||
P: PPainterInfo;
|
||
begin
|
||
if GetPainterInfo(Handle, P) then
|
||
Result := P.TextAlignment
|
||
else
|
||
Result := TA_LEFT or TA_TOP;
|
||
end;
|
||
|
||
function SetTextAlign(Handle: QPainterH; Mode: Cardinal): Cardinal;
|
||
begin
|
||
Result := GetTextAlign(Handle);
|
||
if Result <> Mode then
|
||
SetPainterInfo(Handle).TextAlignment := Mode;
|
||
end;
|
||
|
||
function FillRect(Handle: QPainterH; const R: TRect; Brush: QBrushH): LongBool;
|
||
begin
|
||
try
|
||
QPainter_fillRect(Handle, @R, Brush);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function DrawIcon(Handle: QPainterH; X, Y: Integer; hIcon: QPixmapH): LongBool;
|
||
var
|
||
Pt: TPoint;
|
||
begin
|
||
Pt.X := X;
|
||
Pt.Y := Y;
|
||
try
|
||
QPainter_drawPixmap(Handle, @Pt, hIcon);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function DrawIconEx(Handle: QPainterH; X, Y: Integer; hIcon: QPixmapH; W, H: Integer;
|
||
istepIfAniCur: Integer; hbrFlickerFreeDraw: QBrushH; diFlags: Cardinal): LongBool;
|
||
var
|
||
TempDC: QPainterH;
|
||
R: TRect;
|
||
begin
|
||
if diFlags = DI_DEFAULTSIZE then
|
||
begin
|
||
if W = 0 then
|
||
begin
|
||
W := GetSystemMetrics(SM_CYICON);
|
||
istepIfAniCur := 0;
|
||
end;
|
||
if H = 0 then
|
||
H := GetSystemMetrics(SM_CXICON);
|
||
end
|
||
else
|
||
begin // DI_NORMAL / DI_IMAGE / DI_MASK
|
||
if W = 0 then
|
||
begin
|
||
W := QPixmap_width(hIcon);
|
||
istepIfAniCur := 0;
|
||
end;
|
||
if H = 0 then
|
||
H := QPixmap_height(hIcon);
|
||
if (DiFlags and DI_MASK) = 0 then // DI_NORMAL / DT_IMAGE
|
||
QPixmap_setMask(hIcon, nil);
|
||
end;
|
||
|
||
if QPixmap_width(hIcon) < ((istepIfAniCur + 1) * W) then
|
||
istepIfAniCur := 0;
|
||
|
||
if hbrFlickerFreeDraw <> nil then
|
||
begin
|
||
R := Bounds(0, 0, W, H);
|
||
try
|
||
TempDC := CreateCompatibleDC(Handle, W, H);
|
||
try
|
||
FillRect(TempDC, R, hbrFlickerFreeDraw);
|
||
QPainter_drawPixmap(TempDC, 0, 0, hIcon, istepIfAniCur * W, 0, W, H);
|
||
BitBlt(Handle, X, Y, W, H, TempDC, 0, 0, RasterOp_CopyRop);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
DeleteObject(TempDC);
|
||
except
|
||
Result := False;
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
try
|
||
QPainter_drawPixmap(Handle, X, Y, hIcon, istepIfAniCur * W, 0, W, H);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function InvertRect(Handle: QPainterH; const R: TRect): LongBool;
|
||
begin
|
||
with R do
|
||
Result := BitBlt(Handle, Left, Top, Right - Left, Bottom-Top,
|
||
Handle, Left, Top, DSTINVERT);
|
||
end;
|
||
|
||
function Rectangle(Handle: QPainterH; Left, Top, Right, Bottom: Integer): LongBool;
|
||
begin
|
||
try
|
||
QPainter_drawRect(Handle, Left, Top, Right, Bottom);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function RoundRect(Handle: QPainterH; Left, Top, Right, Bottom, X3, Y3: Integer): LongBool;
|
||
begin
|
||
try
|
||
QPainter_drawRoundRect(Handle, Left, Top, Right, Bottom, X3, Y3);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function Ellipse(Handle: QPainterH; Left, Top, Right, Bottom: Integer): LongBool;
|
||
begin
|
||
try
|
||
QPainter_drawEllipse(Handle, Left, Top, Right, Bottom);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function FrameRect(Handle: QPainterH; const R: TRect; Brush: QBrushH): LongBool;
|
||
var
|
||
Pen: QPenH;
|
||
begin
|
||
Result := False;
|
||
if (Handle = nil) or (R.Right - R.Left <= 0) or (R.Bottom - R.Top <= 0) or
|
||
(Brush = nil) then
|
||
Exit;
|
||
try
|
||
Pen := nil;
|
||
QPainter_save(Handle);
|
||
try
|
||
Pen := QPen_create(QBrush_color(Brush), 1, PenStyle_SolidLine);
|
||
QPainter_setPen(Handle, Pen);
|
||
QPainter_setBrush(Handle, BrushStyle_NoBrush);
|
||
QPainter_drawRect(Handle, @R);
|
||
finally
|
||
if Assigned(Pen) then
|
||
QPen_destroy(Pen);
|
||
QPainter_restore(Handle);
|
||
end;
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
procedure FrameRect(Canvas: TCanvas; const R: TRect);
|
||
begin
|
||
Canvas.Start;
|
||
try
|
||
FrameRect(Canvas.Handle, R, Canvas.Brush.Handle);
|
||
finally
|
||
Canvas.Stop;
|
||
end;
|
||
end;
|
||
|
||
function DrawFocusRect(Handle: QPainterH; const R: TRect): LongBool;
|
||
begin
|
||
try
|
||
QPainter_drawWinFocusRect(Handle, @R);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function DrawFrameControl(Handle: QPainterH; const Rect: TRect; uType, uState: Longword): LongBool;
|
||
|
||
function GetColorGroup(uState: LongWord): QColorGroupH;
|
||
begin
|
||
if uState and DFCS_INACTIVE <> 0 then
|
||
Result := Application.Palette.ColorGroup(cgDisabled)
|
||
else if uState and DFCS_HOT <> 0 then
|
||
Result := Application.Palette.ColorGroup(cgActive)
|
||
else
|
||
Result := Application.Palette.ColorGroup(cgInActive);
|
||
end;
|
||
|
||
const
|
||
Mask = $00FF;
|
||
var
|
||
InnerRect, R: TRect;
|
||
Brush: QBrushH;
|
||
Pen: QPenH;
|
||
Font: QFontH;
|
||
Size: TSize;
|
||
QC: QColorH;
|
||
oBkMode: Integer;
|
||
MaskPainter, Painter: QPainterH;
|
||
MaskBitmap: QBitmapH;
|
||
Pixmap: QPixmapH;
|
||
// FInstance: TControl;
|
||
// FObject: TObject;
|
||
begin
|
||
Result := False;
|
||
if (Handle = nil) or (not QPainter_isActive(Handle)) then
|
||
Exit;
|
||
|
||
QPainter_save(Handle);
|
||
try
|
||
if uState and DFCS_TRANSPARENT <> 0 then
|
||
begin
|
||
Brush := nil;
|
||
oBkMode := SetBkMode(Handle, TRANSPARENT);
|
||
end
|
||
else
|
||
begin
|
||
oBkMode := SetBkMode(Handle, OPAQUE);
|
||
Brush := QPainter_brush(Handle);
|
||
|
||
if uState and DFCS_INACTIVE <> 0 then
|
||
QC := QColor(clDisabledButton)
|
||
else if uState and DFCS_HOT <> 0 then
|
||
QC := QColor(clActiveButton)
|
||
else
|
||
QC := QColor(clNormalButton);
|
||
QPainter_setBackgroundColor(Handle, QC);
|
||
QBrush_setColor(Brush, QC);
|
||
QColor_destroy(QC);
|
||
QPainter_eraseRect(Handle, @Rect);
|
||
end;
|
||
try
|
||
R := Rect;
|
||
case uType of
|
||
DFC_CAPTION:
|
||
begin
|
||
// draw button
|
||
Result := DrawFrameControl(Handle, Rect, DFC_BUTTON,
|
||
DFCS_BUTTONPUSH or (uState and not Mask));
|
||
if Result then
|
||
begin
|
||
// draw image
|
||
Pen := CreatePen(PS_SOLID, 1, clBlack);
|
||
QPainter_setPen(Handle, Pen);
|
||
QPen_destroy(Pen);
|
||
SetBkMode(Handle, TRANSPARENT);
|
||
case uState and Mask of
|
||
DFCS_CAPTIONCLOSE:
|
||
begin
|
||
SetRect(R, 0, 0, 6, 6);
|
||
R := CenterRect(R, Rect);
|
||
if (uState and DFCS_PUSHED) = 0 then
|
||
OffsetRect(R, -1, -1);
|
||
QPainter_moveTo(Handle, R.Left , R.Top);
|
||
QPainter_lineTo(Handle, R.Right, R.Bottom);
|
||
QPainter_moveTo(Handle, R.Left , R.Bottom);
|
||
QPainter_lineTo(Handle, R.Right, R.Top);
|
||
OffsetRect(R, 1, 0);
|
||
QPainter_moveTo(Handle, R.Left , R.Top);
|
||
QPainter_lineTo(Handle, R.Right, R.Bottom);
|
||
QPainter_moveTo(Handle, R.Left , R.Bottom);
|
||
QPainter_lineTo(Handle, R.Right, R.Top);
|
||
end;
|
||
DFCS_CAPTIONMIN:
|
||
begin
|
||
SetRect(R, 0, 0, 9, 9);
|
||
R := CenterRect(R, Rect);
|
||
if (uState and DFCS_PUSHED) <> 0 then
|
||
OffsetRect(R, 1, 1);
|
||
// Inc(R.Left, 4);
|
||
// Dec(R.Right, 6);
|
||
// Dec(R.Bottom, 4);
|
||
QPainter_moveTo(Handle, R.Left , R.Bottom - 1);
|
||
QPainter_lineTo(Handle, R.Right, R.Bottom - 1);
|
||
QPainter_moveTo(Handle, R.Left , R.Bottom );
|
||
QPainter_lineTo(Handle, R.Right, R.Bottom );
|
||
end;
|
||
DFCS_CAPTIONMAX:
|
||
begin
|
||
{$IFDEF MSWINDOWS}
|
||
// InflateRect(R, -4, -4);
|
||
{$ENDIF MSWINDOWS}
|
||
{$IFDEF LINUX}
|
||
// InflateRect(R, -3, -2);
|
||
{$ENDIF LINUX}
|
||
SetRect(R, 0, 0, 9, 9);
|
||
R := CenterRect(R, Rect);
|
||
if (uState and DFCS_PUSHED) <> 0 then
|
||
OffsetRect(R, 1, 1);
|
||
QPainter_drawRect(Handle, @R);
|
||
QPainter_moveTo(Handle, R.Left, R.Top + 1);
|
||
QPainter_lineTo(Handle, R.Right - 1, R.Top + 1);
|
||
end;
|
||
DFCS_CAPTIONRESTORE:
|
||
begin
|
||
QPainter_save(Handle);
|
||
SetRect(R, 0, 0, 6, 6);
|
||
R := CenterRect(R, Rect);
|
||
if (uState and DFCS_PUSHED) <> 0 then
|
||
OffsetRect(R, 1, 1);
|
||
OffsetRect(R, -2, 1);
|
||
ExcludeClipRect(Handle, R.Left, R.Top, R.Right, R.Bottom);
|
||
OffsetRect(R, 2, -3);
|
||
QPainter_drawRect(Handle, @R);
|
||
QPainter_moveTo(Handle, R.Left + 1, R.Top + 1);
|
||
QPainter_lineTo(Handle, R.Right - 1, R.Top + 1);
|
||
QPainter_restore(Handle);
|
||
|
||
OffsetRect(R, -2, 3);
|
||
QPainter_drawRect(Handle, @R);
|
||
QPainter_moveTo(Handle, R.Left + 1, R.Top + 1);
|
||
QPainter_lineTo(Handle, R.Right - 1, R.Top + 1);
|
||
QPainter_restore(Handle);
|
||
end;
|
||
DFCS_CAPTIONHELP:
|
||
begin
|
||
Font := QFont_create(Application.Font.Handle);
|
||
QFont_setBold(Font, True);
|
||
QPainter_setFont(Handle, Font);
|
||
QFont_destroy(Font);
|
||
if (uState and DFCS_PUSHED) = 0 then
|
||
OffsetRect(R, -1, -1);
|
||
OffsetRect(R, -1, 0);
|
||
DrawText(Handle, '?', 1, R, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
|
||
end;
|
||
end; // case of
|
||
end;
|
||
end; // DFC_CAPTION
|
||
|
||
DFC_MENU:
|
||
begin
|
||
// white background color. Windows paints it so we must paint it, too.
|
||
QC := QColor(clWhite);
|
||
QPainter_setBrush(Handle, QC);
|
||
QColor_destroy(QC);
|
||
|
||
case uState and Mask of
|
||
DFCS_MENUARROW: // (ahuser) this is the submenu arrow that points left-to-right !
|
||
begin
|
||
QStyle_drawArrow(Application.Style.Handle, Handle,
|
||
ArrowType_RightArrow,
|
||
uState and DFCS_PUSHED <> 0,
|
||
R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top,
|
||
GetColorGroup(uState),
|
||
uState and DFCS_INACTIVE = 0,
|
||
Brush);
|
||
Result := True;
|
||
end;
|
||
DFCS_MENUARROWRIGHT: // (ahuser) this is the right submenu arrow that points right-to-left !
|
||
begin
|
||
QStyle_drawArrow(Application.Style.Handle, Handle,
|
||
ArrowType_LeftArrow,
|
||
uState and DFCS_PUSHED <> 0,
|
||
R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top,
|
||
GetColorGroup(uState),
|
||
uState and DFCS_INACTIVE = 0,
|
||
Brush);
|
||
Result := True;
|
||
end;
|
||
DFCS_MENUCHECK:
|
||
begin
|
||
QPainter_fillRect(Handle, @R, QPainter_brush(Handle));
|
||
QStyle_drawCheckMark(Application.Style.Handle, Handle,
|
||
R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top,
|
||
GetColorGroup(uState),
|
||
uState and DFCS_CHECKED <> 0,
|
||
uState and DFCS_INACTIVE <> 0
|
||
);
|
||
Result := True;
|
||
end;
|
||
DFCS_MENUBULLET:
|
||
begin
|
||
QPainter_fillRect(Handle, @R, QPainter_brush(Handle));
|
||
R := Types.Rect(0, 0, 7, 7);
|
||
OffsetRect(R,
|
||
((Rect.Right - Rect.Left) - R.Right) div 2 + Rect.Left,
|
||
((Rect.Bottom - Rect.Top) - R.Bottom) div 2 + Rect.Top);
|
||
SetDCBrushColor(Handle, clBlack);
|
||
SetDCPenColor(Handle, clBlack);
|
||
QPainter_drawEllipse(Handle, @R);
|
||
Result := True;
|
||
end;
|
||
end;
|
||
end; // DFC_MENU
|
||
|
||
DFC_SCROLL:
|
||
begin
|
||
DrawFrameControl(Handle, Rect, DFC_BUTTON, DFCS_BUTTONPUSH or (uState and not Mask));
|
||
InflateRect(R, -2,-2);
|
||
case uState and Mask of
|
||
DFCS_SCROLLUP:
|
||
begin
|
||
QStyle_drawArrow(Application.Style.Handle, Handle,
|
||
ArrowType_UpArrow,
|
||
uState and DFCS_PUSHED <> 0,
|
||
R.Left, R.Top, R.Right-R.Left, R.Bottom-R.Top,
|
||
GetColorGroup(uState),
|
||
uState and DFCS_INACTIVE = 0,
|
||
Brush);
|
||
Result := True;
|
||
end;
|
||
DFCS_SCROLLCOMBOBOX, // looks equal to DFCS_SCROLLDOWN
|
||
DFCS_SCROLLDOWN:
|
||
begin
|
||
QStyle_drawArrow(Application.Style.Handle, Handle,
|
||
ArrowType_DownArrow,
|
||
uState and DFCS_PUSHED <> 0,
|
||
R.Left, R.Top, R.Right-R.Left, R.Bottom-R.Top,
|
||
GetColorGroup(uState),
|
||
uState and DFCS_INACTIVE = 0,
|
||
Brush);
|
||
Result := True;
|
||
end;
|
||
DFCS_SCROLLLEFT:
|
||
begin
|
||
QStyle_drawArrow(Application.Style.Handle, Handle,
|
||
ArrowType_LeftArrow,
|
||
uState and DFCS_PUSHED <> 0,
|
||
R.Left, R.Top, R.Right-R.Left, R.Bottom-R.Top,
|
||
GetColorGroup(uState),
|
||
uState and DFCS_INACTIVE = 0,
|
||
Brush);
|
||
Result := True;
|
||
end;
|
||
DFCS_SCROLLRIGHT:
|
||
begin
|
||
QStyle_drawArrow(Application.Style.Handle, Handle,
|
||
ArrowType_RightArrow,
|
||
uState and DFCS_PUSHED <> 0,
|
||
R.Left, R.Top, R.Right-R.Left, R.Bottom-R.Top,
|
||
GetColorGroup(uState),
|
||
uState and DFCS_INACTIVE = 0,
|
||
Brush);
|
||
Result := True;
|
||
end;
|
||
else
|
||
raise Exception.Create('not implemented');
|
||
end;
|
||
end; // DFC_SCROLL
|
||
|
||
DFC_BUTTON:
|
||
case uState and Mask of
|
||
DFCS_BUTTONRADIO:
|
||
begin
|
||
QStyle_exclusiveIndicatorSize(Application.Style.Handle, @Size);
|
||
OffsetRect(R, (R.Right - R.Left - Size.cx) div 2,
|
||
(R.Bottom - R.Top - Size.cy) div 2);
|
||
Pixmap := CreateCompatibleBitmap(Handle, R.Right - R.Left, R.Bottom - R.Top);
|
||
try
|
||
MaskBitmap := QBitmap_create(R.Right - R.Left, R.Bottom - R.Top,
|
||
False, QPixmapOptimization_DefaultOptim);
|
||
try
|
||
QC := QColor(clBlack);
|
||
QPixmap_fill(MaskBitmap, QC);
|
||
QColor_destroy(QC);
|
||
MaskPainter := QPainter_create(MaskBitmap);
|
||
QStyle_drawExclusiveIndicatorMask(Application.Style.Handle, MaskPainter,
|
||
0, 0, QPixmap_width(MaskBitmap), QPixmap_height(MaskBitmap),
|
||
uState and DFCS_CHECKED <> 0);
|
||
QPainter_destroy(MaskPainter);
|
||
QPixmap_setMask(Pixmap, MaskBitmap);
|
||
finally
|
||
QBitmap_destroy(MaskBitmap);
|
||
end;
|
||
|
||
Painter := QPainter_create(Pixmap);
|
||
QStyle_drawExclusiveIndicator(
|
||
Application.Style.Handle, Painter,
|
||
0, 0, R.Right - R.Left, R.Bottom - R.Top,
|
||
GetColorGroup(uState),
|
||
uState and DFCS_CHECKED <> 0,
|
||
uState and DFCS_INACTIVE <> 0,
|
||
True);
|
||
QPainter_destroy(Painter);
|
||
QPainter_drawPixmap(Handle, R.Left, R.Top, Pixmap, 0, 0,
|
||
QPixmap_width(Pixmap), QPixmap_height(Pixmap));
|
||
finally
|
||
DeleteObject(Pixmap);
|
||
end;
|
||
Result := True;
|
||
end;
|
||
DFCS_BUTTONCHECK:
|
||
begin
|
||
QStyle_drawIndicatorMask(Application.Style.Handle, Handle,
|
||
R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top, 0);
|
||
|
||
if uState and DFCS_INACTIVE = 0 then
|
||
QStyle_drawIndicator(Application.Style.Handle, Handle,
|
||
R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top,
|
||
Application.Palette.ColorGroup(cgActive), //GetColorGroup(cgInActive),
|
||
0, False, True)
|
||
else
|
||
QStyle_drawIndicator(Application.Style.Handle, Handle,
|
||
R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top,
|
||
Application.Palette.ColorGroup(cgActive), //GetColorGroup(cgInActive),
|
||
0, True, True);
|
||
InflateRect(R, -2, -2);
|
||
if uState and DFCS_CHECKED <> 0 then
|
||
DrawFrameControl(Handle, R, DFC_MENU, DFCS_MENUCHECK or (uState and not Mask));
|
||
Result := True;
|
||
end;
|
||
DFCS_BUTTONPUSH:
|
||
begin
|
||
R := Rect;
|
||
InnerRect := Rect;
|
||
InflateRect(InnerRect, -2, -2);
|
||
if uState and DFCS_ADJUSTRECT <> 0 then
|
||
PRect(@Rect)^ := InnerRect;
|
||
if uState and DFCS_FLAT <> 0 then
|
||
begin
|
||
if uState and (DFCS_PUSHED or DFCS_HOT) <> 0 then
|
||
begin
|
||
QStyle_drawButton(Application.Style.Handle, Handle,
|
||
R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top,
|
||
GetColorGroup(uState),
|
||
uState and DFCS_PUSHED <> 0,
|
||
Brush
|
||
);
|
||
{QStyle_drawPanel(Application.Style.Handle, Handle,
|
||
R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top,
|
||
GetColorGroup(uState),
|
||
uState and DFCS_PUSHED <> 0,
|
||
1,
|
||
Brush);}
|
||
InflateRect(R, -1, -1);
|
||
end;
|
||
Result := True;
|
||
end
|
||
else if uState and DFCS_MONO = 0 then
|
||
begin
|
||
QStyle_drawButton(Application.Style.Handle, Handle,
|
||
R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top,
|
||
GetColorGroup(uState),
|
||
uState and DFCS_PUSHED <> 0,
|
||
Brush);
|
||
InflateRect(R, -2, -2);
|
||
Result := True;
|
||
end
|
||
else
|
||
begin
|
||
SetDCPenColor(Handle, clBlack);
|
||
QPainter_drawRect(Handle, @R);
|
||
InflateRect(R, -1, -1);
|
||
Result := True;
|
||
end;
|
||
end;
|
||
else
|
||
// not implemented
|
||
raise Exception.Create('QWindows.DrawFrameControl: not implemented');
|
||
end;
|
||
|
||
DFC_POPUPMENU:
|
||
begin
|
||
//
|
||
QStyle_drawPopupPanel(Application.Style.Handle, Handle,
|
||
R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top,
|
||
GetColorGroup(uState), 2, Brush);
|
||
end;
|
||
end;
|
||
finally
|
||
SetBkMode(Handle, oBkMode);
|
||
end;
|
||
finally
|
||
QPainter_restore(Handle);
|
||
end;
|
||
end;
|
||
|
||
function DrawFrameControl(Canvas: TCanvas; const Rect: TRect; uType, uState: Longword): LongBool;
|
||
begin
|
||
with Canvas do
|
||
begin
|
||
Start;
|
||
RequiredState(Canvas, [csHandleValid, csBrushValid, csPenValid]);
|
||
Result := DrawFrameControl(Canvas.Handle, Rect, uType, uState);
|
||
Stop;
|
||
end;
|
||
end;
|
||
|
||
|
||
function DrawEdge(Handle: QPainterH; var Rect: TRect; Edge: Cardinal;
|
||
Flags: Cardinal): LongBool;
|
||
var
|
||
Brush: QBrushH;
|
||
ColorDark, ColorLight: TColor;
|
||
ClientRect: TRect;
|
||
|
||
procedure DrawLine(X1, Y1, X2, Y2: Integer);
|
||
begin
|
||
QPainter_moveTo(Handle, X1, Y1);
|
||
QPainter_lineTo(Handle, X2, Y2);
|
||
end;
|
||
|
||
procedure DoDrawEdge(Outer: Boolean; const R: TRect);
|
||
var
|
||
X1, Y1, X2, Y2: Integer;
|
||
ColorLeftTop, ColorRightBottom: TColor;
|
||
begin
|
||
X1 := R.Left;
|
||
Y1 := R.Top;
|
||
X2 := R.Right;
|
||
Y2 := R.Bottom;
|
||
ColorLeftTop := clNone;
|
||
ColorRightBottom := clNone;
|
||
|
||
if Outer then
|
||
begin
|
||
if Edge and BDR_RAISEDOUTER <> 0 then
|
||
begin
|
||
ColorLeftTop := ColorLight;
|
||
ColorRightBottom := ColorDark;
|
||
end
|
||
else if Edge and BDR_SUNKENOUTER <> 0 then
|
||
begin
|
||
ColorLeftTop := ColorDark;
|
||
ColorRightBottom := ColorLight;
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
if Edge and BDR_RAISEDINNER <> 0 then
|
||
begin
|
||
ColorLeftTop := ColorLight;
|
||
ColorRightBottom := ColorDark;
|
||
end
|
||
else if Edge and BDR_SUNKENINNER <> 0 then
|
||
begin
|
||
ColorLeftTop := ColorDark;
|
||
ColorRightBottom := ColorLight;
|
||
end;
|
||
end;
|
||
|
||
if Flags and BF_DIAGONAL = 0 then
|
||
begin
|
||
SetDCPenColor(Handle, ColorLeftTop);
|
||
if Flags and BF_LEFT <> 0 then
|
||
DrawLine(X1, Y1, X1, Y2);
|
||
if Flags and BF_TOP <> 0 then
|
||
DrawLine(X1, Y1, X2, Y1);
|
||
|
||
SetDCPenColor(Handle, ColorRightBottom);
|
||
if Flags and BF_RIGHT <> 0 then
|
||
DrawLine(X2, Y1, X2, Y2);
|
||
if Flags and BF_BOTTOM <> 0 then
|
||
DrawLine(X1, Y2, X2, Y2);
|
||
end
|
||
else
|
||
begin
|
||
// diagonal (does not really work properly with Qt's line algorithm)
|
||
SetDCPenColor(Handle, ColorLeftTop);
|
||
if (Flags and BF_DIAGONAL_ENDTOPLEFT = BF_DIAGONAL_ENDTOPLEFT) or
|
||
(Flags and BF_DIAGONAL_ENDBOTTOMRIGHT = BF_DIAGONAL_ENDBOTTOMRIGHT) then
|
||
DrawLine(X1, Y1, X2, Y2)
|
||
else
|
||
{if (Flags and BF_DIAGONAL_ENDBOTTOMLEFT = BF_DIAGONAL_ENDBOTTOMLEFT) or
|
||
(Flags and BF_DIAGONAL_ENDTOPRIGHT = BF_DIAGONAL_ENDTOPRIGHT) then} // default
|
||
DrawLine(X1, Y2, X2, Y1);
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
Result := False;
|
||
if Handle = nil then
|
||
Exit;
|
||
try
|
||
ClientRect := Rect;
|
||
QPainter_save(Handle);
|
||
try
|
||
ColorDark := ColorToRGB(clDark);
|
||
ColorLight := ColorToRGB(clBtnHighlight);
|
||
if Flags and BF_FLAT <> 0 then
|
||
ColorLight := clSilver;
|
||
if Flags and BF_MONO <> 0 then
|
||
begin
|
||
ColorDark := clBlack;
|
||
ColorLight := clWhite;
|
||
end;
|
||
try
|
||
if Edge and (BDR_SUNKENOUTER or BDR_RAISEDOUTER) <> 0 then
|
||
DoDrawEdge(True, Rect); // outer
|
||
InflateRect(ClientRect, -1, -1); // remove outer rect
|
||
if Flags and BF_MONO = 0 then
|
||
ColorDark := ColorToRGB(clMid);
|
||
if Edge and (BDR_SUNKENINNER or BDR_RAISEDINNER) <> 0 then
|
||
begin
|
||
DoDrawEdge(False, ClientRect); // inner
|
||
InflateRect(ClientRect, -1, -1); // remove inner rect
|
||
end;
|
||
finally
|
||
|
||
end;
|
||
|
||
if Flags and BF_MIDDLE <> 0 then
|
||
begin
|
||
// fill interior rect
|
||
Brush := CreateSolidBrush(clButton);
|
||
try
|
||
FillRect(Handle, ClientRect, Brush);
|
||
finally
|
||
DeleteObject(Brush);
|
||
end;
|
||
end;
|
||
|
||
if Flags and BF_ADJUST <> 0 then
|
||
Rect := ClientRect;
|
||
|
||
Result := True;
|
||
finally
|
||
QPainter_restore(Handle);
|
||
end;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function GetCurrentPositionEx(Handle: QPainterH; pos: PPoint): LongBool;
|
||
begin
|
||
try
|
||
QPainter_pos(Handle, pos);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function LineTo(Handle: QPainterH; X, Y:Integer): LongBool;
|
||
begin
|
||
try
|
||
QPainter_lineTo(Handle, X, Y);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function MoveToEx(Handle: QPainterH; X, Y:Integer; Point: PPoint): LongBool;
|
||
begin
|
||
try
|
||
if Point <> nil then
|
||
QPainter_pos(Handle, Point);
|
||
QPainter_moveTo(Handle, X, Y);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function GetDC(Handle: QWidgetH): QPainterH;
|
||
var
|
||
PaintDevice: QPaintDeviceH;
|
||
begin
|
||
try
|
||
if Handle = nil then
|
||
Handle := QApplication_desktop;
|
||
PaintDevice := QWidget_to_QPaintDevice(Handle);
|
||
Result := QPainter_create(PaintDevice, Handle);
|
||
if not QPainter_isActive(Result) then
|
||
QPainter_begin(Result, PaintDevice, Handle);
|
||
except
|
||
Result := nil;
|
||
end;
|
||
end;
|
||
|
||
function GetDC(Handle: Integer): QPainterH;
|
||
begin
|
||
Result := GetDC(QWidgetH(Handle));
|
||
end;
|
||
|
||
function GetWindowDC(Handle: QWidgetH): QPainterH;
|
||
begin
|
||
Result := GetDC(Handle);
|
||
end;
|
||
|
||
function ReleaseDC(wdgtH: QWidgetH; Handle: QPainterH): Integer;
|
||
begin
|
||
try
|
||
// asn: wdgtH ignored
|
||
QPainter_end(Handle);
|
||
QPainter_destroy(Handle);
|
||
Result := 1;
|
||
except
|
||
Result := 0;
|
||
end;
|
||
end;
|
||
|
||
function ReleaseDC(wdgtH: Integer; Handle: QPainterH): Integer;
|
||
begin
|
||
Result := ReleaseDC(QWidgetH(wdgtH), Handle);
|
||
end;
|
||
|
||
function DeleteDC(Handle: QPainterH): LongBool;
|
||
var
|
||
P: PPainterInfo;
|
||
begin
|
||
if GetPainterInfo(Handle, P) and P.IsCompatibleDC then
|
||
Result := DeleteObject(Handle)
|
||
else
|
||
Result := ReleaseDC(0, Handle) = 1;
|
||
end;
|
||
|
||
function CreateCompatibleDC(Handle: QPainterH; Width: Integer = 1; Height: Integer = 1): QPainterH;
|
||
var
|
||
Pixmap: QPixmapH;
|
||
DesktopPainter: Boolean;
|
||
begin
|
||
Result := nil;
|
||
try
|
||
if Handle = nil then
|
||
begin
|
||
Handle := GetDC(0);
|
||
DesktopPainter := True;
|
||
end
|
||
else
|
||
DesktopPainter := False;
|
||
try
|
||
Pixmap := CreateCompatibleBitmap(Handle, Width, Height);
|
||
if Pixmap = nil then
|
||
Exit;
|
||
Result := QPainter_create(Pixmap);
|
||
try
|
||
SetPainterInfo(Result).IsCompatibleDC := True;
|
||
QPainter_setPen(Result, QPainter_pen(Handle));
|
||
QPainter_setBackgroundColor(Result, QPainter_BackgroundColor(Handle));
|
||
QPainter_setFont(Result, QPainter_Font(Handle));
|
||
|
||
if not QPainter_isActive(Result) then
|
||
QPainter_begin(Result, QPainter_device(Result));
|
||
except
|
||
DeleteObject(Result);
|
||
Result := nil;
|
||
end;
|
||
finally
|
||
if DesktopPainter then
|
||
ReleaseDC(0, Handle);
|
||
end;
|
||
except
|
||
Result := nil;
|
||
end;
|
||
end;
|
||
|
||
function CreateCompatibleBitmap(Handle: QPainterH; Width, Height: Integer): QPixmapH;
|
||
var
|
||
pdm: QPaintDeviceMetricsH;
|
||
DesktopPainter: Boolean;
|
||
begin
|
||
Result := nil;
|
||
if (Width <= 0) or (Height <= 0) then
|
||
Exit;
|
||
if Handle = nil then
|
||
begin
|
||
Handle := GetDC(0);
|
||
DesktopPainter := True;
|
||
end
|
||
else
|
||
DesktopPainter := False;
|
||
try
|
||
if QPainter_device(Handle) <> nil then
|
||
begin
|
||
try
|
||
pdm := QPaintDeviceMetrics_create(QPainter_device(Handle));
|
||
Result := QPixmap_create(Width, Height, QPaintDeviceMetrics_depth(pdm),
|
||
QPixmapOptimization_DefaultOptim);
|
||
QPaintDeviceMetrics_destroy(pdm);
|
||
except
|
||
Result := nil;
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
try
|
||
Result := QPixmap_create(Width, Height, -1, QPixmapOptimization_DefaultOptim);
|
||
except
|
||
Result := nil;
|
||
end;
|
||
end;
|
||
finally
|
||
if DesktopPainter then
|
||
ReleaseDC(0, Handle);
|
||
end;
|
||
end;
|
||
|
||
function Convert24To32(Bits: PByte; PixelCount: Cardinal): PByte;
|
||
var
|
||
i: Integer;
|
||
P: PByte;
|
||
begin
|
||
GetMem(Result, PixelCount * 4);
|
||
P := Result;
|
||
for i := 0 to PixelCount - 1 do
|
||
begin
|
||
P^ := PByte(Bits)^;
|
||
Inc(Bits);
|
||
Inc(P);
|
||
P^ := PByte(Bits)^;
|
||
Inc(Bits);
|
||
Inc(P);
|
||
P^ := PByte(Bits)^;
|
||
Inc(Bits);
|
||
Inc(P);
|
||
P^ := 0;
|
||
Inc(P);
|
||
end;
|
||
end;
|
||
|
||
function CreateBitmap(Width, Height: Integer; Planes, BitCount: Longint; Bits: Pointer): QPixmapH;
|
||
var
|
||
Image: QImageH;
|
||
Data: PByte;
|
||
begin
|
||
if (Width <= 0) or (Height <= 0) or (Planes <= 0) or (BitCount <= 0) then
|
||
Result := nil
|
||
else
|
||
begin
|
||
try
|
||
Data := PByte(Bits);
|
||
if BitCount = 24 then
|
||
begin
|
||
BitCount := 32;
|
||
if Bits <> nil then
|
||
// convert InitBits
|
||
Data := Convert24To32(Bits, Width * Height);
|
||
end;
|
||
try
|
||
if Data = nil then
|
||
Result := QPixmap_create(Width, Height, BitCount, QPixmapOptimization_DefaultOptim)
|
||
else
|
||
begin
|
||
Image := QImage_create(Width, Height, BitCount, 0, QImageEndian_IgnoreEndian);
|
||
try
|
||
Move(Data^, QImage_bits(Image)^, (Width * Height * BitCount + 7) div 8);
|
||
Result := QPixmap_create;
|
||
try
|
||
QPixmap_convertFromImage(Result, Image, QPixmapColorMode_Auto);
|
||
except
|
||
QPixmap_destroy(Result);
|
||
Result := nil;
|
||
end;
|
||
finally
|
||
QImage_destroy(Image);
|
||
end;
|
||
end;
|
||
finally
|
||
if Data <> Bits then
|
||
FreeMem(Data);
|
||
end;
|
||
except
|
||
Result := nil;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function CreateDIBitmap(Handle: QPainterH; var InfoHeader: TBitmapInfoHeader;
|
||
dwUsage: Longword; InitBits: PChar; var InitInfo: TBitmapInfo; wUsage: Cardinal): QPixmapH;
|
||
var
|
||
Image: QImageH;
|
||
Data: PByte;
|
||
NumColors: Integer;
|
||
begin
|
||
with InfoHeader do
|
||
begin
|
||
if (biWidth <= 0) or (biHeight <= 0) or (biPlanes <> 1) or (biBitCount <= 0) then
|
||
Result := nil
|
||
else
|
||
begin
|
||
Data := PByte(InitBits);
|
||
if biBitCount = 24 then
|
||
begin
|
||
biBitCount := 32;
|
||
if (InitBits <> nil) and (dwUsage = CBM_INIT) then
|
||
// convert InitBits
|
||
Data := Convert24To32(PByte(InitBits), biWidth * biHeight);
|
||
end;
|
||
try
|
||
try
|
||
case biBitCount of
|
||
1: NumColors := 1;
|
||
4: NumColors := 16; // (ahuser) is this supported by Qt ?
|
||
8: NumColors := 256;
|
||
else
|
||
NumColors := 0;
|
||
end;
|
||
Image := QImage_create(biWidth, biHeight, biBitCount, NumColors, QImageEndian_IgnoreEndian);
|
||
try
|
||
if (dwUsage = CBM_INIT) then
|
||
begin
|
||
if (InitBits <> nil) then
|
||
Move(Data^, QImage_bits(Image)^, (biWidth * biHeight * biBitCount + 7) div 8);
|
||
case biBitCount of
|
||
1: Move(InitInfo.bmiColors[0], QImage_colorTable(Image)^, 1 * SizeOf(QRgb));
|
||
4: Move(InitInfo.bmiColors[0], QImage_colorTable(Image)^, 16 * SizeOf(QRgb)); // (ahuser) is this supported by Qt ?
|
||
8: Move(InitInfo.bmiColors[0], QImage_colorTable(Image)^, 256 * SizeOf(QRgb));
|
||
end;
|
||
end;
|
||
|
||
Result := QPixmap_create;
|
||
try
|
||
QPixmap_convertFromImage(Result, Image, QPixmapColorMode_Auto);
|
||
except
|
||
QPixmap_destroy(Result);
|
||
Result := nil;
|
||
end;
|
||
finally
|
||
QImage_destroy(Image);
|
||
end;
|
||
except
|
||
Result := nil;
|
||
end;
|
||
finally
|
||
if Data <> PByte(InitBits) then
|
||
FreeMem(Data);
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function GetBitmapBits(Bitmap: QPixmapH; Count: Longint; Bits: Pointer): Longint;
|
||
var
|
||
Image: QImageH;
|
||
begin
|
||
Result := 0;
|
||
if (Bitmap = nil) or (Count <= 0) then
|
||
Exit;
|
||
try
|
||
Image := QImage_create;
|
||
try
|
||
QPixmap_convertToImage(Bitmap, Image);
|
||
Result := (QImage_width(Image) * QImage_height(Image) * QImage_depth(Image) + 7) div 8;
|
||
if Count < Result then
|
||
Result := Count;
|
||
if Result > 0 then
|
||
Move(QImage_bits(Image)^, Bits^, Result);
|
||
finally
|
||
QImage_destroy(Image);
|
||
end;
|
||
except
|
||
Result := 0;
|
||
end;
|
||
end;
|
||
|
||
function SetBitmapBits(Bitmap: QPixmapH; Count: Longint; Bits: Pointer): Longint;
|
||
var
|
||
Image: QImageH;
|
||
begin
|
||
Result := 0;
|
||
if (Bitmap = nil) or (Count <= 0) then
|
||
Exit;
|
||
try
|
||
Image := QImage_create;
|
||
try
|
||
QPixmap_convertToImage(Bitmap, Image);
|
||
Result := (QImage_width(Image) * QImage_height(Image) * QImage_depth(Image) + 7) div 8;
|
||
if Count < Result then
|
||
Result := Count;
|
||
if Result > 0 then
|
||
Move(Bits^, QImage_bits(Image)^, Result);
|
||
QPixmap_convertFromImage(Bitmap, Image, QPixmapColorMode_Auto);
|
||
finally
|
||
QImage_destroy(Image);
|
||
end;
|
||
except
|
||
Result := 0;
|
||
end;
|
||
end;
|
||
|
||
function GetObject(Handle: QPixmapH; Size: Cardinal; Data: PtagBITMAP): Boolean;
|
||
begin
|
||
Result := False;
|
||
if (Handle <> nil) and (Size > 0) and (Data <> nil) then
|
||
begin
|
||
try
|
||
Data.bmWidth := QPixmap_width(Handle);
|
||
Data.bmHeight := QPixmap_height(Handle);
|
||
Data.bmBitsPixel := QPixmap_depth(Handle);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function GetObject(Handle: QPenH; Size: Cardinal; Data: PLogPen): Boolean;
|
||
begin
|
||
Result := False;
|
||
if (Handle <> nil) and (Size > 0) and (Data <> nil) then
|
||
begin
|
||
try
|
||
Data.lopnStyle := Cardinal(QPen_style(Handle));
|
||
Data.lopnWidth := Point(QPen_width(Handle), 0);
|
||
Data.lopnColor := QColorColor(QPen_color(Handle));
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function SetPixel(Handle: QPainterH; X, Y: Integer; Color: TColor): TColorRef;
|
||
var
|
||
Brush: QBrushH;
|
||
OldRop: RasterOp;
|
||
R: TRect;
|
||
begin
|
||
R := Bounds(X, Y, 1, 1);
|
||
Brush := CreateSolidBrush(Color);
|
||
OldRop := QPainter_rasterOp(Handle);
|
||
if OldRop <> RasterOp_CopyROP then
|
||
QPainter_setRasterOp(Handle, RasterOp_CopyROP);
|
||
FillRect(Handle, R, Brush);
|
||
if OldRop <> RasterOp_CopyROP then
|
||
QPainter_setRasterOp(Handle, OldRop);
|
||
QBrush_destroy(Brush);
|
||
Result := GetPixel(Handle, X, Y);
|
||
end;
|
||
|
||
function GetPixel(Handle: QPainterH; X, Y: Integer): TColorRef;
|
||
var
|
||
depth: Integer;
|
||
pixmap: QPixmapH;
|
||
pdm: QPaintDeviceMetricsH;
|
||
tempDC: QPainterH;
|
||
img: QImageH;
|
||
begin
|
||
try
|
||
pdm := QPaintDeviceMetrics_create(QPainter_device(Handle));
|
||
depth := QPaintDeviceMetrics_depth(pdm);
|
||
QPaintDeviceMetrics_destroy(pdm);
|
||
img := nil;
|
||
tempdc := nil;
|
||
pixmap := nil;
|
||
try
|
||
pixmap := QPixmap_create(2, 2, depth, QPixmapOptimization_NoOptim);
|
||
tempDC := QPainter_create(pixmap);
|
||
BitBlt(tempDC, 0, 0, 2, 2, Handle, X, Y, SRCCOPY);
|
||
img := QImage_create;
|
||
QPixmap_convertToImage(pixmap, img);
|
||
Result := QImage_pixelIndex(img, 0, 0);
|
||
finally
|
||
if Assigned(img) then
|
||
QImage_destroy(img);
|
||
if Assigned(tempdc) then
|
||
QPainter_destroy(tempdc);
|
||
if Assigned(pixmap) then
|
||
QPixmap_destroy(pixmap);
|
||
end;
|
||
except
|
||
Result := 0;
|
||
end;
|
||
end;
|
||
|
||
function DeleteObject(Handle: QPainterH): LongBool;
|
||
var
|
||
Pixmap: QPaintDeviceH;
|
||
P: PPainterInfo;
|
||
IsCompatible: Boolean;
|
||
begin
|
||
if Handle = nil then
|
||
Result := False
|
||
else
|
||
try
|
||
Pixmap := QPainter_device(Handle); // get paintdevice
|
||
if QPainter_isActive(Handle) then
|
||
QPainter_end(Handle);
|
||
|
||
IsCompatible := GetPainterInfo(Handle, P) and (P.IsCompatibleDC);
|
||
if P <> nil then
|
||
DeletePainterInfo(Handle);
|
||
QPainter_destroy(Handle); // destroy painter
|
||
if IsCompatible then
|
||
QPixmap_destroy(QPixmapH(Pixmap)); // destroy pixmap paintdevice
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function DeleteObject(Handle: QPixmapH): LongBool;
|
||
begin
|
||
try
|
||
// if not TStockObjectList.ReleaseStockObject(Handle) then
|
||
QPixmap_destroy(Handle);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function SaveDC(Handle: QPainterH): Integer;
|
||
begin
|
||
try
|
||
QPainter_save(Handle);
|
||
Result := -1;
|
||
except
|
||
Result := 0;
|
||
end;
|
||
end;
|
||
|
||
{ only negative and zero values of nSaveDC are supported }
|
||
function RestoreDC(Handle: QPainterH; nSavedDC: Integer): LongBool;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
if nSavedDC < 0 then
|
||
begin
|
||
try
|
||
for i:= nSavedDC - 1 to 0 do // nSavedDC
|
||
QPainter_restore(Handle);
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end
|
||
else // limited implementation
|
||
Result := True;
|
||
end;
|
||
|
||
function HWND_DESKTOP: QWidgetH;
|
||
begin
|
||
Result := QApplication_desktop;
|
||
end;
|
||
|
||
function GetDesktopWindow: QWidgetH;
|
||
begin
|
||
Result := HWND_DESKTOP;
|
||
end;
|
||
|
||
function GetActiveWindow: QWidgetH;
|
||
begin
|
||
Result := QApplication_activeWindow(Application.Handle);
|
||
end;
|
||
|
||
function GetForegroundWindow: QWidgetH;
|
||
begin
|
||
// is this correct ?
|
||
Result := QApplication_focusWidget(Application.Handle);
|
||
end;
|
||
|
||
procedure SetActiveWindow(Handle: QWidgetH);
|
||
begin
|
||
QWidget_setActiveWindow(Handle);
|
||
end;
|
||
|
||
// maps DT_ alignment flags to Qt (extended) alignment flags
|
||
function Win2QtAlign(Flags: Integer): Integer;
|
||
begin
|
||
Result := 0;
|
||
// Singleline & multiline
|
||
if Flags and DT_SINGLELINE <> 0 then
|
||
Result := SingleLine
|
||
// multiline:
|
||
else if Flags and DT_WORDBREAK <> 0 then
|
||
Result := Result or WordBreak;
|
||
// else
|
||
// Result := Result or BreakAnywhere;
|
||
// <tab> and '&' prefix
|
||
if Flags and DT_EXPANDTABS <> 0 then
|
||
Result := Result or ExpandTabs;
|
||
if Flags and DT_NOPREFIX = 0 then
|
||
Result := Result or ShowPrefix;
|
||
// Horizontal alignment
|
||
if Flags and DT_RIGHT <> 0 then
|
||
Result := Result or AlignRight
|
||
else if Flags and DT_CENTER <> 0 then
|
||
Result := Result or AlignHCenter
|
||
else
|
||
Result := Result or AlignLeft; // default
|
||
// vertical alignment
|
||
if Flags and DT_BOTTOM <> 0 then
|
||
Result := Result or AlignTop
|
||
else if Flags and DT_VCENTER <> 0 then
|
||
Result := Result or AlignVCenter
|
||
else
|
||
Result := Result or AlignTop; // default
|
||
// extended Qt alignments
|
||
if Flags and DT_CALCRECT <> 0 then
|
||
Result := Result or CalcRect
|
||
else
|
||
begin
|
||
if Flags and DT_ELLIPSIS <> 0 then
|
||
Result := Result or ClipName or SingleLine
|
||
else if Flags and DT_PATH_ELLIPSIS <> 0 then
|
||
Result := Result or ClipPath or SingleLine
|
||
else if Flags and DT_WORD_ELLIPSIS <> 0 then
|
||
Result := Result or ClipToWord;
|
||
if Flags and DT_MODIFYSTRING <> 0 then
|
||
Result := Result or ModifyString;
|
||
end;
|
||
if Flags and DT_NOCLIP <> 0 then
|
||
Result := Result or DontClip;
|
||
end;
|
||
|
||
{ strips Qt extended alignment from flags }
|
||
function QtStdAlign(Flags: Integer): Word;
|
||
begin
|
||
Result := Word(Flags and QtAlignMask);
|
||
end;
|
||
|
||
|
||
function IsCharAlpha(Ch: Char): LongBool;
|
||
begin
|
||
{$IFDEF MSWINDOWS}
|
||
Result := Windows.IsCharAlpha(Ch);
|
||
{$ENDIF MSWINDOWS}
|
||
{$IFDEF LINUX}
|
||
Result := IsAlpha(cardinal(ch)) <> 0 ;
|
||
{$ENDIF LINUX}
|
||
end;
|
||
|
||
function IsCharAlphaNumeric(Ch: Char): LongBool;
|
||
begin
|
||
Result := (Ch in ['0'..'9']) or IsCharAlpha(Ch);
|
||
end;
|
||
|
||
{ IP Address edit control }
|
||
|
||
function MAKEIPRANGE(low, high: Byte): integer;
|
||
begin
|
||
Result := high;
|
||
Result := (Result shl 8) + low;
|
||
end;
|
||
|
||
function MAKEIPADDRESS(b1, b2, b3, b4: cardinal): integer;
|
||
begin
|
||
Result := (b1 shl 24) + (b2 shl 16) + (b3 shl 8) + b4;
|
||
end;
|
||
|
||
function FIRST_IPADDRESS(x: cardinal): cardinal;
|
||
begin
|
||
Result := (x shr 24) and $FF;
|
||
end;
|
||
|
||
function SECOND_IPADDRESS(x: cardinal): cardinal;
|
||
begin
|
||
Result := (x shr 16) and $FF;
|
||
end;
|
||
|
||
function THIRD_IPADDRESS(x: cardinal): cardinal;
|
||
begin
|
||
Result := (x shr 8) and $FF;
|
||
end;
|
||
|
||
function FOURTH_IPADDRESS(x: cardinal): cardinal;
|
||
begin
|
||
Result := x and $FF;
|
||
end;
|
||
|
||
{$IFDEF LINUX}
|
||
function FileGetAttr(const FileName: string): Integer;
|
||
var
|
||
sr: TSearchRec;
|
||
valid: Boolean;
|
||
begin
|
||
Result := 0;
|
||
valid := FindFirst(FileName, faAnyFile, sr) = 0;
|
||
if valid then
|
||
begin
|
||
Result := sr.attr;
|
||
FindClose(sr);
|
||
end;
|
||
end;
|
||
|
||
function FileGetSize(const FileName: string): Cardinal;
|
||
var
|
||
sr: TSearchRec;
|
||
valid: Boolean;
|
||
begin
|
||
Result := 0;
|
||
valid := FindFirst(FileName, faAnyFile, sr) = 0;
|
||
if valid then
|
||
begin
|
||
Result := sr.size;
|
||
FindClose(sr);
|
||
end;
|
||
end;
|
||
|
||
function FileGetTime(const FileName: string): Integer;
|
||
var
|
||
sr: TSearchRec;
|
||
valid: Boolean;
|
||
begin
|
||
Result := 0;
|
||
valid := FindFirst(FileName, faAnyFile, sr) = 0;
|
||
if valid then
|
||
begin
|
||
Result := sr.time;
|
||
FindClose(sr);
|
||
end;
|
||
end;
|
||
|
||
function CopyFile(const Source, Destination: string; FailIfExists: Boolean): LongBool;
|
||
const
|
||
ChunkSize = 8192;
|
||
var
|
||
CopyBuffer: Pointer;
|
||
Src, Dest: Integer;
|
||
{FSize,} BytesCopied {, TotalCopied}: Longint;
|
||
DestName: string;
|
||
begin
|
||
Result := False;
|
||
if DirectoryExists(Destination) then
|
||
DestName := IncludeTrailingPathDelimiter(Destination) + ExtractFileName(Source)
|
||
else
|
||
DestName := Destination;
|
||
if FailIfExists and FileExists(DestName) then
|
||
Exit;
|
||
Result := ForceDirectories(ExtractFilePath(Destination));
|
||
if Result then
|
||
begin
|
||
GetMem(CopyBuffer, ChunkSize);
|
||
try
|
||
Dest := FileCreate(DestName);
|
||
if Dest < 0 then
|
||
raise EFCreateError.CreateFmt(SFCreateError, [DestName]);
|
||
try
|
||
// TotalCopied := 0;
|
||
Src := FileOpen(source, fmShareDenyWrite);
|
||
if Src < 0 then
|
||
raise EFOpenError.CreateFmt(SFOpenError, [source]);
|
||
try
|
||
//FSize := GetFileSize(source);
|
||
repeat
|
||
BytesCopied := FileRead(Src, CopyBuffer^, ChunkSize);
|
||
if BytesCopied = -1 then
|
||
raise EReadError.Create(SReadError);
|
||
// TotalCopied := TotalCopied + BytesCopied;
|
||
if BytesCopied > 0 then
|
||
begin
|
||
if FileWrite(Dest, CopyBuffer^, BytesCopied) = -1 then
|
||
raise EWriteError.Create(SWriteError);
|
||
end;
|
||
until BytesCopied < ChunkSize;
|
||
FileSetDate(DestName, FileGetDate(Src));
|
||
Result := True;
|
||
finally
|
||
FileClose(Src);
|
||
end;
|
||
finally
|
||
FileClose(Dest);
|
||
end;
|
||
finally
|
||
FreeMem(CopyBuffer, ChunkSize);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function CopyFile(lpExistingFileName, lpNewFileName: PChar;
|
||
bFailIfExists: LongBool): LongBool;
|
||
var
|
||
EF, NF: string;
|
||
begin
|
||
EF := lpExistingFileName;
|
||
NF := lpNewFilename;
|
||
Result := CopyFile(EF, NF, Boolean(bFailIfExists));
|
||
end;
|
||
|
||
function CopyFileA(lpExistingFileName, lpNewFileName: PAnsiChar;
|
||
bFailIfExists: LongBool): LongBool;
|
||
var
|
||
EF, NF: string;
|
||
begin
|
||
EF := lpExistingFileName;
|
||
NF := lpNewFilename;
|
||
Result := CopyFile(EF, NF, Boolean(bFailIfExists));
|
||
end;
|
||
|
||
function CopyFileW(lpExistingFileName, lpNewFileName: PWideChar;
|
||
bFailIfExists: LongBool): LongBool;
|
||
var
|
||
EF, NF: string;
|
||
begin
|
||
EF := lpExistingFileName;
|
||
NF := lpNewFilename;
|
||
Result := CopyFile(EF, NF, bFailIfExists);
|
||
end;
|
||
|
||
function GetComputerName(Buffer: PChar; var Size: Cardinal): LongBool;
|
||
var
|
||
S: string;
|
||
begin
|
||
Result := True;
|
||
try
|
||
SetLength(S, 255);
|
||
if gethostname(PChar(S), Length(S)) <> -1 then
|
||
begin
|
||
SetLength(S, StrLen(PChar(S)));
|
||
Size := Length(S) + 1;
|
||
Result := S <> '';
|
||
if Result and (Buffer <> nil) then
|
||
StrLCopy(Buffer, PChar(S), Size - 1);
|
||
end;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function GetUserName(Buffer: PChar; var Size: Cardinal): LongBool;
|
||
var
|
||
S: string;
|
||
psswrd: PPasswordRecord;
|
||
begin
|
||
Result := False;
|
||
try
|
||
psswrd := getpwuid(getuid); // static no need to free
|
||
if psswrd <> nil then
|
||
begin
|
||
S := psswrd.pw_gecos; // user's real name? or pwd.pw_name
|
||
Size := Length(S) + 1;
|
||
Result := S <> '';
|
||
if Result and (Buffer <> nil) then
|
||
StrLCopy(Buffer, PChar(S), Size - 1);
|
||
end;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function MakeIntResource(Value: Integer): PChar;
|
||
begin
|
||
Result := PChar(Value and $0000ffff);
|
||
end;
|
||
|
||
function MakeWord(A, B: Byte): Word;
|
||
begin
|
||
Result := A or B shl 8;
|
||
end;
|
||
|
||
function MakeLong(A, B: Word): Longint;
|
||
begin
|
||
Result := A or B shl 16;
|
||
end;
|
||
|
||
function HiWord(L: DWORD): Word;
|
||
begin
|
||
Result := L shr 16;
|
||
end;
|
||
|
||
function HiByte(W: Word): Byte;
|
||
begin
|
||
Result := W shr 8;
|
||
end;
|
||
|
||
procedure MessageBeep(Value: Integer);
|
||
begin
|
||
QApplication_beep;
|
||
end;
|
||
|
||
procedure OutputDebugString(OutputString: AnsiString);
|
||
begin
|
||
WriteLn(ErrOutput, Format('%s %s (%d)', [OutputString, ExtractFilename(Application.ExeName), GetCurrentThreadID]));
|
||
end;
|
||
|
||
procedure OutputDebugString(lpOutputString: PAnsiChar);
|
||
begin
|
||
OutputDebugString(string(lpOutputString));
|
||
end;
|
||
|
||
function GetCurrentProcess: THandle;
|
||
begin
|
||
Result := THandle(0);
|
||
end;
|
||
|
||
function CheckThreadError(ErrCode: Integer): Integer;
|
||
begin
|
||
if ErrCode <> 0 then
|
||
raise EThread.CreateResFmt(@SQThreadError, [SysErrorMessage(ErrCode), ErrCode]);
|
||
Result := ErrCode;
|
||
end;
|
||
|
||
function TerminateThread(ThreadID: TThreadID; RetVal: Integer): LongBool;
|
||
begin
|
||
case RetVal of
|
||
0:
|
||
Result := CheckThreadError(pthread_kill(ThreadID, SIGQUIT)) = 0;
|
||
130:
|
||
Result := CheckThreadError(pthread_kill(ThreadID, SIGABRT)) = 0; /// CTRL_C
|
||
else
|
||
Result := CheckThreadError(pthread_kill(ThreadID, SIGKILL))= 0; // unmaskable
|
||
end;
|
||
end;
|
||
|
||
function SuspendThread(ThreadID: TThreadID): LongBool;
|
||
begin
|
||
Result := CheckThreadError(pthread_kill(ThreadID, SIGSTOP)) = 0;
|
||
end;
|
||
|
||
function ResumeThread(ThreadID: TThreadID): LongBool;
|
||
begin
|
||
Result := CheckThreadError(pthread_kill(ThreadID, SIGCONT)) = 0;
|
||
end;
|
||
|
||
function GetThreadPolicy(ThreadID: TThreadID): Integer;
|
||
var
|
||
SP: TSchedParam;
|
||
begin
|
||
CheckThreadError(pthread_getschedparam(ThreadID, Result, SP));
|
||
end;
|
||
|
||
procedure SetThreadPolicy(ThreadID: TThreadID; value: Integer);
|
||
var
|
||
SP: TSchedParam;
|
||
begin
|
||
if Value <> GetThreadPolicy(ThreadID) then
|
||
begin
|
||
SP.sched_priority := GetThreadPriority(ThreadID);
|
||
CheckThreadError(pthread_setschedparam(ThreadID, Value, @SP));
|
||
end;
|
||
end;
|
||
|
||
function GetThreadPriority(ThreadID: TThreadID): TThreadPriority;
|
||
var
|
||
P: Integer;
|
||
SP: TSchedParam;
|
||
begin
|
||
if CheckThreadError(pthread_getschedparam(ThreadID, P, SP)) <> 0
|
||
then
|
||
Result := THREAD_PRIORITY_ERROR_RETURN
|
||
else
|
||
Result := SP.sched_priority;
|
||
end;
|
||
|
||
function SetThreadPriority(ThreadID: TThreadID; priority: Integer): LongBool; // handle to the thread
|
||
var
|
||
SP: TSchedParam;
|
||
P: Integer;
|
||
begin
|
||
if priority <> GetThreadPriority(ThreadID) then
|
||
begin
|
||
SP.sched_priority := priority;
|
||
P:= GetThreadPolicy(ThreadID);
|
||
CheckThreadError(pthread_setschedparam(ThreadID, P, @SP));
|
||
Result := errno = 0;
|
||
end
|
||
else
|
||
Result := True;
|
||
end;
|
||
|
||
function VirtualProtect(lpAddress: Pointer; dwSize, flNewProtect: Cardinal;
|
||
lpflOldProtect: Pointer): LongBool; overload;
|
||
var
|
||
AlignedAddress: Cardinal;
|
||
PageSize, ProtectSize: Cardinal;
|
||
begin
|
||
if lpflOldProtect <> nil then
|
||
begin
|
||
// (ahuser) I have not found a Libc function for that
|
||
PCardinal(lpflOldProtect)^ := PAGE_EXECUTE_READWRITE;
|
||
end;
|
||
|
||
PageSize := Cardinal(Libc.getpagesize);
|
||
AlignedAddress := Cardinal(lpAddress) and not (PageSize - 1); // start memory page
|
||
// get the number of needed memory pages
|
||
ProtectSize := PageSize;
|
||
while Cardinal(lpAddress) + dwSize > AlignedAddress + ProtectSize do
|
||
Inc(ProtectSize, PageSize);
|
||
Result := mprotect(Pointer(AlignedAddress), ProtectSize, flNewProtect) = 0;
|
||
end;
|
||
|
||
function VirtualProtect(lpAddress: Pointer; dwSize, flNewProtect: Cardinal;
|
||
var OldProtect: Cardinal): LongBool; overload;
|
||
begin
|
||
Result := VirtualProtect(lpAddress, dwSize, flNewProtect, @OldProtect);
|
||
end;
|
||
|
||
function ReadProcessMemory(hProcess: THandle; const lpBaseAddress: Pointer;
|
||
lpBuffer: Pointer; nSize: LongWord; var lpNumberOfBytesRead: Cardinal): LongBool;
|
||
var
|
||
OldProt, Dummy: Cardinal;
|
||
begin
|
||
Result := False;
|
||
lpNumberOfBytesRead := 0;
|
||
if (hProcess = GetCurrentProcess) and (lpBuffer <> nil) then
|
||
begin
|
||
if nSize = 0 then
|
||
Result := True
|
||
else
|
||
if VirtualProtect(lpBaseAddress, nSize, PAGE_EXECUTE_READWRITE, OldProt) then
|
||
begin
|
||
try
|
||
Move(lpBaseAddress^, lpBuffer^, nSize);
|
||
lpNumberOfBytesRead := nSize;
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
VirtualProtect(lpBaseAddress, nSize, OldProt, Dummy);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function WriteProcessMemory(hProcess: THandle; const lpBaseAddress: Pointer;
|
||
lpBuffer: Pointer; nSize: LongWord; var lpNumberOfBytesWritten: Longword): LongBool;
|
||
var
|
||
OldProt, Dummy: Cardinal;
|
||
begin
|
||
Result := False;
|
||
lpNumberOfBytesWritten := 0;
|
||
if (hProcess = GetCurrentProcess) and (lpBuffer <> nil) then
|
||
begin
|
||
if nSize = 0 then
|
||
Result := True
|
||
else
|
||
if VirtualProtect(lpBaseAddress, nSize, PAGE_EXECUTE_READWRITE, OldProt) then
|
||
begin
|
||
try
|
||
Move(lpBuffer^, lpBaseAddress^, nSize);
|
||
lpNumberOfBytesWritten := nSize;
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
VirtualProtect(lpBaseAddress, nSize, OldProt, Dummy);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure FlushInstructionCache(PID: cardinal; OrgCalProc: Pointer; size: Integer);
|
||
asm
|
||
JMP @@Exit
|
||
// 64 Bytes:
|
||
DD 0, 0, 0, 0, 0, 0, 0, 0
|
||
DD 0, 0, 0, 0, 0, 0, 0, 0
|
||
@@Exit:
|
||
end;
|
||
|
||
function GetKeyState(nVirtKey: Integer): SmallInt;
|
||
begin
|
||
Result := 0;
|
||
case nVirtKey of
|
||
Key_Shift:
|
||
if ssShift in Application.KeyState then
|
||
Result := -32768; // = $8000
|
||
Key_Control:
|
||
if ssCtrl in Application.KeyState then
|
||
Result := -32768;
|
||
Key_Menu:
|
||
if ssAlt in Application.KeyState then
|
||
Result := -32768;
|
||
end;
|
||
end;
|
||
|
||
function GetAsyncKeyState(vKey: Integer): SmallInt;
|
||
var
|
||
Root: Window;
|
||
Child: Window;
|
||
RootX, RootY, WinX, WinY: Longint;
|
||
Mask: Cardinal;
|
||
begin
|
||
XQueryPointer(Application.Display,
|
||
XRootWindow(Application.Display, XDefaultScreen(Application.Display)),
|
||
@Root, @Child, @RootX, @RootY, @WinX, @WinY, @Mask);
|
||
Result := 0;
|
||
case vKey of
|
||
VK_SHIFT:
|
||
if Mask and ShiftMask <> 0 then
|
||
Result := -32768; // = $8000
|
||
VK_CONTROL:
|
||
if Mask and ControlMask <> 0 then
|
||
Result := -32768;
|
||
VK_MENU:
|
||
if Mask and Mod1Mask <> 0 then
|
||
Result := -32768;
|
||
end;
|
||
end;
|
||
|
||
|
||
// Handle-Values and IPC
|
||
type
|
||
THandleObjectList = class;
|
||
|
||
THandleObject = class(TObject)
|
||
private
|
||
FRefCount: Integer;
|
||
FName: string;
|
||
FList: THandleObjectList;
|
||
public
|
||
constructor Create(AList: THandleObjectList; const AName: string);
|
||
destructor Destroy; override;
|
||
procedure AddRef;
|
||
procedure Release;
|
||
|
||
property Name: string read FName;
|
||
property List: THandleObjectList read FList;
|
||
end;
|
||
|
||
TWaitObject = class(THandleObject)
|
||
constructor Create(const AName: string);
|
||
function WaitFor(Timeout: Longword): Cardinal; virtual; abstract;
|
||
end;
|
||
|
||
THandleObjectList = class(TObjectList)
|
||
private
|
||
FLockHandle: TSemaphore;
|
||
function GetItems(Index: Integer): THandleObject;
|
||
public
|
||
constructor Create;
|
||
destructor Destroy; override;
|
||
procedure Enter;
|
||
procedure Leave;
|
||
function Find(const AName: string): THandleObject;
|
||
property Items[Index: Integer]: THandleObject read GetItems;
|
||
end;
|
||
|
||
TSemaphoreWaitObject = class(TWaitObject)
|
||
private
|
||
FOwnSem: Boolean;
|
||
FSemId: Integer;
|
||
public
|
||
constructor Create(InitialCount, Max: Integer; const AName: string; Open: Boolean);
|
||
destructor Destroy; override;
|
||
function WaitFor(Timeout: Longword): Cardinal; override;
|
||
function ReleaseSemaphore(ReleaseCount: Integer; PreviousCount: PInteger): Boolean;
|
||
end;
|
||
|
||
TEventWaitObject = class(TWaitObject)
|
||
private
|
||
FManualReset: Boolean;
|
||
FEvent: TEvent;
|
||
FSignaled: Boolean;
|
||
public
|
||
constructor Create(EventAttributes: PSecurityAttributes;
|
||
ManualReset, InitialState: LongBool; const AName: string);
|
||
destructor Destroy; override;
|
||
function WaitFor(Timeout: Longword): Cardinal; override;
|
||
function SetEvent: Boolean;
|
||
function ResetEvent: Boolean;
|
||
end;
|
||
|
||
TEventTimeoutThread = class(TThread)
|
||
private
|
||
FStopped: Boolean;
|
||
FEvent: TEventWaitObject;
|
||
FTimeout: Integer;
|
||
protected
|
||
procedure Execute; override;
|
||
public
|
||
constructor Create(AEvent: TEventWaitObject; ATimeout: Integer);
|
||
property Stopped: Boolean read FStopped write FStopped;
|
||
end;
|
||
|
||
TMutexWaitObject = class(TSemaphoreWaitObject)
|
||
private
|
||
FOwnerThreadId: Cardinal;
|
||
FThreadLocks: Integer;
|
||
FCritSect: TRTLCriticalSection;
|
||
public
|
||
constructor Create(const AName: string; Open: Boolean);
|
||
destructor Destroy; override;
|
||
function WaitFor(Timeout: Longword): Cardinal; override;
|
||
function ReleaseMutex: Boolean;
|
||
end;
|
||
|
||
var
|
||
WaitObjectList: THandleObjectList;
|
||
|
||
{ THandleObject }
|
||
|
||
constructor THandleObject.Create(AList: THandleObjectList; const AName: string);
|
||
begin
|
||
inherited Create;
|
||
FList := AList;
|
||
FName := AName;
|
||
FRefCount := 0;
|
||
if Assigned(FList) then
|
||
FList.Add(Self);
|
||
AddRef;
|
||
end;
|
||
|
||
destructor THandleObject.Destroy;
|
||
begin
|
||
if Assigned(FList) then
|
||
FList.Extract(Self);
|
||
inherited Destroy;
|
||
end;
|
||
|
||
procedure THandleObject.AddRef;
|
||
begin
|
||
Inc(FRefCount);
|
||
end;
|
||
|
||
procedure THandleObject.Release;
|
||
begin
|
||
Dec(FRefCount);
|
||
if FRefCount <= 0 then
|
||
Free;
|
||
end;
|
||
|
||
{ TWaitObject }
|
||
|
||
constructor TWaitObject.Create(const AName: string);
|
||
begin
|
||
inherited Create(WaitObjectList, AName);
|
||
end;
|
||
|
||
{ THandleObjectList }
|
||
|
||
constructor THandleObjectList.Create;
|
||
begin
|
||
inherited Create;
|
||
sem_init(FLockHandle, False, 1);
|
||
end;
|
||
|
||
destructor THandleObjectList.Destroy;
|
||
begin
|
||
sem_destroy(FLockHandle);
|
||
inherited Destroy;
|
||
end;
|
||
|
||
procedure THandleObjectList.Enter;
|
||
begin
|
||
sem_wait(FLockHandle);
|
||
end;
|
||
|
||
procedure THandleObjectList.Leave;
|
||
begin
|
||
sem_post(FLockHandle);
|
||
end;
|
||
|
||
function THandleObjectList.GetItems(Index: Integer): THandleObject;
|
||
begin
|
||
Result := THandleObject(inherited Items[Index]);
|
||
end;
|
||
|
||
function THandleObjectList.Find(const AName: string): THandleObject;
|
||
var
|
||
I: Integer;
|
||
begin
|
||
if AName <> '' then
|
||
begin
|
||
for I := 0 to Count - 1 do
|
||
begin
|
||
Result := Items[I];
|
||
if Result.Name = AName then
|
||
Exit;
|
||
end;
|
||
end;
|
||
Result := nil;
|
||
end;
|
||
|
||
{ TSemaphoreWaitObject }
|
||
|
||
// asn: documented, but (afaics) not in libc.so.6
|
||
//function semtimedop; external libcmodulename name 'semtimedop';
|
||
|
||
function semtimedop(semid: Integer; sops: PSemaphoreBuffer;
|
||
nsops: size_t;timeout: PTimeSpec): Integer;
|
||
var
|
||
sem: TSemaphoreBuffer;
|
||
psem: PSemaphoreBuffer;
|
||
i: Integer;
|
||
WaitTicks, StartTicks: cardinal;
|
||
begin
|
||
if timeout = nil then
|
||
Result := semop(semid, sops, nsops)
|
||
else
|
||
begin
|
||
Result := 0; // incase nsops = 0
|
||
WaitTicks := 1000 * timeout.tv_sec + timeout.tv_nsec div 1000000;
|
||
psem := sops;
|
||
StartTicks := GetTickCount ;
|
||
try
|
||
for i:= 0 to nsops-1 do
|
||
begin
|
||
sem := psem^ ;
|
||
sem.sem_flg := sem.sem_flg OR IPC_NOWAIT;
|
||
|
||
// process one sem
|
||
while (GetTickCount - StartTicks) <= WaitTicks do
|
||
begin
|
||
Result := semop(semid, @sem, 1);
|
||
if Result <> -1 then
|
||
begin
|
||
inc(psem); // succes, next semaphore
|
||
break;
|
||
end
|
||
else
|
||
begin
|
||
if (errno = EAGAIN) and ((psem^.sem_flg and IPC_NOWAIT) = 0)
|
||
then
|
||
Sleep(10) // try again
|
||
else
|
||
Exit; // no wait allowed or other error
|
||
end;
|
||
end; // while
|
||
|
||
if (Result = -1) and (errno <> EAGAIN) then
|
||
break;
|
||
end; // for i:= 0 to ..
|
||
except
|
||
Result := -1;
|
||
// errno := EFAULT;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function GetIPCKey(const AName: string; What: Integer): Integer;
|
||
var
|
||
Filename: string;
|
||
begin
|
||
if AName = '' then
|
||
Result := IPC_PRIVATE
|
||
else
|
||
begin
|
||
Filename := IpcDirectory + PathDelim + AName;
|
||
ForceDirectories(IpcDirectory);
|
||
if not FileExists(Filename) then
|
||
FileClose(FileCreate(Filename));
|
||
Result := ftok(PChar(Filename), What);
|
||
end;
|
||
end;
|
||
|
||
type
|
||
TSemUnion = record
|
||
case Integer of
|
||
0: (val: Integer);
|
||
1: (buf: PSemaphoreIdDescriptor);
|
||
2: (ary: PWord);
|
||
3: (__buf: PSemaphoreInfo);
|
||
end;
|
||
|
||
constructor TSemaphoreWaitObject.Create(InitialCount, Max: Integer; const AName: string;
|
||
Open: Boolean);
|
||
const
|
||
AccessMode = S_IREAD or S_IWRITE or S_IRGRP or S_IWGRP;
|
||
var
|
||
Arg: TSemUnion;
|
||
IPCKey: Integer;
|
||
begin
|
||
inherited Create(AName);
|
||
IPCKey := GetIPCKey(Name, 1);
|
||
if not Open then
|
||
FSemId := semget(IPCKey, 1, IPC_CREAT or IPC_EXCL or AccessMode)
|
||
else
|
||
FSemId := -1; // open
|
||
|
||
if FSemId = -1 then
|
||
begin
|
||
// open sempahore
|
||
FOwnSem := False;
|
||
FSemId := semget(IPCKey, 0, SEM_UNDO);
|
||
if FSemId = -1 then
|
||
RaiseLastOSError;
|
||
end
|
||
else
|
||
begin
|
||
FOwnSem := True;
|
||
Arg.val := Max - InitialCount;
|
||
if semctl(FSemId, 0, SETVAL, Arg) = -1 then
|
||
RaiseLastOSError;
|
||
end;
|
||
end;
|
||
|
||
destructor TSemaphoreWaitObject.Destroy;
|
||
begin
|
||
if FOwnSem then
|
||
begin
|
||
semctl(FSemId, 0, IPC_RMID);
|
||
if Name <> '' then
|
||
DeleteFile(IpcDirectory + PathDelim + Name); // only if allowed
|
||
end;
|
||
inherited Destroy;
|
||
end;
|
||
|
||
function TSemaphoreWaitObject.WaitFor(Timeout: Longword): Cardinal;
|
||
var
|
||
Buf: TSemaphoreBuffer;
|
||
RetValue: Integer;
|
||
timespec: TTimeSpec;
|
||
begin
|
||
Buf.sem_num := 0;
|
||
Buf.sem_op := -1;
|
||
Buf.sem_flg := SEM_UNDO;
|
||
if Timeout = INFINITE then
|
||
// RetValue := semop(FSemId, @Buf, 1)
|
||
Timeout := 2000000;
|
||
// else
|
||
if Timeout = 0 then
|
||
begin
|
||
Buf.sem_flg := Buf.sem_flg or IPC_NOWAIT;
|
||
RetValue := semop(FSemId, @Buf, 1);
|
||
end
|
||
else
|
||
begin
|
||
timespec.tv_sec := Timeout div 1000;
|
||
timespec.tv_nsec := (Timeout mod 1000) * 1000000;
|
||
RetValue := semtimedop(FSemId, @Buf, 1, @timespec); // Timeout=0 -> INFINTE
|
||
end;
|
||
|
||
if RetValue = -1 then
|
||
begin
|
||
if errno = EAGAIN then
|
||
Result := WAIT_TIMEOUT
|
||
else
|
||
Result := WAIT_FAILED;
|
||
end
|
||
else
|
||
Result := WAIT_OBJECT_0;
|
||
end;
|
||
|
||
function TSemaphoreWaitObject.ReleaseSemaphore(ReleaseCount: Integer; PreviousCount: PInteger): Boolean;
|
||
var
|
||
Buf: TSemaphoreBuffer;
|
||
Arg: TSemUnion;
|
||
begin
|
||
Result := False;
|
||
if ReleaseCount >= 0 then
|
||
begin
|
||
if PreviousCount <> nil then
|
||
begin
|
||
Result := semctl(FSemId, 0, GETVAL, @Arg) = 0;
|
||
PreviousCount^ := Arg.val;
|
||
end;
|
||
if ReleaseCount > 0 then
|
||
begin
|
||
Buf.sem_num := 0;
|
||
Buf.sem_op := ReleaseCount;
|
||
Buf.sem_flg := SEM_UNDO;
|
||
Result := semop(FSemId, @Buf, 1) = 0;
|
||
end;
|
||
end
|
||
end;
|
||
|
||
{ TEventTimeoutThread }
|
||
|
||
constructor TEventTimeoutThread.Create(AEvent: TEventWaitObject; ATimeout: Integer);
|
||
begin
|
||
FEvent := AEvent;
|
||
FTimeout := ATimeout;
|
||
FStopped := False;
|
||
inherited Create(False);
|
||
end;
|
||
|
||
procedure TEventTimeoutThread.Execute;
|
||
var
|
||
StartTime, CurrentTime: Int64;
|
||
begin
|
||
StartTime := GetTickCount;
|
||
while not FStopped do
|
||
begin
|
||
CurrentTime := GetTickCount;
|
||
if CurrentTime < StartTime then
|
||
Inc(CurrentTime, $100000000);
|
||
if CurrentTime - StartTime > FTimeout then
|
||
begin
|
||
FStopped := True;
|
||
FEvent.SetEvent;
|
||
Break;
|
||
end;
|
||
Sleep(10);
|
||
end;
|
||
end;
|
||
|
||
{ TEventWaitObject }
|
||
|
||
type
|
||
TPrivateEvent = class(TEvent)
|
||
protected
|
||
FEvent: TSemaphore;
|
||
{...}
|
||
end;
|
||
|
||
constructor TEventWaitObject.Create(EventAttributes: PSecurityAttributes;
|
||
ManualReset, InitialState: LongBool; const AName: string);
|
||
begin
|
||
inherited Create(AName);
|
||
FManualReset := ManualReset;
|
||
FEvent := TEvent.Create(EventAttributes,
|
||
False, // ManualReset: handled by this class
|
||
InitialState, AName);
|
||
FSignaled := False;
|
||
end;
|
||
|
||
destructor TEventWaitObject.Destroy;
|
||
begin
|
||
sem_destroy(TPrivateEvent(FEvent).FEvent);
|
||
FEvent.Free;
|
||
inherited Destroy;
|
||
end;
|
||
|
||
function TEventWaitObject.WaitFor(Timeout: Longword): Cardinal;
|
||
var
|
||
TimeoutThread: TEventTimeoutThread;
|
||
begin
|
||
Result := WAIT_FAILED;
|
||
TimeoutThread := nil;
|
||
if Timeout <> INFINITE then
|
||
{ POSIX semaphores do not support a timeout value. Here we use a
|
||
second thread that produces a timeout by releasing the semaphore. }
|
||
TimeoutThread := TEventTimeoutThread.Create(Self, Integer(Timeout));
|
||
try
|
||
case FEvent.WaitFor(INFINITE) of
|
||
wrSignaled:
|
||
Result := WAIT_OBJECT_0;
|
||
wrTimeout:
|
||
Result := WAIT_TIMEOUT; // POSIX semaphores do not have a timeout
|
||
wrAbandoned:
|
||
Result := WAIT_ABANDONED; // for events ?
|
||
end;
|
||
finally
|
||
if Assigned(TimeoutThread) then
|
||
begin
|
||
if TimeoutThread.Stopped then
|
||
Result := WAIT_TIMEOUT;
|
||
TimeoutThread.Stopped := True;
|
||
TimeoutThread.WaitFor;
|
||
TimeoutThread.Free;
|
||
end;
|
||
if FManualReset then
|
||
begin
|
||
FSignaled := True;
|
||
SetEvent; // do not auto-reset
|
||
end
|
||
else
|
||
FSignaled := False;
|
||
end;
|
||
end;
|
||
|
||
function TEventWaitObject.SetEvent: Boolean;
|
||
begin
|
||
FEvent.SetEvent;
|
||
Result := True;
|
||
end;
|
||
|
||
function TEventWaitObject.ResetEvent: Boolean;
|
||
begin
|
||
if FSignaled then
|
||
begin
|
||
FSignaled := False;
|
||
WaitFor(INFINITE); // auto-reset
|
||
end;
|
||
FEvent.ResetEvent;
|
||
Result := True;
|
||
end;
|
||
|
||
{ TMutexWaitObject }
|
||
|
||
constructor TMutexWaitObject.Create(const AName: string; Open: Boolean);
|
||
begin
|
||
inherited Create(0, 1, AName, Open);
|
||
FOwnerThreadId := 0;
|
||
FThreadLocks := 0;
|
||
InitializeCriticalSection(FCritSect);
|
||
end;
|
||
|
||
destructor TMutexWaitObject.Destroy;
|
||
begin
|
||
if FOwnerThreadId <> 0 then
|
||
ReleaseSemaphore(1, nil);
|
||
DeleteCriticalSection(FCritSect);
|
||
inherited Destroy;
|
||
end;
|
||
|
||
function TMutexWaitObject.WaitFor(Timeout: Longword): Cardinal;
|
||
var
|
||
CurThreadId: Cardinal;
|
||
begin
|
||
CurThreadId := GetCurrentThreadID;
|
||
if CurThreadId = FOwnerThreadId then
|
||
begin
|
||
InterlockedIncrement(FThreadLocks);
|
||
Result := WAIT_OBJECT_0;
|
||
end
|
||
else
|
||
begin
|
||
Result := inherited WaitFor(Timeout);
|
||
if Result = WAIT_OBJECT_0 then
|
||
begin
|
||
EnterCriticalSection(FCritSect);
|
||
try
|
||
FOwnerThreadId := CurThreadId;
|
||
InterlockedIncrement(FThreadLocks);
|
||
finally
|
||
LeaveCriticalSection(FCritSect);
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function TMutexWaitObject.ReleaseMutex: Boolean;
|
||
begin
|
||
if GetCurrentThreadId = FOwnerThreadId then
|
||
begin
|
||
EnterCriticalSection(FCritSect);
|
||
try
|
||
InterlockedDecrement(FThreadLocks);
|
||
if FThreadLocks <= 0 then
|
||
begin
|
||
Result := ReleaseSemaphore(1, nil);
|
||
FOwnerThreadId := 0;
|
||
FThreadLocks := 0;
|
||
end
|
||
else
|
||
Result := True;
|
||
finally
|
||
LeaveCriticalSection(FCritSect);
|
||
end;
|
||
end
|
||
else
|
||
Result := False;
|
||
end;
|
||
|
||
// ======= IPC API functions =======
|
||
|
||
function CreateEvent(EventAttributes: PSecurityAttributes;
|
||
ManualReset, InitialState: LongBool; Name: PChar): THandle;
|
||
begin
|
||
WaitObjectList.Enter;
|
||
try
|
||
Result := THandle(WaitObjectList.Find(Name));
|
||
if Result <> 0 then
|
||
begin
|
||
if THandleObject(Result) is TEventWaitObject then
|
||
THandleObject(Result).AddRef
|
||
else
|
||
Result := 0;
|
||
end
|
||
else
|
||
Result := THandle(TEventWaitObject.Create(EventAttributes, ManualReset,
|
||
InitialState, Name));
|
||
finally
|
||
WaitObjectList.Leave;
|
||
end;
|
||
end;
|
||
|
||
function OpenEvent(DesiredAccess: Longword; InheritHandle: LongBool;
|
||
Name: PChar): THandle;
|
||
begin
|
||
WaitObjectList.Enter;
|
||
try
|
||
Result := THandle(WaitObjectList.Find(Name));
|
||
if (Result <> 0) and (THandleObject(Result) is TEventWaitObject) then
|
||
THandleObject(Result).AddRef
|
||
else
|
||
Result := 0;
|
||
finally
|
||
WaitObjectList.Leave;
|
||
end;
|
||
end;
|
||
|
||
function SetEvent(Event: THandle): LongBool;
|
||
begin
|
||
WaitObjectList.Enter;
|
||
try
|
||
try
|
||
Result := (Event <> 0) and (THandleObject(Event) is TEventWaitObject);
|
||
if Result then
|
||
TEventWaitObject(Event).SetEvent;
|
||
except
|
||
Result := False;
|
||
end;
|
||
finally
|
||
WaitObjectList.Leave;
|
||
end;
|
||
end;
|
||
|
||
function ResetEvent(Event: THandle): LongBool;
|
||
begin
|
||
WaitObjectList.Enter;
|
||
try
|
||
try
|
||
Result := (Event <> 0) and (THandleObject(Event) is TEventWaitObject);
|
||
if Result then
|
||
TEventWaitObject(Event).ResetEvent;
|
||
except
|
||
Result := False;
|
||
end;
|
||
finally
|
||
WaitObjectList.Leave;
|
||
end;
|
||
end;
|
||
|
||
function PulseEvent(Event: THandle): LongBool;
|
||
begin
|
||
// not implemented
|
||
Result := SetEvent(Event);
|
||
end;
|
||
|
||
function CreateMutex(MutexAttributes: PSecurityAttributes; InitialOwner: LongBool;
|
||
Name: PChar): THandle;
|
||
begin
|
||
WaitObjectList.Enter;
|
||
try
|
||
Result := THandle(WaitObjectList.Find(Name));
|
||
if Result <> 0 then
|
||
begin
|
||
if THandleObject(Result) is TMutexWaitObject then
|
||
THandleObject(Result).AddRef
|
||
else
|
||
Result := 0; // no mutex
|
||
end
|
||
else
|
||
begin
|
||
try
|
||
Result := THandle(TMutexWaitObject.Create(Name, False));
|
||
except
|
||
Result := 0;
|
||
end;
|
||
end;
|
||
finally
|
||
WaitObjectList.Leave;
|
||
end;
|
||
|
||
if (Result <> 0) and InitialOwner then
|
||
WaitForSingleObject(Result, INFINITE);
|
||
end;
|
||
|
||
function OpenMutex(DesiredAccess: Longword; InheritHandle: Boolean;
|
||
Name: PChar): THandle;
|
||
begin
|
||
WaitObjectList.Enter;
|
||
try
|
||
Result := THandle(WaitObjectList.Find(Name));
|
||
if (Result <> 0) and (THandleObject(Result).ClassType = TMutexWaitObject) then
|
||
THandleObject(Result).AddRef
|
||
else
|
||
begin
|
||
try
|
||
Result := THandle(TMutexWaitObject.Create(Name, True));
|
||
except
|
||
Result := 0;
|
||
end;
|
||
end;
|
||
finally
|
||
WaitObjectList.Leave;
|
||
end;
|
||
end;
|
||
|
||
function ReleaseMutex(Mutex: THandle): LongBool;
|
||
begin
|
||
WaitObjectList.Enter;
|
||
try
|
||
try
|
||
Result := (Mutex <> 0) and (THandleObject(Mutex).ClassType = TMutexWaitObject);
|
||
if Result then
|
||
TMutexWaitObject(Mutex).ReleaseMutex;
|
||
except
|
||
Result := False;
|
||
end;
|
||
finally
|
||
WaitObjectList.Leave;
|
||
end;
|
||
end;
|
||
|
||
function CreateSemaphore(SemaphoreAttributes: PSecurityAttributes;
|
||
InitialCount, MaximumCount: Longint; Name: PChar): THandle;
|
||
begin
|
||
WaitObjectList.Enter;
|
||
try
|
||
Result := THandle(WaitObjectList.Find(Name));
|
||
if Result <> 0 then
|
||
begin
|
||
if THandleObject(Result).ClassType = TSemaphoreWaitObject then
|
||
THandleObject(Result).AddRef
|
||
else
|
||
Result := 0; // no semaphore
|
||
end
|
||
else
|
||
begin
|
||
if (InitialCount < 0) or (MaximumCount <= 0) or (InitialCount > MaximumCount) then
|
||
Result := 0 // invalid
|
||
else
|
||
begin
|
||
try
|
||
Result := THandle(TSemaphoreWaitObject.Create(InitialCount, MaximumCount,
|
||
Name, False));
|
||
except
|
||
Result := 0;
|
||
end;
|
||
end;
|
||
end;
|
||
finally
|
||
WaitObjectList.Leave;
|
||
end;
|
||
end;
|
||
|
||
function OpenSemaphore(DesiredAccess: Longword; InheritHandle: LongBool;
|
||
Name: PChar): THandle;
|
||
begin
|
||
WaitObjectList.Enter;
|
||
try
|
||
Result := THandle(WaitObjectList.Find(Name));
|
||
if (Result <> 0) and (THandleObject(Result).ClassType = TSemaphoreWaitObject) then
|
||
THandleObject(Result).AddRef
|
||
else
|
||
begin
|
||
try
|
||
Result := THandle(TSemaphoreWaitObject.Create(0, 0, Name, True));
|
||
except
|
||
Result := 0;
|
||
end;
|
||
end;
|
||
finally
|
||
WaitObjectList.Leave;
|
||
end;
|
||
end;
|
||
|
||
function ReleaseSemaphore(Semaphore: THandle; ReleaseCount: Longint;
|
||
PreviousCount: PInteger): LongBool;
|
||
begin
|
||
WaitObjectList.Enter;
|
||
try
|
||
try
|
||
Result := (Semaphore <> 0) and (THandleObject(Semaphore).ClassType = TSemaphoreWaitObject);
|
||
if Result then
|
||
TSemaphoreWaitObject(Semaphore).ReleaseSemaphore(ReleaseCount, PreviousCount);
|
||
except
|
||
Result := False;
|
||
end;
|
||
finally
|
||
WaitObjectList.Leave;
|
||
end;
|
||
end;
|
||
|
||
// common handle functions
|
||
|
||
function WaitForSingleObject(Handle: THandle; Milliseconds: Cardinal): Cardinal;
|
||
begin
|
||
Result := WAIT_FAILED;
|
||
try
|
||
if (Handle <> 0) and (THandleObject(Handle) is TWaitObject) then
|
||
begin
|
||
TWaitObject(Handle).AddRef;
|
||
try
|
||
Result := TWaitObject(Handle).WaitFor(Milliseconds);
|
||
finally
|
||
TWaitObject(Handle).Release;
|
||
end;
|
||
end;
|
||
except
|
||
Result := WAIT_FAILED;
|
||
end;
|
||
end;
|
||
|
||
// The WaitForMultipleObjects function returns when one of the following occurs:
|
||
//
|
||
// <20> Either any one or all of the specified objects are in the signaled state.
|
||
// <20> The time-out interval elapses.
|
||
function WaitForMultipleObjects(Count: Cardinal; Handles: PWOHandleArray;
|
||
WaitAll: LongBool; Milliseconds: Cardinal): Cardinal;
|
||
var
|
||
i: Integer;
|
||
startticks: int64;
|
||
ticks: Integer;
|
||
begin
|
||
startticks := GetTickCount;
|
||
Result := WAIT_OBJECT_0;
|
||
if WaitAll then
|
||
begin
|
||
for i := 0 to Count - 1 do
|
||
begin
|
||
ticks := Milliseconds - (GetTickCount - StartTicks);
|
||
if ticks < 0 then
|
||
begin
|
||
Result := WAIT_TIMEOUT;
|
||
Exit;
|
||
end
|
||
else
|
||
begin
|
||
Result := WaitForSingleObject(Handles[i], Ticks);
|
||
if Result <> WAIT_OBJECT_0 then
|
||
begin
|
||
Inc(Result, i);
|
||
Exit;
|
||
end;
|
||
end;
|
||
end;
|
||
end
|
||
else
|
||
begin //
|
||
while True do
|
||
begin
|
||
for i := 0 to Count-1 do
|
||
begin
|
||
Result := WaitForSingleObject(Handles[i], 0);
|
||
case Result of
|
||
WAIT_FAILED, WAIT_ABANDONED, WAIT_OBJECT_0:
|
||
begin
|
||
Inc(Result, i);
|
||
Exit;
|
||
end;
|
||
else
|
||
if (startticks - GetTickCount) > MilliSeconds then
|
||
begin
|
||
Result := WAIT_TIMEOUT;
|
||
Exit;
|
||
end;
|
||
end;
|
||
end;
|
||
Sleep(5);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
// all Handles are THandleObject derived classes
|
||
function CloseHandle(hObject: THandle): LongBool;
|
||
begin
|
||
WaitObjectList.Enter;
|
||
try
|
||
try
|
||
if (hObject <> 0) then
|
||
THandleObject(hObject).Release;
|
||
Result := True;
|
||
except
|
||
Result := False;
|
||
end;
|
||
finally
|
||
WaitObjectList.Leave;
|
||
end;
|
||
end;
|
||
|
||
function GlobalAllocPtr(Flags: Integer; Bytes: Longint): Pointer;
|
||
begin
|
||
Result := GlobalLock(GlobalAlloc(Flags, Bytes));
|
||
end;
|
||
|
||
function GlobalReAllocPtr(P: Pointer; Bytes: Longint; Flags: Integer): Pointer;
|
||
var
|
||
hMem: Cardinal;
|
||
begin
|
||
hMem := GlobalHandle(P);
|
||
GlobalUnlock(hMem);
|
||
Result := GlobalLock(GlobalReAlloc(hMem, Bytes, Flags));
|
||
end;
|
||
|
||
function GlobalFreePtr(P: Pointer): THandle;
|
||
var
|
||
hMem: Cardinal;
|
||
begin
|
||
hMem := GlobalHandle(P);
|
||
GlobalUnlock(hMem);
|
||
Result := GlobalFree(hMem);
|
||
end;
|
||
|
||
type
|
||
PGlobalBlock = ^TGlobalBlock;
|
||
TGlobalBlock = packed record
|
||
Start: Pointer;
|
||
Size: Longword;
|
||
end;
|
||
|
||
function GlobalAlloc(uFlags: Cardinal; dwBytes: Longword): Cardinal;
|
||
var
|
||
Info: PGlobalBlock;
|
||
Start, P: PByte;
|
||
begin
|
||
Result := 0;
|
||
if dwBytes > 0 then
|
||
begin
|
||
GetMem(P, SizeOf(TGlobalBlock) + dwBytes + 16);
|
||
Start := P;
|
||
Inc(P, SizeOf(TGlobalBlock) + $0F);
|
||
P := Pointer(Cardinal(P) and not $0F);
|
||
Info := Pointer(Cardinal(P) - SizeOf(TGlobalBlock));
|
||
Info^.Start := Start;
|
||
Info^.Size := dwBytes;
|
||
|
||
if uFlags and GMEM_ZEROINIT <> 0 then
|
||
FillChar(P^, dwBytes, 0);
|
||
|
||
Result := Cardinal(P);
|
||
end;
|
||
end;
|
||
|
||
function GlobalReAlloc(hMem: Cardinal; dwBytes: Longword; uFlags: Cardinal): Cardinal;
|
||
var
|
||
CurSize: Longword;
|
||
Offset: Cardinal;
|
||
Start: Pointer;
|
||
Info: PGlobalBlock;
|
||
P: PChar;
|
||
begin
|
||
if dwBytes = 0 then
|
||
begin
|
||
GlobalFree(hMem);
|
||
Result := 0;
|
||
Exit;
|
||
end;
|
||
if hMem = 0 then
|
||
Result := GlobalAlloc(uFlags, dwBytes)
|
||
else
|
||
begin
|
||
CurSize := GlobalSize(hMem);
|
||
Start := PGlobalBlock(hMem - SizeOf(TGlobalBlock))^.Start;
|
||
Offset := hMem - Cardinal(Start);
|
||
ReallocMem(Start, SizeOf(TGlobalBlock) + dwBytes + 16);
|
||
hMem := Cardinal(Start) + Offset;
|
||
P := Pointer(hMem);
|
||
|
||
if hMem and $0F <> 0 then
|
||
begin
|
||
P := Start;
|
||
Inc(P, SizeOf(TGlobalBlock) + $0F);
|
||
P := Pointer(Cardinal(P) and not $0F);
|
||
Info := Pointer(Cardinal(P) - SizeOf(TGlobalBlock));
|
||
Move(Pointer(hMem)^, P^, CurSize); // move data
|
||
hMem := Cardinal(P);
|
||
Info^.Start := Start;
|
||
Info^.Size := dwBytes;
|
||
end;
|
||
|
||
PGlobalBlock(hMem - SizeOf(TGlobalBlock))^.Size := dwBytes;
|
||
if uFlags and GMEM_ZEROINIT <> 0 then
|
||
if CurSize < dwBytes then
|
||
FillChar(P[CurSize], dwBytes - CurSize, 0);
|
||
Result := hMem;
|
||
end;
|
||
end;
|
||
|
||
function GlobalSize(hMem: Cardinal): Longword;
|
||
begin
|
||
if hMem > 0 then
|
||
Result := PGlobalBlock(hMem - SizeOf(TGlobalBlock))^.Size
|
||
else
|
||
Result := 0;
|
||
end;
|
||
|
||
function GlobalLock(hMem: Cardinal): Pointer;
|
||
begin
|
||
Result := Pointer(hMem);
|
||
end;
|
||
|
||
function GlobalHandle(Mem: Pointer): Cardinal;
|
||
begin
|
||
Result := Cardinal(Mem);
|
||
end;
|
||
|
||
function GlobalUnlock(hMem: Cardinal): LongBool;
|
||
begin
|
||
Result := hMem <> 0;
|
||
end;
|
||
|
||
function GlobalFree(hMem: Cardinal): Cardinal;
|
||
begin
|
||
if hMem <> 0 then
|
||
begin
|
||
FreeMem(PGlobalBlock(hMem - SizeOf(TGlobalBlock))^.Start);
|
||
Result := 0;
|
||
end
|
||
else
|
||
Result := GMEM_INVALID_HANDLE;
|
||
end;
|
||
|
||
|
||
var
|
||
StartTimeVal: TTimeVal;
|
||
|
||
// linux systems tend to run for months,
|
||
// rolls over after 49.7 days since application start
|
||
// predictable !
|
||
// return value: number of milliseconds since application start
|
||
|
||
function GetTickCount: Cardinal;
|
||
var
|
||
TimeVal: TTimeVal;
|
||
begin
|
||
gettimeofday(TimeVal, nil);
|
||
Result := 1000 * (TimeVal.tv_sec - StartTimeVal.tv_sec) +
|
||
(TimeVal.tv_usec - StartTimeVal.tv_usec) div 1000;
|
||
end;
|
||
|
||
procedure InitGetTickCount;
|
||
begin
|
||
gettimeofday(StartTimeVal, nil);
|
||
end;
|
||
|
||
function QueryPerformanceCounter(var PerformanceCount: int64): LongBool;
|
||
var
|
||
TimeVal: TTimeVal;
|
||
begin
|
||
gettimeofday(TimeVal, nil);
|
||
PerformanceCount := CLOCKS_PER_SEC * TimeVal.tv_sec + Timeval.tv_usec;
|
||
Result := true;
|
||
end;
|
||
|
||
function QueryPerformanceFrequency(var Frequency: int64): LongBool;
|
||
begin
|
||
Frequency := CLOCKS_PER_SEC; // 1 Mhz resolution gettimeofday
|
||
Result := True;
|
||
end;
|
||
|
||
procedure GetLocalTime(var st: TSystemTime);
|
||
var
|
||
dt: TDateTime;
|
||
begin
|
||
dt := Now;
|
||
DecodeDateTime(dt, st.wYear, st.wMonth, st.wDay, st.wHour, st.wMinute,
|
||
st.wSecond, st.wMilliseconds);
|
||
st.wDayOfWeek := DayOfTheWeek(dt);
|
||
end;
|
||
|
||
// Provider helpers
|
||
|
||
function Succeeded(Res: HResult): Boolean;
|
||
begin
|
||
Result := Res and $80000000 = 0;
|
||
end;
|
||
|
||
function Failed(Res: HResult): Boolean;
|
||
begin
|
||
Result := Res and $80000000 <> 0;
|
||
end;
|
||
|
||
function ResultCode(Res: HResult): Integer;
|
||
begin
|
||
Result := Res and $0000FFFF;
|
||
end;
|
||
|
||
function CoCreateGUID(out Guid: TGUID): HResult;
|
||
begin
|
||
Result := CreateGuid(Guid);
|
||
end;
|
||
|
||
{$ENDIF LINUX}
|
||
|
||
// for ShellExecute(0, ..
|
||
function ShellExecute(Handle: Integer; Operation, FileName, Parameters,
|
||
Directory: PChar; ShowCmd: Integer): THandle;
|
||
begin
|
||
Result := ShellExecute(QWidgetH(Handle), Operation, FileName,
|
||
Parameters, Directory, ShowCmd);
|
||
end;
|
||
|
||
function ShellExecute(Handle: QWidgetH; Operation, FileName, Parameters,
|
||
Directory: PChar; ShowCmd: Integer): THandle;
|
||
var
|
||
Name: string;
|
||
Dir: string;
|
||
Par: string;
|
||
begin
|
||
if Directory <> nil then
|
||
Dir := Directory;
|
||
if Parameters <> nil then
|
||
Par := Parameters;
|
||
if Filename <> nil then
|
||
Name := FileName;
|
||
Result := ShellExecute(Handle, Operation, Name, Par, Dir, ShowCmd);
|
||
end;
|
||
|
||
function ShellExecute(Handle: QWidgetH; const Operation, FileName, Parameters,
|
||
Directory: string; ShowCmd: Integer): THandle;
|
||
var
|
||
{$IFDEF MSWINDOWS}
|
||
WinId: Integer;
|
||
{$ENDIF MSWINDOWS}
|
||
{$IFDEF LINUX}
|
||
Line: string;
|
||
{$ENDIF LINUX}
|
||
begin
|
||
{$IFDEF MSWINDOWS}
|
||
if Handle = nil then
|
||
WinId := 0
|
||
else
|
||
WinId := QWidget_winID(Handle);
|
||
Result := ShellAPI.ShellExecute(WinId, PChar(Operation),
|
||
PChar(FileName), PChar(Parameters),
|
||
PChar(Directory), ShowCmd);
|
||
{$ENDIF MSWINDOWS}
|
||
{$IFDEF LINUX}
|
||
if (Operation = 'open') or (Operation = '') then
|
||
Line := Format('%s "%s" %s',[Shell, Filename, Parameters])
|
||
else
|
||
if Operation = 'browse' then
|
||
Line := Format('%s "%s" %s',
|
||
[GetEnvironmentVariable('BROWSER'), Filename, Parameters])
|
||
else
|
||
begin
|
||
Result := THandle(HINSTANCE_ERROR);
|
||
Exit;
|
||
end;
|
||
Line := Trim(Line)+ '&';
|
||
if Directory <> '' then
|
||
Line := Format('cd "%s";', [Directory]) + Line;
|
||
if Libc.system(PChar(Line)) <> -1 then
|
||
Result := THandle(HINSTANCE_OK)
|
||
else
|
||
Result := THandle(HINSTANCE_ERROR)
|
||
{$ENDIF LINUX}
|
||
end;
|
||
|
||
function InterlockedIncrement(var I: Integer): Integer;
|
||
begin
|
||
{$IFDEF MSWINDOWS}
|
||
Result := Windows.InterlockedIncrement(I);
|
||
{$ENDIF MSWINDOWS}
|
||
{$IFDEF LINUX}
|
||
Result := SysUtils.InterlockedIncrement(I);
|
||
{$ENDIF LINUX}
|
||
end;
|
||
|
||
function InterlockedDecrement(var I: Integer): Integer;
|
||
begin
|
||
{$IFDEF MSWINDOWS}
|
||
Result := Windows.InterlockedDecrement(I);
|
||
{$ENDIF MSWINDOWS}
|
||
{$IFDEF LINUX}
|
||
Result := SysUtils.InterlockedDecrement(I);
|
||
{$ENDIF LINUX}
|
||
end;
|
||
|
||
function InterlockedExchange(var A: Integer; B: Integer): Integer;
|
||
begin
|
||
{$IFDEF MSWINDOWS}
|
||
Result := Windows.InterlockedExchange(A, B);
|
||
{$ENDIF MSWINDOWS}
|
||
{$IFDEF LINUX}
|
||
Result := SysUtils.InterlockedExchange(A, B);
|
||
{$ENDIF LINUX}
|
||
end;
|
||
|
||
function InterlockedExchangeAdd(var A: Integer; B: Integer): Integer;
|
||
begin
|
||
{$IFDEF MSWINDOWS}
|
||
Result := Windows.InterlockedExchangeAdd(A, B);
|
||
{$ENDIF MSWINDOWS}
|
||
{$IFDEF LINUX}
|
||
Result := SysUtils.InterlockedExchangeAdd(A, B);
|
||
{$ENDIF LINUX}
|
||
end;
|
||
|
||
{$IFDEF MSWINDOWS}
|
||
{ wrappers to windows}
|
||
|
||
function CopyFile(lpExistingFileName, lpNewFileName: PChar;
|
||
bFailIfExists: LongBool): LongBool;
|
||
begin
|
||
Result := Windows.CopyFile(lpExistingFileName, lpNewFileName, bFailIfExists);
|
||
end;
|
||
|
||
function CopyFileA(lpExistingFileName, lpNewFileName: PAnsiChar;
|
||
bFailIfExists: LongBool): LongBool;
|
||
begin
|
||
Result := Windows.CopyFileA(lpExistingFileName, lpNewFileName, bFailIfExists);
|
||
end;
|
||
|
||
function CopyFileW(lpExistingFileName, lpNewFileName: PWideChar;
|
||
bFailIfExists: LongBool): LongBool;
|
||
begin
|
||
Result := Windows.CopyFileW(lpExistingFileName, lpNewFileName, bFailIfExists);
|
||
end;
|
||
|
||
function GetUserName(Buffer: PChar; var Size: Cardinal): LongBool;
|
||
begin
|
||
Result := Windows.GetUserName(Buffer,Size);
|
||
end;
|
||
|
||
function GetComputerName(Buffer: PChar; var Size: Cardinal): LongBool;
|
||
begin
|
||
Result := Windows.GetComputerName(Buffer,Size);
|
||
end;
|
||
|
||
function GetTickCount: Cardinal;
|
||
begin
|
||
Result := Windows.GetTickCount;
|
||
end;
|
||
|
||
function QueryPerformanceCounter(var PerformanceCount: int64): LongBool;
|
||
begin
|
||
Result := Windows.QueryPerformanceCounter(PerformanceCount);
|
||
end;
|
||
|
||
function QueryPerformanceFrequency(var Frequency: int64): LongBool;
|
||
begin
|
||
Result := Windows.QueryPerformanceFrequency(Frequency);
|
||
end;
|
||
|
||
function SetEvent(Event: THandle): LongBool;
|
||
begin
|
||
Result := Windows.SetEvent(Event);
|
||
end;
|
||
|
||
function ResetEvent(Event: THandle): LongBool;
|
||
begin
|
||
Result := Windows.ResetEvent(Event);
|
||
end;
|
||
|
||
function PulseEvent(Event: THandle): LongBool;
|
||
begin
|
||
Result := Windows.PulseEvent(Event);
|
||
end;
|
||
|
||
procedure OutputDebugString(OutputString: AnsiString);
|
||
begin
|
||
Windows.OutputDebugString(PAnsiChar(OutputString));
|
||
end;
|
||
|
||
procedure OutputDebugString(lpOutputString: PAnsiChar);
|
||
begin
|
||
Windows.OutputDebugString(lpOutputString);
|
||
end;
|
||
|
||
function GetKeyState(nVirtKey: Integer): SmallInt;
|
||
begin
|
||
Result := Windows.GetKeyState(nVirtKey);
|
||
end;
|
||
|
||
//
|
||
// Taken from QDialogs.
|
||
//
|
||
type
|
||
PTaskWindow = ^TTaskWindow;
|
||
TTaskWindow = record
|
||
Next: PTaskWindow;
|
||
Window: Windows.HWnd;
|
||
end;
|
||
|
||
var
|
||
TaskActiveWindow: Windows.HWnd = 0;
|
||
TaskFirstWindow: Windows.HWnd = 0;
|
||
TaskFirstTopMost: Windows.HWnd = 0;
|
||
TaskWindowList: PTaskWindow = nil;
|
||
|
||
function DoDisableWindow(Window: Windows.HWnd; Data: Longint): Bool; stdcall;
|
||
var
|
||
P: PTaskWindow;
|
||
begin
|
||
if (Window <> TaskActiveWindow) and Windows.IsWindowVisible(Window) and
|
||
Windows.IsWindowEnabled(Window) then
|
||
begin
|
||
New(P);
|
||
P^.Next := TaskWindowList;
|
||
P^.Window := Window;
|
||
TaskWindowList := P;
|
||
Windows.EnableWindow(Window, False);
|
||
end;
|
||
Result := True;
|
||
end;
|
||
|
||
procedure EnableTaskWindows(WindowList: Pointer);
|
||
var
|
||
P: PTaskWindow;
|
||
begin
|
||
while WindowList <> nil do
|
||
begin
|
||
P := WindowList;
|
||
if Windows.IsWindow(P^.Window) then Windows.EnableWindow(P^.Window, True);
|
||
WindowList := P^.Next;
|
||
Dispose(P);
|
||
end;
|
||
end;
|
||
|
||
function DisableTaskWindows(ActiveWindow: Windows.HWnd): Pointer;
|
||
var
|
||
SaveActiveWindow: Windows.HWND;
|
||
SaveWindowList: Pointer;
|
||
begin
|
||
Result := nil;
|
||
SaveActiveWindow := TaskActiveWindow;
|
||
SaveWindowList := TaskWindowList;
|
||
TaskActiveWindow := ActiveWindow;
|
||
TaskWindowList := nil;
|
||
try
|
||
try
|
||
EnumThreadWindows(GetCurrentThreadID, @DoDisableWindow, 0);
|
||
Result := TaskWindowList;
|
||
except
|
||
EnableTaskWindows(TaskWindowList);
|
||
raise;
|
||
end;
|
||
finally
|
||
TaskWindowList := SaveWindowList;
|
||
TaskActiveWindow := SaveActiveWindow;
|
||
end;
|
||
end;
|
||
{$ENDIF MSWINDOWS}
|
||
|
||
function IgnoreMouseEvents(Handle: QObjectH; Event: QEventH): boolean;
|
||
begin
|
||
case QEvent_type(Event) of
|
||
QEventType_MouseButtonPress,
|
||
QEventType_MouseButtonRelease,
|
||
QEventType_MouseButtonDblClick,
|
||
QEventType_MouseMove,
|
||
QEventType_Enter,
|
||
QEventType_Leave,
|
||
QEventType_Wheel:
|
||
Result := true;
|
||
else
|
||
Result := false;
|
||
end;
|
||
end;
|
||
|
||
function GetCursorPos(var P: TPoint): LongBool;
|
||
begin
|
||
Result := True;
|
||
try
|
||
QCursor_pos(@P);
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
procedure SetCursorPos(X, Y: integer);
|
||
var
|
||
Value: TPoint;
|
||
begin
|
||
Value.X := X;
|
||
Value.Y := Y;
|
||
QCursor_setPos(@Value);
|
||
end;
|
||
|
||
{ ------------ Caret -------------- }
|
||
type
|
||
TEmulatedCaret = class(TComponent)
|
||
private
|
||
FTimer: TTimer;
|
||
FWndId: Cardinal;
|
||
FWidget: QWidgetH;
|
||
FPixmap: QPixmapH;
|
||
FWidth, FHeight: Integer;
|
||
FPos: TPoint;
|
||
FVisible: Boolean;
|
||
FShown: Boolean;
|
||
FCritSect: TRTLCriticalSection;
|
||
procedure SetPos(const Value: TPoint);
|
||
protected
|
||
procedure DoTimer(Sender: TObject);
|
||
procedure DrawCaret; virtual;
|
||
function CreateColorPixmap(Color: Cardinal): QPixmapH;
|
||
procedure SetWidget(AWidget: QWidgetH);
|
||
public
|
||
constructor Create(AOwner: TComponent); override;
|
||
destructor Destroy; override;
|
||
|
||
procedure Lock;
|
||
procedure Unlock;
|
||
|
||
function CreateCaret(AWidget: QWidgetH; Pixmap: QPixmapH; Width, Height: Integer): Boolean;
|
||
function DestroyCaret: Boolean;
|
||
|
||
function IsValid: Boolean;
|
||
|
||
function Show(AWidget: QWidgetH): Boolean;
|
||
function Hide: Boolean;
|
||
|
||
property Timer: TTimer read FTimer;
|
||
property Pos: TPoint read FPos write SetPos;
|
||
end;
|
||
|
||
var
|
||
GlobalCaret: TEmulatedCaret = nil ;
|
||
|
||
procedure GlobalCaretNeeded;
|
||
begin
|
||
if GlobalCaret = nil then
|
||
begin
|
||
GlobalCaret := TEmulatedCaret.Create(nil);
|
||
OutputDebugString('Global caret created.');
|
||
end;
|
||
end;
|
||
|
||
function CreateCaret(Widget: QWidgetH; Pixmap: QPixmapH; Width, Height: Integer): Boolean;
|
||
begin
|
||
GlobalCaretNeeded;
|
||
GlobalCaret.Lock;
|
||
try
|
||
Result := GlobalCaret.CreateCaret(Widget, Pixmap, Width, Height);
|
||
finally
|
||
GlobalCaret.Unlock;
|
||
end;
|
||
end;
|
||
|
||
function CreateCaret(Widget: QWidgetH; ColorCaret: Cardinal; Width, Height: Integer): Boolean;
|
||
begin
|
||
Result := CreateCaret(Widget, QPixmapH(ColorCaret), Width, Height);
|
||
end;
|
||
|
||
function GetCaretBlinkTime: Cardinal;
|
||
begin
|
||
Result := QApplication_cursorFlashTime;
|
||
end;
|
||
|
||
function SetCaretBlinkTime(uMSeconds: Cardinal): LongBool;
|
||
begin
|
||
Result := True;
|
||
try
|
||
QApplication_setCursorFlashTime(uMSeconds);
|
||
if assigned(GlobalCaret) then
|
||
begin
|
||
GlobalCaret.Lock;
|
||
try
|
||
GlobalCaret.Timer.Interval := GetCaretBlinkTime;
|
||
finally
|
||
GlobalCaret.Unlock;
|
||
end;
|
||
end;
|
||
except
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function HideCaret(Widget: QWidgetH): Boolean;
|
||
begin
|
||
GlobalCaretNeeded;
|
||
if Assigned(GlobalCaret) then
|
||
begin
|
||
GlobalCaret.Lock;
|
||
try
|
||
Result := GlobalCaret.Hide;
|
||
finally
|
||
GlobalCaret.Unlock;
|
||
end;
|
||
end
|
||
else
|
||
Result := false;
|
||
end;
|
||
|
||
function ShowCaret(Widget: QWidgetH): Boolean;
|
||
begin
|
||
GlobalCaretNeeded;
|
||
GlobalCaret.Lock;
|
||
try
|
||
Result := GlobalCaret.Show(Widget);
|
||
finally
|
||
GlobalCaret.Unlock;
|
||
end;
|
||
end;
|
||
|
||
function SetCaretPos(X, Y: Integer): Boolean;
|
||
begin
|
||
Result := True;
|
||
GlobalCaretNeeded;
|
||
GlobalCaret.Lock;
|
||
try
|
||
GlobalCaret.Pos := Point(X, Y);
|
||
finally
|
||
GlobalCaret.Unlock;
|
||
end;
|
||
end;
|
||
|
||
function GetCaretPos(var Pt: TPoint): Boolean;
|
||
begin
|
||
Result := True;
|
||
GlobalCaretNeeded;
|
||
GlobalCaret.Lock;
|
||
try
|
||
Pt := GlobalCaret.Pos;
|
||
finally
|
||
GlobalCaret.Unlock;
|
||
end;
|
||
end;
|
||
|
||
function DestroyCaret: Boolean;
|
||
begin
|
||
if Assigned(GlobalCaret) then
|
||
begin
|
||
GlobalCaret.Lock;
|
||
try
|
||
Result := GlobalCaret.DestroyCaret;
|
||
finally
|
||
GlobalCaret.Unlock;
|
||
end;
|
||
end
|
||
else
|
||
Result := False;
|
||
end;
|
||
|
||
{ TEmulatedCaret }
|
||
|
||
constructor TEmulatedCaret.Create(AOwner: TComponent);
|
||
begin
|
||
inherited Create(AOwner);
|
||
InitializeCriticalSection(FCritSect);
|
||
|
||
FTimer := TTimer.Create(self);
|
||
FTimer.Enabled := False;
|
||
FTimer.Interval := GetCaretBlinkTime;
|
||
FTimer.OnTimer := DoTimer;
|
||
end;
|
||
|
||
destructor TEmulatedCaret.Destroy;
|
||
begin
|
||
DestroyCaret;
|
||
DeleteCriticalSection(FCritSect);
|
||
inherited Destroy;
|
||
end;
|
||
|
||
function TEmulatedCaret.CreateCaret(AWidget: QWidgetH; Pixmap: QPixmapH;
|
||
Width, Height: Integer): Boolean;
|
||
begin
|
||
DestroyCaret;
|
||
SetWidget(AWidget);
|
||
FWidth := Width;
|
||
FHeight := Height;
|
||
if Cardinal(Pixmap) > $FFFF then
|
||
FPixmap := QPixmap_create(Pixmap)
|
||
else
|
||
FPixmap := CreateColorPixmap(Integer(Pixmap));
|
||
|
||
Result := IsValid;
|
||
end;
|
||
|
||
function TEmulatedCaret.DestroyCaret: Boolean;
|
||
begin
|
||
Hide;
|
||
if Assigned(FPixmap) then
|
||
QPixmap_destroy(FPixmap);
|
||
FWidget := nil;
|
||
FPixmap := nil;
|
||
FWidth := 0;
|
||
FHeight := 0;
|
||
Result := not IsValid;
|
||
end;
|
||
|
||
procedure TEmulatedCaret.DrawCaret;
|
||
var
|
||
DestDev: QPaintDeviceH;
|
||
R: TRect;
|
||
begin
|
||
if IsValid then
|
||
begin
|
||
|
||
DestDev := QWidget_to_QPaintDevice(FWidget);
|
||
R := Rect(0, 0, QPixmap_width(FPixmap), QPixmap_height(FPixmap));
|
||
|
||
Qt.bitBlt(DestDev, @FPos, FPixmap, @R, RasterOp_CopyROP);
|
||
FShown := not FShown;
|
||
end;
|
||
end;
|
||
|
||
function TEmulatedCaret.Show(AWidget: QWidgetH): Boolean;
|
||
begin
|
||
if FWidget <> AWidget then
|
||
Hide;
|
||
SetWidget(AWidget);
|
||
Result := IsValid;
|
||
if Result then
|
||
begin
|
||
FVisible := True;
|
||
FTimer.Enabled := True;
|
||
DrawCaret;
|
||
end;
|
||
end;
|
||
|
||
function TEmulatedCaret.Hide: Boolean;
|
||
begin
|
||
Result := IsValid;
|
||
if Result then
|
||
begin
|
||
FVisible := False;
|
||
FTimer.Enabled := False;
|
||
if FShown then
|
||
DrawCaret;
|
||
FShown := False;
|
||
end;
|
||
end;
|
||
|
||
procedure TEmulatedCaret.SetPos(const Value: TPoint);
|
||
begin
|
||
if FVisible then
|
||
begin
|
||
Hide;
|
||
try
|
||
FPos := Value;
|
||
finally
|
||
Show(FWidget);
|
||
end;
|
||
end
|
||
else
|
||
FPos := Value;
|
||
end;
|
||
|
||
procedure TEmulatedCaret.DoTimer(Sender: TObject);
|
||
begin
|
||
DrawCaret;
|
||
end;
|
||
|
||
procedure TEmulatedCaret.Lock;
|
||
begin
|
||
EnterCriticalSection(FCritSect);
|
||
end;
|
||
|
||
procedure TEmulatedCaret.Unlock;
|
||
begin
|
||
LeaveCriticalSection(FCritSect);
|
||
end;
|
||
|
||
function TEmulatedCaret.CreateColorPixmap(Color: Cardinal): QPixmapH;
|
||
var
|
||
QC: QColorH;
|
||
begin
|
||
if (FWidth <= 0) or (FHeight <= 0) then
|
||
Result := nil
|
||
else
|
||
begin
|
||
case Color of
|
||
0: QC := QColor(clBlack);
|
||
1: QC := QColor(clGray);
|
||
else
|
||
Result := nil;
|
||
Exit;
|
||
end;
|
||
try
|
||
Result := QPixmap_create(FWidth, FHeight, -1, QPixmapOptimization_MemoryOptim);
|
||
try
|
||
QPixmap_fill(Result, QC);
|
||
except
|
||
QPixmap_destroy(Result);
|
||
Result := nil;
|
||
end;
|
||
finally
|
||
QColor_destroy(QC);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function TEmulatedCaret.IsValid: Boolean;
|
||
begin
|
||
Result := (FWidget <> nil) and (FPixmap <> nil) and
|
||
(QWidget_find(FWndId) <> nil);
|
||
end;
|
||
|
||
procedure TEmulatedCaret.SetWidget(AWidget: QWidgetH);
|
||
begin
|
||
FWidget := AWidget;
|
||
if FWidget <> nil then
|
||
FWndId := QWidget_winId(FWidget)
|
||
else
|
||
FWndId := 0;
|
||
end;
|
||
|
||
|
||
type
|
||
TCriticalSections = class(TComponent)
|
||
public
|
||
constructor Create(AOwner: TComponent); override;
|
||
destructor Destroy; override;
|
||
end;
|
||
|
||
constructor TCriticalSections.Create(AOwner: TComponent);
|
||
begin
|
||
inherited Create(AOwner);
|
||
InitializeCriticalSection(StockObjectListCritSect);
|
||
end;
|
||
|
||
destructor TCriticalSections.Destroy;
|
||
begin
|
||
DeleteCriticalSection(StockObjectListCritSect);
|
||
inherited Destroy;
|
||
end;
|
||
|
||
function Perform(Control: TControl; Msg: Cardinal; WPar, LPar: Longint): Longint;
|
||
var
|
||
Mesg: TMessage;
|
||
begin
|
||
Mesg.Msg := Msg;
|
||
Mesg.WParam := WPar;
|
||
Mesg.LParam := LPar;
|
||
Mesg.Result := 0;
|
||
Control.Dispatch(Mesg);
|
||
Result := Mesg.Result;
|
||
end;
|
||
|
||
function SendMessage(Receiver: QWidgetH; MsgId: Integer; WPar, LPar: Longint): Integer;
|
||
var
|
||
Event: QCustomEventH;
|
||
Mesg: TMessage;
|
||
begin
|
||
AppEventHookNeeded;
|
||
with Mesg do
|
||
begin
|
||
Msg := MsgId;
|
||
wParam := WPar;
|
||
lParam := LPar;
|
||
Result := 0;
|
||
end;
|
||
Event := QCustomEvent_create(QEventType_Message, @Mesg);
|
||
QApplication_sendEvent(Receiver, Event);
|
||
Result := Mesg.Result;
|
||
QEvent_destroy(Event);
|
||
end;
|
||
|
||
function SendMessage(AControl: TWidgetControl; MsgId: Integer; WPar, LPar: Longint): Integer;
|
||
begin
|
||
// OutputDebugString(Pchar(Format('%s: %s Sended message %x', [AControl.Name, AControl.ClassName, MsgId ])));
|
||
Result := SendMessage(AControl.Handle, MsgId, WPar, LPar);
|
||
end;
|
||
|
||
type
|
||
TCustomMsg = packed record
|
||
Msg: integer;
|
||
WParam: integer;
|
||
LParam: integer;
|
||
Result: integer;
|
||
Pt: TPoint;
|
||
end;
|
||
|
||
function PostMessage(Receiver: QWidgetH; MsgId: Integer; WPar, LPar: Longint): LongBool;
|
||
var
|
||
Mesg: PMessage;
|
||
Event: QCustomEventH;
|
||
begin
|
||
AppEventHookNeeded;
|
||
New(Mesg);
|
||
with Mesg^ do
|
||
begin
|
||
Msg := MsgId;
|
||
WParam := WPar;
|
||
LParam := LPar;
|
||
Result := 0; //or GetTickCount?;
|
||
end;
|
||
Event := QCustomEvent_Create(QEventType_Message, Mesg);
|
||
try
|
||
QApplication_postEvent(Receiver, QEventH(Event));
|
||
Result := true;
|
||
except
|
||
QCustomEvent_Destroy(Event);
|
||
Result := false;
|
||
end;
|
||
end;
|
||
|
||
function PostMessage(AControl: TWidgetControl; MsgId: Integer; WPar, LPar: Longint): LongBool;
|
||
begin
|
||
// OutputDebugString(Pchar(Format('%s: %s Posted message %x', [AControl.Name, AControl.ClassName, MsgId ])));
|
||
Result := PostMessage(AControl.Handle, MsgId, WPar, LPar);
|
||
end;
|
||
|
||
{
|
||
implements
|
||
- WMTimer dispatch
|
||
- Handles messages posted through QCustomEvent_message
|
||
}
|
||
|
||
type
|
||
TWinTimer = class(TComponent)
|
||
private
|
||
FWMTimer: Cardinal;
|
||
FQtTimer: Cardinal;
|
||
FTimerProc: TTimerProc;
|
||
public
|
||
constructor Create(AOwner: TComponent); override;
|
||
class function CreateTimer(AOwner: TWinControl; WMTimerId: Cardinal;
|
||
Elapse: Cardinal; Proc: TTimerProc): TWinTimer;
|
||
destructor Destroy; override;
|
||
property WMTimer: Cardinal read FWMTimer;
|
||
property QtTimer: Cardinal read FQtTimer;
|
||
property TimerProc: TTimerProc read FTimerProc write FTimerProc;
|
||
end;
|
||
|
||
constructor TWinTimer.Create(AOwner: TComponent);
|
||
begin
|
||
inherited Create(AOwner);
|
||
FWMTimer := 0;
|
||
FQtTimer := 0;
|
||
FTimerProc := nil;
|
||
end;
|
||
|
||
class function TWinTimer.CreateTimer(AOwner: TWinControl; WMTimerId: Cardinal;
|
||
Elapse: Cardinal; Proc: TTimerProc): TWinTimer;
|
||
begin
|
||
AppEventHookNeeded;
|
||
Result := Create(AOwner);
|
||
with Result do
|
||
begin
|
||
FWMTimer := WMTimerId;
|
||
FTimerProc := Proc;
|
||
FQtTimer := QObject_startTimer(AOwner.Handle, Elapse);
|
||
end;
|
||
end;
|
||
|
||
destructor TWinTimer.Destroy;
|
||
begin
|
||
QObject_killTimer(TWinControl(Owner).Handle, FQtTimer);
|
||
inherited Destroy;
|
||
end;
|
||
|
||
function FindTimer(Receiver: QWidgetH; QtTimerID: Cardinal): TWinTimer;
|
||
var
|
||
I: Integer;
|
||
Instance: TWinControl;
|
||
begin
|
||
Result := nil;
|
||
Instance := FindControl(Receiver);
|
||
if Assigned(Instance) then
|
||
with Instance do
|
||
for I := 0 to ComponentCount - 1 do
|
||
if (Components[I] is TWinTimer) and
|
||
(TWinTimer(Components[I]).QtTimer = QtTimerID) then
|
||
begin
|
||
Result := TWinTimer(Components[I]);
|
||
Exit;
|
||
end;
|
||
end;
|
||
|
||
function FindWMTimer(Receiver: QWidgetH; WinTimerID: Longword): TWinTimer;
|
||
var
|
||
I: Integer;
|
||
Instance: TComponent;
|
||
begin
|
||
Result := nil;
|
||
Instance := FindControl(Receiver);
|
||
if Assigned(Instance) then
|
||
with Instance do
|
||
for I := 0 to ComponentCount - 1 do
|
||
if (Components[I] is TWinTimer) and
|
||
(TWinTimer(Components[I]).WMTimer = WinTimerID) then
|
||
begin
|
||
Result := TWinTimer(Components[I]);
|
||
Exit;
|
||
end;
|
||
end;
|
||
|
||
function SetTimer(Instance: TWidgetControl; WMTimerID, Elapse: Cardinal;
|
||
TimerFunc: TTimerProc): Cardinal;
|
||
var
|
||
FWinTimer: TWinTimer;
|
||
begin
|
||
if Assigned(AppEventHook) then
|
||
begin
|
||
FWinTimer := FindWMTimer(Instance.Handle, WMTimerId);
|
||
if Assigned(FWinTimer) then
|
||
FWinTimer.Destroy;
|
||
end
|
||
else
|
||
AppEventHookNeeded;
|
||
|
||
FWinTimer := TWinTimer.CreateTimer(Instance, WMTimerID, Elapse, TimerFunc);
|
||
Result := FWinTimer.WMTimer;
|
||
end;
|
||
|
||
function SetTimer(Wnd: QWidgetH; WMTimerID, Elapse: Cardinal;
|
||
TimerFunc: TTimerProc): Cardinal;
|
||
var
|
||
Instance: TWidgetControl;
|
||
begin
|
||
Instance := FindControl(Wnd);
|
||
if assigned(Instance) then
|
||
Result := SetTimer(Instance, WMTimerID, Elapse, TimerFunc)
|
||
else
|
||
Result := 0;
|
||
end;
|
||
|
||
function KillTimer(Instance: TWidgetControl; WMTimerId: Cardinal): LongBool;
|
||
begin
|
||
Result := KillTimer(Instance.Handle, WMTimerId);
|
||
end;
|
||
|
||
function KillTimer(Wnd: QWidgetH; WMTimerId: Cardinal): LongBool;
|
||
var
|
||
WinTimer: TWinTimer;
|
||
begin
|
||
WinTimer := FindWMTimer(Wnd, WMTimerId);
|
||
if Assigned(WinTimer) then
|
||
begin
|
||
WinTimer.Destroy;
|
||
Result := true;
|
||
end
|
||
else
|
||
Result := false;
|
||
end;
|
||
|
||
function TAppEventHook.EventFilter(Receiver: QObjectH; Event: QEventH): Boolean;
|
||
var
|
||
WinTimer: TWinTimer;
|
||
Mesg: TMessage;
|
||
Id: Integer;
|
||
Instance: TWidgetControl;
|
||
begin
|
||
Result := false;
|
||
case QEvent_Type(Event) of
|
||
|
||
QEventType_Message:
|
||
begin
|
||
Instance := FindControl(QWidgetH(Receiver));
|
||
if Assigned(Instance) and not (csDestroying in Instance.ComponentState) then
|
||
begin
|
||
Mesg := TMessage(QCustomEvent_data(QCustomEventH(Event))^);
|
||
Mesg.Result := 0;
|
||
Instance.Dispatch(Mesg);
|
||
end;
|
||
Result := True;
|
||
end;
|
||
|
||
QEventType_Timer:
|
||
begin
|
||
if not QObject_isWidgetType(Receiver) then
|
||
Exit;
|
||
Id := QTimerEvent_timerId(QTimerEventH(Event));
|
||
WinTimer := FindTimer(QWidgetH(Receiver), Id );
|
||
if Assigned(WinTimer) then
|
||
with WinTimer do
|
||
begin
|
||
if Assigned(TimerProc) then
|
||
TimerProc(QWidgetH(Receiver), WM_TIMER, WMTimer, GetTickCount);
|
||
with Mesg do
|
||
begin
|
||
Mesg.Msg := WM_TIMER;
|
||
Mesg.WParam := WMTimer;
|
||
Mesg.LParam := Integer(@TimerProc);
|
||
Mesg.Result := 0;
|
||
WinTimer.Owner.Dispatch(Mesg);
|
||
end;
|
||
Result := True;
|
||
end;
|
||
end;
|
||
|
||
end; // case EventType of
|
||
end;
|
||
|
||
function InstallApplicationEventHook(EventFilter: TEventFilterMethod): QApplication_hookH;
|
||
var
|
||
Method: TMethod;
|
||
begin
|
||
Result := QApplication_hook_create(Application.Handle);
|
||
TEventFilterMethod(Method) := EventFilter;
|
||
Qt_hook_hook_events(Result, Method);
|
||
end;
|
||
|
||
constructor TAppEventHook.Create(AOwner: TComponent);
|
||
var
|
||
Method: TMethod;
|
||
begin
|
||
inherited Create(AOwner);
|
||
FHook := QApplication_hook_create(Application.Handle);
|
||
TEventFilterMethod(Method) := EventFilter;
|
||
Qt_hook_hook_events(FHook, Method);
|
||
end;
|
||
|
||
destructor TAppEventHook.Destroy;
|
||
begin
|
||
if Assigned(FHook) then
|
||
begin
|
||
QApplication_hook_destroy(FHook);
|
||
end;
|
||
inherited Destroy;
|
||
end;
|
||
|
||
initialization
|
||
//OutputDebugString('Loading QWindows.pas');
|
||
{$IFDEF LINUX}
|
||
InitGetTickCount;
|
||
WaitObjectList := THandleObjectList.Create;
|
||
{$ENDIF LINUX}
|
||
// TCriticalSections.Create(Application);
|
||
|
||
finalization
|
||
{$IFDEF LINUX}
|
||
WaitObjectList.Free;
|
||
{$ENDIF LINUX}
|
||
AppEventHook.Free;
|
||
GlobalCaret.Free;
|
||
//OutputDebugString('Unloaded QWindows.pas');
|
||
end.
|
||
|
||
|
||
|