- Timestamp:
- Jan 11, 2017, 8:12:01 AM (8 years ago)
- Location:
- trunk
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/ScreenTools.pas
r43 r46 19 19 end; 20 20 21 TColor32 = type Cardinal; 22 TColor32Component = (ccBlue, ccGreen, ccRed, ccAlpha); 23 TPixel32 = packed record 24 case Integer of 25 0: (B, G, R, A: Byte); 26 1: (ARGB: TColor32); 27 2: (Planes: array[0..3] of Byte); 28 3: (Components: array[TColor32Component] of Byte); 29 end; 30 PPixel32 = ^TPixel32; 31 21 32 {$IFDEF WINDOWS} 22 33 function ChangeResolution(x, y, bpp, freq: integer): boolean; 23 34 {$ENDIF} 35 function GetBitmapPixelPtr(Bitmap: TBitmap; X, Y: Integer): PPixel32; 24 36 procedure RestoreResolution; 25 37 function Play(Item: string; Index: integer = -1): boolean; … … 272 284 end; 273 285 286 function GetBitmapPixelPtr(Bitmap: TBitmap; X, Y: Integer): PPixel32; 287 begin 288 Result := Pointer(Bitmap.RawImage.Data) + X * (Bitmap.RawImage.Description.BitsPerPixel shr 3) + Y * Bitmap.RawImage.Description.BytesPerLine; 289 end; 290 274 291 procedure EmptyMenu(MenuItems: TMenuItem; Keep: integer = 0); 275 292 var … … 514 531 515 532 function LoadGraphicSet(Name: string): integer; 516 type517 TLine = array [0 .. 999, 0 .. 2] of Byte;518 533 var 519 534 i, x, y, xmax, OriginalColor: integer; 520 535 FileName: string; 521 536 Source: TBitmap; 522 Data Line, MaskLine: ^TLine;537 DataPixel, MaskPixel: PPixel32; 523 538 begin 524 539 i := 0; … … 556 571 for y := 0 to Source.Height - 1 do 557 572 begin 558 DataLine := GrExt[nGrExt].Data.ScanLine[y];559 MaskLine := GrExt[nGrExt].Mask.ScanLine[y];560 573 for x := 0 to xmax - 1 do 561 574 begin 562 OriginalColor := Cardinal((@DataLine[x])^) and $FFFFFF; 575 DataPixel := GetBitmapPixelPtr(GrExt[nGrExt].Data, x, y); 576 MaskPixel := GetBitmapPixelPtr(GrExt[nGrExt].Mask, x, Y); 577 578 OriginalColor := DataPixel^.ARGB and $FFFFFF; 563 579 if (OriginalColor = $FF00FF) or (OriginalColor = $7F007F) then 564 580 begin // transparent 565 Cardinal((@MaskLine[x])^):= $FFFFFF;566 Cardinal((@DataLine[x])^) := Cardinal((@DataLine[x])^)and $FF000000581 MaskPixel^.ARGB := $FFFFFF; 582 DataPixel^.ARGB := DataPixel^.ARGB and $FF000000 567 583 end 568 584 else 569 585 begin 570 Cardinal((@MaskLine[x])^):= $000000; // non-transparent586 MaskPixel^.ARGB := $000000; // non-transparent 571 587 if Gamma <> 100 then 572 588 begin 573 Data Line[x, 0] := GammaLUT[DataLine[x, 0]];574 Data Line[x, 1] := GammaLUT[DataLine[x, 1]];575 Data Line[x, 2] := GammaLUT[DataLine[x, 2]];589 DataPixel^.B := GammaLUT[DataPixel^.B]; 590 DataPixel^.G := GammaLUT[DataPixel^.G]; 591 DataPixel^.R := GammaLUT[DataPixel^.R]; 576 592 end 577 593 end … … 621 637 // Src is template 622 638 // X channel = background amp (old Dst content), 128=original brightness 623 type624 TPixel = array [0 .. 2] of Byte;625 639 var 626 640 i, Brightness, test: integer; 627 641 PixelSrc: ^Byte; 628 PixelDst: ^TPixel;642 PixelDst: PPixel32; 629 643 begin 630 644 {TODO assert(Src.PixelFormat = pf8bit);} … … 654 668 while yDst < h do 655 669 begin 656 PixelDst := dst.ScanLine[yDst] + 3 * xDst;670 PixelDst := GetBitmapPixelPtr(dst, xDst, yDst); 657 671 PixelSrc := Src.ScanLine[ySrc] + xSrc; 658 672 for i := 0 to w - 1 do 659 673 begin 660 674 Brightness := PixelSrc^; 661 test := (PixelDst[2] * Brightness) shr 7; 675 test := (PixelDst^.R * Brightness) shr 7; 676 if test >= 256 then PixelDst^.R := 255 677 else PixelDst^.R := test; // Red 678 test := (PixelDst^.G * Brightness) shr 7; 679 if test >= 256 then PixelDst^.G := 255 680 else PixelDst^.G := test; // Green 681 test := (PixelDst^.B * Brightness) shr 7; 662 682 if test >= 256 then 663 PixelDst [2]:= 255683 PixelDst^.R := 255 664 684 else 665 PixelDst[2] := test; // Red 666 test := (PixelDst[1] * Brightness) shr 7; 667 if test >= 256 then 668 PixelDst[1] := 255 669 else 670 PixelDst[1] := test; // Green 671 test := (PixelDst[0] * Brightness) shr 7; 672 if test >= 256 then 673 PixelDst[2] := 255 674 else 675 PixelDst[0] := test; // Blue 676 PixelDst := Pointer(PixelDst) + 3; 685 PixelDst^.B := test; // Blue 686 PixelDst := Pointer(PixelDst) + (Dst.RawImage.Description.BitsPerPixel shr 3); 677 687 PixelSrc := Pointer(PixelSrc) + 1; 678 688 end; … … 690 700 // G channel = Color1 amp, 128=original brightness 691 701 // R channel = Color2 amp, 128=original brightness 692 type693 TLine = array [0 .. 9999, 0 .. 2] of Byte;694 702 var 695 703 ix, iy, amp1, amp2, trans, Value: integer; 696 Src Line, DstLine: ^TLine;704 SrcPixel, DstPixel: PPixel32; 697 705 begin 698 706 if xDst < 0 then begin … … 717 725 for iy := 0 to h - 1 do 718 726 begin 719 SrcLine := Src.ScanLine[ySrc + iy];720 DstLine := dst.ScanLine[yDst + iy];721 727 for ix := 0 to w - 1 do 722 728 begin 723 trans := SrcLine[xSrc + ix, 0] * 2; // green channel = transparency 724 amp1 := SrcLine[xSrc + ix, 1] * 2; 725 amp2 := SrcLine[xSrc + ix, 2] * 2; 729 SrcPixel := GetBitmapPixelPtr(Src, xSrc + ix, ySrc + iy); 730 DstPixel := GetBitmapPixelPtr(Dst, xDst + ix, yDst + iy); 731 trans := SrcPixel^.B * 2; // green channel = transparency 732 amp1 := SrcPixel^.G * 2; 733 amp2 := SrcPixel^.R * 2; 726 734 if trans <> $FF then 727 735 begin 728 Value := (Dst Line[xDst + ix][0]* trans + ((Color2 shr 16) and $FF) * amp2736 Value := (DstPixel^.B * trans + ((Color2 shr 16) and $FF) * amp2 729 737 + ((Color1 shr 16) and $FF) * amp1) div $FF; 730 if Value < 256 then 731 DstLine[xDst + ix][0] := Value 732 else 733 DstLine[xDst + ix][0] := 255; 734 Value := (DstLine[xDst + ix][1] * trans + ((Color2 shr 8) and $FF) * amp2 738 if Value < 256 then DstPixel^.B := Value 739 else DstPixel^.B := 255; 740 Value := (DstPixel^.G * trans + ((Color2 shr 8) and $FF) * amp2 735 741 + ((Color1 shr 8) and $FF) * amp1) div $FF; 736 if Value < 256 then 737 DstLine[xDst + ix][1] := Value 738 else 739 DstLine[xDst + ix][1] := 255; 740 Value := (DstLine[xDst + ix][2] * trans + (Color2 and $FF) * amp2 + 742 if Value < 256 then DstPixel^.G := Value 743 else DstPixel^.G := 255; 744 Value := (DstPixel^.R * trans + (Color2 and $FF) * amp2 + 741 745 (Color1 and $FF) * amp1) div $FF; 742 if Value < 256 then 743 DstLine[xDst + ix][2] := Value 744 else 745 DstLine[xDst + ix][2] := 255; 746 end 747 end 746 if Value < 256 then DstPixel^.R := Value 747 else DstPixel^.R := 255; 748 end; 749 end; 748 750 end; 749 751 Src.EndUpdate; … … 757 759 // G channel = Color1 amp, 128=original brightness 758 760 // R channel = Color2 amp, 128=original brightness 759 type760 TPixel = array [0 .. 2] of Byte;761 761 var 762 762 i, Red, Green: integer; 763 Pixel: ^TPixel;763 Pixel: PPixel32; 764 764 begin 765 765 bmp.BeginUpdate; … … 768 768 while y < h do 769 769 begin 770 Pixel := pointer(bmp.ScanLine[y]) + 3 * x;770 Pixel := GetBitmapPixelPtr(Bmp, x, y); 771 771 for i := 0 to w - 1 do 772 772 begin 773 Red := ((Pixel [0] * (Color0 and $0000FF) + Pixel[1]* (Color1 and $0000FF)774 + Pixel [2]* (Color2 and $0000FF)) shr 8) and $ff;775 Green := ((Pixel [0] * (Color0 shr 8 and $0000FF) + Pixel[1]*776 ((Color1 shr 8) and $0000FF) + Pixel [2]* ((Color2 shr 8) and773 Red := ((Pixel^.B * (Color0 and $0000FF) + Pixel^.G * (Color1 and $0000FF) 774 + Pixel^.R * (Color2 and $0000FF)) shr 8) and $ff; 775 Green := ((Pixel^.B * ((Color0 shr 8) and $0000FF) + Pixel^.G * 776 ((Color1 shr 8) and $0000FF) + Pixel^.R * ((Color2 shr 8) and 777 777 $0000FF)) shr 8) and $ff; 778 Pixel [0] := ((Pixel[0] * (Color0 shr 16 and $0000FF) + Pixel[1]*779 ((Color1 shr 16) and $0000FF) + Pixel [2]* ((Color2 shr 16) and $0000FF))778 Pixel^.B := ((Pixel^.B * ((Color0 shr 16) and $0000FF) + Pixel^.G * 779 ((Color1 shr 16) and $0000FF) + Pixel^.R * ((Color2 shr 16) and $0000FF)) 780 780 shr 8) and $ff; // Blue 781 Pixel [1]:= Green;782 Pixel [2]:= Red;783 Pixel := pointer(Pixel) + 3;781 Pixel^.G := Green; 782 Pixel^.R := Red; 783 Pixel := pointer(Pixel) + (Bmp.RawImage.Description.BitsPerPixel shr 3); 784 784 end; 785 785 inc(y); -
trunk/Start.pas
r41 r46 5 5 6 6 uses 7 GameServer, Messg, ButtonBase, ButtonA, ButtonC, ButtonB, Area, 8 9 LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, 7 GameServer, Messg, ButtonBase, ButtonA, ButtonC, ButtonB, Area, Math, 8 LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, 10 9 Menus, Registry; 11 10 … … 451 450 BiColorTextOut(Canvas, Colors.Canvas.Pixels[clkAge0 - 1, cliDimmedText], 452 451 $000000, xAction, y + 21, Phrases2.Lookup(TextItem)); 453 BitBlt (LogoBuffer.Canvas.Handle, 0, 0, 50, 50, Canvas.Handle,452 BitBltCanvas(LogoBuffer.Canvas, 0, 0, 50, 50, Canvas, 454 453 xActionIcon - 2, y - 2, SRCCOPY); 455 454 GlowFrame(LogoBuffer, 8, 8, 34, 34, $202020); … … 566 565 h := ClientHeight - ActionBottomBorder - 567 566 (yAction + SelectedAction * ActionPitch - 8); 568 BitBlt (LogoBuffer.Canvas.Handle, 0, 0, w, h, Canvas.Handle,567 BitBltCanvas(LogoBuffer.Canvas, 0, 0, w, h, Canvas, 569 568 ActionSideBorder + i * wBuffer, yAction + SelectedAction * ActionPitch 570 569 - 8, SRCCOPY); … … 822 821 823 822 procedure TStartDlg.FormShow(Sender: TObject); 824 type 825 TLine = array [0 .. 99999999] of Byte; 826 var 827 i, x, y: integer; 828 PictureLine: ^TLine; 823 var 824 x, y: integer; 825 PicturePixel: PPixel32; 829 826 begin 830 827 SetMainTextureByAge(-1); … … 836 833 for y := 0 to 63 do 837 834 begin // darken texture for empty slot 838 PictureLine := EmptyPicture.ScanLine[y]; 839 for x := 0 to 64 * 3 - 1 do 840 begin 841 i := integer(PictureLine[x]) - 28; 842 if i < 0 then 843 i := 0; 844 PictureLine[x] := i; 835 for x := 0 to 64 - 1 do 836 begin 837 PicturePixel := GetBitmapPixelPtr(EmptyPicture, x, y); 838 PicturePixel^.B := Max(PicturePixel^.B - 28, 0); 839 PicturePixel^.G := Max(PicturePixel^.G - 28, 0); 840 PicturePixel^.R := Max(PicturePixel^.R - 28, 0); 845 841 end 846 842 end; … … 1004 1000 1005 1001 procedure PaintRandomMini(Brightness: integer); 1006 type1007 TLine = array [0 .. lxmax * 2, 0 .. 2] of Byte;1008 1002 var 1009 1003 i, x, y, xm, cm: integer; 1010 Mini Line: ^TLine;1004 MiniPixel: PPixel32; 1011 1005 Map: ^TTileList; 1012 1006 begin … … 1016 1010 1017 1011 Mini.PixelFormat := pf24bit; 1018 Mini.width := MiniWidth * 2; 1019 Mini.height := MiniHeight; 1012 Mini.SetSize(MiniWidth * 2, MiniHeight); 1020 1013 Mini.BeginUpdate; 1021 for y := 0 to MiniHeight - 1 do 1022 begin 1023 MiniLine := Mini.ScanLine[y]; 1024 for x := 0 to MiniWidth - 1 do 1025 for i := 0 to 1 do 1026 begin 1014 for y := 0 to MiniHeight - 1 do begin 1015 for x := 0 to MiniWidth - 1 do begin 1016 for i := 0 to 1 do begin 1027 1017 xm := (x * 2 + i + y and 1) mod (MiniWidth * 2); 1018 MiniPixel := GetBitmapPixelPtr(Mini, xm, y); 1028 1019 cm := MiniColors 1029 1020 [Map[x * lxmax div MiniWidth + lxmax * 1030 1021 ((y * (lymax - 1) + MiniHeight div 2) div (MiniHeight - 1))] and 1031 1022 fTerrain, i]; 1032 Mini Line[xm, 0] := cm shr 16* Brightness div 3;1033 Mini Line[xm, 1] := cm shr 8 and $FF* Brightness div 3;1034 Mini Line[xm, 2] := cm and $FF* Brightness div 3;1023 MiniPixel^.B := ((cm shr 16) and $FF) * Brightness div 3; 1024 MiniPixel^.G := ((cm shr 8) and $FF) * Brightness div 3; 1025 MiniPixel^.R := ((cm shr 0) and $FF) * Brightness div 3; 1035 1026 end; 1027 end; 1036 1028 end; 1037 1029 Mini.EndUpdate;
Note:
See TracChangeset
for help on using the changeset viewer.