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

📄 getmanfrm.pas

📁 结合读卡器使用。程序中有按迟到时间长短自动开罚单功能
💻 PAS
字号:
unit GetManfrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Jpeg,StdCtrls, Buttons, ExtCtrls, ExtDlgs,DB;

type
  TGetManForm = class(TForm)
    Label1: TLabel;
    Panel1: TPanel;
    BitBtn4: TBitBtn;
    BitBtn5: TBitBtn;
    Label2: TLabel;
    Edit1: TEdit;
    Label3: TLabel;
    Edit2: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    Edit4: TEdit;
    Label6: TLabel;
    Edit5: TEdit;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Edit8: TEdit;
    Label10: TLabel;
    Edit9: TEdit;
    Label11: TLabel;
    Memo1: TMemo;
    Label12: TLabel;
    Panel2: TPanel;
    Image1: TImage;
    OpenPictureDialog1: TOpenPictureDialog;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    ComboBox3: TComboBox;
    BitBtn1: TBitBtn;
    procedure FormActivate(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure Image1Click(Sender: TObject);
    procedure ShowFields;
    procedure BitBtn1Click(Sender: TObject);
  private
    PName:String;
    procedure ClearFields; 
    { Private declarations }
  public
    { Public declarations }
  end;

var
  GetManForm: TGetManForm;


implementation
uses DataModule1;

{$R *.dfm}

procedure TGetManForm.ClearFields;
var
  I:Byte;
begin
  for I:=0 to ComponentCount-1 do
  begin
      if Components[I] is TEdit then TEdit(Components[I]).Text :='';
      if Components[I] is TComboBox then TComboBox(Components[I]).Text :='';
      Memo1.Text :='';
      Image1.canvas.Refresh;
  end;
end;

procedure TGetManForm.FormActivate(Sender: TObject);
begin
    case CurrentAct of
    0:begin
        Label1.Caption :='输入员工信息';
        ClearFields;
        Bitbtn1.Visible :=false;
        Bitbtn4.Visible :=true;
      end;
    1:begin
        Label1.Caption :='修改员工信息';
        Bitbtn1.Visible :=false;
        Bitbtn4.Visible :=true;
        ShowFields;
      end;
    2:begin
        Label1.Caption :='查询员工信息';
        Bitbtn1.Visible :=false;
        Bitbtn4.Visible :=False;
        ShowFields;
      end;
    3:begin
        Label1.Caption :='删除员工信息';
        showFields;
        Bitbtn1.Visible :=True;
        Bitbtn4.Visible :=False;
      end;
    end;
end;

procedure TGetManForm.ShowFields;
var
   MS:TMemoryStream;
 
begin
   MS:=TMemoryStream.Create;
   with DM.TBWorker do
   begin
      Edit1.Text :=FieldByName('M_Name').asString;
      Edit2.Text :=FieldByName('M_No').AsString;
      Edit4.Text :=FieldByName('M_Age').AsString;
      Edit5.Text :=FieldByName('M_tel').AsString;
      Edit8.Text :=FieldByName('M_Password').AsString;
      Edit9.Text :=FieldByName('M_Address').AsString;
      ComboBox1.Text :=FieldByName('M_Sex').AsString;
      ComboBox2.Text :=FieldByName('M_Department').AsString;
      ComboBox3.Text :=FieldByName('M_Lev').AsString;
      Memo1.Text :=FieldByName('M_Describe').AsString;
      (fieldByName('M_Picture')as TBlobField).SaveToStream(MS);
      MS.Position :=0;
      Image1.Picture.Graphic:=nil;
      Image1.Picture.Graphic:=TJPEGImage.Create;
      Image1.Picture.Graphic.LoadFromStream(MS);
      MS.Free;

   end;
end;

procedure TGetManForm.BitBtn4Click(Sender: TObject);   //保存
var
  Sext:String;
  Pjpg:TJPEGImage;
  Pic:TMemoryStream;
  LastDutyNo:byte;
begin
       Sext:=ExtractFileExt(PName);
       try
          with DM.qryWorker do
          begin
             Close;
             SQL.Clear;
             SQL.Add('Select M_Sort from Worker');
             SQL.Add('Where M_Department=:varDepart order By M_Sort ASC');
             ParamByName('varDepart').AsString :=ComboBox2.Text;
             Open;
             Last;
             LastDutyNo:=FieldByName('M_Sort').AsInteger;
          end;

          with DM.TBWorker do
          begin
             if CurrentAct=0 then
             begin
               Open;
               Append;
             end;
             if CurrentAct=1 then Edit;
             DM.Database1.StartTransaction;
             FieldByName('M_Name').AsString :=Edit1.Text;
             FieldByName('M_No').AsString :=Edit2.Text;
             FieldByName('M_Sex').AsString :=ComboBox1.Text;
             FieldByName('M_Age').AsString :=Edit4.Text;
             FieldByName('M_Tel').AsString :=Edit5.Text;
             FieldByName('M_Department').AsString :=ComboBox2.Text;

             FieldByName('M_Lev').AsInteger :=ComboBox3.ItemIndex;
             FieldByName('M_Password').AsString :=Edit8.Text;
             FieldByName('M_Address').AsString :=Edit9.Text;
             FieldByName('M_Describe').AsString :=Memo1.Text;
             FieldByName('M_PicRoute').AsString :=PName;
             if CurrentAct=0 then FieldByName('M_Sort').asInteger:=LastDutyNo+1;
             if (UpperCase(Sext)='.JPG') or (UpperCase(Sext)='.JPEG') then
             begin
                Pjpg:=TJPEGimage.Create;
                Pjpg.LoadFromFile(PName);
                Pic:=TMemoryStream.Create;
                PJpg.SaveToStream(Pic);
                Pic.Position :=0;
                (DM.TBWorker.FieldByName('M_Picture') as TBlobField).LoadFromStream(pic);
                pic.Free;
             end;
             if UpperCase(Sext)='.BMP' then
             begin
                FieldByName('M_Picture').Assign(Image1.Picture.Graphic); 
             end;
             Post;
             Close;
             MessageBox(Application.Handle,'保存成功!',
             '提示',MB_OK+MB_ICONINFORMATION+MB_SYSTEMMODAL);
          end;
          DM.Database1.Commit;  
       except
          DM.Database1.Rollback;
          MessageBox(Application.Handle,'输入信息失败!请重新输入',
          '提示',MB_OK+MB_ICONERROR+MB_SYSTEMMODAL);
       end;

end;

procedure TGetManForm.Image1Click(Sender: TObject);
begin
   if OpenPictureDialog1.Execute then
   begin
      PName:=OpenPictureDialog1.FileName;
      Image1.Picture.LoadFromFile(PName);
   end;
  
end;

procedure TGetManForm.BitBtn1Click(Sender: TObject);
begin
   if  MessageBox(Application.Handle,'确认删除吗?','提示'
    ,MB_OKCANCEL+MB_ICONERROR+MB_SYSTEMMODAL)=idOK then
    with DM.TBWorker do
    begin
       try
         delete;
         DM.TrimWorkerSort;
       except
         MessageBox(Application.Handle,Pchar(ErrAct),'提示'
         ,MB_OKCANCEL+MB_ICONERROR+MB_SYSTEMMODAL);
       end;
    end;

end;

end.

⌨️ 快捷键说明

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