使用: Delphi XE2 Update 4.1、32 ビット VCL アプリケーション、Windows 8
DragMode が dmAutomatic に設定されている場合、OnStartDrag イベントが呼び出されます。ただし、DragMode が dmManual に設定されている場合、OnStartDrag イベントはバイパスされます。
これは設計によるものですか?OnStartDrag イベントが確実に呼び出されるようにするにはどうすればよいですか?
編集:リクエストに応じて投稿されたコード。問題のイベントは、BeginDrag (TTableDesigner.LblOnMouseDown 内) の呼び出し後に実行されていない TTableDesigner.LblStartDrag です。
unit uTableDesigner;
interface
uses
System.SysUtils, System.Classes, Vcl.Controls, Graphics, JvCaptionPanel,
StdCtrls, ExtCtrls;
type
TMyTable = record
TableName: String;
TableFields: TStrings;
TableObject: Pointer;
end;
PMyTable = ^TMyTable;
TTableDesigner = class(TCustomControl)
procedure CreateWnd; override;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure LblOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure LblDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure LblDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure LblEndDrag(Sender, Target: TObject; X, Y: Integer);
procedure LblStartDrag(Sender: TObject; var DragObject: TDragObject);
// procedure Paint; override;
private
{ Private declarations }
FTableList: TList;
FCaptionPanelList: TList;
FPanelSlot_Left: Integer;
FPanelSlot_Top: Integer;
FStartDragPnl: TJvCaptionPanel;
FDragHoverPnl: TJvCaptionPanel;
FEndDragPnl: TJvCaptionPanel;
procedure HighlightPanelLabel(ALabel: TLabel);
protected
{ Protected declarations }
public
{ Public declarations }
procedure AddTable(const ATableName: String; const AFields: TStrings);
procedure DeleteTable(const ATableName: String);
procedure DeleteAllTables;
published
{ Published declarations }
property Align;
property Visible;
property Color;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TTableDesigner]);
end;
constructor TTableDesigner.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FTableList := TList.Create;
FCaptionPanelList := TList.Create;
FPanelSlot_Left := 40;
FPanelSlot_Top := 40;
end;
destructor TTableDesigner.Destroy;
begin
DeleteAllTables;
FTableList.Free;
FCaptionPanelList.Free;
inherited;
end;
procedure TTableDesigner.CreateWnd;
begin
inherited;
end;
procedure TTableDesigner.AddTable(const ATableName: String; const AFields: TStrings);
var
pnl: TJvCaptionPanel;
c, h, j: Integer;
lbl: TLabel;
MyTable: PMyTable;
begin
pnl := TJvCaptionPanel.Create(Self);
pnl.Parent := Self;
pnl.Color := clWhite;
pnl.Caption := ATableName;
pnl.CaptionPosition := dpTop;
pnl.Left := FPanelSlot_Left;
pnl.Top := FPanelSlot_Top;
// FPanelSlot_Left := FPanelSlot_Left + pnl.Width + 40;
// if FPanelSlot_Left > ClientWidth - 100 then
// begin
// FPanelSlot_Left := 40;
//
// j := 0;
// for c := 0 to FTableList.Count - 1 do
// if j < TJvCaptionPanel(TMyTable(FTableList.Items[c]^).TableObject).Height then
// j := TJvCaptionPanel(TMyTable(FTableList.Items[c]^).TableObject).Height;
//
// FPanelSlot_Top := FPanelSlot_Top + j + 40;
// end;
h := 0;
for c := 0 to AFields.Count - 1 do
begin
lbl := TLabel.Create(pnl);
lbl.Parent := pnl;
lbl.Align := alTop;
lbl.Caption := AFields[c];
lbl.Transparent := False;
lbl.ParentColor := False;
lbl.DragKind := dkDrag;
lbl.OnMouseDown := LblOnMouseDown;
lbl.OnDragDrop := LblDragDrop;
lbl.OnDragOver := LblDragOver;
lbl.OnEndDrag := LblEndDrag;
lbl.OnStartDrag := LblStartDrag;
// lbl.DragMode := dmAutomatic;
h := h + lbl.Height + 4;
end;
pnl.ClientHeight := pnl.CaptionHeight + h;
MyTable := AllocMem(SizeOf(TMyTable));
Initialize(MyTable^);
MyTable.TableName := ATableName;
MyTable.TableFields := TStringList.Create;
MyTable.TableFields.Assign(AFields);
MyTable.TableObject := pnl;
FTableList.Add(MyTable);
end;
procedure TTableDesigner.DeleteTable(const ATableName: String);
var
c: Integer;
begin
for c := 0 to FTableList.Count - 1 do
if TMyTable(FTableList.Items[c]^).TableName = ATableName then
begin
TJvCaptionPanel(TMyTable(FTableList.Items[c]^).TableObject).Free;
TMyTable(FTableList.Items[c]^).TableFields.Free;
Finalize(TMyTable(FTableList.Items[c]^));
FreeMem(FTableList.Items[c]);
FTableList.Delete(c);
Break;
end;
end;
procedure TTableDesigner.DeleteAllTables;
var
c: Integer;
begin
for c := FTableList.Count - 1 downto 0 do
begin
TJvCaptionPanel(TMyTable(FTableList.Items[c]^).TableObject).Free;
TMyTable(FTableList.Items[c]^).TableFields.Free;
Finalize(TMyTable(FTableList.Items[c]^));
FreeMem(FTableList.Items[c]);
FTableList.Delete(c);
end;
end;
procedure TTableDesigner.HighlightPanelLabel(ALabel: TLabel);
var
pnl: TJvCaptionPanel;
c: Integer;
begin
pnl := TJvCaptionPanel(ALabel.Parent);
for c := 0 to pnl.ControlCount - 1 do
if pnl.Controls[c] = ALabel then
TLabel(pnl.Controls[c]).Color := clHighlight
else
TLabel(pnl.Controls[c]).Color := pnl.Color;
end;
procedure TTableDesigner.LblOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
HighlightPanelLabel(TLabel(Sender));
BeginDrag(False, 4);
end;
procedure TTableDesigner.LblDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
FEndDragPnl := TJvCaptionPanel(TLabel(Sender).Parent);
FEndDragPnl.Color := clWhite;
end;
procedure TTableDesigner.LblDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
FDragHoverPnl := TJvCaptionPanel(TLabel(Sender).Parent);
FDragHoverPnl.Color := clGreen;
Accept := True;
end;
procedure TTableDesigner.LblEndDrag(Sender, Target: TObject; X, Y: Integer);
begin
TJvCaptionPanel(TLabel(Sender).Parent).Color := clPurple;
end;
procedure TTableDesigner.LblStartDrag(Sender: TObject; var DragObject: TDragObject);
begin
FStartDragPnl := TJvCaptionPanel(TLabel(Sender).Parent);
FStartDragPnl.Color := clRed;
end;
// procedure TTableDesigner.Paint;
// var
// c: Integer;
// begin
// inherited;
//
// // Canvas.Pen.Mode := pmBlack;
// // Canvas.Pen.Color := clBlack;
// // Canvas.Pen.Style := psSolid;
// // Canvas.Pen.Width := 1;
// // Canvas.MoveTo(50, 50);
// // Canvas.LineTo(500, 500);
//
// end;
end.