Changeset 8 for trunk/UCore.pas
- Timestamp:
- Mar 16, 2011, 10:47:36 PM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/UCore.pas
r7 r8 7 7 uses 8 8 Dialogs, Classes, SysUtils, Contnrs, Graphics, SpecializedMatrix, SpecializedList, 9 IntfGraphics, FPImage, LCLType, SpecializedBitmap ;9 IntfGraphics, FPImage, LCLType, SpecializedBitmap, GraphType; 10 10 11 11 const … … 96 96 FRedrawPending: Boolean; 97 97 FBitmapLower: TBitmapTColor; 98 IntfImage: TLazIntfImage; 98 99 function GetPlayerCount: Integer; 99 100 procedure SetBitmap(const AValue: TBitmap); … … 229 230 var 230 231 X, Y: Integer; 232 PixelPtr: PInteger; 233 PixelRowPtr: PInteger; 234 RawImage: TRawImage; 235 BytePerPixel: Integer; 236 P: Integer; 231 237 begin 232 238 try 233 Bitmap.BeginUpdate(True); 234 for Y := 0 to Bitmap.Height - 1 do 235 for X := 0 to Bitmap.Width - 1 do 236 Bitmap.Canvas.Pixels[X, Y] := SurfaceMatterColors[TSurfaceMatter( 237 Surface.ItemsXY[Trunc(X / Bitmap.Width * Surface.Count.X), 238 Trunc(Y / Bitmap.Height * Surface.Count.Y)])]; 239 Bitmap.BeginUpdate; 240 RawImage := Bitmap.RawImage; 241 PixelRowPtr := PInteger(RawImage.Data); 242 BytePerPixel := RawImage.Description.BitsPerPixel div 8; 243 for Y := 0 to Bitmap.Height - 1 do begin 244 PixelPtr := PixelRowPtr; 245 for X := 0 to Bitmap.Width - 1 do begin 246 P := SurfaceMatterColors[TSurfaceMatter( 247 Surface.ItemsXY[Trunc(X / Bitmap.Width * Surface.Count.X), 248 Trunc(Y / Bitmap.Height * Surface.Count.Y)])]; 249 PixelPtr^ := ((P and $ff) shl 16) or (P and $00ff00) or ((P shr 16) and $ff); 250 Inc(PByte(PixelPtr), BytePerPixel); 251 end; 252 Inc(PByte(PixelRowPtr), RawImage.Description.BytesPerLine); 253 end; 239 254 finally 240 255 Bitmap.EndUpdate; … … 591 606 begin 592 607 FBitmapLower := TBitmapTColor.Create; 608 IntfImage := TLazIntfImage.Create(1, 1); 593 609 Players := TObjectList.Create; 594 610 World := TWorld.Create; … … 600 616 begin 601 617 FBitmapLower.Free; 618 IntfImage.Free; 602 619 Players.Free; 603 620 World.Free; … … 616 633 procedure TEngine.Draw; 617 634 var 618 IntfImage: TLazIntfImage;619 635 I: Integer; 620 636 X, Y: Integer; 621 637 H, W: Integer; 622 638 Ratio: Single; 639 PixelPtr: PInteger; 640 PixelRowPtr: PInteger; 641 RawImage: TRawImage; 642 BytePerPixel: Integer; 643 P: Integer; 623 644 begin 624 645 if FRedrawPending then begin … … 627 648 TPlayer(Players[I]).Paint; 628 649 end; 629 if Assigned(FBitmap) then begin 630 //FBitmap.Canvas.StretchDraw(Rect(0, 0, FBitmap.Width, FBitmap.Height), FBitmapLower); 631 try 632 IntfImage := FBitmap.CreateIntfImage; 633 if (FBitmap.Width / FBitmapLower.Width) < (FBitmap.Height / FBitmapLower.Height) then 634 Ratio := FBitmap.Width / FBitmapLower.Width 635 else Ratio := FBitmap.Height / FBitmapLower.Height; 636 for Y := 0 to Trunc(FBitmapLower.Height * Ratio) - 1 do 637 for X := 0 to Trunc(FBitmapLower.Width * Ratio) - 1 do 638 IntfImage.Colors[X, Y] := TColorToFPColor(FBitmapLower.Pixels[Trunc(X / Ratio), Trunc(Y / Ratio)]); 639 FBitmap.LoadFromIntfImage(IntfImage); 640 finally 641 IntfImage.Free; 650 if Assigned(FBitmap) then try 651 Bitmap.BeginUpdate(False); 652 RawImage := Bitmap.RawImage; 653 PixelRowPtr := PInteger(RawImage.Data); 654 BytePerPixel := RawImage.Description.BitsPerPixel div 8; 655 if (IntfImage.Width <> FBitmap.Width) or (IntfImage.Height <> FBitmap.Height) then 656 IntfImage.SetSize(FBitmap.Width, FBitmap.Height); 657 if (FBitmap.Width / FBitmapLower.Width) < (FBitmap.Height / FBitmapLower.Height) then 658 Ratio := FBitmap.Width / FBitmapLower.Width 659 else Ratio := FBitmap.Height / FBitmapLower.Height; 660 for Y := 0 to Trunc(FBitmapLower.Height * Ratio) - 1 do begin 661 PixelPtr := PixelRowPtr; 662 for X := 0 to Trunc(FBitmapLower.Width * Ratio) - 1 do begin 663 P := FBitmapLower.Pixels[Trunc(X / Ratio), Trunc(Y / Ratio)]; 664 PixelPtr^ := ((P and $ff) shl 16) or (P and $00ff00) or ((P shr 16) and $ff); 665 Inc(PByte(PixelPtr), BytePerPixel); 666 end; 667 Inc(PByte(PixelRowPtr), RawImage.Description.BytesPerLine); 642 668 end; 669 finally 670 FBitmap.EndUpdate(False); 643 671 end; 644 672 FRedrawPending := False;
Note:
See TracChangeset
for help on using the changeset viewer.