Создание прозрачного окна
procedure TForm1.SetRegions; var i: integer; RgnAll, RgnCtrl: HRGN; begin RgnAll:= 0; BorderStyle:= bsNone; // Установим без границ, чтобы не было смещения for i:= 0 to ControlCount - 1 do begin with Controls[i] do begin if Visible then begin // Создаем область для каждого видимого управления RgnCtrl:= CreateRectRgn(Left, Top, Left + Width, Top + Height); // Объединить области со всеми предыдущими, если доступно if (RgnCtrl <> 0) and (RgnAll <> 0) then begin CombineRgn(RgnAll, RgnAll, RgnCtrl, RGN_OR); DeleteObject(RgnCtrl); end else RgnAll:= RgnCtrl; // Это первая создаваемая область end; end; end; // Теперь установим RgnAll, чтобы видеть окно if RgnAll <> 0 then begin { О SetWindowRgn в справочном файле: "После успешного вызова SetWindowRgn, операционная система имеет область, определенную дескриптором hRgn. Операционная система не делает копию области. Таким образом, Вы не должны делать никаких вызовов функций с этим дескриптором области. В частности, не закрывайте этот дескриптор." Так что не вызывайте DeleteObject для RgnAll после исползования его для SetWindowRgn (Richard Albury). } SetWindowRgn(handle, RgnAll, true); end; end;
Вызвать процедуру можно так:
procedure TForm1.FormCreate(Sender: TObject); begin SetRegions; end; // Не забудьте эту кнопку, а то закрыть окно будет нечем! procedure TForm1.BitBtn1Click(Sender: TObject); begin Application.Terminate; end;
Обратите внимание, что DeleteObject вызывается уже после того, как закончено использование региона. Не выполнение этого условия приведет к утечке ресурсов Windows. Здесь используется функция API CreateRectRgn, но если у Вас другая форма, Вы можете использовать CreatePolygonRgn, чтобы точно настроить отображение формы.
Но есть одна проблема, с которой Вы можете столкнуться, когда есть перемещающиеся управления на форме. Если Вы программно перемещаете управление (например, в событии OnMouseMove), область позади управления не будет перекрашиваться, также, как и само управление. Решение простое: нужно вызвать SetRegions снова, чтобы обновить новую видимую область формы и вынудить перекраситься управление вызовом Control.Repaint, типа того, как показано ниже:
procedure TForm1.GenericMouseMove( Sender: TObject; Shift: TShiftState; X, Y: Integer); begin // Если управление не было перемещено, сразу выход if (X - LastX = 0) and (Y - LastY = 0) then Exit; // Переместили управление with (Sender as TControl) do begin Left := Left + (X - LastX); Top := Top + (Y - LastY); end; SetRegions; (Sender as TControl).Repaint; end;
Комментарии