main.pas

这是一个DELPHI7应用案例开发篇有配套程序种子光盘

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBClient, MConnect, StdCtrls, StdActns, ActnList, Menus,
  AppEvnts;

type
  TfrmMain = class(TForm)
    MainMenu1: TMainMenu;
    ActionList1: TActionList;
    miSystem: TMenuItem;
    miLogin: TMenuItem;
    N3: TMenuItem;
    miExit: TMenuItem;
    miLogout: TMenuItem;
    miHelp: TMenuItem;
    miHelpContent: TMenuItem;
    miHelpAbout: TMenuItem;
    N9: TMenuItem;
    miMan: TMenuItem;
    miManBook: TMenuItem;
    miManStore: TMenuItem;
    miManBuy: TMenuItem;
    miManCustomer: TMenuItem;
    miSell: TMenuItem;
    Login: TAction;
    Logout: TAction;
    Exit: TAction;
    ManBook: TAction;
    ManBuy: TAction;
    ManStore: TAction;
    ManCustomer: TAction;
    ManSell: TAction;
    HelpContents1: THelpContents;
    HelpTopicSearch1: THelpTopicSearch;
    HelpAbout: TAction;
    pmSystem: TPopupMenu;
    N2: TMenuItem;
    ApplicationEvents1: TApplicationEvents;
    AccessControl: TAction;
    N1: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    PrintBookList: TAction;
    PrintBuyList: TAction;
    N6: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure HelpAboutExecute(Sender: TObject);
    procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
    procedure AccessControlUpdate(Sender: TObject);
    procedure AccessControlExecute(Sender: TObject);
    procedure ManBookExecute(Sender: TObject);
    procedure ManBuyExecute(Sender: TObject);
    procedure PrintBookListExecute(Sender: TObject);
    procedure PrintBuyListExecute(Sender: TObject);
  private
    { Private declarations }
  public
    procedure WMSystemCommand(var Mes:TMessage);message WM_SYSCOMMAND;
  end;

var
  frmMain: TfrmMain;

implementation

uses DataM, AccessControl, Book, Buy;

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
var
    i:Integer;
begin
    ModifyMenu(MainMenu1.Handle,miHelp.Command,MF_HELP,
        miHelp.Command,PChar('帮助'));

    with pmSystem do
        for i:=0 to Items.Count-1 do
        begin
            AppendMenu(GetSystemMenu(Self.Handle,false),MF_ENABLED,
                Items[i].Handle,PChar(Items[i].Caption));
            AppendMenu(GetSystemMenu(Application.Handle,False),MF_ENABLED,
                Items[i].Handle,PChar(Items[i].Caption));
        end;
end;

procedure TfrmMain.HelpAboutExecute(Sender: TObject);
begin
    MessageDlg('关于菜单', mtInformation, [mbOK], 0);
end;

procedure TfrmMain.WMSystemCommand(var Mes: TMessage);
var
    item : TMenuItem;
begin
    item := pmSystem.FindItem(Mes.WParam,fkHandle);
    if Assigned(item) then
        item.Click;

    Inherited;
end;

procedure TfrmMain.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
var
    item : TMenuItem;
begin
    if Msg.message = WM_SYSCOMMAND then
    begin
        item := pmSystem.FindItem(Msg.wParam, fkHandle);
        if Assigned(item) then
            item.Click;
    end;
end;

procedure TfrmMain.AccessControlUpdate(Sender: TObject);
begin
    if DataModule1.Priv = 1 then
        AccessControl.Enabled := True
    else
        AccessControl.Enabled := False;
end;

procedure TfrmMain.AccessControlExecute(Sender: TObject);
begin
    if DataModule1.Priv = 1 then
    begin
        frmAccessControl := TfrmAccessControl.Create(Application);
        frmAccessControl.ShowModal;
        frmAccessControl.Free;
    end;
end;

procedure TfrmMain.ManBookExecute(Sender: TObject);
begin
    if not Assigned(frmBook) then
        frmBook := TfrmBook.Create(Application);
end;

procedure TfrmMain.ManBuyExecute(Sender: TObject);
begin
    if not Assigned(frmBuy) then
        frmBuy := TfrmBuy.Create(Application);
end;

procedure TfrmMain.PrintBookListExecute(Sender: TObject);
begin
    DataModule1.RvProject1.ExecuteReport('BookList');
end;

procedure TfrmMain.PrintBuyListExecute(Sender: TObject);
begin
    DataModule1.RvProject1.ExecuteReport('BuyList');
end;

end.