unit Unit1;//
//矩阵遍历,矩阵遍历算法的示范程序
//作者:yeye55 2009年5月29日
//
//版权 2009,由 yeye55 拥有,保留所有权利。
//本文件中的代码是免费程序,无需任何授权或许可即可用于个人和商业目的。使用者一切后果自负。
//
//如果你转载了本文件中的代码,请注明代码出处和代码作者;
//如果你修改了本文件中的代码,请注明修改位置和修改作者。
//
//本文件最早在http://www.programbbs.com/bbs/上发布
//interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Memo1: TMemo;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}type
    //遍历方向
    TAspect = (asLeft, asRight, asUp, asDown);const
    //遍历步长
    Interval = 1;    //移动坐标差
    MoveVal : array [asLeft..asDown] of TPoint = (
        (X : -Interval; Y : 0), //asLeft
        (X :  Interval; Y : 0), //asRight
        (X : 0; Y : -Interval), //asUp
        (X : 0; Y :  Interval)  //asDown
    );    //矩阵大小
    RowCount = 10;
    ColCount = 10;var
    //矩阵
    Matrix : array [0..RowCount-1,0..ColCount-1] of Integer;//一般遍历
procedure MatrixOrder0;
var
    VisitCount : Integer; //访问计数,测试用
    y,x : Integer;
begin
    VisitCount:=0; //访问计数,测试用
    for y:=0 to RowCount-1 do
    begin
        for x:=0 to ColCount-1 do
        begin            //访问矩阵元素
            Matrix[y,x]:=VisitCount;
            VisitCount:=VisitCount+1; //访问计数,测试用        end;
    end;
end;//螺旋遍历(不支持步长)
procedure MatrixOrder1(y,x : Integer);
var
    Aspect : TAspect;
    VisitCount,Count,i : Integer;
begin
    VisitCount:=0;
    Aspect:=asUp;
    Count:=1;
    while VisitCount<(RowCount*ColCount) do
    begin
        for i:=0 to Count-1 do
        begin
            if (x>=0) and (x<ColCount) and
               (y>=0) and (y<RowCount) then
            begin                //访问矩阵元素
                Matrix[y,x]:=VisitCount;                VisitCount:=VisitCount+1;
            end;
            x:=x+MoveVal[Aspect].X;
            y:=y+MoveVal[Aspect].Y;
        end;
        case Aspect of
            asLeft  : begin Aspect:=asUp;   Count:=Count+1; end;
            asRight : begin Aspect:=asDown; Count:=Count+1; end;
            asUp    : begin Aspect:=asRight; end;
            asDown  : begin Aspect:=asLeft;  end;
        end;
    end;
end;//螺旋遍历2(支持步长)
procedure MatrixOrder2(y,x : Integer);
var
    Aspect : TAspect;
    VisitCount : Integer; //访问计数,测试用
    Count,i : Integer;
    Visit : Boolean;
begin
    VisitCount:=0; //访问计数,测试用
    Visit:=false;
    Aspect:=asUp;
    Count:=1;
    while true do
    begin
        for i:=0 to Count-1 do
        begin
            if (x>=0) and (x<ColCount) and
               (y>=0) and (y<RowCount) then
            begin                //访问矩阵元素
                Matrix[y,x]:=VisitCount;
                VisitCount:=VisitCount+1; //访问计数,测试用                Visit:=true;
            end;
            x:=x+MoveVal[Aspect].X;
            y:=y+MoveVal[Aspect].Y;
        end;
        case Aspect of
            asLeft : begin
                if not Visit then break;
                Visit:=false;
                Aspect:=asUp;
                Count:=Count+1;
            end;
            asRight : begin Aspect:=asDown; Count:=Count+1; end;
            asUp    : begin Aspect:=asRight; end;
            asDown  : begin Aspect:=asLeft;  end;
        end;
    end;
end;//回形遍历(支持步长)
procedure MatrixOrder3(y,x : Integer);
var
    Aspect : TAspect;
    VisitCount : Integer; //访问计数,测试用
    Count,i : Integer;
    Visit : Boolean;
begin
    VisitCount:=0; //访问计数,测试用    //先访问基点元素
    Matrix[y,x]:=VisitCount;
    VisitCount:=VisitCount+1; //访问计数,测试用    x:=x-Interval;
    y:=y-Interval;
    Visit:=false;
    Aspect:=asRight;
    Count:=2;
    while true do
    begin
        for i:=0 to Count-1 do
        begin
            if (x>=0) and (x<ColCount) and
               (y>=0) and (y<RowCount) then
            begin                //访问矩阵元素
                Matrix[y,x]:=VisitCount;
                VisitCount:=VisitCount+1; //访问计数,测试用                Visit:=true;
            end;
            x:=x+MoveVal[Aspect].X;
            y:=y+MoveVal[Aspect].Y;
        end;
        case Aspect of
            asUp : begin
                if not Visit then break;
                Visit:=false;
                x:=x-Interval;
                y:=y-Interval;
                Aspect:=asRight;
                Count:=Count+2;
            end;
            asDown  : Aspect:=asLeft;
            asLeft  : Aspect:=asUp;
            asRight : Aspect:=asDown;
        end;
    end;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
    self.Caption:=Format('大小为%d×%d的矩阵',[RowCount,ColCount]);
end;procedure TForm1.Button1Click(Sender: TObject);
var
    x,y : Integer;
    s : String;
begin
    for y:=0 to RowCount-1 do
        for x:=0 to ColCount-1 do
            Matrix[y,x]:=-1;    self.Memo1.Lines.Add('');    y:=StrToIntDef(self.Edit1.Text,0);
    x:=StrToIntDef(self.Edit2.Text,0);    if self.RadioButton1.Checked then
    begin
        self.Memo1.Lines.Add('一般遍历矩阵...');
        MatrixOrder0;
    end
    else if self.RadioButton2.Checked then
    begin
        self.Memo1.Lines.Add(Format('以(%d,%d)为基点的螺旋遍历矩阵(不支持步长)...',[y,x]));
        if Interval>1 then
        begin
            self.Memo1.Lines.Add(Format('当前步长为%d,不支持。',[Interval]));
            exit;
        end;
        MatrixOrder1(y,x);
    end
    else if self.RadioButton3.Checked then
    begin
        self.Memo1.Lines.Add(Format('以(%d,%d)为基点的螺旋遍历矩阵(支持步长)...',[y,x]));
        MatrixOrder2(y,x);
    end
    else if self.RadioButton4.Checked then
    begin
        self.Memo1.Lines.Add(Format('以(%d,%d)为基点的回形遍历矩阵(支持步长)...',[y,x]));
        MatrixOrder3(y,x);
    end;    self.Memo1.Lines.Add('输出矩阵:');
    s:='   +';
    for x:=0 to ColCount-1 do s:=Format('%s%3d',[s,x]);
    self.Memo1.Lines.Add(s);
    for y:=0 to RowCount-1 do
    begin
        s:=Format('%2d :',[y]);
        for x:=0 to ColCount-1 do
        begin
            if Matrix[y,x]=-1 then
                s:=Format('%s  -',[s])
            else
                s:=Format('%s%3d',[s,Matrix[y,x]]);
        end;
        self.Memo1.Lines.Add(s);
    end;
end;procedure TForm1.Button2Click(Sender: TObject);
begin
    self.Memo1.Lines.Clear;
end;end.以上是我在网上搜索到的代码。然后根据上面的程序我写了如下函数,可是有时成功有时失败请大家帮忙一下。
其实就是已知图片上某点的坐标,然后以这个坐标为基点回形遍历此图片。
function TForm1.FindRedcolor(iLeft, iTop, iRight, iBottom,PointX,PointY: integer; var iX,
  iY: integer): boolean;
var
  i,j,ColCount,RowCount,Count:integer;
  vColor:TColor;
  Visit : Boolean;
  Aspect : TAspect;
begin
  if GameBmp = nil then Exit;
  iX := -1;
  iY := -1;
  PointX := PointX-Interval;
  PointY := PointY-Interval;
  Visit:=false;
  Aspect:=asRight;
  Count:=2;
  ColCount:=iRight - iLeft;
  RowCount := iBottom - iTop;
  while true do
  begin
    for i:=0 to Count-1 do
    begin
      if (PointX >=0) and (PointX< ColCount) and
         (PointY >=0) and (PointY<RowCount) then
      begin
        vColor :=GameBmp.Canvas.Pixels[PointX,PointY];
        if (GetRValue(vColor) >= 200) and
         (GetRValue(vColor) <= 255) and
         (GetGValue(vColor) >= 0) and
         (GetGValue(vColor) <= 50) and
         (GetBValue(vColor) >= 0) and
         (GetBValue(vColor) <= 50) then
        begin
          iX:= PointX;
          iY:= PointY;
          break;
        end;
        //if iX<>-1 then break;
        Visit:=true;
      end;
      PointX :=PointX+MoveVal[Aspect].X;
      PointY :=PointY+MoveVal[Aspect].Y;
      Application.ProcessMessages;
    end;
    case Aspect of
      asUp : begin
        if not Visit then break;
        Visit:=false;
        PointX :=PointX -Interval;
        PointY :=PointY -Interval;
        Aspect:=asRight;
        Count:=Count+2;
      end;
      asDown  : Aspect:=asLeft;
      asLeft  : Aspect:=asUp;
      asRight : Aspect:=asDown;
    end;
  end;
  {
  for j := iTop  to iBottom do
  begin
    for i := iLeft  to iRight  do
    begin
      vColor :=GameBmp.Canvas.Pixels[i,j];
      if (GetRValue(vColor) >= 200) and
         (GetRValue(vColor) <= 255) and
         (GetGValue(vColor) >= 0) and
         (GetGValue(vColor) <= 36) and
         (GetBValue(vColor) >= 0) and
         (GetBValue(vColor) <= 36) then
      begin
        iX:= i;
        iY:= j;
        break;
      end;
    end;
    if iX<>-1 then break;
  end;
  }
  result := iX<>-1;
end;

解决方案 »

  1.   

    自己解决了,呵呵!
    function TForm1.FindRedcolor(iLeft, iTop, iRight, iBottom,PointX,PointY: integer; var iX,
      iY: integer): boolean;
    var
      i,j,ColCount,RowCount,Count,VisitCount:integer;
      vColor:TColor;
      Aspect : TAspect;
    begin
      if GameBmp = nil then Exit;
      iX := -1;
      iY := -1;
      Aspect:=asUp;
      result:=false;
      VisitCount:=0;
      Count:=2;
      ColCount:=iRight - iLeft;
      RowCount := iBottom - iTop;
      while VisitCount<(ColCount*RowCount) do
      begin
        for i:=0 to Count-1 do
        begin
          if (PointX >=0) and (PointX< ColCount) and
             (PointY >=0) and (PointY<RowCount) then
          begin
            vColor :=GameBmp.Canvas.Pixels[PointX,PointY];
            if (GetRValue(vColor) >= 200) and
             (GetRValue(vColor) <= 255) and
             (GetGValue(vColor) >= 0) and
             (GetGValue(vColor) <= 50) and
             (GetBValue(vColor) >= 0) and
             (GetBValue(vColor) <= 50) then
            begin
              iX:= PointX;
              iY:= PointY;
              Result := True;
              break;
            end;
            VisitCount :=VisitCount +1;
          end;
          PointX :=PointX+MoveVal[Aspect].X;
          PointY :=PointY+MoveVal[Aspect].Y;
          Application.ProcessMessages;
        end;
        if Result then Break;
        case Aspect of
          asLeft  : begin Aspect:=asUp;   Count:=Count+1; end;
          asRight : begin Aspect:=asDown; Count:=Count+1; end;
          asUp    : begin Aspect:=asRight; end;
          asDown  : begin Aspect:=asLeft;  end;
        end;
      end;
    end;
      

  2.   

    Mark 
    我做异性窗口有用到~~   遍历图片像素~~~
    不过速度似乎有点慢