Changeset 10
- Timestamp:
- Mar 19, 2011, 4:30:27 PM (14 years ago)
- Location:
- trunk
- Files:
-
- 1 added
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/UCore.pas
r8 r10 7 7 uses 8 8 Dialogs, Classes, SysUtils, Contnrs, Graphics, SpecializedMatrix, SpecializedList, 9 IntfGraphics, FPImage, LCLType, SpecializedBitmap, GraphType ;9 IntfGraphics, FPImage, LCLType, SpecializedBitmap, GraphType, Math; 10 10 11 11 const … … 115 115 end; 116 116 117 TFastBitmapPixelComponents = packed record 118 B, G, R, A: Byte; 119 end; 120 117 121 const 118 122 SurfaceMatterColors: array[TSurfaceMatter] of TColor = (clBlack, $0756b0, … … 127 131 Engine: TEngine; 128 132 133 function SwapBRComponent(Value: Integer): Integer; inline; 134 129 135 implementation 136 137 function SwapBRComponent(Value: Integer): Integer; 138 begin 139 // Result := (Value and $00ff00) or ((Value shr 16) and $ff) or ((Value and $ff) shl 16); 140 Result := Value; 141 TFastBitmapPixelComponents(Result).R := TFastBitmapPixelComponents(Value).B; 142 TFastBitmapPixelComponents(Result).B := TFastBitmapPixelComponents(Value).R; 143 end; 130 144 131 145 { TTank } … … 635 649 I: Integer; 636 650 X, Y: Integer; 637 H, W: Integer; 638 Ratio: Single; 651 PixelX, PixelY: Integer; 652 SubPixelPtr: PInteger; 653 SubPixelRowPtr: PInteger; 654 SubPixelSizeX: Integer; 655 SubPixelSizeY: Integer; 639 656 PixelPtr: PInteger; 640 657 PixelRowPtr: PInteger; 658 BytePerPixel: Integer; 659 BytePerRow: Integer; 641 660 RawImage: TRawImage; 642 BytePerPixel: Integer; 643 P: Integer; 644 begin 645 if FRedrawPending then begin 646 FBitmapLower.FillAll(0); 661 Color: Integer; 662 Shift: TPoint; 663 XDiv, XMod, XAcc: Integer; 664 YDiv, YMod, YAcc: Integer; 665 Ratio: Real; 666 TargetHeight: Integer; 667 TargetWidth: Integer; 668 begin 669 if FRedrawPending then 670 begin 671 FRedrawPending := False; 672 //FBitmapLower.FillAll(0); 647 673 for I := 0 to Players.Count - 1 do begin 648 674 TPlayer(Players[I]).Paint; 649 675 end; 650 if Assigned(FBitmap) then try 651 Bitmap.BeginUpdate(False); 676 if Assigned(FBitmap) then 677 try 678 Bitmap.BeginUpdate; 652 679 RawImage := Bitmap.RawImage; 653 PixelRowPtr := PInteger(RawImage.Data);654 680 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); 681 BytePerRow := RawImage.Description.BytesPerLine; 682 FillChar(RawImage.Data^, Bitmap.Height * BytePerRow, 0); 683 657 684 if (FBitmap.Width / FBitmapLower.Width) < (FBitmap.Height / FBitmapLower.Height) then 658 685 Ratio := FBitmap.Width / FBitmapLower.Width 659 686 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); 687 688 // Preserve aspect ratio 689 TargetWidth := Trunc(FBitmapLower.Width * Ratio); 690 TargetHeight := Trunc(FBitmapLower.Height * Ratio); 691 692 Shift.X := Trunc((Bitmap.Width - TargetWidth) / 2); 693 Shift.Y := Trunc((Bitmap.Height - TargetHeight) / 2); 694 695 XDiv := TargetWidth div FBitmapLower.Width; 696 XMod := TargetWidth mod FBitmapLower.Width; 697 YDiv := TargetHeight div FBitmapLower.Height; 698 YMod := TargetHeight mod FBitmapLower.Height; 699 700 PixelRowPtr := PInteger(RawImage.Data + BytePerRow * Shift.Y); 701 YAcc := FBitmapLower.Height div 2; 702 for Y := 0 to FBitmapLower.Height - 1 do begin 703 SubPixelSizeY := YDiv; 704 Inc(YAcc, YMod); 705 if YAcc >= FBitmapLower.Height then begin 706 Dec(YAcc, FBitmapLower.Height); 707 Inc(SubPixelSizeY); 666 708 end; 667 Inc(PByte(PixelRowPtr), RawImage.Description.BytesPerLine); 709 710 PixelPtr := PixelRowPtr + Shift.X; 711 XAcc := FBitmapLower.Width div 2; 712 for X := 0 to FBitmapLower.Width - 1 do begin 713 SubPixelSizeX := XDiv; 714 Inc(XAcc, XMod); 715 if XAcc >= FBitmapLower.Width then begin 716 Dec(XAcc, FBitmapLower.Width); 717 Inc(SubPixelSizeX); 718 end; 719 720 Color := SwapBRComponent(FBitmapLower.Pixels[X, Y]); 721 722 // Draw large pixel 723 SubPixelRowPtr := PixelPtr; 724 for PixelY := 0 to SubPixelSizeY - 1 do begin 725 SubPixelPtr := SubPixelRowPtr; 726 for PixelX := 0 to SubPixelSizeX - 1 do begin 727 SubPixelPtr^ := Color; 728 Inc(PByte(SubPixelPtr), BytePerPixel); 729 end; 730 Inc(PByte(SubPixelRowPtr), BytePerRow); 731 end; 732 Inc(PByte(PixelPtr), BytePerPixel * SubPixelSizeX); 733 end; 734 Inc(PByte(PixelRowPtr), BytePerRow * SubPixelSizeY); 668 735 end; 669 736 finally 670 FBitmap.EndUpdate(False); 671 end; 672 FRedrawPending := False; 737 FBitmap.EndUpdate; 738 end; 673 739 end; 674 740 end; -
trunk/UMainForm.lfm
r9 r10 5 5 Width = 514 6 6 Caption = 'Tunneler' 7 ClientHeight = 3 937 ClientHeight = 389 8 8 ClientWidth = 514 9 9 Menu = MainMenu1 … … 13 13 OnShow = FormShow 14 14 LCLVersion = '0.9.31' 15 WindowState = wsMaximized 15 16 object StatusBar1: TStatusBar 16 17 Left = 0 17 Height = 2018 Top = 37 318 Height = 17 19 Top = 372 19 20 Width = 514 20 21 Panels = < 22 item 23 Width = 50 24 end 21 25 item 22 26 Width = 50 … … 29 33 object Image1: TImage 30 34 Left = 0 31 Height = 37 335 Height = 372 32 36 Top = 0 33 37 Width = 514 -
trunk/UMainForm.pas
r9 r10 7 7 uses 8 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, 9 ComCtrls, Menus, ActnList, UCore ;9 ComCtrls, Menus, ActnList, UCore, UPlatform, Math, DateUtils; 10 10 11 11 type … … 45 45 OriginalWindowState: TWindowState; 46 46 ScreenBounds: TRect; 47 StartTime: TDateTime; 48 DrawDuration: TDateTime; 49 Drawing: Boolean; 47 50 public 48 51 { public declarations } … … 63 66 procedure TMainForm.TimerDrawTimer(Sender: TObject); 64 67 begin 68 if not Drawing then 65 69 try 66 TimerDraw.Enabled := False; 70 Drawing := True; 71 StartTime := NowPrecise; 67 72 Engine.Draw; 73 DrawDuration := NowPrecise - StartTime; 68 74 StatusBar1.Panels[1].Text := IntToStr(TPlayer(Engine.Players[0]).Position.X) + ', ' + 69 75 IntToStr(TPlayer(Engine.Players[0]).Position.Y) + ' ' + 70 76 IntToStr(TPlayer(Engine.Players[0]).Direction); 77 StatusBar1.Panels[2].Text := FloatToStr(RoundTo(DrawDuration / OneMillisecond, -2)); 71 78 finally 72 TimerDraw.Enabled := True;79 Drawing := False; 73 80 end; 74 81 end; -
trunk/tunneler.lpi
r9 r10 42 42 </Item3> 43 43 </RequiredPackages> 44 <Units Count=" 41">44 <Units Count="50"> 45 45 <Unit0> 46 46 <Filename Value="tunneler.lpr"/> … … 49 49 <WindowIndex Value="0"/> 50 50 <TopLine Value="1"/> 51 <CursorPos X=" 14" Y="8"/>52 <UsageCount Value=" 60"/>51 <CursorPos X="62" Y="19"/> 52 <UsageCount Value="72"/> 53 53 </Unit0> 54 54 <Unit1> … … 58 58 <ResourceBaseClass Value="Form"/> 59 59 <UnitName Value="UMainForm"/> 60 <IsVisibleTab Value="True"/> 61 <EditorIndex Value="2"/> 62 <WindowIndex Value="0"/> 63 <TopLine Value="75"/> 64 <CursorPos X="18" Y="84"/> 65 <UsageCount Value="60"/> 60 <EditorIndex Value="4"/> 61 <WindowIndex Value="0"/> 62 <TopLine Value="83"/> 63 <CursorPos X="12" Y="85"/> 64 <UsageCount Value="72"/> 66 65 <Loaded Value="True"/> 67 66 <LoadedDesigner Value="True"/> … … 71 70 <IsPartOfProject Value="True"/> 72 71 <UnitName Value="UCore"/> 72 <IsVisibleTab Value="True"/> 73 73 <EditorIndex Value="0"/> 74 74 <WindowIndex Value="0"/> 75 <TopLine Value=" 229"/>76 <CursorPos X=" 56" Y="242"/>77 <UsageCount Value=" 60"/>75 <TopLine Value="663"/> 76 <CursorPos X="3" Y="669"/> 77 <UsageCount Value="72"/> 78 78 <Loaded Value="True"/> 79 79 </Unit2> … … 142 142 <Filename Value="../../PascalClassLibrary/Generics/TemplateGenerics/Generic/GenericMatrix.inc"/> 143 143 <WindowIndex Value="0"/> 144 <TopLine Value=" 52"/>145 <CursorPos X="1 5" Y="29"/>146 <UsageCount Value=" 25"/>144 <TopLine Value="141"/> 145 <CursorPos X="1" Y="158"/> 146 <UsageCount Value="31"/> 147 147 </Unit11> 148 148 <Unit12> … … 261 261 <ResourceBaseClass Value="Form"/> 262 262 <UnitName Value="UMapForm"/> 263 <EditorIndex Value=" 1"/>264 <WindowIndex Value="0"/> 265 <TopLine Value="1 5"/>263 <EditorIndex Value="3"/> 264 <WindowIndex Value="0"/> 265 <TopLine Value="14"/> 266 266 <CursorPos X="20" Y="39"/> 267 <UsageCount Value=" 39"/>267 <UsageCount Value="51"/> 268 268 <Loaded Value="True"/> 269 269 </Unit27> … … 286 286 <WindowIndex Value="0"/> 287 287 <TopLine Value="63"/> 288 <CursorPos X=" 65" Y="81"/>289 <UsageCount Value=" 8"/>288 <CursorPos X="14" Y="80"/> 289 <UsageCount Value="14"/> 290 290 </Unit30> 291 291 <Unit31> … … 299 299 <Filename Value="../../../lazarus/lcl/intfgraphics.pas"/> 300 300 <UnitName Value="IntfGraphics"/> 301 <WindowIndex Value="0"/> 302 <TopLine Value="3371"/> 303 <CursorPos X="24" Y="3388"/> 304 <UsageCount Value="10"/> 301 <EditorIndex Value="2"/> 302 <WindowIndex Value="0"/> 303 <TopLine Value="3131"/> 304 <CursorPos X="42" Y="3148"/> 305 <UsageCount Value="10"/> 306 <Loaded Value="True"/> 305 307 </Unit32> 306 308 <Unit33> … … 323 325 <UnitName Value="GraphType"/> 324 326 <WindowIndex Value="0"/> 325 <TopLine Value="1 91"/>326 <CursorPos X=" 3" Y="188"/>327 <TopLine Value="173"/> 328 <CursorPos X="5" Y="190"/> 327 329 <UsageCount Value="10"/> 328 330 </Unit35> … … 330 332 <Filename Value="../../PascalClassLibrary/Generics/TemplateGenerics/Generic/GenericBitmap.inc"/> 331 333 <WindowIndex Value="0"/> 332 <TopLine Value=" 9"/>333 <CursorPos X=" 32" Y="26"/>334 <UsageCount Value="1 2"/>334 <TopLine Value="8"/> 335 <CursorPos X="9" Y="22"/> 336 <UsageCount Value="16"/> 335 337 </Unit36> 336 338 <Unit37> … … 364 366 <UsageCount Value="10"/> 365 367 </Unit40> 368 <Unit41> 369 <Filename Value="../../PascalClassLibrary/Docking/CoolDocking/UCDLayout.pas"/> 370 <UnitName Value="UCDLayout"/> 371 <WindowIndex Value="0"/> 372 <TopLine Value="1"/> 373 <CursorPos X="9" Y="69"/> 374 <UsageCount Value="10"/> 375 </Unit41> 376 <Unit42> 377 <Filename Value="../../PascalClassLibrary/Docking/CoolDocking/CoolDocking.pas"/> 378 <UnitName Value="CoolDocking"/> 379 <WindowIndex Value="0"/> 380 <TopLine Value="1"/> 381 <CursorPos X="1" Y="1"/> 382 <UsageCount Value="10"/> 383 </Unit42> 384 <Unit43> 385 <Filename Value="../../PascalClassLibrary/Docking/CoolDocking/Common/URectangle.pas"/> 386 <UnitName Value="URectangle"/> 387 <WindowIndex Value="0"/> 388 <TopLine Value="1"/> 389 <CursorPos X="14" Y="20"/> 390 <UsageCount Value="10"/> 391 </Unit43> 392 <Unit44> 393 <Filename Value="UPlatform.pas"/> 394 <IsPartOfProject Value="True"/> 395 <UnitName Value="UPlatform"/> 396 <UsageCount Value="31"/> 397 </Unit44> 398 <Unit45> 399 <Filename Value="/usr/share/fpcsrc/2.4.0/rtl/objpas/math.pp"/> 400 <UnitName Value="math"/> 401 <WindowIndex Value="0"/> 402 <TopLine Value="929"/> 403 <CursorPos X="5" Y="932"/> 404 <UsageCount Value="14"/> 405 </Unit45> 406 <Unit46> 407 <Filename Value="../../PascalClassLibrary/Generics/NativeGenerics/Units/GenericRange.pas"/> 408 <UnitName Value="GenericRange"/> 409 <WindowIndex Value="0"/> 410 <TopLine Value="1"/> 411 <CursorPos X="50" Y="5"/> 412 <UsageCount Value="13"/> 413 </Unit46> 414 <Unit47> 415 <Filename Value="../../PascalClassLibrary/Generics/NativeGenerics/NativeGenerics.pas"/> 416 <UnitName Value="NativeGenerics"/> 417 <WindowIndex Value="0"/> 418 <TopLine Value="1"/> 419 <CursorPos X="36" Y="15"/> 420 <UsageCount Value="10"/> 421 </Unit47> 422 <Unit48> 423 <Filename Value="../../../lazarus/lcl/include/custombitmap.inc"/> 424 <EditorIndex Value="1"/> 425 <WindowIndex Value="0"/> 426 <TopLine Value="330"/> 427 <CursorPos X="35" Y="338"/> 428 <UsageCount Value="11"/> 429 <Loaded Value="True"/> 430 </Unit48> 431 <Unit49> 432 <Filename Value="/usr/share/fpcsrc/2.4.0/rtl/objpas/types.pp"/> 433 <UnitName Value="types"/> 434 <WindowIndex Value="0"/> 435 <TopLine Value="58"/> 436 <CursorPos X="5" Y="75"/> 437 <UsageCount Value="10"/> 438 </Unit49> 366 439 </Units> 367 <JumpHistory Count=" 29" HistoryIndex="28">440 <JumpHistory Count="30" HistoryIndex="28"> 368 441 <Position1> 369 <Filename Value="U MainForm.pas"/>370 <Caret Line=" 67" Column="6" TopLine="48"/>442 <Filename Value="UCore.pas"/> 443 <Caret Line="705" Column="1" TopLine="686"/> 371 444 </Position1> 372 445 <Position2> 373 446 <Filename Value="UCore.pas"/> 374 <Caret Line=" 126" Column="14" TopLine="109"/>447 <Caret Line="708" Column="1" TopLine="686"/> 375 448 </Position2> 376 449 <Position3> 377 450 <Filename Value="UCore.pas"/> 378 <Caret Line=" 99" Column="24" TopLine="82"/>451 <Caret Line="709" Column="1" TopLine="686"/> 379 452 </Position3> 380 453 <Position4> 381 454 <Filename Value="UCore.pas"/> 382 <Caret Line=" 530" Column="28" TopLine="530"/>455 <Caret Line="710" Column="1" TopLine="686"/> 383 456 </Position4> 384 457 <Position5> 385 458 <Filename Value="UCore.pas"/> 386 <Caret Line=" 99" Column="39" TopLine="95"/>459 <Caret Line="711" Column="1" TopLine="696"/> 387 460 </Position5> 388 461 <Position6> 389 462 <Filename Value="UCore.pas"/> 390 <Caret Line=" 530" Column="50" TopLine="530"/>463 <Caret Line="712" Column="1" TopLine="696"/> 391 464 </Position6> 392 465 <Position7> 393 466 <Filename Value="UCore.pas"/> 394 <Caret Line=" 629" Column="24" TopLine="612"/>467 <Caret Line="713" Column="1" TopLine="696"/> 395 468 </Position7> 396 469 <Position8> 397 470 <Filename Value="UCore.pas"/> 398 <Caret Line=" 98" Column="6" TopLine="93"/>471 <Caret Line="718" Column="1" TopLine="696"/> 399 472 </Position8> 400 473 <Position9> 401 474 <Filename Value="UCore.pas"/> 402 <Caret Line=" 105" Column="15" TopLine="94"/>475 <Caret Line="721" Column="1" TopLine="706"/> 403 476 </Position9> 404 477 <Position10> 405 478 <Filename Value="UCore.pas"/> 406 <Caret Line=" 632" Column="59" TopLine="615"/>479 <Caret Line="722" Column="1" TopLine="706"/> 407 480 </Position10> 408 481 <Position11> 409 482 <Filename Value="UCore.pas"/> 410 <Caret Line=" 634" Column="32" TopLine="616"/>483 <Caret Line="723" Column="1" TopLine="706"/> 411 484 </Position11> 412 485 <Position12> 413 486 <Filename Value="UCore.pas"/> 414 <Caret Line=" 637" Column="14" TopLine="620"/>487 <Caret Line="724" Column="1" TopLine="706"/> 415 488 </Position12> 416 489 <Position13> 417 490 <Filename Value="UCore.pas"/> 418 <Caret Line=" 638" Column="38" TopLine="621"/>491 <Caret Line="725" Column="1" TopLine="706"/> 419 492 </Position13> 420 493 <Position14> 421 <Filename Value="U MainForm.pas"/>422 <Caret Line=" 174" Column="1" TopLine="153"/>494 <Filename Value="UCore.pas"/> 495 <Caret Line="726" Column="1" TopLine="706"/> 423 496 </Position14> 424 497 <Position15> 425 <Filename Value="U MainForm.pas"/>426 <Caret Line=" 175" Column="1" TopLine="154"/>498 <Filename Value="UCore.pas"/> 499 <Caret Line="725" Column="1" TopLine="706"/> 427 500 </Position15> 428 501 <Position16> 429 502 <Filename Value="UCore.pas"/> 430 <Caret Line=" 639" Column="38" TopLine="616"/>503 <Caret Line="726" Column="1" TopLine="706"/> 431 504 </Position16> 432 505 <Position17> 433 506 <Filename Value="UCore.pas"/> 434 <Caret Line=" 634" Column="1" TopLine="622"/>507 <Caret Line="725" Column="1" TopLine="706"/> 435 508 </Position17> 436 509 <Position18> 437 510 <Filename Value="UCore.pas"/> 438 <Caret Line=" 636" Column="1" TopLine="622"/>511 <Caret Line="726" Column="1" TopLine="706"/> 439 512 </Position18> 440 513 <Position19> 441 514 <Filename Value="UCore.pas"/> 442 <Caret Line=" 637" Column="1" TopLine="622"/>515 <Caret Line="724" Column="41" TopLine="706"/> 443 516 </Position19> 444 517 <Position20> 445 518 <Filename Value="UCore.pas"/> 446 <Caret Line="6 38" Column="1" TopLine="622"/>519 <Caret Line="682" Column="12" TopLine="667"/> 447 520 </Position20> 448 521 <Position21> 449 522 <Filename Value="UCore.pas"/> 450 <Caret Line=" 632" Column="83" TopLine="622"/>523 <Caret Line="709" Column="1" TopLine="681"/> 451 524 </Position21> 452 525 <Position22> 453 526 <Filename Value="UCore.pas"/> 454 <Caret Line=" 594" Column="41" TopLine="577"/>527 <Caret Line="692" Column="4" TopLine="681"/> 455 528 </Position22> 456 529 <Position23> 457 530 <Filename Value="UCore.pas"/> 458 <Caret Line="6 41" Column="10" TopLine="612"/>531 <Caret Line="695" Column="5" TopLine="681"/> 459 532 </Position23> 460 533 <Position24> 461 534 <Filename Value="UCore.pas"/> 462 <Caret Line="6 29" Column="1" TopLine="621"/>535 <Caret Line="693" Column="41" TopLine="681"/> 463 536 </Position24> 464 537 <Position25> 465 538 <Filename Value="UCore.pas"/> 466 <Caret Line=" 9" Column="54" TopLine="1"/>539 <Caret Line="695" Column="7" TopLine="678"/> 467 540 </Position25> 468 541 <Position26> 469 542 <Filename Value="UCore.pas"/> 470 <Caret Line=" 628" Column="15" TopLine="622"/>543 <Caret Line="710" Column="42" TopLine="688"/> 471 544 </Position26> 472 545 <Position27> 473 <Filename Value="U Core.pas"/>474 <Caret Line=" 647" Column="32" TopLine="633"/>546 <Filename Value="UMainForm.pas"/> 547 <Caret Line="85" Column="12" TopLine="83"/> 475 548 </Position27> 476 549 <Position28> 477 550 <Filename Value="UCore.pas"/> 478 <Caret Line=" 649" Column="49" TopLine="617"/>551 <Caret Line="710" Column="52" TopLine="693"/> 479 552 </Position28> 480 553 <Position29> 481 <Filename Value="U MapForm.pas"/>482 <Caret Line=" 39" Column="20" TopLine="15"/>554 <Filename Value="UCore.pas"/> 555 <Caret Line="692" Column="52" TopLine="683"/> 483 556 </Position29> 557 <Position30> 558 <Filename Value="../../../lazarus/lcl/include/custombitmap.inc"/> 559 <Caret Line="338" Column="35" TopLine="330"/> 560 </Position30> 484 561 </JumpHistory> 485 562 </ProjectOptions> -
trunk/tunneler.lpr
r4 r10 8 8 {$ENDIF}{$ENDIF} 9 9 Interfaces, // this includes the LCL widgetset 10 Forms, UMainForm, UCore, TemplateGenerics, UMapForm 10 Forms, UMainForm, UCore, TemplateGenerics, UMapForm, UPlatform 11 11 { you can add units after this }; 12 12
Note:
See TracChangeset
for help on using the changeset viewer.