TDropFileTargetMelander のDragDropスイートのコンポーネントを試しています。目標は、ファイルがドラッグ アンド ドロップされた後に特定のタスクを実行することです。また、処理中に何か問題が発生した場合は、例外を受け取りたいです。
イベントハンドラで発生した例外OnDropが飲み込まれているようです。ただし、raiseコンポーネントのソース コードにステートメントを挿入した後でも、例外を受け取ることができません。コメントを手伝っていただけますか？
サンプル dfm ファイル。
object Form4: TForm4
Left = 0
Top = 0
Caption = 'Form4'
ClientHeight = 270
ClientWidth = 392
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object edt1: TEdit
Left = 56
Top = 72
Width = 257
Height = 21
TabOrder = 0
Text = 'edt1'
end
object dropfiletarget2: TDropFileTarget
DragTypes = [dtCopy, dtLink]
OnDrop = dropfiletarget2Drop
Target = edt1
OptimizedMove = True
Left = 56
Top = 120
end
end
サンプルの pas ファイル。
unit Unit4;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DragDrop, DropTarget, DragDropFile, StdCtrls;
type
TForm4 = class(TForm)
edt1: TEdit;
dropfiletarget2: TDropFileTarget;
procedure dropfiletarget2Drop(Sender: TObject; ShiftState: TShiftState; APoint:
TPoint; var Effect: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form4: TForm4;
implementation
{$R *.dfm}
procedure TForm4.dropfiletarget2Drop(Sender: TObject; ShiftState: TShiftState;
APoint: TPoint; var Effect: Integer);
begin
raise Exception.Create('Error Message');
end;
end.
の元のコードTCustomDropTarget.Drop。
function TCustomDropTarget.Drop(const dataObj: IDataObject; grfKeyState: Longint;
pt: TPoint; var dwEffect: Longint): HResult;
var
ShiftState: TShiftState;
ClientPt: TPoint;
begin
FScrollTimer.Enabled := False;
// Protect resources against exceptions in OnDrop event handler.
try
// Refuse drop if we have lost the data object somehow.
// This can happen if the drop is rejected in one of the other IDropTarget
// methods (e.g. DragOver).
if (not Enabled) or (FDataObject = nil) then
begin
dwEffect := DROPEFFECT_NONE;
Result := E_UNEXPECTED;
end else
begin
ShiftState := KeysToShiftStatePlus(grfKeyState);
// Create a default drop effect based on the shift state and allowed
// drop effects (or an OnGetDropEffect event if implemented).
if (FTarget <> nil) then
ClientPt := FTarget.ScreenToClient(pt)
else
ClientPt := pt;
dwEffect := GetValidDropEffect(ShiftState, ClientPt, dwEffect);
// Get data from source and generate an OnDrop event unless we failed to
// get data.
try
if (FGetDataOnEnter or GetData(dwEffect)) then
begin
if (not AsyncTransfer) then
DoDrop(ShiftState, ClientPt, dwEffect);
end else
dwEffect := DROPEFFECT_NONE;
Result := S_OK;
except
// We must not allow exceptions to escape from any of the COM methods since
// COM doesn't support exceptions.
dwEffect := DROPEFFECT_NONE;
Result := E_UNEXPECTED;
end;
end;
if (DropTargetHelper <> nil) then
DropTargetHelper.Drop(DataObj, pt, dwEffect)
else
if (FDragImageHandle <> 0) and (FTarget <> nil) then
ImageList_DragLeave(FTarget.Handle);
finally
// clean up!
if (not AsyncTransfer) then
begin
ClearData;
FDataObject := nil;
FTarget := nil;
end;
FDropTargetHelper := nil;
end;
end;
の変更されたコードTCustomDropTarget.Drop。
function TCustomDropTarget.Drop(const dataObj: IDataObject; grfKeyState: Longint;
pt: TPoint; var dwEffect: Longint): HResult;
var
ShiftState: TShiftState;
ClientPt: TPoint;
begin
FScrollTimer.Enabled := False;
try
// Protect resources against exceptions in OnDrop event handler.
try
// Refuse drop if we have lost the data object somehow.
// This can happen if the drop is rejected in one of the other IDropTarget
// methods (e.g. DragOver).
if (not Enabled) or (FDataObject = nil) then
begin
dwEffect := DROPEFFECT_NONE;
Result := E_UNEXPECTED;
end else
begin
ShiftState := KeysToShiftStatePlus(grfKeyState);
// Create a default drop effect based on the shift state and allowed
// drop effects (or an OnGetDropEffect event if implemented).
if (FTarget <> nil) then
ClientPt := FTarget.ScreenToClient(pt)
else
ClientPt := pt;
dwEffect := GetValidDropEffect(ShiftState, ClientPt, dwEffect);
// Get data from source and generate an OnDrop event unless we failed to
// get data.
try
if (FGetDataOnEnter or GetData(dwEffect)) then
begin
if (not AsyncTransfer) then
DoDrop(ShiftState, ClientPt, dwEffect);
end else
dwEffect := DROPEFFECT_NONE;
Result := S_OK;
except
// We must not allow exceptions to escape from any of the COM methods since
// COM doesn't support exceptions.
dwEffect := DROPEFFECT_NONE;
Result := E_UNEXPECTED;
raise; // <--- Why can't I get the exception
end;
end;
if (DropTargetHelper <> nil) then
DropTargetHelper.Drop(DataObj, pt, dwEffect)
else
if (FDragImageHandle <> 0) and (FTarget <> nil) then
ImageList_DragLeave(FTarget.Handle);
finally
// clean up!
if (not AsyncTransfer) then
begin
ClearData;
FDataObject := nil;
FTarget := nil;
end;
FDropTargetHelper := nil;
end;
except
raise; // <--- Why can't I get the exception
end;
end;