Mouse - movento labels em caracteres e nao em pixels

Top  Previous  Next

{

  Este exemplo pode ser usado para criar uma configuracao de nota fiscal ou boleto 

  bancario onde o usuario podera mover os campos (labels) com o mouse, ate ai

  nada de anormal, o que é interessante é que ele move em CARACTERES e não em pixels

  Para funcionar crie uma form com um label e coloque fonte MONOESPACADA.

 

  Voce ainda pode gravar / ou setar as configuracoes usando a linha e coluna

  atraves das funcoes  GetX, GetY (coluna e linha) e SetaXY( seta linha e coluna).

}

 

var

  BtPress             : Boolean;

  PosMouseX, PosMouseY: Integer;

 

////////////////////////////////////////////////////// Funções de calculos de caracter x pixels

 

procedure SetaXY(const Col, Lin: Integer; Variavel: TCustomLabel);

begin

  Variavel.Left := ((Col-1) * Variavel.Canvas.TextWidth('X'))  + 1;  // estes +1 e -2 é só para ficar *um pouquinho*

  Variavel.Top  := ((Lin-1) * Variavel.Canvas.TextHeight('X')) - 2;  // mais centralizado

end;

 

function GetX(Variavel: TCustomLabel): Integer;

begin

  Result := (Variavel.Left div Variavel.Canvas.TextWidth('X')) + 1;

  if Result < 1 then Result := 1;

end;

 

function GetY(Variavel: TCustomLabel): Integer;

begin

  // Aqui abaixo eu some +8 para poder ficar melhor para o usuário fazer movimento com o mouse

  // se ficar 0 funciona mais se o usuario soltar faltando 1 pixel para linha de baixo ele pula

  // para a de cima, o 8 são 8 pixels de tolerancia neste sentido.

  Result := ((Variavel.Top + 8) div Variavel.Canvas.TextHeight('X')) + 1;

  if Result < 1 then Result := 1;

end;

 

///////////////////////////////////////////////////// Mouse

 

procedure TForm1.ValorLabelMouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

  BtPress   := True; // Só move se o InfoPanel estiver em Alt ou Inc

  PosMouseX := X;

  PosMouseY := Y;

end;

 

procedure TForm1.ValorLabelMouseMove(Sender: TObject; Shift: TShiftState;

  X, Y: Integer);

var

  R: TRect;

  S: string;

  PX, PY : Integer;

begin

  inherited;

  if not BtPress then Exit;

 

  // Calcula posicao do Label levando em conta que deve mexer em caracteres e nào em pixels:

  PX := TLabel(Sender).Left + X - PosMouseX;

  PX := (PX div TLabel(Sender).Canvas.TextWidth('X')) + 1;

  if PX < 1 then PX := 1;

  PX := ((PX - 1) * TLabel(Sender).Canvas.TextWidth('X')) + 1;

 

  PY := TLabel(Sender).Top + Y - PosMouseY;

  PY := ((PY + 8) div TLabel(Sender).Canvas.TextHeight('X')) + 1;

  if PY < 1 then PY := 1;

  PY := ((PY - 1) * TLabel(Sender).Canvas.TextHeight('X')) - 2;

 

  TLabel(Sender).Top := PY;

  TLabel(Sender).Left:= PX;

 

  // Ve se extrapolou os limites máximos X-Y

  if GetX(TLabel(Sender)) > 78 then SetaXY( 78, GetY(TLabel(Sender)), TLabel(Sender));

  if GetY(TLabel(Sender)) > 18 then SetaXY( GetX(TLabel(Sender)), 18, TLabel(Sender));

end;

 

procedure TForm1.ValorLabelMouseUp(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

  BtPress := False;

end;

.