Текущий архив: 2005.10.09;
Скачать: CL | DM;

Вниз

Окно с прозрачной областью   Найти похожие ветки 

← →
BFG9k ©   (2005-08-11 15:28) [0]

На изображении нужно нарисовать прямоугольную рамку, которую можно перемещать, а также изменять ее размеры мышью. Думаю, что это должно быть окно (например форма) с прозрачной областью. Не исключаю другие варианты, главное - результат (быстро и без мерцания).

---

← →
Kolan ©   (2005-08-11 15:36) [1]

В посте не видно вопроса.

PS D2, D3, D4, D5, D6, D7, Win95/98, WinME, NT4, Win2k, WinXP
Солидный наборчик.

---

← →
BFG9k ©   (2005-08-11 16:10) [2]

Kolan:
Да мне нужно, чтобы работало и под Win98. Наборчик нормальный, я всегда так делаю, если речь не идет о чем-нибудь вроде ValueListEditor"а или компонентов Indy, которых нет в ранних версиях.

Проблему решил сам. BEW_SIZE,BEW_COLOR - толщина и цвет рамки.


procedure TForm4.FormResize(Sender: TObject);
var Rgn,HoleRgn:HRGN;
begin
  Rgn:=CreateRectRgn(0,0,Width,Height);
  HoleRgn:=CreateRectRgn(BEW_SIZE,BEW_SIZE,Width-BEW_SIZE,Height-BEW_SIZE);
  CombineRgn(Rgn,Rgn,HoleRgn,RGN_DIFF);
  SetWindowRgn(Handle,Rgn,True);
end;

procedure TForm4.WMNCPaint(var Msg:TWMNCPaint);
var DC:hDC;
 Pen,OldPen:hPen;
   OldBrush:hBrush;
   i:integer;
begin
inherited;
  DC:=GetWindowDC(Handle);
  msg.Result:=1;
  Pen:=CreatePen(PS_SOLID,1,BEW_COLOR);
  OldPen:=SelectObject(DC,Pen);
  OldBrush:=SelectObject(DC,GetStockObject(NULL_BRUSH));

  for i:=0 to BEW_SIZE-1 do
   Rectangle(DC,i,i,Width-i,Height-i);
  SelectObject(DC,OldBrush);
  SelectObject(DC,OldPen);
  DeleteObject(Pen);
  ReleaseDC(Handle,Canvas.Handle);
end;



---

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

Текущий архив: 2005.10.09;
Скачать: CL | DM;

Наверх

Память: 0.47 MB
Время: 0.025 c