createstring.pas

类似Delphi Ide的对象查看器 可以在RUNTIME时使用

unit createstring;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, MyEdit, MyButton, MyAutoBtn, PropEdit;

type
  Tfrm_createstring = class(TForm)
    memString: TMyMemo;
    btnOk: TMyAutoBitBtn;
    btnCancel: TMyAutoBitBtn;
    btnClear: TMyAutoBitBtn;
    lblCount: TLabel;

    function GetStrings: TStrings;
    procedure memStringChange(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
  private
    { Private declarations }
  public
    property Strings: TStrings read GetStrings;
    { Public declarations }
  end;

  TStringsPropertyEditor = class(TPropertyEditor)
    function Execute: Boolean; override;
  end;

{var
  frm_createstring: Tfrm_createstring;}

implementation

{$R *.dfm}

function Tfrm_createstring.GetStrings: TStrings;
begin
  Result:=memString.Lines;
end;

procedure Tfrm_createstring.memStringChange(Sender: TObject);
var
  S: string;
begin
  with memString.Lines do
  begin
    if GetAcp=936 then
      S:=Format('总%d 行',[Count])
    else if GetAcp=950then
      S:=Format('羆%d ︽',[Count])
    else S:=Format('%d lines',[Count]);
    if Count<>1 then S:=S+'s';
  end;
  lblCount.Caption:=S;
end;

procedure Tfrm_createstring.btnClearClick(Sender: TObject);
begin
  memString.Lines.Clear;
end;

function TStringsPropertyEditor.Execute: Boolean;
{$IFDEF GOISETPROC}
type
  TSetStringsProc = procedure (NewStrings: TStrings) of object;
var
  SetProc: TSetStringsProc;
{$ENDIF}
begin
  with Tfrm_createstring.Create(nil) do
  try
    memString.Lines.Assign(TStrings(Prop.AsObject));
    Result:=ShowModal=mrOk;
    if Result then
    begin
      {$IFDEF GOISETPROC}
      TMethod(SetProc).Code:=Prop.SetProc;
      TMethod(SetProc).Data:=Pointer(Prop.Instance);
      SetProc(memString.Lines);
      {$ELSE}
      TStrings(Prop.AsObject).Assign(memString.Lines);
      {$ENDIF}
    end;
  finally
    Free;
  end;
end;

end.