Entwickler-Ecke

Windows API - Bild wird nicht gezeichnet


delporum - Mi 02.08.23 10:16
Titel: Bild wird nicht gezeichnet
ich möchte von pointer^:=RGB in window x,y zeichnen.
pixel,line,rectangle funktionieren, aber nicht das bild, obwohl bitblt=true

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
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:=RegisterClassEx(WCls1);

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

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

    ShowWindow(HWnd1,sw_show);
    UpdateWindow(HWnd1);
  End;
      
  Procedure PaintOpen;
  Begin
    WinDC:=GetDC(HWnd1);
    PS.hdc:=WinDC;
    PS.ferase:=false;
    PS.rcpaint.left:=0;
    PS.rcpaint.top:=0;
    PS.rcpaint.right:=WinWidth;
    PS.rcpaint.bottom:=WinHeight;
    WinBP:=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:\Picture.bmp');
  FH:=FileOpen('D:\Picture.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);
  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);

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


Moderiert von user profile iconTh69: Delphi-Tags hinzugefügt


Sinspin - Mi 02.08.23 16:30

Bei dem Quelltext funktioniert bei mir auch nichts.
Pack den mal in Delphi Tags und formatiere ihn so dass man ihn lesen kann.
Ansonsten wirst Du wohl alleine rausfinden müssen was nicht geht.


gerd33 - Do 03.08.23 17:03

Hallo,

Sehe nichts unauffälliges.
ich bin mir nicht sicher aber reichen die F: File of byte aus. Muesste es da nicht integer heissen?
Das ist nur eine Vermutung von mir.

Gerd


Sinspin - Do 03.08.23 19:30

@Gerd:
F: File of Byte ist schon richtig.

@delporum:
Die Methode das Bild zu laden ist etwas extrem riskant.
Wenn man ein ein 24- oder 32-Bit Raster hat und dessen größe kennt, kann man das machen aber mit einer BMP Datei besser nicht.
Werte mal BmpH aus nach Aufruf von CreateBitmap.
Verwende auch mal FMem anstelle von BMem für CreateBitmap. Selbst wenn der Anfang nicht passt, solltest Du das Bild erkennen können.
GetObject brauchst du nicht, bzw macht nur Sinn zum Auswerten der Bitmap settings.
SelectObject auch nicht. Zeichne mal BmpH auf WinDC. das sollte es gewesen sein.


delporum - Sa 05.08.23 14:17

FMem war es nicht
BmpH bleibt gleich nach jeder prozedur
selectobject,getobject weglassen zeigt nichts
ich habe schon viele kombinationen ausprobiert bei den variablen.
8,32 bit an beiden stellen ging auch nicht

obwohl beim win 10 viele farben sind, steht irgendwo in den einstellungen 8-bit. was soll ich jetzt glauben.


Th69 - So 06.08.23 08:38

Warum versuchst du denn überhaupt die rohe WinAPI zu benutzen und nicht die VCL und dessen TBitmap [http://docwiki.embarcadero.com/Libraries/Alexandria/de/Vcl.Graphics.TBitmap]-Klasse?

So wie bisher dein Code ist, kannst du auch nur eine bestimmte Art von Bitmap-Dateien laden (24Bit, d.h. RGB), das Bitmap-Format [https://de.wikipedia.org/wiki/Windows_Bitmap] ist aber komplexer.

Und auch die WinAPI solltest du anders benutzen: das gesamte Zeichnen eines Windows sollte in der WM_PAINT Nachricht [https://learn.microsoft.com/de-de/windows/win32/gdi/the-wm-paint-message] stattfinden, nicht außerhalb (darum kann es auch sein, daß du nichts von der Bitmap siehst).


Sinspin - Mo 07.08.23 08:34

Die default Einstellungen für die Farbtiefe hängt vom Device ab auf dem man sich befindet.

Guck erstmal in die MS Hilfe wozu SelectObject überhaupt da ist.
Dort wird auch beschrieben wie man die Farbtiefe und alles andere für ein Bitmap einstellen kann wenn man es aus einem Raster selber lädt.
Aber ich würde dir raten das Windows-Bitmap Object zu verwenden wenn du eine echte BMP Datei laden willst.

user profile iconTh69 hat folgendes geschrieben Zum zitierten Posting springen:
Warum versuchst du denn überhaupt die rohe WinAPI zu benutzen und nicht die VCL und dessen TBitmap [http://docwiki.embarcadero.com/Libraries/Alexandria/de/Vcl.Graphics.TBitmap]-Klasse?

Wer braucht schon VCL? Nur die harten kommen in Garten! :lol:
Man kann sich doch auch mal damit befassen was neues zu erfinden anstatt immer nur dem Mist von anderen wiederzukäuen.
Oder zum Hunderttausendsten mal das Rad neu erfinden :gruebel:


delporum - Di 08.08.23 22:25

ich versuche schon 24 RGB bilder zu zeigen und die windows-prozeduren würden schon reichen.
der bildschirm dürfte keine probleme machen, weil die anderen programme ja normale bilder anzeigen.
und da setpixel,lineto,fillrect funktionieren, fehlt nur noch die bitblt.
plgblt und stretchblt funktionieren auch nicht.


Blup - Mi 09.08.23 17:32

So wird zumindest erst mal ein Bild angezeigt:

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
program BitmapToWindow;

  {$APPTYPE GUI}

  uses WinProcs,System.SysUtils;

  var
    FMem:Pointer;
    FH:THandle;
    FileLength: Int64;
    FR:LongInt;
    BMem:Pointer;
    WinX, WinY, WinWidth, WinHeight,
    PicWidth,PicHeight:Integer;

    HWnd1:HWND;
    WCls1:WndClassEx;
    WinDC:HDC;
    PS:TPaintStruct;
    WinBP:HDC;
    PB:Boolean;

    BmpH:HBitmap;
    CDC: HDC;
    SelO:HGDIObj;
    BmpT:TBitmapInfo; //tagBitmap;

  Procedure WinOpen;
    Var
      WCN,WT:PChar;
      WReg:Integer;
      WH1:HWnd;
      dx,dy: Integer;
  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:=RegisterClassEx(WCls1);

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

    dx := WinWidth + GetSystemMetrics(SM_CXFIXEDFRAME)*2;
    dy := WinHeight + GetSystemMetrics(SM_CYFIXEDFRAME)*2 + GetSystemMetrics(SM_CYCAPTION);
    WinX:=(1920-dx) Div 2;
    WinY:=(1080-dy) Div 2;

    HWnd1:=CreateWindow(WCN,WT,
      WS_OVERLAPPED+WS_SIZEBOX,
      WinX,WinY,dx,dy,
      0,0,GetModuleHandle(NiL),NiL);

    ShowWindow(HWnd1,sw_show);
    UpdateWindow(HWnd1);
  End;

  Procedure PaintOpen;
  Begin
    WinDC:=GetDC(HWnd1);
    PS.hdc:=WinDC;
    PS.ferase:=false;
    PS.rcpaint.left:=0;
    PS.rcpaint.top:=0;
    PS.rcpaint.right:=WinWidth;
    PS.rcpaint.bottom:=WinHeight;
    WinBP:=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
  FH:=FileOpen('D:\Picture.bmp',fmOpenReadWrite);
  if FH = INVALID_HANDLE_VALUE then
    Exit;
  try
    FileLength := FileSeek(FH,0,2);
    FileSeek(FH,0,0);
    FMem:=GetMemory(FileLength);
    FR:=FileRead(FH,FMem^, FileLength);
  finally
    FileClose(FH);
  end;

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

  WinWidth:=PicWidth+30;
  WinHeight:=PicHeight+30;
  WinOpen;
  PaintOpen;
  PaintRect(0,0,WinWidth,WinHeight,0,200,0);
  PaintRect(10,10,PicWidth,PicHeight,200,0,0);

  BmpT.bmiHeader.biSize:= SizeOf(BmpT.bmiHeader); // + SizeOf(BmpT.bmiColors) * Anzahl der Paletteneinträge
  BmpT.bmiHeader.biWidth:=PicWidth;
  BmpT.bmiHeader.biHeight:=PicHeight;
  BmpT.bmiHeader.biPlanes:=1;
  BmpT.bmiHeader.biBitCount:=24;

  CDC:=CreateCompatibleDC(WinDC);
  try
    BmpH := CreateCompatibleBitmap(WinDC, BmpT.bmiHeader.biWidth, BmpT.bmiHeader.biHeight);
    if BmpH = 0 then
      Exit;
    try
      SelO:=SelectObject(CDC,BmpH);
      try
        if SetDIBits(CDC, BmpH, 0, BmpT.bmiHeader.biHeight, BMem, BmpT, DIB_RGB_COLORS ) <= 0 Then
          Exit;

        PB:=BitBlT(WinDC,10,10,PicWidth,PicHeight,CDC,00,00,SRCCopy);
      finally
        SelectObject(CDC,SelO);
      end;
    finally
      DeleteObject(BmpH);
    end;
  finally
    DeleteObject(CDC);
  end;

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


delporum - Do 10.08.23 00:09

das war grossartig !!! blup
ich kann ein bild nun in ein window zeichnen.
herzlichen dank !