source: trunk/Packages/DpiControls/Dpi.ComCtrls.pas

Last change on this file was 468, checked in by chronos, 6 months ago
  • Added: High DPI support integrated into trunk branch. It can be enabled by adding DPI define to compiler parameters for main project and packages.
File size: 10.3 KB
Line 
1unit Dpi.ComCtrls;
2
3interface
4
5uses
6 Classes, SysUtils, ComCtrls, Graphics, Dpi.Controls;
7
8type
9 TDpiCustomListView = class(TWinControl)
10 end;
11
12 TDpiLVCustomDrawItemEvent = procedure(Sender: TDpiCustomListView; Item: TListItem;
13 State: TCustomDrawState; var DefaultDraw: Boolean) of object;
14
15 { TDpiListView }
16
17 TDpiListView = class(TDpiCustomListView)
18 private
19 FOnCustomDrawItem: TDpiLVCustomDrawItemEvent;
20 NativeListView: TListView;
21 function GetCanvas: TCanvas;
22 function GetColumns: TListColumns;
23 function GetItems: TListItems;
24 function GetOnChange: TLVChangeEvent;
25 function GetOnColumnClick: TLVColumnClickEvent;
26 function GetOnCustomDrawItem: TDpiLVCustomDrawItemEvent;
27 function GetProperty(AIndex: Integer): Boolean;
28 function GetViewStyle: TViewStyle;
29 procedure SetColumns(AValue: TListColumns);
30 procedure SetItems(AValue: TListItems);
31 procedure SetOnChange(AValue: TLVChangeEvent);
32 procedure SetOnColumnClick(AValue: TLVColumnClickEvent);
33 procedure SetOnCustomDrawItem(AValue: TDpiLVCustomDrawItemEvent);
34 procedure SetProperty(AIndex: Integer; AValue: Boolean);
35 procedure SetViewStyle(AValue: TViewStyle);
36 procedure DoCustomDrawItem(Sender: TCustomListView; Item: TListItem;
37 State: TCustomDrawState; var DefaultDraw: Boolean);
38 public
39 function GetItemAt(x,y: integer): TListItem;
40 function GetNativeListView: TListView;
41 constructor Create(TheOwner: TComponent); override;
42 destructor Destroy; override;
43 property Columns: TListColumns read GetColumns write SetColumns;
44 property Items: TListItems read GetItems write SetItems;
45 property Canvas: TCanvas read GetCanvas;
46 property Checkboxes: Boolean index Ord(lvpCheckboxes) read GetProperty write SetProperty default False;
47 published
48 property OnColumnClick: TLVColumnClickEvent read GetOnColumnClick
49 write SetOnColumnClick;
50 property OnCustomDrawItem: TDpiLVCustomDrawItemEvent read GetOnCustomDrawItem
51 write SetOnCustomDrawItem;
52 property ViewStyle: TViewStyle read GetViewStyle write SetViewStyle default vsList;
53 property OnChange: TLVChangeEvent read GetOnChange write SetOnChange;
54 end;
55
56 { TDpiToolBar }
57
58 TDpiToolBar = class(TCustomControl)
59 private
60 NativeToolBar: TToolBar;
61 function ButtonHeightIsStored: Boolean;
62 function ButtonWidthIsStored: Boolean;
63 function GetButtonHeight: Integer;
64 function GetButtonWidth: Integer;
65 procedure SetButtonHeight(AValue: Integer);
66 procedure SetButtonWidth(AValue: Integer);
67 public
68 function GetNativeToolBar: TToolBar;
69 constructor Create(TheOwner: TComponent); override;
70 destructor Destroy; override;
71 property ButtonHeight: Integer read GetButtonHeight write SetButtonHeight stored ButtonHeightIsStored;
72 property ButtonWidth: Integer read GetButtonWidth write SetButtonWidth stored ButtonWidthIsStored;
73 end;
74
75 { TDpiCoolBand }
76
77 TDpiCoolBand = class(TCustomControl)
78 private
79 NativeCoolBand: TCoolBand;
80 function GetMinHeight: Integer;
81 function GetMinWidth: Integer;
82 procedure SetMinHeight(AValue: Integer);
83 procedure SetMinWidth(AValue: Integer);
84 protected const
85 cDefMinHeight = 25;
86 cDefMinWidth = 100;
87 public
88 function GetNativeCoolBand: TCoolBand;
89 constructor Create(TheOwner: TComponent); override;
90 destructor Destroy; override;
91 property MinHeight: Integer read GetMinHeight write SetMinHeight default cDefMinHeight;
92 property MinWidth: Integer read GetMinWidth write SetMinWidth default cDefMinWidth;
93 end;
94
95 { TDpiCoolBands }
96
97 TDpiCoolBands = class(TCollection)
98 private
99 procedure SetItem(Index: Integer; AValue: TDpiCoolBand);
100 function GetItem(Index: Integer): TDpiCoolBand;
101 public
102 property Items[Index: Integer]: TDpiCoolBand read GetItem write SetItem; default;
103 end;
104
105 { TDpiCoolBar }
106
107 TDpiCoolBar = class(TCustomControl)
108 private
109 NativeCoolBar: TCoolBar;
110 function GetBands: TDpiCoolBands;
111 function GetThemed: Boolean;
112 procedure SetBands(AValue: TDpiCoolBands);
113 procedure SetThemed(AValue: Boolean);
114 public
115 procedure BeginUpdate;
116 procedure EndUpdate;
117 function GetNativeCoolBar: TCoolBar;
118 constructor Create(TheOwner: TComponent); override;
119 destructor Destroy; override;
120 property Bands: TDpiCoolBands read GetBands write SetBands;
121 property Themed: Boolean read GetThemed write SetThemed default True;
122 end;
123
124 { TDpiPageControl }
125
126 TDpiPageControl = class(TWinControl)
127 private
128 NativePageControl: TPageControl;
129 function GetPageCount: Integer;
130 function GetTabSheet(Index: Integer): TTabSheet;
131 public
132 function GetNativePageControl: TPageControl;
133 constructor Create(TheOwner: TComponent); override;
134 destructor Destroy; override;
135 property PageCount: Integer read GetPageCount;
136 property Pages[Index: Integer]: TTabSheet read GetTabSheet;
137 end;
138
139
140
141implementation
142
143uses
144 Dpi.Common;
145
146{ TDpiListView }
147
148function TDpiListView.GetItems: TListItems;
149begin
150 Result := GetNativeListView.Items;
151end;
152
153function TDpiListView.GetOnChange: TLVChangeEvent;
154begin
155 Result := GetNativeListView.OnChange;
156end;
157
158function TDpiListView.GetOnColumnClick: TLVColumnClickEvent;
159begin
160 Result := GetNativeListView.OnColumnClick;
161end;
162
163function TDpiListView.GetOnCustomDrawItem: TDpiLVCustomDrawItemEvent;
164begin
165 Result := FOnCustomDrawItem;
166end;
167
168function TDpiListView.GetProperty(AIndex: Integer): Boolean;
169begin
170 Result := GetNativeListView.Checkboxes;
171end;
172
173function TDpiListView.GetViewStyle: TViewStyle;
174begin
175 Result := GetNativeListView.ViewStyle;
176end;
177
178function TDpiListView.GetColumns: TListColumns;
179begin
180 Result := GetNativeListView.Columns;
181end;
182
183function TDpiListView.GetCanvas: TCanvas;
184begin
185 Result := GetNativeListView.Canvas;
186end;
187
188procedure TDpiListView.SetColumns(AValue: TListColumns);
189begin
190 GetNativeListView.Columns := AValue;
191end;
192
193procedure TDpiListView.SetItems(AValue: TListItems);
194begin
195 GetNativeListView.Items := AValue;
196end;
197
198procedure TDpiListView.SetOnChange(AValue: TLVChangeEvent);
199begin
200 GetNativeListView.OnChange := AValue;
201end;
202
203procedure TDpiListView.SetOnColumnClick(AValue: TLVColumnClickEvent);
204begin
205 GetNativeListView.OnColumnClick := AValue;
206end;
207
208procedure TDpiListView.SetOnCustomDrawItem(AValue: TDpiLVCustomDrawItemEvent);
209begin
210 FOnCustomDrawItem := AValue;
211end;
212
213procedure TDpiListView.SetProperty(AIndex: Integer; AValue: Boolean);
214begin
215 GetNativeListView.Checkboxes := AValue;
216end;
217
218procedure TDpiListView.SetViewStyle(AValue: TViewStyle);
219begin
220 GetNativeListView.ViewStyle := AValue;
221end;
222
223procedure TDpiListView.DoCustomDrawItem(Sender: TCustomListView; Item: TListItem;
224 State: TCustomDrawState; var DefaultDraw: Boolean);
225begin
226 if Assigned(FOnCustomDrawItem) then
227 FOnCustomDrawItem(Self, Item, State, DefaultDraw);
228end;
229
230function TDpiListView.GetItemAt(x, y: integer): TListItem;
231begin
232 Result := GetNativeListView.GetItemAt(X, Y);
233end;
234
235function TDpiListView.GetNativeListView: TListView;
236begin
237 if not Assigned(NativeListView) then begin
238 NativeListView := TListView.Create(nil);
239 NativeListView.OnCustomDrawItem := DoCustomDrawItem;
240 end;
241 Result := NativeListView;
242end;
243
244constructor TDpiListView.Create(TheOwner: TComponent);
245begin
246 inherited Create(TheOwner);
247end;
248
249destructor TDpiListView.Destroy;
250begin
251 FreeAndNil(NativeListView);
252 inherited;
253end;
254
255{ TDpiToolBar }
256
257function TDpiToolBar.ButtonHeightIsStored: Boolean;
258begin
259
260end;
261
262function TDpiToolBar.ButtonWidthIsStored: Boolean;
263begin
264
265end;
266
267function TDpiToolBar.GetButtonHeight: Integer;
268begin
269 Result := ScaleFromNative(GetNativeToolBar.ButtonHeight);
270end;
271
272function TDpiToolBar.GetButtonWidth: Integer;
273begin
274 Result := ScaleFromNative(GetNativeToolBar.ButtonWidth);
275end;
276
277procedure TDpiToolBar.SetButtonHeight(AValue: Integer);
278begin
279 GetNativeToolBar.ButtonHeight := ScaleToNative(AValue);
280end;
281
282procedure TDpiToolBar.SetButtonWidth(AValue: Integer);
283begin
284 GetNativeToolBar.ButtonWidth := ScaleToNative(AValue);
285end;
286
287function TDpiToolBar.GetNativeToolBar: TToolBar;
288begin
289 if not Assigned(NativeToolBar) then NativeToolBar := TToolBar.Create(nil);
290 Result := NativeToolBar;
291end;
292
293constructor TDpiToolBar.Create(TheOwner: TComponent);
294begin
295 inherited Create(TheOwner);
296end;
297
298destructor TDpiToolBar.Destroy;
299begin
300 FreeAndNil(NativeToolBar);
301 inherited;
302end;
303
304{ TDpiCoolBar }
305
306function TDpiCoolBar.GetBands: TDpiCoolBands;
307begin
308
309end;
310
311function TDpiCoolBar.GetThemed: Boolean;
312begin
313 Result := GetNativeCoolBar.Themed;
314end;
315
316procedure TDpiCoolBar.SetBands(AValue: TDpiCoolBands);
317begin
318
319end;
320
321procedure TDpiCoolBar.SetThemed(AValue: Boolean);
322begin
323 GetNativeCoolBar.Themed := AValue
324end;
325
326procedure TDpiCoolBar.BeginUpdate;
327begin
328 GetNativeCoolBar.BeginUpdate;
329end;
330
331procedure TDpiCoolBar.EndUpdate;
332begin
333 GetNativeCoolBar.EndUpdate;
334end;
335
336function TDpiCoolBar.GetNativeCoolBar: TCoolBar;
337begin
338 if not Assigned(NativeCoolBar) then NativeCoolBar := TCoolBar.Create(nil);
339 Result := NativeCoolBar;
340end;
341
342constructor TDpiCoolBar.Create(TheOwner: TComponent);
343begin
344 inherited Create(TheOwner);
345end;
346
347destructor TDpiCoolBar.Destroy;
348begin
349 FreeAndNil(NativeCoolBar);
350 inherited Destroy;
351end;
352
353{ TDpiCoolBands }
354
355procedure TDpiCoolBands.SetItem(Index: Integer; AValue: TDpiCoolBand);
356begin
357
358end;
359
360function TDpiCoolBands.GetItem(Index: Integer): TDpiCoolBand;
361begin
362
363end;
364
365{ TDpiCoolBand }
366
367function TDpiCoolBand.GetMinWidth: Integer;
368begin
369
370end;
371
372function TDpiCoolBand.GetMinHeight: Integer;
373begin
374
375end;
376
377procedure TDpiCoolBand.SetMinHeight(AValue: Integer);
378begin
379
380end;
381
382procedure TDpiCoolBand.SetMinWidth(AValue: Integer);
383begin
384
385end;
386
387function TDpiCoolBand.GetNativeCoolBand: TCoolBand;
388begin
389
390end;
391
392constructor TDpiCoolBand.Create(TheOwner: TComponent);
393begin
394 inherited Create(TheOwner);
395end;
396
397destructor TDpiCoolBand.Destroy;
398begin
399 inherited Destroy;
400end;
401
402{ TDpiPageControl }
403
404function TDpiPageControl.GetPageCount: Integer;
405begin
406 Result := GetNativePageControl.PageCount;
407end;
408
409function TDpiPageControl.GetTabSheet(Index: Integer): TTabSheet;
410begin
411 Result := GetNativePageControl.Pages[Index];
412end;
413
414function TDpiPageControl.GetNativePageControl: TPageControl;
415begin
416 if not Assigned(NativePageControl) then NativePageControl := TPageControl.Create(nil);
417 Result := NativePageControl;
418end;
419
420constructor TDpiPageControl.Create(TheOwner: TComponent);
421begin
422 inherited Create(TheOwner);
423end;
424
425destructor TDpiPageControl.Destroy;
426begin
427 FreeAndNil(NativePageControl);
428 inherited;
429end;
430
431
432end.
433
Note: See TracBrowser for help on using the repository browser.