liujianjun
/
tslediter
3
0
Fork 1
Code Issues Pull Requests Projects Releases Wiki Activity

界面库 

拆分
This commit is contained in:
JianjunLiu 2022-05-11 16:47:43 +08:00
parent 20d268ed0d
commit ab6488d42d
31 changed files with 33601 additions and 32969 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
designer/tediterform.tsf
View File

@ -1,5 +1,5 @@
type TEditerForm = class(TVCform) //编辑器主窗口
uses tslvcl,UTslSynMemo,UtslCodeEditor;
uses utslvclauxiliary,tslvcl,UTslSynMemo,UtslCodeEditor;
function WMACTIVATE(o,e):WM_ACTIVATE;override; //激活
begin
inherited;

13
designer/tslvcldesigner.tsf
View File

@ -3,7 +3,7 @@ unit tslvclDesigner;
@explan(说明)设计器库 %%
**}
interface
uses tslvcl,cstructurelib,UVCPropertyTypesPersistence,utslmemo,UDesignerProject;
uses cstructurelib,utslvclauxiliary,utslvclbase,utslvclgdi,tslvcl,UVCPropertyTypesPersistence,utslmemo,UDesignerProject;
function initlib();
//*******设计控件基类**********************
@ -272,7 +272,7 @@ type TDComponent = class()
ndp := nd.parent;
if ndp then
begin
dm := gettswin32api().MessageBoxA(nd.owner.handle,"¼´½«É¾³ý:"+nd.Caption,"ɾ³ý",0x1 .| 0x30);
dm := MessageBoxA("¼´½«É¾³ý:"+nd.Caption,"ɾ³ý",0x1 .| 0x30,nd.owner);//
if dm<>1 then exit;
wd := nd.Component.Cwnd;
ds := nd.owner.Designer;
@ -5532,7 +5532,7 @@ type TGridCellBitmapEdit = class(TBtnCellDrawVTtype,TPropertyBitmap)
{**
@explan(说明) 绘制格子 %%
**}
if ifarray(d) and (d["value"] is class(tbitmap) )then inherited;
if ifarray(d) and (d["value"] is class(TcustomBitmap) )then inherited;
end
function create(AOwner);override;
@ -5582,7 +5582,7 @@ type TGridCellIconEdit = class(TBtnCellDrawVTtype,TPropertyIcon)
{**
@explan(说明) 绘制格子 %%
**}
if ifarray(d) and (d["value"] is class(ticon)) then inherited;
if ifarray(d) and (d["value"] is class(tcustomicon)) then inherited;
end
function create(AOwner);override;
begin
@ -7555,7 +7555,7 @@ type TDesigImageList = class(TControlImageList)
n := item.ClassName;
id := FIconMaps[n];
bmp := item.bitmap();
if (bmp is class(tbitmap)) and bmp.HandleAllocated() then
if (bmp is class(TcustomBitmap)) and bmp.HandleAllocated() then
begin
if id>=0 then
begin
@ -8878,7 +8878,6 @@ F7A31439DD9B0EC80BCFCBD56CFE0506116665A7640DF50A54EEE2F8BDA750000
cwnd := cp.Cwnd;
cwnd.PopupMenu := mu;
xy := o.ClientToScreen(e.lolparamsigned,e.hilparamsigned);
//_send_(WM_CONTEXTMENU,self.handle,makeposition(xy[0],xy[1]),1);
_send_(WM_CONTEXTMENU,cwnd.handle,makeposition(xy[0],xy[1]),1);
return ;
uf := TPM_LEFTALIGN .| TPM_TOPALIGN .| TPM_RIGHTBUTTON;
@ -9422,7 +9421,7 @@ type TBitmapGrid = class(TGridList)
public
function CheckItem(v);override;
begin
return (v is class(tbitmap)) and inherited;
return (v is class(TcustomBitmap)) and inherited;
end
function create(AOwner);override;
begin

2
designer/udesignerproject.tsf
View File

@ -1,6 +1,6 @@
Unit UDesignerProject;
interface
uses tslvcl,utslmemo,UTslSynMemo,UVCPropertyTypesPersistence,tslvclDesigner,UtslCodeEditor;
uses utslvclauxiliary,tslvcl,utslmemo,UTslSynMemo,UVCPropertyTypesPersistence,tslvclDesigner,UtslCodeEditor;
function SetWndPostWithMouse(wnd,lft);
type TProjectManagerForm = class(TVCForm) //工程管理 TCustomControl
function Create(AOwner);override;

14928
designer/utslcodeeditor.tsf
View File

File diff suppressed because it is too large Load Diff

152
designer/utslsynmemo.tsf
View File

@ -3,7 +3,7 @@ interface
{**
@explan(说明) tsl语法编辑器库
**}
uses TslVcl,UTslMemo;
uses utslvclauxiliary,UTslMemo,TslVcl;
function FileSaveThreader(o,d);
type TTSLCompletion= class(TSynCompletion)
{**
@ -1555,6 +1555,7 @@ type TTsfFileParser = class //
//FFileWorker := new TThreadWorker("this.OnMessage :=findfunction('UTslSynMemo.FileSaveThreader') ;");
FFindDirs := array();
end
function DispatchMethod(o,d);//分发消息
begin
if not ifarray(d) then return ;
@ -1608,7 +1609,8 @@ type TTsfFileParser = class //
end
if r then
begin
//echo "\r\nlodad";
//echo "\r\nlodad";
vmsg := r["msg"];
end else
begin
s := d["value"];
@ -1618,32 +1620,53 @@ type TTsfFileParser = class //
cls := array();
ScriptDelBlocks(r["blcks"],str2array(s,"\n"),cls);
r["blcks"] := cls;
r["blcks"] := cls;
vmsg := getmsgd_Crc32(s);//GetMsgdigest(s,0);
end
ext := array();
FormatFunction(rti,r["functions"],rt,"",r["lines"],ext,1);
FormatBlocks(rti,r["blcks"],rt,"",nil,ext,1);
FormatWords(rti,r["words"],rt,"",ext,1);
dounits := array(vmsg);
uout := array();
for i,v in r["units"] do //单元
begin
begin
vfn := checknamespacename(v);
if m=(lowercase(vfn)+".tsf") then continue;
vi := LoadByName(vfn);
if vi then
begin
if vmsg=vi["msg"] then continue;
if vi["msg"] =vmsg then
begin
continue;
end
ext := array();
FormatFunction(rti,vi["functions"],rt,vfn,vi["lines"],ext,4);
FormatBlocks(rti,vi["blcks"],rt,vfn,nil,ext,4);
FormatWords(rti,vi["words"],rt,vfn,ext,4);
end
dounits[length(dounits)] := vi["msg"];
loadunits(vi["units"],dounits,uout);
end
end
//mtic;
for i,v in uout do
begin
vfn := checknamespacename(v);
if m=(lowercase(vfn)+".tsf") then continue;
vi := LoadByName(vfn);
if vi then
begin
if vi["msg"] =vmsg then
begin
continue;
end
ext := array();
FormatFunction(rti,vi["functions"],rt,vfn,vi["lines"],ext,4);
end
end
uout := array();
//echo "\r\n other time:",mtoc;
dounits := array(vmsg);
for i,v in r["class"] do //类
begin
vfn := checknamespacename(v);
@ -1651,13 +1674,27 @@ type TTsfFileParser = class //
vi := LoadByName(vfn);
if vi then
begin
if vmsg=vi["msg"] then continue;
if vi["msg"] in dounits then continue;
ext:= array();
FormatFunction(rti,vi["functions"],rt,vfn,vi["lines"],ext,4);
FormatWords(rti,vi["words"],rt,vfn,ext,4);
//ident 文件名
loadclasses(vi["class"],dounits,uout);
end
end
for i,v in uout do
begin
vfn := checknamespacename(v);
if m=(lowercase(vfn)+".tsf") then continue;
vi := LoadByName(vfn);
if vi then
begin
if vi["msg"]=vmsg then continue;
ext:= array();
FormatFunction(rti,vi["functions"],rt,vfn,vi["lines"],ext,4);
FormatWords(rti,vi["words"],rt,vfn,ext,4);
end
end
//FormatFile(rti,FCacheS,rt,3,m);
return rt;
//return o.postmessage(r);
@ -1665,6 +1702,74 @@ type TTsfFileParser = class //
end
end
private
function loadunitcalss(us,cs,dounits,uout,cout);
begin
if not ifarray(uout) then uout := array();
if not ifarray(cout) then cout := array();
for i,v in us do
begin
vfn := checknamespacename(v);
vi := LoadByName(vfn);
if vi then
begin
if vi["msg"] in dounits then continue;
dounits[length(dounits)] := vi["msg"];
uout[length(uout)] := vfn;
loadunitcalss(vi["units"],vi["class"],dounits,uout,cout);
end
end
for i,v in cs do
begin
vfn := checknamespacename(v);
if m=(lowercase(vfn)+".tsf") then continue;
vi := LoadByName(vfn);
if vi then
begin
if vi["msg"] in dounits then continue;
dounits[length(dounits)] := vi["msg"];
//ident ÎļþÃû
cout[length(cout)] := vfn;
loadunitcalss(vi["units"],vi["class"],dounits,uout,cout);
end
end
end
function loadunits(us,dounits,uout);
begin
if not ifarray(uout) then uout := array();
for i,v in us do
begin
vfn := checknamespacename(v);
vi := LoadByName(vfn);
if vi then
begin
if vi["msg"] in dounits then continue;
dounits[length(dounits)] := vi["msg"];
uout[length(uout)] := vfn;
loadunits(vi["units"],dounits,uout);
end
end
end
function loadclasses(cs,dounits,uout);
begin
if not ifarray(uout) then uout := array();
for i,v in cs do
begin
vfn := checknamespacename(v);
if m=(lowercase(vfn)+".tsf") then continue;
vi := LoadByName(vfn);
if vi then
begin
if vi["msg"] in dounits then continue;
dounits[length(dounits)] := vi["msg"];
//ident ÎļþÃû
uout[length(uout)] := vfn;
loadclasses(cs,dounits,uout);
end
end
end
function checknamespacename(v);
begin
for ii in FCacheS do
@ -1782,7 +1887,7 @@ type TTsfFileParser = class //
end
ScriptDelBlocks(v["msub"],strs,r);
end
end
end
function FormatBlocks(idx,r,d,f,rr,ext,od);
begin
if not ifarray(ext) then ext := array();
@ -1997,7 +2102,7 @@ type TTsfFileParser = class //
fn := FCacheDir+ioFileseparator()+ModifyFname(n)+".p";
if importfile(ftstream(),"",fn,d)=1 and ifarray(d) then
begin
FCacheS[lowercase(n)] := d;
FCacheS[lowercase(n)] := new tparserdobject(d);
FFilePaths[lowercase(n)] := d["fullpath"];
return d;
end
@ -2049,4 +2154,23 @@ begin
end
end
type tparserdobject = class
function create(d);
begin
if ifarray(d) then
FData := d;
end
function operator[](idx);
begin
if FData then
return FData[idx];
end
function operator[1](idx,v);
begin
if FData then
FData[idx] := v;
end
private
FData ;
end
end.

89
funcext/tvclib/getmsgd_crc32.tsf Normal file
View File

@ -0,0 +1,89 @@
Function getmsgd_Crc32(s);
Begin
{**
@explan(说明) 获得字符串的信息指纹%%
@param(s)(string) 字符串 %%
@return(string) 8位长度的信息指纹%%
**}
{$ifdef linux}
G_CRC32TABLE:=array(
0x00000000, 0x77073096, 0xEE0E612C, 0x990951BA,
0x076DC419, 0x706AF48F, 0xE963A535, 0x9E6495A3,
0x0EDB8832, 0x79DCB8A4, 0xE0D5E91E, 0x97D2D988,
0x09B64C2B, 0x7EB17CBD, 0xE7B82D07, 0x90BF1D91,
0x1DB71064, 0x6AB020F2, 0xF3B97148, 0x84BE41DE,
0x1ADAD47D, 0x6DDDE4EB, 0xF4D4B551, 0x83D385C7,
0x136C9856, 0x646BA8C0, 0xFD62F97A, 0x8A65C9EC,
0x14015C4F, 0x63066CD9, 0xFA0F3D63, 0x8D080DF5,
0x3B6E20C8, 0x4C69105E, 0xD56041E4, 0xA2677172,
0x3C03E4D1, 0x4B04D447, 0xD20D85FD, 0xA50AB56B,
0x35B5A8FA, 0x42B2986C, 0xDBBBC9D6, 0xACBCF940,
0x32D86CE3, 0x45DF5C75, 0xDCD60DCF, 0xABD13D59,
0x26D930AC, 0x51DE003A, 0xC8D75180, 0xBFD06116,
0x21B4F4B5, 0x56B3C423, 0xCFBA9599, 0xB8BDA50F,
0x2802B89E, 0x5F058808, 0xC60CD9B2, 0xB10BE924,
0x2F6F7C87, 0x58684C11, 0xC1611DAB, 0xB6662D3D,
0x76DC4190, 0x01DB7106, 0x98D220BC, 0xEFD5102A,
0x71B18589, 0x06B6B51F, 0x9FBFE4A5, 0xE8B8D433,
0x7807C9A2, 0x0F00F934, 0x9609A88E, 0xE10E9818,
0x7F6A0DBB, 0x086D3D2D, 0x91646C97, 0xE6635C01,
0x6B6B51F4, 0x1C6C6162, 0x856530D8, 0xF262004E,
0x6C0695ED, 0x1B01A57B, 0x8208F4C1, 0xF50FC457,
0x65B0D9C6, 0x12B7E950, 0x8BBEB8EA, 0xFCB9887C,
0x62DD1DDF, 0x15DA2D49, 0x8CD37CF3, 0xFBD44C65,
0x4DB26158, 0x3AB551CE, 0xA3BC0074, 0xD4BB30E2,
0x4ADFA541, 0x3DD895D7, 0xA4D1C46D, 0xD3D6F4FB,
0x4369E96A, 0x346ED9FC, 0xAD678846, 0xDA60B8D0,
0x44042D73, 0x33031DE5, 0xAA0A4C5F, 0xDD0D7CC9,
0x5005713C, 0x270241AA, 0xBE0B1010, 0xC90C2086,
0x5768B525, 0x206F85B3, 0xB966D409, 0xCE61E49F,
0x5EDEF90E, 0x29D9C998, 0xB0D09822, 0xC7D7A8B4,
0x59B33D17, 0x2EB40D81, 0xB7BD5C3B, 0xC0BA6CAD,
0xEDB88320, 0x9ABFB3B6, 0x03B6E20C, 0x74B1D29A,
0xEAD54739, 0x9DD277AF, 0x04DB2615, 0x73DC1683,
0xE3630B12, 0x94643B84, 0x0D6D6A3E, 0x7A6A5AA8,
0xE40ECF0B, 0x9309FF9D, 0x0A00AE27, 0x7D079EB1,
0xF00F9344, 0x8708A3D2, 0x1E01F268, 0x6906C2FE,
0xF762575D, 0x806567CB, 0x196C3671, 0x6E6B06E7,
0xFED41B76, 0x89D32BE0, 0x10DA7A5A, 0x67DD4ACC,
0xF9B9DF6F, 0x8EBEEFF9, 0x17B7BE43, 0x60B08ED5,
0xD6D6A3E8, 0xA1D1937E, 0x38D8C2C4, 0x4FDFF252,
0xD1BB67F1, 0xA6BC5767, 0x3FB506DD, 0x48B2364B,
0xD80D2BDA, 0xAF0A1B4C, 0x36034AF6, 0x41047A60,
0xDF60EFC3, 0xA867DF55, 0x316E8EEF, 0x4669BE79,
0xCB61B38C, 0xBC66831A, 0x256FD2A0, 0x5268E236,
0xCC0C7795, 0xBB0B4703, 0x220216B9, 0x5505262F,
0xC5BA3BBE, 0xB2BD0B28, 0x2BB45A92, 0x5CB36A04,
0xC2D7FFA7, 0xB5D0CF31, 0x2CD99E8B, 0x5BDEAE1D,
0x9B64C2B0, 0xEC63F226, 0x756AA39C, 0x026D930A,
0x9C0906A9, 0xEB0E363F, 0x72076785, 0x05005713,
0x95BF4A82, 0xE2B87A14, 0x7BB12BAE, 0x0CB61B38,
0x92D28E9B, 0xE5D5BE0D, 0x7CDCEFB7, 0x0BDBDF21,
0x86D3D2D4, 0xF1D4E242, 0x68DDB3F8, 0x1FDA836E,
0x81BE16CD, 0xF6B9265B, 0x6FB077E1, 0x18B74777,
0x88085AE6, 0xFF0F6A70, 0x66063BCA, 0x11010B5C,
0x8F659EFF, 0xF862AE69, 0x616BFFD3, 0x166CCF45,
0xA00AE278, 0xD70DD2EE, 0x4E048354, 0x3903B3C2,
0xA7672661, 0xD06016F7, 0x4969474D, 0x3E6E77DB,
0xAED16A4A, 0xD9D65ADC, 0x40DF0B66, 0x37D83BF0,
0xA9BCAE53, 0xDEBB9EC5, 0x47B2CF7F, 0x30B5FFE9,
0xBDBDF21C, 0xCABAC28A, 0x53B39330, 0x24B4A3A6,
0xBAD03605, 0xCDD70693, 0x54DE5729, 0x23D967BF,
0xB3667A2E, 0xC4614AB8, 0x5D681B02, 0x2A6F2B94,
0xB40BBE37, 0xC30C8EA1, 0x5A05DF1B, 0x2D02EF8D);
result :=0xFFFFFFFF;
bs := binary(s);
for i:=0 to length(bs)-1 do
begin
ebx:=G_CRC32TABLE[(result .& 0xff) .^ord(bs[i]) ];
result shr=8;
result .^= ebx;
end;
result:=_not(result);
return inttohex(result,8);
{$endif}
return GetMsgDigest(s,0);
End;

11
funcext/tvclib/iofileseparator.tsf Normal file
View File

@ -0,0 +1,11 @@
function iofileseparator();
begin
{**
@explan(说明) 返回文件系统的目录分割符 %%
@return(string) linux 下/ windows下\
**}
{$ifdef linux}
return '/';
{$endif}
return '\\';
end

626
funcext/tvclib/tcomponent.tsf Normal file
View File

@ -0,0 +1,626 @@
type tcomponent = class(TSLUIBASE)
uses utslvclauxiliary,utslvclbase;
{**
@explan(说明) 可视化组件基类 %%
@date(20220505) 分离tcomponent基类
**}
private
{**
@param(FOwner)(tcomponent) 所有者 %%
@param(FComponents)( TFpList ) 子项 %%
@param(FComponentState)( array of integer) 节点状态 %%
@param(FComponentStyle)( array of integer) 节点样式 %%
@param(FFreeNotifies)( TFpList) 销毁通知节点 %%
**}
FOwner;
FName;
FComponents;
FFreeNotifies: TFpList;
FComponentState;
FComponentStyle;
FComponentCreated;
FLoader;
function ComponentGetParent();virtual;
begin
end
function ComponentSetParent();virtual;
begin
end
#!begin //private methods
function GetLoader();
begin
global G_T_TTFM2COMPONET_;
if not G_T_TTFM2COMPONET_ then return 0;
if not FLoader then FLoader := createobject(G_T_TTFM2COMPONET_);
return FLoader;
end
function GetPropInfo();
begin
o := self(true);
r := getPropInfo2(o);
ret := array();
ii := 0;
for i,v in r do
begin
ret[ii++]:= v;
end
return select * from ret order by["name"] end;
end
static FClassDigestB;
class function GetClassDigestB(idx,d);
begin
if not ifarray(FClassDigestB)then FClassDigestB := array();
if ifnil(d)then return FClassDigestB[idx];
else FClassDigestB[idx]:= d;
end
function getPropInfo2(o);
begin
if not(o is class(tcomponent))then return array();
t := o.classinfo;
idx := getmsgd_Crc32(tostm(t))+"&&";
r := GetClassDigestB(idx);
if ifarray(r)then return r;
r := array();
hs := t["inherited"];
for i,v in hs do
begin
r union=static call(thisfunction,findclass(v,o))name v+"&&_&&";
end
for i,v in t["properties"] do
begin
n := v["name"];
if((v["access"]in array(2,3))or(not(v["read"])))or not(v["type"])then
begin
deleteindex(r,n);
continue;
end
if v["read"]and v["type"]then
begin
r union=array(n:v[array("name","type","write","parser")]);
end
end
for i,v in t["members"] do
begin
n := v["name"];
if(v["access"]in array(2,3))or not(v["type"])then
begin
deleteindex(r,n);
continue;
end
tr := v[array("name","type","write","parser")];
tr["write"]:= true;
r union=array(n:tr);
end
GetClassDigestB(idx,r);
return r;
end
function GetComponent(AIndex);
begin
{**
@explan(说明) 获取子节点 %%
@param(AIndex)( integer ) 子项序号 %%
**}
return FComponents.geti(AIndex);
end
function SetComponentState(v);
begin
if ifarray(v)then FComponentState := v;
end
function GetComponentCount();
begin
{**
@explan(说明) 获取子节数量%%
@return(AIndex)( integer ) 数量 %%
**}
return FComponents.count();
end
function GetComponentIndex();
begin
{**
@explan(说明) 获取子节序号%%
@return(AIndex)( integer ) 子项序号 %%
**}
if FOwner is class(tcomponent)then
begin
return FOwner.Components.findvid(self);
end
return-1;
end
procedure Insert(AComponent:TComponent); //此处需要修改
begin
{**
@explan(说明)添加子节点 %%
**}
FComponents.Add(AComponent);
AComponent.FOwner := Self(true);
end
procedure Remove(AComponent:TComponent);
begin
{**
@explan(说明)移除子节点 %%
**}
if FComponents.Remove(AComponent)>0 then
begin
AComponent.FOwner := Nil;
return true;
end
return false;
end;
procedure RemoveNotification(AComponent:TComponent);
begin
FFreeNotifies.Remove(AComponent);
if FFreeNotifies.count()<1 then includestate(FComponentState,csFreeNotification);
end
#!end
protected
#!begin //protected methods
function SetName(v);virtual;
begin
if ifstring(v)and length(v)>1 and v <> FName then
begin
if isKeyWords(v)then return;
nv := lowercase(v);
if new TCharDiscrimi().IsVariableName(v)then
begin
r := RootOwner().FindComponentByName(nv);
if not r then
begin
FName := nv;
end
end
end
end
Procedure SetAncestor(Value:Boolean);
begin
If Value then includestate(FComponentState,csAncestor)else excludestate(FCOmponentState,csAncestor);
For Runner := 0 To FComponents.Count-1 do
begin
FComponents.geti(Runner).SetAncestor(Value);
end
end;
function ValidateContainer(AComponent:TComponent);virtual;
begin
if AComponent is class(tcomponent)then return AComponent.ValidateInsert(Self);
end
function ValidateInsert(AComponent:TComponent);virtual;
begin
return true;
end
public
function ExecuteCommand(cmd,p);virtual;
begin
end
Procedure Notification(AComponent,Operation);virtual;
begin
{**
@explan(说明) 通知处理 %%
@param(AComponent)(tcomponent) 改变的对象 %%
@param(Operation)(member of TOperation) 通知码 %%
**}
If(Operation=opRemove)then
begin
RemoveFreeNotification(AComponent);
end
data := FComponents.data();
C := length(data)-1;
While(C >= 0) do
begin
data[c].Notification(AComponent,Operation);
c--;
end;
end;
private
Procedure SetDesignInstance(Value);
begin
If Value then
includestate(FComponentState,csDesignInstance)
else
excludestate(FComponentState,csDesignInstance);
end;
public
procedure RemoveFreeNotification(AComponent:TComponent);
begin
RemoveNotification(AComponent);
AComponent.RemoveNotification(self);
end;
Procedure SetDesigning(Value,SetChildren);virtual;
begin
{**
@explan(说明) 设计器使用方法,设置为设计状态,或者解除设置状态 %%
@param(Value)(bool) 状态值 %%
@param(SetChildren)(bool) 是否修改子控件状态 %%
**}
if ifnil(SetChildren)then SetChildren := true;
If Value then
includestate(FComponentState,csDesigning);
else
excludestate(FComponentState,csDesigning);
if SetChildren then
begin
items := FComponents.data;
For Runner := 0 To length(items)-1 do
begin
items[Runner].SetDesigning(Value);
end
end
end;
protected
function SetParentComponent(Value);virtual;
begin
end
function GetChildren();virtual;
begin
end
procedure Updating;virtual;
begin
includestate(FComponentState,csUpdating);
end
procedure Updated;virtual;
begin
excludestate(FComponentState,csUpdating);
end
#!end
public
#!begin //public methods
function create(AOwner);virtual;
begin
class(TSLUIBASE).create();
FComponents := NEW TFpList();
FFreeNotifies := NEW TFpList();
FComponentStyle := array(csInheritable);
FComponentstate := array();
SetOwner(AOwner);
FEventsProperties := array();
FVariableProperties := array();
FComponentCreated := true;
return;
If AOwner is class(tcomponent)then
begin
FOwner := AOwner;
AOwner.InsertComponent(Self);
end
end
function RootOwner();
begin
if not(FOwner is class(TComponent))then return self(true);
return FOwner.RootOwner();
end
function FindComponentByName(n);
begin
if n and n=FName then return self(true);
cps := Components;
for i := 0 to cps.Count-1 do
begin
r := cps[i].FindComponentByName(n);
if r then return r;
end
return false;
end
function isDescendant(cd);
begin
{**
@explan(说明) 判断节点是否为其子节点 %%
@param(cd)(tcomponent) 等判断节点 %%
@return(bool) true 为子节点 false 非子节点 %%
**}
if cd=self then return true;
for i := 0 to FComponents.count()-1 do
begin
if FComponents[i].isDescendant(cd)then return true;
end
return false;
end
function SetOwner(AOwner);
begin
{**
@explan(说明) 设置所有者,注意只能成功设置一次,之后设置无效 %%
@param(AOwner)(tcomponent) 所有者 %%
**}
if ifnil(FOwner)and(AOwner is class(tcomponent))then
begin
if isDescendant(AOwner)then exit;
FOwner := AOwner;
AOwner.InsertComponent(self(true));
end
end
function Recycling();override;
begin
if not FComponentCreated then exit;
Destroying();
DestroyComponents();
If FOwner is class(tcomponent)Then FOwner.RemoveComponent(Self);
inherited;
end
function Destroy();virtual;
begin
inherited;
end;
function Destroying();
begin
If csDestroying in FComponentstate Then Exit;
includestate(FComponentState,csDestroying);
if not FCOmponents then exit;
data := FCOmponents.data();
for i,v in data do v.Destroying();
end;
function ExecuteAction(act:TBasicAction):Boolean;virtual;
begin
{**
@explan(说明)执行action %%
**}
if act.HandlesTarget(Self)then
begin
act.ExecuteTarget(Self);
return True;
end else
return False;
end
function UpdateAction(act:TBasicAction):Boolean;virtual;
begin
{**
@explan(说明) 更新action %%
**}
if act.HandlesTarget(Self)then
begin
act.UpdateTarget(Self);
return True;
end else
return False;
end
function DestroyComponents();
begin
{**
@explan(说明)删除子项 %%
**}
if not FComponents then exit;
FName := nil;
data := FComponents.data();
FComponents.clean();
for i,Acomponent in data do
begin
Acomponent.Recycling();
end
end;
Procedure FreeNotification(AComponent:TComponent);
begin
{**
@explan(说明) 关联对象,在释放的时候相互通知 %%
@param(AComponent)(TComponent) 对象 %%
**}
if not(AComponent is class(tcomponent))then exit;
If(Owner <> Nil)and(AComponent=Owner)then exit;
If FFreeNotifies.IndexOf(AComponent)=-1 then
begin
FFreeNotifies.Add(AComponent);
AComponent.FreeNotification(self(true)); //添加当前的
end;
end;
//function GetParentComponent(); virtual;begin end
//function HasParent(); virtual;begin end
function InsertComponent(AComponent);virtual;
begin
{**
@explan(说明)插入节点 %%
**}
if AComponent.ValidateContainer(Self)then
begin
self.Insert(AComponent);
If csDesigning in FComponentState then AComponent.SetDesigning(true);
Notification(AComponent,opInsert);
end
end;
Procedure RemoveComponent(AComponent);
begin
{**
@explan(说明)移除子节点 %%
**}
Notification(AComponent,opRemove);
if Remove(AComponent)then Acomponent.Setdesigning(False);
end;
function Assigned(o);virtual;
begin
return ifobj(o);
end
#!end
private
FEventsProperties;
FChangedProperties;
FVariableProperties;
function GetPublishInfo();
begin
r := publishs();
rr := array();
ri := 0;
for i,v in r do
begin
if ifstring(v) then rr[ri++] := lowercase(v);
end
return rr;
end
function OrderPublish(r,od); //排序发布的东西
begin
if od then
begin
r1 := array();
for i,v in od do
begin
vi := r[v];
if vi then r1[v]:= vi;
end
r := r1;
end
end
public
function publishs();virtual;
begin
//return array("currentcolor","lazyitems","range","firstdayofweek","align","mbbtnstyle","textalign","text","imagelist","canvs","images","items","bkbitmap","icon","popupmenu","mainmenu","cursor","height","width","left","top","enabled","visible","caption","color","font","onclick","rootfolder","initialdir");
end
function GetPublishproperties();virtual;
begin
{**
@explan(说明) 获得properties,设计器使用%%
**}
ps := GetPropInfo();
r := array();
pps := GetPublishInfo();
for i,v in ps do
begin
typ := v["type"];
if typ="eventhandler" then continue;
otype := GetPropertyType(typ);
if otype then
begin
n := v["name"];
if pps and not(n in pps)then continue;
if typ in array("variable","popupmenu","syscursor","tmainmenu")then
begin
r[n]:= otype.FormatEdit(FVariableProperties[n],v["write"]?true:false);
end else
r[n]:= otype.FormatEdit(invoke(self(true),n),v["write"]?true:false);
end
end
//次序处理
////////////////////
OrderPublish(r,pps);
////////////////////
return r;
end
function GetPublishEvents();virtual;
begin
{**
@explan(说明) 获得event值,设计器使用 %%
@return(array)
**}
ps := GetPropInfo();
r := array();
pps := GetPublishInfo();
for i,v in ps do
begin
typ := v["type"];
if typ <> "eventhandler" then continue;
otype := GetPropertyType(typ);
if otype then
begin
n := v["name"];
if pps and not(n in pps)then continue;
ne := FEventsProperties[n];
r[n]:= otype.FormatEdit(ne,v["write"]?true:false);
end
end
OrderPublish(r,pps);
return r;
end
function GetChangedPropertiesn(n);virtual;
begin
return FChangedProperties[n];
end
function GetChangedPublish();virtual;
begin
{**
@explan(说明)获取修改过的publish,设计器使用 %%
**}
r := array();
if not FChangedProperties then return r;
ps := GetPropInfo();
for i,vi in ps do
begin
n := vi["name"];
vv := FChangedProperties[n];
if ifnil(vv)then continue;
vit := vi["type"];
otype := GetPropertyType(vit);
if vi["write"]and otype then
begin
r[n]:= otype.FormatTMF(vv);
end
end
return r;
end
function SetChangedPublish(n,v);virtual;
begin
{**
@explan(说明) 设计器相关函数 %%
**}
if not ifarray(FChangedProperties)then FChangedProperties := array();
//reindex(FChangedProperties,array(n:nil));
FChangedProperties[n]:= v;
end
function DeleteChangedPublish(n);virtual;
begin
if n and ifstring(n)then
begin
if not ifarray(FChangedProperties)then FChangedProperties := array();
reindex(FChangedProperties,array(n:nil));
end
end
function SetPublish(n,v);virtual;
begin
{**
@explan(说明) 修改单个值,设计器使用 %%
@param(n)(string) 名称 %%
@param(v)(any) 值 %%
**}
ps := GetPropInfo();
for i,vi in ps do //获取信息
begin
if n=vi["name"]then
begin
vit := vi["type"];
otype := GetPropertyType(vit); //获得转换对象
if ifobj(otype)then
begin
iv := otype.UnformatEdit(v); //反转换
SetChangedPublish(n,iv); //保存
if vit="eventhandler" then //分类保存
begin
FEventsProperties[n]:= iv;
end else
begin
if vit in array("variable","popupmenu","syscursor","tmainmenu")then //分类保存
begin
FVariableProperties[n]:= iv;
if vit="tmainmenu" then
begin
try
invoke(self(true),n,1,iv);
except
return false;
end;
end
end else
//if not ifnil(iv) then //设置到设计控件
begin
try
//if n="visible" and (not((self(true) is class(tform)) and (self(true) is class(tpanelform)))) then
//else
invoke(self(true),n,1,iv);
except
return false;
end;
end
end
end
return true;
end
end
end
property Owner:tcomponent read FOwner;
{**
@param(Owner)(tcomponent) 所有者 %%
@param(ComponentState)() 状态集合 %%
@param(ComponentStyle)() 样式结合 %%
@param(ComponentCreated)(bool) 样式结合 %%
**}
//property DesignInfo read FDesignInfo write FDesignInfo;
property ComponentCreated read FComponentCreated;
property Components read FComponents;
property ComponentState read FComponentState write SetComponentState;
property ComponentStyle read FComponentStyle;
property Name:string read FName write SetName;
property Parent read ComponentGetParent write ComponentSetParent;
property Loader read GetLoader;
end

1540
funcext/tvclib/tcontrol.tsf Normal file
View File

File diff suppressed because it is too large Load Diff

61
funcext/tvclib/tcustomcontrol.tsf Normal file
View File

@ -0,0 +1,61 @@
type tcustomcontrol=class(TWinControl)
uses utslvclauxiliary;
{**
@explan(说明) 自绘制窗口控件 %%
**}
private
FOnPaint:TNotifyEvent;
protected
procedure PaintWindow(DC:HDC);override;
begin
//odh := canvas.Handle;
Canvas.Handle := dc;
Canvas.ClipRect := PAINTSTRUCT().rcpaint();
try
Paint();
finally
Canvas.Handle := odh;
end;
end
procedure Paint();override;
begin
inherited;
if datatype(FOnPaint)=7 then call(FOnPaint,self(true));
end
public
function Create(AOwner:TComponent);override;
begin
inherited;
includestate(FControlState,csCustomPaint);
//FCanvas := new tcanvas();
end
function CreateParams(p);override;
begin
inherited;
//p.style .|= WS_CLIPSIBLINGS .| WS_CLIPCHILDREN;
end
function Recycling();override;
begin
FOnPaint := nil;
inherited;
end
function DoVScroll(o,e);virtual;
begin
end
function DoHScroll(o,e);virtual;
begin
end
public
function WMVScroll(o,e):LM_VScroll;virtual;
begin
return DoVScroll(o,e);
end
function WMHScroll(o,e):LM_HSCROLL;virtual;
begin
return DoHScroll(o,e);
end
property OnPaint:eventhandler read FOnPaint write FOnPaint;
{**
@param(OnPaint)(function[TCustomControl,tuieventbase]) 窗口关闭消息回调 %%
**}
end;

375
funcext/tvclib/tcustomscrollcontrol.tsf Normal file
View File

@ -0,0 +1,375 @@
type tcustomscrollcontrol = class(TCustomControl)
uses utslvclmemstruct;
{**
@explan(说明) 带滚动条的自绘制窗口 %%
**}
private
FLocalX;//水平基准
FLocalXold;
FLocalY;//垂直基准
FLocalYold;
FSI; //滚动条结构
FAutoScroll; //自动滚动条
FThumbTrack; //thunmtrack
FWhileStep ;//滚动步长
function SetAutoScroll(v);
begin
if(v in array(0,1,2,3))and v <> FAutoScroll then
begin
FAutoScroll := v;
InitialScroll();
end
end
function SetWhileStep(v);
begin
if not v>=1 then return ;
nv := integer(v);
if FWhileStep=nv then return ;
FWhileStep := nv;
end
protected
function GetXScrollDelta();virtual; //x间隔
begin
{**
@explan(说明) 获得x间隔 %%
**}
return 10;
end
function GetYScrollDelta();virtual; //y 间隔
begin
{**
@explan(说明) 获得y间隔 %%
**}
return 10;
end
function GetClientXCapacity();virtual; //宽度容量
begin
{**
@explan(说明) 客户区x容量 %%
**}
return 0;
end
function GetClientYCapacity();virtual; //高度容量
begin
{**
@explan(说明) 客户区y容量 %%
**}
return 0; //integer((yClient) / FDeltaY);
end
function GetClientXCount();virtual; //宽度间隔
begin
{**
@explan(说明) 客户区x数量 %%
**}
return 0;
end
function GetClientYCount();virtual; //高度项
begin
{**
@explan(说明) 客户区y数量 %%
**}
return 0;
end
function PositionChanged();virtual; //基准点改变
begin
{**
@explan(说明) 基准点改变回调 %%
**}
end
function GetDeltaXpos();virtual; //水平变化
begin
r := FLocalX-FLocalXold;
FLocalXold := FLocalX;
return r;
end
function GetDeltaYpos();virtual; //垂直变化
begin
r := FLocalY-FLocalYold;
FLocalYold := FLocalY;
return r;
end
function GetXPos();virtual;
begin
return FLocalX;
end
function GetYPos();virtual;
begin
return FLocalY;
end
function SetXpos(x);virtual;
begin
nx := integer(x);
if not HandleAllocated()then return FLocalX := nx;
if nx <> FLocalX then
begin
hwnd := Handle;
FSI.fMask := SIF_POS; //SIF_ALL;
_wapi.GetScrollInfo(hwnd,SB_HORZ,FSI._getptr_);
ypos := FSI.nPos;
hwnd := Handle;
FSI.fMask := SIF_POS;
FSI.nPos := nx;
_wapi.SetScrollInfo(hwnd,SB_HORZ,FSI._getptr_,TRUE);
// 获得滚动条滑块的位置，由于窗口调整，它可能不是同一个值
_wapi.GetScrollInfo(hwnd,SB_HORZ,FSI._getptr_);
if FSI.nPos <> ypos then
begin
FLocalXold := FLocalX;
FLocalX := FSI.nPos;
PositionChanged();
end
end
end
function SetYpos(y);virtual;
begin
nx := integer(y);
if not HandleAllocated()then return FLocalY := nx;
if nx <> FLocalY then
begin
hwnd := Handle;
FSI.fMask := SIF_POS; //SIF_ALL;
_wapi.GetScrollInfo(hwnd,SB_VERT,FSI._getptr_);
ypos := FSI.nPos;
FSI.nPos := nx;
FSI.fMask := SIF_POS;
_wapi.SetScrollInfo(hwnd,SB_VERT,FSI._getptr_,TRUE);
// 获得滚动条滑块的位置，由于窗口调整，它可能不是同一个值
_wapi.GetScrollInfo(hwnd,SB_VERT,FSI._getptr_);
if FSI.nPos <> ypos then
begin
FLocalYold := FLocalY;
FLocalY := FSI.nPos;
PositionChanged();
end
end
end
function InitialScroll();virtual;
begin
if not HandleAllocated()then return;
hwnd := Handle;
// 设置垂直滚动条范围和页面大小（设置页面大小将决定滑块的粗细）
FSI.fMask := SIF_POS .| SIF_RANGE .| SIF_PAGE;
FSI.nMin := 0;
FSI.nPos := FLocalY; //20200709
FSI.nMax :=(FAutoScroll .& 1)?(GetClientYCount()):0;
FSI.nPage := GetClientYCapacity();
_wapi.SetScrollInfo(hwnd,SB_VERT,FSI._getptr_,true);
{if FSI.nMax>FSI.nPage then
begin
FLocalYold := FLocalY;
FLocalY := 0;
end else
begin }
FSI.fMask := SIF_POS;
_wapi.GetScrollInfo(hwnd,SB_VERT,FSI._getptr_);
FLocalYold := FLocalY;
FLocalY := FSI.nPos;
//end
// 设置水平滚动条范围和页面大小（设置页面大小将决定滑块的粗细）
FSI.cbSize := FSI._size_;
FSI.fMask := SIF_RANGE .| SIF_PAGE .| SIF_POS;
FSI.nMin := 0;
FSI.nPos := FLocalX;
FSI.nMax :=(FAutoScroll .& 2)?(GetClientXCount()):0;
FSI.nPage := GetClientXCapacity();
_wapi.SetScrollInfo(hwnd,SB_HORZ,FSI._getptr_,TRUE);
{if FSI.nMax>FSI.nPage then
begin
FLocalXold := FLocalX;
FLocalX := 0;
end else
begin }
FSI.fMask := SIF_POS;
_wapi.GetScrollInfo(hwnd,SB_HORZ,FSI._getptr_);
FLocalXold := FLocalX;
FLocalX := FSI.nPos;
//end
PositionChanged();
end
function DoVScroll(o,e);override;
begin
// 获得垂直滚动条的所有信息
if csDesigning in ComponentState then return;
FSI.fMask := SIF_ALL;
hwnd := e.hwnd;
_wapi.GetScrollInfo(hwnd,SB_VERT,FSI._getptr_);
// 保存当前滑块位置，迟些进行比较
yPos := FSI.nPos;
case e.lowparam of
// 用户点击键盘 Home 按键
SB_TOP:
begin
FSI.nPos := FSI.nMin;
end
// 用户点击键盘 End 按键
SB_BOTTOM:
begin
FSI.nPos := FSI.nMax;
end
// 用户点击滚动条上边的三角形
SB_LINEUP:
begin
FSI.nPos -= 1;
end
// 用户点击滚动条下边的三角形
SB_LINEDOWN:
begin
FSI.nPos += 1;
end
// 用户点击滑块上边的滚动条轴
SB_PAGEUP:
begin
//return ;
FSI.nPos -= FSI.nPage;
end
// 用户点击滑块下边的滚动条轴
SB_PAGEDOWN:
begin
//return ;
FSI.nPos += FSI.nPage;
end
// 用户拖动滚动条
SB_THUMBTRACK:
begin
if ThumbTrack then
begin
FSI.nPos := FSI.nTrackPos;
end
end
SB_THUMBPOSITION:
begin
FSI.nPos := FSI.nTrackPos;
end
end
// 设置滚动条滑块的新位置
if FSI.nPos=yPos then return;
return SetYpos(FSI.nPos);
FSI.fMask := SIF_POS;
_wapi.SetScrollInfo(hwnd,SB_VERT,FSI._getptr_,TRUE);
// 获得滚动条滑块的位置，由于窗口调整，它可能不是同一个值
_wapi.GetScrollInfo(hwnd,SB_VERT,FSI._getptr_);
// 与此前的保存的值进行比较，如果不同则滚动窗口
FLocalY := FSI.nPos;
if(FSI.nPos <> yPos)then
begin
PositionChanged();
end
return 0;
end
function DoHScroll(o,e);override;
begin
if csDesigning in ComponentState then return;
FSI.fMask := SIF_ALL;
_wapi.GetScrollInfo(e.hwnd,SB_HORZ,FSI._getptr_);
// 保存当前滑块位置，迟些进行比较
xPos := FSI.nPos;
case e.lowparam of
// 用户点击滚动条左边的三角形
SB_LEFT:
begin
FSI.nPos := FSI.nMin;
end
SB_RIGHT:
begin
FSI.nPos := FSI.nMax;
end
SB_LINELEFT:
begin
FSI.nPos -= 1;
end
// 用户点击滚动条右边的三角形
SB_LINERIGHT:
begin
FSI.nPos += 1;
end
// 用户点击滑块左边的滚动条轴
SB_PAGELEFT:
begin
FSI.nPos -= FSI.nPage;
end
// 用户点击滑块右边的滚动条轴
SB_PAGERIGHT:
begin
FSI.nPos += FSI.nPage;
end
// 用户拖动滚动条
SB_THUMBTRACK:
begin
if ThumbTrack then
begin
FSI.nPos := FSI.nTrackPos;
end
end
SB_THUMBPOSITION:
begin
//return ;
FSI.nPos := FSI.nTrackPos;
end
end;
if FSI.nPos=xPos then return;
return SetXpos(FSI.nPos);
// 设置滚动条滑块的新位置
FSI.fMask := SIF_POS;
_wapi.SetScrollInfo(e.hwnd,SB_HORZ,FSI._getptr_,TRUE);
// 获得滚动条滑块的位置，由于窗口调整，它可能不是同一个值
_wapi.GetScrollInfo(e.hwnd,SB_HORZ,FSI._getptr_);
// 与此前的保存的值进行比较，如果不同则滚动窗口
FLocalX := FLocalX;
FLocalX := FSI.nPos;
if(FSI.nPos <> xPos)then
begin
PositionChanged();
end
end
function DoMouseWheel(o,e);override;
begin
if csDesigning in ComponentState then return;
hwnd := self.Handle;
FSI.fMask := SIF_ALL;
_wapi.GetScrollInfo(hwnd,SB_VERT,FSI._getptr_);
// 保存当前滑块位置，迟些进行比较
yPos := FSI.nPos;
dd := 0;
if e.delta<0 and FSI.nMax>yPos then
begin
//dd++;
dd += FWhileStep;
end
if e.delta>0 and FSI.nMin<yPos then
begin
//dd--;
dd -= FWhileStep;
end
if not dd then return;
FSI.fMask := SIF_POS;
FSI.nPos := yPos+dd;
_wapi.SetScrollInfo(hwnd,SB_VERT,FSI._getptr_,TRUE);
// 获得滚动条滑块的位置，由于窗口调整，它可能不是同一个值
_wapi.GetScrollInfo(hwnd,SB_VERT,FSI._getptr_);
dd := yPos-FSI.nPos;
FLocalYold := FLocalY;
FLocalY := FSI.nPos;
if dd then
begin
PositionChanged();
end
end
public
function Create(AOwner);override;
begin
FWhileStep := 3;
inherited;
FLocalX := 0;
FLocalY := 0;
FLocalXold := 0;
FLocalYold := 0;
FAutoScroll := 0;
FSI := new TScrollinfo();
FSI.cbSize := FSI._size_;
end
property AutoScroll read FAutoScroll write SetAutoScroll;
property ThumbTrack read FThumbTrack write FThumbTrack;
property WhileStep read FWhileStep write SetWhileStep; //滚动步长
end

2
funcext/tvclib/tgdiplusflat.tsf
View File

@ -214,7 +214,7 @@ type TGdiplusflat=class
hd := gdk_pixbuf_new_from_file(p,0);
if hd then r := 0;
else return -1;
np := unit(tslvcl).getmsgd_Crc32(p);
np := getmsgd_Crc32(p);
nnp := "/tmp/tinysoft/tslvcl/"+np[1]+"/"+np[2]+"/"+np+".png";
imageref(hd);
SetImageProperty(hd,"file",nnp);

177
funcext/tvclib/tgraphiccontrol.tsf Normal file
View File

@ -0,0 +1,177 @@
type tgraphiccontrol = class(TControl)
uses utslvclauxiliary,utslvclgdi;
{**
@explan(说明) 自绘制控件 %%
**}
private
//FCanvas: TCanvas;
FOnPaint:TNotifyEvent;
protected
procedure ChangeBounds(ALeft,ATop,AWidth,AHeight:integer;KeepBase:boolean);override; //type_tcontrol
begin
rect1 := array(FLeft,FTop,FLeft+FWidth,FTop+FHeight);
rect2 := array(ALeft,ATop,ALeft+AWidth,ATop+AHeight);
inherited;
if rect1 <> rect2 then
begin
if Parent then
begin
//Parent.InvalidateRect(nil,false);
Parent.InvalidateRect(rect1,false);
Parent.InvalidateRect(rect2,false);
//Parent.updateWindow();
end
end
end
function RealSetText(s);override;
begin
{**
@explan(说明) 修改标题 %%
**}
if ifstring(s)and caption <> s then
begin
inherited;
InvalidateRect(rec,true);
end
end
procedure Paint();virtual;
begin
{**
@explan(说明)控件绘制调用 ,使用Canvas属性和PAINTSTRUCT结构体 绘制控件 %%
**}
if(datatype(FOnPaint)<> 7)or(not call(FOnPaint,self(true)))then
begin
canvas.Font := font;
Canvas.DrawText(self.caption,self.ClientRect,DT_VCENTER .| DT_SINGLELINE .| DT_CENTER .| DT_NOPREFIX);
end
//_wapi.DrawFrameControl(Canvas.handle,const ClientRect,DFC_BUTTON,DFCS_BUTTONCHECK);
//_wapi.DrawEdge(Canvas.handle,const ClientRect,EDGE_ETCHED,BF_RECT);
//_wapi.DrawFocusRect(Canvas.Handle,const ClientRect);
end
procedure DoOnChangeBounds();override;
begin
end
procedure DoOnParentHandleDestruction;override;
begin
end
function InvalidateRectForce();
begin
if Parent then
begin
nrec := array(FLeft,FTop,FLeft+FWidth,FTop+FHeight);
//return Parent.InvalidateRect(nrec,true);
return Parent.InvalidateRect(nrec,false);
end
end
public
procedure SetVisible(Value);virtual;
begin
nv := Value?true:false;
if nv <> Visible then
begin
inherited;
InvalidateRectForce();
end
end
function InvalidateRect(rec,f);
begin
{**
@explan(说明)设置窗口区域无效 %%
@param(rec)(array) 无效区域,nil表示窗口整体无效,array(左上右下) %%
@param(f)(bool) 是否重画 %%
**}
if Visible {and Parent}then
begin
if not ifarray(rec)then return InvalidateRectForce();
nrec := array(FLeft+rec[0],FTop+rec[1],FLeft+rec[2],FTop+rec[3]);
return Parent.InvalidateRect(nrec,false);
end
end
function WMPaint(o,Message:TLMPaint):LM_PAINT;override;
begin
//if csCustomPaint in ControlState then if Message.lparam<>2 then return ;
dc := Message.wparam;
if dc then
begin
//_wapi.ReleaseDC(Canvas.Handle);
//odh := canvas.Handle;
Canvas.Handle := dc;
try
_wapi.SetViewportOrgEx(dc,FLeft,FTop,nil);
//_send_(WM_ERASEBKGND,dc,1,1);
//Perform(new tuieventbase(WM_ERASEBKGND,dc,1));
//Perform(messagecreater(nil,WM_ERASEBKGND,dc,1));
WMERASEBKGND(self(true),messagecreater(nil,WM_ERASEBKGND,dc,2));
Canvas.SaveDC();
Paint();
Canvas.RestoreDC();
//Canvas.
finally
Canvas.Handle := odh;
end;
//Canvas.Handle := _wapi.GetDC(self.Handle);
end
end
function WMERASEBKGND(o,e):WM_ERASEBKGND;override;
begin
if e.wparam and e.lparam then
begin
if(BKBitmap is class(tcustombitmap))and BKBitmap.HandleAllocated()then
begin
//Canvas.StretchDraw(GetClientRect(),self.BKBitmap);//20210812 修正默认的背景绘图
Canvas.DrawBitmap(self.BKBitmap,GetClientRect());
end else
begin
cl := Color;
if ifnumber(cl)then
begin
Canvas.Brush.Color := cl;
Canvas.FillRect(GetClientRect());
end
end
e.skip := true;
return 1;
end
end
function CMCursorChanged(var Message:TLMessage):CM_CURSORCHANGED;override;
begin
inherited;
end
procedure FontChanged(Sender:TObject);override;
begin
inherited;
end
function IsContainer(cd);override;
begin
return false;
end
function Create(AOwner:TComponent);override;
begin
inherited;
//inherited Create(AOwner);
FLeft := 10;
FTop := 10;
FWidth := 80;
FHeight := 25;
includestate(FControlState,csCustomPaint);
end
function Recycling();override;
begin
FOnPaint := nil;
inherited;
end
function SetParent(NewParent);override; //type_tcontrol
begin
op := parent;
if op=NewParent then return;
inherited;
if NewParent is class(TWinControl)then
begin
InvalidateRect();
end
end
property OnPaint:eventhandler read FOnPaint write FOnPaint;
{**
@param(OnPaint)(function[TGraphicControl]:bool) 绘制回调,返回true不执行默认绘制 %%
**}
end;

25769
funcext/tvclib/tslvcl.tsf
View File

File diff suppressed because it is too large Load Diff

155
funcext/tvclib/tuieventbase.tsf Normal file
View File

@ -0,0 +1,155 @@
type tuieventbase=class(TSLUICONST)
{**
@explan(说明) 消息基类 %%
**}
uses utslvclauxiliary,utslvclconstant;
public
Message:integer;
Wparam:pointer;
Lparam:pointer;
Hwnd:pointer;
_tag;
{**
@param(Message)(integer) 消息id %%
@param(Wparam)(pointer) 消息wparam %%
@param(Lparam)(pointer) 消息lparam %%
@param(Hwnd)(pointer) 窗口句柄 %%
**}
private
Fhwparam;
Flwparam;
Fhlparam;
Fllparam;
//有符号数
Fuhwparam;
Fulwparam;
Fuhlparam;
Fullparam;
//结果
FSkip;
Fresult;
FSender;
function setSkip(v);
begin
if v then
begin
FSkip := true;
end else
begin
FSkip := false;
end
end
function GetSender();
begin
return FSender;
end
Function SetSender(v);
begin
return FSender := v;
end
public
//FLparamdata;
//FWparamdata;
function create(m,w,l,h);virtual;
begin
{**
@explan(说明) 消息构造 %%
@param(m)(integer) 消息id %%
@param(w)(pointer) 消息wparam %%
@param(l)(pointer) 消息lparam %%
@param(h)(pointer) 窗口句柄 %%
**}
Message := m;
Wparam := w;
Lparam := l;
Hwnd := h;
end
function hilparam();
begin
{**
@explan(说明) 高字节 %%
**}
if ifnil(Fhlparam)then
begin
lowuperdword(Lparam,Fllparam,Fhlparam);
end
return Fhlparam;
end
function lolparam();
begin
{**
@explan(说明) 低字节 %%
**}
if ifnil(Fllparam)then
begin
lowuperdword(Lparam,Fllparam,Fhlparam);
end
return Fllparam;
end
function hiwparam();
begin
{**
@explan(说明) 高字节 %%
**}
if ifnil(Fhwparam)then
begin
lowuperdword(Wparam,Flwparam,Fhwparam);
end
return Fhwparam;
end
function lowparam();
begin
{**
@explan(说明) 低字节 %%
**}
if ifnil(Flwparam)then
begin
lowuperdword(Wparam,Flwparam,Fhwparam);
end
return Flwparam;
end
function hilparamsigned();
begin
{**
@explan(说明) 高字作为符号数
**}
if ifnil(Fuhlparam)then Fuhlparam := unsignedtosigned(hilparam());
return Fuhlparam;
end
function lolparamsigned();
begin
{**
@explan(说明) 低字作为符号数
**}
if ifnil(Fullparam)then Fullparam := unsignedtosigned(lolparam());
return Fullparam;
end
function hiwparamsigned();
begin
{**
@explan(说明) 高字作为符号数
**}
if ifnil(Fuhwparam)then Fuhwparam := unsignedtosigned(hiwparam());
return Fuhwparam;
end
function lowparamsigned();
begin
{**
@explan(说明) 低字作为符号数
**}
if ifnil(Fulwparam)then Fulwparam := unsignedtosigned(lowparam());
return Fulwparam;
end
property msg read Message;
property skip read FSkip write setSkip;
property Result read Fresult write Fresult;
property Handle read Hwnd write Hwnd;
property Sender read GetSender write SetSender;
{**
@param(msg)(integer) 消息id %%
@param(skip)(bool) 是否忽略底层消息处理函数 %%
@param(Result)(integer) 消息处理返回 %%
@param(Handle)(pointer) 窗口句柄 %%
@param(sender)(TControl) 发送消息的控件,如菜单消息的触发窗口 %%
**}
end

2464
funcext/tvclib/twincontrol.tsf Normal file
View File

File diff suppressed because it is too large Load Diff

2727
funcext/tvclib/ugtkinterface.tsf
View File

File diff suppressed because it is too large Load Diff

52
funcext/tvclib/utslmemo.tsf
View File

@ -3,7 +3,7 @@ unit UTslMemo;
@explan(说明) 文本控件库 %%
**}
interface
uses TslVcl;
uses utslvclauxiliary,utslvclgdi,utslvclstdctl;
type TMemoLineItem=class
function Create(s);
begin
@ -18,11 +18,11 @@ type TMemoLineItem=class
FStr;
end
TYPE TMemoLineList=class(TMyArrayB)
TYPE TMemoLineList=class(tnumindexarray)
function Create(Aedit);override;
begin
FEdit := Aedit;
class(TMyArrayB).create();
class(tnumindexarray).create();
FRowMaxLength := 1;
Flock := true;
end
@ -236,7 +236,7 @@ type TTslMenoUndoList=class() //undolist
function Create();
begin
fLockCount := 0;
fItems := new TMyArrayB();
fItems := new tnumindexarray();
fMaxUndoActions := 1024;
fBlockChangeNumber := 0;
fNextChangeNumber := 1;
@ -1716,7 +1716,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
begin
if not FCopyer then
begin
FCopyer := new TClipBoard(self);
FCopyer := new TcustomClipBoard(self);
end
FCopyer.text := r;
return true;
@ -1727,7 +1727,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
//if ReadOnly then return ;
if not FCopyer then
begin
FCopyer := new TClipBoard(self);
FCopyer := new TcustomClipBoard(self);
end
//s := FCopyer.Text;
//echo length(s),"\r\n";
@ -2296,7 +2296,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
return array(ncy,ncx);
end
end
type TSynCompletionList = class(TListBox) //չʾlist
type TSynCompletionList = class(TcustomListBox) //展示list
function Create(AOwner);override;
begin
inherited;
@ -2412,7 +2412,7 @@ type TSynCompletion = class(TSynCompletionList)
it := GetItem(GetCurrentSelection());
if it then
begin
callDatafunction(OnJumpChoosed,self.Owner,it);
CallMessgeFunction(OnJumpChoosed,self.Owner,it);
end
end
function CancelJump(); //取消选中
@ -2932,7 +2932,7 @@ type TSynCustomMemo = class(TCustomMemo)
inherited;
if e.Button() = mbRight then
begin
calldatafunction(OnRClick,o,e);
CallMessgeFunction(OnRClick,o,e);
end
end
function ExecuteCommand(cmd,data);override;
@ -3456,6 +3456,40 @@ function CreateATslMemoUndoItem(AReason,AStart,AEnd,ChangeText,SelMode);
begin
return new TTslMemoUndoItem(AReason,AStart,AEnd,ChangeText,SelMode);
end
type TCanvsRgnClipAutoSave=class
{**
@expan(说明) 裁剪canvas区域,销毁时还原 %%
**}
function Create(cvs,rec);
begin
{**
@explan(说明)构造裁剪对象 %%
@param(cvs)(tcustomcanvas) canvas 对象 %%
@param(rec)(array(左上右下))区域 %%
**}
if(cvs is class(tcustomcanvas))and cvs.HandleAllocated()and ifarray(rec)then
begin
FW32api := cvs._wapi;
FCvsHandle := cvs.Handle;
FCrg := FW32api.CreateRectRgn(rec[0],rec[1],rec[2],rec[3]);
FBKrg := FW32api.SelectClipRgn(FCvsHandle,FCrg); //裁剪区域
end
end
function Destroy();
begin
if FW32api and FCvsHandle and FBKrg and FCrg then
begin
FW32api.SelectClipRgn(FCvsHandle,FBKrg); //恢复区域
FW32api.DeleteObject(FCrg); //销毁区域
end
FW32api := nil;
end
private
FBKrg;
FCrg;
FCvsHandle;
FW32api;
end
InitialIzation
end.

545
funcext/tvclib/utslvclaction.tsf Normal file
View File

@ -0,0 +1,545 @@
unit utslvclaction;
{**
@explan(说明) action 接口库
**}
interface
uses utslvclauxiliary,utslvclbase;
type TBasicAction=class(TComponent)
private
FActionComponent:TComponent; //执行的tcomponent
FOnChange:TNotifyEvent;
FOnExecute:TNotifyEvent;
FOnUpdate:TNotifyEvent;
FParent;
function SetParent(p);
begin
if FParent <> p then
begin
if FParent is class(TActionList)then
begin
FParent.DeleteAction(self);
end
if p is class(TActionList)then
begin
p.AddAction(self);
end
Fparent := p;
end
end
protected FClients;
{**
@param(FClients)( TFpList of TActionLink) 关联的组件 %%
**}
procedure Change;virtual;
begin
if datatype(FOnChange)=7 then call(FOnChange,self);
end
procedure SetOnExecute(Value:TNotifyEvent);virtual;
begin
for i := 0 to FClients.count-1 do
begin
FClients[i].SetOnExecute(value);
end
FOnExecute := Value;
Change();
end
public
function Create(AOwner:TComponent);override;
begin
inherited;
FClients := new TFpList();
end
function Recycling();override;
begin
if FActionComponent then
begin
FActionComponent.RemoveFreeNotification(self);
end
while FClients.Count>0 do
begin
UnRegisterChanges(FClients.Last());
end
inherited;
end
function Destroy();override;
begin
inherited;
end
function HandlesTarget(Target:TObject):Boolean;virtual;
begin
return false;
end
procedure UpdateTarget(Target:TObject);virtual;
begin
end
procedure ExecuteTarget(Target:TObject);virtual;
begin
end
function Execute():Boolean;virtual;
begin
if csDesigning in ComponentState then return ;
if FOnExecute then
begin
e := new tuieventbase(0,0,0,0);
if datatype(FOnExecute)=7 then call(FOnExecute,self(true),e);
return true;
end
return false;
end
procedure RegisterChanges(Value:TBasicActionLink);
begin
Value.FAction := Self(true);
FClients.add(Value);
end
procedure UnRegisterChanges(Value:TBasicActionLink);
begin
for i := 0 to FClients.count-1 do
begin
if FClients[i]=Value then
begin
Value.FAction := nil;
FClients.deli(i);
break;
end
end
end
function Notification(AComponent,Operation);override;
begin
inherited;
if Operation=opRemove and AComponent=FActionComponent then
begin
FActionComponent := nil;
if FParent is class(TActionList)then
begin
FParent.DeleteAction(self);
end
end
end
function SetActionComponent(Value);
begin
if FActionComponent <> Value then
begin
if FActionComponent is class(TComponent)then FActionComponent.RemoveFreeNotification(self);
FActionComponent := Value;
if FActionComponent is class(TComponent)then FActionComponent.FreeNotification(self);
end
end
property ActionComponent:TComponent read FActionComponent write SetActionComponent;
property onexecute:eventhandler read FOnExecute write SetOnExecute;
property OnUpdate:TNotifyEvent read FOnUpdate write FOnUpdate;
property OnChange:TNotifyEvent read FOnChange write FOnChange;
property parent read FParent Write SetParent;
{**
@param(OnExecute)(fpointer) 执行回调 %%
@param(OnUpdate)(fpointer) 更新回调 %%
@param(OnChange)(fpointer) 改变回调 %%
**}
end;
type TContainedAction=class(TBasicAction)
function create(AOwner);override;
begin
inherited;
end
function Destroy();override;
begin
inherited;
end
end
type TCustomAction=class(TContainedAction)
{**
@explan(说明) action类 %%
**}
private
FCaption:string;
FChecked:Boolean;
FChecking:Boolean;
FEnabled:Boolean;
FGroupIndex:Integer;
FHint:string;
FVisible:Boolean;
FShortCut;
procedure SetCaption(const Value:string);
begin
if Value=FCaption then exit;
for I := 0 to FClients.Count-1 do
begin
FClients[I].SetCaption(Value);
end
FCaption := Value;
Change();
end
procedure SetChecked(Value:Boolean);
begin
if Value=FChecked then exit;
for I := 0 to FClients.Count-1 do
begin
FClients[I].SetChecked(Value);
end
FChecked := Value;
Change();
end
procedure SetEnabled(Value:Boolean);
begin
nValue := Value?true:false;
if nValue=FEnabled then exit;
for I := 0 to FClients.Count-1 do FClients[I].SetEnabled(nValue);
FEnabled := nValue;
Change();
end
procedure SetVisible(Value:Boolean);
begin
nValue := Value?true:false;
if nValue=FVisible then exit;
for I := 0 to FClients.Count-1 do FClients[I].SetVisible(nValue);
FVisible := nValue;
Change();
end
function getShortCut();
begin
return formatshortcut(FShortCut);
end
function SetShortCut(v);
begin
if v and ifstring(v) then
begin
nst := parsershortcutstr(v);
end else nst := nil;
if nst <> FShortCut then
begin
FShortCut := nst;
for I := 0 to FClients.Count-1 do
begin
FClients[I].SetShortCut(v);
end
Change();
end
end
protected
procedure AssignTo(Dest:TPersistent);override;
begin
{**
@explan(说明) 赋值 %%
**}
if Dest=Self then exit;
if Dest is class(TCustomAction)then
begin
ps := array("checked","caption","visible","enabled","shortcut");
for i,v in ps do invoke(Dest,v,1,invoke(self,v));
end else
inherited;
end
public
function Create(AOwner:TComponent);override;
begin
{**
@explan(说明) 构造 %%
**}
inherited;
FEnabled := True;
FVisible := True;
end
function Recycling();override;
begin
inherited;
end
function Destroy;override;
begin
inherited;
end
function ExecuteCommand(cmd,p);override;
begin
if csDesigning in ComponentState then return ;
if cmd="doshortcut" then
begin
if (FClients and FClients.Count>0) and Enabled and Visible and ShortCut = p then
begin
if Execute() then return "havedoshortcut";
end
end
end
function Execute():Boolean;override;
begin
Result := False;
Result := Enabled and inherited Execute();
return Result;
end
published
property Caption:string read FCaption write SetCaption;
property Checked:bool read FChecked write SetChecked;
property Enabled:bool read FEnabled write SetEnabled;
property Visible:bool read FVisible write SetVisible;
property ShortCut read getshortcut write SetShortCut;
function publishs();override;
begin
r := array("name","caption","enabled","onexecute");
return r;
end
end;
type TActionList=class(TComponent)
{**
@explan(说明) actionlist %%
**}
private
FActionList;
function DeleteAllActions();
begin
while FActionList.Count>0 do
begin
it := FActionList[0];
if it is class(TBasicAction)then
begin
it.parent := nil;
end else
FActionList.deli(0);
end
end
public
function create(AOwner);override;
begin
inherited;
FActionList := new TFpList();
end
function DeleteAction(v);
begin
{**
@explan(说明) 删除 %%
@param(v)(TBasicAction)
**}
if not(v is class(TBasicAction))then return 0;
idx := FActionList.indexof(v);
if not(idx >= 0)then return 0;
FActionList.deli(idx);
v.parent := nil;
end
function AddAction(V);
begin
{**
@explan(说明) 删除Action %%
@param(v)(TBasicAction)
**}
if v is class(TBasicAction)then
begin
if FActionList.indexof(v)>= 0 then return 0;
FActionList.add(v);
v.parent := self;
end
end
function Notification(AComponent,Operation);override;
begin
inherited;
if Operation=opRemove and AComponent=FActionComponent then
begin
DeleteAllActions();
end
end
function Recycling();override;
begin
DeleteAllActions();
inherited;
end
function publishs();override;
begin
return array("name");
end
end
type TBasicActionLink=class(TSLUIBASE)
{**
@explan(说明) 基础action component关联类 %%
**}
private
FOnChange;
protected
procedure AssignClient(AClient:TObject);virtual;
begin
end
procedure Change;virtual;
begin
if datatype(FOnChange)=7 then call(OnChange,FAction);
end
function IsOnExecuteLinked():Boolean;virtual;
begin
return true;
end
procedure SetAction(Value:TBasicAction);virtual;
begin
if Value <> FAction then
begin
if FAction then FAction.UnRegisterChanges(Self(true));
FAction := Value;
if Value then Value.RegisterChanges(Self(true));
end;
end
procedure SetOnExecute(Value:TNotifyEvent);virtual;
begin
end
public
FAction:TBasicAction;
function Create(AClient:TObject);override;
begin
inherited create();
AssignClient(AClient);
end
Function Recycling();override;
begin
if FAction is class(TBasicAction)then FAction.UnRegisterChanges(self);
inherited;
end
function Destroy;override;
begin
inherited;
end
function Execute(AComponent:TComponent):Boolean;virtual;
begin
{**
@explan(说明) 执行 %%
**}
if not(FAction is class(TBasicAction))then exit;
FAction.ActionComponent := AComponent;
try
r := FAction.Execute();
finally
FAction.ActionComponent := nil;
end;
return r;
end
{function Update(): Boolean; virtual;
begin
if FAction is class(TBasicAction) then return FAction.Update();
end }
property Action:TBasicAction read FAction write SetAction;
property OnChange:TNotifyEvent read FOnChange write FOnChange;
{**
@param(OnChange)(function[sender:tcomponent]) 改变的回调 %%
@param(Action)(taction) action对象 %%
**}
end;
type TActionLink=class(TBasicActionLink)
{**
@explan(说明) action与控件连接类 %%
**}
public
procedure SetShortCut(const Value:String);virtual;
begin
end
procedure SetCaption(const Value:string);virtual;
begin
end
procedure SetChecked(Value:Boolean);virtual;
begin
end
procedure SetEnabled(Value:Boolean);virtual;
begin
end
procedure SetVisible(Value:Boolean);virtual;
begin
end
function create(AClient);override;
begin
inherited;
end
protected
function IsshortcutLinked():Boolean;virtual;
begin
return Action is CLASS(TCustomAction);
end
function IsCheckedLinked():Boolean;virtual;
begin
return Action is CLASS(TCustomAction);
end
function IsEnabledLinked():Boolean;virtual;
begin
return Action is CLASS(TCustomAction);
end
function IsCaptionLinked():Boolean;virtual;
begin
return Action is CLASS(TCustomAction);
end
function IsOnExecuteLinked():Boolean;virtual;
begin
return Action is CLASS(TCustomAction);
end
function IsVisibleLinked():Boolean;virtual;
begin
return Action is CLASS(TCustomAction);
end
end;
type TControlActionLink=class(TActionLink)
{**
@explan(说明)关联tcontrol 和 taction 类 %%
**}
protected
FClient:TControl;
function IsshortcutLinked():Boolean;virtual;
begin
return false;
end
procedure AssignClient(AClient);override;
begin
{**
@explan(说明)赋值control %%
@param(AClient)(tcontrol) %%
**}
if AClient is class(tcontrol)then FClient := AClient;
end
function IsCaptionLinked():Boolean;override;
begin
return FClient and inherited;
end
function IsEnabledLinked():Boolean;override;
begin
return FClient and inherited;
end
function IsVisibleLinked():Boolean;override;
begin
return FClient and inherited;
end
function IsOnExecuteLinked():Boolean;override;
begin
return FClient and inherited;
end
function IsCheckedLinked():Boolean;virtual;
begin
return false;
end
public
function create(AClient);override;
begin
inherited;
end
function destroy();override;
begin
inherited;
end
function Recycling();override;
begin
FClient := nil;
inherited;
end
procedure SetCaption(const Value:string);override;
begin
if IsCaptionLinked()then return FClient.Caption := Value;
end
procedure SetEnabled(Value:Boolean);override;
begin
if IsEnabledLinked()then return FClient.Enabled := Value;
end
procedure SetVisible(Value:Boolean);override;
begin
if IsVisibleLinked()then return FClient.Visible := Value;
end
procedure SetOnExecute(Value:TNotifyEvent);override;
begin
return inherited;
end
end;
implementation
initialization
end.

1812
funcext/tvclib/utslvclauxiliary.tsf
View File

File diff suppressed because it is too large Load Diff

395
funcext/tvclib/utslvclbase.tsf Normal file
View File

@ -0,0 +1,395 @@
unit utslvclbase;
interface
{$ifdef linux}
{$define gtkpaint}
{$define linuxgtk}
{$else}
{$define gdipaint}
{$endif}
uses utslvclconstant,utslvclmemstruct,utslvclauxiliary,UVCPropertyTypesPersistence;
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 GetScreenRect();
begin
{**
@explan(说明) 获取屏幕大小%%
@return(array) 左上右下 %%
**}
rc := new tcrect();
SystemParametersInfoA(0x30,0,rc._getptr_(),0);
return rc._getdata_();
end
function getpathbyprocid(id);
begin
{**
@explan(说明) 获取所有进程路径 %%
@param(id)(integer) 进程id
**}
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
**}
{**
@example(获取所有进程id,并获得路径)
t := EnumProcesses();
for i,v in t do echo getpathbyprocid(v),"\r\n";
**}
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(说明) 获取所有进程信息 %%
@param()
@return(array) 进程信息 %%
**}
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信息
**}
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
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
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
FReCycleState;
static FTSLkeyWords;
static TSLRCS_NONE;
static TSLRCS_BEGIN;
static TSLRCS_END;
static FHAPP;
static FEditTypes;
_hashdata;
_temppath;
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)then
begin
global G_O_TSWIN32API_;
if not G_O_TSWIN32API_ then G_O_TSWIN32API_ := new tswin32api();
_wapi := G_O_TSWIN32API_;
FTSLkeyWords := TSL_ReservedKeys2();
end
if not FHAPP then
begin
FHAPP := _wapi.GetModuleHandleA(0);
TSLRCS_NONE := 0;
TSLRCS_BEGIN := 1;
TSLRCS_END := 2;
end
end
class Function isKeyWords(key);
begin
{**
@explan(说明) 判断是否为tsl关键字 %%
@param(key)(string)
**}
return ifstring(key)and ifarray(FTSLkeyWords)and(lowercase(key)in FTSLkeyWords);
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
class function RegPropertyType(v); //注册设计器编辑
begin
RegComponentPropertyType(v);
end
class function GetPropertyType(n); //获得设计器编辑
begin
return GetComponentPropertyType(n);
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.

451
funcext/tvclib/utslvclconstant.tsf
View File

@ -40,6 +40,329 @@ type tenumeration=class
end
end
end
type TAlign=class(tenumeration)
{**
@explan(说明) 自动对齐类型常量 %%
**}
static alNone;
static alTop;
static alBottom;
static alLeft;
static alRight;
static alClient;
static alCustom;
end
type TAnchorKind=class(tenumeration)
//akTop, akLeft, akRight, akBottom
static akTop;
static akLeft;
static akRight;
static akBottom;
end
type TFormStyle=class(tenumeration)
static fsMDIChild;
static fsMDIForm;
static fsStayOnTop;
static fsSplash;
static fsSystemStayOnTop;
end
type TComponentState=class(tenumeration)
static csLoading;
static csReading;
static csWriting;
static csDestroying;
static csDesigning;
static csAncestor;
static csUpdating;
static csFixups;
static csFreeNotification;
static csInline;
static csDesignInstance;
end
type TComponentStyle=class(tenumeration)
static csInheritable;
static csCheckPropAvail;
static csSubComponent;
static csTransient;
end
type TOperation=class(tenumeration)
static opInsert;
static opRemove;
end
type TWinControlFlag=class(tenumeration)
static wcfClientRectNeedsUpdate;
static wcfColorChanged;
static wcfFontChanged;
static wcfAllAutoSizing;
static wcfAligningControls;
static wcfEraseBackground;
static wcfCreatingHandle;
static wcfInitializing;
static wcfCreatingChildHandles;
static wcfRealizingBounds;
static wcfBoundsRealized;
static wcfUpdateShowing;
static wcfHandleVisible;
static wcfAdjustedLogicalClientRectValid;
static wcfKillIntfSetBounds;
end
type TControlStyleType=class(tenumeration)
static csAcceptsControls; // can have children in the designer;
static csCaptureMouse; // auto capture mouse when clicked;
static csDesignInteractive; // wants mouse events in design mode;
static csClickEvents; // handles mouse events;
static csFramed; // not implemented; has 3d frame;
static csSetCaption; // if Name=Caption; changing the Name changes the Caption;
static csOpaque; // the control paints its area completely;
static csDoubleClicks; // understands mouse double clicks;
static csTripleClicks; // understands mouse triple clicks;
static csQuadClicks; // understands mouse quad clicks;
static csFixedWidth; // cannot change its width;
static csFixedHeight; // cannot change its height (for example combobox);
static csNoDesignVisible; // is invisible in the designer;
static csReplicatable; // PaintTo works;
static csNoStdEvents; // standard events such as mouse; key; and click events are ignored.;
static csDisplayDragImage; // display images from dragimagelist during drag operation over control;
static csReflector; // not implemented; the controls respond to size; focus and dlg messages - it can be used as ActiveX control under Windows;
static csActionClient; // Action is set;
static csMenuEvents; // not implemented;
static csNoFocus; // control will not take focus when clicked with mouse.;
static csNeedsBorderPaint; // not implemented;
static csParentBackground; // tells WinXP to paint the theme background of parent on controls background;
static csDesignNoSmoothResize; // when resizing control in the designer do not SetBounds while dragging;
static csDesignFixedBounds; // can not be moved nor resized in designer;
static csHasDefaultAction; // implements useful ExecuteDefaultAction;
static csHasCancelAction; // implements useful ExecuteCancelAction;
static csNoDesignSelectable; // can not be selected at design time;
static csOwnedChildrenNotSelectable; // child controls owned by this control are NOT selectable in the designer;
static csAutoSize0x0; // if the preferred size is 0x0 then control is shrinked ot 0x0;
static csAutoSizeKeepChildLeft; // when AutoSize=true do not move children horizontally;
static csAutoSizeKeepChildTop; // when AutoSize=true do not move children vertically;
static csRequiresKeyboardInput; // If the device has no physical keyboard then show the virtual keyboard when this control gets focus (therefore available only to TWinControl descendents);
end
type TMouseButton=class(tenumeration)
static mbLeft;
static mbRight;
static mbMiddle;
static mbExtra1;
static mbExtra2;
end
type TShiftStateEnum=class(tenumeration)
static ssShift;
static ssAlt;
static ssCtrl;
static ssLeft;
static ssRight;
static ssMiddle;
static ssDouble;
static ssMeta; //// Extra additions
static ssSuper;
static ssHyper;
static ssAltGr;
static ssCaps;
static ssNum;
static ssScroll;
static ssTriple;
static ssQuad;
static ssExtra1;
static ssExtra2;
end
type TControlFlag=class(tenumeration)
static cfLoading; // set by TControl.ReadState; unset by TControl.Loaded when all on form finished loading;
static cfAutoSizeNeeded;
static cfLeftLoaded; // cfLeftLoaded is set; when 'Left' is set during loading.;
static cfTopLoaded;
static cfWidthLoaded;
static cfHeightLoaded;
static cfClientWidthLoaded;
static cfClientHeightLoaded;
static cfBoundsRectForNewParentValid;
static cfBaseBoundsValid;
static cfPreferredSizeValid;
static cfPreferredMinSizeValid;
static cfOnChangeBoundsNeeded;
static cfProcessingWMPaint;
static cfKillChangeBounds;
static cfKillInvalidatePreferredSize;
static cfKillAdjustSize;
end
type TDockOrientation=class(tenumeration)
static doNoOrient; // zone contains a TControl and no child zones.;
static doHorizontal; // zone's children are stacked top-to-bottom.;
static doVertical; // zone's children are arranged left-to-right.;
static doPages; // zone's children are pages arranged left-to-right.;
end
type TDragKind=class(tenumeration)
static dkDrag;
static dkDock;
end
type TDragMode=class(tenumeration)
static dmManual;
static dmAutomatic;
end
type TDragState=class(tenumeration)
static dsDragEnter;
static dsDragLeave;
static dsDragMove;
end
type TDragMessage=class(tenumeration)
static dmDragEnter;
static dmDragLeave;
static dmDragMove;
static dmDragDrop;
static dmDragCancel;
static dmFindTarget;
end
type TCanvasStates=class(tenumeration)
static csHandleValid;
static csFontValid;
static csPenvalid;
static csBrushValid;
static csRegionValid;
end
type TFPPenMode=class(tenumeration)
static pmBlack;
static pmWhite;
static pmNop;
static pmNot;
static pmCopy;
static pmNotCopy;
static pmMergePenNot;
static pmMaskPenNot;
static pmMergeNotPen;
static pmMaskNotPen;
static pmMerge;
static pmNotMerge;
static pmMask;
static pmNotMask;
static pmXor;
static pmNotXor;
end
type TFPPenEndCap=class(tenumeration)
static pecRound;
static pecSquare;
static pecFlat;
end
type TFPPenJoinStyle=class(tenumeration)
static pjsRound;
static pjsBevel;
static pjsMiter;
end
type TControlStateType=class(tenumeration)
static csLButtonDown;
static csClicked;
static csPalette;
static csReadingState;
static csFocusing;
static csCreating;
static csPaintCopy;
static csCustomPaint;
static csDestroyingHandle;
static csDocking;
static csVisibleSetInLoading;
end
type TFormBorderStyle=class(tenumeration)
static bsNone;
static bsSingle;
static bsSizeable;
static bsDialog;
static bsToolWindow;
static bsSizeToolWin;
end
type TAlignStyle9=class(tenumeration)
{**
@explan(说明) 九宫格对齐常量 %%
**}
static AL9_DEFAULT; //0
static AL9_TOPLEFT; //1
static AL9_TOPCENTER; //2
static AL9_TOPRIGHT; //3
static AL9_CENTERLEFT; //4
static AL9_CENTER; //5
static AL9_CENTERRIGHT; //6
static AL9_BOTTOMLEFT; //7
static AL9_BOTTOMCENTER; //8
static AL9_BOTTOMRIGHT; //9
end
type TAlignStyleH3=class(tenumeration)
{**
@explan(说明) 水平对齐常量 %%
**}
static AL3_LEFT; //0
static AL3_RIGHT; //1
static AL3_CENTER; //2
end
type TSysCursor=class(tenumeration)
class function basevalue();override;
begin
{
//gtk 对照
IDC_ARROW :=2 ;
IDC_IBEAM :=152;
IDC_WAIT :=150 ;
IDC_CROSS :=30;
IDC_UPARROW := 6;
IDC_SIZE :=0; //***
IDC_ICON := 64;
IDC_SIZENWSE := 14;
IDC_SIZENESW := 12;
IDC_SIZEWE :=70;
IDC_SIZENS :=138;
IDC_SIZEALL := 58;
IDC_NO :=0;
IDC_HAND := 24;
IDC_APPSTARTING := 126;
IDC_HELP :=92;
return ;
}
IDC_ARROW := 32512;
IDC_SIZE := 32540;
IDC_NO := 32548;
end
static IDC_ARROW; //MAKEINTRESOURCE(32512)
static IDC_IBEAM; //MAKEINTRESOURCE(32513)
static IDC_WAIT; //MAKEINTRESOURCE(32514)
static IDC_CROSS; //MAKEINTRESOURCE(32515)
static IDC_UPARROW; //MAKEINTRESOURCE(32516)
static IDC_SIZE; //MAKEINTRESOURCE(32640) /* OBSOLETE: use IDC_SIZEALL */
static IDC_ICON; //MAKEINTRESOURCE(32641) /* OBSOLETE: use IDC_ARROW */
static IDC_SIZENWSE; // MAKEINTRESOURCE(32642)
static IDC_SIZENESW; // MAKEINTRESOURCE(32643)
static IDC_SIZEWE; //MAKEINTRESOURCE(32644)
static IDC_SIZENS; //MAKEINTRESOURCE(32645)
static IDC_SIZEALL; //MAKEINTRESOURCE(32646)
static IDC_NO; //MAKEINTRESOURCE(32648)
static IDC_HAND; //MAKEINTRESOURCE(32649)
static IDC_APPSTARTING; // MAKEINTRESOURCE(32650)
static IDC_HELP; //MAKEINTRESOURCE(32651)
end
type TActionListState=class(tenumeration)
static asNormal;
static asSuspended;
static asSuspendedEnabled;
end
type TToolButtonStyle=class(tenumeration)
static tbsButton;
static tbsCheck;
static tbsDropDown;
static tbsSeparator;
static tbsDivider;
static tbsButtonDrop;
end
type TPairSplitterType=class(tenumeration)
static pstHorizontal;
static pstVertical;
end
type TMBbtnstyle=class()
{**
@explan(˵Ã÷) TMessageboxADlg °´Å¥Ñùʽ³£Á¿%%
@ -78,6 +401,119 @@ type TDrawitemState=class
static ODS_NOACCEL;
static ODS_NOFOCUSRECT;
end
type TRasterOperationConst=class
{**
@explan(说明) 光栅操作代码常量类 %%
**}
static SRCCOPY;
static SRCPAINT;
static SRCAND;
static SRCINVERT;
static SRCERASE;
static NOTSRCCOPY;
static NOTSRCERASE;
static MERGECOPY;
static MERGEPAINT;
static PATCOPY;
static PATPAINT;
static PATINVERT;
static DSTINVERT;
static BLACKNESS;
static WHITENESS;
static NOMIRRORBITMAP;
end
type TSystemBitmap=class
{**
@explan(说明) 系统提供的bitmap id %%
**}
static OBM_CLOSE;
static OBM_UPARROW;
static OBM_DNARROW;
static OBM_RGARROW;
static OBM_LFARROW;
static OBM_REDUCE;
static OBM_ZOOM;
static OBM_RESTORE;
static OBM_REDUCED;
static OBM_ZOOMD;
static OBM_RESTORED;
static OBM_UPARROWD;
static OBM_DNARROWD;
static OBM_RGARROWD;
static OBM_LFARROWD;
static OBM_MNARROW;
static OBM_COMBO;
static OBM_UPARROWI;
static OBM_DNARROWI;
static OBM_RGARROWI;
static OBM_LFARROWI;
static OBM_OLD_CLOSE;
static OBM_SIZE;
static OBM_OLD_UPARROW;
static OBM_OLD_DNARROW;
static OBM_OLD_RGARROW;
static OBM_OLD_LFARROW;
static OBM_BTSIZE;
static OBM_CHECK;
static OBM_CHECKBOXES;
static OBM_BTNCORNERS;
static OBM_OLD_REDUCE;
static OBM_OLD_ZOOM;
static OBM_OLD_RESTORE;
end
type TSystemCursor=class
{**
@explan(说明) 鼠标常量类,作为参考 %%
**}
static OCR_WAIT; //150
static OCR_CROSS; //30;
static OCR_UP; //6
static OCR_SIZE; //0
static OCR_SIZENWSE; //14
static OCR_SIZENESW; //12
static OCR_SIZEWE; //70
static OCR_SIZENS; //138
static OCR_SIZEALL; //58
static OCR_ICOCUR; // 0
static OCR_NO; //0
static OCR_HAND; //24
static OCR_APPSTARTING; //126
static OCR_IBEAM; //152
end
type tmacroconst=class(_commctrldef_,_tvclmsageid_,_shellapi_)
class function sinit();virtual;
begin
class(_commctrldef_).sinit();
class(_tvclmsageid_).sinit();
class(_shellapi_).sinit();
end
end
type tconstant = class(talign,TAnchorKind,TFormStyle,TComponentState,
TComponentStyle,TOperation,TWinControlFlag,
TControlStyleType,TMouseButton,TShiftStateEnum,
TControlFlag,TDockOrientation,TDragKind,TDragMode,
TDragState,TDragMessage,TCanvasStates,TFPPenMode,
TFPPenEndCap,TFPPenJoinStyle,TControlStateType,
TFormBorderStyle,TAlignStyle9,TAlignStyleH3,TSysCursor,
TActionListState,TToolButtonStyle,TPairSplitterType
)
{**
@explan(说明) 常量类集合 %%
**}
end
type TSLUICONST=class(tmacroconst,tconstant)
{**
@explan(说明) 界面库常量类 %%
**}
static WM_TRAY;
class function sinit();override;
begin
class(tmacroconst).sinit();
WM_TRAY := WM_USER+100;
end
end
type _shellapi_=class()
static abm_new;
static abm_remove;static abm_querypos;static abm_setpos;static abm_getstate;static abm_gettaskbarpos;
@ -5492,7 +5928,20 @@ type _tvclmsageid_ = class()
end
end
implementation
{
type TFPPenStyle=class(tenumeration)
static psSolid;
static psDash;
static psDot;
static psDashDot;
static psDashDotDot;
static psinsideFrame;
static psPattern;
static psClear;
end
}
initialization
class(TSLUICONST).sinit();
class(tenumeration).initenumeration(new tconstant());
end.

389
funcext/tvclib/utslvclevent.tsf Normal file
View File

@ -0,0 +1,389 @@
unit utslvclevent;
interface
uses cstructurelib,utslvclconstant,utslvclmemstruct,utslvclauxiliary;
{**
@explan(说明) 消息相关对象相关类型 %%
@date(20220507)
**}
///////////////////////////消息对象////////////////////////////////////
type TMNOTIFY=class(tuieventbase,tslcstructureobj)
{**
@explan(说明) 系统控件通知消息 %%
**}
STATIC SFSTRUCT;
function getstruct();
begin
if not SFSTRUCT then SFSTRUCT := MemoryAlignmentCalculate(array(
("hwndfrom","intptr",0),
("idfrom","intptr",0),
("code","int",0)));
return SFSTRUCT;
end
function create(m,w,l,h);override;
begin
inherited;
class(tslcstructureobj).create(getstruct(),l);
end
property hwndfrom index "hwndfrom" read _getvalue_;
property code index "code" read _getvalue_;
{**
@param(hwndfrom)(pointer) 子控件句柄 %%
@param(code)(integer) 通知码 %%
**}
end
type TMALIGN=class(tuieventbase)
value;
top:integer;
left:integer;
width:integer;
height:integer;
function create(m,w,l,h);
begin
inherited;
top := left := right := bottom := 0;
end
end
type TMANCHOR=class(tuieventbase)
prec;
function create(m,w,l,h);
begin
inherited;
prec := array(0,0,0,0);
end
end
type TMMENUSELECT=class(tuieventbase)
{**
@explan(说明) 菜单选择消息 %%
**}
function create(m,w,l,h);override;
begin
inherited;
end
property itemid read lowparam;
property flags read hiwparam;
{**
@param(itemid)(integer) 菜单id %%
@param(flags)(integer) 状态 %%
**}
end
type TMKEY=class(tuieventbase)
{**
@param(说明) 按键消息
**}
private
FShiftsate;
function getshiftsate();
begin
if not ifarray(FShiftsate)then
begin
FShiftsate := array();
global G_O_TSWIN32API_;
w32 := G_O_TSWIN32API_;
if w32 then
begin
if getbitsfrominteger(w32.GetKeyState(VK_SHIFT),15,15)then FShiftsate[length(FShiftsate)]:= ssShift;
if getbitsfrominteger(w32.GetKeyState(VK_CONTROL),15,15)then FShiftsate[length(FShiftsate)]:= ssCtrl;
if getbitsfrominteger(w32.GetKeyState(VK_MENU),15,15)then FShiftsate[length(FShiftsate)]:= ssAlt;
end
//echo tostn(FShiftsate);
//echo getbitsfrominteger( w32.GetKeyState(VK_MENU),15,15),"*************\r\n";
end
return FShiftsate;
end
FChar;
public
function create(m,w,l,h);override;
begin
inherited;
FChar := chr(w);
end
property char read FChar;
property CharCode read wparam;
property shiftstate read getshiftsate;
{**
@param(char)(string) 键符号 %%
@param(CharCode)(integer) ascii码 %%
@param(shiftstate)(arry of TShiftStateEnum member ) ascii码 %%
**}
end
Type TtageDrawItem=class(tslcstructureobj)
private
static SFSTRUCT;
class function getstruct();virtual;
begin
if not SFSTRUCT then SFSTRUCT := MemoryAlignmentCalculate(array(
("ctltype","int",0),
("ctlid","int",0),
("itemid","int",0),
("itemaction","int",0),
("itemstate","int",0),
("hwnditem","intptr",0),
("hdc","intptr",0),
("rcitem","int[4]",
(0,0,0,0)),
("itemdata","intptr",0)));
return SFSTRUCT;
end
public
function create(ptr);
begin
inherited create(getstruct(),ptr);
end
{**
@param(ctltype)(integer) 控件类型 %%
@param(ctlid)(integer) 控件id %%
@param(id)(integer) 待绘制的子项序号 %%
@param(itemstate)(member of TDrawitemState ) 状态%%
@param(hdc)(pointer) canvas句柄 %%
@param(hwnditem)(pointer) windows句柄 %%
@param(rcitem)(array of integer) array(左,上,右,下) %%
@param(itemaction)(integer) ODA_DRAWENTIRE or ODA_FOCUS or ODA_SELECT %%
**}
property ctltype index "ctltype" read _getvalue_ write _setvalue_;
property ctlid index "ctlid" read _getvalue_ write _setvalue_;
property id index "itemid" read _getvalue_ write _setvalue_;
property itemid index "itemid" read _getvalue_ write _setvalue_;
property itemaction index "itemaction" read _getvalue_ write _setvalue_;
property itemstate index "itemstate" read _getvalue_ write _setvalue_;
property rcitem index "rcitem" read _getvalue_ write _setvalue_;
property hdc index "hdc" read _getvalue_ write _setvalue_;
property hwnditem index "hwnditem" read _getvalue_ write _setvalue_;
end
type TMDRAWITEM=class(tuieventbase,TtageDrawItem)
public
function create(m,w,l,h);override;
begin
inherited;
class(TtageDrawItem).create(l);
end
function destroy();override;
begin
inherited;
class(TtageDrawItem).destroy();
end
canvas;
end
type TGRIDMDRAWITEM=class(TMDRAWITEM)
{**
@explan(说明) 控件绘制消息类 %%
**}
private
FSubitemid;
FSubItemRect;
public
function create(m,w,l,h);override;
begin
inherited;
end
property Subitemid read FSubitemid write FSubitemid;
property SubItemRect read FSubItemRect write FSubItemRect;
end
type TMMEASUREITEM=class(tuieventbase,tslcstructureobj)
{**
@explan(说明) 系统控件测量消息
**}
static SFSTRUCT;
class function getstruct();
begin
if not SFSTRUCT then SFSTRUCT := MemoryAlignmentCalculate(array(
("ctltype","int",0),
("ctlid","int",0),
("itemid","int",0),
("itemwidth","int",0),
("itemheight","int",0),
("itemdata","intptr",0)));
return SFSTRUCT;
end
function create(m,w,l,h);override;
begin
inherited;
class(tslcstructureobj).create(getstruct(),l);
end
property ctlid index "ctlid" read _getvalue_;
property ctltype index "ctltype" read _getvalue_;
property id index "itemid" read _getvalue_;
property width index "itemwidth" read _getvalue_ write _setvalue_;
property height index "itemheight" read _getvalue_ write _setvalue_;
property itemid index "itemid" read _getvalue_;
property itemwidth index "itemwidth" read _getvalue_ write _setvalue_;
property itemheight index "itemheight" read _getvalue_ write _setvalue_;
{**
@param(ctlid)(integer) 控件id %%
@param(itemid)(integer) 控件在父窗口中的序号 %%
@param(width)(integer) 设置或者获取宽度 %%
@param(height)(integer) 设置或者获取高度 %%
**}
end
type TSIFTSTATE = class(TSLUICONST)
//protected
//FKeyState;
class function KeysToShiftState(Keys: PtrUInt): TShiftState;
begin
{**
@explan(说明) 解析按键状态 %%
**}
Result := array();
if (Keys .& MK_Shift) <> 0 then includestate(Result, ssShift);
if (Keys .& MK_Control) <> 0 then includestate(Result, ssCtrl);
if (Keys .& MK_LButton) <> 0 then includestate(Result, ssLeft);
if (Keys .& MK_RButton) <> 0 then includestate(Result, ssRight);
if (Keys .& MK_MButton) <> 0 then includestate(Result, ssMiddle);
if (Keys .& MK_XBUTTON1) <> 0 then includestate(Result, ssExtra1);
if (Keys .& MK_XBUTTON2) <> 0 then includestate(Result, ssExtra2);
if (Keys .& MK_DOUBLECLICK) <> 0 then includestate(Result, ssDouble);
if (Keys .& MK_TRIPLECLICK) <> 0 then includestate(Result, ssTriple);
if (Keys .& MK_QUADCLICK) <> 0 then includestate(Result, ssQuad);
global G_O_TSWIN32API_;
if G_O_TSWIN32API_ then
begin
v := G_O_TSWIN32API_.GetKeyState(VK_MENU);
end else v := 0;
if _shr(v,15) then includestate(Result, ssAlt);
//if gettswin32api().GetKeyState(VK_MENU) < 0 then includestate(Result, ssAlt);
//if (GetKeyState(VK_LWIN) < 0) or (GetKeyState(VK_RWIN) < 0) then Include(Result, ssMeta);
return Result;
end;
end
type TMMOUSEWHEEL=class(tuieventbase)
{**
@explan(说明)鼠标滚动消息类 %%
**}
function create(m,w,l,h);override;
begin
inherited;
end
function shiftstate();
begin
{**
@explan(说明) 按键状态 %%
@return(array of TShiftStateEnum menuber) shift 键集合
**}
if ifnil(FKeyState)then
begin
FKeyState := class(TSIFTSTATE).KeysToShiftState(lowparam());
end
return FKeyState;
end
property delta read hiwparamsigned;
property ypos read hilparamsigned;
property xpos read lolparamsigned;
{**
@param(ypos)(integer)鼠标的y坐标 %%
@param(xpos)(integer)鼠标的x坐标 %%
@param(delta)(integer)运动距离 %%
**}
private
FKeyState;
end
type TMMouse=class(tuieventbase)
{**
@explan(说明) 鼠标消息类 %%
**}
protected FButton;
public
function create(m,w,l,h);override;
begin
inherited;
end
{**
@param(xpos)(integer) x 位置 %%
@param(ypos)(integer) y 位置 %%
@param(FButton)(integer) 按键状态,继承时候使用 %%
**}
property xpos:integer read lolparamsigned;
property ypos:integer read hilparamsigned;
function pos();
begin
return array(xpos(),ypos());
end
property Dummy read Lparam;
function SetButton(v);
begin
{**
@ignore(忽略) %%
**}
if ifnumber(v)then FButton := v;
else return FButton;
end
function button();
begin
{**
@explan(说明) 鼠标按键情况 %%
@return(member of TMouseButton)
**}
return FButton;
end
function shiftstate();
begin
{**
@explan(说明) 按键状态 %%
@return( array of TShiftStateEnum menuber) %%
**}
if ifnil(FKeyState)then
begin
FKeyState := class(TSIFTSTATE).KeysToShiftState(Wparam);
end
return FKeyState;
end
function setshiftdouble(v);
begin
{**
@ignore(忽略) %%
**}
shiftstate();
if ifnumber(v)then
begin
includestate(FKeyState,v);
end
end
function shiftdouble();
begin
{**
@explan(说明) 是否双击 %%
@return(bool) 是否双击
**}
shiftstate();
return(ssDouble in FKeyState);
end
private
FKeyState;
end
type TMSTYLECHANG=class(tuieventbase)
{**
@explan(说明)窗口样式改变消息 %%
**}
private
FSTyle;
function _getvalue_(n);
begin
return FSTyle._getvalue_(n);
end
function _setvalue_(n,v);
begin
return FSTyle._setvalue_(n,v);
end
public
function create(m,w,l,h);override;
begin
inherited;
FSTyle := new TSTYLESTRUCT(l);
end
property styleold index "styleold" read _getvalue_ write _setvalue_;
property stylenew index "stylenew" read _getvalue_ write _setvalue_;
{**
@param(stylenew)(integer) 新样式 %%
@param(styleold)(integer) 旧样式 %%
**}
end
implementation
initialization
finalization
end.

2990
funcext/tvclib/utslvclgdi.tsf Normal file
View File

File diff suppressed because it is too large Load Diff

1226
funcext/tvclib/utslvclgrid.tsf Normal file
View File

File diff suppressed because it is too large Load Diff

1166
funcext/tvclib/utslvclmemstruct.tsf
View File

File diff suppressed because it is too large Load Diff

1020
funcext/tvclib/utslvclmenu.tsf Normal file
View File

File diff suppressed because it is too large Load Diff

4856
funcext/tvclib/utslvclstdctl.tsf Normal file
View File

File diff suppressed because it is too large Load Diff

1922
funcext/tvclib/utslvcltree.tsf Normal file
View File

File diff suppressed because it is too large Load Diff

52
funcext/tvclib/uvcpropertytypespersistence.tsf
View File

@ -1,6 +1,6 @@
Unit UVCPropertyTypesPersistence;
interface
uses utslvclauxiliary,tslvcl;
uses utslvclauxiliary;
{**
@explan(说明) 可视控件属性处理库 %%
**}
@ -1229,6 +1229,8 @@ type TPropertyImagesData=class(TPropertyType)
end
function TmfToNode(d);override;
begin
global G_T_BITMAP_;
if not G_T_BITMAP_ then return ;
if ifstring(d)then
begin
r := HexFormatStrToTsl(d);
@ -1237,7 +1239,7 @@ type TPropertyImagesData=class(TPropertyType)
ret := array();
for i,v in r["items"] do
begin
bmp := new tbitmap();
bmp := createobject(G_T_BITMAP_);
bmp.Readvcon(v);
ret[i]:= bmp;
end
@ -1265,14 +1267,6 @@ type TPropertyImagesData=class(TPropertyType)
its[length(its)]:= dv;
end
end
{for i,v in d do
begin
if v is class(TBitmap) then
begin
dv := v.tovcon();
its[length(its)] := dv;
end
end }
r["items"]:= its;
reti := TSlToHexFormatStr(r);
ret := "{ ";
@ -1282,6 +1276,8 @@ type TPropertyImagesData=class(TPropertyType)
end
function ReadTMF(d,o);override;
begin
global G_T_BITMAP_;
if not G_T_BITMAP_ then return ;
if ifstring(d)then
begin
r := HexFormatStrToTsl(d);
@ -1290,7 +1286,7 @@ type TPropertyImagesData=class(TPropertyType)
ret := array("type":"bmps");
for i,v in r["items"] do
begin
bmp := new tbitmap();
bmp := createobject(G_T_BITMAP_);
bmp.Readvcon(v);
ret["items"][i]:= bmp;
end
@ -1306,10 +1302,12 @@ type TPropertyBitmap=class(TPropertyType)
end
function TmfToNode(d);override;
begin
global G_T_BITMAP_;
if not G_T_BITMAP_ then return ;
if ifstring(d)and d then
begin
tar := HexFormatStrToTsl(d);
bmp := new tbitmap();
bmp := createobject(G_T_BITMAP_);
bmp.Readvcon(tar);
return bmp;
end
@ -1321,8 +1319,11 @@ type TPropertyBitmap=class(TPropertyType)
@explan(说明)修改表格数据转换为tmf文件数据 %%
**}
reti := "";
if d is class(tbitmap)then
global G_T_BITMAP_;
if d is G_T_BITMAP_ then
begin
echo " \r\nglob bitmap===";
reti := TSlToHexFormatStr(d.tovcon);
end
ret := "{ ";
@ -1342,12 +1343,14 @@ type TPropertyIcon=class(TPropertyType)
end
function TmfToNode(d);override;
begin
global G_T_ICON_;
if not G_T_ICON_ then return ;
if ifstring(d)and d then
begin
dd := HexFormatStrToTsl(d);
if ifarray(dd)then
begin
r := new Ticon();
r := createobject(G_T_ICON_);
r.Readvcon(dd);
return r;
end
@ -1359,7 +1362,8 @@ type TPropertyIcon=class(TPropertyType)
@explan(说明)修改表格数据转换为tmf文件数据 %%
**}
reti := "";
if d is class(ticon)then
global G_T_ICON_;
if G_T_ICON_ and (d is G_T_ICON_) then
begin
reti := TSlToHexFormatStr(d.tovcon());
end
@ -1519,8 +1523,8 @@ type UniObjectMember=class(UniSelProperty)
function CreateSelValues();override;
begin
//FNameMap := FValueMap := array();
FNameMap := New TMyArrayA();
FValueMap := New TMyArrayA();
FNameMap := New tstrindexarray();
FValueMap := New tstrindexarray();
FInfoObj := CreateInfoOBJ();
r := array();
if not ifobj(FInfoObj)then return array();
@ -1554,6 +1558,20 @@ type TPropertyAnchors=class(UniObjectMember)
return true;
end
private
type TAnchorKind=class()
//akTop, akLeft, akRight, akBottom
function create();
begin
akTop := 0;
akTop := 1;
akRight := 2;
akBottom := 3;
end
akTop;
akLeft;
akRight;
akBottom;
end
end
type TPropertyAlign9=class(UniObjectMember)
function EditType();override;

601
funcext/tvclib/uwindowsinterface.tsf Normal file
View File

@ -0,0 +1,601 @@
unit uwindowsinterface;
interface
{**
@explan(说明) windows平台相关接口 %%
@date(20220509) %%
**}
uses cstructurelib;
type twindowsapi = class
function openresourcemanager(p); //打开资源管理器
begin
if ifstring(p) then
return WinExec('cmd.exe /C start "" "'+p,1);
end
function getclipboardtext(clpd);
begin
sid := GetClipboardData(0x7);
r := ReadStringFromPtr(sid);
return r;
end
function setclipboardtext(clbd,s);
begin
len := length(s);
hm := GlobalAlloc(2,len+1); //分配内容
if hm <> 0 then
begin
lm := GlobalLock(hm); //枷锁
if lm <> 0 then
begin
memcpy(lm,s,len); //内存拷贝
GlobalUnlock(hm); //解锁
r := SetClipboardData(1,hm);
if r <> 0 then
begin
ret := 1;
end
end
end
return ret;
end
function getclipboardbmp();
begin
return GetClipboardData(0x2);
end
function setclipboardbmp(bmp);
begin
r := SetClipboardData(0x2,bmp);
if r<>0 then
begin
ret := 1;
end
return ret;
end
//////////////////////////////////////////////////////////////////////////////////////////////////////
class function AnsiToWidChar(c);
begin
if not ifstring(c) then return "";
iSize := MultiByteToWideChar_a(0, 0, C , -1, "", 0);
if not(iSize>0) then return "";
pwszUnicode := "";
setlength(pwszUnicode,isize*2); //少减去2
MultiByteToWideChar_a(0, 0, c , -1, pwszUnicode , iSize-1);
return pwszUnicode;
end
class function GetEncoderClsid(n:String;ed:pointer);
begin
r := tslvclgetencoderclsid(n,ed);
return r;
end;
function drawbitmaptodc(bm,hdc,x,y,rc,flag,thdc);
begin
oldmp := SelectObject(thdc,bm);
if not flag then flag := 0xcc0020;
r := BitBlt(hdc,x,y,rc[2]-rc[0],rc[3]-rc[1],thdc,rc[0],rc[1],flag);
if oldmp then SelectObject(thdc,oldmp);
return r;
end
function drawbitmapstretchtodc(bm,hdc,drect,rc,flag,thdc);
begin
oldmp := SelectObject(thdc,bm);
if not flag then flag := 0xcc0020;
r := StretchBlt(hdc,drect[0],drect[1],drect[2]-drect[0],drect[3]-drect[1],thdc,rc[0],rc[1],rc[2]-rc[0],rc[3]-rc[1],flag);
if oldmp then SelectObject(thdc,oldmp);
return r;
end
////////////////////////clipboar//////////////////////
function OpenClipboard(hwd :pointer):integer;stdcall;external "User32.dll" name "OpenClipboard";
function EmptyClipboard():integer;stdcall;external "User32.dll" name "EmptyClipboard";
function CloseClipboard():integer;stdcall;external "User32.dll" name "CloseClipboard";
function SetClipboardData(uflags:integer;mem:pointer):pointer;stdcall;external "User32.dll" name "SetClipboardData";
function GetClipboardData(uflags:integer):pointer;stdcall;external "User32.dll" name "GetClipboardData";
function IsClipboardFormatAvailable(format:integer):integer;stdcall;external "User32.dll" name "IsClipboardFormatAvailable";
//***********
function GetDpiForMonitor(hmonitor:pointer; dpiType:integer;var dpiX:integer;var dpiY:integer):pointer;stdcall;external "Shcore.dll" name "GetDpiForMonitor";
//Kernel32.dll
//进程和内存相关
class function SetTimer(hWnd:pointer; nIDEvent:pointer; uElapse:integer;lpTimerFunc:pointer):integer;stdcall;external "User32.dll" name "SetTimer";
class function KillTimer(hWnd:pointer; nIDEvent:pointer):integer;stdcall;external "User32.dll" name "KillTimer";
class function MultiByteToWideChar_a(CodePage:integer;dwFlags:integer;lpMultiByteStr:string;cbMultiByte:integer;var lpWideCharStr:string;cchWideChar:integer):integer;stdcall;external "Kernel32.dll" name "MultiByteToWideChar";
class function GetModuleHandleA(name:pointer):pointer;stdcall;external "Kernel32.dll" name "GetModuleHandleA";
class function GetComputerNameA(var lpBuffer:string;var nSize:integer):integer;stdcall;external "Kernel32.dll" name "GetComputerNameA";
class function GetLastError():integer;stdcall;external "Kernel32.dll" name "GetLastError";
class function GetEnvironmentVariableA(lpName:string;lpBuffer:string;nSize:integer):integer;stdcall;external "Kernel32.dll" name "GetEnvironmentVariableA";
class function SetEnvironmentVariableA(lpName:string; lpValue:string):integer;stdcall;external "Kernel32.dll" name "SetEnvironmentVariableA";
class function GetLogicalDriveStringsA(BUFSIZE:integer; szLogicDriveStrings:string):integer;stdcall;external "Kernel32.dll" name "GetLogicalDriveStringsA";
class function GetDiskFreeSpaceExA(lpDirectoryName:string;var lpFreeBytesAvailableToCaller:int64;var lpTotalNumberOfBytes:int64;var lpTotalNumberOfFreeBytes:int64):integer;stdcall ;external "Kernel32.dll" name "GetDiskFreeSpaceExA";
function GlobalAlloc(uFlags :integer;dwBytes:integer):pointer;stdcall;external "Kernel32.dll" name "GlobalAlloc";
function CreateStreamOnHGlobal(hGlobal:pointer;fDeleteOnRelease:integer; var ppstm:pointer):pointer;stdcall;external "Ole32.dll" name "CreateStreamOnHGlobal";
function GetHGlobalFromStream(pstm:pointer; var phglobal:pointer):pointer;stdcall;external "Ole32.dll" name "GetHGlobalFromStream";
function GlobalLock(mem :pointer):pointer;stdcall;external "Kernel32.dll" name "GlobalLock";
function GlobalUnlock(mem :pointer):integer;stdcall;external "Kernel32.dll" name "GlobalUnlock";
function GlobalSize(menm:pointer):integer;stdcall;external "Kernel32.dll" name "GlobalSize";
function GetStartupInfoA(lpStartupInfo:pointer):integer;stdcall ;external "Kernel32.dll" name "GetStartupInfoA" ;
function GetExitCodeProcess(hProcess:pointer;var lpExitCode:integer):integer;stdcall ;external "Kernel32.dll" name "GetExitCodeProcess" ;
function CreateProcessA(lpApplicationName:string;lpCommandLine:string;lpProcessAttributes:pointer;
lpThreadAttributes:pointer;bInheritHandles:integer;dwCreationFlags:integer;lpEnvironment:pointer;
lpCurrentDirectory:string;lpStartupInfo:pointer;
lpProcessInformation:pointer):integer;stdcall ;external "Kernel32.dll" name "CreateProcessA" ;
function CreatePipe(var hReadPipe:pointer;var hWritePipe : pointer;
lpPipeAttributes:pointer;nSize:integer):integer;stdcall;external "Kernel32.dll" name "CreatePipe";
function PeekNamedPipe(hNamedPipe:pointer;var lpBuffer:string; nBufferSize:integer; var lpBytesRead:integer;
varlpTotalBytesAvail:integer;var lpBytesLeftThisMessage:integer):integer;stdcall;external "Kernel32.dll" name "PeekNamedPipe";
function GetStdHandle(nStdHandle:integer):pointer;stdcall;external "Kernel32.dll" name "GetStdHandle";
function SetStdHandle(nStdHandle:integer;hHandle:pointer):integer;stdcall;external "Kernel32.dll" name "SetStdHandle";
function CreateFileA(var lpFileName:string;dwDesiredAccess:integer;
dwShareMode:integer;lpSecurityAttributes:pointer;dwCreationDisposition:integer;
dwFlagsAndAttributes:integer;hTemplateFile:pointer):pointer;stdcall;external "Kernel32.dll" name "CreateFileA";
function WriteFile(hFile:pointer; lpBuffer:pointer;nNumberOfBytesToWrite:integer;var lpNumberOfBytesWritten:integer; lpOverlapped:pointer):integer;stdcall;external "Kernel32.dll" name "WriteFile";
function WriteFile2(hFile:pointer; var lpBuffer:string;nNumberOfBytesToWrite:integer;var lpNumberOfBytesWritten:integer; lpOverlapped:pointer):integer;stdcall;external "Kernel32.dll" name "WriteFile";
function ReadFile__(hFile:pointer;var lpBuffer:string;nNumberOfBytesToRead:integer;var lpNumberOfBytesRead:integer;pOverlapped:pointer):integer;stdcall;external "Kernel32.dll" name "ReadFile";
function OpenProcess(dwDesiredAccess:integer;bInheritHandle:integer;dwProcessId:integer):pointer;stdcall;external "Kernel32.dll" name "OpenProcess";
function GetHandleInformation(hObject:pointer;var lpdwFlags:integer):integer;stdcall;external "Kernel32.dll" name "GetHandleInformation";
function CloseHandle(hObject:pointer):integer;stdcall ;external "Kernel32.dll" name "CloseHandle" ;
function _lclose(hObject:pointer):pointer;stdcall ;external "Kernel32.dll" name "_lclose" ;
function CreateToolhelp32Snapshot(dwFlags:integer;th32ProcessID:integer):pointer;stdcall;external "Kernel32.dll" name "CreateToolhelp32Snapshot";
function Process32First(hSnapshot:pointer;lppe:pointer):integer;stdcall;external "Kernel32.dll" name "Process32First";
function Process32Next(hSnapshot:pointer; lppe:pointer):integer;stdcall;external "Kernel32.dll" name "Process32Next";
function Module32First(hSnapshot:pointer;lpme:pointer):integer;stdcall;external "Kernel32.dll" name "Module32First";
function Module32Next(hSnapshot:pointer; lppe:pointer):integer;stdcall;external "Kernel32.dll" name "Module32Next";
function GetCurrentDirectoryA(nBufferLength:integer; var lpBuffer:string):integer;stdcall;external "Kernel32.dll" name "GetCurrentDirectoryA";
function SetCurrentDirectoryA(lpPathName:string):integer;stdcall;external "Kernel32.dll" name "SetCurrentDirectoryA";
Function WinExec(lpCmdLine:string;nCmdShow:integer):integer;stdcall; external "kernel32.dll" name "WinExec" ;
function GetDriveTypeA(lpRootPathName:string):integer;stdcall; external "kernel32.dll" name "GetDriveTypeA" ;
(*
DRIVE_UNKNOWN = 0; {未知}
DRIVE_NO_ROOT_DIR = 1; {可移动磁盘}
DRIVE_REMOVABLE = 2; {软盘}
DRIVE_FIXED = 3; {本地硬盘}
DRIVE_REMOTE = 4; {网络磁盘}
DRIVE_CDROM = 5; {CD-ROM}
DRIVE_RAMDISK = 6; {RAM 磁盘}
*)
function EnumProcesses_(var lpidProcess:array of integer;cb:integer; var lpcbNeeded:integer):integer;stdcall;external "Kernel32.dll" name "K32EnumProcesses";
function GetModuleFileNameExA(hProcess:pointer; hModule:pointer;var lpFilename:string;nSize:integer):integer;stdcall;external "Kernel32.dll" name "K32GetModuleFileNameExA";
function QueryFullProcessImageNameA(hProcess:pointer; dwFlags:integer;var lpFilename:string;var nSize:integer):integer;stdcall;external "Kernel32.dll" name "QueryFullProcessImageNameA";
function GetCurrentProcess():pointer;stdcall;external "Kernel32.dll" name "GetCurrentProcess";
function OpenProcessToken(ProcessHandle:pointer;DesiredAccess:integer; var TokenHandle:pointer):integer;stdcall;external "Advapi32.dll" name "OpenProcessToken";
//SeDebugPrivilege
function LookupPrivilegeValueA(var PolicyHandle:string;var Name:string; lpLuid:pointer):integer;stdcall;external "Advapi32.dll" name "LookupPrivilegeValueA";
function AdjustTokenPrivileges(TokenHandle:pointer; DisableAllPrivileges:integer; NewState:pointer ; BufferLength:integer;
PreviousState:pointer; ReturnLength:pointer):integer;stdcall;external "Advapi32.dll" name "AdjustTokenPrivileges";
//Snapshot from Psapi.lib – WinSDK V7.0*
(* #if (PSAPI_VERSION > 1)
#define EnumProcesses K32EnumProcesses
#define EnumProcessModules K32EnumProcessModules
#define EnumProcessModulesEx K32EnumProcessModulesEx
#define GetModuleBaseNameA K32GetModuleBaseNameA
#define GetModuleBaseNameW K32GetModuleBaseNameW
#define GetModuleFileNameExA K32GetModuleFileNameExA
#define GetModuleFileNameExW K32GetModuleFileNameExW
#define GetModuleInformation K32GetModuleInformation
#define EmptyWorkingSet K32EmptyWorkingSet
#define QueryWorkingSet K32QueryWorkingSet
#define QueryWorkingSetEx K32QueryWorkingSetEx
#define InitializeProcessForWsWatch K32InitializeProcessForWsWatch
#define GetWsChanges K32GetWsChanges
#define GetWsChangesEx K32GetWsChangesEx
#define GetMappedFileNameW K32GetMappedFileNameW
#define GetMappedFileNameA K32GetMappedFileNameA
#define EnumDeviceDrivers K32EnumDeviceDrivers
#define GetDeviceDriverBaseNameA K32GetDeviceDriverBaseNameA
#define GetDeviceDriverBaseNameW K32GetDeviceDriverBaseNameW
#define GetDeviceDriverFileNameA K32GetDeviceDriverFileNameA
#define GetDeviceDriverFileNameW K32GetDeviceDriverFileNameW
#define GetProcessMemoryInfo K32GetProcessMemoryInfo
#define GetPerformanceInfo K32GetPerformanceInfo
#define EnumPageFilesW K32EnumPageFilesW
#define EnumPageFilesA K32EnumPageFilesA
#define GetProcessImageFileNameA K32GetProcessImageFileNameA
#define GetProcessImageFileNameW K32GetProcessImageFileNameW
#endif *)
//定时器
//function SetClassLongA(hWnd:pointer; nIDEvent:pointer):integer;stdcall;external "User32.dll" name " SetClassLongA";
function GetDpiFromDpiAwarenessContext(v:pointer):integer;stdcall;external "User32.dll" name "GetDpiFromDpiAwarenessContext";
function GetDpiForWindow(hwnd:pointer):integer;stdcall;external "User32.dll" name "GetDpiForWindow";
function GetMonitorInfoA(hMonitor:pointer;lpmi:pointer):integer;stdcall;external "User32.dll" name "GetMonitorInfoA";
function MonitorFromWindow(hwnd:pointer;dwFlags:integer):pointer;stdcall;external "User32.dll" name "MonitorFromWindow";
function GetSysColor(idx:integer):integer;;stdcall;external "User32.dll" name "GetSysColor";
function SystemParametersInfoA(uiAction:integer;uiParam:integer; pvParam:pointer; fWinIni:integer):integer;stdcall;external "User32.dll" name "SystemParametersInfoA";
//双击间隔
function SetDoubleClickTime(it:integer):integer;stdcall;external "User32.dll" name "SetDoubleClickTime";
function GetDoubleClickTime():integer;stdcall;external "User32.dll" name "GetDoubleClickTime";
//热键
function RegisterHotKey(hWnd:pointer;id:integer; fsModifiers:integer; vk:integer):integer;stdcall;external "User32.dll" name "RegisterHotKey";
function UnregisterHotKey(hWnd:pointer;id:integer):integer;stdcall;external "User32.dll" name "UnregisterHotKey";
function MapVirtualKeyA(uCode:integer; uMapType:integer):integer;stdcall;external "User32.dll" name "MapVirtualKeyA";
function GetKeyNameTextA(lParam:integer;var lpString:string;cchSize:integer):integer;stdcall;external "User32.dll" name "GetKeyNameTextA";
//窗口相关
class function FindWindowA(lpClassName:string;lpWindowName:string):pointer;stdcall;external "User32.dll" name "FindWindowA";
class function GetForegroundWindow():pointer;stdcall;external "User32.dll" name "GetForegroundWindow";
class function GetActiveWindow():pointer;stdcall;external "User32.dll" name "GetActiveWindow";
class function SetActiveWindow(h:pointer):pointer;stdcall;external "user32.dll" name "SetActiveWindow";
function UpdateLayeredWindow(hWnd:pointer;hdcDst:pointer;pptDst:pointer;psize:pointer;hdcSrc:pointer;pptSrc:pointer; crKey:integer;pblend:pointer; dwFlags:pointer):integer;stdcall;external "User32.dll" name "UpdateLayeredWindow";
function GetFocus():pointer;stdcall;external "User32.dll" name "GetFocus";
function SetLayeredWindowAttributes(hwnd:pointer;crKey:integer;bAlpha:byte;dwFlags:integer):integer;stdcall;external "User32.dll" name "SetLayeredWindowAttributes";
class function IsWindow(hd:pointer):integer;stdcall;external "User32.dll" name "IsWindow";
class function IsWindowVisible(hd:pointer):integer;stdcall;external "User32.dll" name "IsWindowVisible";
function GetWindow(hd:pointer;cd:integer):pointer;stdcall;external "User32.dll" name "GetWindow";
function GetNextWindow(hd:pointer;cd:integer):pointer;stdcall;external "User32.dll" name "GetNextWindow";
function GetTopWindow(hd:pointer):pointer;stdcall;external "User32.dll" name "GetTopWindow";
function IsChild(hd:pointer;cd:pointer):integer;stdcall;external "User32.dll" name "IsChild";
function RegisterClassExA(wc:pointer):short;stdcall;external "User32.dll" name "RegisterClassExA";
function EnableWindow(wc:pointer;b:integer):integer;stdcall;external "User32.dll" name "EnableWindow";
//窗口操作
function ShowWindow(hwd :pointer;f:integer):integer;stdcall;external "User32.dll" name "ShowWindow";
function BringWindowToTop(hwd :pointer):integer;stdcall;external "User32.dll" name "BringWindowToTop";
function SetForegroundWindow(hwd :pointer):integer;stdcall;external "User32.dll" name "SetForegroundWindow";
function SetWindowPos(wd:pointer;hWndInsertAfter:pointer;
X:integer; Y:integer; cx:integer;cy:integer; uFlags:integer):pointer;stdcall;external "User32.dll" name "SetWindowPos";
function MoveWindow(wd:pointer; X:integer; Y:integer; cx:integer;cy:integer; bRepaint:integer):pointer;stdcall;external "User32.dll" name "MoveWindow";
//窗口大小
function GetClientRect(hwnd :pointer;var rec:array of integer):integer;stdcall;external "User32.dll" name "GetClientRect";
function GetWindowRect(hwnd :pointer;var rec:array of integer):integer;stdcall;external "User32.dll" name "GetWindowRect";
function GetWindowInfo(hwnd :pointer;f:pointer):integer;stdcall;external "User32.dll" name "GetWindowInfo";
function GetSystemMetrics(ndx :integer):integer;stdcall;external "User32.dll" name "GetSystemMetrics";
function ClientToScreen(hwnd :pointer;var p:array of integer):integer;stdcall;external "User32.dll" name "ClientToScreen";
function ScreenToClient(hwnd :pointer;var p:array of integer):integer;stdcall;external "User32.dll" name "ScreenToClient";
function GetParent(hwnd :pointer):pointer;stdcall;external "User32.dll" name "GetParent";
function SetParent(hwnd :pointer;phwnd:pointer):pointer;stdcall;external "User32.dll" name "SetParent";
function UpdateWindow(hwnd :pointer):integer;stdcall;external "User32.dll" name "UpdateWindow";
function GetUpdateRect(hWnd:pointer; var lpRect:array of integer;bErase:integer):integer;stdcall;external "User32.dll" name "GetUpdateRect";
function InvalidateRect(hwnd :pointer;rec:array of integer;f:integer):integer;stdcall;external "User32.dll" name "InvalidateRect";
function InvalidateRect2(hwnd :pointer;rec:pointer;f:integer):integer;stdcall;external "User32.dll" name "InvalidateRect";
function ValidateRect(hwnd :pointer;rec:array of integer):integer;stdcall;external "User32.dll" name "ValidateRect";
function SetFocus(hwnd :pointer):pointer;stdcall;external "User32.dll" name "SetFocus";
function GetWindowTextLengthA(hwnd :pointer):integer;stdcall;external "User32.dll" name "GetWindowTextLengthA";
function GetWindowTextA(hwnd :pointer;var s:string;l:integer):integer;stdcall;external "User32.dll" name "GetWindowTextA";
function SetWindowTextA(hwnd :pointer;s:string):integer;stdcall;external "User32.dll" name "SetWindowTextA";
function GetClassInfoExA(HH:pointer;lpszClass:string;lpwcx:pointer):integer;stdcall;external "User32.dll" name "GetClassInfoExA";
function DefWindowProc(hWnd:pointer;Msg:integer;wParam:pointer;lParam:pointer):integer;stdcall;external "User32.dll" name "DefWindowProc";
{$IFDEF win64}
function SetWindowLongPtrA(HH:pointer;idx:integer;dwNewLong:pointer):pointer;stdcall;external "User32.dll" name "SetWindowLongPtrA";
function GetWindowLongPtrA(HH:pointer;idx:integer):pointer;stdcall;external "User32.dll" name "GetWindowLongPtrA";
function SetClassLongPtrA(HH:pointer;idx:integer;dwNewLong:pointer):pointer;stdcall;external "User32.dll" name "SetClassLongPtrA";
function GetClassLongPtrA(HH:pointer;idx:integer):pointer;stdcall;external "User32.dll" name "GetClassLongPtrA";
{$ELSE}
function SetWindowLongPtrA(HH:pointer;idx:integer;dwNewLong:pointer):pointer;stdcall;external "User32.dll" name "SetWindowLongA";
function GetWindowLongPtrA(HH:pointer;idx:integer):pointer;stdcall;external "User32.dll" name "GetWindowLongA";
function SetClassLongPtrA(HH:pointer;idx:integer;dwNewLong:pointer):pointer;stdcall;external "User32.dll" name "SetClassLongA";
function GetClassLongPtrA(HH:pointer;idx:integer):pointer;stdcall;external "User32.dll" name "GetClassLongA";
{$ENDIF}
//function SetWindowLongA(HH:pointer;idx:integer;dwNewLong:pointer):pointer;stdcall;external "User32.dll" name "SetWindowLongA";
//function GetWindowLongA(HH:pointer;idx:integer):pointer;stdcall;external "User32.dll" name "GetWindowLongA";
function GetClassNameA(HH:pointer;var name:string;len:integer):pointer;stdcall;external "User32.dll" name "GetClassNameA";
function CreateWindowExA(dwExStyle:integer; lpClassName:string; lpWindowName:string;
dwStyle:integer;x:integer;y:integer;nWidth:integer;nHeight:integer;
hWndParent:pointer;hMenu:pointer; hInstance:pointer;lpParam:pointer):pointer;stdcall;external "User32.dll" name "CreateWindowExA";
function DestroyWindow(hWnd:pointer):integer;stdcall;external "User32.dll" name "DestroyWindow";
//消息相关
function CallWindowProcA(lpPrevWndFunc:pointer;hWnd:pointer;Msg:integer;wParam:pointer;lParam:pointer):pointer;stdcall;external "User32.dll" name "CallWindowProcA";
function DefWindowProcA(hWnd:pointer;Msg:integer;wParam:pointer;lParam:pointer):pointer;stdcall;external "User32.dll" name "DefWindowProcA";
function SendMessageA(hWnd:pointer;Msg:integer;wParam:pointer;lParam:pointer):pointer;stdcall;external "User32.dll" name "SendMessageA";
function PostMessageA(hWnd:pointer;Msg:integer;wParam:pointer;lParam:pointer):integer;stdcall;external "User32.dll" name "PostMessageA";
function GetMessageA(lpMsg:pointer;hWnd:pointer;wMsgFilterMin:integer;wMsgFilterMax:integer):integer;stdcall;external "User32.dll" name "GetMessageA";
function PeekMessageA(lpMsg:pointer; hWnd:pointer; wMsgFilterMin:integer; wMsgFilterMax:integer;wRemoveMsg:integer):integer ;stdcall;external "User32.dll" name "PeekMessageA";
function PostQuitMessage(code:integer);stdcall;external "User32.dll" name "PostQuitMessage";
function PostThreadMessageA(idThread:integer ;Msg:integer;wParam:pointer;lParam:pointer):integer;stdcall;external "User32.dll" name "PostThreadMessageA";
function TranslateMessage(msg:pointer):integer;stdcall;external "User32.dll" name "TranslateMessage";
function DispatchMessageA(msg:pointer):integer;stdcall;external "User32.dll" name "DispatchMessageA";
function TranslateAcceleratorA(hWnd:pointer; hAccTable:pointer;lpMsg:pointer):integer;stdcall;external "User32.dll" name "TranslateAcceleratorA";
function CreateAcceleratorTableA(paccel:pointer;cAccel:integer):pointer;stdcall;external "User32.dll" name "CreateAcceleratorTableA";
function DestroyAcceleratorTable(hAccel:pointer):integer;stdcall;external "User32.dll" name "DestroyAcceleratorTable";
//按键状态
Function GetKeyState(key:integer):short;stdcall;external "User32.dll" name "GetKeyState";
Function GetAsyncKeyState(key:integer):short;stdcall;external "User32.dll" name "GetAsyncKeyState";
//光标
function WindowFromPoint(X:integer; Y:integer):pointer;stdcall;external "User32.dll" name "WindowFromPoint";
function ClipCursor(rec:array of integer):integer;stdcall;external "User32.dll" name "ClipCursor";
function GetCursorPos(var point: array of integer):integer;stdcall;external "User32.dll" name "GetCursorPos";
function GetCursorInfo_( pci:pointer):integer;stdcall;external "User32.dll" name "GetCursorInfo";
function ShowCursor(bshow:integer):integer;stdcall;external "User32.dll" name "ShowCursor";
function SetCursorPos(x:integer;y:integer):integer;stdcall;external "User32.dll" name "SetCursorPos" ;
Function LoadCursorA(hd:pointer;n:string):pointer;stdcall;external "User32.dll" name "LoadCursorA";
Function LoadCursorA2(hd:pointer;n:pointer):pointer;stdcall;external "User32.dll" name "LoadCursorA";
Function SetCursor(hd:pointer):pointer;stdcall;external "User32.dll" name "SetCursor";
function CreateCursor(hInst:pointer; xHotSpot:integer;yHotSpot:integer; nWidth:integer; nHeight:integer; pvANDPlane:pointer; pvXORPlane:pointer):pointer;stdcall;external "User32.dll" name "CreateCursor";
//caret 插入符号
function CreateCaret(hWnd :pointer;hBitmap:pointer;nWidth:integer;nHeight:integer):integer;stdcall;external "User32.dll" name "CreateCaret";
function SetCaretPos(x:integer;y:integer):integer;stdcall;external "User32.dll" name "SetCaretPos";
function HideCaret(hwnd :pointer):integer;stdcall;external "User32.dll" name "HideCaret";
function DestroyCaret():integer;stdcall;external "User32.dll" name "DestroyCaret";
function SetCaretBlinkTime(uMSeconds :integer):integer;stdcall;external "User32.dll" name "SetCaretBlinkTime";
function ShowCaret(hwnd :pointer):integer;stdcall;external "User32.dll" name "ShowCaret";
function GetCaretBlinkTime():integer;stdcall;external "User32.dll" name "GetCaretBlinkTime";
function GetCaretPos(lp:array of integer):integer;stdcall;external "User32.dll" name "GetCaretPos";
function memcpy(dst:pointer;src:string;size_t:integer):pointer;cdecl;external "msvcrt.dll" name "memcpy";
function memcpy2(var dst:string;src:pointer;size_t:integer):pointer;cdecl;external "msvcrt.dll" name "memcpy";
function fopen(filename:string; mode:string):pointer;cdecl;external "msvcrt.dll" name "fopen";
function fclose(f:pointer):integer;cdecl;external "msvcrt.dll" name "fclose";
function LockFile(hFile:pointer; dwFileOffsetLow:integer; dwFileOffsetHigh:integer;nNumberOfBytesToLockLow:integer;nNumberOfBytesToLockHigh:integer):integer;stdcall;external "Kernel32.dll" name "LockFile";
function UnlockFile(hFile:pointer; dwFileOffsetLow:integer; dwFileOffsetHigh:integer;nNumberOfBytesToLockLow:integer;nNumberOfBytesToLockHigh:integer):integer;stdcall;external "Kernel32.dll" name "UnlockFile";
//icon
function DrawIcon(hDC:pointer;X:integer;Y:integer;hIcon:pointer):integer;stdcall;external "User32.dll" name "DrawIcon";
function CreateIcon(hInstance:pointer;nWidth:integer;nHeight:integer;cPlanes:byte;cBitsPixel:byte ;lpbANDbits:pointer;lpbXORbits:pointer):pointer;stdcall;external "User32.dll" name "CreateIcon";
function CreateIconIndirect(info:pointer):pointer;stdcall;external "User32.dll" name "CreateIconIndirect";
function CreateIcon2(hInstance:pointer;nWidth:integer;nHeight:integer;cPlanes:byte;cBitsPixel:byte ;var lpbANDbits:string;var lpbXORbits:string):pointer;stdcall;external "User32.dll" name "CreateIcon";
function DestroyIcon(icon:pointer):integer;stdcall;external "User32.dll" name "DestroyIcon";
function GetIconInfo(hIcon:pointer; piconinfo:pointer):integer;stdcall;external "User32.dll" name "GetIconInfo";
function DestroyCursor(cursor:pointer):integer;stdcall;external "User32.dll" name "DestroyCursor";
//scroll
function SetScrollRange(hWnd:pointer;nBar:integer;nMinPos:integer; nMaxPos:integer;bRedraw:integer):integer;stdcall;external "User32.dll" name "SetScrollRange";
function GetScrollRange(hWnd:pointer;nBar:integer;var nMinPos:integer; var nMaxPos:integer):integer;stdcall;external "User32.dll" name "GetScrollRange";
function SetScrollPos(hWnd:pointer;nBar:integer;Pos:integer;bRedraw:integer):integer;stdcall;external "User32.dll" name "SetScrollPos";
function GetScrollPos(hWnd:pointer;nBar:integer):integer;stdcall;external "User32.dll" name "GetScrollPos";
function ScrollWindow(hWnd:pointer;x:integer;y:integer; var lpRect:array of integer;var lpClipRect:array of integer):integer;stdcall;external "User32.dll" name "ScrollWindow";
function ScrollDC(hDC:pointer;dx:integer;dy:integer;var lprcScroll:array of integer; var lprcClip:array of integer;hrgnUpdate:pointer;lprcUpdate:pointer):integer;stdcall;external "User32.dll" name "ScrollDC";
function GetScrollInfo(hWnd:pointer;x:integer;info:pointer):integer;stdcall;external "User32.dll" name "GetScrollInfo";
function SetScrollInfo(hwnd:pointer; nBar:integer; lpsi:pointer;redraw:integer):integer;stdcall;external "User32.dll" name "SetScrollInfo";
//menu菜单类*****************************************************
Function CreateMenu():pointer;stdcall;external "User32.dll" name "CreateMenu";
Function CreatePopupMenu():pointer;stdcall;external "User32.dll" name "CreatePopupMenu";
Function DestroyMenu(hMenu:pointer):integer;stdcall;external "User32.dll" name "DestroyMenu";
Function IsMenu(hMenu:pointer):integer;stdcall;external "User32.dll" name "IsMenu";
function DeleteMenu(hMenu:pointer;uPosition:integer;uFlags:integer):integer;stdcall;external "User32.dll" name "DeleteMenu"; //会销毁
Function GetMenuInfo(hMenu:pointer;lpcmi:pointer):integer;stdcall;external "User32.dll" name "GetMenuInfo";
Function SetMenuInfo(hMenu:pointer;lpcmi:pointer):integer;stdcall;external "User32.dll" name "SetMenuInfo";
Function GetSubMenu(hMenu:pointer;nPos:integer):pointer;stdcall;external "User32.dll" name "GetSubMenu";
Function GetSystemMenu(hWnd:pointer;bRevert:integer):pointer;stdcall;external "User32.dll" name "GetSystemMenu";
Function RemoveMenu( hMenu:pointer; uPosition:integer;uFlags:integer):integer;stdcall;external "User32.dll" name "RemoveMenu";
Function SetMenuItemInfoA( hMenu:pointer; uItem:integer;fByPosition:integer;lpmii:pointer):integer;stdcall;external "User32.dll" name "SetMenuItemInfoA";
Function InsertMenuItemA( hMenu:pointer;uItem:integer;fByPosition:integer;lpmii:pointer):integer;stdcall;external "User32.dll" name "InsertMenuItemA";
function AppendMenuA(hMenu:pointer;uFlags:integer;uIDNewItem:pointer; var lpNewItem:string):integer;stdcall ;external "User32.dll" name "AppendMenuA";
function HiliteMenuItem(hWnd:pointer; hMenu:pointer; uIDHiliteItem:integer; uHilite:integer):integer;stdcall;external "User32.dll" name "HiliteMenuItem";
Function GetMenuItemInfoA( hMenu:pointer; uItem:integer;fByPosition:integer;lpmii:pointer):integer;stdcall;external "User32.dll" name "GetMenuItemInfoA";
Function TrackPopupMenu( hMenu:pointer;uFlags:integer; x:integer; y:integer; nReserved:integer;hWnd:pointer; prcRect: array of integer):integer;stdcall;external "User32.dll" name "TrackPopupMenu";
function TrackPopupMenuEx(hMenu:pointer;uFlags:integer;x:integer;y:integer;hwnd:pointer;lptpm:pointer):integer;stdcall;external "User32.dll" name "TrackPopupMenuEx";
Function ModifyMenuA( hMenu:pointer; uItem:integer;fByPosition:integer;lpmii:pointer;lpNewItem:string):integer;stdcall;external "User32.dll" name "ModifyMenuA";
Function GetMenuStringA(hMenu:pointer; uIDItem:integer; var lpString:string; nMaxCount:integer;uFlag:integer):integer;stdcall;external "User32.dll" name "GetMenuStringA";
Function RedrawWindow(hWnd:pointer;lprcUpdate:array of integer; hrgnUpdate:pointer;flags:integer):integer;stdcall;external "User32.dll" name "RedrawWindow";
//***************window menu*************************
Function DrawMenuBar(hwd:pointer):integer;stdcall;external "User32.dll" name "DrawMenuBar";
Function SetMenu(hwd:pointer;hmenu:pointer):integer;stdcall;external "User32.dll" name "SetMenu";
Function GetMenu(hwd:pointer):pointer;stdcall;external "User32.dll" name "GetMenu";
//**********************************************
function GetDesktopWindow():pointer;stdcall;external "User32.dll" name "GetDesktopWindow";
Function GetDC(hwd :pointer):pointer;stdcall;external "User32.dll" name "GetDC";
function GetWindowDC(hWnd:pointer):pointer;stdcall;external "User32.dll" name "GetWindowDC";
Function GetDCEx(hwd :pointer;hrgnClip:pointer;flags:integer):pointer;stdcall;external "User32.dll" name "GetDCEx";
Function LoadImageA(hinst:pointer;lpszName:string; uType:integer; cxDesired:integer;cyDesired:integer;fuLoad:integer):pointer;stdcall;external "User32.dll" name "LoadImageA";
function LoadBitmapA(hin:pointer;lpsz:string):pointer;stdcall;external "User32.dll" name "LoadBitmapA";
function LoadBitmapA2(hin:pointer;lpsz:pointer):pointer;stdcall;external "User32.dll" name "LoadBitmapA";
Function LoadIconA(hd:pointer;n:string):pointer;stdcall;external "User32.dll" name "LoadIconA";
Function LoadIconA2(hd:pointer;n:pointer):pointer;stdcall;external "User32.dll" name "LoadIconA";
Function DrawTextA(hdc :pointer;txt:string;len:integer;rec:array of integer;fmt:integer):integer;stdcall;external "User32.dll" name "DrawTextA";
Function DrawTextExA(hdc :pointer;txt:string;len:integer;rec:array of integer;fmt:integer;lpdtp:pointer):integer;stdcall;external "User32.dll" name "DrawTextExA";
Function DrawFrameControl(DC:pointer; var LPRECT: array of integer ; dr1 :integer;dr2:integer):integer;stdcall;external "User32.dll" name "DrawFrameControl";
function DrawEdge(hdc:pointer;var qrc:array of integer;edge:integer;grfFlags:integer):integer;;stdcall;external "User32.dll" name "DrawEdge";
function DrawFocusRect(hDC:pointer; var rect:array of integer):integer;stdcall;external "User32.dll" name "DrawFocusRect";
Function FillRect(dc:pointer;rec:array of integer;br:pointer):integer;stdcall;external "User32.dll" name "FillRect";
Function InvertRect(dc:pointer;rec:array of integer;br:pointer):integer;stdcall;external "User32.dll" name "InvertRect";
function ReleaseDC(hwd :pointer;hdc:pointer):integer;stdcall;external "User32.dll" name "ReleaseDC";
function BeginPaint(hwd :pointer;strc:pointer):pointer;stdcall;external "User32.dll" name "BeginPaint";
function EndPaint(hwd :pointer;strc:pointer):integer;stdcall;external "User32.dll" name "EndPaint";
function WindowFromDC(dc:pointer):pointer;stdcall;external "User32.dll" name "WindowFromDC";
function MessageBoxA(hwnd :pointer;txt:string;cap:string;flag:integer):integer;stdcall;external "User32.dll" name "MessageBoxA";
function TrackMouseEvent(lpEventTrack:pointer):integer;stdcall;external "User32.dll" name "TrackMouseEvent";
//Gdi32.dll
function SaveDC(hdc :pointer):integer;stdcall;external "Gdi32.dll" name "SaveDC";
function RestoreDC(hdc :pointer;nSavedDC:integer):integer;stdcall;external "Gdi32.dll" name "RestoreDC";
function DeleteDC(hdc :pointer):integer;stdcall;external "Gdi32.dll" name "DeleteDC";
{
https://msdn.microsoft.com/query/dev14.query?appId=Dev14IDEF1&l=ZH-CN&k=k(WINGDI%2FCreateCompatibleDC);k(CreateCompatibleDC);k(DevLang-C%2B%2B);k(TargetOS-Windows)&rd=true
If the function succeeds, the return value is the handle to a memory DC.
If the function fails, the return value is NULL.
}
function CreateCompatibleDC(hdc :pointer):pointer;stdcall;external "Gdi32.dll" name "CreateCompatibleDC";
{
https://msdn.microsoft.com/query/dev14.query?appId=Dev14IDEF1&l=ZH-CN&k=k(WINGDI%2FGetTextColor);k(GetTextColor);k(DevLang-C%2B%2B);k(TargetOS-Windows)&rd=true
}
Function GetTextColor(hdc :pointer):integer;stdcall;external "Gdi32.dll" name "GetTextColor";
Function SetTextColor(hdc :pointer;col:integer):integer;stdcall;external "Gdi32.dll" name "SetTextColor";
function GetTextExtentPoint32A(hdc:pointer;lpString:string;c:integer; psizl:pointer):integer;stdcall;external "Gdi32.dll" name "GetTextExtentPoint32A";
function GetTextExtentPoint32A2(hdc:pointer;lpString:string;c:integer; var psizl:array of integer):integer;stdcall;external "Gdi32.dll" name "GetTextExtentPoint32A";
function GetCharWidthA(hdc:pointer;iFirst:integer;iLast:integer;var lpBuffer:array of integer):integer;stdcall;external "Gdi32.dll" name "GetCharWidthA";
function GetCharABCWidthsA(hdc:pointer;wFirst:integer;wLast:integer; lpABC:pointer):integer;stdcall;external "Gdi32.dll" name "GetCharABCWidthsA";
function GetFontLanguageInfo(hdc:pointer):integer;stdcall;external "Gdi32.dll" name "GetFontLanguageInfo";
Function SetDCPenColor(hdc :pointer;col:integer):integer;stdcall;external "Gdi32.dll" name "SetDCPenColor";
Function GetDCPenColor(hdc :pointer):integer;stdcall;external "Gdi32.dll" name "GetDCPenColor";
Function GetDCBrushColor(hdc :pointer):integer;stdcall;external "Gdi32.dll" name "GetDCBrushColor";
Function SetDCBrushColor(hdc :pointer;col:integer):integer;stdcall;external "Gdi32.dll" name "SetDCBrushColor";
{
https://msdn.microsoft.com/query/dev14.query?appId=Dev14IDEF1&l=ZH-CN&k=k(WINGDI%2FRectangle);k(Rectangle);k(DevLang-C%2B%2B);k(TargetOS-Windows)&rd=true
}
Function Rectangle(hdc :pointer;l:integer;t:integer;r:integer;b:integer):integer;stdcall;external "Gdi32.dll" name "Rectangle";
Function Ellipse(hdc :pointer;l:integer;t:integer;r:integer;b:integer):integer;stdcall;external "Gdi32.dll" name "Ellipse";
Function RoundRect(hdc :pointer;l:integer;t:integer;r:integer;b:integer;wid:integer;ht:integer):integer;stdcall;external "Gdi32.dll" name "RoundRect";
Function Chord(hdc :pointer;l:integer;t:integer;r:integer;b:integer;wid:integer;ht:integer):integer;stdcall;external "Gdi32.dll" name "Chord";
Function Pie(hdc :pointer;nLeftRect:integer;nTopRect:integer;nRightRect:integer;nBottomRect:integer;nXRadial1:integer;nYRadial1:integer;nXRadial2:integer;nYRadial2:integer):integer;stdcall;external "Gdi32.dll" name "Pie";
Function SetArcDirection(hdc :pointer;direct:integer):integer;stdcall;external "Gdi32.dll" name "SetArcDirection";
Function Arc(hdc :pointer;nLeftRect:integer;nTopRect:integer;nRightRect:integer;nBottomRect:integer;nXRadial1:integer;nYRadial1:integer;nXRadial2:integer;nYRadial2:integer):integer;stdcall;external "Gdi32.dll" name "Arc";
Function Polygon(hdc :pointer;points:array of integer;n:integer):integer;stdcall;external "Gdi32.dll" name "Polygon";
Function PolyBezier(hdc :pointer;points:array of integer;n:integer):integer;stdcall;external "Gdi32.dll" name "PolyBezier";
Function SetPolyFillMode(hdc :pointer;md:integer):integer;stdcall;external "Gdi32.dll" name "SetPolyFillMode";
Function Polyline(hdc :pointer;points:array of integer;n:integer):integer;stdcall;external "Gdi32.dll" name "Polyline";
Function PolyPolyline(hdc :pointer;points:array of integer;pc:array of integer;n:integer):integer;stdcall;external "Gdi32.dll" name "PolyPolyline";
function ExtFloodFill(hdc:pointer;nXStart:integer; nYStart:integer;crColor:integer;fuFillType:integer):integer;stdcall;external "Gdi32.dll" name "ExtFloodFill";
function SetTextJustification(hdc:pointer;nBreakExtra:integer;nBreakCount:integer):integer;stdcall;external "Gdi32.dll" name "SetTextJustification";
function TransparentBlt( hdcDest:pointer; xoriginDest:integer; yoriginDest:integer; wDest:integer; hDest:integer;
hdcSrc:pointer; xoriginSrc:integer; yoriginSrc:integer; wSrc:integer; hSrc:integer; crTransparent:integer):integer;stdcall;external "Msimg32.dll" name "TransparentBlt";
function AlphaBlend( hdcDest:pointer; xoriginDest:integer; yoriginDest:integer; wDest:integer; hDest:integer;
hdcSrc:pointer; xoriginSrc:integer; yoriginSrc:integer; wSrc:integer; hSrc:integer; ftn:integer):integer;stdcall;external "Msimg32.dll" name "AlphaBlend";
function SetWindowExtEx(hdc:pointer;nXExtent:integer;nYExtent:integer;lpSize:pointer):integer;stdcall;external "Gdi32.dll" name "SetWindowExtEx";
function IntersectClipRect(hdc :pointer;nLeftRect:integer;nTopRect:integer;nRightRect:integer;nBottomRect:integer):integer;stdcall;external "Gdi32.dll" name "IntersectClipRect";
function GetDIBits(hdc:pointer; hbm:pointer;start:integer; cLines:integer;lpvBits:pointer;lpbmi:pointer; usage:integer):integer;stdcall;external "Gdi32.dll" name "GetDIBits";
function GetDIBits2(hdc:pointer; hbm:pointer;start:integer; cLines:integer;var lpvBits:string;lpbmi:pointer; usage:integer):integer;stdcall;external "Gdi32.dll" name "GetDIBits";
function SetDIBits2(hdc:pointer; hbmp:pointer;uStartScan:integer;cScanLines:integer;var lpvBits:string;lpbmi:pointer;fuColorUse:integer):integer;stdcall;external "Gdi32.dll" name "SetDIBits";
Function GetBitmapBits(bmp :pointer;len:integer;bf:pointer{var bf: array of integer }):integer;stdcall;external "Gdi32.dll" name "GetBitmapBits";
Function GetBitmapBits2(bmp :pointer;len:integer;var bf:string):integer;stdcall;external "Gdi32.dll" name "GetBitmapBits";
Function SetBitmapBits(bmp :pointer;len:integer;bf:pointer{var bf: array of integer }):integer;stdcall;external "Gdi32.dll" name "SetBitmapBits";
Function SetBitmapBits2(bmp :pointer;len:integer;var bf:string):integer;stdcall;external "Gdi32.dll" name "SetBitmapBits";
Function SetBitmapDimensionEx(hBitmap:pointer;nWidth:integer; nHeight:integer;VAR lpSize:array of integer):integer;stdcall;external "Gdi32.dll" name "SetBitmapDimensionEx";
Function GetBitmapDimensionEx(hBitmap:pointer;VAR ps:array of integer):integer;stdcall;external "Gdi32.dll" name "GetBitmapDimensionEx";
{
https://msdn.microsoft.com/query/dev14.query?appId=Dev14IDEF1&l=ZH-CN&k=k(WINGDI%2FGetTextMetrics);k(GetTextMetrics);k(DevLang-C%2B%2B);k(TargetOS-Windows)&rd=true
}
Function GetTextMetricsA(hdc :pointer;TM:pointer):integer;stdcall;external "Gdi32.dll" name "GetTextMetricsA";
Function MoveToEx(hdc :pointer;x:integer;y:integer;var point:array of integer):integer;stdcall;external "Gdi32.dll" name "MoveToEx" keepresident;
Function LineTo(hdc :pointer;x:integer;y:integer):integer;stdcall;external "Gdi32.dll" name "LineTo" keepresident;
Function TextOutA(hdc :pointer;X:integer;y:integer;txt:string;len:integer):integer;stdcall;external "Gdi32.dll" name "TextOutA";
//gdi path********************
function BeginPath(hdc:pointer):integer;stdcall;external "Gdi32.dll" name "BeginPath";
function EndPath(hdc:pointer):integer;stdcall;external "Gdi32.dll" name "EndPath";
function FillPath(hdc:pointer):integer;stdcall;external "Gdi32.dll" name "FillPath";
function StrokePath(hdc:pointer):integer;stdcall;external "Gdi32.dll" name "StrokePath";
function StrokeAndFillPath(hdc:pointer):integer;stdcall;external "Gdi32.dll" name "StrokeAndFillPath";
function AbortPath(hdc:pointer):integer;stdcall;external "Gdi32.dll" name "AbortPath";
function CloseFigure(hdc:pointer):integer;stdcall;external "Gdi32.dll" name "CloseFigure";
function FlattenPath(hdc:pointer):integer;stdcall;external "Gdi32.dll" name "FlattenPath";
function GetMiterLimit(hdc:pointer;var plimit:Single):integer;stdcall;external "Gdi32.dll" name "GetMiterLimit";
function GetPath(hdc:pointer;apt:array of integer;aj:integer;cpt:integer):integer;stdcall;external "Gdi32.dll" name "GetPath";
function PathToRegion(hdc:pointer):pointer;stdcall;external "Gdi32.dll" name "PathToRegion";
function SetMiterLimit(hdc:pointer;limit:Single;var od:Single):integer;stdcall;external "Gdi32.dll" name "SetMiterLimit";
function WidenPath(hdc:pointer):integer;stdcall;external "Gdi32.dll" name "WidenPath";
function PatBlt(hdc:pointer;nleftrect:integer;ntoprect:integer;nwidth:integer;nheight:pointer;fdwrop:integer):integer;stdcall;external "Gdi32.dll" name "PatBlt";
Function BitBlt(hdcDest:pointer;nXDest:integer;nYDest:integer;nWidth:integer;nHeight:integer;
hdcSrc :pointer;nXSrc:integer;nYSrc:integer;dwRop:integer):integer;stdcall;external "Gdi32.dll" name "BitBlt";
Function StretchBlt(hdcDest:pointer;nXOriginDest:integer; nYOriginDest:integer;nWidthDest:integer; nHeightDest:integer;
hdcSrc :pointer;nXOriginSrc:integer;nYOriginSrc:integer; nWidthSrc:integer; nHeightSrc:integer; dwRop:integer
):integer;stdcall;external "Gdi32.dll" name "StretchBlt";
Function SetStretchBltMode(hdc:pointer;iStretchMode:integer):integer;stdcall;external "Gdi32.dll" name "SetStretchBltMode";
function SelectObject(hdc :pointer;gdiobj:pointer):pointer;stdcall;external "Gdi32.dll" name "SelectObject";
function DeleteObject(gdiobj :pointer):integer;stdcall;external "Gdi32.dll" name "DeleteObject";
function CreateBitmap(nWidth:integer; nHeight:integer; cPlanes:integer;cBitsPerPel:integer;
lpvBits:pointer):pointer;stdcall;external "Gdi32.dll" name "CreateBitmap";
function CreateBitmap2(nWidth:integer; nHeight:integer; cPlanes:integer;cBitsPerPel:integer;
var lpvBits:string):pointer;stdcall;external "Gdi32.dll" name "CreateBitmap";
function CreateBitmaplndirect(bmp:pointer):pointer;stdcall;external "Gdi32.dll" name "CreateBitmaplndirect";
function CreateCompatibleBitmap(hdc:pointer;x:integer;y:integer):pointer;stdcall;external "Gdi32.dll" name "CreateCompatibleBitmap";
function CreatePen(fnPenStyle:integer;nWidth:integer;crColor:integer):pointer;stdcall;external "Gdi32.dll" name "CreatePen";
function CreatePenIndirect(LOGPEN :pointer):pointer;stdcall;external "Gdi32.dll" name "CreatePen";
function CreateSolidBrush(crColor:integer):pointer;stdcall;external "Gdi32.dll" name "CreateSolidBrush";
function CreateBrushIndirect(Logb:pointer):pointer;stdcall;external "Gdi32.dll" name "CreateBrushIndirect";
function CreatePatternBrush(bmp:pointer):pointer;stdcall;external "Gdi32.dll" name "CreatePatternBrush";
function CreateHatchBrush(fnStyle:integer;clrref:integer):pointer;stdcall;external "Gdi32.dll" name "CreateHatchBrush";
function CreateFontA(nHeight:integer;nWidth:integer;nEscapement:integer; nOrientation:integer;fnWeight:integer;
fdwItalic:integer;fdwUnderline:integer;fdwStrikeOut:integer;fdwCharSet:integer;fdwOutputPrecision:integer;
fdwClipPrecision:integer; fdwQuality:integer; fdwPitchAndFamily:integer;lpszFace:string):pointer;stdcall;external "Gdi32.dll" name "CreateFontA";
function CreateFontIndirectA(lplf:pointer):pointer;stdcall;external "Gdi32.dll" name "CreateFontIndirectA";
//https://msdn.microsoft.com/zh-cn/library/windows/desktop/dd183436(v=vs.85).aspx clipping functions
function GetStockObject(fnObject:integer):pointer;stdcall;external "Gdi32.dll" name "GetStockObject";
function CreatePalette(LOGPALETTE:pointer):pointer;stdcall;external "Gdi32.dll" name "CreatePalette";
function GetDeviceCaps(dc:pointer;idex:integer):integer;stdcall;external "Gdi32.dll" name "GetDeviceCaps";
function SetPixel(dc:pointer;x:integer;y:integer;col:integer):integer;stdcall;external "Gdi32.dll" name "SetPixel";
function CreateEllipticRgn(nLeftRect:integer;nTopRect:integer;nRightRect:integer;nBottomRect:integer):pointer;stdcall;external "Gdi32.dll" name "CreateEllipticRgn";
function CreatePolyPolygonRgn(ps:array of integer;pc:array of integer;len:integer;md:integer):pointer;stdcall;external "Gdi32.dll" name "CreatePolyPolygonRgn";
function SetROP2(hdc:pointer;fnDrawMode:integer):integer;stdcall;external "Gdi32.dll" name "SetROP2";
function CreateRectRgn(nLeftRect:integer;nTopRect:integer;nRightRect:integer;nBottomRect:integer):pointer;stdcall;external "Gdi32.dll" name "CreateRectRgn";
function CreatePolygonRgn(ps:array of integer;len:integer;md:integer):pointer;stdcall;external "Gdi32.dll" name "CreatePolygonRgn";
function CombineRgn(hrgnDest:pointer;hrgnSrc1:pointer;hrgnSrc2:pointer; fnCombineMode:integer):integer;stdcall;external "Gdi32.dll" name "CombineRgn";
function SelectClipRgn(dc:pointer;rgn:pointer):integer;stdcall;external "Gdi32.dll" name "SelectClipRgn";
function PtVisible(dc:pointer;x:integer;y:integer):integer;stdcall;external "Gdi32.dll" name "PtVisible";
function RectVisible(dc:pointer;rect:array of integer):integer;stdcall;external "Gdi32.dll" name "RectVisible";
function ExcludeClipRect(hdc:pointer;nLeftRect:integer;nTopRect:integer;nRightRect:integer;nBottomRect:integer;):integer;stdcall;external "Gdi32.dll" name "ExcludeClipRect";
function SetWindowOrgEx(hdc:pointer;x:integer;y:integer;var lppt: array of integer):integer;stdcall;external "Gdi32.dll" name "SetWindowOrgEx";
function SetViewportOrg(dc:pointer;x:integer;y:integer):integer;stdcall;external "Gdi32.dll" name "SetViewportOrg";
function SetViewportOrgEx(dc:pointer;x:integer;y:integer;var pt:array of integer):integer;stdcall;external "Gdi32.dll" name "SetViewportOrgEx";
Function FillRgn(dc:pointer;rgn:pointer;br:pointer):integer;stdcall;external "Gdi32.dll" name "FillRgn";
Function SetTextAlign(dc:pointer;fMode:integer):integer;stdcall;external "Gdi32.dll" name "SetTextAlign";
Function SetWorldTransform(dc:pointer;lpXform:pointer):integer;stdcall;external "Gdi32.dll" name "SetWorldTransform";
Function SetGraphicsMode(dc:pointer;iMode:integer):integer;stdcall;external "Gdi32.dll" name "SetGraphicsMode";
Function GetGraphicsMode(dc:pointer):integer;stdcall;external "Gdi32.dll" name "GetGraphicsMode";
Function SetMapMode(dc:pointer;iMode:integer):integer;stdcall;external "Gdi32.dll" name "SetMapMode";
Function SetBkColor(dc:pointer;clrref:integer):integer;stdcall;external "Gdi32.dll" name "SetBkColor";
Function GetBkColor(dc:pointer):integer;stdcall;external "Gdi32.dll" name "GetBkColor";
Function SetBkMode(dc:pointer;clrref:integer):integer;stdcall;external "Gdi32.dll" name "SetBkMode";
Function GetBkMode(dc:pointer):integer;stdcall;external "Gdi32.dll" name "GetBkMode";
Function GetObjectA(hgdiobj:pointer;cbBuffer:integer;lpvObject:pointer):integer;stdcall;external "Gdi32.dll" name "GetObjectA";
//**************Comctl32.dll***************************************************************
procedure GetEffectiveClientRect(hWnd:pointer;lprc:array of integer;lpInfo:array of integer);stdcall;external "Comctl32.dll" name "GetEffectiveClientRect";
function ImageList_Add(himl:pointer;hbmImage:pointer; hbmMask:pointer):integer;stdcall;external "Comctl32.dll" name "ImageList_Add";
function ImageList_AddMasked(himl:pointer;hbmImage:pointer; crMask:integer):integer;stdcall;external "Comctl32.dll" name "ImageList_AddMasked";
function ImageList_BeginDrag(himlTrack:pointer; iTrack:integer;dxHotspot:integer;dyHotspot:integer):integer;stdcall;external "Comctl32.dll" name "ImageList_BeginDrag";
function ImageList_DragMove(x:integer;y:integer):integer;stdcall;external "Comctl32.dll" name "ImageList_DragMove";
function ImageList_DragEnter(hwndLock:pointer;x:integer;y:integer):integer;stdcall;external "Comctl32.dll" name "ImageList_DragEnter";
function ImageList_DragLeave(hwndLock:pointer):integer;stdcall;external "Comctl32.dll" name "ImageList_DragLeave";
procedure ImageList_EndDrag();stdcall;external "Comctl32.dll" name "ImageList_EndDrag";
function ImageList_Create(cx:integer; cy:integer; flags:integer; cInitial:integer;cGrow:integer):pointer;stdcall;external "Comctl32.dll" name "ImageList_Create";
function ImageList_Draw(himl:pointer;i:integer;hdcDst:pointer;x:integer;y:integer;fStyle:integer):integer;stdcall;external "Comctl32.dll" name "ImageList_Draw";
function ImageList_Destroy(himl:pointer):integer;stdcall;external "Comctl32.dll" name "ImageList_Add";
function ImageList_Replace(himl:pointer;id:integer;hbmImage:pointer; hbmMask:pointer):integer;stdcall;external "Comctl32.dll" name "ImageList_Replace";
function ImageList_Remove(himl:pointer;id:integer):integer;stdcall;external "Comctl32.dll" name "ImageList_Remove";
function ImageList_SetBkColor(himl:pointer;clrBk:integer):integer;stdcall;external "Comctl32.dll" name "ImageList_SetBkColor";
function ImageList_LoadImageA2(hi:pointer;lpbmp:pointer;cx:integer;cGrow:integer; crMask:integer;uType:integer;uFlags:integer):pointer;stdcall;external "Comctl32.dll" name "ImageList_LoadImageA";
function ImageList_GetBkColor(himl:pointer):integer;stdcall;external "Comctl32.dll" name "ImageList_GetBkColor";
function ImageList_GetDragImage(ppt:pointer;pptHotspot:pointer):pointer;stdcall;external "Comctl32.dll" name "ImageList_GetDragImage";
function ImageList_GetImageCount(himl:pointer):integer;stdcall;external "Comctl32.dll" name "ImageList_GetImageCount";
function ImageList_SetImageCount(himl:pointer;clrBk:integer):integer;stdcall;external "Comctl32.dll" name "ImageList_SetImageCount";
function ImageList_Copy(himlDst:pointer;iDst:integer; himlSrc:pointer;iSrc:integer;uFlags:integer):integer;stdcall;external "Comctl32.dll" name "ImageList_Copy";
function ImageList_Duplicate(himl:pointer):pointer;stdcall;external "Comctl32.dll" name "ImageList_Duplicate";
function ImageList_Merge(himl1:pointer;i1:integer;himl2:pointer;i2:integer;dx:integer;dy:integer):pointer;stdcall;external "Comctl32.dll" name "ImageList_Merge";
function ImageList_SetDragCursorImage(himlDrag:pointer;iDrag:integer;dxHotspot:integer;dyHotspot:integer):integer;stdcall;external "Comctl32.dll" name "ImageList_SetDragCursorImage";
function ImageList_GetImageInfo(himl:pointer; i:integer;pImageInfo:pointer):integer;stdcall;external "Comctl32.dll" name "ImageList_GetImageInfo";
function ImageList_ReplaceIcon(himl:pointer;i:integer;hicon:pointer):integer;stdcall;external "Comctl32.dll" name "ImageList_ReplaceIcon";
function ImageList_SetIconSize(himl:pointer;cx:integer;cy:integer):integer;stdcall;external "Comctl32.dll" name "ImageList_SetIconSize";
function ImageList_GetIconSize(himl:pointer;var cx:integer;var cy:integer):integer;stdcall;external "Comctl32.dll" name "ImageList_GetIconSize";
function ImageList_GetIcon(himl:pointer;i:integer;flags:integer):pointer;stdcall;external "Comctl32.dll" name "ImageList_GetIcon";
function ImageList_DrawIndirect(pimldp:pointer):pointer;stdcall;external "Comctl32.dll" name "ImageList_DrawIndirect";
function ImageList_DragShowNolock(fShow:integer):integer;stdcall;external "Comctl32.dll" name "ImageList_DragShowNolock";
function InitCommonControlsEx(it:pointer):integer;stdcall;external "Comctl32.dll" name "InitCommonControlsEx";
function Comctl32DllGetVersion(it:pointer):pointer;stdcall;external "Comctl32.dll" name "DllGetVersion";
function GetOpenFileNameA(LPOPENFILENAMEA:pointer):integer;stdcall;external "Comdlg32.dll" name "GetOpenFileNameA" keepresident;
function GetSaveFileNameA(LPOPENFILENAMEA:pointer):integer;stdcall;external "Comdlg32.dll" name "GetSaveFileNameA";
function ChooseFontA(LOGFONTA:pointer):integer;stdcall;external "Comdlg32.dll" name "ChooseFontA";
function ChooseColorA(LOGFONTA:pointer):integer;stdcall;external "Comdlg32.dll" name "ChooseColorA";
//************************************
function Shell_NotifyIconA(dwMessage:integer; lpData:pointer):integer;stdcall;external "Shell32.dll" name "Shell_NotifyIconA";
function ILCreateFromPathA(pszPath:string):pointer;stdcall;external "Shell32.dll" name "ILCreateFromPathA";
procedure ILFree(pidl:pointer);stdcall;external "Shell32.dll" name "ILFree";
function SHBrowseForFolderA(LPITEMIDLIST:pointer):pointer;stdcall;external "Shell32.dll" name "SHBrowseForFolderA";
function SHGetPathFromIDListA(LPBROWSEINFOA:pointer;var buf:string ):integer;stdcall;external "Shell32.dll" name "SHGetPathFromIDListA";
function shell32DllGetVersion(it:pointer):pointer;stdcall;external "Shell32.dll" name "DllGetVersion";
function ShellExecuteExA(pExecInfo :pointer):integer;stdcall;external "Shell32.dll" name "ShellExecuteExA";
function SHGetFolderPathA(hwnd:pointer;csidl:integer;hToken:pointer;dwFlags:integer;var pszPath:string):integer;stdcall;external "Shell32.dll" name "SHGetFolderPathA";
//socket
function socket(af:integer;tp:integer;protocol:integer):pointer;stdcall;external "Ws2_32.dll" name "socket";
function WSAStartup(af:SHORT;DA:pointer):integer;stdcall;external "Ws2_32.dll" name "WSAStartup";
function WSACleanup():integer;stdcall;external "Ws2_32.dll" name "WSACleanup";
function htonl(hostlong:integer):integer;stdcall;external "Ws2_32.dll" name "htonl";
function htons(hostshort:short):short;stdcall;external "Ws2_32.dll" name "htons";
function ntohs(hostshort:short):short;stdcall;external "Ws2_32.dll" name "ntohs";
function bind(s:pointer;name:pointer;len:integer):integer;stdcall;external "Ws2_32.dll" name "bind";
function accept(s:pointer;name:pointer;var len:integer):pointer;stdcall;external "Ws2_32.dll" name "accept";
function send(s:pointer;bufer:string;len:integer;flag:integer):integer;stdcall;external "Ws2_32.dll" name "send";
function recv(s:pointer;var bufer:string;len:integer;flag:integer):integer;stdcall;external "Ws2_32.dll" name "recv";
function listen(s:pointer;port:integer):integer;stdcall;external "Ws2_32.dll" name "listen";
function closesocket(s:pointer):integer;stdcall;external "Ws2_32.dll" name "closesocket";
function connect(s:pointer;name:pointer;len:integer):integer;stdcall;external "Ws2_32.dll" name "connect";
function inet_addr(s:string):integer;stdcall;external "Ws2_32.dll" name "inet_addr";
function WSAGetLastError():integer;stdcall;external "Ws2_32.dll" name "WSAGetLastError";
function inet_ntoa(ad:integer):string;stdcall;external "Ws2_32.dll" name "inet_ntoa";
function shutdown(s:pointer;how:integer):integer;stdcall;external "Ws2_32.dll" name "shutdown";
function WSAAsyncSelect(s:pointer;hWnd:pointer;wMsg:integer;lEvent:integer):integer;stdcall;external "Ws2_32.dll" name "WSAAsyncSelect";
function ioctlsocket(s:pointer;cmd:integer;var argp:integer):integer;stdcall;external "Ws2_32.dll" name "ioctlsocket";
function setsockopt(s:pointer;level:integer;optname:integer;optval:string;optlen:integer):integer;stdcall;external "Ws2_32.dll" name "setsockopt";
function getsockopt(s:pointer;level:integer;optname:integer;var optval:string;var optlen:integer):integer;stdcall;external "Ws2_32.dll" name "getsockopt";
end
implementation
initialization
finalization
end.