📄 fmusermenuu.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 + -