⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mainview.pas

📁 Delphi利用MVC开发的典型例子
💻 PAS
字号:
{
                     MastApp Main Window.

  By default, the database component's alias is DBDEMOS, and so the
  application accesses the Paradox tables. You can upsize the
  application to use Local InterBase data by choosing View | Remote
  Data from the application's main menu.  For this to work, however,
  the Local InterBase Server must be running.  The application checks
  for this and raises an exception if there's a problem.

  The application also creates the MASTSQL alias if it doesn't
  already exist.  This code for this appears in the MastData module.

}

unit mainview;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, IniFiles,
  Forms, Dialogs, Buttons, StdCtrls, Menus, ExtCtrls, DB, DBTables, patterns;

type
  TDateOrder = (doMDY, doDMY, doYMD);

  TViewMain = class(TForm, IObserver)
    MainPanel: TPanel;
    PrinterSetup: TPrinterSetupDialog;
    OrderBtn: TSpeedButton;
    BrowseBtn: TSpeedButton;
    PartsBtn: TSpeedButton;
    CloseBtn: TSpeedButton;
    ReportBtn: TSpeedButton;
    HelpBtn: TSpeedButton;
    MainMenu: TMainMenu;
    FileMenu: TMenuItem;
    FilePrinterSetup: TMenuItem;
    FileExit: TMenuItem;
    FileNewOrder: TMenuItem;
    FilePrintReport: TMenuItem;
    PrintCustList: TMenuItem;
    PrintOrders: TMenuItem;
    PrintInvoice: TMenuItem;
    ViewMenu: TMenuItem;
    ViewOrders: TMenuItem;
    ViewPartsInventory: TMenuItem;
    ViewStayOnTop: TMenuItem;
    ViewLocal: TMenuItem;
    ViewRemote: TMenuItem;
    HelpMenu: TMenuItem;
    HelpAbout: TMenuItem;
    HelpContents: TMenuItem;
    procedure BrowseCustOrd(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ToggleStayonTop(Sender: TObject);
    procedure PrinterSetupClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ViewLocalClick(Sender: TObject);
    procedure ViewRemoteClick(Sender: TObject);
    procedure ViewMenuClick(Sender: TObject);
  private
    FEventHandler: TNotifyEvent;
    procedure CloseAllWindows;
    procedure UpdateRSConnect(const Dbpath: string);
    procedure InitRSRUN;
  public
    procedure setEventListener(AEventHandler: TNotifyEvent);
    procedure UpdateView(o: TObject);
  end;

var
  ViewMain: TViewMain;

implementation

uses DataMod;
//  DataMod, { Data Module }
//  BrCstOrd, { The Browse Orders by Customer form }
//  BrParts, { The Browse Parts form }
//  EdOrders, { The Edit Orders form }
//  QryCust, { The Specify Date Range form }
//  PickRep, { The Report Selection form }
//  About, { The About dialog box }
//  IniFiles, { Delphi Unit for INI file support }
//  CustRpt, { The customer by invoice report }
//  OrderRpt, { The orders by ship date report }
//  InvcRpt, { The invoice report }
//  PickInvc; { The invoice number selection dialog }

{$R *.DFM}

function GetDateOrder(const DateFormat: string): TDateOrder;
var
  I: Integer;
begin
  Result := doMDY;
  I := 1;
  while I <= Length(DateFormat) do
  begin
    case Chr(Ord(DateFormat[I]) and $DF) of
      'Y': Result := doYMD;
      'M': Result := doMDY;
      'D': Result := doDMY;
    else
      Inc(I);
      Continue;
    end;
    Exit;
  end;
  Result := doMDY;
end;

procedure TViewMain.BrowseCustOrd(Sender: TObject);
begin
//  case GetDateOrder(ShortDateFormat) of
//    doYMD: ShortDateFormat := 'yy/mm/dd';
//    doMDY: ShortDateFormat := 'mm/dd/yy';
//    doDMY: ShortDateFormat := 'dd/mm/yy';
//  end;
//  BrCustOrdForm.Show;
end;

procedure TViewMain.UpdateRSConnect(const Dbpath: string);
const
  TiniFilename = 'RPTSMITH.CON'; {ReportSmith connections file}
  AppConTitle = 'MASTAPP';
  SQLConTitle = 'MASTSQL';
  ConnectNamesSection = 'ConnectNamesSection';
  ConnectNamesKey = 'ConnectNames';
  MASTAPPSection = 'MASTAPP';
  MASTSQLSection = 'MASTSQL';
  TypeKey = 'Type';
  ServerKey = 'Server';
  SQLTypeVal = 67;
  SQLServerVal = 'MASTSQL';
  SQLDataFilePathKey = 'Database';
  SQLUseridKey = 'USERID';
  SQLUseridVal = 'SYSDBA';
  TypeVal = 61;
  ServerVal = 'PARADOX';
  DataFilePathKey = 'DataFilePath';
var
  TempStr: string;
  RSCON: TIniFile;
begin
 { the ReportSmith CON file is actually an INI file -- assumes in win dir}
  RSCon := TIniFile.Create(TiniFilename);
  TempStr := RSCon.ReadString(ConnectNamesSection, ConnectNamesKey, '');
  { CON file contents differs for SQL connections }
  if TMastData.GetInstance.Database.IsSQLBased then
  begin
    if AnsiPos(SQLConTitle, TempStr) = 0 then
    begin
      if TempStr <> '' then
        TempStr := TempStr + ',';
      RSCon.WriteString(ConnectNamesSection, ConnectNamesKey, TempStr + SQLConTitle);
    end;
    RSCon.WriteInteger(MASTSQLSection, TypeKey, SQLTypeVal);
    RSCon.WriteString(MASTSQLSection, SQLDataFilePathKey, DBpath);
    RSCon.WriteString(MASTSQLSection, ServerKey, SQLServerVal);
    RSCon.WriteString(MASTSQLSection, SQLUseridKey, SQLUseridVal);
  end
  else
  begin
    if AnsiPos(AppConTitle, TempStr) = 0 then
    begin
      if TempStr <> '' then
        TempStr := TempStr + ',';
      RSCon.WriteString(ConnectNamesSection, ConnectNamesKey, TempStr + AppConTitle);
    end;
    RSCon.WriteInteger(MASTAPPSection, TypeKey, TypeVal);
    RSCon.WriteString(MASTAPPSection, DataFilePathKey, DBpath);
    RSCon.WriteString(MASTAPPSection, ServerKey, ServerVal);
  end;
  RSCon.Free;
end;

procedure TViewMain.InitRSRUN;
var
  DBPath: string;
  ParamList: TStringList;
begin
  { get the actual location of the database from the alias,
    the path is needed for the reports -- assumes alias is defined }
  ParamList := TStringList.Create;
  try
    Session.GetAliasParams(TMastData.GetInstance.Database.AliasName, ParamList);
    if TMastData.GetInstance.Database.IsSQLBased then
      DBPath := ParamList.Values['SERVER NAME']
    else
      DBPath := ParamList.Values['PATH'];
  finally
    ParamList.Free;
  end;
  { set up the ReportSmith "connection" identifying the database location }
  UpdateRSConnect(DBPath);
end;

procedure TViewMain.FormCreate(Sender: TObject);
begin
  ClientWidth := CloseBtn.Left + CloseBtn.Width + 1;
  ClientHeight := CloseBtn.Top + CloseBtn.Height;
  MainPanel.Align := alClient;
  { position the form at the top of display }
  Left := 0;
  Top := 0;
  { initialize ReportSmith }
  InitRSRUN;
end;

procedure TViewMain.ToggleStayonTop(Sender: TObject);
begin
  with Sender as TMenuItem do
  begin
    Checked := not Checked;
    if Checked then FormStyle := fsStayOnTop
    else FormStyle := fsNormal;
  end;
end;

procedure TViewMain.PrinterSetupClick(Sender: TObject);
begin
  PrinterSetup.Execute;
end;

procedure TViewMain.FormDestroy(Sender: TObject);
begin
  Application.HelpCommand(HELP_QUIT, 0);
end;

procedure TViewMain.CloseAllWindows;
var
  I: Integer;
  F: TForm;
begin
  for I := 0 to Application.ComponentCount - 1 do
  begin
    if Application.Components[I] is TForm then
    begin
      F := TForm(Application.Components[I]);
      if (F <> Self) and (F.Visible) then F.Close;
    end;
  end;
end;

procedure TViewMain.ViewLocalClick(Sender: TObject);
begin
  CloseAllWindows;
//  TMastData.GetInstance.UseLocalData;
  ViewLocal.Checked := True;
  Caption := Application.Title + ' (Paradox Data)';
  //this menu item's tag=-1,means handle it manually
  if assigned(self.FEventHandler) then
    FEventHandler(sender);
end;

procedure TViewMain.ViewRemoteClick(Sender: TObject);
begin
  CloseAllWindows;
  ViewRemote.Checked := True;
  Caption := Application.Title + ' (Local Interbase)';
    //this menu item's tag=-1,means handle it manually
  if assigned(self.FEventHandler) then
    FEventHandler(sender);
end;

procedure TViewMain.ViewMenuClick(Sender: TObject);
begin
  { Enable the Remote data menu item only if local Interbase is running }
  ViewRemote.Enabled := FindWindow(nil, 'InterBase Server') <> 0;
end;


procedure TViewMain.setEventListener(AEventHandler: TNotifyEvent);
var
  i: integer;
begin
  FEventHandler := AEventHandler;
  for i := 0 to self.ComponentCount - 1 do
  begin
    //all components with -1 in tag would be manually handled
    if self.Components[i].Tag <> -1 then
    begin
      if (self.Components[i] is TMenuItem) then
        (self.Components[i] as TMenuItem).OnClick := AEventHandler
      else if self.Components[i] is TSpeedButton then
        (self.Components[i] as TSpeedButton).OnClick := AEventHandler;
    end;
  end;
end;

procedure TViewMain.UpdateView(o: TObject);
begin
//do nothing
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -