Programowanie w języku Delphi » Gotowce

Przyklejanie okna ala WinAmp, inaczej ;-)

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

kuty 2013-01-27 14:35

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.

Patryk27 2009-09-15 19:31

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

zoltek 2003-04-30 09:16

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

lofix 2003-04-23 09:12

UZYWAJ  TAGOW < delphi > i </ delphi >

piotr_12345 2003-04-22 14:18

@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 !

zoltek 2003-04-22 10:23

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