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

📄 mainpas.pas

📁 特别方便的工具程序
💻 PAS
📖 第 1 页 / 共 2 页
字号:
🔍
12 
unit Mainpas;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ToolWin, Menus, ExtCtrls, Registry, ShellAPI, StdCtrls, Imm,
  MMSystem, ExtDlgs, ImgList, Xeduser;

const
  WM_TRAYNOTIFY = WM_USER + 1000;
  MY_TRAY_ICON = WM_USER + 1001;
type
  TA00Form = class(TForm)
    MMenu1: TMainMenu;
    Timer1: TTimer;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N51: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    aaaa1: TMenuItem;
    aa1: TMenuItem;
    Image1: TImage;
    aaa1: TMenuItem;
    aaa2: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    aaaa2: TMenuItem;
    DFNO01: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    Button1: TButton;
    aa2: TMenuItem;
    LimitMouse: TMenuItem;
    RelaxMouse: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    aaaa3: TMenuItem;
    PrintDBGrid: TMenuItem;
    F1Book1: TMenuItem;
    N19: TMenuItem;
    PMenu1: TPopupMenu;
    cccc1: TMenuItem;
    CDROM1: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    N22: TMenuItem;
    N23: TMenuItem;
    DllForm1: TMenuItem;
    N24: TMenuItem;
    SaveDialog1: TSavePictureDialog;
    N25: TMenuItem;
    N26: TMenuItem;
    N27: TMenuItem;
    N29: TMenuItem;
    N30: TMenuItem;
    N31: TMenuItem;
    N32: TMenuItem;
    N33: TMenuItem;
    N34: TMenuItem;
    N35: TMenuItem;
    N36: TMenuItem;
    N28: TMenuItem;
    LimitSysKey: TMenuItem;
    RelaxKey: TMenuItem;
    N38: TMenuItem;
    N39: TMenuItem;
    N40: TMenuItem;
    N41: TMenuItem;
    N42: TMenuItem;
    SB: TStatusBar;
    N37: TMenuItem;
    ListView1: TListView;
    N43: TMenuItem;
    N44: TMenuItem;
    Dialog1: TOpenPictureDialog;
    N45: TMenuItem;
    N46: TMenuItem;
    N47: TMenuItem;
    N48: TMenuItem;
    ImageList1: TImageList;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    N49: TMenuItem;
    N50: TMenuItem;
    F1: TMenuItem;
    ToolButton6: TToolButton;
    Button2: TButton;
    N52: TMenuItem;
    N53: TMenuItem;
    Button3: TButton;
    N54: TMenuItem;
    Html1: TMenuItem;
    N55: TMenuItem;
    procedure Minimize(Sender: TObject);
    procedure Maximize(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure GetWinProductID(Sender: TObject);
    procedure GetAppIcon(Sender: TObject);
    procedure GetAllColor(Sender: TObject);
    procedure ShutDown(Sender: TObject);
    procedure GetNetUserName(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure DFNO01Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure Memo1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SetMouse(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure N17Click(Sender: TObject);
    procedure N18Click(Sender: TObject);
    procedure SetWinRgn(Sender: TObject);
    procedure PrintTable(Sender: TObject);
    procedure F1Book1Click(Sender: TObject);
    procedure N19Click(Sender: TObject);
    procedure CDROM1Click(Sender: TObject);
    procedure N20Click(Sender: TObject);
    procedure N21Click(Sender: TObject);
    procedure N23Click(Sender: TObject);
    procedure DllForm1Click(Sender: TObject);
    procedure N24Click(Sender: TObject);
    procedure N25Click(Sender: TObject);
    procedure N28Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ProceedSysKey(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N38Click(Sender: TObject);
    procedure SetDispMode(Sender: TObject);
    procedure N42Click(Sender: TObject);
    procedure cccc1Click(Sender: TObject);
    procedure N44Click(Sender: TObject);
    procedure N45Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure ShowThisWindow(Sender: TObject);
    procedure N49Click(Sender: TObject);
    procedure FileCheck(Sender: TObject);
    procedure ShutMonitor(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Html1Click(Sender: TObject);
    procedure N55Click(Sender: TObject);
  private
    { Private declarations }
    procedure OnIdle(Sender: TObject; var Done: Boolean);
    procedure MyMenu(var msg: twmmenuselect); message wm_syscommand;
    procedure AllowMove(var Msg: TMessage); message WM_NCHITTEST;
    procedure WMQueryEnd(var Msg: Tmessage); message WM_QueryEndSession;
    procedure GexInfo(var message: twmgetminmaxinfo); message wm_getminmaxinfo;
    procedure WMTrayNotify(var Msg: TMessage); message WM_TRAYNOTIFY;
    procedure NoPosChange(var Msg: TWMWindowPosMsg); message WM_WINDOWPOSCHANGing;
    procedure DrawCaptButton;

    procedure LoadNTCur(Sender: TObject);
    procedure DisplayHint(Sender: TObject);
    procedure DeActTool(Sender: TObject);
    procedure HandleMe(Sender: TObject; E: Exception);
  public
    CaptionBtn: TRect;
    NTIcon: TNotifyIconData;
    NewWinProc,
      OldWinProc: Pointer;
    SetWay: string;
    Curs: Integer;
    CanMove: Boolean;
    { Public declarations }
  end;

var
  A00Form: TA00Form;

implementation

uses Cleaner, StopProc, Canvas01, LogPas, PRINDB01, F1Book1, Draw01, imme01,
  GetField, MyAbout, FindPas, Disp01, Speed1, AttrPas, FilePas, HtmlPas,
  GetIcon;

{$R *.DFM}
{$R NTCursor.RES}
const
  htCaptionBtn = htSizeLast + 1;

procedure TA00Form.Minimize(Sender: TObject);
begin
  ShowWindow(Application.Handle, SW_Hide);
end;

procedure TA00Form.Maximize(Sender: TObject);
begin
  ShowWindow(Application.Handle, SW_Show);
  SetForeGroundWindow(Handle);
end;

procedure TA00Form.AllowMove(var Msg: TMessage);
begin // 禁止随意移动
  inherited;
  //  if Msg.Result = htCaption then Msg.Result := htClient;
  //Msg.Result := htCaption;  Msg.Result := 0;
end;

procedure TA00Form.NoPosChange(var Msg: TWMWindowPosMsg);
begin // 禁止改变位置大小
  inherited; exit;
  if not CanMove then
    with Msg.WindowPos^ do
      Flags := Flags or SWP_NOMOVE or SWP_NOSIZE;
end;

procedure TA00Form.GexInfo;
begin exit;
  with message.MinMaxInfo^ do
  begin
    ptMaxSize.X := 640;
    ptMaxSize.Y := 480;
    ptMaxPosition.X := 0;
    ptMaxPosition.Y := 0;
  end;
  message.Result := 0;
  inherited;
end;

procedure TA00Form.WMQueryEnd(var Msg: Tmessage);
var
  Answer: Integer;
begin // 禁止随意关机
  Answer := MessageBox(Handle, '是要关闭计算机吗', '关机提示', MB_YESNO);
  Msg.Result := ID_NO - Answer;
end;

procedure TA00Form.N2Click(Sender: TObject);
begin
  Application.CreateForm(TProcForm, ProcForm);
  ProcForm.Showmodal;
  ProcForm.Free;
  Application.OnHint := DisplayHint;
end;

procedure TA00Form.N4Click(Sender: TObject);
begin
  Application.CreateForm(TDrawForm, DrawForm);
  DrawForm.Showmodal;
  DrawForm.Free;
end;

procedure TA00Form.N5Click(Sender: TObject);
begin
  Application.CreateForm(TCanForm, CanForm);
  CanForm.Showmodal;
  CanForm.Free;
end;

function GetWindowsProductID: string;
var
  reg: TRegistry;
begin
  Result := '';
  reg := TRegistry.Create;
  with reg do
  begin
    RootKey := HKEY_LOCAL_MACHINE;
    OpenKey('Software\Microsoft\Windows\CurrentVersion', False);
    Result := ReadString('ProductID');
  end;
  reg.Free;
end;

procedure TA00Form.GetWinProductID(Sender: TObject);
begin
  Showmessage(GetWindowsProductID);
end;

procedure TA00Form.GetAppIcon(Sender: TObject);
var filename: string;
begin
  Filename := Paramstr(0);
  Image1.Picture.Icon.Handle :=
    ExtractIcon(Hinstance, pchar(FileName), 0);
end;

function GetSysColorNum: Cardinal;
var
  ScreenDc: HDC;
  NumBitsPixel: Integer;
begin
  ScreenDc := GetDC(0);
  NumBitsPixel := GetDeviceCaps(ScreenDc, BITSPIXEL);
  ReleaseDC(0, ScreenDC);
  Result := NumBitsPixel;
end;

procedure TA00Form.GetAllColor(Sender: TObject);
begin
  Showmessage(Inttostr(GetSysColorNum) + '位');
end;

procedure TA00Form.ShutDown(Sender: TObject);
var
  Send, Ex: UInt;
begin
  Send := 5;
  if SEND = 1 then EX := EWX_FORCE else
    if SEND = 2 then EX := EWX_LOGOFF else
      if SEND = 3 then EX := EWX_POWEROFF else
        if SEND = 4 then EX := EWX_REBOOT else
          if SEND = 5 then EX := EWX_SHUTDOWN else EXIT;
  ExitWindowsEx(EWX_POWEROFF or EWX_SHUTDOWN or EWX_FORCE, 0);
end;

function GetUserNameB: AnsiString;
var
  lpName: PAnsiChar;
  lpUserName: PAnsiChar;
  lpnLength: DWORD;
begin
  lpnLength := 100;
  WNetGetUser(nil, nil, lpnLength); // 取得字串所需的長度
  if lpnLength = 0 then Exit;
  GetMem(lpUserName, lpnLength);
  lpName := '\\dfno0';
  if WNetGetUser(lpName, lpUserName, lpnLength) = NO_ERROR
    then Result := lpUserName else Result := '根本没有登录过网络';
  FreeMem(lpUserName, lpnLength);
end; { GetNetUserName }

procedure TA00Form.GetNetUserName(Sender: TObject);
begin
  Showmessage(GetUserNameB);
end;

procedure TA00Form.N8Click(Sender: TObject);
begin
  WNetCancelConnection2('dfno0', 0, True);
end;

procedure TA00Form.DFNO01Click(Sender: TObject);
begin
  Application.CreateForm(TLogForm, LogForm);
  LogForm.Showmodal;
  LogForm.Free;
end;

procedure TA00Form.LoadNTCur(Sender: TObject);
begin exit;
  screen.cursors[1] := LoadCursor(hInstance, pChar('CURSOR_1'));
  screen.cursors[2] := LoadCursor(hInstance, pChar('CURSOR_2'));
  screen.cursors[3] := LoadCursor(hInstance, pChar('CURSOR_3'));
  screen.cursors[4] := LoadCursor(hInstance, pChar('CURSOR_4'));
  screen.cursors[5] := LoadCursor(hInstance, pChar('CURSOR_5'));
  screen.cursors[6] := LoadCursor(hInstance, pChar('CURSOR_6'));
  screen.cursors[7] := LoadCursor(hInstance, pChar('CURSOR_7'));
  screen.cursors[8] := LoadCursor(hInstance, pChar('CURSOR_8'));
  screen.cursors[9] := LoadCursor(hInstance, pChar('CURSOR_9'));
  screen.cursors[10] := LoadCursor(hInstance, pChar('CURSOR_10'));
  screen.cursors[11] := LoadCursor(hInstance, pChar('CURSOR_11'));
  screen.cursors[12] := LoadCursor(hInstance, pChar('CURSOR_12'));
  Curs := 0;
end;

procedure TA00Form.FormCreate(Sender: TObject);
var
  R: TRegistry;
  DeskBMP: string;
begin
  ListView1.Hide;
  ListView1.Align := alClient;
  CanMove := True;
  R := TRegIniFile.Create('Control Panel');
  R.OpenKey('Desktop', False);
  SetWay := R.ReadString('WallPaperStyle');
  if SetWay <> '2' then
    SetWay := R.ReadString('TileWallPaper');
  DeskBMP := R.ReadString('Wallpaper');
  R.Free;
  SetWay := '1';
  Image1.Hide;
  if FileExists(DeskBMP) then begin
    Image1.Picture.LoadFromFile(DeskBMP);
  end;
  with NTIcon do begin
    cbSize := Sizeof(TNOTIFYICONDATA);
    Wnd := Handle;
    UID := MY_TRAY_ICON;
    uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
    uCallBackMessage := WM_TRAYNOTIFY;
    hIcon := LoadIcon(HInstance, 'MAINICON');
    szTip := '这里是例子管理程序的图标'#0;
  end;
  Shell_NotifyIcon(NIM_ADD, @NTIcon);
  LoadSite(Self, 'Xed Tools');
  Show; Update;
  CanMove := False;
  LoadNTCur(Self);
  Hint := '本范例程序版本号：' + FileVersion(ParamStr(0));
  //Application.OnDeactivate := DeActTool;
  Application.OnHint := DisplayHint;
  Application.OnMinimize := Minimize;
  Application.OnRestore := Maximize;
  Application.OnIdle := OnIdle;
  Application.OnHelp := OnHelp;
  Application.OnActivate := onActivate;
  Application.OnException := HandleMe;
  Application.HelpFile := 'Win32s.HLP';
end;

procedure TA00Form.HandleMe(Sender: TObject; E: Exception);
begin
  E.Message := '程序出现异常错误：'#13#13 + E.Message;
  Application.ShowException(E);
end;

procedure TA00Form.DeActTool(Sender: TObject);
begin
  Application.Minimize;
end;

procedure TA00Form.OnIdle(Sender: TObject; var Done: Boolean);
begin
  exit; Done := True;
  inc(Curs);
  if Curs > 12 then
  begin
    Curs := 1;
  end;
  screen.cursor := Curs;
end;

procedure TA00Form.DisplayHint(Sender: TObject);
begin
  SB.Panels[0].Text := Application.Hint;
end;

procedure TA00Form.WMTrayNotify(var Msg: TMessage);
var
  PT: TPoint;
begin
  case MSG.lParam of
    WM_LBUTTONUP, WM_RBUTTONUP:
      if IsWindowVisible(Handle) then begin
        Application.Minimize;
//       ShowWindow(Self.Handle, sw_Hide);
      end else begin
        Application.Restore;
//       ShowWindow(Application.Handle, sw_Show);
        if MSG.lParam = WM_RBUTTONUP then begin
          GetCursorPos(Pt);
          PMenu1.Popup(PT.X, PT.Y);
        end;
      end;
  end;
end;

procedure TA00Form.N9Click(Sender: TObject);
begin
  Close;
end;

procedure MyGetImeList(AList: TStrings);
const
  nHKL_LIST = 20;
{var
  iHandleCount: integer;
  pList: array[0..nHKL_LIST] of HKL;
  szFileName: array[0..MAX_PATH] of char;
  i: integer;}
begin
{  ComBoBox1.Items.Assign(Screen.Imes);
  ComBoBox1.ItemIndex := 0;
  if AList = nil then Exit;
  AList.Clear;
  iHandleCount := GetKeyboardLayoutList(nHKL_LIST, pList);
  for i := 0 to iHandleCount - 1 do
  begin
    if ImmGetIMEFileName(pList[I], szFileName, MAX_PATH) > 0 then
    begin
      // AList.Add(StrPas(szFileName));  // 這是各 IME 的檔名
      if ImmEscape(pList[i], 0,
        IME_ESC_IME_NAME, @szFileName) > 0 then
        AList.Add(Copy(StrPas(szFileName), 1, 30));
    end;
  end;}
end;

procedure TA00Form.N10Click(Sender: TObject);
var
  S: TStringList;
  I: Integer;
12

⌨️ 快捷键说明

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