Jump to content
milurt

bitmap is not displayed

Recommended Posts

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.

  • Thanks 1

Share this post


Link to post

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);

 

Share this post


Link to post
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 by Remy Lebeau

Share this post


Link to post
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 by Remy Lebeau

Share this post


Link to post
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"

 

Share this post


Link to post
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 by Remy Lebeau

Share this post


Link to post
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.

 

Share this post


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

Share this post


Link to post

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.

 

Share this post


Link to post

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.

Share this post


Link to post
6 hours ago, milurt said:

  Repeat Until GetAsyncKeyState(32)=-32768;

 

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

Share this post


Link to post

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.

 

Share this post


Link to post

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.

 

embwperr.png

Share this post


Link to post
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!

Share this post


Link to post

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.

 

Share this post


Link to post
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.

Share this post


Link to post

last example of remy lebau: my embarcadero could not find

System.SysInit but the other both libraries.

 

Share this post


Link to post
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.

Share this post


Link to post
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!

  • Like 2

Share this post


Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×