unit HogeFormUnit;

interface

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

type
  THogeForm = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    Image1: TImage;
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private 宣言 }
    FBackColor : TColor;
    FDispCtrl : TMemo;
    procedure SetBackColor(const Value: TColor);
  public
    { Public 宣言 }
    procedure ColorChange(AText: string);
    procedure DrawToImage(Sender: TObject; AImage: TImage; ADrawKind: Integer);
    property BackColor : TColor read FBackColor write SetBackColor;
    property DispCtrl : TMemo read FDispCtrl write FDispCtrl;
  end;

var
  HogeForm: THogeForm;

implementation

{$R *.dfm}

{ THogeForm }

//-----------------------------------------------------------------------------
//  公開メソッド
//  Panel1 の色を変更するメソッド
//-----------------------------------------------------------------------------
procedure THogeForm.ColorChange(AText: string);
var
  LColor : TColor;
begin
  LColor := RGB(Random(255), Random(255), Random(255));
  Panel1.Color := LColor;

  Panel1.ParentBackground := False;
  Panel1.Caption := AText;
end;

//-----------------------------------------------------------------------------
//  公開メソッド
//  引数の TImage の Canvas への描画用メソッド
//-----------------------------------------------------------------------------
procedure THogeForm.DrawToImage(Sender: TObject; AImage: TImage;
  ADrawKind: Integer);
var
  LCanvas : TCanvas;
begin
  if Sender.ClassName <> 'TButton' then Exit;

  if ADrawKind = 1 then begin
    AImage.Picture.Assign(nil);

    LCanvas := AImage.Canvas;
    LCanvas.Pen.Width := 5;
    LCanvas.Pen.Color := clRed;
    LCanvas.MoveTo(0, 0);
    LCanvas.LineTo(AImage.Width, AImage.Height);
  end;
end;

//=============================================================================
//  Image1 (TImage) の OnMouseMove イベント
//  プロパティ FDispCtrl (TMemo) が設定されている場合はその Text に値を代入
//  代入する値は TImage 上のマウス座標
//
//  このような情報は TApplicationEvents コンポーネントを使用すれば
//  利用側kの TApplicationEvents.OnMessage イベントでも取得可能
//=============================================================================
procedure THogeForm.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  LText : string;
begin
  if FDispCtrl <> nil then begin
    LText := Self.Name + '.' + TControl(Sender).Name + sLineBreak
           + 'X : ' + IntToStr(X) + sLineBreak + 'Y : ' + IntToStr(Y);
    FDispCtrl.Text := LText;
  end;
end;

//-----------------------------------------------------------------------------
//  プロパティ FBackColor の設定用メソッド
//  FBackColor はこのフォームの色
//  TForm.Color プロパティと同じであるか，プロパティの実装サンプルとして・・・
//
//  アプリの開発では関係するユニットを uses して使用するこも多い
//  その場合は，このようなプロパティの設定は不要だろう
//-----------------------------------------------------------------------------
procedure THogeForm.SetBackColor(const Value: TColor);
begin
  if csLoading in ComponentState then Exit;

  if FBackColor <> Value then begin
    FBackColor := Value;
    Self.Color := FBackColor;
  end;
end;

end.

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
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Image1: TImage;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }

  end;

var
  Form1: TForm1;

implementation

uses 
  HogeFormUnit;

{$R *.DFM}

//=============================================================================
//  フォーム表示開始時の処理
//
//  HogeForm は HogeFormUnit.pas 内で宣言されている THogeForm 型のグローバル変数
//  フォームを自動生成する時はこの名前が使用される
//
//  VCL のフォームを新規作成すると，このようなグローバル変数が宣言される
//  このフォームの場合は TForm1 型の Form1 という名前
//  この宣言は勝手に書き換えてはいけない．変更はオブジェクト・インスペクタで行う
//  このインスタンスは識別子 Self で参照できる (Form1.Caption = Self.Caption)
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  HogeForm.DispCtrl := Memo1;
end;

//=============================================================================
//  フォーム HogeForm を表示する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  HogeForm.Left := Self.Left + 200;
  HogeForm.Top  := Self.Top - 250;
  HogeForm.Show;
end;

//=============================================================================
//  フォーム HogeForm のメソッドを実行
//  HogeForm 上に配置した TPanel の色が変わる
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
 HogeForm.ColorChange(ExtractFileName(Application.ExeName));
end;

//=============================================================================
//  フォーム HogeForm の TImage に画像を描画
//  HogeForm の Image1 への描画を呼び出し側で実行する例
//  画像ファイルは ZIP 書庫に添付
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LBitmap : TBitmap;
  LImage  : TImage;
begin
  // Limage := Image1 にするとこのフォームの Image1 への描画
  LImage := HogeForm.Image1;

  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile('smail_25.bmp');
    LBitmap.AlphaFormat := afDefined;
    LImage.Canvas.Draw(0, 0, LBitmap);
  finally
     FreeAndNil(LBitmap);
  end;

  LImage.Canvas.Pen.Width := 5;
  LImage.Canvas.Pen.Color := clBlack;
  LImage.Canvas.MoveTo(LImage.Width, 0);
  LImage.Canvas.LineTo(0, LImage.Height);
end;

//=============================================================================
//  フォーム HogeForm の Image1 への描画
//  HogeForm 内の描画コードを実行する例
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
begin
  HogeForm.DrawToImage(Sender, HogeForm.Image1, 1);
end;

//=============================================================================
//  フォーム HogeForm の描画コードを実行
//  HogeForm 内の描画コードをこのフォームの Image1 (TImage) に対して実行する例
//=============================================================================
procedure TForm1.Button5Click(Sender: TObject);
begin
  HogeForm.DrawToImage(Sender, Image1, 1);
end;

//=============================================================================
//  フォーム HogeForm の BackColor プロパティを設定
//  このプロパティは TForm.Color プロパティと同じ
//  プロパティの実装例として別名のプロパティにしてみた
//=============================================================================
procedure TForm1.Button6Click(Sender: TObject);
begin
  HogeForm.BackColor := clSilver;
end;

end.

unit HogeFormExUnit;

interface

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

type
  THogeFormEx = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  protected
    procedure WMMove(var Message: TWMMove); message WM_MOVE;
  public
    { Public 宣言 }
  end;

var
  HogeFormEx: THogeFormEx;

implementation

uses
  Unit1;

{$R *.dfm}

{ THogeForm }

//=============================================================================
//  Button1.OnClich イベント
//  このイベントが発生したら Form1 の指定メソッドを実行する
//  Form1 では，このフォームの Button1 クリックが検出できることになる
//
//  このコードは Form1.Buttn2 のクリックイベントのコードを実行するが，
//  Form1.Button2 をクリックするのではない．したがってフォーカスの移動はない
//=============================================================================
procedure THogeFormEx.Button1Click(Sender: TObject);
begin
  Form1.Button2Click(Sender);
end;

//-----------------------------------------------------------------------------
//  このフォームの WM_MOVE メッセージ処理
//  このメッセージが発生したら From1 の指定メソッドを実行する
//  Form1 で，このフォームで発生したメッセージに対応した処理が可能になる
//-----------------------------------------------------------------------------
procedure THogeFormEx.WMMove(var Message: TWMMove);
begin
  inherited;
  Form1.ReceiveFormMove(Point(Message.XPos, Message.YPos));
end;

end.

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
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    procedure ReceiveFormMove(APos: TPoint);
  end;

var
  Form1: TForm1;

implementation

uses 
  HogeFormExUnit;

{$R *.DFM}

//=============================================================================
//  フォーム表示開始時の処理
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  Memo1.Lines.Clear;
end;

//=============================================================================
//  フォーム HogeFormEx を表示する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  HogeFormEx.Left := Self.Left + 150;
  HogeFormEx.Top  := Self.Top - 100;
  HogeFormEx.Show;
end;

//=============================================================================
//  フォーム HogeFormEx の色を変更
//  このイベントのコードは HogeFormEx の Button1 をクリックした時も実行される
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LColor : TColor;
begin
  LColor := RGB(Random(255), Random(255), Random(255));
  HogeFormEx.Color := LColor;
end;

//-----------------------------------------------------------------------------
//  HogeFormEx の位置が変更された時に実行されるメソッド
//  Memo1 に HogeFormEx の位置を表示
//-----------------------------------------------------------------------------
procedure TForm1.ReceiveFormMove(APos: TPoint);
begin
  Memo1.Lines.Add('Left : ' + IntToStr(APos.X));
  Memo1.Lines.Add('Top  : ' + IntToStr(APos.Y));
end;

end.

unit HogeFormExUnit;

interface

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

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,
  HogeFormExUnit;

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
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }

  end;

var
  Form1: TForm1;

implementation

uses
  DualList;

{$R *.DFM}

//=============================================================================
//  リポジトリに登録されているフォームをコピーして利用する例
//
//  (1) [ファイル] [新規作成] [その他] のダイアログを表示
//  (2) [Delphi ファイル] から [デュアルリストボックス] を選択してコピー
//  (3) 名前を付けて保存で [Test7_Units] 内に保存
//  (4) uses に DualList を追加 
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if DualListDlg.ShowModal = mrOk then begin
  end;
end;

end.

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
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

  function InputQuery(const ACaption, APrompt: string; var Value: string): Boolean;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  自前の InputQuery 関数を実行
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LValue : string;
begin
  LValue := '123';
  if InputQuery('値の入力', '値', LValue) then begin
  end;
end;

//-----------------------------------------------------------------------------
//  文字 (アルファベット) のサイズを取得する関数
//  Result.x は A.Z,a..z の文字の平均文字幅
//  Result.y は A..Z,a..z の文字の最大高さ
//-----------------------------------------------------------------------------
function GetAveCharSize(Canvas: TCanvas): TPoint;
var
  LIndex  : Integer;
  LBuffer : array[0..51] of Char;
begin
  // 文字配列に A..Z,a..z の文字を全てセット
  for LIndex := 0 to 25 do begin
    LBuffer[LIndex] := Chr(LIndex + Ord('A'));
  end;
  for LIndex := 0 to 25 do begin
    LBuffer[LIndex + 26] := Chr(LIndex + Ord('a'));
  end;

  GetTextExtentPoint(Canvas.Handle, LBuffer, 52, TSize(Result));
  Result.X := Result.X div 52;
end;

//-----------------------------------------------------------------------------
//  実行時にフォームを新規作成して表示する関数の例
//  フォームに配置するコントロールも実行時に生成すする
//  Delphi の InputQuery 関数のコード (若干改変)
//
//  コントロールの位置とサイズを MulDiv 関数を使用して文字数を基準にして計算
//  自分でコーディングする場合は，それにこだわる必要はない
//-----------------------------------------------------------------------------
function InputQuery(const ACaption, APrompt: string;  var Value: string): Boolean;
var
  LForm         : TForm;
  LPrompt       : TLabel;
  LEdit         : TEdit;
  LButtonOk     : TButton;
  LButtonCancel : TButton;
  LDialogUnits  : TPoint;
  LButtonTop    : Integer;
  LButtonWidth  : Integer;
  LButtonHeight : Integer;
begin
  Result := False;

  LForm := TForm.Create(Application);
  try
    LForm.Canvas.Font := LForm.Font;
    LDialogUnits := GetAveCharSize(LForm.Canvas);

    // 生成するフォームのプロパティ
    LForm.BorderStyle := bsDialog;
    LForm.Caption     := ACaption;
    LForm.ClientWidth := MulDiv(180, LDialogUnits.X, 4);
    LForm.Position    := poScreenCenter;

    // TLabel の生成
    LPrompt := TLabel.Create(LForm);
    LPrompt.Parent  := LForm;
    LPrompt.Caption := APrompt;
    LPrompt.Left    := MulDiv(8, LDialogUnits.X, 4);
    LPrompt.Top     := MulDiv(8, LDialogUnits.Y, 8);
    LPrompt.Constraints.MaxWidth := MulDiv(164, LDialogUnits.X, 4);
    LPrompt.WordWrap := True;

    // TEdit の生成
    LEdit := TEdit.Create(LForm);
    LEdit.Parent    := LForm;
    LEdit.Left      := LPrompt.Left;
    LEdit.Top       := LPrompt.Top + LPrompt.Height + 5;
    LEdit.Width     := MulDiv(164, LDialogUnits.X, 4);
    LEdit.MaxLength := 255;
    LEdit.Text      := Value;
    LEdit.SelectAll;

    // 生成する TButton の位置の値
    LButtonTop    := LEdit.Top + LEdit.Height + 15;
    LButtonWidth  := MulDiv(50, LDialogUnits.X, 4);
    LButtonHeight := MulDiv(14, LDialogUnits.Y, 8);

    // OK ボタンの生成
    LButtonOk := TButton.Create(LForm);
    LButtonOk.Parent     := LForm;
    LButtonOk.Caption    := 'OK';
    LButtonOk.ModalResult := mrOk;
    LButtonOk.Default    := True;
    LButtonOk.SetBounds(MulDiv(38, LDialogUnits.X, 4), LButtonTop,
      LButtonWidth, LButtonHeight);

    // キャンセルボタンの生成
    LButtonCancel := TButton.Create(LForm);
    LButtonCancel.Parent      := LForm;
    LButtonCancel.Caption     := 'キャンセル';
    LButtonCancel.ModalResult := mrCancel;
    LButtonCancel.Cancel      := True;
    LButtonCancel.SetBounds(MulDiv(92, LDialogUnits.X, 4), LEdit.Top + LEdit.Height + 15,
      LButtonWidth, LButtonHeight);

    LForm.ClientHeight := LButtonCancel.Top + LButtonCancel.Height + 13;


    // フォームをモーダル表示
    if LForm.ShowModal = mrOk then begin
      Value  := LEdit.Text;
      Result := True;
    end;
  finally
    FreeAndNil(LForm);
  end;
end;

end.

implementation

uses
  HogeFormUnit;

{$R *.DFM}

//=============================================================================
//  フォーム HogeForm をモードレス表示
//  HogeForm が自動生成の場合
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  HogeForm.Left := Self.Left + 100;
  HogeForm.Top  := Self.Top - 100;

  HogeForm.Show;
end;

//=============================================================================
//  フォーム HogeForm をモーダル表示
//  HogeForm が自動生成の場合
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  HogeForm.Left := Self.Left + 100;
  HogeForm.Top  := Self.Top - 100;

  HogeForm.ShowModal;
end;

implementation

uses 
  HogeFormUnit;

{$R *.DFM}

//=============================================================================
//  フォーム HogeForm をモーダル (ShowModal メソッドで) 表示
//  Create メソッドの引数は nil でもよい
//========================f=====================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  HogeForm := THogeForm.Create(Self);
  try
    HogeForm.Left := Self.Left + 100;
    HogeForm.Top  := Self.Top - 100;

    HogeForm.ShowModal;
  finally
    FreeAndNil(HogeForm);
  end;
end;

implementation

uses 
  HogeFormUnit;

{$R *.DFM}

//=============================================================================
//  フォーム HogeForm をモードレス (Show メソッドで) 表示
//  Create メソッドの引数を nil にしないこと
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if HogeForm = nil then begin
    HogeForm := THogeForm.Create(Self);
    HogeForm.Left := Self.Left + 100;
    HogeForm.Top  := Self.Top - 100;
  end;

  HogeForm.Show;
end;

var
  HogeForm: THogeForm;

implementation

{$R *.dfm}

{ THogeForm }

//=============================================================================
//  フォームが閉じる時の処理
//  このフォーム自身のメモリを解放して nil を代入しておく
//  nil を代入しておくことでインスタンスの有無の判定が可能になる
//  このフォームでは，TControl(Sender).Name の値は常に HogeForm
//=============================================================================
procedure THogeForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
  HogeForm := nil;
end;

//=============================================================================
//  フォーム HogeForm をモードレス表示
//  Button1 をクリックした回数だけ THogeForm のフォームが生成される
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LForm : THogeForm;
begin
  LForm := THogeForm.Create(Self);
  LForm.Left := Self.Left + 150;
  LForm.Top  := Self.Top - 300;

  LForm.Show;
end;

//=============================================================================
//  このフォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
var
  LIndex : Integer;
  LForm  : TForm;
  LText  : string;
begin
  LText := 'オーナを持つフォーム一覧' + sLineBreak + sLineBreak;
  for LIndex := Screen.FormCount -1 downto 0 do begin
    LForm := Screen.Forms[LIndex];
    if LForm.Owner <> nil then begin
      LText := LText + LForm.Name + '  ( ' + LForm.Owner.Name + ' ) ' + sLineBreak;
    end;
  end;
  MessageBox(Handle, PChar(LText), 'フォーム一覧', MB_ICONINFORMATION);
end;