⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 popedom_unit.pas

📁 药品进销管理程序,内有SQL附加的数据库.....详情看里面的,运行就OK
💻 PAS
字号:
unit Popedom_Unit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, CheckLst, Buttons, ComCtrls, DB,
  ADODB;

type
  TfrmAuthorize = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    chlbItems: TCheckListBox;
    btnOk: TBitBtn;
    btnCancel: TBitBtn;
    tvUser: TTreeView;
    qryTemp: TADOQuery;
    procedure FormShow(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure btnOkClick(Sender: TObject);
    procedure tvUserClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmAuthorize: TfrmAuthorize;

implementation

uses Common_Unit, LeechdomMain_Unit;

{$R *.dfm}

procedure TfrmAuthorize.FormShow(Sender: TObject);
var
  ListSQL, UserSQL: string;
  Node: TTreeNode;
begin
  ListSQL := 'Select * From MenuInfo';
  UserSQL := 'select * from [User]';
  chlbItems.Items.Clear;
  OpenDataSQL(qryTemp, ListSQL);
  with qryTemp do
  begin
    while not Eof do
    begin
      chlbItems.Items.Add(FieldByName('MenuName').AsString);
      Next;
    end;
  end;
  tvUser.Items.Clear;
  OpenDataSQL(qryTemp, UserSQL);
  with qryTemp do
  begin
    while not Eof do
    begin
      tvUser.Items.Add(nil,FieldByName('LoginID').AsString + '.' + FieldByName('LogName').AsString);
      Next;
    end;
  end;
end;

procedure TfrmAuthorize.btnCancelClick(Sender: TObject);
begin
  inherited;
  Close;
end;

procedure TfrmAuthorize.btnOkClick(Sender: TObject);
var
  SetSQL: string;
  i: integer;
begin
  if tvUser.Selected.Selected = False then
    Exit;
  for i := 0 to chlbItems.Items.Count - 1 do
  begin
    if chlbItems.Checked[i] = True then
    begin
      SetSQL := 'Exec proc_Base @Flag=''Insert_Popedom'' '
              + ',@UserID=' + Quotedstr(Copy(tvUser.Selected.Text,1,Pos('.',tvUser.Selected.Text) - 1))
              + ',@MenuName=' + Quotedstr(chlbItems.Items.Strings[i]);
      ExecSQL(qryTemp,SetSQL);
    end;
  end;
  Application.MessageBox('权限设定成功!','提示',64); 
end;

procedure TfrmAuthorize.tvUserClick(Sender: TObject);
var
  SelSQL: string;
  i, j: integer;
begin
  for j := 0 to chlbItems.Items.Count - 1 do
     chlbItems.Checked[j] := False;
  SelSQL := 'Exec proc_Base @Flag=''SelectPopodom''' + ',@UserID=' + QUotedstr(Copy(tvUser.Selected.Text,1,Pos('.',tvUser.Selected.Text) - 1));
  OpenDataSQL(qryTemp, SelSQL);
  with qryTemp do
  begin
    while not eof do
    begin
      for i := 0 to chlbItems.Items.Count - 1 do
        if chlbItems.Items.Strings[i] = FieldByName('MenuName').AsString then
          chlbItems.Checked[i] := True;
      Next;
    end;
  end;
end;

procedure TfrmAuthorize.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caFree;
  frmAuthorize := nil;
end;

end.

⌨️ 快捷键说明

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