1 {
2 *****************************************************************************
3 See the file COPYING.modifiedLGPL.txt, included in this distribution,
4 for details about the license.
5 *****************************************************************************
6
7 Author: Andrew Johnson, Mattias Gaertner
8
9 Abstract:
10 This unit defines the property editors for graphic types.
11 }
12 unit GraphPropEdits;
13
14 {$mode objfpc}{$H+}
15
16 interface
17
18 uses
19 Classes, TypInfo, SysUtils, Math,
20 // LCL
21 LCLType, Forms, Graphics, Buttons, Menus, Dialogs, Grids, ImgList, EditBtn,
22 // LazUtils
23 GraphType, UITypes, LazFileUtils,
24 // IdeIntf
25 PropEdits, GraphicPropEdit; // defines TGraphicPropertyEditorForm
26
27 type
28 { TGraphicPropertyEditor
29 The default property editor for all TGraphic's and sub types (e.g. TBitmap,
30 TPixmap, TIcon, etc.). }
31
32 TGraphicPropertyEditor = class(TClassPropertyEditor)
33 public
34 procedure Edit; override;
GetAttributesnull35 function GetAttributes: TPropertyAttributes; override;
36 end;
37
38 { TPicturePropertyEditor
39 The default property editor for TPicture}
40
41 TPicturePropertyEditor = class(TGraphicPropertyEditor)
42 public
43 procedure Edit; override;
44 end;
45
46 { TButtonGlyphPropEditor
47 The default property editor for the Glyphs of TSpeedButton and TBitBtn }
48 TButtonGlyphPropEditor = class(TGraphicPropertyEditor)
49 public
50 procedure Edit; override;
51 end;
52
53 { TColorPropertyEditor
54 PropertyEditor editor for the TColor type. Displays the color as a clXXX value
55 if one exists, otherwise displays the value as hex. Also allows the
56 clXXX value to be picked from a list. }
57
58 TColorPropertyEditor = class(TIntegerPropertyEditor)
59 public
60 procedure Edit; override;
GetAttributesnull61 function GetAttributes: TPropertyAttributes; override;
OrdValueToVisualValuenull62 function OrdValueToVisualValue(OrdValue: longint): string; override;
63 procedure GetValues(Proc: TGetStrProc); override;
64 procedure SetValue(const NewValue: ansistring); override;
65 procedure ListMeasureWidth(const {%H-}CurValue: ansistring; {%H-}Index: integer;
66 ACanvas: TCanvas; var AWidth: Integer); override;
67 procedure ListDrawValue(const CurValue: ansistring; Index: integer;
68 ACanvas: TCanvas; const ARect:TRect; AState: TPropEditDrawState); override;
69 procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect;
70 AState: TPropEditDrawState); override;
71 end;
72
73 { TBrushStylePropertyEditor
74 PropertyEditor editor for TBrush's Style. Provides custom render. }
75
76 TBrushStylePropertyEditor = class(TEnumPropertyEditor)
77 public
GetAttributesnull78 function GetAttributes: TPropertyAttributes; override;
79 procedure ListMeasureWidth(const {%H-}CurValue: ansistring; {%H-}Index:integer;
80 {%H-}ACanvas: TCanvas; var AWidth: Integer); override;
81 procedure ListDrawValue(const CurValue: ansistring; Index:integer;
82 ACanvas: TCanvas; const ARect: TRect; AState: TPropEditDrawState); override;
83 procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect;
84 AState: TPropEditDrawState); override;
85 end;
86
87 { TPenStylePropertyEditor
88 PropertyEditor editor for TPen's Style. Simply provides custom render. }
89
90 TPenStylePropertyEditor = class(TEnumPropertyEditor)
91 public
GetAttributesnull92 function GetAttributes: TPropertyAttributes; override;
93 procedure ListMeasureWidth(const {%H-}CurValue: ansistring; {%H-}Index:integer;
94 {%H-}ACanvas: TCanvas; var AWidth: Integer); override;
95 procedure ListDrawValue(const CurValue: ansistring; {%H-}Index:integer;
96 ACanvas: TCanvas; const ARect: TRect; AState: TPropEditDrawState); override;
97 procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect;
98 AState:TPropEditDrawState); override;
99 end;
100
101 { TFontPropertyEditor
102 PropertyEditor editor for the Font property.
103 Brings up the font dialog as well as allowing the properties of the object to
104 be edited. }
105
106 TFontPropertyEditor = class(TClassPropertyEditor)
107 public
108 procedure Edit; override;
GetAttributesnull109 function GetAttributes: TPropertyAttributes; override;
110 end;
111
112 { TFontNamePropertyEditor
113 PropertyEditor editor for TFont.Name. Simply provides listing font names. }
114
115 TFontNamePropertyEditor = class(TStringPropertyEditor)
116 public
GetAttributesnull117 function GetAttributes: TPropertyAttributes; override;
118 procedure GetValues(Proc: TGetStrProc); override;
119 end;
120
121 { TFontCharsetPropertyEditor
122 PropertyEditor editor for the TFontCharset properties.
123 Displays Charset as constant name if exists, otherwise an integer. }
124
125 TFontCharsetPropertyEditor = class(TIntegerPropertyEditor)
126 public
GetAttributesnull127 function GetAttributes: TPropertyAttributes; override;
OrdValueToVisualValuenull128 function OrdValueToVisualValue(OrdValue: longint): string; override;
129 procedure GetValues(Proc: TGetStrProc); override;
130 procedure SetValue(const NewValue: ansistring); override;
131 end;
132
133 { TImageIndexPropertyEditor
134 PropertyEditor editor for ImageIndex. Provides list of glyphs. }
135
136 TImageIndexPropertyEditor = class(TIntegerPropertyEditor)
137 protected
GetImageListnull138 function GetImageList: TCustomImageList; virtual;
139 public
GetAttributesnull140 function GetAttributes: TPropertyAttributes; override;
141 procedure GetValues(Proc: TGetStrProc); override;
142 procedure ListMeasureHeight(const {%H-}AValue: ansistring; {%H-}Index:integer;
143 ACanvas:TCanvas; var AHeight: Integer); override;
144 procedure ListDrawValue(const CurValue: ansistring; Index:integer;
145 ACanvas: TCanvas; const ARect: TRect; AState: TPropEditDrawState); override;
146 end;
147
148 { TGridImageIndexPropertyEditor
149 ImageIndex property editor specialized for a grid's title and sort images. }
150
151 TGridImageIndexPropertyEditor = class(TImageIndexPropertyEditor)
152 protected
GetImageListnull153 function GetImageList: TCustomImageList; override;
154 end;
155
156 //==============================================================================
157 // Delphi Compatible Property Editor Classnames
158
159 type
160 TFontNameProperty = TFontNamePropertyEditor;
161 //TFontCharsetProperty = TFontCharsetPropertyEditor;
162 TColorProperty = TColorPropertyEditor;
163 TBrushStyleProperty = TBrushStylePropertyEditor;
164 TPenStyleProperty = TPenStylePropertyEditor;
165 TFontProperty = TFontPropertyEditor;
166
167 implementation
168
169 { TGraphicPropertyEditor }
170
171 procedure TGraphicPropertyEditor.Edit;
172 var
173 TheDialog: TGraphicPropertyEditorForm;
174 AGraphic: TGraphic;
175 FreeGraphic: Boolean;
176 begin
177 AGraphic := TGraphic(GetObjectValue(TGraphic));
178 TheDialog := TGraphicPropertyEditorForm.Create(nil);
179 FreeGraphic:=false;
180 try
181 TheDialog.CaptionDetail := GetComponent(0).GetNamePath + '.' + GetName();
182 if (AGraphic <> nil) then
183 TheDialog.Graphic := AGraphic;
184
185 if (TheDialog.ShowModal = mrOK) and TheDialog.Modified then
186 begin
187 if (TheDialog.Graphic <> nil) and (not TheDialog.Graphic.Empty) then
188 begin
189 if AGraphic = nil then
190 begin
191 AGraphic := TGraphicClass(GetTypeData(GetPropType)^.ClassType).Create;
192 FreeGraphic := True;
193 end;
194
195 AGraphic.Assign(TheDialog.Graphic);
196
197 if (AGraphic.ClassType = TheDialog.Graphic.ClassType)
198 and not AGraphic.Equals(TheDialog.Graphic) then
199 begin
200 if (TheDialog.FileName <> '') and FileExistsUTF8(TheDialog.FileName) then
201 begin
202 AGraphic.LoadFromFile(TheDialog.FileName);
203 //MessageDlg('Differences detected, file reloaded', mtInformation, [mbOK], 0);
204 end
205 else
206 //MessageDlg('Image may be different', mtWarning, [mbOK], 0);
207 end;
208
209 SetPtrValue(AGraphic);
210 end
211 else
212 if AGraphic <> nil then
213 AGraphic.Clear;
214 Modified;
215 end;
216 finally
217 if FreeGraphic then
218 AGraphic.Free;
219 TheDialog.Free;
220 end;
221 end;
222
GetAttributesnull223 function TGraphicPropertyEditor.GetAttributes: TPropertyAttributes;
224 begin
225 Result := [paDialog, paRevertable, paReadOnly];
226 end;
227
228 { TPicturePropertyEditor }
229
230 procedure TPicturePropertyEditor.Edit;
231
232 procedure AddPackage(Picture: TPicture);
233 begin
234 if (Picture.Graphic=nil) or (GlobalDesignHook=nil) then exit;
235 //DebugLn(['AddPackage ',dbgsname(Picture.Graphic)]);
236 GlobalDesignHook.AddDependency(Picture.Graphic.ClassType,'');
237 end;
238
239 var
240 TheDialog: TGraphicPropertyEditorForm;
241 Picture: TPicture;
242 begin
243 Picture := TPicture(GetObjectValue(TPicture));
244 TheDialog := TGraphicPropertyEditorForm.Create(nil);
245 try
246 TheDialog.CaptionDetail := GetComponent(0).GetNamePath + '.' + GetName();
247 if (Picture.Graphic <> nil) then
248 TheDialog.Graphic := Picture.Graphic;
249 if (TheDialog.ShowModal = mrOK) and TheDialog.Modified then
250 begin
251 if TheDialog.Graphic <> nil then
252 begin
253 Picture.Graphic := TheDialog.Graphic;
254 if not Picture.Graphic.Equals(TheDialog.Graphic) then
255 begin
256 if (TheDialog.FileName <> '') and FileExistsUTF8(TheDialog.FileName) then
257 begin
258 Picture.LoadFromFile(TheDialog.FileName);
259 //MessageDlg('Differences detected, file reloaded', mtInformation, [mbOK], 0);
260 end
261 else
262 //MessageDlg('Image may be different', mtWarning, [mbOK], 0);
263 end;
264 AddPackage(Picture);
265 end
266 else
267 Picture.Graphic := nil;
268 Modified;
269 end;
270 finally
271 TheDialog.Free;
272 end;
273 end;
274
275 { TButtonGlyphPropEditor }
276
277 procedure TButtonGlyphPropEditor.Edit;
278 var
279 TheDialog: TGraphicPropertyEditorForm;
280 ABitmap: TBitmap;
281 begin
282 ABitmap := TBitmap(GetObjectValue(TBitmap));
283 TheDialog := TGraphicPropertyEditorForm.Create(nil);
284 try
285 TheDialog.CaptionDetail := GetComponent(0).GetNamePath + '.' + GetName();
286 if not ABitmap.Empty then
287 TheDialog.Graphic := ABitmap;
288 if (TheDialog.ShowModal = mrOK) and TheDialog.Modified then
289 begin
290 ABitmap.Assign(TheDialog.Graphic);
291 Modified;
292 end;
293 finally
294 TheDialog.Free;
295 end;
296 end;
297
298 { TColorPropertyEditor }
299
300 procedure TColorPropertyEditor.Edit;
301 var
302 ColorDialog: TColorDialog;
303 begin
304 ColorDialog := TColorDialog.Create(nil);
305 try
306 ColorDialog.Color := GetOrdValue;
307 if ColorDialog.Execute then
308 SetOrdValue(ColorDialog.Color);
309 finally
310 ColorDialog.Free;
311 end;
312 end;
313
GetAttributesnull314 function TColorPropertyEditor.GetAttributes: TPropertyAttributes;
315 begin
316 Result := [paMultiSelect,paDialog,paValueList,paCustomDrawn,paRevertable];
317 end;
318
OrdValueToVisualValuenull319 function TColorPropertyEditor.OrdValueToVisualValue(OrdValue: longint): string;
320 begin
321 Result := ColorToString(TColor(OrdValue));
322 end;
323
324 procedure TColorPropertyEditor.GetValues(Proc: TGetStrProc);
325 var
326 CValue: Longint;
327 begin
328 if not IdentToColor(GetVisualValue, CValue) then Proc(GetVisualValue);
329 GetColorValues(Proc);
330 end;
331
332 procedure TColorPropertyEditor.PropDrawValue(ACanvas:TCanvas; const ARect:TRect;
333 AState:TPropEditDrawState);
334 begin
335 if GetVisualValue <> '' then
336 ListDrawValue(GetVisualValue, -1, ACanvas, ARect, [pedsInEdit])
337 else
338 inherited PropDrawValue(ACanvas, ARect, AState);
339 end;
340
341 procedure TColorPropertyEditor.ListDrawValue(const CurValue:ansistring;
342 Index:integer; ACanvas:TCanvas; const ARect:TRect;
343 AState: TPropEditDrawState);
344
ColorToBorderColornull345 function ColorToBorderColor(AColor: TColorRef): TColor;
346 type
347 TColorQuad = record
348 Red,
349 Green,
350 Blue,
351 Alpha: Byte;
352 end;
353 begin
354 if (TColorQuad(AColor).Red > 192) or
355 (TColorQuad(AColor).Green > 192) or
356 (TColorQuad(AColor).Blue > 192) then
357 Result := clBlack
358 else
359 if pedsInEdit in AState then
360 begin
361 if pedsSelected in AState then
362 Result := clWindow
363 else
364 Result := TColor(AColor);
365 end else
366 begin
367 if pedsSelected in AState then
368 Result := clHighlight
369 else
370 Result := clWindow;
371 end;
372 end;
373 var
374 vRight, vBottom: Integer;
375 vOldPenColor, vOldBrushColor: TColor;
376 vOldPenStyle: TPenStyle;
377 noFill: Boolean;
378 begin
379 vRight := (ARect.Bottom - ARect.Top) + ARect.Left - 2;
380 vBottom:=ARect.Bottom-2;
381 with ACanvas do
382 begin
383 // save off things
384 vOldPenStyle := Pen.Style;
385 vOldPenColor := Pen.Color;
386 vOldBrushColor := Brush.Color;
387
388 // set things up and do the work
389 noFill := CurValue = 'clNone';
390 if noFill then
391 Brush.Color := clWindow
392 else
393 Brush.Color := StringToColorDef(CurValue,clNone);
394 Pen.Color := ColorToBorderColor(ColorToRGB(Brush.Color));
395 Rectangle(ARect.Left + 1, ARect.Top + 1, vRight - 1, vBottom - 1);
396 if noFill then
397 begin
398 Line(ARect.Left + 1, ARect.Top + 1, vRight - 2, vBottom - 2);
399 Line(ARect.Left + 1, vBottom - 2, vRight - 2, ARect.Top + 1);
400 end;
401
402 // restore the things we twiddled with
403 Brush.Color := vOldBrushColor;
404 Pen.Color := vOldPenColor;
405 Pen.Style := vOldPenStyle;
406 end;
407 inherited ListDrawValue(CurValue, Index, ACanvas,
408 Rect(vRight, ARect.Top, ARect.Right, ARect.Bottom),
409 AState);
410 end;
411
412 procedure TColorPropertyEditor.ListMeasureWidth(const CurValue:ansistring;
413 Index:integer; ACanvas:TCanvas; var AWidth:Integer);
414 begin
415 AWidth := ACanvas.TextWidth('clGradientInactiveCaption')+25;
416 end;
417
418 procedure TColorPropertyEditor.SetValue(const NewValue: ansistring);
419 var
420 CValue: Longint;
421 begin
422 if IdentToColor(NewValue, CValue) then
423 SetOrdValue(CValue)
424 else
425 inherited SetValue(NewValue);
426 end;
427
GetAttributesnull428 function TFontNamePropertyEditor.GetAttributes: TPropertyAttributes;
429 begin
430 Result := [paMultiSelect, paValueList, paRevertable];
431 end;
432
433 procedure TFontNamePropertyEditor.GetValues(Proc: TGetStrProc);
434 var
435 I: Integer;
436 begin
437 Proc('default');
438 for I := 0 to Screen.Fonts.Count -1 do
439 Proc(Screen.Fonts[I]);
440 end;
441
442 { TFontCharsetPropertyEditor }
443
GetAttributesnull444 function TFontCharsetPropertyEditor.GetAttributes: TPropertyAttributes;
445 begin
446 Result:=[paMultiSelect,paSortList,paValueList,paRevertable];
447 end;
448
OrdValueToVisualValuenull449 function TFontCharsetPropertyEditor.OrdValueToVisualValue(OrdValue: longint
450 ): string;
451 begin
452 Result := CharsetToString(OrdValue);
453 end;
454
455 procedure TFontCharsetPropertyEditor.GetValues(Proc: TGetStrProc);
456 begin
457 proc(CharsetToString(ANSI_CHARSET));
458 proc(CharsetToString(DEFAULT_CHARSET));
459 proc(CharsetToString(SYMBOL_CHARSET));
460 proc(CharsetToString(MAC_CHARSET));
461 proc(CharsetToString(SHIFTJIS_CHARSET));
462 proc(CharsetToString(HANGEUL_CHARSET));
463 proc(CharsetToString(JOHAB_CHARSET));
464 proc(CharsetToString(GB2312_CHARSET));
465 proc(CharsetToString(CHINESEBIG5_CHARSET));
466 proc(CharsetToString(GREEK_CHARSET));
467 proc(CharsetToString(TURKISH_CHARSET));
468 proc(CharsetToString(VIETNAMESE_CHARSET));
469 proc(CharsetToString(HEBREW_CHARSET));
470 proc(CharsetToString(ARABIC_CHARSET));
471 proc(CharsetToString(BALTIC_CHARSET));
472 proc(CharsetToString(RUSSIAN_CHARSET));
473 proc(CharsetToString(THAI_CHARSET));
474 proc(CharsetToString(EASTEUROPE_CHARSET));
475 proc(CharsetToString(OEM_CHARSET));
476 proc(CharsetToString(FCS_ISO_10646_1));
477 end;
478
479 procedure TFontCharsetPropertyEditor.SetValue(const NewValue: ansistring);
480 var
481 CValue: Longint;
482 begin
483 if not SameText(NewValue, 'DEFAULT_CHARSET') then
484 begin
485 CValue := StringToCharset(NewValue);
486 if CValue = DEFAULT_CHARSET then
487 inherited SetValue(NewValue)
488 else
489 SetOrdValue(CValue);
490 end
491 else
492 SetOrdValue(DEFAULT_CHARSET);
493 end;
494
495 { TBrushStylePropertyEditor }
496
497 procedure TBrushStylePropertyEditor.PropDrawValue(ACanvas: TCanvas;
498 const ARect: TRect; AState:TPropEditDrawState);
499 begin
500 if GetVisualValue <> '' then
501 ListDrawValue(GetVisualValue, -1, ACanvas, ARect, [pedsInEdit])
502 else
503 inherited PropDrawValue(ACanvas, ARect, AState);
504 end;
505
506 procedure TBrushStylePropertyEditor.ListDrawValue(const CurValue: ansistring;
507 Index:integer; ACanvas: TCanvas; const ARect: TRect; AState:TPropEditDrawState);
508 var
509 vRight, vBottom: Integer;
510 vOldPenColor, vOldBrushColor: TColor;
511 vOldBrushStyle: TBrushStyle;
512 begin
513 vRight := (ARect.Bottom - ARect.Top) {* 2} + ARect.Left -2;
514 vBottom:= ARect.Bottom-2;
515 with ACanvas do
516 try
517 // save off things
518 vOldPenColor := Pen.Color;
519 vOldBrushColor := Brush.Color;
520 vOldBrushStyle := Brush.Style;
521
522 // frame things
523 Pen.Color := Brush.Color;
524 Brush.Color := clWindow;
525 Rectangle(ARect.Left, ARect.Top, vRight, vBottom);
526
527 // set things up
528 Pen.Color := clWindowText;
529 Brush.Style := TBrushStyle(GetEnumValue(GetPropInfo^.PropType, CurValue));
530
531 // bsClear hack
532 if Brush.Style = bsClear then begin
533 Brush.Color := clWindow;
534 Brush.Style := bsSolid;
535 end
536 else
537 Brush.Color := clWindowText;
538
539 // ok on with the show
540 Rectangle(ARect.Left + 1, ARect.Top + 1, vRight - 1, vBottom - 1);
541
542 // restore the things we twiddled with
543 Brush.Color := vOldBrushColor;
544 Brush.Style := vOldBrushStyle;
545 Pen.Color := vOldPenColor;
546 finally
547 inherited ListDrawValue(CurValue, Index, ACanvas,
548 Rect(vRight, ARect.Top, ARect.Right, ARect.Bottom),
549 AState);
550 end;
551 end;
552
GetAttributesnull553 function TBrushStylePropertyEditor.GetAttributes: TPropertyAttributes;
554 begin
555 Result:=(inherited GetAttributes)+[paCustomDrawn];
556 end;
557
558 procedure TBrushStylePropertyEditor.ListMeasureWidth(const CurValue: ansistring;
559 Index:integer; ACanvas: TCanvas; var AWidth: Integer);
560 begin
561 AWidth := 130;
562 end;
563
564 { TPenStylePropertyEditor }
565
566 procedure TPenStylePropertyEditor.PropDrawValue(ACanvas: TCanvas;
567 const ARect: TRect; AState:TPropEditDrawState);
568 begin
569 if GetVisualValue <> '' then
570 ListDrawValue(GetVisualValue, -1, ACanvas, ARect, [pedsInEdit])
571 else
572 inherited PropDrawValue(ACanvas, ARect, AState);
573 end;
574
575 procedure TPenStylePropertyEditor.ListDrawValue(const CurValue: ansistring;
576 Index:integer; ACanvas: TCanvas;
577 const ARect: TRect; AState:TPropEditDrawState);
578 var
579 vRight, vTop, vBottom: Integer;
580 vOldPenColor, vOldBrushColor: TColor;
581 vOldPenStyle: TPenStyle;
582 i: Integer;
583 begin
584 vRight := (ARect.Bottom - ARect.Top) * 2 + ARect.Left;
585 vTop := (ARect.Bottom - ARect.Top) div 2 + ARect.Top;
586 vBottom := ARect.Bottom-2;
587 with ACanvas do
588 try
589 // save off things
590 vOldPenColor := Pen.Color;
591 vOldBrushColor := Brush.Color;
592 vOldPenStyle := Pen.Style;
593
594 // frame things
595 Pen.Color := Brush.Color;
596 Rectangle(ARect.Left, ARect.Top, vRight, vBottom);
597
598 // white out the background
599 Pen.Color := clWindowText;
600 Brush.Color := clWindow;
601 Rectangle(ARect.Left + 1, ARect.Top + 1, vRight - 1, vBottom - 1);
602
603 // set thing up and do work
604 Pen.Color := clWindowText;
605 i:=GetEnumValue(GetPropInfo^.PropType, CurValue);
606 Pen.Style := TPenStyle(i);
607 MoveTo(ARect.Left + 1, vTop);
608 LineTo(vRight - 1, vTop);
609 MoveTo(ARect.Left + 1, vTop + 1);
610 LineTo(vRight - 1, vTop + 1);
611
612 // restore the things we twiddled with
613 Brush.Color := vOldBrushColor;
614 Pen.Style := vOldPenStyle;
615 Pen.Color := vOldPenColor;
616 finally
617 inherited ListDrawValue(CurValue, -1, ACanvas,
618 Rect(vRight, ARect.Top, ARect.Right, ARect.Bottom),
619 AState);
620 end;
621 end;
622
GetAttributesnull623 function TPenStylePropertyEditor.GetAttributes: TPropertyAttributes;
624 begin
625 Result:=(inherited GetAttributes)+[paCustomDrawn];
626 end;
627
628 procedure TPenStylePropertyEditor.ListMeasureWidth(const CurValue: ansistring;
629 Index:integer; ACanvas: TCanvas; var AWidth: Integer);
630 begin
631 AWidth := 130;
632 end;
633
634 { TFontPropertyEditor }
635
636 procedure TFontPropertyEditor.Edit;
637 var FontDialog: TFontDialog;
638 begin
639 FontDialog := TFontDialog.Create(nil);
640 try
641 FontDialog.Font := TFont(GetObjectValue(TFont));
642 FontDialog.Options := FontDialog.Options + [fdShowHelp, fdForceFontExist];
643 if FontDialog.Execute then
644 SetPtrValue(FontDialog.Font);
645 finally
646 FontDialog.Free;
647 end;
648 end;
649
GetAttributesnull650 function TFontPropertyEditor.GetAttributes: TPropertyAttributes;
651 begin
652 Result := [paMultiSelect, paSubProperties, paDialog, paReadOnly];
653 end;
654
655
656 //------------------------------------------------------------------------------
657
658 { TImageIndexPropertyEditor }
659
660 type
661 TOwnedCollectionHelper = class(TOwnedCollection)
662 end;
663
TImageIndexPropertyEditor.GetImageListnull664 function TImageIndexPropertyEditor.GetImageList: TCustomImageList;
665 var
666 Persistent: TPersistent;
667 Component: TComponent absolute Persistent;
668 PropInfo: PPropInfo;
669 Obj: TObject;
670 begin
671 Result := nil;
672 Persistent := GetComponent(0);
673
674 if (Persistent is TCollectionItem) and
675 (TCollectionItem(Persistent).Collection <> nil) and
676 (TCollectionItem(Persistent).Collection is TOwnedCollection) and
677 (TOwnedCollectionHelper(TCollectionItem(Persistent).Collection).Owner <> nil) and
678 (TOwnedCollectionHelper(TCollectionItem(Persistent).Collection).Owner is TComponent) then
679 begin
680 Component := TComponent(TOwnedCollectionHelper(TCollectionItem(Persistent).Collection).Owner);
681 PropInfo := TypInfo.GetPropInfo(Component, 'Images');
682 if PropInfo = nil then
683 Exit;
684 Obj := GetObjectProp(Component, PropInfo);
685 if Obj is TCustomImageList then
686 Exit(TCustomImageList(Obj));
687 Exit;
688 end
689 else
690 if not (Persistent is TComponent) then
691 Exit;
692
693 if Component is TMenuItem then
694 begin
695 Component := Component.GetParentComponent;
696 while (Component <> nil) do
697 begin
698 if (Component is TMenuItem) and (TMenuItem(Component).SubMenuImages <> nil) then
699 Exit(TMenuItem(Component).SubMenuImages);
700 if (Component is TMenu) then
701 Exit(TMenu(Component).Images);
702 Component := Component.GetParentComponent;
703 end;
704 end
705 else
706 begin
707 if not (
708 (Component is TCustomSpeedButton)
709 or (Component is TCustomBitBtn)
710 or (Component is TCustomEditButton))
711 then
712 Component := Component.GetParentComponent;
713 if Component = nil then
714 Exit;
715 PropInfo := TypInfo.GetPropInfo(Component, 'Images');
716 if PropInfo = nil then
717 Exit;
718 Obj := GetObjectProp(Component, PropInfo);
719 if Obj is TCustomImageList then
720 Exit(TCustomImageList(Obj));
721 end;
722 end;
723
GetAttributesnull724 function TImageIndexPropertyEditor.GetAttributes: TPropertyAttributes;
725 begin
726 Result := [paValueList, paCustomDrawn, paRevertable];
727 end;
728
729 procedure TImageIndexPropertyEditor.GetValues(Proc: TGetStrProc);
730 var
731 Images: TCustomImageList;
732 I, DefValue: Integer;
733 begin
734 Proc(IntToStr(-1));
735 DefValue := GetDefaultOrdValue;
736 if (DefValue <> NoDefaultValue) and (DefValue <> -1) then
737 Proc(IntToStr(DefValue));
738 Images := GetImageList;
739 if Assigned(Images) then
740 for I := 0 to Images.Count - 1 do
741 if (I <> DefValue) then
742 Proc(IntToStr(I));
743 end;
744
745 procedure TImageIndexPropertyEditor.ListMeasureHeight(const AValue: ansistring;
746 Index: integer; ACanvas: TCanvas; var AHeight: Integer);
747 var
748 Images: TCustomImageList;
749 begin
750 AHeight := ACanvas.TextHeight('1');
751 Images := GetImageList;
752 if Assigned(Images) then
753 AHeight := Max(AHeight, Images.Height + 2);
754 end;
755
756 procedure TImageIndexPropertyEditor.ListDrawValue(const CurValue: ansistring;
757 Index: integer; ACanvas: TCanvas; const ARect: TRect; AState: TPropEditDrawState);
758 var
759 Images: TCustomImageList;
760 R: TRect;
761 dh: Integer;
762 begin
763 if GetDefaultOrdValue <> NoDefaultValue then
764 Dec(Index);
765 Images := GetImageList;
766 R := ARect;
767 dh := R.Bottom - R.Top; // Rect height.
768 if Assigned(Images) then
769 begin
770 if (pedsInComboList in AState) and not (pedsInEdit in AState) then
771 begin
772 if pedsSelected in AState then
773 ACanvas.Brush.Color := clHighlight
774 else
775 ACanvas.Brush.Color := clWhite;
776 ACanvas.FillRect(R);
777 end;
778 Images.Draw(ACanvas, R.Left + 1, R.Top + 1, Index);
779 Inc(R.Left, Images.Width + 2);
780 // The numeric value in list goes too low without an adjustment. Why?
781 Dec(R.Top, (dh - ACanvas.TextHeight(CurValue)) div 2);
782 end;
783 inherited ListDrawValue(CurValue, Index, ACanvas, R, AState);
784 end;
785
786 { TGridImageIndexPropertyEditor }
787
788 type
789 TCustomGridOpener = class(TCustomGrid);
790
TGridImageIndexPropertyEditor.GetImagelistnull791 function TGridImageIndexPropertyEditor.GetImagelist: TCustomImagelist;
792 var
793 p: TPersistent;
794 begin
795 Result := nil;
796 p := GetComponent(0);
797 if (p is TGridColumnTitle) then begin
798 p := TGridColumnTitle(p).Column;
799 if not (p is TGridColumn) then exit;
800 p := TGridColumn(p).Collection;
801 if not (p is TGridColumns) then exit;
802 p := TGridColumns(p).Grid;
803 end;
804 if p is TCustomGrid then
805 Result := TCustomGridOpener(p).TitleImageList
806 end;
807
808 initialization
809 RegisterPropertyEditor(TypeInfo(TGraphicsColor), nil, '', TColorPropertyEditor);
810 RegisterPropertyEditor(TypeInfo(TPenStyle), nil, '', TPenStylePropertyEditor);
811 RegisterPropertyEditor(TypeInfo(TBrushStyle), nil, '', TBrushStylePropertyEditor);
812 RegisterPropertyEditor(TypeInfo(AnsiString), TFont, 'Name', TFontNamePropertyEditor);
813 RegisterPropertyEditor(TypeInfo(TFontCharset), nil, 'CharSet', TFontCharsetPropertyEditor);
814 RegisterPropertyEditor(TypeInfo(TImageIndex), TPersistent, 'ImageIndex', TImageIndexPropertyEditor);
815 RegisterPropertyEditor(TypeInfo(TImageIndex), TPersistent, 'OverlayImageIndex', TImageIndexPropertyEditor);
816 RegisterPropertyEditor(TypeInfo(TImageIndex), TPersistent, 'SelectedImageIndex', TImageIndexPropertyEditor);
817 RegisterPropertyEditor(TypeInfo(TImageIndex), TGridColumnTitle, 'ImageIndex', TGridImageIndexPropertyEditor);
818 RegisterPropertyEditor(TypeInfo(TImageIndex), TCustomGrid, 'ImageIndexSortAsc', TGridImageIndexPropertyEditor);
819 RegisterPropertyEditor(TypeInfo(TImageIndex), TCustomGrid, 'ImageIndexSortDesc', TGridImageIndexPropertyEditor);
820 RegisterPropertyEditor(ClassTypeInfo(TFont), nil,'',TFontPropertyEditor);
821 RegisterPropertyEditor(ClassTypeInfo(TGraphic), nil,'',TGraphicPropertyEditor);
822 RegisterPropertyEditor(ClassTypeInfo(TPicture), nil,'',TPicturePropertyEditor);
823 RegisterPropertyEditor(ClassTypeInfo(TBitmap), TSpeedButton,'Glyph', TButtonGlyphPropEditor);
824 RegisterPropertyEditor(ClassTypeInfo(TBitmap), TBitBtn,'Glyph', TButtonGlyphPropEditor);
825
826 end.
827
828