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

Last change on this file was 568, checked in by chronos, 2 months ago
  • Fixed: Custom draw ListBox items to keep consistent style on Linux.
  • Fixed: Last game name index error if no saved games.
File size: 15.6 KB
Line 
1unit Dpi.StdCtrls;
2
3interface
4
5uses
6 Classes, SysUtils, Controls, StdCtrls, Forms, Dpi.Controls, Dpi.Graphics;
7
8type
9 { TMemo }
10
11 TMemo = class(TWinControl)
12 private
13 NativeMemo: StdCtrls.TMemo;
14 function GetLines: TStrings;
15 function GetReadOnly: Boolean;
16 function GetScrollBars: TScrollStyle;
17 function GetWordWrap: Boolean;
18 procedure SetLines(AValue: TStrings);
19 procedure SetReadOnly(AValue: Boolean);
20 procedure SetScrollBars(AValue: TScrollStyle);
21 procedure SetWordWrap(AValue: Boolean);
22 protected
23 function GetNativeWinControl: Controls.TWinControl; override;
24 function GetNativeMemo: StdCtrls.TMemo; virtual;
25 public
26 procedure Clear;
27 constructor Create(TheOwner: TComponent); override;
28 destructor Destroy; override;
29 published
30 property Lines: TStrings read GetLines write SetLines;
31 property WordWrap: Boolean read GetWordWrap write SetWordWrap default True;
32 property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
33 property ScrollBars: TScrollStyle read GetScrollBars write SetScrollBars default ssNone;
34 end;
35
36 { TEdit }
37
38 TEdit = class(TWinControl)
39 private
40 function GetSelLength: Integer;
41 function GetSelStart: Integer;
42 procedure SetSelLength(AValue: Integer);
43 procedure SetSelStart(AValue: Integer);
44 protected
45 function GetNativeWinControl: Controls.TWinControl; override;
46 function GetNativeEdit: StdCtrls.TEdit; virtual;
47 function GetText: TCaption; override;
48 procedure SetText(AValue: TCaption); override;
49 public
50 NativeEdit: StdCtrls.TEdit;
51 destructor Destroy; override;
52 property SelLength: Integer read GetSelLength write SetSelLength;
53 property SelStart: Integer read GetSelStart write SetSelStart;
54 published
55 property Text;
56 property BorderStyle default bsSingle;
57 property ParentFont;
58 end;
59
60 { TComboBox }
61
62 TComboBox = class(TWinControl)
63 private
64 NativeComboBox: StdCtrls.TComboBox;
65 public
66 function GetNativeComboBox: StdCtrls.TComboBox;
67 constructor Create(TheOwner: TComponent); override;
68 destructor Destroy; override;
69 end;
70
71 { TCheckBox }
72
73 TCheckBox = class(TWinControl)
74 private
75 NativeCheckBox: StdCtrls.TCheckBox;
76 public
77 function GetNativeCheckBox: StdCtrls.TCheckBox;
78 constructor Create(TheOwner: TComponent); override;
79 destructor Destroy; override;
80 end;
81
82 { TRadioButton }
83
84 TRadioButton = class(TWinControl)
85 private
86 NativeRadioButton: StdCtrls.TRadioButton;
87 public
88 function GetNativeRadioButton: StdCtrls.TRadioButton;
89 constructor Create(TheOwner: TComponent); override;
90 destructor Destroy; override;
91 end;
92
93 { TButton }
94
95 TButton = class(TWinControl)
96 private
97 protected
98 function GetNativeWinControl: Controls.TWinControl; override;
99 public
100 NativeButton: StdCtrls.TButton;
101 destructor Destroy; override;
102 published
103 property Visible;
104 end;
105
106 TDrawItemEvent = procedure(Control: TWinControl; Index: Integer;
107 ARect: TRect; State: TOwnerDrawState) of object;
108 TListBoxStyle = StdCtrls.TListBoxStyle;
109
110 { TListBox }
111
112 TListBox = class(TWinControl)
113 private
114 FCanvas: TCanvas;
115 FOnDrawItem: TDrawItemEvent;
116 function GetBorderStyle: TBorderStyle;
117 function GetCount: Integer;
118 function GetExtendedSelect: Boolean;
119 function GetIntegralHeight: Boolean;
120 function GetItemHeight: Integer;
121 function GetItemIndex: Integer;
122 function GetItems: TStrings;
123 function GetOnSelectionChange: TSelectionChangeEvent;
124 function GetParentFont: Boolean;
125 function GetScrollWidth: Integer;
126 function GetStyle: TListBoxStyle;
127 function GetTopIndex: Integer;
128 procedure SetBorderStyle(AValue: TBorderStyle);
129 procedure SetExtendedSelect(AValue: Boolean);
130 procedure SetIntegralHeight(AValue: Boolean);
131 procedure SetItemHeight(AValue: Integer);
132 procedure SetItemIndex(AValue: Integer);
133 procedure SetItems(AValue: TStrings);
134 procedure SetOnDrawItem(AValue: TDrawItemEvent);
135 procedure SetOnSelectionChange(AValue: TSelectionChangeEvent);
136 procedure SetParentFont(AValue: Boolean);
137 procedure SetScrollWidth(AValue: Integer);
138 procedure SetStyle(AValue: TListBoxStyle);
139 procedure SetTopIndex(AValue: Integer);
140 procedure DoDrawItemNative(Control: Controls.TWinControl; Index: Integer;
141 ARect: TRect; State: TOwnerDrawState);
142 protected
143 function GetNativeWinControl: Controls.TWinControl; override;
144 function GetNativeListBox: StdCtrls.TListBox; virtual;
145 public
146 NativeListBox: StdCtrls.TListBox;
147 constructor Create(AOwner: TComponent); override;
148 destructor Destroy; override;
149 property ItemIndex: Integer read GetItemIndex write SetItemIndex;
150 property Items: TStrings read GetItems write SetItems;
151 property Count: Integer read GetCount;
152 property Canvas: TCanvas read FCanvas;
153 published
154 property ParentColor;
155 property TopIndex: Integer read GetTopIndex write SetTopIndex default 0;
156 property ScrollWidth: Integer read GetScrollWidth write SetScrollWidth default 0;
157 property ParentFont: Boolean read GetParentFont write SetParentFont default True;
158 property ItemHeight: Integer read GetItemHeight write SetItemHeight;
159 property IntegralHeight: Boolean read GetIntegralHeight write SetIntegralHeight default False;
160 property ExtendedSelect: Boolean read GetExtendedSelect write SetExtendedSelect default true;
161 property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsNone;
162 property Visible;
163 property Anchors;
164 property OnSelectionChange: TSelectionChangeEvent read GetOnSelectionChange
165 write SetOnSelectionChange;
166 property Style: TListBoxStyle read GetStyle write SetStyle default lbStandard;
167 property OnDrawItem: TDrawItemEvent read FOnDrawItem write SetOnDrawItem;
168 end;
169
170 { TScrollBar }
171
172 TScrollBar = class(TWinControl)
173 private
174 function GetKind: TScrollBarKind;
175 function GetMax: Integer;
176 function GetMin: Integer;
177 function GetOnChange: TNotifyEvent;
178 function GetPageSize: Integer;
179 function GetPosition: Integer;
180 procedure SetKind(AValue: TScrollBarKind);
181 procedure SetMax(AValue: Integer);
182 procedure SetMin(AValue: Integer);
183 procedure SetOnChange(AValue: TNotifyEvent);
184 procedure SetPageSize(AValue: Integer);
185 procedure SetPosition(AValue: Integer);
186 protected
187 function GetNativeWinControl: Controls.TWinControl; override;
188 function GetNativeScrollBar: StdCtrls.TScrollBar; virtual;
189 public
190 NativeScrollBar: StdCtrls.TScrollBar;
191 constructor Create(TheOwner: TComponent); override;
192 destructor Destroy; override;
193 published
194 property PageSize: Integer read GetPageSize write SetPageSize;
195 property Min: Integer read GetMin write SetMin default 0;
196 property Max: Integer read GetMax write SetMax default 100;
197 property Position: Integer read GetPosition write SetPosition default 0;
198 property Kind: TScrollBarKind read GetKind write SetKind default sbHorizontal;
199 property OnChange: TNotifyEvent read GetOnChange write SetOnChange;
200 property Visible;
201 end;
202
203procedure Register;
204
205
206implementation
207
208uses
209 Dpi.Common;
210
211procedure Register;
212begin
213 RegisterComponents(DpiControlsComponentPaletteName, [TEdit, TButton,
214 TScrollBar, TListBox, TCheckBox, TComboBox]);
215end;
216
217{ TMemo }
218
219function TMemo.GetLines: TStrings;
220begin
221 Result := GetNativeMemo.Lines;
222end;
223
224function TMemo.GetReadOnly: Boolean;
225begin
226 Result := GetNativeMemo.ReadOnly;
227end;
228
229function TMemo.GetScrollBars: TScrollStyle;
230begin
231 Result := GetNativeMemo.ScrollBars;
232end;
233
234function TMemo.GetWordWrap: Boolean;
235begin
236 Result := GetNativeMemo.WordWrap;
237end;
238
239procedure TMemo.SetLines(AValue: TStrings);
240begin
241 GetNativeMemo.Lines := AValue;
242end;
243
244procedure TMemo.SetReadOnly(AValue: Boolean);
245begin
246 GetNativeMemo.ReadOnly := AValue;
247end;
248
249procedure TMemo.SetScrollBars(AValue: TScrollStyle);
250begin
251 GetNativeMemo.ScrollBars := AValue;
252end;
253
254procedure TMemo.SetWordWrap(AValue: Boolean);
255begin
256 GetNativeMemo.WordWrap := AValue;
257end;
258
259function TMemo.GetNativeWinControl: Controls.TWinControl;
260begin
261 Result := GetNativeMemo;
262end;
263
264procedure TMemo.Clear;
265begin
266 GetNativeMemo.Clear;
267end;
268
269function TMemo.GetNativeMemo: StdCtrls.TMemo;
270begin
271 if not Assigned(NativeMemo) then NativeMemo := StdCtrls.TMemo.Create(nil);
272 Result := NativeMemo;
273end;
274
275constructor TMemo.Create(TheOwner: TComponent);
276begin
277 inherited Create(TheOwner);
278end;
279
280destructor TMemo.Destroy;
281begin
282 FreeAndNil(NativeMemo);
283 inherited;
284end;
285
286{ TEdit }
287
288function TEdit.GetText: TCaption;
289begin
290 Result := GetNativeEdit.Text;
291end;
292
293procedure TEdit.SetText(AValue: TCaption);
294begin
295 GetNativeEdit.Text := AValue;
296end;
297
298destructor TEdit.Destroy;
299begin
300 FreeAndNil(NativeEdit);
301 inherited;
302end;
303
304function TEdit.GetSelLength: Integer;
305begin
306 Result := GetNativeEdit.SelLength;
307end;
308
309function TEdit.GetSelStart: Integer;
310begin
311 Result := GetNativeEdit.SelStart;
312end;
313
314procedure TEdit.SetSelLength(AValue: Integer);
315begin
316 GetNativeEdit.SelLength := AValue;
317end;
318
319procedure TEdit.SetSelStart(AValue: Integer);
320begin
321 GetNativeEdit.SelStart := AValue;
322end;
323
324function TEdit.GetNativeWinControl: Controls.TWinControl;
325begin
326 Result := GetNativeEdit;
327end;
328
329function TEdit.GetNativeEdit: StdCtrls.TEdit;
330begin
331 if not Assigned(NativeEdit) then NativeEdit := StdCtrls.TEdit.Create(nil);
332 Result := NativeEdit;
333end;
334
335{ TCheckBox }
336
337function TCheckBox.GetNativeCheckBox: StdCtrls.TCheckBox;
338begin
339 if not Assigned(NativeCheckBox) then NativeCheckBox := StdCtrls.TCheckBox.Create(nil);
340 Result := NativeCheckBox;
341end;
342
343constructor TCheckBox.Create(TheOwner: TComponent);
344begin
345 inherited Create(TheOwner);
346end;
347
348destructor TCheckBox.Destroy;
349begin
350 FreeAndNil(NativeCheckBox);
351 inherited;
352end;
353
354{ TComboBox }
355
356function TComboBox.GetNativeComboBox: StdCtrls.TComboBox;
357begin
358 if not Assigned(NativeComboBox) then NativeComboBox := StdCtrls.TComboBox.Create(nil);
359 Result := NativeComboBox;
360end;
361
362constructor TComboBox.Create(TheOwner: TComponent);
363begin
364 inherited Create(TheOwner);
365end;
366
367destructor TComboBox.Destroy;
368begin
369 FreeAndNil(NativeComboBox);
370 inherited;
371end;
372
373{ TRadioButton }
374
375function TRadioButton.GetNativeRadioButton: StdCtrls.TRadioButton;
376begin
377 if not Assigned(NativeRadioButton) then NativeRadioButton := StdCtrls.TRadioButton.Create(nil);
378 Result := NativeRadioButton;
379end;
380
381constructor TRadioButton.Create(TheOwner: TComponent);
382begin
383 inherited Create(TheOwner);
384end;
385
386destructor TRadioButton.Destroy;
387begin
388 FreeAndNil(NativeRadioButton);
389 inherited;
390end;
391
392{ TButton }
393
394function TButton.GetNativeWinControl: Controls.TWinControl;
395begin
396 if not Assigned(NativeButton) then NativeButton := StdCtrls.TButton.Create(nil);
397 Result := NativeButton;
398end;
399
400destructor TButton.Destroy;
401begin
402 FreeAndNil(NativeButton);
403 inherited;
404end;
405
406{ TScrollBar }
407
408function TScrollBar.GetKind: TScrollBarKind;
409begin
410 Result := GetNativeScrollBar.Kind;
411end;
412
413function TScrollBar.GetMax: Integer;
414begin
415 Result := GetNativeScrollBar.Max;
416end;
417
418function TScrollBar.GetMin: Integer;
419begin
420 Result := GetNativeScrollBar.Min;
421end;
422
423function TScrollBar.GetOnChange: TNotifyEvent;
424begin
425 Result := GetNativeScrollBar.OnChange;
426end;
427
428function TScrollBar.GetPageSize: Integer;
429begin
430 Result := GetNativeScrollBar.PageSize;
431end;
432
433function TScrollBar.GetPosition: Integer;
434begin
435 Result := GetNativeScrollBar.Position;
436end;
437
438procedure TScrollBar.SetKind(AValue: TScrollBarKind);
439begin
440 GetNativeScrollBar.Kind := AValue;
441end;
442
443procedure TScrollBar.SetMax(AValue: Integer);
444begin
445 GetNativeScrollBar.Max := AValue;
446end;
447
448procedure TScrollBar.SetMin(AValue: Integer);
449begin
450 GetNativeScrollBar.Min := Avalue;
451end;
452
453procedure TScrollBar.SetOnChange(AValue: TNotifyEvent);
454begin
455 GetNativeScrollBar.OnChange := AValue;
456end;
457
458procedure TScrollBar.SetPageSize(AValue: Integer);
459begin
460 GetNativeScrollBar.PageSize := AValue;
461end;
462
463procedure TScrollBar.SetPosition(AValue: Integer);
464begin
465 GetNativeScrollBar.Position := AValue;
466end;
467
468function TScrollBar.GetNativeWinControl: Controls.TWinControl;
469begin
470 Result := GetNativeScrollBar;
471end;
472
473function TScrollBar.GetNativeScrollBar: StdCtrls.TScrollBar;
474begin
475 if not Assigned(NativeScrollBar) then NativeScrollBar := StdCtrls.TScrollBar.Create(nil);
476 Result := NativeScrollBar;
477end;
478
479constructor TScrollBar.Create(TheOwner: TComponent);
480begin
481 inherited;
482end;
483
484destructor TScrollBar.Destroy;
485begin
486 FreeAndNil(NativeScrollBar);
487 inherited;
488end;
489
490{ TListBox }
491
492function TListBox.GetBorderStyle: TBorderStyle;
493begin
494 Result := GetNativeListBox.BorderStyle;
495end;
496
497function TListBox.GetCount: Integer;
498begin
499 Result := GetNativeListBox.Count;
500end;
501
502function TListBox.GetExtendedSelect: Boolean;
503begin
504 Result := GetNativeListBox.ExtendedSelect;
505end;
506
507function TListBox.GetIntegralHeight: Boolean;
508begin
509 Result := GetNativeListBox.IntegralHeight;
510end;
511
512function TListBox.GetItemHeight: Integer;
513begin
514 Result := ScaleFromNative(GetNativeListBox.ItemHeight);
515end;
516
517function TListBox.GetItemIndex: Integer;
518begin
519 Result := GetNativeListBox.ItemIndex;
520end;
521
522function TListBox.GetItems: TStrings;
523begin
524 Result := GetNativeListBox.Items;
525end;
526
527function TListBox.GetOnSelectionChange: TSelectionChangeEvent;
528begin
529 Result := GetNativeListBox.OnSelectionChange;
530end;
531
532function TListBox.GetParentFont: Boolean;
533begin
534 Result := GetNativeListBox.ParentFont;
535end;
536
537function TListBox.GetScrollWidth: Integer;
538begin
539 Result := GetNativeListBox.ScrollWidth;
540end;
541
542function TListBox.GetStyle: TListBoxStyle;
543begin
544 Result := GetNativeListBox.Style;
545end;
546
547function TListBox.GetTopIndex: Integer;
548begin
549 Result := GetNativeListBox.TopIndex;
550end;
551
552procedure TListBox.SetBorderStyle(AValue: TBorderStyle);
553begin
554 GetNativeListBox.BorderStyle := AValue;
555end;
556
557procedure TListBox.SetExtendedSelect(AValue: Boolean);
558begin
559 GetNativeListBox.ExtendedSelect := AValue;
560end;
561
562procedure TListBox.SetIntegralHeight(AValue: Boolean);
563begin
564 GetNativeListBox.IntegralHeight := AValue;
565end;
566
567procedure TListBox.SetItemHeight(AValue: Integer);
568begin
569 GetNativeListBox.ItemHeight := ScaleToNative(AValue);
570end;
571
572procedure TListBox.SetItemIndex(AValue: Integer);
573begin
574 GetNativeListBox.ItemIndex := AValue;
575end;
576
577procedure TListBox.SetItems(AValue: TStrings);
578begin
579 GetNativeListBox.Items := AValue;
580end;
581
582procedure TListBox.SetOnDrawItem(AValue: TDrawItemEvent);
583begin
584 FOnDrawItem := AValue;
585 if Assigned(AValue) then
586 GetNativeListBox.OnDrawItem := DoDrawItemNative
587 else GetNativeListBox.OnDrawItem := nil;
588end;
589
590procedure TListBox.SetOnSelectionChange(AValue: TSelectionChangeEvent);
591begin
592 GetNativeListBox.OnSelectionChange := AValue;
593end;
594
595procedure TListBox.SetParentFont(AValue: Boolean);
596begin
597 GetNativeListBox.ParentFont := AValue;
598end;
599
600procedure TListBox.SetScrollWidth(AValue: Integer);
601begin
602 GetNativeListBox.ScrollWidth := AValue;
603end;
604
605procedure TListBox.SetStyle(AValue: TListBoxStyle);
606begin
607 GetNativeListBox.Style := AValue;
608end;
609
610procedure TListBox.SetTopIndex(AValue: Integer);
611begin
612 GetNativeListBox.TopIndex := AValue;
613end;
614
615procedure TListBox.DoDrawItemNative(Control: Controls.TWinControl;
616 Index: Integer; ARect: TRect; State: TOwnerDrawState);
617begin
618 if Assigned(FOnDrawItem) then
619 FOnDrawItem(Self, Index, ScaleRectFromNative(ARect), State);
620end;
621
622function TListBox.GetNativeWinControl: Controls.TWinControl;
623begin
624 Result := GetNativeListBox;
625end;
626
627function TListBox.GetNativeListBox: StdCtrls.TListBox;
628begin
629 if not Assigned(NativeListBox) then NativeListBox := StdCtrls.TListBox.Create(nil);
630 Result := NativeListBox;
631end;
632
633constructor TListBox.Create(AOwner: TComponent);
634begin
635 inherited;
636 FCanvas := TCanvas.Create;
637 FCanvas.NativeCanvas := GetNativeListBox.Canvas;
638end;
639
640destructor TListBox.Destroy;
641begin
642 FreeAndNil(FCanvas);
643 FreeAndNil(NativeListBox);
644 inherited;
645end;
646
647
648initialization
649
650RegisterClasses([TButton]);
651
652end.
653
Note: See TracBrowser for help on using the repository browser.