bitmap is not displayed

[Anders Melander 1782]

2 hours ago, KodeZwerg said:

Somewhere I've done a mistake, when I remove the "halt" app going into a deadlock. 

function WindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  case Msg of
    WM_DESTROY:
      begin
        PostQuitMessage(0);
        Exit(0);
      end;
  else
    Result := DefWindowProc(hWnd, Msg, wParam, lParam);
  end;
end;

procedure RunClient;
begin
  UpdateWindow(LHWND);
  while (integer(GetMessage(LMsg, LHWND, 0, 0)) > 0) do
  begin
    if (LMsg.message = WM_QUIT) then
    begin
      PostQuitMessage(0);
      break;
    end;
    TranslateMessage(LMsg);
    DispatchMessage(LMsg);
  end;
  UnregisterClass(PChar(GClassName), LInst);
end;

 

The main problem was that GetMessage is declared to return a BOOL but it actually returns an integer. Specifically, it returns -1 when the message queue has been destroyed.

[milurt 0]

now i have this and it is still nothing to see, but b=True

bmpw:tagbitmap;

 

  hbmp:=CreateBitmap(100,100,1,24,RGBMem);
  bc:=CreateCompatibleDC(winddc);
  boss:=SelectObject(bc,hbmp);
  ???: getobject(hbmp,sizeof(bmpw),Addr(bmpw));
  b:=bitblt(winddc,0,0,620,489,bc,0,0,SRCCOPY);
  SelectObject(bc,boss);
  DeleteObject(bc);

 

[Remy Lebeau 1392]

On 3/23/2023 at 7:17 AM, Anders Melander said:

The main problem was that GetMessage is declared to return a BOOL but it actually returns an integer.

BOOL is an integer.  The Windows.BOOL type is defined as a LongBool.  Don't confuse BOOL with Delphi's native Boolean type. See: BOOL vs. VARIANT_BOOL vs. BOOLEAN vs. bool

Quote

Specifically, it returns -1 when the message queue has been destroyed.

It returns -1 when it is passed invalid parameters, see: When will GetMessage return -1? Besides, assuming no memory corruption has occurred, it is otherwise physically impossible for a thread's message queue to be destroyed while the thread is still running, and a thread can't retrieve messages for other threads.

Edited May 8, 2023 by Remy Lebeau

[Remy Lebeau 1392]

On 3/22/2023 at 7:00 AM, milurt said:

now compile it: is there a procedure missed? why the picture is not to see in the window?

There is a LOT of things wrong with the code you have shown.

 

Starting with the fact that you are trying to draw onto your window from outside of a WM_PAINT message handler. You need to move that logic inside your WndProc() function instead.

 

Or, the fact that you are giving invalid data to CreateBitmapIndirect(), or that you are setting up your HDCs incorrectly.

 

Try something more like the following instead:

program ForumBitmap2023;

{$APPTYPE GUI}

uses
  System.SysInit,
  Winapi.Messages,
  Winapi.Windows;

var
  hBmp: HBITMAP;

function WndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  PS: TPaintStruct;
  hOldBmp: HBITMAP;
  hdcBmp: HDC;
begin
  Result := 0;

  case uMsg of
    WM_CREATE:
      hBmp := LoadImage(0, 'C:\Paints.bmp', IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE);
    end;

    WM_DESTROY: begin
      DeleteObject(hBmp);
      PostQuitMessage(0);
    end;

    WM_PAINT: begin
      BeginPaint(hWnd, PS);
      hdcBmp := CreateCompatibleDC(PS.hdc);
      hOldBmp := SelectObject(hdcBmp, hBmp);
      BitBlt(PS.hdc, 30, 10, 620, 489, hdcBmp, 0, 0, SRCCOPY);
      SelectObject(hdcBmp, hOldBmp);
      DeleteDC(hdcBmp);
      EndPaint(hWnd, PS);
    end
  else
    Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
  end;
end;

var
  cls: WNDCLASSEX;
  hWnd: HWND;
  msg: TMsg;
begin
  ZeroMemory(@cls, Sizeof(cls));
  cls.cbSize := Sizeof(cls);
  cls.style := CS_HREDRAW or CS_VREDRAW;
  cls.lpfnWndProc := Addr(WndProc);
  cls.cbclsExtra := 0;
  cls.cbWndExtra := 0;
  cls.hInstance := HInstance;
  cls.hIcon := LoadIcon(0, IDI_APPLICATION);
  cls.hCursor := 0;
  cls.hbrBackground := COLOR_HIGHLIGHTTEXT + 1;
  cls.lpszMenuName := nil;
  cls.lpszClassName := 'Window';
  cls.hIconSm := LoadIcon(cls.hInstance, IDI_APPLICATION);
  RegisterClassEx(cls);

  hWnd := CreateWindow(cls.lpszClassName, 'Program', WS_OVERLAPPED or WS_SIZEBOX, 300, 100, 700, 500, 0, 0, cls.hInstance, nil);
  ShowWindow(hWnd, SW_SHOW);
  UpdateWindow(hWnd);

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

  ExitCode := msg.wParam;
end.

 

Edited May 9, 2023 by Remy Lebeau

[programmerdelphi2k 237]

18 minutes ago, Remy Lebeau said:

hBmp, hOldBmp: HBITMAP;

{$APPTYPE GUI}

uses
  Winapi.Messages,  // <--- System.SysInit
  Winapi.Windows;

var
  hBmp: HBITMAP;

function WndProc(hWnd: hWnd; uMsg: UINT; wParam: wParam; lParam: lParam): LRESULT; stdcall;
var
  PS               : TPaintStruct;
  { hBmp, } hOldBmp: HBITMAP; // <---   hiding hBMP global = hBmp always "0"

 

[Remy Lebeau 1392]

3 hours ago, programmerdelphi2k said:

uses
  Winapi.Messages,  // <--- System.SysInit
  Winapi.Windows;

 

Using System.SysInit was intentional to get to the global HInstance variable.

But you are right, I needed Winapi.Messages, too.  I have now added it.

3 hours ago, programmerdelphi2k said:

 

var
  hBmp: HBITMAP;

function WndProc(hWnd: hWnd; uMsg: UINT; wParam: wParam; lParam: lParam): LRESULT; stdcall;
var
  PS               : TPaintStruct;
  { hBmp, } hOldBmp: HBITMAP; // <---   hiding hBMP global = hBmp always "0"

Good catch.  That was a copy/paste error as I was reorganizing the code.  I have now fixed it.

 

Edited May 9, 2023 by Remy Lebeau

[milurt 0]

On 5/9/2023 at 12:41 AM, Remy Lebeau said:

BOOL is an integer.  The Windows.BOOL type is defined as a LongBool.  Don't confuse BOOL with Delphi's native Boolean type. See: BOOL vs. VARIANT_BOOL vs. BOOLEAN vs. bool

It returns -1 when it is passed invalid parameters, see: When will GetMessage return -1? Besides, assuming no memory corruption has occurred, it is otherwise physically impossible for a thread's message queue to be destroyed while the thread is still running, and a thread can't retrieve messages for other threads.

 

[milurt 0]

that i don't have inserted

[milurt 0]

hdcBmp := CreateCompatibleDC(PS.hdc);
      hOldBmp := SelectObject(hdcBmp, hBmp);
      BitBlt(PS.hdc, 30, 10, 620, 489, hdcBmp, 0, 0, SRCCOPY);
      SelectObject(hdcBmp, hOldBmp);
      DeleteDC(hdcBmp);

[milurt 0]

that before has not worked

[milurt 0]

now i have this and i can not see the picture:

 

program BitmapToWindow;

  {$APPTYPE GUI}

  uses WinProcs,System.SysUtils;
 
  var
    FMem:Pointer;
    FH:THandle;
    F:File of Byte;
    FR:LongInt;
    BMem:Pointer;
    
    PicWidth,PicHeight:Integer;
    WinX,WinY,WinWidth,WinHeight,
    HWnd1:HWND;
    WCls1:WndClassEx;
    WinDC:HDC;
    PS:TPaintStruct;
    WinBP:HDC;
    PB:Boolean;
    
    BmpH:HBitmap;
    CDC:HDC;
    SelO:HGDIObj;
    BmpT:tagBitmap;
    

  Procedure WinOpen;
    Var
      WCN,WT:PChar;
      WReg:Integer;
      WH1:HWnd;
  Begin
    WCls1.cbSize:=sizeof(WCls1);
    WCls1.style:=CS_HREDRAW Or CS_VREDRAW;
    WCls1.lpfnWndProc:=Addr(DefWindowProc);
    WCls1.cbclsExtra:=0;
    WCls1.cbWndExtra:=0;
    WCls1.hInstance:=GetModuleHandle(nil);;
    WCls1.hIcon:=winprocs.LoadIcon(0, IDI_APPLICATION);
    WCls1.hCursor:=0;
    WCls1.hbrBackground:=(14 + 1);
    WCls1.lpszMenuName:=NiL;
    WCls1.lpszClassName:='My Window'#0;
    WCls1.hIconSm:=LoadIcon(WCls1.hInstance, IDI_APPLICATION);

    WReg:=WinProcs.RegisterClassEx(WCls1);

    WT:='My Program'#0;
    WCN:='My Window'#0;

    HWnd1:=WinProcs.CreateWindow(WCN,WT,
      WS_OVERLAPPED+WS_SIZEBOX+WS_TABSTOP,
      WinX,WinY,WinWidth,WinHeight,
      0,0,GetModuleHandle(NiL),NiL);

    ShowWindow(HWnd1,sw_show);
    UpdateWindow(HWnd1);
  End;
      
  Procedure PaintOpen;
  Begin
    WinDC:=WinProcs.GetDC(HWnd1);
    PS.hdc:=WinDC;
    PS.ferase:=false;
    PS.rcpaint.left:=WinX;
    PS.rcpaint.top:=WinY;
    PS.rcpaint.right:=WinWidth;
    PS.rcpaint.bottom:=WinHeight;
    WinBP:=WinProcs.BeginPaint(HWnd1,PS);
  End;

  Procedure PaintRect(RX,RY,RWidth,RHeight:Integer;R,G,B:Byte);
    Var R1:TRect;B1:HBrush;
  Begin
    R1.left:=RX;
    R1.right:=RX+RWidth;
    R1.top:=RY;
    R1.bottom:=RY+RHeight;
    B1:=CreateSolidBrush(((B*256)+G)*256+R);
    fillrect(WinDC,r1,b1);
    DeleteObject(B1);
  End;

Begin
  FMem:=GetMemory(1000000);
  AsSign(F,'D:\15333842.bmp');
  FH:=FileOpen('D:\15333842.bmp',fmOpenReadWrite);
  FR:=FileRead(FH,FMem^,909594{FileSize(F)});

  Longint(BMem):=longint(FMem)+Longint(Pointer(longint(FMem)+10)^);
  PicWidth:=LongInt(Pointer(longint(FMem)+18)^);
  PicHeight:=LongInt(Pointer(longint(FMem)+22)^);

  WinWidth:=PicWidth+20;WinHeight:=PicHeight+20;
  WinX:=(1920-WinWidth) Div 2;WinY:=(1080-WinHeight) Div 2;
  WinOpen;
  PaintOpen;
  PaintRect(0,0,WinWidth,WinHeight,0,200,0);

  BmpT.bmtype:=0;
  BmpT.bmwidth:=PicWidth;
  BmpT.bmheight:=PicHeight;
  BmpT.bmWidthBytes:=2*BmpT.bmwidth;
  BmpT.bmplanes:=1;
  BmpT.bmbitspixel:=24;
  BmpT.bmBits:=BMem;

  BmpH:=CreateBitmap(PicWidth,PicHeight,1,24,BMem);
  CDC:=CreateCompatibleDC(WinDC);
  SelO:=SelectObject(CDC,BmpH);
  getobject(BmpH,sizeof(bmpT),Addr(bmpT));
  PB:=BitBlT(WinDC,00,00,PicWidth,PicHeight,CDC,00,00,SRCCopy);
  SelectObject(CDC,SelO);
  DeleteObject(CDC);

  Repeat Until GetAsyncKeyState(32)=-32768;
end.

 

[PeterBelow 238]

For a GUI program this code is not designed correctly. A GUI program has to have a message loop and has to do any painting of the UI when Windows tells it to paint its window, by handling the WM_PAINT message in the window proc. You cannot leave that to DefWindowProc in this case, since it knows nothing about the bitmap you want to show.

 

Anyway, this is not the way you write GUI programs in Delphi. Just create a VCL program skeleton via the File -> New menu, drop a TImage on the form the IDE creates for you, load the bitmap into its Picture property, set the Align property of the image to alclient, save the project, build and run it. Done.

 

The whole purpose of using an environment offering a rich GUI class library like Delphi's VCL is to shield you from all the messy details of the Windows API.

[KodeZwerg 54]

6 hours ago, milurt said:

  Repeat Until GetAsyncKeyState(32)=-32768;

 

Really? You thinking this is how GUI Applications made for Windows are internal working?

[milurt 0]

with the wndproc the program works not better: i can see no window anymore

 

program BmpToWinWP;

  {$APPTYPE GUI}

  uses WinProcs,System.SysUtils;
 
  var
    FMem:Pointer;
    FH:THandle;
    F:File of Byte;
    FR:LongInt;
    BMem:Pointer;
    
    PicWidth,PicHeight:Integer;
    WinX,WinY,WinWidth,WinHeight,
    HWnd1:HWND;
    WCls1:WndClassEx;
    WinDC:HDC;
    PS:TPaintStruct;
    WinBP:HDC;
    PB:Boolean;
    
    BmpH:HBitmap;
    CDC:HDC;
    SelO:HGDIObj;
    BmpT:tagBitmap;
    
  Procedure WinOpen;
    Var
      WCN,WT:PChar;
      WReg:Integer;
      WH1:HWnd;
  Begin
    WCls1.cbSize:=sizeof(WCls1);
    WCls1.style:=CS_HREDRAW Or CS_VREDRAW;
    WCls1.lpfnWndProc:=Addr(DefWindowProc);
    WCls1.cbclsExtra:=0;
    WCls1.cbWndExtra:=0;
    WCls1.hInstance:=GetModuleHandle(nil);;
    WCls1.hIcon:=winprocs.LoadIcon(0, IDI_APPLICATION);
    WCls1.hCursor:=0;
    WCls1.hbrBackground:=(14 + 1);
    WCls1.lpszMenuName:=NiL;
    WCls1.lpszClassName:='My Window'#0;
    WCls1.hIconSm:=LoadIcon(WCls1.hInstance, IDI_APPLICATION);

    WReg:=WinProcs.RegisterClassEx(WCls1);

    WT:='My Program'#0;
    WCN:='My Window'#0;

    HWnd1:=WinProcs.CreateWindow(WCN,WT,
{{}      ws_popup+ws_tabstop,  {NoFrame,NoTitle,NoMenu,NoMove,NoTabStop,00XY00}
{{      WS_OVERLAPPED+WS_SIZEBOX+WS_TABSTOP,  {ThickFrame,Title,NoMenu,NoMove,NoTabStop,ThanXY00}
      WinX,WinY,WinWidth,WinHeight,
      0,0,GetModuleHandle(NiL),NiL);

    ShowWindow(HWnd1,sw_show);
    UpdateWindow(HWnd1);
  End;
      
  Procedure PaintOpen;
  Begin
    WinDC:=WinProcs.GetDC(HWnd1); {device context of window}
    PS.hdc:=WinDC;
    PS.ferase:=false;
    PS.rcpaint.left:=WinX;
    PS.rcpaint.top:=WinY;
    PS.rcpaint.right:=WinWidth;
    PS.rcpaint.bottom:=WinHeight;
    WinBP:=WinProcs.BeginPaint(HWnd1,PS);
  End;

  Procedure PaintRect(RX,RY,RWidth,RHeight:Integer;R,G,B:Byte);
    Var R1:TRect;B1:HBrush;
  Begin
    R1.left:=RX;
    R1.right:=RX+RWidth;
    R1.top:=RY;
    R1.bottom:=RY+RHeight;
    B1:=CreateSolidBrush(((B*256)+G)*256+R);
    fillrect(WinDC,r1,b1);
    DeleteObject(B1);
  End;

  procedure wndproc(hwnd:hwnd;msg,pw:word;pl:longint);
  begin
    case msg of
      wm_paint:begin   
  WinWidth:=PicWidth+20;WinHeight:=PicHeight+20;
  WinX:=(1920-WinWidth) Div 2;WinY:=(1080-WinHeight) Div 2;
  WinOpen;
  PaintOpen;
  PaintRect(0,0,WinWidth,WinHeight,0,200,0);
  PaintRect(10,10,PicWidth,PicHeight,200,0,0);

  BmpT.bmtype:=0;
  BmpT.bmwidth:=PicWidth;
  BmpT.bmheight:=PicHeight;
  BmpT.bmWidthBytes:=2*BmpT.bmwidth;
  BmpT.bmplanes:=1;
  BmpT.bmbitspixel:=24;
  BmpT.bmBits:=BMem;

  BmpH:=CreateBitmap(PicWidth,PicHeight,1,24,BMem);
  CDC:=CreateCompatibleDC(WinDC);
  SelO:=SelectObject(CDC,BmpH);
  getobject(BmpH,sizeof(bmpT),Addr(bmpT));
  PB:=BitBlT(WinDC,00,00,PicWidth,PicHeight,CDC,00,00,SRCCopy);
  SelectObject(CDC,SelO);
  DeleteObject(CDC);
end;
    end;
  end;

Begin
  FMem:=GetMemory(1000000);
  AsSign(F,'D:\15333842.bmp');
  FH:=FileOpen('D:\15333842.bmp',fmOpenReadWrite);
  FR:=FileRead(FH,FMem^,909594{FileSize(F)});

  Longint(BMem):=longint(FMem)+Longint(Pointer(longint(FMem)+10)^);
  PicWidth:=LongInt(Pointer(longint(FMem)+18)^);
  PicHeight:=LongInt(Pointer(longint(FMem)+22)^);

  Repeat Until GetAsyncKeyState(32)=-32768;
end.

 

[milurt 0]

and with

WCls1.lpfnWndProc:=Addr(wndproc);

it is not working too

[milurt 0]

and improved the main with this winopen gives a runtime error with opening the cpu-window:

 

Begin
  FMem:=GetMemory(1000000);
  AsSign(F,'D:\15333842.bmp');
  FH:=FileOpen('D:\15333842.bmp',fmOpenReadWrite);
  FR:=FileRead(FH,FMem^,909594{FileSize(F)});

  Longint(BMem):=longint(FMem)+Longint(Pointer(longint(FMem)+10)^);
  PicWidth:=LongInt(Pointer(longint(FMem)+18)^);
  PicHeight:=LongInt(Pointer(longint(FMem)+22)^);

  WinWidth:=PicWidth+20;WinHeight:=PicHeight+20;
  WinX:=(1920-WinWidth) Div 2;WinY:=(1080-WinHeight) Div 2;
  WinOpen;
  PaintOpen;

  Repeat Until GetAsyncKeyState(32)=-32768;
end.

 

[PeterBelow 238]

21 hours ago, milurt said:

and with

WCls1.lpfnWndProc:=Addr(wndproc);

it is not working too

Why do you expect this to work? Your program still does not have a messager loop!

[milurt 0]

but even than there is this runtime error with the cpu-window

in my embarcadero 10.4 for windows 10 64-bit

 

  WinOpen;
  PaintOpen;

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

  Repeat Until GetAsyncKeyState(32)=-32768;

End.

 

[David Heffernan 2345]

WinProcs? Why are you working with code from the 1990s? Where did that code come from? 

[KodeZwerg 54]

15 hours ago, David Heffernan said:

WinProcs? Why are you working with code from the 1990s? Where did that code come from? 

I do more wonder why he not uses the example from @Remy Lebeau or the thing that I posted and close this topic/thread as solved.

[milurt 0]

last example of remy lebau: my embarcadero could not find

System.SysInit but the other both libraries.

 

[milurt 0]

and kodezwerg: my question was pointer^:=rgb;

 

[Remy Lebeau 1392]

7 hours ago, milurt said:

last example of remy lebau: my embarcadero could not find

System.SysInit but the other both libraries.

Then try changing it from System.SysInit to just SysInit.

[milurt 0]

sysinit: he says it is redeclared and has 6 compiler-errors

 

[KodeZwerg 54]

On 7/31/2023 at 1:51 PM, milurt said:

and kodezwerg: my question was pointer^:=rgb;

 

To correct you, your topic is "bitmap not displayed", very informative but anyway I've read, later we found out that you try to code in a non-Vcl style by doing many things wrong.
So Remy and I spend our time to write you an example.
While you say that you can not compile for whatever reason Remy's code you said nothing to mine.
Anders was correcting mine so it will do what your initial problem was, it display a bitmap. (even without fixing it does work...)

Why you insist to still use your wrong way of doing?
Why you never use the </> button to put your code better readable in?
Why am I replying to this topic anymore?

Best of luck!