传奇Delphi源码---公布！

sunwy

  传奇Delphi源码---公布！[一]

unit Grobal2;

interface
uses
Math,windows;
Const
BUFFERSIZE =1024;
//版本号
// VERSION_NUMBER_0522 = 20010522;
VERSION_NUMBER_0522 = 20040522;
//客户端发送的命令
CM_SOFTCLOSE =0;

CM_QUERYUSERSTATE = 2;
CM_ADJUST_BONUS =60;

CM_QUERYUSERNAME = 80; //查询用户姓名
CM_QUERYBAGITEMS = 81; //查询包裹内容

CM_QUERYCHR = 100; //查询人物
CM_NEWCHR = 101; //新人物
CM_DELCHR = 102; //删除人物
CM_SELCHR = 103; //选择人物
CM_SELECTSERVER = 104; //选择服务器
///////////
//动作
CM_DROPITEM = 1000; //丢掉物品
CM_PICKUP = 1001; //拣东西
CM_OPENDOOR = 1002; //开门
CM_TAKEONITEM = 1003; //穿上/戴上/拿上 物品
CM_TAKEOFFITEM = 1004; //脱下物品
CM_EAT = 1006; //吃物品
CM_BUTCH = 1007; //
CM_MAGICKEYCHANGE = 1008; //改变魔法按键

CM_CLICKNPC = 1010; //点击NPC???
CM_MERCHANTDLGSELECT = 1011; // NPC Tag Click 选择商人功能窗口
CM_MERCHANTQUERYSELLPRICE = 1012; //查询出卖给商人的价格
CM_USERSELLITEM = 1013; //选择物品
CM_USERBUYITEM = 1014; //购买物品
CM_USERGETDETAILITEM = 1015; //????????????????????????
CM_DROPGOLD = 1016; //丢掉金币

Wil部分！

unit WIL;
//WIL文件的封装:TWmImages
//LibType一般设置为ltUseCache
interface

uses
  Windows, Classes, Graphics, SysUtils, DXDraws, DXClass, Dialogs,
  DirectX, DIB, wmUtil, HUtil32;

const
//  UseDIBSurface : Boolean = FALSE;
  UseDIBSurface : Boolean = TRUE;
  BoWilNoCache : Boolean = FALSE;
   
type
  TLibType = (ltLoadBmp, ltLoadMemory, ltLoadMunual, ltUseCache);

  TBmpImage = record
    bmp: TBitmap;
    LatestTime: integer;
  end;
  PTBmpImage = ^TBmpImage;

  TBmpImageArr = array[0..MaxListSize div 4] of TBmpImage;
  TDxImageArr = array[0..MaxListSize div 4] of TDxImage;
  PTBmpImageArr = ^TBmpImageArr;
  PTDxImageArr = ^TDxImageArr;

  TWMImages = class (TComponent)
  private
    FFileName: string;    //WIL文件名
    FImageCount: integer;  //图象总数
    FLibType: TLibType;   //图象装载方式
    FDxDraw: TDxDraw;
    FDDraw: TDirectDraw;
    FMaxMemorySize: integer;
    procedure LoadAllData;
    procedure LoadAllDataBmp;
    procedure LoadIndex (idxfile: string);
    procedure LoadDxImage (position: integer; pdximg: PTDxImage);
    procedure LoadBmpImage (position: integer; pbmpimg: PTBmpImage);
    procedure FreeOldMemorys;
    function  FGetImageSurface (index: integer): TDirectDrawSurface;
    procedure FSetDxDraw (fdd: TDxDraw);
    procedure FreeOldBmps;
    function  FGetImageBitmap (index: integer): TBitmap;
  protected
    //MemorySize: integer;
    lsDib: TDib;
    memchecktime: longword;
  public
    ImgArr: PTDxImageArr;
    BmpArr: PTBmpImageArr;
    IndexList: TList;
    //BmpList: TList;
    Stream: TFileStream;
    //MainSurfacePalette: TDirectDrawPalette;
    MainPalette: TRgbQuads;
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Initialize;
    procedure Finalize;
    procedure ClearCache;
    procedure LoadPalette;
    procedure FreeBitmap (index: integer);
    function  GetImage (index: integer; var px, py: integer): TDirectDrawSurface;
    function  GetCachedImage (index: integer; var px, py: integer): TDirectDrawSurface;
    function  GetCachedSurface (index: integer): TDirectDrawSurface;
    function  GetCachedBitmap (index: integer): TBitmap;
    procedure DrawZoom (paper: TCanvas; x, y, index: integer; zoom: Real);
    procedure DrawZoomEx (paper: TCanvas; x, y, index: integer; zoom: Real; leftzer Boolean);
    property Images[index: integer]: TDirectDrawSurface read FGetImageSurface;
    property Bitmaps[Index: Integer]: TBitmap read FGetImageBitmap;
    property DDraw: TDirectDraw read FDDraw write FDDraw;
  published
    property FileName: string read FFileName write FFileName;
    property ImageCount: integer read FImageCount;
    property DxDraw: TDxDraw read FDxDraw write FSetDxDraw;
    property LibType: TLibType read FLibType write FLibType;
    property MaxMemorySize: integer read FMaxMemorySize write FMaxMemorySize;
  end;

function TDXDrawRGBQuadsToPaletteEntries(const RGBQuads: TRGBQuads; AllowPalette256: Boolean): TPaletteEntries;

procedure Register;


implementation

//uses
//  ClMain;  //唱吝俊 瘤匡 巴.

procedure Register;
begin
  RegisterComponents('Zura', [TWmImages]);
end;

constructor TWMImages.Create (AOwner: TComponent);
begin
  inherited Create (AOwner);
  FFileName := '';
  FLibType := ltLoadBmp;
  FImageCount := 0;
  //MemorySize := 0;
  FMaxMemorySize := 1024*1000; //1M

  FDDraw := nil;
  FDxDraw := nil;
  Stream := nil;
  ImgArr := nil;
  BmpArr := nil;
  IndexList := TList.Create;
  lsDib := TDib.Create;
  lsDib.BitCount := 8;
  //BmpList := TList.Create;  //Bmp侩栏肺 荤侩且 锭巩 荤侩

  memchecktime := GetTickCount;
end;

destructor TWMImages.Destroy;
begin
  IndexList.Free;
//  BmpList.Free;
  if Stream <> nil then Stream.Free;
  lsDib.Free;
  inherited Destroy;
end;

procedure TWMImages.Initialize;
var
  idxfile: string;
  header: TWMImageHeader;
begin
  if not (csDesigning in ComponentState) then begin
    if FFileName = &#39;&#39; then begin
      raise Exception.Create (&#39;FileName not assigned..&#39;);
      exit;
    end;
    if (LibType <> ltLoadBmp) and (FDDraw = nil) then begin
      raise Exception.Create (&#39;DDraw not assigned..&#39;);
      exit;
    end;
    if FileExists (FFileName) then begin
      if Stream = nil then
        Stream := TFileStream.Create (FFileName, fmOpenRead or fmShareDenyNone);
      Stream.Read (header, sizeof(TWMImageHeader));
      FImageCount := header.ImageCount;

      if LibType = ltLoadBmp then begin
        BmpArr := AllocMem (sizeof(TBmpImage) * FImageCount);
        if BmpArr = nil then
          raise Exception.Create (self.Name + &#39; BmpArr = nil&#39;);
      end else begin
        ImgArr := AllocMem (sizeof(TDxImage) * FImageCount);
        if ImgArr = nil then

          raise Exception.Create (self.Name + &#39; ImgArr = nil&#39;);
      end;
      //索引文件
      idxfile := ExtractFilePath(FFileName) + ExtractFileNameOnly(FFileName) + &#39;.WIX&#39;;
      LoadPalette;
      if LibType = ltLoadMemory then
        LoadAllData
      else begin
        LoadIndex (idxfile);
      end;
    end else begin
      MessageDlg (FFileName + &#39; 文件不存在.&#39;, mtWarning, [mbOk], 0);
    end;
  end;
end;

procedure TWMImages.Finalize;
var
  i: integer;
begin
//释放装载的所有图片
  for i:=0 to FImageCount-1 do begin
    if ImgArr.Surface <> nil then begin
      ImgArr.Surface.Free;
      ImgArr.Surface := nil;
    end;
  end;
  if Stream <> nil then begin
    Stream.Free;
    Stream := nil;
  end;
end;
//这个函数在DXDraws里有
function TDXDrawRGBQuadsToPaletteEntries(const RGBQuads: TRGBQuads;
  AllowPalette256: Boolean): TPaletteEntries;
var
  Entries: TPaletteEntries;
  dc: THandle;
  i: Integer;
begin
  Result := RGBQuadsToPaletteEntries(RGBQuads);

  if not AllowPalette256 then
  begin
   dc := GetDC(0);
   GetSystemPaletteEntries(dc, 0, 256, Entries);
   ReleaseDC(0, dc);

   for i:=0 to 9 do
    Result := Entries;

   for i:=256-10 to 255 do
    Result := Entries;
  end;

  for i:=0 to 255 do
   Result.peFlags := D3DPAL_READONLY;
end;

//装载图片到内存，需要大量内存！
procedure TWMImages.LoadAllData;
var
  i: integer;
  imgi: TWMImageInfo;
  dib: TDIB;
  dximg: TDxImage;
begin
  dib := TDIB.Create;
  for i:=0 to FImageCount-1 do begin
    Stream.Read (imgi, sizeof(TWMImageInfo) - 4);

    dib.Width := imgi.Width;
    dib.Height := imgi.Height;
    dib.ColorTable := MainPalette;
    dib.UpdatePalette;
    Stream.Read (dib.PBits^, imgi.Width * imgi.Height);

    dximg.px := imgi.px;
    dximg.py := imgi.py;
    dximg.surface := TDirectDrawSurface.Create (FDDraw);
    dximg.surface.SystemMemory := TRUE;
    dximg.surface.SetSize (imgi.Width, imgi.Height);
    dximg.surface.Canvas.Draw (0, 0, dib);
    dximg.surface.Canvas.Release;
    dib.Clear; //FreeImage;

    dximg.surface.TransparentColor := 0;
    ImgArr := dximg;
  end;
  dib.Free;
end;
//从WIL文件中装载调色板
procedure TWMImages.LoadPalette;
var
  Entries: TPaletteEntries;
begin
  Stream.Seek (sizeof(TWMImageHeader), 0);
  Stream.Read (MainPalette, sizeof(TRgbQuad) * 256); //迫贰飘

  //Entries := TDXDrawRGBQuadsToPaletteEntries (MainPalette, TRUE);
  //MainSurfacePalette := TDirectDrawPalette.Create (FDDraw);
  ////MainSurfacePalette.SetEntries(0, 256, Entries);
  //MainSurfacePalette.CreatePalette(DDPCAPS_8BIT, Entries);
end;

//Cache从WIL文件中装载所有BMP到内存.
procedure TWMImages.LoadAllDataBmp;
var
  i: integer;
  pbuf: PByte;
  imgi: TWMImageInfo;
  bmp: TBitmap;
begin
{  GetMem (pbuf, 1024*768);  //傍侩 滚欺积己, 漂喊茄 捞蜡啊 乐澜
  Stream.Seek (sizeof(TWMImageHeader), 0);
  Stream.Read (MainPalette, sizeof(TRgbQuad) * 256); //迫贰飘
  for i:=0 to ImageCount-1 do begin
    Stream.Read (imgi, sizeof(TWMImageInfo)-4);
    Stream.Read (pbuf^, imgi.Width * imgi.Height);
    bmp := MakeBmp (imgi.Width, imgi.Height, pbuf, MainPalette);
    BmpList.Add (bmp);    //BMP府胶飘甫 悼矫俊 包府.. (弊府靛俊 弊府扁侩)
  end;
  FreeMem (pbuf); }
end;

szzjfsl

挣钱好难,物价好贵

xuanwei.net

近来物价又上涨了，真是活不下去了

xuanwei.net

Delphi源码？看不懂，传奇是用Delphi做的吗？

luojunrong

阳光网驿 真是个好地方啊，我喜欢这里，大家一起努力，把这里做成全国第一啊
本文来源:阳光网驿
原文地址:http://bbs.sunwy.org/thread-57297-1-1.html

linghao234

这个东西你也发，，还是管理员发的。。。心里不平衡～～

scsxj

原来传奇是用C++写的···

ycs101

晕！！！！！！这么看不懂。。。。。。。。。。