-2

と を持つ「Form2」がありScrollBoxますPaintBox

親として「 Form2 」を持つ「 Form3 」と呼ばれる別のフォームも存在します(これもPaintBox内部にあります)。次に、の座標に基づいて「Form3」に長方形=>を描く必要があります。ScrollBoxForm2.PaintBox

これは可能ですか?

提案/ヘルプで事前に感謝します。


ここに画像の説明を入力

Form1 :

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  Unit2;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Form2.Show;
end;

end.

Form2 :

type
  TForm2 = class(TForm)
    Panel1: TPanel;
    ScrollBox1: TScrollBox;
    Button1: TButton;
    Image1: TImage;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    Button3: TButton;
    PaintBox1: TPaintBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

uses
  Unit3;

{$R *.dfm}

procedure TForm2.Button2Click(Sender: TObject);
begin
  Form3.Close;
end;

procedure TForm2.Button3Click(Sender: TObject);
begin
  with TOpenDialog.Create(self) do
    try
      Caption := 'Open Image';
      Options := [ofPathMustExist, ofFileMustExist];
      if Execute then
        Image1.Picture.LoadFromFile(FileName);
    finally
      Free;
    end;
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
  Form3 := TForm3.Create(self);
  Form3.Parent := ScrollBox1;
  Form3.Show;
end;

Form3 :

type
  TForm3 = class(TForm)
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1Paint(Sender: TObject);
  private
    { Private declarations }
    FSelecting: Boolean;
    FSelection: TRect;
    pos1, pos2, pos3, pos4: Integer;
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

uses
  Unit2;

{$R *.dfm}

procedure TForm3.FormCreate(Sender: TObject);
begin
  Left := (Form2.Image1.Width - Width) div 2;
  Top := (Form2.Image1.Height - Height) div 2;
end;

procedure TForm3.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FSelection.Left := X;
  FSelection.Top := Y;
  FSelecting := True;
end;

procedure TForm3.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if FSelecting then
  begin
    FSelection.Right := X;
    FSelection.Bottom := Y;
    PaintBox1.Invalidate;
  end;
end;

procedure TForm3.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  FormRegion: HRGN;
  HoleRegion: HRGN;
begin
  FSelecting := False;
  FSelection.Right := X;
  FSelection.Bottom := Y;
  PaintBox1.Invalidate;

  pos1 := FSelection.Left;
  pos2 := FSelection.Top;
  pos3 := X;
  pos4 := Y;

  FSelection.NormalizeRect;
  if FSelection.IsEmpty then
    SetWindowRgn(Handle, 0, True)
  else
  begin
    FormRegion := CreateRectRgn(0, 0, Width, Height);
    HoleRegion := CreateRectRgn(pos1, pos2, pos3, pos4);
    CombineRgn(FormRegion, FormRegion, HoleRegion, RGN_DIFF);
    SetWindowRgn(Handle, FormRegion, True);
  end;
end;

procedure TForm3.PaintBox1Paint(Sender: TObject);
begin
  PaintBox1.Canvas.Brush.Style := bsClear;
  PaintBox1.Canvas.Pen.Style := psSolid;
  PaintBox1.Canvas.Pen.Color := clBlue;
  PaintBox1.Canvas.Rectangle(FSelection)
end;

Form2 .DFM :

object Form2: TForm2
  Left = 0
  Top = 0
  Caption = 'Form2'
  ClientHeight = 478
  ClientWidth = 767
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 767
    Height = 47
    Align = alTop
    TabOrder = 0
    object Button1: TButton
      Left = 24
      Top = 8
      Width = 89
      Height = 25
      Caption = 'Form3 Open'
      TabOrder = 0
      OnClick = Button1Click
    end
    object Button2: TButton
      Left = 119
      Top = 8
      Width = 89
      Height = 25
      Caption = 'Form3 Close'
      TabOrder = 1
      OnClick = Button2Click
    end
    object Button3: TButton
      Left = 232
      Top = 8
      Width = 89
      Height = 25
      Caption = 'Open image'
      TabOrder = 2
      OnClick = Button3Click
    end
  end
  object ScrollBox1: TScrollBox
    Left = 0
    Top = 47
    Width = 767
    Height = 431
    Align = alClient
    TabOrder = 1
    object Image1: TImage
      Left = 3
      Top = 4
      Width = 558
      Height = 301
      AutoSize = True
    end
    object PaintBox1: TPaintBox
      Left = 0
      Top = 0
      Width = 763
      Height = 427
      Align = alClient
      ExplicitLeft = 80
      ExplicitTop = 40
      ExplicitWidth = 105
      ExplicitHeight = 105
    end
  end
  object OpenDialog1: TOpenDialog
    Left = 360
  end
end

Form3 .DFM :

object Form3: TForm3
  Left = 0
  Top = 0
  BorderStyle = bsNone
  Caption = 'Form3'
  ClientHeight = 365
  ClientWidth = 533
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poDefaultSizeOnly
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object PaintBox1: TPaintBox
    Left = 0
    Top = 0
    Width = 533
    Height = 365
    Align = alClient
    OnMouseDown = PaintBox1MouseDown
    OnMouseMove = PaintBox1MouseMove
    OnMouseUp = PaintBox1MouseUp
    OnPaint = PaintBox1Paint
    ExplicitLeft = 328
    ExplicitTop = 200
    ExplicitWidth = 105
    ExplicitHeight = 105
  end
end

版:

この質問は基本的に私の前の質問の続きです

4

1 に答える 1