Procedure Tfrmprincipal.wmnchittest(var Msg: Twmnchittest);

[Paulo Nobre]

Tenho um form sem caption(bsnone) com um label(serve para brincar de fazer relógio).

Uso para isso a procedure abaixo:

procedure TfrmPrincipal.WMNCHitTest(var Msg: TWMNCHitTest);

begin

inherited;

If GetAsynckeyState(VK_LBUTTON) < 0 Then

msg.Result := HTCAPTION

Else

msg.Result := HTCLIENT;

end;

Clicando no label o form se movimenta.

Primeiro problema:

Se colocar no form um memo, clicando nele(e arrastando), o form não se movimenta.

Como poderia fazer para ficar igual ao label????

Segundo problema:

Com o código acima independentemente do modo como o form está(borderStyle)

mesmo bsSizeable não se consegue alterar o seu tamanho.

Tem que ser assim mesmo?

Preciso de algo que talvez seja impossível, mas vai a pergunta:

O form tem que ter bsNone sem caption, movimentando-se com a procedure acima

e podendo ter seu tamanho alterado.Existe um milagre para isto.

Explicando o objetivo:

Isto é para uma simulação de um POst-It, que nada mais é que memo dentro de um

form(sem caption) com a propriedade align para alclient. Só que eu gostaria que

ele pudesse ser dimensionado.

Tem como resolver estes problemas?

[Thales Pontes Martins]

É Paulo, suponho que você tenha declarado essa procedure dessa maneira->

   
type
  TForm1 = class(TForm)
  .
  .
  Protected  
    procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHitTest;
  .
  .

se é isso, você tem que lembrar que a mensagem está sendo enviada somente para o controle do form, e o memo é um outro controle. Para ser enviada para o memo esta procedure tem que estar declarada no memo, para isso é preciso derivar um novo componente da classe TMemo ->

  THMemo = class(tmemo)
  protected
    procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHitTest;
  end;

só que nesse caso ocorrerá um novo problema: Ao se arrastar clicando no memo, somente o memo se move dentro do form, o form mesmo continua parado.

Nesse caso acho melhor você fazer a movimentação do form combinando o evento OnMouseDown do memo com a alteração das propriedades Top e Left do form.

O caso do redimensionamento também pode ser resolvido da mesma forma, combinando-se os eventos OnMouseDown de algum componente colocado na borda do form com a alteração das propriedades Width e Height do form.

Se tiver alguma dificuldade avisa aí que mandarei alguns códigos de exemplo.

[Thales Pontes Martins]

É o seguinte Paulo, fiz aqui oque você desejava, vou postar a unit inteira, e se quiser me passar seu email posso mandoar o projeto inteiro. É so você colocar um form BsNone, coloca um memo e deixa alNone mas com todas as Anchors ligadas. A posição do memo deverá ser colada a esquerda e em cima do form, porem deixando 5 pixels de distância em baixo e a direita, para dar espaço ao bevel de redimensionamento. Com todas as ancoras ligadas o memo se redimensiona sozinho. Aí a unit que deverá ser escrita é essa ( Lembre-se de mudar o nome das variáveis, no meu caso é Form3. E lembre-se que depois de colar a unit você deverá ir até o abject inspector e atribuir aos eventos as devidas procedures[ FormCreate, FormClose, Memo1MouseDown, Memo1MouseUp...... ] ) ->

unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type

  TResizex = class(TBevel)
  private
    drag : boolean;
  protected
    procedure MouseDown(Button:TMouseButton; Shift:TShiftState;X,Y: Integer); override;
    procedure MouseUp(Button:TMouseButton; Shift:TShiftState;X,Y: Integer); override;
  end;

  TResizey = class(TBevel)
  private
    drag : boolean;
  protected
    procedure MouseDown(Button:TMouseButton; Shift:TShiftState;X,Y: Integer); override;
    procedure MouseUp(Button:TMouseButton; Shift:TShiftState;X,Y: Integer); override;
  end;


  TForm3 = class(TForm)
    Memo1: TMemo;
    Bevel1: TBevel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure Memo1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Memo1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);


  private
    { Private declarations }
    rx : TResizex;
    ry : TResizey;
    drag : boolean;
  protected

  public
    { Public declarations }

  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}


procedure TResizex.MouseDown(Button:TMouseButton; Shift:TShiftState;X,Y: Integer);
var act : TPoint;
begin
  //GetCursorPos(off);
  //dec(off.X,left); dec(off.Y,top);
  drag:=true;
  repeat
    GetCursorPos(act);
    form3.width:=act.x-form3.left;
    Application.ProcessMessages;
  until not(drag);
end;

procedure TResizex.MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
begin
  drag:=false;
end;

procedure TResizey.MouseDown(Button:TMouseButton; Shift:TShiftState;X,Y: Integer);
var act : TPoint;
begin
  //GetCursorPos(off);
  //dec(off.X,left); dec(off.Y,top);
  drag:=true;
  repeat
    GetCursorPos(act);
    form3.height:=act.y-form3.top;
    Application.ProcessMessages;
  until not(drag);
end;

procedure TResizey.MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
begin
  drag:=false;
end;


procedure TForm3.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  rx.Free;
  ry.Free;
end;

procedure TForm3.FormCreate(Sender: TObject);
begin
  rx:=TResizex.Create(Form3);
  rx.Parent:=form3;
  rx.Align:=alright;
  rx.width:=5;
  rx.Cursor:=crsizewe;

  ry:=TResizey.Create(Form3);
  ry.Parent:=form3;
  ry.Align:=albottom;
  ry.height:=5;
  ry.Cursor:=crsizens;
end;

procedure TForm3.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var off, act : TPoint;
begin
  GetCursorPos(off);
  dec(off.X,left); dec(off.Y,top);
  drag:=true;
  repeat
    GetCursorPos(act);
    left:=act.X-off.X;
    top:=act.Y-off.Y;
    Application.ProcessMessages;
  until not(drag);
end;

procedure TForm3.Memo1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  drag:=false;
end;

end.

[Paulo Nobre]

Grande Thales,

Obrigado por mais esta força.

Vou estudar o código.

[]s

[Thales Pontes Martins]

Para deixar com aspecto melhor pode-se aumentar em 1 ou 2 pixels a largura e altura do memo, assim esconde mais o bevel. ;)

[Paulo Nobre]

Fiz isso e ficou ótimo.

Está funcionando redondinho.

[Thales Pontes Martins]

e lembrando que se você quiser sumir com o bevel você pode colocar lá no form create rx.shape:=bsBottonLine; e ry.shape:=BsRightLine.

e lembrando que é possível adaptar outro componente ou o código dos já existentes para fazer o redimensionamento na diagonal.

e lembrando que é possível deixar o form tranparente com as propriedades TransparentColor e TransparentColorValue para que apareça só o memo, sem a borda.

e lembrando que é possivel derivar um componente do memo e escrever o código que faça isso sem nessecidade do bevel.

e lembrando, não, agora eu vou parar de encher o saco.

[Paulo Nobre]

Realmente, Thales, tinha pensado no detalhe que você mencionou da diagonal, mas os outros, realmente não. Valeu pelas sugestões. Parece que programação é algo infinito né. Não é a toa que as versões dos programas não terminam nunca.

[Micheus]

Com licença Thales, permita-me um pitaco...

O form tem que ter bsNone sem caption, movimentando-se com a procedure acima

e podendo ter seu tamanho alterado.Existe um milagre para isto.

Pegando um gancho...

Se juntarmos parte do seu código(Thales) e do código inicial do Paulo Nobre, dá para encolher um pouco o código e ter a questão do resize igualzinho como ocorre numa janela com bordas.

Considerei uma borda de 2 pixels. A propriedade left e top do Memo1 definem ela, porém, acho que uns 3 ficaria melhor para manipular.

No código abaixo, utilizando WM_NCHITTEST do Paulo adaptado, basta mover o cursor até as bordas para visualizar a alteração do cursor e clicar e arrastar para realizar o resize. Já para mover a janela, a parte do código do Thales para este fim continua a mesma, sendo apenas retirada a utilização dos bevels.

unit Unit1;
interface
uses
  Windows, Messages, Classes, Forms, Controls, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure Memo1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Memo1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    drag : boolean;
    procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHitTest;
  end;

var
  Form1: TForm1;

implementation
{$R *.dfm}

procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var off, act : TPoint;
begin
  GetCursorPos(off);
  dec(off.X,left); dec(off.Y,top);
  drag:=true;
  repeat
    GetCursorPos(act);
    left:=act.X-off.X;
    top:=act.Y-off.Y;
    Application.ProcessMessages;
  until not(drag);
end;

procedure TForm1.Memo1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  drag:=false;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FormResize(Sender);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  Memo1.Width := Width -(Memo1.Left*2);
  Memo1.Height := Height -(Memo1.Top*2);
end;

procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
var
  xPos,
  yPos :Integer;
  Flag :byte;
begin
  inherited;
  Flag := 0;
  xPos := (Msg.XPos -Left);
  yPos := (Msg.YPos -Top);

  if xPos <= Memo1.Left then
    Flag := $10
  else if xPos >= (Memo1.Left +Memo1.Width) then
    Flag := $01;
  if yPos <= Memo1.Top then
    Flag := Flag or $20
  else if yPos >= (Memo1.Top +Memo1.Height) then
    Flag := Flag or $02;

  case Flag of
    $10 : Msg.Result := HTLEFT;
    $01 : Msg.Result := HTRIGHT;
    $20 : Msg.Result := HTTOP;
    $02 : Msg.Result := HTBOTTOM;
    $20 or $10 : Msg.Result := HTTOPLEFT;
    $20 or $01 : Msg.Result := HTTOPRIGHT;
    $02 or $10 : Msg.Result := HTBOTTOMLEFT;
    $02 or $01 : Msg.Result := HTBOTTOMRIGHT;
  end;
end;

end.

[]s

[Thales Pontes Martins]

Grande Micheus, Gênio. Se eu conhecesse a mensagem direito não precisaria de fazer aquela gambiarra toda...

[Micheus]

Se eu conhecesse a mensagem direito não precisaria de fazer aquela gambiarra toda...

Resqüícios do tempo em que utilizando o Borland Pascal for Windows (faz tempo), tinhamos que criar os procedimentos de janela e, com isso, acabavamos por ter que conhecer/entender algunas das principais mensagens do Windows. Com certeza hoje, inda ajuda bastante.

As coisas estão mais fávocês hoje em dia. :D

[]s

[Paulo Nobre]

Micheus,

O código ficou show de bola.