mainfrm.pas

这是一个本人初定的小制作

unit mainfrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, GoodInfoFrm, SaleInputFrm, SalesManFrm, SalesManQuery,
  ExtCtrls, DBBackupFrm, MainDM, LCDScreen;

type
  TFormMain = class(TForm)
    MMain: TMainMenu;
    F1: TMenuItem;
    R1: TMenuItem;
    X1: TMenuItem;
    C1: TMenuItem;
    MISalesManQuery: TMenuItem;
    N16: TMenuItem;
    MISaleBackInput: TMenuItem;
    MIStockInInput: TMenuItem;
    MISaleInput: TMenuItem;
    N31: TMenuItem;
    MICompanyInfo: TMenuItem;
    MIPermission: TMenuItem;
    MIOperator: TMenuItem;
    MISalesManInfo: TMenuItem;
    MIGoodInfo: TMenuItem;
    MIDepartInfo: TMenuItem;
    N33: TMenuItem;
    N40: TMenuItem;
    MIDBBackup: TMenuItem;
    MISaleBackQuery: TMenuItem;
    MIStorageQuery: TMenuItem;
    MIStockOutInput: TMenuItem;
    Image1: TImage;
    procedure MICompanyInfoClick(Sender: TObject);
    procedure R1Click(Sender: TObject);
    procedure X1Click(Sender: TObject);
    procedure MIGoodInfoClick(Sender: TObject);
    procedure MISaleInputClick(Sender: TObject);
    procedure MISalesManInfoClick(Sender: TObject);
    procedure MISalesManQueryClick(Sender: TObject);
    procedure MIDepartInfoClick(Sender: TObject);
    procedure MIOperatorClick(Sender: TObject);
    procedure MISaleBackInputClick(Sender: TObject);
    procedure MIDBBackupClick(Sender: TObject);
    procedure N40Click(Sender: TObject);
    procedure MIStockInInputClick(Sender: TObject);
    procedure MIStockOutInputClick(Sender: TObject);
    procedure MISaleBackQueryClick(Sender: TObject);
    procedure MIStorageQueryClick(Sender: TObject);
    procedure MIPermissionClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FUserName: string;
    FUserRealName: string;
    FUserPermission: string;
    FClientInstance,FPrevClientProc : TFarProc;
    FGoodInfoDlg: TGoodInfoDlg;
    FSaleInputDlg: TSaleInputDlg;
    FSalesManDlg: TSalesManDlg;
    procedure ShowChildForm(InstanceClass: TComponentClass; var Reference);
    procedure ClientWndProc(var Message: TMessage);
  public
    { Public declarations }
    procedure SetUserName(AUserName: string);
    procedure SetUserRealName(ARealName: string);
    procedure SetUserPermission(APermission: string);
    procedure RefreshUI;
  end;

var
  FormMain: TFormMain;

implementation
uses CompanyInfoFrm, LoginFrm, DepartInputFrm,
  SysOperatorInputFrm, SaleBackFrm, ABoutBoxFrm, StockInFrm,
  StockOutFrm, SaleBackQueryFrm, StorageQueryFrm,
  PermissionFrm;
{$R *.dfm}
procedure TFormMain.SetUserName(AUserName: string);
begin
  FUserName := AUserName;
end;

procedure TFormMain.SetUserRealName(ARealName: string);
begin
  FUserRealName := ARealName;
end;

procedure TFormMain.SetUserPermission(APermission: string);
begin
  FUserPermission := APermission;
end;

procedure TFormMain.MICompanyInfoClick(Sender: TObject);
var
  LDlg: TComanyInfoDlg;
begin
  Application.CreateForm(TComanyInfoDlg, LDlg);
  LDlg.ShowModal;
  FreeAndNil(LDlg);
end;

procedure TFormMain.R1Click(Sender: TObject);
var
  LDlg: TFormLogin;
begin
  LDlg := TFormLogin.Create(nil);
  LDlg.ShowModal;
  if LDlg.IsLegal then
  begin
    SetUserName(LDlg.GetUserName);
    SetUserRealName(LDlg.GetUserRealName);
    SetUserPermission(LDlg.GetUserPermission);
  end;
  RefreshUI();
  FreeAndNil(LDlg);
end;

procedure TFormMain.RefreshUI;
var
  LPer: string;//permissoin
begin
  DMMain.ADOTOperator.Open;
  DMMain.ADOTOperator.First;
  DMMain.ADOTOperator.Locate('UserName', FUserName, []);
  LPer := DMMain.ADOTOperator.FieldByName('Permission').AsString;
  DMMain.ADOTPermission.Open;
  DMMain.ADOTPermission.First;
  DMMain.ADOTPermission.Locate('Name', LPer, []);
  MISalesManQuery.Enabled := DMMain.ADOTPermission.FieldByName('SalesManQuery').AsBoolean;
  MISaleBackQuery.Enabled := DMMain.ADOTPermission.FieldByName('SaleBackQuery').AsBoolean;
  MIStorageQuery.Enabled := DMMain.ADOTPermission.FieldByName('StorageQuery').AsBoolean;
  MISaleBackInput.Enabled := DMMain.ADOTPermission.FieldByName('SaleBackInput').AsBoolean;
  MIStockInInput.Enabled := DMMain.ADOTPermission.FieldByName('StockInInput').AsBoolean;
  MISaleInput.Enabled := DMMain.ADOTPermission.FieldByName('SaleInput').AsBoolean;
  MIStockOutInput.Enabled := DMMain.ADOTPermission.FieldByName('StockOutInput').AsBoolean;
  MICompanyInfo.Enabled := DMMain.ADOTPermission.FieldByName('CompanyInfoMgr').AsBoolean;
  MIPermission.Enabled := DMMain.ADOTPermission.FieldByName('PermissionMgr').AsBoolean;
  MIOperator.Enabled := DMMain.ADOTPermission.FieldByName('OperatorMgr').AsBoolean;
  MISalesManInfo.Enabled := DMMain.ADOTPermission.FieldByName('SalesManMgr').AsBoolean;
  MIGoodInfo.Enabled := DMMain.ADOTPermission.FieldByName('GoodMgr').AsBoolean;
  MIDepartInfo.Enabled := DMMain.ADOTPermission.FieldByName('DepartMgr').AsBoolean;
  MIDBBackup.Enabled := DMMain.ADOTPermission.FieldByName('DBBackup').AsBoolean;
end;

procedure TFormMain.X1Click(Sender: TObject);
begin
  Close;
end;

procedure TFormMain.MIGoodInfoClick(Sender: TObject);
begin
  ShowChildForm(TGoodInfoDlg, FGoodInfoDlg);
end;

procedure TFormMain.MISaleInputClick(Sender: TObject);
begin
   ShowChildForm(TSaleInputDlg, FSaleInputDlg);
end;

procedure TFormMain.MISalesManInfoClick(Sender: TObject);
begin
  ShowChildForm(TSalesManDlg, FSalesManDlg);

end;

procedure TFormMain.MISalesManQueryClick(Sender: TObject);
var
  LDlg: TSalesManQueryDlg;
begin
  ShowChildForm(TSalesManQueryDlg, LDlg);
  LDlg.SetUserName(FUserName);
end;

procedure TFormMain.MIDepartInfoClick(Sender: TObject);
var
  LDlg: TDepartInputDlg;
begin
  ShowChildForm(TDepartInputDlg, LDlg);
end;

procedure TFormMain.MIOperatorClick(Sender: TObject);
var
  LDlg: TSysOperatorInputDlg;
begin
    ShowChildForm(TSysOperatorInputDlg, LDlg);
end;

procedure TFormMain.MISaleBackInputClick(Sender: TObject);
var
  LDlg: TSaleBackInputDlg;
begin

  ShowChildForm(TSaleBackInputDlg, LDlg);
end;

procedure TFormMain.MIDBBackupClick(Sender: TObject);
var
  LDlg: TDBBackupDlg;
begin
  LDlg := TDBBackupDlg.Create(nil);
  LDlg.ShowModal;
  FreeAndNil(LDlg);
end;

procedure TFormMain.N40Click(Sender: TObject);
var
  FDlg: TAboutBoxDlg;
begin
  FDlg := TAboutBoxDlg.Create(nil);
  FDlg.Top := 200;
  FDlg.Left := 200;
  FDlg.ShowModal;
  FreeAndNil(FDlg);
end;

procedure TFormMain.MIStockInInputClick(Sender: TObject);
var
  LDlg: TStockInDlg;
begin
  ShowChildForm(TStockInDlg, LDlg);
end;

procedure TFormMain.MIStockOutInputClick(Sender: TObject);
var
  LDlg: TStockOutDlg;
begin
  ShowChildForm(TStockOutDlg, LDlg);
end;

procedure TFormMain.MISaleBackQueryClick(Sender: TObject);
var
  LDlg: TSaleBackQueryDlg;
begin
  ShowChildForm(TSaleBackQueryDlg, LDlg);
  LDlg.SetUserName(FUserName);
  FreeAndNil(LDlg);
end;

procedure TFormMain.MIStorageQueryClick(Sender: TObject);
var
  LDlg: TStorageQueryDlg;
begin
  ShowChildForm(TStorageQueryDlg, LDlg);

end;

procedure TFormMain.MIPermissionClick(Sender: TObject);
var
  LDlg: TPermissionDlg;
begin
  ShowChildForm(TPermissionDlg, LDlg);
end;

procedure TFormMain.FormShow(Sender: TObject);
begin
  RefreshUI();
end;


procedure TFormMain.ShowChildForm(InstanceClass: TComponentClass; var Reference);
var
  Instance: TComponent;
  n, i: integer;
begin
  Instance := TComponent(InstanceClass.NewInstance);
  TComponent(Reference) := Instance;
  n := Self.MDIChildCount;
  if n > 0 then
    for i := 1 to n do
    begin
      Self.MDIChildren[i-1].Close;;
      Self.MDIChildren[i-1].Free;
    end;
  Instance := TComponent(InstanceClass.NewInstance);
  try
    Instance.Create(Self);
  except
    TComponent(Instance) := nil;
    raise;
  end;
  TForm(Instance).Show;
end;

procedure TFormMain.ClientWndProc(var Message: TMessage);
var
  MyDC : hDC;
  Ro, Co : Word;
begin
  with Message do
    case Msg of
      WM_ERASEBKGND:
        begin
          MyDC := TWMEraseBkGnd(Message).DC;
          FOR Ro := 0 TO ClientHeight DIV Image1.Picture.Height DO
            FOR Co := 0 TO ClientWIDTH DIV Image1.Picture.Width DO
              BitBlt(MyDC, Co*Image1.Picture.Width, Ro*Image1.Picture.
              Height, Image1.Picture.Width, Image1.Picture.Height,
              Image1.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
          Result := 1;
        end;
    else
      Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam,lParam);
    end;
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
   FClientInstance := MakeObjectInstance(ClientWndProc);
   FPrevClientProc := Pointer(GetWindowLong(ClientHandle,GWL_WNDPROC)
);
   SetWindowLong(ClientHandle, GWL_WNDPROC,LongInt(FClientInstance));
end;

end.