コントロール移動リサイズコンポーネント
テストプログラム MetaFileString |
動作確認等 |
Windows 7 U64(SP1) + Delphi XE Pro |
サンプルプログラム集[170_MetaFile描画でImageサイズ調整]のコードを利用して,文字列のサイズと位置変更を可能にするテストプログラムです. |
|
図1
設計時画面
- 配置コントロールは以下の通り
TplDragResize
TButton
TImage
|
|
図2
実行画面
|
|
図3
大きく拡大
|
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, plDragResize, StdCtrls, Menus, ExtDlgs;
type
TForm1 = class(TForm)
plDragResize1: TplDragResize;
Image1: TImage;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(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 宣言 }
procedure MakeMetaFileFitImageSize(AImage: TImage; AText: String; AFont: TFont);
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
//=============================================================================
// フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
Caption := '移動リサイズ可能な文字列';
end;
//=============================================================================
// [生成・選択]ボタン
// 1. 指定文字列を指定フォントで描画したメタフィルを作成して,TImageに表示
// 2. TImageの表示位置を指定
// 3. 選択状態にして移動リサイズ可能にする
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
AFont : TFont;
begin
if Image1.Picture.Graphic = nil then begin
AFont := TFont.Create;
try
AFont.Assign(Self.Canvas.Font);
AFont.Size := 50;
MakeMetaFileFitImageSize(Image1, '文字列', AFont);
Image1.Left := 50;
Image1.Top := 80;
finally
FreeAndNil(AFont);
end;
end;
plDragResize1.Target := Image1;
end;
//=============================================================================
// Image1のMouseDownイベント処理
// マウス左ボタンダウンで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;
//=============================================================================
// 文字列だけのメタファイルを作成してTImageのサイズに合わせて表示
//
// メタファイル画像であれば,AImage.Picture.Assign()で表示できるが,図形等は
// TMetaFileCanvasを生成して作成しなければならない
//=============================================================================
procedure TForm1.MakeMetaFileFitImageSize(AImage: TImage; AText: String;
AFont: TFont);
var
AMetaFile : TMetafile;
ACanvas : TMetaFileCanvas;
AWidth : Integer;
AHeight : Integer;
ARect : TRect;
DrawFlag : Cardinal;
begin
AImage.Picture.Assign(nil);
AMetaFile := TMetafile.Create;
AMetaFile.Enhanced := TRue;
try
ACanvas := TMetafileCanvas.Create(AMetaFile, Image1.Canvas.Handle);
try
ACanvas.Font.Assign(AFont);
AWidth := ACanvas.TextWidth(AText);
AHeight := ACanvas.TextHeight(AText);
finally
ACanvas.Free;
end;
AMetaFile.Width := AWidth;
AMetaFile.Height := AHeight;
ACanvas := TMetafileCanvas.Create(AMetaFile, Image1.Canvas.Handle);
try
ACanvas.Font.Assign(AFont);
ACanvas.Brush.Style := bsClear;
ARect := Rect(0, 0, AWidth, AHeight);
ACanvas.FillRect(ARect);
DrawFlag := DT_SINGLELINE or DT_CENTER or DT_VCENTER;
DrawText(ACanvas.Handle, PChar(AText), -1, ARect, DrawFlag);
finally
ACanvas.Free;
end;
AImage.SetBounds(0, 0, AWidth, AHeight);
AImage.Picture.Assign(AMetaFile);
finally
AMetaFile.Free;
end;
end;
end.
|