问题
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.
回答1:
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;
回答2:
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.
来源：https://stackoverflow.com/questions/13766255/delphi-freeze-on-form-close-with-custom-component