Форум: "Начинающим";
Текущий архив: 2007.06.03;
Скачать: [xml.tar.bz2];

Вниз

Доброго времени суток   Найти похожие ветки 

← →
Лысеющий Самурай   (2007-05-12 11:00) [0]

Доброго времени суток, подскажите пожалуйста как можно менять размер формы если у неё

BorderStyle:= bsNone;

и при загрузке

procedure TForm1.FormCreate(Sender: TObject);
var
 hRgn: integer;
begin
 hRgn:=CreateRoundRectRgn(1,1,ClientWidth,ClientHeight,5,5);
 SetWindowRgn(Handle, hRgn, true);
end;

---

← →
Loginov Dmitry ©   (2007-05-12 11:25) [1]

> Доброго времени суток, подскажите пожалуйста как можно менять
> размер формы если у неё
>
> BorderStyle:= bsNone;


Без рамочки нельзя вручную изменять размеры формы.

---

← →
Юрий Зотов ©   (2007-05-12 13:50) [2]

Можно обрабатывать WM_NCHITTEST и искусственно эмулировать рамку, возвращая нужный результат. Но при изменении размеров регион, видимо, придется пересоздавать.

---

← →
Лысеющий Самурай   (2007-05-12 18:17) [3]

Спасибо

---

← →
DVM ©   (2007-05-12 18:28) [4]

Как-то так:


unit Unit1;

interface

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

type
 TForm1 = class(TForm)
 private
   { Private declarations }
   procedure WMNCHitTest(var Message: TMessage); message WM_NCHITTEST;
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMNCHitTest(var Message: TMessage);
const
 Delta = 5;
var
 X, Y: Integer;
 Point: TPoint;
Begin
 inherited;
 if (not (csDesigning in ComponentState)) then
   begin
     Point.x := Message.LParamLo ;
     Point.y := Message.LParamHi;
     Point := ScreenToClient(Point);
     x := Point.x;
     y := Point.y;
     // Message.Result:=HTCLIENT;
     if (Align = alNone) then
       begin
         Message.Result := HTCAPTION;
        end;
     if Align <> alClient Then
       begin
         if ((Width - x) <= Delta) and ((Height - y) <= Delta) and (Align = alNone) then
           begin
             Message.Result := HTBOTTOMRIGHT;
             Exit;
           end;
         if (x <= Delta) and (y <= Delta) and (Align = alNone) then
           begin
             Message.Result := HTTOPLEFT;
             Exit;
           end;
         if ((Width - x) <= Delta) and (y  <= Delta) and (Align = alNone) then
           begin
             Message.Result := HTTOPRIGHT;
             Exit;
           end;
         if (x <= Delta) and (Height - y  <= Delta) and (Align = alNone) then
           begin
             Message.Result := HTBOTTOMLEFT;
             Exit;
           end;
         if ((Width - x) <= Delta) and (Align in [alNone,alLeft]) then
           Message.Result := HTRIGHT;
         if (x  <= Delta) and (Align in [alNone,alRight]) then
           Message.Result := HTLEFT;
         if ((Height - y) <= Delta) and (Align in [alNone , alTop]) then
           Message.Result := HTBOTTOM;
         if (y  <= Delta) and (Align in [alNone , alBottom]) then
           Message.Result := HTTOP;
       end;
   end;

end;

end.



---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2007.06.03;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.051 c