お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





FDelphi FAQ
16番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル

"ラバーバンドでTImageを変形させる"




 ラバーバンドでサイズを指定してTImageをフィットさせる例です。
フォーム上にTImageを置いて、画像をロードしておいてください。
FormMouseDown,Move,UpはForm1とImage1両方で共有して下さい。
(つまり、Form1のOnMouseDownもImage1のOnMouseDownも同じFormMouseDown)
実行して、どこでもマウスでクリックしてドラッグしてみて下さい。


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 
Dialogs,
  ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    pressed:Boolean;
    prev:TPoint;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  pressed:=True;
  prev:=Point(Image1.Left,Image1.Top);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if pressed then
  begin
    Canvas.Pen.Mode:=pmNotXor;
    Canvas.Pen.Width:=4;
    Canvas.Brush.style:=bsClear;
    if Sender=Image1 then
    begin
       X:=X+Image1.Left;
       Y:=Y+Image1.Top;
    end;
    Canvas.Rectangle(Rect(Image1.Left,Image1.Top,prev.X,prev.Y));
    Canvas.Rectangle(Rect(Image1.Left,Image1.Top,X,Y));
    prev:=Point(X,Y);
  end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if pressed then
  begin
    Canvas.Pen.Mode:=pmNotXor;
    Canvas.Pen.Width:=4;
    Canvas.Brush.style:=bsClear;
    if Sender=Image1 then
    begin
       X:=X+Image1.Left;
       Y:=Y+Image1.Top;
    end;
    Canvas.Rectangle(Rect(Image1.Left,Image1.Top,prev.X,prev.Y));
    Image1.Width:=X-Image1.Left;
    Image1.Height:=Y-Image1.Top;
    pressed:=False;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1.Stretch:=True;
  pressed:=False;
end;

end.

☆☆☆  かわいいコードにゃ旅をさせよう いざサンプル蔵へ!! ☆☆☆
                                 00/06/30(金) 00:53 凛(MXB01744)

Original document by 凛              氏 ID:(MXB01744)


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

Copyright 1996-2002 Delphi Users' Forum