Question

Using: Delphi XE2 Update 4.1, 32-bit VCL application, Windows 8

If DragMode is set to dmAutomatic the the OnStartDrag event is called; however if the DragMode is set to dmManual, the OnStartDrag event is bypassed.

Is this by design? How to ensure that OnStartDrag event is called?

EDIT: Code posted on request. The event in question is TTableDesigner.LblStartDrag which is not being executed after a call to BeginDrag (in TTableDesigner.LblOnMouseDown) .

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.

Answer 1

You’re in a method of ‘TTableDesigner’, if you do not qualify a method ‘Self’ is implied. So the ‘BeginDrag’ call applies to the TableDesigner object.

You’d rather call ‘TLabel(Sender).BeginDrag(..’.