charcls.pas

千年源代码,只缺少控件,可以做二次开发用,好不容易得来的

   DynamicObjName := '';
   id := 0;
end;

procedure   TDynamicObject.ChangeProperty(pCP : PTSChangeProperty);
begin
   DynamicObjName := StrPas(@pCP^.rNameString);
end;

procedure   TDynamicObject.ProcessMessage (aMsg, aMotion: integer);
begin
   case amsg of
      SM_STRUCTED :
         begin
            StructedTick := mmAnsTick;
            StructedPercent := aMotion;
         end;
   end;
end;

function    TDynamicObject.IsArea ( ax, ay: integer): Boolean;
var
   xp, yp: integer;
   xx, yy: integer;
   pb : pword;
begin
   Result := TRUE;
   xx := RealX + DynamicObjImage.px - DynamicObjectMaxSizeHalf;
   yy := RealY + DynamicObjImage.py - DynamicObjectMaxSizeHalf;

   if (ax <= xx) then Result := FALSE;
   if (ay <= yy) then Result := FALSE;
   if ax >= xx + DynamicObjImage.Width then Result := FALSE;
   if ay >= yy + DynamicObjImage.Height then Result := FALSE;
   if Result = FALSE then exit;

   xp := ax-xx;
   yp := ay-yy;

   pb := PWORD (DynamicObjImage.bits);
   inc (pb, xp + yp*DynamicObjImage.Width);
   if pb^ = 0 then Result := FALSE;
end;

procedure   TDynamicObject.SetFrame(aDynamicObjectState: byte; CurTick : integer);
var
   ImageLib : TA2ImageLib;
begin
   DynamicObjImage.Free;
   DynamicObjImage := TA2Image.Create (DynamicObjectMaxSize, DynamicObjectMaxSize, 0, 0);
   case aDynamicObjectState of
      0 : // ex 惑磊 : 凯府绰 葛嚼
         begin
            ImageLib := FAtzClass.GetImageLib (format ('x%d.atz', [DynamicObjShape]),CurTick);
            if ImageLib <> nil then begin
               if DynamicObjIndex > FEndFrame then DynamicObjIndex := FEndFrame;
               if (ImageLib <> nil) and (ImageLib.Images[DynamicObjIndex] <> nil) then begin
                  DynamicObjImage.DrawImage (ImageLib.Images[DynamicObjIndex], ImageLib.Images[DynamicObjIndex].px+DynamicObjectMaxSizeHalf, ImageLib.Images[DynamicObjIndex].py+DynamicObjectMaxSizeHalf, TRUE);
                  DynamicObjImage.Optimize;
               end;
               Inc(DynamicObjIndex)
            end;
         end;
      1 :  // ex 巩颇檬籍 拳肺 : 拌加利栏肺 Scroll凳
         begin
            ImageLib := FAtzClass.GetImageLib (format ('x%d.atz', [DynamicObjShape]), CurTick);
            if ImageLib <> nil then begin
               if DynamicObjIndex > FEndFrame then DynamicObjIndex := FStartFrame;
               if (ImageLib <> nil) and (ImageLib.Images[DynamicObjIndex] <> nil) then begin
                  DynamicObjImage.DrawImage (ImageLib.Images[DynamicObjIndex], ImageLib.Images[DynamicObjIndex].px+DynamicObjectMaxSizeHalf, ImageLib.Images[DynamicObjIndex].py+DynamicObjectMaxSizeHalf, TRUE);
                  DynamicObjImage.Optimize;
               end;
               Inc(DynamicObjIndex)
            end;
         end;
   end;
end;

procedure   TDynamicObject.Paint;
begin
   if DynamicObjImage <> nil then
      BackScreen.DrawImage (DynamicObjImage, RealX-DynamicObjectMaxSizeHalf, RealY-DynamicObjectMaxSizeHalf, TRUE);
   if StructedTick <> 0 then BackScreen.DrawStructed (RealX, RealY, 55, StructedPercent);
end;

function    TDynamicObject.Update ( CurTick: integer) : Integer;
begin
   Result := 0;
   if StructedTick + 200 < CurTick then StructedTick := 0;
   if CurTick > DelayTick + DYNAMICOBJECTTIME then begin
      DelayTick := CurTick;
      SetFrame (DynamicObjectState, CurTick);
   end;
end;

//////////////////////////////////
//         Item Class
//////////////////////////////////

constructor TItemClass.Create (aAtzClass: TAtzClass);
begin
   FAtzClass := aAtzClass;
   ItemImage := TA2Image.Create (140, 140, 0, 0);
end;

destructor  TItemClass.Destroy;
begin
   ItemImage.Free;
   inherited destroy;
end;

procedure   TItemClass.SetItemAndColor (aItemshape, aItemColor: integer);
var
   gc, ga: integer;
   tempImage : TA2Image;
begin
   ItemShape := aItemShape;
   ItemColor := aItemColor;
   tempImage := FAtzClass.GetItemImage (ItemShape);
   ItemImage.Free;
   ItemImage := TA2Image.Create (140, 140, 0, 0);

   GetGreenColorAndAdd (ItemColor, gc, ga);
   ItemImage.DrawImageGreenConvert (TempImage, 70-TempImage.Width div 2, 70-TempImage.Height div 2, gc, ga);
   ItemImage.Optimize;
   RealX := x * UNITX + UNITX div 2;
   RealY := y * UNITY + UNITY div 2;
end;

procedure   TItemClass.Initialize (aItemName: string; aRace: byte; aId, ax, ay, aItemshape, aItemcolor: integer);
var
   gc, ga: integer;
   tempImage : TA2Image;
begin
   ItemName := aItemName;
   id := aid; x := ax; y := ay; ItemShape := aItemShape; ItemColor := aItemColor;
   tempImage := FAtzClass.GetItemImage (ItemShape);
   ItemImage.Free;
   ItemImage := TA2Image.Create (140, 140, 0, 0);

   GetGreenColorAndAdd (ItemColor, gc, ga);
   ItemImage.DrawImageGreenConvert (TempImage, 70-TempImage.Width div 2, 70-TempImage.Height div 2, gc, ga);
   ItemImage.Optimize;
   RealX := x * UNITX + UNITX div 2;
   RealY := y * UNITY + UNITY div 2;
   Race := aRace;
   FUsed := TRUE;
end;

procedure   TItemClass.Finalize;
begin
   FUsed := FALSE;
   ItemName := '';
   id := 0;
   Race := RACE_ITEM;
end;

procedure TItemClass.ChangeProperty(pCP : PTSChangeProperty);
begin
   ItemName := StrPas(@pCP^.rNameString);
end;

function  TItemClass.IsArea ( ax, ay: integer): Boolean;
var
   xp, yp: integer;
   xx, yy: integer;
   pb : pword;
begin
   Result := TRUE;
   xx := RealX +ItemImage.px- 70;
   yy := RealY +ItemImage.py- 70;

   if (ax <= xx) then Result := FALSE;
   if (ay <= yy) then Result := FALSE;
   if ax >= xx + ItemImage.Width then Result := FALSE;
   if ay >= yy + ItemImage.Height then Result := FALSE;
   if Result = FALSE then exit;

   xp := ax-xx;
   yp := ay-yy;

   pb := PWORD (ItemImage.bits);
   inc (pb, xp + yp*ItemImage.Width);
   if pb^ = 0 then Result := FALSE;
end;

procedure   TItemClass.Paint;
begin
   BackScreen.DrawImage (ItemImage, RealX-70, RealY-70, TRUE);
end;

function    TItemClass.Update (CurTick: integer) : Integer;
begin
   Result := 0;
end;


//////////////////////////////////
//         Char Class
//////////////////////////////////

constructor TCharClass.Create (aAtzClass:TAtzClass);
var
   i : integer;
begin
   FAtzClass := aAtzClass;

   for i := 0 to CharImageBufferCount -1 do begin
      CharImageBuffer[i].aCharImage := nil;
      CharImageBuffer[i].aImageNumber := -1;
   end;
   CharImageBuffer[0].aCharImage := TA2Image.Create (CharMaxSiez, CharMaxSiez, 0, 0);
   CharImageBufferIndex := 0;

   OverImage := TA2Image.Create (CharMaxSiez, CharMaxSiez, 0, 0);
   BubbleList := TStringList.Create;
   BgEffect := nil;
end;

destructor  TCharClass.Destroy;
var
   i : integer;
begin
   BubbleList.Free;
   if BgEffect <> nil then BgEffect.Free;
   for i := 0 to CharImageBufferCount -1 do begin
      if CharImageBuffer[i].aCharImage <> nil then CharImageBuffer[i].aCharImage.Free;
   end;

   if OverImage <> nil then OverImage.free;
   inherited destroy;
end;

procedure   TCharClass.AddMessage (aRMsg: TRecordMessage);
var i : integer;
begin
   for i := 1 to 5-1 do MessageArr[i-1] := MessageArr[i];
   FillChar (MessageArr[5-1], sizeof(TRecordMessage), 0);
   for i := 0 to 5-1 do begin
      if MessageArr[i].rmsg = 0 then begin
         MessageArr[i] := aRMsg;
         break;
      end;
   end;
end;

procedure   TCharClass.GetMessage (var aRMsg: TRecordMessage);
var i : integer;
begin
   aRMsg := MessageArr[0];
   for i := 1 to 5-1 do MessageArr[i-1] := MessageArr[i];
   FillChar (MessageArr[5-1], sizeof(TRecordMessage), 0);
end;

procedure   TCharClass.ViewMessage (var aRMsg: TRecordMessage);
begin
   aRMsg := MessageArr[0];
end;

procedure   TCharClass.AddBgEffect (aRealx, aRealy: integer; aShape: integer; aLightEffectKind: TLightEffectKind);
begin
   if BgEffect = nil then begin
      BgEffect := TBgEffect.Create (FAtzClass);
      BgEffect.Initialize (aRealx, aRealy, aShape, aLightEffectKind);
      Feature.rEffectNumber := 0;
   end else begin
      BgEffect.Initialize (aRealx, aRealy, aShape, aLightEffectKind);
      Feature.rEffectNumber := 0;
      exit;
   end;
end;

function    TCharClass.GetArrImageLib (aindex, CurTick: integer): TA2ImageLib;
begin
   if not Feature.rboMan then
      Result := FAtzClass.GetImageLib (char(word('a')+aindex) + format ('%d0.atz', [Feature.rArr[aindex*2]]), CurTick)
   else
      Result := FAtzClass.GetImageLib (char(word('n')+aindex) + format ('%d0.atz', [Feature.rArr[aindex*2]]), CurTick);
end;

function    TCharClass.IsArea ( ax, ay: integer): Boolean;
var
   xp, yp: integer;
   xx, yy: integer;
   pb : pword;
begin
   Result := TRUE;
//   if CharImageBuffer[CharImageBufferIndex].aCharImage = nil then exit;
//   xx := Realx - CharImage.px - CHarMaxSiezHalf;
//   yy := Realy - CharImage.py - CHarMaxSiezHalf;

   xx := Realx + CharImageBuffer[CharImageBufferIndex].aCharImage.px - CHarMaxSiezHalf;
   yy := Realy + CharImageBuffer[CharImageBufferIndex].aCharImage.py - CHarMaxSiezHalf;

   if (ax <= xx) then Result := FALSE;
   if (ay <= yy) then Result := FALSE;
   if ax >= xx + CharImageBuffer[CharImageBufferIndex].aCharImage.Width then Result := FALSE;
   if ay >= yy + CharImageBuffer[CharImageBufferIndex].aCharImage.Height then Result := FALSE;
   if Result = FALSE then exit;

   xp := ax-xx;
   yp := ay-yy;

   pb := PWORD (CharImageBuffer[CharImageBufferIndex].aCharImage.bits);
   inc (pb, xp + yp*CharImageBuffer[CharImageBufferIndex].aCharImage.Width);
   if pb^ = 0 then Result := FALSE;
end;

procedure   TCharClass.Initialize (aName: string; aId, adir, ax, ay: integer; afeature: TFeature);
begin
   Name := aName;
   id := aid; dir := adir; x := ax; y := ay; Feature := aFeature;
   CurFrame := 1;
   CurActionInfo := nil;
   CurAction := -1;
   AniList := Animater.GetAnimationList(aFeature.raninumber);

   FUsed := TRUE;
   OldMakeFrame := -1;

   TurningTick := 0;
   StructedTick := 0;
   StructedPercent := 0;
   BgEffect := nil;
   CharImageBuffer[0].aCharImage := TA2Image.Create (CharMaxSiez, CharMaxSiez, 0, 0);
   CharImageBufferIndex := 0;
end;

procedure   TCharClass.Finalize;
var
   i : integer;
begin
   if BgEffect <> nil then begin
      BgEffect.Free;
      BgEffect := nil;
   end;
   for i := 0 to CharImageBufferCount -1 do begin
      if CharImageBuffer[i].aCharImage <> nil then CharImageBuffer[i].aCharImage.Free;
      CharImageBuffer[i].aCharImage := nil;
      CharImageBuffer[i].aImageNumber := -1;
   end;
   Name := '';
   id := 0; dir := 0; x := 0; y := 0; FillChar (Feature, sizeof(Feature), 0);
   FUsed := FALSE;
end;

procedure TCharClass.Say (astr: string);
begin
   BubbleTick := mmAnsTick;
   BubbleList.Clear;
   BackScreen.GetBubble (BubbleList, astr);
end;

procedure TCharClass.ChangeProperty(pCP : PTSChangeProperty);
begin
   Name := StrPas(@pCP^.rNameString);
end;

function    TCharClass.ProcessMessage (aMsg, adir, ax, ay: Integer; afeature: TFeature; amotion: integer): Integer;
var
   CurTick : integer;
   xx, yy: word;
   i : integer;
//   RMsg : TRecordMessage;
begin
   Result := 0;
   CurTick := mmAnsTick;
   OldMakeFrame := -1;
{
   if (CurActionInfo <> nil) and (id <> CharCenterId) then begin
      RMsg.rMsg := aMsg;
      RMsg.rdir := adir;