delphi - カスタムコンポーネントを使用してフォームを閉じるとDelphiがフリーズする

Question

Graphics32ベースのImgView32のパンおよびズーム機能を実装するためのコンポーネントを開発しました。コンポーネントをTImgView32の横にドロップし、コンポーネントのImage viewプロパティを設定すると、すべてが正常に機能し、期待どおりに機能します。ただし、コンポーネントをホストしているフォームを閉じようとすると、ImgView32でDelphiIDEがフリーズします。私が最初に考えたのは、コンポーネントにリンクされたままのImgView32がコンポーネントの前に破棄されるため、Delphiの標準通知メカニズムを実装したことです。それでも問題は残っています。これが私のコンポーネントのソースコードです。コンポーネントはランタイムパッケージに含まれており、別のデザインタイムパッケージがランタイムパッケージを使用してコンポーネントを登録しています。

Robの便利なデバッグのヒントの結果として、更新します。結局のところ、コンポーネントは、Notificationメソッドへの無限の呼び出しでハングします。多分それは誰かへのヒントです。

unit MJImgView32PanZoom;

interface

uses Classes, Controls, Gr32, GR32_Image, GR32_Layers;

type
  TImgView32ScaleChangeEvent = procedure( OldScale, NewScale: Double ) of object;

  TimgView32PanZoom = class(TComponent)
  private
    FEnabled: Boolean;
    FMaxZoom: Double;
    FMinZoom: Double;
    FImgView32: TImgView32;
    FZoomStep: Double;
    FOrigImgMouseMove: TImgMouseMoveEvent;
    FOrigImgMouseDown: TImgMouseEvent;
    FOrigImgMouseUp: TImgMouseEvent;
    FOrigImgMouseWheel: TMouseWheelEvent;
    FOrigImgCursor: TCursor;
    FPanMouseButton: TMouseButton;
    FLastMouseDownPos : TFloatPoint;
    FPanCursor: TCursor;
    FOnScaleChanged: TImgView32ScaleChangeEvent;
    procedure imgMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
    procedure imgMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
    procedure SetImgView32(const Value: TImgView32);
    procedure imgMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure imgMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    destructor Destroy; override;
    constructor Create(AOwner: TComponent); override;
  published
    property Enabled: Boolean read FEnabled write FEnabled;
    property MaxZoom: Double read FMaxZoom write FMaxZoom;
    property MinZoom: Double read FMinZoom write FMinZoom;
    property PanMouseButton: TMouseButton read FPanMouseButton write FPanMouseButton;
    property PanCursor: TCursor read FPanCursor write FPanCursor;
    property ZoomStep: Double read FZoomStep write FZoomStep;
    property ImgView32: TImgView32 read FImgView32 write SetImgView32;
    property OnScaleChanged: TImgView32ScaleChangeEvent read FOnScaleChanged write FOnScaleChanged;
  end;



implementation

{ TimgView32PanZoom }

constructor TimgView32PanZoom.Create(AOwner: TComponent);
begin
  inherited;
  FimgView32 := nil;
  FEnabled := True;
  FZoomStep := 0.1;
  FMaxZoom := 5;
  FMinZoom := 0.1;
  FPanMouseButton := mbLeft;
  FEnabled := True;
  FPanCursor := crDefault;
end;

destructor TimgView32PanZoom.Destroy;
begin
  ImgView32 := nil;
  inherited;
end;

procedure TimgView32PanZoom.imgMouseDown( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer );
begin
  if not Enabled then
    Exit;
  if ( FPanMouseButton = mbLeft ) and not( ssLeft in Shift ) then
    Exit;
  if ( FPanMouseButton = mbRight ) and not( ssRight in Shift ) then
    Exit;
  FImgView32.Cursor := FPanCursor;
  Mouse.CursorPos := Point(Mouse.CursorPos.X+1, Mouse.CursorPos.Y);   // need to move mouse in order to make
  Mouse.CursorPos := Point(Mouse.CursorPos.X-1, Mouse.CursorPos.Y);   // cursor change visible
  with FImgView32, GetBitmapRect do
        FLastMouseDownPos := FloatPoint((X - Left) / Scale,(Y - Top) / Scale);
  if Assigned(FOrigImgMouseDown) then
    FOrigImgMouseDown(Sender, Button, Shift, X, Y, Layer);
end;

procedure TimgView32PanZoom.imgMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
begin
  FImgView32.Cursor := FOrigImgCursor;
  if Assigned(FOrigImgMouseUp) then
    FOrigImgMouseUp(Sender, Button, Shift, X, Y, Layer);
end;

procedure TimgView32PanZoom.imgMouseMove( Sender: TObject; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer );
begin
  if not Enabled then
    Exit;
  if ( FPanMouseButton = mbLeft ) and not( ssLeft in Shift ) then
    Exit;
  if ( FPanMouseButton = mbRight ) and not( ssRight in Shift ) then
    Exit;
  with FImgView32 do
    with ControlToBitmap( Point( X, Y ) ) do
    begin
      OffsetHorz := OffsetHorz + Scale * ( X - FLastMouseDownPos.X );
      OffsetVert := OffsetVert + Scale * ( Y - FLastMouseDownPos.Y );
    end;
  if Assigned( FOrigImgMouseMove ) then
    FOrigImgMouseMove( Sender, Shift, X, Y, Layer );
end;

procedure TimgView32PanZoom.imgMouseWheel( Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean );
var
  tmpScale: Single;
  NewHoriz, NewVert: Single;
  NewScale: Single;
begin
  if not Enabled then
    Exit;
  with FImgView32 do
  begin
    BeginUpdate;
    tmpScale := Scale;
    if WheelDelta > 0 then
      NewScale := Scale * 1.1
    else
      NewScale := Scale / 1.1;
    if NewScale > FMaxZoom then
      NewScale := FMaxZoom;
    if NewScale < FMinZoom then
      NewScale := FMinZoom;
    NewHoriz := OffsetHorz + ( tmpScale - NewScale ) * FImgView32.ControlToBitmap( FImgView32.ScreenToClient( Mouse.CursorPos ) ).X;
    NewVert := OffsetVert + ( tmpScale - NewScale ) * FImgView32.ControlToBitmap( FImgView32.ScreenToClient( Mouse.CursorPos ) ).Y;
    Scale := NewScale;
    OffsetHorz := NewHoriz;
    OffsetVert := NewVert;
    EndUpdate;
    Invalidate;
  end;
  if Assigned( FOnScaleChanged ) then
    FOnScaleChanged( tmpScale, NewScale );
  if Assigned( FOrigImgMouseWheel ) then
    FOrigImgMouseWheel( Sender, Shift, WheelDelta, MousePos, Handled );
end;

procedure TimgView32PanZoom.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if (Operation = opRemove) and (AComponent = FImgView32) then
  begin
    FImgView32 := nil;
  end;
end;

procedure TimgView32PanZoom.SetImgView32(const Value: TImgView32);
begin
   if Assigned(FImgView32) then
   begin
     FImgView32.RemoveFreeNotification(Self);
     FImgView32.OnMouseMove := FOrigImgMouseMove;
     FImgView32.OnMouseDown := FOrigImgMouseDown;
     FImgView32.OnMouseWheel := FOrigImgMouseWheel;
     FImgView32.OnMouseUp := FOrigImgMouseUp;
     FImgView32.Cursor := FOrigImgCursor;
   end;

   FImgView32 := Value;
   if Assigned(FImgView32) then
   begin
     FOrigImgMouseMove := FImgView32.OnMouseMove;
     FOrigImgMouseDown := FImgView32.OnMouseDown;
     FOrigImgMouseWheel := FImgView32.OnMouseWheel;
     FOrigImgMouseUp := FImgView32.OnMouseUp;
     FOrigImgCursor := FImgView32.Cursor;
     FImgView32.OnMouseDown := imgMouseDown;
     FImgView32.OnMouseMove := imgMouseMove;
     FImgView32.OnMouseWheel := imgMouseWheel;
     FImgView32.OnMouseUp := imgMouseUp;
     FImgView32.FreeNotification(Self);
   end;
end;


end.

score 9 · Accepted Answer

Stack Overflow は個人的なデバッグサービスではないため、コードを詳しく調べるつもりはありません。代わりに、これを自分でデバッグする方法を説明します。そうすれば、この回答は他の人にも役立ち、質問を「ローカライズしすぎ」で締めくくる必要はありません。

これをデバッグするには、何でもデバッグするので、 debugger を使用します。ただし、これは設計時のコードであり、プログラムは実行されていません。では、デバッガーはどこで機能するのでしょうか? この場合、コードを実行するプログラムは IDE であるため、デバッガーを IDE にアタッチします。

Delphi を実行し、コンポーネントを含むパッケージプロジェクトを開きます。「ホストプログラム」がdelphi32.exeになるようにプロジェクトオプションを設定するか、Delphi バージョンの EXE 名がたまたま何であれ。

パッケージプロジェクトを実行します。Delphi の 2 番目のコピーが実行を開始します。その 2 番目のコピーで、解決しようとしている問題を再現します。（つまり、Delphi の 2 番目のインスタンスをハングさせます。）最初のコピーを使用して、2 番目のコピーをデバッグします。実行を一時停止し、コールスタックを確認し、変数をチェックし、ブレークポイントを設定し、通常は問題をデバッグするために通常行うことを行います。

Delphi の内部コードのソースコードやデバッグシンボルがないため、この作業では少し手が回らないでしょう。ただし、このタスクの目的上、探している問題はとにかくコードにあると想定するのが最善です。そのため、不足しているコードはそれほど大きな問題にはなりません。

score 8 · Accepted Answer

コントロールアセンダントチェーンで発生するすべての通知をコントロールに処理させるにはinherited、メソッドを呼び出す必要があります。したがって、無限ループを修正するには（フリーズのソースを説明したとおりです）、メソッドを次のようNotificationに変更します。Notification

procedure TimgView32PanZoom.Notification(AComponent: TComponent; 
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FImgView32) then
    FImgView32 := nil;
end;

delphi - カスタムコンポーネントを使用してフォームを閉じるとDelphiがフリーズする

2 に答える 2

Related

Reference