Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: WinAPI и системное программирование > Регион не растягивается


Автор: Олег_Игоревич 21.4.2006, 15:45
Здравствуйте!
Подскажите пожалуйста, как можно при создании региона указать, чтобы окно можно было растянуть.Создаю при помощи CreateRoundRectRegion.
Вот код:
Код
   r := Form1.ClientRect;
   rgn := CreateRoundRectRgn(r.Left, r.top, r.right, r.bottom, 20,18);
   Form1.BorderStyle := bsNone;
   SetWindowRgn(Form1.Handle, rgn, true);

Заранее спасибо.   

Автор: Alexeis 21.4.2006, 15:55
Олег_Игоревич, не знаю правильно ли вас понял, но нестандартные регионы windows вроде как неумеет растягивать.
я могу и ошибаться. 

Автор: Rouse_ 21.4.2006, 16:47
Пересоздавать регион при ресайзе формы... 

Автор: Олег_Игоревич 21.4.2006, 19:36
Спасибо.Сейчас попробую. 

Автор: Олег_Игоревич 22.4.2006, 11:04
Приведите пожалуйста пример растягивания региона.
Что-то не пойму как это сделать.
Заранее спасибо. 

Автор: x77 22.4.2006, 11:43
Код

procedure TForm1.UpdateRegion;
var
  Rgn: hRGN;
begin
  Rgn := CreateRoundRectRgn(0, 0, Width, Height, 20,18);
  SetWindowRgn(Handle, Rgn, true);
  DeleteObject (Rgn);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
//  Form1.BorderStyle := bsNone;
  UpdateRegion;
end;

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


твоя проблема в том, что ты выставляешь BorderStyle в bsNone, что запрещает растягиваться самой форме, а регионы тут как бы и не при чём smile

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

Автор: Олег_Игоревич 22.4.2006, 23:20
Вот я хочу именно при BorderStyle в bsNone и осуществить ресайзинг.Покажите пример.
Спасибо. 

Автор: Rouse_ 4.5.2006, 14:26
Код

unit Unit12;

interface

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

type
  TForm12 = class(TForm)
    procedure FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer;
      var Resize: Boolean);
    procedure FormCreate(Sender: TObject);
  public
    hRegion: THandle;
    procedure RefreshRegion;
    procedure WMNCMLButtonDown(var Message: TMessage); message WM_NCLBUTTONDOWN;
  end;

var
  Form12: TForm12;

implementation

{$R *.dfm}

procedure TForm12.FormCanResize(Sender: TObject; var NewWidth,
  NewHeight: Integer; var Resize: Boolean);
begin
  RefreshRegion;
end;

procedure TForm12.FormCreate(Sender: TObject);
begin
  RefreshRegion;
end;

procedure TForm12.RefreshRegion;
begin
  hRegion := CreateEllipticRgn(0, 0, Width, Height);
  SetWindowRgn(Handle, hRegion, True);
  DeleteObject(hRegion);
end;

procedure TForm12.WMNCMLButtonDown(var Message: TMessage);
const
  EnableFulDrag: UINT = 1;
var
  TmpBool: UINT;
begin
  SystemParametersInfo(SPI_GETDRAGFULLWINDOWS, 0, @TmpBool, 0);
  SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, EnableFulDrag, nil, 0);
  inherited;
  SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, TmpBool, nil, 0);
end;

end.


Добавлено @ 14:27 
А, блин... не внимательно прочитал. Что-то про рамку подумал а не про bsNone smile

Добавлено @ 14:40 
Тогда вот так:

Код

unit Unit12;

interface

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

type
  TForm12 = class(TForm)
    procedure FormShow(Sender: TObject);
    procedure FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer;
      var Resize: Boolean);
    procedure FormCreate(Sender: TObject);
  public
    hRegion: THandle;
    procedure RefreshRegion;
    procedure WMNCMLButtonDown(var Message: TMessage); message WM_NCLBUTTONDOWN;
  end;

var
  Form12: TForm12;

implementation

type
  THackScrollingWinControl = class(TScrollingWinControl);

{$R *.dfm}

procedure TForm12.FormCanResize(Sender: TObject; var NewWidth,
  NewHeight: Integer; var Resize: Boolean);
begin
  RefreshRegion;
end;

procedure TForm12.FormCreate(Sender: TObject);
begin
  BorderStyle := bsNone;
  SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE)
    or WS_THICKFRAME or WS_BORDER);
  RefreshRegion;
end;

procedure TForm12.FormShow(Sender: TObject);
begin
  THackScrollingWinControl(Self).AutoScroll := True;
  if not THackScrollingWinControl(Self).AutoScroll then
    ShowMessage('qwe');
end;

procedure TForm12.RefreshRegion;
begin
  hRegion := CreateEllipticRgn(0, 0, Width, Height);
  SetWindowRgn(Handle, hRegion, True);
  DeleteObject(hRegion);
end;

procedure TForm12.WMNCMLButtonDown(var Message: TMessage);
const
  EnableFulDrag: UINT = 1;
var
  TmpBool: UINT;
begin
  SystemParametersInfo(SPI_GETDRAGFULLWINDOWS, 0, @TmpBool, 0);
  SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, EnableFulDrag, nil, 0);
  inherited;
  SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, TmpBool, nil, 0);
end;

end.
 

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)