Jump to content
milurt

bitmap is not displayed

Recommended Posts

is a procedure missing or the sequence wrong?

 

var B001:tagBitmap;
HB:hbitmap;
bitmap1-3:hdc;
begin
hwnd001:=createwindow;
wdc:=getdc;hbp:=beginpaint;
PB:=getmemory;
B001.bmBits:=PB;

HB:=CreateBitmapIndirect(B001);
bitmapdc1:=getdc(HB);
selectobject(bitmapdc2,bitmapdc1);
bitmapdc3:=CreateCompatibleDC(bitmapdc2);
bitblt(wdc,300,300,200,100,bitmapdc3,0,0,SRCCOPY);

end.

 

Share this post


Link to post

Is it too much to ask that you make your code readable if you're asking other people to spend their time reading it?

 

There's a whole bunch of stuff missing from the code you posted. So much that there's not much point in trying to figure out what problem you're having (you might also have stated that. we're not mind readers).

Share this post


Link to post

i think it is better, if i do not write the complete
registerclass and createwindow. than you have
more overview. why is that the problem? and the
second part of the program are the bitmap-drawing-
procedures, where i asked which procedure can
be absent. are the variables:=procedures better
readable, if i make some spaces at the beginning
of the line?

 

Share this post


Link to post

Ok then,

imassumingthatthisisaWM_PAINThandler.ifnot,thenyouneedtoreadtheBeginPaintdocumentation.ifitis,thenthere'samissingcalltoEndPaint.youarealsonotusingtheinformationinPAINTSTRUCTfilledoutbyBeginPaint.

andfinally,youstillhaven'ttolduswhattheactualproblemis.

  • Haha 1

Share this post


Link to post

some like this...?  (from CodeProject in C  sources)

 

in Delphi

procedure TForm1.Button3Click(Sender: TObject);
var
  LScreenWidth   : Integer;
  LScreenHeigth  : Integer;
  LHWndDesktop   : HWND;
  LHDCDesktop    : HDC;
  LHDCCapture    : HDC;
  LHBitmapCapture: HBITMAP;
begin
  LHWndDesktop    := 0;
  LHDCDesktop     := 0;
  LHDCCapture     := 0;
  LHBitmapCapture := 0;
  try
    // maybe it's better verify if ( HDCxxxx > 0) then ...
    LScreenWidth  := GetSystemMetrics(SM_CXSCREEN); // screen sizes
    LScreenHeigth := GetSystemMetrics(SM_CYSCREEN);
    //
    LHWndDesktop := GetDesktopWindow;
    LHDCDesktop  := GetDC(LHWndDesktop);
    //
    LHDCCapture     := CreateCompatibleDC(LHDCDesktop);
    LHBitmapCapture := CreateCompatibleBitmap(LHDCDesktop, LScreenWidth, LScreenHeigth);
    //
    SelectObject(LHDCCapture, LHBitmapCapture);
    BitBlt(LHDCCapture, 0, 0, LScreenWidth, LScreenHeigth, LHDCDesktop, 0, 0, SRCCOPY {or CAPTUREBLT}
    );//
    Image1.Picture.Bitmap.Handle := LHBitmapCapture; // just get the handle of this object...
    
    
    // storing in some place (disk, memory,etc...) to load later...
    // Image1 is TImage just show on form tests...
    Image1.Picture.Bitmap.SaveToFile('bmptemp.bmp');
    Image1.Picture.Bitmap.LoadFromFile('bmptemp.bmp');
  finally
    ReleaseDC(LHWndDesktop, LHDCDesktop);
    DeleteDC(LHDCCapture);
    DeleteObject(LHBitmapCapture); // this destroy the LHBitmapCapture (reference) above!
  end;
end;

 

screenshot.gif

Edited by programmerdelphi2k

Share this post


Link to post

the paintstruct defines the area to paint, but after my set of bitmap-drawing procedure i see the window and other

drawings but not the bitmap, which i want from tagbitmap place on beginpaint.

Share this post


Link to post

Don't expect people to help you if you don't want to make an effort yourself. You need to make it as easy as possible for us to help you.

Generally, when describing a problem there are 4 things you need to state:

  1. What are you trying to do (high-level description)?
    E.g. I'm trying to display a bitmap
  2. How are you doing it (the steps)?
    Clean up your code. Post the whole method/function and use the code tag (the </> button).
  3. What is the expected result?
    E.g. The bitmap is drawn in the window
  4. What is the actual/observed result?
    E.g. Nothing is drawn in the window

You don't need to write it as a list but unless we have all this information we will have to guess and that just slows things down.

bad-bug-report-it-doesntwork.png.34c933db1cc235aa31e89c2a4cd7c0cf.png

 

See also: https://stackoverflow.com/help/how-to-ask

  • Thanks 1

Share this post


Link to post

And to elaborate a bit on Anders great pointers on how to ask a question that will get usable answers: When posting code use the code tags! It makes code just so much more readable by coloring and over all prettying things up. As you seem to have noticed yourself, formatting the code by following general guidelines like this one https://docwiki.embarcadero.com/RADStudio/Alexandria/en/Introduction to render it more human readable is also a plus. The less strain reading your code puts on the potential helpers eyes the more likely you will get great answers.

Share this post


Link to post

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


 

</>

program ForumBitmap2023;

{$APPTYPE GUI}

uses System.SysUtils,windows;

Var winc:WNDCLASSEx;
    wname,wcl:PChar;
    wnddc:hdc;
    windbp,hwind:hwnd;
    PStrc:TPAINTSTRUCT;
    FH:THandle;
    FBuf,Bmpf:Pointer;
    fch:Pchar;
    F:File of byte;
    BmpH:HBitmap;
    Bmp:tagBitmap;
    BmpDC1:Hdc;
    bmpdc2:hdc;
    bmpdc3:hdc;

  Function wndproc(hwndow:HWND;msga,msgword:word;msglong:longint):LResult;stdcall;
  Begin
    wndproc:=DefWindowProc(hwndow,msga,msgword,msglong);
  End;

Begin
  winc.cbSize:=sizeof(winc);
  winc.style:=CS_HREDRAW Or CS_VREDRAW;
  winc.lpfnWndProc:=Addr(wndproc);
  winc.cbclsExtra:=0;
  winc.cbWndExtra:=0;
  winc.hInstance:=0;;
  winc.hIcon:=LoadIcon(0, IDI_APPLICATION);
  winc.hCursor:=0;
  winc.hbrBackground:=(14 + 1);
  winc.lpszMenuName:=NiL;
  winc.lpszClassName:='Window'#0;
  winc.hIconSm:=LoadIcon(winc.hInstance, IDI_APPLICATION);
  RegisterClassEx(winc);
  wcl:='Program'#0;
  wname:='Window'#0;
  hwind:=CreateWindow(wname,wcl,WS_OVERLAPPED+WS_SIZEBOX,300,100,700,
          500,0,0,0,NiL);
  ShowWindow(hwind,sw_show);
  UpdateWindow(hwind);
  wndDC:=GetDC(hwind);
  PStrc.hdc:=wndDC;
  PStrc.ferase:=false;
  PStrc.rcpaint.left:=0;
  PStrc.rcpaint.top:=0;
  PStrc.rcpaint.right:=690;
  PStrc.rcpaint.bottom:=495;
  windBP:=BeginPaint(hwind,PStrc);

  Bmpf:=GetMemory(1000000*2);
  fch:=bmpf;
  fch:=fch+10;
  FBuf:=fch;
  AsSign(F,'C:\Paints.bmp');
  FH:=FileOpen('C:\Paints.bmp',fmOpenReadWrite);
  FileRead(FH,FBuf^,735829);

  bmp.bmtype:=0;
  bmp.bmwidth:=630;
  bmp.bmheight:=492;
  bmp.bmWidthBytes:=2*3*bmp.bmwidth;
  bmp.bmplanes:=1;
  bmp.bmbitspixel:=24;
  bmp.bmBits:=FBuf;
  BmpH:=CreateBitmapIndirect(bmp);
  bmpdc1:=getdc(bmph);
  selectobject(bmpdc2,Bmpdc1);
  BmpDC3:=CreateCompatibleDC(Bmpdc2);
  BitBlT(wnddc,30,10,620,489,BmpDC3,0,0,SRCCOPY);
end.

</>

 

Share this post


Link to post

try put a "wait me please" in last line...

Quote

  BitBlT(wnddc, 30, 10, 620, 489, bmpdc3, 0, 0, SRCCOPY);
  //
  readln;  // waiting...
 

 

Share this post


Link to post
1 hour ago, milurt said:

now compile it: is there a procedure missed?

Uh. This looks like a "classic" Windows application.

While it definitely is possible to create a Windows GUI application that doesn't use the RTL or VCL it isn't really something that is done anymore. If really you want to write a Windows application that way there are a few things missing from your code. I suggest you start by reading the following: https://learn.microsoft.com/en-us/windows/win32/learnwin32/your-first-windows-program

 

If all you want is an application that displays a form with a bitmap on it, here's one that does that:

program NoVCL;
{$APPTYPE GUI}
uses
  Forms, ExtCtrls;
var
  Form: TForm;
  Image: TImage;
begin
  Form := TForm.CreateNew(nil);
  try
    Image := TImage.Create(Form);
    Image.Parent := Form;
    Image.AutoSize := True;
    Image.Picture.Bitmap.LoadFromFile('bitmap.bmp');
    Form.ShowModal;
  finally
    Form.Free;
  end;
end.

 

Share this post


Link to post
3 hours ago, milurt said:

is there a procedure missed?

Not just a procedure, many things are wrong or looking strange at your code.

Exemplary:

procedure RunClient;
begin
  UpdateWindow(LHWND);
  while(GetMessage(LMsg, LHWND, 0, 0)) do
  begin
    TranslateMessage(LMsg);
    DispatchMessage(LMsg);
  end;
  UnregisterClassA(PChar(GClassName), LInst);
end;

A message loop.... (mostest basic things for non-Vcl code)

 

You really should structure your whole code better, making methods for each thing etc....

Share this post


Link to post

Here is a full example, excuse any errors, long time not done non-vcl 😛

program BitmapDemo;

{$APPTYPE GUI}

{.$R *.res}

uses
  Winapi.Windows, Winapi.Messages;

const
  GClassName: string = 'KodeZwergs_CLASS';
  GWidth: Integer = 800;
  GHeight: Integer = 600;

var
  LWinClass: TWndClass;
  LInst: HINST;
  LHWND,
  LBitmap: HWND;
  LMsg: TMsg;
  LBmp: HBITMAP;

function WindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  s: string;
  ws: WideString;
begin
  case Msg of
    WM_DESTROY: begin
                  UnregisterClass(PChar(GClassName), LInst);
                  PostQuitMessage(0);
                  Halt;
                end;
  else
    Result := DefWindowProc(hWnd, Msg, wParam, lParam);
  end;
end;

procedure CreateClient;
begin
  LInst := GetModuleHandle(nil);
  with LWinClass do
  begin
    style              := CS_CLASSDC or CS_PARENTDC or CS_HREDRAW or CS_VREDRAW;
    lpfnWndProc        := @WindowProc;
    cbClsExtra         := 0;
    cbWndExtra         := 0;
    hInstance          := LInst;
    hIcon              := LoadIcon(hInstance, PChar('MAINICON'));
    hCursor            := LoadCursor(0, PChar(IDC_ARROW));
    hbrBackground      := Succ(COLOR_BTNFACE);
    lpszMenuName       := PChar('');
    lpszClassname      := PChar(GClassName);
  end;
  RegisterClass(LWinClass);
  LHWND := CreateWindowEx(WS_EX_WINDOWEDGE or WS_EX_TOPMOST, PChar(GClassName),
                          PChar('KodeZwergs Bitmap Example'),
                          DS_CENTER OR WS_VISIBLE or WS_CAPTION or WS_POPUP or WS_SYSMENU or WS_BORDER,
                          ((GetSystemMetrics(SM_CXFULLSCREEN) div 2) - (GWidth div 2)),
                          ((GetSystemMetrics(SM_CYFULLSCREEN) div 2) - ((GHeight - (GetSystemMetrics(SM_CYSIZE) + GetSystemMetrics(SM_CYMIN))) div 2)),
                          GWidth, GHeight + GetSystemMetrics(SM_CYSIZE), 0, 0, LInst, NIL);
  if (LHWND = 0) then
    begin
      UnregisterClass(PChar(GClassName), LInst);
      Exit;
    end;

  // create static for bitmap
  LBitmap := CreateWindow('Static', '', SS_BITMAP or WS_CHILD or WS_VISIBLE or WS_GROUP,
                           5, 5, (GWidth - 5), (GHeight - 5), LHWND, 0, LInst, NIL);
  // load bitmap
  LBmp := LoadImage(LInst, PChar('.\Bitmap.bmp'), IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE);
  // display bitmap
  SendMessage(LBitmap, STM_SETIMAGE, IMAGE_BITMAP, LBmp);
end;

procedure RunClient;
begin
  UpdateWindow(LHWND);
  while(GetMessage(LMsg, LHWND, 0, 0)) do
  begin
    TranslateMessage(LMsg);
    DispatchMessage(LMsg);
  end;
  UnregisterClass(PChar(GClassName), LInst);
end;

begin
  CreateClient;
  RunClient;
end.

 

  • Like 1

Share this post


Link to post

me too... im getting "runtime error 216" behind form-main in showmessage (old run error...) in first run... later, run ok and show bmp into form

Edited by programmerdelphi2k

Share this post


Link to post
25 minutes ago, milurt said:

but who can say the error in my program?

It isn't a valid Windows GUI application at all so what do you expect us to say? Compare your code to @KodeZwerg's code. Can you spot the difference?

Why do you want to do it this way in the first place?

Share this post


Link to post
2 hours ago, KodeZwerg said:

WM_DESTROY: 
  begin
    UnregisterClass(PChar(GClassName), LInst);
    PostQuitMessage(0);
    Halt;
  end;

 

The Halt should probably be an Exit. Otherwise, there isn't much point in the PostQuitMessage.

Share this post


Link to post

mister anders melander,

do you want to say, what is missed to be a valid GUI?

kodezwerg has only made procedure for the createwindow-theme,

that types are not my questions.

this means no more procedures are to add to show the bitmap?

i have no runtime error.

Share this post


Link to post

@milurt  

say more about your project:

  1. what MSWindows you are using?
  2. what Delphi you are using?
  3. why you needs a non-conventional way to create your GUI app (go backing to the caves)?
  4. what your real objective with all this?
Edited by programmerdelphi2k

Share this post


Link to post
46 minutes ago, milurt said:

kodezwerg has only made procedure for the createwindow-theme,

If that is your only observation than you should re-read and re-compare what I am doing and what you are doing.

  • Like 1

Share this post


Link to post
9 minutes ago, programmerdelphi2k said:
  1. why you needs a non-conventional way to create your GUI app (go backing to the caves)?

Coding non-Vcl is a good way to learn how things are working under the Vcl.
(beside the benefit that the compiled file is just around 50kb vs 3mb by using Vcl)

Share this post


Link to post
4 minutes ago, KodeZwerg said:

Coding non-Vcl is a good way to learn how things are working under the Vcl.

not only in VCL, but in any other environment... unfortunatelly I lost the beggin in programming  ... I would like have learned more about the "root"

I would like to be a "cave-man"  too! 😪

Edited by programmerdelphi2k
  • Haha 1

Share this post


Link to post
13 hours ago, Anders Melander said:

The Halt should probably be an Exit. Otherwise, there isn't much point in the PostQuitMessage.

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

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

×