こんにちは、たけ(tk)です。

(****   === tkVars.pas ===

　【概要】

　データ分離型の入力窓です。

　複数の入力窓（TTkVarEdit）を一つのデータ（TTkVar）にリンクさせ、い
ずれかの入力窓を変更すると（またはデータを変更すると）、リンクしてい
るすべての入力窓の表示が変わるようにします。

　別のフォームの入力窓でもリンクさせることが出来る。

　なお、
　http://member.nifty.ne.jp/take_tk/delphi/tkvars.pas
　にはラベル版も入っています。コメントも、(^_^;)。

　【使い方】

　TTkVarEdit  は通常の  TEdit  のようにフォームに貼りつける。 通常の
TEdit と同様に扱える。

　TTkVar 型のコンポーネントもフォームに貼りつける。ただし、 非ビジュ
アルコンポであり、実行時には表示されない。

　TTkVarEdit と TTkVar とのリンクの張り方は、同一フォームある場合と、
別のフォームにある場合とでは異なる。

　同一フォームにある場合には、入力窓のプロパティエディタで TkVar  の
プロパティの項目を ALT+↓する。そのフォームにある TTkVar  型のコンポ
ーネントが一覧できるので、その中から選択する。

　別のフォームある場合には、入力窓のプロパティエディタで OnStart  イ
ベントをダブルクリックして OnStart ハンドラを作成し、 次のように記述
する。

  ┌─ 【例】 ─────────────────────┐
  │procedure TForm2.TkVarEdit1Start(Sender: TObject);  │
  │begin                                               │
  │  TkVarEdit1.TkVar := Form1.tkVar1;                 │
  │end;                                                │
  └──────────────────────────┘
    ＊　Form2 の入力窓 TkVarEdit1 と Form1 のデータ tkVar1  とをリン
      クさせる例。

　自作の TEdit 系のクラスがある場合には、xxxEdit = class( TEdit ) の
部分を xxxEdit = class( TTkVarEdit ) とすれば簡単に拡張できる。

****)

unit tkVars ; interface

uses
  Controls, { TControl }
  Messages, { TMessage }
  SysUtils, { IntToStr.. debug }
  Classes,  { TComponent }
  Forms,    { applicatin.mainform.caption .. for debug }
  StdCtrls; { TEdit }

const
  TKM_BASE = $7000;
  TKM_VARCHANGED = TKM_BASE + 1 ;   { →TKVars.pas }
  TKM_START      = TKM_BASE + 2 ;   { →TKVars.pas }

(****　TTkVar　＝＝　****)

type

  TTkVar = class( TComponent )
  private
    FList:TList;
    FString:string;
    function  getAsString:string;virtual;
    procedure setAsString( const Value:string );virtual;
  protected
    procedure VarChanged;
    procedure Notification(AComponent: TComponent;
                    Operation:TOperation); override;
    procedure SetName(const Value: TComponentName); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure add( Control:TControl );
    procedure remove( Control:TControl );
    property asString:string   read FString  write setAsString;
  published
    property text:string read FString write setAsString;
  end;

  TTkVarEdit = class( TEdit )       { ← 公開用 }
  private
    FTkVar:  TTkVar;
    FStart:   boolean;
    FOnStart: TNotifyEvent;
    procedure TKMVarChanged(var Message: TMessage);message TKM_
VARCHANGED;
    procedure setTkVar( Value:TTkVar );
  protected
    procedure Notification(AComponent: TComponent;
                    Operation:TOperation);override;
    procedure Change; override ; { dynamic;}
    procedure TKMStart(var Message: TMessage); message TKM_START;
    procedure WMPaint( var Message: TWMPaint); message WM_PAINT;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property TkVar:TTkVar          read FTkVar   write setTkVar;
    property OnStart: TNotifyEvent read FOnStart write FOnStart;
  end;

implementation

constructor TTkVar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FList   := nil;
  {FString := Name; { NG }
end;

procedure TTkVar.SetName(const Value: TComponentName);
var
  ChangeText: Boolean;
begin
  ChangeText := (Name = Text)
            and (    (Owner = nil)
              or not (Owner is TControl)
              or not (csLoading in TControl(Owner).ComponentState));
  inherited SetName(Value);
  if ChangeText then FString := Value;
end;

destructor TTkVar.Destroy;
begin
  if FList <> nil then FList.free;
  FList := nil;
  inherited Destroy;
end;

procedure TTkVar.Notification(AComponent:
                        TComponent;Operation:TOperation);
begin
  inherited Notification( AComponent,Operation);
  if ( FList <> nil ) and ( Operation = opRemove )
    then remove( TControl(AComponent) );
end;

procedure TTkVar.VarChanged;
const
 reenter:boolean=false;
var
  i:integer;
begin
  if FList = nil then exit;
  if reenter then exit;
  reenter := true; try
    for i := FList.count -1 downto 0 do begin
      TControl(FList[i]).Perform( TKM_VARCHANGED , 0 , longint(self));
    end;
  finally reenter := false ; end;
end;

procedure TTkVar.add( Control:TControl );
begin
  if FList = nil then FList := TList.Create;
  FList.add( Control);
end;

procedure TTkVar.remove( Control:TControl );
begin
  if FList = nil then exit;
  FList.remove( Control );
  if FList.count <> 0 then exit;
  FList.Free;
  FList := nil;
end;

function  TTkVar.getAsString:string;
begin
  result := FString;
end;

procedure TTkVar.setAsString( const Value:string );
begin
  if Value = FString then exit;
  FString := Value;
  VarChanged;
end;

(****　＝＝　TTkVarEdit　****)

constructor TTkVarEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTkVar   := nil;
  FStart   := true;
  FOnStart := nil;
end;

procedure TTkVarEdit.setTkVar( Value:TTkVar );
begin
  if ( FTkVar = Value ) then exit;
  if ( FTkVar <> nil ) then FTkVar.remove(self);
  if ( Value  <> nil ) then  Value.add(self);
  FTkVar := value;
end;

procedure TTkVarEdit.Notification(AComponent: TComponent;
                Operation:TOperation);
begin
  inherited Notification( AComponent,Operation);
  if ( AComponent = FTkVar ) and ( Operation = opRemove )
    then FTkVar := nil;
end;

procedure TTkVarEdit.TKMVarChanged(var Message: TMessage);
begin
  Text := TTkVar(Message.LParam).asString;
end;

procedure TTkVarEdit.Change;
begin
  inherited Change;
  if ( FTkVar <> nil ) then FTkVar.asString := Text;
end;

procedure TTkVarEdit.TKMStart(var Message: TMessage);
begin
  if assigned(FOnStart) then FOnStart( self );
  if ( FTkVar <> nil ) then Text := FTkVar.asString ;
end;

procedure TTkVarEdit.WMPaint(var Message: TWMPaint);
begin
  if FStart then begin
    FStart := false;
    perform( TKM_START , 0 , longint(self) );
  end;
  inherited ;
end;

end.

                              99/4/19(Mon) 01:53pm  CQK01016 たけ(tk)

Original document by たけ(tk)        氏 ID:(CQK01016)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。