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

📄 fmusermenuu.pas

📁 小型库存管理,希望有帮助,小型库存管理,希望有帮助
💻 PAS
字号:
unit FMUserMenuU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, FMBaseU, Grids, DBGrids, ExtCtrls, ImgList, ADODB, DB, DBClient,
  Provider, StdCtrls, Buttons;

type
  TFMUserMenu = class(TFMBase)
    Panel1: TPanel;
    DBGrid1: TDBGrid;
    cdsUserMenu: TADODataSet;
    ProviderMenu: TDataSetProvider;
    cdsMenu: TClientDataSet;
    cdsMenufUse: TStringField;
    cdsMenufMenuId: TWideStringField;
    cdsMenufCaption: TWideStringField;
    dsMenu: TDataSource;
    adoSQL: TADOQuery;
    ImageList1: TImageList;
    Label1: TLabel;
    boxUser: TComboBox;
    btnSave: TBitBtn;
    btnExit: TBitBtn;
    procedure DBGrid1CellClick(Column: TColumn);
    procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure DBGrid1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure boxUserChange(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
  private
    { Private declarations }
    m_keyStat:TShiftState;
    pCheckBitmap,pUnCheckBitmap,pBlankBitmap : TBitmap;
  public
    { Public declarations }
    aMenuList,aMenuCaptionList :TStringList ;
  end;

var
  FMUserMenu: TFMUserMenu;

implementation

{$R *.dfm}
uses FMDBU ;

procedure TFMUserMenu.DBGrid1CellClick(Column: TColumn);
begin
  inherited;
  if not cdsMenu.Active then exit ;
  if (DBGrid1.SelectedField.FieldName='fUse') then
  begin
    DBGrid1.DataSource.DataSet.Edit;
    if DBGrid1.SelectedField.asString = 'Y' then
    begin
      DBGrid1.SelectedField.AsString := 'N';
    end
    else
    begin
      DBGrid1.SelectedField.AsString := 'Y';
    end;
    DBGrid1.DataSource.DataSet.Post;
    m_keyStat:=[];
  end ;
end;

procedure TFMUserMenu.DBGrid1DrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
var
  xPos, yPos : Integer;
begin
  if not cdsMenu.Active then exit ;
  if (Column.FieldName = 'fUse') then
  begin
    //把Cell清为空白
    TDBGrid(Sender).Canvas.StretchDraw(Rect, pBlankBitmap);

    xPos := (Rect.Right - Rect.Left - pCheckBitmap.Width) div 2;
    yPos := (Rect.Bottom - Rect.Top - pCheckBitmap.Height) div 2;

    if TDBGrid(Sender).DataSource.DataSet.fieldByname('fUse').asString='Y' then
    begin
      TDBGrid(Sender).Canvas.Draw(Rect.Left + xPos, Rect.Top + yPos, pCheckBitmap);
    end
    else
    begin
      TDBGrid(Sender).Canvas.Draw(Rect.Left + xPos, Rect.Top + yPos, pUnCheckBitmap);
    end;
  end;

end;

procedure TFMUserMenu.DBGrid1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Key=45 then Key :=0;
  if (Key=46) and (Shift =[ssCtrl]) then key :=0;
end;

procedure TFMUserMenu.FormShow(Sender: TObject);
begin
  inherited;
  {当前用户}
  boxUser.Items.Clear ;
  adoSQL.Active :=false ;
  adoSQL.SQL.Text :='select fUserNO,fUserName from ts_User where fStatu=1 and fUserNO<>''system'' ';
  adoSQL.Active :=true ;
  while not adoSQL.Eof do
   begin
       boxUser.Items.Add(adoSQL.Fields[0].AsString+'_'+adoSQL.Fields[1].AsString);
     adoSQL.Next ;
   end ;
  adoSQL.Active :=false ;
end;

procedure TFMUserMenu.FormCreate(Sender: TObject);
begin
  //inherited;
  aMenuCaptionList :=TStringList.Create ;
  aMenuList :=TStringList.Create ;
  
  pCheckBitmap := TBitmap.Create;
  ImageList1.GetBitmap(1,pCheckBitmap);

  pUnCheckBitmap := TBitmap.Create;
  ImageList1.GetBitmap(0,pUnCheckBitmap);

  pBlankBitmap := TBitmap.Create;
  ImageList1.GetBitmap(2,pBlankBitmap);

  cdsMenu.CreateDataSet ;
  cdsMenu.Open ;
  cdsMenu.Edit ;

end;

procedure TFMUserMenu.boxUserChange(Sender: TObject);
var
  i :integer ; 
  strUser,strMenu :string ;
begin
  inherited;
  strUser :=boxUser.Text ;
  if strUser<>'' then
     strUser :=copy(strUser,0,pos('_',strUser)-1);
  if cdsMenu.RecordCount >0 then cdsMenu.EmptyDataSet ;

  cdsUserMenu.Active :=false ;
  cdsUserMenu.CommandText :='select * from ts_UserMenu where fUserNo='+#39+strUser+#39 ;
  cdsUserMenu.Active :=true ;

  {逐笔加入菜单}
  for i :=0 to aMenuCaptionList.Count -1 do
   begin
      strMenu := aMenuList.Strings[i] ;
      cdsMenu.Append ;
      if cdsUserMenu.Locate('fMenuNo',strMenu,[loCaseInsensitive]) then
         cdsMenu.FieldByName('fUse').AsString :='Y'
      else
         cdsMenu.FieldByName('fUse').AsString :='N' ;
      cdsMenu.FieldByName('fMenuId').AsString :=aMenuList.Strings[i] ;
      cdsMenu.FieldByName('fCaption').AsString :=aMenuCaptionList.Strings[i] ;
      cdsMenu.Post ;
   end ;
end;

{保存}
procedure TFMUserMenu.btnSaveClick(Sender: TObject);
var
  strUser :string ;
begin
  inherited;
  strUser :=boxUser.Text ;
  if strUser<>'' then
     strUser :=copy(strUser,0,pos('_',strUser)-1);
  if cdsMenu.RecordCount =0 then exit ;

  if messagebox(handle,'确定保存此用户的权限资料吗?','确认',MB_OKCANCEL+MB_ICONINFORMATION)<>IDOK then exit ;

  adoSQL.Active :=false ;
  adoSQL.SQL.Text :='delete from ts_UserMenu where fUserNo='+#39+strUser+#39;
  adoSQL.ExecSQL ;
  cdsMenu.DisableControls ;
  cdsMenu.First ;
  while not cdsMenu.Eof do
   begin
      if cdsMenu.FieldByName('fUse').AsString ='Y' then
       begin
         adoSQL.Active :=false ;
         adoSQL.SQL.Text :='insert into ts_UserMenu(fUserNo,fMenuNo) '
          +' values('+#39+strUser+#39+','+#39+cdsMenu.FieldByName('fMenuId').AsString+#39+')';
         adoSQL.ExecSQL ;
       end ;
    cdsMenu.Next ;
  end ;
 cdsMenu.First ;
 cdsMenu.EnableControls ;
end;

procedure TFMUserMenu.btnExitClick(Sender: TObject);
begin
  inherited;
  close ; 
end;

end.

⌨️ 快捷键说明

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