facepart.pas

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

  if Assigned(FOnPartsChange) then
    FOnPartsChange(Self);
end;

procedure TPartList.SetPicture(const Value: TBitmap);
var
  i: Integer;
begin
  FPicture.Assign(Value);
  for i:= 0 to Count - 1 do Parts[i].RefreshFace;
  DoChange;
end;

procedure TPartList.LoadPicture(aFileName: String);
var
  FileStream: TFileStream;
  FStrStream: TStringStream;
begin
  FileStream:= TFileStream.Create(aFileName, fmOpenRead or fmShareExclusive);
  FStrStream:= TStringStream.Create('');
  try
    FStrStream.CopyFrom(FileStream, FileStream.Size);
    Face:= EncodeData(FStrStream.DataString);
  finally
    FStrStream.Free;
    FileStream.Free;
  end;
end;

{ TPartsControl }

constructor TPartsControl.Create(AOwer: TComponent);
begin
  inherited;
  FFace:= TBitmap.Create;
end;

destructor TPartsControl.Destroy;
begin
  if Assigned(FPartList) then
  begin
    FPartList.FOnPartsChange:= nil;
    FPartList.FOnPartsFree:= nil;
    FPartList:= nil;
  end;
  FFace.Free;
  inherited;
end;

procedure TPartsControl.Paint;
begin
  Canvas.Draw(0, 0, FFace);
end;

procedure TPartsControl.PartsChange(Sender: TObject);
begin
  RefreshFace;
  if Assigned(FOnChange) then FOnChange(Sender);
end;

procedure TPartsControl.PartsFree(Sender: TObject);
begin
  FPartList.FOnPartsChange:= nil;
  FPartList.FOnPartsFree:= nil;
  FPartList:= nil;
  RefreshFace;
end;

procedure TPartsControl.SetPartVisible(const Value: Boolean);
begin
  FPartVisible := Value;
  RefreshFace;
end;

procedure TPartsControl.SetNumbVisible(const Value: Boolean);
begin
  FNumbVisible := Value;
  RefreshFace;
end;

procedure TPartsControl.SetPartList(const Value: TPartList);
begin
  if Assigned(FPartList) then
  begin
    FPartList.FOnPartsChange:= nil;
    FPartList.FOnPartsFree:= nil;
    FPartList:= nil;
  end;
  if Assigned(Value) then
  begin
    FPartList := Value;
    FPartList.FOnPartsChange:= PartsChange;
    FPartList.FOnPartsFree:= PartsFree;
  end;
end;

procedure TPartsControl.WMEraseBkgnd(var Message: TMessage);
begin
  Message.Result:= 1;
end;

procedure TPartsControl.Resize;
begin
  FFace.Width:= Width;
  FFace.Height:= Height;
  RefreshFace;
  inherited;
end;

procedure TPartsControl.RefreshFace;
var
  i: Integer;
  X,Y: Integer;
begin
  with FFace.Canvas do
  begin
    Brush.Color:= clBtnFace;
    FillRect(ClientRect);
    if PartList.Picture.Empty then Exit;
    X:= (ClientWidth - PartList.Picture.Width) div 2;
    Y:= (ClientHeight - PartList.Picture.Height) div 2;
    Draw(X, Y, PartList.Picture);
    if not Assigned(FPartList) then Exit;
    for i:= 0 to FPartList.Count - 1 do
      with FPartList.Parts[i] do
      begin
        if FPartVisible then
        begin
          Brush.Color:= $FF0000;
          FrameRect(Rect(X + PartX, Y + PartY, X + PartX + PartW, Y + PartY + PartH));
        end;
        if FNumbVisible then
        begin
          Brush.Color:= $FFFFFF;
          TextOut(X + PartX + 1, Y + PartY + 1, IntToStr(i));
        end;
      end;
  end;
  Canvas.Draw(0, 0, FFace);
end;


{ TFramePart }

constructor TFramePart.Create(AOwner: TFrameItem);
begin
  inherited Create;
  FOwner:= TFrameItem(AOwner);
end;

procedure TFramePart.DoChange;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

function TFramePart.GetFace: TBitmap;
begin
  Result:= nil;
  if Have then
    Result:= FOwner.PartList.Items[FIndex].Picture;
end;

function TFramePart.GetHave: Boolean;
begin
  Result:= False;
  if Assigned(FOwner.PartList) then
    if (FIndex >= 0) and (FIndex < FOwner.PartList.Count) then
      Result:= True;
end;

procedure TFramePart.SetIndex(const Value: Integer);
begin
  if FIndex = Value then Exit;
  FIndex := Value;
  DoChange;
end;

procedure TFramePart.SetLinkX(const Value: Integer);
begin
  if FLinkX = Value then Exit;
  FLinkX := Value;
  DoChange;
end;

procedure TFramePart.SetLinkY(const Value: Integer);
begin
  if FLinkY = Value then Exit;
  FLinkY := Value;
  DoChange;
end;

{ TFrameItem }

constructor TFrameItem.Create(AOwner: TActionItem);
var
  i: Integer;
begin
  inherited Create;
  FOwner:= AOwner;
  FRectB:= 11;
  SetLength(FFrameParts, FOwner.FOwner.FramePartCount);
  for i:= 0 to FramePartCount - 1 do
  begin
    FFrameParts[i]:= TFramePart.Create(Self);
    FFrameParts[i].FIndex:= -1;
    FFrameParts[i].FOnChange:= FramePartChange;
  end;
end;

function TFrameItem.GetData: String;
var
  i: Integer;
begin
  Result:= '    <Frame>' + Ln;
  Result:= Result + '      ' + PickSInt(RectW, 'RectW') + Ln;
  Result:= Result + '      ' + PickSInt(RectT, 'RectT') + Ln;
  Result:= Result + '      ' + PickSInt(FireX, 'FireX') + Ln;
  Result:= Result + '      ' + PickSInt(FireY, 'FireY') + Ln;
  Result:= Result + '      ' + PickSInt(FireW, 'FireW') + Ln;
  Result:= Result + '      ' + PickSInt(FireH, 'FireH') + Ln;
  for i:= 0 to FramePartCount - 1 do
  begin
    Result:= Result + '      <FramePart>' + Ln;
    Result:= Result + '        ' + PickSInt(FrameParts[i].Index, 'Index') + Ln;
    Result:= Result + '        ' + PickSInt(FrameParts[i].LinkX, 'LinkX') + Ln;
    Result:= Result + '        ' + PickSInt(FrameParts[i].LinkY, 'LinkY') + Ln;
    Result:= Result + '      </FramePart>' + Ln;
  end;
  Result:= Result + '    </Frame>' + Ln;
end;

procedure TFrameItem.SetData(const Value: String);
var
  i: Integer;
  StrList: TStrList;
begin
  try FRectW:= ReadSint(Value, 'RectW'); except end;
  try FRectT:= ReadSInt(Value, 'RectT'); except end;
  try FFireX:= ReadSint(Value, 'FireX'); except end;
  try FFireY:= ReadSInt(Value, 'FireY'); except end;
  try FFireW:= ReadSInt(Value, 'FireW'); except end;
  try FFireH:= ReadSInt(Value, 'FireH'); except end;
  StrList:= ReadList(Value, 'FramePart');
  for i:= 0 to FramePartCount - 1 do
  begin
    try FrameParts[i].FIndex:= ReadSInt(StrList[i], 'Index'); except end;
    try FrameParts[i].FLinkX:= ReadSInt(StrList[i], 'LinkX'); except end;
    try FrameParts[i].FLinkY:= ReadSInt(StrList[i], 'LinkY'); except end;
  end;
  RefreshFace;
end;

procedure TFrameItem.RefreshFace;
var
  FaceL, FaceT, FaceR, FaceB: Integer;
  sign: array of Boolean;
  pics: array of TBitmap;
  Face: TBitmap;
  i: Integer;
begin
  SetLength(sign, FramePartCount);
  SetLength(pics, FramePartCount);
  FaceL:= 0;
  FaceR:= 0;
  FaceT:= 0;
  FaceB:= 0;
  Face:= TBitmap.Create;
  try
    if not Assigned(PartList) then begin
      Face.Width:= 1;
      Face.Height:= 1;
      Picture:= Face;
    end else begin
      for i:= 0 to FramePartCount - 1 do
        sign[i]:= (FrameParts[i].Index >= 0) and (FrameParts[i].Index < PartList.Count);
      for i:= 0 to FramePartCount - 1 do
      begin
        if sign[i] then begin
          pics[i]:= PartList.Parts[FrameParts[i].Index].Picture;
          FaceL:= Max(FaceL, FrameParts[i].LinkX);
          FaceT:= Max(FaceT, FrameParts[i].LinkY);
          FaceR:= Max(FaceR, pics[i].Width - FrameParts[i].LinkX);
          FaceB:= Max(FaceB, pics[i].Height - FrameParts[i].LinkY);
        end;
      end;
      Face.Width:= FaceL + FaceR;
      Face.Height:= FaceT + FaceB;
      for i:= 0 to FramePartCount - 1 do
        if sign[i] then
        begin
          pics[i].TransparentColor:= $FFFFFF;
          pics[i].Transparent:= True;
          DrawBitmap(Face, FaceL - FrameParts[i].LinkX, FaceT - FrameParts[i].LinkY, pics[i]);
        end;
    end;
  finally
    Picture:= Face;
    Face.Free;
  end;
end;

function TFrameItem.GetFramePart(Index: Integer): TFramePart;
begin
  if (Index < 0) or (Index >= FramePartCount) then
    raise Exception.Create('读取FramePart索引出界！');
  Result:= FFrameParts[Index];
end;

procedure TFrameItem.SetFramePart(Index: Integer; const Value: TFramePart);
begin
  if (Index < 0) or (Index >= FramePartCount) then
    raise Exception.Create('设置FramePart索引出界！');
  FFrameParts[Index].FIndex:= Value.Index;
  FFrameParts[Index].FLinkX:= Value.LinkX;
  FFrameParts[Index].FLinkY:= Value.LinkY;
  RefreshFace;
end;

procedure TFrameItem.SetRectT(const Value: Integer);
begin
  if FRectT = Value then Exit;
  FRectT := Value;
end;

procedure TFrameItem.SetRectW(const Value: Integer);
begin
  if FRectW = Value then Exit;
  FRectW := Value;
end;

function TFrameItem.GetPartList: TPartList;
begin
  Result:= FOwner.PartList;
end;

procedure TFrameItem.FramePartChange(Sender: TObject);
begin
  RefreshFace;
end;

function TFrameItem.GetFramePartCount: Integer;
begin
  Result:= Length(FFrameParts);
end;

procedure TFrameItem.SetFireH(const Value: Integer);
begin
  if FFireH = Value then Exit;
  FFireH := Value;
end;

procedure TFrameItem.SetFireW(const Value: Integer);
begin
  if FFireW = Value then Exit;
  FFireW := Value;
end;

procedure TFrameItem.SetFireX(const Value: Integer);
begin
  if FFireX = Value then Exit;
  FFireX := Value;
end;

procedure TFrameItem.SetFireY(const Value: Integer);
begin
  if FFireY = Value then Exit;
  FFireY := Value;
end;

{ TActionItem }

constructor TActionItem.Create(AOwner: TActionLst);
begin
  inherited Create;
  FOwner:= AOwner;
end;

function TActionItem.GetData: String;
var
  i: Integer;
begin
  Result:= '  <Action>' + Ln;
  Result:= Result + '    ' + PickText(FCaption, 'Name') + Ln;
  for i:= 0 to Count - 1 do
    Result:= Result + TFrameItem(Items[i]).Data;
  Result:= Result + '  </Action>' + Ln;
end;

procedure TActionItem.SetData(const Value: String);
var
  i: Integer;
  StrList: TStrList;
  Frame: TFrameItem;
begin
  FCaption:= ReadText(Value, 'Name');
  StrList:= ReadList(Value, 'Frame');
  Clear;
  for i:= 0 to Length(StrList) - 1 do
  begin
    Frame:= TFrameItem.Create(Self);
    Frame.Data:= StrList[i];
    AddItem(Frame);
  end;
end;

function TActionItem.GetFrame(Index: Integer): TFrameItem;
begin
  Result:= TFrameItem(Items[Index]);
end;

function TActionItem.GetPartList: TPartList;
begin
  Result:= FOwner.FPartList;
end;

function TActionItem.NewFrame: TFrameItem;
begin
  Result:= TFrameItem.Create(Self);
  AddItem(Result);
end;

{ TActionLst }

constructor TActionLst.Create;
begin
  FPartList:= TPartList.Create;
  FFramePartCount:= 4;
end;

destructor TActionLst.Destroy;
var
  i: Integer;
begin
  for i:= 0 to Length(FActions) - 1 do
    FActions[i].Free;
  FPartList.Free;
  inherited;
end;

function TActionLst.GetAction(Index: Integer): TActionItem;
begin
  Result:= FActions[Index];
end;

function TActionLst.GetCount: Integer;
begin
  Result:= Length(FActions);
end;

function TActionLst.GetData: String;
var
  i: Integer;
begin
  Result:= '<ActionList>' + Ln;
  Result:= Result + FPartList.Data;
  for i:= 0 to Count - 1 do Result:= Result + Actions[i].Data;
  Result:= Result + '</ActionList>' + Ln;
end;

procedure TActionLst.SetData(const Value: String);
var
  i: Integer;
  FStrList: TStrList;
  FAction: TActionItem;
begin
  Clear;
  FPartList.Data:= ReadText(Value, 'Parts');
  FStrList:= ReadList(Value, 'Action');
  for i:= 0 to Length(FStrList) - 1 do
  begin
    FAction:= TActionItem.Create(Self);
    FAction.Data:= FStrList[i];
    SetLength(FActions, i + 1);
    FActions[i]:= FAction;
  end;
end;

function TActionLst.NewAction: TActionItem;
var
  Len: Integer;
begin
  Len:= Length(FActions);
  SetLength(FActions, Len + 1);