传奇Delphi源码---公布！
传奇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 of TBmpImage;
TDxImageArr = array 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;
functionFGetImageSurface (index: integer): TDirectDrawSurface;
procedure FSetDxDraw (fdd: TDxDraw);
procedure FreeOldBmps;
functionFGetImageBitmap (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);
functionGetImage (index: integer; var px, py: integer): TDirectDrawSurface;
functionGetCachedImage (index: integer; var px, py: integer): TDirectDrawSurface;
functionGetCachedSurface (index: integer): TDirectDrawSurface;
functionGetCachedBitmap (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: TDirectDrawSurface read FGetImageSurface;
property Bitmaps: 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', );
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 = '' then begin
raise Exception.Create ('FileName not assigned..');
exit;
end;
if (LibType <> ltLoadBmp) and (FDDraw = nil) then begin
raise Exception.Create ('DDraw not assigned..');
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 + ' BmpArr = nil');
end else begin
ImgArr := AllocMem (sizeof(TDxImage) * FImageCount);
if ImgArr = nil then
raise Exception.Create (self.Name + ' ImgArr = nil');
end;
//索引文件
idxfile := ExtractFilePath(FFileName) + ExtractFileNameOnly(FFileName) + '.WIX';
LoadPalette;
if LibType = ltLoadMemory then
LoadAllData
else begin
LoadIndex (idxfile);
end;
end else begin
MessageDlg (FFileName + ' 文件不存在.', mtWarning, , 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; 挣钱好难,物价好贵 近来物价又上涨了，真是活不下去了 Delphi源码？看不懂，传奇是用Delphi做的吗？ 阳光网驿 真是个好地方啊，我喜欢这里，大家一起努力，把这里做成全国第一啊
本文来源:阳光网驿
原文地址:http://bbs.sunwy.org/thread-57297-1-1.html 这个东西你也发，，还是管理员发的。。。心里不平衡～～ 原来传奇是用C++写的··· 晕！！！！！！这么看不懂。。。。。。。。。。
页:
[1]