[nonVCL] UpdateLayeredWindow & 32 Bit Bmp - Helfer gesucht

[turboPASCAL]

Hi,

Ich bekomme es nicht so recht gebacken, ich möchte in nonVCL ein 32 Bit Bitmap erstellen und darauf zeichnen.

In dem Testprogramm (im Anhang) kann man sehen wozu und wieso. Der Grund ist im moment werkel ich mit der Graphics.dcu von Delphi mit in der nonVCL und das ist nicht vom mir nicht erwünst.
Man könnte es ja dan auch gleich mit der VCL machen.

Also ich habe schon versucht ein Geräteunabhäniges 32 Bit bitmap zu bauen aber das klappt nicht so recht.
Auch mit der/einer GDI Plus unit klappt das nicht da vom 32Bitbitmap irgenwie ein falscher DC zurückkommt.


Wenn jemand helfen könnte und das noch mie ein bissel Sourcecode ...

Bitte nicht auf die MSDN verweisen, mein En. ist nicht besonders.

Gruss


//Edit:
So schauts im Moment aus:

Delphi-Quellcode:

program Test;

{$R 'Resources\BitmapRes.res' 'Resources\BitmapRes.rc'}

uses
  Windows,
  Messages,
  //
  graphics;
  //

type
  TPixel = array[0..0] of packed record
                            B, G, R, Alpha: Byte;
                          end;

const
  IDC_CLOSEBTN = 0815;

var
  ps: PAINTSTRUCT;
  pt: TPoint;
  sz: TSize;
  bf: BLENDFUNCTION;
  pix1, pix2: ^TPixel;

  aBitmap, aBitMsk: TBitmap;

  CloseBtn: HWND;

  Top, Left: Integer;


function _Rect(aLeft, aTop, aRight, aBottom: Integer): TRect;
begin
  with Result do
  begin
    Left := aLeft;
    Top := aTop;
    Right := aRight;
    Bottom := aBottom;
  end;
end;

function _ExtractFilePath(const s: string): string;
var
  i: integer;
begin
  result := s;
  for i := length(s) downto 1 do
    if s[i] = '\' then
    begin
      result := copy(s, 1, i);
      break;
    end;
end;

function SetClientRect(hWnd: HWND; Width, Height: Integer): Boolean;
var
  R: TRect;
  isMenu: Boolean;
  Top,Left: Integer;
begin
  GetWindowRect(hWnd, R);
  Left := R.Left;
  Top := R.Top;
  SetRect(R, 0, 0, Width, Height);
  if GetMenu(hWnd) = 0 then isMenu := FALSE else isMenu := TRUE;
  if AdjustWindowRectEx(R, GetWindowLong(hWnd, GWL_STYLE), isMenu,
    GetWindowLong(hWnd, GWL_EXSTYLE)) then
  Result := MoveWindow(hWnd, Left, Top, R.Right - R.Left, R.Bottom - R.Top, TRUE)
  else Result := FALSE;
end;

procedure Paint(DC: HDC);
begin
end;

function WndProc(Wnd : HWND; uMsg : UINT; wParam : Integer; lParam: Integer) : Integer; stdcall;
var
  PaintDC: HDC;
  x, y: integer;
begin
  result := 0;

  case uMsg of
    WM_CREATE:
      begin
        //* Bitmap(s) aufbereiten

        aBitmap := TBitmap.Create;
        aBitmap.LoadFromResourceName(hInstance, 'RGB');
        aBitmap.PixelFormat := pf32bit;

        // nur für CloseBtn
        DrawFrameControl(aBitmap.Canvas.Handle,
          _RECT(0, 0, 16, 16), DFC_CAPTION, DFCS_CAPTIONCLOSE);
        //

        aBitMsk := TBitmap.Create;
        aBitMsk.LoadFromResourceName(hInstance, 'MASK');
        aBitMsk.PixelFormat := pf32bit;

        // nur für CloseBtn (Alpha)
        aBitMsk.Canvas.Brush.Color := $00FFFFFF;
        aBitMsk.Canvas.FillRect(_RECT(0,0,16,16));
        //

        for y := 0 to abitmap.Height - 1 do // Einen Alphakanal bauen / füllen
        begin
          pix1 := aBitmap.ScanLine[y];
          pix2 := aBitMsk.ScanLine[y];
          for x := 0 to aBitmap.Width - 1 do
            pix1[x].Alpha :=
              (pix2[x].R + pix2[x].G + pix2[x].B) div 3;
          Inc(pix1);
          Inc(pix2);
        end;

        aBitMsk.Free;

        //* Spielerei

        CloseBtn := CreateWindowEx(WS_EX_CLIENTEDGE, 'BUTTON', 'X',
                      WS_VISIBLE or WS_CHILD, 0, 0, 16, 16, Wnd, IDC_CLOSEBTN, hInstance, nil);

        SetClientRect(Wnd, abitmap.Width, abitmap.Height);

        Left := (GetSystemMetrics(SM_CXSCREEN) div 2) - (abitmap.Width div 2);
        Top := (GetSystemMetrics(SM_CYSCREEN) div 2) - (abitmap.Height div 2);

        SetWindowPos(Wnd, HWND_NOTOPMOST, Left, Top, 0,0, SWP_NOSIZE or SWP_NOZORDER);
      end;

    WM_DESTROY:
      begin
        aBitmap.Free;

        DestroyWindow(CloseBtn);

        PostQuitMessage(0);
        result := 0;
      end;

    WM_SHOWWINDOW:
      begin
        pt.X := 0;
        pt.Y := 0;
        sz.cx := abitmap.Width;
        sz.cy := abitmap.Height;

        bf.BlendOp := AC_SRC_OVER;
        bf.BlendFlags := 0;
        bf.AlphaFormat := AC_SRC_ALPHA;
        bf.SourceConstantAlpha := 250;

        UpdateLayeredWindow(
          wnd,
          0,
          nil,
          @sz,
          abitmap.Canvas.Handle,  // to do... //
          @pt,
          0,
          @bf,
          ULW_ALPHA);
      end;

    WM_PAINT:
      begin
        PaintDC := BeginPaint(Wnd, ps);
        Paint(PaintDC);
        EndPaint(Wnd, ps);
        result := 0;
      end;

    WM_LBUTTONDOWN:
      begin
        SendMessage(Wnd, WM_NCLBUTTONDOWN, HTCAPTION, lParam);
      end;

    WM_COMMAND:
      if hiword(wparam) = BN_CLICKED then
      begin
        case loword(wparam) of
          IDC_CLOSEBTN: SendMessage(wnd, WM_CLOSE, 0, 0);
        end;
      end;

   else
      result := DefWindowProc(Wnd, uMsg, wParam, lParam);
   end;
end;

var
  hWnd     : THandle;
  Msg      : TMsg;
  wndClass : TWndClass;
begin
   wndClass.style          := CS_HREDRAW or CS_VREDRAW;
   wndClass.lpfnWndProc    := @WndProc;
   wndClass.cbClsExtra     := 0;
   wndClass.cbWndExtra     := 0;
   wndClass.hInstance      := hInstance;
   wndClass.hIcon          := LoadIcon(0, IDI_APPLICATION);
   wndClass.hCursor        := LoadCursor(0, IDC_ARROW);
   wndClass.hbrBackground  := COLOR_APPWORKSPACE;
   wndClass.lpszMenuName   := nil;
   wndClass.lpszClassName  := 'MyTestWndClass';

   RegisterClass(wndClass);

   hWnd := CreateWindowEx(
      WS_EX_LAYERED,
      wndClass.lpszClassName,
      'Blabla...',
      WS_POPUP or WS_SYSMENU,
      Integer(CW_USEDEFAULT),
      Integer(CW_USEDEFAULT),
      Integer(CW_USEDEFAULT),
      Integer(CW_USEDEFAULT),
      0,
      0,
      hInstance,
      nil);

   ShowWindow(hWnd, SW_SHOW);
   UpdateWindow(hWnd);

   while(GetMessage(msg, 0, 0, 0)) do
   begin
      TranslateMessage(msg);
      DispatchMessage(msg);
   end;
end.