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

📄 okunit.pas

📁 工资管理系统
💻 PAS
字号:
unit okunit;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
  Buttons, ExtCtrls,comobj,activex,shlobj, Gauges, DisplaySwitcher,
  Animate, GIFCtrl;

type
  TOK = class(TForm)
    Panel1: TPanel;
    Bevel1: TBevel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    dsp: TDisplaySwitcher;
    RxGIFAnimator1: TRxGIFAnimator;
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  OK: TOK;

implementation

{$R *.DFM}

procedure createlink(programpath,programarg,linkpath,descr:string);
  var
  anobj:iunknown;
  shelllink:ishelllink;
  afile:ipersistfile;
  FileName:WideString;
  begin
    if uppercase(extractfileext(linkpath))<>'.LNK' then
     begin
       raise Exception.Create('快捷方式的扩展名必须是"lnk"!');
       end;
       try
         oleinitialize(nil);
         anobj:=createcomobject(clsid_shelllink);
         shelllink:=anobj as ishelllink;
         afile:=anobj as ipersistfile;
         shelllink.setpath(PChar(programpath));
         shelllink.setarguments(PChar(programarg));
         shelllink.SetDescription(PChar(descr));
         shelllink.SetHotkey(vk_F11);
        // shelllink.SetRelativePath(PChar(programarg),1);
        // shelllink.SetShowCmd(1);
         shelllink.SetWorkingDirectory(PChar(ExtractFileDir(Application.EXEName)));
         FileName:=linkpath;
         afile.Save(pwidechar(FileName),false);
         finally
         oleuninitialize;
         end;
         end;

procedure TOK.FormShow(Sender: TObject);
var
tmp:array[0..max_path] of char;
windir:string;
begin
    getwindowsdirectory(tmp,max_path);
    windir:=string(tmp);
     begin
        begin
         abort;
         end;
  if Length(windir)>3 then
    windir:=windir+'\';
    createlink(ParamStr(0),'献给我可爱的小儿子:范润泽 !!!',windir+'Desktop\'+'龙矿集团工资系统 2001'+'.LNK','Application.title');
    end;
end;


{procedure GetDiskInfo;
var TmpStr: string;
    RootPathName: Pchar;
    SectorsPerCluster,
    BytesPerSector,
    FreeClusters,
    TotalClusters,
    FreeBytes,
    TotalBytes        : DWORD;
begin

//  with SysInfoRec do begin
    RootPathName := Pchar('C:\');
    if GetDiskFreeSpace( RootPathName,    SectorsPerCluster,
                         BytesPerSector,  FreeClusters,
                         TotalClusters ) then;
    FreeBytes  := SectorsPerCluster * BytesPerSector * FreeClusters;
    TotalBytes := SectorsPerCluster * BytesPerSector * TotalClusters;}
//  end; {- with }
//end; {- GetDiskInfo }



procedure TOK.FormCreate(Sender: TObject);
var
//TmpStr: string;
    RootPathName: Pchar;
    SectorsPerCluster,
    BytesPerSector,
    FreeClusters,
    TotalClusters,
    FreeBytes,
    TotalBytes        : DWORD;
    tempdir:array[0..255] of char;
    txyza:file;
begin
if (dsp.CurrentWidth<>800) or (dsp.CurrentHeight<>600) then
application.MessageBox(pchar('本程序在800*600分辨率下可获得最佳效果.目前您的显示器分辨率为:'+inttostr(dsp.CurrentWidth)+'*'+inttostr(dsp.CurrentHeight)),'注意',mb_ok+mb_iconinformation);
    if not (fileexists(ExtractFileDir(Application.EXEName)+'\Print.txt')) then
    begin
         try
         assignfile(txyza,'Print.Txt');
         rewrite(txyza);
         except

         end;

    end;

   gettemppath(255,@tempdir);
   RootPathName := PChar(copy(tempdir,1,3));
    if GetDiskFreeSpace( RootPathName,    SectorsPerCluster,
                         BytesPerSector,  FreeClusters,
                         TotalClusters ) then;
    FreeBytes  := SectorsPerCluster * BytesPerSector * FreeClusters;
    TotalBytes := SectorsPerCluster * BytesPerSector * TotalClusters;
    if freebytes<50000000 then
    begin
        application.messagebox(pchar(RootPathName+'盘空间为:'+floattostr(totalbytes/1000000)+'兆字节,'+RootPathName+'盘剩余空间为:'+floattostr(freebytes/1000000)+'兆字节,不足于运行本软件,本软件需要至少50MB,请运行本软件附带的工具<垃圾清理工>或者删除一些没用的程序或者清空回收站!!!'),'龙矿集团工资系统 2000',mb_ok+mb_iconstop);
    end;
 if not (fileexists(ExtractFileDir(Application.EXEName)+'\utd.db')) then
 label1.Caption:='您是第一次运行本程序,正在建立基本数据...';
 label1.Update;
end;



end.

⌨️ 快捷键说明

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