tslediter/funcext/tvclib/utslvclbase.tsf

430 lines
12 KiB
Plaintext
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

unit utslvclbase;
interface
{$ifdef linux}
{$define gtkpaint}
{$define linuxgtk}
{$else}
{$define gdipaint}
{$endif}
uses utslvclconstant,utslvclmemstruct,utslvclauxiliary;
type tswin32api = class({$ifdef linuxgtk}tsgtkapi {$else} twindowsapi {$endif} ) //windows接口
{$ifdef linuxgtk}
uses ugtkinterface;
{$else}
uses uwindowsinterface;
{$endif}
{**
@explan(说明) win32api接口函数类
1. 导出了部分win32的api
2. winuser头文件的宏定义
3. 添加了部分结构体定义到成员变量
4. 下面的external函数的win32api可以在msdn中查找具体用法
**}
public
function get_current_directory()//获取当前环境路径
begin
{$ifdef linux}
return getcwd();
{$else}
s := "";
setlength(s,1024);
N := GetCurrentDirectoryA(1023,s);
if n>0 then return s[1:N];
return "";
{$endif}
end
function GetScreenRect(p);
begin
{**
@explan(说明) 获取屏幕大小%%
@return(array) 左上右下 %%
**}
{$ifdef linux}
{$else}
if ifarray(p) then getmonitorrect := true;
{$endif }
if getmonitorrect then
begin
r1 := array(p[0]-2,p[0]+2,p[1]-2,p[1]+2);
mh := MonitorFromRect(r1,2);
info := new TMONITORINFO();
GetMonitorInfoA(mh,info._getptr_);
return info.rcmonitor;
end
rc := new tcrect();
SystemParametersInfoA(0x30,0,rc._getptr_(),0);
return rc._getdata_();
end
function getpathbyprocid(id);
begin
{**
@explan(说明) 获取所有进程路径,仅支持windows %%
@param(id)(integer) 进程id
**}
{$ifdef linux}
return "";
{$endif }
strFilePath := "";
len := 1024;
setlength(strFilePath,len);
hd := OpenProcess(0x000F0000L .| 0x00100000L .| 0xFFFF,0,id);
GetModuleFileNameExA(hd,0,strFilePath,len);
//QueryFullProcessImageNameA(hd, 1, strFilePath, len);
r := "";
for i := 1 to length(strFilePath) do
begin
vi := strFilePath[i];
if vi="\0" then break;
r += vi;
end
if hd then CloseHandle(hd);
return r;
end
function EnumProcesses();
begin
{**
@explan(说明) 获取所有进程id仅支持windows
**}
{**
@example(获取所有进程id,并获得路径)
t := EnumProcesses();
for i,v in t do echo getpathbyprocid(v),"\r\n";
**}
{$ifdef linux}
return "";
{$endif }
ret := zeros(2048);
EnumProcesses_(ret,length(ret)* 4,t);
r := "";
if t>0 then r := ret[0:t/4];
return r;
end
function Toolhelp32Snapshot();
begin
{**
@explan(说明) 获取所有进程信息仅支持windows %%
@param()
@return(array) 进程信息 %%
**}
{$ifdef linux}
return array();
{$endif }
currentProcess := new Ttagprocessentry32();
hProcess := CreateToolhelp32Snapshot(2,0); //给系统内的所有进程拍一个快照
r := array();
if hProcess=-1 then return r;
bMore := Process32First(hProcess,currentProcess._getptr_); //获取第一个进程信息
countProcess := 0;
while(bMore) do
begin
r[countProcess]:= currentProcess._getdata_;
bMore := Process32Next(hProcess,currentProcess._getptr_); //遍历下一个
countProcess++;
end
CloseHandle(hProcess); //清除hProcess句柄
return r;
end
function Toolhelp32Snapshotmodule(id);
begin
{**
@explan(说明) 获取所有module信息仅支持windows
**}
{$ifdef linux}
return array();
{$endif }
if not(id >= 0)then id := 0;
currentProcess := new TtagMODULEENTRY32();
hProcess := CreateToolhelp32Snapshot(8,id); //给系统内的所有进程拍一个快照
r := array();
if hProcess=-1 then return r;
bMore := Module32First(hProcess,currentProcess._getptr_); //获取第一个进程信息
countProcess := 0;
while(bMore) do
begin
r[countProcess]:= currentProcess._getdata_;
bMore := Module32Next(hProcess,currentProcess._getptr_); //遍历下一个
countProcess++;
end
CloseHandle(hProcess); //清除hProcess句柄
return r;
end
function Comctl32version(); //获取comctl32.dll版本
begin
{$ifdef linux}
return array();
{$endif }
o := tslcstructure(array(
("cbsize","int",0),
("dwmajorversion","int",0),
("dwminorversion","int",0),
("dwbuildnumber","int",0),
("dwplatformid","int",0)));
o._setvalue_("cbsize",o._size_);
Comctl32DllGetVersion(o._getptr_);
return o._getdata_();
end
function shell32Version(); //获取shell32.dll版本
begin
{$ifdef linux}
return array();
{$endif }
o := tslcstructure(array(
("cbsize","int",0),
("dwmajorversion","int",0),
("dwminorversion","int",0),
("dwbuildnumber","int",0),
("dwplatformid","int",0)));
o._setvalue_("cbsize",o._size_);
shell32DllGetVersion(o._getptr_);
return o._getdata_();
end
function GetCursorInfo(); //获取cursor 信息
begin
{
字段:
flags 为0 表示 The cursor is hidden.
为1 表示 The cursor is showing.
为2 表示 The cursor is suppressed
hcursor 光标句柄
ptscreenpos 光标位置
}
o := new ctslctrans(array(
("cbsize","int",0,0,4,"int",1),
("flags","int",0,4,4,"int",1),
("hcursor","intptr",0,8,4,"intptr",1),
("ptscreenpos","int[2]",
(0,0),12,8,"intarray",2)),nil,nil);
o._setvalue_("cbsize",o._size_());
if(GetCursorInfo_(o._getptr_()))then
begin
return o._getdata_();
end
end
function GetMonitor(mhandle,r); //获得显示器信息%%
begin
r := new TMONITORINFO();
return GetMonitorInfoA(mhandle,r._getptr_());
end
end
type TSLUIBASE=class(TSLUICONST) //图像库基类
{**
@explan(说明)图像库基类,提供基本的底层操作和常量 %%
**}
private
static const TSLRCS_NONE = 0;
static const TSLRCS_BEGIN = 1;
static const TSLRCS_END = 2;
static FTSLkeyWords;
static FTSLkeyWordshash;
static FHAPP;
//static FEditTypes;
_hashdata;
_temppath;
FReCycleState;
function Gethapp();
begin
return FHAPP;
end
function SetHapp(v);
begin
end
public
static _wapi; //windows api;
function create();virtual; //构造
begin
_hashdata := array();
sinit();
FReCycleState := TSLRCS_NONE;
end
class function sinit();virtual;
begin
{**
@explan(说明)初始化win32接口对象_wapi
**}
if not(_wapi is class(tswin32api))then
begin
global G_O_TSWIN32API_;
if not G_O_TSWIN32API_ then G_O_TSWIN32API_ := new tswin32api();
_wapi := G_O_TSWIN32API_;
if not FTSLkeyWordshash then
begin
FTSLkeyWords := TSL_ReservedKeys2();
FTSLkeyWordshash := array();
for i,v in FTSLkeyWords do
begin
FTSLkeyWordshash[v] := true;
end
end
end
if not FHAPP then
begin
FHAPP := _wapi.GetModuleHandleA(0);
end
end
class Function isKeyWords(k);
begin
{**
@explan(说明) 判断是否为tsl关键字 %%
@param(k)(string)
**}
return ifstring(k)and ifarray(FTSLkeyWordshash) and( FTSLkeyWordshash[lowercase(k)]);
return false;
end
function destroy();virtual;
begin
if FReCycleState=TSLRCS_NONE then Recycling();
end
function NoRecycled();
begin
{**
@explan(说明) 是否没有被回收 %%
@return(bool) 没有回收返回true ,否则返回false;
**}
return FReCycleState=TSLRCS_NONE;
end
function Recycling();virtual;
begin
{**
@explan(说明)析构准备;为消除循环引用的销毁
**}
if FReCycleState=TSLRCS_END then return;
_Tag := nil;
_hashdata := array();
FReCycling := true;
FReCycleState := TSLRCS_END;
end
function hashset(i,v,f);
begin
{**
@explan(说明)设置一个哈希值 %%
@param(i)(string | integer) 下标 %%
@param(f)(bool) i=nil and f=1 and v=array 替换哈希表 %%
@param(v)() 值
**}
if ifstring(i)or ifint(i)then
begin
_hashdata[i]:= v;
end else
if(ifnil(i)and ifarray(v)and(f=1))then _hashdata := v;
end
function hashget(i);
begin
{**
@explan(说明)获取一个哈希值 %%
@param(i)(string | integer) 下标 %%
@return() 值
**}
if ifstring(i)or ifint(i)then
begin
return _hashdata[i];
end else
if ifnil(i)then return _hashdata;
end
function hashdel(i,f);
begin
{**
@explan(说明)删除一个哈希值 %%
@param(i)(string | integer) 下标 %%
@param(f)(bool) i=nil and f=1 清空hash表 %%
@return(bool)是否成功
**}
if ifstring(i)or ifint(i)then
begin
return reindex(_hashdata,array(i:nil));
end else
if ifnil(i)and f=1 then _hashdata := array();
end
function caption(s);virtual;
begin
return "";
end
function temppath();
begin
{**
@explan(说明) 获取一个可以读写的文件夹 %%
@return(string) 目录路径 %%
**}
if not(ifstring(_temppath)and _temppath)then _temppath := gettemppath()+"tinysoft";
return _temppath;
end
property happ read Gethapp write SetHapp;
property ReCycleState read FReCycleState; //write FReCycleState;
_Tag; //标签
{**
@param(_wapi)(tswin32api) win32宏定义,以及api接口 %%
@param(_Tag)(any) 调用者使用的成员变量 %%
**}
end
type TWMNCHITTEST=class(TSLUICONST) // hittest消息处理类
function hitstyle(o,e);
begin
return hitstyle2(o,e.lolparam,e.hilparam);
end
function hitstyle2(o,x,y);
begin
//rec := o.clientrect(); //客户区
//p := o.screentoclient(e.lolparam,e.hilparam);
rec := zeros(4);
o._wapi.GetWindowRect(o.Handle,rec);
p := array(x,y); //
r := borerhittest(p,rec,4);
r := inttohit(r);
return r;
end
function inttohit(i);
begin
r := HTCLIENT;
case i of
1:r := HTTOPLEFT;
2:r := HTTOPRIGHT;
3:r := HTBOTTOMRIGHT;
4:r := HTBOTTOMLEFT;
5:r := HTLEFT;
6:r := HTTOP;
7:r := HTRIGHT;
8:r := HTBOTTOM;
end;
return r;
end
function borerhittest(p,rec,dv);
begin
rec[0]+= 1;
rec[1]+= 1;
rec[2]-= 1;
rec[3]+= 1;
ps := array(rec[0:1],(rec[2],rec[1]),(rec[2],rec[3]),(rec[0],rec[3]));
ds := array();
for i,v in ps do
begin
ds[i]:= integer(sqrt((p[0]-v[0])^2+(p[1]-v[1])^2));
end
minds := minvalue(ds);
if minds<dv then
begin
for i,v in ds do if minds=v then
begin
return i+1;
end
end
ds := array();
ds[0]:= abs(p[0]-rec[0]);
ds[1]:= abs(p[1]-rec[1]);
ds[2]:= abs(p[0]-rec[2]);
ds[3]:= abs(p[1]-rec[3]);
minds := minvalue(ds);
if minds<dv then
begin
for i,v in ds do if minds=v then
begin
return i+5;
end
end
return 0;
end
end
implementation
initialization
end.