borderstyle ->bsnone (нельзя изменить размеры формы)

← →
Змей © (2006-01-19 16:04) [0]

Здравствуйте Мастера!
имеется форма. в инспекторе объектов в borderstyle выбираю значение bsnone все прекрасно, исчезает полоска с крестиком, но нельзя изменить размеры формы, ну мышкой растягивать и назад!
как это исправить?
СПАСИБО!

← →
EvS (2006-01-19 20:54) [1]

Если тебе нужно убрать крестик то в BorderIcons установи biSystemMenu=false.

← →
Змей © (2006-01-20 00:23) [2]

в том то и дело что я хочу свою полоску разместить сбоку! и за нее передвигать форму. и на ней там свои кнопочки закрытия сворачивания.

← →
Юрий Зотов © (2006-01-20 00:41) [3]

Все очень просто - надо обрабатывать сообщение WM_NCHITTEST.

← →
Змей © (2006-01-20 01:08) [4]

а не подскажете плз? у меня просто с этими делами туговато все эти АПИ
стыдно аж както:)

← →
Yegorchic © (2006-01-20 02:32) [5]

unit DragMain; interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCrtls; type TForm1 = class(TForm) Button1: TButton; procedure ButtonClick(Sender: TObject); private procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCCHitTest; end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1. WMNCHitTest(var M: TWMNCHitTest); begin inherited; if M.Result = htClient then M.Result := htCaption; end; procedure TForm1.Button1Click(Sender: TObject); begin Close; end; end.

Delphi Russian Knowledge Base

← →
Юрий Зотов © (2006-01-20 02:51) [6]

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); //OnCreate procedure FormPaint(Sender: TObject); //OnPaint procedure FormResize(Sender: TObject); //OnResize private procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; procedure PaintLeftCaption(CaptionColor: TColor); end; var Form1: TForm1; implementation uses Types; {$R *.dfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject); //OnCreate begin BorderStyle := bsNone end; procedure TForm1.FormPaint(Sender: TObject); //OnPaint begin PaintLeftCaption(clRed) end; procedure TForm1.FormResize(Sender: TObject); //OnResize begin PaintLeftCaption(Color); PaintLeftCaption(clRed) end; procedure TForm1.PaintLeftCaption(CaptionColor: TColor); var F, C: integer; begin F := GetSystemMetrics(SM_CXSIZEFRAME); C := GetSystemMetrics(SM_CYCAPTION); Canvas.Brush.Color := CaptionColor; if CaptionColor <> Color then begin Canvas.FillRect(Rect(F, F, F + C, Height - F)) end else Canvas.FillRect(Rect(0, 0, F + C, Height)) end; procedure TForm1.WMNCHitTest(var Message: TWMNCHitTest); var F, C: integer; P: TPoint; begin F := GetSystemMetrics(SM_CXSIZEFRAME); C := GetSystemMetrics(SM_CYCAPTION); P := ScreenToClient(SmallPointToPoint(Message.Pos)); if PtInRect(Rect(0, 0, F, F), P) then Message.Result := HTTOPLEFT else if PtInRect(Rect(F, 0, Width - F, F), P) then Message.Result := HTTOP else if PtInRect(Rect(Width - F, 0, Width, F), P) then Message.Result := HTTOPRIGHT else if PtInRect(Rect(Width - F, F, Width, Height - F), P) then Message.Result := HTRIGHT else if PtInRect(Rect(Width - F, Height - F, Width, Height), P) then Message.Result := HTBOTTOMRIGHT else if PtInRect(Rect(F, Height - F, Width - F, Height), P) then Message.Result := HTBOTTOM else if PtInRect(Rect(0, Height - F, F, Height), P) then Message.Result := HTBOTTOMLEFT else if PtInRect(Rect(0, F, F, Height - F), P) then Message.Result := HTLEFT else if PtInRect(Rect(F, F, F + C, Height - F), P) then Message.Result := HTCAPTION else inherited end; end.

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

Но когда Вы намучаетесь с прорисовкой иконки, вертикального текста, системных кнопок и тем XP, то, думаю, поймете, что не стоит желать странного.

ой пасиба:)

да работает но когда panel1 растянуто на всю область panel.align:=alclient
не работает:(

borderstyle ->bsnone (нельзя изменить размеры формы) Найти похожие ветки