delphi - Delphi卡住窗体并关闭自定义组件

Question

我已经开发了一个组件，用于为基于Graphics32的ImgView32s实现平移和缩放功能。可以将组件放在TImgView32旁边，设置组件的Image view属性，一切都很好，并且可以按预期工作。
但是，一旦我尝试关闭托管组件和ImgView32的窗体，Delphi IDE就会冻结。我的第一个想法是，仍与组件链接的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.

Answer 1

您需要在inherited方法中调用Notification，以使控件处理控件上升链中发生的所有通知。因此，要修复无限循环（正如您所描述的冻结源），请按以下方式修改您的Notification方法：

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