← Back to branch summary

~ubuntu-branches/ubuntu/vivid/lazarus/vivid

« back to all changes in this revision

Viewing changes to components/ideintf/graphpropedits.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Paul Gevers
  • Date: 2014-02-22 10:25:57 UTC
  • mfrom: (1.1.11)
  • Revision ID: package-import@ubuntu.com-20140222102557-ors9d31r84nz31jq
Tags: 1.2~rc2+dfsg-1
http://bugs.debian.org/724776
[ Abou Al Montacir ]
* New upstream pre-release.
  + Moved ideintf to components directory.
  + Added new package cairocanvas.
* Remove usage of depreciated parameters form of find. (Closes: Bug#724776)
* Bumped standard version to 3.9.5.
* Clean the way handling make files generation and removal.

[ Paul Gevers ]
* Remove nearly obsolete bzip compression for binary packages
  (See https://lists.debian.org/debian-devel/2014/01/msg00542.html)
* Update d/copyright for newly added dir in examples and components
* Update Vcs-* fields with new packaging location
* Update d/watch file to properly (Debian way) change upstreams versions
* Prevent 46MB of package size by sym linking duplicate files
* Patches
  - refresh to remove fuzz
  - add more Lintian found spelling errors
  - new patch to add shbang to two scripts in lazarus-src
* Drop lcl-# from Provides list of lcl-units-#
* Make lazarus-ide-qt4-# an arch all until it really contains stuff
* Make all metapackages arch all as the usecase for arch any doesn't
  seem to warrant the addition archive hit
* Fix permissions of non-scripts in lazarus-src-#

Show diffs side-by-side

added added

removed removed

Lines of Context:
components/ideintf/graphpropedits.pas
 
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 units 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, LCLProc, Forms, Controls, LCLType, GraphType,
 
20
  FileUtil, Graphics, StdCtrls, Buttons, ComCtrls, Menus, ExtCtrls, Dialogs,
 
21
  LCLIntf, ExtDlgs, PropEdits, PropEditUtils, ImgList, Math,
 
22
  GraphicPropEdit; // defines TGraphicPropertyEditorForm
 
23
 
 
24
type
 
25
{ TGraphicPropertyEditor
 
26
  The default property editor for all TGraphic's and sub types (e.g. TBitmap,
 
27
  TPixmap, TIcon, etc.). }
 
28
 
 
29
  TGraphicPropertyEditor = class(TClassPropertyEditor)
 
30
  public
 
31
    procedure Edit; override;
 
32
    function GetAttributes: TPropertyAttributes; override;
 
33
  end;
 
34
 
 
35
{ TPicturePropertyEditor
 
36
  The default property editor for TPicture}
 
37
 
 
38
  TPicturePropertyEditor = class(TGraphicPropertyEditor)
 
39
  public
 
40
    procedure Edit; override;
 
41
  end;
 
42
 
 
43
{ TButtonGlyphPropEditor
 
44
  The default property editor for the Glyphs of TSpeedButton and TBitBtn }
 
45
  TButtonGlyphPropEditor = class(TGraphicPropertyEditor)
 
46
  public
 
47
    procedure Edit; override;
 
48
  end;
 
49
 
 
50
{ TColorPropertyEditor
 
51
  PropertyEditor editor for the TColor type. Displays the color as a clXXX value
 
52
  if one exists, otherwise displays the value as hex.  Also allows the
 
53
  clXXX value to be picked from a list. }
 
54
 
 
55
  TColorPropertyEditor = class(TIntegerPropertyEditor)
 
56
  public
 
57
    procedure Edit; override;
 
58
    function GetAttributes: TPropertyAttributes; override;
 
59
    function OrdValueToVisualValue(OrdValue: longint): string; override;
 
60
    procedure GetValues(Proc: TGetStrProc); override;
 
61
    procedure SetValue(const NewValue: ansistring); override;
 
62
    procedure ListMeasureWidth(const CurValue: ansistring; Index: integer;
 
63
      ACanvas: TCanvas; var AWidth: Integer);  override;
 
64
    procedure ListDrawValue(const CurValue: ansistring; Index: integer;
 
65
      ACanvas: TCanvas; const ARect:TRect; AState: TPropEditDrawState); override;
 
66
    procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect;
 
67
      AState: TPropEditDrawState); override;
 
68
  end;
 
69
 
 
70
{ TBrushStylePropertyEditor
 
71
  PropertyEditor editor for TBrush's Style. Provides custom render. }
 
72
 
 
73
  TBrushStylePropertyEditor = class(TEnumPropertyEditor)
 
74
  public
 
75
    function GetAttributes: TPropertyAttributes; override;
 
76
    procedure ListMeasureWidth(const CurValue: ansistring; Index:integer;
 
77
      ACanvas: TCanvas;  var AWidth: Integer); override;
 
78
    procedure ListDrawValue(const CurValue: ansistring; Index:integer;
 
79
      ACanvas: TCanvas;  const ARect: TRect; AState: TPropEditDrawState); override;
 
80
    procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect;
 
81
      AState: TPropEditDrawState); override;
 
82
  end;
 
83
 
 
84
{ TPenStylePropertyEditor
 
85
  PropertyEditor editor for TPen's Style. Simply provides custom render. }
 
86
 
 
87
  TPenStylePropertyEditor = class(TEnumPropertyEditor)
 
88
  public
 
89
    function GetAttributes: TPropertyAttributes; override;
 
90
    procedure ListMeasureWidth(const CurValue: ansistring; Index:integer;
 
91
      ACanvas: TCanvas;  var AWidth: Integer); override;
 
92
    procedure ListDrawValue(const CurValue: ansistring; Index:integer;
 
93
      ACanvas: TCanvas;  const ARect: TRect; AState: TPropEditDrawState); override;
 
94
    procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect;
 
95
      AState:TPropEditDrawState); override;
 
96
  end;
 
97
 
 
98
{ TFontPropertyEditor
 
99
  PropertyEditor editor for the Font property.
 
100
  Brings up the font dialog as well as allowing the properties of the object to
 
101
  be edited. }
 
102
 
 
103
  TFontPropertyEditor = class(TClassPropertyEditor)
 
104
  public
 
105
    procedure Edit; override;
 
106
    function GetAttributes: TPropertyAttributes; override;
 
107
  end;
 
108
 
 
109
{ TFontNamePropertyEditor
 
110
  PropertyEditor editor for TFont.Name. Simply provides listing font names. }
 
111
 
 
112
  TFontNamePropertyEditor = class(TStringPropertyEditor)
 
113
  public
 
114
    function GetAttributes: TPropertyAttributes; override;
 
115
    procedure GetValues(Proc: TGetStrProc); override;
 
116
  end;
 
117
 
 
118
{ TFontCharsetPropertyEditor
 
119
  PropertyEditor editor for the TFontCharset properties.
 
120
  Displays Charset as constant name if exists, otherwise an integer. }
 
121
 
 
122
  TFontCharsetPropertyEditor = class(TIntegerPropertyEditor)
 
123
  public
 
124
    function GetAttributes: TPropertyAttributes; override;
 
125
    function OrdValueToVisualValue(OrdValue: longint): string; override;
 
126
    procedure GetValues(Proc: TGetStrProc); override;
 
127
    procedure SetValue(const NewValue: ansistring); override;
 
128
  end;
 
129
 
 
130
{ TImageIndexPropertyEditor
 
131
  PropertyEditor editor for ImageIndex. Provides list of glyphs. }
 
132
 
 
133
  TImageIndexPropertyEditor = class(TIntegerPropertyEditor)
 
134
  protected
 
135
    function GetImageList: TCustomImageList; virtual;
 
136
  public
 
137
    function GetAttributes: TPropertyAttributes; override;
 
138
    procedure GetValues(Proc: TGetStrProc); override;
 
139
    procedure ListMeasureHeight(const AValue: ansistring; Index:integer;
 
140
      ACanvas:TCanvas; var AHeight: Integer); override;
 
141
    procedure ListDrawValue(const CurValue: ansistring; Index:integer;
 
142
      ACanvas: TCanvas;  const ARect: TRect; AState: TPropEditDrawState); override;
 
143
  end;
 
144
 
 
145
//==============================================================================
 
146
// Delphi Compatible Property Editor Classnames
 
147
 
 
148
type
 
149
  TFontNameProperty =       TFontNamePropertyEditor;
 
150
  //TFontCharsetProperty =    TFontCharsetPropertyEditor;
 
151
  TColorProperty =          TColorPropertyEditor;
 
152
  TBrushStyleProperty =     TBrushStylePropertyEditor;
 
153
  TPenStyleProperty =       TPenStylePropertyEditor;
 
154
  TFontProperty =           TFontPropertyEditor;
 
155
 
 
156
implementation
 
157
 
 
158
{ TGraphicPropertyEditor }
 
159
 
 
160
procedure TGraphicPropertyEditor.Edit;
 
161
var
 
162
  TheDialog: TGraphicPropertyEditorForm;
 
163
  AGraphic: TGraphic;
 
164
  FreeGraphic: Boolean;
 
165
begin
 
166
  AGraphic := TGraphic(GetObjectValue(TGraphic));
 
167
  TheDialog := TGraphicPropertyEditorForm.Create(nil);
 
168
  FreeGraphic:=false;
 
169
  try
 
170
    TheDialog.CaptionDetail := GetComponent(0).GetNamePath + '.' + GetName();
 
171
    if (AGraphic <> nil) then
 
172
      TheDialog.Graphic := AGraphic;
 
173
 
 
174
    if (TheDialog.ShowModal = mrOK) and TheDialog.Modified then
 
175
    begin
 
176
      if (TheDialog.Graphic <> nil) and (not TheDialog.Graphic.Empty) then
 
177
      begin
 
178
        if AGraphic = nil then
 
179
        begin
 
180
          AGraphic := TGraphicClass(GetTypeData(GetPropType)^.ClassType).Create;
 
181
          FreeGraphic := True;
 
182
        end;
 
183
 
 
184
        AGraphic.Assign(TheDialog.Graphic);
 
185
 
 
186
        if (AGraphic.ClassType = TheDialog.Graphic.ClassType)
 
187
          and not AGraphic.Equals(TheDialog.Graphic) then
 
188
        begin
 
189
          if (TheDialog.FileName <> '') and FileExistsUTF8(TheDialog.FileName) then
 
190
          begin
 
191
            AGraphic.LoadFromFile(TheDialog.FileName);
 
192
            //MessageDlg('Differences detected, file reloaded', mtInformation, [mbOK], 0);
 
193
          end
 
194
          else
 
195
            //MessageDlg('Image may be different', mtWarning, [mbOK], 0);
 
196
        end;
 
197
 
 
198
        SetPtrValue(AGraphic);
 
199
      end
 
200
      else
 
201
      if AGraphic <> nil then
 
202
        AGraphic.Clear;
 
203
      Modified;
 
204
    end;
 
205
  finally
 
206
    if FreeGraphic then
 
207
      AGraphic.Free;
 
208
    TheDialog.Free;
 
209
  end;
 
210
end;
 
211
 
 
212
function TGraphicPropertyEditor.GetAttributes: TPropertyAttributes;
 
213
begin
 
214
  Result := [paDialog, paRevertable, paReadOnly];
 
215
end;
 
216
 
 
217
{ TPicturePropertyEditor }
 
218
 
 
219
procedure TPicturePropertyEditor.Edit;
 
220
 
 
221
  procedure AddPackage(Picture: TPicture);
 
222
  begin
 
223
    if Picture.Graphic=nil then exit;
 
224
    //DebugLn(['AddPackage ',dbgsname(Picture.Graphic)]);
 
225
    GlobalDesignHook.AddDependency(Picture.Graphic.ClassType,'');
 
226
  end;
 
227
 
 
228
var
 
229
  TheDialog: TGraphicPropertyEditorForm;
 
230
  Picture: TPicture;
 
231
begin
 
232
  Picture := TPicture(GetObjectValue(TPicture));
 
233
  TheDialog := TGraphicPropertyEditorForm.Create(nil);
 
234
  try
 
235
    TheDialog.CaptionDetail := GetComponent(0).GetNamePath + '.' + GetName();
 
236
    if (Picture.Graphic <> nil) then
 
237
      TheDialog.Graphic := Picture.Graphic;
 
238
    if (TheDialog.ShowModal = mrOK) and TheDialog.Modified then
 
239
    begin
 
240
      if TheDialog.Graphic <> nil then
 
241
      begin
 
242
        Picture.Graphic := TheDialog.Graphic;
 
243
        if not Picture.Graphic.Equals(TheDialog.Graphic) then
 
244
        begin
 
245
          if (TheDialog.FileName <> '') and FileExistsUTF8(TheDialog.FileName) then
 
246
          begin
 
247
            Picture.LoadFromFile(TheDialog.FileName);
 
248
            //MessageDlg('Differences detected, file reloaded', mtInformation, [mbOK], 0);
 
249
          end
 
250
          else
 
251
            //MessageDlg('Image may be different', mtWarning, [mbOK], 0);
 
252
        end;
 
253
        AddPackage(Picture);
 
254
      end
 
255
      else
 
256
        Picture.Graphic := nil;
 
257
      Modified;
 
258
    end;
 
259
  finally
 
260
    TheDialog.Free;
 
261
  end;
 
262
end;
 
263
 
 
264
{ TButtonGlyphPropEditor }
 
265
 
 
266
procedure TButtonGlyphPropEditor.Edit;
 
267
var
 
268
  TheDialog: TGraphicPropertyEditorForm;
 
269
  ABitmap: TBitmap;
 
270
begin
 
271
  ABitmap := TBitmap(GetObjectValue(TBitmap));
 
272
  TheDialog := TGraphicPropertyEditorForm.Create(nil);
 
273
  try
 
274
    TheDialog.CaptionDetail := GetComponent(0).GetNamePath + '.' + GetName();
 
275
    if not ABitmap.Empty then
 
276
      TheDialog.Graphic := ABitmap;
 
277
    if (TheDialog.ShowModal = mrOK) and TheDialog.Modified then
 
278
    begin
 
279
      ABitmap.Assign(TheDialog.Graphic);
 
280
      Modified;
 
281
    end;
 
282
  finally
 
283
    TheDialog.Free;
 
284
  end;
 
285
end;
 
286
 
 
287
{ TColorPropertyEditor }
 
288
 
 
289
procedure TColorPropertyEditor.Edit;
 
290
var
 
291
  ColorDialog: TColorDialog;
 
292
begin
 
293
  ColorDialog := TColorDialog.Create(nil);
 
294
  try
 
295
    ColorDialog.Color := GetOrdValue;
 
296
    if ColorDialog.Execute then
 
297
      SetOrdValue(ColorDialog.Color);
 
298
  finally
 
299
    ColorDialog.Free;
 
300
  end;
 
301
end;
 
302
 
 
303
function TColorPropertyEditor.GetAttributes: TPropertyAttributes;
 
304
begin
 
305
  Result := [paMultiSelect,paDialog,paValueList,paCustomDrawn,paRevertable];
 
306
  if GetDefaultOrdValue <> NoDefaultValue then
 
307
    Result := Result + [paHasDefaultValue];
 
308
end;
 
309
 
 
310
function TColorPropertyEditor.OrdValueToVisualValue(OrdValue: longint): string;
 
311
begin
 
312
  Result := ColorToString(TColor(OrdValue));
 
313
end;
 
314
 
 
315
procedure TColorPropertyEditor.GetValues(Proc: TGetStrProc);
 
316
var
 
317
  CValue: Longint;
 
318
begin
 
319
  if not IdentToColor(GetVisualValue, CValue) then Proc(GetVisualValue);
 
320
  GetColorValues(Proc);
 
321
end;
 
322
 
 
323
procedure TColorPropertyEditor.PropDrawValue(ACanvas:TCanvas; const ARect:TRect;
 
324
  AState:TPropEditDrawState);
 
325
begin
 
326
  if GetVisualValue <> '' then
 
327
    ListDrawValue(GetVisualValue, -1, ACanvas, ARect, [pedsInEdit])
 
328
  else
 
329
    inherited PropDrawValue(ACanvas, ARect, AState);
 
330
end;
 
331
 
 
332
procedure TColorPropertyEditor.ListDrawValue(const CurValue:ansistring;
 
333
  Index:integer; ACanvas:TCanvas;  const ARect:TRect;
 
334
  AState: TPropEditDrawState);
 
335
 
 
336
  function ColorToBorderColor(AColor: TColorRef): TColor;
 
337
  type
 
338
    TColorQuad = record
 
339
      Red,
 
340
      Green,
 
341
      Blue,
 
342
      Alpha: Byte;
 
343
    end;
 
344
  begin
 
345
    if (TColorQuad(AColor).Red > 192) or
 
346
       (TColorQuad(AColor).Green > 192) or
 
347
       (TColorQuad(AColor).Blue > 192) then
 
348
      Result := clBlack
 
349
    else
 
350
      if pedsInEdit in AState then
 
351
      begin
 
352
        if pedsSelected in AState then
 
353
          Result := clWindow
 
354
        else
 
355
         Result := TColor(AColor);
 
356
      end else
 
357
      begin
 
358
        if pedsSelected in AState then
 
359
          Result := clHighlight
 
360
        else
 
361
         Result := clWindow;
 
362
      end;
 
363
  end;
 
364
var
 
365
  vRight, vBottom: Integer;
 
366
  vOldPenColor, vOldBrushColor: TColor;
 
367
  vOldPenStyle: TPenStyle;
 
368
begin
 
369
  vRight := (ARect.Bottom - ARect.Top) + ARect.Left - 2;
 
370
  vBottom:=ARect.Bottom-2;
 
371
  with ACanvas do
 
372
  begin
 
373
    // save off things
 
374
    vOldPenStyle := Pen.Style;
 
375
    vOldPenColor := Pen.Color;
 
376
    vOldBrushColor := Brush.Color;
 
377
 
 
378
    // frame things
 
379
    if pedsInEdit in AState then
 
380
    begin
 
381
      if pedsSelected in AState then
 
382
        Brush.Color := clWindow
 
383
      else
 
384
        Brush.Color := ACanvas.Brush.Color;
 
385
    end
 
386
    else
 
387
    begin
 
388
      if pedsSelected in AState then
 
389
        Brush.Color := clHighlightText
 
390
      else
 
391
       Brush.Color := clWindow;
 
392
    end;
 
393
    Pen.Color := Brush.Color;
 
394
    Pen.Style := psSolid;
 
395
    FillRect(ARect);
 
396
    Rectangle(ARect.Left, ARect.Top, vRight, vBottom);
 
397
 
 
398
    // set things up and do the work
 
399
    Brush.Color := StringToColorDef(CurValue,clNone);
 
400
    Pen.Color := ColorToBorderColor(ColorToRGB(Brush.Color));
 
401
    Rectangle(ARect.Left + 1, ARect.Top + 1, vRight - 1, vBottom - 1);
 
402
    
 
403
    // restore the things we twiddled with
 
404
    Brush.Color := vOldBrushColor;
 
405
    Pen.Color := vOldPenColor;
 
406
    Pen.Style := vOldPenStyle;
 
407
  end;
 
408
  inherited ListDrawValue(CurValue, Index, ACanvas,
 
409
                          Rect(vRight, ARect.Top, ARect.Right, ARect.Bottom),
 
410
                          AState);
 
411
end;
 
412
 
 
413
procedure TColorPropertyEditor.ListMeasureWidth(const CurValue:ansistring;
 
414
  Index:integer; ACanvas:TCanvas;  var AWidth:Integer);
 
415
begin
 
416
  AWidth := ACanvas.TextWidth('clGradientInactiveCaption')+25;
 
417
end;
 
418
 
 
419
procedure TColorPropertyEditor.SetValue(const NewValue: ansistring);
 
420
var
 
421
  CValue: Longint;
 
422
begin
 
423
  if IdentToColor(NewValue, CValue) then
 
424
    SetOrdValue(CValue)
 
425
  else
 
426
    inherited SetValue(NewValue);
 
427
end;
 
428
 
 
429
function TFontNamePropertyEditor.GetAttributes: TPropertyAttributes;
 
430
begin
 
431
  Result := [paMultiSelect, paValueList, paRevertable];
 
432
end;
 
433
 
 
434
procedure TFontNamePropertyEditor.GetValues(Proc: TGetStrProc);
 
435
var
 
436
  I: Integer;
 
437
begin
 
438
  for I := 0 to Screen.Fonts.Count -1 do
 
439
    Proc(Screen.Fonts[I]);
 
440
end;
 
441
 
 
442
{ TFontCharsetPropertyEditor }
 
443
 
 
444
function TFontCharsetPropertyEditor.GetAttributes: TPropertyAttributes;
 
445
begin
 
446
  Result:=[paMultiSelect,paSortList,paValueList,paRevertable,paHasDefaultValue];
 
447
end;
 
448
 
 
449
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
 
 
553
function TBrushStylePropertyEditor.GetAttributes: TPropertyAttributes;
 
554
begin
 
555
  Result:=(inherited GetAttributes)-[paHasDefaultValue]+[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
 
 
623
function TPenStylePropertyEditor.GetAttributes: TPropertyAttributes;
 
624
begin
 
625
  Result:=(inherited GetAttributes)-[paHasDefaultValue]+[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
 
 
650
function TFontPropertyEditor.GetAttributes: TPropertyAttributes;
 
651
begin
 
652
  Result := [paMultiSelect, paSubProperties, paDialog, paReadOnly];
 
653
end;
 
654
 
 
655
 
 
656
//------------------------------------------------------------------------------
 
657
 
 
658
{ TImageIndexPropertyEditor }
 
659
 
 
660
function TImageIndexPropertyEditor.GetImageList: TCustomImageList;
 
661
var
 
662
  Persistent: TPersistent;
 
663
  Component: TComponent absolute Persistent;
 
664
  PropInfo: PPropInfo;
 
665
  Obj: TObject;
 
666
begin
 
667
  Result := nil;
 
668
  Persistent := GetComponent(0);
 
669
  if not (Persistent is TComponent) then
 
670
    Exit;
 
671
 
 
672
  if Component is TMenuItem then
 
673
  begin
 
674
    Component := Component.GetParentComponent;
 
675
    while (Component <> nil) do
 
676
    begin
 
677
      if (Component is TMenuItem) and (TMenuItem(Component).SubMenuImages <> nil) then
 
678
        Exit(TMenuItem(Component).SubMenuImages);
 
679
      if (Component is TMenu) then
 
680
        Exit(TMenu(Component).Images);
 
681
      Component := Component.GetParentComponent;
 
682
    end;
 
683
  end
 
684
  else
 
685
  begin
 
686
    Component := Component.GetParentComponent;
 
687
    if Component = nil then
 
688
      Exit;
 
689
    PropInfo := TypInfo.GetPropInfo(Component, 'Images');
 
690
    if PropInfo = nil then
 
691
      Exit;
 
692
    Obj := GetObjectProp(Component, PropInfo);
 
693
    if Obj is TCustomImageList then
 
694
      Exit(TCustomImageList(Obj));
 
695
  end;
 
696
end;
 
697
 
 
698
function TImageIndexPropertyEditor.GetAttributes: TPropertyAttributes;
 
699
begin
 
700
  Result := [paValueList, paCustomDrawn, paRevertable];
 
701
  if GetDefaultOrdValue <> NoDefaultValue then
 
702
    Result := Result + [paHasDefaultValue];
 
703
end;
 
704
 
 
705
procedure TImageIndexPropertyEditor.GetValues(Proc: TGetStrProc);
 
706
var
 
707
  Images: TCustomImageList;
 
708
  I: Integer;
 
709
begin
 
710
  Proc(IntToStr(GetDefaultOrdValue));
 
711
  Images := GetImageList;
 
712
  if Assigned(Images) then
 
713
    for I := 0 to Images.Count - 1 do
 
714
      Proc(IntToStr(I));
 
715
end;
 
716
 
 
717
procedure TImageIndexPropertyEditor.ListMeasureHeight(const AValue: ansistring;
 
718
  Index: integer; ACanvas: TCanvas; var AHeight: Integer);
 
719
var
 
720
  Images: TCustomImageList;
 
721
begin
 
722
  AHeight := ACanvas.TextHeight('1');
 
723
  Images := GetImageList;
 
724
  if Assigned(Images) then
 
725
    AHeight := Max(AHeight, Images.Height + 2);
 
726
end;
 
727
 
 
728
procedure TImageIndexPropertyEditor.ListDrawValue(const CurValue: ansistring;
 
729
  Index: integer; ACanvas: TCanvas; const ARect: TRect; AState: TPropEditDrawState);
 
730
var
 
731
  Images: TCustomImageList;
 
732
  R: TRect;
 
733
  OldColor: TColor;
 
734
begin
 
735
  Dec(Index);
 
736
  Images := GetImageList;
 
737
  R := ARect;
 
738
  if Assigned(Images) then
 
739
  begin
 
740
    if (pedsInComboList in AState) and not (pedsInEdit in AState) then
 
741
    begin
 
742
      OldColor := ACanvas.Brush.Color;
 
743
      if pedsSelected in AState then
 
744
        ACanvas.Brush.Color := clHighlight
 
745
      else
 
746
        ACanvas.Brush.Color := clWhite;
 
747
      ACanvas.FillRect(R);
 
748
      ACanvas.Brush.Color := OldColor;
 
749
    end;
 
750
 
 
751
    Images.Draw(ACanvas, R.Left + 1, R.Top + 1, Index, True);
 
752
    R.Left := R.Left + Images.Width + 2;
 
753
  end;
 
754
  inherited ListDrawValue(CurValue, Index, ACanvas, R, AState);
 
755
end;
 
756
 
 
757
initialization
 
758
  RegisterPropertyEditor(TypeInfo(TGraphicsColor), nil, '', TColorPropertyEditor);
 
759
  RegisterPropertyEditor(TypeInfo(TPenStyle), nil, '', TPenStylePropertyEditor);
 
760
  RegisterPropertyEditor(TypeInfo(TBrushStyle), nil, '', TBrushStylePropertyEditor);
 
761
  RegisterPropertyEditor(TypeInfo(AnsiString), TFont, 'Name', TFontNamePropertyEditor);
 
762
  RegisterPropertyEditor(TypeInfo(TFontCharset), nil, 'CharSet', TFontCharsetPropertyEditor);
 
763
  RegisterPropertyEditor(TypeInfo(TImageIndex), TComponent, 'ImageIndex', TImageIndexPropertyEditor);
 
764
  RegisterPropertyEditor(ClassTypeInfo(TFont), nil,'',TFontPropertyEditor);
 
765
  RegisterPropertyEditor(ClassTypeInfo(TGraphic), nil,'',TGraphicPropertyEditor);
 
766
  RegisterPropertyEditor(ClassTypeInfo(TPicture), nil,'',TPicturePropertyEditor);
 
767
  RegisterPropertyEditor(ClassTypeInfo(TBitmap), TSpeedButton,'Glyph', TButtonGlyphPropEditor);
 
768
  RegisterPropertyEditor(ClassTypeInfo(TBitmap), TBitBtn,'Glyph', TButtonGlyphPropEditor);
 
769
 
 
770
end.
 
771