📄 mainformunit.~pas

📁 很不错的软件请使用
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
12 下一页
unit MainFormUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Registry, ComCtrls, StdCtrls, DB, ADODB, ImgList, XPMenu,
  ToolWin, ExtCtrls, Menus,comobj,ShellApi, Buttons, Mask, ToolEdit;

type
  TMainform = class(TForm)
    StatusBar1: TStatusBar;
    ImageList1: TImageList;
    MainMenu1: TMainMenu;
    F1: TMenuItem;
    R1: TMenuItem;
    N1: TMenuItem;
    L1: TMenuItem;
    Q1: TMenuItem;
    E1: TMenuItem;
    G1: TMenuItem;
    N2: TMenuItem;
    S2: TMenuItem;
    N3: TMenuItem;
    Excel1: TMenuItem;
    B1: TMenuItem;
    L2: TMenuItem;
    U1: TMenuItem;
    N7: TMenuItem;
    N4: TMenuItem;
    T1: TMenuItem;
    N5: TMenuItem;
    P1: TMenuItem;
    P2: TMenuItem;
    H1: TMenuItem;
    readme1: TMenuItem;
    H2: TMenuItem;
    A1: TMenuItem;
    XPMenu1: TXPMenu;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    Image1: TImage;
    ToolButton8: TToolButton;
    N6: TMenuItem;
    A2: TMenuItem;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    ProgressBar1: TProgressBar;
    ToolButton13: TToolButton;
    N8: TMenuItem;
    N9: TMenuItem;
    SaveDialog1: TSaveDialog;
    ADOQuery1: TADOQuery;
    ToolButton14: TToolButton;
    PopupMenu1: TPopupMenu;
    N111111: TMenuItem;
    N222221: TMenuItem;
    N333331: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure onkeydown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ondockdrop(Sender: TObject; Source: TDragDockObject; X,
      Y: Integer);
    procedure ondragover(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure onundock(Sender: TObject; Client: TControl;
      NewTarget: TWinControl; var Allow: Boolean);
    procedure R1Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure A2Click(Sender: TObject);
    procedure A1Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure H2Click(Sender: TObject);
    procedure P2Click(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure S2Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure ToolButton10Click(Sender: TObject);
    procedure ToolButton6Click(Sender: TObject);
    procedure ToolButton7Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure T1Click(Sender: TObject);
    procedure ToolButton9Click(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure L1Click(Sender: TObject);
    procedure Q1Click(Sender: TObject);
    procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);
    procedure ToolButton13Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure Excel1Click(Sender: TObject);
    procedure B1Click(Sender: TObject);
    procedure L2Click(Sender: TObject);
  private
  MainAppHelpName:string;
  progress:TProgressbar;
  StatusDrawRect:TRect;
  { Private declarations }
  public
  { Public declarations }
  end;

var
  Mainform: TMainform;
  MainAppConString,
  MainDataBasePath,
  MainDataBaseName,
  MainDataBasePassword,
  MainAppBgImage,
  MainAppLoginBgImage,
  MainAppTitleImage,
  MainAppLogoImage,
  MainAppAdminPassword,
  MainAppLogoString,
  MainAppMail,
  MainAppAboutTitle_1,
  MainAppAboutTitle_2,
  MainAppPrintTitle,
  MainAppPrintMemo,
  BackUpDataBaseName,
  BackUpDatabasePath:string;
  procedure GetHelp;
  Procedure GetProgressBar;

implementation

uses login_unit, people_unit, PeopledataUnit, searchs_unit, abouts,
  PrintCard, OptionUnit, loginworks, ChartFrmUnit, MainDataModule;

function ClientWindowProc(wnd: HWND; msg: Cardinal; wparam, lparam: Integer ): Integer; stdcall;
var
  f: Pointer;
begin
  f := Pointer( GetWindowLong( wnd, GWL_USERDATA ));
  case msg of
    WM_NCCALCSIZE:
    begin
      if (GetWindowLong( wnd, GWL_STYLE ) and
        (WS_HSCROLL or WS_VSCROLL)) <> 0 then
          SetWindowLong(wnd, GWL_STYLE, GetWindowLong(wnd, GWL_STYLE) and not
                          (WS_HSCROLL or WS_VSCROLL));
    end;
  end;
  Result := CallWindowProc(f, wnd, msg, wparam, lparam);
end;
{$R *.dfm}
Procedure GetProgressBar;
var
 i,count:integer;
begin
 mainform.progress:=TProgressbar.create(Mainform);
 count:=3000; //进程条的最大值
 mainform.statusbar1.repaint;
 with mainform.progress do
  begin
  top:=mainform.StatusDrawRect.top-1;
  left:=mainform.StatusDrawRect.left-1;
  width:=mainform.StatusDrawRect.right-mainform.StatusDrawRect.left+2;
  height:=mainform.StatusDrawRect.bottom-mainform.StatusDrawRect.top+2;
  visible:=true;
  try
  Parent := mainform.statusbar1;
  Min := 0; Max := Count;
  Step:= 1;
  for i := 1 to Count do
  Stepit;
  finally
  Free;
  end;
 end;
end;

procedure gethelp;
begin
with mainform do
try
 ShellExecute(handle,nil,pchar(MainAppHelpName),nil,nil,sw_shownormal);
except;
end;
end;
procedure TMainform.StatusBar1DrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
StatusDrawRect:=rect;
end;

procedure TMainform.FormCreate(Sender: TObject);
var
 Reg:TRegistry;
 Hold: String;
 ZAppName: array[0..127] of char;
 Found: HWND;
 UserTime:integer;
 Registryed:boolean;
begin
 //
  MainAppMail:='Mailto:sfply.net';
 //获取注册信息
 Reg:=TRegistry.Create;
 try
  begin
  Reg.RootKey:=HKEY_CURRENT_USER;
  Reg.OpenKey('\Software\NormalSystem', True);
  Application.Icon.LoadFromFile(Reg.ReadString('MainAppIcon'));
  Mainform.Caption:=Reg.ReadString('MainAppTitle');
  statusbar1.Panels[4].text:=Reg.ReadString('MainAppBottomSting');
  MainDataBasePath:=Reg.ReadString('MainDataBasePath');
  MainDataBaseName:=Reg.ReadString('MainDataBaseName');
  MainDataBasePassword:=Reg.ReadString('MainDataBasePassword');
  MainAppConString:=Reg.ReadString('MainAppConString');
  MainAppBgImage:=Reg.ReadString('MainAppBgImage');
  MainAppLoginBgImage:=Reg.ReadString('MainAppLoginBgImage');
  MainAppTitleImage:=Reg.ReadString('MainAppTitleImage');
  MainAppLogoImage:=Reg.ReadString('MainAppLogoImage');
  MainAppLogoString:=Reg.ReadString('MainAppLogoString');
  MainAppAdminPassword:=Reg.ReadString('MainAppAdminPassword');
  MainAppHelpName:=Reg.ReadString('MainAppHelpName');
  MainAppAboutTitle_1:=Reg.ReadString('MainAppAboutTitle_1');
  MainAppAboutTitle_2:=Reg.ReadString('MainAppAboutTitle_2');
  MainAppPrintTitle:=Reg.ReadString('MainAppPrintTitle');
  MainAppPrintMemo:=Reg.ReadString('MainAppPrintMemo');
  BackUpDatabasePath:=Reg.ReadString('BackUpDatabasePath');
  BackUpDataBaseName:=Reg.ReadString('BackUpDataBaseName');
  Reg.CloseKey;
  Reg.RootKey:=HKEY_LOCAL_MACHINE;
  if (Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Install',false))=False then
   begin  //如果注册表中没有信息则创建初始化信息
   Reg.CreateKey('\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Install');
   Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Install', True);
   Reg.WriteBool('Urlencoding',false);
   Reg.WriteInteger('ActiveXCash',100);
   end;
  Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Install', True);
  Registryed:=Reg.ReadBool('Urlencoding');
  if not Registryed then
   begin
   Usertime:=Reg.ReadInteger('ActiveXCash');
   if usertime<=0 then
    begin
    F1.Enabled:=false;
    end else
    Reg.WriteInteger('ActiveXCash',Usertime-1);
  end;
  Reg.CloseKey;
  Reg.Free;
  end;
  except
   begin
   MessageBox(Handle,'注册表错误导致程序终止！！','警告',MB_OK or MB_ICONSTOP);
   Application.Terminate;
   end;
  end;
  //关闭无效
  ModifyMenu(GetSystemMenu(Handle,False),6,MF_BYPOSITION,0,nil);
  //去除主滚动条
  if ClientHandle <> 0 then
  begin
    if (not (GetWindowLong(ClientHandle, GWL_USERDATA) <> 0)) then
    begin
      SetWindowLong(ClientHandle, GWL_USERDATA,
        SetWindowLong(ClientHandle, GWL_WNDPROC, Integer(@ClientWindowProc)));
    end;
  end;
   //使提示框立即出现、显示快捷键信息、使一个提示框出现后，立即显示新的提示框
  Application.HintPause:=0;
  Application.HintShortCuts:=True;
  Application.HintShortPause:=0;
  //避免重复执行程序
  Hold := Application.Title;
  Application.Title := 'OnlyOne'
     + IntToStr(HInstance); // 暂时修改窗口标题
  StrPCopy(ZAppName, Hold); // 原窗口标题
  Found := FindWindow(nil, ZAppName); // 查找窗口
  Application.Title := Hold; // 恢复窗口标题
  if Found<>0 then begin
    ShowWindow(Found, SW_RESTORE);
    Application.Terminate;
  end;
  //载入各种背景图片
  try
  image1.Picture.LoadFromFile(MainAppBgImage);
  except
  end;
end;

procedure TMainform.onkeydown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
12 下一页
⌨️ 快捷键说明

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