label kaydırma

[master_20]

merhaba arkadaşlar, top=223 left=636 olan labeli timerla top=401, left=299 a orantılı bir şekilde kaydırmak istiyorum fakat ya top ya da left önce geliyor :s bu algoritmayı nasıl yaparım ?

[orhancc]

iki kenar arasındaki eşitliği sağlayana kadar düz sola gidiyor işine yarayacaksa kullan.

Kod: Tümünü seç

var
  sol,ust,fark:Integer;
begin
  if (label1.Left<299) or (Label1.Top < 401) then
    begin
    sol := Label1.Left-299;
    ust := 401-Label1.Top;
//    fark := sol-ust;
    if sol>ust then
      Label1.Left := Label1.Left-1
    else
      Label1.Top := Label1.Top+1;

[sabanakman]

Başlama ve bitiş koordinat değerlerini değişik değerlerle çalışabilecek bir mantık gerekirse bu örnek işe yarayabilir.

Kod: Tümünü seç

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    procedure Tasi;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var aL,aT,oY:Extended; zL,zT,oD:Integer; Bitir:Boolean;

procedure TForm1.Button1Click(Sender: TObject);
begin
  aL:=636; aT:=223; //Başlama noktası
  zL:=299; zT:=401; //Bitiş noktası
  if aT>zT then oD:=-1 else oD:=1; //Dikey hareket oranı
  oY:=Abs((zL-aL)/(zT-aT));  //Yatay hareket oranı (pozitif değeri)
  if aL>zL then oY:=-oY; //
  Tasi;
  Bitir:=False;
  Timer1.Enabled:=True;
end;

procedure TForm1.Tasi;
begin
  Label1.Left:=Round(aL);
  Label1.Top:=Round(aT);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var L,T:Integer;
begin
  L:=Round(aL);
  T:=Round(aT);
  repeat
    aL:=aL+oY; //Yatay art
    aT:=aT+oD; //Dikey art
  until (Round(aL)<>L) and (Round(aT)<>T); //Her iki yönde (sol,üst) birden gideceği kadar geç
  if oY<0 then Bitir:=Bitir or (aL<=zL) else Bitir:=Bitir or (aL>=zL);
  if oD<0 then Bitir:=Bitir or (aT<=zT) else Bitir:=Bitir or (aT>=zT);
  if Bitir then begin
    aL:=zL;
    aT:=zT;
    Timer1.Enabled:=False;
  end;
  Tasi;
end;

end.

Yukarıda hareketi hesaplayan

Kod: Tümünü seç

  L:=Round(aL);
  T:=Round(aT);
  repeat
    aL:=aL+oY; //Yatay art
    aT:=aT+oD; //Dikey art
  until (Round(aL)<>L) and (Round(aT)<>T);

kodlarını döngü içinden çıkarmak (repeat-until döngüsünü kaldırmak) aynı hareketi sağlar ama hareket daha yavaş gerçekleşir.

[master_20]

Başlama ve bitiş koordinat değerlerini değişik değerlerle çalışabilecek bir mantık gerekirse bu örnek işe yarayabilir.

Kod: Tümünü seç

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    procedure Tasi;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var aL,aT,oY:Extended; zL,zT,oD:Integer; Bitir:Boolean;

procedure TForm1.Button1Click(Sender: TObject);
begin
  aL:=636; aT:=223; //Başlama noktası
  zL:=299; zT:=401; //Bitiş noktası
  if aT>zT then oD:=-1 else oD:=1; //Dikey hareket oranı
  oY:=Abs((zL-aL)/(zT-aT));  //Yatay hareket oranı (pozitif değeri)
  if aL>zL then oY:=-oY; //
  Tasi;
  Bitir:=False;
  Timer1.Enabled:=True;
end;

procedure TForm1.Tasi;
begin
  Label1.Left:=Round(aL);
  Label1.Top:=Round(aT);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var L,T:Integer;
begin
  L:=Round(aL);
  T:=Round(aT);
  repeat
    aL:=aL+oY; //Yatay art
    aT:=aT+oD; //Dikey art
  until (Round(aL)<>L) and (Round(aT)<>T); //Her iki yönde (sol,üst) birden gideceği kadar geç
  if oY<0 then Bitir:=Bitir or (aL<=zL) else Bitir:=Bitir or (aL>=zL);
  if oD<0 then Bitir:=Bitir or (aT<=zT) else Bitir:=Bitir or (aT>=zT);
  if Bitir then begin
    aL:=zL;
    aT:=zT;
    Timer1.Enabled:=False;
  end;
  Tasi;
end;

end.

Yukarıda hareketi hesaplayan

Kod: Tümünü seç

  L:=Round(aL);
  T:=Round(aT);
  repeat
    aL:=aL+oY; //Yatay art
    aT:=aT+oD; //Dikey art
  until (Round(aL)<>L) and (Round(aT)<>T);

kodlarını döngü içinden çıkarmak (repeat-until döngüsünü kaldırmak) aynı hareketi sağlar ama hareket daha yavaş gerçekleşir.

hocam proramı çalıştırdığım zaman kilitleniyor.. kodları kontrol edebilri misin ?

[mrmarman]

Başka bir açıdan bakabilmen için şöyle bir fonksiyon hazırladım.


Kullanımı Şöyle

Kod: Tümünü seç

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  Label1.Left := 636;
  Label1.Top  := 223;
  Kaydir( Label1, 636, 223, 299, 401, 10 );
  ShowMessage('Bitti');
end;

Tasarlanan Procedure ise aşağıdaki şekilderir.

Kod: Tümünü seç

Procedure Kaydir( Lbl:TLabel; L1, T1, L2, T2, Bekleme : Integer );
Var
  aL, aT : Integer;
  vFark, hFark  : Integer;
  vEkle, hEkle  : Integer;
begin
    aL := L1;
    aT := T1;
  if T1 < T2 then begin
    vEkle := 1;
  end else begin
    vEkle := -1;
  end;
  if L1 < L2 then begin
    hEkle := 1;
  end else begin
    hEkle := -1;
  end;

  while (aL <> L2) AND (aT <> T2) do begin
  // Trük burada:
    // Farkı "küçük" olana sadece 1 eklenecek,
    // Farkı "BÜYÜK" olana büyük küçük arasındaki ORAN kadar eklenecek.
    // Artı veya Eksi yönünün zaten vEkle ile hEkle ile önceden belirlemiştik.
  // Farklar
    vFark := ABS(aT-T2);
    hFark := ABS(aL-L2);

    if vFark < hFark then
    begin
      inc(aT, vEkle);
      inc(aL, (hFark div vFark)*hEkle);
    end else
    begin
      inc(aL, hEkle);
      inc(aT, (vFark div hFark)*vEkle);
    end;
    Lbl.Left := aL;
    Lbl.Top  := aT;
    Lbl.Caption := Format('%d,%d', [aL, aT]);
    Sleep(Bekleme);
    Application.ProcessMessages;
  end;
end;

[sabanakman]

hocam proramı çalıştırdığım zaman kilitleniyor.. kodları kontrol edebilri misin ?

Garip, bunu boş projede çalıştırıp öyle cevaplamıştım. Kilitlenme nedeni faklı bir şey olabilir mi? Mesela koordinatları değiştirip özel bir değer mi yakaladınız. Hatta örnek proje ekte, indirip deneyebilirsiniz.