ユニット分割について (ID:149998)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

新規にプロジェクトを作成して，
Unit1 のコードを以下にしてコンパイルします．
EXE を起動したら，Button1 をクリックしてから From1 上でマウスダウンします．
Form1 にはマウスダウンのコードはありませんが，マウスダウンのイベントが発生します．
そして，Form1 上に配置した TPanel の色が変わります．

イベントを発生させるコードはクラス型として定義しているので，
このクラスのインスタンスを別に生成すれば，別のコントロールのイベントの捕捉も可能です．
　　
    
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  // このクラスのコードを別ユニットにすれば他のプロジェクトからも利用可能
  // 必要性の有無は別として・・・  
  TMyCommClass = class(TObject)
  private
    FTargetCtrl : TControl;
    FDispCtrl : TControl;
    procedure SetTargetCtrl(const Value: TControl);
  protected
   procedure OnMouseDownEvent(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  public
    property TargetCtrl: TControl read FTargetCtrl write SetTargetCtrl;
    property DispCtrl: TControl read FDispCtrl write FDispCtrl;
  end;

TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

var
  FMyCommClass : TMyCommClass;   
    
procedure TForm1.FormCreate(Sender: TObject);
begin
  FMyCommClass := TMyCommClass.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FMyCommClass);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  // TargetCtrl はマウスのイベントを受け取るコントロール
  FMyCommClass.TargetCtrl := Form1;
  // 動作確認表示用
  FMyCommClass.DispCtrl := Panel1;
end;

{ TMyCommClass }

type
  TMyControl = class(TCustomControl);

procedure TMyCommClass.OnMouseDownEvent(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  LColor : TColor;
begin
  if FDispCtrl <> nil then begin
    TMyControl(FDispCtrl).Caption := TMyControl(Sender).Name;
    TMyControl(FDispCtrl).ParentBackground := False;

LColor := RGB(Random(255), Random(255), Random(255));
    TMyControl(FDispCtrl).Color := LColor;
  end;
end;

procedure TMyCommClass.SetTargetCtrl(const Value: TControl);
begin
  FTargetCtrl := Value;
  if FTargetCtrl <> nil then begin
    TMyControl(FTargetCtrl).OnMouseDown := OnMouseDownEvent;
  end;
end;

end.

←解決時は質問者本人がここをチェックしてください。

戻る