Transparent-Function auch für Win-Versionen unter Win2000?

[Helmi]

Hallo Jungs,

bei den Schweizern hab ich folgenden Code gefunden, um eine Form transparent darstellen zu lassen:

Delphi-Quellcode:

function MakeWindowTransparent(Wnd: HWND; nAlpha: Integer = 10): Boolean;
type
  TSetLayeredWindowAttributes = function(hwnd: HWND; crKey: COLORREF; bAlpha: Byte;
    dwFlags: Longint): Longint; stdcall;
var
  hUser32: HMODULE;
  SetLayeredWindowAttributes: TSetLayeredWindowAttributes;

begin
  Result  := False;

  // Here we import the function from USER32.DLL
  hUser32 := GetModuleHandle('USER32.DLL');

  If hUser32 <> 0 then
    begin
      @SetLayeredWindowAttributes := GetProcAddress(hUser32, 'SetLayeredWindowAttributes');

      // If the import did not succeed, make sure your app can handle it!
      If @SetLayeredWindowAttributes <> nil then
        begin
          // Check the current state of the dialog, and then add the WS_EX_LAYERED attribute
          SetWindowLong(Wnd, GWL_EXSTYLE, GetWindowLong(Wnd, GWL_EXSTYLE) or WS_EX_LAYERED);

          // The SetLayeredWindowAttributes function sets the opacity and
          // transparency color key of a layered window
          SetLayeredWindowAttributes(Wnd, 0, Trunc((255 / 100) * (100 - nAlpha)), LWA_ALPHA);

          Result := True;
        end;
    end;
end;

Nun ist meine Frage, ob diese Function auch unter Win95/98/Me läuft (also alle Windows-Versionen unter Win2000)?
(ich hab momentan keine Möglichkeit dies auf niedrigerer Windowsversionen zu testen)

Ich hätte ja sehr gerne "AlphaBlend" verwendet, nur ist dies laut OH nur ab 2000 lauffähig!

[mOzZzI]

Sry,noobie Frage wie ruft man den Code auf??

[MagicAndre1981]

Nöö, steht ja in der MSDN ;-)

Zitat:

Minimum operating systems Windows 2000

[Helmi]

Zitat:

Zitat von MagicAndre1981

Nöö, steht ja in der MSDN ;-)

Zitat:

Minimum operating systems Windows 2000

Shit (verzeihung: Stoffwechselendprodukt)- ich brauch auch ne möglichkeit eine Form transparent zu machen, unter Win95/98/Me

[mOzZzI]

bin mir sicher das das was ich suche im Link steht aber mein Internet machts net mit...
Könnte es jemand vill kopieren und hier posten?? Übrigens ich hab XP Pro ich glaub da geht des sogar, oder?

[Helmi]

Aufruf: (z. b.)

Delphi-Quellcode:

begin
  MakeWindowTransparent(Form1.Handle, 30);
end;

oder mit Abfrage:

Delphi-Quellcode:

begin
  If MakeWindowTransparent(Form1.Handle, 30) then
    ShowMessage('Form transparent')
  else
    ShowMessage('Form nicht transparent');
end;

[turboPASCAL]

Transparent ja aber ohne Alphablending. Stichwort(e): [oh]CreateRegion, CreateRegionEx, CombineRgn[/oh]

Diese Procedur kann eine "Unförmige" Form aus einem Bitmap erstellen. Optim. auf NonVCL, ab Windowsversion 95

Delphi-Quellcode:

//  BitmapToRegion :
//
//  Author:  Jean-Edouard Lachand-Robert 
//           ([url]http://www.geocities.com/Paris/LeftBank/1160/resume.htm[/url]), June 1998.
//           Sergei Stolyarov cancel{a}gorodok.net [url]http://web.ict.nsc.ru/~cancel/delphi[/url]
//
//  hBmp              : Bitmap
//  dwWndWidth        : Rückgabewert des Bitmaps (Width) zB. setzen der Fensterbreite
//  dwWndHeight       : Rückgabewert des Bitmaps (Height) zB. setzen der Fensterhöhe
//  cTransparentColor : RGB-Wert der farbe die Transparent werden soll
//  cTolerance        : Toleranzwert  für die Transparente Farbe

const ALLOC_UNIT = 100;

function min(x,y : DWORD) : DWORD;
begin
  if x<y then result := x else result := y;
end;

function BitmapToRegion(hBmp : HBITMAP; var dwWndWidth: DWORD; var dwWndHeight: DWORD;
  cTransparentColor : COLORREF = 0; cTolerance : COLORREF = $101010) : HRGN;
var
  rgn, h : HRGN;
  hMemDC, hDC : THANDLE;
  bm, bm32 : BITMAP;
  RGB32BITSBITMAPINFO : BITMAPINFOHEADER;
  hbm32, holdBmp, holdBmp2 : HBITMAP;
  pbits32 : Pointer;
  maxRects, x, y, x0 : DWORD;
  hData : THANDLE;
  pData : PRgnData;
  lr, lg, lb, hr, hg, hb : BYTE;
  p32 : PBYTE;
  b : byte;
  p : PDWORD;
  pr : PRECT;
begin
  rgn := 0;
  if hBmp<>0 then begin
    hMemDC := CreateCompatibleDC(0);
    if (hMemDC <> 0) then begin
      GetObject(hBmp, sizeof(bm), @bm);

      RGB32BITSBITMAPINFO.biSize := sizeof(BITMAPINFOHEADER);
      RGB32BITSBITMAPINFO.biWidth := bm.bmWidth;
      RGB32BITSBITMAPINFO.biHeight := bm.bmHeight;
      dwWndWidth := bm.bmWidth;
      dwWndHeight := bm.bmHeight;

      RGB32BITSBITMAPINFO.biPlanes := 1;
      RGB32BITSBITMAPINFO.biBitCount := 32;
      RGB32BITSBITMAPINFO.biCompression := BI_RGB;
      RGB32BITSBITMAPINFO.biSizeImage := 0;
      RGB32BITSBITMAPINFO.biXPelsPerMeter := 0;
      RGB32BITSBITMAPINFO.biYPelsPerMeter := 0;
      RGB32BITSBITMAPINFO.biClrUsed := 0;
      RGB32BITSBITMAPINFO.biClrImportant := 0;

      hbm32 := CreateDIBSection(hMemDC, PBITMAPINFO(@RGB32BITSBITMAPINFO)^,
                 DIB_RGB_COLORS, pbits32, 0, 0);

      if (hbm32 <> 0) then begin
        holdBmp := SelectObject(hMemDC, hbm32);

        hDC := CreateCompatibleDC(hMemDC);
        if (hDC <> 0) then begin
          GetObject(hbm32, sizeof(bm32), @bm32);
          while (bm32.bmWidthBytes mod 4 <> 0) do
            inc(bm32.bmWidthBytes);

          holdBmp2 := SelectObject(hDC, hBmp);
          BitBlt(hMemDC, 0, 0, bm.bmWidth, bm.bmHeight, hDC, 0, 0, SRCCOPY);

          maxRects := ALLOC_UNIT;
          hData := GlobalAlloc(GMEM_MOVEABLE, sizeof(RGNDATAHEADER) + (sizeof(TRECT) * maxRects));
          pData := GlobalLock(hData);

          pData^.rdh.dwSize := sizeof(RGNDATAHEADER);
          pData^.rdh.iType := RDH_RECTANGLES;
          pData^.rdh.nCount := 0;
          pData^.rdh.nRgnSize := 0;
          SetRect(pData^.rdh.rcBound, MAXLONG, MAXLONG, 0, 0);

          lr := GetRValue(cTransparentColor);
          lg := GetGValue(cTransparentColor);
          lb := GetBValue(cTransparentColor);
          hr := min($ff, lr + GetRValue(cTolerance));
          hg := min($ff, lg + GetGValue(cTolerance));
          hb := min($ff, lb + GetBValue(cTolerance));

          p32 := PBYTE(DWORD(bm32.bmBits) + (DWORD(bm32.bmHeight) - 1) * DWORD(bm32.bmWidthBytes));
          for y := 0 to bm.bmHeight-1 do begin

            x := 0;
            while x<DWORD(bm.bmWidth) do begin
              x0 := x;
              p := PDWORD(p32);
              inc(p, x);
              while x < DWORD(bm.bmWidth) do begin
                p^ := RGB(GetBValue(p^), GetGValue(p^), GetRValue(p^));
                b := GetRValue(p^);
                if (b >= lr) and (b <= hr) then begin
                  b := GetGValue(p^);
                  if (b >= lg) and (b <= hg) then begin
                    b := GetBValue(p^);
                    if (b >= lb) and (b <= hb) then
                      break;
                  end;
                end;//if (b >= lr) and (b <= hr)
                inc(p);
                inc(x);
              end;

              if (x > x0) then begin
                if (pData^.rdh.nCount >= maxRects) then begin
                  GlobalUnlock(hData);
                  inc(maxRects, ALLOC_UNIT);
                  hData := GlobalReAlloc(hData, sizeof(RGNDATAHEADER) +
                             (sizeof(TRECT) * maxRects), GMEM_MOVEABLE);
                  pData := GlobalLock(hData);
                end;

                pr := PRECT(@pData^.Buffer);
                inc(pr, pData^.rdh.nCount);

                SetRect(pr^, x0, y, x, y+1);
                if x0 < DWORD(pData^.rdh.rcBound.left) then
                  pData^.rdh.rcBound.left := x0;
                if y < DWORD(pData^.rdh.rcBound.top) then
                  pData^.rdh.rcBound.top := y;
                if x > DWORD(pData^.rdh.rcBound.right) then
                  pData^.rdh.rcBound.right := x;
                if y+1 > DWORD(pData^.rdh.rcBound.bottom) then
                  pData^.rdh.rcBound.bottom := y+1;
                inc(pData^.rdh.nCount);

                if pData^.rdh.nCount = 200 then begin
                  h := ExtCreateRegion(nil, sizeof(RGNDATAHEADER) + sizeof(TRECT) * maxRects, PRGNDATA(pData)^);
                  if Rgn <> 0 then begin
                    CombineRgn(Rgn, Rgn, h, RGN_OR);
                    DeleteObject(h);
                  end//if Rgn <> 0
                  else
                    Rgn := h;
                   pData^.rdh.nCount := 0;
                   SetRect(pData^.rdh.rcBound, MAXLONG, MAXLONG, 0, 0);
                 end(*if pData^.rdh.nCount = 2000*) else

              end;//if (x > x0)
              inc(x);
            end;//while x<bm.bmWidth

            dec(p32, bm32.bmWidthBytes);
          end;//for y := 0 to bm.bmHeight-1

          h := ExtCreateRegion(nil, sizeof(RGNDATAHEADER) + (sizeof(TRECT) * maxRects), PRGNDATA(pData)^);
          if (Rgn <> 0) then begin
            CombineRgn(Rgn, Rgn, h, RGN_OR);
            DeleteObject(h);
          end
          else
            Rgn := h;

          SelectObject(hDC, holdBmp2);
          DeleteDC(hDC);
          GlobalFree(hData);
        end;

        DeleteObject(SelectObject(hMemDC, holdBmp));
      end;

      DeleteDC(hMemDC);
    end;

  end;
  result := rgn;
end;

Aufruf:

Delphi-Quellcode:

var
  rgn: HRGN;
  hBmp: hBitmap;  // in der VCL: TBitmap.Handle
  h, w: Integer;

Procedure ...
begin
  // NonVCL:
  hBmp := LoadImage(...
  rgn := BitmapToRegion(hBmp, w, h, RGB(255,0,255) {clFuchsia}, 0);

  // VCL:
  rgn := BitmapToRegion(ImageX.Picture.Bitmap.Handle, W, H, RGB(255,0,255) {clFuchsia}, 0);

  SetWindowRgn(hwnd,  Rgn, TRUE);
end;

DeleteObject(Rgn); nicht vergessen im Destroy aufzurufen...