⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 untlogin.pas

📁 简要说明:对医院幼儿心理情况做的一个调查,统计系统.
💻 PAS
字号:
unit untLogin;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, DB, ADODB, untGlobalVar, jpeg, untBase;

type
  TfrmLogin = class(TfrmBase)
    adsUser: TADODataSet;
    Image1: TImage;
    edtPassWord: TEdit;
    cbUser: TComboBox;
    lblOK: TLabel;
    btnCancel: TLabel;
    Label1: TLabel;
    procedure FormShow(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure lblOKClick(Sender: TObject);
    procedure edtPassWordKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnCancelClick(Sender: TObject);
    procedure cbUserExit(Sender: TObject);
  private
    { Private declarations }
    FLoginInfo: TUserRec;
    //function UserExists(strUserNo: string): Boolean;
    //function CheckUser(UserPwd: string; var ALoginInfo: TUserRec): Boolean;
    Function GenCombobox(CbName: TComboBox; SqlTxt: String; DispFlds: Array of String; AddItem: String = '全部'): Boolean;
    Function GetItemText(CbName: TComboBox; Index: Integer; Spector: String = '|'; FldIndex: Integer = 1): String;
  public
    { Public declarations }
    Conn: TADOConnection;
  end;

function GetLoginInfo(AConn: TADOConnection; var ALoginInfo: TUserRec): Boolean;

implementation

uses untDM;

function GetLoginInfo(AConn: TADOConnection; var ALoginInfo: TUserRec): Boolean;
begin
  with TfrmLogin.Create(Application) do
  begin
    Conn := AConn;
    result := ShowModal = mrOK;
    if result then
      ALoginInfo := FLoginInfo;
    Free;
  end;
end;

{$R *.dfm}

procedure TfrmLogin.FormShow(Sender: TObject);
begin
  inherited;
  if adsUser.Active then adsUser.Active := false;
  adsUser.Connection := Conn;
  adsUser.Active := True;
end;

procedure TfrmLogin.SpeedButton2Click(Sender: TObject);
begin
  inherited;
  ModalResult := mrCancel;
end;

procedure TfrmLogin.FormCreate(Sender: TObject);
begin
  inherited;
  GenComboBox(cbUser, 'Select * From tDoctor where IsUsed=1 Order By code', ['code','name'],'');
end;

function TfrmLogin.GenCombobox(CbName: TComboBox; SqlTxt: String;
  DispFlds: array of String; AddItem: String): Boolean;
var i : integer;
   ItemStr, tmpStr: string;
   FldLen: integer;
   QryTmp: TADOQuery;
   AFldLen: Array of Integer;
begin
  Result := False;
  Setlength(AFldLen, High(DispFlds)+1);
  For I := Low(AFldLen) to  High(AFldLen) do
    AFldLen[i] := 0;
  QryTmp := TADOQuery.Create(Nil);
  Try
    With CbName.Items do
    begin
      Clear;
      if AddItem <> '' then
        Add(AddItem);
      With qryTmp do
      begin
        Connection := DM.cnn;
        if Active Then Close;
        Sql.Clear;
        Sql.Add(sqlTxt);
        Try
          Active := True;
        Except
          Exception.Create('Sql Statement Not Right!');
          Exit;
        end;
        //得到最小宽度
        First;
        while Not Eof do
        begin
          For I := Low(DispFlds) to High(DispFlds) do
          begin
            FldLen := Length(Trim(FieldByName(DispFlds[i]).AsString));
            if FldLen > AFldLen[i] then
              AFldLen[i] := FldLen;
          end;
          Next;
        end;
        First;
        while Not Eof do
        begin
          ItemStr := '';
          For I := Low(DispFlds) to High(DispFlds) do
          begin
            FldLen := AFldLen[i];
            TmpStr := Trim(FieldByName(DispFlds[i]).AsString);
            if (I < High(DispFlds)) then
            begin
              while Length(TmpStr) < FldLen do
                TmpStr := TmpStr + ' ';
              ItemStr := ItemStr + TmpStr + ' | ';
            end
            else
              ItemStr := ItemStr + TmpStr;
          end; //for
          Add(ItemStr);
          Next;
        end; //while
        Close;
      end;  //with  qryTemp
    end; //with cbName
    Result := True;
  finally
    qryTmp.Close;
    qryTmp.Free;
  end;
end; //Function

function TfrmLogin.GetItemText(CbName: TComboBox; Index: Integer;
  Spector: String; FldIndex: Integer): String;
begin
  Result := '';
  with cbName do
  begin
    if Index > Items.Count - 1 then Exit;
    if Pos(Spector, Items[Index]) = 0 then
    begin
      if FldIndex = 1 then
        Result := Items[Index]
      else
        Result := '';
      Exit;  
    end;
    if FldIndex = 1 then
      Result := Trim(Copy(Items[Index], 1, Pos(Spector, Items[index]) - 1))
    else
      Result := Trim(Copy(Items[Index], Pos(Spector, Items[index]) + Length(Spector) + 1,
             Length(Items[index])));
  end;
end;

procedure TfrmLogin.lblOKClick(Sender: TObject);
begin
  inherited;
  //
  FLoginInfo.Code := cbUser.Text;
  with adsUser do
  begin
    Close;
    CommandText := 'select * from tDoctor where code = ' + QuotedStr(FLoginInfo.Code);
    Open;
    if Eof then
    begin
      Application.MessageBox('无效的登录用户!','提示',MB_OK+MB_ICONINFORMATION);
      cbUser.SetFocus;
      Exit;
    end
    else
    begin
      FLoginInfo.UserID := FieldByName('iAutoID').Value;
      FLoginInfo.Name := Trim(FieldByName('Name').AsString);
      FLoginInfo.Password := Trim(FieldByName('Password').AsString);
      if FLoginInfo.Password <> edtPassWord.Text then
      begin
        Application.MessageBox('对不起,密码不正确!','提示',mb_ok+mb_iconInformation);
        edtPassWord.SetFocus;
        Exit;
      end;
    end;
  end;
  Self.ModalResult:=mrOk;

end;

procedure TfrmLogin.edtPassWordKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Key = VK_RETURN then
    lblOK.OnClick(lblOK);
end;

procedure TfrmLogin.btnCancelClick(Sender: TObject);
begin
  inherited;
  ModalResult:=mrCancel;
end;

procedure TfrmLogin.cbUserExit(Sender: TObject);
begin
  inherited;
  cbUser.Text:=GetItemText(cbUser, cbUser.ItemIndex);
  Label1.Caption:=GetItemText(cbUser, cbUser.ItemIndex,'|',0);
  edtPassWord.SetFocus;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -