frmmain.pas

超市管理系统

   User_explorer(1);
end;

procedure TFrm_main.FSB_queryClick(Sender: TObject);
begin
   User_explorer(2);
end;

procedure TFrm_main.FSB_chartClick(Sender: TObject);
begin
   User_explorer(3);
end;

procedure TFrm_main.FSB_bassmessageClick(Sender: TObject);
begin
   User_explorer(4);
end;

procedure TFrm_main.ScrollBox_datainputResize(Sender: TObject);
var
   I_temp,I_control:integer;
begin
   (sender as Tscrollbox).VertScrollBar.Position :=0;
   I_temp:=((sender as Tscrollbox).Height -
      (sender as Tscrollbox).ControlCount*(sender as Tscrollbox).Controls[0].Height)
       div ((sender as Tscrollbox).ControlCount+1);
   if I_temp<5 then I_temp:=5;
   for I_control:=0 to (sender as Tscrollbox).controlcount-1 do
   begin
      with (sender as Tscrollbox).controls[I_control] do
      begin
         Left :=0;
         Width :=(sender as Tscrollbox).width;
         height:=(sender as Tscrollbox).Controls[0].Height;
         Top :=I_control*(sender as Tscrollbox).Controls[0].Height + (I_control+1)*I_temp;
      end;
   end;
end;

procedure TFrm_main.Sb_explorer_xsywClick(Sender: TObject);
var
   ClickMenu:TMenuItem;
   QueryPopUpMenu: TPopUpMenu;
   QueryPopUpItems: array of  TMenuItem;
   I_menuitem:integer;
begin
   if sender=Sb_explorer_xsyw then
      ClickMenu:=Menu_ywcx_xscx
   else if sender=Sb_explorer_jhyw then
      ClickMenu:=Menu_ywcx_jhcx
   else if sender=Sb_explorer_thyw then
      ClickMenu:=Menu_ywcx_thcx
   else if sender=Sb_explorer_kczk then
      ClickMenu:=Menu_ywcx_kczk
   else if sender=Sb_explorer_depotgoods then
      ClickMenu:=Menu_bassmessage_depotgoods
   else
      ClickMenu:=nil;
   if ClickMenu = nil then exit;
   QueryPopUpMenu := TPopUpMenu.Create(self);
   QueryPopUpMenu.Images := ImageList_tools;
   setlength(QueryPopUpItems,ClickMenu.Count);
   for I_menuitem := 0 to ClickMenu.Count-1 do
     begin
          QueryPopUpItems[I_menuitem] := TMenuItem.Create(Self);
          // 设置菜单项的Caption属性
          QueryPopUpItems[I_menuitem].Enabled := ClickMenu.Items[I_menuitem].Enabled;
          QueryPopUpItems[I_menuitem].Caption := ClickMenu.Items[I_menuitem].Caption;
          QueryPopUpItems[I_menuitem].ImageIndex :=ClickMenu.Items[I_menuitem].ImageIndex ;
          QueryPopUpMenu.Items.Add(QueryPopUpItems[I_menuitem]);
          // 指定菜单项的OnClick事件的处理过程
          QueryPopUpItems[I_menuitem].OnClick := ClickMenu.Items[I_menuitem].OnClick ;
     end;
   QueryPopUpMenu.Popup(mouse.CursorPos.X ,mouse.CursorPos.Y );
end;

procedure TFrm_main.Menu_tools_aboutClick(Sender: TObject);
begin
   Application.CreateForm(Tfrm_about,Frm_about);
   Frm_about.showmodal;
   Frm_about.free; 
end;

procedure TFrm_main.Menu_bassmessage_adminClick(Sender: TObject);
begin
   if Checkrights(USERRIGHTS,'查看') then
   begin
      Application.CreateForm(Tfrm_bassmessage_user,frm_bassmessage_user);
      frm_bassmessage_user.showmodal;
      frm_bassmessage_user.free;
   end
   else
      messagedlg(Errormsg0006+'0007',mterror,[mbok],0);
end;

procedure TFrm_main.FormCreate(Sender: TObject);
var
   reg:TRegistry;
   NumSec: SmallInt;
   StartTime: TDateTime;
   LABEL Systemsetup;
begin
   //开始运行
   S_RegTree:='\Software\SytySoft\THINKSHOP';
   //延时
   numsec:=1;              //延时1秒
   StartTime :=now;
   repeat
      application.ProcessMessages ;
   until Now > StartTime + NumSec * (1/24/60/60);

   Systemsetup:      //重新设置时的入口
   reg:=TRegistry.Create;
   Reg.RootKey:=HKEY_CURRENT_USER;
     try
        if (Reg.OpenKey(S_RegTree,False))=False then
        begin
             // 如果注册表中没有信息则创建初始化信息
             //打开注册窗口
             Application.CreateForm(TFrm_setup, Frm_setup);
             with Frm_setup do
             begin
               sb_stop.Visible :=true;
               Caption :=Caption +'（初始化设置）';
               showmodal;
               free;
             end;
        end;
        Reg.OpenKey(S_RegTree,True);
        S_name:=reg.ReadString('Coname');
        S_username:=reg.ReadString('username');
        S_cotel:=reg.ReadString('Cotel');
        S_address:=reg.ReadString('address');
        S_autosave:=reg.Readstring('autosave');
        S_savedays:=reg.Readstring('savedays');
        if Reg.ReadString('Countdate')='1' then
           try
              I_countdate:=reg.ReadInteger('Dateday');
           except
              I_countdate:=0;
           end
        else
           I_countdate:=0;
        HWSHOPDATA:=reg.ReadString('Datapath');
        if HWSHOPDATA='【系统默认】' then
        begin
           HWSHOPDATA:=ExtractFileDir(Application.ExeName);
           if (StrLen(PChar(HWSHOPDATA)) <> 3) then
               HWSHOPDATA:=HWSHOPDATA+'\DATA\'
           else
               HWSHOPDATA:=HWSHOPDATA+'DATA\';
        end;
        if (trim(s_name)='') then
        begin
          reg.DeleteKey(S_RegTree);
          reg.CloseKey ;
          reg.Free ;
          halt;
        end;
     finally
        Reg.CloseKey;
        Reg.Free;
     end;
   //日志文件
      S_logfile:=ExtractFileDir(Application.ExeName);
      if (StrLen(PChar(S_logfile)) <> 3) then
         S_logfile:=S_logfile+'\THINKSHOP.LOG'
      else
         S_logfile:=S_logfile+'THINKSHOP.LOG';
   //检测数据库
   if not DirectoryExists(HWSHOPDATA) then    //指定目录不存在
   begin
      messagedlg('指定数据库目录路径不存在或已被改名，系统将尝试调用默认数据库目录！',mtWarning,[mbok],0);
      HWSHOPDATA:=ExtractFileDir(Application.ExeName);
      if (StrLen(PChar(HWSHOPDATA)) <> 3) then
         HWSHOPDATA:=HWSHOPDATA+'\DATA\'
      else
         HWSHOPDATA:=HWSHOPDATA+'DATA\';
      if not DirectoryExists(HWSHOPDATA) then
      begin
         messagedlg('系统在尝试默认数据库目录后发现：'+#13+#13+'系统默认数据库目录不存在或已被改名！'
               +#13+#13+'系统将终止运行，请重新进行系统设置。',mtError,[mbok],0);
         Application.CreateForm(TFrm_setup, Frm_setup);
         with Frm_setup do
         begin
            sb_stop.Visible :=true;
            Caption :=Caption +'（初始化设置）';
            showmodal;
            free;
         end;
         goto Systemsetup;
      end
      else
      begin
         messagedlg('系统正在尝试调用默认数据库目录。'+#13+#13+'此信息在下次启动系统可能还会出现！'
               +#13+#13+'要想解决此问题，请在进入系统后重新进行系统设置。',mtInformation,[mbok],0);
      end;
   end;

   self.Caption :=Application.Title+' - '+S_name + '【'+HWSHOPDATA+'】';
   application.HintPause :=500;
   StatusBar_main.Panels.Items[1].Text :='版权所有 '+Getfilever; 
   StatusBar_main.Panels.Items[2].Text :='现在时间：'+DateTimeToStr(now);
   User_depotgoodsMenu;      //设置动态菜单
   //系统日志
   frm_message:=Tfrm_message.Create(Frm_main);
   if fileexists(S_logfile) then
   begin
      frm_message.Memo_message.Lines.LoadFromFile(S_logfile);
   end;
end;

procedure TFrm_main.Menu_tools_rightsClick(Sender: TObject);
begin
   if not Checkrights(USERRIGHTS,'高级') then
   begin
      messagedlg(Errormsg0006+'0007',mterror,[mbok],0);
      exit;
   end;
   application.CreateForm(TFrm_rightsmanage,Frm_rightsmanage);
   Frm_rightsmanage.showmodal;
   Frm_rightsmanage.free;
end;

procedure TFrm_main.TB_logoClick(Sender: TObject);
begin
   if Panel_main.DockClientCount> 0 then
   begin
      messagedlg(Infmsg0005,mtInformation,[mbok],0);
      exit;
   end;
   frm_message.Memo_message.Lines.Append(datetimetostr(now)+'：'+USERNAME+' - 注销');
   try
      frm_message.Memo_message.Lines.SaveToFile(S_logfile);
   except
      messagedlg('系统日志保存失败！',mtInformation,[mbok],0);
   end;
   Application.CreateForm(TFrm_logo, Frm_logo);
   //显示登录窗口
   Frm_logo.showmodal;
   frm_logo.free ;
end;

procedure TFrm_main.Menu_bassmessage_userClick(Sender: TObject);
begin
   if not Checkrights(USERRIGHTS,'查看') then
   begin
      messagedlg(Errormsg0006+'0007',mterror,[mbok],0);
      exit;
   end;
   application.CreateForm(Tfrm_bassmessage_ywy,frm_bassmessage_ywy);
   frm_bassmessage_ywy.showmodal;
   frm_bassmessage_ywy.free;
end;

procedure TFrm_main.Menu_bassmessage_depotClick(Sender: TObject);
begin
   if not Checkrights(USERRIGHTS,'查看') then
   begin
      messagedlg(Errormsg0006+'0007',mterror,[mbok],0);
      exit;
   end;
   application.CreateForm(Tfrm_bassmessage_depot,frm_bassmessage_depot);
   frm_bassmessage_depot.showmodal;
   frm_bassmessage_depot.free;
   User_depotgoodsMenu;
end;

procedure TFrm_main.Menu_bassmessage_goodsClick(Sender: TObject);
begin
   if not Checkrights(USERRIGHTS,'查看') then
   begin
      messagedlg(Errormsg0006+'0007',mterror,[mbok],0);
      exit;
   end;
   application.CreateForm(Tfrm_bassmessage_GOODS,frm_bassmessage_GOODS);
   frm_bassmessage_GOODS.showmodal;
   frm_bassmessage_GOODS.free;
end;

procedure TFrm_main.User_depotgoodsMenu();
var
   PopUpItems: array of  TMenuItem;
   I_record:integer;
begin
   I_record:=0;
   Menu_bassmessage_depotgoods.Clear ;
   Query_menu.DatabaseName :=HWSHOPDATA;
   with Query_menu do
   begin
      close;
      sql.Clear ;
      sql.Text :='select name,setid from Depot where type<>"暂停"' ;
      try
         open;
      except
         if frm_face.Showing then frm_face.Hide ;
         messagedlg('数据库打开错误，可能指定的系统数据库文件不存在！'+#13+#13
                     +'系统将终止运行，请重新尝试打开本程序。'
                     +#13+#13+'如果依然出现本信息，请与程序供应商联系。',mtError,[mbok],0);
         close;
         halt;
      end;
      if RecordCount>0 then setlength(PopUpItems,RecordCount+2)
      else setlength(PopUpItems,2);
      while not eof do
      begin
         PopUpItems[I_record]:=TMenuItem.Create(Self);
         if fieldbyname('setid').AsInteger =999 then
         begin
            PopUpItems[I_record].Enabled :=false;
            PopUpItems[I_record].Caption:=fieldbyname('name').asstring+'[&'+chr(65+I_record)+']'+' - 已进行初始化！';
         end
         else
            PopUpItems[I_record].Caption:=fieldbyname('name').asstring+'[&'+chr(65+I_record)+']';
         PopUpItems[I_record].OnClick :=User_setupdepot;
         Menu_bassmessage_depotgoods.Add(PopUpItems[I_record]);
         inc(I_record);
         next;
      end;
      close;
   end;
   PopUpItems[I_record]:=TMenuItem.Create(Self);
   PopUpItems[I_record].Caption:='-';
   Menu_bassmessage_depotgoods.Add(PopUpItems[I_record]);
   PopUpItems[I_record+1]:=TMenuItem.Create(Self);
   PopUpItems[I_record+1].Caption:='选择商场...[&Z]';
   PopUpItems[I_record+1].OnClick :=User_selectsetupdepot;
   Menu_bassmessage_depotgoods.Add(PopUpItems[I_record+1]);
end;

procedure Tfrm_main.User_setupdepot(Sender: TObject);
begin
   if not Checkrights(USERRIGHTS,'增加') then
   begin
      messagedlg(Errormsg0006+'0007',mterror,[mbok],0);
      exit;
   end;
   application.CreateForm(TFrm_main_depotgoods,Frm_main_depotgoods);
   with Sender as TMenuItem do
   begin
      Frm_main_depotgoods.cb_depot.Text :=copy(Caption,1,length(caption)-4);
   end;
   Frm_main_depotgoods.cb_depot.Enabled :=false;
   Frm_main_depotgoods.Dock(panel_main,BoundsRect);
   Frm_main_depotgoods.show;
end;