bitmap is not displayed

[milurt 0]

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.

 

[Anders Melander 1782]

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

[milurt 0]

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?

 

[Anders Melander 1782]

Ok then,

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

andfinally,youstillhaven'ttolduswhattheactualproblemis.

[programmerdelphi2k 237]

and Tezeus ran, ran, fleeing the labyrinth and the Minitaurus... however, he found Medusa on his way out, and petrified to death.

[programmerdelphi2k 237]

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;

 

Edited March 16, 2023 by programmerdelphi2k

[milurt 0]

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.

[milurt 0]

no tips anymore? why my program does not work.

 

[Anders Melander 1782]

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.

 

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

[Sherlock 663]

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.

[milurt 0]

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.

</>

 

[programmerdelphi2k 237]

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

Quote

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

 

[Anders Melander 1782]

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.

 

[KodeZwerg 54]

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

[KodeZwerg 54]

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.

 

[milurt 0]

but who can say the error in my program?

[programmerdelphi2k 237]

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 March 22, 2023 by programmerdelphi2k

[Anders Melander 1782]

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?

[Anders Melander 1782]

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.

[milurt 0]

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.

[programmerdelphi2k 237]

@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 March 22, 2023 by programmerdelphi2k

[KodeZwerg 54]

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.

[KodeZwerg 54]

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)

[programmerdelphi2k 237]

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 March 22, 2023 by programmerdelphi2k

[KodeZwerg 54]

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.