frmprjs.pas

详细说明:毕业论文中关于小型宾馆管理系统的详细设计毕 业论文中关于小型宾馆...一个酒店管理系统VB+Access [学生学籍管理系统(VB+Acess).zip] - !这个是刚刚编的毕业设计,可能

//
// Users dialog
//
// (c) Chicony Software 20001                                                            in
//
// When        Who     Why
// ---------   ---     ------------------------------------------------------------
// 2001.6.13   Century Initial Version
//
unit frmPrjs;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ImgList, ToolWin, ExtCtrls, Menus, Buttons,Variants,
  vafuncs, utils, frmDataGrid,wpfuncs,prefs, Spin, CheckLst,PODMSADM_TLB,PODMSDOC_TLB;
type
  Tref = Record
    t_ePrjname,t_eDescription,t_cbGroup,t_cbType:string;

  end;

type
  Tfrmprj = class(TForm)
    PageControl: TPageControl;
    tsMain: TTabSheet;
    Label1: TLabel;
    ePrjname: TEdit;
    eDescription: TEdit;
    Label2: TLabel;
    Label4: TLabel;
    Label3: TLabel;
    Bevel1: TBevel;
    btCreate: TBitBtn;
    btClose: TBitBtn;
    edId: TEdit;
    tsRights: TTabSheet;
    Label10: TLabel;
    Label11: TLabel;
    GroupBox5: TGroupBox;
    lstTargetp: TListBox;
    GroupBox6: TGroupBox;
    lstSourcep: TListBox;
    cbType: TComboBox;
    Bevel2: TBevel;
    cbGroup: TComboBox;
    sbtnAdd2: TSpeedButton;
    sbtnDelete2: TSpeedButton;
    egrp: TEdit;
    etype: TEdit;
    procedure tbExitClick(Sender: TObject);

    procedure btCloseClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure btCreateClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure lstSourceDblClick(Sender: TObject);
    procedure lstTargetpDblClick(Sender: TObject);
    procedure lstSourcepDblClick(Sender: TObject);
    procedure lstTarget1DblClick(Sender: TObject);
    procedure sbtnAdd2Click(Sender: TObject);
    procedure sbtnDelete2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);

  private


    g_Users: OleVariant;                     // Temporary storage
    g_DataModified: Boolean;                 // TRUE if any rows have been
                                             // inserted, updated, or deleted.
                                             // See WasDataModified
    g_sup:IPODMSSECU;
    g_sub:IPODMSBUS;
    procedure InitUserGroups;
    procedure InitUserPolicy;
    function CheckInList(str:string;List:TCustomListBox):boolean;
  public
    isChange:Boolean;
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
    function ShowModal(t_sup:IPODMSSECU;t_sub:IPODMSBUS; new, modify: Boolean): Integer; reintroduce; overload;
    function WasDataModified: Boolean;

  end;

var

  isAdministrator,isManager,isSuperuser,isImpersonator,isGeneral:Boolean;
  isClose:Boolean;
  t_Tref:Tref;
implementation

{$R *.DFM}

//==============================================================================
//
// Creation & destruction
//

// Create form & initialise global data
constructor Tfrmprj.Create(Owner: TComponent);
begin
     inherited Create(owner);

     // Globals
     g_Users:=Unassigned;
     g_DataModified:=FALSE;
end;

// Destroy form & free any resources used
destructor Tfrmprj.Destroy;
begin
     // Globals
     g_Users:=Unassigned;
     inherited Destroy;
end;

//==============================================================================
//
// Entry points
//

//
// Display a users dialog box
//
// Args: framework object to use
//       name of user to load (empty string means none)
//       description of user to load (empty string means none)
//       description (Unassigned if not known)
//       if delete is TRUE then user can delete rows
//       if new is TRUE then user can create rows
//       if modify is TRUE then user can modify rows
//       if find is TRUE then user can find new rows
//
// Returns: GE_OK on success
//
// Note: If a user is to be loaded then pass its name, else if the user has
//       already been loaded it can be passed in the users_row argument
//       (only the first user is loaded). If the ID is not known then the
//       name may be passed.
//
// Returns: mrAbort on failure
//
function Tfrmprj.ShowModal(t_sup:IPODMSSECU;t_sub:IPODMSBUS;new, modify: Boolean): Integer;
begin
     // Initialise
     g_sup:=t_sup;
     g_sub:=t_sub;
     if (not new) and (not modify) then begin
         btCreate.visible:=false;
         ePrjname.ReadOnly:=TRUE;
         eDescription.ReadOnly:=TRUE;
         cbGroup.Enabled:=false;
     end;
     if new then begin
         cbgroup.ItemIndex:=0;
         tsRights.TabVisible:=false;
         InitUserGroups;
     end;
     // Delete
     if  modify  then begin
         btCreate.Caption:='OK';
         tsRights.TabVisible:=true;
         InitUserGroups;
         InitUserPolicy;
     end;



     
     // Continue with standard
     Result:=inherited ShowModal;
end;

// Returns TRUE if data was modified
function Tfrmprj.WasDataModified: Boolean;
begin
     Result:=g_DataModified;
end;


//
// Exit
//
procedure Tfrmprj.tbExitClick(Sender: TObject);
begin
     Close;
end;




procedure Tfrmprj.btCloseClick(Sender: TObject);
begin
  isclose:=true;
  Close;
end;

procedure Tfrmprj.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  CanClose:=isclose;
end;

procedure Tfrmprj.btCreateClick(Sender: TObject);
begin
  isclose:=true;
  ischange:=false;
  if btCreate.caption='OK' then begin
     if (t_Tref.t_ePrjname<>ePrjname.text) or
        (t_Tref.t_eDescription<>eDescription.text) or
        (t_Tref.t_cbgroup<>cbGroup.Text) or
        (t_Tref.t_cbtype<>cbType.Text) then
        if MessageDlg('Are you sure you want to modify this record?',
                mtConfirmation, [mbYes, mbNo], 0) = mrNo then begin
                isClose:=false;
                Exit;
        end else begin
          if ePrjname.Text='' then begin
              MessageDlg('Every project must have a name', mtWarning,[mbOk], 0);
              isClose:=false;
              exit;
          end;
          ischange:=true;
        end;

  end else begin

      if ePrjname.Text='' then begin
         MessageDlg('Every user must have a name!', mtWarning,[mbOk], 0);
         isClose:=false;
         exit;
      end;
      if cbGroup.Text='' then begin
         MessageDlg('Group must have a value!', mtWarning,[mbOk], 0);
         isClose:=false;
         exit;
      end;
      if cbType.Text='' then begin
         MessageDlg('Project type must have a value!', mtWarning,[mbOk], 0);
         isClose:=false;
         exit;
      end;

  end;

end;



procedure Tfrmprj.InitUserGroups;
var
    ole:Olevariant;
    row:TStrings;
begin
    //
    ole:=g_sup.PS_Get_Groups('');
    if not VarIsEmpty(ole) then begin
        row:=Get_ColRecords(ole,2);
        cbGroup.Items:=row;
    end;

    ole:=g_sup.ps_get_users('');
    if not VarIsEmpty(ole) then begin
       row:=Get_ColRecords(ole,1);
       lstSourceP.Items:=row;
    end;
    ole:=g_sup.PS_Get_Types(-1,0);
    if not VarIsEmpty(ole) then begin
       row:=Get_ColRecords(ole,1);
       cbType.Items:=row;
    end;
    cbGroup.ItemIndex:=cbGroup.Items.IndexOf(egrp.Text);
    cbType.ItemIndex:=cbtype.Items.IndexOf(eType.Text);


end;
//
procedure Tfrmprj.InitUserPolicy;
var
    ole:Olevariant;
    row:TStrings;
begin
    ole:=g_sup.PS_GET_UserPrj('',ePrjName.Text);
    if not VarIsEmpty(ole) then begin
       row:=Get_ColRecords(ole,1);
       lstTargetp.Items:=row;
    end;
end;


function Tfrmprj.CheckInList(str:string;List:TCustomListBox):boolean;
var i:integer;
begin
   result:=false;
   if List.items.Count>0 then begin
      for i:=list.items.Count-1 downto 0 do begin
          if uppercase(str)=uppercase(list.Items.Strings[i]) then
             result:=true;
      end;
   end;

end;





procedure Tfrmprj.FormShow(Sender: TObject);
begin
   PageControl.ActivePage:=tsMain;
   t_Tref.t_eprjname:=eprjname.text;
   t_Tref.t_eDescription:=eDescription.text;
   t_Tref.t_cbgroup:=cbgroup.Text;
   t_Tref.t_cbtype:=cbType.Text;

end;

procedure Tfrmprj.lstSourceDblClick(Sender: TObject);
begin
 self.sbtnAdd2.OnClick(self);
end;

procedure Tfrmprj.lstTargetpDblClick(Sender: TObject);
begin
self.sbtnDelete2.OnClick(self);
end;




procedure Tfrmprj.lstSourcepDblClick(Sender: TObject);
begin
 self.sbtnAdd2.OnClick(self);
end;

procedure Tfrmprj.lstTarget1DblClick(Sender: TObject);
begin
  self.sbtnDelete2.OnClick(self);
end;

procedure Tfrmprj.sbtnAdd2Click(Sender: TObject);

var i:integer;
    username,prj:string;
begin

    //showmessage(edId.text);
    if (edId.text='') or (lstSourcep.SelCount <= 0) then exit;
    prj:=g_sup.PS_valStrToStr('csi_projects','c_prj_id','c_prj_name',edId.Text);
    for i:= lstSourcep.Items.Count - 1 downto 0 do begin
        if lstSourcep.Selected[i] then
        begin
          if not checkinlist(lstSourcep.Items.Strings[i],lstTargetp) then  begin
             username:=lstSourcep.Items.Strings[i];
             if g_sup.PS_Ins_UserPrj(username,prj)=0 then begin
                lstTargetp.Items.Add(lstSourcep.Items.Strings[i]);
                lstSourcep.Items.Delete(i);
             end else showmessage(g_sup.PS_Lasterror);
          end else lstSourcep.Items.Delete(i);
        end;
    end;
end;

procedure Tfrmprj.sbtnDelete2Click(Sender: TObject);
var i:integer;
    username,policy:string;
begin
    lstTargetp.refresh;
    lstSourcep.refresh;
    if (edId.text='') or (lstTargetp.SelCount <= 0) then exit;
    policy:=g_sup.PS_valStrToStr('csi_projects','c_prj_id','c_prj_name',edId.Text);
    if lstTargetp.SelCount<0 then exit;
    for i:= lstTargetp.Items.Count - 1 downto 0 do  begin
        if lstTargetp.Selected[i] then
        begin
          username:=lstTargetp.Items.Strings[i];
          if not checkinlist(lstTargetp.Items.Strings[i],lstSourcep) then  begin
             if g_sup.PS_Del_UserPrj(username,policy)=0 then begin
                lstSourcep.Items.Add(lstTargetp.Items.Strings[i]);
                lstTargetp.Items.Delete(i);

             end else showmessage('delfail : '+g_sup.PS_LastError);
          end else begin
             if g_sup.PS_Del_UserPrj(username,policy)=0 then
                lstTargetp.Items.Delete(i) else showmessage(g_sup.PS_LastError);
          end;
        end;
    end;

end;

procedure Tfrmprj.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  g_sup:=nil;
  g_sub:=nil;
end;

initialization

end.