1 | unit Dpi.Controls;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Classes, SysUtils, Controls, Graphics, LCLType, Generics.Collections,
|
---|
7 | Dpi.Graphics;
|
---|
8 |
|
---|
9 | const
|
---|
10 | CM_MOUSELEAVE = Controls.CM_MOUSELEAVE;
|
---|
11 |
|
---|
12 | type
|
---|
13 | TMouseButton = Controls.TMouseButton;
|
---|
14 | TKeyEvent = Controls.TKeyEvent;
|
---|
15 | TAlign = Controls.TAlign;
|
---|
16 | TBorderStyle = Controls.TBorderStyle;
|
---|
17 |
|
---|
18 | { TControlEx }
|
---|
19 |
|
---|
20 | TControlEx = class(Controls.TControl)
|
---|
21 | public
|
---|
22 | property ParentColor;
|
---|
23 | property OnMouseDown;
|
---|
24 | property OnMouseUp;
|
---|
25 | property OnMouseMove;
|
---|
26 | property OnMouseWheel;
|
---|
27 | property OnMouseLeave;
|
---|
28 | property OnMouseEnter;
|
---|
29 | property OnDblClick;
|
---|
30 | property ParentFont;
|
---|
31 | end;
|
---|
32 |
|
---|
33 | { TGraphicControlEx }
|
---|
34 |
|
---|
35 | TGraphicControlEx = class(Controls.TGraphicControl)
|
---|
36 | public
|
---|
37 | property OnPaint;
|
---|
38 | procedure Paint; override;
|
---|
39 | end;
|
---|
40 |
|
---|
41 | TWinControlEx = class(Controls.TWinControl)
|
---|
42 | public
|
---|
43 | property BorderStyle;
|
---|
44 | property OnKeyDown;
|
---|
45 | end;
|
---|
46 |
|
---|
47 | TWinControl = class;
|
---|
48 | TControlBorderSpacing = class;
|
---|
49 |
|
---|
50 | { TSizeConstraints }
|
---|
51 |
|
---|
52 | TSizeConstraints = class(TPersistent)
|
---|
53 | private
|
---|
54 | FMaxHeight: TConstraintSize;
|
---|
55 | FMaxWidth: TConstraintSize;
|
---|
56 | FMinHeight: TConstraintSize;
|
---|
57 | FMinWidth: TConstraintSize;
|
---|
58 | procedure SetMaxHeight(AValue: TConstraintSize);
|
---|
59 | procedure SetMaxWidth(AValue: TConstraintSize);
|
---|
60 | procedure SetMinHeight(AValue: TConstraintSize);
|
---|
61 | procedure SetMinWidth(AValue: TConstraintSize);
|
---|
62 | published
|
---|
63 | property MaxHeight: TConstraintSize read FMaxHeight write SetMaxHeight default 0;
|
---|
64 | property MaxWidth: TConstraintSize read FMaxWidth write SetMaxWidth default 0;
|
---|
65 | property MinHeight: TConstraintSize read FMinHeight write SetMinHeight default 0;
|
---|
66 | property MinWidth: TConstraintSize read FMinWidth write SetMinWidth default 0;
|
---|
67 | end;
|
---|
68 |
|
---|
69 | { TControl }
|
---|
70 |
|
---|
71 | TControl = class(TComponent)
|
---|
72 | private
|
---|
73 | FBorderSpacing: TControlBorderSpacing;
|
---|
74 | FConstraints: TSizeConstraints;
|
---|
75 | FFont: TFont;
|
---|
76 | FHeight: Integer;
|
---|
77 | FLeft: Integer;
|
---|
78 | FOnChangeBounds: TNotifyEvent;
|
---|
79 | FOnMouseUp: TMouseEvent;
|
---|
80 | FOnMouseDown: TMouseEvent;
|
---|
81 | FOnMouseMove: TMouseMoveEvent;
|
---|
82 | FOnMouseEnter: TNotifyEvent;
|
---|
83 | FOnMouseLeave: TNotifyEvent;
|
---|
84 | FOnMouseWheel: TMouseWheelEvent;
|
---|
85 | FOnResize: TNotifyEvent;
|
---|
86 | FTop: Integer;
|
---|
87 | FWidth: Integer;
|
---|
88 | FParent: TWinControl;
|
---|
89 | function GetAlign: TAlign;
|
---|
90 | function GetAnchors: TAnchors;
|
---|
91 | function GetAutoSize: Boolean;
|
---|
92 | function GetBoundsRect: TRect;
|
---|
93 | function GetClientHeight: Integer;
|
---|
94 | function GetClientWidth: Integer;
|
---|
95 | function GetColor: TColor;
|
---|
96 | function GetCursor: TCursor;
|
---|
97 | function GetEnabled: Boolean;
|
---|
98 | function GetHint: string;
|
---|
99 | function GetOnClick: TNotifyEvent;
|
---|
100 | function GetOnDblClick: TNotifyEvent;
|
---|
101 | function GetParentColor: Boolean;
|
---|
102 | function GetParentFont: Boolean;
|
---|
103 | function GetShowHint: Boolean;
|
---|
104 | function GetVisible: Boolean;
|
---|
105 | function GetWindowProc: TWndMethod;
|
---|
106 | function IsAnchorsStored: Boolean;
|
---|
107 | procedure SetAlign(AValue: TAlign);
|
---|
108 | procedure SetAnchors(AValue: TAnchors);
|
---|
109 | procedure SetAutoSize(AValue: Boolean);
|
---|
110 | procedure SetBorderSpacing(AValue: TControlBorderSpacing);
|
---|
111 | procedure SetBoundsRect(AValue: TRect);
|
---|
112 | procedure SetClientHeight(AValue: Integer);
|
---|
113 | procedure SetClientWidth(AValue: Integer);
|
---|
114 | procedure SetColor(AValue: TColor);
|
---|
115 | procedure SetCursor(AValue: TCursor);
|
---|
116 | procedure SetEnabled(AValue: Boolean);
|
---|
117 | procedure SetFont(AValue: TFont);
|
---|
118 | procedure SetHint(AValue: string);
|
---|
119 | procedure SetOnClick(AValue: TNotifyEvent);
|
---|
120 | procedure SetOnDblClick(AValue: TNotifyEvent);
|
---|
121 | procedure SetParentColor(AValue: Boolean);
|
---|
122 | procedure SetParentFont(AValue: Boolean);
|
---|
123 | procedure SetShowHint(AValue: Boolean);
|
---|
124 | procedure NativeFormResize(Sender: TObject);
|
---|
125 | procedure NativeChangeBounds(Sender: TObject);
|
---|
126 | procedure DoFormResize;
|
---|
127 | procedure DoChangeBounds;
|
---|
128 | procedure MouseDownHandler(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
|
---|
129 | X, Y: Integer); virtual;
|
---|
130 | procedure MouseUpHandler(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
|
---|
131 | X, Y: Integer); virtual;
|
---|
132 | procedure MouseMoveHandler(Sender: TObject; Shift: TShiftState; X, Y: Integer); virtual;
|
---|
133 | procedure MouseWheelHandler(Sender: TObject; Shift: TShiftState;
|
---|
134 | WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); virtual;
|
---|
135 | procedure MouseLeaveHandler(Sender: TObject); virtual;
|
---|
136 | procedure MouseEnterHandler(Sender: TObject); virtual;
|
---|
137 | procedure SetWindowProc(AValue: TWndMethod);
|
---|
138 | function ColorIsStored: Boolean; virtual;
|
---|
139 | protected
|
---|
140 | procedure DoBorderSpacingChange(Sender: TObject; InnerSpaceChanged: Boolean); virtual;
|
---|
141 | function GetText: TCaption; virtual;
|
---|
142 | procedure SetText(AValue: TCaption); virtual;
|
---|
143 | procedure UpdateBounds; virtual;
|
---|
144 | procedure FontChanged(Sender: TObject); virtual;
|
---|
145 | function GetCaption: string; virtual;
|
---|
146 | procedure SetParent(AValue: TWinControl); virtual;
|
---|
147 | procedure SetCaption(AValue: string); virtual;
|
---|
148 | procedure SetHeight(AValue: Integer); virtual;
|
---|
149 | procedure SetLeft(AValue: Integer); virtual;
|
---|
150 | procedure SetTop(AValue: Integer); virtual;
|
---|
151 | procedure SetVisible(AValue: Boolean); virtual;
|
---|
152 | procedure SetWidth(AValue: Integer); virtual;
|
---|
153 | function GetNativeControl: Controls.TControl; virtual;
|
---|
154 | procedure UpdateNativeControl; virtual;
|
---|
155 | procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
---|
156 | X, Y: Integer); virtual;
|
---|
157 | procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
|
---|
158 | X, Y: Integer); virtual;
|
---|
159 | procedure MouseMove(Shift: TShiftState; X, Y: Integer); virtual;
|
---|
160 | procedure MouseLeave; virtual;
|
---|
161 | procedure MouseEnter; virtual;
|
---|
162 | property Text: TCaption read GetText write SetText;
|
---|
163 | property ParentFont: Boolean read GetParentFont write SetParentFont default True;
|
---|
164 | property ParentColor: Boolean read GetParentColor write SetParentColor default True;
|
---|
165 | public
|
---|
166 | function ScreenToClient(const APoint: TPoint): TPoint; virtual;
|
---|
167 | function ClientToScreen(const APoint: TPoint): TPoint; virtual;
|
---|
168 | procedure AddHandlerOnVisibleChanged(const OnVisibleChangedEvent: TNotifyEvent;
|
---|
169 | AsFirst: boolean = false);
|
---|
170 | procedure RemoveHandlerOnVisibleChanged(const OnVisibleChangedEvent: TNotifyEvent);
|
---|
171 | procedure ScreenChanged; virtual;
|
---|
172 | procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); virtual;
|
---|
173 | procedure Show;
|
---|
174 | procedure Hide;
|
---|
175 | procedure Invalidate;
|
---|
176 | procedure Repaint;
|
---|
177 | procedure Update;
|
---|
178 | procedure Refresh;
|
---|
179 | function IsParentOf(AControl: TControl): Boolean; virtual;
|
---|
180 | function Scale96ToScreen(const ASize: Integer): Integer;
|
---|
181 | constructor Create(TheOwner: TComponent); override;
|
---|
182 | destructor Destroy; override;
|
---|
183 | property Parent: TWinControl read FParent write SetParent;
|
---|
184 | property BoundsRect: TRect read GetBoundsRect write SetBoundsRect;
|
---|
185 | property Visible: Boolean read GetVisible write SetVisible;
|
---|
186 | property Anchors: TAnchors read GetAnchors write SetAnchors stored IsAnchorsStored default [akLeft, akTop];
|
---|
187 | property BorderSpacing: TControlBorderSpacing read FBorderSpacing write SetBorderSpacing;
|
---|
188 | property WindowProc: TWndMethod read GetWindowProc write SetWindowProc;
|
---|
189 | published
|
---|
190 | property AutoSize: Boolean read GetAutoSize write SetAutoSize default False;
|
---|
191 | property ClientHeight: Integer read GetClientHeight write SetClientHeight;
|
---|
192 | property ClientWidth: Integer read GetClientWidth write SetClientWidth;
|
---|
193 | property Hint: string read GetHint write SetHint;
|
---|
194 | property Top: Integer read FTop write SetTop;
|
---|
195 | property Left: Integer read FLeft write SetLeft;
|
---|
196 | property Width: Integer read FWidth write SetWidth;
|
---|
197 | property Height: Integer read FHeight write SetHeight;
|
---|
198 | property Caption: string read GetCaption write SetCaption;
|
---|
199 | property Enabled: Boolean read GetEnabled write SetEnabled;
|
---|
200 | property ShowHint: Boolean read GetShowHint write SetShowHint;
|
---|
201 | property Font: TFont read FFont write SetFont;
|
---|
202 | property Align: TAlign read GetAlign write SetAlign;
|
---|
203 | property Color: TColor read GetColor write SetColor stored ColorIsStored default {$ifdef UseCLDefault}clDefault{$else}clWindow{$endif};
|
---|
204 | property Constraints: TSizeConstraints read FConstraints write FConstraints;
|
---|
205 | property Cursor: TCursor read GetCursor write SetCursor default crDefault;
|
---|
206 | property OnResize: TNotifyEvent read FOnResize write FOnResize;
|
---|
207 | property OnChangeBounds: TNotifyEvent read FOnChangeBounds write FOnChangeBounds;
|
---|
208 | property OnClick: TNotifyEvent read GetOnClick write SetOnClick;
|
---|
209 | property OnDblClick: TNotifyEvent read GetOnDblClick write SetOnDblClick;
|
---|
210 | property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
|
---|
211 | property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
|
---|
212 | property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
|
---|
213 | property OnMouseWheel: TMouseWheelEvent read FOnMouseWheel write FOnMouseWheel;
|
---|
214 | end;
|
---|
215 |
|
---|
216 | TDpiControls = TObjectList<TControl>;
|
---|
217 |
|
---|
218 | { TWinControl }
|
---|
219 |
|
---|
220 | TWinControl = class(TControl)
|
---|
221 | private
|
---|
222 | FOnKeyDown: TKeyEvent;
|
---|
223 | function GetBorderStyle: TBorderStyle;
|
---|
224 | function GetHandle: HWND;
|
---|
225 | function GetOnKeyDown: TKeyEvent;
|
---|
226 | function GetOnKeyPress: TKeyPressEvent;
|
---|
227 | function GetOnKeyUp: TKeyEvent;
|
---|
228 | function GetTabOrder: TTabOrder;
|
---|
229 | function GetTabStop: Boolean;
|
---|
230 | procedure SetBorderStyle(AValue: TBorderStyle);
|
---|
231 | procedure SetHandle(AValue: HWND);
|
---|
232 | procedure SetOnKeyDown(AValue: TKeyEvent);
|
---|
233 | procedure SetOnKeyPress(AValue: TKeyPressEvent);
|
---|
234 | procedure SetOnKeyUp(AValue: TKeyEvent);
|
---|
235 | procedure SetTabOrder(AValue: TTabOrder);
|
---|
236 | procedure SetTabStop(AValue: Boolean);
|
---|
237 | procedure KeyDownHandler(Sender: TObject; var Key: Word; Shift: TShiftState);
|
---|
238 | protected
|
---|
239 | procedure UpdateNativeControl; override;
|
---|
240 | function GetNativeControl: Controls.TControl; override;
|
---|
241 | function GetNativeWinControl: Controls.TWinControl; virtual;
|
---|
242 | property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsNone;
|
---|
243 | procedure KeyDown(var Key: Word; Shift: TShiftState); virtual;
|
---|
244 | public
|
---|
245 | Controls: TDpiControls;
|
---|
246 | function HandleAllocated: Boolean;
|
---|
247 | procedure ScreenChanged; override;
|
---|
248 | function ControlCount: Integer;
|
---|
249 | procedure SetFocus; virtual;
|
---|
250 | constructor Create(TheOwner: TComponent); override;
|
---|
251 | destructor Destroy; override;
|
---|
252 | property Handle: HWND read GetHandle write SetHandle;
|
---|
253 | published
|
---|
254 | property TabOrder: TTabOrder read GetTabOrder write SetTabOrder default -1;
|
---|
255 | property TabStop: Boolean read GetTabStop write SetTabStop default False;
|
---|
256 | property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown;
|
---|
257 | property OnKeyPress: TKeyPressEvent read GetOnKeyPress write SetOnKeyPress;
|
---|
258 | property OnKeyUp: TKeyEvent read GetOnKeyUp write SetOnKeyUp;
|
---|
259 | end;
|
---|
260 |
|
---|
261 | { TControlBorderSpacing }
|
---|
262 |
|
---|
263 | TControlBorderSpacing = class(TPersistent)
|
---|
264 | private
|
---|
265 | FAround: TSpacingSize;
|
---|
266 | FBottom: TSpacingSize;
|
---|
267 | FLeft: TSpacingSize;
|
---|
268 | FOnChange: TNotifyEvent;
|
---|
269 | FRight: TSpacingSize;
|
---|
270 | FTop: TSpacingSize;
|
---|
271 | FControl: TControl;
|
---|
272 | FDefault: PControlBorderSpacingDefault;
|
---|
273 | function IsAroundStored: Boolean;
|
---|
274 | function IsBottomStored: Boolean;
|
---|
275 | function IsLeftStored: Boolean;
|
---|
276 | function IsRightStored: Boolean;
|
---|
277 | function IsTopStored: Boolean;
|
---|
278 | procedure SetAround(AValue: TSpacingSize);
|
---|
279 | procedure SetBottom(AValue: TSpacingSize);
|
---|
280 | procedure SetLeft(AValue: TSpacingSize);
|
---|
281 | procedure SetRight(AValue: TSpacingSize);
|
---|
282 | procedure SetTop(AValue: TSpacingSize);
|
---|
283 | procedure Change(InnerSpaceChanged: Boolean); virtual;
|
---|
284 | public
|
---|
285 | constructor Create(OwnerControl: TControl; ADefault: PControlBorderSpacingDefault = nil);
|
---|
286 | published
|
---|
287 | property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
---|
288 | property Around: TSpacingSize read FAround write SetAround stored IsAroundStored;
|
---|
289 | property Left: TSpacingSize read FLeft write SetLeft stored IsLeftStored;
|
---|
290 | property Top: TSpacingSize read FTop write SetTop stored IsTopStored;
|
---|
291 | property Right: TSpacingSize read FRight write SetRight stored IsRightStored;
|
---|
292 | property Bottom: TSpacingSize read FBottom write SetBottom stored IsBottomStored;
|
---|
293 | end;
|
---|
294 |
|
---|
295 | { TCustomControl }
|
---|
296 |
|
---|
297 | TCustomControl = class(TWinControl)
|
---|
298 | private
|
---|
299 | FCanvas: TCanvas;
|
---|
300 | function GetCanvas: TCanvas;
|
---|
301 | function GetOnPaint: TNotifyEvent;
|
---|
302 | function GetPixelsPerInch: Integer;
|
---|
303 | procedure SetOnPaint(AValue: TNotifyEvent);
|
---|
304 | procedure SetPixelsPerInch(AValue: Integer);
|
---|
305 | protected
|
---|
306 | function GetNativeWinControl: Controls.TWinControl; override;
|
---|
307 | function GetNativeCustomControl: Controls.TCustomControl; virtual;
|
---|
308 | public
|
---|
309 | constructor Create(TheOwner: TComponent); override;
|
---|
310 | destructor Destroy; override;
|
---|
311 | property Canvas: TCanvas read GetCanvas;
|
---|
312 | published
|
---|
313 | property PixelsPerInch: Integer read GetPixelsPerInch write SetPixelsPerInch stored False;
|
---|
314 | property OnPaint: TNotifyEvent read GetOnPaint write SetOnPaint;
|
---|
315 | end;
|
---|
316 |
|
---|
317 | { TGraphicControl }
|
---|
318 |
|
---|
319 | TGraphicControl = class(TControl)
|
---|
320 | private
|
---|
321 | FOnPaint: TNotifyEvent;
|
---|
322 | NativeGraphicControl: Controls.TGraphicControl;
|
---|
323 | FCanvas: TCanvas;
|
---|
324 | function GetOnPaint: TNotifyEvent;
|
---|
325 | procedure SetCanvas(AValue: TCanvas);
|
---|
326 | procedure PaintHandler(Sender: TObject);
|
---|
327 | procedure SetOnPaint(AValue: TNotifyEvent);
|
---|
328 | protected
|
---|
329 | procedure Paint; virtual;
|
---|
330 | function GetNativeControl: Controls.TControl; override;
|
---|
331 | function GetNativeGraphicControl: Controls.TGraphicControl; virtual;
|
---|
332 | procedure UpdateNativeControl; override;
|
---|
333 | property OnPaint: TNotifyEvent read GetOnPaint write SetOnPaint;
|
---|
334 | public
|
---|
335 | constructor Create(TheOwner: TComponent); override;
|
---|
336 | destructor Destroy; override;
|
---|
337 | published
|
---|
338 | property Canvas: TCanvas read FCanvas write SetCanvas;
|
---|
339 | end;
|
---|
340 |
|
---|
341 | { TMouse }
|
---|
342 |
|
---|
343 | TMouse = class
|
---|
344 | private
|
---|
345 | function GetCursorPos: TPoint;
|
---|
346 | procedure SetCursorPos(AValue: TPoint);
|
---|
347 | public
|
---|
348 | constructor Create;
|
---|
349 | destructor Destroy; override;
|
---|
350 | property CursorPos: TPoint read GetCursorPos write SetCursorPos;
|
---|
351 | end;
|
---|
352 |
|
---|
353 | { TImageList }
|
---|
354 |
|
---|
355 | TImageList = class(TComponent)
|
---|
356 | private
|
---|
357 | NativeImageList: Controls.TImageList;
|
---|
358 | function GetCount: Integer;
|
---|
359 | function GetHeight: Integer;
|
---|
360 | function GetWidth: Integer;
|
---|
361 | procedure SetHeight(AValue: Integer);
|
---|
362 | procedure SetWidth(AValue: Integer);
|
---|
363 | public
|
---|
364 | function GetNativeImageList: Controls.TImageList;
|
---|
365 | procedure GetBitmap(Index: Integer; Image: TBitmap);
|
---|
366 | procedure BeginUpdate;
|
---|
367 | procedure EndUpdate;
|
---|
368 | procedure Clear;
|
---|
369 | function Add(Image, Mask: TBitmap): Integer;
|
---|
370 | constructor Create(TheOwner: TComponent); override;
|
---|
371 | destructor Destroy; override;
|
---|
372 | property Width: Integer read GetWidth write SetWidth default 16;
|
---|
373 | property Height: Integer read GetHeight write SetHeight default 16;
|
---|
374 | property Count: Integer read GetCount;
|
---|
375 | end;
|
---|
376 |
|
---|
377 | var
|
---|
378 | Mouse: TMouse;
|
---|
379 |
|
---|
380 |
|
---|
381 | implementation
|
---|
382 |
|
---|
383 | uses
|
---|
384 | Dpi.Common;
|
---|
385 |
|
---|
386 | { TCustomControl }
|
---|
387 |
|
---|
388 | function TCustomControl.GetOnPaint: TNotifyEvent;
|
---|
389 | begin
|
---|
390 | Result := GetNativeCustomControl.OnPaint;
|
---|
391 | end;
|
---|
392 |
|
---|
393 | function TCustomControl.GetPixelsPerInch: Integer;
|
---|
394 | begin
|
---|
395 | //Result := GetNativeCustomControl.Pix;
|
---|
396 | end;
|
---|
397 |
|
---|
398 | function TCustomControl.GetCanvas: TCanvas;
|
---|
399 | begin
|
---|
400 | Result := FCanvas;
|
---|
401 | end;
|
---|
402 |
|
---|
403 | procedure TCustomControl.SetOnPaint(AValue: TNotifyEvent);
|
---|
404 | begin
|
---|
405 | GetNativeCustomControl.OnPaint := AValue;
|
---|
406 | end;
|
---|
407 |
|
---|
408 | procedure TCustomControl.SetPixelsPerInch(AValue: Integer);
|
---|
409 | begin
|
---|
410 | end;
|
---|
411 |
|
---|
412 | function TCustomControl.GetNativeWinControl: Controls.TWinControl;
|
---|
413 | begin
|
---|
414 | Result := GetNativeCustomControl;
|
---|
415 | end;
|
---|
416 |
|
---|
417 | function TCustomControl.GetNativeCustomControl: Controls.TCustomControl;
|
---|
418 | begin
|
---|
419 | Result := nil;
|
---|
420 | end;
|
---|
421 |
|
---|
422 | constructor TCustomControl.Create(TheOwner: TComponent);
|
---|
423 | begin
|
---|
424 | inherited;
|
---|
425 | FCanvas := TCanvas.Create;
|
---|
426 | FCanvas.NativeCanvas := GetNativeCustomControl.Canvas;
|
---|
427 | end;
|
---|
428 |
|
---|
429 | destructor TCustomControl.Destroy;
|
---|
430 | begin
|
---|
431 | FreeAndNil(FCanvas);
|
---|
432 | inherited;
|
---|
433 | end;
|
---|
434 |
|
---|
435 | { TWinControl }
|
---|
436 |
|
---|
437 | function TWinControl.GetBorderStyle: TBorderStyle;
|
---|
438 | begin
|
---|
439 | {$objectChecks-}
|
---|
440 | Result := TWinControlEx(GetNativeWinControl).BorderStyle;
|
---|
441 | {$objectChecks+}
|
---|
442 | end;
|
---|
443 |
|
---|
444 | function TWinControl.GetHandle: HWND;
|
---|
445 | begin
|
---|
446 | Result := GetNativeWinControl.Handle;
|
---|
447 | end;
|
---|
448 |
|
---|
449 | function TWinControl.GetOnKeyDown: TKeyEvent;
|
---|
450 | begin
|
---|
451 | Result := GetNativeWinControl.OnKeyDown;
|
---|
452 | end;
|
---|
453 |
|
---|
454 | function TWinControl.GetOnKeyPress: TKeyPressEvent;
|
---|
455 | begin
|
---|
456 | Result := GetNativeWinControl.OnKeyPress;
|
---|
457 | end;
|
---|
458 |
|
---|
459 | function TWinControl.GetOnKeyUp: TKeyEvent;
|
---|
460 | begin
|
---|
461 | Result := GetNativeWinControl.OnKeyUp;
|
---|
462 | end;
|
---|
463 |
|
---|
464 | function TWinControl.GetTabOrder: TTabOrder;
|
---|
465 | begin
|
---|
466 | Result := GetNativeWinControl.TabOrder;
|
---|
467 | end;
|
---|
468 |
|
---|
469 | function TWinControl.GetTabStop: Boolean;
|
---|
470 | begin
|
---|
471 | Result := GetNativeWinControl.TabStop;
|
---|
472 | end;
|
---|
473 |
|
---|
474 | procedure TWinControl.SetBorderStyle(AValue: TBorderStyle);
|
---|
475 | begin
|
---|
476 | {$objectChecks-}
|
---|
477 | TWinControlEx(GetNativeWinControl).BorderStyle := AValue;
|
---|
478 | {$objectChecks+}
|
---|
479 | end;
|
---|
480 |
|
---|
481 | procedure TWinControl.SetHandle(AValue: HWND);
|
---|
482 | begin
|
---|
483 | GetNativeWinControl.Handle := AValue;
|
---|
484 | end;
|
---|
485 |
|
---|
486 | procedure TWinControl.SetOnKeyDown(AValue: TKeyEvent);
|
---|
487 | begin
|
---|
488 | GetNativeWinControl.OnKeyDown := AValue;
|
---|
489 | end;
|
---|
490 |
|
---|
491 | procedure TWinControl.SetOnKeyPress(AValue: TKeyPressEvent);
|
---|
492 | begin
|
---|
493 | GetNativeWinControl.OnKeyPress := AValue;
|
---|
494 | end;
|
---|
495 |
|
---|
496 | procedure TWinControl.SetOnKeyUp(AValue: TKeyEvent);
|
---|
497 | begin
|
---|
498 | GetNativeWinControl.OnKeyUp := AValue;
|
---|
499 | end;
|
---|
500 |
|
---|
501 | procedure TWinControl.SetTabOrder(AValue: TTabOrder);
|
---|
502 | begin
|
---|
503 | GetNativeWinControl.TabOrder := AValue;
|
---|
504 | end;
|
---|
505 |
|
---|
506 | procedure TWinControl.SetTabStop(AValue: Boolean);
|
---|
507 | begin
|
---|
508 | GetNativeWinControl.TabStop := AValue;
|
---|
509 | end;
|
---|
510 |
|
---|
511 | procedure TWinControl.KeyDownHandler(Sender: TObject; var Key: Word;
|
---|
512 | Shift: TShiftState);
|
---|
513 | begin
|
---|
514 | KeyDown(Key, Shift);
|
---|
515 | if Assigned(FOnKeyDown) then FOnKeyDown(Self, Key, Shift);
|
---|
516 | end;
|
---|
517 |
|
---|
518 | procedure TWinControl.UpdateNativeControl;
|
---|
519 | begin
|
---|
520 | inherited;
|
---|
521 | GetNativeWinControl.OnKeyDown := KeyDownHandler;
|
---|
522 | end;
|
---|
523 |
|
---|
524 | function TWinControl.GetNativeControl: Controls.TControl;
|
---|
525 | begin
|
---|
526 | Result := GetNativeWinControl;
|
---|
527 | end;
|
---|
528 |
|
---|
529 | function TWinControl.GetNativeWinControl: Controls.TWinControl;
|
---|
530 | begin
|
---|
531 | Result := nil;
|
---|
532 | end;
|
---|
533 |
|
---|
534 | procedure TWinControl.KeyDown(var Key: Word; Shift: TShiftState);
|
---|
535 | begin
|
---|
536 | end;
|
---|
537 |
|
---|
538 | function TWinControl.HandleAllocated: Boolean;
|
---|
539 | begin
|
---|
540 | Result := GetNativeWinControl.HandleAllocated;
|
---|
541 | end;
|
---|
542 |
|
---|
543 | procedure TWinControl.ScreenChanged;
|
---|
544 | var
|
---|
545 | I: Integer;
|
---|
546 | begin
|
---|
547 | inherited;
|
---|
548 | for I := 0 to Controls.Count - 1 do
|
---|
549 | Controls[I].ScreenChanged;
|
---|
550 | end;
|
---|
551 |
|
---|
552 | function TWinControl.ControlCount: Integer;
|
---|
553 | begin
|
---|
554 | Result := Controls.Count;
|
---|
555 | end;
|
---|
556 |
|
---|
557 | procedure TWinControl.SetFocus;
|
---|
558 | begin
|
---|
559 | GetNativeWinControl.SetFocus;
|
---|
560 | end;
|
---|
561 |
|
---|
562 | constructor TWinControl.Create(TheOwner: TComponent);
|
---|
563 | begin
|
---|
564 | Controls := TDpiControls.Create;
|
---|
565 | Controls.OwnsObjects := False;
|
---|
566 | inherited;
|
---|
567 | end;
|
---|
568 |
|
---|
569 | destructor TWinControl.Destroy;
|
---|
570 | begin
|
---|
571 | FreeAndNil(Controls);
|
---|
572 | inherited;
|
---|
573 | end;
|
---|
574 |
|
---|
575 | { TControl }
|
---|
576 |
|
---|
577 | procedure TControl.SetTop(AValue: Integer);
|
---|
578 | begin
|
---|
579 | if FTop = AValue then Exit;
|
---|
580 | FTop := AValue;
|
---|
581 | UpdateBounds;
|
---|
582 | end;
|
---|
583 |
|
---|
584 | procedure TControl.SetVisible(AValue: Boolean);
|
---|
585 | begin
|
---|
586 | GetNativeControl.Visible := AValue;
|
---|
587 | end;
|
---|
588 |
|
---|
589 | procedure TControl.SetWidth(AValue: Integer);
|
---|
590 | begin
|
---|
591 | if FWidth = AValue then Exit;
|
---|
592 | FWidth := AValue;
|
---|
593 | UpdateBounds;
|
---|
594 | end;
|
---|
595 |
|
---|
596 | function TControl.GetNativeControl: Controls.TControl;
|
---|
597 | begin
|
---|
598 | Result := nil;
|
---|
599 | end;
|
---|
600 |
|
---|
601 | procedure TControl.UpdateNativeControl;
|
---|
602 | begin
|
---|
603 | Font.NativeFont := GetNativeControl.Font;
|
---|
604 | GetNativeControl.OnResize := NativeFormResize;
|
---|
605 | GetNativeControl.OnChangeBounds := NativeChangeBounds;
|
---|
606 |
|
---|
607 | {$objectChecks-}
|
---|
608 | TControlEx(GetNativeControl).OnMouseDown := MouseDownHandler;
|
---|
609 | TControlEx(GetNativeControl).OnMouseUp := MouseUpHandler;
|
---|
610 | TControlEx(GetNativeControl).OnMouseMove := MouseMoveHandler;
|
---|
611 | TControlEx(GetNativeControl).OnMouseEnter := MouseEnterHandler;
|
---|
612 | TControlEx(GetNativeControl).OnMouseLeave := MouseLeaveHandler;
|
---|
613 | TControlEx(GetNativeControl).OnMouseWheel := MouseWheelHandler;
|
---|
614 | {$objectChecks+}
|
---|
615 | end;
|
---|
616 |
|
---|
617 | procedure TControl.MouseDownHandler(Sender: TObject; Button: TMouseButton;
|
---|
618 | Shift: TShiftState; X, Y: Integer);
|
---|
619 | begin
|
---|
620 | MouseDown(Button, Shift, ScaleFromNative(X), ScaleFromNative(Y));
|
---|
621 | if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, ScaleFromNative(X), ScaleFromNative(Y));
|
---|
622 | end;
|
---|
623 |
|
---|
624 | procedure TControl.MouseUpHandler(Sender: TObject; Button: TMouseButton;
|
---|
625 | Shift: TShiftState; X, Y: Integer);
|
---|
626 | begin
|
---|
627 | MouseUp(Button, Shift, ScaleFromNative(X), ScaleFromNative(Y));
|
---|
628 | if Assigned(FOnMouseUp) then FOnMouseUp(Self, Button, Shift, ScaleFromNative(X), ScaleFromNative(Y));
|
---|
629 | end;
|
---|
630 |
|
---|
631 | procedure TControl.MouseMoveHandler(Sender: TObject; Shift: TShiftState; X,
|
---|
632 | Y: Integer);
|
---|
633 | begin
|
---|
634 | MouseMove(Shift, ScaleFromNative(X), ScaleFromNative(Y));
|
---|
635 | if Assigned(FOnMouseMove) then FOnMouseMove(Self, Shift, ScaleFromNative(X), ScaleFromNative(Y));
|
---|
636 | end;
|
---|
637 |
|
---|
638 | procedure TControl.MouseWheelHandler(Sender: TObject; Shift: TShiftState;
|
---|
639 | WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
|
---|
640 | begin
|
---|
641 | if Assigned(FOnMouseWheel) then FOnMouseWheel(Self, Shift, WheelDelta,
|
---|
642 | ScalePointFromNative(MousePos), Handled);
|
---|
643 | end;
|
---|
644 |
|
---|
645 | procedure TControl.MouseLeaveHandler(Sender: TObject);
|
---|
646 | begin
|
---|
647 | MouseLeave;
|
---|
648 | if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
|
---|
649 | end;
|
---|
650 |
|
---|
651 | procedure TControl.MouseEnterHandler(Sender: TObject);
|
---|
652 | begin
|
---|
653 | MouseEnter;
|
---|
654 | if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
|
---|
655 | end;
|
---|
656 |
|
---|
657 | procedure TControl.SetWindowProc(AValue: TWndMethod);
|
---|
658 | begin
|
---|
659 | GetNativeControl.WindowProc := AValue;
|
---|
660 | end;
|
---|
661 |
|
---|
662 | function TControl.ColorIsStored: Boolean;
|
---|
663 | begin
|
---|
664 | Result := not ParentColor;
|
---|
665 | end;
|
---|
666 |
|
---|
667 | procedure TControl.DoBorderSpacingChange(Sender: TObject;
|
---|
668 | InnerSpaceChanged: Boolean);
|
---|
669 | begin
|
---|
670 | GetNativeControl.BorderSpacing.Left := ScaleToNative(FBorderSpacing.Left);
|
---|
671 | GetNativeControl.BorderSpacing.Right := ScaleToNative(FBorderSpacing.Right);
|
---|
672 | GetNativeControl.BorderSpacing.Top := ScaleToNative(FBorderSpacing.Top);
|
---|
673 | GetNativeControl.BorderSpacing.Bottom := ScaleToNative(FBorderSpacing.Bottom);
|
---|
674 | GetNativeControl.BorderSpacing.Around := ScaleToNative(FBorderSpacing.Around);
|
---|
675 | end;
|
---|
676 |
|
---|
677 | procedure TControl.SetText(AValue: TCaption);
|
---|
678 | begin
|
---|
679 |
|
---|
680 | end;
|
---|
681 |
|
---|
682 | procedure TControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
|
---|
683 | Y: Integer);
|
---|
684 | begin
|
---|
685 | end;
|
---|
686 |
|
---|
687 | procedure TControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
|
---|
688 | Y: Integer);
|
---|
689 | begin
|
---|
690 | end;
|
---|
691 |
|
---|
692 | procedure TControl.MouseMove(Shift: TShiftState; X, Y: Integer);
|
---|
693 | begin
|
---|
694 | end;
|
---|
695 |
|
---|
696 | procedure TControl.MouseLeave;
|
---|
697 | begin
|
---|
698 | end;
|
---|
699 |
|
---|
700 | procedure TControl.MouseEnter;
|
---|
701 | begin
|
---|
702 | end;
|
---|
703 |
|
---|
704 | function TControl.ScreenToClient(const APoint: TPoint): TPoint;
|
---|
705 | begin
|
---|
706 | Result := ScalePointFromNative(GetNativeControl.ScreenToClient(ScalePointToNative(APoint)));
|
---|
707 | end;
|
---|
708 |
|
---|
709 | function TControl.ClientToScreen(const APoint: TPoint): TPoint;
|
---|
710 | begin
|
---|
711 | Result := ScalePointFromNative(GetNativeControl.ClientToScreen(ScalePointToNative(APoint)));
|
---|
712 | end;
|
---|
713 |
|
---|
714 | procedure TControl.AddHandlerOnVisibleChanged(
|
---|
715 | const OnVisibleChangedEvent: TNotifyEvent; AsFirst: boolean);
|
---|
716 | begin
|
---|
717 | GetNativeControl.AddHandlerOnVisibleChanged(OnVisibleChangedEvent, AsFirst);
|
---|
718 | end;
|
---|
719 |
|
---|
720 | procedure TControl.RemoveHandlerOnVisibleChanged(
|
---|
721 | const OnVisibleChangedEvent: TNotifyEvent);
|
---|
722 | begin
|
---|
723 | GetNativeControl.RemoveHandlerOnVisibleChanged(OnVisibleChangedEvent);
|
---|
724 | end;
|
---|
725 |
|
---|
726 | procedure TControl.ScreenChanged;
|
---|
727 | begin
|
---|
728 | UpdateBounds;
|
---|
729 | Font.ScreenChanged;
|
---|
730 | end;
|
---|
731 |
|
---|
732 | procedure TControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
|
---|
733 | begin
|
---|
734 | FLeft := ALeft;
|
---|
735 | FTop := ATop;
|
---|
736 | FWidth := AWidth;
|
---|
737 | FHeight := AHeight;
|
---|
738 | UpdateBounds;
|
---|
739 | end;
|
---|
740 |
|
---|
741 | procedure TControl.Show;
|
---|
742 | begin
|
---|
743 | Visible := True;
|
---|
744 | end;
|
---|
745 |
|
---|
746 | procedure TControl.Hide;
|
---|
747 | begin
|
---|
748 | Visible := False;
|
---|
749 | end;
|
---|
750 |
|
---|
751 | procedure TControl.Invalidate;
|
---|
752 | begin
|
---|
753 | GetNativeControl.Invalidate;
|
---|
754 | end;
|
---|
755 |
|
---|
756 | procedure TControl.Repaint;
|
---|
757 | begin
|
---|
758 | GetNativeControl.Repaint;
|
---|
759 | end;
|
---|
760 |
|
---|
761 | procedure TControl.Update;
|
---|
762 | begin
|
---|
763 | GetNativeControl.Update;
|
---|
764 | end;
|
---|
765 |
|
---|
766 | procedure TControl.Refresh;
|
---|
767 | begin
|
---|
768 | GetNativeControl.Refresh;
|
---|
769 | end;
|
---|
770 |
|
---|
771 | function TControl.IsParentOf(AControl: TControl): Boolean;
|
---|
772 | begin
|
---|
773 | Result := False;
|
---|
774 | while Assigned(AControl) do
|
---|
775 | begin
|
---|
776 | AControl := AControl.Parent;
|
---|
777 | if Self = AControl then
|
---|
778 | Exit(True);
|
---|
779 | end;
|
---|
780 | end;
|
---|
781 |
|
---|
782 | function TControl.Scale96ToScreen(const ASize: Integer): Integer;
|
---|
783 | begin
|
---|
784 | Result := MulDiv(ASize, ScreenInfo.Dpi, 96);
|
---|
785 | end;
|
---|
786 |
|
---|
787 | constructor TControl.Create(TheOwner: TComponent);
|
---|
788 | begin
|
---|
789 | inherited;
|
---|
790 | FFont := TFont.Create;
|
---|
791 | FFont.OnChange := FontChanged;
|
---|
792 | FConstraints := TSizeConstraints.Create;
|
---|
793 | if Assigned(TheOwner) and (TheOwner is TWinControl) then
|
---|
794 | Parent := TWinControl(TheOwner);
|
---|
795 | FBorderSpacing := TControlBorderSpacing.Create(Self);
|
---|
796 | GetNativeControl;
|
---|
797 | UpdateNativeControl;
|
---|
798 | ScreenChanged;
|
---|
799 | end;
|
---|
800 |
|
---|
801 | destructor TControl.Destroy;
|
---|
802 | begin
|
---|
803 | FreeAndNil(FBorderSpacing);
|
---|
804 | FreeAndNil(FConstraints);
|
---|
805 | FreeAndNil(FFont);
|
---|
806 | inherited;
|
---|
807 | end;
|
---|
808 |
|
---|
809 | procedure TControl.SetLeft(AValue: Integer);
|
---|
810 | begin
|
---|
811 | if FLeft = AValue then Exit;
|
---|
812 | FLeft := AValue;
|
---|
813 | UpdateBounds;
|
---|
814 | end;
|
---|
815 |
|
---|
816 | procedure TControl.SetCaption(AValue: string);
|
---|
817 | begin
|
---|
818 | GetNativeControl.Caption := AValue;
|
---|
819 | end;
|
---|
820 |
|
---|
821 | procedure TControl.SetParent(AValue: TWinControl);
|
---|
822 | begin
|
---|
823 | if FParent = AValue then Exit;
|
---|
824 | if Assigned(FParent) then begin
|
---|
825 | FParent.Controls.Remove(Self);
|
---|
826 | if Assigned(FParent) and (FParent is TWinControl) then
|
---|
827 | GetNativeControl.Parent := nil;
|
---|
828 | end;
|
---|
829 | FParent := AValue;
|
---|
830 | if Assigned(FParent) then begin
|
---|
831 | FParent.Controls.Add(Self);
|
---|
832 | if Assigned(FParent) and (FParent is TWinControl) then
|
---|
833 | GetNativeControl.Parent := TWinControl(FParent).GetNativeWinControl;
|
---|
834 | end;
|
---|
835 | end;
|
---|
836 |
|
---|
837 | procedure TControl.SetFont(AValue: TFont);
|
---|
838 | begin
|
---|
839 | if FFont = AValue then Exit;
|
---|
840 | FFont := AValue;
|
---|
841 | end;
|
---|
842 |
|
---|
843 | procedure TControl.SetHint(AValue: string);
|
---|
844 | begin
|
---|
845 | GetNativeControl.Hint := AValue;
|
---|
846 | end;
|
---|
847 |
|
---|
848 | function TControl.GetBoundsRect: TRect;
|
---|
849 | begin
|
---|
850 | Result.Left := Left;
|
---|
851 | Result.Top := Top;
|
---|
852 | Result.Right := Left + Width;
|
---|
853 | Result.Bottom := Top + Height;
|
---|
854 | end;
|
---|
855 |
|
---|
856 | function TControl.GetAlign: TAlign;
|
---|
857 | begin
|
---|
858 | Result := GetNativeControl.Align;
|
---|
859 | end;
|
---|
860 |
|
---|
861 | function TControl.GetAnchors: TAnchors;
|
---|
862 | begin
|
---|
863 | Result := GetNativeControl.Anchors;
|
---|
864 | end;
|
---|
865 |
|
---|
866 | function TControl.GetAutoSize: Boolean;
|
---|
867 | begin
|
---|
868 | Result := GetNativeControl.AutoSize;
|
---|
869 | end;
|
---|
870 |
|
---|
871 | function TControl.GetClientHeight: Integer;
|
---|
872 | begin
|
---|
873 | Result := ScaleFromNative(GetNativeControl.ClientHeight);
|
---|
874 | end;
|
---|
875 |
|
---|
876 | function TControl.GetClientWidth: Integer;
|
---|
877 | begin
|
---|
878 | Result := ScaleFromNative(GetNativeControl.ClientWidth);
|
---|
879 | end;
|
---|
880 |
|
---|
881 | function TControl.GetColor: TColor;
|
---|
882 | begin
|
---|
883 | Result := GetNativeControl.Color;
|
---|
884 | end;
|
---|
885 |
|
---|
886 | function TControl.GetCursor: TCursor;
|
---|
887 | begin
|
---|
888 | Result := GetNativeControl.Cursor;
|
---|
889 | end;
|
---|
890 |
|
---|
891 | function TControl.GetEnabled: Boolean;
|
---|
892 | begin
|
---|
893 | Result := GetNativeControl.Enabled;
|
---|
894 | end;
|
---|
895 |
|
---|
896 | function TControl.GetHint: string;
|
---|
897 | begin
|
---|
898 | Result := GetNativeControl.Hint;
|
---|
899 | end;
|
---|
900 |
|
---|
901 | function TControl.GetOnClick: TNotifyEvent;
|
---|
902 | begin
|
---|
903 | Result := GetNativeControl.OnClick;
|
---|
904 | end;
|
---|
905 |
|
---|
906 | function TControl.GetOnDblClick: TNotifyEvent;
|
---|
907 | begin
|
---|
908 | {$objectChecks-}
|
---|
909 | Result := TControlEx(GetNativeControl).OnDblClick;
|
---|
910 | {$objectChecks+}
|
---|
911 | end;
|
---|
912 |
|
---|
913 | function TControl.GetParentColor: Boolean;
|
---|
914 | begin
|
---|
915 | {$objectChecks-}
|
---|
916 | Result := TControlEx(GetNativeControl).ParentColor;
|
---|
917 | {$objectChecks+}
|
---|
918 | end;
|
---|
919 |
|
---|
920 | function TControl.GetParentFont: Boolean;
|
---|
921 | begin
|
---|
922 | {$objectChecks-}
|
---|
923 | Result := TControlEx(GetNativeControl).ParentFont;
|
---|
924 | {$objectChecks+}
|
---|
925 | end;
|
---|
926 |
|
---|
927 | function TControl.GetShowHint: Boolean;
|
---|
928 | begin
|
---|
929 | Result := GetNativeControl.ShowHint;
|
---|
930 | end;
|
---|
931 |
|
---|
932 | function TControl.GetText: TCaption;
|
---|
933 | begin
|
---|
934 | Result := '';
|
---|
935 | end;
|
---|
936 |
|
---|
937 | function TControl.GetVisible: Boolean;
|
---|
938 | begin
|
---|
939 | Result := GetNativeControl.Visible;
|
---|
940 | end;
|
---|
941 |
|
---|
942 | function TControl.GetWindowProc: TWndMethod;
|
---|
943 | begin
|
---|
944 | Result := GetNativeControl.WindowProc;
|
---|
945 | end;
|
---|
946 |
|
---|
947 | function TControl.IsAnchorsStored: Boolean;
|
---|
948 | begin
|
---|
949 |
|
---|
950 | end;
|
---|
951 |
|
---|
952 | procedure TControl.SetAlign(AValue: TAlign);
|
---|
953 | begin
|
---|
954 | GetNativeControl.Align := AValue;
|
---|
955 | end;
|
---|
956 |
|
---|
957 | procedure TControl.SetAnchors(AValue: TAnchors);
|
---|
958 | begin
|
---|
959 | GetNativeControl.Anchors := AValue;
|
---|
960 | end;
|
---|
961 |
|
---|
962 | procedure TControl.SetAutoSize(AValue: Boolean);
|
---|
963 | begin
|
---|
964 | GetNativeControl.AutoSize := AValue;
|
---|
965 | end;
|
---|
966 |
|
---|
967 | procedure TControl.SetBorderSpacing(AValue: TControlBorderSpacing);
|
---|
968 | begin
|
---|
969 | if FBorderSpacing = AValue then Exit;
|
---|
970 | FBorderSpacing := AValue;
|
---|
971 | end;
|
---|
972 |
|
---|
973 | procedure TControl.SetBoundsRect(AValue: TRect);
|
---|
974 | begin
|
---|
975 | SetBounds(AValue.Left, AValue.Top, AValue.Right - AValue.Left, AValue.Bottom - AValue.Top);
|
---|
976 | end;
|
---|
977 |
|
---|
978 | procedure TControl.SetClientHeight(AValue: Integer);
|
---|
979 | begin
|
---|
980 | GetNativeControl.ClientHeight := ScaleToNative(AValue);
|
---|
981 | end;
|
---|
982 |
|
---|
983 | procedure TControl.SetClientWidth(AValue: Integer);
|
---|
984 | begin
|
---|
985 | GetNativeControl.ClientWidth := ScaleToNative(AValue);
|
---|
986 | end;
|
---|
987 |
|
---|
988 | procedure TControl.SetColor(AValue: TColor);
|
---|
989 | begin
|
---|
990 | GetNativeControl.Color := AValue;
|
---|
991 | end;
|
---|
992 |
|
---|
993 | procedure TControl.SetCursor(AValue: TCursor);
|
---|
994 | begin
|
---|
995 | GetNativeControl.Cursor := AValue;
|
---|
996 | end;
|
---|
997 |
|
---|
998 | procedure TControl.SetEnabled(AValue: Boolean);
|
---|
999 | begin
|
---|
1000 | GetNativeControl.Enabled := AValue;
|
---|
1001 | end;
|
---|
1002 |
|
---|
1003 | procedure TControl.SetOnClick(AValue: TNotifyEvent);
|
---|
1004 | begin
|
---|
1005 | GetNativeControl.OnClick := AValue;
|
---|
1006 | end;
|
---|
1007 |
|
---|
1008 | procedure TControl.SetOnDblClick(AValue: TNotifyEvent);
|
---|
1009 | begin
|
---|
1010 | {$objectChecks-}
|
---|
1011 | TControlEx(GetNativeControl).OnDblClick := AValue;
|
---|
1012 | {$objectChecks+}
|
---|
1013 | end;
|
---|
1014 |
|
---|
1015 | procedure TControl.SetParentColor(AValue: Boolean);
|
---|
1016 | begin
|
---|
1017 | {$objectChecks-}
|
---|
1018 | TControlEx(GetNativeControl).ParentColor := AValue;
|
---|
1019 | {$objectChecks+}
|
---|
1020 | end;
|
---|
1021 |
|
---|
1022 | procedure TControl.SetParentFont(AValue: Boolean);
|
---|
1023 | begin
|
---|
1024 | {$objectChecks-}
|
---|
1025 | TControlEx(GetNativeControl).ParentFont := AValue;
|
---|
1026 | {$objectChecks+}
|
---|
1027 | end;
|
---|
1028 |
|
---|
1029 | procedure TControl.SetShowHint(AValue: Boolean);
|
---|
1030 | begin
|
---|
1031 | GetNativeControl.ShowHint := AValue;
|
---|
1032 | end;
|
---|
1033 |
|
---|
1034 | procedure TControl.NativeFormResize(Sender: TObject);
|
---|
1035 | var
|
---|
1036 | R: TRect;
|
---|
1037 | begin
|
---|
1038 | R := ScaleRectFromNative(GetNativeControl.BoundsRect);
|
---|
1039 | FLeft := R.Left;
|
---|
1040 | FTop := R.Top;
|
---|
1041 | FWidth := R.Width;
|
---|
1042 | FHeight := R.Height;
|
---|
1043 | DoFormResize;
|
---|
1044 | end;
|
---|
1045 |
|
---|
1046 | procedure TControl.NativeChangeBounds(Sender: TObject);
|
---|
1047 | var
|
---|
1048 | NewBounds: TRect;
|
---|
1049 | begin
|
---|
1050 | NewBounds := ScaleRectFromNative(GetNativeControl.BoundsRect);
|
---|
1051 | if NewBounds <> BoundsRect then begin
|
---|
1052 | FLeft := NewBounds.Left;
|
---|
1053 | FTop := NewBounds.Top;
|
---|
1054 | FWidth := NewBounds.Width;
|
---|
1055 | FHeight := NewBounds.Height;
|
---|
1056 | DoChangeBounds;
|
---|
1057 | end;
|
---|
1058 | end;
|
---|
1059 |
|
---|
1060 | procedure TControl.DoFormResize;
|
---|
1061 | begin
|
---|
1062 | if Assigned(FOnResize) then begin
|
---|
1063 | FOnResize(Self);
|
---|
1064 | end;
|
---|
1065 | end;
|
---|
1066 |
|
---|
1067 | procedure TControl.DoChangeBounds;
|
---|
1068 | begin
|
---|
1069 | if Assigned(FOnChangeBounds) then FOnChangeBounds(Self);
|
---|
1070 | end;
|
---|
1071 |
|
---|
1072 | function TControl.GetCaption: string;
|
---|
1073 | begin
|
---|
1074 | Result := GetNativeControl.Caption;
|
---|
1075 | end;
|
---|
1076 |
|
---|
1077 | procedure TControl.FontChanged(Sender: TObject);
|
---|
1078 | begin
|
---|
1079 | GetNativeControl.Font.Size := ScaleToNative(Font.Size);
|
---|
1080 | end;
|
---|
1081 |
|
---|
1082 | procedure TControl.UpdateBounds;
|
---|
1083 | begin
|
---|
1084 | GetNativeControl.BoundsRect := ScaleRectToNative(BoundsRect);
|
---|
1085 | end;
|
---|
1086 |
|
---|
1087 | procedure TControl.SetHeight(AValue: Integer);
|
---|
1088 | begin
|
---|
1089 | if FHeight = AValue then Exit;
|
---|
1090 | FHeight := AValue;
|
---|
1091 | UpdateBounds;
|
---|
1092 | end;
|
---|
1093 |
|
---|
1094 | { TControlBorderSpacing }
|
---|
1095 |
|
---|
1096 | function TControlBorderSpacing.IsBottomStored: Boolean;
|
---|
1097 | begin
|
---|
1098 | if FDefault = nil
|
---|
1099 | then Result := FBottom <> 0
|
---|
1100 | else Result := FBottom <> FDefault^.Bottom;
|
---|
1101 | end;
|
---|
1102 |
|
---|
1103 | function TControlBorderSpacing.IsAroundStored: Boolean;
|
---|
1104 | begin
|
---|
1105 | if FDefault = nil
|
---|
1106 | then Result := FAround <> 0
|
---|
1107 | else Result := FAround <> FDefault^.Around;
|
---|
1108 | end;
|
---|
1109 |
|
---|
1110 | function TControlBorderSpacing.IsLeftStored: Boolean;
|
---|
1111 | begin
|
---|
1112 | if FDefault = nil
|
---|
1113 | then Result := FLeft <> 0
|
---|
1114 | else Result := FLeft <> FDefault^.Left;
|
---|
1115 | end;
|
---|
1116 |
|
---|
1117 | function TControlBorderSpacing.IsRightStored: Boolean;
|
---|
1118 | begin
|
---|
1119 | if FDefault = nil
|
---|
1120 | then Result := FRight <> 0
|
---|
1121 | else Result := FRight <> FDefault^.Right;
|
---|
1122 | end;
|
---|
1123 |
|
---|
1124 | function TControlBorderSpacing.IsTopStored: Boolean;
|
---|
1125 | begin
|
---|
1126 | if FDefault = nil
|
---|
1127 | then Result := FTop <> 0
|
---|
1128 | else Result := FTop <> FDefault^.Top;
|
---|
1129 | end;
|
---|
1130 |
|
---|
1131 | procedure TControlBorderSpacing.SetAround(AValue: TSpacingSize);
|
---|
1132 | begin
|
---|
1133 | if FAround = AValue then Exit;
|
---|
1134 | FAround := AValue;
|
---|
1135 | Change(False);
|
---|
1136 | end;
|
---|
1137 |
|
---|
1138 | procedure TControlBorderSpacing.SetBottom(AValue: TSpacingSize);
|
---|
1139 | begin
|
---|
1140 | if FBottom = AValue then Exit;
|
---|
1141 | FBottom := AValue;
|
---|
1142 | Change(False);
|
---|
1143 | end;
|
---|
1144 |
|
---|
1145 | procedure TControlBorderSpacing.SetLeft(AValue: TSpacingSize);
|
---|
1146 | begin
|
---|
1147 | if FLeft = AValue then Exit;
|
---|
1148 | FLeft := AValue;
|
---|
1149 | Change(False);
|
---|
1150 | end;
|
---|
1151 |
|
---|
1152 | procedure TControlBorderSpacing.SetRight(AValue: TSpacingSize);
|
---|
1153 | begin
|
---|
1154 | if FRight = AValue then Exit;
|
---|
1155 | FRight := AValue;
|
---|
1156 | Change(False);
|
---|
1157 | end;
|
---|
1158 |
|
---|
1159 | procedure TControlBorderSpacing.SetTop(AValue: TSpacingSize);
|
---|
1160 | begin
|
---|
1161 | if FTop = AValue then Exit;
|
---|
1162 | FTop := AValue;
|
---|
1163 | Change(False);
|
---|
1164 | end;
|
---|
1165 |
|
---|
1166 | procedure TControlBorderSpacing.Change(InnerSpaceChanged: Boolean);
|
---|
1167 | begin
|
---|
1168 | if FControl <> nil then
|
---|
1169 | FControl.DoBorderSpacingChange(Self, InnerSpaceChanged);
|
---|
1170 | if Assigned(OnChange) then OnChange(Self);
|
---|
1171 | end;
|
---|
1172 |
|
---|
1173 | constructor TControlBorderSpacing.Create(OwnerControl: TControl;
|
---|
1174 | ADefault: PControlBorderSpacingDefault);
|
---|
1175 | begin
|
---|
1176 | FControl := OwnerControl;
|
---|
1177 | FDefault := ADefault;
|
---|
1178 | if ADefault <> nil then
|
---|
1179 | begin
|
---|
1180 | FLeft := ADefault^.Left;
|
---|
1181 | FRight := ADefault^.Right;
|
---|
1182 | FTop := ADefault^.Top;
|
---|
1183 | FBottom := ADefault^.Bottom;
|
---|
1184 | FAround := ADefault^.Around;
|
---|
1185 | end;
|
---|
1186 | inherited Create;
|
---|
1187 | end;
|
---|
1188 |
|
---|
1189 | { TSizeConstraints }
|
---|
1190 |
|
---|
1191 | procedure TSizeConstraints.SetMaxHeight(AValue: TConstraintSize);
|
---|
1192 | begin
|
---|
1193 | if FMaxHeight=AValue then Exit;
|
---|
1194 | FMaxHeight:=AValue;
|
---|
1195 | end;
|
---|
1196 |
|
---|
1197 | procedure TSizeConstraints.SetMaxWidth(AValue: TConstraintSize);
|
---|
1198 | begin
|
---|
1199 | if FMaxWidth=AValue then Exit;
|
---|
1200 | FMaxWidth:=AValue;
|
---|
1201 | end;
|
---|
1202 |
|
---|
1203 | procedure TSizeConstraints.SetMinHeight(AValue: TConstraintSize);
|
---|
1204 | begin
|
---|
1205 | if FMinHeight=AValue then Exit;
|
---|
1206 | FMinHeight:=AValue;
|
---|
1207 | end;
|
---|
1208 |
|
---|
1209 | procedure TSizeConstraints.SetMinWidth(AValue: TConstraintSize);
|
---|
1210 | begin
|
---|
1211 | if FMinWidth=AValue then Exit;
|
---|
1212 | FMinWidth:=AValue;
|
---|
1213 | end;
|
---|
1214 |
|
---|
1215 | { TGraphicControl }
|
---|
1216 |
|
---|
1217 | procedure TGraphicControl.SetCanvas(AValue: TCanvas);
|
---|
1218 | begin
|
---|
1219 | if FCanvas = AValue then Exit;
|
---|
1220 | FCanvas := AValue;
|
---|
1221 | end;
|
---|
1222 |
|
---|
1223 | procedure TGraphicControl.PaintHandler(Sender: TObject);
|
---|
1224 | begin
|
---|
1225 | Paint;
|
---|
1226 | if Assigned(FOnPaint) then
|
---|
1227 | FOnPaint(Sender);
|
---|
1228 | end;
|
---|
1229 |
|
---|
1230 | procedure TGraphicControl.Paint;
|
---|
1231 | begin
|
---|
1232 | end;
|
---|
1233 |
|
---|
1234 | function TGraphicControl.GetNativeControl: Controls.TControl;
|
---|
1235 | begin
|
---|
1236 | Result := GetNativeGraphicControl;
|
---|
1237 | end;
|
---|
1238 |
|
---|
1239 | function TGraphicControl.GetNativeGraphicControl: Controls.TGraphicControl;
|
---|
1240 | begin
|
---|
1241 | Result := NativeGraphicControl;
|
---|
1242 | end;
|
---|
1243 |
|
---|
1244 | procedure TGraphicControl.UpdateNativeControl;
|
---|
1245 | begin
|
---|
1246 | inherited;
|
---|
1247 | {$objectChecks-}
|
---|
1248 | TGraphicControlEx(GetNativeGraphicControl).OnPaint := PaintHandler;
|
---|
1249 | {$objectChecks+}
|
---|
1250 | end;
|
---|
1251 |
|
---|
1252 | function TGraphicControl.GetOnPaint: TNotifyEvent;
|
---|
1253 | begin
|
---|
1254 | Result := FOnPaint;
|
---|
1255 | end;
|
---|
1256 |
|
---|
1257 | procedure TGraphicControl.SetOnPaint(AValue: TNotifyEvent);
|
---|
1258 | begin
|
---|
1259 | FOnPaint := AValue;
|
---|
1260 | end;
|
---|
1261 |
|
---|
1262 | constructor TGraphicControl.Create(TheOwner: TComponent);
|
---|
1263 | begin
|
---|
1264 | NativeGraphicControl := Controls.TGraphicControl.Create(nil);
|
---|
1265 | inherited;
|
---|
1266 | FCanvas := TCanvas.Create;
|
---|
1267 | FCanvas.NativeCanvas := GetNativeGraphicControl.Canvas;
|
---|
1268 | end;
|
---|
1269 |
|
---|
1270 | destructor TGraphicControl.Destroy;
|
---|
1271 | begin
|
---|
1272 | FreeAndNil(FCanvas);
|
---|
1273 | FreeAndNil(NativeGraphicControl);
|
---|
1274 | inherited;
|
---|
1275 | end;
|
---|
1276 |
|
---|
1277 | { TGraphicControlEx }
|
---|
1278 |
|
---|
1279 | procedure TGraphicControlEx.Paint;
|
---|
1280 | begin
|
---|
1281 | inherited Paint;
|
---|
1282 | end;
|
---|
1283 |
|
---|
1284 | { TMouse }
|
---|
1285 |
|
---|
1286 | function TMouse.GetCursorPos: TPoint;
|
---|
1287 | begin
|
---|
1288 | Result := ScalePointFromNative(Controls.Mouse.CursorPos);
|
---|
1289 | end;
|
---|
1290 |
|
---|
1291 | procedure TMouse.SetCursorPos(AValue: TPoint);
|
---|
1292 | begin
|
---|
1293 | Controls.Mouse.CursorPos := ScalePointToNative(AValue);
|
---|
1294 | end;
|
---|
1295 |
|
---|
1296 | constructor TMouse.Create;
|
---|
1297 | begin
|
---|
1298 | end;
|
---|
1299 |
|
---|
1300 | destructor TMouse.Destroy;
|
---|
1301 | begin
|
---|
1302 | inherited;
|
---|
1303 | end;
|
---|
1304 |
|
---|
1305 | { TImageList }
|
---|
1306 |
|
---|
1307 | function TImageList.GetHeight: Integer;
|
---|
1308 | begin
|
---|
1309 |
|
---|
1310 | end;
|
---|
1311 |
|
---|
1312 | function TImageList.GetCount: Integer;
|
---|
1313 | begin
|
---|
1314 |
|
---|
1315 | end;
|
---|
1316 |
|
---|
1317 | function TImageList.GetWidth: Integer;
|
---|
1318 | begin
|
---|
1319 |
|
---|
1320 | end;
|
---|
1321 |
|
---|
1322 | procedure TImageList.SetHeight(AValue: Integer);
|
---|
1323 | begin
|
---|
1324 |
|
---|
1325 | end;
|
---|
1326 |
|
---|
1327 | procedure TImageList.SetWidth(AValue: Integer);
|
---|
1328 | begin
|
---|
1329 |
|
---|
1330 | end;
|
---|
1331 |
|
---|
1332 | function TImageList.GetNativeImageList: Controls.TImageList;
|
---|
1333 | begin
|
---|
1334 | if not Assigned(NativeImageList) then
|
---|
1335 | NativeImageList := Controls.TImageList.Create(nil);
|
---|
1336 | Result := NativeImageList;
|
---|
1337 | end;
|
---|
1338 |
|
---|
1339 | procedure TImageList.GetBitmap(Index: Integer; Image: TBitmap);
|
---|
1340 | begin
|
---|
1341 |
|
---|
1342 | end;
|
---|
1343 |
|
---|
1344 | procedure TImageList.BeginUpdate;
|
---|
1345 | begin
|
---|
1346 |
|
---|
1347 | end;
|
---|
1348 |
|
---|
1349 | procedure TImageList.EndUpdate;
|
---|
1350 | begin
|
---|
1351 |
|
---|
1352 | end;
|
---|
1353 |
|
---|
1354 | procedure TImageList.Clear;
|
---|
1355 | begin
|
---|
1356 |
|
---|
1357 | end;
|
---|
1358 |
|
---|
1359 | function TImageList.Add(Image, Mask: TBitmap): Integer;
|
---|
1360 | begin
|
---|
1361 |
|
---|
1362 | end;
|
---|
1363 |
|
---|
1364 | constructor TImageList.Create(TheOwner: TComponent);
|
---|
1365 | begin
|
---|
1366 | inherited Create(TheOwner);
|
---|
1367 | end;
|
---|
1368 |
|
---|
1369 | destructor TImageList.Destroy;
|
---|
1370 | begin
|
---|
1371 | FreeAndNil(NativeImageList);
|
---|
1372 | inherited;
|
---|
1373 | end;
|
---|
1374 |
|
---|
1375 | initialization
|
---|
1376 |
|
---|
1377 | Mouse := TMouse.Create;
|
---|
1378 |
|
---|
1379 | finalization;
|
---|
1380 |
|
---|
1381 | FreeAndNil(Mouse);
|
---|
1382 |
|
---|
1383 | end.
|
---|
1384 |
|
---|