?? common.pas
字號:
systime.wYear :=strtoint(copy(formatdatetime('yyyy-mm-dd hh:mm:ss',ttime),1,4));
systime.wMonth :=strtoint(copy(formatdatetime('yyyy-mm-dd hh:mm:ss',ttime),6,2));
systime.wDay :=strtoint(copy(formatdatetime('yyyy-mm-dd hh:mm:ss',ttime),9,2));
systime.wHour :=strtoint(copy(formatdatetime('yyyy-mm-dd hh:mm:ss',ttime),12,2));
systime.wMinute :=strtoint(copy(formatdatetime('yyyy-mm-dd hh:mm:ss',ttime),15,2));
systime.wSecond :=strtoint(copy(formatdatetime('yyyy-mm-dd hh:mm:ss',ttime),18,2));
if SetLocalTime(systime) then result := true
else result := false;
end;
////////////////////////////////////////////////////////////////////////////////
// 功能: 得到系統(tǒng)桌面窗體句柄
////////////////////////////////////////////////////////////////////////////////
function GetDesktopHand: THandle;
begin
Result:=FindWindow('progman',nil);
Result:=GetWindow(Result,GW_Child);
end;
////////////////////////////////////////////////////////////////////////////////
// 功能: 得到系統(tǒng)任務欄句柄
////////////////////////////////////////////////////////////////////////////////
function GetTrayHandle :THandle;
begin
Result := FindWindow('Shell_TrayWnd',nil);
end;
////////////////////////////////////////////////////////////////////////////////
// 功能: 獲取用戶的最高權(quán)限
////////////////////////////////////////////////////////////////////////////////
function SetPrivilege(sPrivilegeName: string; bEnabled: boolean ): boolean;
var TPPrev,TP :TTokenPrivileges;
Token :THandle;
dwRetLen :DWord;
begin
Result := False;
//opens the access token associated with a process.
OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,Token);
TP.PrivilegeCount := 1;
//retrieves the locally unique identifier (LUID) used on a specified system to
//locally represent the specified privilege name.
if( LookupPrivilegeValue(Nil,PChar( sPrivilegeName ),TP.Privileges[ 0 ].LUID ))then
begin
if (bEnabled) then //Give this privileges
begin
TP.Privileges[ 0 ].Attributes := SE_PRIVILEGE_ENABLED;
end
else
begin //NOT Give this privileges
TP.Privileges[ 0 ].Attributes := 0;
end;
dwRetLen := 0;
//enables or disables privileges in the specified access token.
Result := AdjustTokenPrivileges(Token,False,TP,SizeOf( TPPrev ),TPPrev,dwRetLen);
end;
CloseHandle( Token );
end;
//////////////////////////////////////////////////////
//iFlags:
//下面一種情況必須被指定
// EWX_LOGOFF
// EWX_REBOOT
// EWX_SHUTDOWN
// 以下標記可以組合使用
// EWX_POWEROFF
// EWX_FORCE : terminate processes
//////////////////////////////////////////////////////
function WinExitInNT( iFlags : integer ) : boolean;
begin
Result := True;
if (SetPrivilege('SeShutdownPrivilege', True)) then
begin
if (not ExitWindowsEx( iFlags,0)) then
Result := False;
SetPrivilege('SeShutdownPrivilege', False )
end
else
Result := False;
end;
/////////////////////////////////////////////////////////////////////////////////
// 功能 :將情報板播放列表中的顏色字符串轉(zhuǎn)換成 TColor顏色值
/////////////////////////////////////////////////////////////////////////////////
function transferTColorToCCCStr(s:TColor):string;
var r,g,b:integer;
ss:string;
begin
ss:= DecToHexEx(s,6) ;
r := StrToInt('$'+copy(ss,5,2));
g := StrToInt('$'+copy(ss,3,2));
b := StrToInt('$'+copy(ss,1,2));
result:= copy(inttostr(r+1000),2,3) + copy(inttostr(g+1000),2,3) +copy(inttostr(b+1000),2,3)+'000';
end;
/////////////////////////////////////////////////////////////////////////////////
// 功能 :將情報板播放列表中的顏色字符串轉(zhuǎn)換成 TColor顏色值
/////////////////////////////////////////////////////////////////////////////////
function transferStrToTColor(s:string):TColor;
begin
if copy(s,1,9)='000000000' then
Result := RGB(255,255,000)
else
result := RGB(strtoint(copy(s,1,3)),strtoint(copy(s,4,3)),strtoint(copy(s,7,3)));//
end;
procedure StringToCharArray(str:string;var outstr: array of char) ;
var i:integer;
begin
for i := 1 to length(str) do
begin
outstr[i-1] := str[i];
end;
end;
///////////////////////////////////////////////////
function clearsubString(substr,str:string):string;
begin
while pos(substr,str)>0 do
begin
delete(str,pos(substr,str),length(substr));
end ;
result := str;
end;
/////////////////////////////////////////////////////////////////////////////////
// 功能 :將字符串根據(jù)分隔符轉(zhuǎn)換到字符串數(shù)組中
/////////////////////////////////////////////////////////////////////////////////
procedure splitToList(sourceStr,splitStr:String; s:TStrings);
var
p:integer;
ss,items:string;
begin
s.Clear;
ss:= sourceStr;
p := pos(splitStr,ss);
while p>0 do
begin
items := copy(ss,1,p-1) ;
if trim(items)<>'' then s.Add(items);
delete(ss,1,p+length(splitStr)-1);
p := pos(splitStr,ss);
end;
if trim(ss)<>'' then s.Add(ss);
end;
/////////////////////////////////////////////////////////////////////////////////
// 功能 :從情報板的播放列表中提取發(fā)送的圖片名稱和字符串
//\fk3232\C038000\c000000000255注意安全謹慎駕駛
/////////////////////////////////////////////////////////////////////////////////
function processCMSContent(sourceStr:TStrings;flag:integer):String;
var
i,tpos:integer;
s,sFile,temps:string;
begin
result :='';
for i :=0 to sourceStr.Count-1 do
begin
s:= sourceStr[i];
temps:='';
if Pos('\B',S)<>0 then
begin
sFile:='['+copy(S,Pos('\B',S)+2,3)+']';
end;
delete(s,1,Pos('\c',s)-2);
while Pos('\c',s)>0 do
begin
//tpos:= ;
if Pos('\f',s) <>0 then
temps := temps+copy(s,Pos('\c',s)+14,Pos('\f',s)-Pos('\c',s)-14)
else
temps := temps+copy(s,Pos('\c',s)+14,length(s)-Pos('\c',s)-13);
if length(s)>14 then delete(s,1,14)
else if length(s)=14 then delete(s,1,14)
else delete(s,1,Pos('\c',s)-1);
end;
result := result +sFile+ temps+';';
end;
end;
/////////////////////////////////////////////////////////////////////////////////
// 功能 :
/////////////////////////////////////////////////////////////////////////////////
function processCMSLibToFile(cmslib:string) :String;
var
sCMSList : TStringList;
begin
sCMSList :=TStringList.create;
splitToList(cmslib,#13#10,sCMSList) ;
result := '[list]'+#13#10+'item_no='+inttostr(sCMSList.Count)+#13#10+cmslib;
end;
function IntToBin(intValue: integer): string;
var
i,shlvalue:integer;
begin
Result:='';
if intvalue=0 then Result:='0';
i:=0;
shlvalue:= 1;
while shlvalue<=intvalue do
begin
if (intValue and shlvalue)<>0 then
Result:='1'+Result else
Result:='0'+Result;
inc(i);
shlvalue:= 1 shl i;
end;
end;
function BinToInt(Binstr: string): integer;
var
i,size:integer;
begin
Size := Length(Binstr);
Result := 0;
for i := 1 to Size do
if BinStr[i] = '1' then
begin
Result := Result + (1 shl (Size-i));
end;
end;
//////////////////////////////////////////////////////////////////////////////
// 功能: 列舉指定路徑下的文件到字符串數(shù)組中
//////////////////////////////////////////////////////////////////////////////
procedure ListDirectoryPathAnyFile(FileList: Tstrings;DirectoryPath:string);
var
sr: TSearchRec;
begin
if FindFirst(DirectoryPath, $00000020, sr) = 0 then
begin
repeat
begin
if lowercase(getFileExtName(sr.Name))='bmp' then
FileList.Add(sr.Name);
end;
until FindNext(sr)<>0;
end;
SysUtils.FindClose(sr);
end;
//系統(tǒng)熱鍵注冊與取消
//ShortCut(Word('C'), [ssShift]); ssCtrl
function RegSysHotKey(Handle:THandle):boolean;
var ShiftState:Cardinal;
begin
HotKeyId := GlobalAddAtom('SYSTEMSET') - $C000;
ShiftState:=ProcessShiftState([ssShift]);
RegisterHotKey(Handle, hotkeyid, ShiftState , Word('G'));
end;
function UnRegSysHotKey(Handle:THandle):boolean;
begin
UnRegisterHotKey(handle, HotKeyId);
end;
function ProcessShiftState(ss:TShiftState):Cardinal;
var
ShiftState :Cardinal;
begin
ShiftState:=0;
if (ssShift in ss) then
ShiftState := ShiftState or MOD_SHIFT;
if (ssCtrl in ss) then
ShiftState := ShiftState or MOD_CONTROL;
if (ssAlt in ss) then
ShiftState := ShiftState or MOD_ALT;
Result :=ShiftState;
end;
////////////////////////////////////////////////////////////////////////////////
//函數(shù)功能 :圖像旋轉(zhuǎn)
//參數(shù)說明 : 輸入?yún)?shù) src源圖,輸出參數(shù) Dst目標圖 輸入?yún)?shù) angle旋轉(zhuǎn)角度
////////////////////////////////////////////////////////////////////////////////
function bmp_rotate(src:tbitmap;var Dst:tbitmap; angle:extended):boolean;
var
c1x,c1y,c2x,c2y:integer;
p1x,p1y,p2x,p2y:integer;
radius,n:integer;
alpha:extended;
c0,c1,c2,c3:tcolor;
begin
Dst.Width := src.Width;
dst.Height := src.Height ;
// Dst.Mask($00347302);
Dst.TransparentColor :=$00347302;
//將角度轉(zhuǎn)換為PI值
angle := (angle / 180) * pi;
// 計算中心點,你可以修改它
c1x := src.width div 2;
c1y := src.height div 2;
c2x := dst.width div 2;
c2y := dst.height div 2;
// 步驟數(shù)值number
if c2x < c2y then
n := c2y
else
n := c2x;
dec (n,1);
// 開始旋轉(zhuǎn)
for p2x := 0 to n do begin
for p2y := 0 to n do begin
if p2x = 0 then
alpha:= pi/2
else
alpha := arctan2(p2y,p2x);
radius := round(sqrt((p2x*p2x)+(p2y*p2y)));
p1x := round(radius * cos(angle+alpha));
p1y := round(radius * sin(angle+alpha));
c0 := src.canvas.pixels[c1x+p1x,c1y+p1y];
c1 := src.canvas.pixels[c1x-p1x,c1y-p1y];
c2 := src.canvas.pixels[c1x+p1y,c1y-p1x];
c3 := src.canvas.pixels[c1x-p1y,c1y+p1x];
dst.canvas.pixels[c2x+p2x,c2y+p2y]:=c0;
dst.canvas.pixels[c2x-p2x,c2y-p2y]:=c1;
dst.canvas.pixels[c2x+p2y,c2y-p2x]:=c2;
dst.canvas.pixels[c2x-p2y,c2y+p2x]:=c3;
end;
application.processmessages
end;
Result :=true;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -