Delphi freeze on Form close with custom component

Question

I have developed a component to implement pan and zoom functionality for Graphics32 based ImgView32s. One can drop the component next to an TImgView32, set the Image view property of my component and all is good, and working as expected. However, once I try to close the Form hosting my component and the ImgView32 the Delphi IDE freezes. My first thought was that the ImgView32 while still linked to my component gets destroyed before my component, so I implemented the Delphi standard notification mechanisms. Still the problem remains. Here is the source code of my component. The component is included in a runtime package and another design time package is using the runtime package and registers the component.

Update, as a result of Rob's useful debugging tips: As it turns out, the component hangs in an endless call to the Notification method. Maybe thats a hint to someone.

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.

Wouldn't be better to derive your component directly from the `TImgView32` ? Or `TCustomImgView32` if there's some (I'm not a friend of Graphics32). — TLama, Dec 07 '12 at 15:44
@TLama, you might be right, but since I have decided to go this way, now I am interested why Delphi freezes on closing the Form. — iamjoosy, Dec 07 '12 at 15:47
You're intercepting mouse calls. Is there any difference depending on position of mouse cursor at the time the form is closed or whether you use a mouse click to close the form? — Disillusioned, Dec 07 '12 at 15:56
try niling all your event handlers when the component destroyed. anyways, I'm with @TLama on this (subclass TImgView32) — kobik, Dec 07 '12 at 16:22
note also that you are not restoring FOrigxxx messages back to the TImgView32 on notification opRemove... — kobik, Dec 07 '12 at 16:37
@kobik, that's fine since the `TimgView32PanZoom` control is notified that the `FImgView32` has been destroyed, so there's nothing to restore. — TLama, Dec 07 '12 at 16:41
@iamjoosy, call `inherited` in the `Notification` method (that's the solution for your endless loop). — TLama, Dec 07 '12 at 16:47
@TLama, yes. I meant to restore original events when the component is destroyed, sorry. nice catch with the inherited :) — kobik, Dec 07 '12 at 16:48
@kobik, that was my thought a couple of minutes ago as well, so I try to replace FImgView := nil with ImgView := nil, but that didn't help either. — iamjoosy, Dec 07 '12 at 16:48
@iamjoosy, those events can't fire anymore since the `FImgView32` is destroyed, so there's no need to care. Just don't break the `Notification` chain, call `inherited` and you'll be fine ;-) — TLama, Dec 07 '12 at 16:54
@iamjoosy a endless call to notification, with notifications about what component? which operation?. I mean, you still have more debugging to do!! — jachguate, Dec 07 '12 at 16:57
@jachguate sorry, but Delphi didn't tell me from what AComponent the notification came - "Inaccesible Value" — iamjoosy, Dec 07 '12 at 17:00
@TLama, I think you got it. calling inherited in Notification did the trick - strange, as Iam sure I saw examples that didn't call inherited. You should make this an answer. — iamjoosy, Dec 07 '12 at 17:01
@TLama, it was exactly here: http://delphi.about.com/library/bluc/text/uc083101a.htm that was misleading me. — iamjoosy, Dec 07 '12 at 17:05
@TLama, if TimgView32PanZoom destroyed, and FImgView32 still lives then FImgView32 will continue to fire events to an unassigned location at deep space :) — kobik, Dec 07 '12 at 17:08
@kobik, that's right, but that's what the `TimgView32PanZoom`'s destructor takes care of. — TLama, Dec 07 '12 at 17:10
@kobik, actullay no problem to destroy TimgView32PanZoom - have a look at the destructor, — iamjoosy, Dec 07 '12 at 17:12
@TLama, ok, now I see the destructor used ImgView32 setter := nill (I thought it was *F*ImgView32 := nil). — kobik, Dec 07 '12 at 17:17

score 9 · Answer 1 · answered Dec 07 '12 at 16:16

Since Stack Overflow is not a personal debugging service, I'm not going to look too closely at your code. Instead, I'm going to explain how to debug this yourself. That way, this answer will be useful to other people, too, and the question won't have to get closed a "too localized."

To debug this, as you debug anything, use the debugger. This is design-time code, though, and your program isn't even running, so where does the debugger come into play? In this case, the program running your code is the IDE, so attach the debugger to the IDE.

Run Delphi, and open the package project that contains your component. Set the project options so that the "host program" is delphi32.exe, or whatever the EXE name of your Delphi version happens to be.

Run your package project. A second copy of Delphi will start running. In that second copy, reproduce the problem you're trying to solve. (I.e., make the second instance of Delphi hang.) Use the first copy to debug the second copy. Pause execution, look at the call stack, check variables, set breakpoints, and generally do whatever you'd normally do to debug a problem.

You'll be a bit crippled in this job because you don't have the source code or debugging symbols for the internal Delphi code. For the purposes of this task, though, it's best to assume the problem you're seeking is in your code anyway, so the missing code shouldn't be too big a problem.

I did not expect you to debug my code - your tips on how to debug a design time component were very valuable - see my updated question. — iamjoosy, Dec 07 '12 at 16:31
If you didn't expect someone to debug your code for you, then what *was* your question? — Rob Kennedy, Dec 07 '12 at 19:56
@Rob, well it depends on the definition of "debug". If you mean that I expected to someone look over my code, then yes, I expected that. But if you mean that someone actually tries to reproduce and then debug my problem using my code in their own Delphi environment, then, no I didn't expect that - the latter one was what I was referring to in my comment. — iamjoosy, Dec 08 '12 at 00:35
@Rob, in any case, to debug or not debug, you helped me tremendously with your answer by a) teaching me something new and b) with that newly gained knowledge I was able to narrow the bug down, so that TLama could immediately spot the problem. — iamjoosy, Dec 08 '12 at 00:40

TLama · Accepted Answer · 2012-12-07T17:14:04.883

8

You need to call inherited in your Notification method to let the control process all notifications that occurs in the control ascendants chain. So, to fix your infinite loop (which is as you've described the source of the freeze) modify your Notification method this way:

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

edited Dec 07 '12 at 17:14

answered Dec 07 '12 at 16:58

TLama

75,147
17
214
392

4

+1 for the catch. You don't need to add parameters when passing the same parameters to the ascendant method. You can just call inherited, which IMHO is simpler and easier to maintain. – jachguate Dec 07 '12 at 17:04
2

This is the correct answer, but I have to say that without Rob Kennedy's help, I would not have gotten so far to narrow the problem down to the Notification method. – iamjoosy Dec 07 '12 at 17:09

Delphi freeze on Form close with custom component

2 Answers2

Linked