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

📄 main.pas

📁 一个delphi开发的库存管理系统源代码
💻 PAS
字号:
🔍 
unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ComCtrls, ToolWin, ImgList, RzBckgnd, IniFiles, ExtCtrls,
  ExtDlgs, ShellApi, XPMenu, StdCtrls, RzLabel, jpeg, StdActns, ActnList;

type
  Tfmain = class(TForm)
    mm: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    ToolBar1: TToolBar;
    sb: TStatusBar;
    il1: TImageList;
    ToolButton1: TToolButton;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    rbg: TRzBackground;
    Timer1: TTimer;
    il2: TImageList;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    ENWEN1: TMenuItem;
    ENWEN2: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    A1: TMenuItem;
    A2: TMenuItem;
    N19: TMenuItem;
    A5: TMenuItem;
    N21: TMenuItem;
    N22: TMenuItem;
    N23: TMenuItem;
    N24: TMenuItem;
    A3: TMenuItem;
    A4: TMenuItem;
    N27: TMenuItem;
    A6: TMenuItem;
    A7: TMenuItem;
    PopupMenu1: TPopupMenu;
    N28: TMenuItem;
    N31: TMenuItem;
    N33: TMenuItem;
    N35: TMenuItem;
    N36: TMenuItem;
    A8: TMenuItem;
    A9: TMenuItem;
    N38: TMenuItem;
    A10: TMenuItem;
    A11: TMenuItem;
    A12: TMenuItem;
    A13: TMenuItem;
    N39: TMenuItem;
    A14: TMenuItem;
    N42: TMenuItem;
    N43: TMenuItem;
    opd: TOpenPictureDialog;
    lbl_info: TLabel;
    al: TActionList;
    N17: TMenuItem;
    WindowClose1: TWindowClose;
    WindowCascade1: TWindowCascade;
    WindowTileHorizontal1: TWindowTileHorizontal;
    WindowTileVertical1: TWindowTileVertical;
    WindowMinimizeAll1: TWindowMinimizeAll;
    WindowArrange1: TWindowArrange;
    Cascade1: TMenuItem;
    Close1: TMenuItem;
    MinimizeAll1: TMenuItem;
    ileHorizontally1: TMenuItem;
    ileVertically1: TMenuItem;
    N18: TMenuItem;
    N20: TMenuItem;
    N25: TMenuItem;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure ENWEN1Click(Sender: TObject);
    procedure ENWEN2Click(Sender: TObject);
    procedure N24Click(Sender: TObject);
    procedure N22Click(Sender: TObject);
    procedure N23Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure A1Click(Sender: TObject);
    procedure A8Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N18Click(Sender: TObject);
    procedure N20Click(Sender: TObject);
    procedure N25Click(Sender: TObject);
  private
    function getform(cform: string):boolean;
    { Private declarations }
  public
    str : array [1..10] of string;
    { Public declarations }
  end;

var
  fmain: Tfmain;

implementation
uses dm,vks,pass,bake,user,about,help,sort,vendor,goods,a1,a2,a3,a4,a5,a6,a7,
     title;

{$R *.dfm}

function Tfmain.getform(cform: string):boolean;
var
  i : integer;
  flag : boolean;
begin
  flag := false;
  for i:=0 to self.MDIChildCount-1 do
    if self.MDIChildren[i].Name=cform then
    begin
      flag := true;
      break;
    end;
  result := flag;
end;

procedure Tfmain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if VKS.box('退出本系统:'#13#10'您真的确定退出该系统吗？','退出系统提示') then
    begin
      fdm.conn.Close;
      Application.Terminate;
    end
  else
      action:=caNone;
end;

procedure Tfmain.FormShow(Sender: TObject);
var
  myini : TIniFile;
  ary : array [1..5] of string;
  size : integer;
  sa:tstringlist;
begin
  Caption := Application.Title;
  sb.Panels[1].Text := '时间: '+FormatDateTime('yyyy-MM-dd hh:mm:ss',now);
  FormResize(Sender);
  myini := TIniFile.Create(str[4]+'set.ini');
  ary[1] := myini.ReadString('config','bgfile','');
  ary[2] := myini.ReadString('config','title','');
  ary[3] := myini.ReadString('config','color','0,0,0');
  ary[4] := myini.ReadString('config','size','18');
  ary[5] := myini.ReadString('config','name','宋体');
  if ary[2]='' then myini.WriteString('config','title','XXX市市委-Enwen版权所有');
  if ary[3]='' then myini.WriteString('config','color','0,0,0');
  if ary[4]='' then myini.WriteString('config','size','18');
  if ary[5]='' then myini.WriteString('config','name','宋体');
  myini.Free;
  if FileExists(ary[1]) then
  begin
    rbg.Image.LoadFromFile(ary[1]);
    if not rbg.ShowImage then rbg.ShowImage := true;
  end;
  if ary[2]<>'' then
  begin
    lbl_info.Caption := ary[2];
    sa := tstringlist.Create;
    sa := vks.split(ary[3],',');
    lbl_info.Font.Color := rgb(strtoint(sa.Strings[0]),strtoint(sa.Strings[1]),strtoint(sa.Strings[2]));
    lbl_info.Font.Size := StrToInt(ary[4]);
    lbl_info.Font.Name := ary[5];
    lbl_info.Top := 45;
    lbl_info.Left := (self.Width - lbl_info.Width ) div 2;
  end;
  if str[3]='' then N20.Checked := true else N20.Checked := false;
  if str[5]='' then N18.Checked := false  else N18.Checked:= true;
end;

procedure Tfmain.FormResize(Sender: TObject);
begin
  sb.Panels[0].Width := Width-(sb.Panels[1].Width+sb.Panels[2].Width+sb.Panels[3].Width);
  lbl_info.Top := 45;
  lbl_info.Left := (self.Width - lbl_info.Width ) div 2;
end;

procedure Tfmain.Timer1Timer(Sender: TObject);
begin
  sb.Panels[1].Text := '时间: '+FormatDateTime('yyyy-MM-dd hh:mm:ss',now);
end;

procedure Tfmain.N10Click(Sender: TObject);
begin
  close;
end;

procedure Tfmain.N8Click(Sender: TObject);
begin
  Application.CreateForm(tfpass,fpass);
  fpass.ShowModal;
end;

procedure Tfmain.N15Click(Sender: TObject);
var
  i : integer;
begin
  for i:=0 to self.MDIChildCount-1 do self.MDIChildren[i].Close;
  Application.CreateForm(tfbake,fbake);
  fbake.ShowModal;
end;

procedure Tfmain.N6Click(Sender: TObject);
begin
  Application.CreateForm(tfuser,fuser);
  fuser.ShowModal;
end;

procedure Tfmain.N12Click(Sender: TObject);
begin
  Application.CreateForm(tfabout,fabout);
  fabout.ShowModal;
end;

procedure Tfmain.N11Click(Sender: TObject);
begin
  Application.CreateForm(tfhelp,fhelp);
  fhelp.Show;
end;

procedure Tfmain.ENWEN1Click(Sender: TObject);
begin
  shellexecute(handle,'open',pchar('http://hpping.hdut.com'),nil,nil,sw_shownormal);
end;

procedure Tfmain.ENWEN2Click(Sender: TObject);
begin
  shellexecute(handle,'open',pchar('mailto:enwen@hdut.com'),nil,nil,sw_shownormal);
end;

procedure Tfmain.N24Click(Sender: TObject);
begin
  shellexecute(handle,'open',pchar('http://www.hdut.com'),nil,nil,sw_shownormal);
end;

procedure Tfmain.N22Click(Sender: TObject);
begin
  Application.CreateForm(tfsort,fsort);
  fsort.ShowModal;
end;

procedure Tfmain.N23Click(Sender: TObject);
begin
  Application.CreateForm(tfvendor,fvendor);
  fvendor.ShowModal;
end;

procedure Tfmain.N14Click(Sender: TObject);
begin
  if not getform('fgoods') then
  begin
    Application.CreateForm(tfgoods,fgoods);
    fgoods.Show;
  end else fgoods.BringToFront;
end;

procedure Tfmain.A1Click(Sender: TObject);
begin
  if (Sender as TMenuItem).Name='A1' then
  begin
    if not getform('fa1') then
    begin
      Application.CreateForm(tfa1,fa1);
      fa1.flag := 'A';
      fa1.lbl_no.Caption := 'A'+formatdatetime('yymmddhhmmss',now);
      fa1.Show;
    end else fa1.BringToFront;
  end;
  if (Sender as TMenuItem).Name='A2' then
  begin
    if not getform('fa5') then
    begin
      Application.CreateForm(tfa5,fa5);
      fa5.Caption := '物品出库操作';
      fa5.Label1.Caption := '出库单编号:';
      fa5.flag := 'B';
      fa5.lbl_no.Caption := 'B'+formatdatetime('yymmddhhmmss',now);
      fa5.Show;
    end else fa5.BringToFront;
  end;
  if (Sender as TMenuItem).Name='A6' then
  begin
    if not getform('fa2') then
    begin
      Application.CreateForm(tfa2,fa2);
      fa2.flag := 'A';
      fdm.qdan.Close;
      fa2.ini('A');
      fa2.Show;
    end else fa2.BringToFront;
  end;
  if (Sender as TMenuItem).Name='A7' then
  begin
    if not getform('fa6') then
    begin
      Application.CreateForm(tfa6,fa6);
      fa6.Caption := '物品出库单审核';
      fa6.flag := 'B';
      fdm.qdan.Close;
      fa6.ini('B');
      fa6.Show;
    end else fa6.BringToFront;
  end;
  if (Sender as TMenuItem).Name='A3' then
  begin
    if not getform('fa3') then
    begin
      Application.CreateForm(tfa3,fa3);
      fa3.flag := 'A';
      fa3.ini('A');
      fa3.Show;
    end else fa3.BringToFront;
  end;
  if (Sender as TMenuItem).Name='A4' then
  begin
    if not getform('fa7') then
    begin
      Application.CreateForm(tfa7,fa7);
      fa7.Caption := '物品出库记录';
      fa7.flag := 'B';
      fa7.ini('B');
      fa7.Show;
    end else fa7.BringToFront;
  end;
  if (Sender as TMenuItem).Name='A5' then
  begin
    if not getform('fa4') then
    begin
      Application.CreateForm(tfa4,fa4);
      fa4.Show;
    end else fa4.BringToFront;
  end;
end;

procedure Tfmain.A8Click(Sender: TObject);
begin
  if (Sender as TMenuItem).Name='A8' then A1Click(A1);
  if (Sender as TMenuItem).Name='A9' then A1Click(A2);
  if (Sender as TMenuItem).Name='A10' then A1Click(A6);
  if (Sender as TMenuItem).Name='A11' then A1Click(A7);
  if (Sender as TMenuItem).Name='A12' then A1Click(A3);
  if (Sender as TMenuItem).Name='A13' then A1Click(A4);
  if (Sender as TMenuItem).Name='A14' then A1Click(A5);
end;

procedure Tfmain.ToolButton2Click(Sender: TObject);
begin
  A1Click(A1);
end;

procedure Tfmain.ToolButton4Click(Sender: TObject);
begin
  A1Click(A2);
end;

procedure Tfmain.ToolButton5Click(Sender: TObject);
begin
  A1Click(A5);
end;

procedure Tfmain.N5Click(Sender: TObject);
var
  myini : TIniFile;
begin
  if opd.Execute then
  begin
    myini := TiniFile.Create(str[4]+'set.ini');
    myini.WriteString('config','bgfile',opd.FileName);
    myini.Free;
    rbg.Image.LoadFromFile(opd.FileName);
    if not rbg.ShowImage then rbg.ShowImage := true;
  end;
end;

procedure Tfmain.N18Click(Sender: TObject);
var
  myini : TIniFile;
begin
  if N18.Checked then
  begin
    str[5] := '';
    N18.Checked := false;
  end else
  begin
    str[5] := 'OK';
    N18.Checked := true;
  end;
  myini := TIniFile.Create(str[4]+'set.ini');
  myini.WriteString('config','print',str[5]);
  myini.Free;
end;

procedure Tfmain.N20Click(Sender: TObject);
var
  myini : TIniFile;
begin
  if N20.Checked then
  begin
    str[3] := 'OK';
    N20.Checked := false;
  end else
  begin
    str[3] := '';
    N20.Checked := true;
  end;
  myini := TIniFile.Create(str[4]+'set.ini');
  myini.WriteString('config','save',str[3]);
  myini.Free;
end;

procedure Tfmain.N25Click(Sender: TObject);
begin
  Application.CreateForm(Tftitle,ftitle);
  ftitle.ShowModal;
end;

end.

⌨️ 快捷键说明

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