Databases
StackOverflow2013
Postsdbo
PODelphi freeze on Form close with custom component
Body
 

Note that there are some explanatory texts on larger screens.

plurals
  1. PODelphi freeze on Form close with custom component
    text
    copied!<p>I have developed a component to implement pan and zoom functionality for <a href="http://graphics32.org/wiki/" rel="nofollow">Graphics32</a> based ImgView32s. One can drop the component next to an <a href="http://graphics32.org/documentation/Docs/Units/GR32_Image/Classes/TImgView32/_Body.htm" rel="nofollow">TImgView32</a>, 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.</p> <p>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. </p> <pre><code>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 &gt; 0 then NewScale := Scale * 1.1 else NewScale := Scale / 1.1; if NewScale &gt; FMaxZoom then NewScale := FMaxZoom; if NewScale &lt; 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. </code></pre>
 

Querying!

 
Guidance
An individual column

Larger individual text columns get their own page to allow for proper reading.

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload