mainpas.pas

来自「本软件是一套功能完整成熟的固定资产管理系统,具有固定资产管理系统的相应全部功能」· PAS 代码 · 共 738 行 · 第 1/2 页

PAS
738
字号
unit mainpas;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls,shellapi, ExtCtrls, StdActns, ActnList, Menus, Buttons, ToolWin,
  jpeg, StdCtrls,inifiles,registry, DiskInfo, XPMenu, ImgList;

type
  Tmainform = class(TForm)
    ToolBar1: TToolBar;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    SpeedButton9: TSpeedButton;
    SpeedButton13: TSpeedButton;
    SpeedButton14: TSpeedButton;
    SpeedButton10: TSpeedButton;
    SpeedButton12: TSpeedButton;
    SpeedButton11: TSpeedButton;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N46: TMenuItem;
    N18: TMenuItem;
    N45: TMenuItem;
    N19: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    N22: TMenuItem;
    N27: TMenuItem;
    N25: TMenuItem;
    N26: TMenuItem;
    N23: TMenuItem;
    N24: TMenuItem;
    N29: TMenuItem;
    N30: TMenuItem;
    N36: TMenuItem;
    N31: TMenuItem;
    N32: TMenuItem;
    N34: TMenuItem;
    N33: TMenuItem;
    N35: TMenuItem;
    N37: TMenuItem;
    N28: TMenuItem;
    Arrange1: TMenuItem;
    MinimizeAll1: TMenuItem;
    Close1: TMenuItem;
    N38: TMenuItem;
    N39: TMenuItem;
    N40: TMenuItem;
    N41: TMenuItem;
    N43: TMenuItem;
    N44: TMenuItem;
    ActionList1: TActionList;
    WindowCascade1: TWindowCascade;
    WindowTileHorizontal1: TWindowTileHorizontal;
    WindowTileVertical1: TWindowTileVertical;
    WindowMinimizeAll1: TWindowMinimizeAll;
    WindowArrange1: TWindowArrange;
    WindowClose1: TWindowClose;
    PrinterSetupDialog1: TPrinterSetupDialog;
    Timer1: TTimer;
    StatusBar1: TStatusBar;
    N47: TMenuItem;
    N48: TMenuItem;
    N49: TMenuItem;
    N50: TMenuItem;
    N5: TMenuItem;
    DiskInfo1: TDiskInfo;
    N51: TMenuItem;
    N52: TMenuItem;
    XPMenu1: TXPMenu;
    ImageList1: TImageList;
    Cascade1: TMenuItem;
    ileHorizontally1: TMenuItem;
    ileVertically1: TMenuItem;
    N42: TMenuItem;
    N53: TMenuItem;
    N54: TMenuItem;
    N55: TMenuItem;
    procedure Timer1Timer(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure SpeedButton11Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure N30Click(Sender: TObject);
    procedure N32Click(Sender: TObject);
    procedure N34Click(Sender: TObject);
    procedure N33Click(Sender: TObject);
    procedure N40Click(Sender: TObject);
    procedure N41Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure SpeedButton10Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure SpeedButton12Click(Sender: TObject);
    procedure N39Click(Sender: TObject);
    procedure N36Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure N35Click(Sender: TObject);
    procedure N37Click(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure N17Click(Sender: TObject);
    procedure N18Click(Sender: TObject);
    procedure N19Click(Sender: TObject);
    procedure N20Click(Sender: TObject);
    procedure N48Click(Sender: TObject);
    procedure N22Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure N25Click(Sender: TObject);
    procedure N23Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N50Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure SpeedButton9Click(Sender: TObject);
    procedure SpeedButton13Click(Sender: TObject);
    procedure N24Click(Sender: TObject);
    procedure SpeedButton14Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N47Click(Sender: TObject);
    procedure N44Click(Sender: TObject);
    procedure N52Click(Sender: TObject);
    procedure N54Click(Sender: TObject);
    procedure N55Click(Sender: TObject);
  private
    { Private declarations }
FUNCTION checkreg():BOOLEAN;
procedure findChild(InstanceClass: TComponentClass;
  var Reference);
  public
    { Public declarations }
  end;

var
  mainform: Tmainform;

implementation

uses xtcspas,gysszpas,zwszpas, datapas,bmzypas,aboutpas, zyqxpas,
  yhloginpas,zclbszpas, zcxhszpas, zcrkpas, zcplzjpas,zcbfpas,zccjpas,zcghpas,zcwxpas,zccxpas,
  passsetpas, bfcxpas, cjcxpas, datacspas, cjdqcxpas, waitpas, rhregpas,zceditpas,
  regpas,zcfltjunit,zcmcfltjunit;

{$R *.dfm}
var showdw:boolean;

//获取计算机名

function GetComputerName: AnsiString;
var lpBuffer: array[0..MAX_PATH] of char;
dwSize: DWORD;
begin
dwSize:= MAX_PATH;
if not Windows.GetComputerName(lpBuffer, dwSize) then
raise
Exception.Create(SysErrorMessage(GetLastError()));
Result:= StrPas(lpBuffer);
end;

function strjm():string;
var i:integer;
s,mm:string;
begin
s:=getcomputername;
setlength(mm,length(s));
for i:=1 to length(s) do
mm[i]:=char(ord(s[i])+2);
result:=mm;
end;


FUNCTION STRMAP(VAR I:INTEGER):STRING;
BEGIN
CASE I OF
0:
STRMAP:='A';
1:
STRMAP:='E';
2:
STRMAP:='A';
3:
STRMAP:='F';
4:
STRMAP:='C';
5:
STRMAP:='D';
6:
STRMAP:='B';
7:
STRMAP:='E';
8:
STRMAP:='0';
9:
STRMAP:='5';
10:
STRMAP:='6';
11:
STRMAP:='4';
12:
STRMAP:='7';
13:
STRMAP:='3';
14:
STRMAP:='8';
15:
STRMAP:='2';
16:
STRMAP:='9';
17:
STRMAP:='1';
END;
END;


FUNCTION tmainform.checkreg():BOOLEAN;
var rego:tregistry;
ss,PASS,computername:string;
i,j,k:integer;
begin
rego:=tregistry.create;
rego.rootkey:=HKEY_USERS;
IF REGO.OPENKEY('.DEFAULT\SOFTWARE\hjzcgl\hjzcgl',FALSE) THEN
BEGIN
computername:=GetComputerName;
ss:=inttostr(diskinfo1.serialnumber)+strjm;
J:=0;
K:=0;
PASS:='';
FOR I:=1 TO LENGTH(SS) DO
J:=J+ORD(SS[I]);
FOR I:=1 TO 16 DO
BEGIN
K:=(J+16-I) MOD (I+3);
PASS:=TRIM(PASS)+STRMAP(K);
END;
if (ss=rego.ReadString('Name')) and (pass=Rego.Readstring('Pass')) then
begin
//showmessage('软件已经注册!');
rego.free;
RESULT:=TRUE;
end else
begin
REGO.FREE;
//showmessage('软件尚未注册,请与程序供应商联系!');
RESULT:=FALSE;
end;
END ELSE
BEGIN
REGO.FREE;
RESULT:=FALSE;
//showmessage('软件尚未注册,请先注册该程序!');
END;
END;

procedure Tmainform.findChild(InstanceClass: TComponentClass;
  var Reference);
var
  i:integer;
begin
  for i:=0 to MDIChildCount-1 do
  begin
    if MDIChildren[i] is instanceclass then
    begin
      MDIChildren[i].Show;
      exit;
   end;
  end;
  try
    application.CreateForm(instanceclass,reference);
    TForm(reference).left:=0;
    TForm(reference).top:=0;
    TForm(reference).width:=ClientWidth-4;
    TForm(reference).height:=ClientHeight-77;
  except
    Application.MessageBox('打开窗体失败!可能是内存不足。'+#13+'请关闭一些程序重试',pchar(caption),mb_OK+MB_IconError);
  end;
end;

procedure Tmainform.Timer1Timer(Sender: TObject);
begin
statusbar1.panels[2].text:=formatdatetime('YYYY"年"MM"月"DD"日"HH"时"MM"分"SS"秒 "DDDD',NOW);

end;

procedure Tmainform.N9Click(Sender: TObject);
begin
close;
end;

procedure Tmainform.SpeedButton11Click(Sender: TObject);
begin
close;
end;

procedure Tmainform.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if messagedlg('是否确认退出本系统?',mtconfirmation,[mbyes,mbno],0)=mryes then
canclose:=true else
canclose:=false;
end;

procedure Tmainform.N30Click(Sender: TObject);
begin
w_xtcssz:=tw_xtcssz.create(application);
w_xtcssz.showmodal;
end;

procedure Tmainform.N32Click(Sender: TObject);
begin
findchild(tw_gyssz,w_gyssz);
end;

procedure Tmainform.N34Click(Sender: TObject);
begin
w_zwsz:=tw_zwsz.create(application);
w_zwsz.showmodal;
end;

procedure Tmainform.N33Click(Sender: TObject);
begin
findchild(tzycxform,zycxform);
end;

procedure Tmainform.N40Click(Sender: TObject);
begin
ShellExecute(handle,nil,'mailto:whd_tr@163.com',nil,nil,sw_shownormal);

end;

procedure Tmainform.N41Click(Sender: TObject);
begin
ShellExecute(handle,nil,'http://www.ithj.com',nil,nil,sw_shownormal);

end;

procedure Tmainform.N7Click(Sender: TObject);
var
  windir: array[0..255] of char;
  s:string;

⌨️ 快捷键说明

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