组装9 WIL初始化的简单认识

 

 

 

4年12月4日，放了2个月忘的差不多了 继续

  

改编的WIL 不作为一个控件 拖拽到 编辑页面上

如果要使用，那么要在 主FORM 的CREATE 事件中， 对WIL对象 进行 CREATE

然后 在DX控件初始化事件中 对必要的 WIL属性进行设置 ，然后初始化

 

也可以在其它事件中对WIL对象创建 ，但一定要在 DX 建立初始化后 才能对 WIL对象初始化，原因是WIL对象 需要设置 DX 表面 属性 才能初始化。

 

好的，我现在就来做一个。

 

2024年12月27日15:49:33

 

Ji继续

例子目录

E:\StudyMir\wilb simple show

 

需要单元：WILIB.pas 这个是自己改写的读取WIL的单元，去掉了注册为控件的功能。

需要引用，

 

DXD7作为底层控件需要安装的控件面板上，它被WILIB.pas 和 主程序引用，

 

在主程序的对象构建中，

  需要对WIL 变量 进行构建。

在主程序的对象析构中，

  需要手动对 WIL 变量 进行析构。

 

 

DXDRAW作为一个控件在主程序窗口上，

   在DXDRAW的DXDraw1Initialize 函数中

   要对WIL 变量 的关键属性DDraw，FileName进行赋值

   再对 WIL 变量进行初始化Initialize。

 

 

  实际上所有的WIL变量都在在DXDRAW的DXDraw1Initialize 函数中

  中进行关键属性赋值，初始化，

 

而不可以在主程序的构建中进行赋值，初始化，

因为在这个时候DXDRAW还没有构建，虽然它是由主程序自动构建，但这个时候它确实没有构建，所以WIL 变量 的需要的关键属性DDraw会指向空。

 

DXDraw会有一个Click事件，

在它里面进行绘图的编写。

由WIL对象读出对应文件的图形数据传递个一个SURFACE的变量

用DXDRAW的函数DXDraw1.Surface.Draw绘画的到 的DXDRAW的表面。

Flip 显示到主表面， 成功显示。

 

 

unit showWIL;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DXDraws ,WILIB, ExtCtrls;

type
  TForm1 = class(TForm)
    DXDraw1: TDXDraw;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure DXDraw1Initialize(Sender: TObject);

    procedure DXDraw1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  g_mainWil: TWILImages;
  g_cacheSurface: TDirectDrawSurface;
  bmpIndex: Integer;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  bmpIndex := -1;
  g_mainWil := TWILImages.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  g_mainWil.Destroy;
  g_cacheSurface.Free;
end;

procedure TForm1.DXDraw1Initialize(Sender: TObject);
begin
  g_mainWil.DDraw := DXDraw1.DDraw;
  g_mainWil.FileName := 'E:\mirClient\Mir1.76\Data\Prguse.wil';
  g_mainWil.Initialize;
end;




procedure TForm1.DXDraw1Click(Sender: TObject);
begin
   Inc(bmpIndex);
   if bmpIndex >= g_mainWil.ImageCount then
     bmpIndex := 0;
   g_cacheSurface := g_mainWil.GetImage(bmpIndex);

   DXDraw1.Surface.Fill(clWhite);
  if g_cacheSurface <> nil then
    DXDraw1.Surface.Draw(0,0,g_cacheSurface.ClientRect,g_cacheSurface,True);
  DXDraw1.Flip;
end;

end.

 

 

 

改写的WIL 单元

 

unit WILIB;
{ 1，去掉属性FDxDraw，只需要属性FDDraw: TDirectDraw，
     其实就是 DxDraw.TDirectDraw
  2, 用动态数组m_Index，m_DXImgArr
  3, 只提供surface,其余都删掉了。 但是提供TDIB 好像更直接。
  4, 去掉wmutil in 'wmUtil.pas' 这个主要是关于WIL,WIX的记录格式定义，已经集合到
     本文件
}

interface

uses
  Windows, Classes, Graphics, SysUtils, DXDraws, DXClass, Dialogs,
  DirectX, DIB;
type
  TWMImageHeader = record
    Title: string[40]; //'ILIB v1.0-WEMADE Entertainment inc.'
    ImageCount: integer;
    ColorCount: integer;
    PaletteSize: integer;
  end;
  PTWMImageHeader = ^TWMImageHeader;

  TWMImageInfo = record
    nWidth: SmallInt;
    nHeight: SmallInt;
    px: smallint;
    py: smallint;
    //  bits: PByte;  //这个在写WIL文件才有实际作用，读WIL可以去掉。
  end;
  PTWMImageInfo = ^TWMImageInfo;

  TWMIndexHeader = record
    Title: string[40]; //'INDX v1.0-WEMADE Entertainment inc.'
    IndexCount: integer;
  end;
  PTWMIndexHeader = ^TWMIndexHeader;

  TWMIndexInfo = record
    Position: integer;
  end;
  PTWMIndexInfo = ^TWMIndexInfo;

  //定义成记录，有偏移量，时间，的DX表面？
  TDXImage = record
    nPx: SmallInt;
    nPy: SmallInt;
    Surface: TDirectDrawSurface;
    dwLatestTime: LongWord;
  end;
  pTDxImage = ^TDXImage;

  TDxImageArr = array of TDxImage;

  TWILImages = class
  private
    FFileName: string;
    FImageCount: integer;
    //  FDxDraw: TDxDraw;
    FDDraw: TDirectDraw;
    //  FMaxMemorySize: integer;
    FAppr: Word;
    procedure LoadIndex(idxfile: string);
    procedure LoadDxImage(position: integer; pdximg: pTDxImage);
    procedure FreeOldMemorys;
    //   procedure FSetDxDraw(fdd: TDxDraw);
  protected
    lsDib: TDib;
    m_dwMemChecktTick: LongWord;

  public
    m_Index: array of Integer;
    m_DxImgArr: TDxImageArr;

    m_FileStream: TFileStream;
    m_WilInfo: TWMImageInfo;
    m_WilHeader: TWMImageHeader;
    m_WixInfo: TWMIndexInfo;
    m_WixHeader: TWMIndexHeader;
    MainPalette: TRgbQuads;
    constructor Create;
    destructor Destroy;

    procedure Initialize;
    procedure Finalize;
    procedure ClearCache;
    procedure LoadPalette;

    function GetCachedImage(index: integer; var px, py: integer):
      TDirectDrawSurface;
    function GetImage(index: integer): TDirectDrawSurface;

    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 MaxMemorySize: integer read FMaxMemorySize write FMaxMemorySize;
    property Appr: Word read FAppr write FAppr;

  end;
  
function  ExtractFileNameOnly (const fname: string): string;

implementation

function  ExtractFileNameOnly (const fname: string): string;
var
   extpos: integer;
   ext, fn: string;
begin
   ext := ExtractFileExt (fname);
   fn := ExtractFileName (fname);
   if ext <> '' then begin
      extpos := pos (ext, fn);
      Result := Copy (fn, 1, extpos-1);
   end else
      Result := fn;
end;

constructor TWILImages.Create;
begin

  FFileName := '';
  FImageCount := 0;
  // FMaxMemorySize := 1024 * 1000;
  FDDraw := nil;
  // FDxDraw := nil;
  m_FileStream := nil;
  m_DxImgArr := nil;

  lsDib := TDib.Create;
  lsDib.BitCount := 8;
  m_dwMemChecktTick := GetTickCount;

end;

destructor TWILImages.Destroy;
begin

  if m_FileStream <> nil then
    m_FileStream.Free;
  lsDib.Free;
  inherited Destroy;
end;

procedure TWILImages.Initialize;
var
  Idxfile: string;
  Header: TWMImageHeader;
begin

  if FFileName = '' then
  begin
    raise Exception.Create('FileName not assigned..');
    exit;
  end;

  if FDDraw = nil then
  begin
    raise Exception.Create('DDraw not assigned..');
    exit;
  end;

  if FileExists(FFileName) then
  begin
    if m_FileStream = nil then
      m_FileStream := TFileStream.Create(FFileName, fmOpenRead or
        fmShareDenyNone);
    m_FileStream.Read(Header, SizeOf(TWMImageHeader)); //读取文件头

    m_WilHeader := Header;

    FImageCount := Header.ImageCount; //图片数量

    SetLength(m_DxImgArr, FImageCount);
    if m_DxImgArr = nil then
      raise Exception.Create(FFileName + ' ImgArr = nil');

    idxfile := ExtractFilePath(FFileName) + ExtractFileNameOnly(FFileName) +
      '.WIX';

    LoadPalette;
    LoadIndex(idxfile);
  end
  else
  begin
    //MessageDlg (FFileName + ' Cannot find file.', mtWarning, [mbOk], 0);
  end;

end;

procedure TWILImages.Finalize;
var
  i: integer;
begin
  if m_DxImgArr <> nil then
    for i := 0 to FImageCount - 1 do
    begin
      if m_DxImgArr[i].Surface <> nil then
      begin
        m_DxImgArr[i].Surface.Free;
        m_DxImgArr[i].Surface := nil;
      end;
    end;
  m_DxImgArr := nil;

  if m_FileStream <> nil then
  begin
    m_FileStream.Free;
    m_FileStream := nil;
  end;
end;

procedure TWILImages.LoadPalette;
var
  Entries: TPaletteEntries;
begin
  m_FileStream.Seek(sizeof(TWMImageHeader), 0);
  //调色板，是个数组，所以数组名就是表示的指针
  m_FileStream.Read(MainPalette, sizeof(TRgbQuad) * 256);

end;

procedure TWILImages.LoadIndex(idxfile: string);
var
  fhandle, i, value: integer;
  header: TWMIndexHeader;
  //pidx: PTWMIndexInfo;
  //记号一下，可以测试下索引文件到底有没有记录大小

begin
  m_Index := nil;
  if FileExists(idxfile) then
  begin
    fhandle := FileOpen(idxfile, fmOpenRead or fmShareDenyNone);
    if fhandle > 0 then
    begin
      FileRead(fhandle, header, sizeof(TWMIndexHeader));
      SetLength(m_Index, header.IndexCount);
      m_WixHeader := header;

      //这里和WIX的信息记录对不上，应该是只存储了索引，没有存储大小。
      //所以这里是4字节。

      FileRead(fhandle, m_Index[0], 4 * header.IndexCount);

      FileClose(fhandle);
    end;
  end;
end;

//属性DxDraw 的写操作
{
procedure TWILImages.FSetDxDraw(fdd: TDxDraw);
begin
  FDxDraw := fdd;
end;
}

procedure TWILImages.LoadDxImage(position: integer; pdximg: pTDxImage);
var
  imginfo: TWMImageInfo;
  DBits: PByte;
begin
  m_FileStream.Seek(position, 0);

  m_FileStream.Read(imginfo, SizeOf(TWMImageInfo));

  //从文件流中读取数据到DIB， 再画到表面的画布上

  try
    lsDib.Clear;
    lsDib.Width := imginfo.nWidth;
    lsDib.Height := imginfo.nHeight;
  except
  end;

  lsDib.ColorTable := MainPalette;
  lsDib.UpdatePalette;
  DBits := lsDib.PBits;
  m_FileStream.Read(DBits^, imginfo.nWidth * imgInfo.nHeight);

  pdximg.nPx := imginfo.px;
  pdximg.nPy := imginfo.py;
  pdximg.surface := TDirectDrawSurface.Create(FDDraw);
  pdximg.surface.SystemMemory := TRUE;
  pdximg.surface.SetSize(imginfo.nWidth, imginfo.nHeight);
  pdximg.surface.LoadFromDIB(lsDib);

  // pdximg.surface.Canvas.Draw(0, 0, lsDib);
  // pdximg.surface.Canvas.Release;
  pdximg.surface.TransparentColor := 0;
end;

//这个释放旧内存只和时间有关，循环查找一遍当图片在5分钟没有被读取过就会被释放掉。
//和内存限制没有关系了。
//设定好时间可以限制在一定的内存。

procedure TWILImages.FreeOldMemorys;
var
  i: integer;
begin
  for i := 0 to ImageCount - 1 do
  begin
    if m_DxImgArr[i].Surface <> nil then
    begin //也是是时间判断？ 5分钟
      if GetTickCount - m_DxImgArr[i].dwLatestTime > 5 * 60 * 1000 then
      begin
        m_DxImgArr[i].Surface.Free;
        m_DxImgArr[i].Surface := nil;
      end;
    end;
  end;
end;

procedure TWILImages.ClearCache;
var
  i: integer;
begin
  for i := 0 to ImageCount - 1 do
  begin
    if m_DxImgArr[i].Surface <> nil then
    begin
      m_DxImgArr[i].Surface.Free;
      m_DxImgArr[i].Surface := nil;
    end;
  end;
end;

//这个在其它单元被大量的调用，它返回了图片表面，还有坐标偏移量
//这个好像是跳过的属性，直接的对m_DxImgArr操作？
//
//调用释放旧内存方法
//调用装载图片方法,赋值坐标偏移量
//赋值图片装载的时间

function TWILImages.GetImage(index: integer): TDirectDrawSurface;

begin
  Result := nil;

  try
    if (index < 0) or (index >= ImageCount) then
      exit;
    //10秒钟清理一次？
    if GetTickCount - m_dwMemChecktTick > 10 * 1000 then
    begin
      m_dwMemChecktTick := GetTickCount;
      //if MemorySize > FMaxMemorySize then begin
      FreeOldMemorys;
      //end;
    end;

    if m_DxImgArr[index].Surface = nil then
    begin
      if index <= High(m_Index) then
      begin
        LoadDxImage(m_Index[index], @m_DxImgArr[index]);
        m_DxImgArr[index].dwLatestTime := GetTickCount;

        //---------写图片编号-----------
        m_DxImgArr[index].Surface.Canvas.Brush.Style := bsClear;
        m_DxImgArr[index].Surface.Canvas.Font.Color := clRed;
        m_DxImgArr[index].Surface.Canvas.Font.Size := 6;
        m_DxImgArr[index].Surface.Canvas.TextOut(0, 0, IntToStr(index));
        m_DxImgArr[index].Surface.Canvas.Release;

        Result := m_DxImgArr[index].Surface;
      end;
    end
    else
    begin
      m_DxImgArr[index].dwLatestTime := GetTickCount;
      
      Result := m_DxImgArr[index].Surface;
    end;
  except
    //DebugOutStr ('GetCachedImage 3 Index: ' + IntToStr(index) + ' Error Code: ' + IntToStr(nErrCode));
  end;
end;

function TWILImages.GetCachedImage(index: integer; var px, py: integer):
  TDirectDrawSurface;

begin
  Result := nil;

  try
    if (index < 0) or (index >= ImageCount) then
      exit;
    //10秒钟清理一次？
    if GetTickCount - m_dwMemChecktTick > 10 * 1000 then
    begin
      m_dwMemChecktTick := GetTickCount;
      //if MemorySize > FMaxMemorySize then begin
      FreeOldMemorys;
      //end;
    end;

    if m_DxImgArr[index].Surface = nil then
    begin
      if index <= High(m_Index) then
      begin
        LoadDxImage(m_Index[index], @m_DxImgArr[index]);
        m_DxImgArr[index].dwLatestTime := GetTickCount;
        px := m_DxImgArr[index].nPx;
        py := m_DxImgArr[index].nPy;
        //---------写图片编号-----------
        m_DxImgArr[index].Surface.Canvas.Brush.Style := bsClear;
        m_DxImgArr[index].Surface.Canvas.Font.Color := clRed;
        m_DxImgArr[index].Surface.Canvas.Font.Size := 6;
        m_DxImgArr[index].Surface.Canvas.TextOut(0, 0, IntToStr(index));
        m_DxImgArr[index].Surface.Canvas.Release;

        Result := m_DxImgArr[index].Surface;

      end;
    end
    else
    begin
      m_DxImgArr[index].dwLatestTime := GetTickCount;
      px := m_DxImgArr[index].nPx;
      py := m_DxImgArr[index].nPy;
      Result := m_DxImgArr[index].Surface;
    end;
  except
    //DebugOutStr ('GetCachedImage 3 Index: ' + IntToStr(index) + ' Error Code: ' + IntToStr(nErrCode));
  end;
end;
end.