frmedit.pas

尚未完成的传奇3资源编辑器,需要就下吧

unit FrmEdit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ComCtrls, Grids, WilImage,tList32, WIL;

const
  ImgWidth  = 100;
  ImgHeight = 110;
  ImgSpace  = 6;
  ImgHint   = 50;


type
  TFrmEdt = class(TForm)
    DG: TDrawGrid;
    M2: TWMImages;
    PopupMenu: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    ODBMP: TOpenDialog;
    SDBMP: TSaveDialog;
    ODFLY: TOpenDialog;
    SDFLY: TSaveDialog;
    StatusBar: TStatusBar;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    FLY1: TMenuItem;
    N6: TMenuItem;
    FLY2: TMenuItem;
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure DGDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
      State: TGridDrawState);
    procedure DGSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
  private
    { Private declarations }
    m_WIL:TWilImageData;
    m_Img:integer;
    m_Array:array of byte;
    m_ImgType:byte;

    m_Arow,m_ACol:integer;

    function  GetImgHint(nIndex:integer):string;
    procedure GetScaleSize(var DstWidth,DstHeigh:integer;SrcWidth,SrcHeigh:integer);
  public
    { Public declarations }
    procedure DrawAllImagesToDGrid;
    procedure DrawImgeToCell(nIndex:integer;ARow,ACol:integer);
    procedure LoadImage(ImgType:byte;szFileName:string;nOpenMode:OpenMode = NrmMode;bComp:boolean = false);
  end;

implementation

{$R *.dfm}

procedure TFrmEdt.GetScaleSize(var DstWidth,DstHeigh:integer;SrcWidth,SrcHeigh:integer);
var DstLen:integer;
    Y:integer;
begin
  Y:= trunc((DstWidth/SrcWidth) * SrcHeigh);
  if Y<=DstHeigh then begin
    DstHeigh:=Y;
  end else begin
    DstWidth:=trunc((DstHeigh/SrcHeigh) * SrcWidth);
  end;
end;

procedure TFrmEdt.LoadImage(ImgType:byte;szFileName:string;nOpenMode:OpenMode;bComp:boolean);
begin
  m_ImgType:=ImgType;
  case m_ImgType of
    0:begin
        m_WIL.Load(szFileName,nOpenMode,bComp);
        m_WIL.Resume; //使用线程 进行重建
        StatusBar.Panels[1].Text:='资源正在重建,暂时不接受编辑,请稍候...';
        m_WIL.StatusBar:=StatusBar;
      end;
    1:begin
        M2.FileName:=szFileName;
        M2.Initialize;
      end;
  end;
  DrawAllImagesToDGrid;
end;

function  TFrmEdt.GetImgHint(nIndex:integer):string;
var buf:array[0..255] of char;
begin
  case m_ImgType of
  0:
    try
    if ((nIndex<0) or (nIndex>=m_WIL.m_stWixImgaeInfo.nIndexCount)) then begin
      ReSult:='';
      Exit;
    end;
    if m_WIL.SetIndex(nIndex) then begin
      ReSult:='ID:'+IntToStr(nIndex) + #13+
            IntToStr(m_WIL.m_lpstCurrWilImageInfo.shWidth)+'×'+IntToStr(m_WIL.m_lpstCurrWilImageInfo.shHeight) + #13 +
            IntToStr(integer(m_WIL.m_lpstCurrWilImageInfo.shPX))+'/'+IntToStr(integer(m_WIL.m_lpstCurrWilImageInfo.shPY)) +','+IntToStr(integer(m_WIL.m_lpstCurrWilImageInfo.shShadowPX))+'/'+IntToStr(integer(m_WIL.m_lpstCurrWilImageInfo.shShadowPY));
    end else  ReSult:='ID:'+ IntToStr(nIndex) + #13 + '空';
    except
    end;
  1:begin
    if ((nIndex<0) or (nIndex>=M2.ImageCount)) then begin
      ReSult:='';
      Exit;
    end;

    if M2.Bitmaps[nIndex]<>nil then begin
        ReSult:='ID:'+IntToStr(nIndex) + #13+
             IntToStr(M2.Bitmaps[nIndex].Width)+'×'+IntToStr(M2.Bitmaps[nIndex].Height);
    end else ReSult:='ID:'+ IntToStr(nIndex) + #13 + '空';
    end;
  end;
end;

procedure TFrmEdt.DrawImgeToCell(nIndex:integer;ARow,ACol:integer);
var rc,brc:TRECT;
    sHint:string;
    BMP:TBitMap;
    X,Y:integer;
begin
  rc:=DG.CellRect(ACol,ARow);
  brc:=rc;
  
  rc.Left  :=  rc.Left +   (ImgSpace div 2) ;
  rc.Top   :=  rc.Top  +   (ImgSpace div 2) ;
  rc.Right :=  rc.Right -  (ImgSpace div 2);
  rc.Bottom:=  rc.Bottom - ImgHint  ;

  BMP:=nil;
  case m_ImgType of
    0:BMP:=m_WIL.LoadBMP(ARow * DG.ColCount + ACol);
    1:BMP:=M2.Bitmaps[ARow * DG.ColCount + ACol];
  end;

  if BMP<>nil then begin
    try
      if not ((BMP.Width<=ImgWidth) and (BMP.Height<=ImgHeight)) then begin
        X:=ImgWidth;Y:=ImgHeight;
        GetScaleSize(X,Y,BMP.Width,BMP.Height);
      end else begin
        X:=BMP.Width;
        Y:=BMP.Height;
      end;
      
      brc.Top:= brc.Top   + ImgSpace;
      brc.Left:= brc.Left + ImgSpace;
      
      brc.Right:=brc.Left + X;
      brc.Bottom:=brc.Top + Y;
      with DG.Canvas do begin
        StretchDraw(brc, TGraphic(BMP));
      end;
    finally
      if m_ImgType=0 then BMP.Free;
    end;
  end;

  sHint:=GetImgHint(ARow * DG.ColCount + ACol);
  rc.Left:=rc.Left + 2;
  rc.Top:=rc.Top + ImgHeight + 3;
  rc.Bottom:= rc.Top + ImgHint;
  DG.Canvas.Pen.Color:=clwhite;
  DrawText(DG.Canvas.Handle, pchar(sHint), -1,rc, DT_LEFT + DT_WORDBREAK);
end;

procedure TFrmEdt.DrawAllImagesToDGrid;
var i,j,nRow,nCol:integer;
    BMP:TBitMap;
begin
  m_Img:=0;
  case m_ImgType of
    0:if m_WIL.m_stWixImgaeInfo.nIndexCount > 0 then m_Img:=m_WIL.m_stWixImgaeInfo.nIndexCount;
    1:m_Img:=M2.ImageCount;
  end;

  if m_Img > 0 then begin
    FormResize(self);
    DG.Update;
    DG.Refresh;
  end;
end;


procedure TFrmEdt.FormResize(Sender: TObject);
var TempCol,TempRow:integer;
begin
  (Sender as TFrmEdt).Left:=2;
  (Sender as TFrmEdt).Top:=2;
  if (Sender as TFrmEdt).Height>=(Sender as TFrmEdt).Parent.ClientHeight - 25 then (Sender as TFrmEdt).Height:= (Sender as TFrmEdt).Parent.ClientHeight - 25;
  if (Sender as TFrmEdt).Width>=(Sender as TFrmEdt).Parent.ClientWidth - 5 then (Sender as TFrmEdt).Width:= (Sender as TFrmEdt).Parent.ClientWidth - 5;

  TempCol:=DG.ClientWidth div (ImgWidth + 2* ImgSpace);
  TempRow:=(m_Img div  TempCol) + 1;
  DG.ColCount:=TempCol;
  DG.RowCount:=TempRow;
  DG.DefaultColWidth:=ImgWidth + 2* ImgSpace;
  DG.DefaultRowHeight:=ImgHeight + ImgSpace + ImgHint;
  DG.Canvas.Brush.Color:=cl3DDkShadow;
  DG.Canvas.FillRect(DG.ClientRect);

  m_Arow:=0;m_Acol:=0;
end;

procedure TFrmEdt.FormCreate(Sender: TObject);
begin
  m_WIL:=TWilImageData.Create;
  m_WIL.Clear;
end;

procedure TFrmEdt.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  m_WIL.Clear;
  m_WIL.Free;

end;

procedure TFrmEdt.DGDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  DrawImgeToCell(0,ARow,ACol);
end;

procedure TFrmEdt.DGSelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
begin
  m_ARow:=ARow;
  m_ACol:=ACol;
end;

procedure TFrmEdt.N1Click(Sender: TObject);
begin
  if ODBMP.Execute then begin
    m_WIL.ImportFromFile(m_ARow * DG.ColCount + m_ACol,ODBMP.FileName);
  end;
end;

procedure TFrmEdt.N2Click(Sender: TObject);
var DstBmp:TBitMap;
begin
  if SDBMP.Execute then begin
    case m_ImgType of
      1:begin
          M2.Bitmaps[m_ARow * DG.ColCount + m_ACol].SaveToFile(SDBMP.FileName);
        end;
      0:begin
          DstBmp:=m_WIL.LoadBMP(m_ARow * DG.ColCount + m_ACol);
          DstBmp.SaveToFile(SDBMP.FileName);
          DstBmp.FreeImage;
          DstBmp.Free;
        end;
    end;
  end;
end;

end.