facepart.pas

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

  Result:= TActionItem.Create(Self);
  FActions[Len]:= Result;
end;

function TActionLst.NewAction(aActionName: String): TActionItem;
var
  Len: Integer;
begin
  Len:= Length(FActions);
  SetLength(FActions, Len + 1);
  Result:= TActionItem.Create(Self);
  Result.Caption:= aActionName;
  FActions[Len]:= Result;
end;

procedure TActionLst.DelAction(Index: Integer);
var
  i: Integer;
begin
  FActions[i].Free;
  for i:= Index to Length(FActions) - 2 do
    FActions[i]:= FActions[i + 1];
  SetLength(FActions, Length(FActions) + 1);
end;

procedure TActionLst.SetFramePartCount(const Value: Integer);
begin
  FFramePartCount := Value;
end;

procedure TActionLst.SetPlatList(const Value: TPartList);
var
  i: Integer;
  j: Integer;
begin
  FPartList := Value;
  for i:= 0 to Count - 1 do
    for j:= 0 to Actions[i].Count - 1 do
      Actions[i].Frames[i].RefreshFace;
end;

procedure TActionLst.Clear;
var
  i: Integer;
begin
  for i:= 0 to Count - 1 do
    FActions[i].Free;
  SetLength(FActions, 0);
end;

procedure TActionLst.ExchangeAction(Index1, Index2: Integer);
var
  ActionItem: TActionItem;
begin
  if (Index1 < 0) or (Index1 >= Count) then Exception.Create('交换动作顺序：索引超出范围！');
  if (Index2 < 0) or (Index2 >= Count) then Exception.Create('交换动作顺序：索引超出范围！');
  ActionItem:= FActions[Index1];
  FActions[Index1]:= FActions[Index2];
  FActions[Index2]:= ActionItem;
end;

{ TShowControl }

constructor TShowControl.Create(AOwner: TComponent);
begin
  if not (AOwner is TFrameControl) then
    raise Exception.Create('ShowControl只能属于 FrameControl！');
  FFace:= TBitmap.Create;
  inherited;
end;

destructor TShowControl.Destroy;
begin
  FFace.Free;
  inherited;
end;

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

procedure TShowControl.CNKeyDown(var Message: TWMKeyDown);
var
  ShiftState: TShiftState;
begin
  if Assigned(FrameItem) then
  begin
    ShiftState := KeyDataToShiftState(Message.KeyData);
    if ssShift in ShiftState then
    case Message.CharCode of
      VK_LEFT:  FrameItem.FireW:= FrameItem.FireW - 1;
      VK_RIGHT: FrameItem.FireW:= FrameItem.FireW + 1;
      VK_UP:    FrameItem.FireH:= FrameItem.FireH - 1;
      VK_DOWN:  FrameItem.FireH:= FrameItem.FireH + 1;
    end else
    if ssCtrl in ShiftState then
    case Message.CharCode of
      VK_LEFT:  FrameItem.FireX:= FrameItem.FireX + 1;
      VK_RIGHT: FrameItem.FireX:= FrameItem.FireX - 1;
      VK_UP:    FrameItem.FireY:= FrameItem.FireY + 1;
      VK_DOWN:  FrameItem.FireY:= FrameItem.FireY - 1;
    end else
    case Message.CharCode of
      VK_LEFT:  FrameItem.RectW:= FrameItem.RectW - 1;
      VK_RIGHT: FrameItem.RectW:= FrameItem.RectW + 1;
      VK_UP:    FrameItem.RectT:= FrameItem.RectT + 1;
      VK_DOWN:  FrameItem.RectT:= FrameItem.RectT - 1;
    end;
    if Message.CharCode in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN] then
      RefreshFace;
  end;
end;

procedure TShowControl.WMKillFocus(var Message: TWMSetFocus);
begin
  Invalidate;
end;

procedure TShowControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited;
  SetFocus;
  Invalidate;
end;

function TShowControl.GetFrameItem: TFrameItem;
begin
  Result:= TFrameControl(Owner).FrameItem;
end;

procedure TShowControl.SetRectVisible(const Value: Boolean);
begin
  if FRectVisible = Value then Exit;
  FRectVisible := Value;
  Invalidate;
end;

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

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

procedure TShowControl.RefreshFace;
var
  X, Y: Integer;
  FStr: String;
  CW, CH: Integer;
  CL, CT, CR, CB: Integer;
  i: Integer;
  FramePart: TFramePart;
begin
  CW:= ClientWidth;
  CH:= ClientHeight;

  with FFace.Canvas do
  begin
    if Focused then
      Brush.Color:= $BBBBBB
    else
      Brush.Color:= $C8D0D4;
    FillRect(Rect(0, 22, CW, CH));

    Brush.Color:= $505050;
    FillRect(Rect(0, 1, Width, 22));
    FrameRect(Rect(0, 0, CW, CH));

    FStr:= '动作帧';
    Font.Color:= $FFFFFF;
    Font.Style:= [fsBold];
    if Assigned(FrameItem) then
      FStr:= FStr + '(' + IntToStr(FrameItem.RectW) + ',' + IntToStr(FrameItem.RectT) + ')'  ;
    TextOut((Width - TextWidth(FStr)) div 2, (22 - TextHeight(FStr)) div 2, FStr);

    CL:= 0;
    CT:= 22;
    CR:= CW - 1;
    CB:= CH - 1;
    CH:= CH - 22;

    X:= CW div 2 + CL;
    Y:= CH div 2 + CT;
    MoveTo(CL, Y); LineTo(CR, Y);
    MoveTo(X, CT); LineTo(X, CB);

    if Assigned(FrameItem) then
    begin
      for i:= 0 to FrameItem.FramePartCount - 1 do
        if FrameItem.FrameParts[i].Have then
        begin
          FramePart:= FrameItem.FrameParts[i];
          FramePart.Face.TransparentColor:= $FFFFFFF;
          FramePart.Face.Transparent:= True;
          DrawBitmap(FFace, X - FramePart.LinkX, Y - FramePart.LinkY, FramePart.Face);
        end;
      if RectVisible then
      begin
        Brush.Color:= $00FF00;
        FrameRect(Rect(X - FrameItem.RectW, Y - FrameItem.RectT, X + FrameItem.RectW, Y + FrameItem.RectB));
        Brush.Color:= $0000FF;
        FrameRect(Rect(X - FrameItem.FireX, Y - FrameItem.FireY, X - FrameItem.FireX + FrameItem.FireW, Y - FrameItem.FireY + FrameItem.FireH));
      end;
    end;
  end;
  Canvas.Draw(0, 0, FFace);
end;

{ TLinkControl }

constructor TLinkControl.Create(AOwner: TComponent);
begin
  if not (AOwner is TFrameControl) then
    raise Exception.Create('LinkControl只能属于FrameControl');
  inherited;
  FFace:= TBitmap.Create;
  Index:= -1;
end;

destructor TLinkControl.Destroy;
begin
  FFace.Free;
  inherited;
end;

procedure TLinkControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited;
  SetFocus;
  Invalidate;
end;

procedure TLinkControl.Paint;
var
  X, Y: Integer;
  Face: TBitmap;
  FStr: string;
begin
  Caption:= '层';
  with FFace.Canvas do
  begin
    //填充大背景
    if Focused then
      Brush.Color:= $BBBBBB
    else
      Brush.Color:= $C8D0D4;
    FillRect(Rect(0, 22, Width, Height));
    //画标题
    Brush.Color:= $505050;
    FillRect(Rect(0, 1, Width, 22));
    if FramePart.Have then
      FStr:= Caption + ' ' + IntToStr(FIndex) + ':' + IntToStr(FramePart.Index) 
    else
      FStr:= Caption + ' ' + IntToStr(FIndex);
    Font.Color:= $FFFFFF;
    Font.Style:= [fsBold];
    TextOut((Width - TextWidth(FStr)) div 2, (22 - TextHeight(FStr)) div 2, FStr);
    //画外框
    FrameRect(Rect(0, 0, Width, Height));
    if FramePart.Have then
    begin
      Face:= FramePart.Face;
      X:= (Width - Face.Width) div 2;
      Y:= (Height - Face.Height) div 2;
      Draw(X, Y, Face);
      Pen.Color:= $0000FF;
      MoveTo(X + FramePart.LinkX - 3, Y + FramePart.LinkY);
      LineTo(X + FramePart.LinkX + 3, Y + FramePart.LinkY);
      MoveTo(X + FramePart.LinkX, Y + FramePart.LinkY - 3);
      LineTo(X + FramePart.LinkX, Y + FramePart.LinkY + 3);
    end;
  end;
  Canvas.Draw(0, 0, FFace);
end;

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

procedure TLinkControl.CNKeyDown(var Message: TWMKeyDown);
begin
  if not FramePart.Have then Exit;
  case Message.CharCode of
    VK_LEFT: FramePart.LinkX:= FramePart.LinkX - 1;
    VK_UP:   FramePart.LinkY:= FramePart.LinkY - 1;
    VK_RIGHT:FramePart.LinkX:= FramePart.LinkX + 1;
    VK_DOWN: FramePart.LinkY:= FramePart.LinkY + 1;
  end;
  DoChange;
  Invalidate;
end;

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

procedure TLinkControl.WMKillFocus(var Message: TWMSetFocus);
begin
  inherited;
  Invalidate;
end;

function TLinkControl.GetFramePart: TFramePart;
begin
  Result:= TFrameControl(Owner).FrameItem.FrameParts[Index];
end;

function TLinkControl.GetPartIndex: Integer;
begin
  Result:= FramePart.Index;
end;

function TLinkControl.GetPartLinkX: Integer;
begin
  Result:= FramePart.LinkX;
end;

function TLinkControl.GetPartLinkY: Integer;
begin
  Result:= FramePart.LinkY;
end;

procedure TLinkControl.SetPartIndex(const Value: Integer);
begin
  FramePart.Index:= Value;
  Invalidate;
  DoChange;
end;

procedure TLinkControl.SetPartLinkX(const Value: Integer);
begin
  FramePart.LinkX:= Value;
  Invalidate;
  DoChange;
end;

procedure TLinkControl.SetPartLinkY(const Value: Integer);
begin
  FramePart.LinkY:= Value;
  Invalidate;
  DoChange;
end;

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

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

{ TFrameControl }

constructor TFrameControl.Create(AOwner: TComponent);
begin
  inherited;
  FShowControl:= TShowControl.Create(Self);
  FBottomPanel:= TPanel.Create(Self);

  FBottomPanel.Parent:= Self;
  FBottomPanel.BevelOuter:= bvNone;
  FShowControl.Parent:= Self;
  FBottomPanel.Align:= alBottom;
  FBottomPanel.Height:= 120;
  FShowControl.Align:= alClient;
end;

destructor TFrameControl.Destroy;
begin
  FShowControl.Free;
  FBottomPanel.Free;
  inherited;
end;

procedure TFrameControl.ClearLinkControls;
var
  i: Integer;
begin
  for i:= 0 to Length(FLinkControls) - 1 do
    FLinkControls[i].Free;
  SetLength(FLinkControls, 0);
end;

procedure TFrameControl.SetFrameItem(const Value: TFrameItem);
var
  i: Integer;
begin
  if not Assigned(Value) then Exit;
  if FFrameItem = Value then Exit;
  FFrameitem := Value;
  if Length(FLinkControls) > FFrameItem.FramePartCount then
  begin
    for i:= Length(FLinkControls) - 1 downto FFrameItem.FramePartCount do
      FLinkControls[i].Free;
    SetLength(FLinkControls, FFrameItem.FramePartCount);
  end else
  if Length(FLinkControls) < FFrameItem.FramePartCount then begin
    for i:= Length(FLinkControls) to FFrameItem.FramePartCount - 1 do
    begin
      SetLength(FLinkControls, i + 1);
      FLinkControls[i]:= TLinkControl.Create(Self);
      FLinkControls[i].Parent:= FBottomPanel;
      FLinkControls[i].Align:= alLeft;
      FLinkControls[i].Left:= Width;
      FLinkControls[i].Width:= Width div FFrameItem.FramePartCount;
      FLinkControls[i].Index:= i;
      FLinkControls[i].FOnChange:= LinkChange;
      FLinkControls[i].OnDragOver:= FOnPartsDragOver;
      FLinkControls[i].OnDragDrop:= FOnPartsDragDrop;
    end;
  end;
  FLinkControls[FFrameItem.FramePartCount - 1].Align:= alClient;
  for i:= 0 to Length(FLinkControls) - 1 do
    FLinkControls[i].Invalidate;
  FShowControl.Invalidate;
end;

procedure TFrameControl.LinkChange(Sender: TObject);
begin
  FShowControl.Invalidate;
end;

procedure TFrameControl.SetOnPartsDragDrop(const Value: TDragDropEvent);
var
  i: Integer;
begin
  FOnPartsDragDrop := Value;
  for i:= 0 to Length(FLinkControls) - 1 do
    FLinkControls[i].OnDragDrop:= Value;
end;

procedure TFrameControl.SetOnPartsDragOver(const Value: TDragOverEvent);
var
  i: Integer;
begin
  FOnPartsDragOver := Value;
  for i:= 0 to Length(FLinkControls) - 1 do
    FLinkControls[i].OnDragOver:= Value;
end;

procedure TFrameControl.Resize;
var
  i: Integer;
  len: Integer;
begin
  inherited;
  len:= Length(FLinkControls);
  for i:= 0 to Len -1 do
    FLinkControls[i].Width:= FBottomPanel.ClientWidth div Len;
end;

function TFrameControl.GetRectVisible: Boolean;
begin
  Result:= FShowControl.RectVisible;
end;

procedure TFrameControl.SetRectVisible(const Value: Boolean);
begin
  FShowControl.RectVisible:= Value;
end;

end.