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.
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 :)