fmain.pas

来自「千年源代码,只缺少控件,可以做二次开发用,好不容易得来的」· PAS 代码 · 共 1,212 行 · 第 1/3 页

unit FMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DXDraws, DXClass, DirectX, DXSounds, uSound, Cltype, A2Form, A2Img, uAnsTick,
  ExtCtrls, StdCtrls, BackScrn, CharCls, ClMap, AtzCls, Deftype, subutil,
  PaintLabel, objcls, tilecls, adeftype, AUtil32, IniFiles, CTable, mmsystem,
  uPersonBat; //Log,
  //uActiveMusic;
type
  TFormData = record
     rForm : TForm;
     rOldParent: integer;
     rA2Form : TA2Form;
  end;
  PTFormData = ^TFormData;

  TFrmM = class(TForm)
    PaintLabel: TPaintLabel;
    Timer1: TTimer;
    DXDraw: TDXDraw;
    DXWaveList1: TDXWaveList;
    DXSound1: TDXSound;
    DXTimer1: TDXTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure DXDrawInitialize(Sender: TObject);
    procedure PaintLabelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure PaintLabelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure PaintLabelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure PaintLabelClick(Sender: TObject);
    procedure PaintLabelDblClick(Sender: TObject);
    procedure PaintLabelDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure PaintLabelDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
    procedure PaintLabelStartDrag(Sender: TObject; var DragObject: TDragObject);
    procedure Time1TimerTimer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure DXTimer1Timer(Sender: TObject; LagCount: Integer);
  private
    { Private declarations }
    FormList : TList;
    function  GetMouseDirection: word;
    procedure DrawChatList;
  public
    EventTick : integer;
    DragItem: TDragItem;

    BottomUpImage : TA2Image;
    AttribLeftImage : TA2Image;
    SoundManager : TSoundManager;

//    BaseAudio : TBaseAudio;
//    BaseAudioVolume : integer;
    ChatList : TStringList;
    procedure AddChat ( astr: string; fcolor, bcolor: integer);
    procedure AddA2Form (aform: TForm; aA2Form: TA2Form);
    procedure DelA2Form (aform:TForm; aA2Form : TA2Form);
    procedure SaveAndDeleteAllA2Form;
    procedure RestoreAndAddAllA2Form;

    procedure SetA2Form (aForm: TForm; aA2Form: TA2Form);
    procedure MoveProcess;
    procedure CheckAndSendClick;
    procedure MessageProcess (var code: TWordComData);

    procedure OnAppMessage (var Msg: TMsg; var Handled: Boolean);
    procedure CheckSome (var code: TWordComData);
  end;

var
   FrmM: TFrmM;
   Keyshift : TShiftState;
var
   GrobalClick : TCClick;
   ClickTick : integer = 0;
   HitTick : integer = 0;
   boShiftAttack : Boolean = TRUE;
   mousecheck : boolean = FALSE;
   RightButtonDown : Boolean = FALSE;

   mouseX, mousey : integer;
   MouseCellX, MouseCelly: integer;

   boShowChat : Boolean = FALSE;

   ClientIni : TIniFile;
//   BaseAudio : TBaseAudio;
//   ActiveBaseAudioList : TActiveBaseAudioList;

implementation

uses
   FLogOn, FSelChar, FBottom, FAttrib, FQuantity, FSearch, FExchange, FSound, FDepository,
   FSearchUser, FbatList, FMuMagicOffer, FcMessageBox;
   //, FNpcView, FMunpaCreate, FMunpaimpo, FcMessageBox, FmunpaWarOffer;


{$R *.DFM}
{$O+}
var
   eventbuffer : array [0..10-1] of integer;

procedure TFrmM.OnAppMessage (var Msg: TMsg; var Handled: Boolean);
begin
   if GetAsyncKeyState(VK_SNAPSHOT) <> 0 then if FrmM.Active then FrmBottom.ClientCapture;

   if (Msg.message >= WM_MOUSEMOVE) and (Msg.message <= WM_MBUTTONDBLCLK) then begin
      inc (eventbuffer[Msg.message - WM_MOUSEMOVE]);
   end;
end;

procedure TFrmM.CheckSome (var code: TWordComData);
var
   PsSCheck : PTSCheck;
   CCheck : TCCheck;
begin
   PsSCheck := @Code.data;
   case PsSCheck^.rCheck of
      1 :
         begin
            CCheck.rMsg := CM_CHECK;
            CCheck.rCheck := PsSCheck^.rCheck;
            CCheck.rTick := 1;
            if not FileExists ('.\South.map') then CCheck.rTick := 0;
            if not FileExists ('.\Southobj.obj') then CCheck.rTick := 0;
            if not FileExists ('.\Southrof.Obj') then CCheck.rTick := 0;
            if not FileExists ('.\Southtil.til') then CCheck.rTick := 0;
         end;
      2 :
         begin
            CCheck.rMsg := CM_CHECK;
            CCheck.rCheck := PsSCheck^.rCheck;
            CCheck.rTick := TimeGetTime;
         end;
   end;
   FrmLogOn.SocketAddData (sizeof(CCheck), @CCheck);
end;

procedure TFrmM.FormCreate(Sender: TObject);
begin
   if doFullScreen in DxDraw.Options then BorderStyle := bsNone
   else BorderStyle := bsDialog;

   Chdir (ExtractFilePath (Application.ExeName));

   ClientIni := TIniFile.Create ('.\ClientIni.ini');
   mainFont := ClientIni.ReadString ('FONT', 'FontName','Arial');  // font read
   // FrmM Font Set
   FrmM.Font.Name := mainFont;
   A2FontClass.SetFont (MainFont);

   FormList := TList.Create;

   SoundManager := TSoundManager.Create (DxSound1, 'wav\wav1000y.atw', 'wav\effect.atw', DXWaveList1);
   SoundManager.Volume := ClientIni.ReadInteger ('SOUND','BASEVOLUME', -1000);

//   BaseAudio := TBaseAudio.Create;
//   BaseAudio.SetVolume (SoundManager.Volume);

   if ClientIni.ReadString ('CLIENT','SOUND','ON') <> 'ON' then boUseSound := FALSE
   else boUseSound := TRUE;

   FrmM.SoundManager.Volume := ClientIni.ReadInteger ('SOUND','BASEVOLUME', -2000);
   FrmM.SoundManager.Volume2 := ClientIni.ReadInteger ('SOUND','EFFECTVOLUME', -2000);

//   ActiveBaseAudioList := TActiveBaseAudioList.Create;

   SoundManager.PlayBaseAudio ('logon.wav', 5);
//   SoundManager.PlayBaseAudio ('1003.wav', 5);

   BottomUpImage := TA2Image.Create (4, 4, 0, 0);
   BottomUpImage.LoadFromFile ('bottomup.bmp');
   AttribLeftImage := TA2Image.Create (4, 4, 0, 0);
   AttribLeftImage.LoadFromFile ('attribleft.bmp');

   BackScreen := TBackScreen.Create;
   DragItem := TDragItem.Create;
   TileDataList := TTileDataList.Create;
   ObjectDataList := TObjectDataList.Create;
   RoofDataList := TObjectDataList.Create;

   Map := TMap.Create;
   EffectPositionClass := TEffectPositionClass.Create;
   Animater := TAnimater.Create;
   AtzClass := TAtzClass.Create('.\sprite\');
   EtcAtzClass := TEtcAtzClass.Create;

   CharList := TCharList.Create (AtzClass);
   ChatList := TStringList.Create;

   PersonBat := TPersonBat.Create;

   Application.OnMessage := OnAppMessage;
end;

procedure TFrmM.FormDestroy(Sender: TObject);
begin

   ClientIni.WriteString ('FONT', 'FontName', mainFont);
   ClientIni.WriteInteger ('SOUND','EFFECTVOLUME', SoundManager.Volume);

   ChatList.free;
   CharList.Free;
   AtzClass.Free;
   Animater.Free;
   EtcAtzClass.Free;
   Map.Free;

   TileDataList.Free;
   ObjectDataList.Free;
   RoofDataList.Free;

   DragItem.Free;
   BackScreen.Free;

   AttribLeftImage.Free;
   BottomUpImage.Free;
   SoundManager.Free;

//   ActiveBaseAudioList.Free;
   PersonBat.Free;

   DXSound1.Finalize;
   FormList.Free;
   ClientIni.Free;
end;

procedure TFrmM.DrawChatList;
var
   i: integer;
begin
//   A2SetFontColor (RGB (12, 12, 12)); // back
   for i := 0 to ChatList.Count -1 do begin
      ATextOut (BackScreen.Back, 20+1, i*16+20+1, WinRGB (1, 1, 1), ChatList[i]);
//      A2TextOut (BackScreen.Back, 20+1, i*16+20+1, ChatList[i]);
   end;

//   A2SetFontColor (clsilver);         // front
   for i := 0 to ChatList.Count -1 do begin
      ATextOut (BackScreen.Back, 20, i*16+20, WinRGB (24, 24, 24), ChatList[i]);
//      A2TextOut (BackScreen.Back, 20, i*16+20, ChatList[i]);
   end;
end;

procedure  TFrmM.AddChat ( astr: string; fcolor, bcolor: integer);
var
   str, rdstr: string;
   col : Integer;
   addflag : Boolean;
begin
   addflag := FALSE;
   str := astr;
   while TRUE do begin
      str := GetValidStr3 (str, rdstr, #13);
      if rdstr = '' then break;

      if chat_outcry then begin // 寇摹扁
         if rdstr[1] = '[' then addflag := TRUE;
      end;

      if chat_Guild then begin  // 辨靛
         if rdstr[1] = '<' then addflag := TRUE;
      end;

      if chat_notice then begin // 傍瘤荤亲
         if bcolor = 16912 then addflag := TRUE;
      end;

      if chat_normal then begin  // 老馆蜡历
         if not(bcolor = 16912) and not(rdstr[1] = '<') and not(rdstr[1] = '[') then begin
            addflag := TRUE;
         end;
      end;

      if Addflag then begin
         if ChatList.Count >= 20 then ChatList.delete (0);
         col := MakeLong (fcolor, bcolor);
         ChatList.addObject (rdstr, TObject (col) );
         if SaveChatList.Count > 500 then SaveChatList.Delete (0);
         SaveChatList.Add (rdstr);
      end;
   end;
end;

procedure  TFrmM.SetA2Form (aForm:TForm; aA2Form: TA2Form);
var
   flag : Boolean;
   i: integer;
   pf : PTFormData;
begin
   if (Formlist.Count > 0) and (PTFormData (FormList[0])^.rForm = aForm) then exit;

   for i := 0 to FormList.Count -1 do begin
      pf := FormList[i];
      if pf^.rForm = aForm then begin
         FormList.Delete (i);
         FormList.Insert (0, pf);
         break;
      end;
   end;

   for i := 0 to FormList.count -1 do begin
      pf := FormList[i];
      flag := pf^.rForm.Visible;
      pf^.rForm.visible := FALSE;
      pf^.rForm.parentwindow := 0;
      pf^.rForm.parentwindow := handle;
      pf^.rForm.visible := flag;
   end;
end;

procedure TFrmM.SaveAndDeleteAllA2Form;
var
   i: integer;
   pf : PTFormData;
begin
   for i := 0 to FormList.Count -1 do begin
      pf := FormList[i];
      pf^.rForm.ParentWindow := pf^.roldParent;
   end;
end;

procedure TFrmM.RestoreAndAddAllA2Form;
var
   i: integer;
   pf : PTFormData;
begin
   for i := 0 to FormList.Count -1 do begin
      pf := FormList[i];
      pf^.rForm.ParentWindow := Handle;
   end;
end;

procedure TFrmM.DelA2Form (aform:TForm; aA2Form : TA2Form);
var
   i: integer;
   pf : PTFormData;
begin
   for i := 0 to FormList.Count -1 do begin
      pf := FormList[i];
      if pf^.rForm = aform then begin
        aForm.ParentWindow := pf^.roldParent;
        dispose (pf);
        FormList.Delete (i);
        exit;
      end;
   end;
end;

procedure TFrmM.AddA2Form (aform:TForm; aA2Form : TA2Form);
var pf : PTFormData;
begin
   new (pf);
   pf^.rOldParent := aForm.parentWindow;
   aForm.ParentWindow := Handle;
   pf^.rForm := aForm;
   pf^.rA2Form := aA2Form;
   FormList.Add (pf);
end;

procedure TFrmM.DXDrawInitialize(Sender: TObject);
const
   first : Boolean = TRUE;
begin
   if first then begin
      first := FALSE;
      DxTimer1.Enabled := TRUE;
      FrmLogon.visible := TRUE;
      FrmLogon.FormActivate(Self);
   end;
end;

function  TFrmM.GetMouseDirection: word;
var
   xx, yy: integer;
   MCellX, MCellY : integer;
   Cl, Sl : TCharClass;
begin
   Result := DR_DONTMOVE;
   Cl := CharList.GetChar (CharCenterId);
   if cl = nil then exit;
   xx := BackScreen.Cx + (Mousex-BackScreen.SWidth div 2);
   yy := BackScreen.Cy + (Mousey-BackScreen.SHeight div 2);

   MCellX := xx div UNITX;
   MCellY := yy div UNITY;

   if SelectedChar <> 0 then begin
      SL := CharList.GetChar (SelectedChar);
      if SL <> nil then begin
         MCellX := Sl.X;
         MCellY := SL.Y;
      end;
   end;

   Result := GetViewDirection (cl.x, cl.y, mcellx, mcelly);
end;

var
   SelScreenId : integer = 0;
   SelScreenX : integer = 0;
   SelScreenY : integer = 0;