Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2005年10月09日] [更新 2012年10月18日] コントロール移動リサイズコンポーネント
コントロール移動リサイズコンポーネント
テストプログラム BasicTest
動作確認等 Windows 7 U64(SP1) + Delphi XE Pro







基本動作テスト


といっても,このぐらいの機能しかありません.


図1
設計時画面
  • 配置コントロールは以下の通り
    TplDragResize
    TPopupMenu
    TOpenPictureDialog
    TImage
    TLabel
    TShape
図2
実行画面
  • Shape1をリサイズ中
  • 画像をダブルクリックすると選択ダイアログ表示

リスト1
基本動作のテスト
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, plDragResize, StdCtrls, Menus, ExtDlgs;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Label1: TLabel;
    Shape1: TShape;
    PopupMenu1: TPopupMenu;
    popBrintToFront: TMenuItem;
    popSendToBack: TMenuItem;
    popDelete: TMenuItem;
    OpenPictureDialog1: TOpenPictureDialog;
    plDragResize1: TplDragResize;
    procedure plDragResize1DblClick(Sender: TObject);
    procedure popBrintToFrontClick(Sender: TObject);
    procedure popSendToBackClick(Sender: TObject);
    procedure popDeleteClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  フォームのCreate処理
//  チラツキをなくすためにDoubleBufferedを設定
//
//  Image1にはTransparent :=Trueにして画像を読込んである
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption := '基本テスト';
  DoubleBuffered := True;
end;

//=============================================================================
//  他のコントロールと共有のOnMouseDownイベント
//  マウス左ボタンダウンでTplDragResizeコンポのTargetを指定
//=============================================================================
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then begin
    plDragResize1.Target := TControl(Sender);
  end; 
end;

//=============================================================================
//  plDragResizeコンポの親であるフォームのMouseDownイベント処理
//  コントロールの選択状態を解除
//=============================================================================
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  plDragResize1.Target := nil;
end;

//=============================================================================
//  plDragResizeコンポのDblClickイベント
//  画像ファイル選択ダイアログを表示
//=============================================================================
procedure TForm1.plDragResize1DblClick(Sender: TObject);
begin
  if TplDragResize(Sender).Target = Image1 then begin
    if OpenPictureDialog1.Execute then begin
      Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
   end;
  end;
end;

//=============================================================================
//  ポップアップメニューの[最前面に移動]
//  TplDragResizeコンポのBringToFrontメソッドを実行
//=============================================================================
procedure TForm1.popBrintToFrontClick(Sender: TObject);
begin
  if plDragResize1.Target = Shape1 then begin
    Shape1.Brush.Style := bsSolid;
    Shape1.Brush.Color := clGreen;
  end;
  plDragResize1.BringToFront;
end;

//=============================================================================
//  ポップアップメニューの[最背面へ移動]
//  TplDragResizeコンポのSendToBackメソッドを実行
//=============================================================================
procedure TForm1.popSendToBackClick(Sender: TObject);
begin
  plDragResize1.SendToBack;
end;

//=============================================================================
//  ポップアップメニューの[削除]
//  Targetプロパティのコントロールを削除
//  Targetは自動的にnilになる
//=============================================================================
procedure TForm1.popDeleteClick(Sender: TObject);
begin
  plDragResize1.Target.Free;
end;

end.