CentrED/Client/UfrmLogin.pas

(*
 * CDDL HEADER START
 *
 * The contents of this file are subject to the terms of the
 * Common Development and Distribution License, Version 1.0 only
 * (the "License").  You may not use this file except in compliance
 * with the License.
 *
 * You can obtain a copy of the license at
 * http://www.opensource.org/licenses/cddl1.php.
 * See the License for the specific language governing permissions
 * and limitations under the License.
 *
 * When distributing Covered Code, include this CDDL HEADER in each
 * file and include the License file at
 * http://www.opensource.org/licenses/cddl1.php.  If applicable,
 * add the following below this CDDL HEADER, with the fields enclosed
 * by brackets "[]" replaced with your own identifying * information:
 *      Portions Copyright [yyyy] [name of copyright owner]
 *
 * CDDL HEADER END
 *
 *
 *      Portions Copyright 2009 Andreas Schneider
 *)
unit UfrmLogin;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls, Spin, EditBtn, Buttons, IniFiles, LConvEncoding, LazHelpHTML,
  ShellAPI, Registry, AeroGlass;

type

  { TfrmLogin }

  TfrmLogin = class(TForm)
    btnOK: TButton;
    btnCancel: TButton;
    btnDefaultOptions: TSpeedButton;
    cbProfile: TComboBox;
    cbLanguage: TComboBox;
    edData: TDirectoryEdit;
    edHost: TEdit;
    edUsername: TEdit;
    edPassword: TEdit;
    gbBaner: TGroupBox;
    gbConnection: TGroupBox;
    gbData: TGroupBox;
    gbActions: TGroupBox;
    gbProfiles: TGroupBox;
    imgBaner: TImage;
    imgHost: TImage;
    imgUsername: TImage;
    imgPassword: TImage;
    lblCopyright: TLabel;
    lblHost: TLabel;
    lblPlusCopyright: TLabel;
    lblUsername: TLabel;
    lblPassword: TLabel;
    edPort: TSpinEdit;
    lblData: TLabel;
    btnSaveProfile: TSpeedButton;
    btnDeleteProfile: TSpeedButton;
    BanerAnim: TTimer;
    pLayout: TPanel;
    procedure BanerAnimTimer(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure btnDefaultOptionsClick(Sender: TObject);
    procedure btnDeleteProfileClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure btnSaveProfileClick(Sender: TObject);
    procedure cbLanguageChange(Sender: TObject);
    procedure cbProfileChange(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BanerClick(Sender: TObject);
    procedure BanerMouseEnter(Sender: TObject);
    procedure BanerMouseLeave(Sender: TObject);
    procedure BanerDrawImage(baner : array of Byte);
  protected
    FProfilePath: string;
  public
    { public declarations }
    SaveProfileCaption: string;
    SaveProfileDescription: string;
  end; 

var
  frmLogin: TfrmLogin;
  sprofile: string;
  LastTickCount: DWORD;

implementation

uses
  UdmNetwork, Logging, vinfo, Language;
  
{$I version.inc}

{ TfrmLogin }

procedure TfrmLogin.btnCancelClick(Sender: TObject);
begin
  Close;
end;



procedure TfrmLogin.btnDefaultOptionsClick(Sender: TObject);
begin
  if cbProfile.ItemIndex > -1 then
  begin
    DeleteFile(FProfilePath + UTF8ToCP1251(cbProfile.Text) + PathDelim + 'RadarMap.cache');
    DeleteFile(FProfilePath + UTF8ToCP1251(cbProfile.Text) + PathDelim + 'TilesEntry.cache');
    DeleteFile(FProfilePath + UTF8ToCP1251(cbProfile.Text) + PathDelim + 'Config.xml');
  end;
end;

procedure TfrmLogin.btnDeleteProfileClick(Sender: TObject);
begin
  if cbProfile.ItemIndex > -1 then
  begin
    DeleteFile(FProfilePath + UTF8ToCP1251(cbProfile.Text) + PathDelim + 'login.ini');
    RemoveDir(FProfilePath + UTF8ToCP1251(cbProfile.Text));
    cbProfile.Items.Delete(cbProfile.ItemIndex);
    sprofile := '';
  end;
end;

procedure TfrmLogin.btnOKClick(Sender: TObject);
var
  path: string;
  configDir: string;
  settings: TIniFile;
  ARegistry: TRegistry;
begin
  // Загрузка настроек
  ARegistry := TRegistry.Create();
  ARegistry.RootKey := HKEY_LOCAL_MACHINE;
  ARegistry.OpenKey('\SOFTWARE\Quintessence\UO CentrED+', False);
  if ARegistry.ReadBool('UseConfigDir')
    then configDir := GetAppConfigDir(False)
    else configDir := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName))
                      + '..' + PathDelim + 'LocalData' + PathDelim + 'UsersData' + PathDelim ;
  ARegistry.Free;

  // Сохранение настроек
  settings := TIniFile.Create(configDir + 'LoginSettings.ini');
  settings.WriteString('Connection', 'Host', edHost.Text);
  settings.WriteInteger('Connection', 'Port', edPort.Value);
  settings.WriteString('Connection', 'Username', edUsername.Text);
  settings.WriteString('Data', 'Path', edData.Text);
  if (cbProfile.ItemIndex > -1) and (cbProfile.ItemIndex < cbProfile.Items.Count) then
     settings.WriteString('Profile', 'Last', cbProfile.Items[cbProfile.ItemIndex])
  else
     settings.WriteString('Profile', 'Last', '');
  if (cbLanguage.ItemIndex > -1) and (cbLanguage.ItemIndex < cbLanguage.Items.Count) then
     settings.WriteString('Profile', 'Lang', LanguageGetName)
  else
     settings.WriteString('Profile', 'Lang', '');
  settings.Free;
  {
  // Проверка путей
  path := IncludeTrailingPathDelimiter(UTF8ToCP1251(edData.Text));
  if (not FileExists(path + 'art.mul')) or
     (not FileExists(path + 'artidx.mul')) or                 LangDirectory := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + PathDelim + 'Language' + PathDelim;

     (not FileExists(path + 'hues.mul')) or
     (not FileExists(path + 'tiledata.mul')) or
     (not FileExists(path + 'animdata.mul')) or
     (not FileExists(path + 'texmaps.mul')) or
     (not FileExists(path + 'texidx.mul')) or
     (not FileExists(path + 'light.mul')) or
     (not FileExists(path + 'lightidx.mul')) then
  begin
    MessageDlg('Неверный путь', 'Указанный вами путь, не является коректным,'
      + ' т.к. не содержит требуемые файлы.', mtWarning, [mbOK], 0);
    edData.SetFocus;
  end else }
    ModalResult := mrOK;
  Logger.Send([lcClient, lcInfo], 'Начинаем соеденинение с сервером');
end;

procedure TfrmLogin.btnSaveProfileClick(Sender: TObject);
var
  profileName: string;
  profile: TIniFile;
begin
  profileName := cbProfile.Text;
  if InputQuery(SaveProfileCaption, SaveProfileDescription, profileName) then
  begin
    if not DirectoryExists(FProfilePath + UTF8ToCP1251(profileName))
      then ForceDirectories(FProfilePath + UTF8ToCP1251(profileName));
    profile := TIniFile.Create(FProfilePath + UTF8ToCP1251(profileName) + PathDelim + 'login.ini');
    profile.WriteString('Connection', 'Host', UTF8ToCP1251(edHost.Text));
    profile.WriteInteger('Connection', 'Port', edPort.Value);
    profile.WriteString('Connection', 'Username', UTF8ToCP1251(edUsername.Text));
    profile.WriteString('Data', 'Path', UTF8ToCP1251(edData.Text));
    profile.Free;
    cbProfile.ItemIndex := cbProfile.Items.IndexOf(profileName);
    if cbProfile.ItemIndex = -1 then
    begin
      cbProfile.Items.Add(profileName);
      cbProfile.ItemIndex := cbProfile.Items.Count - 1;
      cbProfileChange(nil);
    end;
  end;
end;

procedure TfrmLogin.cbLanguageChange(Sender: TObject);
begin
  LanguageSet(cbLanguage.ItemIndex);
  LanguageTranslate(Self);
  cbLanguage.Hint := LanguageGetName();
  Self.Repaint;
end;

procedure TfrmLogin.cbProfileChange(Sender: TObject);
var
  profile: TIniFile;
begin
  if cbProfile.ItemIndex > -1 then
  begin
    btnDefaultOptions.Enabled := true;
    btnDeleteProfile.Enabled  := true;
    sprofile := cbProfile.Text;
    profile := TIniFile.Create(FProfilePath + UTF8ToCP1251(cbProfile.Text) + PathDelim + 'login.ini');
    edHost.Text := CP1251ToUTF8(profile.ReadString('Connection', 'Host', ''));
    edPort.Value := profile.ReadInteger('Connection', 'Port', 2597);
    edUsername.Text := CP1251ToUTF8(profile.ReadString('Connection', 'Username', ''));
    edPassword.Text := '';
    edData.Text := CP1251ToUTF8(profile.ReadString('Data', 'Path', ''));
    if Sender <> nil then
       edPassword.SetFocus;
    profile.Free;
  end else begin
    btnDefaultOptions.Enabled := false;
    btnDeleteProfile.Enabled := false;
    sprofile := '';
  end;
end;

procedure TfrmLogin.FormActivate(Sender: TObject);
begin
  GlassForm(frmLogin);
end;

procedure TfrmLogin.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  if ModalResult <> mrOK then
    dmNetwork.CheckClose(Self);
end;

procedure TfrmLogin.FormCreate(Sender: TObject);
var
  searchRec: TSearchRec;
  iniSettings: TIniFile;
  lastProfile: string;
  lastLanguage: string;
  nodeindex: integer;
  langDirectory: string;
  langFileName : string;
  ARegistry: TRegistry;
  configDir: string;
begin
  Width := 494;
  Height := 266;

  Caption := Format('UO CentrED+ v%s build: %d',
  //Caption := Format('UO CentrED+ v%s build: %d  !!! pre-release (not stable version) !!! ',
            [VersionInfo.GetProductVersionString, VersionInfo.Build]);
  lblCopyright.Caption := Format('%s || "UO CentrED+" ver %s (c) %s',
    [Original, VersionInfo.GetFileVersionString, Copyright]);
  BanerMouseLeave(Sender);
  edData.DialogTitle:=lblData.Caption;

  // Загрузка настроек
  ARegistry := TRegistry.Create();
  ARegistry.RootKey := HKEY_LOCAL_MACHINE;
  ARegistry.OpenKey('\SOFTWARE\Quintessence\UO CentrED+', False);
  if ARegistry.ReadBool('UseConfigDir')
    then configDir := GetAppConfigDir(False)
    else configDir := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName))
                      + '..' + PathDelim + 'LocalData' + PathDelim + 'UsersData' + PathDelim ;
  ARegistry.Free;

  sprofile := '';
  iniSettings := TIniFile.Create(configDir + 'LoginSettings.ini');
  lastProfile := iniSettings.ReadString('Profile', 'Last', '');
  lastLanguage:= iniSettings.ReadString('Profile', 'Lang', '');

  FProfilePath := configDir + 'Profiles' + PathDelim;
  ForceDirectories(FProfilePath);
  if FindFirst(FProfilePath + '*', faDirectory, searchRec) = 0 then
  begin
    repeat
      if FileExists(FProfilePath + PathDelim + searchRec.Name + PathDelim + 'login.ini') then
      begin
        nodeindex := cbProfile.Items.Add(CP1251ToUTF8(searchRec.Name));
        if (cbProfile.Items[nodeindex] <> '') and (cbProfile.Items[nodeindex] = lastProfile) then
        begin
          cbProfile.ItemIndex := nodeindex;
          cbProfileChange(nil);
        end;
      end;
    until FindNext(searchRec) <> 0;
  end;
  FindClose(searchRec);

  if (cbProfile.ItemIndex < 0) or (lastprofile = '') then
  begin
    edHost.Text := iniSettings.ReadString('Connection', 'Host', 'localhost');
    edPort.Value := iniSettings.ReadInteger('Connection', 'Port', 2597);
    edUsername.Text := iniSettings.ReadString('Connection', 'Username', '');
    edPassword.Text := '';
    edData.Text := iniSettings.ReadString('Data', 'Path', '');
  end;

  iniSettings.Free;

  // Загрузка локализаций
  LangDirectory := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName))
                   + PathDelim + '..' + PathDelim +'Language' + PathDelim;
  LanguageLoad(Self, lastLanguage, LangDirectory);
end;

procedure TfrmLogin.FormShow(Sender: TObject);
begin
  edPassword.SetFocus;
end;

procedure TfrmLogin.BanerClick(Sender: TObject);
begin
  // Открываем сайт в браузере по умолчанию
  ShellExecute(Handle, 'open', PChar('http://dev.uoquint.ru'), nil, nil, 1 {SW_SHOWNORMAL});
end;

procedure TfrmLogin.BanerDrawImage(baner : array of Byte);
var stream: TMemoryStream;
begin
  stream := TMemoryStream.Create;
  stream.Write(baner[0],SizeOf(baner));
  stream.Position:=0;
  imgBaner.Picture.Bitmap.LoadFromStream(stream);
  imgBaner.Update;
  stream.Free;
end;

//function GetTickCount:DWORD; external 'kernel32' name 'GetTickCount';
procedure TfrmLogin.BanerAnimTimer(Sender: TObject);
var NowsTickCount : DWORD;
begin { Таймер и GetTickCount вообще не работают!!!
  NowsTickCount := GetTickCount;
  if (NowsTickCount - LastTickCount) < 10000 then exit;
  LastTickCount := NowsTickCount;

  if BanerAnim.Tag = 1 then begin
    BanerAnim.Tag := 2; BanerDrawImage(baner_u);
  end;
  if BanerAnim.Tag = 2 then begin
    BanerAnim.Tag := 1; BanerDrawImage(baner_h);
  end; }
end;

procedure TfrmLogin.BanerMouseEnter(Sender: TObject);
var stream: TMemoryStream;
begin
  lblPlusCopyright.Font.Color:= $FF0000;
  lblPlusCopyright.Font.Size := 10;
  BanerDrawImage(baner_h);
end;

procedure TfrmLogin.BanerMouseLeave(Sender: TObject);
var stream: TMemoryStream;
begin
  lblPlusCopyright.Font.Color:= $000000;
  lblPlusCopyright.Font.Size := 8;
  BanerDrawImage(baner_u);
end;

initialization
  {$I UfrmLogin.lrs}

end.