//Pour utiliser ce bout de code, il faut cliquer sur n'importe quelle touche (et "Echappe" pour quitter). procedure TForm1.FormCreate(Sender: TObject); begin BorderStyle := bsNone; WindowState := wsMaximized; KeyPreview := true; end; procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_ESCAPE then Application.Terminate; end; procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char); begin Canvas.TextOut(100,100,'Dim Canvas : ' + IntToStr(Form1.ClientWidth) + ' x ' + IntToStr(Form1.ClientHeight) +' (Touche Echap pour quitter)'); end;
var Scan0 : pRGBTriple; i : Integer; BMP : TBitmap; begin BMP := TBitmap.Create; try BMP.Width := Form1.Width; BMP.Height:= Form1.Height; BMP.PixelFormat := pf24bit; Scan0 :BMP.ScanLine[BMP.Height - 1];// GDI> toujours BottomUp DIB for i := 1 to (BMP.Width*BMP.Height) do begin with Scan0^ do begin rgbtBlue := 50; rgbtGreen:= 200; rgbtRed := 60; Inc(Scan0); end; end; Form1.Canvas.Draw(0,0,BMP); finally BMP.Free; end; end;
var Scan0 : pRGBQuad; i : Integer; BMP : TBitmap; begin BMP := TBitmap.Create; try BMP.Width := Form1.Width; BMP.Height:= Form1.Height; BMP.PixelFormat := pf32bit; Scan0 := BMP.ScanLine[BMP.Height - 1]; for i := 1 to (BMP.Width*BMP.Height) do begin with Scan0^ do begin rgbBlue := 150; rgbGreen := 20; rgbRed := 30; rgbReserved:= 0;//Peut servir à stocker n'importe quelle valeur utile en byte ! Inc(Scan0); end; end; Form1.Canvas.Draw(0,0,BMP); finally BMP.Free; end; end;
//ATTENTION ! La largeur du Bitmap doit être divisible par 4 ! procedure TMainFiche.FormClick(Sender: TObject); var X,Y,P: Integer; Depart: TDateTime; CurrentScan : pRGBTriple; // A CHANGE ! Scan0 : pRGBTriple; // A ETE AJOUTE ! couleur: Byte; begin Depart := Now; Scan0 := Img.ScanLine[Img.Height - 1]; // A CHANGE ! For P := 0 to 99 do Begin CurrentScan := Scan0; // A CHANGER ! For X := 1 to (Img.Width*img.Height) do // A CHANGE ! Begin Couleur := Random(256); With CurrentScan^ do Begin rgbtRed := Couleur; rgbtGreen := Couleur; rgbtBlue := Couleur; end; Inc(CurrentScan); // A CHANGE ! end; MainFiche.Canvas.Draw(0,0,Img); end; MainFiche.Canvas.TextOut(10,10,FormatFloat('0.0',1000 / (MilliSecondsBetween(Depart,Now) / 100)) + ' images par secondes'); end;
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionV_SCR_MATRIX := AllocMem(Img.Width * Img.Height * 4);
V_SCR_MATRIX := AllocMem(Img.Width * Img.Height * BytesPerPix);
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_ESCAPE then Close; // manière correcte de fermer une application end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_ESCAPE then Application.Terminate; // manière brutale les évènements ne sont pas déclanchés end;
procedure TMainFiche.FormClick(Sender: TObject); var X,Y,P: Integer; Depart: TDateTime; CurrentScan: Integer; couleur: Byte; begin Depart := Now; {Initialisation des paramètres d'affichage} Scan0 := Integer(Img.ScanLine[0]); // pointe sur la 1ère ligne du Bitmap MemLineSize := Integer(Img.ScanLine[1]) - Scan0; // MemLineSize est le plus souvent < 0 et permet ainsi de décrémenter l'adresse du pointeur de ligne-mémoire (Y) BytesPerPix := Abs( MemLineSize div Img.Width ); // BytesPerPix permet d'incrémenter l'adresse du pointeur pRGBTriple en fonction de sa position dans la ligne (X) For P := 0 to 99 do Begin For Y := 0 to 1049 do Begin CurrentScan := Scan0 + (Y * MemLineSize); // on se place en début de ligne For X := 0 to 1679 do Begin Couleur := Random(256); With PRGBTriple(CurrentScan)^do Begin rgbtRed := Couleur; rgbtGreen := Couleur; rgbtBlue := Couleur; end; Inc(CurrentScan,BytesPerPix); // on incrémente de BytesPerPix pour passer à la valeur suivante end; end; MainFiche.Canvas.Draw(0,0,Img); end; MainFiche.Caption := FormatFloat('0.0',1000 / (MilliSecondsBetween(Depart,Now) / 100)) + ' images par secondes'; end;
En général, comme tu le sais, le pf32bit donne de meilleurs résultats car le proc est fait pour calculer avec des DWords...je viens de faire l'essai ... en passant de pf24bit à pf32bit le Frame Rate est à nouveau divisé par 3 !!!!!
For I := 1 to (Img.Width * img.Height) do // A CHANGE ! Begin Y := I Div Img.Width; X := I - (Y * Img.Width); ...
with pRGBTriple(MATRIX_CurrentScan)^ do begin if (X > 600) And (X < 800) And (Y > 450) And (Y < 734) then Begin rgbtRed := 62; rgbtGreen := 145; rgbtBlue := 23; end else Begin Couleur := Random(256); rgbtRed := Couleur; rgbtGreen := Couleur; rgbtBlue := Couleur; end; end;
//---Start-CALCULS---// For X := 0 to 1679 do // la 1ère double boucle utilise le ray-casting et affiche For Y := 0 to 1049 do // les murs, les sols et les plafonds With V_SCR_MATRIX[X,Y] do Begin if (X > 600) And (X < 800) And (Y > 450) And (Y < 734) then Begin rgbtRed := 62; rgbtGreen := 145; rgbtBlue := 23; end else Begin Couleur := Random(256); rgbtRed := Couleur; rgbtGreen := Couleur; rgbtBlue := Couleur; end; end; For X := 500 to 718 do // ici peu importe l'ordre des X et des Y, on est plus dans la logique ray-casting For Y := 300 to 467 do // mais affichage de certains éléments du décor, arme, HUD, ... With V_SCR_MATRIX[X,Y] do Begin rgbtRed := (rgbtRed + 248) Div 2; rgbtGreen := 12; rgbtBlue := 31; end; //---End---CALCULS---// //---Start-AFFICHAGE---// For Y := 0 to 1049 do Begin CurrentScan := Scan0 + Y * MemLineSize; // on se place en début de ligne For X := 0 to 1679 do Begin pRGBTriple(CurrentScan)^ := V_SCR_MATRIX[X,Y]; Inc(CurrentScan, BytesPerPix); // on incrémente de BytesPerPixel pour passer à la valeur suivante end; end; MainFiche.Canvas.Draw(0,0,Img); //---End---AFFICHAGE---//