Delphi使用自定义组件冻结Form close

时间：2012-12-07 15:41:46

标签： delphi delphi-xe graphics32

我开发了一个组件来实现基于Graphics32的ImgView32s的平移和缩放功能。可以将组件放在TImgView32旁边，设置我的组件的Image视图属性，一切都很好，并按预期工作。 但是，一旦我尝试关闭托管我的组件的表单和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.

2 个答案:

答案 0 :(得分：9)

由于Stack Overflow不是个人调试服务，因此我不会过分关注您的代码。相反，我将解释如何自己调试。这样，这个答案也会对其他人有用，而且问题不会被关闭“过于本地化”。

要调试它，在调试任何内容时，使用调试器。这是设计时代码，你的程序甚至没有运行，那么调试器在哪里发挥作用？在这种情况下，运行代码的程序是IDE，因此将调试器附加到IDE。

运行Delphi，打开包含组件的包项目。设置项目选项，以便“主机程序”是 delphi32.exe ，或者您的Delphi版本的EXE名称恰好是。

运行您的包项目。 Delphi的第二个副本将开始运行。在第二个副本中，重现您尝试解决的问题。 （即，使Delphi的第二个实例挂起。）使用第一个副本来调试第二个副本。暂停执行，查看调用堆栈，检查变量，设置断点，并且通常执行通常用于调试问题的任何操作。

由于您没有内部Delphi代码的源代码或调试符号，因此您在这项工作中会有点瘫痪。但是，出于此任务的目的，最好假设您正在寻找的问题仍然在您的代码中，因此丢失的代码不应该是一个太大的问题。

答案 1 :(得分：8)

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

procedure TimgView32PanZoom.Notification(AComponent: TComponent; 
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FImgView32) then
    FImgView32 := nil;
end;
相关问题
最新问题