?? main.pas
字號:
if not Connected then
for i:=1 to 8 do
MainMenu.Items.Items[i].Visible:=false
else
begin
for i:=1 to 8 do
MainMenu.Items.Items[i].Visible:=true;
end;
SystemAffiche.Enabled:=Connected; //公布欄
SystemWake.Enabled:=Connected; //系統提醒
SystemIssueInfo.Enabled:=Connected; //信息發布
SystemLogin.Enabled := not Connected;
SystemExit.Enabled := Connected;
SetupUserLog.Enabled:=Connected;
end;
Procedure TFormMain.GongGaoXinXi;
begin
With Query1 do
Begin
Close;
SQL.Clear;
SQL.Add('Select * From GG WHERE 1=1');
SQL.Add(' And ID Not IN (Select ID From GH_GG WHERE BZ=0 AND GH='+''''+GH+''''+')');
SQL.Add(' And (JBDM<='+IntToStr(JBDM)+'OR JBDM=9)');
If (JBDM<>0) And (JBDM<>1) THEN //JBDM??0?1???????????????
Begin
SQL.Add(' And (OFF_NO_HOME=0 OR OFF_NO_HOME='+IntToStr(JX)+')');
SQL.Add(' And (JBDM=9 Or JBDM='+IntToStr(JBDM)+')');
End;
Open;
IF Not (Eof And Bof) Then
Begin
//Application.CreateForm(TForm_xs,Form_xs);
//Form_xs.ShowModal;
End
Else
Exit;
End;
end;
procedure TFormMain.FormCreate(Sender: TObject);
begin
sele_nbr:=0;
JX := -1; //set to a invalid number
GH := '';
JBDM := 999; //set to max ,so has no right
roomid:=-1;
DHHM := '';
LstJX := TStringList.Create;
LogTry := 0;
ShortDateFormat := 'yyyy-mm-dd';
LongDateFormat := 'yyyy-mm-dd';
DateSeparator := '-';
Application.UpdateFormatSettings := false;
Application.OnHint := ShowHint;
Application.OnException := MyHandleException;
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
SetWindowLong(ClientHandle, GWL_WNDPROC, LongInt(FClientInstance));
end;
procedure TFormMain.ShowHint(Sender: TObject);
begin
StatusBarMain.Panels[1].Text := GetLongHint(Application.Hint);
end;
procedure TFormMain.MyHandleException(Sender: TObject;E: Exception);
begin
if (E is EDBEditError) then
begin
Application.MessageBox('對不起，您輸入的內容不符合要求,請重新輸入或按ESC取消輸入!','提示',MB_OK+MB_ICONERROR);
Exit;
end;
if (E is EDBEngineError) then
case (E as EDBEngineError).Errors[0].Errorcode of
eRequiredFieldMissing:
Application.MessageBox('對不起，您輸入的輸入項不全,請重新輸入!','錯誤',MB_OK+MB_ICONERROR);
eKeyViol:
Application.MessageBox('對不起，您輸入的編號或代碼重復,請重新輸入!'#13#13'如果編號或代碼是系統自動生成的，并且出現該提示框的話，請和當地的系統管理員聯系。謝謝','錯誤',MB_OK+MB_ICONERROR);
eDetailsExist:
Application.MessageBox('對不起，您要刪除的內容中，有其他數據參照該記錄,不能刪除!','錯誤',MB_OK+MB_ICONERROR);
eNotNull:
Application.MessageBox('對不起，您輸入的輸入項不能改為空,請重新輸入!'#13#13'如果您輸入的輸入項不是空的，但是出現了該提示框的話，請檢查網絡是否已經連通或者數據庫是否可以連接？','錯誤',MB_OK+MB_ICONERROR);
eForeignKey:
Application.MessageBox('對不起，您要修改或者刪除的項目違反參照性約束,不允許修改或刪除!如果真的要進行刪除的話，請和系統管理員聯系!謝謝！','錯誤',MB_OK+MB_ICONERROR);
end
else Application.ShowException(E);
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 ImageBkGd.Picture.Height DO
FOR Co := 0 TO ClientWIDTH DIV ImageBkGd.Picture.Width DO
BitBlt(MyDC, Co*ImageBkGd.Picture.Width, Ro*ImageBkGd.Picture.Height,
ImageBkGd.Picture.Width, ImageBkGd.Picture.Height,
ImageBkGd.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
Result := 1;
{ BitBlt(MyDC,
Round((FormMain.ClientWidth - ImageLogo.Picture.Width)/2),
Round((FormMain.ClientHeight - StatusBarMain.Height - ToolBarMain.Height - ImageLogo.Picture.Height)/2),
ImageLogo.Picture.Width, ImageLogo.Picture.Height,
ImageLogo.Picture.Bitmap.Canvas.Handle, 0, 0, SRCAND);
BitBlt(MyDC,
Round((FormMain.ClientWidth - Imagedh.Picture.Width)/2)+300,
Round((FormMain.ClientHeight - StatusBarMain.Height - ToolBarMain.Height - ImageLogo.Picture.Height)/2)+50,
Imagedh.Picture.Width, Imagedh.Picture.Height,
Imagedh.Picture.Bitmap.Canvas.Handle, 0, 0, MERGECOPY );
}
end;
else
Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
end;
end;
//IF EXISTS MDICHILD ,THEN SHOW IT AND RETURN TRUE,ELSE RETURN FALSE
function TFormMain.ExistMDIChild(ChildForm: TForm): Boolean;
var
i : integer;
begin
for i := 0 to FormMain.MDIChildCount - 1 do
begin
if FormMain.MDIChildren[i] = ChildForm then
begin
result := true;
Exit;
end;
end;
result := false;
end;
procedure TFormMain.FormShow(Sender: TObject);
begin
//initial menu
InitiateControl(false);
FormMain.Repaint ;
SpeedButtonloginClick(Nil);
end;
procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if (Application.MessageBox('您是否真的要退出系統嗎?'+#13#10+#13#10+'選擇“確定”則退出系統'+#13#10+#13#10+'選擇“取消”則返回系統','系統提示',MB_OKCANCEL+MB_ICONINFORMATION)=id_ok) then
Application.Terminate
else
Action := caNone;
end;
procedure TFormMain.SystemCloseClick(Sender: TObject);
begin
close;
crypt.UserEnter_Log('登入系統','瀏覽',0,Gh,'登入窗體');
end;
procedure TFormMain.SpeedButtonLogoutClick(Sender: TObject);
begin
JX := -1; //set to a invalid number
GH := '';
JBDM := 999; //set to max ,so has no right
roomid:=-1;
DHHM := '';
StatusBarMain.Refresh;
InitiateControl(false);
end;
procedure TFormMain.StatusBarMainDrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
var
ImageIdx,MyMargin: integer;
begin
if GH = '' then Exit; //工號為空表示未登錄,不顯示圖標
ImageIdx := 0;
MyMargin := 0;
case Panel.Index of
0:
begin
ImageIdx := 0;
MyMargin := 7;
end;
2: ImageIdx := 1;
4: ImageIdx := 2 + JBDM;
6: ImageIdx := 5;
end;
ImageListStatus.Draw(StatusBarMain.Canvas,Rect.Left+MyMargin,Rect.Top,ImageIdx,True);
end;
procedure TFormMain.MenuItemRestoreAllClick(Sender: TObject);
var
i:integer;
begin
for i := 0 to FormMain.MDIChildCount-1 do// downto 0 do
begin
FormMain.MDIChildren[i].WindowState := wsNormal;
end;
end;
procedure TFormMain.MenuItemMinimizeAllClick(Sender: TObject);
var
i:integer;
begin
for i := FormMain.MDIChildCount-1 downto 0 do
begin
FormMain.MDIChildren[i].WindowState := wsMinimized;
end;
end;
procedure TFormMain.MenuItemHelpContentClick(Sender: TObject);
var
ConfigIni : TIniFile;
HelpFileName : String ;
begin
//獲取幫助信息，本幫助信息已經把內容打包成一個chm文件。系統在打開幫助文件的時候
//主要對該chm文件進行調用.(并且該幫助文件一定命名為VipHelp.Chm)
ConfigIni := TInifile.Create(ExtractFilePath(application.exename) + '/Config.ini');
HelpFileName := ConfigIni.ReadString('Help', 'HelpFileName', '');
if HelpFileName='' then //沒有找到你要的幫助文件，提示是否自己找
begin
if Application.MessageBox('對不起，你的幫助文件沒有找到，您是否自己找幫助文件？','提示',MB_OKCANCEL+MB_ICONINFORMATION)=ID_CANCEL then
begin
ConfigIni.Free;
Exit ;
End;
if OpenDialogHelpFile.Execute then //打開幫助文件
ConfigIni.WriteString('Help', 'HelpFileName',OpenDialogHelpFile.FileName);
end;
if OpenDialogHelpFile.fileName <> '' then
begin
Try
ShellExecute(Handle,nil,pchar(OpenDialogHelpFile.FileName),nil,nil,SW_SHOWNORMAL);
except
if Application.MessageBox('對不起，你的幫助文件已經無法使用。請發郵件:doone@doone.com.cn和福建新東網公司聯系！'#13#10+#13#10+'選擇“確定”則馬上啟動郵件程序發送電子郵件給福建新東網公司'+#13#10+#13#10+'選擇“取消”則返回系統','提示',MB_OKCANCEL+MB_ICONINFORMATION)=ID_OK then
ShellExecute(Handle,nil,pchar('mailto:doone@doone.com.cn'),nil,nil,SW_SHOWNORMAL);
end ;
end;
//有內容存在，但是無法打開
ConfigIni.Free;
end;
procedure TFormMain.SpeedButtonloginClick(Sender: TObject);
begin
//登錄窗體調用
with TFormLogin.Create(Application) do
try
ShowModal;
finally
Free;
//GongGaoXinXi
end;
//InitiateMenu;
{//各地市使用不同的菜單選項
with dm_main.qry_share do
begin
close;
sql.clear;
sql.add('select menucode from setareamenu');
sql.add('where area='+regcity);
open;
while not eof do
begin
if self.findcomponent(fieldbyname('menucode').asstring)<>nil then
Tmenuitem(self.findcomponent(fieldbyname('menucode').asstring)).visible:=false;
next;
end;
end;
/////////////////////////////////////////////////////////////////////
}
end;
procedure TFormMain.SpeedButtonlockClick(Sender: TObject);
begin
JX := -1; //set to a invalid number
GH := '';
JBDM := 999; //set to max ,so has no right
roomid:=-1;
DHHM := '';
StatusBarMain.Refresh;
// screenstat(false);
InitiateControl(false);
end;
procedure TFormMain.SystemExitClick(Sender: TObject);
var
i : integer;
begin
JX := -1; //set to a invalid number
GH := '';
JBDM := 999; //set to max ,so has no right
roomid:=-1 ;
DHHM := '';
StatusBarMain.Refresh;
InitiateControl(false);
//modify by h 2002.08.19
with FormMain do
for I := MDIChildCount-1 downto 0 do
if MDIChildren[i].Name <> 'FormMain' then
MDIChildren[i].Close;
end;
procedure TFormMain.SystemWakeClick(Sender: TObject);
begin
//信息發布
Pro_OpenForm(TFrm_SystemWake, Frm_SystemWake, self);// Application.CreateForm(TForm_xs,Form_xs);
end;
//after login success,init menu
procedure TFormMain.InitiateMenu;
var
i : integer;
begin
//init all menu can use.
for i := 0 to FormMain.ComponentCount - 1 do
begin
if (FormMain.Components[i] is TMenuItem) then
(FormMain.Components[i] as TMenuItem).enabled := True;
end;{for}
//if system manager or manager then can use all perview
If JBDM<=0 Then
Exit;
//find not pop menu and set it can't use
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('Select * From t_d_menuset Where MENU_TOP=''1'' ');
Query1.Open;
for i := 0 to FormMain.ComponentCount - 1 do
begin
if (FormMain.Components[i] is TMenuItem) then
If Query1.Locate('MENU_CODE', FormMain.Components[i].Name, []) = True Then
(FormMain.Components[i] as TMenuItem).enabled := False;
end;{for}
//if owner's perview
with Query1 do
begin
close;
sql.clear;
sql.add('select ID, MENU_CODE From t_d_menuset Where Upper(MENU_STATE)=''Z'' and ID in(Select ID From t_d_menugrant Where WK_NO='''+GH+''')');
open;
//have then find owner's perview and show
If Query1.IsEmpty Then
Begin
Close;
SQL.Clear;
SQL.Add('Select ID,Menu_Code From t_d_menuset Where Upper(Menu_State)=''Z'' and ID in (Select OBJECT From t_d_init Where LEVEL_SEQ='+IntToStr(JBDM)+')');
Open;
End;
while not eof do
begin
for i := 0 to FormMain.ComponentCount - 1 do
if FormMain.Components[i].Name = Fields[1].AsString then
begin
if (FormMain.Components[i] is TMenuItem) then
begin
if (FormMain.Components[i] as TMenuItem).Count = 0 then
(FormMain.Components[i] as TMenuItem).enabled := True;
end;
break;
end;{if}
next;
end;{while}
end;{wiht query1}
end;
procedure TFormMain.SystemAfficheClick(Sender: TObject);
begin
//公告欄
Pro_OpenForm(TFrm_SystemIssueInfo, Frm_SystemIssueInfo, self);
end;
procedure TFormMain.SystemIssueInfoClick(Sender: TObject);
begin
//信息發布
Pro_OpenForm(TFrm_SystemAffiche, Frm_SystemAffiche, self);// Application.CreateForm(TForm_xs,Form_xs);
end;
procedure TFormMain.SetupPerviewClick(Sender: TObject);
begin
Pro_OpenForm(TFormRygl, FormRygl, self);
end;
procedure TFormMain.ValidateCustClick(Sender: TObject);
begin
//show ValidateCust form
Pro_OpenForm(TFrm_ValidateCust, Frm_ValidateCust, self);
end;
procedure TFormMain.ManagerSMSSendClick(Sender: TObject);
begin
//短信發送
Pro_OpenForm(TFrm_ManagerSMSSend, Frm_ManagerSMSSend, self);
end;
procedure TFormMain.ManagerDistributeClick(Sender: TObject);
begin
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -