⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 gamelib.pas

📁 很好玩的一个DELPHI游戏
💻 PAS
字号:
unit GameLib;

interface
uses
  Windows,SysUtils,Classes,Graphics,
  DXDraws,DIB;

procedure FadeOut(DIB1,DIB2:TDIB;Step:Byte);
procedure Zoom(DIB1,DIB2:TDIB;ZoomRatio:Real);
procedure Blur(DIB1,DIB2:TDIB);
procedure FadeIn(DIB1,DIB2:TDIB;Step:Byte);
procedure FillDIB8(DIB:TDIB;Color:Byte);
procedure MaSaiKey(DX:TDXDraw;SBitMap:TBitmap);

const
  MAXX = 276;
  MAXY = 185;
  DAMP = 4;
  rIndex = 4.0;

var
  tsin,tcos:array[0..511] of Single;
  Closing:Boolean;
  CT,NW:Byte;

  dispLut:array[0..511] of Byte;
implementation

procedure FadeOut(DIB1,DIB2:TDIB;Step:Byte);
var
  P1,P2:PByteArray;
  W,H:Integer;
begin
  P1:=DIB1.ScanLine[DIB2.Height - 1];
  P2:=DIB2.ScanLine[DIB2.Height - 1];
  W:=DIB1.WidthBytes;
  H:=DIB1.Height;
  asm
    PUSH ESI
    PUSH EDI
    MOV ESI, P1
    MOV EDI, P2
    MOV EDX, W
    MOV EAX, H
    IMUL EDX
    MOV ECX, EAX
    @@1:
    MOV AL, Step
    MOV AH, [ESI]
    CMP AL, AH
    JA @@2
    MOV AL, AH
@@2:
    MOV [EDI], AL
    INC ESI
    INC EDI
    DEC ECX
    JNZ @@1
    POP EDI
    POP ESI
  end;
end;

procedure Zoom(DIB1,DIB2:TDIB;ZoomRatio:Real);
var
  P1,P2:PByteArray;
  W,H:Integer;
  X,Y:Integer;
  xr,yr,xstep,ystep:Real;
  xstart:Real;
begin
  W:=DIB1.WidthBytes;
  H:=DIB1.Height;
  xstart:=(W - (W * ZoomRatio)) / 2;

  xr:=xstart;
  yr:=(H - (H * ZoomRatio)) / 2;
  xstep:=ZoomRatio;
  ystep:=ZoomRatio;

  for Y:=1 to DIB1.Height - 1 do
  begin
    P2:=DIB2.ScanLine[Y];
    if (yr >= 0) and (yr <= H) then
    begin
      P1:=DIB1.ScanLine[Trunc(yr)];
      for X:=1 to DIB1.Width - 1 do
      begin
        if (xr >= 0) and (xr <= W) then
        begin
          P2[X]:=P1[Trunc(xr)];
        end
        else
        begin
          P2[X]:=0;
        end;
        xr:=xr + xstep;
      end;
    end
    else
    begin
      for X:=1 to DIB1.Width - 1 do
      begin
        P2[X]:=0;
      end;
    end;
    xr:=xstart;
    yr:=yr + ystep;
  end;
  Sleep(250);
end;

procedure Blur(DIB1,DIB2:TDIB);
var
  P1,P2:PByteArray;
  W {,H}:Integer;
  X,Y:Integer;
begin
  W:=DIB1.WidthBytes;
  // H := DIB1.Height;

  for Y:=1 to DIB1.Height - 1 do
  begin
    P1:=DIB1.ScanLine[Y];
    P2:=DIB2.ScanLine[Y];
    for X:=1 to DIB1.Width - 1 do
    begin
      P2[X]:=(P1[X] + P1[X - 1] + P1[X + 1] + P1[X + W] + P1[X - W]) div 5;
    end;
  end;

end;

procedure FadeIn(DIB1,DIB2:TDIB;Step:Byte);
var
  P1,P2:PByteArray;
  W,H:Integer;
begin
  P1:=DIB1.ScanLine[DIB2.Height - 1];
  P2:=DIB2.ScanLine[DIB2.Height - 1];
  W:=DIB1.WidthBytes;
  H:=DIB1.Height;
  asm
    PUSH ESI
    PUSH EDI
    MOV ESI, P1
    MOV EDI, P2
    MOV EDX, W
    MOV EAX, H
    IMUL EDX
    MOV ECX, EAX
    @@1:
    MOV AL, Step
    MOV AH, [ESI]
    CMP AL, AH
    JB @@2
    MOV AL, AH
@@2:
    MOV [EDI], AL
    INC ESI
    INC EDI
    DEC ECX
    JNZ @@1
    POP EDI
    POP ESI
  end;
end;

procedure FillDIB8(DIB:TDIB;Color:Byte);
var
  P:PByteArray;
  W,H:Integer;
begin
  P:=DIB.ScanLine[DIB.Height - 1];
  W:=DIB.WidthBytes;
  H:=DIB.Height;
  asm
    PUSH ESI
    MOV ESI, P
    MOV EDX, W
    MOV EAX, H
    IMUL EDX
    MOV ECX, EAX
    MOV AL, Color
    @@1:
    MOV [ESI], AL
    INC ESI
    DEC ECX
    JNZ @@1
    POP ESI
  end;
end;

procedure MaSaiKey(DX:TDXDraw;SBitMap:TBitmap);
var
  c:TColor;
  r,g,b:Byte;
  sr,sg,sb:Integer;
  i,j:Integer;
  ix,iy:Integer;
  Rsize,Pocet:Integer;
begin
  //RSize=100
  //Pocet=25
  if Rsize <> 0 then
  begin
    for ix:=0 to (DX.SurfaceWidth div Rsize - 1) do
    begin
      for iy:=0 to (DX.SurfaceHeight div Rsize - 1) do
      begin
        sr:=0;sg:=0;sb:=0;

        for j:=1 to Pocet do
        begin

          c:=SBitMap.Canvas.Pixels
            [ix * (Rsize) + Random(Rsize),iy * Rsize + Random(Rsize)];

          sr:=sr + GetRValue(c);
          sg:=sg + GetGValue(c);
          sb:=sb + GetBValue(c);
        end;

        r:=sr div Pocet;
        g:=sg div Pocet;
        b:=sb div Pocet;

        DX.Surface.Canvas.Pen.Style:=psClear;
        DX.Surface.Canvas.Brush.Color:=RGB(r,g,b);
        DX.Surface.Canvas.Rectangle
          (ix * Rsize,iy * Rsize,
          (ix * Rsize + Rsize) + 1,(iy * Rsize + Rsize) + 1);
      end;
    end;

    Rsize:=Rsize - 1;
    if Rsize = 5 then Rsize:=0;

    Pocet:=(Rsize div 2) + 1;
    if Pocet = 1 then Pocet:=2;

  end
  else
  begin

    DX.Surface.Canvas.CopyRect
      (rect(0,0,200,300),SBitMap.Canvas,
      rect(0,0,200,300));
  end;

  DX.Flip;
end;

end.

 

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -