introscn.pas

在网上有很多传奇源程序DELPHI

   //EdPasswd.Visible := FALSE;
   //FrmDlg.DLogin.Visible := FALSE;
   ChangeLoginState (lsCloseAll);
end;

procedure TLoginScene.OpenLoginDoor;
begin
   NowOpening := TRUE;
   StartTime := GetTickCount;
   HideLoginBox;
   PlaySound (s_rock_door_open);
end;

procedure TLoginScene.PlayScene (MSurface: TDirectDrawSurface);
var
   d: TDirectDrawSurface;
begin
   if BoOpenFirst then begin
      BoOpenFirst := FALSE;
      EdId.Visible := TRUE;
      EdPasswd.Visible := TRUE;
      EdId.SetFocus;
   end;
   d := FrmMain.WChrSel.Images[102-80];
   if d <> nil then begin
      MSurface.Draw (0, 0, d.ClientRect, d, FALSE);
   end;
   //开门
   if NowOpening then begin
      if GetTickCount - StartTime > 230 then begin
         StartTime := GetTickCount;
         Inc (CurFrame);
      end;
      if CurFrame >= MaxFrame-1 then begin
         CurFrame := MaxFrame-1;
         if not DoFadeOut and not DoFadeIn then begin
            DoFadeOut := TRUE;
            DoFadeIn := TRUE;
            FadeIndex := 29;
         end;
      end;
      d := FrmMain.WChrSel.Images[103+CurFrame-80];
      if d <> nil then
         MSurface.Draw (152, 96, d.ClientRect, d, TRUE);

      if DoFadeOut then begin
         if FadeIndex <= 1 then begin
            FrmMain.WProgUse.ClearCache;
            FrmMain.WChrSel.ClearCache;
            DScreen.ChangeScene (stSelectChr); //辑滚俊辑 某腐磐 沥焊啊 坷搁 急琶芒栏肺 逞绢埃促.
         end;
      end;
   end;
end;

procedure TLoginScene.ChangeLoginState (state: TLoginState);
var
   i, focus: integer;
   c: TControl;
begin
   focus := -1;
   case state of
      lsLogin: focus := 10;
      lsNewIdRetry, lsNewId: focus := 11;
      lsChgpw: focus := 12;
      lsCloseAll: focus := -1;
   end;
   with FrmMain do begin  //login
      for i:=0 to ControlCount-1 do begin
         c := Controls[i];
         if c is TEdit then begin
            if c.Tag in [10..12] then begin
               if c.Tag = focus then begin
                  c.Visible := TRUE;
                  TEdit(c).Text := '';
               end else begin
                  c.Visible := FALSE;
                  TEdit(c).Text := '';
               end;
            end;
         end;
      end;
      if EnglishVersion then  //康巩滚傈篮 林刮殿废锅龋 涝仿阑 救茄促.
         EdSSNo.Visible := FALSE;

      case state of
         lsLogin:
            begin
               FrmDlg.DNewAccount.Visible := FALSE;
               FrmDlg.DChgPw.Visible := FALSE;
               FrmDlg.DLogin.Visible := TRUE;
               if EdId.Visible then EdId.SetFocus;
            end;
         lsNewIdRetry,
         lsNewId:
            begin
               if BoUpdateAccountMode then
                  EdNewId.Enabled := FALSE
               else
                  EdNewId.Enabled := TRUE;
               FrmDlg.DNewAccount.Visible := TRUE;
               FrmDlg.DChgPw.Visible := FALSE;
               FrmDlg.DLogin.Visible := FALSE;
               if EdNewId.Visible and EdNewId.Enabled then begin
                  EdNewId.SetFocus;
               end else begin
                  if EdConfirm.Visible and EdConfirm.Enabled then
                     EdConfirm.SetFocus;
               end;
            end;
         lsChgpw:
            begin
               FrmDlg.DNewAccount.Visible := FALSE;
               FrmDlg.DChgPw.Visible := TRUE;
               FrmDlg.DLogin.Visible := FALSE;
               if EdChgId.Visible then EdChgId.SetFocus;
            end;
         lsCloseAll:
            begin
               FrmDlg.DNewAccount.Visible := FALSE;
               FrmDlg.DChgPw.Visible := FALSE;
               FrmDlg.DLogin.Visible := FALSE;
            end;
      end;
   end;
end;

procedure TLoginScene.NewClick;
begin
   BoUpdateAccountMode := FALSE;
   FrmDlg.NewAccountTitle := '';
   ChangeLoginState (lsNewId);
end;

procedure TLoginScene.NewIdRetry (boupdate: Boolean);
begin
   BoUpdateAccountMode := boupdate;
   ChangeLoginState (lsNewidRetry);
   EdNewId.Text     := NewIdRetryUE.LoginId;
   EdNewPasswd.Text := NewIdRetryUE.Password;
   EdYourName.Text  := NewIdRetryUE.UserName;
   EdSSNo.Text      := NewIdRetryUE.SSNo;
   EdQuiz1.Text     := NewIdRetryUE.Quiz;
   EdAnswer1.Text   := NewIdRetryUE.Answer;
   EdPhone.Text     := NewIdRetryUE.Phone;
   EdEMail.Text     := NewIdRetryUE.EMail;
   EdQuiz2.Text     := NewIdRetryAdd.Quiz2;
   EdAnswer2.Text   := NewIdRetryAdd.Answer2;
   EdMobPhone.Text  := NewIdRetryAdd.MobilePhone;
   EdBirthDay.Text  := NewIdRetryAdd.BirthDay;
end;

procedure TLoginScene.UpdateAccountInfos (ue: TUserEntryInfo);
begin
   NewIdRetryUE := ue;
   FillChar (NewIdRetryAdd, sizeof(TUserEntryAddInfo), #0);
   BoUpdateAccountMode := TRUE; //扁粮俊 乐绰 沥焊甫 犁涝仿窍绰 版快
   NewIdRetry (TRUE);
   FrmDlg.NewAccountTitle := '(帐号更新.)';
end;

procedure TLoginScene.OkClick;
var
   key: char;
begin
   key := #13;
   EdLoginPasswdKeyPress (self, key);
end;

procedure TLoginScene.ChgPwClick;
begin
   ChangeLoginState (lsChgPw);
end;

function  TLoginScene.CheckUserEntrys: Boolean;
begin
   Result := FALSE;
   EdNewId.Text := Trim(EdNewId.Text);
   EdQuiz1.Text := Trim(EdQuiz1.Text);
   EdYourName.Text := Trim(EdYourName.Text);
   if not NewIdCheckNewId then exit;

   if not EnglishVersion then begin //康巩 滚傈俊辑绰 眉农救窃
      if not NewIdCheckSSNo then
         exit;
   end;

   if not NewIdCheckBirthday then exit;
   if Length(EdNewId.Text) < 3 then begin
      EdNewId.SetFocus;
      exit;
   end;
   if Length(EdNewPasswd.Text) < 3 then begin
      EdNewPasswd.SetFocus;
      exit;
   end;
   if EdNewPasswd.Text <> EdConfirm.Text then begin
      EdConfirm.SetFocus;
      exit;
   end;
   if Length(EdQuiz1.Text) < 1 then begin
      EdQuiz1.SetFocus;
      exit;
   end;
   if Length(EdAnswer1.Text) < 1 then begin
      EdAnswer1.SetFocus;
      exit;
   end;
   if Length(EdQuiz2.Text) < 1 then begin
      EdQuiz2.SetFocus;
      exit;
   end;
   if Length(EdAnswer2.Text) < 1 then begin
      EdAnswer2.SetFocus;
      exit;
   end;
   if Length(EdYourName.Text) < 1 then begin
      EdYourName.SetFocus;
      exit;
   end;
   if not EnglishVersion then begin //康巩 滚傈俊辑绰 眉农救窃
      if Length(EdSSNo.Text) < 1 then begin
         EdSSNo.SetFocus;
         exit;
      end;
   end;
   Result := TRUE;
end;

procedure TLoginScene.NewAccountOk;
var
   ue: TUserEntryInfo;
   ua: TUserEntryAddInfo;
begin
   if CheckUserEntrys then begin
      FillChar (ue, sizeof(TUserEntryInfo), #0);
      FillChar (ua, sizeof(TUserEntryAddInfo), #0);
      ue.LoginId := LowerCase(EdNewId.Text);
      ue.Password := EdNewPasswd.Text;
      ue.UserName := EdYourName.Text;
      //
      if not EnglishVersion then
         ue.SSNo := EdSSNo.Text
      else
          ue.SSNo := '650101-1455111';

      ue.Quiz := EdQuiz1.Text;
      ue.Answer := Trim(EdAnswer1.Text);
      ue.Phone := EdPhone.Text;
      ue.EMail := Trim(EdEMail.Text);

      ua.Quiz2 := EdQuiz2.Text;
      ua.Answer2 := Trim(EdAnswer2.Text);
      ua.Birthday := EdBirthday.Text;
      ua.MobilePhone := EdMobPhone.Text;

      NewIdRetryUE := ue;    //犁矫档锭 荤侩
      NewIdRetryUE.LoginId := '';
      NewIdRetryUE.Password := '';
      NewIdRetryAdd := ua;

      if not BoUpdateAccountMode then
         FrmMain.SendNewAccount (ue, ua)
      else
         FrmMain.SendUpdateAccount (ue, ua);
      BoUpdateAccountMode := FALSE;
      NewAccountClose;
   end;
end;

procedure TLoginScene.NewAccountClose;
begin
   if not BoUpdateAccountMode then
      ChangeLoginState (lsLogin);
end;

procedure TLoginScene.ChgpwOk;
var
   uid, passwd, newpasswd: string;
begin
   if EdChgNewPw.Text = EdChgRepeat.Text then begin
      uid := EdChgId.Text;
      passwd := EdChgCurrentPw.Text;
      newpasswd := EdChgNewPw.Text;
      FrmMain.SendChgPw (uid, passwd, newpasswd);
      ChgpwCancel;
   end else begin
      FrmDlg.DMessageDlg ('货 厚剐锅龋 犁涝仿 犬牢捞 嘎瘤 臼嚼聪促.', [mbOk]);
      EdChgNewPw.SetFocus;
   end;
end;

procedure TLoginScene.ChgpwCancel;
begin
   ChangeLoginState (lsLogin);
end;


{-------------------- TSelectChrScene ------------------------}

constructor TSelectChrScene.Create;
begin
   CreateChrMode := FALSE;
   FillChar (ChrArr, sizeof(TSelChar)*2, #0);
   ChrArr[0].FreezeState := TRUE; //扁夯捞 倔绢 乐绰 惑怕
   ChrArr[1].FreezeState := TRUE;
   NewIndex := 0;
   EdChrName := TEdit.Create (FrmMain.Owner);
   with EdChrName do begin
      Parent := FrmMain;
      Height := 16;
      Width  := 137;
      BorderStyle := bsNone;
      Color := clBlack;
      Font.Color := clWhite;
      ImeMode := LocalLanguage;
      MaxLength := 14;
      Visible := FALSE;
      OnKeyPress := EdChrnameKeyPress;
   end;
   SoundTimer := TTimer.Create (FrmMain.Owner);
   with SoundTimer do begin
      OnTimer := SoundOnTimer;
      Interval := 1;
      Enabled := FALSE;
   end;
   inherited Create (stSelectChr);
end;

destructor TSelectChrScene.Destroy;
begin
   inherited Destroy;
end;

procedure TSelectChrScene.OpenScene;
begin
   FrmDlg.DSelectChr.Visible := TRUE;
   SoundTimer.Enabled := TRUE;
   SoundTimer.Interval := 1;
end;

procedure TSelectChrScene.CloseScene;
begin
   SilenceSound;
   FrmDlg.DSelectChr.Visible := FALSE;
   SoundTimer.Enabled := FALSE;
end;

procedure TSelectChrScene.SoundOnTimer (Sender: TObject);
begin
   PlayBGM (bmg_select);
   SoundTimer.Enabled := FALSE;
   //SoundTimer.Interval := 38 * 1000;
end;

procedure TSelectChrScene.SelChrSelect1Click;
begin
   if (not ChrArr[0].Selected) and (ChrArr[0].Valid) then begin
      ChrArr[0].Selected := TRUE;
      ChrArr[1].Selected := FALSE;
      ChrArr[0].Unfreezing := TRUE;
      ChrArr[0].AniIndex := 0;
      ChrArr[0].DarkLevel := 0;
      ChrArr[0].EffIndex := 0;
      ChrArr[0].StartTime := GetTickCount;
      ChrArr[0].MoreTime := GetTickCount;
      ChrArr[0].StartEffTime := GetTickCount;
      PlaySound (s_meltstone);
   end;
end;

procedure TSelectChrScene.SelChrSelect2Click;
begin