Figuras elásticas
Um macete para esticar, puxar, espremer figuras, etc

Quando o Windows foi desenvolvido os computadores mais potentes da época eram os 286/386 que atingiam as espantosas velocidades de 12 e 25 Mhz. Um assombro. Mesmo operando em modo 16 cores e na resolução 640 x 480, neste tipo de máquina o deslocamento de áreas gráficas, por envolver grandes quantidades de bytes, era um problema.

A solução adotada para, por exemplo deslocar uma janela de um lugar para outro na tela, foi bem simples: criar um retângulo do tamanho da área e deslocá-lo. Só no final do movimento, então, é que o conteúdo da área era transferido.

Mas o mundo evoluiu. As placas TrueColor se tornaram, hoje em dia, indispensáveis. Os Pentiuns com mais de 1400 Mhz estão aí mesmo, fazendo a cabeça de 10 em cada 10 usuários. Então, por que razão continuar com uma solução tão pobre, para os deslocamentos na tela?

Foi pensando nisso que resolvi "dar uma incrementada" em meus programas e partí para criar rotinas genéricas de deslocamento. No começo tudo parecia ser muito simples, afinal os objetos no Delphi possuem propriedades de arrastar. Mas eu queria algo diferente: ver a figura deslocando-se.

A primeira opção foi criar um evento OnMouseMove numa dada TImage (que chamei de "Area"). Como esse evento devolve as coordenadas X,Y do mouse, bastava então atualizar as propriedades Top e Left da TImage. Foi um desastre total.

Ficou claro que seria necessário criar antes uma série de definições e regras para que o deslocamento se efetivasse como desejado.

O primeiro ponto foi estabelecer que duas variáveis globais integer (Kx e Ky) seriam usadas para guardar o ponto inicial do movimento - dado pelo evento OnMouseDown sobre a TImage. Usei mais uma variável global integer (Lk) para estabelecer o estado de movimento da figura (Lk = 1) ou não (Lk <> 1).

Veja como ficou:

  procedure TForm1.AreaMouseDown(Sender: TObject;
    Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  begin
    Kx:= X; Ky:= Y; Lk:= 1;
  end;

A seguir bastou monitorar o movimento do mouse, pelo evento OnMouseMove:

  procedure TForm1.AreaMouseMove(Sender: TObject;
   Shift: TShiftState;  X,  Y: Integer);
  begin
    if Lk = 1 then begin
    if X > Kx then Area.Left:= Area.Left + (X - Kx) else
       Area.Left:= Area.Left - (Kx - X);
       if Y > Ky then Area.Top:= Area.Top + (Y - Ky) else
          Area.Top:= Area.Top - (Ky - Y);
    end;
  end;

A coisa é bem simples: conhecendo o tamanho do deslocamento e seu sinal (mais ou menos), podemos transportar essa diferença para as propriedade Left e Top da TImage. Assim, o cursor do mouse estará sempre sobre o mesmo ponto da TImage, enquanto ela muda de lugar. Fica parecendo que ela "grudou" no cursor. Não corremos o risco de "perder" o evento OnMouseMove pois o cursor nunca sai de dentro da figura, não importa quão grande seja o deslocamento.

Para desligar o "arrastão", basta zerar a variável Lk no evento OnMouseUp:

  procedure TForm1.AreaMouseUp(Sender: TObject;
   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  begin
    Lk:= 0;
  end;

Viu só como é fácil. Mas eu queria mais: criar uma alça para redimensionar a figura. A solução foi aplicar essa mesma técnica num objeto que serviria como alça. Usei um TShape, ao qual dei o nome de Alca. É claro que dimensionei-o de tal forma a se parecer um uma alça padrão do Windows. No final, ele foi colocado no canto inferior direito da TImage. Lembrando que o TShape precisa estar sobre a TImage para que tudo funcione direitinho.

Para "ligar" e "desligar" o redimensionamento basta usar os mesmo eventos OnMouseDown e OnMouseUp da TImage. Com isso economizamos digitação. O evento OnMouseMove, do TShape Alca, ficou assim:

  procedure TForm1.AlcaMouseMove(Sender: TObject;
   Shift: TShiftState;  X, Y: integer);
  var
    Tmpx,Tmpy: integer;
  begin
    if Lk = 1 then begin
      Tmpx:= Alca.Left; Tmpy:= Alca.Top;
      if X > Kx then Alca.Left:= Alca.Left + (X - Kx) else
                     Alca.Left:= Alca.Left - (Kx - X);
      if Y > Ky then Alca.Top:= Alca.Top + (Y - Ky) else
                     Alca.Top:= Alca.Top - (Ky - Y);
      if Tmpx < Alca.Left then
         Area.Width:= Area.Width+(Alca.Left-Tmpx) else
         Area.Width:= Area.Width-(Tmpx-Alca.Left);
      if Tmpy < Alca.Top then
         Area.Height:= Area.Height+(Alca.Top-Tmpy) else
         Area.Height:= Area.Height-(Tmpy-Alca.Top);
    end;
  end;

Criei duas variáveis temporárias (Tmpx e Tmpy) para auxiliar no cálculo das novas dimensões da figura. Agora, ao deslocar o TShape dentro da TImage, ela vai sendo redimensionada.

Lembre-se que, para tudo isso funcionar corretamente a propriedade AutoSize, da TImage, deve ser ajustada para False e a propriedade Stretch para True.

Volte lá no evento OnMouseMove da TImage e acrescente as coordenadas do TShape Alca, para que ele permaneça sempre no cantinho da figura, quando a deslocarmos pelo formulário:

  procedure TForm1.AreaMouseMove(Sender: TObject;
   Shift: TShiftState; X,  Y: Integer);
  begin
    if Lk = 1 then begin
      Tmpx:= Area.Left; Tmpy:= Area.Top;
      if X > Kx then begin
        Area.Left:= Area.Left + (X - Kx);
        Alca.Left:= Alca.Left + (X - Kx); end
      else begin
        Area.Left:= Area.Left - (Kx - X);
        Alca.Left:= Alca.Left - (Kx - X); end;
      if Y > Ky then begin
        Area.Top:= Area.Top + (Y - Ky);
        Alca.Top:= Alca.Top + (Y - Ky); end
      else begin
        Area.Top:= Area.Top - (Ky - Y);
        Alca.Top:= Alca.Top - (Ky - Y); end;
    end;
  end;

Gostou? Clique no link abaixo para baixar o fonte completo desta "bolação".


Download...
Clique no link para fazer o download dos arquivos. Se sua assinatura do club TILT está para vencer, clique aqui e saiba como renová-la.

Fontes completos do exemplo da matéria
 
online