uusersetup.pas

天涯進銷存系統

unit uUserSetup;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, LBMorphVCLBase, LBMorphButton, StdCtrls, jpeg,
  ActnList, LBCtrls, DB, DBClient, SimpleDS, Grids, LBDBGrid, LBDBScrollBar;

type
  TfrmUserSetup = class(TForm)
    Image1: TImage;
    WindowCaption: TLabel;
    SysCloseButton: TLBMorphButton;
    Shape1: TShape;
    Shape2: TShape;
    Shape4: TShape;
    Panel7: TPanel;
    Image2: TImage;
    Shape22: TShape;
    Shape23: TShape;
    Shape24: TShape;
    Shape25: TShape;
    LBSpeecButton2: TLBSpeecButton;
    LBSpeecButton1: TLBSpeecButton;
    LBSpeecButton3: TLBSpeecButton;
    ActionList1: TActionList;
    Action1: TAction;
    Action2: TAction;
    Action3: TAction;
    Action4: TAction;
    LBSpeecButton4: TLBSpeecButton;
    Shape3: TShape;
    LBDBGrid1: TLBDBGrid;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Panel3: TPanel;
    Shape8: TShape;
    Label3: TLabel;
    Shape7: TShape;
    LBCheckBox1: TLBCheckBox;
    LBCheckBox2: TLBCheckBox;
    LBCheckBox3: TLBCheckBox;
    LBCheckBox4: TLBCheckBox;
    LBCheckBox5: TLBCheckBox;
    LBCheckBox6: TLBCheckBox;
    LBCheckBox7: TLBCheckBox;
    Panel4: TPanel;
    UserData: TSimpleDataSet;
    UserDs: TDataSource;
    LBCheckBox8: TLBCheckBox;
    LBCheckBox9: TLBCheckBox;
    LBCheckBox10: TLBCheckBox;
    LBCheckBox11: TLBCheckBox;
    LBCheckBox12: TLBCheckBox;
    LBCheckBox13: TLBCheckBox;
    LBCheckBox14: TLBCheckBox;
    LBCheckBox15: TLBCheckBox;
    LBCheckBox16: TLBCheckBox;
    LBCheckBox17: TLBCheckBox;
    LBCheckBox18: TLBCheckBox;
    LBCheckBox19: TLBCheckBox;
    LBCheckBox20: TLBCheckBox;
    LBCheckBox21: TLBCheckBox;
    LBCheckBox22: TLBCheckBox;
    LBCheckBox23: TLBCheckBox;
    LBCheckBox24: TLBCheckBox;
    LBCheckBox25: TLBCheckBox;
    LBCheckBox26: TLBCheckBox;
    LBCheckBox27: TLBCheckBox;
    LBCheckBox28: TLBCheckBox;
    LBCheckBox29: TLBCheckBox;
    LBCheckBox30: TLBCheckBox;
    LBCheckBox31: TLBCheckBox;
    LBCheckBox32: TLBCheckBox;
    LBCheckBox33: TLBCheckBox;
    LBCheckBox34: TLBCheckBox;
    LBCheckBox35: TLBCheckBox;
    LBCheckBox36: TLBCheckBox;
    LBCheckBox37: TLBCheckBox;
    LBCheckBox38: TLBCheckBox;
    LBCheckBox39: TLBCheckBox;
    LBCheckBox40: TLBCheckBox;
    LBCheckBox41: TLBCheckBox;
    LBCheckBox42: TLBCheckBox;
    LBDBScrollBar1: TLBDBScrollBar;
    LBButton1: TLBButton;
    LBButton2: TLBButton;
    LBButton3: TLBButton;
    LBButton4: TLBButton;
    procedure SysCloseButtonClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Action1Execute(Sender: TObject);
    procedure Action2Execute(Sender: TObject);
    procedure Action3Execute(Sender: TObject);
    procedure Action4Execute(Sender: TObject);
    procedure LBButton1Click(Sender: TObject);
    procedure LBButton2Click(Sender: TObject);
    procedure LBButton3Click(Sender: TObject);
    procedure LBButton4Click(Sender: TObject);
    procedure UserDataAfterScroll(DataSet: TDataSet);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmUserSetup: TfrmUserSetup;
  i, j: integer;
  key: string;

implementation

uses uMain, uDataMo, uNewUser, uPublicvar, uConst;

{$R *.dfm}

procedure TfrmUserSetup.SysCloseButtonClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmUserSetup.FormShow(Sender: TObject);
begin
  OpenData('select * From UserKey where isSys='+''''+'0'+'''', UserData);
end;

procedure TfrmUserSetup.Action1Execute(Sender: TObject);
begin
  UserData.Append;
  frmNewUser:=TfrmNewUser.Create(Application);
  frmNewUser.UserOldCode:='';
  frmNewUser.ShowModal;
  frmNewUser.Free;
end;

procedure TfrmUserSetup.Action2Execute(Sender: TObject);
begin
  if UserData.IsEmpty then
  begin
    Application.MessageBox('没有可修改的用户。',Hintinfo, $30);
    Exit;
  end;
  UserData.Edit;
  frmNewUser:=TfrmNewUser.Create(Application);
  frmNewUser.UserOldCode:=UserData.Fieldbyname('UserCode').asstring;
  frmNewUser.ShowModal;
  frmNewUser.Free;
end;

procedure TfrmUserSetup.Action3Execute(Sender: TObject);
begin
  DeleteData(UserData, False);
end;

procedure TfrmUserSetup.Action4Execute(Sender: TObject);
begin
  if UserData.IsEmpty then
  begin
    Application.MessageBox('没有可设置权限的用户。', Hintinfo, $30);
    Exit; 
  end;
  Panel4.Visible:=True;
  Panel3.Enabled:=True;
  LBDBGrid1.Enabled:=False;
end;

procedure TfrmUserSetup.LBButton1Click(Sender: TObject);
begin
  for i:=0 to ComponentCount -1 do
  begin
    if  (Components[i] is TLBCheckBox) then
    (Components[i] as TLBCheckBox).Checked:=True
  end;
end;

procedure TfrmUserSetup.LBButton2Click(Sender: TObject);
begin
  for i:=0 to ComponentCount -1 do
  begin
    if  (Components[i] is TLBCheckBox) then
    (Components[i] as TLBCheckBox).Checked:=False;
  end;
end;

procedure TfrmUserSetup.LBButton3Click(Sender: TObject);
begin
  key:='';
  for i:=0 to ComponentCount -1 do
  begin
    if  (Components[i] is TLBCheckBox) then
    if  (Components[i] as TLBCheckBox).Checked=True then
      key:=key+'1'
    else  key:=key+'0';
  end;
  with UserData do
  begin
    Edit;
    Fieldbyname('userKey').asstring:=key;
    ApplyUpdates(-1);
  end;
  Panel4.Visible:=False;
  Panel3.Enabled:=False;
  LBDBGrid1.Enabled:=True;
end;

procedure TfrmUserSetup.LBButton4Click(Sender: TObject);
begin
  Panel4.Visible:=False;
  Panel3.Enabled:=False;
  LBDBGrid1.Enabled:=True;
  OpenData('select * From UserKey where isSys='+''''+'0'+'''', UserData);
end;

procedure TfrmUserSetup.UserDataAfterScroll(DataSet: TDataSet);
var
  s: string;
begin
  if UserData.IsEmpty then Exit;
  Key:=UserData.Fieldbyname('userKey').asstring;
  j:=1;
  for i:=0 to ComponentCount -1 do
  begin
    if  (Components[i] is TLBCheckBox) then
    if (TLBCheckBox(Components[i]).Name='LBCheckBox'+inttostr(j)) then
    begin
      s:=Copy(key, j, 1);
      if s='1' then (Components[i] as TLBCheckBox).Checked:=True
      else (Components[i] as TLBCheckBox).Checked:=False;
      j:=j+1;
    end;
  end;
end;

procedure TfrmUserSetup.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=27 then Close;
end;

procedure TfrmUserSetup.Image1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  SendMessage(Handle, wm_SysCommand ,$F012, 0);
end;

procedure TfrmUserSetup.FormCreate(Sender: TObject);
begin
UserData.Connection:=dmData.SQLConnection;
end;

end.