unit1.pas

千年2的脱机源代码

unit unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, MapInfo, ExtCtrls;

type
  TForm1 = class(TForm)
    ButtonOpen: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Label1: TLabel;
    Labelx: TLabel;
    Labely: TLabel;
    ButtonSaveBMP: TButton;
    ButtonSaveFile: TButton;
    SaveDialog2: TSaveDialog;
    MapImage: TImage;
    procedure ButtonOpenClick(Sender: TObject);
    procedure ButtonSaveBMPClick(Sender: TObject);
    procedure ButtonSaveFileClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure MapImageMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
    procedure MapImageMouseDown(Sender: TObject; Button: TMouseButton;
                                Shift: TShiftState; X, Y: Integer);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

procedure DrawMap();

var
    Form1: TForm1;
    MapFileName : String;
    i : integer = 0;
    Start : TPoint;
    Goal : TPoint;

implementation

{$R *.dfm}

uses path;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    if MapInfor <> nil then
    begin
        MapInfor.free;
    end;
end;

procedure TForm1.ButtonOpenClick(Sender: TObject);         //open the map
begin
    if MapInfor <> nil then
    begin
        MapInfor.Free;
    end;
    MapInfor := TMapInfo.Create;
    
    MapFileName := '';
    OpenDialog1.Execute;

    if OpenDialog1.FileName = '' then
    begin
        MapInfor.Free;
        MapInfor := nil;
        Exit;
    end;
        
    MapFilename := OpenDialog1.FileName;
    if MapInfor.LoadMap(MapFilename) = False then ShowMessage ('加载地图文件失败!!!!'); // load map information

        Form1.Caption  := '千年地图文件 -- ' + MapFileName;
        Label1.Caption := IntToStr(MapInfor.GetMapWidth) + '× '+IntToStr(MapInfor.GetMapHeight);
        DrawMap;                                         //draw the map
        ButtonSaveFile.Enabled := True;
        ButtonSaveBMP.Enabled := True;
end;

procedure TForm1.ButtonSaveBMPClick(Sender: TObject);         //save in the bmp
begin
    SaveDialog1.FileName := MapFileName;
    SaveDialog1.Execute;
    if SaveDialog1.FileName = '' then Exit;

    MapInfor.SaveToBmp(SaveDialog1.FileName);
end;

procedure TForm1.ButtonSaveFileClick(Sender: TObject);
begin
    SaveDialog2.FileName := MapFileName;
    SaveDialog2.Execute;
    if SaveDialog2.FileName = '' then Exit;
    MapInfor.SaveToFile(SaveDialog2.FileName);
end;

procedure TForm1.MapImageMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
begin
    Labelx.Caption := IntToStr(x);
    Labely.Caption := IntToStr(y);
end;

procedure TForm1.MapImageMouseDown(Sender: TObject; Button: TMouseButton;
                                   Shift: TShiftState; X, Y: Integer);
var
    temp : TPoint;
begin
    if MapInfor = nil then AStart := TAStart.Create;
 {   if MapInfor <> nil then
    begin
        AStart := TAStart.Create;
    end
    else
        exit;   }
    if (X < 0) or ( X > MapInfor.GetMapWidth -1) or (Y < 0) or (Y > MapInfor.GetMapHeight-1) then
        begin
        ShowMessage ('点超出范围');
        exit;
        end;  

    if (Start.X = 0) and (Start.Y = 0) then
        begin
        Start.X := X;
        Start.Y := Y;
        exit;
        end
    else
    begin
        if (Start.X = X ) and (Start.Y = Y) then
        begin
            ShowMessage ('起点和终点相同');
            Start.X := 0;
            Start.Y := 0;
            Goal.X := 0;
            Goal.Y := 0;
            exit;
        end;
        Goal.X := X;
        Goal.Y := Y;

    if AStart.FindRoad(Start, Goal) = false then
    begin
        ShowMessage('寻路失败');
        Start.X := 0;
        Start.Y := 0;
        Goal.X := 0;
        Goal.Y := 0;
        exit;
    end;

    temp.x := AStart.NodeData[Goal.X, Goal.Y].father.x;
    temp.y := AStart.NodeData[Goal.X, Goal.Y].father.y;
    if (temp.X = 0) and (temp.Y = 0) then exit;
    while (temp.X <> Start.X) and (temp.y <> Start.Y) do
    begin
        form1.MapImage.Canvas.Pixels[temp.x,temp.y] := clred;
        temp.x := AStart.NodeData[temp.X, temp.Y].father.x;
        temp.y := AStart.NodeData[temp.X, temp.Y].father.y;
    end;     

    Start.X := 0;
    Start.Y := 0;
    Goal.X := 0;
    Goal.Y := 0;
    end;
end;

procedure DrawMap();                          //画出地图
var
  x,y :integer;
begin
    form1.MapImage.Picture := nil;        //清除原来图上的内容

    for x := 0 to MapInfor.GetMapWidth -1 do
    begin
        for y := 0 to MapInfor.GetMapHeight -1 do
        begin
            case MapInfor.MapData [x,y] of 
              0 : form1.MapImage.Canvas.Pixels[y,x] := clwhite;         //空点
              1 : form1.MapImage.Canvas.Pixels[y,x] := clblack;         //障碍
              2 : form1.MapImage.Canvas.Pixels[y,x] := clblue;
              3 : form1.MapImage.Canvas.Pixels[y,x] := clgreen;         //障碍.好像有点特殊
              4 : form1.MapImage.Canvas.Pixels[y,x] := clyellow;
              5 : form1.MapImage.Canvas.Pixels[y,x] := clactivecaption;
              6 : form1.MapImage.Canvas.Pixels[y,x] := clteal;
            else
                form1.MapImage.Canvas.Pixels[y,x] := clred;
            end;
        end;
    end;
end;

end.