?? myfun.pas
字號:
unit myFun;
{-----------------------------------}
{ Create by 李金浩 }
{ QQ:67260745 }
{ 2004-3-21 }
{ 我的目標--共建理想常用函數庫 }
{ install only for delphi7 }
{-----------------------------------}
interface
uses Windows, Messages, SysUtils,Variants,iniFiles, Classes, Controls,
Forms,Dialogs, StdCtrls,TeeProcs, TeEngine, Chart, ExtCtrls,StrUtils,
registry,Graphics,ComCtrls,Grids,Winsock,ShellApi,
DB,Buttons;
//comobj;
type
TBitType=(HighBit,LowBit,AllBit);
(*定義鼠標入鍵盤事件常量*)
TClickType=(leftDown,rightDown,midDown,
leftUp,rightUp,midUp,
leftDB,rightDB,midDB,
vkeyDown,vkeyUp,vKeyClick,
pageUp,PageDown);
//-------------------------------------
(*窗體大小常量*)
TWinRect=record
Top:integer;
Left:integer;
Width:integer;
Height:integer;
end;
//--IP設置常量--------
TNetValue=record
IpAddress:string;//IP地址
SubnetMask:string;//掩碼
DefaultGateway:string;//默認網關
end;
//---------memo的返回常量-------
TmemoPos=record
LinePos:integer;//光標所在行號
CharPos:integer;//光標所在的字符位置
lineLenght:integer;//得到該行的字符長度
end;
//------------------
{===============================================================================}
{ TFun功能函數集合 }
{包含平時開發常用的函數及功能子程序. }
{===============================================================================}
TFun=class(TComponent)
// TFun=Class(TCustomControl)
private
{code}
myIniFile:TIniFile;
// procedure CMMouseEnter(var Msg:TMessage);message CM_MOUSEENTER;
// procedure CMMOUSELEAVE (var Msg:TMessage);message CM_MOUSELEAVE;
public
Function IntToBit(const source:word;const Bit:TBitType=AllBit):string; //10 to 16
function IntToHexEx(sInt:word;const Bit:integer=2):string;overload;
Function BitToInt(sBin:string):integer; //2 to 10
Function HexToInt(sHex:string):integer; //16 to 10
Function HexToBit(sHex:string;const Bit:TBitType=AllBit):string;//16 to 2
Function BitToHex(sBin:string;const Bit:integer=2):string;//2 to 16
{----------------------------------------------}
{ 將十六進制表示的十制制轉為實際的十進制數}
{如: $12===>12 | $32===>32 ... }
{----------------------------------------------}
Function HexBCDToint(sHexBCD:Byte):integer;
Function IntToBCD(Int:Byte):word;
Function MinuteToTime(Minute:Double):TdateTime;overload;//分鐘到標準時間的轉換
Function MinuteToTime(Minute:Double;var DayCount:integer):TdateTime;overload;
//------------------------------------------------------------------------------
Function GetWeekOfChina(dDay:TdateTime):string;//得到星期
Function GetWeekOfNum(dDay:TdateTime):integer;
//------------------------------------------------------------------------------
Function IsStrAsNumber(NumStr:string):Bool;//判斷字符串是不是有效數字在字符串
Function IsStrInOtherStr(mainStr,FindStr:string):Bool;//檢測在一個字符串中是否包括另一個字符串
function IsCOMClassRegistered(GUID:TGUID):Boolean;//判斷一個COM對像是否已注冊
Function IsBDEInstalled:boolean;//查看ＢＤＥ是否安裝
function GetPYIndexChar( hzchar:string):char;//得到漢字的首字母
Function Squ(X,Y:integer):integer;overload;//計算x的Y次方
Function Squ(X:Double;Y:integer):Double;overload;//計算x的Y次方
Function RandomNumByGUID:String;
//--------------系統功能------------
Function AppRunOnce:Boolean;//讓程序只能運行一個實例
procedure AutoRunByReg(FileName:string='');//讓程序自動運行
procedure DelAutoRunByReg(KeyName:string='');//刪除一個自啟動項
procedure MoveWindow(handle:Thandle);overload;//托動無標題窗體
Function GetAppPath(AddLastName:string=''):string;//得到程序的當前目錄
Procedure ReMoveWinTitle(Form:Tform);//移去窗體的Title;
procedure BeepEx(Freq:Word;MSecs:LongInt); //DoBeep調用
procedure ClickStartMenu;//通過代碼擊活開始菜單
procedure OpenScreenSave;//打開屏幕保護
// procedure DelTree(DirName:String);//刪除目錄
procedure DeleteDir(SourcePath: String); //刪除指定文件夾(含子文件夾),文件夾及其夾內文件可以具有只讀或隱藏屬性
procedure DelSelfApp;//程序在運行完后就刪除自己
(*-----------------*)
procedure HideTaskBar(bHide:boolean=False);//顯示或掩藏TaskBar
procedure DisplayOFFON(SW: boolean);//關閉和打開顯示器
procedure HideDesktop(sw:Boolean=false);//顯示和隱藏桌面
procedure HideDesktopAndTaskBar(sw:Boolean=false);//同時隱藏桌面和任務欄
procedure HideTrayNotify(sw:Boolean=false);//隱藏系統通知區域
procedure HideWinButton(sw:Boolean=false);//隱藏開始按鈕
procedure HideQuickLaunchBar(sw:Boolean=false);//隱藏快速啟動按鈕欄
// procedure HideAppInTastWin(sw:Boolean=False);//使程序在任務管理器中隱藏
procedure DisbleQuikKey(sw:boolean=false);//屏蔽ALT+F4和ALT+Ctrl+Del
Function GetTaskBarHeight:integer;//得到任務欄的高度
//------------------------------------------------------------------------------
function GetDesktopListViewHandle: THandle; { 得到桌面列表試圖的句柄 }
procedure MinWinAll;//最小化所有的窗體
procedure CloseWinAll;//關閉所有窗體
procedure DrawWindowRect(handle: Thandle;wColor: Tcolor=clBlack;PenWidth:integer=1);//給窗體加個邊框
Procedure SetParentWinDefFont(Sender:TObject;const defFont:Tfont=nil);//設置parent窗體的默認字體
{得到memo中光標所在的位置，行號，行長}
procedure GetMemoMousePos(m:Tmemo;var posValue:TmemoPos);overload;
procedure GetMemoMousePos(m:TRichEdit;var posValue:TmemoPos);overload;
//Memo翻頁
procedure setScrollPos(MHandle:Thandle;const pos:TClickType=PageDown);overload;
//得到指定窗體的大小
procedure GetWinRect(const WinHandle:HWND;var winRect:TwinRect);
procedure TimeDelay(DT:Dword);//精確毫秒級延時
procedure SetIPaddress(SIP: TNetValue;const isAuto:boolean=false);//設定網絡Ip地址
Function GetLocalIP:string;//得到本機的IP地址
Procedure OpenURL(URL:string);//打開1個web URL
//==============================================================================
// 這一部分的函數摘自其他作者處.姓名不詳
//==============================================================================
function GetDisplayFrequency: Integer; //獲取顯示刷新率
function GetIdeSerialNumber: String; //獲取第一個硬盤的序列號
function GetCPUSpeed: Double; //獲取當前CPU速率
Function GetCPUID:string; //獲取CPU ID
Function GetCPUVendor: string; //獲取CPU 類型
Function GetFileLastAccessTime(sFileName:string):TDateTime; //獲取文件最后訪問日期和時間
Function GetFileCreateTime(const strFileName:string):TDateTime; //獲取文件創建時間
Function GetFileModifyTime(const strFileName:string):TDateTime; //獲取文件修改時間
Function GetDNSTOIP(DNSName:String):String; //把域名轉化為IP地址
Function GetDNSName(IPAddress:String):String; //把IP地址轉化為域名
//==============================================================================
// 摘用部分結束
//==============================================================================
//--------------------------------
// procedure GetNetConf
//----------INI文件操作集-----------
(*_讀ini文件_*)
Function ReadIniFile(const FileName,Section, Ident:string; Default: string):string; overload;
Function ReadIniFile(const FileName,Section, Ident:string; Default: integer):integer; overload;
Function ReadIniFile(const FileName,Section, Ident:string; Default: Double):Double; overload;
Function ReadIniFile(const FileName,Section, Ident:string; Default: Boolean):Boolean; overload;
Function ReadIniFile(const FileName,Section, Ident:string; Default: TdateTime):TdateTime; overload;
(*_寫INI文件_*)
procedure WriteIniFile(const FileName,Section, Ident:string; Value:string);overload;
procedure WriteIniFile(const FileName,Section, Ident:string; Value:integer);overload;
procedure WriteIniFile(const FileName,Section, Ident:string; Value:Double);overload;
procedure WriteIniFile(const FileName,Section, Ident:string; Value:Boolean);overload;
procedure WriteIniFile(const FileName,Section, Ident:string; Value:TdateTime);overload;
//--------------------------
(*模擬鼠標單擊*)
procedure SendMouseClick(const WinHandle:HWND;const PosX,PosY:integer;const ClickFlag:TClickType=vKeyclick);
(*模擬鍵盤按鍵*)
procedure SendKey(const WinHandle:HWND;const Vkey:word;const KeyClickFlag:TClickType=vkeyDown);
procedure SendComBoKey(const CtrlKey,FnKey:word);//如：發送ALT+F4
//-------------------------
{在指定的chart控件上畫1條數直線，并返回mouse所在的index}
Function ChartMoveLine(Chart:Tobject;MousePos_X:Integer;LineColor:TColor=clRed):integer;
procedure DataToExcelCSV(SaveFileName:string;DataSet:TDataSet;ShowCompleteBoX:Boolean=True;GroupCount:integer=1);
(*---------聲音DoBeep發聲----------*)
// procedure Destroy;
{-------------------------------------------------------------------------------
作者: 不死鳥 ^^me 的好朋友提供的部分代碼
日期: 2004.03.31
-------------------------------------------------------------------------------}
//將數據轉為Excel文件，TDataSet中visible為False的字段不加入
// function DataToExcel(myExcelName: String; myDataSet: TDataSet): Boolean;
function ToBigRMB(RMB: string): string; //小寫金額轉大寫
function IsRightDate(mInputDate:String):Boolean;//輸入的日期是否正確
//字符串簡單加密、解密函數 key=1時為加密，0為解密,利用xor操作
function Decrypt(const s: string; key:Byte=1): string;
function RightCopy(S: string; Index,count:Integer): string; //從右第Index位復制Count個字符
//----------------------------------------------------------------------------
procedure SetHintDraw(Flag:boolean=True);
constructor Create(AOwner: TComponent); override;
protected
{Code}
Published
{code}
end;
//_______________________________________________
{===============================================================================}
{ 帶圖標的提示欄 }
{ THintWindow類重載 }
{===============================================================================}
TIconHintX = class(THintWindow)
private
FActivating: Boolean;
FLastActive: Cardinal;
protected
procedure Paint;override;
public
procedure ActivateHint(Rect: TRect; const AHint: string);override;
// function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; override;
end;
//______________________________________________________________________________
{===============================================================================}
{ TvirtualKeyBoard }
{工控觸摸屏中常要輸入數字和字符,于是利用TstringGrid,寫了個虛擬鍵盤 }
{功能很有限,只是為了本人在工控系統中方便的使用,開發的 }
{要做到每個對象的輸入,你可以在主form中利用wm_Lbuttondown來得到除自己外的對象句柄
來實現多對象輸入！ }
{===============================================================================}
TVkeyDown=Procedure(Sender:TObject;KeyChar:String)of object;
TvirtualKeyBoard = class(TStringGrid)
private
FSendHandle:TWinControl;
FVkeyDown:TVkeyDown;
procedure SetSendHandle(Control:TWinControl);
{code}
protected
public
constructor Create(AOwner: TComponent); override;
procedure DrawCell(ACol, ARow: Longint; ARect: TRect;AState: TGridDrawState);override;
function SelectCell(ACol, ARow: Longint): Boolean;override;
// destructor Destroy; override;
published
(*選擇虛擬鍵盤的按盤發送對像，在Objecet Inspector中選擇*)
property SendKeyControl:TWinControl read FSendHandle write SetSendHandle;
property OnSelectCell:TVkeyDown read FVkeyDown write FVkeyDown;
end;
//________________________________________________________________________________
{===============================================================================}
{ TExChart 2004-3-25 lijinhao }
{帶有鼠標Y軸，繪線功能的Chart空件,自動獲得Yvalue, }
{可以通過[YLableDraw]來設置將Yvalue顯示在chart的左上角 }
{同時YLableCaption,和YLableUnit來分別設置名稱和單位 }
{同樣本人重寫了OnMounseMove處理過程,在onMouseMove過程中也可以很方便的得到Yvalue }
{和Xindex這些原chart組件所沒有的 }
{===============================================================================}
TChartYIndex=procedure(sender:TObject;XIndex,X,Y:integer;YValue:Double) of object;
TExChart = class(TChart)
private
FDrawMouseLineFlag:Boolean;
FDrawMouseLineColor:TColor;
FYLableCaption,FYLableUnit:String;//要顯示Y的caption,和單位
FChartYIndex:TChartYIndex;
FYLableDraw:boolean;
procedure DrawMouseLine(Var Message:Tmessage);message WM_MouseMove;
procedure SetDrawMouseLineColor(Color:TColor);//設置mouseLine的顏色
procedure SetDrawMouseLineFlag(Flag:Boolean);//設置是否顯示mouseline
procedure SetYLableCaption(caption:String);//設置Ylable名稱
procedure SetYLableUnit(UnitValue:String);//設置Ylable單位
procedure SetYLableDraw(Flag:boolean);//設定YLable是否顯示
protected
{code}
public
constructor Create(AOwner: TComponent); override;
// destructor Destroy; override;
published
property DrawMouseLineFlag:Boolean read FDrawMouseLineFlag write SetDrawMouseLineFlag;
property DrawMouseLineColor:TColor read FDrawMouseLineColor write SetDrawMouseLineColor;
property YLableCaption:String read FYLableCaption write SetYLableCaption;
property YLableUnit:String read FYLableUnit write SetYLableUnit;
property YLableDraw:Boolean read FYLableDraw write SetYLableDraw;
property OnMouseMove:TChartYIndex read FChartYIndex write FChartYIndex;
end;
{==============================================================================}
// TExEdit
//對原有的LableEdit上加入了OnlyInputNumber選項來控制只可以輸入數字
{==============================================================================}
{ TExEdit }
TKeyDown=procedure(sender:Tobject;Key:Word) of object;
TExEdit = class(TLabeledEdit)
private
FOnlyInputNumber:Boolean;
FKeyDown:TKeyDown;
FCaption: string;
procedure WMKeyDown(Var Message:Tmessage);message WM_KeyUP;
procedure SetCaption(const Value: string);
protected
procedure SetOnlyInputNumber(Flag:Boolean);
public
// destructor Destroy; override;
constructor Create(AOwner: TComponent); override;
published
Property OnlyInputNumber:Boolean read FOnlyInputNumber write SetOnlyInputNumber;
property OnKeyDown:TKeyDown read FkeyDown write FkeyDown;
property Caption:string read FCaption write SetCaption;
end;
//======================TMyForm========================================================
// TMyForm modify by Panel Component
// lijinhao 2004-3-28
//利用panel。派生實現了1個模擬窗體。
//==============================================================================
TSizeFlag=(SZNil,SZLeft,SZRight,SZTop,SZBottom,
SZLeftTop,SZRightTop,
SZLeftBottom,SZRightBottom);
TMyMouseEvent=procedure(sender:TObject;MouseButton:TMouseButton;X,Y:integer)of Object;
TMyForm = class(TPanel)
private
FWinRectColor:TColor;
FWinRectLineWidth:integer;
FSizeFlag:TSizeFlag;
FTitleActiveColor:TColor;
FTitleActiveFontColor:TColor;
FTitleNoActiveColor:TColor;
FAutoBringTop:Boolean;
FCaption:string;
//---------------
FMouseDown,FMouseUp:TMyMouseEvent;
FMouseMove:TMouseMoveEvent;
FClose:TNotifyEvent;
//--------------
SizeFlag:boolean;
TempTitleColor:Tcolor;
FClick,FMouseEnter,FMouseLeave:TNotifyEvent;
// FMouseDown:TmouseEvent;
procedure WMLBUTTONDBLCLK(var message:TMessage);Message WM_LBUTTONDBLCLK;
procedure WMMouseMove(Var message:Tmessage);Message WM_MOUSEMOVE;
procedure WMLMouseDown(Var message:Tmessage);Message WM_LBUTTONDOWN;
procedure WMLMouseUp(Var message:Tmessage);Message WM_LBUTTONUP;
procedure WMRMouseDown(Var message:Tmessage);Message WM_RBUTTONDOWN;
procedure WMRMouseUp(Var message:Tmessage);Message WM_RBUTTONUP;
//----------
procedure WMMouseEnter(var Message:TMessage);Message CM_MouseEnter;
procedure WMMouseLeave(var Message:TMessage);Message CM_MouseLeave;
procedure setAutoBringTop(const Value: Boolean);
// procedure WMLMouseUp(Var message:TMessage);Message WM_LButtonUp;
protected
procedure DrawTitleButton;
public
constructor Create(AOwner: TComponent); override;
//destructor Destroy; override;
procedure Paint;override;
procedure SetWinRectColor(color:TColor);//設定窗體的邊框顏色
Procedure SetWinRectLineWidth(Lwidth:integer);////設定窗體的邊框的粗度
procedure SetCaption(str:string);
procedure SetTitleActiveColor(color:TCOlor);//設置Title顏色
Procedure SetTitleActiveFontColor(Color:TColor);//設置Title字體顏色
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -