Drag Drop i samme Dbgrid

Det skulle da ikke være en umulighed. Hvad vil du opnå ved at trække rundt med linier i samme DBGrid?

Ved godt at min kommentar er som Microsofts hjælpetekst: Teknisk set uangribeligt, men i praksis aldeles ubrugeligt. Jeg kunne bare godt tænke mig lidt flere oplysninger inden jeg satte min ned og eksperimenterede.

Jeg har en Tabel i Access over en ugeplan. Mandag til Søndag. Og med Timer ned ad.
I disse felter har jeg 1 Min, 15Min, 30 Min, 1 Time.Disse bruges så til at fortælle mit program hvor tit det skal oprette forbindelse med modem /Web til en server.
Da tidspunkter kan varierer i løbet af en uge.
Min plan var så at jeg kunne trække et felt i Dbgrid til et andet felt i Dbgriden.
For ikke at skulle hente et felt i en edit boks hvergang.
Du ved dovnskab længe leve.
Håber du kan forstå det jeg har skrevet.

Først laver jeg en variant af TDragObject som indeholder oplysningerne som jeg vil flytte. Her flytter jeg alle data, men kunne egentlig også bare flytte nøglen på den record som jeg trækker.

  TMyDragObject = class(TDragObject)
  private
    fSparePart : integer;
    fDescription : string;
    fBought : integer;
    fNewPurchase : integer;
  public
    constructor Create(const aSparePart, aBought, aNewPurchase : integer; const aDescription : string);
    property SparePart : integer read fSparePart;
    property Description : string read fDescription;
    property Bought : integer read fBought;
    property NewPurchase : integer read fNewPurchase;
  end;

Næste træk er at få fundet den record som man vil flytte. Det kan lade sig gøre vha. et grimt hack - men under loven om nødværge og fordi Borland endnu ikke har valgt at ændre denne detalje, så kommer den her.

Vi har brug for et linienummer når vi begynder at trække. Ellers snupper den bare den record som tilfældigvis er valgt, ikke den man vil trække.

... men row findes ikke i TDBGrid..?

og jo. Den findes under Protected sektion, hvilket betyder at det kun er klasser der nedarver fra den, som kan se den.

... så det gør vi så:

type
  TDBGHack = class(TDBGrid);

... Sådan. Nu har vi en klasse hvorfra vi har adgang til Row.

procedure TfrmMain.dbgResultStartDrag(Sender: TObject; var DragObject: TDragObject);
var
  SparePart : integer;
  Description : string;
  Bought : integer;
  NewPurchase : integer;
  Row : integer;
  gc : TGridCoord;
begin
  // Her finder vi den valgte række og kolonne via musens position
  with Mouse.CursorPos do
    gc := dbgResult.MouseCoord(X,Y);

  // Her finder vi rækken. Bemærk at vi typecaster TDBGridden for at få fat i .Row
  Row := TDBGHack(dbgResult).Row;

  // Hvis vi får gode data tilbage, så flyt databasecursor til rækken
  if (gc.Y > 0) and (gc.X > 0) then begin
    dbgResult.DataSource.DataSet.MoveBy(gc.Y - Row);

    // Hent data ud af record og pak det ind i min variant af en TDragObject
    with ADOQueryView do begin
      SparePart := FieldByName('SparePart').AsInteger;
      Description := FieldByName('Description').AsString;
      Bought := FieldByName('Bought').AsInteger;
      NewPurchase := FieldByName('NewPurchase').AsInteger;
  end;

  // DragObject er en var-parameter så vi sender objektet ud på en rejse
  DragObject := TMyDragObject.Create(SparePart,Bought,NewPurchase,Description);
end;

procedure TfrmMain.dbgResultDragOver(Sender, Source: TObject; X, Y: Integer;
                                    State: TDragState; var Accept: Boolean);
begin
  case State of
    dsDragEnter : sbStatus.SimpleText := 'Elvis has entered the control';
    dsDragLeave : sbStatus.SimpleText := 'Elvis has left the control';
    dsDragMove : sbStatus.SimpleText := 'Elvis is moving around the control';
  end;
  Accept := (Source is TMyDragObject);
end;

procedure TfrmMain.dbgResultDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  DragObject : TMyDragObject;
begin
  DragObject := Source as TMyDragObject;
  try
    with ADOQueryInsert do begin
      Parameters.ParamByName('pSparePart').Value := DragObject.SparePart;
      Parameters.ParamByName('pDescription').Value := DragObject.Description;
      Parameters.ParamByName('pBought').Value := DragObject.Bought;
      Parameters.ParamByName('pNewPurchase').Value := DragObject.NewPurchase;
      ExecSql;
    end;
  finally
    DragObject.Free;
  end;
end;

Der er bare et par små hager:

1. I hjælpeteksten står at man skal frigive min TDragObject variant. Det er ikke et problem sålænge at man dropper den på en komponent der kan håndtere den, men hvad sker der hvis man smider den andetsteds? Hvordan får man den frigivet? Eneste løsning jeg kan tænke på er at lave en variabel i klassen:

  fDragObject : TMyDragObject;

Sætte den til nil i OnCreate

I min OnDestroy:

begin
  if assigned(fDragObject) then
    fDragObject.Free;
end;

I min OnDragStart

begin
  if assigned(fDragObject) then
    fDragObject.Free;

  fDragObject := TMyDragObject.Create(...)

  DragObject := fDragObject
end;

... men der må være en pænere metode.

2. Jeg kan ikke få DBGriddens MousePos til at returnere noget > 0. Min X-koordinat bliver sat fint, mens Y-eren er -1 => X bliver sat tilbage til -1. Den har jeg ikke løst endnu.

Det var en ordenlig smøre for så lidt.
Prøver lige imorgen. Eller måske først mandag.

I stedet for at lave et TDragObject kan man måske typecaste den til at være nøglen på den record man flytter: Et objekt er jo en pointer som er et tal der angiver hvilken adresse den ligger på. Hvis man tager nøglen og typecaster den, så får man nøglen med over uden at der oprettes noget som helst.

Inde i DragStart:

var
  Key : integer;
begin
  Key := FindPrimaereNøglePaaDenRecordDuVilFlytte;
  DragObject := TDragObject(Key);
end;

Det er grimt som ind i h......, men det er ret almindeligt brugt.

I din DragDrop vil det se ud som dette

var
  Key : integer;
begin
  Key := integer(Source);
  KopierRecord1OverIRecord2;
end;

Jeg arbejder lidt videre på det med at få DBGridden til at flytte ned til musens position. Kan godt være at DragMode (DragAction??) skal sættes til manuel, hvorved det måske bliver lettere at styre.

Hej Hrc.
Nu har jeg prøvet det du har lavet.
Kan desværre ikke få det til at køre.

Lukker

Lukker