Советы по Delphi. Версия 1.4.3 от 1.1.2001

Как создать окна непрямоугольной формы и работать с ними?

Nomadic советует:

Достаточно создать регион нужной формы и вызвать SetWindowRgn —

HRGN rgn := CreateEllipticRgn(10,10,100,100);

SetWindowRgn(hMyWnd,rgn); // Вот и будет круглое окно

При этом регион этот теперь используется Windows и будет уничтожен при закрытии окна.

Попробуйте вот этот обpаботчик OnCreate : На меня это произвело впечатление.

procedure TForm1.FormCreate(Sender: TObject);

const W=36*pi/180;

var

 R,R1,R2: HRgn;

 X,Y,i:integer;

 function S(a:integer;R:integer):integer;

 begin

  Result:=round(R*sin(W*a));

 end;

 function C(a:integer;R:integer):integer;

 begin

  Result:=round(R*cos(W*a));

 end;

 function GetStarReg(X,Y,R:integer):HRGN;

 var P : array [0..4] of TPoint;

 begin

  P[0] := Point(X, Y-R);

  P[1] := Point(X-S(4,R), Y-C(4,R));

  P[2] := Point(X-S(8,R), Y-C(8,R));

  P[3] := Point(X-S(2,R), Y-C(2,R));

  P[4] := Point(X-S(6,R), Y-C(6,R));

  Result := CreatePolygonRgn(P, 5, WINDING);

 end;

begin

 X:=Width div 2;

 Y:=Height div 2;

 R:=GetStarReg(X,Y,100);

 i:=1;

 repeat

  R1:=GetStarReg(X-S(i,120),Y-C(i,110),40);

  CombineRgn(R,R,R1,RGN_OR);

  inc(i,2);

 until i>9;

 R1:=GetStarReg(X,Y,30);

 CombineRgn(R,R,R1,RGN_DIFF);

 R1:=CreateEllipticRgn(3,3,Width-6,Height-6);

 R2:=CreateEllipticRgn(20,10,Width-20,Height-10);

 CombineRgn(R1,R1,R2,RGN_DIFF);

 CombineRgn(R,R,R1,RGN_OR);

 SetWindowRgn(Handle, R, True);

end;

Как запретить кнопку Close [×] в заголовке окна?

Nomadic советует:

Вот кусок, который делает все, что тебе нужно:

procedure TForm1.FormCreate(Sender: TObject);

var Style: Longint;

begin

 Style := GetWindowLong(Handle, GWL_STYLE);

 SetWindowLong(Handle, GWL_STYLE, Style And Not WS_SYSMENU);

end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

 if (Key = VK_F4) and (ssAlt in Shift) then begin

  MessageBeep(0);

  Key := 0;

 end;

end;

{ Disable close button }

procedure TForm1.Button1Click(Sender: TObject);

var SysMenu: HMenu;

begin

 SysMenu := GetSystemMenu(Handle, False);

 Windows.EnableMenuItem(SysMenu, SC_CLOSE, MF_DISABLED or MF_GRAYED);

end;

{ Enable close button }

procedure TForm1.Button2Click(Sender: TObject);

begin

 GetSystemMenu(Handle, True);

 Perform(WM_NCPAINT, Handle, 0);

end;

Но это окно можно закрыть из TaskBar'а. 

Мерцание формы

Как бы это осуществить рисование в окне без его дурацкого мерцания и без помощи создания виртуального изображения в памяти? WM_SETREDRAW здесь поможет?

Попробуйте этот код. Даже если некоторые компоненты имеют пару BeginUpdate / EndUpdate, то для таких компонентов, как TTreeView, интенсивное рисование может послужить причиной перемещения полосы прокрутки и появления других «барабашек». В таких ситуаций вместо дескриптора элемента управления используйте родительский дескриптор.

procedure BeginScreenUpdate(hwnd : THandle);

begin

 if (hwnd = 0) then hwnd := Application.MainForm.Handle;

 SendMessage(hwnd, WM_SETREDRAW, 0, 0);

end;

procedure EndScreenUpdate(hwnd : THandle; erase : Boolean);

begin

 if (hwnd = 0) then hwnd := Application.MainForm.Handle;

 SendMessage(hwnd, WM_SETREDRAW, 1, 0);