Forms que grudam nas outras como no winnamp

Delphi

06/07/2005

estou tentando fazer forms que grudam umas nas outras pelos cantos, igual as forms do winnamp. fiz um código que funciona, mas porcamente, tá meio feinho, tipo, quando chega perto da ´área´ que é ára ´grudar´, ela fica piscando, porque fica grudando e desgrudando.

abaixo segue o código, meu problema é com a lógica, quem puder me ajudar, ficarei muito grato!

type
  TfrmConfig = class(TForm)
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    arrastando: boolean;
    MouseDownSpot: TPoint;

    topo, rodape, esquerda, direita: integer;
    Mtopo, Mrodape, Mesquerda, Mdireita: integer;
    NovaEsquerda, NovaDireita, NovoTopo, NovoRodape: integer;
    function pegaforms: TForm;
  public
    { Public declarations }
  end;

var
  frmConfig: TfrmConfig;

const
  DISTANCIAJANELA = 50;

implementation

{$R *.dfm}

procedure TfrmConfig.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  topo := top;
  rodape := top + Height;
  esquerda := left;
  direita := left + Width;

  Mtopo := pegaforms.Top;
  Mrodape := pegaforms.Top + pegaforms.Height;
  Mesquerda := pegaforms.Left;
  Mdireita := pegaforms.Left + pegaforms.Width;

  NovaEsquerda := Mesquerda - Width;
  NovaDireita := Mdireita;
  Novotopo := mtopo - Height;
  NovoRodape := Mrodape;

  if arrastando then
  begin

    self.Left := self.Left - (MouseDownSpot.x - x);
    self.Top := self.Top - (MouseDownSpot.y - y);

    //grudar a form nos cantos
     //esquerda
    if (direita <= mesquerda + DISTANCIAJANELA) and
      (direita >= mesquerda - DISTANCIAJANELA) and (direita <> mesquerda) then
    begin
      left := NovaEsquerda;
      arrastando := false;
    end;
    //*********************************************************************

    //direita
    if (esquerda <= mdireita + DISTANCIAJANELA) and
      (esquerda >= mdireita - DISTANCIAJANELA) and (esquerda <> mdireita) then
    begin
      left := NovaDireita;
      arrastando := false;
    end;
    //*********************************************************************

    //topo
    if (rodape <= mtopo + DISTANCIAJANELA) and
      (rodape >= mtopo - DISTANCIAJANELA) and (rodape <> mtopo) then
    begin
      top := NovoTopo;
      arrastando := false;
    end;
    //*********************************************************************

    //rodape
    if (topo <= mrodape + DISTANCIAJANELA) and
      (topo >= mrodape - DISTANCIAJANELA) and (topo <> mrodape) then
    begin
      top := NovoRodape;
      arrastando := false;
    end;
    //*********************************************************************

    if GetAsyncKeyState(VK_LBUTTON) < 0 then
    begin
      arrastando := true;
    end;
  end;

end;

procedure TfrmConfig.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  SetCapture(self.Handle);
  arrastando := true;
  MouseDownSpot.X := x;
  MouseDownSpot.Y := Y;
end;

procedure TfrmConfig.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if arrastando then
  begin
    ReleaseCapture;
    arrastando := false;
    self.Left := self.Left - (MouseDownSpot.x - x);
    self.Top := self.Top - (MouseDownSpot.y - y);
  end;

end;

function TfrmConfig.pegaforms: TForm;
begin
  result := application.MainForm;
end;



Vitor Rubio

Vitor Rubio

Curtidas 0
POSTAR