unit1.pas

千年外挂通用

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    SaveDialog1: TSaveDialog;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  tmapheader = record                                    //千年地图文件头三行 48字节
    name   : array [0..15] of char;
    a1     : dword;
    width  : dword;
    height : dword;
    char   : array [0..19] of char;
  end;

  mapinfo = record                                      //千年地图文件每个点 12字节
    header : byte;
    char   : array [0..9]  of char;
    arise  : byte;
  end;

function loadmap ( name:string ):bool;
procedure paintmap ;
procedure savetext(str : string);
function chartoascii(str:PChar;strlen:Integer):string;

var
  Form1: TForm1;
  mapfilename : string;
  mapdata : array [0..1048576] of byte;
  buf : array [0..12582912] of byte;

  mapwidth : integer;
  mapheight: integer;
  maparea : integer;

  mousemovex : integer;
  mousemovey : integer;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);         //打开文件
var
  dd : bool;
begin
  mapfilename := '';
  OpenDialog1.Execute;
  if OpenDialog1.FileName = '' then
    begin
    showmessage ('文件名为空');
    exit;
    end;
  mapfilename := OpenDialog1.FileName;
  dd := loadmap (mapfilename);
  if dd = false then showmessage ('加载地图文件失败')
  else
    begin
    form1.Caption :='千年地图文件 -- ' + mapfilename;
    end;
end;

procedure TForm1.Button2Click(Sender: TObject);         //保存文件
begin
  SaveDialog1.FileName := mapfilename;
  SaveDialog1.execute;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
begin
  mousemovex := x;
  mousemovey := y;
  label2.Caption := inttostr (x) + ',' + inttostr (y);
end;

function loadmap ( name:string ):bool;
var
  mapfile : file;
  mapheader : tmapheader;
  i,size :integer;
begin
  if name <> '' then
    begin
    try
    assignfile (mapfile,name);                          //建立文件关联
    reset (mapfile,1);                                  //打开文件
    seek (mapfile,0);                                   //移动指针
    blockread (mapfile,mapheader,48);                   //读取文件头
    mapwidth := mapheader.width;
    mapheight:= mapheader.height;
    maparea := mapwidth * mapheight ;
    form1.Label1.Caption := '长度: '+ inttostr(mapwidth) +'  宽度: ' +
                            inttostr(mapheight) + '  面积: '+ inttostr(maparea);
                            
    blockread (mapfile,buf,maparea*12,size);            //读取地图信息
    if size <> maparea*12 then showmessage ('读取的内容出错');

    for i := 1 to maparea do
      begin
      mapdata[i-1] := buf [i * 12 - 1];
      end;
   { for i := 0 to size div 12 - 1 do
      begin
      savetext(chartoascii(@buf[i*12],12)+ '  第'+inttostr(i+1)+'行');
      end; }

    paintmap;                                           //画图
    
    finally
    closefile (mapfile);
    loadmap := true;
    end;
    end else
  loadmap := false;
end;

procedure paintmap ;
begin
  form1.Canvas.Pen.Style:=TPenStyle(0);
  form1.Canvas.MoveTo(0,0);
  form1.Paint;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  x,y :integer;
begin
  for y := 1 to mapheight do
    begin
    for x := 1 to mapwidth do
      begin
      case mapdata [x + y * mapheight] of
      0 : form1.Canvas.Pixels [x,y] := clwhite;         //可行走
      1 : form1.Canvas.Pixels [x,y] := clblack;
      2 : form1.Canvas.Pixels [x,y] := clblue;
      3 : form1.Canvas.Pixels [x,y] := clgreen;         //可行走.好像有点特殊
//      4 : form1.Canvas.Pixels [x,y] := clyellow;
//      5 : form1.Canvas.Pixels [x,y] := clactivecaption;
//      6 : form1.Canvas.Pixels [x,y] := clteal;
      else
      form1.Canvas.Pixels [x,y] := clred;
      end;
      end;
    end;   
end;

procedure savetext(str : string);
var
  tfile : textfile;
begin
assignfile (tfile,'D:\My Documents\xiaotutu\源代码\delphi\全新外挂\千年地图信息测试\地图信息.txt');
if fileexists('D:\My Documents\xiaotutu\源代码\delphi\全新外挂\千年地图信息测试\地图信息.txt')=false then rewrite (tfile)
else
append (tfile);
writeln (tfile,str);
closefile (tfile);
end;

function chartoascii(str:PChar;strlen:Integer):string;
var
  str2  : string;
  i     : Integer;
  p     : Integer;
  ascii : string;
begin
  setlength(ascii,2*strlen);
  ascii:='';
  for i:=0 to strlen-1 do
    begin
    p:=integer(str[i]);
    str2:=IntToHex(p,2);
    ascii:=ascii + str2;
    end;
  chartoascii:=ascii;
end;

end.