main.~pas

来自「一个电力企业的后台管理程序」· ~PAS 代码 · 共 392 行

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Menus, ComCtrls, OleCtrls, Buttons, ToolWin, Isp3,
  ActnList, ImgList, shdocvw;

const
  CM_HOMEPAGEREQUEST = WM_USER + $1000;

type
  TMainForm = class(TForm)
    StatusBar1: TStatusBar;
    MainMenu_Menu: TMainMenu;
    mmi_View: TMenuItem;
    NavigatorImages: TImageList;
    NavigatorHotImages: TImageList;
    LinksImages: TImageList;
    LinksHotImages: TImageList;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    Btn_Back: TToolButton;
    Btn_Forward: TToolButton;
    Btn_Stop: TToolButton;
    Btn_Refresh: TToolButton;
    Animate1: TAnimate;
    URLs: TComboBox;
    mmi_view_Toolbar: TMenuItem;
    mmi_View_Statusbar: TMenuItem;
    mmi_View_Stop: TMenuItem;
    mmi_View_Refresh: TMenuItem;
    N2: TMenuItem;
    ActionList_menu: TActionList;
    Act_Back: TAction;
    Act_Forward: TAction;
    Act_Stop: TAction;
    Act_Refresh: TAction;
    mmi_User: TMenuItem;
    mmi_User_Relogin: TMenuItem;
    mmi_User_ChangePass: TMenuItem;
    N1: TMenuItem;
    mmi_User_Quit: TMenuItem;
    nHelp: TMenuItem;
    nHelpTopic: TMenuItem;
    nAbout: TMenuItem;
    nHome: TMenuItem;
    mmi_view_Standard: TMenuItem;
    mmi_View_Add: TMenuItem;
    mmi_View_Link: TMenuItem;
    nSupport: TMenuItem;
    N6: TMenuItem;
    mmi_View_Forward: TMenuItem;
    mmi_View_Back: TMenuItem;
    ToolBar4: TToolBar;
    TB_User: TToolButton;
    TB_Look: TToolButton;
    Timer_main: TTimer;
    WebBrowser1: TWebBrowser;
    procedure Exit1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure StopClick(Sender: TObject);
    procedure URLsKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure LinksClick(Sender: TObject);
    procedure RefreshClick(Sender: TObject);
    procedure BackClick(Sender: TObject);
    procedure ForwardClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure URLsClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure mmi_View_StatusbarClick(Sender: TObject);
    procedure Act_BackUpdate(Sender: TObject);
    procedure Act_ForwardUpdate(Sender: TObject);
    procedure WebBrowser1BeforeNavigate2(Sender: TObject;
      const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
    procedure WebBrowser1DownloadBegin(Sender: TObject);
    procedure WebBrowser1DownloadComplete(Sender: TObject);
    procedure mmi_User_QuitClick(Sender: TObject);
    procedure nAboutClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Timer_mainTimer(Sender: TObject);
    procedure mmi_View_LinkClick(Sender: TObject);
    procedure mmi_View_AddClick(Sender: TObject);
    procedure mmi_view_StandardClick(Sender: TObject);
    procedure mmi_User_ReloginClick(Sender: TObject);
    procedure mmi_User_ChangePassClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormConstrainedResize(Sender: TObject; var MinWidth,
      MinHeight, MaxWidth, MaxHeight: Integer);
    procedure nHelpTopicClick(Sender: TObject);
  private
    HistoryIndex: Integer;
    HistoryList: TStringList;
    UpdateCombo: Boolean;
    procedure FindAddress;
    procedure HomePageRequest(var message: tmessage); message CM_HOMEPAGEREQUEST;
  public
    function CanClose:boolean;virtual;
  end;


var
  MainForm: TMainForm;
  cIntHomepage:string;
implementation

uses
SystemDM,systemModipwdFM, SystemPH; 

{$R *.DFM}

procedure TMainForm.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.FindAddress;
var
  Flags: OLEVariant;

begin
  Flags := 0;
  UpdateCombo := True;
  try
     WebBrowser1.Navigate(WideString(Urls.Text), Flags, Flags, Flags, Flags);
  except
     WebBrowser1.Navigate(WideString(cIntHomepage), Flags, Flags, Flags, Flags);
  end;


end;

procedure TMainForm.About1Click(Sender: TObject);
begin
  //ShowAboutBox;
end;

procedure TMainForm.StopClick(Sender: TObject);
begin
  WebBrowser1.Stop;
end;

procedure TMainForm.URLsKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_Return then
  begin
    FindAddress;
  end;
end;

procedure TMainForm.URLsClick(Sender: TObject);
begin
  FindAddress;
end;

procedure TMainForm.LinksClick(Sender: TObject);
begin
  if (Sender as TToolButton).Hint = '' then Exit;
  URLs.Text := (Sender as TToolButton).Hint;
  FindAddress;
end;

procedure TMainForm.RefreshClick(Sender: TObject);
begin
  FindAddress;
end;

procedure TMainForm.BackClick(Sender: TObject);
begin
  URLs.Text := HistoryList[HistoryIndex - 1];
  FindAddress;
end;

procedure TMainForm.ForwardClick(Sender: TObject);
begin
  URLs.Text := HistoryList[HistoryIndex + 1];
  FindAddress;
end;

procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Shift = [ssAlt] then
    if (Key = VK_RIGHT) and Btn_Forward.Enabled then
      Btn_Forward.Click
    else if (Key = VK_LEFT) and Btn_Back.Enabled then
      Btn_Back.Click;
end;

procedure TMainForm.mmi_View_StatusbarClick(Sender: TObject);
begin
  with Sender as TMenuItem do
  begin
    Checked := not Checked;
    StatusBar1.Visible := Checked;
  end;
end;

procedure TMainForm.HomePageRequest(var Message: TMessage);
begin
  URLs.Text := cIntHomepage;
  FindAddress;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  Caption:=sysDM.AppExplain;
  Application.Title :=sysDM.AppExplain;
//  cIntHomepage:=ExtractFilePath(Application.ExeName)+'鞍山供电公司信息港.htm';
  cIntHomepage:= ReadIni('Option','SySet','');
  HistoryIndex := -1;
  HistoryList := TStringList.Create;
  Animate1.FileName := ExtractFilePath(Application.ExeName) + '中国_电力.avi';
  PostMessage(Handle, CM_HOMEPAGEREQUEST, 0, 0);
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  HistoryList.Free;
  Screen.OnActiveFormChange := nil;
end;

procedure TMainForm.Act_BackUpdate(Sender: TObject);
begin
  if HistoryList.Count > 0 then
    Act_Back.Enabled := HistoryIndex > 0
 else
    Act_Back.Enabled := False;
end;

procedure TMainForm.Act_ForwardUpdate(Sender: TObject);
begin
  if HistoryList.Count > 0 then
    Act_Forward.Enabled := HistoryIndex < HistoryList.Count - 1
  else
    Act_Forward.Enabled := False;
end;

procedure TMainForm.WebBrowser1BeforeNavigate2(Sender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
var
  NewIndex: Integer;
  URLstr:string;
begin
  URLstr:=URLs.Text;
  NewIndex := HistoryList.IndexOf(URLstr);
  if NewIndex = -1 then
  begin
    { Remove entries in HistoryList between last address and current address }
    if (HistoryIndex >= 0) and (HistoryIndex < HistoryList.Count - 1) then
      while HistoryList.Count > HistoryIndex do
        HistoryList.Delete(HistoryIndex);
    HistoryIndex := HistoryList.Add(URLstr);
  end
  else
    HistoryIndex := NewIndex;
  if UpdateCombo then
  begin
    UpdateCombo := False;
    NewIndex := URLs.Items.IndexOf(URLstr);
    if NewIndex = -1 then
      URLs.Items.Insert(0, URLstr)
    else
      URLs.Items.Move(NewIndex, 0);
  end;
  URLs.Text := URLstr;
  Statusbar1.Panels[0].Text := URLs.Text;
end;

procedure TMainForm.WebBrowser1DownloadBegin(Sender: TObject);
begin
  { Turn the stop button dark red }
  Btn_Stop.ImageIndex := 4;
  { Play the avi from the first frame indefinitely }
  Animate1.Active := True;
end;

procedure TMainForm.WebBrowser1DownloadComplete(Sender: TObject);
begin
  { Turn the stop button grey }
  Btn_Stop.ImageIndex := 2;
  { Stop the avi and show the first frame }
  //Animate1.Active := False;
end;

procedure TMainForm.mmi_User_QuitClick(Sender: TObject);
begin
  if CanClose then Close; 
end;

procedure TMainForm.nAboutClick(Sender: TObject);
begin
  //About.ShowAboutBox;
end;

procedure TMainForm.FormActivate(Sender: TObject);
begin
  StatusBar1.Panels[2].Text:='操作员:'+sysDM.WorkName;
end;

procedure TMainForm.Timer_mainTimer(Sender: TObject);
begin
  StatusBar1.Panels[1].Text:=formatdatetime('yyyy"年"mm"月"dd"日"hh"点"mm"分"',now);
end;

procedure TMainForm.mmi_View_LinkClick(Sender: TObject);
begin
  with Sender as TMenuItem do
  begin
    Checked := not Checked;
    Coolbar1.bands[4].Visible := Checked;
  end;
end;

procedure TMainForm.mmi_View_AddClick(Sender: TObject);
begin
  with Sender as TMenuItem do
  begin
    Checked := not Checked;
    Coolbar1.bands[3].Visible := Checked;
  end;
end;

procedure TMainForm.mmi_view_StandardClick(Sender: TObject);
begin
  with Sender as TMenuItem do
  begin
    Checked := not Checked;
    Coolbar1.bands[2].Visible := Checked;
  end;
end;

procedure TMainForm.mmi_User_ReloginClick(Sender: TObject);
var
  QuitFlag:boolean;
begin
  QuitFlag:=false;
  if CanClose then
  begin
    while not sysDM.CallReLogin do
    begin
      if Application.MessageBox('退出系统吗？','提示',MB_OKCANCEL+MB_ICONINFORMATION)=IDOK then
      begin
        QuitFlag:=true;
        break;
      end;
    end;
    if QuitFlag then Close;
  end;
end;

function TMainForm.CanClose:boolean;
begin
  result:=true;
end;

procedure TMainForm.mmi_User_ChangePassClick(Sender: TObject);
begin
  sysDM.ShowModalForm(Tfrm_ModiPwd);
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if not CanClose then Action:=caNone;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if Self.CanClose then  CanClose:=true;
end;

procedure TMainForm.FormConstrainedResize(Sender: TObject; var MinWidth,
  MinHeight, MaxWidth, MaxHeight: Integer);
begin
  self.Invalidate;
end;

procedure TMainForm.nHelpTopicClick(Sender: TObject);
begin
  Application.HelpCommand(3,0);
end;

end.