interface
 uses Classes,SysUtils;
 
type
  pAStarPathNode=^tAStarPathNode;
  tAStarPathNode=record
      x,y:word;
      F:word;
      G:word;
      H:word;
      father:pAStarPathNode; //地图方格的父方格
      prev  :pAStarPathNode; //链表上的上个节点
      next  :pAStarPathNode; //链表上的下个节点
  end;
  tAStarMapBuf=array of byte;

  pAStarArea=^tAStarArea; //区域
  tAStarArea=record
      headNode:pAStarPathNode;
      endNode:pAStarPathNode;
  end;

var
  mapWidth,mapHeight:integer;
  mapToX,mapToY:integer;
  AStarOpenArea:pAStarArea;
  AStarCloseArea:pAStarArea;
  pAStarMapBuf:pByte;
  nearGBuf:array [0..2,0..2] of byte;
 
  function ArrayOf(buf:pByte;x,y,xSize:word):byte;
  function AStarFindPath(var returnPath:tstringlist;fromX,fromY,toX,toY,mapW,mapH:word;mapBuf:pByte):boolean;
  function AStarGetHValue(fX,fY:word):word;
  function AStarGetGValue(fX,fY,tX,tY:word):word;
  procedure AStarInitNearG(x,y:word);
  procedure AStarInsertByF(pHead:pAStarArea;thisNode:pAStarPathNode);
  function AStarSearchMinF(fatherNode:pAStarPathNode):pAStarPathNode;

implementation

  //数组与地图XY的对应关系: ary[y,x] 这样就能对应到地图的(x,y)
  //因此传入的地图数组数据，第1个是Y，第2个是X,要注意与数据的位置对应

  function AStarFindPath(var returnPath:tstringlist;fromX,fromY,toX,toY,mapW,mapH:word;mapBuf:pByte):boolean;
  var
    p:pAStarPathNode;
    i:integer;
    s:string;
  begin
     result:=false;
     pAStarMapBuf:=mapBuf;
     mapToX:=toX;
     mapToY:=toY;
     mapWidth:=mapW;
     mapHeight:=mapH;

     new(AStarCloseArea);    //建立开放区
     AStarCloseArea.headNode:=nil;
     AStarCloseArea.endNode:=nil;

     new(AStarOpenArea);     //建立封闭区
     AStarOpenArea.headNode:=nil;
     AStarOpenArea.endNode:=nil;

     new(p);                //起点加入开放区
     p.x:=fromX;
     p.y:=fromY;
     p.G:=0;
     p.H:=AStarGetHValue(fromx,fromY);
     p.F:=p.G+p.H;
     p.next:=nil;
     p.father:=nil;
     AStarOpenArea.headNode:=p;
     AStarOpenArea.endNode:=p;

     while true do
       begin
        if (p.x=tox) and (p.y=toy) then break; //找到终点就退出
        p:=AStarSearchMinF(p);
        if p=nil then exit;
       end;
     result:=true;
     while true do //从终点开始延者父节点返回到起点就是路径
       begin
         if p=nil then break;
         s:=inttostr(p.x)+','+inttostr(p.y);
         returnPath.Insert(0,s);
         p:=p.father;
       end;
  end;

  //计算到目标点的H值
  function AStarGetHValue(fX,fY:word):word;
  var
    dx,dy:integer;
  begin
    dx:=abs(fX-mapToX);
    dy:=abs(fY-mapToY);
    result:=dx*10+dy*10;
  end;

  //计算周围8个方向的G值
  function AStarGetGValue(fX,fY,tX,tY:word):word;
  var
    dx,dy:integer;
  begin
    dx:=abs(fX-tX);
    dy:=abs(fY)-(tY);
    if (dx=0) and (dy=0) then result:=0
     else
      if dx*dy=0 then result:=10 else result:=14;
  end;

  //通过指针访问数组
  function ArrayOf(buf:pByte;x,y,xSize:word):byte;
  var
    j:integer;
  begin
     j:=y*xSize+x;
     inc(buf,j);
     result:=buf^;
  end; 

  //设置x,y周围8个各自的G值
  procedure AStarInitNearG(x,y:word);
  var
   i,j,v,x1,y1:integer;
   p:pbyte;
  begin
    p:=pAStarMapBuf; //全局地图指针
    fillChar(nearGBuf,9,1);
    for i:=-1 to 1 do  //Y
      begin
        y1:=y+i;
        for j:=-1 to 1 do //X
         begin
           if nearGBuf[i+1,j+1]=0 then continue; //由于路障被预先处理了
           x1:=x+j;
           //中间的点,超出地图范围的点不可用
           if ((i=0) and (j=0)) or (x1<0) or (y1<0) or (x1>mapWidth) or (y1>mapHeight) then v:=-1
             else
               begin
                  v:=ArrayOf(p,x1,y1,mapWidth); //看地图数据里这格是否是路障
                  v:=AStarGetGValue(x,y,x1,y1) * v; //计算临近的格G值
               end;

           if (v=0) and ((x1=x) or (y1=y))  then //格子平行方向不可行或竖向不可行，上下或左右的也不可行
             begin
                if y1=y then  //左右边右路障，因方格有角，路障下面和上面的格也不可过
                  begin
                     nearGBuf[i,j+1]:=0;
                     nearGBuf[i+1,j+1]:=v; //自己=0
                     nearGBuf[i+2,j+1]:=0;
                  end;
                if x1=x then
                  begin
                     nearGBuf[i+1,j]:=0;
                     nearGBuf[i+1,j+1]:=v;
                     nearGBuf[i+1,j+2]:=0;
                  end;
                continue;
             end;
           if v<0 then v:=0; //非超出范围的位置
           nearGBuf[i+1,j+1]:=v;
         end;
      end;
  end;

  //根据thisNode进行F值降序调整链接节点位置或者插入
  procedure AStarInsertByF(pHead:pAStarArea;thisNode:pAStarPathNode);
  var
    p,p2:pAStarPathNode;
    F:word;
  begin
    p:=pHead.headNode;
    while true do
      begin
        if thisNode.F<p.F then //找到F值比自己大的
          begin
             p2:=p.prev; //上个节点
             if p2=nil then //这个节点是头节点
               begin
                 thisNode.prev:=nil;//变成头属性
                 pHead.headNode:=thisNode; //插入第一个节点作为头
               end
             else
               begin
                p2.next:=thisNode; //跟上一个点对接
                thisNode.prev:=p2;
               end;

             p.prev:=thisNode; //插入后对接
             thisNode.next:=p;
             exit;
          end;
        if p.next=nil then //末尾
          begin
             if p=thisNode then exit; //就是自己啦
             p.next:=thisNode;
             thisNode.prev:=p;
             thisNode.next:=nil;
             pHead.endNode:=thisNode;
             exit;
          end;         
        p:=p.next;
      end;
  end;

  //从开发区中选出F值最小的点
  //原理：以基点为中心通过周围8方向辐射的方式不断的添加新格子(以基点作为父节点)到开放区
  //      (完成这个工作后这个辐射基点要加到封闭区)
  // 在辐射的过程中，同时检测早先被加入开放区的格子的G值是不是最小的(从辐射基点到该格子的G值)
  // 如果这个基点到该格子的G值更小，则变换这个格子的父节点为基点并重新计算F值
  //，然后在开放区中选出最小F值的格子，再继续以选定的点往外辐射,直至辐射到目的点
  function AStarSearchMinF(fatherNode:pAStarPathNode):pAStarPathNode;
  var
    x,y,x1,y1:integer;
    p,p2:pAStarPathNode;
    pX,pY:integer;
    g,h,f:word;
  begin
    pX:=fatherNode.x;
    pY:=fatherNode.y;
    AStarInitNearG(pX,pY);//周围的G值如何，路障，原点排除

    for y:=1 downto -1 do  //Y的3行
      begin
        for x:=1 downto -1 do //X的3列
          begin
             x1:=x+pX;    //尝试周围的坐标
             y1:=y+pY;
             g:=nearGBuf[y+1,x+1]; //有可能被预先清0了(路障在中间时)
             if g=0 then continue ;//跳过没有G值的
             p:=AStarOpenArea.headNode;
             while true do  //搜索此点是否在开发区内
               begin
                 if p=nil then break;
                 if (p.x=x1) and (p.y=y1) then break; //在开放区
                 p:=p.next;
               end;

             if p<>nil then //在开放区
               begin
                  g:=p.G+g;  //起点经由选中点到此点的G值
                  if g<p.g then  //经过此点更近，早先设置的父节点需要更改
                    begin
                       p.father:=fatherNode;  //更新它的父节点
                       p.G:=g;
                       p.F:=p.G+p.H;//重新计算F值
                    end;
                  continue;//后面不用再搜索封闭区了
               end;
             p:=AStarCloseArea.headNode;
             while true do  //搜索封闭区
               begin
                  if p=nil then break;  //没有在封闭区
                  if (p.x=x1) and (p.y=y1) then break; //在封闭区
                  p:=p.next;
               end;
             if p=nil then  //这是个新点,设定父节点
               begin
                  new(p);
                  p.prev:=AStarOpenArea.endNode ; //接到最后的开放节点上
                  AStarOpenArea.endNode:=p;
                  p.next:=nil;
                  p.x:=x1;
                  p.y:=y1;
                  p.G:=fatherNode.G+g;
                  p.H:=AStarGetHValue(x1,y1);
                  p.F:=p.G+p.H;
                  p.father:=fatherNode; //父节点，保存是谁把它加入开放区的
                  AStarInsertByF(AStarOpenArea,p);//插入开发区中
               end;
          end; // next x
      end; //next y;

    //把此节点从开放区抽出来，做好开放区节点的重新连接
    if fatherNode.prev=nil then  //当前点是开放区的第一个
      begin
         p:=fatherNode.next;//下一个接的准备变成头
         p.prev:=nil;      //头属性
         AStarOpenArea.headNode:=p;//更新头
      end
    else
      begin
        p:=fatherNode.next;    //下个节点
        p.prev:=fatherNode.prev; //连到这个点的上个节点上
        fatherNode.prev.next:=p;
      end;

    //准备加到封闭区的末尾
    p:=AStarCloseArea.endNode;  //封闭区最末的点
    if p=nil then AStarCloseArea.headNode:=fatherNode; //如果没有，那这个也是头也是未
    AStarCloseArea.endNode:=fatherNode; //是未位
    fatherNode.prev:=nil;
    fatherNode.next:=nil;
    if p<>nil then //有其他的末位
      begin
       p.next:=fatherNode; //连到尾巴上
       fatherNode.prev:=p;
      end;
     
    AStarOpenArea.headNode.prev:=nil; //最小的F已经在首个,设置成首属性
    result:=AStarOpenArea.headNode;//返回F值最小的
  end;

end.

调用方法： AStarFindPath
地图数据为字节型的数组,大小为mapW x mapH,调用时传入该数组的地址(pByte)

　　在利用ODBC访问数据库时，通常的方法时是在ODBC管理面板中设置一个ODBC系统数据源(系统DSN)，然后在DBD中或在程序中设置一个数据库别名(Alias)对应该DSN，这样就可以如愿以偿地操作数据库了．相信用DELPHI做过数据库应用的程序员对这方面已经很熟悉了，笔者就不多说了．在实际应用中，笔者曾遇到过这样的情况，我们的数据库应用程序是依靠ODBC系统数据源访问和操作数据库的，应用程序运行一直良好，直到某一天，一个对WINDOWS系统较为熟悉但又不太精通的用户不慎修改或删除了我们预先设置的系统DSN......

　　于是，笔者就开始研究怎么在程序中动态地设置ODBC系统DSN的内容，这样就可以增加自己程序的坚固性了．经过整整一天对WINDOWS注册表的研究，终于找到了ODBC管理程序设置DSN的秘密（＂天地自有公道，付出总会回报！＂，不是做广告！），现写出来与大家共享，也请高手指教．
　　ODBC管理程序设置DSN的秘密在注册表中，不信可以到HKEY_LOCAL_MACHINE\Software\ODBC去看看，肯定让你感觉已经成功了一半．
　　首先来看看系统中已安装的ODBC数据库驱动程序．在HKEY_LOCAL_MACHINE\Software\ODBC\ ODBCInst.INI中，存放着已经安装了的ODBC数据库驱动程序的信息，从这里可以查到已安装的ODBC数据库驱动程序对应的DLL文件等信息．在ODBCInst.INI\ODBC Drivers的各个键值中，键名是驱动程序名称(如Microsoft Access Driver(*.mdb))，键值为“Installed”，表示驱动程序已安装．在 ODBCInst.INI\DriverName(DriverName为一个驱动程序名称，如Microsoft Access Driver(*.mdb))中，有驱动程序的详细信息，我们主要从这里获得ODBC驱动程序对应的DLL文件的路径和文件名，即键名Driver的键值，一般为"C:\WINDOWS\SYSTEM\FileName.DLL"．

　　然后来看系统DSN的注册信息，在HKEY_LOCAL_MACHINE\Software\ODBC\ODBC.INI中，存放着系统DSN的注册信息，我们在ODBC管理面板设置的DSN参数就在这里．

　　下面来看看创建一个ODBC系统DSN的步骤，即我们在ODBC管理面板中完成参数设置后，ODBC管理程序是怎么在注册表中注册DSN信息的．以创建一个名称为MyAccess的Ms Access97类型的系统DSN为例，我们指定的参数主要有数据库类型(Microsoft Access Driver(*.mdb))、数据源名称(MyAccess)、数据源描述(我的ACCESS)、数据库路径(C:\Inetpub\wwwroot\Test.mdb)，其它参数如用户名称、用户密码、独占、只读、系统数据库、默认目录、缓冲区大小、扫描行数、页超时等采用系统缺省参数．这时，注册系统DSN一般应有以下几个步骤：

　　1．在HKEY_LOCAL_MACHINE\Software\ODBC\ODBC.INI\ODBC Data Sources中增加一个字符串键值，为MyAccess = Microsoft Access Driver(*.mdb)，其中分别为数据源名称和数据库类型．这是在注册表中注册一个系统DSN名称．

　　2．在HKEY_LOCAL_MACHINE\Software\ODBC\ODBC.INI中创建一个子键(SubKey)MyAccess，即创建一个键为HKEY_LOCAL_MACHINE\Software\ODBC\ODBC.INI\MyAccess，然后在其下创建一些键值，详细描述一个系统DSN的配置信息，主要信息有([]中的内容为笔者注释)：
DBQ=C:\Inetpub\wwwroot\Test.mdb [字符串，表示数据库路径]
Description=我的ACCESS [字符串，表示数据库描述]
Driver=C:\PWIN98\System\odbcjt32.dll [字符串，表示驱动程序，可见ODBCINST.INI]
DriverId=0x00000019(25) [数字，表示驱动程序标识，不能改变]
FIL=Ms Access; [字符串，可能与过滤Filter有关]
SafeTransaction=0x00000000 [数字，可能表示支持事务性操作的个数]
UID="" [字符串，表示用户名称，此处为空字符串]

　　3．在HKEY_LOCAL_MACHINE\Software\ODBC\ODBC.INI\MyAccess中创建一个子键(SubKey)Engines，再在其下创建子键(SubKey)Jet，即创建一个键为
HKEY_LOCAL_MACHINE\Software\ODBC\ODBC.INI\MyAccess\Engines\Jet，然后在其下创建一些键值，详细描述一个系统DSN的数据库引擎配置信息，主要信息有([]中的内容为笔者注释)：
ImplicitCommitSync=Yes [字符串，可能表示是否立即反映数据修改]
MaxBufferSize=0x00000200(512) [数字，表示缓冲区大小]
PageTimeout=0x00000005(5) [数字，表示页超时]
Threads=0x00000003(3) [数字，可能表示支持的最大线程数目]
UserCommitSync=Yes [字符串，可能表示是否立即将数据修改反映到用户]

　　以上是建立一个系统DSN的基本信息(其它信息如选项或高级选项等信息也在这里设置，只不过因采用默认信息，注册表里没有列出)，我们在程序中按上述步骤操作注册表，同样也能增加一个系统DSN或修改其配置．

 
--------------------------------------------------------------------------------

    在很多应用程序中，都需要程序具有打印预览功能，以避免用户由于选择不当出现打印错误。预览实现方式为通过创建一个Tpanel的派生类并公开它的canvas属性比例尺或视区范围，使用较为不方便，笔者通过实践实现了用图元文件（Metafile）来实现打印预览的方法，这种方式不需要调整比例尺和视区范围。

基本原理和方法：

　　　　使用图元文件的好处在于图元文件也称作"绘图类型"的图形，是以图形对象（线、圆弧、多边形）方式而不是像素方式来储存图像。图元文件将图形定义为编码的确线段和图形。Windows系统下有两种类型的图元文件:标准型（WMF文件格式）和增强型（EMF文件格式）。

它能够任意大小缩放并且任能保持一定的逼真度，这是因为图元文件通常由一系列矢量图形的图元组成，图元是指线条、填充的区域以及轮廓字体等。扩大或缩小图像只是简单地缩放定义这些图元的所有坐标点，所以当调整图像大小时，图元文件对图像的保存比像素更精确，效果更好。

　　Delphi以Tmetafile对象对 Win32增强型图元文件进行了封装，通过设置Enhanced属性可以设定图元文件是以标准型或可增强型格式存储。
在Delphi中使用图元文件的基本方法是：

  　创建图元文件
  　使用参照设备的打印机句柄创建图元文件画布对象（Tmetafilecanvas）
  　如同在打印机画布上一样，在图元文件画布进行描
  　将图元文件在屏幕上显示出来

实现步骤：

　　首先建立一个窗体文件，在适当位置放上一个panel控件 (panel)，一个checkbok控件(chedkbox1),并设定checkbox的 caption为"打印预览"，在panel上放置一个image控件(image), 并设image的align属性为kckient.

  　在USES中添加打印程序单元（Printers）,尽管Delphi在生成窗体时会自动在USESB部分加入许多程序单元，但打印程序单元却不在此列，只能手工给它加上。

  　关键代码说明：用GetDevice (Printer.Handle,LOGPIXESX)获取当前打印机的水平分辨率。

    如果想让打印程序在任何打印机上都能正常的打印，你就必须改变你的度量单位。

Dpm:=trunc(dpi/25.4);
//算出每毫米的打印机点数。
MyMetafile :=Tmetafile.Create;
//创建图元文件
TmetafileCanvas.Create (MyMetafile,printer.Handle)
//以打印机句柄创建图元文件画布
textout(trunc(sx*dpm), trunc(sy*dpm),'我的打印')；//进行打印输入
imagel.Camvas.StretchDraw (imagel.canvas.cliprect, MyMetafile);
//显示图元文件

程序源代码：
unit u_print;
interface
uses
Windows,Messages,SysUtils,Classes,Graphics,Controls,Controls,Fr-ms,Dialogs,
StdCtr;d,Buttons,printers,ExtCtrls;
Type
TF_prin = class(Tform)
………
private
{Private declarations}
public
{Public declarations}
end;
var
F_print: TF_print;
Implementation
{$R*.DFM}

procedure TF_print.BitBtn1Click(Sender:Tobject);
brgin
  close;
end;

//定义report过程，使真实打印和打印愈来愈览共用此过程
procedure TF_print.report (Acanvas:Tcanvas);
var
 sx,sy,sy0,sx0:real;//开始位置
 dpi,dpm:real; //每毫米的点数
 Arect: Trect;
Begin
  Dpi: =GetDeviceCaps (Printer.Handle,LogPixelsX);
  Dpm:=trunc(dpi/25.4); //每毫米的点数
  Sx:=100; sx0:=10; sy0:=10 sy:=sy0;
  with Acanvas do
    try
     font.name:='宋体'；
     font.size:=18;
     textout(trunc (60*dpm),trunc (sy*dpm),'姓名')；
     sy:=sy+10;
     pen.Width:=5;
     MoveTo(trunc(sx0*dpm),trunc(sy*spm));
     LineTo(trunc((sX0+200)*dpm),trunc(sy*dpm));
     font.size:=12;
     sy::=sy+5;
     textout(trunc(sx0*dpm),trunc(ay*dpm),'内容')；
     sy:=sy+5
     MoveTo(trunc(sx0*dpm),trunc(sy*dpm));
     LineTo(trunc((sX0+200)*dpm),trunc(sy*dpm));
   finally
     Free;
  End;
End;

Procedure TF_print,BitBtn2Click（Sender:Tobject）;
Var
  mymetafile:Tmetafile;
  Ifprt:Boolean;
Begin
  Ifprt:=not checkbok1.checked;
  //是false则打印预览，true则打印
  if ifprt then
    begin
     printer.BeginDoc;
     report(printer.canvas);
     //将打印机画布对象传给report过程
    end
  else
   begin
     MyMetafile: =Tmetafile.Create
     //创建图元文件
     //以打印机句柄创建图元文件画布对象（Tmetafilecanvas）,并调用report过程
     report (TmetagileCanvas.Create(MyMetafile, printer.Handle));
   end;
  //如果是打印则结束打印
  if ifprt then printer.enddoc;
   //如果是打印预览，则在image1上显示出来
  if not ifprt then image1.Canvas.StretchDraw (image1.canvas.cliprect,MyMetafile);
end;
end.

逐节点加入：
var
XDoc :TXMLDocument;
Root :IXMLNode;
Node :IXMLNode;

begin
    XDoc.Active := true;
    Root := XDoc.AddChild('Root');
    Node := Root.AddChild('Node');
    Node.Attributes['Attrib'] := 'Attrib';
end;

读取XML节点:
var
XDoc :TXMLDocument;
sXML,sName,sAttr :AnsiString;
Root :IXMLNode;
Node :IXMLNode;
begin
    XDoc.Active := false;
    XDoc.XML.Text := sXML;
    XDoc.Active := true;
    Root = XDoc.DocumentElement;
    if (Root.NodeName = 'Root')
    begin
        Node := Root.ChildNodes.Nodes[0];
       //或者Node := Root.ChildNodes['sql'];
        sName := Node.NodeName;
        sAttr := Node.GetAttribute(A_Folder);
    end
    XDoc.Active := false;
end;

问题代码如下：

procedure Tdbd.Edit1onExit(Sender: TObject);

   edit2.setFocus

end; 

估计是EDIT2的获焦点消息被EDIT1的离开焦点覆盖掉了。

后来手动给EDIT2再发一次获焦点的消息后能触发变色事件，但是却无法输入东西，需要用setFocus命令才正常。

procedure Tdbd.Edit1onExit(Sender: TObject);

  postmessage(edit2.Handle,WM_SETFOCUS,0,0);

 edit2.setFocus

end;