unit ProjetoX_Screen;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 ExtCtrls, StdCtrls, DBCtrls;
type
 TFormScreen = class(TForm)
  ImgFundo: TImage;
  procedure FormCreate(Sender: TObject);
 public
  { Public declarations }
  MyRegion : HRGN;
  function BitmapToRegion(hBmp: TBitmap; TransColor: TColor): HRGN;
 end;
var
 FormScreen: TFormScreen;
implementation
{$R *.DFM}
{===========================molda o formato do formulЯrio no bitmap}
function TFormScreen.BitmapToRegion(hBmp: TBitmap; TransColor: TColor): HRGN;
const
 ALLOC_UNIT = 100;
var
 MemDC, DC: HDC;
 BitmapInfo: TBitmapInfo;
 hbm32, holdBmp, holdMemBmp: HBitmap;
 pbits32 : Pointer;
 bm32 : BITMAP;
 maxRects: DWORD;
 hData: HGLOBAL;
 pData: PRgnData;
 b, CR, CG, CB : Byte;
 p32: pByte;
 x, x0, y: integer;
 p: pLongInt;
 pr: PRect;
 h: HRGN;
begin
 Result := 0;
 if hBmp <> nil then
 begin
  { Cria um Device Context onde serЯ armazenado o Bitmap }
  MemDC := CreateCompatibleDC(0);
  if MemDC <> 0 then
  begin
  { Cria um Bitmap de 32 bits sem compressТo }
  with BitmapInfo.bmiHeader do
  begin
  biSize := sizeof(TBitmapInfoHeader);
  biWidth := hBmp.Width;
  biHeight := hBmp.Height;
  biPlanes := 1;
  biBitCount := 32;
  biCompression := BI_RGB;
  biSizeImage := 0;
  biXPelsPerMeter := 0;
  biYPelsPerMeter := 0;
  biClrUsed := 0;
  biClrImportant := 0;
  end;
  hbm32 := CreateDIBSection(MemDC, BitmapInfo, DIB_RGB_COLORS, pbits32,0, 0);
  if hbm32 <> 0 then
  begin
  holdMemBmp := SelectObject(MemDC, hbm32);
  {
  Calcula quantos bytes por linha o bitmap de 32 bits ocupa.
  }
  GetObject(hbm32, SizeOf(bm32), @bm32);
  while (bm32.bmWidthBytes mod 4) > 0 do
  inc(bm32.bmWidthBytes);
  DC := CreateCompatibleDC(MemDC);
  { Copia o bitmap para o Device Context }
  holdBmp := SelectObject(DC, hBmp.Handle);
  BitBlt(MemDC, 0, 0, hBmp.Width, hBmp.Height, DC, 0, 0, SRCCOPY);
  {
  Para melhor performance, serЯ utilizada a funюТo ExtCreasteRegion
  para criar o HRGN. Esta funюТo recebe uma estrutura RGNDATA.
  Cada estrutura terЯ 100 retФngulos por padrТo (ALLOC_UNIT)
  }
  maxRects := ALLOC_UNIT;
  hData := GlobalAlloc(GMEM_MOVEABLE, sizeof(TRgnDataHeader) +
  SizeOf(TRect) * maxRects);
  pData := GlobalLock(hData);
  pData^.rdh.dwSize := SizeOf(TRgnDataHeader);
  pData^.rdh.iType := RDH_RECTANGLES;
  pData^.rdh.nCount := 0;
  pData^.rdh.nRgnSize := 0;
  SetRect(pData^.rdh.rcBound, MaxInt, MaxInt, 0, 0);
  { Separa o pixel em suas cores fundamentais }
  CR := GetRValue(ColorToRGB(TransColor));
  CG := GetGValue(ColorToRGB(TransColor));
  CB := GetBValue(ColorToRGB(TransColor));
  {
  Processa os pixels bitmap de baixo para cima, jЯ que bitmaps sТo
  verticalmente invertidos.
  }
  p32 := bm32.bmBits;
  inc(PChar(p32), (bm32.bmHeight - 1) * bm32.bmWidthBytes);
  for y := 0 to hBmp.Height-1 do
  begin
  { Processa os pixels do bitmap da esquerda para a direita }
  x := -1;
  while x+1 < hBmp.Width do
  begin
  inc(x);
  { Procura por uma faixa contЭnua de pixels nТo transparentes }
  x0 := x;
  p := PLongInt(p32);
  inc(PChar(p), x * SizeOf(LongInt));
  while x < hBmp.Width do
  begin
  b := GetBValue(p^);
  if (b = CR) then
  begin
  b := GetGValue(p^);
  if (b = CG) then
  begin
  b := GetRValue(p^);
  if (b = CB) then
  break;
  end;
  end;
  inc(PChar(p), SizeOf(LongInt));
  inc(x);
  end;
  if x > x0 then
  begin
  {
  Adiciona o intervalo de pixels [(x0, y),(x, y+1)] como um novo
  retФngulo na regiТo.
  }
  if pData^.rdh.nCount >= maxRects then
  begin
  GlobalUnlock(hData);
  inc(maxRects, ALLOC_UNIT);
  hData := GlobalReAlloc(hData, SizeOf(TRgnDataHeader) +
  SizeOf(TRect) * maxRects, GMEM_MOVEABLE);
  pData := GlobalLock(hData);
  Assert(pData <> NIL);
  end;
  pr := @pData^.Buffer[pData^.rdh.nCount * SizeOf(TRect)];
  SetRect(pr^, x0, y, x, y+1);
  if x0 < pData^.rdh.rcBound.Left then
  pData^.rdh.rcBound.Left := x0;
  if y < pData^.rdh.rcBound. then
  pData^.rdh.rcBound. := y;
  if x > pData^.rdh.rcBound.Right then
  pData^.rdh.rcBound.Left := x;
  if y+1 > pData^.rdh.rcBound.Bottom then
  pData^.rdh.rcBound.Bottom := y+1;
  inc(pData^.rdh.nCount);
  {
  No Windows98, a funюТo ExtCreateRegion() pode falhar se o n·mero
  de retФngulos for maior que 4000. Por este motivo, a regiТo deve
  ser criada por partes com menos de 4000 retФngulos. Neste caso, foram
  padronizadas regi§es com 2000 retФngulos.
  }
  if pData^.rdh.nCount = 2000 then
  begin
  h := ExtCreateRegion(NIL, SizeOf(TRgnDataHeader) +
  (SizeOf(TRect) * maxRects), pData^);
  Assert(h <> 0);
  { Combina a regiТo parcial, recЪm criada, com as anteriores }
  if Result <> 0 then
  begin
  CombineRgn(Result, Result, h, RGN_OR);
  DeleteObject(h);
  end else
  Result := h;
  pData^.rdh.nCount := 0;
  SetRect(pData^.rdh.rcBound, MaxInt, MaxInt, 0, 0);
  end;
  end;
  end;
  Dec(PChar(p32), bm32.bmWidthBytes);
  end;
  { Cria a regiТo geral }
  h := ExtCreateRegion(NIL, SizeOf(TRgnDataHeader) +
  (SizeOf(TRect) * maxRects), pData^);
  Assert(h <> 0);
  if Result <> 0 then
  begin
  CombineRgn(Result, Result, h, RGN_OR);
  DeleteObject(h);
  end else
  Result := h;
  { Com a regiТo final completa, o bitmap de 32 bits pode ser
  removido da mem?ria, com todos os outros ponteiros que foram criados.}
  GlobalFree(hData);
  SelectObject(DC, holdBmp);
  DeleteDC(DC);
  DeleteObject(SelectObject(MemDC, holdMemBmp));
  end;
  end;
  DeleteDC(MemDC);
 end;
end;
procedure TFormScreen.FormCreate(Sender: TObject);
begin
{carregue uma imagem na TImage ImgFundo}
{redesenha o formulario no formato do ImgFundo}
  MyRegion := BitmapToRegion(imgFundo.Picture.Bitmap,imgFundo.Canvas.Pixels[0,0]);
  SetWindowRgn(Handle,MyRegion,True);
end;



Para os outros formulЯrios basta declarar as seguintes linhas na procedure FormCreate
procedure TFormXXXXXX.FormCreate(Sender: TObject);
begin
{carregue uma imagem na TImage ImgFundo}
{redesenha o formulario no formato do ImgFundo}
  FormScreen.MyRegion := FormScreen.BitmapToRegion(imgFundo.Picture.Bitmap,
  imgFundo.Canvas.Pixels[0,0]);
  SetWindowRgn(Handle,FormScreen.MyRegion,True);
end;