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 |
|
---|
378 | var
|
---|
379 | Mouse: TMouse;
|
---|
380 |
|
---|
381 |
|
---|
382 | implementation
|
---|
383 |
|
---|
384 | uses
|
---|
385 | Dpi.Common;
|
---|
386 |
|
---|
387 | { TCustomControl }
|
---|
388 |
|
---|
389 | function TCustomControl.GetOnPaint: TNotifyEvent;
|
---|
390 | begin
|
---|
391 | Result := GetNativeCustomControl.OnPaint;
|
---|
392 | end;
|
---|
393 |
|
---|
394 | function TCustomControl.GetPixelsPerInch: Integer;
|
---|
395 | begin
|
---|
396 | //Result := GetNativeCustomControl.Pix;
|
---|
397 | end;
|
---|
398 |
|
---|
399 | function TCustomControl.GetCanvas: TCanvas;
|
---|
400 | begin
|
---|
401 | Result := FCanvas;
|
---|
402 | end;
|
---|
403 |
|
---|
404 | procedure TCustomControl.SetOnPaint(AValue: TNotifyEvent);
|
---|
405 | begin
|
---|
406 | GetNativeCustomControl.OnPaint := AValue;
|
---|
407 | end;
|
---|
408 |
|
---|
409 | procedure TCustomControl.SetPixelsPerInch(AValue: Integer);
|
---|
410 | begin
|
---|
411 | end;
|
---|
412 |
|
---|
413 | function TCustomControl.GetNativeWinControl: Controls.TWinControl;
|
---|
414 | begin
|
---|
415 | Result := GetNativeCustomControl;
|
---|
416 | end;
|
---|
417 |
|
---|
418 | function TCustomControl.GetNativeCustomControl: Controls.TCustomControl;
|
---|
419 | begin
|
---|
420 | Result := nil;
|
---|
421 | end;
|
---|
422 |
|
---|
423 | constructor TCustomControl.Create(TheOwner: TComponent);
|
---|
424 | begin
|
---|
425 | inherited;
|
---|
426 | FCanvas := TCanvas.Create;
|
---|
427 | FCanvas.NativeCanvas := GetNativeCustomControl.Canvas;
|
---|
428 | end;
|
---|
429 |
|
---|
430 | destructor TCustomControl.Destroy;
|
---|
431 | begin
|
---|
432 | FreeAndNil(FCanvas);
|
---|
433 | inherited;
|
---|
434 | end;
|
---|
435 |
|
---|
436 | { TWinControl }
|
---|
437 |
|
---|
438 | function TWinControl.GetBorderStyle: TBorderStyle;
|
---|
439 | begin
|
---|
440 | {$objectChecks-}
|
---|
441 | Result := TWinControlEx(GetNativeWinControl).BorderStyle;
|
---|
442 | {$objectChecks+}
|
---|
443 | end;
|
---|
444 |
|
---|
445 | function TWinControl.GetHandle: HWND;
|
---|
446 | begin
|
---|
447 | Result := GetNativeWinControl.Handle;
|
---|
448 | end;
|
---|
449 |
|
---|
450 | function TWinControl.GetOnKeyDown: TKeyEvent;
|
---|
451 | begin
|
---|
452 | Result := GetNativeWinControl.OnKeyDown;
|
---|
453 | end;
|
---|
454 |
|
---|
455 | function TWinControl.GetOnKeyPress: TKeyPressEvent;
|
---|
456 | begin
|
---|
457 | Result := GetNativeWinControl.OnKeyPress;
|
---|
458 | end;
|
---|
459 |
|
---|
460 | function TWinControl.GetOnKeyUp: TKeyEvent;
|
---|
461 | begin
|
---|
462 | Result := GetNativeWinControl.OnKeyUp;
|
---|
463 | end;
|
---|
464 |
|
---|
465 | function TWinControl.GetTabOrder: TTabOrder;
|
---|
466 | begin
|
---|
467 | Result := GetNativeWinControl.TabOrder;
|
---|
468 | end;
|
---|
469 |
|
---|
470 | function TWinControl.GetTabStop: Boolean;
|
---|
471 | begin
|
---|
472 | Result := GetNativeWinControl.TabStop;
|
---|
473 | end;
|
---|
474 |
|
---|
475 | procedure TWinControl.SetBorderStyle(AValue: TBorderStyle);
|
---|
476 | begin
|
---|
477 | {$objectChecks-}
|
---|
478 | TWinControlEx(GetNativeWinControl).BorderStyle := AValue;
|
---|
479 | {$objectChecks+}
|
---|
480 | end;
|
---|
481 |
|
---|
482 | procedure TWinControl.SetHandle(AValue: HWND);
|
---|
483 | begin
|
---|
484 | GetNativeWinControl.Handle := AValue;
|
---|
485 | end;
|
---|
486 |
|
---|
487 | procedure TWinControl.SetOnKeyDown(AValue: TKeyEvent);
|
---|
488 | begin
|
---|
489 | GetNativeWinControl.OnKeyDown := AValue;
|
---|
490 | end;
|
---|
491 |
|
---|
492 | procedure TWinControl.SetOnKeyPress(AValue: TKeyPressEvent);
|
---|
493 | begin
|
---|
494 | GetNativeWinControl.OnKeyPress := AValue;
|
---|
495 | end;
|
---|
496 |
|
---|
497 | procedure TWinControl.SetOnKeyUp(AValue: TKeyEvent);
|
---|
498 | begin
|
---|
499 | GetNativeWinControl.OnKeyUp := AValue;
|
---|
500 | end;
|
---|
501 |
|
---|
502 | procedure TWinControl.SetTabOrder(AValue: TTabOrder);
|
---|
503 | begin
|
---|
504 | GetNativeWinControl.TabOrder := AValue;
|
---|
505 | end;
|
---|
506 |
|
---|
507 | procedure TWinControl.SetTabStop(AValue: Boolean);
|
---|
508 | begin
|
---|
509 | GetNativeWinControl.TabStop := AValue;
|
---|
510 | end;
|
---|
511 |
|
---|
512 | procedure TWinControl.KeyDownHandler(Sender: TObject; var Key: Word;
|
---|
513 | Shift: TShiftState);
|
---|
514 | begin
|
---|
515 | KeyDown(Key, Shift);
|
---|
516 | if Assigned(FOnKeyDown) then FOnKeyDown(Self, Key, Shift);
|
---|
517 | end;
|
---|
518 |
|
---|
519 | procedure TWinControl.UpdateNativeControl;
|
---|
520 | begin
|
---|
521 | inherited;
|
---|
522 | GetNativeWinControl.OnKeyDown := KeyDownHandler;
|
---|
523 | end;
|
---|
524 |
|
---|
525 | function TWinControl.GetNativeControl: Controls.TControl;
|
---|
526 | begin
|
---|
527 | Result := GetNativeWinControl;
|
---|
528 | end;
|
---|
529 |
|
---|
530 | function TWinControl.GetNativeWinControl: Controls.TWinControl;
|
---|
531 | begin
|
---|
532 | Result := nil;
|
---|
533 | end;
|
---|
534 |
|
---|
535 | procedure TWinControl.KeyDown(var Key: Word; Shift: TShiftState);
|
---|
536 | begin
|
---|
537 | end;
|
---|
538 |
|
---|
539 | function TWinControl.HandleAllocated: Boolean;
|
---|
540 | begin
|
---|
541 | Result := GetNativeWinControl.HandleAllocated;
|
---|
542 | end;
|
---|
543 |
|
---|
544 | procedure TWinControl.ScreenChanged;
|
---|
545 | var
|
---|
546 | I: Integer;
|
---|
547 | begin
|
---|
548 | inherited;
|
---|
549 | for I := 0 to Controls.Count - 1 do
|
---|
550 | Controls[I].ScreenChanged;
|
---|
551 | end;
|
---|
552 |
|
---|
553 | function TWinControl.ControlCount: Integer;
|
---|
554 | begin
|
---|
555 | Result := Controls.Count;
|
---|
556 | end;
|
---|
557 |
|
---|
558 | procedure TWinControl.SetFocus;
|
---|
559 | begin
|
---|
560 | GetNativeWinControl.SetFocus;
|
---|
561 | end;
|
---|
562 |
|
---|
563 | constructor TWinControl.Create(TheOwner: TComponent);
|
---|
564 | begin
|
---|
565 | Controls := TDpiControls.Create;
|
---|
566 | Controls.OwnsObjects := False;
|
---|
567 | inherited;
|
---|
568 | end;
|
---|
569 |
|
---|
570 | destructor TWinControl.Destroy;
|
---|
571 | begin
|
---|
572 | FreeAndNil(Controls);
|
---|
573 | inherited;
|
---|
574 | end;
|
---|
575 |
|
---|
576 | { TControl }
|
---|
577 |
|
---|
578 | procedure TControl.SetTop(AValue: Integer);
|
---|
579 | begin
|
---|
580 | if FTop = AValue then Exit;
|
---|
581 | FTop := AValue;
|
---|
582 | UpdateBounds;
|
---|
583 | end;
|
---|
584 |
|
---|
585 | procedure TControl.SetVisible(AValue: Boolean);
|
---|
586 | begin
|
---|
587 | GetNativeControl.Visible := AValue;
|
---|
588 | end;
|
---|
589 |
|
---|
590 | procedure TControl.SetWidth(AValue: Integer);
|
---|
591 | begin
|
---|
592 | if FWidth = AValue then Exit;
|
---|
593 | FWidth := AValue;
|
---|
594 | UpdateBounds;
|
---|
595 | end;
|
---|
596 |
|
---|
597 | function TControl.GetNativeControl: Controls.TControl;
|
---|
598 | begin
|
---|
599 | Result := nil;
|
---|
600 | end;
|
---|
601 |
|
---|
602 | procedure TControl.UpdateNativeControl;
|
---|
603 | begin
|
---|
604 | Font.NativeFont := GetNativeControl.Font;
|
---|
605 | GetNativeControl.OnResize := NativeFormResize;
|
---|
606 | GetNativeControl.OnChangeBounds := NativeChangeBounds;
|
---|
607 |
|
---|
608 | {$objectChecks-}
|
---|
609 | TControlEx(GetNativeControl).OnMouseDown := MouseDownHandler;
|
---|
610 | TControlEx(GetNativeControl).OnMouseUp := MouseUpHandler;
|
---|
611 | TControlEx(GetNativeControl).OnMouseMove := MouseMoveHandler;
|
---|
612 | TControlEx(GetNativeControl).OnMouseEnter := MouseEnterHandler;
|
---|
613 | TControlEx(GetNativeControl).OnMouseLeave := MouseLeaveHandler;
|
---|
614 | TControlEx(GetNativeControl).OnMouseWheel := MouseWheelHandler;
|
---|
615 | {$objectChecks+}
|
---|
616 | end;
|
---|
617 |
|
---|
618 | procedure TControl.MouseDownHandler(Sender: TObject; Button: TMouseButton;
|
---|
619 | Shift: TShiftState; X, Y: Integer);
|
---|
620 | begin
|
---|
621 | MouseDown(Button, Shift, ScaleFromNative(X), ScaleFromNative(Y));
|
---|
622 | if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, ScaleFromNative(X), ScaleFromNative(Y));
|
---|
623 | end;
|
---|
624 |
|
---|
625 | procedure TControl.MouseUpHandler(Sender: TObject; Button: TMouseButton;
|
---|
626 | Shift: TShiftState; X, Y: Integer);
|
---|
627 | begin
|
---|
628 | MouseUp(Button, Shift, ScaleFromNative(X), ScaleFromNative(Y));
|
---|
629 | if Assigned(FOnMouseUp) then FOnMouseUp(Self, Button, Shift, ScaleFromNative(X), ScaleFromNative(Y));
|
---|
630 | end;
|
---|
631 |
|
---|
632 | procedure TControl.MouseMoveHandler(Sender: TObject; Shift: TShiftState; X,
|
---|
633 | Y: Integer);
|
---|
634 | begin
|
---|
635 | MouseMove(Shift, ScaleFromNative(X), ScaleFromNative(Y));
|
---|
636 | if Assigned(FOnMouseMove) then FOnMouseMove(Self, Shift, ScaleFromNative(X), ScaleFromNative(Y));
|
---|
637 | end;
|
---|
638 |
|
---|
639 | procedure TControl.MouseWheelHandler(Sender: TObject; Shift: TShiftState;
|
---|
640 | WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
|
---|
641 | begin
|
---|
642 | if Assigned(FOnMouseWheel) then FOnMouseWheel(Self, Shift, WheelDelta,
|
---|
643 | ScalePointFromNative(MousePos), Handled);
|
---|
644 | end;
|
---|
645 |
|
---|
646 | procedure TControl.MouseLeaveHandler(Sender: TObject);
|
---|
647 | begin
|
---|
648 | MouseLeave;
|
---|
649 | if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
|
---|
650 | end;
|
---|
651 |
|
---|
652 | procedure TControl.MouseEnterHandler(Sender: TObject);
|
---|
653 | begin
|
---|
654 | MouseEnter;
|
---|
655 | if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
|
---|
656 | end;
|
---|
657 |
|
---|
658 | procedure TControl.SetWindowProc(AValue: TWndMethod);
|
---|
659 | begin
|
---|
660 | GetNativeControl.WindowProc := AValue;
|
---|
661 | end;
|
---|
662 |
|
---|
663 | function TControl.ColorIsStored: Boolean;
|
---|
664 | begin
|
---|
665 | Result := not ParentColor;
|
---|
666 | end;
|
---|
667 |
|
---|
668 | procedure TControl.DoBorderSpacingChange(Sender: TObject;
|
---|
669 | InnerSpaceChanged: Boolean);
|
---|
670 | begin
|
---|
671 | GetNativeControl.BorderSpacing.Left := ScaleToNative(FBorderSpacing.Left);
|
---|
672 | GetNativeControl.BorderSpacing.Right := ScaleToNative(FBorderSpacing.Right);
|
---|
673 | GetNativeControl.BorderSpacing.Top := ScaleToNative(FBorderSpacing.Top);
|
---|
674 | GetNativeControl.BorderSpacing.Bottom := ScaleToNative(FBorderSpacing.Bottom);
|
---|
675 | GetNativeControl.BorderSpacing.Around := ScaleToNative(FBorderSpacing.Around);
|
---|
676 | end;
|
---|
677 |
|
---|
678 | procedure TControl.SetText(AValue: TCaption);
|
---|
679 | begin
|
---|
680 |
|
---|
681 | end;
|
---|
682 |
|
---|
683 | procedure TControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
|
---|
684 | Y: Integer);
|
---|
685 | begin
|
---|
686 | end;
|
---|
687 |
|
---|
688 | procedure TControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
|
---|
689 | Y: Integer);
|
---|
690 | begin
|
---|
691 | end;
|
---|
692 |
|
---|
693 | procedure TControl.MouseMove(Shift: TShiftState; X, Y: Integer);
|
---|
694 | begin
|
---|
695 | end;
|
---|
696 |
|
---|
697 | procedure TControl.MouseLeave;
|
---|
698 | begin
|
---|
699 | end;
|
---|
700 |
|
---|
701 | procedure TControl.MouseEnter;
|
---|
702 | begin
|
---|
703 | end;
|
---|
704 |
|
---|
705 | function TControl.ScreenToClient(const APoint: TPoint): TPoint;
|
---|
706 | begin
|
---|
707 | Result := ScalePointFromNative(GetNativeControl.ScreenToClient(ScalePointToNative(APoint)));
|
---|
708 | end;
|
---|
709 |
|
---|
710 | function TControl.ClientToScreen(const APoint: TPoint): TPoint;
|
---|
711 | begin
|
---|
712 | Result := ScalePointFromNative(GetNativeControl.ClientToScreen(ScalePointToNative(APoint)));
|
---|
713 | end;
|
---|
714 |
|
---|
715 | procedure TControl.AddHandlerOnVisibleChanged(
|
---|
716 | const OnVisibleChangedEvent: TNotifyEvent; AsFirst: boolean);
|
---|
717 | begin
|
---|
718 | GetNativeControl.AddHandlerOnVisibleChanged(OnVisibleChangedEvent, AsFirst);
|
---|
719 | end;
|
---|
720 |
|
---|
721 | procedure TControl.RemoveHandlerOnVisibleChanged(
|
---|
722 | const OnVisibleChangedEvent: TNotifyEvent);
|
---|
723 | begin
|
---|
724 | GetNativeControl.RemoveHandlerOnVisibleChanged(OnVisibleChangedEvent);
|
---|
725 | end;
|
---|
726 |
|
---|
727 | procedure TControl.ScreenChanged;
|
---|
728 | begin
|
---|
729 | UpdateBounds;
|
---|
730 | Font.ScreenChanged;
|
---|
731 | end;
|
---|
732 |
|
---|
733 | procedure TControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
|
---|
734 | begin
|
---|
735 | FLeft := ALeft;
|
---|
736 | FTop := ATop;
|
---|
737 | FWidth := AWidth;
|
---|
738 | FHeight := AHeight;
|
---|
739 | UpdateBounds;
|
---|
740 | end;
|
---|
741 |
|
---|
742 | procedure TControl.Show;
|
---|
743 | begin
|
---|
744 | Visible := True;
|
---|
745 | end;
|
---|
746 |
|
---|
747 | procedure TControl.Hide;
|
---|
748 | begin
|
---|
749 | Visible := False;
|
---|
750 | end;
|
---|
751 |
|
---|
752 | procedure TControl.Invalidate;
|
---|
753 | begin
|
---|
754 | GetNativeControl.Invalidate;
|
---|
755 | end;
|
---|
756 |
|
---|
757 | procedure TControl.Repaint;
|
---|
758 | begin
|
---|
759 | GetNativeControl.Repaint;
|
---|
760 | end;
|
---|
761 |
|
---|
762 | procedure TControl.Update;
|
---|
763 | begin
|
---|
764 | GetNativeControl.Update;
|
---|
765 | end;
|
---|
766 |
|
---|
767 | procedure TControl.Refresh;
|
---|
768 | begin
|
---|
769 | GetNativeControl.Refresh;
|
---|
770 | end;
|
---|
771 |
|
---|
772 | function TControl.IsParentOf(AControl: TControl): Boolean;
|
---|
773 | begin
|
---|
774 | Result := False;
|
---|
775 | while Assigned(AControl) do
|
---|
776 | begin
|
---|
777 | AControl := AControl.Parent;
|
---|
778 | if Self = AControl then
|
---|
779 | Exit(True);
|
---|
780 | end;
|
---|
781 | end;
|
---|
782 |
|
---|
783 | function TControl.Scale96ToScreen(const ASize: Integer): Integer;
|
---|
784 | begin
|
---|
785 | Result := MulDiv(ASize, ScreenInfo.Dpi, 96);
|
---|
786 | end;
|
---|
787 |
|
---|
788 | constructor TControl.Create(TheOwner: TComponent);
|
---|
789 | begin
|
---|
790 | inherited;
|
---|
791 | FFont := TFont.Create;
|
---|
792 | FFont.OnChange := FontChanged;
|
---|
793 | FConstraints := TSizeConstraints.Create;
|
---|
794 | if Assigned(TheOwner) and (TheOwner is TWinControl) then
|
---|
795 | Parent := TWinControl(TheOwner);
|
---|
796 | FBorderSpacing := TControlBorderSpacing.Create(Self);
|
---|
797 | GetNativeControl;
|
---|
798 | UpdateNativeControl;
|
---|
799 | ScreenChanged;
|
---|
800 | end;
|
---|
801 |
|
---|
802 | destructor TControl.Destroy;
|
---|
803 | begin
|
---|
804 | FreeAndNil(FBorderSpacing);
|
---|
805 | FreeAndNil(FConstraints);
|
---|
806 | FreeAndNil(FFont);
|
---|
807 | inherited;
|
---|
808 | end;
|
---|
809 |
|
---|
810 | procedure TControl.SetLeft(AValue: Integer);
|
---|
811 | begin
|
---|
812 | if FLeft = AValue then Exit;
|
---|
813 | FLeft := AValue;
|
---|
814 | UpdateBounds;
|
---|
815 | end;
|
---|
816 |
|
---|
817 | procedure TControl.SetCaption(AValue: string);
|
---|
818 | begin
|
---|
819 | GetNativeControl.Caption := AValue;
|
---|
820 | end;
|
---|
821 |
|
---|
822 | procedure TControl.SetParent(AValue: TWinControl);
|
---|
823 | begin
|
---|
824 | if FParent = AValue then Exit;
|
---|
825 | if Assigned(FParent) then begin
|
---|
826 | FParent.Controls.Remove(Self);
|
---|
827 | if Assigned(FParent) and (FParent is TWinControl) then
|
---|
828 | GetNativeControl.Parent := nil;
|
---|
829 | end;
|
---|
830 | FParent := AValue;
|
---|
831 | if Assigned(FParent) then begin
|
---|
832 | FParent.Controls.Add(Self);
|
---|
833 | if Assigned(FParent) and (FParent is TWinControl) then
|
---|
834 | GetNativeControl.Parent := TWinControl(FParent).GetNativeWinControl;
|
---|
835 | end;
|
---|
836 | end;
|
---|
837 |
|
---|
838 | procedure TControl.SetFont(AValue: TFont);
|
---|
839 | begin
|
---|
840 | if FFont = AValue then Exit;
|
---|
841 | FFont := AValue;
|
---|
842 | end;
|
---|
843 |
|
---|
844 | procedure TControl.SetHint(AValue: string);
|
---|
845 | begin
|
---|
846 | GetNativeControl.Hint := AValue;
|
---|
847 | end;
|
---|
848 |
|
---|
849 | function TControl.GetBoundsRect: TRect;
|
---|
850 | begin
|
---|
851 | Result.Left := Left;
|
---|
852 | Result.Top := Top;
|
---|
853 | Result.Right := Left + Width;
|
---|
854 | Result.Bottom := Top + Height;
|
---|
855 | end;
|
---|
856 |
|
---|
857 | function TControl.GetAlign: TAlign;
|
---|
858 | begin
|
---|
859 | Result := GetNativeControl.Align;
|
---|
860 | end;
|
---|
861 |
|
---|
862 | function TControl.GetAnchors: TAnchors;
|
---|
863 | begin
|
---|
864 | Result := GetNativeControl.Anchors;
|
---|
865 | end;
|
---|
866 |
|
---|
867 | function TControl.GetAutoSize: Boolean;
|
---|
868 | begin
|
---|
869 | Result := GetNativeControl.AutoSize;
|
---|
870 | end;
|
---|
871 |
|
---|
872 | function TControl.GetClientHeight: Integer;
|
---|
873 | begin
|
---|
874 | Result := ScaleFromNative(GetNativeControl.ClientHeight);
|
---|
875 | end;
|
---|
876 |
|
---|
877 | function TControl.GetClientWidth: Integer;
|
---|
878 | begin
|
---|
879 | Result := ScaleFromNative(GetNativeControl.ClientWidth);
|
---|
880 | end;
|
---|
881 |
|
---|
882 | function TControl.GetColor: TColor;
|
---|
883 | begin
|
---|
884 | Result := GetNativeControl.Color;
|
---|
885 | end;
|
---|
886 |
|
---|
887 | function TControl.GetCursor: TCursor;
|
---|
888 | begin
|
---|
889 | Result := GetNativeControl.Cursor;
|
---|
890 | end;
|
---|
891 |
|
---|
892 | function TControl.GetEnabled: Boolean;
|
---|
893 | begin
|
---|
894 | Result := GetNativeControl.Enabled;
|
---|
895 | end;
|
---|
896 |
|
---|
897 | function TControl.GetHint: string;
|
---|
898 | begin
|
---|
899 | Result := GetNativeControl.Hint;
|
---|
900 | end;
|
---|
901 |
|
---|
902 | function TControl.GetOnClick: TNotifyEvent;
|
---|
903 | begin
|
---|
904 | Result := GetNativeControl.OnClick;
|
---|
905 | end;
|
---|
906 |
|
---|
907 | function TControl.GetOnDblClick: TNotifyEvent;
|
---|
908 | begin
|
---|
909 | {$objectChecks-}
|
---|
910 | Result := TControlEx(GetNativeControl).OnDblClick;
|
---|
911 | {$objectChecks+}
|
---|
912 | end;
|
---|
913 |
|
---|
914 | function TControl.GetParentColor: Boolean;
|
---|
915 | begin
|
---|
916 | {$objectChecks-}
|
---|
917 | Result := TControlEx(GetNativeControl).ParentColor;
|
---|
918 | {$objectChecks+}
|
---|
919 | end;
|
---|
920 |
|
---|
921 | function TControl.GetParentFont: Boolean;
|
---|
922 | begin
|
---|
923 | {$objectChecks-}
|
---|
924 | Result := TControlEx(GetNativeControl).ParentFont;
|
---|
925 | {$objectChecks+}
|
---|
926 | end;
|
---|
927 |
|
---|
928 | function TControl.GetShowHint: Boolean;
|
---|
929 | begin
|
---|
930 | Result := GetNativeControl.ShowHint;
|
---|
931 | end;
|
---|
932 |
|
---|
933 | function TControl.GetText: TCaption;
|
---|
934 | begin
|
---|
935 | Result := '';
|
---|
936 | end;
|
---|
937 |
|
---|
938 | function TControl.GetVisible: Boolean;
|
---|
939 | begin
|
---|
940 | Result := GetNativeControl.Visible;
|
---|
941 | end;
|
---|
942 |
|
---|
943 | function TControl.GetWindowProc: TWndMethod;
|
---|
944 | begin
|
---|
945 | Result := GetNativeControl.WindowProc;
|
---|
946 | end;
|
---|
947 |
|
---|
948 | function TControl.IsAnchorsStored: Boolean;
|
---|
949 | begin
|
---|
950 |
|
---|
951 | end;
|
---|
952 |
|
---|
953 | procedure TControl.SetAlign(AValue: TAlign);
|
---|
954 | begin
|
---|
955 | GetNativeControl.Align := AValue;
|
---|
956 | end;
|
---|
957 |
|
---|
958 | procedure TControl.SetAnchors(AValue: TAnchors);
|
---|
959 | begin
|
---|
960 | GetNativeControl.Anchors := AValue;
|
---|
961 | end;
|
---|
962 |
|
---|
963 | procedure TControl.SetAutoSize(AValue: Boolean);
|
---|
964 | begin
|
---|
965 | GetNativeControl.AutoSize := AValue;
|
---|
966 | end;
|
---|
967 |
|
---|
968 | procedure TControl.SetBorderSpacing(AValue: TControlBorderSpacing);
|
---|
969 | begin
|
---|
970 | if FBorderSpacing = AValue then Exit;
|
---|
971 | FBorderSpacing := AValue;
|
---|
972 | end;
|
---|
973 |
|
---|
974 | procedure TControl.SetBoundsRect(AValue: TRect);
|
---|
975 | begin
|
---|
976 | SetBounds(AValue.Left, AValue.Top, AValue.Right - AValue.Left, AValue.Bottom - AValue.Top);
|
---|
977 | end;
|
---|
978 |
|
---|
979 | procedure TControl.SetClientHeight(AValue: Integer);
|
---|
980 | begin
|
---|
981 | GetNativeControl.ClientHeight := ScaleToNative(AValue);
|
---|
982 | end;
|
---|
983 |
|
---|
984 | procedure TControl.SetClientWidth(AValue: Integer);
|
---|
985 | begin
|
---|
986 | GetNativeControl.ClientWidth := ScaleToNative(AValue);
|
---|
987 | end;
|
---|
988 |
|
---|
989 | procedure TControl.SetColor(AValue: TColor);
|
---|
990 | begin
|
---|
991 | GetNativeControl.Color := AValue;
|
---|
992 | end;
|
---|
993 |
|
---|
994 | procedure TControl.SetCursor(AValue: TCursor);
|
---|
995 | begin
|
---|
996 | GetNativeControl.Cursor := AValue;
|
---|
997 | end;
|
---|
998 |
|
---|
999 | procedure TControl.SetEnabled(AValue: Boolean);
|
---|
1000 | begin
|
---|
1001 | GetNativeControl.Enabled := AValue;
|
---|
1002 | end;
|
---|
1003 |
|
---|
1004 | procedure TControl.SetOnClick(AValue: TNotifyEvent);
|
---|
1005 | begin
|
---|
1006 | GetNativeControl.OnClick := AValue;
|
---|
1007 | end;
|
---|
1008 |
|
---|
1009 | procedure TControl.SetOnDblClick(AValue: TNotifyEvent);
|
---|
1010 | begin
|
---|
1011 | {$objectChecks-}
|
---|
1012 | TControlEx(GetNativeControl).OnDblClick := AValue;
|
---|
1013 | {$objectChecks+}
|
---|
1014 | end;
|
---|
1015 |
|
---|
1016 | procedure TControl.SetParentColor(AValue: Boolean);
|
---|
1017 | begin
|
---|
1018 | {$objectChecks-}
|
---|
1019 | TControlEx(GetNativeControl).ParentColor := AValue;
|
---|
1020 | {$objectChecks+}
|
---|
1021 | end;
|
---|
1022 |
|
---|
1023 | procedure TControl.SetParentFont(AValue: Boolean);
|
---|
1024 | begin
|
---|
1025 | {$objectChecks-}
|
---|
1026 | TControlEx(GetNativeControl).ParentFont := AValue;
|
---|
1027 | {$objectChecks+}
|
---|
1028 | end;
|
---|
1029 |
|
---|
1030 | procedure TControl.SetShowHint(AValue: Boolean);
|
---|
1031 | begin
|
---|
1032 | GetNativeControl.ShowHint := AValue;
|
---|
1033 | end;
|
---|
1034 |
|
---|
1035 | procedure TControl.NativeFormResize(Sender: TObject);
|
---|
1036 | var
|
---|
1037 | R: TRect;
|
---|
1038 | begin
|
---|
1039 | R := ScaleRectFromNative(GetNativeControl.BoundsRect);
|
---|
1040 | FLeft := R.Left;
|
---|
1041 | FTop := R.Top;
|
---|
1042 | FWidth := R.Width;
|
---|
1043 | FHeight := R.Height;
|
---|
1044 | DoFormResize;
|
---|
1045 | end;
|
---|
1046 |
|
---|
1047 | procedure TControl.NativeChangeBounds(Sender: TObject);
|
---|
1048 | var
|
---|
1049 | NewBounds: TRect;
|
---|
1050 | begin
|
---|
1051 | NewBounds := ScaleRectFromNative(GetNativeControl.BoundsRect);
|
---|
1052 | if NewBounds <> BoundsRect then begin
|
---|
1053 | FLeft := NewBounds.Left;
|
---|
1054 | FTop := NewBounds.Top;
|
---|
1055 | FWidth := NewBounds.Width;
|
---|
1056 | FHeight := NewBounds.Height;
|
---|
1057 | DoChangeBounds;
|
---|
1058 | end;
|
---|
1059 | end;
|
---|
1060 |
|
---|
1061 | procedure TControl.DoFormResize;
|
---|
1062 | begin
|
---|
1063 | if Assigned(FOnResize) then begin
|
---|
1064 | FOnResize(Self);
|
---|
1065 | end;
|
---|
1066 | end;
|
---|
1067 |
|
---|
1068 | procedure TControl.DoChangeBounds;
|
---|
1069 | begin
|
---|
1070 | if Assigned(FOnChangeBounds) then FOnChangeBounds(Self);
|
---|
1071 | end;
|
---|
1072 |
|
---|
1073 | function TControl.GetCaption: string;
|
---|
1074 | begin
|
---|
1075 | Result := GetNativeControl.Caption;
|
---|
1076 | end;
|
---|
1077 |
|
---|
1078 | procedure TControl.FontChanged(Sender: TObject);
|
---|
1079 | begin
|
---|
1080 | GetNativeControl.Font.Size := ScaleToNative(Font.Size);
|
---|
1081 | end;
|
---|
1082 |
|
---|
1083 | procedure TControl.UpdateBounds;
|
---|
1084 | begin
|
---|
1085 | GetNativeControl.BoundsRect := ScaleRectToNative(BoundsRect);
|
---|
1086 | end;
|
---|
1087 |
|
---|
1088 | procedure TControl.SetHeight(AValue: Integer);
|
---|
1089 | begin
|
---|
1090 | if FHeight = AValue then Exit;
|
---|
1091 | FHeight := AValue;
|
---|
1092 | UpdateBounds;
|
---|
1093 | end;
|
---|
1094 |
|
---|
1095 | { TControlBorderSpacing }
|
---|
1096 |
|
---|
1097 | function TControlBorderSpacing.IsBottomStored: Boolean;
|
---|
1098 | begin
|
---|
1099 | if FDefault = nil
|
---|
1100 | then Result := FBottom <> 0
|
---|
1101 | else Result := FBottom <> FDefault^.Bottom;
|
---|
1102 | end;
|
---|
1103 |
|
---|
1104 | function TControlBorderSpacing.IsAroundStored: Boolean;
|
---|
1105 | begin
|
---|
1106 | if FDefault = nil
|
---|
1107 | then Result := FAround <> 0
|
---|
1108 | else Result := FAround <> FDefault^.Around;
|
---|
1109 | end;
|
---|
1110 |
|
---|
1111 | function TControlBorderSpacing.IsLeftStored: Boolean;
|
---|
1112 | begin
|
---|
1113 | if FDefault = nil
|
---|
1114 | then Result := FLeft <> 0
|
---|
1115 | else Result := FLeft <> FDefault^.Left;
|
---|
1116 | end;
|
---|
1117 |
|
---|
1118 | function TControlBorderSpacing.IsRightStored: Boolean;
|
---|
1119 | begin
|
---|
1120 | if FDefault = nil
|
---|
1121 | then Result := FRight <> 0
|
---|
1122 | else Result := FRight <> FDefault^.Right;
|
---|
1123 | end;
|
---|
1124 |
|
---|
1125 | function TControlBorderSpacing.IsTopStored: Boolean;
|
---|
1126 | begin
|
---|
1127 | if FDefault = nil
|
---|
1128 | then Result := FTop <> 0
|
---|
1129 | else Result := FTop <> FDefault^.Top;
|
---|
1130 | end;
|
---|
1131 |
|
---|
1132 | procedure TControlBorderSpacing.SetAround(AValue: TSpacingSize);
|
---|
1133 | begin
|
---|
1134 | if FAround = AValue then Exit;
|
---|
1135 | FAround := AValue;
|
---|
1136 | Change(False);
|
---|
1137 | end;
|
---|
1138 |
|
---|
1139 | procedure TControlBorderSpacing.SetBottom(AValue: TSpacingSize);
|
---|
1140 | begin
|
---|
1141 | if FBottom = AValue then Exit;
|
---|
1142 | FBottom := AValue;
|
---|
1143 | Change(False);
|
---|
1144 | end;
|
---|
1145 |
|
---|
1146 | procedure TControlBorderSpacing.SetLeft(AValue: TSpacingSize);
|
---|
1147 | begin
|
---|
1148 | if FLeft = AValue then Exit;
|
---|
1149 | FLeft := AValue;
|
---|
1150 | Change(False);
|
---|
1151 | end;
|
---|
1152 |
|
---|
1153 | procedure TControlBorderSpacing.SetRight(AValue: TSpacingSize);
|
---|
1154 | begin
|
---|
1155 | if FRight = AValue then Exit;
|
---|
1156 | FRight := AValue;
|
---|
1157 | Change(False);
|
---|
1158 | end;
|
---|
1159 |
|
---|
1160 | procedure TControlBorderSpacing.SetTop(AValue: TSpacingSize);
|
---|
1161 | begin
|
---|
1162 | if FTop = AValue then Exit;
|
---|
1163 | FTop := AValue;
|
---|
1164 | Change(False);
|
---|
1165 | end;
|
---|
1166 |
|
---|
1167 | procedure TControlBorderSpacing.Change(InnerSpaceChanged: Boolean);
|
---|
1168 | begin
|
---|
1169 | if FControl <> nil then
|
---|
1170 | FControl.DoBorderSpacingChange(Self, InnerSpaceChanged);
|
---|
1171 | if Assigned(OnChange) then OnChange(Self);
|
---|
1172 | end;
|
---|
1173 |
|
---|
1174 | constructor TControlBorderSpacing.Create(OwnerControl: TControl;
|
---|
1175 | ADefault: PControlBorderSpacingDefault);
|
---|
1176 | begin
|
---|
1177 | FControl := OwnerControl;
|
---|
1178 | FDefault := ADefault;
|
---|
1179 | if ADefault <> nil then
|
---|
1180 | begin
|
---|
1181 | FLeft := ADefault^.Left;
|
---|
1182 | FRight := ADefault^.Right;
|
---|
1183 | FTop := ADefault^.Top;
|
---|
1184 | FBottom := ADefault^.Bottom;
|
---|
1185 | FAround := ADefault^.Around;
|
---|
1186 | end;
|
---|
1187 | inherited Create;
|
---|
1188 | end;
|
---|
1189 |
|
---|
1190 | { TSizeConstraints }
|
---|
1191 |
|
---|
1192 | procedure TSizeConstraints.SetMaxHeight(AValue: TConstraintSize);
|
---|
1193 | begin
|
---|
1194 | if FMaxHeight=AValue then Exit;
|
---|
1195 | FMaxHeight:=AValue;
|
---|
1196 | end;
|
---|
1197 |
|
---|
1198 | procedure TSizeConstraints.SetMaxWidth(AValue: TConstraintSize);
|
---|
1199 | begin
|
---|
1200 | if FMaxWidth=AValue then Exit;
|
---|
1201 | FMaxWidth:=AValue;
|
---|
1202 | end;
|
---|
1203 |
|
---|
1204 | procedure TSizeConstraints.SetMinHeight(AValue: TConstraintSize);
|
---|
1205 | begin
|
---|
1206 | if FMinHeight=AValue then Exit;
|
---|
1207 | FMinHeight:=AValue;
|
---|
1208 | end;
|
---|
1209 |
|
---|
1210 | procedure TSizeConstraints.SetMinWidth(AValue: TConstraintSize);
|
---|
1211 | begin
|
---|
1212 | if FMinWidth=AValue then Exit;
|
---|
1213 | FMinWidth:=AValue;
|
---|
1214 | end;
|
---|
1215 |
|
---|
1216 | { TGraphicControl }
|
---|
1217 |
|
---|
1218 | procedure TGraphicControl.SetCanvas(AValue: TCanvas);
|
---|
1219 | begin
|
---|
1220 | if FCanvas = AValue then Exit;
|
---|
1221 | FCanvas := AValue;
|
---|
1222 | end;
|
---|
1223 |
|
---|
1224 | procedure TGraphicControl.PaintHandler(Sender: TObject);
|
---|
1225 | begin
|
---|
1226 | Paint;
|
---|
1227 | if Assigned(FOnPaint) then
|
---|
1228 | FOnPaint(Sender);
|
---|
1229 | end;
|
---|
1230 |
|
---|
1231 | procedure TGraphicControl.Paint;
|
---|
1232 | begin
|
---|
1233 | end;
|
---|
1234 |
|
---|
1235 | function TGraphicControl.GetNativeControl: Controls.TControl;
|
---|
1236 | begin
|
---|
1237 | Result := GetNativeGraphicControl;
|
---|
1238 | end;
|
---|
1239 |
|
---|
1240 | function TGraphicControl.GetNativeGraphicControl: Controls.TGraphicControl;
|
---|
1241 | begin
|
---|
1242 | Result := NativeGraphicControl;
|
---|
1243 | end;
|
---|
1244 |
|
---|
1245 | procedure TGraphicControl.UpdateNativeControl;
|
---|
1246 | begin
|
---|
1247 | inherited;
|
---|
1248 | {$objectChecks-}
|
---|
1249 | TGraphicControlEx(GetNativeGraphicControl).OnPaint := PaintHandler;
|
---|
1250 | {$objectChecks+}
|
---|
1251 | end;
|
---|
1252 |
|
---|
1253 | function TGraphicControl.GetOnPaint: TNotifyEvent;
|
---|
1254 | begin
|
---|
1255 | Result := FOnPaint;
|
---|
1256 | end;
|
---|
1257 |
|
---|
1258 | procedure TGraphicControl.SetOnPaint(AValue: TNotifyEvent);
|
---|
1259 | begin
|
---|
1260 | FOnPaint := AValue;
|
---|
1261 | end;
|
---|
1262 |
|
---|
1263 | constructor TGraphicControl.Create(TheOwner: TComponent);
|
---|
1264 | begin
|
---|
1265 | NativeGraphicControl := Controls.TGraphicControl.Create(nil);
|
---|
1266 | inherited;
|
---|
1267 | FCanvas := TCanvas.Create;
|
---|
1268 | FCanvas.NativeCanvas := GetNativeGraphicControl.Canvas;
|
---|
1269 | end;
|
---|
1270 |
|
---|
1271 | destructor TGraphicControl.Destroy;
|
---|
1272 | begin
|
---|
1273 | FreeAndNil(FCanvas);
|
---|
1274 | FreeAndNil(NativeGraphicControl);
|
---|
1275 | inherited;
|
---|
1276 | end;
|
---|
1277 |
|
---|
1278 | { TGraphicControlEx }
|
---|
1279 |
|
---|
1280 | procedure TGraphicControlEx.Paint;
|
---|
1281 | begin
|
---|
1282 | inherited Paint;
|
---|
1283 | end;
|
---|
1284 |
|
---|
1285 | { TMouse }
|
---|
1286 |
|
---|
1287 | function TMouse.GetCursorPos: TPoint;
|
---|
1288 | begin
|
---|
1289 | Result := ScalePointFromNative(Controls.Mouse.CursorPos);
|
---|
1290 | end;
|
---|
1291 |
|
---|
1292 | procedure TMouse.SetCursorPos(AValue: TPoint);
|
---|
1293 | begin
|
---|
1294 | Controls.Mouse.CursorPos := ScalePointToNative(AValue);
|
---|
1295 | end;
|
---|
1296 |
|
---|
1297 | constructor TMouse.Create;
|
---|
1298 | begin
|
---|
1299 | end;
|
---|
1300 |
|
---|
1301 | destructor TMouse.Destroy;
|
---|
1302 | begin
|
---|
1303 | inherited;
|
---|
1304 | end;
|
---|
1305 |
|
---|
1306 | { TImageList }
|
---|
1307 |
|
---|
1308 | function TImageList.GetHeight: Integer;
|
---|
1309 | begin
|
---|
1310 |
|
---|
1311 | end;
|
---|
1312 |
|
---|
1313 | function TImageList.GetCount: Integer;
|
---|
1314 | begin
|
---|
1315 |
|
---|
1316 | end;
|
---|
1317 |
|
---|
1318 | function TImageList.GetWidth: Integer;
|
---|
1319 | begin
|
---|
1320 |
|
---|
1321 | end;
|
---|
1322 |
|
---|
1323 | procedure TImageList.SetHeight(AValue: Integer);
|
---|
1324 | begin
|
---|
1325 |
|
---|
1326 | end;
|
---|
1327 |
|
---|
1328 | procedure TImageList.SetWidth(AValue: Integer);
|
---|
1329 | begin
|
---|
1330 |
|
---|
1331 | end;
|
---|
1332 |
|
---|
1333 | function TImageList.GetNativeImageList: Controls.TImageList;
|
---|
1334 | begin
|
---|
1335 | if not Assigned(NativeImageList) then
|
---|
1336 | NativeImageList := Controls.TImageList.Create(nil);
|
---|
1337 | Result := NativeImageList;
|
---|
1338 | end;
|
---|
1339 |
|
---|
1340 | procedure TImageList.GetBitmap(Index: Integer; Image: TBitmap);
|
---|
1341 | begin
|
---|
1342 |
|
---|
1343 | end;
|
---|
1344 |
|
---|
1345 | procedure TImageList.BeginUpdate;
|
---|
1346 | begin
|
---|
1347 |
|
---|
1348 | end;
|
---|
1349 |
|
---|
1350 | procedure TImageList.EndUpdate;
|
---|
1351 | begin
|
---|
1352 |
|
---|
1353 | end;
|
---|
1354 |
|
---|
1355 | procedure TImageList.Clear;
|
---|
1356 | begin
|
---|
1357 |
|
---|
1358 | end;
|
---|
1359 |
|
---|
1360 | function TImageList.Add(Image, Mask: TBitmap): Integer;
|
---|
1361 | begin
|
---|
1362 |
|
---|
1363 | end;
|
---|
1364 |
|
---|
1365 | constructor TImageList.Create(TheOwner: TComponent);
|
---|
1366 | begin
|
---|
1367 | inherited Create(TheOwner);
|
---|
1368 | end;
|
---|
1369 |
|
---|
1370 | destructor TImageList.Destroy;
|
---|
1371 | begin
|
---|
1372 | FreeAndNil(NativeImageList);
|
---|
1373 | inherited;
|
---|
1374 | end;
|
---|
1375 |
|
---|
1376 | initialization
|
---|
1377 |
|
---|
1378 | Mouse := TMouse.Create;
|
---|
1379 |
|
---|
1380 | finalization;
|
---|
1381 |
|
---|
1382 | FreeAndNil(Mouse);
|
---|
1383 |
|
---|
1384 | end.
|
---|
1385 |
|
---|