1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
{
*****************************************************************************
* CustomDrawnWSForms.pp *
* ------------ *
* *
* *
*****************************************************************************
*****************************************************************************
This file is part of the Lazarus Component Library (LCL)
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
}
unit CustomDrawnWSForms;
{$mode objfpc}{$H+}
{$I customdrawndefines.inc}
interface
//{$I qtdefines.inc}
uses
// RTL
SysUtils, Classes, types, ctypes,
{$ifdef CD_Windows}Windows, customdrawn_WinProc,{$endif}
{$ifdef CD_Cocoa}MacOSAll, CocoaAll, customdrawn_cocoaproc, CocoaUtils, CocoaGDIObjects,{$endif}
{$ifdef CD_X11}XShm, X, XLib, XUtil, XAtom, customdrawn_x11proc,
{$ifdef CD_X11_UseATK}atk, {$endif} {unitxft, Xft font support}{$endif}
{$ifdef CD_Android}customdrawn_androidproc,{$endif}
// LazUtils
LazSysUtils,
// LCL
Controls, LCLType, Forms, LCLProc, GraphType, IntfGraphics, lazcanvas,
lazregions, LCLIntf, Lmessages, LazUTF8,
customdrawncontrols,
// Widgetset
InterfaceBase, WSForms, WSProc, WSLCLClasses, LCLMessageGlue,
customdrawnwscontrols, customdrawnint, customdrawnproc, customdrawnprivate;
type
{ TCDWSScrollingWinControl }
TCDWSScrollingWinControl = class(TWSScrollingWinControl)
published
end;
{ TCDWSScrollBox }
TCDWSScrollBox = class(TWSScrollBox)
published
// class procedure ScrollBy(const AWinControl: TWinControl;
// DeltaX, DeltaY: integer); override;
end;
{ TCDWSCustomFrame }
TCDWSCustomFrame = class(TWSCustomFrame)
published
// class procedure ScrollBy(const AWinControl: TWinControl;
// DeltaX, DeltaY: integer); override;
end;
{ TCDWSFrame }
TCDWSFrame = class(TWSFrame)
published
end;
{ TCDWSCustomForm }
TCDWSCustomForm = class(TWSCustomForm)
public
{$ifdef CD_Windows}
class function CalcBorderIconsFlags(const AForm: TCustomForm): dword;
class function CalcBorderIconsFlagsEx(const AForm: TCustomForm): DWORD;
class procedure CalcFormWindowFlags(const AForm: TCustomForm;
var Flags, FlagsEx: dword);
//class procedure CalculateDialogPosition(var Params: TCreateWindowExParams;
//Bounds: TRect; lForm: TCustomForm);
class function GetDesigningBorderStyle(const AForm: TCustomForm): TFormBorderStyle;
class function CalcBorderStyleFlags(const AForm: TCustomForm): DWORD;
class function CalcBorderStyleFlagsEx(const AForm: TCustomForm): DWORD;
class procedure AdjustFormBounds(const AForm: TCustomForm; out SizeRect: TRect);
class procedure WSWinControl_SetBounds(const AWinControl: TWinControl;
const ALeft, ATop, AWidth, AHeight: Integer);
{$endif}
{$ifdef CD_X11}
class procedure UpdateMotifWMHints(const AWinControl: TWinControl; CanMaximize: Boolean);
class procedure SetPosition(const AWinControl: TWinControl; const APosition: TPoint);
class procedure SetSize(const AWinControl: TWinControl; const ASize: TSize);
class procedure SetMinMaxSize(const AWinControl: TWinControl; const AMinSize, AMaxSize: TSize);
class procedure CreateX11Canvas(AWindowInfo: TX11WindowInfo);
class procedure DrawRawImageToGC(ARawImage: TRawImage;
ADestWindowInfo: TX11WindowInfo; ADestX, ADestY, ADestWidth, ADestHeight: Integer);
class function alloc_xshm_image(dpy: PDisplay; vis: PVisual;
width, height, depth: Integer; out shminfo: TXShmSegmentInfo): PXImage;
class procedure destroy_xshm_image(img: PXImage; var shminfo: TXShmSegmentInfo);
class procedure DrawRawImageToGC_XShmPutImage(ARawImage: TRawImage;
ADestWindowInfo: TX11WindowInfo; ADestX, ADestY, ADestWidth, ADestHeight: Integer);
class procedure DrawRawImageToGC_XPutImage(ARawImage: TRawImage;
ADestWindowInfo: TX11WindowInfo; ADestX, ADestY, ADestWidth, ADestHeight: Integer);
// Event handling
class procedure EvKeyPressed(const AWinControl: TWinControl;
AWindowInfo: TX11WindowInfo; var Event: TXKeyEvent);
class procedure EvKeyReleased(const AWinControl: TWinControl;
AWindowInfo: TX11WindowInfo; var Event: TXKeyEvent);
class procedure EvMousePressed(const AWinControl: TWinControl; AWindowInfo: TX11WindowInfo;
var Event: TXButtonEvent);
class procedure EvMouseReleased(const AWinControl: TWinControl; AWindowInfo: TX11WindowInfo;
var Event: TXButtonEvent);
class procedure EvMouseEnter(const AWinControl: TWinControl; AWindowInfo: TX11WindowInfo);
class procedure EvMouseLeave(const AWinControl: TWinControl; AWindowInfo: TX11WindowInfo);
class procedure EvMouseMove(const AWinControl: TWinControl; AWindowInfo: TX11WindowInfo;
var Event: TXMotionEvent);
class procedure EvFocusIn(const AWinControl: TWinControl; AWindowInfo: TX11WindowInfo);
class procedure EvFocusOut(const AWinControl: TWinControl; AWindowInfo: TX11WindowInfo);
class procedure EvPaint(const AWinControl: TWinControl; AWindowInfo: TX11WindowInfo);
class procedure EvPaintEx(const AWinControl: TWinControl; AWindowInfo: TX11WindowInfo);
class procedure EvConfigureNotify(const AWinControl: TWinControl; AWindowInfo: TX11WindowInfo;
var Event: TXConfigureEvent);
class procedure EvClientMessage(const AWinControl: TWinControl;
AWindowInfo: TX11WindowInfo; var Event: TXClientMessageEvent);
// Key routines
class function StartComposing(const Event: TXKeyEvent): TKeySym;
class function X11KeyToLCLKey(AX11Key: TKeySym): Word;
{$endif}
class function DoCreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle;
class procedure DoShowHide(const AWinControl: TWinControl);
published
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure DestroyHandle(const AWinControl: TWinControl); override;
class procedure SetBounds(const AWinControl: TWinControl;
const ALeft, ATop, AWidth, AHeight: Integer); override;
class procedure SetBorderIcons(const AForm: TCustomForm;
const ABorderIcons: TBorderIcons); override;
class procedure SetFormBorderStyle(const AForm: TCustomForm;
const AFormBorderStyle: TFormBorderStyle); override;
// class procedure SetFormStyle(const AForm: TCustomform; const AFormStyle, AOldFormStyle: TFormStyle); override;
// class procedure SetRealPopupParent(const ACustomForm: TCustomForm;
// const APopupParent: TCustomForm); override;
class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); override;
class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); override;
class procedure ShowModal(const ACustomForm: TCustomForm); override;
class procedure ShowHide(const AWinControl: TWinControl); override;
class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override;
class function GetTextLen(const AWinControl: TWinControl; var ALength: Integer): Boolean; override;
class procedure SetText(const AWinControl: TWinControl; const AText: String); override;
class function GetClientBounds(const AWincontrol: TWinControl; var ARect: TRect): Boolean; override;
class function GetClientRect(const AWincontrol: TWinControl; var ARect: TRect): Boolean; override;
{ class function CanFocus(const AWinControl: TWinControl): Boolean; override;
class procedure CloseModal(const ACustomForm: TCustomForm); override;
class procedure SetAllowDropFiles(const AForm: TCustomForm; AValue: Boolean); override;
class procedure SetAlphaBlend(const ACustomForm: TCustomForm;
const AlphaBlend: Boolean; const Alpha: Byte); override;}
end;
{ TCDWSForm }
TCDWSForm = class(TWSForm)
published
end;
{ TCDWSHintWindow }
TCDWSHintWindow = class(TWSHintWindow)
published
// class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
end;
{ TCDWSScreen }
TCDWSScreen = class(TWSScreen)
published
end;
{ TCDWSApplicationProperties }
TCDWSApplicationProperties = class(TWSApplicationProperties)
published
end;
implementation
{$ifdef CD_Windows}
{$include customdrawnwsforms_win.inc}
{$endif}
{$ifdef CD_Cocoa}
{$include customdrawnwsforms_cocoa.inc}
{$endif}
{$ifdef CD_X11}
{$include customdrawnwsforms_x11.inc}
{$endif}
{$ifdef CD_Android}
{$include customdrawnwsforms_android.inc}
{$endif}
end.
|
