unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, jpeg, ExtCtrls;
type
TImage = class (ExtCtrls.TImage) // Небольшой хак (чтобы рисовать рамку выделения вокруг картинки)
protected
procedure Paint; override;
end;
type
TForm1 = class(TForm)
Image1: TImage;
procedure Image1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormDblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
JumpImg: TImage = nil;
implementation
{$R *.dfm}
uses
Unit2;
{ TImage }
procedure TImage.Paint;
var
Canv: TCanvas;
aRect: TRect;
begin
if (Self.Tag = 1) then
begin
aRect := Rect(Self.Left-3,Self.Top-3,Self.Left+Self.Width+3,Self.Top+Self.Height+3);
Canv := TForm(Self.Owner).Canvas;
Canv.Pen.Color := clRed;
Canv.Pen.Width := 3;
Canv.Rectangle(aRect);
end;
inherited;
end;
procedure TForm1.Image1Click(Sender: TObject);
begin
if (Sender is TImage) then
begin
if (TImage(Sender).Tag = 0) then
begin
TImage(Sender).Tag := 1;
JumpImg := TImage(Sender);
end
else
begin
JumpImg := nil;
TImage(Sender).Tag := 0;
end;
Repaint;
end;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
Form2.Top := Top;
Form2.Left := Left + Width+1;
Form2.Show;
end;
procedure TForm1.FormDblClick(Sender: TObject);
var
aPoint: TPoint;
begin
if (JumpImg <> nil) then
begin
GetCursorPos(aPoint);
aPoint := ScreenToClient(aPoint);
JumpImg.Parent := Self;
Form2.Repaint;
JumpImg.Top := aPoint.Y;
JumpImg.Left := aPoint.X;
JumpImg.Tag := 0;
Repaint;
JumpImg := nil;
end;
end;
end.