Butonları taşıma

[brs]

Merhaba, android telefonda olduğu gibi, bir butonu yukarı, aşağıya veya sağa, sola taşımak istediğimde iki butonun birbirlerini yer değiştirmemelerini nasıl sağlaya bilirim...

[mrmarman]

Merhaba.

- Bu bahsedeceğim işlem butonu taşıma anını sürükle bırak şekilde gözlemleyemediğin halidir. Eğer görsel olarak butonun da mouse ile yer değişikliği yapmasını istersen, MouseDown, MouseMove, MouseUp durumularına göre bıraktığın nesnenin bırakma anındaki mouse koordinatının başka bir butona denk gelmesiyle yer değiştirmesi, aks halde eski konuma zıplamasını sağlamak gerekiyor.

- Burada her iki tekniğe de örnek veriyorum. Projenin kaynak kodları mesaj ekinde, açıklamalı olarak açık hallerini de mesaj içerisinde tarif etmeye gayret edeceğim. Forumda dama oyunu yapmak isteyen bir arkadaş da vardı, illa ki de nesne taşıma ile yapıcam diyordu. Ona da örnek olsun...

(1) Önce bir butonun MouseDown, StartDrag, DragOver, DragDrop özelliklerini kurmalısın. Sonra bunların dördünü de bir FormCreate olayında geriye kalan 8 butona da atamasını yaparsın, veya elle tek tek de yapabilirsin.

Kod: Tümünü seç

procedure TForm1.FormCreate(Sender: TObject);
Var
  i : Integer;
begin
  for i := 1 to 9 do
  begin
    With TButton( FindComponent( 'Button' + IntToStr(i) ) ) do
    begin
      OnMouseDown := Button1MouseDown;
      OnStartDrag := Button1StartDrag;
      OnDragOver  := Button1DragOver;
      OnDragDrop  := Button1DragDrop;
    end;
  end;
end;

(2) Bir adet GLOBAL değişken olarak TButton tanımla. Taşıma işlemi öncesi hangi butonun taşındığını buna atayacaksın.

Kod: Tümünü seç

Var
  xButton : TButton;

(3) Button'un StartDrag olayında bu değişkene ilgili butonu ata.

Kod: Tümünü seç

procedure TForm1.Button1StartDrag(Sender: TObject; var DragObject: TDragObject);
begin
  xButton := TButton(Sender);
end;

(4) Button'un OnDragOver olayında şunu yapıcaz. Üzerine taşınan nesne bir button mu yoksa başka bir şey mi ? Ayrıca kendi kendini taşımaya çalışmadığını da kontrol edicez.

Kod: Tümünü seç

procedure TForm1.Button1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var
  aControl : TControl;
begin
  aControl := FindVCLWindow(Mouse.CursorPos);
  if (  aControl is TButton ) AND ( aControl <> xButton )
    then Accept := True
    else Accept := False;
end;

(5) Geriye ne kaldı, DragDrop... Bu da butonu bıraktığın anlamına geliyor. Accept edilmiş bir butona DragDrop yaptığında, daha önce yedeğe aldığın xButton ile üzerine bırakılan butonun Left ve Top değerlerini swap edeceksin.

Kod: Tümünü seç

procedure TForm1.Button1DragDrop(Sender, Source: TObject; X, Y: Integer);
Var
  aLeft, aTop : Integer;
begin
  aLeft := xButton.Left;
  aTop  := xButton.Top;

  xButton.Left := TButton(Sender).Left;
  xButton.Top  := TButton(Sender).Top;

  TButton(Sender).Left := aLeft;
  TButton(Sender).Top  := aTop;
end;

// ---------------------------------------- //

Diğer bahsettiğim mouse ile taşıma anını görebildiğin metod ise aşağıdaki şekilde gerçekleşiyor. DragDrop işlemi kullanmadan tümüyle ilüzyon ile hallediyoruz.

(1) Önce yedekte tutacağımız bilgiler için Global değişkenleri tanımlıyoruz.

Kod: Tümünü seç

Var
  xTasinanButton : TButton = Nil;
  xLeft, xTop    : Integer;
  xP             : TPoint;
  xDragMod       : Boolean = False;

(2) Bir butonun MouseDown, MouseOver, MouseUP özelliklerini kurmalısın. Sonra bunların dördünü de yukarıdaki şekilde bir FormCreate olayında geriye kalan 8 butona da atamasını yaparsın, veya yine elle tek tek de yapabilirsin.

Kod: Tümünü seç

Var
  i : Integer;
begin
  for i := 10 to 18 do
  begin
    With TButton( FindComponent( 'Button' + IntToStr(i) ) ) do
    begin
      OnMouseDown := Button10MouseDown;
      OnMouseUp   := Button10MouseUp;
      OnMouseMove := Button10MouseMove;
    end;
  end;
end;

(3) Mouse hareketlerinin tanımlanması...

Kod: Tümünü seç

procedure TForm1.Button10MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if xTasinanButton = nil then
  begin
    xTasinanButton := TButton(Sender);
    xTasinanButton.BringToFront;
    xLeft := xTasinanButton.Left;
    xTop  := xTasinanButton.Top;
    xP.X  := X;
    xP.Y  := Y;
    xDragMod := True;
  end;
end;

procedure TForm1.Button10MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if xDragMod then
  begin
    TButton(Sender).Left := TButton(Sender).Left + (X - xP.X);
    TButton(Sender).Top  := TButton(Sender).Top  + (Y - xP.Y);
  end;
end;

procedure TForm1.Button10MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  aControl : TControl;
  aLeft, aTop : Integer;
begin
  xTasinanButton.Visible := False; // Bunu yapmazsak arkada kalan butonu anlayamıyoruz.
  aControl := FindVCLWindow( Mouse.CursorPos );
  xTasinanButton.Visible := True;
  if xDragMod AND ( aControl is TButton ) AND ( aControl <> xTasinanButton )
    then begin
      ShowMessageFmt(' %s - %s arasında yer değişikliği olacak...', [ xTasinanButton.Name, aControl.Name ]);
      aLeft := xLeft;
      aTop  := xTop;

      xTasinanButton.Left := TButton(aControl).Left;
      xTasinanButton.Top  := TButton(aControl).Top;

      TButton(aControl).Left := aLeft;
      TButton(aControl).Top  := aTop;
      xTasinanButton := Nil;
    end
    else begin
      xTasinanButton.Left := xLeft;
      xTasinanButton.Top  := xTop;
      xTasinanButton := Nil;
    end;
  xDragMod := False;
end;

Aşağıdaki ekran kopyasında taşıma anında cursor farklı görünüyor. Aslında taşıma sırasında dilediğiniz şekle büründürebilirsiniz. crHandPoint, crDrag vs. vs.

[brs]

Üstat elinize sağlık....

[hido]

Hocam butonların left ve top larını nasıl alırız ben denedim ama olmadı...

Kod: Tümünü seç

procedure TForm1.Button10MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  AControl: TControl;
  ALeft, ATop: Integer;
begin
  XTasinanButton.Visible := False;
  AControl := FindVCLWindow(Mouse.CursorPos);
  XTasinanButton.Visible := True;
  if XDragMod AND (AControl is TButton) AND (AControl <> XTasinanButton) then
  begin
    // ShowMessageFmt(' %s - %s arasında yer değişikliği olacak...',
    // [xTasinanButton.Name, aControl.Name]);
    ALeft := XLeft;
    ATop := XTop;

    XTasinanButton.Left := TButton(AControl).Left;
    XTasinanButton.Top := TButton(AControl).Top;

    TButton(AControl).Left := ALeft;
    TButton(AControl).Top := ATop;
    XTasinanButton := Nil;
  end
  else
  begin
    XTasinanButton.Left := XLeft;
    XTasinanButton.Top := XTop;
    XTasinanButton := Nil;
  end;
  XDragMod := False;

  Label1.Caption := XLeft;
  Label2.Caption := XTop;
  Label3.Caption := ALeft;
  Label4.Caption := ATop;
end;

Kod: Tümünü seç

  
  Label1.Caption := XLeft;
  Label2.Caption := XTop;
  Label3.Caption := ALeft;
  Label4.Caption := ATop;
 

[mrmarman]

Hangi butonun mesela ?

Taşıma anında ise şöyle yap, hani ShowMessage var ya orayı // ile Comment yapmışsın, oranın altına şöyle yaz.

xTasinanButton, aControl elindeki iki buton olduğuna göre

Kod: Tümünü seç

  Label1.Caption := xTasinanButton.Left;
  Label2.Caption := xTasinanButton.Top;
  Label3.Caption := TButton(aControl).Left;
  Label4.Caption := TButton(aControl).Top;

[hido]

Hangi butonun mesela ?

Taşıma anında ise şöyle yap, hani ShowMessage var ya orayı // ile Comment yapmışsın, oranın altına şöyle yaz.

xTasinanButton, aControl elindeki iki buton olduğuna göre

Kod: Tümünü seç

  Label1.Caption := xTasinanButton.Left;
  Label2.Caption := xTasinanButton.Top;
  Label3.Caption := TButton(aControl).Left;
  Label4.Caption := TButton(aControl).Top;

Hocam left ve top alamıyorum

[mrmarman]

Bunu hataya bakarak da anlayabilirdin. Bize hata mesajını yazmadığın halde bakınca bir an durdum. IntToStr yaz demeyi unutmuşum aceleden.

Kod: Tümünü seç

  Label1.Caption := IntToStr( xTasinanButton.Left );
  Label2.Caption := IntToStr( xTasinanButton.Top );
  Label3.Caption := IntToStr( TButton(aControl).Left );
  Label4.Caption := IntToStr( TButton(aControl).Top );

[dogan]

mrmarman hocam, yapmış olduğunuz buton taşıma olayını ben resim için uyguluyorum, projemizdeki kodları alıp yeni bir proje oluşturup ve gerekli değişiklikleri yaptım. Ancak bir yerde takıldım toplam on resim var en üsteki resim boyutları 250 x 250 diğerleri ise 75 x 75 yukarı taşıdım resim ile yeri değiştiren resim boyutlarını nasıl düzenleye bilirim...


http://s3.dosya.tc/server2/1m47nx/Foto.rar.html

[mrmarman]

Taşıdığın resmi biliyorsun, yerine koyup takas yapacağın resmi de. Öyleyse helva yapmak kalıyor.
Mesaj verdirdiğim yer var ya, hani şu ile şu yer değiştirilecek diyor. Orada şöyle yap.

aResim ve bResim olsunlar, bResim'in boyutlarını yedekle, sonra bResim'in büyüklüğünü aResim ile eşitle. Sonra yedeklediğin boyutları bu defa aResim'e uygula

Örnek:

Kod: Tümünü seç

Var
  iTakasHeight, iTakasWidth : Integer;
begin
  iTakasWidth  := bResim.Width;
  iTakasHeight := bResim.Height;

  bResim.Width  := aResim.Width;
  bResim.Height := aResim.Height;

  aResim.Width  := iTakasWidth;
  aResim.Height := iTakasHeight;
end;

[Dostk]

Hocam mrmarman buton taşıma olayını TButton ları TSpeedButton denedim olmadı. SpeedButton bu işlem için uygun değil mi?

[mrmarman]

Sınıfları farklı ancak her ikisi de TControl ailesinden olduğu için aşağıdaki şekilde yapabilirsin.

xButton global değişkeni TButton olarak kalsın. Bize o şekliyle lazım.

- FindComponent zaten değişecek... Bu uyumlu olsa da olacaktı.
- Ancak dikat edersen TSpeedButton parantezin değil de eskiden olduğu gibi TButton parantezine olarak CAST'ını DragDrop uyumlu olana çektik.
- Ne de olsa bu iki sınıf bir biriyle kuzenler.

Kod: Tümünü seç

    With TButton( FindComponent( 'SpeedButton' + IntToStr(i) ) ) do
    begin
      OnMouseDown := Button1MouseDown;
      OnStartDrag := Button1StartDrag;
      OnDragOver  := Button1DragOver;
      OnDragDrop  := Button1DragDrop;
    end;

- Geriye DragOver kısmını düzenlemek kaldı.

Kod: Tümünü seç

procedure TForm1.Button1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  if ( Source is TSpeedButton ) AND ( TButton(Sender) <> xButton )
    then Accept := True
    else Accept := False;
end;

[Dostk]

Sınıfları farklı ancak her ikisi de TControl ailesinden olduğu için aşağıdaki şekilde yapabilirsin.

xButton global değişkeni TButton olarak kalsın. Bize o şekliyle lazım.

- FindComponent zaten değişecek... Bu uyumlu olsa da olacaktı.
- Ancak dikat edersen TSpeedButton parantezin değil de eskiden olduğu gibi TButton parantezine olarak CAST'ını DragDrop uyumlu olana çektik.
- Ne de olsa bu iki sınıf bir biriyle kuzenler.

Kod: Tümünü seç

    With TButton( FindComponent( 'SpeedButton' + IntToStr(i) ) ) do
    begin
      OnMouseDown := Button1MouseDown;
      OnStartDrag := Button1StartDrag;
      OnDragOver  := Button1DragOver;
      OnDragDrop  := Button1DragDrop;
    end;

- Geriye DragOver kısmını düzenlemek kaldı.

Kod: Tümünü seç

procedure TForm1.Button1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  if ( Source is TSpeedButton ) AND ( TButton(Sender) <> xButton )
    then Accept := True
    else Accept := False;
end;

Hocam sanırım yanlış anlaşıldı, SpeedButton'un "OnStartDrag" özellği yok...

[mrmarman]

Ben de kuzenlerinin var onu ödünç al diyorum

Bir buton koy ona getekli eventleri uygula, sonra onları speedbutonlara sana gösterdiğim şekilde ata.

Kodunu verdiğim şekilde düzenleyip denersen TSpeedButton'un gizli kalmış da olsa bu özelliğini kazanacaksın.

Başarmaya çalış, olmadı söyle sana destek olayım.

.. Ama bir şartım var, örnek proje kurup öyle deneyecek, başaramadığın noktada örnekle destek olacağım.

[G.Arkas]

Sınıfları farklı ancak her ikisi de TControl ailesinden olduğu için aşağıdaki şekilde yapabilirsin.

xButton global değişkeni TButton olarak kalsın. Bize o şekliyle lazım.

- FindComponent zaten değişecek... Bu uyumlu olsa da olacaktı.
- Ancak dikat edersen TSpeedButton parantezin değil de eskiden olduğu gibi TButton parantezine olarak CAST'ını DragDrop uyumlu olana çektik.
- Ne de olsa bu iki sınıf bir biriyle kuzenler.

Kod: Tümünü seç

    With TButton( FindComponent( 'SpeedButton' + IntToStr(i) ) ) do
    begin
      OnMouseDown := Button1MouseDown;
      OnStartDrag := Button1StartDrag;
      OnDragOver  := Button1DragOver;
      OnDragDrop  := Button1DragDrop;
    end;

- Geriye DragOver kısmını düzenlemek kaldı.

Kod: Tümünü seç

procedure TForm1.Button1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  if ( Source is TSpeedButton ) AND ( TButton(Sender) <> xButton )
    then Accept := True
    else Accept := False;
end;

Hocam sanırım yanlış anlaşıldı, SpeedButton'un "OnStartDrag" özellği yok...

Kendi metodunu yazabilirsin.

Kod: Tümünü seç

procedure BenimButonunDragOveri(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);

Bunu çağırıken OnDragOver özelliği olan bir componentten faydalanarak çağırabilirsin.


FormCreate'de

Kod: Tümünü seç

TPanel(SpeedButton1).OnDragOver:=BenimButonunDragOveri;

[Dostk]

Ben de kuzenlerinin var onu ödünç al diyorum

Bir buton koy ona getekli eventleri uygula, sonra onları speedbutonlara sana gösterdiğim şekilde ata.

Kodunu verdiğim şekilde düzenleyip denersen TSpeedButton'un gizli kalmış da olsa bu özelliğini kazanacaksın.

Başarmaya çalış, olmadı söyle sana destek olayım.

.. Ama bir şartım var, örnek proje kurup öyle deneyecek, başaramadığın noktada örnekle destek olacağım.

Maalesef yapamadım, yardımcı olursanız sevinirim...


http://www.dosya.tc/server5/w12l8g/Butt ... n.rar.html