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

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

医药行业

开发平台：

Delphi

uuser.pas：源码内容
  1. unit uuser;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, ComCtrls, StdCtrls, Buttons, CheckLst, ImgList;
  8. type intptr=record
  9.          id:integer;
  10.          qx:int64;
  11.       end;
  13. type
  14.   TFuser = class(TForm)
  15.     man: TTreeView;
  16.     BitBtn1: TBitBtn;
  17.     BitBtn2: TBitBtn;
  18.     BitBtn3: TBitBtn;
  19.     BitBtn4: TBitBtn;
  20.     qx: TCheckListBox;
  21.     ImageList1: TImageList;
  22.     procedure BitBtn1Click(Sender: TObject);
  23.     procedure FormShow(Sender: TObject);
  24.     procedure BitBtn4Click(Sender: TObject);
  25.     procedure manChange(Sender: TObject; Node: TTreeNode);
  26.     procedure BitBtn3Click(Sender: TObject);
  27.     procedure BitBtn2Click(Sender: TObject);
  28.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  29.   private
  30.     { Private declarations }
  31.   public
  32.     { Public declarations }
  33.   end;
  35. var
  36.   Fuser: TFuser;
  38. implementation
  40. uses udm,uuser2;
  42. {$R *.dfm}
  44. procedure TFuser.BitBtn1Click(Sender: TObject);
  45. var newnode:Ttreenode;ptr:^intptr;i:integer;
  46. begin
  47.   adodm.tuser.Append;
  48.   i:= fuser2.ShowModal ;
  49.   //showmessage(inttostr(i));
  50.   if i=mrok then
  51.   begin
  52.   adodm.tuser.Last;
  53.  // showmessage(adodm.tuser.fieldbyname('yh').asstring);
  54.   newnode:=ttreenode.Create(man.Items);
  55.   new(ptr);
  56.   ptr.id:= adodm.tuser.fieldbyname('userid').AsInteger;
  57.   ptr.qx:=adodm.tuser.fieldbyname('able').asinteger;
  58.   man.Items.AddObject(newnode,adodm.tuser.fieldbyname('oper').asstring,ptr) ;
  59.   newnode.Free;
  60.   end;
  61. end;
  63. procedure TFuser.FormShow(Sender: TObject);
  65. var newnode:Ttreenode;
  66.     ptr:^intptr;
  68. begin
  69.  man.Items.Clear;
  70.  adodm.tuser.Close;
  71.  adodm.tuser.Open;
  72.  adodm.tuser.First;
  73.  newnode:=ttreenode.Create(man.Items);
  74.  
  75.  while not adodm.tuser.Eof do
  76.  begin
  77.  new(ptr);
  78.  ptr.id:= adodm.tuser.fieldbyname('userid').AsInteger;
  79.  ptr.qx:=adodm.tuser.fieldbyname('able').asinteger;
  80.  man.Items.AddObject(newnode,adodm.tuser.fieldbyname('oper').asstring,ptr) ;
  81.  adodm.tuser.Next;
  83.  end;
  84.  newnode.Free;
  85. end;
  87. procedure TFuser.BitBtn4Click(Sender: TObject);
  88. begin
  89.   close;
  90. end;
  92. procedure TFuser.manChange(Sender: TObject; Node: TTreeNode);
  93. var a:int64; i:integer;
  94. begin
  95.     a:=intptr(node.Data^).qx;
  96.     //showmessage(inttostr(a));
  97.     a:=a xor 1234567890;
  98.     a:=a shr 10;
  99.     for i:=0 to qx.Items.Count-1 do //共有6 种权限
  100.     if ((1 shl i) and a)<>0 then
  101.     qx.Checked[i]:=true
  102.     else
  103.     qx.Checked[i]:=false;
  105.     
  106. end;
  108. procedure TFuser.BitBtn3Click(Sender: TObject);
  109. var i:integer; a:int64;
  110. begin
  111.   a:=0;
  112.   for i:=0 to  qx.Items.Count-1 do
  113.   if qx.Checked[i] then
  114.   a:=a or (1 shl i);
  116.   a:=a shl 10  ;
  118.   a:=a xor 1234567890;
  119.  // showmessage(inttostr(a));
  120.  if  adodm.tuser.Locate('userid',intptr(man.Selected.Data^).id,[]) then
  121.  begin
  122.     // showmessage('找到了!'+adodm.tuser.FieldByName('yh').Asstring);
  123.      adodm.tuser.Edit;
  124.      adodm.tuser.FieldByName('able').Asstring:=inttostr(a);
  125.     // showmessage(adodm.tuser.FieldByName('qx').Asstring+'  a='+inttostr(a)) ;
  126.      adodm.tuser.Post;
  127.      intptr(man.Selected.Data^).qx:=a;
  128.  end
  129.  else
  130.       showmessage('在数据库中没有找到该用户的信息,请重新录入信息!');
  131.       
  135. end;
  137. procedure TFuser.BitBtn2Click(Sender: TObject);
  138. begin
  139.  if  adodm.tuser.Locate('userid',intptr(man.Selected.Data^).id,[]) then
  140.     begin
  141.     if messagedlg('真的要删除此用户吗?',mtwarning,[mbyes,mbno],0)=mryes then
  142.        adodm.tuser.delete;
  143.     end
  145.  else
  146.       showmessage('在数据库中没有找到该用户的信息,可能已经被删除了!');
  147.        man.Selected.Delete;
  148.  end;
  149.      
  150. procedure TFuser.FormClose(Sender: TObject; var Action: TCloseAction);
  151. begin
  152. action:=cafree;
  153. end;
  155. end.