TPropertyEditor = class
private
  FDesigner: IFormDesigner;
  FPropList: PInstPropList;
  FPropCount: Integer;
  function GetPrivateDirectory: string;
  procedure SetPropEntry(Index: Integer; AInstance: TPersistent;
    APropInfo: PPropInfo);
protected
  constructor Create(const ADesigner: IFormDesigner; APropCount: Integer); virtual;
  function GetPropInfo: PPropInfo;
  function GetFloatValue: Extended;
  function GetFloatValueAt(Index: Integer): Extended;
  function GetInt64Value: Int64;
  function GetInt64ValueAt(Index: Integer): Int64;
  function GetMethodValue: TMethod;
  function GetMethodValueAt(Index: Integer): TMethod;
  function GetOrdValue: Longint;
  function GetOrdValueAt(Index: Integer): Longint;
  function GetStrValue: string;
  function GetStrValueAt(Index: Integer): string;
  function GetVarValue: Variant;
  function GetVarValueAt(Index: Integer): Variant;
  procedure Modified; 
  procedure SetFloatValue(Value: Extended);
  procedure SetMethodValue(const Value: TMethod);
  procedure SetInt64Value(Value: Int64);
  procedure SetOrdValue(Value: Longint);
  procedure SetStrValue(const Value: string);
  procedure SetVarValue(const Value: Variant);
public
  destructor Destroy; override;
  procedure Activate; virtual;
  function AllEqual: Boolean; virtual;
  function AutoFill: Boolean; virtual;
  procedure Edit; virtual;
  function GetAttributes: TPropertyAttributes; virtual;
  function GetComponent(Index: Integer): TPersistent;
  function GetEditLimit: Integer; virtual;
  function GetName: string; virtual;
  procedure GetProperties(Proc: TGetPropEditProc); virtual;
  function GetPropType: PTypeInfo;
  function GetValue: string; virtual;
  function GetVisualValue: string;
  procedure GetValues(Proc: TGetStrProc); virtual;
  procedure Initialize; virtual;
  procedure Revert;
  procedure SetValue(const Value: string); virtual;
  function ValueAvailable: Boolean;
  procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas;
    var AWidth: Integer); dynamic;
  procedure ListMeasureHeight(const Value: string; ACanvas: TCanvas;
    var AHeight: Integer); dynamic;
  procedure ListDrawValue(const Value: string; ACanvas: TCanvas;
    const ARect: TRect; ASelected: Boolean); dynamic;
  procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect;
    ASelected: Boolean); dynamic;
  procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect;
    ASelected: Boolean); dynamic;
  property Designer: IFormDesigner read FDesigner;
  property PrivateDirectory: string read GetPrivateDirectory;
  property PropCount: Integer read FPropCount;
  property Value: string read GetValue write SetValue;
end;

TIntegerProperty = class(TOrdinalProperty)
  public
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
  end;

function TIntegerProperty.GetValue: string;
begin
  with GetTypeData(GetPropType)^ do
    if OrdType = otULong then // unsigned
      Result := IntToStr(Cardinal(GetOrdValue))
    else
      Result := IntToStr(GetOrdValue);
end;

procedure TIntegerProperty.SetValue(const Value: String);

  procedure Error(const Args: array of const);
  begin
    raise EPropertyError.CreateResFmt(@SOutOfRange, Args);
  end;

var
  L: Int64;
begin
  L := StrToInt64(Value);
  with GetTypeData(GetPropType)^ do
    if OrdType = otULong then
    begin   // unsigned compare and reporting needed
      if (L < Cardinal(MinValue)) or (L > Cardinal(MaxValue)) then
        // bump up to Int64 to get past the %d in the format string
        Error([Int64(Cardinal(MinValue)), Int64(Cardinal(MaxValue))]);
    end
    else if (L < MinValue) or (L > MaxValue) then
      Error([MinValue, MaxValue]);
  SetOrdValue(L);
end;

type
  TFontProperty = class(TClassProperty)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

procedure TFontProperty.Edit;
var
  FontDialog: TFontDialog;
begin
  FontDialog := TFontDialog.Create(Application);
  try
    FontDialog.Font := TFont(GetOrdValue);
    FontDialog.HelpContext := hcDFontEditor;
    FontDialog.Options := FontDialog.Options + [fdShowHelp, fdForceFontExist];
    if FontDialog.Execute then SetOrdValue(Longint(FontDialog.Font));
  finally
    FontDialog.Free;
  end;
end;

function TFontProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paSubProperties, paDialog, paReadOnly];
end;

type
  TFontNameProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
    { »ý·« }
  end;
  
function TFontNameProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paValueList, paSortList, paRevertable];
end;

procedure TFontNameProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
begin
  for I := 0 to Screen.Fonts.Count - 1 do Proc(Screen.Fonts[I]);
end;

procedure RegisterPropertyEditor(PropertyType: PTypeInfo; ComponentClass: TClass;
  const PropertyName: string; EditorClass: TPropertyEditorClass);

RegisterPropertyEditor(TypeInfo(string), nil, '', TdpbHintProperty);

RegisterPropertyEditor(TypeInfo(string), TControl, 'Hint', TdpbHintProperty);

RegisterPropertyEditor(TypeInfo(string), nil, '', TStringProperty);
RegisterPropertyEditor(TypeInfo(string), TAnimate, 'FileName', TMPFileNameProperty);

TdpbHintProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure Edit; override;
  end;

Procedure Tdpbhintproperty.Edit;
Begin
  With Tfrmhintpropedit.Create(Nil) Do
  Try
    If Propcount > 1 Then
      Caption := 'Hint 

procedure Register;
begin
  RegisterPropertyEditor(TypeInfo(string), TControl, 'Hint', TdpbHintProperty);
end;

const
  VERSION = '1.0';

type
  { »ý·« }
  TdpbLabel = class(TCustomLabel)
  private
    { »ý·« }
    procedure SetAbout(const Value : string);
    function  GetAbout : string;
    { »ý·« }
  published
    { Published declarations }
    property About : string read GetAbout write SetAbout stored False;
    { »ý·« }
  end;

implementation

{ TdpbLabel }
{ »ý·« }

function TdpbLabel.GetAbout: string;
begin
  Result := VERSION;
end;

procedure TdpbLabel.SetAbout(const Value: string);
begin
end;
{ »ý·« }

TdpbAboutProperty = class(TStringProperty)
  public
    procedure Edit; override;
    function GetAttributes : TPropertyAttributes; override;
    function GetValue : string; override;
  end;

function TdpbAboutProperty.GetAttributes : TPropertyAttributes;
begin
  Result := [ paDialog, paReadOnly ];
end;

function TdpbAboutProperty.GetValue : string;
begin
  Result := 'Press ... to display About dialog';
end;

procedure TdpbAboutProperty.Edit;
begin
  with TfrmAboutPropEdit.Create(nil) do
  try
    { Ŭ·¡½º À̸§°ú ¹öÀü Á¤º¸¸¦ ±¸ÇÑ´Ù }
    CompClass := GetComponent(0).ClassName;
    Version := inherited GetValue;
    Caption := CompClass + ' ¿¡ ´ëÇØ...';
    ShowModal;
  finally
    Free;
  end;
end;

procedure TfrmAboutPropEdit.FormPaint(Sender: TObject);
var
  Bmp : TBitmap;
begin
  { ÄÞÆ÷³ÍÆ®ÀÇ ÆÈ·¹Æ® ºñÆ®¸ÊÀ» ±×¸°´Ù. }
  Bmp := TBitmap.Create;
  try
    Bmp.LoadFromResourceName(hInstance, UpperCase(CompClass));
    Canvas.Brush.Color := Self.Color;
    Canvas.BrushCopy(Bounds(16, 16, 24, 24), Bmp, 
Bounds(0, 0, 24, 24), Bmp.TransparentColor);
  finally
    Bmp.Free;
  end;

  { ÄÞÆ÷³ÍÆ®ÀÇ Å¬·¡½º À̸§°ú ¹öÀüÀ» ±×¸°´Ù. }
  SetBkMode(Canvas.Handle, TRANSPARENT);
  Canvas.Font.Name := 'Times New Roman';
  Canvas.Font.Size := 16;
  Canvas.Font.Style := [fsBold];
  Canvas.Font.Color := clBtnShadow;
  Canvas.TextOut(49, 15, CompClass + ' ' + Version);
  Canvas.Font.Color := clWindow;
  Canvas.TextOut(51, 17, CompClass + ' ' + Version);
  Canvas.Font.Color := clMaroon;
  Canvas.TextOut(50, 16, CompClass + ' ' + Version);
end;

procedure Register;
begin
  RegisterComponents('DPB', [TdpbLabel]);
  RegisterPropertyEditor(TypeInfo(string), TdpbLabel, 'About', TdpbAboutProperty);
end;