开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 行业应用 > 百货/超市行业 > 查看源码
UnitMain.pas
资源名称：东之源.rar　[点击查看]
上传用户：zexin0769
上传日期：2010-01-19
资源大小：443k
文件大小：14k
源码类别：

百货/超市行业

开发平台：

Delphi

UnitMain.pas：源码内容
  1. unit UnitMain;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, StdCtrls, ExtCtrls, Menus, ImgList, ADODB, mmsystem;
  9. type
  10.   TForm2 = class(TForm)
  11.     ImageBack: TImage;
  12.     Image2: TImage;
  13.     Image3: TImage;
  14.     Image4: TImage;
  15.     Image1: TImage;
  16.     Image6: TImage;
  17.     Image7: TImage;
  18.     Image111: TImage;
  19.     Image112: TImage;
  20.     Image121: TImage;
  21.     Image122: TImage;
  22.     Image131: TImage;
  23.     Image132: TImage;
  24.     Image142: TImage;
  25.     Image141: TImage;
  26.     Image151: TImage;
  27.     Image152: TImage;
  28.     PopupMenu5: TPopupMenu;
  29.     N1: TMenuItem;
  30.     N2: TMenuItem;
  31.     N3: TMenuItem;
  32.     ImageList1: TImageList;
  33.     PopupMenu1: TPopupMenu;
  34.     N9: TMenuItem;
  35.     PopupMenu2: TPopupMenu;
  36.     PopupMenu3: TPopupMenu;
  37.     N15: TMenuItem;
  38.     N16: TMenuItem;
  39.     N19: TMenuItem;
  40.     N20: TMenuItem;
  41.     N21: TMenuItem;
  42.     N7: TMenuItem;
  43.     N23: TMenuItem;
  44.     N4: TMenuItem;
  45.     N5: TMenuItem;
  46.     N6: TMenuItem;
  47.     N8: TMenuItem;
  48.     ImageBar31: TImage;
  49.     ImageBar32: TImage;
  50.     ImageBar33: TImage;
  51.     ImageBar34: TImage;
  52.     ImageBar11: TImage;
  53.     ImageBar12: TImage;
  54.     ImageBar21: TImage;
  55.     ImageBar22: TImage;
  56.     ImageBar41: TImage;
  57.     procedure Image2Click(Sender: TObject);
  58.     procedure ShowBar(BarNo:Integer);
  59.     procedure ShowMenu(MenuNo:Integer);
  60.     procedure Image3Click(Sender: TObject);
  61.     procedure Image4Click(Sender: TObject);
  62.     procedure Image1Click(Sender: TObject);
  63.     procedure ImageBackMouseMove(Sender: TObject; Shift: TShiftState; X,
  64.       Y: Integer);
  65.     procedure Image7Click(Sender: TObject);
  66.     procedure Image6Click(Sender: TObject);
  67.     procedure Image111MouseMove(Sender: TObject; Shift: TShiftState; X,
  68.       Y: Integer);
  69.     procedure Image121MouseMove(Sender: TObject; Shift: TShiftState; X,
  70.       Y: Integer);
  71.     procedure Image131MouseMove(Sender: TObject; Shift: TShiftState; X,
  72.       Y: Integer);
  73.     procedure Image141MouseMove(Sender: TObject; Shift: TShiftState; X,
  74.       Y: Integer);
  75.     procedure Image151MouseMove(Sender: TObject; Shift: TShiftState; X,
  76.       Y: Integer);
  77.     procedure N3Click(Sender: TObject);
  78.     procedure Image112Click(Sender: TObject);
  79.     procedure Image122Click(Sender: TObject);
  80.     procedure Image132Click(Sender: TObject);
  81.     procedure Image152Click(Sender: TObject);
  82.     procedure Image111Click(Sender: TObject);
  83.     procedure Image121Click(Sender: TObject);
  84.     procedure Image131Click(Sender: TObject);
  85.     procedure Image151Click(Sender: TObject);
  86.     procedure N7Click(Sender: TObject);
  87.     procedure ShowFrame(FrameNo:Integer);
  88.     procedure N23Click(Sender: TObject);
  89.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  90.     procedure FormCreate(Sender: TObject);
  91.     procedure N15Click(Sender: TObject);
  92.     procedure N19Click(Sender: TObject);
  93.     procedure FormActivate(Sender: TObject);
  94.     procedure N9Click(Sender: TObject);
  95.     procedure N20Click(Sender: TObject);
  96.     procedure N5Click(Sender: TObject);
  97.     procedure N16Click(Sender: TObject);
  98.     procedure N6Click(Sender: TObject);
  99.     procedure N2Click(Sender: TObject);
  100.     procedure Image142Click(Sender: TObject);
  101.     procedure ImageBar11Click(Sender: TObject);
  102.     procedure ImageBar12Click(Sender: TObject);
  103.     procedure ImageBar21Click(Sender: TObject);
  104.     procedure ImageBar22Click(Sender: TObject);
  105.     procedure ImageBar31Click(Sender: TObject);
  106.     procedure ImageBar32Click(Sender: TObject);
  107.     procedure ImageBar33Click(Sender: TObject);
  108.     procedure ImageBar34Click(Sender: TObject);
  109.     procedure ImageBar41Click(Sender: TObject);
  110.     procedure N1Click(Sender: TObject);
  112.   private
  113.     { Private declarations }
  114.   public
  115.     { Public declarations }
  116.   end;
  118. var
  119.   Form2: TForm2;
  120.   CurrBar: Integer;
  121.   IsCreat: bool;
  123. implementation
  125. uses UnitLogin, UnitUserList, UnitProdList, UnitSell, UnitReportProd,
  126.   UnitDbBuckup, UnitReportSell, UnitSellHistory, UnitAbout, UnitHelp;
  128. {$R *.dfm}
  130. procedure TForm2.Image2Click(Sender: TObject);
  131. begin
  132.   ShowBar(2);
  133. end;
  135. procedure TForm2.ShowBar(BarNo:Integer);
  136. var
  137.   i,j:integer;
  138.   AImage:TComponent;
  139. begin
  140.   if  barno>currbar then
  141.   begin
  142.     for i := currbar+1 to barno do
  143.     begin
  144.       Aimage := Form2.FindComponent('Image' + IntToStr(i));
  145.       if Aimage is Timage then TImage(AImage).top :=  TImage(AImage).top-134;
  146.     end;
  147.   end
  148.   else
  149.   begin
  150.     for i := barno+1 to currbar do
  151.     begin
  152.       Aimage := Form2.FindComponent('Image' + IntToStr(i));
  153.       if Aimage is Timage then TImage(AImage).top :=  TImage(AImage).top+134;
  154.     end;
  155.   end;
  156.   for i:=1 to 4 do
  157.     for j:=1 to 4 do
  158.     begin
  159.       Aimage := Form2.FindComponent('ImageBar' + IntToStr(i) + IntToStr(j));
  160.       if Aimage is Timage then
  161.         if i=BarNo then
  162.           TImage(AImage).Visible := True
  163.         else
  164.           TImage(AImage).Visible := False;
  165.     end;
  166.   if CurrBar<>BarNo then sndplaysound(pchar(ExeRoot+'soundfolder.wav'),snd_async);
  167.   CurrBar := BarNo;
  168. end;
  170. procedure TForm2.ShowMenu(MenuNo:Integer);
  171. var
  172.   i: integer;
  173.   AImage: TComponent;
  174. begin
  175.   for i := 1 to 5 do
  176.   begin
  177.     Aimage := Form2.FindComponent('Image1' + IntToStr(i) + '2');
  178.     if i<>MenuNo then
  179.     begin
  180.       TImage(AImage).Visible := False;
  181.     end
  182.     else
  183.       TImage(AImage).Visible := True;
  184.   end;
  185. end;
  188. procedure TForm2.Image3Click(Sender: TObject);
  189. begin
  190.   ShowBar(3);
  191. end;
  193. procedure TForm2.Image4Click(Sender: TObject);
  194. begin
  195.   ShowBar(4);
  196. end;
  198. procedure TForm2.Image1Click(Sender: TObject);
  199. begin
  200.   ShowBar(1);
  201. end;
  203. procedure TForm2.ImageBackMouseMove(Sender: TObject; Shift: TShiftState; X,
  204.   Y: Integer);
  205. begin
  206.   ShowMenu(0);
  207.   if (ssleft in shift) then
  208.   begin
  209.     releasecapture;
  210.     perform(wm_syscommand, $f012, 0);
  211.   end;
  212. end;
  214. procedure TForm2.Image7Click(Sender: TObject);
  215. begin
  216.   application.Minimize;
  217. end;
  219. procedure TForm2.Image6Click(Sender: TObject);
  220. begin
  221.   application.Terminate;
  222. end;
  224. procedure TForm2.Image111MouseMove(Sender: TObject; Shift: TShiftState; X,
  225.   Y: Integer);
  226. begin
  227.   ShowMenu(1);
  228. end;
  230. procedure TForm2.Image121MouseMove(Sender: TObject; Shift: TShiftState; X,
  231.   Y: Integer);
  232. begin
  233.   ShowMenu(2);
  234. end;
  236. procedure TForm2.Image131MouseMove(Sender: TObject; Shift: TShiftState; X,
  237.   Y: Integer);
  238. begin
  239.   ShowMenu(3);
  240. end;
  242. procedure TForm2.Image141MouseMove(Sender: TObject; Shift: TShiftState; X,
  243.   Y: Integer);
  244. begin
  245.   ShowMenu(4);
  246. end;
  248. procedure TForm2.Image151MouseMove(Sender: TObject; Shift: TShiftState; X,
  249.   Y: Integer);
  250. begin
  251.   ShowMenu(5);
  252. end;
  254. procedure TForm2.N3Click(Sender: TObject);
  255. begin
  256.   form2.Close;
  257. end;
  259. procedure TForm2.Image112Click(Sender: TObject);
  260. begin
  261.   PopupMenu1.Popup(Form2.Left +Image112.Left ,Form2.Top + Image112.Top + Image112.Height + 1);
  262. end;
  264. procedure TForm2.Image122Click(Sender: TObject);
  265. begin
  266.   PopupMenu2.Popup(Form2.Left +Image122.Left ,Form2.Top + Image122.Top + Image122.Height + 1);
  267. end;
  269. procedure TForm2.Image132Click(Sender: TObject);
  270. begin
  271.   PopupMenu3.Popup(Form2.Left +Image132.Left ,Form2.Top + Image132.Top + Image132.Height + 1);
  272. end;
  274. procedure TForm2.Image152Click(Sender: TObject);
  275. begin
  276.   PopupMenu5.Popup(Form2.Left +Image152.Left ,Form2.Top + Image152.Top + Image152.Height + 1);
  277. end;
  279. procedure TForm2.Image111Click(Sender: TObject);
  280. begin
  281.   PopupMenu1.Popup(Form2.Left +Image112.Left ,Form2.Top + Image112.Top + Image112.Height + 1);
  282. end;
  284. procedure TForm2.Image121Click(Sender: TObject);
  285. begin
  286.   PopupMenu2.Popup(Form2.Left +Image122.Left ,Form2.Top + Image122.Top + Image122.Height + 1);
  287. end;
  289. procedure TForm2.Image131Click(Sender: TObject);
  290. begin
  291.   PopupMenu3.Popup(Form2.Left +Image132.Left ,Form2.Top + Image132.Top + Image132.Height + 1);
  292. end;
  294. procedure TForm2.Image151Click(Sender: TObject);
  295. begin
  296.   PopupMenu5.Popup(Form2.Left +Image152.Left ,Form2.Top + Image152.Top + Image152.Height + 1);
  297. end;
  299. procedure TForm2.N23Click(Sender: TObject);
  300. begin
  301.   {用户列表}ShowFrame(1);
  302. end;
  304. procedure TForm2.N7Click(Sender: TObject);
  305. begin
  306.   {商品列表}ShowFrame(2);
  307. end;
  309. procedure TForm2.ShowFrame(FrameNo:Integer);
  310. var
  311.   i: integer;
  312. begin
  313.   if (UserType<>'管理员') and (FrameNo<>3) then
  314.   begin
  315.     messagebox(handle,'没有足够的权限！','权限不足',MB_ICONWARNING+mb_ok);
  316.     exit;
  317.   end;
  318.   {清除所有的Frame}
  319.   for i:=0 to self.ComponentCount-1 do
  320.     if (self.Components[i] is Tframe) then (self.Components[i] as Tframe).Free;
  321.   {建立相应的Frame}
  322.   case FrameNo of
  323.     1:
  324.     begin
  325.       with TFrameUserList.Create(self) do
  326.       begin
  327.         Parent := Form2;
  328.         Left := 220;
  329.         Top := 195;
  330.         ADOQuery1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+DataFile+';Persist Security Info=False';
  331.         ADOQuery1.Active := True;
  332.         Show;
  333.       end;
  334.     end;
  335.     2:
  336.     begin
  337.       with TFrameProdList.Create(self) do
  338.       begin
  339.         Parent := Form2;
  340.         Left := 220;
  341.         Top := 195;
  342.         ADOQuery1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+DataFile+';Persist Security Info=False';
  343.         ADOQuery1.Active := True;
  344.         Show;
  345.       end;
  346.     end;
  347.     3:
  348.     begin
  349.       with TFrameSell.Create(self) do
  350.       begin
  351.         Parent := Form2;
  352.         Left := 220;
  353.         Top := 195;
  354.         ADOQuery1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+DataFile+';Persist Security Info=False';
  355.         Show;
  356.       end;
  357.     end;
  358.     4:
  359.     begin
  360.       with TFrameDbBuckup.Create(self) do
  361.       begin
  362.         Parent := Form2;
  363.         Left := 220;
  364.         Top := 195;
  365.         Show;
  366.       end;
  367.     end;
  368.     5:
  369.     begin
  370.       with TFrameSellHistory.Create(self) do
  371.       begin
  372.         Parent := Form2;
  373.         Left := 220;
  374.         Top := 195;
  375.         ADOQuery1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+DataFile+';Persist Security Info=False';
  376.         ADOQuery1.Active := True;
  377.         Show;
  378.       end;
  379.     end;
  380.   end;
  381. end;
  383. procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
  384. begin
  385.   IsCreat := True;
  386.   sndplaysound(pchar(ExeRoot+'soundlogout.wav'),snd_async);
  387.   form1.Show;
  388. end;
  390. procedure TForm2.FormCreate(Sender: TObject);
  391. begin
  392.   CurrBar := 3;
  393.   IsCreat := True;
  394. end;
  396. procedure TForm2.N15Click(Sender: TObject);
  397. begin
  398.   ShowFrame(3);
  399. end;
  401. procedure TForm2.N19Click(Sender: TObject);
  402. begin
  403.   if (UserType<>'管理员') then
  404.   begin
  405.     messagebox(handle,'没有足够的权限！','权限不足',MB_ICONWARNING+mb_ok);
  406.     exit;
  407.   end;
  408.   DbReportProd.ADOQuery1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+DataFile+';Persist Security Info=False;';
  409.   DbReportProd.ADOQuery1.Active := True;
  410.   DbRePortProd.QuickRep1.Refresh;
  411.   DbReportProd.QuickRep1.Preview;
  412. end;
  414. procedure TForm2.FormActivate(Sender: TObject);
  415. begin
  416.   if IsCreat then
  417.   begin
  418.     sndplaysound(pchar(ExeRoot+'soundlogin.wav'),snd_async);
  419.     ShowBar(3);
  420.     ShowFrame(3);
  421.     IsCreat := False;
  422.   end;
  423. end;
  425. procedure TForm2.N9Click(Sender: TObject);
  426. begin
  427.   ShowFrame(4);
  428. end;
  431. procedure TForm2.N20Click(Sender: TObject);
  432. begin
  433.   if (UserType<>'管理员') then
  434.   begin
  435.     messagebox(handle,'没有足够的权限！','权限不足',MB_ICONWARNING+mb_ok);
  436.     exit;
  437.   end;
  438.   DbReportSell.ADOQuery1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+DataFile+';Persist Security Info=False;';
  439.   DbReportSell.ADOQuery1.Active := True;
  440.   DbRePortSell.QuickRep1.Refresh;
  441.   DbReportSell.QuickRep1.Preview;
  442. end;
  444. procedure TForm2.N5Click(Sender: TObject);
  445. begin
  446.   Application.Terminate;
  447. end;
  449. procedure TForm2.N16Click(Sender: TObject);
  450. var
  451.   ADOQuery1: TADOQuery;
  452. begin
  453.   if (UserType<>'管理员') then
  454.   begin
  455.     messagebox(handle,'没有足够的权限！','权限不足',MB_ICONWARNING+mb_ok);
  456.     exit;
  457.   end;
  458.   ADOQuery1:= TADOQuery.Create(self);
  459.   ADOQuery1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+DataFile+';Persist Security Info=False;';
  460.   ADOQuery1.SQL.Clear;
  461.   ADOQuery1.SQL.Add('select sum(sell_prod_price*sell_number) as TDResult from t_sell where year(sell_time)=year(now()) and month(sell_time)=month(now()) and day(sell_time)=day(now())');
  462.   ADOQuery1.Open;
  463.   messagebox(handle,PChar('今日销售额为 '+ADOQuery1.FieldByName('TDResult').AsString+' 元。'),'今日盘点',MB_ICONinformation+mb_ok);
  464.   ADOQuery1.Free;
  465. end;
  467. procedure TForm2.N6Click(Sender: TObject);
  468. begin
  469.   ShowFrame(5);
  470. end;
  472. procedure TForm2.N2Click(Sender: TObject);
  473. begin
  474.   FormAbout.ShowModal;
  475. end;
  477. procedure TForm2.Image142Click(Sender: TObject);
  478. begin
  479.   if (UserType<>'管理员') then
  480.   begin
  481.     messagebox(handle,'没有足够的权限！','权限不足',MB_ICONWARNING+mb_ok);
  482.     exit;
  483.   end;
  484.   messagebox(handle,'共享版本不提供此功能，要升级软件，请与作者取得联系！','升级软件',MB_ICONinformation+mb_ok);
  485. end;
  487. procedure TForm2.ImageBar11Click(Sender: TObject);
  488. begin
  489.   N23Click(Self);
  490. end;
  492. procedure TForm2.ImageBar12Click(Sender: TObject);
  493. begin
  494.   N9Click(Self);
  495. end;
  497. procedure TForm2.ImageBar21Click(Sender: TObject);
  498. begin
  499.   N7Click(Self);
  500. end;
  502. procedure TForm2.ImageBar22Click(Sender: TObject);
  503. begin
  504.   N19Click(Self);
  505. end;
  507. procedure TForm2.ImageBar31Click(Sender: TObject);
  508. begin
  509.   N15Click(Self);
  510. end;
  512. procedure TForm2.ImageBar32Click(Sender: TObject);
  513. begin
  514.   N20Click(Self);
  515. end;
  517. procedure TForm2.ImageBar33Click(Sender: TObject);
  518. begin
  519.   N6Click(Self);
  520. end;
  522. procedure TForm2.ImageBar34Click(Sender: TObject);
  523. begin
  524.   N16Click(Self);
  525. end;
  527. procedure TForm2.ImageBar41Click(Sender: TObject);
  528. begin
  529.   Image142Click(Self);
  530. end;
  532. procedure TForm2.N1Click(Sender: TObject);
  533. begin
  534.   FormHelp.WebBrowser1.Navigate(ExeRoot+'helpindex.htm');
  535.   FormHelp.ShowModal;
  536. end;
  538. end.