Delphi 编写菜单权限设置的一个方法《LceMeaning》

最新推荐文章于 2023-11-05 15:45:27 发布
最新推荐文章于 2023-11-05 15:45:27 发布
阅读量289 收藏 2
点赞数
原文链接：http://www.cnblogs.com/LceMeaning/p/3503282.html
版权

以下本人在Delphi XE2 进行编写并通过

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.Menus, Vcl.StdCtrls,
  Data.DB, Data.Win.ADODB, CommCtrl, Vcl.Grids, Vcl.DBGrids;

type
  TForm1 = class(TForm)
    tv1: TTreeView;
    btn1: TButton;
    mmo1: TMemo;
    con1: TADOConnection;
    qry1: TADOQuery;
    btn5: TButton;
    btn2: TButton;
    qry2: TADOQuery;
    btn3: TButton;
    dlgSave1: TSaveDialog;
    mm1: TMainMenu;
    N86: TMenuItem;
    N87: TMenuItem;
    N88: TMenuItem;
    N84: TMenuItem;
    N83: TMenuItem;
    N85: TMenuItem;
    N91: TMenuItem;
    N92: TMenuItem;
    N93: TMenuItem;
    N1: TMenuItem;
    N78: TMenuItem;
    N79: TMenuItem;
    N80: TMenuItem;
    N81: TMenuItem;
    N82: TMenuItem;
    N90: TMenuItem;
    N2: TMenuItem;
    N57: TMenuItem;
    N59: TMenuItem;
    N58: TMenuItem;
    N60: TMenuItem;
    N61: TMenuItem;
    N95: TMenuItem;
    N62: TMenuItem;
    N63: TMenuItem;
    N64: TMenuItem;
    N65: TMenuItem;
    N66: TMenuItem;
    N67: TMenuItem;
    N69: TMenuItem;
    N70: TMenuItem;
    N71: TMenuItem;
    N72: TMenuItem;
    N103: TMenuItem;
    N75: TMenuItem;
    N73: TMenuItem;
    N74: TMenuItem;
    N76: TMenuItem;
    N77: TMenuItem;
    N3: TMenuItem;
    N53: TMenuItem;
    N54: TMenuItem;
    N55: TMenuItem;
    N56: TMenuItem;
    N4: TMenuItem;
    N42: TMenuItem;
    N44: TMenuItem;
    N52: TMenuItem;
    N45: TMenuItem;
    N46: TMenuItem;
    N47: TMenuItem;
    N48: TMenuItem;
    N49: TMenuItem;
    N50: TMenuItem;
    N51: TMenuItem;
    N5: TMenuItem;
    N32: TMenuItem;
    N33: TMenuItem;
    N34: TMenuItem;
    N35: TMenuItem;
    N36: TMenuItem;
    N37: TMenuItem;
    N38: TMenuItem;
    N39: TMenuItem;
    N40: TMenuItem;
    N41: TMenuItem;
    N6: TMenuItem;
    N29: TMenuItem;
    N31: TMenuItem;
    N28: TMenuItem;
    N89: TMenuItem;
    N7: TMenuItem;
    N25: TMenuItem;
    N96: TMenuItem;
    N30: TMenuItem;
    N100: TMenuItem;
    N27: TMenuItem;
    N99: TMenuItem;
    N26: TMenuItem;
    N101: TMenuItem;
    N102: TMenuItem;
    N8: TMenuItem;
    N21: TMenuItem;
    N22: TMenuItem;
    N23: TMenuItem;
    N24: TMenuItem;
    N97: TMenuItem;
    N43: TMenuItem;
    N98: TMenuItem;
    N9: TMenuItem;
    N16: TMenuItem;
    N20: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    N19: TMenuItem;
    N94: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    btn4: TButton;
    procedure aaaaa(mMenu: TMenuItem; nNode: TTreeNodes;p_node: TTreeNode);
    procedure btn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btn5Click(Sender: TObject);
    procedure tv1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure btn4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Rights, MenuCaptions : string;
implementation

{$R *.dfm}
const
TVIS_CHECKED = $2000;

//检查某个节点是否被 选中
function IsChecked(Node: TTreeNode): Boolean;
var
  TvItem :TTVItem;
begin
  TvItem.Mask := TVIF_STATE;
  TvItem.hItem := Node.ItemId;
  TreeView_GetItem(Node.TreeView.Handle, TvItem);
  Result := (TvItem.State and TVIS_CHECKED) = TVIS_CHECKED;
end;

//让 某个节点被 选中
procedure SetChecked(Node: TTreeNode; Checked: Boolean);
var
TvItem :TTVItem;
begin
  FillChar(TvItem, SizeOf(TvItem), 0);
  with TvItem do
  begin
    hItem := Node.ItemId;
    Mask := TVIF_STATE;
    StateMask := TVIS_STATEIMAGEMASK;
    if Checked then
      TvItem.State :=TVIS_CHECKED
    else
    TvItem.State := TVIS_CHECKED shr 1;
    TreeView_SetItem(Node.TreeView.Handle, TvItem);
  end;
end;

// 检查对节点中所有子节点 选中 或 未选中 状态
procedure tvToggleCheckbox(TreeView: TTreeView;Node: TTreeNode ;isclick :boolean=false);
var
  CurNode, ParentNode, GrandSonNode,sonNode: TTreeNode;
  flg1: boolean;
begin
  CurNode :=node;
  with TreeView do
    begin
      if IsChecked(CurNode) then //
        begin
          sonNode := CurNode.GetFirstChild; //遍历子树,选中 则子节点 全部 为选中；
          while sonNode<>nil do
            begin
              SetChecked(sonNode, true);
              tvToggleCheckbox(TreeView,sonNode,true);
              sonNode := sonNode.GetNextSibling;
            end;
            ParentNode:= CurNode.Parent; //父；
          if ParentNode<>nil then
            begin
              if not isChecked(parentNode) then
                begin
                  GrandSonNode := ParentNode.GetFirstChild; //遍历子树；
                  flg1 := false;
                  while GrandSonNode<>nil do
                  begin
                    if (not IsChecked(GrandSonNode)) then //true,有未选中
                      flg1 := true;
                    if flg1 then //已有、退出loop;
                      GrandSonNode := nil
                    else
                      GrandSonNode := GrandSonNode.GetNextSibling;
                  end;
                    SetChecked(ParentNode, not flg1);
                    tvToggleCheckbox(TreeView,ParentNode,false);
                end;
            end; // end parentNode 不等于空
        end
      else
        if not IsChecked(CurNode) then
          begin
            ParentNode := CurNode.Parent; //父；
            if ParentNode<>nil then
              begin
                if isChecked(parentNode) then
                  begin
                    SetChecked(ParentNode, false);
                    tvToggleCheckbox(TreeView,ParentNode);
                  end;
              end; //end parentnode

            if (isclick) then
              begin
              sonNode := CurNode.GetFirstChild; //遍历子树,未选中 则子节点 全部 为未选中；
                while sonNode<>nil do
                  begin
                    SetChecked(sonNode, false);
                    tvToggleCheckbox(TreeView,sonNode,true);
                    sonNode := sonNode.GetNextSibling;
                  end;
              end;
          end;
    end;
end;



procedure TForm1.aaaaa(mMenu: TMenuItem{父节子}; nNode: TTreeNodes{};p_node: TTreeNode{});
var
  i: Integer;
  c_node: TTreeNode;
begin
  for i := 0 to mMenu.Count - 1 do
  begin
    if mMenu.Items[i].Caption <> '-' then
      begin
        c_node := nNode.AddChild(p_node,mMenu.Items[i].Caption);
        aaaaa(mMenu.Items[i],nNode,c_node);                                         //递归
      end;
  end;
end;


procedure treeCldnode(Anode: TTreeNode; Query: TADOQuery);
var
  TVI: TTVItem;
  i: integer;
  node: TTreeNode;
  right,sql : string;
begin
  for i := 0 to Anode.Count - 1 do
    begin
      Node := ANode.Item[i];
      TVI.mask := TVIF_STATE;
      TVI.hItem := Node.ItemId;
      TreeView_GetItem(Anode.Handle, TVI);

      if TVI.state and $2000 = $2000 then
        right := '1'
      else
        right := '0';

      //sql := 'update UserRights set Rights='''+Right+''' where UserGroups=''管理员'' and MenuCaptions='''+Anode.Item[i].Text+'''';
      sql := 'insert into UserRights(UserGroups,MenuCaptions,Rights) values('''
         +'收银员'','''+Anode.Item[i].Text+''','''+right+''')';
      Query.Close;
      Query.SQL.Clear;
      Query.SQL.Add(sql);
      Query.ExecSQL;

      if node.Count > 0 then
        treeCldnode(Node,Query);
    end;
end;

procedure TraverseTreeView(Anode1: TTreeNode; Menu: string; Rig: Boolean);
var
  i: integer;
  node: TTreeNode;
  sql :string;
begin
  for i := 0 to Anode1.Count - 1 do
    begin
      Node := ANode1.Item[i];

      if Anode1.Item[i].Text = Menu then
        begin
          if Rig then
              SetChecked(node, True)
          else
              SetChecked(node, False);
        end;

      if node.Count > 0 then
        TraverseTreeView(Node,Menu,Rig);
    end;
end;

//遍历菜单
procedure TForm1.btn1Click(Sender: TObject);
var
  i: Integer;
  parent_node : TTreeNode;
begin
  tv1.Items.Clear;
  for i:= 0 to mm1.Items.Count-1 do //父节子10
  begin
    parent_node := tv1.Items.Add(nil,mm1.Items[i].Caption);
    aaaaa(mm1.Items[i],tv1.Items, parent_node);
  end;
  tv1.FullExpand;
end;

//加载
procedure TForm1.btn2Click(Sender: TObject);
var
  i,ii: Integer;
  sql : string;
  node1 : TTreeNode;
  rig : Boolean;
begin
  sql := 'select * from UserRights where UserGroups=''管理员''';
  qry2.Close;
  qry2.SQL.Clear;
  qry2.SQL.Add(sql);
  qry2.Open;

  for ii := 0 to qry2.RecordCount do
    begin
      MenuCaptions := qry2.FieldByName('MenuCaptions').AsString;
      Rights := qry2.FieldByName('Rights').AsString;
      rig := Bool(StrToInt(Rights));
      //rig := true;
      for i := 0 to tv1.Items.Count - 1 do
        begin
          node1 := tv1.Items[i];
          TraverseTreeView(node1,MenuCaptions,rig);
        end;
      qry2.Next;
    end;
end;

//保存菜单到文件
procedure TForm1.btn3Click(Sender: TObject);
begin
  if dlgSave1.Execute then
    tv1.SaveToFile(dlgSave1.FileName);
end;

procedure TForm1.btn4Click(Sender: TObject);
var
  i: Integer;
  parent_node : TTreeNode;
begin
  for i:= 0 to mm1.Items.Count-1 do //父节子10
  begin
    mmo1.Lines.Add(mm1.Items[i].Caption);
  end;
end;

//遍历Treeview写数据
procedure TForm1.btn5Click(Sender: TObject);
var
  i: integer;
  node: TTreeNode;
begin
  for i := 0 to tv1.Items.Count - 1 do
    begin
      node := tv1.Items[i];
      treeCldnode(node,qry1);
    end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  //仅仅这一句话就能让treeview 显示复选框
  SetWindowLong(TV1.Handle, GWL_STYLE, GetWindowLong(TV1.Handle, GWL_STYLE) or $00000100);
end;

//Treeview 点击事件
procedure TForm1.tv1Click(Sender: TObject);
var
  P:TPoint;
  treenode :TTreeNode;
begin
  GetCursorPos(P);
  P := Tv1.ScreenToClient(P);
  if (htOnStateIcon in Tv1.GetHitTestInfoAt(P.X,P.Y)) then
    begin
      treenode := Tv1.GetNodeAt(P.X,P.Y);
      tvToggleCheckbox(Tv1,treenode ,true);
    end;
end;

end.

 实现方法：

procedure TForm1.btnLoadMenuClick(Sender: TObject);
var
  Rec, I, II : Integer;
  sql, MenuCaption : string;
  UserRight : Boolean;
  label GoToStr;
begin
  sql := 'select * from UserRights where UserGroups='''+DeptName+'''';
  qrySet.Close;
  qrySet.SQL.Clear;
  qrySet.SQL.Add(sql);
  qrySet.Open;

  if qryset.RecordCount > 0 then
    for Rec := 0 to qrySet.RecordCount - 1 do
      begin
        MenuCaption := qrySet.FieldByName('MenuCaptions').AsString;  //菜单名
        UserRight := StrToBool(qrySet.FieldByName('Rights').asString);  //1为真; 0为假
        for I := 0 to mm1.Items.Count-1 do                              //遍历菜单
          begin
            for II := 0 to mm1.Items[I].Count - 1 do
              begin
                if MenuCaption = mm1.Items[I][II].Caption then
                  begin
                    mm1.Items[I][II].Enabled := UserRight;
                    goto GoToStr;
                  end;
              end;
          end;
        GoToStr : qrySet.Next;
      end;
end;

 

转载于:https://www.cnblogs.com/LceMeaning/p/3503282.html

weixin_30292843
关注
delphi 菜单授权
liuin的专栏
11-05 1488
初学delphi时做的，模仿白貂的用pb开发的那个框架，代码很垃圾，有时间在重新整理吧treeview用3个图片，模仿checkbox的三态授权窗口unit YHGL;interfaceuses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, StdCtrls, Ex
delphi写的用户权限管理
05-16
用delphi写的用户权限管理 修改了权限树节点状态生成过程，采用循环遍历树结点 修改了主界面菜单和工具条显示过程，采用递规遍历菜单 通过系统管理员进入sys权限设置，在mainfrom创建的时候读取权限。 权限设置模块中可根据需要改为：将树型结构的节点写进数据库，进行动态修改。在程序中动态生成树型结构 过系统管理员:sys 密码:sys 普通用户:001 密码:123 用VB、VS等开发工具可参考设计。
delphi 权限菜单 例程
07-07
简单测权限菜单设计，送给delphi新手！
根据用户权限从数据库生成菜单
04-11
根据来自数据库的用户权限动态生成菜单。
DELPHI的权限控制
daigua1987的博客
04-04 1102
DELPHI的权限控制 本人DELPHI新手，没事练习写个简单的系统，第一个权限控制就想了好几天不知道怎么去控制，看了很多权限控制的代码，要不是一个一个的MenuItem的去判断要不是遍历MainMenu，还需要搞递归，感觉太不方便了，下面的本人的一个方法，感觉适合新手使用。 第一把所有MenuItem的Name存储到数据库的表中,t_Mod是所有菜单的表ModNo是菜单Name，新增用户后，把t_Mod的数据插入到权限表（t_Power）中，然后再勾选权限 第二前端控制，前端我们通过TComponent
Delphi菜单组件TMainMenu使用方法详解
08-28
Delphi 菜单组件 TMainMenu 是 Delphi 编程语言中一个非常重要的组件，它允许开发者在应用程序中创建菜单，实现菜单的各种操作。下面将详细介绍 TMainMenu 的使用方法，包括创建菜单、添加菜单项、设计级联菜单、...
利用Delphi编写Socket通信程序.doc
02-13
Delphi是一个功能强大的开发工具，它提供了丰富的组件和库，帮助开发者快速构建各种应用程序。其中，Socket通信是Delphi中一个非常重要的组件，用于实现计算机之间的网络通信。本文将详细介绍如何利用Delphi编写...
纯Delphi编写的一个Tree绘制程序
05-01
内容索引:Delphi源码,图形处理,Tree,绘制　纯Delphi编写的一个Tree绘制程序，画一个树，点击一次画一次，画出支杆，代码有参考性。
一个相当不错的Delphi TreeView树控菜单.rar
07-10
一个Delphi编写的相当不错的TreeView树控菜单，类似于Windows资源管理器中的树状菜单。 　ParentFolder: IShellFolder; // 节点对应的文件夹的父文件夹的IShellFolder接口 　Pidl, FullPidl: PItemIDList;// 节点...
Delphi创建一个ocx控件的方法，含
05-18
摘要:Delphi源码,控件组件,生成ocx控件　Delphi创建一个ocx控件实例，本程序可生成一个扩展名为ocx的控件，控件并不具备什么功能，只是向delphi编程者演示创建此种控件的思路和方法，对新手或许有帮助。
DELPHI 权限管理
07-13
DELPHI 权限管理 一个比较全通用权限管理
一个Delphi权限管理示例程序.rar
07-10
一个Delphi权限管理示例程序，使用了数据库保存权限设置信息，比较简单点的权限设置程序，可为开发同类模块的Delphi爱好者提升程序参考。相关说明：由MainMenu1，ToolBar1动态维护权限 　　但这对四级内菜单有效 　　有RZ4控件
基于delphi的用户管理权限
03-29
基于delphi的用户管理权限！基于delphi的用户管理权限！
delphi 组权限设置
05-11
用户组权限设置，代码简单，控制权限方便，可扩展性好。 通过系统管理员进入 权限设置，设置权限组及该组的功能。 然后通过用户设置，设置用户并指定用户是哪个组，改用户就赋予该组的权限。 使用actionlist 集中设置权限。所有程序功能代码都放在这里，菜单和空间的action设置相应的Action 把actions的序号和名称预置到数据库表—功能模块中即可。这样程序以后增加功能只需在数据库表中增加模块id和模块名称就行了，不需要修改权限代码。 在FormActivate执行权限设置代码 程序其他代码删除 程序缺点：没实现树形结构，Actions循序不能随便更改，改了以后需要更改数据库表。 欢迎高手指点。
用delphi编写权限管理
09-05
在网上找了很多权限管理,感觉不是很好,去年在写程序自己写的权限管理模块; 该程序包含编写程序登录界面，权限管理，权限控制等; 由于原来上传的程序被挂马，现重新上传
windows7以上操作系统，Delphi程序自动获得管理员权限运行
Delphi开发局QQ群:32422310
07-31 1325
Q:开发环境，win8+delphixe10.3.1，想让程序用管理员权限运行。 1）根据菜单设置：project/options/application/manifest executionlevel选择了requireadministrator后，运行程序还是没有用administra tor权限运行啊。 2）用网上说的UAC.manifest编译出UAC.res，在工程文...
Delphi中给用户设置权限方法
qq_45083002的博客
04-25 1107
Delphi权限设置
后台管理系统控制菜单权限的两种方法
最新发布
weixin_45600052的博客
11-05 1078
一般登录成功后接口会返回该用户拥有哪些权限 例：menus: ['department', 'settings', 'permissions'] (此处list中的数据是路由的name，返回的具体内容和后端协商好就可以)路由一般分为 常量路由(所有人都可以访问)，动态路由(通过权限控制的路由)，任意路由(当访问的路由不存在时，跳转到的页面)在退出登录的时候需要重新创建一个新的路由实例，并使用新的路由实例覆盖老的路由实例。上面两张图一般后端接口返回的格式(封装的获取异步路由的方法是按照第二张图的数据封装的)
Delphi设置某用户对文件（夹）的权限
挨踢生涯
07-19 5186
以下在代码在D7+2003和D7+XP中调试通过 unit NTSecurityU; interface Uses Windows, AclApi, AccCtrl; Const SECURITY_NULL_SID_AUTHORITY : _SID_IDENTIFIER_AUTHORITY = ( Value : (0,0,0,0,0,0)); SECURITY_WOR
Delphi编写的Java环境变量设置工具
总结而言，Java环境变量设置工具的Delphi版不仅为Java新手提供了一个方便的环境配置方式，也为Delphi初学者提供了一个学习和实践的良好案例。通过分析和学习这样的工具，初学者可以加深对系统级编程和Delphi编程语言...
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值