Form nicht rechteckig

[turboPASCAL]

Ich hatte das ganze mal folgendermassen gelöst, das Teil ist auch noch Win9x kompatibel:

Delphi-Quellcode:

//...

function TForm1.SetWndRegionFromImg(Bmp: TBitmap; TransparentColor: TColor): Boolean;
type
  TTransColState = (trsOn, trsOff);

  TRGBQuadArray = array[WORD] of Cardinal;
  pRGBQuadArray = ^TRGBQuadArray;
var
  TransColState: TTransColState;
  x, y: Integer;
  line: Integer;
  count: Integer;
  rgn, nrgn: THandle;
  pPixelArray: pRGBQuadArray;
begin
  Result := TRUE;

  if Bmp.PixelFormat <> pf32Bit then
    Bmp.PixelFormat := pf32Bit;

  count := 0;
  line := 0;

  rgn := CreateRectRGN(0, 0, 0, 0); // First Init Region
  nrgn := rgn;

  for y := 0 to Bmp.Height - 1 do
  begin
    pPixelArray := Bmp.Scanline[y];
    TransColState := trsOff;
    for x := 0 to Bmp.Width - 1 do
    begin
      if pPixelArray[x] <> COLORREF(TransparentColor) then
      begin
        if TransColState = trsOff then
        begin
          TransColState := trsOn;
          line := x - 1;
          inc(line);
        end;
      end else
      begin
        if TransColState = trsOn then
        begin
          TransColState := trsOff;
          if count < 4096 then
          begin
            nrgn := CreateRectRgn(line, y, x, y + 1);
            CombineRgn(Rgn, Rgn, nRgn, RGN_OR);
            inc(Count);
          end else
          begin
            ShowMessage('Debuginfo: To many Regions. Count of Rgn: '#9 + IntToStr(Count));
            Application.Terminate;
          end;
        end;
      end;
    end;
  end;
  SetWindowRgn(Handle, Rgn, TRUE);
  DeleteObject(Rgn);
  DeleteObject(nRgn);
end;


procedure TForm1.FormCreate(Sender: TObject);
const
  LWA_COLORKEY = 1; // Use crKey as the transparency color.
  LWA_ALPHA = 2; // Use bAlpha to determine the opacity of the layered window..

  USER32DLL = 'user32.dll';
var
  _SetLayeredWindowAttributes: function(hWnd: THandle; TRansparentColor: COLORREF;
    AlphaValue: Byte; Flags: Cardinal): BOOL; stdcall;
var
  hLib: THandle;
begin
  Self.Color := clFuchsia;
  Self.BorderStyle := bsNone;

  if not (Image1.Picture.Graphic is TBitmap) then
  begin
    ShowMessage('Fehler: Image muss ein Bitmap sein !');
    Application.Terminate;
  end;

  hLib := LoadLibrary(USER32DLL);
  @_SetLayeredWindowAttributes := GetProcAddress(hLib, 'SetLayeredWindowAttributes');
  if @_SetLayeredWindowAttributes <> nil then
  begin
    SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
    _SetLayeredWindowAttributes(Self.Handle, COLORREF(clFuchsia), 250, LWA_COLORKEY or LWA_ALPHA);
  end
  else
  begin
    // alternative, im falle das es SetLayeredWindowAttributes nicht gibt
    SetWndRegionFromImg(Image1.Picture.Bitmap, clFuchsia);
  end;
  FreeLibrary(hLib);
end;

//...