[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.

[turboPASCAL]

Oh, keiner eine Idee ?

Delphi-Quellcode:

asm
  push hä, wie
  pop ToTop
end.

[Go2EITS]

Ich glaube, kaum jemand mag den Code durchkauen. Obwohl, interessantes Projekt.
In erster Linie benötigst Du den DC. Damit Du weiter kommst, mach mal ne Miniversion,
die wir nachvollziehen kommen. Dann antwortet Dir auch einer, der es kann..
Mit besten Grüßen
Go2EITS

[turboPASCAL]

Ist das zu komplex ? Ist doch schon eine Miniversion. das problem ist der DC, aber halt unabhänig vom Gerät.

[turboPASCAL]

So, habs soweit hin bekommen. Das Project läuft nun ohne die Graphics Unit der VCL.

Das erstellen und Konvertieren des Bitmaps schaut nun so aus:

Delphi-Quellcode:

procedure CreateBitmap32(width, height: Word);
var
  bmi: BITMAPINFO;
begin
  BmpDC := CreateCompatibleDC(0);

  with bmi do
  begin
    bmiHeader.biSize := SizeOF(bmi.bmiHeader);
    bmiHeader.biWidth := width;
    bmiHeader.biHeight := -height;
    bmiHeader.biPlanes := 1;
    bmiHeader.biBitCount := 32;
    bmiHeader.biCompression := BI_RGB;
    bmiHeader.biSizeImage := 0;
    bmiHeader.biXPelsPerMeter := 0;
    bmiHeader.biYPelsPerMeter := 0;
    bmiHeader.biClrUsed := 0;
    bmiHeader.biClrImportant := 0;
  end;

  hBMP := CreateDIBSection(BmpDC, bmi, DIB_RGB_COLORS, bits, 0, 0);
  SelectObject(BmpDC, hBMP);
end;

procedure DeleteBitmap32;
begin
  DeleteDC(BmpDC);
  DeleteObject(hBMP);
end;

Delphi-Quellcode:

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

        // RGB Bitmap laden
        RGBBmp :=  LoadImage(hInstance, 'RGB', IMAGE_BITMAP, 0, 0, 0);
        RGBBmpDC := CreateCompatibleDC(0);
        SelectObject(RGBBmpDC, RGBBmp);

        GetObject(RGBBmp, sizeof(BITMAP), @BmpInfo);

        CreateBitmap32(BmpInfo.bmWidth, BmpInfo.bmHeight);

        BitBlt(BmpDC, 0, 0, BmpInfo.bmWidth, BmpInfo.bmHeight, RGBBmpDC, 0, 0, SRCCOPY);

        // noch 'n Close Button malen
        DrawFrameControl(BmpDC,
          _RECT(0, 0, 16, 16), DFC_CAPTION, DFCS_CAPTIONCLOSE);

        DeleteObject(RGBBmp);
        DeleteDC(RGBBmpDC);

        // Mask Bitmap laden

        MskBmp :=  LoadImage(hInstance, 'MASK', IMAGE_BITMAP, 0, 0, 0);
        MskBmpDC := CreateCompatibleDC(0);
        SelectObject(MskBmpDC, MskBmp);

        // noch 'n Alphawert für den Closebutton erzeugen
        Brush := CreateSolidBrush($00FFFFFF);
        FillRect(MskBmpDC, _RECT(0, 0, 16, 16), Brush);
        DeleteObject(Brush);

        // RGB und Alpha -Bitmap kombinieren
        for y := 0 to BmpInfo.bmHeight - 1 do
          for x := 0 to BmpInfo.bmWidth - 1 do
          begin
            // "Get Pixel form Pointer"
            rgba := pRGBA(INTEGER(bits) + (x + y * BmpInfo.bmWidth) * 4);
            //

            PixColor := GetPixel(MskBmpDC, x, y);

            rgba.alpha :=
                 (GetRValue(PixColor) +
                  GetGValue(PixColor) +
                  GetBValue(PixColor)) div 3;
         end;

        DeleteObject(MskBmp);
        DeleteDC(MskBmpDC);
        ////////////////////////////////////////////////////////////////////////

        // einen Button zum Schliessen erstellen (welcher auf dem Bitmap ist)

        //...
      end;

    WM_DESTROY:
  // ...

Das läuft nun noch etwas "langsam", ich denke mal wegen dem GetRValue etc.

Mal schauen was man da machen kann.

Den akt. Code gibts im Anhang und die fertige Exe ist inkl. Bitmaps nur noch ~ 76 KB gross. ;)