📄 frmmainp.~pas

📁 二次开发模块一、条形码的批量生成
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
12 下一页
unit FrmMainP;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, XPBarMenu, Menus, ImgList, StdActns, ActnList, MDIWallp,Shellapi,
  ComCtrls, DB, ADODB, StdCtrls, RxGIF, ExtCtrls, jpeg;

type
  TFrmMain = class(TForm)
    XPBarMenu1: TXPBarMenu;
    ImageListEnable: TImageList;
    MDIWallpaper1: TMDIWallpaper;
    ActionList1: TActionList;
    WindowClose1: TWindowClose;
    WindowTileHorizontal1: TWindowTileHorizontal;
    WindowTileVertical1: TWindowTileVertical;
    WindowMinimizeAll1: TWindowMinimizeAll;
    WindowCascade1: TWindowCascade;
    WindowArrange1: TWindowArrange;
    WindowsCloseWindows: TAction;
    MainMenu1: TMainMenu;
    NNN: TMenuItem;
    N8: TMenuItem;
    N10: TMenuItem;
    N9: TMenuItem;
    E1: TMenuItem;
    NWindows: TMenuItem;
    C2: TMenuItem;
    H2: TMenuItem;
    V1: TMenuItem;
    MinimizeAll1: TMenuItem;
    Close1: TMenuItem;
    O1: TMenuItem;
    H1: TMenuItem;
    Email1: TMenuItem;
    www1: TMenuItem;
    N1: TMenuItem;
    A1: TMenuItem;
    NU1: TMenuItem;
    StatusBar1: TStatusBar;
    N2: TMenuItem;
    N3: TMenuItem;
    L1: TMenuItem;
    V2: TMenuItem;
    N4: TMenuItem;
    A2: TMenuItem;
    MISA1: TMenuItem;
    I1: TMenuItem;
    A3: TMenuItem;
    B2: TMenuItem;
    N5: TMenuItem;
    C1: TMenuItem;
    B1: TMenuItem;
    A4: TMenuItem;
    A5: TMenuItem;
    C3: TMenuItem;
    B3: TMenuItem;
    Image1: TImage;
    C4: TMenuItem;
    D1: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N11: TMenuItem;
    B4: TMenuItem;
    N12: TMenuItem;
    B5: TMenuItem;
    C5: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    procedure Email1Click(Sender: TObject);
    procedure www1Click(Sender: TObject);
    procedure A1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure E1Click(Sender: TObject);
    procedure L1Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure NU1Click(Sender: TObject);
    procedure O1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CloseAllWindows;
    procedure WindowsCloseWindowsExecute(Sender: TObject);
    procedure MISA1Click(Sender: TObject);
    procedure C1Click(Sender: TObject);
    procedure I1Click(Sender: TObject);
    procedure A3Click(Sender: TObject);
    function GetPCID: String;
    Function GetString(SourceStr:String;iNum:Integer):String;
    procedure N5Click(Sender: TObject);
    function GetVer(cVer: String): Integer;
    Function GetFileDate:String;
    procedure A4Click(Sender: TObject);
    Function CheckFileName(cFile:String):String;
    procedure B2Click(Sender: TObject);
    Procedure CheckInv(cVouch:String);
    procedure UpdateInv(cVouch:String);
    procedure ReadTxtFile(cFile,cChar,cVouch:String;AdoQry:TADOQuery);
    procedure DeleteRD(AdoQry:TADOQuery);
    procedure DeleteRDS(ii,kk:Integer);
    procedure GetNullNumber(cType,cVouch: String);
    procedure UpdateNull(II:Integer;cVouch: String);
    procedure SumNumber(cVouch: String;Lab:TLabel);
    procedure CalcFieldsList(AdoQry:TADOQuery;cCheck:String);
    procedure CheckType(cType,cVouch:String);
    procedure B3Click(Sender: TObject);
    procedure A5Click(Sender: TObject);
    procedure C3Click(Sender: TObject);
    Function ReadReg(LsStr,cFStr,cType:String):String;
    procedure N7Click(Sender: TObject);
    procedure C4Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure B5Click(Sender: TObject);
    procedure C5Click(Sender: TObject);
  private
    { Private declarations }
  public
    PCID:String;
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation

uses FrmAboutP, FrmLoginP, FrmUserP, SUFunctionP, FrmMisDataP, DataDmP,
  FrmIniSetP, FrmINp, FrmDefineP, FrmPopIniP, FrmOutP, FrmProcP, FrmPoPInvP,
  FrmPoPTypeP, FrmOtherinP, FrmMaterialOutP, FrmOtherOutP, FrmRegP,
  FrmTransVouchP, FrmBarAutoP, UntBundle, UntBox;

{$R *.dfm}

procedure TFrmMain.Email1Click(Sender: TObject);
begin
  ShellExecute(handle,nil,pchar('mailto:xmszb@ufsoft.com.cn'),nil,nil,sw_shownormal);
end;

procedure TFrmMain.www1Click(Sender: TObject);
begin
  ShellExecute(handle,nil,pchar('http://www.ufsoft.com.cn'),nil,nil,sw_shownormal);
end;

procedure TFrmMain.A1Click(Sender: TObject);
begin
  Application.CreateForm(tFrmAbout,FrmAbout);
  FrmAbout.Caption:='关于:'+PCID;  
  FrmAbout.ShowModal;
  FrmAbout.Free;
  FrmAbout:=NIL;
end;

procedure TFrmMain.FormShow(Sender: TObject);
begin
  PCID:=GetPCID;
  StatusBar1.Panels[3].Text:=' ID:'+PCID;

  if FrmLogin.ShowModal<>mrok then
    Begin
     DataDm.AdoConUfsoft.Connected:=False;
     DataDm.ConUfsystem.Connected:=False;
     DataDm.ConDataSys.Connected:=False;         
     Application.Terminate;
    end;
//  DataDm.ConToDestData;   
end;

procedure TFrmMain.E1Click(Sender: TObject);
begin
  Close;
end;

procedure TFrmMain.L1Click(Sender: TObject);
begin
  CloseAllWindows;
  FrmLogin.ShowModal;
end;

procedure TFrmMain.N8Click(Sender: TObject);
begin
if Application.MessageBox('确定恢复网格默认设置？','提示',MB_OKCANCEL+ MB_ICONINFORMATION)= IDOK  Then
    begin
      Try
       DeleteFile(ExtractFilePath(Application.ExeName)+'dxDBGrid.ini');
       Application.MessageBox('恢复成功！','信息',MB_OK+ MB_ICONINFORMATION);
      except
       Application.MessageBox(pchar('错误！无法删除'+ExtractFilePath(Application.ExeName)+'dxDBGrid.ini'),'信息',MB_OK+ MB_ICONINFORMATION);
      end;
    end;
end;

procedure TFrmMain.NU1Click(Sender: TObject);
begin
  Application.CreateForm(tFrmUser,FrmUser);
  FrmUser.ShowModal;
  FrmUser.Free;
  FrmUser:=NIL;
end;

procedure TFrmMain.O1Click(Sender: TObject);
begin
  while self.MDIChildCount>0 do
   begin
     ActiveMDIChild.Close;
     Application.ProcessMessages; //没有 MDIChildCount 始终不变
   end;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  V2.Caption:='版本(&V)  '+SUFunction.GetVerInfo(Application.ExeName);
end;

procedure TFrmMain.CloseAllWindows;
begin
  while self.MDIChildCount>0 do
     begin
       ActiveMDIChild.Close;
       Application.ProcessMessages; //没有 MDIChildCount 始终不变
     end;
end;

procedure TFrmMain.WindowsCloseWindowsExecute(Sender: TObject);
begin
  CloseAllWindows;
end;

procedure TFrmMain.MISA1Click(Sender: TObject);
begin
   Application.CreateForm(tFrmMisData,FrmMisData);
   FrmMisData.ShowModal;
   FrmMisData.Free;
   FrmMisData:=nil;
end;

procedure TFrmMain.C1Click(Sender: TObject);
begin
if Application.MessageBox('确定进行系统库维护?(其它工作站程序需退出)','信息',MB_OKCANCEL+ MB_ICONINFORMATION)= IDOK  Then
    begin
      Try
        SUFunction.DeleteTableView(DataDm.AdoConUfsoft,'Szb_Ini');
        SUFunction.CreateTableView(DataDm.AdoConUfsoft,'Szb_Ini');

        SUFunction.DeleteTableView(DataDm.AdoConUfsoft,'Szb_PurIn');
        SUFunction.CreateTableView(DataDm.AdoConUfsoft,'Szb_PurIn');

        SUFunction.DeleteTableView(DataDm.AdoConUfsoft,'Szb_PurInList');
        SUFunction.CreateTableView(DataDm.AdoConUfsoft,'Szb_PurInList');
      except
      end;
      Application.MessageBox(Pchar('系统库维护完成.'),'信息',MB_OK+ MB_ICONINFORMATION);
    end;
end;


procedure TFrmMain.I1Click(Sender: TObject);
begin
   Application.CreateForm(tFrmIniSet,FrmIniSet);
   FrmIniSet.ShowModal;
   FrmIniSet.Free;
   FrmIniSet:=nil;
end;

procedure TFrmMain.A3Click(Sender: TObject);
begin
   if FrmIN=nil then
     Application.CreateForm(tFrmIN,FrmIN);
   FrmIN.Show;  
end;

function TFrmMain.GetPCID: String;
var
  Hour, Min, Sec, MSec, Year, Month, Day: Word;
  function ChangeInt(ii,kk: Integer): String;
    begin
      Result:=IntToStr(ii);
      while Length(Result)<kk do
         Result:='0'+Result;
    end;
Begin
 DecodeTime(Time, Hour, Min, Sec, MSec);
 DecodeDate(DataDm.GetSysDateTime, Year, Month, Day);
 Result:=IntToStr(Year)+ChangeInt(Month,2)+ChangeInt(Day,2)+ChangeInt(Hour,2)+ChangeInt(Min,2)+ChangeInt(Sec,2)+ChangeInt(MSec,3);
end;

function TFrmMain.GetString(SourceStr: String; iNum: Integer): String;
begin
  if iNum=1 then Result:=Copy(SourceStr,1,5);
  if iNum=2 then Result:=Copy(SourceStr,6,5);
  if iNum=3 then Result:=Copy(SourceStr,11,30);
  if iNum=4 then Result:=Copy(SourceStr,41,20);
  if iNum=5 then Result:=Copy(SourceStr,61,35);
  if iNum=6 then Result:=Copy(SourceStr,96,10);
  Result:=Trim(Result);   
end;

procedure TFrmMain.N5Click(Sender: TObject);
begin

   Application.CreateForm(tFrmPopIni,FrmPopIni);
//   FrmPopIni.ShowModal;

   Application.CreateForm(tFrmDefine,FrmDefine);
   FrmDefine.ShowModal;
   FrmDefine.Free;
   FrmDefine:=nil;

   FrmPopIni.Free;
   FrmPopIni:=nil;

end;

function TFrmMain.GetVer(cVer: String): Integer;
 Function GetSub(Str:String;iNum:Integer):Integer;
 Var LsStr,ss:String;
     ii,kk:Integer;
  begin
     LsStr:=Str;
     ii:=0;
     while ii<iNum do
      begin
        kk:=pos('.',LsStr);
        ii:=ii+1;
        if ii<iNum then
           LsStr:=copy(LsStr,kk+1,length(LsStr))
        else
          begin
           if kk>0 then
              ss:=Copy(LsStr,1,kk-1)
           else
              ss:=LsStr;
           Break;
          end;
      end;
   Result:=StrToIntDef(ss,0);
   ii:=4;
   while ii>iNum do
    begin
     Result:=Result*1000;
     ii:=ii-1;
    end;
  end;
var ii,kk,jj,mm:Integer;
begin
  ii:=GetSub(cVer,1);
  jj:=GetSub(cVer,2);
  kk:=GetSub(cVer,3);
  mm:=GetSub(cVer,4);
  Result:=ii+jj+kk+mm;
end;

function TFrmMain.GetFileDate: String;
function IntToStrDefinde(ii: Integer): String;
begin
  Result:=IntToStr(ii);
  if Length(Result)=1 then Result:='0'+Result;
end;
var
 Year, Month, Day, Hour, Min, Sec, MSec: Word;
begin
  DecodeDate(Date(), Year, Month, Day);
  DecodeTime(Time(), Hour, Min, Sec, MSec);
  Result:=IntToStr(Year)+IntToStrDefinde(Month)+IntToStrDefinde(Day);
  Result:=Result+'_'+IntToStrDefinde(Hour)+IntToStrDefinde(Min);

end;

procedure TFrmMain.A4Click(Sender: TObject);
begin
   if FrmOut=nil then
     Application.CreateForm(tFrmOut,FrmOut);
   FrmOut.Show;
end;

function TFrmMain.CheckFileName(cFile: String): String;
var LsStr:String;
begin
  LsStr:=Copy(cFile,length(cFile)-3,4);
  if UpperCase(LsStr)<>'.XML' Then  Result:=cFile+'.xml'
  else Result:=cFile;
end;

procedure TFrmMain.B2Click(Sender: TObject);
begin
   if FrmProc=nil then
     Application.CreateForm(tFrmProc,FrmProc);
   FrmProc.Show;
end;
12 下一页
⌨️ 快捷键说明

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