(*  unit:        ThCtrls
    version:     1
    release:     May 2004
    developed:   2002-2004
    environment: Borland Delphi 7
    --------------------------------------------------
    author: Thomas Lackó
    web:    http://thomas.sk
    e-mail: thomas.lacko@gmail.com
*)

unit ThCtrls;

INTERFACE

uses Windows,Classes,Controls,Forms;
const UnitVersion = $04051B01;

// unregular forms

type
  TFormRegion=set of (frBorders,frControls,frBackground,frCustom);
  TUnregularForm=class(TForm)
   protected
    FormRgn:THandle;
    procedure Resize; override;
   private
    FTransparent:Boolean;
    FRegion:TFormRegion;
    FCustomRgn:THandle;
    procedure SetTransparent(T:Boolean);
    procedure SetRegion(R:TFormRegion);
    procedure SetCustomRgn(R:THandle);
   public
    constructor Create(AOwner:TComponent); override;
    property  CustomRegion:THandle read FCustomRgn write SetCustomRgn;
    procedure UpdateRegion;
   published
    property Transparent:Boolean read FTransparent write SetTransparent default False;
    property Region:TFormRegion read FRegion write SetRegion
             default [frBorders,frControls,frBackground,frCustom];
  end;

IMPLEMENTATION

//--------------- UNREGULAR FORMS -------------------------------------------

{ TUnregularForm }

constructor TUnregularForm.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FRegion:=[frBorders,frControls,frBackground,frCustom];
  FormRgn:=0; FCustomRgn:=0; FTransparent:=False;
end;

procedure TUnregularForm.Resize;
begin
  inherited;
  if FormRgn<>0 then UpdateRegion;
end;

procedure TUnregularForm.UpdateRegion;
var
  BaseX,BaseY,x,y,i:Integer; C:TControl;
  R,RClient,RControls,RObj,OldRgn:THandle;
begin
  if (FormRgn=0) and not FTransparent or
     (csDesigning in ComponentState) then Exit;
  if FTransparent then begin
    BaseX:=(Width-ClientWidth) div 2;
    BaseY:=Height-BaseX-ClientHeight;
    RClient:=CreateRectRgn(BaseX,BaseY,BaseX+ClientWidth,BaseY+ClientHeight);
    RControls:=CreateRectRgn(0,0,0,0);
    if (frControls in FRegion)<>(frBackground in FRegion) then
      for i:=0 to ControlCount-1 do begin
        C:=Controls[i];
        if ((C is TWinControl) or (C is TGraphicControl)) and C.Visible then
          with C do begin
            x:=BaseX+Left; y:=BaseY+Top;
            RObj:=CreateRectRgn(x,y,x+Width,y+Height);
            CombineRgn(RControls,RControls,RObj,RGN_OR);
            DeleteObject(RObj);
          end;
      end;
    R:=CreateRectRgn(0,0,0,0);
    if frControls in FRegion then
      if frBackground in FRegion then
        CombineRgn(R,R,RClient,RGN_OR)
      else CombineRgn(R,R,RControls,RGN_OR)
    else if frBackground in FRegion then begin
      CombineRgn(R,R,RClient,RGN_OR);
      CombineRgn(R,R,RControls,RGN_DIFF);
    end;
    if frBorders in FRegion then begin
      RObj:=CreateRectRgn(0,0,Width,Height);
      CombineRgn(RObj,RObj,RClient,RGN_DIFF);
      CombineRgn(R,R,RObj,RGN_OR);
      DeleteObject(RObj);
    end;
    DeleteObject(RControls); DeleteObject(RClient);
    if (frCustom in FRegion) and (FCustomRgn<>0) then
      CombineRgn(R,R,FCustomRgn,RGN_OR);
  end
  else R:=0;
  SetWindowRgn(Handle,R,Visible);
  OldRgn:=FormRgn; FormRgn:=R;
  if OldRgn<>0 then DeleteObject(OldRgn);
end;

procedure TUnregularForm.SetTransparent(T:Boolean);
begin
  if T<>FTransparent then begin
    FTransparent:=T; UpdateRegion;
  end;
end;

procedure TUnregularForm.SetRegion(R:TFormRegion);
begin
  if FRegion<>R then begin
    FRegion:=R; if FTransparent then UpdateRegion;
  end;
end;

procedure TUnregularForm.SetCustomRgn(R:THandle);
var OldRgn:THandle;
begin
  if R=FCustomRgn then Exit;
  OldRgn:=FCustomRgn; FCustomRgn:=R;
  if OldRgn<>0 then DeleteObject(OldRgn);
  if FTransparent and (frCustom in Region) then UpdateRegion;
end;

END.
