formherodata.pas

著名的J2ME动作编辑器.<金刚>也是由这个编辑器制作动作的.

unit FormHeroData;
{* 定义怪物类型数据 }
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActnList, ImgList, ComCtrls, StdCtrls, ExtCtrls, ToolWin, ManaList,
  MarkData, MFiles, MGraphics, Math, NumEdits, GifImage, Encode,
  MStream, FacePart, ClipBrd, Buttons;

procedure MException(condition: boolean; Msg: String);

type
  TFrmHeroData = class(TForm)
    ImageList1: TImageList;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    SaveDialogExport: TSaveDialog;
    StatusBar1: TStatusBar;
    PalMain: TPanel;
    PalTitle: TPanel;
    ToolBar1: TToolBar;
    ToolButtonNew: TToolButton;
    ToolButtonOpen: TToolButton;
    ToolButtonSave: TToolButton;
    ToolButtonParts: TToolButton;
    ToolButtonExport: TToolButton;
    ToolButtonExit: TToolButton;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButtonAction: TToolButton;
    PalClient: TPanel;
    ActLst: TActionList;
    ActParts: TAction;
    ActAction: TAction;
    ActNewProj: TAction;
    ActOpenProj: TAction;
    ActSaveProj: TAction;
    ActExportData: TAction;
    PalPart: TPanel;
    ToolBar: TToolBar;
    tlbSelectPic: TToolButton;
    tlbExportPic: TToolButton;
    ToolButton4: TToolButton;
    ToolButton3: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    SplMidd: TSplitter;
    SaveDialogExportPic: TSaveDialog;
    PalList: TPanel;
    PalEdit: TPanel;
    Bevel1: TBevel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    NdtFaceX: TNumEdit;
    NdtFaceY: TNumEdit;
    NdtFaceW: TNumEdit;
    NdtFaceH: TNumEdit;
    NdtTotal: TNumEdit;
    LvwFrame: TListView;
    PalFace: TPanel;
    OpenDialogSelectPic: TOpenDialog;
    ImgList: TImageList;
    ActionList1: TActionList;
    ActSelectPic: TAction;
    ActExportPic: TAction;
    ActFaceVisible: TAction;
    ActNumbVisible: TAction;
    ActDelPart: TAction;
    PalAction: TPanel;
    Timer: TTimer;
    Panel3: TPanel;
    ImageList2: TImageList;
    ActionList2: TActionList;
    ActDel: TAction;
    ActNew: TAction;
    ActUpMove: TAction;
    ActDownMove: TAction;
    ActCopy: TAction;
    ActPaste: TAction;
    ActPlayStart: TAction;
    ActPlayEnd: TAction;
    SpbDelPart: TSpeedButton;
    ActRectVisible: TAction;
    Panel4: TPanel;
    ToolBar2: TToolBar;
    ToolButton18: TToolButton;
    ToolButton17: TToolButton;
    ToolButton19: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    ToolButton13: TToolButton;
    ToolButton14: TToolButton;
    ToolButton15: TToolButton;
    ToolButton16: TToolButton;
    ActNewAction: TAction;
    ActDelAction: TAction;
    ToolButton20: TToolButton;
    ToolButton21: TToolButton;
    ToolButton22: TToolButton;
    PalFrameList: TPanel;
    FrameListView: TIconListView;
    PalFrameTitle: TPanel;
    Splitter3: TSplitter;
    PalActionList: TPanel;
    PalActionTitle: TPanel;
    ActionListView: TTextListView;
    Splitter1: TSplitter;
    Splitter2: TSplitter;
    PalPartList: TPanel;
    PartListView: TIconListView;
    Panel9: TPanel;
    PalFrameEdit: TPanel;
    ToolButton23: TToolButton;
    ToolButton24: TToolButton;
    ActActionUpMove: TAction;
    ActActionDownMove: TAction;
    PalLeft: TPanel;
    Splitter4: TSplitter;
    TextListView1: TTextListView;
    Panel2: TPanel;
    procedure ToolButtonExitClick(Sender: TObject);
    procedure SwitchClick(Sender: TObject);
    procedure ActOpenProjExecute(Sender: TObject);
    procedure ActSaveProjExecute(Sender: TObject);
    procedure ActExportDataExecute(Sender: TObject);
    procedure ActDelExecute(Sender: TObject);
    procedure ActNewExecute(Sender: TObject);
    procedure ActUpMoveExecute(Sender: TObject);
    procedure ActDownMoveExecute(Sender: TObject);
    procedure ActCopyExecute(Sender: TObject);
    procedure ActPasteExecute(Sender: TObject);
    procedure ActPlayStartExecute(Sender: TObject);
    procedure ActPlayEndExecute(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure NdtFaceChange(Sender: TObject);
    procedure LvwFrameData(Sender: TObject; Item: TListItem);
    procedure LvwFrameSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure NdtTotalChange(Sender: TObject);
    procedure ActNumbVisibleExecute(Sender: TObject);
    procedure ActFaceVisibleExecute(Sender: TObject);
    procedure SpbDelPartClick(Sender: TObject);
    procedure ActSelectPicExecute(Sender: TObject);
    procedure ActExportPicExecute(Sender: TObject);
    procedure ActionListViewSelectItem(Sender: TObject; Item: TManaItem;
      Selected: Boolean);
    procedure FrameListViewSelectItem(Sender: TObject; Item: TManaItem;
      Selected: Boolean);
    procedure ActRectVisibleExecute(Sender: TObject);
    procedure ActActionUpMoveExecute(Sender: TObject);
    procedure ActNewActionExecute(Sender: TObject);
    procedure ActDelActionExecute(Sender: TObject);
    procedure ActActionDownMoveExecute(Sender: TObject);
  private
    FActionList: TActionLst;
    FPartsControl: TPartsControl;
    FFrameControl: TFrameControl;
    FFaceFileName: String;

    procedure RefreshActionList;
    procedure ActionListViewChange(Sender: TObject); 

    procedure FramePartDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
    procedure FramePartDragDrop(Sender, Source: TObject; X, Y: Integer);
    function GetActionItem: TActionItem;
    procedure PartsChange(Sender: TObject);
    function GetSign: String;
    function QueryOverWriteFile(aFileName: String): Boolean;
    property CurrentAction: TActionItem read GetActionItem;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;
var
  FrmHeroData: TFrmHeroData;
implementation

{$R *.dfm}
procedure MException(condition: boolean; Msg: String);
begin
  if condition then
    raise Exception.Create(msg);
end;

{ TFrmHeroData }

constructor TFrmHeroData.Create(AOwner: TComponent);
var
  i: Integer;
  StrList: TStrList;
begin
  inherited;
  ActionListView.OnListChange:= ActionListViewChange;

  FActionList:= TActionLst.Create;
  FActionList.FramePartCount:= 3;
  for i:=0 to FActionList.Count - 1 do
    ActionlistView.NewItem(FActionList.Actions[i].Caption);

  PalPart.Align:= alClient;
  PalAction.Align:= alClient;
  PalAction.Visible:= False;

  FPartsControl:= TPartsControl.Create(Self);
  FFrameControl:= TFrameControl.Create(Self);
  FPartsControl.Parent:= PalFace;
  FPartsControl.Align:= alClient;
  FPartsControl.PartList:= FActionList.PartList;
  FPartsControl.OnChange:= PartsChange;
  PartListView.List:= FActionList.PartList;
  ActFaceVisible.Checked:= True;

  FPartsControl.PartVisible:= True;
  FFrameControl.Parent:= PalFrameEdit;
  FFrameControl.Align:= alClient;
  FFrameControl.OnPartsDragOver:= FramePartDragOver;
  FFrameControl.OnPartsDragDrop:= FramePartDragDrop;
  FFrameControl.RectVisible:= False;
end;

destructor TFrmHeroData.Destroy;
begin
  ActionListView.OnListChange:= nil;
  ActionListView.List:= nil;
  FrameListView.List:= nil;
  PartListView.List:= nil;
  
  FFrameControl.Free;
  FPartsControl.Free;
  FActionList.Free;
  inherited;
end;

procedure TFrmHeroData.ToolButtonExitClick(Sender: TObject);
begin
  Close();
end;

procedure TFrmHeroData.SwitchClick(Sender: TObject);
begin
  PalPart.Visible:=  Sender = TObject(ActParts);
  PalAction.Visible:= Sender = TObject(ActAction);
end;

function TFrmHeroData.QueryOverWriteFile(aFileName: String): Boolean;
begin
  Result:= MessageBox(Handle, PChar('文件"' + aFileName + '"已经存在，是否覆盖！'),
    PChar('提示'), MB_OKCANCEL) = IDOK;
end;

procedure TFrmHeroData.ActOpenProjExecute(Sender: TObject);
var
  FileName: String;
  FData: String;
  FileStream: TFileStream;
  FStrStream: TStringStream;
begin
  if not OpenDialog.Execute then Exit;
  FileName:= OpenDialog.FileName;
  FileStream:= TFileStream.Create(FileName, fmOpenRead or fmShareExclusive);
  FStrStream:= TStringStream.Create('');
  try
    FStrStream.CopyFrom(FileStream, FileStream.Size);
    FData:= FStrStream.DataString;
    MException(ReadText(FData, 'Sign') <> GetSign, '文件版本标记错误！');
    FActionList.PartList.Face:= ReadText(FData, 'FaceData');
    FFaceFileName:= ReadText(FData, 'FaceFileName');
    FActionList.Data:= FData;
    Caption:= '角色动作编辑器 -' + FileName;
    RefreshActionList;     
  finally
    FStrStream.Free;
    FileStream.Free;
  end;
end;

function TFrmHeroData.GetSign: String;
begin
  Result:= 'HeroData-2.0';
end;

procedure TFrmHeroData.ActSaveProjExecute(Sender: TObject);
var
  FileStream: TFileStream;
  FileName: String;
  FData: String;
begin
  if not SaveDialog.Execute then Exit;
  FileName:= SaveDialog.FileName;

  FileStream:= TFileStream.Create(FileName, fmCreate or fmShareExclusive);
  try
    FData:= PickText(GetSign, 'Sign') + Ln +
       PickText(FFaceFileName, 'FaceFileName') + Ln +
       PickText(FActionList.PartList.Face, 'FaceData') + Ln +
       FActionList.Data;
    FileStream.Write(FData[1], Length(FData));
  finally
    FileStream.Free;
  end;
end;

procedure TFrmHeroData.ActExportDataExecute(Sender: TObject);
var
  FileName: String;
  i: Integer;
  FileStream: TFileStream;
  FaceW: Integer;
  FaceName: string;
  part: TPartItem;
begin
  //询问导出数据的文件
  if not SaveDialogExport.Execute then Exit;
  FileName:= SaveDialogExport.FileName;

  if (FileExists(FileName)) and (not QueryOverWriteFile(FileName)) then Exit;
  //建立流对象
  FileStream:= TFileStream.Create(FileName, fmCreate);
  FaceW:= FActionList.PartList.Picture.Width;
  //输出数据
  try
    //写入图像数据
//    WriteStrToStream(DecodeData(FActionList.PartList.Face));