piece.pas

用于开发税务票据管理的软件

unit Piece;

interface

uses
  Forms, SysUtils, Windows, Classes, Graphics;

type
  TRGBArray = Array[0..32767] of TRGBTriple;
  pRGBArray = ^TRGBArray;

  TColour = (cWhite, cBlack);

 // PPiece = ^TPiece;
  TPiece = class(TComponent)
  private
    { Private declarations }
    FFilterArray: Array[0..8] of Integer;
    FFilterDivisor: Integer;
    FFilterName: ShortString;
    FPic: TPicture;
    FSmooth: Boolean;
    FStretch: Boolean;

    procedure ChangePic(NewPic: TPicture);
    procedure ChangeSmooth(NewVal: Boolean);
    procedure ChangeStretch(NewVal: Boolean);

  protected
    { Protected declarations }
    FCaptured: Boolean;
    FHint: String;
    FNotation: Byte;         { Used for prefix getting (0 - old, 1 - new) }
    FNumberMoves: Cardinal;
    FOldX,
    FOldY: Integer;
    FPieceNum: Byte;  { holds number of pieces of same type... not used for
                        TPiece, but for descendants (e.g. TBishop) }
    FPlayer: TColour;
    FPrefix: Char;
    FShowHint: Boolean;
    FSTARTDIR: String;
    FValue: Byte;
    FX,
    FY: Integer;

{    procedure PieceDragOver(Sender, Source: TObject; X,
      Y: Integer; State: TDragState; var Accept: Boolean); virtual;
    procedure PieceDragDrop(Sender, Source: TObject; X,
      Y: Integer); virtual; }

    procedure ChangeColour(NewVal: TColour); virtual;
    procedure ChangeFilterName(const NewVal: ShortString);
    function GetStartingLocation(NumberOfItems: Byte): TPoint; virtual; abstract;
    procedure ChangeCaptured(NewVal: Boolean);
    procedure ChangeX(NewVal: Integer);
    procedure ChangeY(NewVal: Integer);
    procedure SetArrayValues(const A: Array of Integer);

    procedure CopyMe(tobmp: TBitmap; frbmp : TGraphic);
    function Set255(Clr : integer) : integer;
    procedure ConvolveI(ray : array of integer; z : word; aBmp : TBitmap);
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure DrawToBitmap(picBitmap: TBitmap; SquareSize: Integer); register;

    procedure SetLocation(Where: TPoint);
    function GetValue: Byte;
    function GetLocation: TPoint;
    function ValidMove(Where: TPoint): Boolean; virtual; abstract;
    function GetPrefix: String; virtual;
    function Move(Where: TPoint): Boolean;
    procedure SetNumberMoves(NewVal: Cardinal);
    procedure ChangeColourAndReset;
    procedure Reset;

    property Captured: Boolean Read FCaptured Write ChangeCaptured;

  published
    { Published declarations }
    property Colour: TColour Read FPlayer Write ChangeColour;
    property FilterName: ShortString Read FFilterName Write ChangeFilterName;
    property ItemNumber: Byte Read FPieceNum Write FPieceNum;
    property Location: TPoint Read GetLocation Write SetLocation;
    property NumberMoves: Cardinal Read FNumberMoves Write FNumberMoves;
    property X: Integer Read FX Write ChangeX;
    property Y: Integer Read FY Write ChangeY;
    property Picture: TPicture Read FPic Write ChangePic;
    property SmoothImage: Boolean Read FSmooth Write ChangeSmooth;
    property Stretch: Boolean Read FStretch Write ChangeStretch;

    property Hint: String Read FHint Write FHint;
    property ShowHint: Boolean Read FShowHint Write FShowHint;
  end;

implementation

uses Board;

constructor TPiece.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  { Don't forget to create new picture }
  FPic := TPicture.Create;
  FPic.Assign(nil);

  FNumberMoves := 0;
  FShowHint := True;
  FStretch := True;
  FCaptured := False;
  FilterName := 'blur';

  FStartDir := ExtractFileDir(Application.ExeName);
  if FStartDir[Length(FStartDir)] <> '\' then FStartDir := FStartDir + '\';
end;

destructor TPiece.Destroy;
begin
  { Created FPic, so free it }
  FPic.Free;
  inherited Destroy;
end;

procedure TPiece.ChangeCaptured(NewVal: Boolean);
begin
  if NewVal <> FCaptured then
  begin
    FCaptured := NewVal;
    if NewVal = False then
    begin
      FX := FOldX;
      FY := FOldY;
    end
    else
    begin
      FOldX := FX;
      FOldY := FY;
      FX := 0;
      FY := 0;
    end;
  end;
end;

function TPiece.Move(Where: TPoint): Boolean;
begin
  if ValidMove(Where) then
  begin
    FX := Where.X;
    FY := Where.Y;
    Inc(FNumberMoves);
    Result := True;
  end
  else
    Result := False;
end;

{ This function differs from the move function in that
  it will always move the piece, without checking if the
  move is valid.  It is used when initialising the position
  of a piece by the board. }
procedure TPiece.SetLocation(Where: TPoint);
begin
  if (Where.X in [1..8]) and (Where.Y in [1..8]) then
  begin
    FX := Where.X;
    FY := Where.Y;
    FOldX := Where.X;
    FOldY := Where.Y;
  end;
end;

procedure TPiece.ChangePic(NewPic: TPicture);
begin
  if NewPic <> nil then
  begin
    FPic.Assign(NewPic);
    if FPic.Graphic <> nil then
      FPic.Graphic.Transparent := True;
  end;
end;

procedure TPiece.DrawToBitmap(picBitmap: TBitmap; SquareSize: Integer); register;
var
  Smooth: TBitmap;
begin
  //assert(FPic.Graphic.Transparent);

try
  if not (((FX - 1) in [0..7]) and
         ((8 - FY) in [0..7])) then Exit;

  if FStretch then
  begin
    if FSmooth then
    begin
      Smooth := TBitmap.Create;
      CopyMe(smooth, FPic.graphic);

      Smooth.Width := FPic.Graphic.Width;
      Smooth.Height := FPic.Graphic.Height;
      Smooth.Canvas.StretchDraw(Smooth.Canvas.ClipRect, FPic.graphic);
      Smooth.Transparent := True;

      ConvolveI( FFilterArray, FFilterDivisor, Smooth);
      PicBitmap.Canvas.StretchDraw( Bounds( (FX - 1) * SquareSize,
                                            (8 - FY) * SquareSize,
                                            SquareSize,
                                            SquareSize),
                                    Smooth);
      Smooth.Free;
    end
    else
      PicBitmap.Canvas.StretchDraw( Bounds( (FX - 1) * SquareSize,
                                             (8 - FY) * SquareSize,
                                             SquareSize,
                                             SquareSize),
                                     FPic.Graphic);
  end
  else
    PicBitmap.Canvas.Draw( (FX - 1) * SquareSize,
                           ( 8 - FY) * SquareSize,
                           FPic.Graphic);
except
  ;
end;

end;

procedure TPiece.ChangeColourAndReset;
begin
  if Colour = cWhite then Colour := cBlack else Colour := cWhite;
  Reset;
end;

procedure TPiece.Reset;
var
  Start: TPoint;
begin
  Start := GetStartingLocation(FPieceNum);
  FNumberMoves := 0;
  FCaptured := False;
  FOldX := 0;
  FOldY := 0;
  FX := Start.X;
  FY := Start.Y;
end;

procedure TPiece.SetArrayValues(const A: Array of Integer);
var
  i: Integer;
begin
  for i := 0 to 8 do
    FFilterArray[i] := A[i];
end;

procedure TPiece.ChangeFilterName(const NewVal: ShortString);
begin
  if NewVal <> FFilterName then
  begin
    FFilterName := Lowercase(NewVal);

    if FFilterName = 'laplace' then
    begin
      SetArrayValues([-1, -1, -1, -1, 8, -1, -1, -1, -1]);
      FFilterDivisor := 1;
    end
    else if FFilterName = 'hipass' then
    begin
      SetArrayValues([-1, -1, -1, -1, 9, -1, -1, -1, -1]);
      FFilterDivisor := 1;
    end
    else if FFilterName = 'find edges (top down)' then
    begin
      SetArrayValues([1, 1, 1, 1, -2, 1, -1, -1, -1]);
      FFilterDivisor := 1;
    end
    else if FFilterName = 'sharpen' then
    begin
      SetArrayValues([-1, -1, -1, -1, 16, -1, -1, -1, -1]);
      FFilterDivisor := 8;
    end
    else if FFilterName = 'edge enhance' then
    begin
      SetArrayValues([0, -1, 0, -1, 5, -1, 0, -1, 0]);
      FFilterDivisor := 1;
    end
    else if FFilterName = 'colour emboss' then
    begin
      SetArrayValues([1, 0, 1, 0, 0, 0, 1, 0, -2]);
      FFilterDivisor := 1;
    end
    else if FFilterName = 'soften' then
    begin
      SetArrayValues([2, 2, 2, 2, 0, 2, 2, 2, 2]);
      FFilterDivisor := 16;
    end
    else if FFilterName = 'blur' then
    begin
      SetArrayValues([3, 3, 3, 3, 8, 3, 3, 3, 3]);
      FFilterDivisor := 32;
    end
    else if FFilterName = 'soften (less)' then
    begin
      SetArrayValues([0, 1, 0, 1, 2, 1, 0, 1, 0]);
      FFilterDivisor := 6;
    end;

        {Some edge detection filters:

laplace      hipass     find edges   sharpen    edge enhance  color emboss
                        (top down)                            (well, kinda)
-1 -1 -1    -1 -1 -1     1  1  1     -1 -1 -1     0 -1  0       1  0  1
-1  8 -1    -1  9 -1     1 -2  1     -1 16 -1    -1  5 -1       0  0  0
-1 -1 -1    -1 -1 -1    -1 -1 -1     -1 -1 -1     0 -1  0       1  0 -2

    1           1           1            8           1             1

 Soften        blur    Soften (less)

 2  2  2     3  3  3     0  1  0
 2  0  2     3  8  3     1  2  1
 2  2  2     3  3  3     0  1  0

   16          32           6
}


  end;
end;

(*

procedure TPiece.PieceDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  if (Owner is TChessboard) then
    if (Source is TPiece) then
    begin
      X := FX;
      Y := FY;

      TChessboard(Owner).OnDragOver(Sender, Source, X, Y, State, Accept);
    end;
end;

procedure TPiece.PieceDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  if (Source is TPiece) then
    if (Owner is TChessboard) then
    begin
      { The X and Y here are for the piece, not the position on the
        board.  Since I couldn't figure out the correct formula for
        changing the X and Y into what the chessboard would expect,
        I took the obvious way.  In the board's DragDrop, it checks
        if the sender is a TPiece.  If it is, it simply converts the
        new location by using point(x,y).  This works perfectly! }

      { NEW NOTE: Now I implement Drag-Drop in a totally different
        way, this is not ever called.  The board deals directly with
        Windows mouse messages to do this, leaving this function alone }
      X := FX;
      Y := FY;
      TChessboard(Owner).OnDragDrop(Sender, Source, X, Y);
    end;
end;                        *)

procedure TPiece.SetNumberMoves(NewVal: Cardinal);
begin
  if NewVal <> FNumberMoves then FNumberMoves := NewVal;
end;

procedure TPiece.ChangeColour(NewVal: TColour);
begin
  if NewVal <> FPlayer then FPlayer := NewVal;
end;

procedure TPiece.ChangeSmooth(NewVal: Boolean);
begin
  if FSmooth <> NewVal then
    FSmooth := NewVal;
end;

{ This is used just for the invalidate bit.  This means when
  the stretch property is changed, the component redraws itself }
procedure TPiece.ChangeStretch(NewVal: Boolean);
begin
  if FStretch <> NewVal then
    FStretch := NewVal;
end;

procedure TPiece.ChangeX(NewVal: Integer);
begin
  if NewVal in [1..8] then
  begin
    FOldX := NewVal;
    FX := NewVal;
  end;
end;

procedure TPiece.ChangeY(NewVal: Integer);
begin
  if NewVal in [1..8] then
  begin
    FOldY := NewVal;
    FY := NewVal;
  end;
end;

function TPiece.GetValue: Byte;
begin
  Result := FValue;
end;

function TPiece.GetLocation: TPoint;
begin
  Result := Point(FX, FY);
end;

function TPiece.GetPrefix: String;
begin
  Result := FPrefix;   { Algebraic/Descriptive notation toggle not yet done }
end;

{A simple procedure to copy any TGraphic to a 24-bit TBitmap}
procedure TPiece.CopyMe(tobmp: TBitmap; frbmp : TGraphic);
begin
  tobmp.Width := frbmp.Width;
  tobmp.Height := frbmp.Height;
  tobmp.PixelFormat := pf24bit;
  tobmp.Canvas.Draw(0,0,frbmp);
end;

{This just forces a value to be 0 - 255 for rgb purposes.  I used asm in an
 attempt at speed, but I don't think it helps much.}
function TPiece.Set255(Clr : integer) : integer;
asm
  MOV  EAX,Clr  // store value in EAX register (32-bit register)
  CMP  EAX,254  // compare it to 254
  JG   @SETHI   // if greater than 254 then go set to 255 (max value)
  CMP  EAX,1    // if less than 255, compare to 1
  JL   @SETLO   // if less than 1 go set to 0 (min value)
  RET           // otherwise it doesn't change, just exit
@SETHI:         // Set value to 255
  MOV  EAX,255  // Move 255 into the EAX register
  RET           // Exit (result value is the EAX register value)
@SETLO:         // Set value to 0
  MOV  EAX,0    // Move 0 into EAX register
end;

procedure TPiece.ConvolveI(ray : array of integer; z : word; aBmp : TBitmap);
var
  O, T, C, B : pRGBArray;  // Scanlines
  x, y : integer;
  tBufr : TBitmap; // temp bitmap
begin
  tBufr := TBitmap.Create;
  CopyMe(tBufr,aBmp);
  for x := 1 to aBmp.Height - 2 do begin  // Walk scanlines
    O := aBmp.ScanLine[x];      // New Target (Original)
    T := tBufr.ScanLine[x-1];     //old x-1  (Top)
    C := tBufr.ScanLine[x];   //old x    (Center)
    B := tBufr.ScanLine[x+1];   //old x+1  (Bottom)
  // Now do the main piece
    for y := 1 to (tBufr.Width - 2) do begin  // Walk pixels
      O[y].rgbtRed := Set255(
          ((T[y-1].rgbtRed*ray[0]) +
          (T[y].rgbtRed*ray[1]) + (T[y+1].rgbtRed*ray[2]) +
          (C[y-1].rgbtRed*ray[3]) +
          (C[y].rgbtRed*ray[4]) + (C[y+1].rgbtRed*ray[5])+
          (B[y-1].rgbtRed*ray[6]) +
          (B[y].rgbtRed*ray[7]) + (B[y+1].rgbtRed*ray[8])) div z
          );
      O[y].rgbtBlue := Set255(
          ((T[y-1].rgbtBlue*ray[0]) +
          (T[y].rgbtBlue*ray[1]) + (T[y+1].rgbtBlue*ray[2]) +
          (C[y-1].rgbtBlue*ray[3]) +
          (C[y].rgbtBlue*ray[4]) + (C[y+1].rgbtBlue*ray[5])+
          (B[y-1].rgbtBlue*ray[6]) +
          (B[y].rgbtBlue*ray[7]) + (B[y+1].rgbtBlue*ray[8])) div z
          );
      O[y].rgbtGreen := Set255(
          ((T[y-1].rgbtGreen*ray[0]) +
          (T[y].rgbtGreen*ray[1]) + (T[y+1].rgbtGreen*ray[2]) +
          (C[y-1].rgbtGreen*ray[3]) +
          (C[y].rgbtGreen*ray[4]) + (C[y+1].rgbtGreen*ray[5])+
          (B[y-1].rgbtGreen*ray[6]) +
          (B[y].rgbtGreen*ray[7]) + (B[y+1].rgbtGreen*ray[8])) div z
          );
    end;
  end;
  tBufr.Free;
end;

end.