Przyklejanie okna ala WinAmp, inaczej ;-)

piotr_12345

Sposób który przedstawię wykorzystuje standardowe eventy i jedną procedurę przejmującą obsługę przesuwania okna....

Oto gotowiec :-)

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    GroupBox2: TGroupBox;
    Edit1: TEdit;
    Panel1: TPanel;
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    procedure setPos(left, top : integer);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  klik : boolean;               // kiedy trzymamy przycisk
  pos : TPoint;                 // pozycja aktualna
  leftT, topT : integer;        // prawdziwe odległości
  przyklejanie : integer = 50;  // moc ;-)
  pozaOkno : boolean = true;    // czy przesuwać poza pulpit

procedure TForm1.setPos(left, top : integer);
begin
  TopT:=top;
  LeftT:=left;

  if (LeftT<=screen.WorkAreaLeft+przyklejanie) and (not pozaOkno or (Left>=screen.WorkAreaLeft))then form1.Left:=screen.WorkAreaLeft
  else if (leftT+form1.Width>=screen.WorkAreaLeft+screen.WorkAreaWidth-przyklejanie) and (not pozaOkno or (leftT+form1.Width<=screen.WorkAreaLeft+screen.WorkAreaWidth)) then form1.Left:=screen.WorkAreaLeft+screen.WorkAreaWidth-form1.Width
  else form1.Left:=LeftT;

  if (TopT<=screen.WorkAreaTop+przyklejanie) and (not pozaOkno or (TopT>=screen.WorkAreaTop)) then form1.Top:=screen.WorkAreaTop
  else if (TopT+form1.Height>=screen.WorkAreaTop+screen.WorkAreaHeight-przyklejanie) and (not pozaOkno or (TopT+form1.Height<=screen.WorkAreaTop+screen.WorkAreaHeight)) then form1.top:=screen.WorkAreaTop+screen.WorkAreaHeight-form1.Height
  else form1.Top:=TopT;

  if not pozaOkno then
    begin
      if leftT<screen.WorkAreaLeft then leftT:=screen.WorkAreaLeft;
      if leftT>screen.WorkAreaLeft+screen.WorkAreaWidth-form1.Width then leftT:=screen.WorkAreaLeft+screen.WorkAreaWidth-form1.Width;
      if topT<screen.WorkAreaLeft then topT:=screen.WorkAreaLeft;
      if topT>screen.WorkAreaTop+screen.WorkAreaHeight-form1.Height then topT:=screen.WorkAreaTop+screen.WorkAreaHeight-form1.Height;
    end;

end;

procedure TForm1.RadioButton1Click(Sender: TObject);
begin
  pozaOkno := true;
end;

procedure TForm1.RadioButton2Click(Sender: TObject);
begin
  pozaOkno:=false;
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  przyklejanie := StrToIntDef(form1.Edit1.Text,20);
  getCursorPos(pos);
  klik:=true;
  topT:=form1.Top;
  leftT:=form1.Left;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  tmp : TPoint;
begin
  if klik then
    begin
      GetCursorPos(tmp);
      setPos(leftT+tmp.X-pos.X, TopT+tmp.Y-pos.Y);
      pos:=tmp;
    end;
end;

procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  klik := false;
end;

end.

6 komentarzy

Proponuję zobaczyć artykuł http://programistakuty.pl/przyciaganie-okna-aplikacji/. Tam jest rzeczowo wytłumaczone jak zastosować przyciąganie okna aplikacji. Ten wyżej przykład niestety nie pozwala na przyciąganie do głównego okna aplikcaji. Ja proponuję zastosować algorytm z linku. Dodatkowo jest obsługa przyciągania do wybranych okien własnego programu.

Wspaniały art !
Tego szukałem !
6+ :)

Nie mam pojecia gdzie to znalazlem, ale nie bylem i nie jestem az tak dobry w Delphi zeby napisac sobie samemu takie cos :) wiec musialem tego szukac w necie :) :P i gdzies cos takiego znalazlem... :) ale sory adresu nie pamietam... :(

UZYWAJ TAGOW < delphi > i </ delphi >

@zoltek : to powiedz jeszcze gdzie to znalazłeś, bo szukałem takiej procedury i nigdzie nie mogłem znaleść. W końcu sam WCZORAJ napisałem :) .....

Pozdrawiam !

Nie widze w tym pomysle niczego "INNEGO" kozystalem z teo juz chyba z 1,5 roku temu...
znalazlem to kiedys, gdzies na zagranicznych serwerach... ale oczywiscie sposob dobry :)