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

源码开发语言/平台
当前位置：首页 > 源码/资料 > 行业应用 > 医药行业 > 查看源码
Umain.pas
资源名称：连锁药店源码.rar　[点击查看]
上传用户：jiete_yjc
上传日期：2010-02-11
资源大小：422k
文件大小：11k
源码类别：

医药行业

开发平台：

Delphi

Umain.pas：源码内容
  1. unit Umain;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, Menus, XPMenu, ComCtrls, ToolWin, ExtCtrls,  dxsbar, ImgList,  Buttons,
  8.   jpeg,udm,uypzdk,uxl,udj, Uypzdk2,uyg,urk,uxstj, ukctj,ulogin, StdCtrls,uty,ubs,upd,ukl,ukc,upf,uls,uac,ucr,uback,uuser;
  11. type userinfo=record
  12.        name:string;
  13.        qx:int64;
  14.        id:int64;
  15.        end;
  16. type
  17.   Tfmain = class(TForm)
  18.     MainMenu1: TMainMenu;
  19.     yp: TMenuItem;
  20.     ch: TMenuItem;
  21.     dm: TMenuItem;
  22.     exit: TMenuItem;
  23.     tj: TMenuItem;
  24.     pd1: TMenuItem;
  25.     N18: TMenuItem;
  26.     kclist1: TMenuItem;
  27.     yplist1: TMenuItem;
  28.     ypprice: TMenuItem;
  29.     ypadd: TMenuItem;
  30.     N24: TMenuItem;
  31.     bm1: TMenuItem;
  32.     xstj: TMenuItem;
  33.     xs: TMenuItem;
  34.     pf1: TMenuItem;
  35.     ls1: TMenuItem;
  36.     bs1: TMenuItem;
  37.     rk1: TMenuItem;
  38.     ty1: TMenuItem;
  39.     N12: TMenuItem;
  40.     crlist1: TMenuItem;
  41.     N14: TMenuItem;
  42.     djsearch: TMenuItem;
  43.     support: TMenuItem;
  44.     company1: TMenuItem;
  45.     xl1: TMenuItem;
  46.     N29: TMenuItem;
  47.     mm: TMenuItem;
  48.     user1: TMenuItem;
  49.     relogin: TMenuItem;
  50.     quit: TMenuItem;
  51.     N36: TMenuItem;
  52.     N37: TMenuItem;
  53.     back1: TMenuItem;
  54.     yg1: TMenuItem;
  55.     XPMenu1: TXPMenu;
  56.     ypedit: TMenuItem;
  57.     help: TMenuItem;
  58.     about: TMenuItem;
  59.     CoolBar1: TCoolBar;
  60.     scroll1: TPageScroller;
  61.     ToolBar1: TToolBar;
  62.     ToolButton1: TToolButton;
  63.     ToolButton2: TToolButton;
  64.     ToolButton3: TToolButton;
  65.     ToolButton4: TToolButton;
  66.     ToolButton5: TToolButton;
  67.     ToolButton6: TToolButton;
  68.     ToolButton8: TToolButton;
  69.     ToolButton7: TToolButton;
  70.     ToolButton10: TToolButton;
  71.     ToolButton9: TToolButton;
  72.     ToolButton11: TToolButton;
  73.     ToolButton12: TToolButton;
  74.     ToolButton13: TToolButton;
  75.     ToolButton14: TToolButton;
  76.     ToolButton15: TToolButton;
  77.     ToolButton16: TToolButton;
  78.     ToolButton17: TToolButton;
  79.     ToolButton18: TToolButton;
  80.     ToolButton19: TToolButton;
  81.     StatusBar1: TStatusBar;
  82.     kctj: TMenuItem;
  83.     systemhelp: TMenuItem;
  84.     N41: TMenuItem;
  85.     Image1: TImage;
  86.     Timer1: TTimer;
  87.     procedure quitClick(Sender: TObject);
  88.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  89.     procedure yplist1Click(Sender: TObject);
  90.     procedure ypaddClick(Sender: TObject);
  91.     procedure ypeditClick(Sender: TObject);
  92.     procedure yppriceClick(Sender: TObject);
  93.     procedure yg1Click(Sender: TObject);
  94.     procedure bm1Click(Sender: TObject);
  95.     procedure company1Click(Sender: TObject);
  96.     procedure rk1Click(Sender: TObject);
  97.     procedure ty1Click(Sender: TObject);
  98.     procedure bs1Click(Sender: TObject);
  99.     procedure pd1Click(Sender: TObject);
  100.     procedure kclist1Click(Sender: TObject);
  101.     procedure pf1Click(Sender: TObject);
  102.     procedure FormCreate(Sender: TObject);
  103.     procedure aboutClick(Sender: TObject);
  104.     procedure systemhelpClick(Sender: TObject);
  105.     procedure supportClick(Sender: TObject);
  106.     procedure ls1Click(Sender: TObject);
  107.     procedure crlist1Click(Sender: TObject);
  108.     procedure back1Click(Sender: TObject);
  109.     procedure user1Click(Sender: TObject);
  110.     procedure FormShow(Sender: TObject);
  111.     procedure Timer1Timer(Sender: TObject);
  112.     procedure xl1Click(Sender: TObject);
  113.     procedure reloginClick(Sender: TObject);
  114.     procedure mmClick(Sender: TObject);
  115.     procedure xstjClick(Sender: TObject);
  116.     procedure djsearchClick(Sender: TObject);
  117.     procedure kctjClick(Sender: TObject);
  118.   private
  119.    FClientInstance,
  120.    FPrevClientProc : TFarProc;
  122.    PROCEDURE ClientWndProc(VAR Message: TMessage);
  124.   public
  125.     auser:userinfo;{ Public declarations }
  126.     operid:int64;
  127.   end;
  129. var
  131.   fmain: Tfmain;
  132.   ypzdk:tfypzdk;
  133.   ypzdk2:tfypzdk2;
  134.   yg:tfyg;
  135.   rk:tfrk;
  136.   ty:tfty;
  137.   bs:tfbs ;
  138.   pd:tfpd;
  139.   kc:tfkc;
  140.   pf:tfpf ;
  141.   ls:tfls;
  142.   ac:tfac;
  143.   cr:tfcr;
  144.   back:tfback;
  145.   user:tfuser;
  146.   xl:tfxl;
  147.   kl:tfkl;
  148.   xstj1:tfxstj ;
  149.   dj:tfdj;
  150.   kctj1:tfkctj;
  151. implementation
  155. {$R *.dfm}
  156. PROCEDURE TFmain.ClientWndProc(VAR Message: TMessage); 
  157. VAR 
  158.   MyDC : hDC; 
  159.   Ro, Co : Word; 
  160. begin 
  161.    with Message do
  162.     case Msg of
  163.       WM_ERASEBKGND:
  164.         begin
  165.           MyDC := TWMEraseBkGnd(Message).DC;
  166.           FOR Ro := 0 TO ClientHeight DIV Image1.Picture.Height DO
  167.             FOR Co := 0 TO ClientWIDTH DIV Image1.Picture.Width DO
  168.               BitBlt(MyDC, Co*Image1.Picture.Width, Ro*Image1.Picture.Height,
  169.                 Image1.Picture.Width, Image1.Picture.Height,
  170.                 Image1.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
  171.           Result := 1;
  172.         end;
  173.     else
  174.        Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
  175.     end;
  176. end; 
  178.     
  181. procedure Tfmain.quitClick(Sender: TObject);
  182. begin
  183. close;
  184. end;
  186. procedure Tfmain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  187. begin
  188. canclose:=application.MessageBox('你真的要退出吗？','退出',mb_yesno)=idyes ;
  189. if canclose then
  190. begin
  191.   try
  192.   adodm.tcr.close;
  193.   adodm.tdw.close;
  194.   adodm.tbm.close;
  195.   adodm.tyg.close;
  196.   adodm.tuser.Close;
  197.   adodm.tkc.Close;
  198.   adodm.ydconn.Close;
  199.   except
  200.   end;
  201. end;
  202. end;
  204. procedure Tfmain.yplist1Click(Sender: TObject);
  206. begin
  207. if application.FindComponent('fypzdk')=nil then
  208. begin
  209. ypzdk:=tfypzdk.create(application) ;
  210. ypzdk.Show;
  211. end
  212. else
  213. if not ypzdk.Showing then
  214. ypzdk.Show;
  215. end;
  216. procedure Tfmain.ypaddClick(Sender: TObject);
  217. begin
  218. yplist1.Click;
  219. ypzdk.BitBtn2.Click;
  220. end;
  222. procedure Tfmain.ypeditClick(Sender: TObject);
  223. begin
  224. yplist1.Click;
  225. ypzdk.search.SetFocus;
  226. end;
  228. procedure Tfmain.yppriceClick(Sender: TObject);
  229. begin
  231. if not fypzdk2.Showing then
  232. fypzdk2.Show;
  233. fypzdk2.sp1.Show;
  234. fypzdk2.look1.Show;
  235. fypzdk2.btadd.Visible:=false;
  236. fypzdk2.ls.Enabled:=true;
  237. fypzdk2.pf.Enabled:=true;
  239. end;
  241. procedure Tfmain.yg1Click(Sender: TObject);
  242. begin
  243. if application.FindComponent('fyg')=nil then
  244. begin
  245. yg:=tfyg.create(application) ;
  246. yg.Show;
  247. end
  248. else
  249. if not yg.Showing then
  250. yg.Show;
  251. yg.TabSheet1.Show;
  253. end;
  255. procedure Tfmain.bm1Click(Sender: TObject);
  256. begin
  257. if application.FindComponent('fyg')=nil then
  258. begin
  259. yg:=tfyg.create(application) ;
  260. yg.Show;
  261. end
  262. else
  263. if not yg.Showing then
  264. yg.Show;
  265. yg.TabSheet2.Show;
  267. end;
  269. procedure Tfmain.company1Click(Sender: TObject);
  270. begin
  271. if application.FindComponent('fyg')=nil then
  272. begin
  273. yg:=tfyg.create(application) ;
  274. yg.Show;
  275. end
  276. else
  277. if not yg.Showing then
  278. yg.Show;
  279. yg.TabSheet3.Show;
  280. end;
  282. procedure Tfmain.rk1Click(Sender: TObject);
  283. begin
  284. if application.FindComponent('frk')=nil then
  285. begin
  286. rk:=tfrk.create(application) ;
  287. rk.Show;
  288. end
  289. else
  290. if not rk.Showing then
  291. rk.Show;
  292. rk.Edit1.Text:=auser.name;
  295. end;
  297. procedure Tfmain.ty1Click(Sender: TObject);
  298. begin
  299.  if application.FindComponent('fty')=nil then
  300. begin
  301. ty:=tfty.create(application) ;
  302. ty.Show;
  303. end
  304. else
  305. if not ty.Showing then
  306. ty.Show;
  307. ty.Edit1.Text:=auser.name;
  308. end;
  310. procedure Tfmain.bs1Click(Sender: TObject);
  311. begin
  312. if application.FindComponent('fbs')=nil then
  313. begin
  314. bs:=tfbs.create(application) ;
  315. bs.Show;
  316. end
  317. else
  318. if not bs.Showing then
  319. bs.Show;
  320. bs.Edit1.Text:=auser.name;
  321. end;
  323. procedure Tfmain.pd1Click(Sender: TObject);
  324. begin
  325. if application.FindComponent('fpd')=nil then
  326. begin
  327. pd:=tfpd.create(application) ;
  328. pd.Show;
  329. end
  330. else
  331. if not pd.Showing then
  332. pd.Show;
  333. pd.Edit1.Text:=auser.name;
  334. end;
  336. procedure Tfmain.kclist1Click(Sender: TObject);
  337. begin
  338. if application.FindComponent('fkc')=nil then
  339. begin
  340. kc:=tfkc.create(application) ;
  341. kc.Show;
  342. end
  343. else
  344. if not kc.Showing then
  345. kc.Show;
  347. end;
  350. procedure Tfmain.pf1Click(Sender: TObject);
  351. begin
  352. if application.FindComponent('fpf')=nil then
  353. begin
  354. pf:=tfpf.create(application) ;
  355. pf.Show;
  356. end
  357. else
  358. if not pf.Showing then
  359. pf.Show;
  360. pf.Edit1.Text:=auser.name;
  361. end;
  363. procedure Tfmain.FormCreate(Sender: TObject);
  364. begin
  365.    FClientInstance := MakeObjectInstance(ClientWndProc);
  366.    FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC)); 
  367.    SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
  368. end;
  370. procedure Tfmain.aboutClick(Sender: TObject);
  371. begin
  372.  if application.FindComponent('fac')=nil then
  373. begin
  374. ac:=tfac.create(application) ;
  375. ac.Label4.Caption:='欢迎使用本公司的软件产品！' ;
  376. ac.ShowModal;
  378. end
  379. else
  380. if not ac.Showing then
  381. ac.Show;
  382. end;
  384. procedure Tfmain.systemhelpClick(Sender: TObject);
  385. begin
  386. //showmessage('本软件是测试版本，不包括此项功能！');
  387. end;
  389. procedure Tfmain.supportClick(Sender: TObject);
  390. begin
  391. //showmessage('本软件是测试版本，不包括此项功能！');
  392. end;
  394. procedure Tfmain.ls1Click(Sender: TObject);
  395. begin
  396. if application.FindComponent('fls')=nil then
  397. begin
  398. ls:=tfls.create(application) ;
  399. ls.Show;
  401. end
  402. else
  403. if not ls.Showing then
  404. ls.Show;
  406. ls.Edit1.Text:=auser.name;
  407. end;
  411. procedure Tfmain.crlist1Click(Sender: TObject);
  412. begin
  413. if application.FindComponent('fcr')=nil then
  414. begin
  415. cr:=tfcr.create(application) ;
  416. cr.Show;
  417. end
  418. else
  419. if not cr.Showing then
  420. cr.Show;
  422. end;
  424. procedure Tfmain.back1Click(Sender: TObject);
  425. begin
  426. if application.FindComponent('fback')=nil then
  427. begin
  428. back:=tfback.create(application) ;
  429. back.Show;
  430. end
  431. else
  432. if not back.Showing then
  433. back.Show;
  434. end;
  436. procedure Tfmain.user1Click(Sender: TObject);
  437. begin
  438. if application.FindComponent('fuser')=nil then
  439. begin
  440. user:=tfuser.create(application) ;
  441. user.Show;
  442. end
  443. else
  444. if not user.Showing then
  445. user.Show;
  446. end;
  448. procedure Tfmain.FormShow(Sender: TObject);
  449. begin
  450. //flogin.Edit2.Text:='';
  452. //flogin.Show;
  453. end;
  455. procedure Tfmain.Timer1Timer(Sender: TObject);
  456. begin
  457. statusbar1.Panels[0].Text:='当前时间：'+datetimetostr(now);
  458. end;
  460. procedure Tfmain.xl1Click(Sender: TObject);
  461. begin
  462. if application.FindComponent('fxl')=nil then
  463. begin
  464. xl:=tfxl.create(application) ;
  465. xl.Show;
  466. end
  467. else
  468. if not xl.Showing then
  469. xl.Show;
  471. end;
  473. procedure Tfmain.reloginClick(Sender: TObject);
  474. begin
  475. adodm.toper.Open;
  476. if adodm.toper.Locate('operid',operid,[]) then
  477.     begin
  478.           adodm.toper.edit;
  479.           adodm.toper.FieldByName('退出时间').AsDateTime:=now;
  480.           adodm.toper.Post;
  481.     end;
  482. flogin.ShowModal;
  483. end;
  485. procedure Tfmain.mmClick(Sender: TObject);
  486. begin
  487. if application.FindComponent('fkl')=nil then
  488. begin
  489. kl:=tfkl.create(application) ;
  490. kl.Show;
  491. end
  492. else
  493. if not kl.Showing then
  494. kl.Show;
  496. end;
  498. procedure Tfmain.xstjClick(Sender: TObject);
  499. begin
  500. if application.FindComponent('fxstj')=nil then
  501. begin
  502. xstj1:=tfxstj.create(application) ;
  503. xstj1.Show;
  504. end
  505. else
  506. if not xstj1.Showing then
  507. xstj1.Show;
  508. end;
  510. procedure Tfmain.djsearchClick(Sender: TObject);
  511. begin
  512. if application.FindComponent('fdj')=nil then
  513. begin
  514. dj:=tfdj.create(application) ;
  515. dj.Show;
  516. end
  517. else
  518. if not dj.Showing then
  519. dj.Show;
  520. end;
  523. procedure Tfmain.kctjClick(Sender: TObject);
  524. begin
  525.  if application.FindComponent('fkctj')=nil then
  526. begin
  527. kctj1:=tfkctj.create(application) ;
  528. kctj1.Show;
  529. end
  530. else
  531. if not kctj1.Showing then
  532. kctj1.Show;
  533. end;
  535. end.