![]() |
Game mit API
So jetzt wirds extrem kompliziert. Also: es ging mir um ein einfaches Grafikspiel (welches weiß ich noch nicht) aber so weit bin ich noch gar nicht gekommen. Bis jetzt wollte ich es eingetlich nur so weit haben, das auf einen Dublebuffer ein Text gezeichnet wird, der von links nach rechts durch den Bildschirm läuft. Hört sich simpel an, war es aber für mich nicht. Das Problem ist, dass die Sach extrem flimmert. Doch genau das wollte ich ja mit dem Doublebuffer vermeiden.
Also hier einmal der Code: erstmal der Hauptteil
Delphi-Quellcode:
dann noch die Fehlenden procedures:
{******************************************************************************}
{ } { Fenster-Vorlage } { } { Copyright (c) 2002 Michael Puff } { [url]www.luckie-online.de[/url] } { [email]mpuff@luckie-online.de[/email] } { } {******************************************************************************} program Fenster_Vorlage; uses Windows, Messages,SysUtils,Graphics,draw,functions; const ClassName = 'WndClass'; AppName = 'Fenster-Vorlage'; WindowWidth = 800; WindowHeight = 600; timebase = 1; var hwndMain: DWORD; dc : HDC; //DeviceContext für ausgabe dcdbl : HDC; //DeviceContext für DBL dbl : HBITMAP; //Speicher für DBL hbrBkgnd:HBRUSH; crBkgnd:COLORREF; { GetLastError } function DisplayErrorMsg(hWnd: THandle): DWORD; var szBuffer: array[0..255] of Char; begin FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, GetLastError, 0, szBuffer, sizeof(szBuffer), nil); MessageBox(hWnd, szBuffer, 'Fehler', MB_ICONSTOP); result := GetLastError; end; function WndProc(hWnd: HWND; uMsg: UINT; wParam: wParam; lParam: LParam): lresult; stdcall; var x, y : integer; begin Result := 0; case uMsg of WM_CREATE: begin { Fenster zentrieren } x := GetSystemMetrics(SM_CXSCREEN); y := GetSystemMetrics(SM_CYSCREEN); MoveWindow(hWnd, (x div 2) - (WindowWidth div 2), (y div 2) - (WindowHeight div 2), WindowWidth, WindowHeight, true); end; WM_DESTROY: PostQuitMessage(0); WM_KEYDOWN: begin; case wparam of VK_ESCAPE: sendmessage(hwnd,WM_CLOSE,0,0); end; end; else Result := DefWindowProc(hWnd, uMsg, wParam, lParam); end; end; var wc: TWndClassEx = ( cbSize : SizeOf(TWndClassEx); Style : CS_HREDRAW or CS_VREDRAW; lpfnWndProc : @WndProc; cbClsExtra : 0; cbWndExtra : 0; lpszMenuName : nil; lpszClassName : ClassName; hIconSm : 0; ); msg: TMsg; zeit1,zeit2:longword; begin wc.hInstance := hInstance; wc.hIcon := LoadIcon(0, IDI_APPLICATION); wc.hCursor := LoadCursor(0, IDC_ARROW); wc.hbrBackground := GetStockObject(BLACK_BRUSH); RegisterClassEx(wc); hwndMain := CreateWindowEx(0, ClassName, AppName,WS_POPUP or WS_VISIBLE, 0,0, WindowWidth, WindowHeight, 0, 0, hInstance, nil); { Doublebuffer erstellen } dc := GetDC(hwndmain); dcdbl := CreateCompatibleDC(dc); dbl := CreateCompatibleBitmap(dc,WindowWidth,Windowheight); SelectObject(dcdbl,dbl); setbkcolor(dc,RGB(0,0,0)); showcursor(false); while true do begin if peekMessage(msg, 0, 0, 0,PM_REMOVE) then begin; //Wenn überhaupt Message da ist if msg.Message = WM_QUIT then Break; TranslateMessage(msg); DispatchMessage(msg); end; //Hauptfunktion aufrufen //Nur alle timebase aufrufen zeit1 := gettime; if (zeit1 > zeit2+timebase) then begin; erasedc(dc,WindowWidth,Windowheight); maindraw(dcdbl,windowWidth,Windowheight); //Doublebuffer auf den Bidlschirm blitten BitBlt(dc,0,0,WindowWidth,Windowheight,dcdbl,0,0,SRCPAINT); end; end; showcursor(true); DeleteObject(dbl); DeleteDC(dcdbl); DeleteDC(dc); ExitCode := msg.wParam; end.
Delphi-Quellcode:
und
var l:integer;
procedure maindraw(var dcdbl:HDC;heigth,width:integer); begin; l := l+0; TextOut(dcdbl,l,20,'TEST',4); end;
Delphi-Quellcode:
Wie bekomme ich das flimmern weg?
function gettime:longword;
var now,hour,min,sec,msec:word; z:longword; begin; decodetime(time,hour,min,sec,msec); z := msec+(sec*1000)+(min*60*1000)+(hour*60*60*1000); result := z; end; procedure erasedc(dc:HDC;w,h:integer); var rcBmp:TRECT; hbrBkgnd:HBRUSH ; crBkgnd:COLORREF; begin; crBkgnd := GetBkColor(dc); hbrBkgnd := CreateSolidBrush(crBkgnd); SetRect(rcBmp, -1, -1, w+1, h+1); FillRect(dc, rcBmp, hbrBkgnd); end; Danke TO |
Bau mal nach dem
Delphi-Quellcode:
ein else ein. Genauer: Deine Zeichenroutine in den else-Abschnitt von if PeekMessage.
DispatchMessage(msg);
end; Deine Funktion gettime hättest du dir sparen können, da für das, was du da vor hast, Windows schon eine solche Funktion liefert: GetTickCount. Es sind zwar nicht die Millisekunden der Uhrzeit, aber die seit Systemstart. Und da du sowieso zwei Zeiten vergleichst, ist es nicht von Bedeutung, auf was sich die Millisekundenangabe bezieht. |
ändert nux!
|
Wieso löscht du den den Hintergrund eigentlich, wenn du ihn sofort wieder komplett überzeichnest? Schmeiß mal das erasedc raus.
|
stimmt, das ware falsch: ich hätte den Doublebuffer löschen müßen:
Delphi-Quellcode:
auf Grund der Änderung muß ich oben noch die Backgroundfarbe ändern!
if (zeit1 > zeit2+timebase) then begin;
erasedc(dcdbl,WindowWidth,Windowheight); maindraw(dcdbl,windowWidth,Windowheight); //Doublebuffer auf den Bidlschirm blitten BitBlt(dc,0,0,WindowWidth,Windowheight,dcdbl,0,0,SRCPAINT); end; also statt setbkcolor(dcd,RGB(0,0,0)); muß es setbkcolor(dcdbl,RGB(0,0,0)); heißen außerdem hatte ich vorhin mal
Delphi-Quellcode:
geschrieben das ist natrülich blödsin, stattdessen muß es
l := l+0;
Delphi-Quellcode:
heißen.
l := l+1;
Wenn ich den Code so verändert habe, dann wird garnux mehr ausgegeben, warum? |
Also ich verstehe nicht so ganz, was du da vor hast, aber normlerweise zeichnet man auf das Fenster, in dem man WM_PAINT abfängt.
Desweiteren hast du die Units SysUtils und Graphics wieder mit drin, dann kannst du acuh gleich wieder die Unit Forms mit reinnehmen. |
Nicht ganz. Graphic gehört zwar zur VCL, bindet aber nur die RTL (SysUtils, Classes) ein, womit sie unabhängig vom Rest der VCL ist.
Zur NonVCL Programmierung: Das was du, Luckie, vorhast, könnte man eher als NonRTLandVCL bezeichnen. Bei MSVC++ verzichtet man ja auch nicht auf die RTL (msvcrtXx.dll). Diese wird eben nur von Windows gleich mitgebracht, was leider nicht auf die Delphi RTL zutrifft. |
also gut, das mit den Units läßt sich später klären. Aber wenn ich die sache in die WM_PAINT machen soll, wann tritt den das Event ein? Doch nur, wenn das Fenster neu gezeichent werden muß, also dann wenn es aus dem Hintergrund nach vornen kommt, oder nicht?
|
gut, habe den Code mal testweise so geändert:
Delphi-Quellcode:
warum geht das jetzt nicht? Das Programm löscht den Bildschirm gar nicht!
{******************************************************************************}
{ } { Fenster-Vorlage } { } { Copyright (c) 2002 Michael Puff } { [url]www.luckie-online.de[/url] } { [email]mpuff@luckie-online.de[/email] } { } {******************************************************************************} program Fenster_Vorlage; uses Windows,Messages,SysUtils,draw,functions; const ClassName = 'WndClass'; AppName = 'Fenster-Vorlage'; WindowWidth = 800; WindowHeight = 600; timebase = 1; var hwndMain: DWORD; dc : HDC; //DeviceContext für ausgabe dcdbl : HDC; //DeviceContext für DBL dbl : HBITMAP; //Speicher für DBL hbrBkgnd:HBRUSH; crBkgnd:COLORREF; { GetLastError } function DisplayErrorMsg(hWnd: THandle): DWORD; var szBuffer: array[0..255] of Char; begin FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, GetLastError, 0, szBuffer, sizeof(szBuffer), nil); MessageBox(hWnd, szBuffer, 'Fehler', MB_ICONSTOP); result := GetLastError; end; function WndProc(hWnd: HWND; uMsg: UINT; wParam: wParam; lParam: LParam): lresult; stdcall; var x, y : integer; zeit1,zeit2:longword; begin Result := 0; case uMsg of WM_CREATE: begin { Fenster zentrieren } x := GetSystemMetrics(SM_CXSCREEN); y := GetSystemMetrics(SM_CYSCREEN); MoveWindow(hWnd, (x div 2) - (WindowWidth div 2), (y div 2) - (WindowHeight div 2), WindowWidth, WindowHeight, true); end; WM_DESTROY: PostQuitMessage(0); WM_KEYDOWN: begin; case wparam of VK_ESCAPE: sendmessage(hwnd,WM_CLOSE,0,0); end; end; WM_PAINT: begin; zeit1 := gettime; if (zeit1 > zeit2+timebase) then begin; //showmessage(hwndmain,'JETZT'); erasedc(dcdbl,WindowWidth,Windowheight); maindraw(dcdbl,windowWidth,Windowheight); //Doublebuffer auf den Bidlschirm blitten BitBlt(dc,0,0,WindowWidth,Windowheight,dcdbl,0,0,SRCPAINT); zeit2:=zeit1; end; end; else Result := DefWindowProc(hWnd, uMsg, wParam, lParam); end; end; var wc: TWndClassEx = ( cbSize : SizeOf(TWndClassEx); Style : CS_HREDRAW or CS_VREDRAW; lpfnWndProc : @WndProc; cbClsExtra : 0; cbWndExtra : 0; lpszMenuName : nil; lpszClassName : ClassName; hIconSm : 0; ); msg: TMsg; begin wc.hInstance := hInstance; wc.hIcon := LoadIcon(0, IDI_APPLICATION); wc.hCursor := LoadCursor(0, IDC_ARROW); wc.hbrBackground := GetStockObject(BLACK_BRUSH); RegisterClassEx(wc); hwndMain := CreateWindowEx(0, ClassName, AppName,WS_POPUP or WS_VISIBLE, 0,0, WindowWidth, WindowHeight, 0, 0, hInstance, nil); { Doublebuffer erstellen } dc := GetDC(hwndmain); dcdbl := CreateCompatibleDC(dc); dbl := CreateCompatibleBitmap(dc,WindowWidth,Windowheight); SelectObject(dcdbl,dbl); setbkcolor(dcdbl,RGB(0,0,0)); settextcolor(dcdbl,rgb(255,0,0)); showcursor(false); while true do begin if peekMessage(msg, 0, 0, 0,PM_REMOVE) then begin; //Wenn überhaupt Message da ist if msg.Message = WM_QUIT then Break; TranslateMessage(msg); DispatchMessage(msg); end; end; showcursor(true); DeleteObject(dbl); DeleteDC(dcdbl); DeleteDC(dc); ExitCode := msg.wParam; end. nochmal die maindraw
Delphi-Quellcode:
procedure maindraw(var dcdbl:HDC;heigth,width:integer);
begin; l := l+1; TextOut(dcdbl,l,20,'TEST',4); end; |
Mit InvalidateRect kannst du ein neu Zeichnen erzwingen.
|
Alle Zeitangaben in WEZ +1. Es ist jetzt 14:02 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz