asked on

Dragging in delphi 7

I wanna make the mobile game called '2248' on PC and I'm almost done, im just having a problem with the Accept parameter of the Dragover event. The problem is that I want the program to allow the dragging only the panel which's caption is identical, or if I have already dragged a few panels before then also allow the drag if the sum of the panels caption dragged before equals to the one im trying to drag to. And also, I dont want the panels to be able to dragged into panels that are not their 'close-neighbours', so only allowing to drag to the panels next to it.
Here is a picture of how It actually looks like, if u dont know the game:https://m.crazygames.com/game/2248

procedure TForm1.balklikk(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button=MBleft then begin
TPanel(sender).BeginDrag(True);
kiindulo:=strtoint(TPanel(sender).caption);
oszeg:=strtoint(TPanel(sender).caption);
end;
end;

procedure TForm1.over(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept :=(Source is Tpanel) and ((Tpanel(sender).caption=Tpanel(source).caption) or (oszeg=strtoint(Tpanel(Sender).caption)));
Tpanel(source).Tag:=1;
if (Source is Tpanel)
  and (Sender is Tpanel)
    and (Source <> Sender)
      and (Tpanel(Sender).Tag=0)
        and(Accept=true)
          and (State = dsDragEnter) then begin
z:=z+1; T2[z]:=Tpanel(Sender); Tpanel(Sender).Tag:=1; oszeg:=oszeg+strtoint(Tpanel(Sender).caption);
end;
end;

Open in new window

on the 'balklikk' event of the panel it just checks if it was a left click, if yes then the dragging begins. Also i have declared here a variable that later on in the over event counts the sum of the previously dragged panels captions. If the initial caption is= with the one we dragged to(source.caption=sender.caption) then it will go to a for cicle in which i store the dragged panels and also i increase the sum(oszeg) with the (sender), so next time something gets dragged, it also gets analyized whether the sum is = or not.

Geert G

fwiw, it's 2048
and it would look a lot better if you made the font a lot bigger
and it's a 4x4 grid

http://2048game.com

you only need to detect a left,right,up or down
dropping 1 panel on the other should evaluate the whole grid, not just that moved panel

if you need so many squares then i'm guessing you haven't gotten a high score in the 2048 game yet ?
i stopped at 16384

you basically only need the 4 arrow keys to play
dragging is not required

i'd use gestures if you really want to make it a little more nifty

add a gesturemanager
in the panel properties open touch property
assign the gesturemanager
open gestures, standard and check left, right, up and down

and then assign an event:

procedure TForm1.panel1_1Gesture(Sender: TObject;
  const EventInfo: TGestureEventInfo; var Handled: Boolean);
begin
  case EventInfo.GestureID of
    sgiLeft: ShowMessage('Left');
    sgiRight: ShowMessage('Right');
    sgiUp: ShowMessage('Up');
    sgiDown: ShowMessage('Down');
  end;
end;

Open in new window

Geert G

for fun , i coded the left bit:
I named all the panels as panelX_Y

panel1_1  panel1_2  panel 1_3 ... 
panel2_1  panel2_2  panel 2_3
...

Open in new window

function TForm1.pnl(X, Y: Integer): TPanel;
begin
  Result := TPanel(FindComponent(Format('panel%d_%d', [X, Y])));
end;

function TForm1.Nbr(X, Y: Integer): Integer;
begin
  Result := StrToIntDef(TPanel(FindComponent(Format('panel%d_%d', [X, Y]))).Caption, 0);
end;

function TForm1.Str2048(N: Integer): string;
begin
  Result := IntToStr(N);
  if Result = '0' then
    Result := '';
end;

procedure TForm1.panel1_1Gesture(Sender: TObject;
  const EventInfo: TGestureEventInfo; var Handled: Boolean);
var
  n, X, Y: Integer;
begin
  case EventInfo.GestureID of
    sgiLeft:
    begin
      // first move all items left
      for n := 1 to 2 do
        for Y := 1 to 4 do
          for X := n to 3 do
          begin
            if pnl(X, Y).Caption = '' then
            begin
              pnl(X,Y).Caption := pnl(X+1,Y).Caption;
              pnl(X+1,Y).Caption := '';
            end;
          end;
      // add all items
      for n := 1 to 2 do
        for Y := 1 to 4 do
          for X := n to 3 do
          begin
            if Nbr(X, Y) = Nbr(X+1, Y) then
            begin
              pnl(X,Y).Caption := Str2048(Nbr(X,Y)*2);
              pnl(X+1,Y).Caption := '';
            end;
          end;
      // move all items left again
        for Y := 1 to 4 do
          for X := 2 to 3 do
          begin
            if pnl(X, Y).Caption = '' then
            begin
              pnl(X,Y).Caption := pnl(X+1,Y).Caption;
              pnl(X+1,Y).Caption := '';
            end;
          end;
    end;
    sgiRight: ShowMessage('Right');
    sgiUp: ShowMessage('Up');
    sgiDown: ShowMessage('Down');
  end;
end;

Open in new window

Balázs Szabó

ASKER

No, i know the game 2048 and im not referring to that game, but the one called 2248, check it, i think it is also available on pc.But thanks your answer nonetheless.https://m.crazygames.com/game/2248

Geert G

that's different indeed
it doesn't only allow you to drag vertically/horizontally but also diagonally and you can continue dragging
and as you do, it connects to the previous tile

that's a whole different ballgame

Geert G

well, i managed to get such a trail going ...

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Touch.GestureMgr, Vcl.ExtCtrls,
  Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    panel1_1: TPanel;
    GestureManager1: TGestureManager;
    panel2_1: TPanel;
    panel3_1: TPanel;
    panel4_1: TPanel;
    panel1_2: TPanel;
    panel2_2: TPanel;
    panel3_2: TPanel;
    panel4_2: TPanel;
    panel1_3: TPanel;
    panel2_3: TPanel;
    panel3_3: TPanel;
    panel4_3: TPanel;
    panel1_4: TPanel;
    panel2_4: TPanel;
    panel3_4: TPanel;
    panel4_4: TPanel;
    Image1: TImage;
    Memo1: TMemo;
    procedure panel1_1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure panel1_1DragDrop(Sender, Source: TObject; X, Y: Integer);
  private
    fPanelPath: TStrings;
    procedure UpdatePath(Source, Sender: TPanel);
    procedure MsgItem(aName, aValue: string);
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;

  end;

var
  Form1: TForm1;

implementation

uses Math;

{$R *.dfm}

constructor TForm1.Create(aOwner: TComponent);
var bmp: TBitmap;
begin
  inherited Create(aOwner);
  fPanelPath := TStringList.Create;
  bmp := TBitmap.Create;
  bmp.Width := panel4_1.Left + panel4_1.Width - panel1_1.Left;
  bmp.Height := panel1_4.Top + panel1_4.Height - panel1_1.Top;
  bmp.Canvas.Brush.Color := clWhite;
  bmp.Canvas.FillRect(Rect(0,0, bmp.Width, bmp.Height));
  Image1.Picture.Graphic := Bmp;
end;

destructor TForm1.Destroy;
begin
  fPanelPath.Free;
  inherited Destroy;
end;

procedure TForm1.panel1_1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  // group everything together
end;

procedure TForm1.MsgItem(aName, aValue: string);
begin
  Memo1.Lines.Values[aName] := aValue;
end;

procedure TForm1.panel1_1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
    function Distance(X1, Y1, X2, Y2: Double): Double;
    begin
      Result:=sqrt(Power(X1-X2,2)+Power(Y1-Y2,2));
    end;
var curr, prev: TPanel;

begin
  Accept := False;
  if (Sender is TPanel) and (Source is TPanel) and (Sender <> Source) then
  begin
    curr := TPanel(Sender);
    prev := TPanel(Source);
    if Sender <> Source then
    begin
      MsgItem('pp', fpanelPath.DelimitedText);
      if fPanelPath.Count > 1 then
        prev := TPanel(FindComponent(fPanelPath[fPanelPath.Count-1]));
      MsgItem('curr', curr.Name);
      MsgItem('prev', prev.Name);
      Accept := ((fPanelPath.IndexOf(TPanel(Sender).Name) < 0) or
        (fPanelPath.IndexOf(TPanel(Sender).Name) >= fPanelPath.Count-1))
        and (Distance(curr.Left + curr.Width/2, curr.Top + curr.Height/2,
          prev.Left + prev.Width/2, prev.Top + prev.Height/2) < curr.Height * 3 );
      MsgItem('accept_drag_over', BoolToStr(Accept));
      UpdatePath(TPanel(Source), TPanel(Sender));
    end
      else
    begin
      // reset list
    end;
  end;

end;

procedure TForm1.UpdatePath(Source, Sender: TPanel);
var pp: TStrings;
  c: TCanvas;
  I: Integer;
  p1, p2: TPanel;
  b: TBitmap;
  im: TImage;
begin
  pp := fPanelPath;

    if pp.IndexOf(Source.Name) < 0 then
      pp.Append(Source.Name);
    if pp.IndexOf(Sender.Name) < 0 then
      pp.Append(Sender.Name);

  // Draw line objects in between panels
  im := Image1;
  b := TBitmap(im.Picture.Graphic);
  c := b.Canvas;
  c.Lock;
  try
    c.Brush.Color := clWhite;
    c.FillRect(Rect(0, 0, b.Width, b.Height));
    c.Pen.Style := psSolid;
    c.Pen.Color := clOlive;
    c.Pen.Width := 15;
    for I := 0 to pp.Count - 2 do
    begin
      p1 := TPanel(FindComponent(pp[I]));
      p2 := TPanel(FindComponent(pp[I+1]));
      c.MoveTo(Round(p1.Left - im.Left + p1.Width / 2), Round(p1.Top - im.Top + p1.Height / 2));
      c.LineTo(Round(p2.Left - im.Left + p2.Width / 2), Round(p2.Top - im.Top + p2.Height / 2));
    end;
  finally
    c.Unlock;
  end;
end;

end.

Open in new window

Balázs Szabó

ASKER

Did u put all those panels by hands ? Your code seems right, although im a begginner to delphi 7 so i dont know much, it seems like its good ?! Can ur code be made dynamically ?

function hatvany(r:integer):integer;
var negyzet:integer;
Begin
negyzet:=2;
while r>1 do begin
r:=r-1;
negyzet:=2*negyzet;
end;
hatvany:=negyzet;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  P:TPanel;
  kep: TImage;
  i,j,x,r: integer;
 begin
randomize;
z:=1;
s:=0;
for i:=1 to 7 do
  for j:=1 to 5 do begin
    r:=random(3)+1;
   P:= TPanel.Create(self);
   P.Parent := Form1;
   P.Visible := True;
   P.Caption := inttostr(hatvany(r));
   P.Enabled:=True;
   P.Width:=125;
   P.Height:=80;
   P.Top := 85*i-70;
   P.Left := 140*j+150;
   P.Tag:=0;
   T[i,j]:=P;
   P.DragMode:=dmManual;
   P.OnMouseDown:=balklikk;
   P.OnDragOver:=over;
   P.OnDragDrop:=drop;
  end;
 end;

Open in new window

But your way of drawing lines in directions was really helpful, i think i will use that solution if nothing else.So if u dont get the game fully going, its not a problem, you already contributed to my code a lot, and thanks :)).

Geert G

yeah, i put those panels by hand ... :)

is that a power of 2 function ?

try this:

uses Math

Result := Power(2, R);

Open in new window

Sinisa Vuk

Hi!

Was busy before..... but made an example too.... just some suggestions...

First, I use custom record to keep info about each panel:

const
  StartingValues: array[0..2] of Integer = (2, 4, 8);
  DefaultColor: TColor = clLtGray;
  SelectedColor: TColor = clYellow; //clSilver;
  MaxSelectionSize = 4;

type
  TPanelInfo = record
    x: Integer;
    y: Integer;
    Value: Integer;
    PanelObj: TPanel;
  end;

  TPanelInfoArray = array of TPanelInfo;

Open in new window

... then ... when creating game ... panel info is stored into array:

function GetNewValue(): Integer;
begin
  Result := StartingValues[ Random(Length(StartingValues)) ];
end;

procedure TForm1.CreatePanels(Parent: TWinControl; sx, sy, Margin: Integer);
var
  i, j, m, w, h, NewVal, idx: Integer;
  pnl: TPanel;
begin
  Parent.DestroyComponents;

  ClearSelection(SelectionList);
  SetLength(GameList, sx * sy);
  
  //calc sizes
  m := Margin; //margin

  //pw = sx * w + (sx+1) * m
  w := (Parent.Width - (sx + 1)*m) div sx;

  //py = sy * h + (sy+1) * m
  h := (Parent.Height - (sy + 1)*m) div sy;

  idx := 0;
  for i := 1 to sx do
  begin
    for j := 1 to sy do
    begin
      NewVal := GetNewValue(); //init value
      //panel
      pnl := TPanel.Create(Parent);
      pnl.Width := w;
      pnl.Height := h;
      pnl.Tag := idx;   //store idx of item in list
      pnl.Caption := IntToStr(NewVal);
      pnl.Left := (i * m) + (i-1) * w;
      pnl.Top := (j * m) + (j-1) * h;
      pnl.Color := DefaultColor;
      pnl.OnStartDrag := PanelStartDrag;
      pnl.OnEndDrag := PanelDragDrop;
      pnl.OnDragOver := PanelDragOver;
      pnl.OnMouseDown := PanelMouseDown;
      pnl.Parent := Parent;
      //game links
      GameList[idx].x := i;
      GameList[idx].y := j;
      GameList[idx].Value := NewVal;
      GameList[idx].PanelObj := pnl;

      Inc(idx);
    end;
  end;
end;

Open in new window

... this will create panels dynamically with custom params like : CreatePanels(Panel1, 5, 7, 20);

Panels are linked to mouse/Drag events like this:

procedure TForm1.PanelDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  //no match
  if not Assigned(Source) then
    ClearSelection(SelectionList)
  else  //do some calc
    AddToSelection(SelectionList, (Source as TWinControl), True, MaxSelectionSize);
end;

procedure TForm1.PanelDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := False;
  //not the same
  if Sender <> Source then
  begin
      //diff_x, diff_y, diff_mx, diff_my: Integer;
  //SelListTmp: TPanelInfoArray;

    Accept := IsNeighbourOrInLine(SelectionList, Sender as TWinControl);
    if Accept then
    begin
      //clear except first then add
      if Length(SelectionList) > 1 then
        SetLength(SelectionList,1);
        
      AddToSelection(SelectionList, (Sender as TWinControl), True, MaxSelectionSize)
    end;
  end;
end;

procedure TForm1.PanelMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    ClearSelection(SelectionList);

    (Sender as TWinControl).BeginDrag(True);
    //add first panel to list ...
    AddToSelection(SelectionList, (Sender as TWinControl), True, MaxSelectionSize);
  end;
end;

Open in new window

... with following functions/procedures I try to implement game logic ...
- to allow adding panels to list - only in straight line
- only to add 4 panels in a line
- to test if value of panel match before adding to list (if it is not right - then simply do not allow to add)

function TForm1.GetPanelInfo(pnl: TWinControl; var Info: TPanelInfo): Boolean;
var
  idx: Integer;
begin
  Result := False;
  ZeroMemory(@Info, SizeOf(TPanelInfo));

  idx := pnl.Tag;
  if (idx >= Low(GameList)) and (idx <= High(GameList)) then
  begin
    Info := GameList[idx];
    Result := True; //found it
  end;
end;

function TForm1.GetPanelInfo(x, y: Integer; var Info: TPanelInfo): Boolean;
var
  i: Integer;
begin
  Result := False;
  ZeroMemory(@Info, SizeOf(TPanelInfo));

  for i := Low(GameList) to High(GameList) do
  begin
    if (GameList[i].x = x) and (GameList[i].y = y) then
    begin
      Info := GameList[i];
      Result := True; //found it
      Break;
    end;
  end;
end;

function TForm1.AddInfoToList(var SelList: TPanelInfoArray; Info: TPanelInfo;
  MaxSelSize: Integer): Boolean;
begin
  Result := False;
  if (Length(SelList) < MaxSelSize) then
  begin
    SetLength(SelList, Length(SelList)+1);  //make room
    SelList[High(SelList)] := Info; //add info
    result := True;
  end;
end;

procedure TForm1.AddToSelection(var SelList: TPanelInfoArray; pnl: TWinControl;
  AddInBetweenToo: Boolean; MaxSelSize: Integer);
var
  Info, Info2: TPanelInfo;
  diff_x, diff_y, diff_mx, diff_my, l, x, y: Integer;
begin
  //find info
  if GetPanelInfo(pnl, Info) then
  begin
    l := Length(SelList);
    //empty?
    if l = 0 then
    begin
      AddInfoToList(SelList, Info, MaxSelSize);
    end
    else
    begin
      //add nodes in between
      //calc m....line coef.
      diff_mx := (Info.x - SelList[0].x);
      diff_my := (Info.y - SelList[0].y);

      x := SelList[0].x;
      y := SelList[0].y;

      if diff_mx = 0 then diff_x := 0
      else diff_x := Sign(diff_mx) * 1;

      if diff_my = 0 then diff_y := 0
      else diff_y := Sign(diff_my) * 1;

      while not ((Abs(x - Info.x)=0) and (Abs(y - Info.y)=0)) do
      begin
        x := x + diff_x;
        y := y + diff_y;

        if not GetPanelInfo(x, y, Info2) then Break;

        if not PanelIsSelected(SelList, Info2) then
        begin
          if Selection_Will_Be_2248(SelList, Info2.Value) then
            AddInfoToList(SelList, Info2, MaxSelSize)
          else  //do not use other.... once line was broken...
            Break;
        end;
      end;
    end;

    ShowSelection(SelList);
  end;
end;

procedure TForm1.ClearSelection(var SelList: TPanelInfoArray);
begin
  SetLength(SelList,0);

  ShowSelection(SelList);
end;

function TForm1.PanelIsSelected(SelList: TPanelInfoArray; Info: TPanelInfo): Boolean;
var
  k: Integer;
begin
  Result := False;

  for k := Low(SelList) to High(SelList) do
  begin
    Result := (Info.x = SelList[k].x) and (Info.y = SelList[k].y);
    if Result then Break;
  end;
end;

procedure TForm1.ShowSelection(SelList: TPanelInfoArray);
var
  i: Integer;
begin
  //reset all
  for i := Low(GameList) to High(GameList) do
  begin
    if PanelIsSelected(SelList, GameList[i]) then
    begin
      GameList[i].PanelObj.Color := SelectedColor;
      GameList[i].PanelObj.Invalidate;
    end
    else
    begin
      GameList[i].PanelObj.Color := DefaultColor;
      GameList[i].PanelObj.Invalidate;
    end; 
  end;
end;

function TForm1.IsNeighbourOrInLine(SelList: TPanelInfoArray; pnl: TWinControl): Boolean;
var
  i, l: Integer;
  Info: TPanelInfo;
  diff_x, diff_y, diff_mx, diff_my: Integer;
  SelListTmp: TPanelInfoArray;
begin
  Result := False;
  if GetPanelInfo(pnl, Info) then
  begin
    //append internal list
    SetLength(SelListTmp, Length(SelList)+1);
    l := Length(SelList);
    for i := Low(SelList) to High(SelList) do
    begin
      SelListTmp[i] := SelList[i];
    end;
    SelListTmp[High(SelListTmp)] := Info;

    //max items...
    if Length(SelListTmp) > MaxSelectionSize then Exit;

    //allow neighbours in all directions
    if l > 0 then
    begin
      //two or more selected - must be in the same line
      Result := True;
      //(y - y0) = m * (x - y0)  where m = (y1 - y0)/(x1 - x0)

      //calc m....
      diff_mx := (SelListTmp[1].x - SelListTmp[0].x);
      diff_my := (SelListTmp[1].y - SelListTmp[0].y);

      for i := 1 to l do
      begin
        diff_x := SelListTmp[l].x - SelListTmp[0].x;
        diff_y := SelListTmp[l].y - SelListTmp[0].y;

        //selection in one direction only
        if (Sign(diff_x) = Sign(diff_mx)) and (Sign(diff_y) = Sign(diff_my)) then
        begin
          if diff_mx = 0 then
          begin
            Result := Result and (diff_x = 0);
          end
          else
          begin
            Result := Result and (diff_y = (diff_x*diff_my/diff_mx));
          end;
        end
        else
          Result := False;

        if not Result then Break;
      end;
    end;
  end;
end;

function TForm1.Selection_Will_Be_2248(SelList: TPanelInfoArray; nextValue: Integer): Boolean;
var
  i, v_sum: Integer;
begin
  Result := (Length(SelList) > 0);
  v_sum := 0;
  //sum all elements before must be equal to next value
  for i := Low(SelList) to High(SelList) do
  begin
    //add to sum
    v_sum := v_sum + SelList[i].Value;
  end;

  Result := Result and (v_sum = nextValue);
end;

Open in new window

My intention was to show you how to use simple structure and more complex - array types - as one of many
ways to solve initial task. I use panel (color) highlighting instead of drawing line (Geert) - but combination would be even better I thought.

Geert G

why would you use an extra array when all info is already available ?
now you need to make sure everything is synchronized ...

i'm not planning on helping to write the game full out
haven't read all the specs of the game, played it a few times
it's got some odd rules, especially for dragging
you can keep combining the same number or go higher ... haven't figured out the logic (or read the rules) yet

Sinisa Vuk

I rather working in back (using arrays) ... to speed up some calculations (if panels are in line). My perception is that panels are just visuals ...
As I said ... there are many ways.... and it is good to know that they exists....

Geert G

not really much of a calculation here ... :)
besides ... my approach is wrong, it just doubles the numbers

it's possible to line up 8 panels of 2 to get 16
or like this:

gave 64, it's actually 68, but it was rounded down
now that i look at, i could joined 8 2's, 10 4's and 4 8's and i would still have only had 64

This question needs an answer!

Become an EE member today

7 DAY FREE TRIAL

Members can start a 7-Day Free trial then enjoy unlimited access to the platform.

View membership options

Learn why we charge membership fees

We get it - no one likes a content blocker. Take one extra minute and find out why we block content.