fxgrafix.pas

传奇源代码的delphi版本

    xinc2:=1;
    yinc1:=1;
    yinc2:=1;
  end;
  { Make sure x and y move in the right directions }
  if x1>x2 then
  begin
    xinc1:=-xinc1;
    xinc2:=-xinc2;
  end;
  if y1>y2 then
  begin
    yinc1:=-yinc1;
    yinc2:=-yinc2;
  end;
  x:=x1;
  y:=y1;


     { Draw the pixels }
  for i:=1 to numpixels do
  begin
    if (x>0) and (x<FWidth-1) and (y>0) and (y<FHeight-1) then
    begin
      //FPixelProc( x,y, Color );
      { This is faster than calling PutPixel }
      case FBitDepth of
        bd8: begin
               PByte(integer(FSurfaceDesc.lpSurface)+FSurfaceDesc.lpitch*Y+X)^:=Color;
             end;
        bd16: begin
               SurfPtr:=pointer(longint(FSurfaceDesc.lpSurface)+FSurfaceDesc.lpitch*y+(x shl 1));
               SurfPtr^:=SurfPtrColor;
              end;
      end;
    end;
    if d<0 then
    begin
      d:=d+dinc1;
      x:=x+xinc1;
      y:=y+yinc1;
    end
    else
    begin
      d:=d+dinc2;
      x:=x+xinc2;
      y:=y+yinc2;
    end;
  end;
end;


{ DRAW A VERTICAL LINE -- FAST }

procedure TFXGrafix.VLine(x,y1,y2: integer; Color: cardinal);
var
  y:integer;
  SurfPtr: ^word;
  SurfPtrColor: cardinal;
begin
  SurfPtrColor:=0;
  if y1<0 then y1:=0;
  if y2>=FHeight then y2:=FHeight-1;

//  for y:=y1 to y2 do  VoxSurface.PutPixel( x,y,rgb(Pal[c].peRed,Pal[c].peGreen,Pal[c].peBlue));
  // The following is 2x faster than the above line of code
//  GetRGB16(Color, r,g,b);
  Case FBitDepth of
    bd8: begin
         end;
    bd16: begin
            SurfPtrColor:=RGBToBGR(Color);
          end;
  end; // case...
  for y:=y1 to y2 do
  begin
    case FBitDepth of
      bd8: begin
             PByte(integer(FSurfaceDesc.lpSurface)+FSurfaceDesc.lpitch*Y+X)^:=Color;
           end;
      bd16: begin
              SurfPtr:=pointer(longint(FSurfaceDesc.lpSurface)+FSurfaceDesc.lpitch*y+(x shl 1));
              SurfPtr^:=SurfPtrColor;
            end;
    end; // case...
  end;
end;

{ DRAW A HORIZONTAL LINE -- FAST }
procedure TFXGrafix.HLine(y,x1,x2: integer; Color: cardinal);
var
  x:integer;
  SurfPtr: ^word;
  SurfPtrColor: cardinal;
begin
  SurfPtrColor:=0;
  if x1<0 then x1:=0;
  if x2>=FWidth then x2:=FWidth-1;

//  for y:=y1 to y2 do  VoxSurface.PutPixel( x,y,rgb(Pal[c].peRed,Pal[c].peGreen,Pal[c].peBlue));
  // The following is 2x faster than the above line of code
//  GetRGB16(Color, r,g,b);
  Case FBitDepth of
    bd8: begin
         end;
    bd16: begin
            SurfPtrColor:=RGBToBGR(Color);
          end;
  end; // case...
  for x:=x1 to x2 do
  begin
    case FBitDepth of
      bd8: begin
           end;
      bd16: begin
              SurfPtr:=pointer(longint(FSurfaceDesc.lpSurface)+FSurfaceDesc.lpitch*y+(x shl 1));
              SurfPtr^:=SurfPtrColor;
            end;
    end; // case...
  end;
end;

{ MUST BE WITHIN A LOCK/UNLOCK AS YOU WOULD USE PUTPIXEL }
procedure TFXGrafix.LinePolar(x, y: integer; angle, length: extended; Color: cardinal);
var
  xp, yp: integer;
begin
  xp:=round(sin(angle*pi/180)*length)+x;
  yp:=round(cos(angle*pi/180)*length)+y;
  Line(x, y, xp, yp, Color);
end;

{ MUST BE WITHIN A LOCK/UNLOCK AS YOU WOULD USE PUTPIXEL }
{ Thanks to Turbo for this proc }
procedure TFXGrafix.WuLine16(x1, y1, x2, y2: Integer; Color: cardinal);
var
  deltax, deltay, loop, start, finish: integer;
  dx, dy, dydx: single; // fractional parts
begin
  deltax := abs(x2 - x1); // Calculate deltax and deltay for initialisation
  deltay := abs(y2 - y1);
  if (deltax = 0) or (deltay = 0) then
  begin // straight lines
    Line(x1, y1, x2, y2, Color);
    exit;
  end;
  if deltax > deltay then // horizontal or vertical
  begin
    if y2 > y1 then // determine rise and run
      dydx := -(deltay / deltax)
    else
      dydx := deltay / deltax;
    if x2 < x1 then
    begin
      start := x2; // right to left
      finish := x1;
      dy := y2;
    end
    else
    begin
      start := x1; // left to right
      finish := x2;
      dy := y1;
      dydx := -dydx; // inverse slope
    end;
    for loop := start to finish do
    begin
      // plot main point
      PutPixelAlpha16(loop, trunc(dy), Color, trunc((1 - frac(dy)) * 255));
      // plot fractional difference
      PutPixelAlpha16(loop, trunc(dy) + 1, Color, trunc(frac(dy) * 255));
      dy := dy + dydx; // next point
    end;
  end
  else
  begin
    if x2 > x1 then // determine rise and run
      dydx := -(deltax / deltay)
    else
      dydx := deltax / deltay;
    if y2 < y1 then
    begin
      start := y2; // right to left
      finish := y1;
      dx := x2;
    end
    else
    begin
      start := y1; // left to right
      finish := y2;
      dx := x1;
      dydx := -dydx; // inverse slope
    end;
    for loop := start to finish do
    begin
      // plot main point
      PutPixelAlpha16(trunc(dx), loop, Color, trunc((1 - frac(dx)) * 255));
      // plot fractional difference
      PutPixelAlpha16(trunc(dx) + 1, loop, Color, trunc(frac(dx) * 255));
      dx := dx + dydx; // next point
    end;
  end;
end;



{ MUST BE WITHIN A LOCK/UNLOCK AS YOU WOULD USE PUTPIXEL }
// I know that the blending of the colours are wrong for the copper bar.
// 27.Mar.2000 Entity - Sort of fixed it... but the 2 halves don't blend into each other
procedure TFXGrafix.CopperBar( const y, cbHeight: integer; TopColor, BottomColor: cardinal);
var
  ColorTop, ColorBot: TRGBQuad;
  rStep, gStep, bStep: extended;
  r,g,b: extended;
  ctr: integer;
begin
  // Extract the Red, Green and Blue values
  with ColorTop do
    GetRGB16(TopColor, rgbRed, rgbGreen, rgbBlue);
  with ColorBot do
    GetRGB16(BottomColor, rgbRed, rgbGreen, rgbBlue);

  { TOP TO BOTTOM }
  { RED }
  if ColorBot.rgbRed=ColorTop.rgbRed then
    rStep:=0
  else
    rStep:=abs((ColorBot.rgbRed-ColorTop.rgbRed) / cbHeight);
  { GREEN }
  if ColorBot.rgbGreen=ColorTop.rgbGreen then
    gStep:=0
  else
    gStep:=abs((ColorBot.rgbGreen-ColorTop.rgbGreen) / cbHeight);
  { BLUE }
  if ColorBot.rgbBlue=ColorTop.rgbBlue then
    bStep:=0
  else
    bStep:=abs((ColorBot.rgbBlue-ColorTop.rgbBlue) / cbHeight);

  r:=ColorTop.rgbRed;
  g:=ColorTop.rgbGreen;
  b:=ColorTop.rgbBlue;
  if ColorBot.rgbRed<=ColorTop.rgbRed then rStep:=-rStep;
  if ColorBot.rgbGreen<=ColorTop.rgbGreen then gStep:=-gStep;
  if ColorBot.rgbBlue<=ColorTop.rgbBlue then bStep:=-bStep;


  // Draw from Top to Middle
  for ctr:=y to y+cbHeight do
    begin
    if (ctr>=0) and (ctr<FHeight-1) then
      HLine(ctr, 0, SurfaceDesc.lPitch div sizeof(word), rgb(round(r),round(g),round(b)));
      r:=r+rStep;
      g:=g+gStep;
      b:=b+bStep;
    end;
end;





{ *** PIXEL FORMAT PROCS *** }
function TFXGrafix.RGBToBGR(Color: cardinal): cardinal;
begin
  result:=(LoByte(LoWord(Color)) shr 3 shl 11) or   // Red
          (HiByte((Color)) shr 2 shl 5) or         // Green
          (LoByte(HiWord(Color)) shr 3);           // Blue

end;

procedure TFXGrafix.GetRGB16(Color: cardinal; var R, G, B: Byte);
begin
  R:=Color;
  G:=Color shr 8;
  B:=Color shr 16;
end;





{ *********************************************************************** }
{ *********************************************************************** }
{ *********************************************************************** }

{ ******* TFXBmpFont procs ******* }

constructor TFXBmpFont.Create(aImageList: TDXImageList; NameInList: string);
begin
  FImageList:=aImageList;
  FNameInList:=NameInList;
  InputChar:='*';
end;

destructor TFXBmpFont.Destroy;
begin
  inherited Destroy;
end;

procedure TFXBmpFont.SetFont(NewNameInList: string);
begin
  FNameInList:=NewNameInList;
end;

{ PRINTS OUT THE TEXT USING BMP FONT }
procedure TFXBmpFont.TextOut( dxDrawSurface: TDirectDrawSurface;
                               xp, yp: integer; mess: string; xCentred: boolean);
var
  ctr: integer;
begin
  if xCentred then
    xp:=(dxDrawSurface.Width div 2) - ((Length(mess)*FImageList.Items.Find(FNameInList).PatternWidth) div 2);
  With FImageList.Items do
    for ctr:=1 to Length(mess) do
      PrintChar(dxDrawSurface, xp+((ctr-1)*Find(FNameInList).PatternWidth), yp, mess[ctr]);
end;

function TFXBmpFont.TextInputStr( DxDrawSurface: TDirectDrawSurface;
                                   xp, yp: integer; InputMess: string;
                                   var aKey: char): string;
const
  LetterCtr: integer = 0;
  FirstTime: boolean = true;
  aString:   string  = '';
var
  x,y : integer;
  cx, cy: integer;
  xc: integer;
begin
  if FirstTime then
  begin
    SetLength(aString, 1);
    aString:='';
    FirstTime:=false;
  end;

  Textout(DxDrawSurface, xp, yp, InputMess, false);
  y:=yp;
  x:=xp+((Length(InputMess)+2)*FImageList.Items.Find(FNameInList).PatternWidth);
  cy:=y;
  cx:=x;
  Textout(DxDrawSurface, x, y, aString, false);

  if aKey=#13 then
  begin
    result:=aString;
    aString:='';
    LetterCtr:=0;
    x:=-100;
    y:=-100;
    FirstTime:=true;
  end
  else
  // Only allows characters that are in the FontTable
  if (pos(aKey, FontTable)>0) or (aKey in [' ']) then
  begin
    LetterCtr:=LetterCtr+1;
    SetLength(aString, LetterCtr);
    aString[LetterCtr]:=aKey;
  end;
  aKey:='*';
  cy:=y;
  cx:=x+((LetterCtr)*FImageList.Items.Find(FNameInList).PatternWidth);
  DisplayCursor(DxDrawSurface, cx, cy);
end;

function TFXBmpFont.TextInputInt( DxDrawSurface: TDirectDrawSurface;
                                   xp, yp: integer; InputMess: string;
                                   var aKey: char): cardinal;
const
  MaxLetters: byte = 8;
  LetterCtr: integer = 0;
  FirstTime: boolean = true;
  aString:   string  = '';
var
  x,y : integer;
  cx, cy: integer;
  xc: integer;
begin
  if FirstTime then
  begin
    SetLength(aString, 1);
    aString:='';
    FirstTime:=false;
  end;

  Textout(DxDrawSurface, xp, yp, InputMess, false);
  y:=yp;
  x:=xp+((Length(InputMess)+2)*FImageList.Items.Find(FNameInList).PatternWidth);
  cy:=y;
  cx:=x;
  Textout(DxDrawSurface, x, y, aString, false);

  if aKey=#13 then
  begin
    result:=strtoint(aString);
    aString:='';
    LetterCtr:=0;
    x:=-100;
    y:=-100;
    FirstTime:=true;
  end
  else
  if aKey in ['0'..'9'] then
  begin
    LetterCtr:=LetterCtr+1;
    if LetterCtr>MaxLetters then LetterCtr:=MaxLetters;
    SetLength(aString, LetterCtr);
    aString[LetterCtr]:=aKey;
  end;
  aKey:='*';
  cy:=y;
  cx:=x+((LetterCtr)*FImageList.Items.Find(FNameInList).PatternWidth);
  DisplayCursor(DxDrawSurface, cx, cy);
end;

{ PRINTS OUT A CHARACTER USING BMP FONT }
procedure TFXBmpFont.PrintChar(dxDrawSurface: TDirectDrawSurface; xp, yp: integer; aChar: char);
begin
  with FImageList.Items do
  begin
      // Searches the FontTable string to find where the letters/numbers/symbols
      // are in the BMP.
      if pos(aChar,FontTable)-1<Find(FNameInList).PatternCount then
      if aChar in ['0'..'9','A'..'Z', 'a'..'z'] then
//        if aChar in ['g','j','p','q','y'] then  // Increase pos by 5 to take tail into account
//          Find(FNameInList).Draw(dxDrawSurface, xp, yp+5, pos(aChar,FontTable)-1)
//        else
          Find(FNameInList).Draw(dxDrawSurface, xp, yp, pos(aChar,FontTable)-1);
  end;
end;

procedure TFXBmpFont.DisplayCursor(DxDrawSurface: TDirectDrawSurface; xp, yp: integer);
const
  ShowCursor: boolean = true;
  BlinkTimer: integer = 0;
  MaxBlinkTime = 20;
begin
  inc(BlinkTimer);
  if BlinkTimer>MaxBlinkTime then
  begin
    ShowCursor:=not(ShowCursor);
    BlinkTimer:=0;
  end;
  if ShowCursor then
  begin
    with DxDrawSurface.Canvas do
    begin
      Brush.Color:=clRed;
      Pen.Color:=Brush.Color;
      Rectangle(xp, yp+((FImageList.Items.Find(FNameInList).PatternHeight)-(FImageList.Items.Find(FNameInList).PatternHeight) div 4),
                xp+FImageList.Items.Find(FNameInList).PatternWidth,
                yp+FImageList.Items.Find(FNameInList).PatternHeight);
      Release;
    end;
  end;
end;




// ===========================================
// == FXSinusScroller CLASS PROCS
// ===========================================

constructor TFXSinusScroller.Create(aImageList: TDXImageList; NameInList: string);
begin
  inherited Create;
  StartOver:=true;
  FImageList:=aImageList;
  FNameInList:=NameInList;
end;

destructor TFXSinusScroller.Free;
begin
  inherited Destroy;
end;

procedure TFXSinusScroller.Scroll( dxDrawSurface: TDirectDrawSurface;
                                   yp: integer; xAmp, yAmp, Angle: extended;
                                   Speed: integer; yCentred, Loop: boolean);
var
  xSin, ySin: extended;
  WidthOffset: integer;
  ctr: integer;
  mess: string;
begin
  if StartOver then
  begin
    xp:=dxDrawSurface.Width+100;
    StartOver:=false;
  end;

  mess:=SinText;
  if yCentred then
    yp:=(dxDrawSurface.Height div 2) - (FImageList.Items.Find(FNameInList).PatternHeight div 2)-(FImageList.Items.Find(FNameInList).PatternHeight div 2);
  With FImageList.Items do
    for ctr:=1 to Length(mess) do
    begin
      WidthOffset:=Find(FNameInList).PatternWidth div 2; // Writes letters a little closer together
      xSin:=cos((ctr+angle)*pi/180)+sin((ctr+angle)*pi/180)*xAmp+(ctr*WidthOffset)+xp;
      ySin:=sin((((ctr*WidthOffset)+ctr*5)+angle)*pi/180)*yAmp+yp;
      PrintChar(dxDrawSurface, round(xSin)+((ctr-1)*Find(FNameInList).PatternWidth), round(ySin), mess[ctr]);
    end;
    // Start over
    if Loop then
      if xp+((length(mess)*(FImageList.Items.Find(FNameInList).PatternWidth+(WidthOffset))))<0 then
      begin
        xp:=dxDrawSurface.Width+100;
        StartOver:=true;
      end;
    xp:=xp-Speed;
end;

procedure TFXSinusScroller.PrintChar(dxDrawSurface: TDirectDrawSurface; xp, yp: integer; aChar: char);
begin
  with FImageList.Items do
  begin
      // Searches the FontTable string to find where the letters/numbers/symbols
      // are in the BMP.
      if pos(aChar,FontTable)-1<Find(FNameInList).PatternCount then
      if aChar in ['0'..'9','A'..'Z', 'a'..'z'] then
//        if aChar in ['g','j','p','q','y'] then  // Increase pos by 5 to take tail into account
//          Find(FNameInList).Draw(dxDrawSurface, xp, yp+5, pos(aChar,FontTable)-1)
//        else
          Find(FNameInList).Draw(dxDrawSurface, xp, yp, pos(aChar,FontTable)-1);
  end;
end;





end.