Delphiその7

　こんにちは、童爺です。

　今日は休むと言いつつ、どうしても気に入らない箇所があったので修正しました。

　元のダイアログ。

　で、新しいダイアログ。

　です。

　キャプションの部分がプロジェクト名だったのを、新しいダイアログを作成し、日本語に修正しました。

　以下コード。

unit MMS_CommonDialog;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
  FMX.Controls.Presentation, FMX.Layouts;

type
  TForm_MsgDlg = class(TForm)
    Layout_Button: TLayout;
    Button_MsgDlg: TButton;
    Label_MsgDlg: TLabel;
    procedure Button_MsgDlgClick(Sender: TObject);
  private
    { private 宣言 }
  public
    { public 宣言 }
    constructor Create(AOwner: TComponent; const Msg: String); reintroduce;
  end;

var
  Form_MsgDlg: TForm_MsgDlg;

implementation

{$R *.fmx}

procedure TForm_MsgDlg.Button_MsgDlgClick(Sender: TObject);
begin
  Close;
end;

constructor TForm_MsgDlg.Create(AOwner: TComponent; const Msg: String);
begin
  inherited Create(AOwner);

  Label_MsgDlg.Text := Msg;
end;

end.

　合わせて本体の方も修正しました。

　以下コード。

unit UserLoginMain;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Edit,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts, FireDAC.Stan.Intf,
  FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf,
  FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys,
  FireDAC.Phys.SQLite, FireDAC.Phys.SQLiteDef, FireDAC.Stan.ExprFuncs,
  FireDAC.FMXUI.Wait, FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf,
  FireDAC.DApt, Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client;

type
  TForm_UserLoginMain = class(TForm)
    Layout_Header: TLayout;
    Layout_UserName: TLayout;
    Layout_Password: TLayout;
    Layout_Login: TLayout;
    Layout_NewUserCreate: TLayout;
    Layout_Footer: TLayout;
    Label_Caption: TLabel;
    Label_UserName: TLabel;
    Label_Password: TLabel;
    Edit_UserName: TEdit;
    Edit_Password: TEdit;
    Button_Login: TButton;
    Button_NewUserCreate: TButton;
    Button_Close: TButton;
    FDConnection_UserLoginMain: TFDConnection;
    FDQuery_UserLoginMain: TFDQuery;
    procedure Button_LoginClick(Sender: TObject);
    procedure Button_NewUserCreateClick(Sender: TObject);
    procedure Button_CloseClick(Sender: TObject);
  private
    { private 宣言 }
  public
    { public 宣言 }
  end;

var
  Form_UserLoginMain: TForm_UserLoginMain;

implementation

{$R *.fmx}

uses
  System.Hash,
  MMS_CommonDialog;

procedure TForm_UserLoginMain.Button_NewUserCreateClick(Sender: TObject);
begin
//後で追加
end;

procedure TForm_UserLoginMain.Button_CloseClick(Sender: TObject);
begin
  Close;
end;

procedure TForm_UserLoginMain.Button_LoginClick(Sender: TObject);
var
  result: Integer;
  MD5: THashMD5;
  UserName: String;
  Password: String;
  administrator: String;
  admin: String;
  root: String;
  MsgDlg: TForm_MsgDlg;
begin

  result := 0;
  UserName := Edit_UserName.Text;
  Password := Edit_Password.Text;

  //工事中

  try
    try
      FDConnection_UserLoginMain.Open;

      FDQuery_UserLoginMain.Params.ParamByName('input_username').AsString := UserName;

      MD5 := THashMD5.Create;
      MD5.Update(Password);
      FDQuery_UserLoginMain.Params.ParamByName('input_password').AsString := MD5.HashAsString;
      FDQuery_UserLoginMain.Open();
      result := FDQuery_UserLoginMain.RecordCount;
    except
      on e: Exception do
      begin
        MsgDlg := TForm_MsgDlg.Create(self, 'Error:' + e.Message);
        MsgDlg.ShowModal;
      end;
    end;
  finally
    FDQuery_UserLoginMain.Close;
    FDConnection_UserLoginMain.Close;
  end;

  //仮の処理　工事中
  if result > 0 then
  begin
    administrator := 'administrator';
    admin := 'admin';
    root := 'root';
    if (AnsiCompareText(UserName, administrator) = 0) or
       (AnsiCompareText(UserName, admin) = 0) or
       (AnsiCompareText(UserName, root) = 0) then
    begin
      //工事中
        MsgDlg := TForm_MsgDlg.Create(self, 'OK! 管理画面へGo!');
        MsgDlg.ShowModal;
    end
    else
    begin
      //工事中
        MsgDlg := TForm_MsgDlg.Create(self, 'OK! ユーザ詳細へGo!');
        MsgDlg.ShowModal;
    end;
  end
  else
  begin
        MsgDlg := TForm_MsgDlg.Create(self, 'ユーザー名またはパスワードが違います。');
        MsgDlg.ShowModal;
  end;

end;

end.

　以上です。

　他のMessage関連のダイアログ探すより早いかなーと思って。

　簡単に修正できそうだったので、サクッと作っちゃいました。

　あーでも、少し変更かけるかもしれません。

　大した変更じゃないですが。

　そんな感じですかね。

---

　それではまた。

　でわでわ。