From 56dbdaf5d7855632eeea4cfe820531bc24b09ee0 Mon Sep 17 00:00:00 2001 From: Alexey Kulakov Date: Wed, 15 Jan 2014 21:18:15 +0000 Subject: sync git-svn-id: http://svn.miranda-ng.org/main/trunk@7671 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c --- plugins/Utils.pas/CustomGraph.pas | 87 ++++ plugins/Utils.pas/common.pas | 742 +++++++++++++++----------- plugins/Utils.pas/compilers.inc | 168 ++++++ plugins/Utils.pas/dbsettings.pas | 74 ++- plugins/Utils.pas/editwrapper.pas | 187 ++++++- plugins/Utils.pas/i_struct_const.inc | 1 + plugins/Utils.pas/mApiCardM.pas | 32 +- plugins/Utils.pas/memini.pas | 2 + plugins/Utils.pas/old/hotkeys.pas | 574 -------------------- plugins/Utils.pas/old/ini.pas | 857 ------------------------------ plugins/Utils.pas/old/mApiCardC.pas | 397 -------------- plugins/Utils.pas/playlist.pas | 2 +- plugins/Utils.pas/sedit.pas | 102 ++-- plugins/Utils.pas/sparam.pas | 986 +++++++++++++++++++++++++++++++++++ plugins/Utils.pas/srvblock.pas | 488 +++++++++++++++++ plugins/Utils.pas/strans.pas | 8 + plugins/Utils.pas/uRect.pas | 283 ++++++++++ plugins/Utils.pas/wrapper.pas | 45 +- 18 files changed, 2850 insertions(+), 2185 deletions(-) create mode 100644 plugins/Utils.pas/CustomGraph.pas delete mode 100644 plugins/Utils.pas/old/hotkeys.pas delete mode 100644 plugins/Utils.pas/old/ini.pas delete mode 100644 plugins/Utils.pas/old/mApiCardC.pas create mode 100644 plugins/Utils.pas/sparam.pas create mode 100644 plugins/Utils.pas/srvblock.pas create mode 100644 plugins/Utils.pas/uRect.pas (limited to 'plugins') diff --git a/plugins/Utils.pas/CustomGraph.pas b/plugins/Utils.pas/CustomGraph.pas new file mode 100644 index 0000000000..638967df0c --- /dev/null +++ b/plugins/Utils.pas/CustomGraph.pas @@ -0,0 +1,87 @@ +unit CustomGraph; + +interface + +uses windows; + +const + clScrollBar = TCOLORREF(COLOR_SCROLLBAR or $80000000); + clBackground = TCOLORREF(COLOR_BACKGROUND or $80000000); + clActiveCaption = TCOLORREF(COLOR_ACTIVECAPTION or $80000000); + clInactiveCaption = TCOLORREF(COLOR_INACTIVECAPTION or $80000000); + clMenu = TCOLORREF(COLOR_MENU or $80000000); + clWindow = TCOLORREF(COLOR_WINDOW or $80000000); + clWindowFrame = TCOLORREF(COLOR_WINDOWFRAME or $80000000); + clMenuText = TCOLORREF(COLOR_MENUTEXT or $80000000); + clWindowText = TCOLORREF(COLOR_WINDOWTEXT or $80000000); + clCaptionText = TCOLORREF(COLOR_CAPTIONTEXT or $80000000); + clActiveBorder = TCOLORREF(COLOR_ACTIVEBORDER or $80000000); + clInactiveBorder = TCOLORREF(COLOR_INACTIVEBORDER or $80000000); + clAppWorkSpace = TCOLORREF(COLOR_APPWORKSPACE or $80000000); + clHighlight = TCOLORREF(COLOR_HIGHLIGHT or $80000000); + clHighlightText = TCOLORREF(COLOR_HIGHLIGHTTEXT or $80000000); + clBtnFace = TCOLORREF(COLOR_BTNFACE or $80000000); + clBtnShadow = TCOLORREF(COLOR_BTNSHADOW or $80000000); + clGrayText = TCOLORREF(COLOR_GRAYTEXT or $80000000); + clGreyText = TCOLORREF(COLOR_GRAYTEXT or $80000000); + clBtnText = TCOLORREF(COLOR_BTNTEXT or $80000000); + clInactiveCaptionText = TCOLORREF(COLOR_INACTIVECAPTIONTEXT or $80000000); + clBtnHighlight = TCOLORREF(COLOR_BTNHIGHLIGHT or $80000000); + cl3DDkShadow = TCOLORREF(COLOR_3DDKSHADOW or $80000000); + cl3DLight = TCOLORREF(COLOR_3DLIGHT or $80000000); + clInfoText = TCOLORREF(COLOR_INFOTEXT or $80000000); + clInfoBk = TCOLORREF(COLOR_INFOBK or $80000000); + + clBlack = TCOLORREF( $000000 ); + clMaroon = TCOLORREF( $000080 ); + clGreen = TCOLORREF( $008000 ); + clOlive = TCOLORREF( $008080 ); + clNavy = TCOLORREF( $800000 ); + clPurple = TCOLORREF( $800080 ); + clTeal = TCOLORREF( $808000 ); + clGray = TCOLORREF( $808080 ); + clGrey = TCOLORREF( $808080 ); + clSilver = TCOLORREF( $C0C0C0 ); + clRed = TCOLORREF( $0000FF ); + clLime = TCOLORREF( $00FF00 ); + clYellow = TCOLORREF( $00FFFF ); + clBlue = TCOLORREF( $FF0000 ); + clFuchsia = TCOLORREF( $FF00FF ); + clAqua = TCOLORREF( $FFFF00 ); + clLtGray = TCOLORREF( $C0C0C0 ); + clLtGrey = TCOLORREF( $C0C0C0 ); + clDkGray = TCOLORREF( $808080 ); + clDkGrey = TCOLORREF( $808080 ); + clWhite = TCOLORREF( $FFFFFF ); + clNone = TCOLORREF( $1FFFFFFF ); + clDefault = TCOLORREF( $20000000 ); + + clMoneyGreen = TCOLORREF( $C0DCC0 ); + clSkyBlue = TCOLORREF( $F0CAA6 ); + clCream = TCOLORREF( $F0FBFF ); + clMedGray = TCOLORREF( $A4A0A0 ); + clMedGrey = TCOLORREF( $A4A0A0 ); + clOrange = TCOLORREF( $3399FF ); + clBrown = TCOLORREF( $505080 ); + clDkBrown = TCOLORREF( $282840 ); + + clGRushHiLight = TCOLORREF( $F3706C ); + clGRushLighten = TCOLORREF( $F1EEDF ); + clGRushLight = TCOLORREF( $e1cebf ); + clGRushNormal = TCOLORREF( $D1beaf ); + clGRushMedium = TCOLORREF( $b6bFc6 ); + clGRushDark = TCOLORREF( $9EACB4 ); + +function ColorToRGB(Color: TCOLORREF):TCOLORREF; + +implementation + +function ColorToRGB(Color: TCOLORREF):TCOLORREF; +begin + if integer(Color) < 0 then + Result := GetSysColor(Color and $000000FF) + else + Result := Color; +end; + +end. diff --git a/plugins/Utils.pas/common.pas b/plugins/Utils.pas/common.pas index d36ecad588..056ac7af6a 100644 --- a/plugins/Utils.pas/common.pas +++ b/plugins/Utils.pas/common.pas @@ -13,7 +13,6 @@ windows {$ENDIF} ; -procedure ShowDump(ptr:pbyte;len:integer); Const {- Character sets -} sBinNum = ['0'..'1']; @@ -34,40 +33,11 @@ const HexDigitChr : array [0..15] of AnsiChar = ('0','1','2','3','4','5','6','7', '8','9','A','B','C','D','E','F'); -const - mimecnt = 5; - mimes:array [0..mimecnt-1] of record - mime:PAnsiChar; - ext:array [0..3] of AnsiChar - end = ( - (mime:'image/gif' ; ext:'GIF'), - (mime:'image/jpg' ; ext:'JPG'), - (mime:'image/jpeg'; ext:'JPG'), - (mime:'image/png' ; ext:'PNG'), - (mime:'image/bmp' ; ext:'BMP') -); - var IsW2K, IsVista, IsAnsi:boolean; -const - CP_UNICODE = 1200; - CP_REVERSEBOM = 65534; -const - SIGN_UNICODE = $FEFF; - SIGN_REVERSEBOM = $FFFE; - SIGN_UTF8 = $BFBBEF; - -function BSwap(value:dword):dword; - -function Hash(s:pointer; len:integer{const Seed: LongWord=$9747b28c}): LongWord; - -function Encode(dst,src:pAnsiChar):PAnsiChar; -function Decode(dst,src:pAnsiChar):PAnsiChar; -function GetTextFormat(Buffer:pByte;sz:cardinal):integer; - function IIF(cond:bool;ret1,ret2:integer ):integer; overload; function IIF(cond:bool;ret1,ret2:PAnsiChar):PAnsiChar; overload; function IIF(cond:bool;ret1,ret2:pWideChar):pWideChar; overload; @@ -78,19 +48,50 @@ function IIF(cond:bool;const ret1,ret2:string):string; overload; {$IFNDEF DELPHI_7_UP} function IIF(cond:bool;ret1,ret2:variant ):variant; overload; {$ENDIF} +function Min(a,b:integer):integer; +function Max(a,b:integer):integer; function GetImageType (buf:pByte;mime:PAnsiChar=nil):dword; function GetImageTypeW(buf:pByte;mime:PWideChar=nil):int64; +//----- Clipboard ----- + procedure CopyToClipboard(txt:pointer; Ansi:bool); function PasteFromClipboard(Ansi:boolean;cp:dword=CP_ACP):pointer; +//----- Memory ----- + function mGetMem (var dst;size:integer):pointer; procedure mFreeMem(var ptr); function mReallocMem(var dst; size:integer):pointer; +procedure FillWord(var buf;count:cardinal;value:word); register; +function CompareMem(P1, P2: Pointer; Length: Integer): Boolean; +procedure ShowDump(ptr:pbyte;len:integer); +function BSwap(value:dword):dword; +function Hash(s:pointer; len:integer{const Seed: LongWord=$9747b28c}): LongWord; -// String processing +type + tSortProc = function (First,Second:integer):integer; + {0=equ; 1=1st>2nd; -1=1st<2nd } +procedure ShellSort(size:integer;Compare,Swap:tSortProc); + +//----- String processing ----- function FormatStrW(fmt:pWideChar; arr:array of pWideChar):pWideChar; +function FormatSimpleW(fmt:pWideChar; arr:array of const):pWideChar; + +const + SIGN_UNICODE = $FEFF; + SIGN_REVERSEBOM = $FFFE; + SIGN_UTF8 = $BFBBEF; +const + CP_ACP = 0; + CP_UTF8 = 65001; + CP_UNICODE = 1200; + CP_REVERSEBOM = 65534; +// trying to recognize text encoding. Returns CP_ +function GetTextFormat(Buffer:pByte;sz:cardinal):integer; + +//----- Encoding conversion ----- function WideToCombo(src:PWideChar;var dst;cp:integer=CP_ACP):integer; @@ -112,10 +113,17 @@ function FastAnsiToWideBuf(src:PAnsiChar;dst:PWideChar;len:cardinal=cardinal(-1) function FastWideToAnsi (src:PWideChar;var dst:PAnsiChar):PAnsiChar; function FastAnsiToWide (src:PAnsiChar;var dst:PWideChar):PWideChar; +// encode/decode text (URL coding) +function Encode(dst,src:pAnsiChar):PAnsiChar; +function Decode(dst,src:pAnsiChar):PAnsiChar; +// '\n'(#13#10) and '\t' (#9) (un)escaping function UnEscape(buf:PAnsiChar):PAnsiChar; function Escape (buf:PAnsiChar):PAnsiChar; +procedure UpperCase(src:pWideChar); +procedure LowerCase(src:pWideChar); + +//----- base strings functions ----- -// ----- base strings functions ----- function StrDup (var dst:PAnsiChar;src:PAnsiChar;len:cardinal=0):PAnsiChar; function StrDupW(var dst:PWideChar;src:PWideChar;len:cardinal=0):PWideChar; function StrDelete (aStr:PAnsiChar;pos,len:cardinal):PAnsiChar; @@ -149,15 +157,44 @@ function StrPosW(const aStr, aSubStr: PWideChar): PWideChar; function StrIndex (const aStr, aSubStr: PAnsiChar):integer; function StrIndexW(const aStr, aSubStr: PWideChar):integer; -procedure FillWord(var buf;count:cardinal;value:word); register; -function CompareMem(P1, P2: Pointer; Length: Integer): Boolean; +function GetPairChar(ch:AnsiChar):AnsiChar; overload; +function GetPairChar(ch:WideChar):WideChar; overload; -function Min(a,b:integer):integer; -function Max(a,b:integer):integer; +//----- String/number conversion ----- + +function IntToHex(dst:pWideChar;Value:int64;Digits:integer=0):pWideChar; overload; +function IntToHex(dst:PAnsiChar;Value:int64;Digits:integer=0):PAnsiChar; overload; +function IntToStr(dst:pWideChar;Value:int64;Digits:integer=0):pWideChar; overload; +function IntToStr(dst:PAnsiChar;Value:int64;Digits:integer=0):PAnsiChar; overload; +function StrToInt(src:pWideChar):int64; overload; +function StrToInt(src:PAnsiChar):int64; overload; +function HexToInt(src:pWideChar;len:cardinal=$FFFF):int64; overload; +function HexToInt(src:PAnsiChar;len:cardinal=$FFFF):int64; overload; +function NumToInt(src:pWideChar):int64; overload; +function NumToInt(src:pAnsiChar):int64; overload; + +//----- Date and Time ----- +const + SecondsPerDay = 24*60*60; + // Days between 1/1/0001 and 12/31/1899 + DateDelta = 693594; + // Days between TDateTime basis (12/31/1899) and Unix time_t basis (1/1/1970) + UnixDateDelta = 25569; + // Days between Unix time_t basis (1/1/1970) and Windows timestamp (1/1/1601) + WinDateDelta = 134774; // + +function IsLeapYear(Year:Word):Boolean; +function EncodeTime(Hour, Minute, Sec: cardinal):TDateTime; +function EncodeDate(Year, Month , Day: cardinal):TDateTime; function Timestamp(Year,Month,Day:cardinal;Hour:cardinal=0;Minute:cardinal=0;Sec:cardinal=0):dword; function GetCurrentTime:dword; +procedure UnixTimeToFileTime(ts:int_ptr; var pft:TFILETIME); +function FileTimeToUnixTime(const pft: TFILETIME):int_ptr; +function TimeStampToLocalTimeStamp(ts:int_ptr):int_ptr; +function TimestampToDateTime(ts:int_ptr):TDateTime; + function TimeToInt(stime:PAnsiChar):integer; overload; function TimeToInt(stime:PWideChar):integer; overload; function IntToTime(dst:pWideChar;time:integer):pWideChar; overload; @@ -176,18 +213,6 @@ function IntToTime(dst:PAnsiChar;time:integer):PAnsiChar; overload; } function IntToK(dst:pWideChar;value,divider,prec,post:integer):pWideChar; -// string conversion -function IntToHex(dst:pWideChar;Value:int64;Digits:integer=0):pWideChar; overload; -function IntToHex(dst:PAnsiChar;Value:int64;Digits:integer=0):PAnsiChar; overload; -function IntToStr(dst:pWideChar;Value:int64;Digits:integer=0):pWideChar; overload; -function IntToStr(dst:PAnsiChar;Value:int64;Digits:integer=0):PAnsiChar; overload; -function StrToInt(src:pWideChar):int64; overload; -function StrToInt(src:PAnsiChar):int64; overload; -function HexToInt(src:pWideChar;len:cardinal=$FFFF):int64; overload; -function HexToInt(src:PAnsiChar;len:cardinal=$FFFF):int64; overload; -function NumToInt(src:pWideChar):int64; overload; -function NumToInt(src:pAnsiChar):int64; overload; - // filename work function ChangeExt (src,ext:PAnsiChar):PAnsiChar; function ChangeExtW(src,ext:PWideChar):PWideChar; @@ -196,138 +221,12 @@ function ExtractW(s:pWideChar;name:Boolean=true):pWideChar; function GetExt(fname,dst:pWideChar;maxlen:dword=100):pWideChar; overload; function GetExt(fname,dst:PAnsiChar;maxlen:dword=100):PAnsiChar; overload; -procedure UpperCase(src:pWideChar); -procedure LowerCase(src:pWideChar); -function GetPairChar(ch:AnsiChar):AnsiChar; overload; -function GetPairChar(ch:WideChar):WideChar; overload; - -type - tSortProc = function (First,Second:integer):integer; - {0=equ; 1=1st>2nd; -1=1st<2nd } -procedure ShellSort(size:integer;Compare,Swap:tSortProc); - function isPathAbsolute(path:pWideChar):boolean; overload; function isPathAbsolute(path:PAnsiChar):boolean; overload; -implementation - -// Murmur 2.0 -function Hash(s:pointer; len:integer{const Seed: LongWord=$9747b28c}): LongWord; -var - lhash: LongWord; - k: LongWord; - tmp,data: pByte; -const - // 'm' and 'r' are mixing constants generated offline. - // They're not really 'magic', they just happen to work well. - m = $5bd1e995; - r = 24; -begin - //The default seed, $9747b28c, is from the original C library - - // Initialize the hash to a 'random' value - lhash := {seed xor }len; - - // Mix 4 bytes at a time into the hash - data := s; - - while(len >= 4) do - begin - k := PLongWord(data)^; - - k := k*m; - k := k xor (k shr r); - k := k*m; - - lhash := lhash*m; - lhash := lhash xor k; - - inc(data,4); - dec(len,4); - end; - - // Handle the last few bytes of the input array - if len = 3 then - begin - tmp:=data; - inc(tmp,2); - lhash := lhash xor (LongWord(tmp^) shl 16); - end; - if len >= 2 then - begin - tmp:=data; - inc(tmp); - lhash := lhash xor (LongWord(tmp^) shl 8); - end; - if len >= 1 then - begin - lhash := lhash xor (LongWord(data^)); - lhash := lhash * m; - end; - - // Do a few final mixes of the hash to ensure the last few - // bytes are well-incorporated. - lhash := lhash xor (lhash shr 13); - lhash := lhash * m; - lhash := lhash xor (lhash shr 15); - - Result := lhash; -end; +//----------------------------------------------------------------------------- -function BSwap(value:dword):dword; - {$IFNDEF WIN64} -begin - asm - mov eax,value - bswap eax - mov result,eax - end; - {$ELSE} -begin - result:=((value and $000000FF) shl 6) + - ((value and $0000FF00) shl 2) + - ((value and $00FF0000) shr 2) + - ((value and $FF000000) shr 6); - {$ENDIF} -end; - -function Encode(dst,src:pAnsiChar):PAnsiChar; -begin - while src^<>#0 do - begin - if not (src^ in [' ','%','+','&','?',#128..#255]) then - dst^:=src^ - else - begin - dst^:='%'; inc(dst); - dst^:=HexDigitChr[ord(src^) shr 4]; inc(dst); - dst^:=HexDigitChr[ord(src^) and $0F]; - end; - inc(src); - inc(dst); - end; - dst^:=#0; - result:=dst; -end; - -function Decode(dst,src:pAnsiChar):PAnsiChar; -begin - while (src^<>#0) and (src^<>'&') do - begin - if (src^='%') and ((src+1)^ in sHexNum) and ((src+2)^ in sHexNum) then - begin - inc(src); - dst^:=AnsiChar(HexToInt(src,2)); - inc(src); - end - else - dst^:=src^; - inc(dst); - inc(src); - end; - dst^:=#0; - result:=dst; -end; +implementation const IS_TEXT_UNICODE_ASCII16 = $1; @@ -445,41 +344,70 @@ begin end; end; -function IIF(cond:bool;ret1,ret2:integer):integer; overload; +function IIF(cond:bool;ret1,ret2:integer):integer; overload;{$IFDEF AllowInline}inline;{$ENDIF} begin if cond then result:=ret1 else result:=ret2; end; -function IIF(cond:bool;ret1,ret2:PAnsiChar):PAnsiChar; overload; +function IIF(cond:bool;ret1,ret2:PAnsiChar):PAnsiChar; overload;{$IFDEF AllowInline}inline;{$ENDIF} begin if cond then result:=ret1 else result:=ret2; end; -function IIF(cond:bool;ret1,ret2:pWideChar):pWideChar; overload; +function IIF(cond:bool;ret1,ret2:pWideChar):pWideChar; overload;{$IFDEF AllowInline}inline;{$ENDIF} begin if cond then result:=ret1 else result:=ret2; end; -function IIF(cond:bool;ret1,ret2:Extended):Extended; overload; +function IIF(cond:bool;ret1,ret2:Extended):Extended; overload;{$IFDEF AllowInline}inline;{$ENDIF} begin if cond then result:=ret1 else result:=ret2; end; -function IIF(cond:bool;ret1,ret2:tDateTime):tDateTime; overload; +function IIF(cond:bool;ret1,ret2:tDateTime):tDateTime; overload;{$IFDEF AllowInline}inline;{$ENDIF} begin if cond then result:=ret1 else result:=ret2; end; -function IIF(cond:bool;ret1,ret2:pointer):pointer; overload; +function IIF(cond:bool;ret1,ret2:pointer):pointer; overload;{$IFDEF AllowInline}inline;{$ENDIF} begin if cond then result:=ret1 else result:=ret2; end; -function IIF(cond:bool;const ret1,ret2:string):string; overload; +function IIF(cond:bool;const ret1,ret2:string):string; overload;{$IFDEF AllowInline}inline;{$ENDIF} begin if cond then result:=ret1 else result:=ret2; end; {$IFNDEF DELPHI_7_UP} -function IIF(cond:bool;ret1,ret2:variant):variant; overload; +function IIF(cond:bool;ret1,ret2:variant):variant; overload;{$IFDEF AllowInline}inline;{$ENDIF} begin if cond then result:=ret1 else result:=ret2; end; {$ENDIF} +function Min(a,b:integer):integer;{$IFDEF AllowInline}inline;{$ENDIF} +begin + if a>b then + result:=b + else + result:=a; +end; + +function Max(a,b:integer):integer;{$IFDEF AllowInline}inline;{$ENDIF} +begin + if anil then + begin +{$IFDEF UseMMI} + mir_free(pointer(ptr)) +{$ELSE} + FreeMem(pointer(ptr)); +{$ENDIF} + Pointer(ptr):=nil; + end; +end; + +function mReallocMem(var dst; size:integer):pointer; +begin +{$IFDEF Use_MMI} + pointer(dst):=mir_realloc(pointer(dst),size) +{$ELSE} + ReallocMem(pointer(dst),size); +{$ENDIF} + result:=pointer(dst); +end; + +procedure ShowDump(ptr:pbyte;len:integer); +var + buf: array of Ansichar; + i:integer; + p:pAnsiChar; + p1:pByte; + cnt:integer; +begin + SetLength(buf,len*4+1); + p:=@buf[0]; + p1:=ptr; + cnt:=0; + for i:=0 to len-1 do + begin + IntToHex(p,p1^,2); + inc(p,2); + inc(p1); + inc(cnt); + if cnt=4 then + begin + cnt:=0; + p^:='.'; + inc(p); + end; + end; + p^:=#0; + messageboxa(0,@buf[0],'',0); +end; + +// Murmur 2.0 +function Hash(s:pointer; len:integer{const Seed: LongWord=$9747b28c}): LongWord; +var + lhash: LongWord; + k: LongWord; + tmp,data: pByte; +const + // 'm' and 'r' are mixing constants generated offline. + // They're not really 'magic', they just happen to work well. + m = $5bd1e995; + r = 24; +begin + //The default seed, $9747b28c, is from the original C library + + // Initialize the hash to a 'random' value + lhash := {seed xor }len; + + // Mix 4 bytes at a time into the hash + data := s; + + while(len >= 4) do + begin + k := PLongWord(data)^; + + k := k*m; + k := k xor (k shr r); + k := k*m; + + lhash := lhash*m; + lhash := lhash xor k; + + inc(data,4); + dec(len,4); + end; + + // Handle the last few bytes of the input array + if len = 3 then + begin + tmp:=data; + inc(tmp,2); + lhash := lhash xor (LongWord(tmp^) shl 16); + end; + if len >= 2 then + begin + tmp:=data; + inc(tmp); + lhash := lhash xor (LongWord(tmp^) shl 8); + end; + if len >= 1 then + begin + lhash := lhash xor (LongWord(data^)); + lhash := lhash * m; + end; + + // Do a few final mixes of the hash to ensure the last few + // bytes are well-incorporated. + lhash := lhash xor (lhash shr 13); + lhash := lhash * m; + lhash := lhash xor (lhash shr 15); + + Result := lhash; +end; + +function BSwap(value:dword):dword; + {$IFNDEF WIN64} +begin + asm + mov eax,value + bswap eax + mov result,eax + end; + {$ELSE} +begin + result:=((value and $000000FF) shl 24) + + ((value and $0000FF00) shl 8) + + ((value and $00FF0000) shr 8) + + ((value and $FF000000) shr 24); + {$ENDIF} +end; + +procedure ShellSort(size:integer;Compare,Swap:tSortProc); +var + i,j,gap:longint; begin - if pointer(ptr)<>nil then + gap:=size shr 1; + while gap>0 do begin -{$IFDEF UseMMI} - mir_free(pointer(ptr)) -{$ELSE} - FreeMem(pointer(ptr)); -{$ENDIF} - Pointer(ptr):=nil; + for i:=gap to size-1 do + begin + j:=i-gap; + while (j>=0) and (Compare(j,UInt(j+gap))>0) do + begin + Swap(j,UInt(j+gap)); + dec(j,gap); + end; + end; + gap:=gap shr 1; end; end; -function mReallocMem(var dst; size:integer):pointer; -begin -{$IFDEF Use_MMI} - pointer(dst):=mir_realloc(pointer(dst),size) -{$ELSE} - ReallocMem(pointer(dst),size); -{$ENDIF} - result:=pointer(dst); -end; - -function Min(a,b:integer):integer; +function Encode(dst,src:pAnsiChar):PAnsiChar; begin - if a>b then - result:=b - else - result:=a; + while src^<>#0 do + begin + if not (src^ in [' ','%','+','&','?',#128..#255]) then + dst^:=src^ + else + begin + dst^:='%'; inc(dst); + dst^:=HexDigitChr[ord(src^) shr 4]; inc(dst); + dst^:=HexDigitChr[ord(src^) and $0F]; + end; + inc(src); + inc(dst); + end; + dst^:=#0; + result:=dst; end; -function Max(a,b:integer):integer; +function Decode(dst,src:pAnsiChar):PAnsiChar; begin - if a#0) and (src^<>'&') do + begin + if (src^='%') and ((src+1)^ in sHexNum) and ((src+2)^ in sHexNum) then + begin + inc(src); + dst^:=AnsiChar(HexToInt(src,2)); + inc(src); + end + else + dst^:=src^; + inc(dst); + inc(src); + end; + dst^:=#0; + result:=dst; end; function UnEscape(buf:PAnsiChar):PAnsiChar; @@ -1133,23 +1214,35 @@ begin result:=buf; end; -procedure ShellSort(size:integer;Compare,Swap:tSortProc); +procedure UpperCase(src:pWideChar); var - i,j,gap:longint; + c:WideChar; begin - gap:=size shr 1; - while gap>0 do + if src<>nil then begin - for i:=gap to size-1 do + while src^<>#0 do begin - j:=i-gap; - while (j>=0) and (Compare(j,UInt(j+gap))>0) do - begin - Swap(j,UInt(j+gap)); - dec(j,gap); - end; + c:=src^; + if (c>='a') and (c<='z') then + src^:=WideChar(ord(c)-$20); + inc(src); + end; + end; +end; + +procedure LowerCase(src:pWideChar); +var + c:WideChar; +begin + if src<>nil then + begin + while src^<>#0 do + begin + c:=src^; + if (c>='A') and (c<='Z') then + src^:=WideChar(ord(c)+$20); + inc(src); end; - gap:=gap shr 1; end; end; @@ -1198,6 +1291,8 @@ begin end; end; +//----- String processing ----- + function FormatStrW(fmt:pWideChar; arr:array of pWideChar):pWideChar; var i,len:integer; @@ -1238,6 +1333,66 @@ begin pc^:=#0; end; +function FormatSimpleW(fmt:pWideChar; arr:array of const):pWideChar; +var + i,len:integer; + pc:pWideChar; + number:integer; +begin + result:=nil; + if (fmt=nil) or (fmt^=#0) then + exit; + + // calculate length + len:=StrLenW(fmt); // -2*Length(arr) + for i:=0 to HIGH(arr) do + begin + case arr[i].VType of + vtInteger : inc(len,10); // max len of VInteger text + vtPWideChar: inc(len,StrLenW(arr[i].VPWideChar)); + end; + end; + + // format + mGetMem(result,(len+1)*SizeOf(WideChar)); + pc:=result; + number:=0; + while fmt^<>#0 do + begin + if (fmt^='%') then + begin + case (fmt+1)^ of + 's': begin + if number<=HIGH(arr) then + begin + pc:=StrCopyEW(pc,arr[number].VPWideChar); + inc(number); + end; + inc(fmt,2); + end; + 'd': begin + if number<=HIGH(arr) then + begin + pc:=StrEndW(IntToStr(pc,arr[number].VInteger)); + inc(number); + end; + inc(fmt,2); + end; + '%': begin + pc^:='%'; + inc(pc); + inc(fmt,2); + end; + else + pc^:=fmt^; + inc(pc); + inc(fmt); + end; + end; + end; + pc^:=#0; +end; + // ----- base string functions ----- function StrDup(var dst:PAnsiChar;src:PAnsiChar;len:cardinal=0):PAnsiChar; var @@ -1798,7 +1953,7 @@ begin result:=(p-aStr)+1; //!!!! end; -// ----- filenames ----- +//----- filename work ----- function ChangeExt(src,ext:PAnsiChar):PAnsiChar; var @@ -1948,6 +2103,20 @@ begin end; end; +function isPathAbsolute(path:pWideChar):boolean; +begin + result:=((path[1]=':') and (path[2]='\')) or ((path[0]='\') {and (path[1]='\')}) or + (StrPosW(path,'://')<>nil); +end; + +function isPathAbsolute(path:pAnsiChar):boolean; +begin + result:=((path[1]=':') and (path[2]='\')) or ((path[0]='\') {and (path[1]='\')}) or + (StrPos(path,'://')<>nil); +end; + +//----- Date and Time ----- + type PDayTable = ^TDayTable; TDayTable = array [0..11] of cardinal; @@ -1957,11 +2126,6 @@ const ((31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31), (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)); -const - DateDelta = 693594; -{ Days between TDateTime basis (12/31/1899) and Unix time_t basis (1/1/1970) } - UnixDateDelta = 25569; - function IsLeapYear(Year:Word):Boolean; begin Result:=(Year mod 4=0) and ((Year mod 100<>0) or (Year mod 400=0)); @@ -1997,7 +2161,7 @@ begin t := t + EncodeTime(Hour, Minute, Sec) else t := t - EncodeTime(Hour, Minute, Sec); - result:=Round((t - UnixDateDelta) * 86400) + result:=Round((t - UnixDateDelta) * SecondsPerDay); end; function GetCurrentTime:dword; @@ -2008,6 +2172,38 @@ begin result:=Timestamp(st.wYear,st.wMonth,st.wDay,st.wHour,st.wMinute,st.wSecond); end; +procedure UnixTimeToFileTime(ts:int_ptr; var pft:TFILETIME); +var + ll:uint64; +begin + ll := (int64(WinDateDelta)*SecondsPerDay + ts) * 10000000; + pft.dwLowDateTime := DWORD(ll); + pft.dwHighDateTime := ll shr 32; +end; + +function FileTimeToUnixTime(const pft: TFILETIME):int_ptr; +var + ll:uint64; +begin + ll := (uint64(pft.dwHighDateTime) shl 32) or pft.dwLowDateTime; + ll := (ll div 10000000) - int64(WinDateDelta)*SecondsPerDay; + result := int_ptr(ll); +end; + +function TimeStampToLocalTimeStamp(ts:int_ptr):int_ptr; +var + ft,lft:TFileTime; +begin + UnixTimeToFileTime(ts,ft); + FileTimeToLocalFileTime(ft, lft); + result:=FileTimeToUnixTime(lft); +end; + +function TimestampToDateTime(ts:int_ptr):TDateTime; +begin + Result := UnixDateDelta + TimeStampToLocalTimeStamp(ts) / SecondsPerDay; +end; + function TimeToInt(stime:PAnsiChar):integer; var hour,minute,sec,len,i:integer; @@ -2096,8 +2292,13 @@ begin result:=FastAnsiToWideBuf(IntToTime(buf,time),dst); end; +//----- String/number conversion ----- + function NumToInt(src:pWideChar):int64; begin + result:=0; + if src=nil then exit; + if (src[0]='$') and (AnsiChar(src[1]) in sHexNum) then result:=HexToInt(src+1) @@ -2112,6 +2313,9 @@ end; function NumToInt(src:pAnsiChar):int64; begin + result:=0; + if src=nil then exit; + if (src[0]='$') and (src[1] in sHexNum) then result:=HexToInt(src+1) @@ -2308,38 +2512,6 @@ begin result:=dst; end; -procedure UpperCase(src:pWideChar); -var - c:WideChar; -begin - if src<>nil then - begin - while src^<>#0 do - begin - c:=src^; - if (c>='a') and (c<='z') then - src^:=WideChar(ord(c)-$20); - inc(src); - end; - end; -end; - -procedure LowerCase(src:pWideChar); -var - c:WideChar; -begin - if src<>nil then - begin - while src^<>#0 do - begin - c:=src^; - if (c>='A') and (c<='Z') then - src^:=WideChar(ord(c)+$20); - inc(src); - end; - end; -end; - function GetPairChar(ch:AnsiChar):AnsiChar; begin case ch of @@ -2434,46 +2606,6 @@ begin result:=dst; end; -function isPathAbsolute(path:pWideChar):boolean; -begin - result:=((path[1]=':') and (path[2]='\')) or ((path[0]='\') {and (path[1]='\')}) or - (StrPosW(path,'://')<>nil); -end; - -function isPathAbsolute(path:pAnsiChar):boolean; -begin - result:=((path[1]=':') and (path[2]='\')) or ((path[0]='\') {and (path[1]='\')}) or - (StrPos(path,'://')<>nil); -end; - -procedure ShowDump(ptr:pbyte;len:integer); -var - buf: array of Ansichar; - i:integer; - p:pAnsiChar; - p1:pByte; - cnt:integer; -begin - SetLength(buf,len*4+1); - p:=@buf[0]; - p1:=ptr; - cnt:=0; - for i:=0 to len-1 do - begin - IntToHex(p,p1^,2); - inc(p,2); - inc(p1); - inc(cnt); - if cnt=4 then - begin - cnt:=0; - p^:='.'; - inc(p); - end; - end; - p^:=#0; - messageboxa(0,@buf[0],'',0); -end; begin CheckSystem; end. diff --git a/plugins/Utils.pas/compilers.inc b/plugins/Utils.pas/compilers.inc index 95940246e1..b3280f17d7 100644 --- a/plugins/Utils.pas/compilers.inc +++ b/plugins/Utils.pas/compilers.inc @@ -133,12 +133,39 @@ {$ifdef Win64} + // BDS XE5 (BDS 9.0) DELPHI and BCB are no longer defined, only COMPILER + {$ifdef VER260} + {$define COMPILER_19} + {$endif VER260} + + // BDS XE4 (BDS 9.0) DELPHI and BCB are no longer defined, only COMPILER + {$ifdef VER250} + {$define COMPILER_18} + {$endif VER250} + + // BDS XE3 (BDS 9.0) DELPHI and BCB are no longer defined, only COMPILER + {$ifdef VER240} + {$define COMPILER_17} + {$endif VER240} + // BDS XE2 (BDS 9.0) DELPHI and BCB are no longer defined, only COMPILER {$ifdef VER230} {$define COMPILER_16} {$endif VER230} + {$ifdef COMPILER_19} + {$define COMPILER_19_UP} + {$endif} + + {$ifdef COMPILER_18} + {$define COMPILER_18_UP} + {$endif} + + {$ifdef COMPILER_17} + {$define COMPILER_17_UP} + {$endif} + {$ifdef COMPILER_16} {$define COMPILER_16_UP} {$endif} @@ -160,6 +187,21 @@ // Compiler defines not specific to a particlular platform. + // BDS XE5 (BDS 9.0) DELPHI and BCB are no longer defined, only COMPILER + {$ifdef VER260} + {$define COMPILER_19} + {$endif VER260} + + // BDS XE4 (BDS 9.0) DELPHI and BCB are no longer defined, only COMPILER + {$ifdef VER250} + {$define COMPILER_18} + {$endif VER250} + + // BDS XE3 (BDS 9.0) DELPHI and BCB are no longer defined, only COMPILER + {$ifdef VER240} + {$define COMPILER_17} + {$endif VER240} + // BDS XE2 (BDS 9.0) DELPHI and BCB are no longer defined, only COMPILER {$ifdef VER230} {$define COMPILER_16} @@ -766,6 +808,132 @@ {$endif} +{$endif} + +{$ifdef COMPILER_17} + {$define COMPILER_1_UP} + {$define COMPILER_2_UP} + {$define COMPILER_3_UP} + {$define COMPILER_4_UP} + {$define COMPILER_5_UP} + {$define COMPILER_6_UP} + {$define COMPILER_7_UP} + {$define COMPILER_8_UP} + {$define COMPILER_9_UP} + {$define COMPILER_10_UP} + {$define COMPILER_11_UP} + {$define COMPILER_12_UP} + {$define COMPILER_14_UP} + {$define COMPILER_15_UP} + {$define COMPILER_16_UP} + {$define COMPILER_17_UP} + // Backwards compatibility + {$define DELPHI_2_UP} + {$define DELPHI_3_UP} + {$define DELPHI_4_UP} + {$define DELPHI_5_UP} + {$define DELPHI_6_UP} + {$define DELPHI_7_UP} + {$define DELPHI_8_UP} + {$define DELPHI_9_UP} + {$define CPPB_3_UP} + {$define CPPB_4_UP} + {$define CPPB_5_UP} + {$define CPPB_6_UP} + + + {$ifdef BCB} + {$define CPPB} + {$else} + {$define DELPHI} + {$endif} + + +{$endif} + +{$ifdef COMPILER_18} + {$define COMPILER_1_UP} + {$define COMPILER_2_UP} + {$define COMPILER_3_UP} + {$define COMPILER_4_UP} + {$define COMPILER_5_UP} + {$define COMPILER_6_UP} + {$define COMPILER_7_UP} + {$define COMPILER_8_UP} + {$define COMPILER_9_UP} + {$define COMPILER_10_UP} + {$define COMPILER_11_UP} + {$define COMPILER_12_UP} + {$define COMPILER_14_UP} + {$define COMPILER_15_UP} + {$define COMPILER_16_UP} + {$define COMPILER_17_UP} + {$define COMPILER_18_UP} + // Backwards compatibility + {$define DELPHI_2_UP} + {$define DELPHI_3_UP} + {$define DELPHI_4_UP} + {$define DELPHI_5_UP} + {$define DELPHI_6_UP} + {$define DELPHI_7_UP} + {$define DELPHI_8_UP} + {$define DELPHI_9_UP} + {$define CPPB_3_UP} + {$define CPPB_4_UP} + {$define CPPB_5_UP} + {$define CPPB_6_UP} + + + {$ifdef BCB} + {$define CPPB} + {$else} + {$define DELPHI} + {$endif} + + +{$endif} + +{$ifdef COMPILER_19} + {$define COMPILER_1_UP} + {$define COMPILER_2_UP} + {$define COMPILER_3_UP} + {$define COMPILER_4_UP} + {$define COMPILER_5_UP} + {$define COMPILER_6_UP} + {$define COMPILER_7_UP} + {$define COMPILER_8_UP} + {$define COMPILER_9_UP} + {$define COMPILER_10_UP} + {$define COMPILER_11_UP} + {$define COMPILER_12_UP} + {$define COMPILER_14_UP} + {$define COMPILER_15_UP} + {$define COMPILER_16_UP} + {$define COMPILER_17_UP} + {$define COMPILER_18_UP} + {$define COMPILER_19_UP} + // Backwards compatibility + {$define DELPHI_2_UP} + {$define DELPHI_3_UP} + {$define DELPHI_4_UP} + {$define DELPHI_5_UP} + {$define DELPHI_6_UP} + {$define DELPHI_7_UP} + {$define DELPHI_8_UP} + {$define DELPHI_9_UP} + {$define CPPB_3_UP} + {$define CPPB_4_UP} + {$define CPPB_5_UP} + {$define CPPB_6_UP} + + + {$ifdef BCB} + {$define CPPB} + {$else} + {$define DELPHI} + {$endif} + + {$endif} {$UNDEF AllowInline} diff --git a/plugins/Utils.pas/dbsettings.pas b/plugins/Utils.pas/dbsettings.pas index 4d7da84f2a..dcd880175b 100644 --- a/plugins/Utils.pas/dbsettings.pas +++ b/plugins/Utils.pas/dbsettings.pas @@ -18,7 +18,7 @@ function DBReadUTF8 (hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;d function DBReadUnicode(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;default:PWideChar=nil):PWideChar; function DBReadStruct (hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar; - ptr:pointer;size:dword):Integer; + ptr:pointer;size:dword):uint_ptr; function DBWriteStruct(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar; ptr:pointer;size:dword):Integer; @@ -70,8 +70,9 @@ begin end; function DBReadSettingStr(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;dbv:PDBVARIANT):int_ptr; + {$IFDEF AllowInline}inline;{$ENDIF} begin - Result:=db_get_s(hContact,szModule,szSetting,dbv,DBVT_ASCIIZ); + result:=db_get_s(hContact, szModule, szSetting, dbv, DBVT_ASCIIZ); end; function DBReadStringLength(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar):integer; @@ -84,7 +85,7 @@ begin if (i<>0) or (dbv.szVal.a=nil) or (dbv.szVal.a^=#0) then result:=0 else - result:=lstrlena(dbv.szVal.a); + result:=StrLen(dbv.szVal.a); DBFreeVariant(@dbv); end; @@ -95,8 +96,7 @@ var i:int_ptr; begin FillChar(dbv,SizeOf(dbv),0); - dbv._type :=enc; - i:=db_get_s(hContact,szModule,szSetting,@dbv,DBVT_ASCIIZ); + i:=db_get_s(hContact,szModule,szSetting,@dbv,enc); if i=0 then default:=dbv.szVal.a; @@ -105,11 +105,11 @@ begin else StrDup(result,default); -//!! if i=0 then - DBFreeVariant(@dbv); + DBFreeVariant(@dbv); end; function DBReadUTF8(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;default:PAnsiChar=nil):PAnsiChar; + {$IFDEF AllowInline}inline;{$ENDIF} begin result:=DBReadString(hContact,szModule,szSetting,default,DBVT_UTF8); end; @@ -133,7 +133,7 @@ begin end; function DBReadStruct(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar; - ptr:pointer;size:dword):Integer; + ptr:pointer;size:dword):uint_ptr; var dbv:TDBVariant; begin @@ -143,9 +143,11 @@ begin if (DBReadSetting(0,szModule,szSetting,@dbv)=0) and (dbv.pbVal<>nil) and (dbv.cpbVal=size) then begin + if ptr=nil then + mGetMem(ptr,size); move(dbv.pbVal^,ptr^,size); DBFreeVariant(@dbv); - result:=1; + result:=uint_ptr(ptr) end else result:=0; @@ -233,17 +235,21 @@ function DBDeleteGroup(hContact:THANDLE;szModule:PAnsiChar;prefix:pAnsiChar=nil) var ces:TDBCONTACTENUMSETTINGS; p:PAnsiChar; - num,len:integer; + code,num:integer; ptr:pAnsiChar; + res:boolean; + len:cardinal; + mask:array [0..31] of AnsiChar; begin ces.szModule:=szModule; num:=0; - + //calculate size for setting names buffer ces.pfnEnumProc:=@EnumSettingsProcCalc; ces.lParam :=lParam(@num); ces.ofsSettings:=0; CallService(MS_DB_CONTACT_ENUMSETTINGS,hContact,lparam(@ces)); + //get setting names list GetMem(p,num+1); ptr:=p; ces.pfnEnumProc:=@EnumSettingsProc; @@ -253,15 +259,53 @@ begin ptr^:=#0; ptr:=p; + code:=0; if (prefix<>nil) and (prefix^<>#0) then - len:=StrLen(prefix) + begin + len:=StrLen(prefix); + + if prefix[len-1]='*' then // bla* + begin + code:=1; + dec(len); + end; + if prefix^='*' then // *bla + begin + code:=code or 2; + dec(len); + inc(prefix); + end; + end else len:=0; + StrCopy(mask,prefix,len); + while ptr^<>#0 do begin - if (len=0) or (StrCmp(prefix,ptr,len)=0) then + if len<>0 then begin - db_unset(hContact,szModule,ptr); + res:=false; + case code of + // postfix (right side) + 2: begin + num:=StrLen(ptr)-len; + if num>=0 then + res:=StrCmp(mask,ptr+num,len)=0; + end; + // content (left, middle or right, no matter) + 3: begin + res:=StrPos(ptr,mask)<>nil; + end; + else // 0 or 1, prefix (left side) + res:=StrCmp(mask,ptr,len)=0; + end; + end + else + res:=true; + + if res then + begin + DBDeleteSetting(hContact,szModule,ptr); end; while ptr^<>#0 do inc(ptr); inc(ptr); @@ -269,7 +313,7 @@ begin FreeMem(p); end; -function DBDeleteModule(szModule:PAnsiChar):integer; // 0.8.0+ +function DBDeleteModule(szModule:PAnsiChar):integer; begin result:=0; CallService(MS_DB_MODULE_DELETE,0,lParam(szModule)); diff --git a/plugins/Utils.pas/editwrapper.pas b/plugins/Utils.pas/editwrapper.pas index 1a66929bfd..a3cd58debc 100644 --- a/plugins/Utils.pas/editwrapper.pas +++ b/plugins/Utils.pas/editwrapper.pas @@ -6,8 +6,8 @@ uses windows; // exported flags const - EF_SCRIPT = 1; - EF_ALL = EF_SCRIPT; // what can be changed + EF_SCRIPT = 1; // right now, just "Variables" script + EF_ALL = EF_SCRIPT; // what can be changed in runtime EF_FORCES = $80; EF_FORCET = $40; EF_FORCE = EF_FORCES or EF_FORCET; @@ -22,6 +22,14 @@ function EnableEditField(Dialog:HWND; id:uint; enable:boolean):boolean; overload function ShowEditField(wnd:HWND; mode:integer):boolean;overload; function ShowEditField(Dialog:HWND; id:uint; mode:integer):boolean;overload; +{ + -1 - cancel + 1 - script + 0 - new text +} +function ShowEditBox(parent:HWND;var text:pWideChar;title:pWideChar):int_ptr; + + implementation uses messages,commctrl,common,wrapper,m_api; @@ -373,4 +381,179 @@ begin result:=ShowEditField(GetDlgItem(Dialog,id),mode); end; +//----- Separate Edit window ----- + +type + pResultText = ^tResultText; + tResultText = record + text:pWideChar; + typ :integer; + end; + pSepDlgParam = ^tSepDlgParam; + tSepDlgParam = record + title:pWideChar; + text :pWideChar; + end; + +function EditWndProcSep(Dialog:HWnd;hMessage:uint;wParam:WPARAM;lParam:LPARAM):lresult; stdcall; +var + pc:pWideChar; + wnd,wnd1:HWND; + vhi:TVARHELPINFO; + p:pResultText; + cr:integer; + idshow,idhide:integer; + urd:TUTILRESIZEDIALOG; +begin + result:=0; + + case hMessage of + WM_DESTROY: begin + end; + + WM_INITDIALOG: begin + TranslateDialogDefault(Dialog); + + SetWindowTextW(Dialog,pSepDlgParam(lParam)^.title); + + idshow:=IDC_TEXT_EDIT_NW; + idhide:=IDC_TEXT_EDIT_W; + SetDlgItemTextW(Dialog,idshow,pSepDlgParam(lParam)^.text); + ShowWindow(GetDlgItem(Dialog,idshow),SW_SHOW); + ShowWindow(GetDlgItem(Dialog,idhide),SW_HIDE); + + wnd:=GetDlgItem(Dialog,IDC_SCRIPT_HELP); + if ServiceExists(MS_VARS_FORMATSTRING)<>0 then + begin + SendMessage(wnd,BM_SETIMAGE,IMAGE_ICON, + CallService(MS_VARS_GETSKINITEM,0,VSI_HELPICON)); + SendMessage(wnd,BUTTONADDTOOLTIP, + CallService(MS_VARS_GETSKINITEM,0,VSI_HELPTIPTEXT),0); +{ + SendMessage(wnd,BM_SETIMAGE,IMAGE_ICON, + CallService(MS_SKIN_LOADICON,SKINICON_OTHER_HELP,0)); +} + end + else + begin + ShowWindow(wnd,SW_HIDE); + end; + end; + + WM_GETMINMAXINFO: begin + with PMINMAXINFO(lParam)^ do + begin + ptMinTrackSize.x:=200; + ptMinTrackSize.y:=180; + end; + end; + + WM_SIZE: begin + FillChar(urd,SizeOf(TUTILRESIZEDIALOG),0); + urd.cbSize :=SizeOf(urd); + urd.hwndDlg :=Dialog; + urd.hInstance :=hInstance; + urd.lpTemplate:='IDD_EDITCONTROL'; + urd.lParam :=0; + urd.pfnResizer:=@EditDlgResizer; + CallService(MS_UTILS_RESIZEDIALOG,0,tlparam(@urd)); + end; + + WM_COMMAND: begin + case wParam shr 16 of + BN_CLICKED: begin + case loword(wParam) of + IDC_TEXT_WRAP: begin + if IsDlgButtonChecked(Dialog,IDC_TEXT_WRAP)<>BST_UNCHECKED then + begin + idshow:=IDC_TEXT_EDIT_W; + idhide:=IDC_TEXT_EDIT_NW; + end + else + begin + idshow:=IDC_TEXT_EDIT_NW; + idhide:=IDC_TEXT_EDIT_W; + end; + wnd :=GetDlgItem(Dialog,idhide); + wnd1:=GetDlgItem(Dialog,idshow); + pc:=GetDlgText(wnd); + SetDlgItemTextW(Dialog,idshow,pc); + mFreeMem(pc); + cr:=hiword(SendMessage(wnd,EM_GETSEL,0,0)); + SendMessage(wnd1,EM_SETSEL,-1,cr); + ShowWindow(wnd1,SW_SHOW); + ShowWindow(wnd ,SW_HIDE); + +// SetWindowLongPtr(wnd,GWL_STYLE,GetWindowLongPtr(wnd,GWL_STYLE) xor WS_HSCROLL); +// SetWindowLongPtr(wnd,GWL_STYLE,GetWindowLongPtr(wnd,GWL_STYLE) xor ES_AUTOHSCROLL); + + end; + + IDC_SCRIPT_HELP: begin + FillChar(vhi,SizeOf(vhi),0); + with vhi do + begin + cbSize:=SizeOf(vhi); + flags :=VHF_FULLDLG or VHF_SETLASTSUBJECT; + if IsDlgButtonChecked(Dialog,IDC_TEXT_WRAP)<>BST_UNCHECKED then + hwndCtrl:=GetDlgItem(Dialog,IDC_TEXT_EDIT_W) + else + hwndCtrl:=GetDlgItem(Dialog,IDC_TEXT_EDIT_NW); + end; + CallService(MS_VARS_SHOWHELPEX,Dialog,tlparam(@vhi)); + end; + + IDOK: begin + mGetMem(p,SizeOf(tResultText)); + + if IsDlgButtonChecked(Dialog,IDC_TEXT_SCRIPT)<>BST_UNCHECKED then + p^.typ:=1 + else + p^.typ:=0; + + if IsDlgButtonChecked(Dialog,IDC_TEXT_WRAP)<>BST_UNCHECKED then + p^.text:=GetDlgText(Dialog,IDC_TEXT_EDIT_W) + else + p^.text:=GetDlgText(Dialog,IDC_TEXT_EDIT_NW); + + EndDialog(Dialog,uint_ptr(p)); + end; + + IDCANCEL: begin // clear result / restore old value + EndDialog(Dialog,0); + end; + end; + end; + end; + end; +{ + WM_NOTIFY: begin + case integer(PNMHdr(lParam)^.code) of + PSN_APPLY: begin + end; + end; + end; +} + end; +end; + +function ShowEditBox(parent:HWND;var text:pWideChar;title:pWideChar):int_ptr; +var + tmp:pResultText; + par:tSepDlgParam; +begin + par.title:=title; + par.text :=text; + result:=DialogBoxParamW(hInstance,'IDD_EDITCONTROL',parent,@EditWndProcSep,tlparam(@par)); + if result<>0 then + begin + tmp:=pResultText(result); + text :=tmp^.text; + result:=tmp^.typ; + mFreeMem(tmp); + end + else + result:=-1; +end; + end. diff --git a/plugins/Utils.pas/i_struct_const.inc b/plugins/Utils.pas/i_struct_const.inc index 00e0b9324e..89def4db9c 100644 --- a/plugins/Utils.pas/i_struct_const.inc +++ b/plugins/Utils.pas/i_struct_const.inc @@ -13,6 +13,7 @@ const // Structure editor IDC_DATA_FULL = 2001; IDC_DATA_TYPE = 2002; + IDC_DATA_SIZE = 2004; IDC_DATA_EDIT = 2005; IDC_DATA_LEN = 2006; IDC_DATA_HELP = 2007; diff --git a/plugins/Utils.pas/mApiCardM.pas b/plugins/Utils.pas/mApiCardM.pas index 41ce4e2aa3..9d96fbdbb7 100644 --- a/plugins/Utils.pas/mApiCardM.pas +++ b/plugins/Utils.pas/mApiCardM.pas @@ -11,6 +11,7 @@ type function GetDescription:pAnsiChar; function GetResultType :pAnsiChar; procedure SetCurrentService(item:pAnsiChar); + function GetWindowStatus:boolean; public constructor Create(fname:pAnsiChar; lparent:HWND=0); destructor Destroy; override; @@ -19,12 +20,14 @@ type function NameFromList(cb:HWND):pAnsiChar; function HashToName(ahash:longword):pAnsiChar; function FillParams(wnd:HWND{;item:pAnsiChar};wparam:boolean):pAnsiChar; + function GetParam(wparam:boolean):pAnsiChar; procedure Show;//(item:pAnsiChar); property Description:pAnsiChar read GetDescription; property ResultType :pAnsiChar read GetResultType; property Service :pAnsiChar write SetCurrentService; property Event :pAnsiChar write SetCurrentService; + property IsShown :boolean read GetWindowStatus; private storage:pointer; current:pointer; @@ -86,6 +89,28 @@ begin result:=nil; end; +function tmApiCard.GetWindowStatus:boolean; +begin + result:=HelpWindow<>0; +end; + +function tmApiCard.GetParam(wparam:boolean):pAnsiChar; +var + paramname:pAnsiChar; +begin + if storage=nil then + begin + result:=nil; + exit; + end; + if wparam then + paramname:='wparam' + else + paramname:='lparam'; + + StrDup(result,GetParamSectionStr(current,paramname,'')); +end; + function tmApiCard.FillParams(wnd:HWND{;item:pAnsiChar};wparam:boolean):pAnsiChar; var buf :array [0..2047] of AnsiChar; @@ -107,6 +132,10 @@ begin StrCopy(buf,GetParamSectionStr(current,paramname,'')); StrDup(result,@buf); + + if wnd=0 then + exit; + SendMessage(wnd,CB_RESETCONTENT,0,0); if buf[0]<>#0 then begin @@ -139,7 +168,7 @@ begin begin FastAnsitoWideBuf(p,tmp); SendMessageW(wnd,CB_ADDSTRING,0,lparam(TranslateW(tmp))); - if (p=@buf) and (lstrcmpia(p,'structure')=0) then + if (p=@buf) and (StrCmp(p,'structure')=0) then break; end; p:=pc+1; @@ -184,6 +213,7 @@ begin // edit field is text from list if StrCmp(pc,@buf)=0 then begin + mFreeMem(pc); result:=HashToName(CB_GetData(cb,idx)); exit; end; diff --git a/plugins/Utils.pas/memini.pas b/plugins/Utils.pas/memini.pas index d82a84ace9..31e7d58747 100644 --- a/plugins/Utils.pas/memini.pas +++ b/plugins/Utils.pas/memini.pas @@ -466,6 +466,8 @@ var nsn,nss:integer; begin result:=nil; + if storage=nil then exit; + nss:=HashOf(section); if namespace=nil then begin diff --git a/plugins/Utils.pas/old/hotkeys.pas b/plugins/Utils.pas/old/hotkeys.pas deleted file mode 100644 index 32f6e201e5..0000000000 --- a/plugins/Utils.pas/old/hotkeys.pas +++ /dev/null @@ -1,574 +0,0 @@ -{Hotkey and timer related functions} -unit hotkeys; - -interface - -uses windows; - -type - AWKHotKeyProc = function(hotkey:integer):integer; - -function AddProc(aproc:AWKHotKeyProc;ahotkey:integer;global:bool=false):integer; overload; -function AddProc(ahotkey:integer;wnd:HWND;aproc:AWKHotKeyProc ):integer; overload; -function AddProc(ahotkey:integer;wnd:HWND;msg:uint_ptr ):integer; overload; -function DelProc(hotkey:integer ):integer; overload; -function DelProc(hotkey:integer;wnd:HWND):integer; overload; - -procedure InitHotKeys; -procedure FreeHotKeys; - -implementation - -uses messages; - -const - HWND_MESSAGE = HWND(-3); - -var - CurThread:THANDLE; - -type - PKBDLLHOOKSTRUCT = ^TKBDLLHOOKSTRUCT; - TKBDLLHOOKSTRUCT = record - vkCode :dword; - scanCode :dword; - flags :dword; - time :dword; - dwExtraInfo:dword; - end; - -const - WH_KEYBOARD_LL = 13; - WM_MYMESSAGE = WM_USER +13; - -// const from commctrl module; -const - HOTKEYF_SHIFT = $01; - HOTKEYF_CONTROL = $02; - HOTKEYF_ALT = $04; - HOTKEYF_EXT = $08; - -const - hkAssigned = 1; - hkGlobal = 2; - hkMessage = 4; -const - kbHook:THANDLE=0; - hiddenwindow:HWND=0; - modifiers:dword=0; -const - PageStep = 10; -type - PHKRec = ^THKRec; - THKRec = record - proc :AWKHotKeyProc; // procedure - flags :integer; // options - handle:THANDLE; // thread or window? - atom :TATOM; // hotkey id - hotkey:integer; // hotkey - end; - PHKRecs = ^THKRecs; - THKRecs = array [0..15] of THKRec; - -const - NumRecs:integer=0; - MaxRecs:integer=10; - hkRecs:pHKRecs=nil; - -//----- simpler version of 'common' function ----- - -const - HexDigitChr: array [0..15] of AnsiChar = ('0','1','2','3','4','5','6','7', - '8','9','A','B','C','D','E','F'); - -function IntToHex(dst:PAnsiChar;Value:cardinal):PAnsiChar; -var - Digits:integer; -begin - dst[8]:=#0; - Digits:=8; - repeat - Dec(Digits); - dst[Digits]:=HexDigitChr[Value and $F]; - Value:=Value shr 4; - until Digits=0; - result:=dst; -end; - -//----- utils ----- - -function GetAtom(hotkey:dword):dword; -const - HKPrefix = 'awk_'; -var - p:array [0..15] of AnsiChar; -begin - lstrcpya(p,HKPrefix); - IntToHex(p+Length(HKPrefix),hotkey); - result:=GlobalAddAtomA(p); -end; - -function HotKeyDlgToHook(w:cardinal):cardinal; register; -asm - movzx ecx,al - xor al,al - test ah,HOTKEYF_ALT - je @L1 - or al,MOD_ALT -@L1: - test ah,HOTKEYF_CONTROL - je @L2 - or al,MOD_CONTROL -@L2: - test ah,HOTKEYF_SHIFT - je @L3 - or al,MOD_SHIFT -@L3: - test ah,HOTKEYF_EXT - je @L4 - or al,MOD_WIN -@L4: - mov ch,al - mov eax,ecx -{ -begin - result:=w and $FF; - if (w and (HOTKEYF_ALT shl 8))<>0 then result:=result or (MOD_ALT shl 8); - if (w and (HOTKEYF_CONTROL shl 8))<>0 then result:=result or (MOD_CONTROL shl 8); - if (w and (HOTKEYF_SHIFT shl 8))<>0 then result:=result or (MOD_SHIFT shl 8); - if (w and (HOTKEYF_EXT shl 8))<>0 then result:=result or (MOD_WIN shl 8); -} -end; - -function HotKeyHookToDlg(w:cardinal):cardinal; register; -asm - movzx ecx,al - xor al,al - test ah,MOD_ALT - je @L1 - or al,HOTKEYF_ALT -@L1: - test ah,MOD_CONTROL - je @L2 - or al,HOTKEYF_CONTROL -@L2: - test ah,MOD_SHIFT - je @L3 - or al,HOTKEYF_SHIFT -@L3: - test ah,MOD_WIN - je @L4 - or al,HOTKEYF_EXT -@L4: - mov ch,al - mov eax,ecx -{ -begin - result:=w and $FF; - if (w and (MOD_ALT shl 8))<>0 then result:=result or (HOTKEYF_ALT shl 8); - if (w and (MOD_CONTROL shl 8))<>0 then result:=result or (HOTKEYF_CONTROL shl 8); - if (w and (MOD_SHIFT shl 8))<>0 then result:=result or (HOTKEYF_SHIFT shl 8); - if (w and (MOD_WIN shl 8))<>0 then result:=result or (HOTKEYF_EXT shl 8); -} -end; - -//----- Hook ----- - -function FindHotkey(keycode:integer;local:boolean):pointer; -var - i:integer; - p:pHKRec; -begin - i:=NumRecs; - p:=pointer(HKRecs); - while i>0 do - begin - dec(i); - with p^ do - begin - if (flags and hkAssigned)<>0 then - begin - if (local xor ((flags and hkGlobal)<>0)) then - begin - if hotkey=keycode then - begin - if handle<>0 then - begin - if GetFocus=handle then - begin - if (flags and hkMessage)<>0 then - begin - PostMessage(handle,wparam(@proc),keycode,0); - result:=pointer(-1); - end - else - result:=@proc; - exit; - end; - end - else - begin - result:=@proc; - exit; - end; - end; - end; - end; - end; - inc(p); - end; - result:=nil; -end; - -function wmKeyboard_hook(code:integer;wParam:WPARAM;lParam:LPARAM):longint; stdcall; -var - key:dword; - proc:pointer; -begin - if (code=HC_ACTION) and - (lParam>0) and (LoWord(lParam)=1) then - begin - key:=0; - if (GetKeyState(VK_SHIFT ) and $8000)<>0 then key:=key or (MOD_SHIFT shl 8); - if (GetKeyState(VK_CONTROL) and $8000)<>0 then key:=key or (MOD_CONTROL shl 8); - if (GetKeyState(VK_MENU ) and $8000)<>0 then key:=key or (MOD_ALT shl 8); - if (GetKeyState(VK_LWIN ) and $8000)<>0 then key:=key or (MOD_WIN shl 8); - if (GetKeyState(VK_RWIN ) and $8000)<>0 then key:=key or (MOD_WIN shl 8); -// if (GetKeyState(VK_APPS) and $8000)<>0 then -// if (GetKeyState(VK_SLEEP) and $8000)<>0 then - key:=key or (cardinal(wParam) and $FF); - proc:=FindHotkey(key,true); - if proc<>nil then - begin - if proc<>pointer(-1) then - PostMessageA(hiddenwindow,WM_MYMESSAGE,key,windows.lparam(proc)); - result:=1; - exit; - end; - end; - result:=CallNextHookEx(KbHook,code,wParam,lParam); -end; - -function wmKeyboardLL_hook(code:integer;wParam:WPARAM;lParam:LPARAM):integer; stdcall; -const - lastkey:dword=0; -var - mask:dword; - key:dword; - proc:pointer; -begin - if code=HC_ACTION then - begin - case PKBDLLHOOKSTRUCT(lParam)^.vkCode of - VK_MENU, - VK_LMENU, - VK_RMENU: mask:=MOD_ALT shl 8; - VK_LWIN, - VK_RWIN: mask:=MOD_WIN shl 8; - VK_SHIFT, - VK_LSHIFT, - VK_RSHIFT: mask:=MOD_SHIFT shl 8; - VK_CONTROL, - VK_LCONTROL, - VK_RCONTROL: mask:=MOD_CONTROL shl 8; - else - if (PKBDLLHOOKSTRUCT(lParam)^.flags and 128)=0 then - begin - // local only -// maybe process will better choice? - if //(lastkey=0) and - (CurThread=GetWindowThreadProcessId(GetForegroundWindow,nil)) then - begin - key:=PKBDLLHOOKSTRUCT(lParam)^.vkCode or modifiers; - proc:=FindHotkey(key,true); - if proc<>nil then - begin - lastkey:=PKBDLLHOOKSTRUCT(lParam)^.vkCode; - if proc<>pointer(-1) then - PostMessageA(hiddenwindow,WM_MYMESSAGE,key,windows.lparam(proc)); - result:=1; - exit; - end; - end; - end - else if (lastkey<>0) and (lastkey=PKBDLLHOOKSTRUCT(lParam)^.vkCode) then - begin - lastkey:=0; - result :=1; - exit; - end; - mask:=0; - end; - if mask<>0 then - begin - if (PKBDLLHOOKSTRUCT(lParam)^.flags and 128)=0 then - modifiers:=modifiers or mask - else - modifiers:=modifiers and not mask; - end - end; - result:=CallNextHookEx(KbHook,code,wParam,lParam); -end; - -function HiddenWindProc(wnd:HWnd;msg:UINT;wParam:WPARAM;lParam:LPARAM):lresult; stdcall; -var - key:dword; -begin - if Msg=WM_HOTKEY then - begin - key:=(lParam shr 16)+((lParam and $FF) shl 8); - result:=lresult(FindHotKey(key,false)); - if result<>0 then - begin - result:=AWKHotKeyProc(result)(HotkeyHookToDlg(key)); - exit; - end; - end - else if Msg=WM_MYMESSAGE then - begin - result:=AWKHotKeyProc(lParam)(HotkeyHookToDlg(wParam)); - exit; - end; - result:=DefWindowProcA(wnd,msg,wparam,lparam); -end; - -procedure DestroyHiddenWindow; -begin - if hiddenwindow<>0 then - begin - DestroyWindow(hiddenwindow); - hiddenwindow:=0; - end; -end; - -procedure CreateHiddenWindow; -var - wnd:HWND; -begin - if hiddenwindow=0 then - begin - wnd:=CreateWindowExA(0,'STATIC',nil,0, - 1,1,1,1,HWND_MESSAGE,0,hInstance,nil); - if wnd<>0 then - begin - SetWindowLongPtrA(wnd,GWL_WNDPROC,LONG_PTR(@HiddenWindProc)); - hiddenwindow:=wnd; - end - end -end; -//----- interface ----- - -function CheckTable(ahotkey:integer;global:bool):integer; -var - tmp:pHKRecs; - i:integer; - p:pHKRec; -begin - if HKRecs=nil then - begin - MaxRecs:=PageStep; - GetMem (HKRecs ,MaxRecs*SizeOf(THKRec)); - FillChar(HKRecs^,MaxRecs*SizeOf(THKRec),0); - NumRecs:=0; - end; - // search existing - i:=0; - p:=pointer(HKRecs); - while i0 then - begin - if (p^.hotkey=ahotkey) and - (((p^.flags and hkGlobal)<>0) xor not global) then - break; - end; - inc(p); - inc(i); - end; - //search empty - if i=NumRecs then - begin - i:=0; - p:=pointer(HKRecs); - while i0 do - begin - dec(i); - if ((p^.flags and hkAssigned)<>0) and (p^.handle=0) then - if p^.hotkey=hotkey then - begin - if (p^.flags and hkGlobal)<>0 then - begin - UnregisterHotKey(hiddenwindow,p^.atom); - GlobalDeleteAtom(p^.atom); - end; - p^.flags:=p^.flags and not hkAssigned; - result:=i; - exit; - end; - inc(p); - end; - result:=0; -end; - -function DelProc(hotkey:integer;wnd:HWND):integer; -var - i:integer; - p:pHKRec; -begin - hotkey:=HotKeyDlgToHook(hotkey); //!! - p:=pointer(HKRecs); - i:=NumRecs; - while i>0 do - begin - dec(i); - if (p^.flags and hkAssigned)<>0 then - if (p^.handle=wnd) {and ((p^.flags and hkGlobal)=0)} then - begin - if (hotkey=0) or (hotkey=p^.hotkey) then - begin - p^.flags:=p^.flags and not hkAssigned; - result:=i; - exit; - end; - end; - inc(p); - end; - result:=0; -end; - -procedure InitHotKeys; -begin - MaxRecs:=10; - GetMem(HKRecs,SizeOf(THKRec)*MaxRecs); - FillChar(HKRecs^,SizeOf(THKRec)*MaxRecs,0); - NumRecs:=0; - CreateHiddenWindow; - kbhook:=SetWindowsHookExA(WH_KEYBOARD_LL,@wmKeyboardLL_hook,hInstance,0); - - if KbHook=0 then - KbHook:=SetWindowsHookExA(WH_KEYBOARD,@wmKeyboard_hook,0,GetCurrentThreadId); -end; - -procedure FreeHotKeys; -var - i:integer; - p:pHKRec; -begin - i:=NumRecs; - p:=pointer(HKRecs); - while i>0 do - begin - dec(i); - if (p^.flags and (hkAssigned or hkGlobal))=(hkAssigned or hkGlobal) then - begin - UnregisterHotKey(hiddenwindow,p^.atom); - GlobalDeleteAtom(p^.atom); - end; - inc(p); - end; - DestroyHiddenWindow; - if kbhook<>0 then - UnhookWindowsHookEx(kbhook); - FreeMem(HKRecs); - HKRecs:=nil; - MaxRecs:=0; - NumRecs:=0; -end; - -initialization - CurThread:=GetCurrentThreadId(); -end. \ No newline at end of file diff --git a/plugins/Utils.pas/old/ini.pas b/plugins/Utils.pas/old/ini.pas deleted file mode 100644 index 8746b51c53..0000000000 --- a/plugins/Utils.pas/old/ini.pas +++ /dev/null @@ -1,857 +0,0 @@ -unit INI; - -interface - -uses windows; - -{+}function SetStorage(name:PAnsiChar;inINI:boolean):cardinal; -{+}procedure FreeStorage(aHandle:cardinal); - -{+}procedure SetDefaultSection(aHandle:cardinal;name:PAnsiChar); -{+}procedure SetCurrentSection(aHandle:cardinal;sect:PAnsiChar); - -{+}procedure FlushSettings(aHandle:cardinal); -{+}procedure FlushSection(aHandle:cardinal); - -{+}procedure WriteNCInt(aHandle:cardinal;sect:PAnsiChar;param:PAnsiChar;value:integer); -{+}procedure WriteNCStr(aHandle:cardinal;sect:PAnsiChar;param:PAnsiChar;value:PAnsiChar); - -{+}procedure WriteNCStruct(aHandle:cardinal;sect:PAnsiChar;param:PAnsiChar;ptr:pointer;size:integer); -{*}procedure WriteStruct(aHandle:cardinal;param:PAnsiChar;ptr:pointer;size:integer); -{+}function ReadStruct (aHandle:cardinal;param:PAnsiChar;ptr:pointer;size:integer):boolean; - -{+}procedure WriteFlag(aHandle:cardinal;param:PAnsiChar;value:integer); -{+}procedure WriteInt (aHandle:cardinal;param:PAnsiChar;value:integer); -{+}procedure WriteStr (aHandle:cardinal;param:PAnsiChar;value:PWideChar); -procedure WriteAnsiStr(aHandle:cardinal;param:PAnsiChar;value:PAnsiChar); -{+}function ReadFlag(aHandle:cardinal;param:PAnsiChar; default:integer):integer; -{+}function ReadInt (aHandle:cardinal;param:PAnsiChar; default:integer):integer; -procedure ReadStr (aHandle:cardinal;var dst:PWideChar;param:PAnsiChar;default:PWideChar); -procedure ReadAnsiStr(aHandle:cardinal;var dst:PAnsiChar;param:PAnsiChar;default:PAnsiChar); - -procedure WriteSect(aHandle:cardinal;src:PAnsiChar); -procedure ReadSect (aHandle:cardinal;var dst:PAnsiChar); - -{*}procedure ClearSection(aHandle:cardinal); -{+}procedure DeleteParam(aHandle:cardinal;param:PAnsiChar); - -implementation - -uses common,io,m_api,dbsettings; - -type - PStorage = ^TStorage; - TStorage = record - SName :PAnsiChar; - SType :bool; - SHandle :THANDLE; - DefSection:PAnsiChar; - Section :Array [0..127] of AnsiChar; - ParOffset :integer; - Buffer :PAnsiChar; - INIBuffer :PAnsiChar; - end; - PStHeap = ^TStHeap; - TStHeap = array [0..10] of TStorage; - -const - Storage:PStHeap=nil; - NumStorage:cardinal=0; - -type - pbrec=^brec; - brec=record - ptr:PAnsiChar; - handle:cardinal; - end; - -const - DefDefSection:PAnsiChar = 'default'; - -{+}function SetStorage(name:PAnsiChar;inINI:boolean):cardinal; -var - i:integer; - tmp:PStHeap; -begin - if Storage=nil then - begin - mGetMem(Storage,SizeOf(TStorage)); - FillChar(Storage^,SizeOf(TStorage),0); - NumStorage:=1; - result:=0; - end - else - begin - integer(result):=-1; - for i:=0 to NumStorage-1 do - begin - if Storage^[i].SName=nil then // free cell - begin - result:=i; - break; - end; - end; - if integer(result)<0 then - begin - mGetMem(tmp,SizeOf(TStorage)*(NumStorage+1)); - move(Storage^,tmp^,SizeOf(TStorage)*NumStorage); - mFreeMem(Storage); - Storage:=tmp; - FillChar(Storage^[NumStorage],SizeOf(TStorage),0); - result:=NumStorage; - inc(NumStorage); - end - end; - with Storage^[result] do - begin - StrDup(SName,name); - SType:=inINI; - end; -end; - -{+}procedure FreeStorage(aHandle:cardinal); -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - begin - mFreeMem(SName); - mFreeMem(DefSection); - mFreeMem(Buffer); - mFreeMem(INIBuffer); - end; -end; - -{+}procedure WriteNCStruct(aHandle:cardinal;sect:PAnsiChar;param:PAnsiChar;ptr:pointer;size:integer); -var - cws:TDBCONTACTWRITESETTING; - pn:array [0..127] of AnsiChar; - i:integer; -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - if SType then - begin - if (sect=nil) or (sect^=#0) then - sect:=DefSection; - if sect=nil then - sect:=DefDefSection; - WritePrivateProfileStructA(sect,param,ptr,size,SName); - end - else - begin - if (sect<>nil) and (sect^<>#0) then - begin - i:=StrLen(sect); - move(sect^,pn,i); - pn[i]:='/'; - inc(i); - end - else - i:=0; - StrCopy(pn+i,param); - cws.szModule :=SName; - cws.szSetting :=pn; - cws.value._type :=DBVT_BLOB; - cws.value.pbVal :=ptr; - cws.value.cpbVal:=size; - PluginLink^.CallService(MS_DB_CONTACT_WRITESETTING,0,lParam(@cws)); - end -end; - -{*}procedure WriteStruct(aHandle:cardinal;param:PAnsiChar;ptr:pointer;size:integer); -const - hex:array [0..15] of AnsiChar = '0123456789ABCDEF'; -var - lptr:PAnsiChar; - buf,buf1:PAnsiChar; - i:integer; - crc:integer; - cws:TDBCONTACTWRITESETTING; -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - if SType then - begin - mGetMem(buf,(size+1)*2); - crc:=0; - buf1:=buf; - for i:=0 to size-1 do - begin - inc(crc,PByte(ptr)^); - buf1^ :=hex[pbyte(ptr)^ shr 4]; - (buf1+1)^:=hex[pbyte(ptr)^ and $0F]; - inc(buf1,2); - inc(pbyte(ptr)); - end; - buf1^ :=hex[(crc and $FF) shr 4]; - (buf1+1)^:=hex[(crc and $0F)]; - - StrCat(Buffer,param); - lptr:=StrEnd(Buffer); - lptr^:='='; - inc(lptr); - move(buf^,lptr^,(size+1)*2); - mFreeMem(buf); - inc(lptr,(size+1)*2); - lptr^ :=#13; - (lptr+1)^:=#10; - (lptr+2)^:=#0; - end - else - begin - StrCopy(Section+ParOffset,param); - cws.szModule :=SName; - cws.szSetting :=Section; - cws.value._type :=DBVT_BLOB; - cws.value.pbVal :=ptr; - cws.value.cpbVal:=size; - PluginLink^.CallService(MS_DB_CONTACT_WRITESETTING,0,lParam(@cws)); - end -end; - -{+}function ReadStruct(aHandle:cardinal;param:PAnsiChar;ptr:pointer;size:integer):boolean; -var - dbv:TDBVariant; -begin - if aHandle>=NumStorage then - begin - result:=false; - exit; - end; - with Storage^[aHandle] do - if SType then - begin - result:=GetPrivateProfileStructA(Section,param,ptr,size,SName); - end - else - begin - dbv._type:=DBVT_BLOB; - dbv.pbVal:=nil; - StrCopy(Section+ParOffset,param); - if (DBReadSetting(0,SName,Section,@dbv)=0) and - (dbv.pbVal<>nil) and (dbv.cpbVal=size) then - begin - move(dbv.pbVal^,ptr^,size); - DBFreeVariant(@dbv); - result:=true; - end - else - result:=false; - end -end; - -{+}procedure WriteNCInt(aHandle:cardinal;sect:PAnsiChar;param:PAnsiChar;value:integer); -var - pn:array [0..127] of AnsiChar; - i:integer; -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - if Stype then - begin - if (sect=nil) or (sect^=#0) then - sect:=DefSection; - if sect=nil then - sect:=DefDefSection; - WritePrivateProfileStringA(sect,param,IntToStr(pn,value),SName); - end - else - begin - if (sect<>nil) and (sect^<>#0) then - begin - i:=StrLen(sect); - move(sect^,pn,i); - pn[i]:='/'; - inc(i); - end - else - i:=0; - StrCopy(pn+i,param); - DBWriteDWord(0,SName,pn,value) - end -end; - -{+}procedure WriteNCStr(aHandle:cardinal;sect:PAnsiChar;param:PAnsiChar;value:PAnsiChar); -var - pn:array [0..127] of AnsiChar; - i:integer; -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - if SType then - begin - if (sect=nil) or (sect^=#0) then - sect:=DefSection; - if sect=nil then - sect:=DefDefSection; - WritePrivateProfileStringA(sect,param,value,SName); - end - else - begin - if (sect<>nil) and (sect^<>#0) then - begin - i:=StrLen(sect); - move(sect^,pn,i); - pn[i]:='/'; - inc(i); - end - else - i:=0; - StrCopy(pn+i,param); - DBWriteString(0,SName,pn,value); - end -end; - -{+}procedure SetDefaultSection(aHandle:cardinal;name:PAnsiChar); -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - begin - mFreeMem(DefSection); - StrDup(DefSection,name); - end; -end; - -{+}procedure SetCurrentSection(aHandle:cardinal;sect:PAnsiChar); -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - begin - if sect=nil then - sect:=DefSection; - if sect=nil then - sect:=''; - if SType then - begin - if (sect=nil) or (sect^=#0) then - sect:=DefDefSection; - StrCopy(Section,sect); - mGetMem(Buffer,16384); - Buffer^ :=#13; - (Buffer+1)^:=#10; - (Buffer+2)^:=#0; - end - else - begin - if sect<>nil then - begin - StrCopy(Section,sect); - ParOffset:=StrLen(Section); - Section[ParOffset]:='/'; - inc(ParOffset); - end - else - ParOffset:=0; - end - end; -end; - -{+}procedure FlushSettings(aHandle:cardinal); -var - size:integer; - ptr:PAnsiChar; -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - begin - if SType then - begin - if INIBuffer=nil then - exit; - ptr:=INIBuffer+1; - size:=StrLen(ptr); - seek(SHandle,0); - BlockWrite(SHandle,ptr^,size); - SetEndOfFile(SHandle); - mFreeMem(INIBuffer); - CloseHandle(SHandle); - end; - end; -end; - -{+}procedure FlushSection(aHandle:cardinal); -var - size,i:integer; - sect:array [0..127] of AnsiChar; - ptr1,ptr:PAnsiChar; -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - if SType then - begin - if INIBuffer=nil then - begin - mGetMem(INIBuffer,32768); - INIBuffer[0]:=#10; - SHandle:=Reset(SName); - if thandle(SHandle)=INVALID_HANDLE_VALUE then - INIBuffer[1]:=#0 - else - begin - size:=FileSize(SHandle); - INIBuffer[size+1]:=#0; - BlockRead(SHandle,(INIBuffer+1)^,size); - CloseHandle(SHandle); - end; - SHandle:=ReWrite(SName); - end; - // construct section name - sect[0]:=#10; - sect[1]:='['; - size:=StrLen(Section); - move(Section,sect[2],size); - sect[size+2]:=']'; - sect[size+3]:=#0; - // search section - ptr:=StrPos(INIBuffer,sect); - // delete section - if ptr<>nil then - begin - ptr1:=ptr; -//!! inc(ptr); - while (ptr^<>#0) and ((ptr^<>#10) or ((ptr+1)^<>'[')) do inc(ptr); - if ptr^<>#0 then - StrCopy(ptr1,ptr+1) - else - ptr1^:=#0; - end; - // append section - if (Buffer<>nil) and (StrLen(Buffer)>0) then - begin - i:=StrLen(INIBuffer); - if INIBuffer[i-1]<>#10 then - begin - INIBuffer[i] :=#13; - INIBuffer[i+1]:=#10; - inc(i,2); - end; - StrCopy(INIBuffer+i,sect+1); - StrCat(INIBuffer,Buffer); - end; - mFreeMem(Buffer); - end; -end; - -{+}procedure WriteFlag(aHandle:cardinal;param:PAnsiChar;value:integer); -var - ptr:PAnsiChar; -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - if SType then - begin - StrCat(Buffer,param); - ptr:=StrEnd(Buffer); - ptr^:='='; - (ptr+1)^:=CHR((value and 1)+ORD('0')); - inc(ptr,2); - ptr^ :=#13; - (ptr+1)^:=#10; - (ptr+2)^:=#0; - end - else - begin - StrCopy(Section+ParOffset,param); - DBWriteByte(0,SName,Section,value) - end; -end; - -{+}procedure WriteInt(aHandle:cardinal;param:PAnsiChar;value:integer); -var - ptr:PAnsiChar; -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - if SType then - begin - StrCat(Buffer,param); - ptr:=StrEnd(Buffer); - ptr^:='='; - IntToStr(ptr+1,value); - ptr:=StrEnd(Buffer); - ptr^ :=#13; - (ptr+1)^:=#10; - (ptr+2)^:=#0; - end - else - begin - StrCopy(Section+ParOffset,param); - DBWriteDWord(0,SName,Section,value) - end; -end; - -procedure WriteStrInt(aHandle:cardinal;param:PAnsiChar;value:pointer;wide:bool); -var - buf:array [0..2047] of AnsiChar; - ptr:PAnsiChar; - lval:PAnsiChar; -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - if SType then - begin - StrCat(Buffer,param); - ptr:=StrEnd(Buffer); - ptr^:='='; - inc(ptr); - if (value<>nil) then - begin - buf[0]:=#0; - if wide then - begin - if PWideChar(value)^<>#0 then - begin - WideToUTF8(value,lval); - StrCopy(buf,lval,SizeOf(buf)-1); - mFreeMem(lval); - end - end - else if PAnsiChar(value)^<>#0 then - StrCopy(buf,value,SizeOf(buf)-1); - if buf[0]<>#0 then - begin - Escape(buf); - StrCopy(ptr,buf); - ptr:=StrEnd(Buffer); - end; - end; - ptr^ :=#13; - (ptr+1)^:=#10; - (ptr+2)^:=#0; - end - else - begin - StrCopy(Section+ParOffset,param); - if wide then - DBWriteUnicode(0,SName,Section,value) - else - DBWriteString(0,SName,Section,value) - end; -end; - -{+}procedure WriteStr(aHandle:cardinal;param:PAnsiChar;value:PWideChar); -begin - WriteStrInt(aHandle,param,value,true); -end; - -{+}procedure WriteAnsiStr(aHandle:cardinal;param:PAnsiChar;value:PAnsiChar); -begin - WriteStrInt(aHandle,param,value,false); -end; - -{+}function ReadFlag(aHandle:cardinal; param:PAnsiChar; default:integer):integer; -begin - if aHandle>=NumStorage then - begin - result:=default; - exit; - end; - with Storage^[aHandle] do - if SType then - begin - result:=GetPrivateProfileIntA(Section,param,default,SName) - end - else - begin - StrCopy(Section+ParOffset,param); - result:=DBReadByte(0,SName,Section,default) - end; -end; - -{+}function ReadInt(aHandle:cardinal; param:PAnsiChar; default:integer):integer; -begin - if aHandle>=NumStorage then - begin - result:=default; - exit; - end; - with Storage^[aHandle] do - if SType then - begin - result:=GetPrivateProfileIntA(Section,param,default,SName) - end - else - begin - StrCopy(Section+ParOffset,param); - result:=DBReadDWord(0,SName,Section,default) - end; -end; - -procedure ReadStrInt(aHandle:cardinal;var dst;param:PAnsiChar;default:pointer;wide:bool); - - function EnumSettingsProc(const szSetting:PAnsiChar;lParam:LPARAM):int; cdecl; - var - p:pbrec; - i:integer; - begin - p:=pbrec(lparam); - if StrCmp(Storage^[p^.handle].Section,szSetting,Storage^[p^.handle].ParOffset)=0 then - begin - i:=StrLen(szSetting)+1; - move(szSetting^,p^.ptr^,i); - inc(p^.ptr,i); - end; - result:=0; - end; - -var - buf:array [0..4095] of AnsiChar; - p:brec; - ces:TDBCONTACTENUMSETTINGS; - def:PAnsiChar; - i:integer; -begin - if aHandle>=NumStorage then - begin - if wide then - StrDupW(pWideChar(dst),pWideChar(default)) - else - StrDup(PAnsiChar(dst),PAnsiChar(default)); - exit; - end; - with Storage^[aHandle] do - if SType then - begin - if wide then - begin - if default=nil then - StrDup(def,'') - else - WideToUTF8(default,def); - end - else - begin - if default=nil then - def:='' - else - def:=default; - end; - i:=GetPrivateProfileStringA(Section,param,def,buf,4095,SName)+1; - mFreeMem(def); - if param<>nil then - begin - if buf[0]<>#0 then - begin - Unescape(buf); - if wide then - UTF8ToWide(buf,pWideChar(dst)) - else - StrDup(PAnsiChar(dst),buf); - end - else - PAnsiChar(dst):=nil; - end - else //!! full section - begin - mGetMem(dst,i); - move(buf,PAnsiChar(dst)^,i); - buf[i-1]:=#0; - end; - end - else - begin - if param<>nil then - begin - StrCopy(Section+ParOffset,param); - if wide then - pWideChar(dst):=DBReadUnicode(0,SName,Section,pWideChar(default)) - else - PAnsiChar(dst):=DBReadString(0,SName,Section,PAnsiChar(default)); - end - else - begin - p.ptr:=@buf; - p.handle:=aHandle; - FillChar(buf,SizeOf(buf),0); - ces.pfnEnumProc:=@EnumSettingsProc; - ces.lParam :=lparam(@p); - ces.szModule :=SName; - ces.ofsSettings:=0; - PluginLink^.CallService(MS_DB_CONTACT_ENUMSETTINGS,0,lparam(@ces)); - mGetMem(dst,p.ptr-PAnsiChar(@buf)+1); - move(buf,PAnsiChar(dst)^,p.ptr-PAnsiChar(@buf)+1); - end; - end; -end; - -procedure ReadStr(aHandle:cardinal;var dst:PWideChar;param:PAnsiChar;default:PWideChar); -begin - ReadStrInt(aHandle,dst,param,default,true); -end; - -procedure ReadAnsiStr(aHandle:cardinal;var dst:PAnsiChar;param:PAnsiChar;default:PAnsiChar); -begin - ReadStrInt(aHandle,dst,param,default,false); -end; - -{*}procedure ClearSection(aHandle:cardinal); - - function EnumSettingsProc(const szSetting:PAnsiChar;lParam:LPARAM):int; cdecl; - var - db:TDBCONTACTGETSETTING; - begin - with Storage^[lParam] do - begin - db.szModule:=SName; - StrCopy(Section+ParOffset,szSetting); - db.szSetting:=Section; - end; - PluginLink^.CallService(MS_DB_CONTACT_DELETESETTING,0,tlparam(@db)); - result:=0; - end; - -var - ces:TDBCONTACTENUMSETTINGS; -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - if SType then - WritePrivateProfileStringA(Section,nil,nil,SName) - else - begin - ces.pfnEnumProc:=@EnumSettingsProc; - ces.lParam :=aHandle; - ces.szModule :=SName; - ces.ofsSettings:=0; - PluginLink^.CallService(MS_DB_CONTACT_ENUMSETTINGS,0,lparam(@ces)); - end; -end; - -{*}procedure WriteSect(aHandle:cardinal;src:PAnsiChar); -var - p:PAnsiChar; -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - if SType then - WritePrivateProfileSectionA(Section,src,SName) - else - begin - ClearSection(aHandle); - while src^<>#0 do - begin - // write as strings - p:=src; - while src^<>'=' do inc(src); - inc(src); - DBWriteString(0,SName,p,src); - while src^<>#0 do inc(src); - inc(src); - end; - end; -end; - -procedure ReadSect(aHandle:cardinal;var dst:PAnsiChar); - - function EnumSettingsProc(const szSetting:PAnsiChar;lParam:LPARAM):int; cdecl; - var - dbv:TDBVariant; - i:integer; - p:pbrec; - buf:array [0..31] of AnsiChar; - begin - result:=1; - - p:=pbrec(lparam); - if (DBReadSetting(0,Storage^[p^.handle].Section,szSetting,@dbv)=0) then - begin - i:=StrLen(szSetting); - move(szSetting^,p^.ptr^,i); - inc(p^.ptr,i); - p^.ptr^:='='; - case dbv._type of - DBVT_ASCIIZ: begin - if dbv.szVal.a<>nil then - begin - i:=StrLen(dbv.szVal.a)+1; - move(dbv.szVal.a^,(p^.ptr+1)^,i); - DBFreeVariant(@dbv); - end - end; - DBVT_BYTE,DBVT_WORD,DBVT_DWORD: begin - case dbv._type of - DBVT_BYTE : i:=dbv.bVal; - DBVT_WORD : i:=dbv.wVal; - DBVT_DWORD: i:=dbv.dVal; - end; - i:=StrLen(IntToStr(buf,i))+1; - move(buf,(p^.ptr+1)^,i); - end; - else - exit; - end; - inc(p^.ptr,i{+1}); - end; - end; - -var - buf:array [0..16383] of AnsiChar; - p:brec; - ces:TDBCONTACTENUMSETTINGS; - i:integer; -begin - if aHandle>=NumStorage then - begin - dst:=nil; - exit; - end; - with Storage^[aHandle] do - begin - if SType then - begin - i:=GetPrivateProfileSectionA(Section,buf,SizeOf(buf),SName)+1; - end - else - begin - p.ptr:=@buf; - p.handle:=aHandle; - FillChar(buf,SizeOf(buf),0); - - ces.pfnEnumProc:=@EnumSettingsProc; - ces.lParam :=lparam(@p); - ces.szModule :=SName; - ces.ofsSettings:=0; - PluginLink^.CallService(MS_DB_CONTACT_ENUMSETTINGS,0,lparam(@ces)); - i:=p.ptr-PAnsiChar(@buf)+1; - end; - mGetMem(dst,i); - move(buf,dst^,i); - buf[i-1]:=#0; - end; -end; - -{+}procedure DeleteParam(aHandle:cardinal;param:PAnsiChar); -var - db:TDBCONTACTGETSETTING; -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - begin - if SType then - WritePrivateProfileStringA(Section,param,nil,SName) - else - begin - StrCopy(Section+ParOffset,param); - db.szModule :=SName; - db.szSetting:=Section; - PluginLink^.CallService(MS_DB_CONTACT_DELETESETTING,0,lparam(@db)); - end; - end; -end; - -end. diff --git a/plugins/Utils.pas/old/mApiCardC.pas b/plugins/Utils.pas/old/mApiCardC.pas deleted file mode 100644 index 7c67443087..0000000000 --- a/plugins/Utils.pas/old/mApiCardC.pas +++ /dev/null @@ -1,397 +0,0 @@ -{service insertion code} -unit mApiCardC; - -interface - -uses windows,messages; - -type - tmApiCard = class - private - function GetDescription:pAnsiChar; - function GetResultType :pAnsiChar; - procedure SetCurrentService(item:pAnsiChar); - public - constructor Create(fname:pAnsiChar; lparent:HWND=0); -// procedure Free; - procedure FillList(combo:HWND; mode:integer=0); - - function FillParams(wnd:HWND{;item:pAnsiChar};wparam:boolean):pAnsiChar; - procedure Show;//(item:pAnsiChar); - - property Description:pAnsiChar read GetDescription; - property ResultType :pAnsiChar read GetResultType; - property Service :pAnsiChar write SetCurrentService; - property Event :pAnsiChar write SetCurrentService; - private - current: array [0..127] of AnsiChar; - IniFile: array [0..511] of AnsiChar; - parent, - HelpWindow:HWND; - isServiceHelp:boolean; - - procedure Update(item:pAnsiChar=nil); - end; - -function CreateServiceCard(parent:HWND=0):tmApiCard; -function CreateEventCard (parent:HWND=0):tmApiCard; - -implementation - -uses common,io,m_api,mirutils; - -{$r mApiCard.res} - -{$include i_card_const.inc} - -const - WM_UPDATEHELP = WM_USER+100; - -const - BufSize = 2048; - -const - ServiceHlpFile = 'plugins\services.ini'; - EventsHlpFile = 'plugins\events.ini'; -{ -procedure tmApiCard.Free; -begin -end; -} -function tmApiCard.GetResultType:pAnsiChar; -var - buf:array [0..2047] of AnsiChar; - p:pAnsiChar; -begin - if INIFile[0]<>#0 then - begin - GetPrivateProfileStringA(@current,'return','',buf,SizeOf(buf),@INIFile); - p:=@buf; - while p^ in sWordOnly do inc(p); - p^:=#0; - StrDup(result,@buf); - end - else - result:=nil; -end; - -function tmApiCard.GetDescription:pAnsiChar; -var - buf:array [0..2047] of AnsiChar; -begin - if INIFile[0]<>#0 then - begin - GetPrivateProfileStringA(@current,'descr','',buf,SizeOf(buf),@INIFile); - StrDup(result,@buf); - end - else - result:=nil; -end; - -function tmApiCard.FillParams(wnd:HWND{;item:pAnsiChar};wparam:boolean):pAnsiChar; -var - buf :array [0..2047] of AnsiChar; - bufw:array [0..2047] of WideChar; - j:integer; - p,pp,pc:PAnsiChar; - tmp:pWideChar; - paramname:pAnsiChar; -begin - if INIFile[0]=#0 then - begin - result:=nil; - exit; - end; - if wparam then - paramname:='wparam' - else - paramname:='lparam'; - GetPrivateProfileStringA(@current,paramname,'',buf,SizeOf(buf),@INIFile); - StrDup(result,@buf); - SendMessage(wnd,CB_RESETCONTENT,0,0); - if buf[0]<>#0 then - begin - p:=@buf; - GetMem(tmp,BufSize*SizeOf(WideChar)); - repeat - pc:=StrScan(p,'|'); - if pc<>nil then - pc^:=#0; - - if (p^ in ['0'..'9']) or ((p^='-') and (p[1] in ['0'..'9'])) then - begin - j:=0; - pp:=p; - repeat - bufw[j]:=WideChar(pp^); - inc(j); inc(pp); - until (pp^=#0) or (pp^=' '); - if pp^<>#0 then - begin - bufw[j]:=' '; bufw[j+1]:='-'; bufw[j+2]:=' '; inc(j,3); - FastAnsitoWideBuf(pp+1,tmp); - StrCopyW(bufw+j,TranslateW(tmp)); - SendMessageW(wnd,CB_ADDSTRING,0,lparam(@bufw)); - end - else - SendMessageA(wnd,CB_ADDSTRING,0,lparam(p)); - end - else - begin - FastAnsitoWideBuf(p,tmp); - SendMessageW(wnd,CB_ADDSTRING,0,lparam(TranslateW(tmp))); - if (p=@buf) and (lstrcmpia(p,'structure')=0) then - break; - end; - p:=pc+1; - until pc=nil; - FreeMem(tmp); - end; - SendMessage(wnd,CB_SETCURSEL,0,0); -end; - -procedure tmApiCard.FillList(combo:hwnd; mode:integer=0); -var - buf:array [0..8191] of AnsiChar; - tmpbuf:array [0..127] of AnsiChar; - p,pc:PAnsiChar; -begin - if INIFile[0]<>#0 then - begin - SendMessage(combo,CB_RESETCONTENT,0,0); - buf[0]:=#0; - GetPrivateProfileSectionNamesA(@buf,SizeOf(buf),@INIFile); // sections - p:=@buf; - while p^<>#0 do - begin - case mode of - 1: begin // just constant name - GetPrivateProfileStringA(p,'alias','',tmpbuf,127,@INIFile); - pc:=@tmpbuf; - end; - 2: begin // value (name) - pc:=StrCopyE(tmpbuf,p); - pc^:=' '; inc(pc); - pc^:='('; inc(pc); - GetPrivateProfileStringA(p,'alias','',pc,63,@INIFile); - pc:=StrEnd(tmpbuf); - pc^:=')'; inc(pc); - pc^:=#0; - pc:=@tmpbuf; - end; - 3: begin // name 'value' - GetPrivateProfileStringA(p,'alias','',tmpbuf,127,@INIFile); - pc:=StrEnd(tmpbuf); - pc^:=' '; inc(pc); - pc^:=''''; inc(pc); - pc:=StrCopyE(pc,p); - pc^:=''''; inc(pc); - pc^:=#0; - pc:=@tmpbuf; - end; - else // just constant value - pc:=p; - end; - SendMessageA(combo,CB_ADDSTRING,0,lparam(pc)); - while p^<>#0 do inc(p); inc(p); - end; - SendMessage(combo,CB_SETCURSEL,-1,0); - end; -end; - -function ServiceHelpDlg(Dialog:HWnd;hMessage:uint;wParam:WPARAM;lParam:LPARAM):LRESULT; stdcall; -var - buf,p:PAnsiChar; - tmp:PWideChar; - card:tmApiCard; -begin - result:=0; - case hMessage of - WM_CLOSE: begin - card:=tmApiCard(GetWindowLongPtr(Dialog,GWLP_USERDATA{DWLP_USER})); - card.HelpWindow:=0; - DestroyWindow(Dialog); //?? - end; - - WM_INITDIALOG: begin - TranslateDialogDefault(Dialog); - result:=1; - end; - - WM_COMMAND: begin - if (wParam shr 16)=BN_CLICKED then - begin - case loword(wParam) of - IDOK,IDCANCEL: begin - card:=tmApiCard(GetWindowLongPtr(Dialog,GWLP_USERDATA{DWLP_USER})); - card.HelpWindow:=0; - DestroyWindow(Dialog); - end; - end; - end; - end; - - WM_UPDATEHELP: begin - with tmApiCard(lParam) do - begin - if (INIFile[0]<>#0) and (lParam<>0) then - begin - GetMem(buf,BufSize); - GetMem(tmp,BufSize*SizeOf(WideChar)); - SetDlgItemTextA(Dialog,IDC_HLP_SERVICE,@current); - - GetPrivateProfileStringA(@current,'alias','',buf,BufSize,@INIFile); - SetDlgItemTextA(Dialog,IDC_HLP_ALIAS,buf); - - GetPrivateProfileStringA(@current,'return','Undefined',buf,BufSize,@INIFile); - p:=buf; - // skip result type - // while p^ in sWordOnly do inc(p); if (p<>@buf) and (p^<>#0) then inc(p); - FastAnsiToWideBuf(p,tmp); - SetDlgItemTextW(Dialog,IDC_HLP_RETURN,TranslateW(tmp)); - - GetPrivateProfileStringA(@current,'descr','Undefined',buf,BufSize,@INIFile); - FastAnsiToWideBuf(buf,tmp); - SetDlgItemTextW(Dialog,IDC_HLP_EFFECT,TranslateW(tmp)); - - GetPrivateProfileStringA(@current,'plugin','',buf,BufSize,@INIFile); - FastAnsiToWideBuf(buf,tmp); - SetDlgItemTextW(Dialog,IDC_HLP_PLUGIN,TranslateW(tmp)); - // Parameters - GetPrivateProfileStringA(@current,'wparam','0',buf,BufSize,@INIFile); - if StrScan(buf,'|')<>nil then - begin - ShowWindow(GetDlgItem(Dialog,IDC_HLP_WPARAML),SW_SHOW); - ShowWindow(GetDlgItem(Dialog,IDC_HLP_WPARAM ),SW_HIDE); - FillParams(GetDlgItem(Dialog,IDC_HLP_WPARAML),true); - end - else - begin - ShowWindow(GetDlgItem(Dialog,IDC_HLP_WPARAML),SW_HIDE); - ShowWindow(GetDlgItem(Dialog,IDC_HLP_WPARAM ),SW_SHOW); - FastAnsiToWideBuf(buf,tmp); - SetDlgItemTextW(Dialog,IDC_HLP_WPARAM,TranslateW(tmp)); - end; - - GetPrivateProfileStringA(@current,'lparam','0',buf,BufSize,@INIFile); - if StrScan(buf,'|')<>nil then - begin - ShowWindow(GetDlgItem(Dialog,IDC_HLP_LPARAML),SW_SHOW); - ShowWindow(GetDlgItem(Dialog,IDC_HLP_LPARAM ),SW_HIDE); - FillParams(GetDlgItem(Dialog,IDC_HLP_LPARAML),false); - end - else - begin - ShowWindow(GetDlgItem(Dialog,IDC_HLP_LPARAML),SW_HIDE); - ShowWindow(GetDlgItem(Dialog,IDC_HLP_LPARAM ),SW_SHOW); - FastAnsiToWideBuf(buf,tmp); - SetDlgItemTextW(Dialog,IDC_HLP_LPARAM,TranslateW(tmp)); - end; - - FreeMem(tmp); - FreeMem(buf); - end - else - begin - SetDlgItemTextW(Dialog,IDC_HLP_SERVICE,nil); - SetDlgItemTextW(Dialog,IDC_HLP_ALIAS ,nil); - SetDlgItemTextW(Dialog,IDC_HLP_PLUGIN ,nil); - SetDlgItemTextW(Dialog,IDC_HLP_RETURN ,nil); - SetDlgItemTextW(Dialog,IDC_HLP_EFFECT ,nil); - SetDlgItemTextW(Dialog,IDC_HLP_WPARAM ,nil); - SetDlgItemTextW(Dialog,IDC_HLP_LPARAM ,nil); - SendDlgItemMessage(Dialog,IDC_HLP_WPARAML,CB_RESETCONTENT,0,0); - SendDlgItemMessage(Dialog,IDC_HLP_LPARAML,CB_RESETCONTENT,0,0); - ShowWindow(GetDlgItem(Dialog,IDC_HLP_WPARAML),SW_HIDE); - ShowWindow(GetDlgItem(Dialog,IDC_HLP_LPARAML),SW_HIDE); - end; - end; - end; - end; -end; - -procedure tmApiCard.SetCurrentService(item:pAnsiChar); -begin - StrCopy(@current,item); -end; - -procedure tmApiCard.Update(item:pAnsiChar=nil); -begin - SendMessage(HelpWindow,WM_UPDATEHELP,0,LPARAM(self)); -end; - -procedure tmApiCard.Show; -var - note, - title:pWideChar; -begin - if HelpWindow=0 then - begin - HelpWindow:=CreateDialogW(hInstance,'IDD_MAPIHELP',//MAKEINTRESOURCEW(IDD_HELP), - parent,@ServiceHelpDlg); - if HelpWindow<>0 then - begin - SetWindowLongPtr(HelpWindow,GWLP_USERDATA{DWLP_USER},LONG_PTR(Self)); - if isServiceHelp then - begin - title:='Miranda service help'; - note :=''''' in service name will be replaced by protocol name for contact handle in parameter'; - end - else - begin - title:='Miranda event help'; - note :=''; - end; - SendMessageW(HelpWindow,WM_SETTEXT,0,LPARAM(title)); - - SendMessageW(GetDlgItem(HelpWindow,IDC_HLP_NOTE),WM_SETTEXT,0,LPARAM(TranslateW(Note))); - end; - end - else - begin -{ - if parent<>GetParent(HelpWindow) then - SetParent(HelpWindow,parent); -} - end; -// if title<>nil then -// SendMessageW(HelpWindow,WM_SETTEXT,0,TranslateW(title)); - - Update(@current); -end; - -constructor tmApiCard.Create(fname:pAnsiChar; lparent:HWND=0); -begin - inherited Create; - - StrCopy(@IniFile,fname); - current[0]:=#0; - HelpWindow:=0; - - if fname<>nil then - begin - ConvertFileName(fname,@INIFile); - if GetFSize(pAnsiChar(@INIFile))=0 then - begin - INIFile[0]:=#0; - end; - parent:=lparent; - end; -end; - -function CreateServiceCard(parent:HWND=0):tmApiCard; -begin - result:=tmApiCard.Create(ServiceHlpFile,parent); - result.isServiceHelp:=true; -end; - -function CreateEventCard(parent:HWND=0):tmApiCard; -begin - result:=tmApiCard.Create(EventsHlpFile,parent); - result.isServiceHelp:=false; -end; - - -//initialization -//finalization -end. diff --git a/plugins/Utils.pas/playlist.pas b/plugins/Utils.pas/playlist.pas index 2ffe0143d6..fc3199dcfc 100644 --- a/plugins/Utils.pas/playlist.pas +++ b/plugins/Utils.pas/playlist.pas @@ -49,7 +49,7 @@ function CreatePlaylistBuf(buf:pointer;format:integer):tPlaylist; implementation -uses windows, common, io, memini;//, m_api, mirutils; +uses windows, common, io, memini; const plSizeStart = 2048; diff --git a/plugins/Utils.pas/sedit.pas b/plugins/Utils.pas/sedit.pas index 7f5feeaf52..896f880b80 100644 --- a/plugins/Utils.pas/sedit.pas +++ b/plugins/Utils.pas/sedit.pas @@ -38,15 +38,13 @@ const col_alias=0; col_type =1; col_len =2; -{$IFDEF Miranda} col_flag =3; col_data =4; -{$ELSE} - col_data =3; -{$ENDIF} var OldLVProc:pointer; +{$IFDEF Miranda} storage:pointer; +{$ENDIF} function GetTypeIndex(etype:integer):integer; var @@ -70,11 +68,7 @@ var begin SendMessageW(wnd,CB_SETITEMDATA, SendMessageW(wnd,CB_ADDSTRING,0, -{$IFDEF Miranda} - lparam(TranslateW(FastAnsiToWideBuf(str,buf)))), -{$ELSE} - lparam(FastAnsiToWideBuf(str,buf))), -{$ENDIF} + lparam({$IFDEF Miranda}TranslateW{$ENDIF}(FastAnsiToWideBuf(str,buf)))), num); end; @@ -217,10 +211,10 @@ begin SendMessageW(list,LVM_INSERTCOLUMNW,col_type ,lparam(@lv)); // type lv.cx :=32; lv.pszText:={$IFDEF Miranda}TranslateW{$ENDIF}('length'); SendMessageW(list,LVM_INSERTCOLUMNW,col_len ,lparam(@lv)); // length -{$IFDEF Miranda} + lv.cx :=20; lv.pszText:={$IFDEF Miranda}TranslateW{$ENDIF}(''); - SendMessageW(list,LVM_INSERTCOLUMNW,col_flag ,lparam(@lv)); // variables flag -{$ENDIF} + SendMessageW(list,LVM_INSERTCOLUMNW,col_flag ,lparam(@lv)); // flags + lv.cx :=72; lv.pszText:={$IFDEF Miranda}TranslateW{$ENDIF}('data'); SendMessageW(list,LVM_INSERTCOLUMNW,col_data ,lparam(@lv)); // value @@ -297,8 +291,14 @@ begin SendMessageW(list,LVM_SETITEMW,0,lparam(@li)); // flags -{$IFDEF Miranda} llen:=0; + + if (element.flags and SF_SIZE)<>0 then + begin + tmp1[llen]:=char_size; inc(llen); + end; + +{$IFDEF Miranda} if (element.flags and SF_SCRIPT)<>0 then begin tmp1[llen]:=char_script; inc(llen); @@ -307,11 +307,11 @@ begin begin tmp1[llen]:=char_mmi; inc(llen); end; +{$ENDIF} tmp1[llen]:=#0; li.iSubItem:=col_flag; li.pszText :=@tmp1; SendMessageW(list,LVM_SETITEMW,0,lparam(@li)); -{$ENDIF} // alias if element.alias[0]<>#0 then @@ -457,14 +457,21 @@ begin inc(dst); end; -{$IFDEF Miranda} li.mask :=LVIF_TEXT; li.iSubItem :=col_flag; li.cchTextMax:=32; li.pszText :=@buf; +{$IFDEF Miranda} isScript:=false; +{$ENDIF} if SendMessage(list,LVM_GETITEMTEXTW,item,lparam(@li))>0 then begin + if StrScanW(buf,char_size)<>nil then + begin + dst^:=char_size; + inc(dst); + end; +{$IFDEF Miranda} if StrScanW(buf,char_script)<>nil then begin dst^:=char_script; @@ -477,8 +484,8 @@ begin dst^:=char_mmi; inc(dst); end; - end; {$ENDIF} + end; { // type text (can skip and use type code) li.mask :=LVIF_TEXT; @@ -546,13 +553,13 @@ begin end; SST_BARR,SST_WARR,SST_BPTR,SST_WPTR: begin + dst^:=' '; inc(dst); // length li.iSubItem :=col_len; li.cchTextMax:=32; li.pszText :=@buf; if SendMessage(list,LVM_GETITEMTEXTW,item,lparam(@li))>0 then begin - dst^:=' '; inc(dst); pc:=@buf; while pc^<>#0 do begin @@ -628,8 +635,10 @@ begin IDC_DATA_LEN: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_TOP; IDC_DATA_SLEN: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_TOP; + IDC_VAR_HELP: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_BOTTOM; IDC_DATA_VARS: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_BOTTOM; IDC_DATA_MMI: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_BOTTOM; + IDC_DATA_SIZE: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_BOTTOM; IDC_DATA_NEW: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_TOP; IDC_DATA_UP: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_TOP; @@ -690,23 +699,23 @@ end; procedure FillLVData(Dialog:HWND;list:HWND;item:integer); var buf:array [0..15] of WideChar; - i:integer; + dtype,i:integer; p:pWideChar; b,b1:boolean; idcshow,idchide:integer; li:TLVITEMW; - {$IFDEF Miranda}vflag,mflag,{$ENDIF} + {$IFDEF Miranda}vflag,{$ENDIF}mflag, len:integer; wnd:HWND; begin len:=LV_GetLParam(list,item); - i :=loword(len); - len:=hiword(len); + dtype:=loword(len); + len :=hiword(len); idcshow:=IDC_DATA_EDIT; idchide:=IDC_DATA_EDTN; buf[0]:=#0; - case i of + case dtype of SST_BYTE,SST_WORD,SST_DWORD, SST_QWORD,SST_NATIVE: begin idchide:=IDC_DATA_EDIT; @@ -764,7 +773,22 @@ begin mGetMem(p,(len+1)*SizeOf(WideChar)); li.cchTextMax:=len+1; li.pszText :=p; + i:=SW_HIDE; + end + else + begin + i:=SW_SHOW; + + if StrScanW(p,char_size)<>nil then + mflag:=BST_CHECKED + else + mflag:=BST_UNCHECKED; + CheckDlgButton(Dialog,IDC_DATA_SIZE,mflag); + + EnableWindow(GetDlgItem(Dialog,IDC_DATA_EDTN),mflag=BST_UNCHECKED); end; + ShowWindow(GetDlgItem(Dialog,IDC_DATA_SIZE),i); + li.iSubItem:=col_data; SendMessage(list,LVM_GETITEMTEXTW,item,lparam(@li)); end; @@ -775,7 +799,7 @@ begin mFreeMem(p); wnd:=GetDlgItem(Dialog,IDC_DATA_TYPE); - CB_SelectData(wnd,i); + CB_SelectData(wnd,dtype); SendMessage(Dialog,WM_COMMAND,(CBN_SELENDOK shl 16)+IDC_DATA_TYPE,wnd); end; @@ -783,9 +807,7 @@ end; procedure FillLVRow(Dialog:hwnd;list:HWND;item:integer); var ltype,j,idc:integer; -{$IFDEF Miranda} idx:integer; -{$ENDIF} wnd:HWND; buf:array [0..63] of WideChar; tmp:pWideChar; @@ -798,8 +820,13 @@ begin LV_SetItemW(list,FastAnsiToWideBuf(StructElems[j].short,buf),item,col_type); // flags -{$IFDEF Miranda} idx:=0; + + if IsDlgButtonChecked(Dialog,IDC_DATA_SIZE)<>BST_UNCHECKED then + begin + buf[idx]:=char_size; inc(idx); + end; +{$IFDEF Miranda} if IsDlgButtonChecked(Dialog,IDC_DATA_VARS)<>BST_UNCHECKED then begin buf[idx]:=char_script; inc(idx); @@ -809,9 +836,9 @@ begin begin buf[idx]:=char_mmi; inc(idx); end; +{$ENDIF} buf[idx]:=#0; LV_SetItemW(list,@buf,item,col_flag); -{$ENDIF} // values tmp:=nil; @@ -973,8 +1000,8 @@ var wnd:HWND; i:integer; li:TLVITEMW; - b,b1:boolean; - idchide,idcshow:integer; + b,b1,b2:boolean; + idchide,idcshow,csize:integer; {$IFDEF Miranda} pc:pAnsiChar; urd:TUTILRESIZEDIALOG; @@ -1088,12 +1115,16 @@ begin EnableWindow(GetDlgItem(Dialog,IDC_DATA_EDTN),b); EnableWindow(GetDlgItem(Dialog,IDC_DATA_LEN ),b1); + csize:=SW_HIDE; if b then begin - if i IN [SST_BYTE,SST_WORD,SST_DWORD,SST_QWORD,SST_NATIVE] then + if not b1 then +// if i IN [SST_BYTE,SST_WORD,SST_DWORD,SST_QWORD,SST_NATIVE] then begin + csize:=SW_SHOW; + b2:=IsDlgButtonChecked(Dialog,IDC_DATA_SIZE)=BST_UNCHECKED; {$IFDEF Miranda} - if IsDlgButtonChecked(Dialog,IDC_DATA_VARS)<>BST_UNCHECKED then + if b2 and (IsDlgButtonChecked(Dialog,IDC_DATA_VARS)<>BST_UNCHECKED) then begin idchide:=IDC_DATA_EDTN; idcshow:=IDC_DATA_EDIT; @@ -1109,10 +1140,14 @@ begin begin idchide:=IDC_DATA_EDTN; idcshow:=IDC_DATA_EDIT; + b2:=true; end; ShowWindow(GetDlgItem(Dialog,idcshow),SW_SHOW); ShowWindow(GetDlgItem(Dialog,idchide),SW_HIDE); + + EnableWindow(GetDlgItem(Dialog,IDC_DATA_EDTN),b2); end; + ShowWindow(GetDlgItem(Dialog,IDC_DATA_SIZE),csize); {$IFDEF Miranda} if i IN [SST_PARAM,SST_LAST] then @@ -1178,6 +1213,11 @@ begin end; end; {$ENDIF} + IDC_DATA_SIZE: begin + EnableWindow(GetDlgItem(Dialog,IDC_DATA_EDTN), + IsDlgButtonChecked(Dialog,IDC_DATA_SIZE)=BST_UNCHECKED); + end; + IDC_DATA_NEW: begin wnd:=GetDlgItem(Dialog,IDC_DATA_FULL); i:=InsertLVLine(wnd); diff --git a/plugins/Utils.pas/sparam.pas b/plugins/Utils.pas/sparam.pas new file mode 100644 index 0000000000..5a686aa4a8 --- /dev/null +++ b/plugins/Utils.pas/sparam.pas @@ -0,0 +1,986 @@ +unit sparam; + +interface + +uses windows; + +const + // parameter flags + ACF_NUMBER = $00000001; // Param is number + ACF_UNICODE = $00000002; // Param is Unicode string + ACF_CURRENT = $00000004; // Param is ignored, used current user handle + // from current message window + ACF_RESULT = $00000008; // Param is previous action result + ACF_PARAM = $00000010; // Param is Call parameter + ACF_STRUCT = $00000020; + ACF_PARTYPE = ACF_NUMBER or ACF_UNICODE or + ACF_CURRENT or ACF_RESULT or + ACF_PARAM or ACF_STRUCT; + ACF_SIGNED = $00002000; // for future + ACF_TEMPLATE = $00000800; + ACF_SCRIPT_PARAM = $00001000; + // dummy + ACF_STRING = 0; + ACF_RNUMBER = 0; + + // result flags + ACF_RSTRING = $00010000; // Service result is string + ACF_RUNICODE = $00020000; // Service result is Widestring + ACF_RSTRUCT = $00040000; // Service result in structure + ACF_RFREEMEM = $00080000; // Need to free memory + ACF_RHEXNUM = $00100000; // Show number as hex + ACF_RSIGNED = $00200000; // Show number as signed + + ACF_RTYPE = ACF_RSTRING or ACF_RUNICODE or + ACF_RSTRUCT or ACF_RFREEMEM or + ACF_RHEXNUM or ACF_RSIGNED; + + // parameter / result block creation flags + ACF_NOSTATIC = $01000000; // No label text in block + ACF_NOBORDER = $02000000; // No group border around block + ACF_NOSTRUCT = $04000000; // don't add structure as param type + ACF_NOVISUAL = $08000000; // don't show number view styles + +function CreateParamBlock(parent:HWND;x,y,width:integer;flags:dword=0):THANDLE; +function ClearParamFields(Dialog:HWND):HWND; +function FillParam (Dialog:HWND;txt:pAnsiChar):integer; +function SetParamValue (Dialog:HWND; flags:dword; value:pointer):boolean; +function GetParamValue (Dialog:HWND;var flags:dword;var value:pointer):boolean; +function SetParamLabel (Dialog:HWND; lbl:pWideChar):HWND; + +procedure ClearParam (flags:dword; var param); +function DuplicateParam(flags:dword; var sparam,dparam):dword; +function TranslateParam(param:uint_ptr;flags:dword;hContact:THANDLE):uint_ptr; + +function CreateResultBlock(parent:HWND;x,y,width:integer;flags:dword=0):THANDLE; +function ClearResultFields(Dialog:HWND):HWND; +function SetResultValue(Dialog:HWND;flags:dword):integer; +function GetResultValue(Dialog:HWND):dword; + +implementation + +uses + messages, + common, editwrapper, wrapper, syswin, + m_api, sedit, strans, + mirutils; + +const + IDC_FLAG_PAR = 2150; + IDC_EDIT_PAR = 2151; + IDC_STRUCT = 2152; + IDC_LABEL_PAR = 2153; + IDC_GROUP_PAR = 2154; + + IDC_RES_TYPE = 2160; + IDC_RES_FREEMEM = 2161; + IDC_RES_SIGNED = 2162; + IDC_RES_HEXNUM = 2163; + + +procedure InsertString(wnd:HWND;num:dword;str:PAnsiChar); +var + buf:array [0..127] of WideChar; +begin + SendMessageW(wnd,CB_SETITEMDATA, + SendMessageW(wnd,CB_ADDSTRING,0, + lparam(TranslateW(FastAnsiToWideBuf(str,buf)))), + num); +end; + + +//----- Dialog functions ----- + +procedure MakeParamTypeList(wnd:HWND; flags:dword); +begin + SendMessage(wnd,CB_RESETCONTENT,0,0); + InsertString(wnd,ACF_NUMBER ,'number value'); + InsertString(wnd,ACF_STRING ,'ANSI string'); + InsertString(wnd,ACF_UNICODE,'Unicode string'); + InsertString(wnd,ACF_CURRENT,'current contact'); + InsertString(wnd,ACF_RESULT ,'last result'); + InsertString(wnd,ACF_PARAM ,'parameter'); + if (flags and ACF_NOSTRUCT)=0 then + InsertString(wnd,ACF_STRUCT ,'structure'); + SendMessage(wnd,CB_SETCURSEL,0,0); +end; + +function IsParamNumber(txt:pAnsiChar):boolean; +begin + if (txt[0] in ['0'..'9']) or ((txt[0]='-') and (txt[1] in ['0'..'9'])) or + ((txt[0]='$') and (txt[1] in sHexNum)) or + ((txt[0]='0') and (txt[1]='x') and (txt[2] in sHexNum)) then + result:=true + else + result:=false; +end; + +// Set parameter type by parameter template +function FixParam(buf:PAnsiChar):integer; +begin + if StrCmp(buf,'hContact' )=0 then result:=ACF_CURRENT + else if StrCmp(buf,'parameter' )=0 then result:=ACF_PARAM + else if StrCmp(buf,'result' )=0 then result:=ACF_RESULT + else if StrCmp(buf,'structure' )=0 then result:=ACF_STRUCT + else if StrCmp(buf,'Unicode text')=0 then result:=ACF_UNICODE + else result:=ACF_STRING; +end; + +function FixParamControls(Dialog:HWND;atype:dword):dword; +var + wnd,wnd1:HWND; + pcw:pWideChar; +begin + result:=atype; + + wnd :=GetDlgItem(Dialog,IDC_EDIT_PAR); + wnd1:=GetDlgItem(Dialog,IDC_STRUCT); + + if atype=ACF_STRUCT then + begin + ShowEditField(wnd ,SW_HIDE); + ShowWindow (wnd1,SW_SHOW); + end + else + begin + ShowEditField(wnd ,SW_SHOW); + ShowWindow (wnd1,SW_HIDE); + + if atype in [ACF_CURRENT,ACF_RESULT,ACF_PARAM] then + EnableEditField(wnd,false) + else + begin + if atype=ACF_NUMBER then //!! + begin + pcw:='0'; + SendMessageW(wnd,WM_SETTEXT,0,TLParam(pcw)); + end; + EnableEditField(wnd,true); + end; + + end; +end; + +// get line from template +function GetParamLine(src:pAnsiChar;dst:pWideChar;var ltype:integer):pAnsiChar; +var + pp,pc:pAnsiChar; + j:integer; + savechar:AnsiChar; +begin + pc:=StrScan(src,'|'); + + if pc<>nil then + begin + savechar:=pc^; + pc^:=#0; + end; + + if IsParamNumber(src) then + begin + j:=0; + pp:=src; + repeat + dst[j]:=WideChar(pp^); + inc(j); inc(pp); + until (pp^=#0) or (pp^=' '); + dst[j]:=WideChar(pp^); // anyway, #0 or " " needs + if pp^<>#0 then + begin + dst[j+1]:='-'; dst[j+2]:=' '; inc(j,3); + FastAnsitoWideBuf(pp+1,dst+j); + StrCopyW(dst+j,TranslateW(dst+j)); + end; + ltype:=ACF_NUMBER; + end + else + begin + ltype:=FixParam(src); + StrCopyW(dst,TranslateW(FastAnsitoWideBuf(src,dst))); + end; + + if pc<>nil then + begin + pc^:=savechar; + inc(pc); + end; + + result:=pc; +end; + +// Set parameter value by parameter template +function FillParam(Dialog:HWND;txt:pAnsiChar):integer; +var + bufw:array [0..2047] of WideChar; + wnd:HWND; + p,pc:PAnsiChar; + ltype:integer; +begin + wnd:=GetDlgItem(Dialog,IDC_EDIT_PAR); + SendMessage(wnd,CB_RESETCONTENT,0,0); + if (txt<>nil) and (txt^<>#0) then + begin + result:=-1; + p:=txt; + repeat + pc:=GetParamLine(p,bufw,ltype); + if result<0 then + result:=ltype; + SendMessageW(wnd,CB_ADDSTRING,0,lparam(@bufw)); + + if result=ACF_STRUCT then + break + else + p:=pc; + until pc=nil; + end + else + result:=ACF_NUMBER; + SendMessage(wnd,CB_SETCURSEL,0,0); + + CB_SelectData(GetDlgItem(Dialog,IDC_FLAG_PAR),result); + FixParamControls(Dialog,result); +end; + +function ClearParamFields(Dialog:HWND):HWND; +var + wnd:HWND; +begin + wnd:=GetDlgItem(Dialog,IDC_EDIT_PAR); + SendMessage (wnd,CB_RESETCONTENT,0,0); + SetEditFlags (wnd,EF_ALL,0); + CB_SelectData(Dialog,IDC_FLAG_PAR,ACF_NUMBER); + FixParamControls(Dialog,ACF_NUMBER); + result:=Dialog; +end; + +function DlgParamProc(Dialog:HWnd;hMessage:uint;wParam:WPARAM;lParam:LPARAM):lresult; stdcall; +var + wnd,wnd1:HWND; + proc:pointer; + pcw:pWideChar; + pc,pc1:pAnsiChar; + i:integer; +begin + result:=0; + + case hMessage of + WM_DESTROY: begin + pc:=pAnsiChar(GetWindowLongPtrW(GetDlgItem(Dialog,IDC_STRUCT),GWLP_USERDATA)); + mFreeMem(pc); + end; + + WM_SHOWWINDOW: begin + // hide window by ShowWindow function + if (lParam=0) and (wParam=0) then + begin + pc:=pAnsiChar(SetWindowLongPtrW(GetDlgItem(Dialog,IDC_STRUCT),GWLP_USERDATA,0)); + mFreeMem(pc); + end; + end; + + WM_COMMAND: begin + case wParam shr 16 of + CBN_EDITCHANGE, + EN_CHANGE: begin + SendMessage(GetParent(Dialog),WM_COMMAND,CBN_EDITCHANGE shl 16,Dialog); + end; + + CBN_SELCHANGE: begin + SendMessage(GetParent(Dialog),WM_COMMAND,CBN_EDITCHANGE shl 16,Dialog); + case loword(wParam) of + IDC_FLAG_PAR: begin + wnd :=GetDlgItem(Dialog,IDC_EDIT_PAR); + wnd1:=GetDlgItem(Dialog,IDC_STRUCT); + + i:=CB_GetData(GetDlgItem(Dialog,loword(wParam))); + + if i=ACF_STRUCT then + begin + ShowEditField(wnd ,SW_HIDE); + ShowWindow (wnd1,SW_SHOW); + end + else + begin + ShowEditField(wnd ,SW_SHOW); + ShowWindow (wnd1,SW_HIDE); + + if i in [ACF_CURRENT,ACF_RESULT,ACF_PARAM] then + EnableEditField(wnd,false) + else + begin + if i=ACF_NUMBER then + begin + pcw:='0'; + SendMessageW(wnd,WM_SETTEXT,0,TLParam(pcw)); + end; + EnableEditField(wnd,true); + end; + + end; + end; + end; + end; + + BN_CLICKED: begin + case loword(wParam) of + IDC_STRUCT: begin + pc:=pAnsiChar(GetWindowLongPtrW(lParam,GWLP_USERDATA)); +//!!!! + pc1:=EditStructure(pc{,Dialog}); + if pc1<>nil then + begin + mFreeMem(pc); + SetWindowLongPtrW(lParam,GWLP_USERDATA,long_ptr(pc1)); + SendMessage(GetParent(Dialog),WM_COMMAND,BN_CLICKED shl 16,Dialog); + end; + end; + else + // can be just edit field wrapper button, no need to react + end; + end; + + end; + end; + else + proc:=pointer(GetWindowLongPtrW(Dialog,GWLP_USERDATA)); + result:=CallWindowProc(proc,Dialog,hMessage,wParam,lParam) + end; +end; + +//----- Common interface functions ----- + +function CreateParamBlock(parent:HWND;x,y,width:integer;flags:dword=0):THANDLE; +var + hf:HFONT; + group,ctrl:HWND; + proc:pointer; + rc:TRECT; + fullline:bool; + gx,dx,dy,xo,yo:integer; + ux,uy:integer; +begin + hf:=SendMessageW(parent,WM_GETFONT,0,0); + GetUnitSize(parent,ux,uy); + + // block + SetRect(rc,x,y,x+width,y+31); + dx:=rc.right-rc.left; + dy:=rc.bottom-rc.top; + + result:=CreateWindowExW(WS_EX_CONTROLPARENT,'STATIC',nil,WS_CHILD+WS_VISIBLE, + x,y,dx,dy, parent,0,hInstance,nil); + proc:=pointer(SetWindowLongPtrW(result,GWLP_WNDPROC,long_ptr(@DlgParamProc))); + SetWindowLongPtrW(result,GWLP_USERDATA,long_ptr(proc)); + + yo:=0; + + // group border + if (flags and ACF_NOBORDER)=0 then + begin + group:=CreateWindowW('BUTTON','Param',WS_CHILD+WS_VISIBLE+WS_GROUP+BS_GROUPBOX, + 0,0,dx,dy, result,IDC_GROUP_PAR,hInstance,nil); + SendMessageW(group,WM_SETFONT,hf,0); + gx:=4; + inc(yo,12); + end + else + begin + gx:=0; + end; + + // label + if (flags and ACF_NOSTATIC)=0 then + begin + + if width<=150 then + begin + fullline:=true; + rc.bottom:=11*uy div 8; + xo:=dx-gx*2; + end + else + begin + fullline:=false; + rc.bottom:=14*uy div 8; // same as param type combobox + xo:=dx div 3; + end; + ctrl:=CreateWindowW('STATIC','Param type',WS_CHILD+WS_VISIBLE+SS_RIGHT+SS_CENTERIMAGE, + gx,yo,xo-gx,rc.bottom, result,IDC_LABEL_PAR,hInstance,nil); + SendMessageW(ctrl,WM_SETFONT,hf,0); + end + else + begin + fullline:=true; + end; + + // param type + rc.bottom:=14*uy div 8; + if fullline then + begin + xo:=gx; + if (flags and ACF_NOSTATIC)=0 then + inc(yo,rc.bottom); + end; + ctrl:=CreateWindowW('COMBOBOX',nil,WS_CHILD+WS_VISIBLE+WS_VSCROLL+CBS_DROPDOWNLIST+CBS_AUTOHSCROLL, + xo+2,yo,dx-xo-gx-2,56, result,IDC_FLAG_PAR,hInstance,nil); + + SendMessageW(ctrl,WM_SETFONT,hf,0); + MakeParamTypeList(ctrl,flags); + inc(yo,rc.bottom+2); + + // param value + rc.bottom:=14*uy div 8; + + ctrl:=CreateWindowW('COMBOBOX',nil,WS_CHILD+WS_VISIBLE+WS_VSCROLL+CBS_DROPDOWN+CBS_AUTOHSCROLL, + gx,yo,dx-gx*2,76, result,IDC_EDIT_PAR,hInstance,nil); + SendMessageW(ctrl,WM_SETFONT,hf,0); + MakeEditField(result,IDC_EDIT_PAR); + + ctrl:=CreateWindowW('BUTTON','Structure',WS_CHILD+WS_VISIBLE+BS_PUSHBUTTON, + gx,yo,dx-gx*2,rc.bottom, result,IDC_STRUCT,hInstance,nil); + SendMessageW(ctrl,WM_SETFONT,hf,0); + inc(yo,rc.bottom+4); + + // resize group and dialog + MoveWindow(result,x,y,dx,yo,false); + if (flags and ACF_NOBORDER)=0 then + MoveWindow(group,0,0,dx,yo,false); + + ClearParamFields(result); +end; + +// if separate +function DestroyBlock(block:pointer):integer; +begin + result:=0; +end; + +function SetParamLabel(Dialog:HWND; lbl:pWideChar):HWND; +var + wnd:HWND; +begin + result:=Dialog; + + if Dialog=0 then + exit; + + wnd:=GetDlgItem(Dialog,IDC_LABEL_PAR); + if wnd<>0 then + SendMessageW(wnd,WM_SETTEXT,0,LPARAM(lbl)) + else + begin + wnd:=GetDlgItem(Dialog,IDC_GROUP_PAR); + if wnd<>0 then + SendMessageW(wnd,WM_SETTEXT,0,LPARAM(lbl)) + end; +end; + +function SetParamValue(Dialog:HWND;flags:dword;value:pointer):boolean; +var + wnd,wnd1:HWND; + pc:pAnsiChar; + pcw:pWideChar; + vtype:integer; +begin + if Dialog=0 then + begin + result:=false; + exit; + end; + + result:=true; + + wnd:=GetDlgItem(Dialog,IDC_EDIT_PAR); + if (flags and ACF_TEMPLATE)<>0 then + begin + vtype:=FillParam(Dialog,value); + end + else if (flags and ACF_PARAM)<>0 then + begin + SendMessageW(wnd,WM_SETTEXT,0,LPARAM(TranslateW('Parameter'))); + EnableWindow(wnd,false); + vtype:=ACF_PARAM; + end + else if (flags and ACF_RESULT)<>0 then + begin + SendMessageW(wnd,WM_SETTEXT,0,LPARAM(TranslateW('Last result'))); + EnableWindow(wnd,false); + vtype:=ACF_RESULT; + end + else if (flags and ACF_CURRENT)<>0 then + begin + SendMessageW(wnd,WM_SETTEXT,0,LPARAM(TranslateW('Current user'))); + EnableWindow(wnd,false); + vtype:=ACF_CURRENT; + end + else if (flags and ACF_STRUCT)<>0 then + begin + vtype:=ACF_STRUCT; + + ShowEditField(wnd,SW_HIDE); + wnd1:=GetDlgItem(Dialog,IDC_STRUCT); + ShowWindow(wnd1,SW_SHOW); + // delete old value + pc:=pAnsiChar(GetWindowLongPtrW(wnd1,GWLP_USERDATA)); + mFreeMem(pc); + // set newly allocated + SetWindowLongPtrW(wnd1,GWLP_USERDATA,long_ptr(StrDup(pc,pAnsiChar(value)))); +//!!!!!!!! + end + else if (flags and ACF_NUMBER)<>0 then + begin + vtype:=ACF_NUMBER; + if value=nil then + pcw:='0' + else + pcw:=value; + SendMessageW(wnd,WM_SETTEXT,0,LPARAM(pcw)); + end + else if (flags and ACF_UNICODE)<>0 then + begin + vtype:=ACF_UNICODE; + SendMessageW(wnd,WM_SETTEXT,0,LPARAM(value)); + end + else + begin + vtype:=ACF_STRING; + SendMessageW(wnd,WM_SETTEXT,0,LPARAM(value)); + end; + SetEditFlags(wnd,EF_SCRIPT,ord((flags and ACF_SCRIPT_PARAM)<>0)); + + CB_SelectData(GetDlgItem(Dialog,IDC_FLAG_PAR),vtype); + FixParamControls(Dialog,vtype); +end; + +function GetParamValue(Dialog:HWND;var flags:dword;var value:pointer):boolean; +var + wnd:HWND; +begin + if Dialog=0 then + begin + result:=false; + exit; + end; + + result:=true; + flags:=0; + value:=nil; + wnd:=GetDlgItem(Dialog,IDC_EDIT_PAR); + case CB_GetData(GetDlgItem(Dialog,IDC_FLAG_PAR)) of + ACF_PARAM: begin + flags:=flags or ACF_PARAM + end; + ACF_RESULT: begin + flags:=flags or ACF_RESULT + end; + ACF_CURRENT: begin + flags:=flags or ACF_CURRENT + end; + ACF_NUMBER: begin + flags:=flags or ACF_NUMBER; + value:=GetDlgText(wnd); + end; + ACF_STRUCT: begin + flags:=flags or ACF_STRUCT; + StrDup(pAnsiChar(value), + pAnsiChar(GetWindowLongPtrW(GetDlgItem(Dialog,IDC_STRUCT),GWLP_USERDATA))); + end; + ACF_UNICODE: begin + flags:=flags or ACF_UNICODE; + value:=GetDlgText(wnd); + end; + ACF_STRING: value:=GetDlgText(wnd); + end; + if (GetEditFlags(wnd) and EF_SCRIPT)<>0 then + flags:=flags or ACF_SCRIPT_PARAM; +end; + +//----- Additional functions ----- + +procedure ClearParam(flags:dword; var param); +begin + if (flags and (ACF_CURRENT or ACF_RESULT or ACF_PARAM))=0 then + mFreeMem(pointer(param)); +end; + +function DuplicateParam(flags:dword; var sparam,dparam):dword; +var + tmpdst:array [0..2047] of WideChar; + ltype:integer; +begin + mFreeMem(dparam); + + if (flags and ACF_TEMPLATE)<>0 then + begin + flags:=flags and not (ACF_TEMPLATE or ACF_PARTYPE); + GetParamLine(pAnsiChar(sparam),tmpdst,ltype); + case ltype of + ACF_NUMBER: begin + flags:=flags or ACF_NUMBER; + StrDupW(pWideChar(dparam),pWideChar(@tmpdst)); + end; + ACF_STRING: begin + flags:=flags or ACF_STRING; + StrDupW(pWideChar(dparam),pWideChar(@tmpdst)); + end; + ACF_UNICODE: begin + flags:=flags or ACF_UNICODE; + StrDupW(pWideChar(dparam),pWideChar(@tmpdst)); + end; + ACF_STRUCT: begin + flags:=flags or ACF_STRUCT; + StrDup(pAnsiChar(dparam),pAnsiChar(sparam)+10); //10=StrLen('structure|') + end; + ACF_CURRENT: flags:=flags or ACF_CURRENT; + ACF_RESULT : flags:=flags or ACF_RESULT; + ACF_PARAM : flags:=flags or ACF_PARAM; + end; + end + else if (flags and (ACF_CURRENT or ACF_RESULT or ACF_PARAM))=0 then + begin + if (flags and ACF_NUMBER)<>0 then + StrDupW(pWideChar(dparam),pWideChar(sparam)) + else if (flags and ACF_STRUCT)<>0 then + StrDup(pAnsiChar(dparam),pAnsiChar(sparam)) + else if (flags and ACF_UNICODE)<>0 then + StrDupW(pWideChar(dparam),pWideChar(sparam)) + else + StrDupW(pWideChar(dparam),pWideChar(sparam)); + end; + result:=flags; +end; + +function TranslateParam(param:uint_ptr;flags:dword;hContact:THANDLE):uint_ptr; +var + tmp1:pWideChar; +begin + if (flags and ACF_SCRIPT_PARAM)<>0 then + result:=uint_ptr(ParseVarString(pWideChar(param),hContact)); + + tmp1:=pWideChar(result); + if (flags and ACF_NUMBER)=0 then + begin + if (flags and ACF_UNICODE)=0 then + WideToAnsi(tmp1,pAnsiChar(result),MirandaCP) + else + StrDupW(pWideChar(result),tmp1); + end + else + result:=NumToInt(tmp1); + + if (flags and ACF_SCRIPT_PARAM)<>0 then + mFreeMem(tmp1); +end; + +//===== result block ===== + +function ClearResultFields(Dialog:HWND):HWND; +var + w:HWND; +begin + result:=Dialog; + + if Dialog=0 then + exit; + + CheckDlgButton(Dialog,IDC_RES_FREEMEM,BST_UNCHECKED); + ShowWindow(GetDlgItem(Dialog,IDC_RES_FREEMEM),SW_HIDE); + CB_SelectData(Dialog,IDC_RES_TYPE,ACF_RNUMBER); + + w:=GetDlgItem(Dialog,IDC_RES_HEXNUM); + if w<>0 then + begin + ShowWindow(w,SW_SHOW); + ShowWindow(GetDlgItem(Dialog,IDC_RES_SIGNED),SW_SHOW); + end; +end; + +procedure MakeResultTypeList(wnd:HWND;flags:dword); +begin + SendMessage(wnd,CB_RESETCONTENT,0,0); + InsertString(wnd,ACF_RNUMBER ,'number value'); + InsertString(wnd,ACF_RSTRING ,'ANSI string'); + InsertString(wnd,ACF_RUNICODE,'Unicode string'); + if (flags and ACF_NOSTRUCT)=0 then + InsertString(wnd,ACF_RSTRUCT ,'structure'); + SendMessage(wnd,CB_SETCURSEL,0,0); +end; + +function DlgResultProc(Dialog:HWnd;hMessage:uint;wParam:WPARAM;lParam:LPARAM):lresult; stdcall; +var + proc:pointer; + wnd:HWND; + b:bool; + i,j:integer; +begin + result:=0; + + case hMessage of + WM_COMMAND: begin + case wParam shr 16 of + BN_CLICKED: begin + case loword(wParam) of + IDC_RES_SIGNED: begin + if IsDlgButtonChecked(Dialog,IDC_RES_SIGNED)=BST_UNCHECKED then + begin + b:=true; + end + else + begin + b:=false; + end; + EnableWindow(GetDlgItem(Dialog,IDC_RES_HEXNUM),b); + end; + IDC_RES_HEXNUM: begin + if IsDlgButtonChecked(Dialog,IDC_RES_HEXNUM)=BST_UNCHECKED then + begin + b:=true; + end + else + begin + b:=false; + end; + EnableWindow(GetDlgItem(Dialog,IDC_RES_SIGNED),b); + end; + end; + end; + + CBN_SELCHANGE: begin + case loword(wParam) of + IDC_RES_TYPE: begin + case CB_GetData(lParam) of + ACF_RNUMBER: begin + i:=SW_HIDE; + j:=SW_SHOW; + end; + ACF_RSTRUCT: begin + i:=SW_HIDE; + j:=SW_HIDE; + end; + ACF_RSTRING,ACF_RUNICODE: begin + i:=SW_SHOW; + j:=SW_HIDE; + end; + end; + ShowWindow(GetDlgItem(Dialog,IDC_RES_FREEMEM),i); + wnd:=GetDlgItem(Dialog,IDC_RES_HEXNUM); + if wnd<>0 then + begin + ShowWindow(wnd,j); + ShowWindow(GetDlgItem(Dialog,IDC_RES_SIGNED),j); + end; + end; + end; + end; + end; + end; + else + proc:=pointer(GetWindowLongPtrW(Dialog,GWLP_USERDATA)); + result:=CallWindowProc(proc,Dialog,hMessage,wParam,lParam) + end; +end; + +function CreateResultBlock(parent:HWND;x,y,width:integer;flags:dword=0):THANDLE; +var + hf:HFONT; + ctrl,group:HWND; + proc:pointer; + rc:TRECT; + fullline:bool; + dx,dy,yo,gx,xo:integer; + ux,uy:integer; +begin + hf:=SendMessageW(parent,WM_GETFONT,0,0); + GetUnitSize(parent,ux,uy); + + // block body + SetRect(rc,x,y,x+width,y+53); + dx:=rc.right-rc.left; + dy:=rc.bottom-rc.top; + + result:=CreateWindowExW(WS_EX_CONTROLPARENT,'STATIC',nil,WS_CHILD+WS_VISIBLE, + x,y,dx,dy, parent,0,hInstance,nil); + proc:=pointer(SetWindowLongPtrW(result,GWLP_WNDPROC,long_ptr(@DlgResultProc))); + SetWindowLongPtrW(result,GWLP_USERDATA,long_ptr(proc)); + + yo:=0; + + // group border + if (flags and ACF_NOBORDER)=0 then + begin + group:=CreateWindowW('BUTTON','Result',WS_CHILD+WS_VISIBLE+WS_GROUP+BS_GROUPBOX, + 0,0,dx,dy, result,0,hInstance,nil); + SendMessageW(group,WM_SETFONT,hf,0); + gx:=4; + inc(yo,12); + end + else + begin + gx:=0; + end; + + // label + if (flags and ACF_NOSTATIC)=0 then + begin + if width<=150 then + begin + fullline:=true; + rc.bottom:=11*uy div 8; + xo:=dx-gx*2; + end + else + begin + fullline:=false; + rc.bottom:=14*uy div 8; // same as param type combobox + xo:=dx div 3; + end; + ctrl:=CreateWindowW('STATIC','Result type',WS_CHILD+WS_VISIBLE+SS_RIGHT+SS_CENTERIMAGE, + gx,yo,xo-gx,rc.bottom, result,IDC_LABEL_PAR,hInstance,nil); + SendMessageW(ctrl,WM_SETFONT,hf,0); + end + else + begin + fullline:=true; + end; + + // result type + rc.bottom:=14*uy div 8; + if fullline then + begin + xo:=gx; + if (flags and ACF_NOSTATIC)=0 then + inc(yo,rc.bottom); + end; + ctrl:=CreateWindowW('COMBOBOX',nil,WS_CHILD+WS_VISIBLE+WS_VSCROLL+CBS_DROPDOWNLIST+CBS_AUTOHSCROLL, + xo+2,yo,dx-xo-gx-2,76, result,IDC_RES_TYPE,hInstance,nil); + + SendMessageW(ctrl,WM_SETFONT,hf,0); + MakeResultTypeList(ctrl,flags); + inc(yo,rc.bottom+2); + + // 'free memory' checkbox + rc.bottom:=11*uy div 8; + + ctrl:=CreateWindowW('BUTTON','Free memory',WS_CHILD+WS_VISIBLE+BS_AUTOCHECKBOX, + gx,yo,dx-gx*2,rc.bottom, result,IDC_RES_FREEMEM,hInstance,nil); + SendMessageW(ctrl,WM_SETFONT,hf,0); + inc(yo,rc.bottom+4); + + if (flags and ACF_NOVISUAL)=0 then + begin + dec(yo,rc.bottom+4); + + ctrl:=CreateWindowW('BUTTON','Signed',WS_CHILD+WS_VISIBLE+BS_AUTOCHECKBOX, + gx,yo,dx-gx*2,rc.bottom, result,IDC_RES_SIGNED,hInstance,nil); + SendMessageW(ctrl,WM_SETFONT,hf,0); + inc(yo,rc.bottom+2); + + ctrl:=CreateWindowW('BUTTON','As hex',WS_CHILD+WS_VISIBLE+BS_AUTOCHECKBOX, + gx,yo,dx-gx*2,rc.bottom, result,IDC_RES_HEXNUM,hInstance,nil); + SendMessageW(ctrl,WM_SETFONT,hf,0); + inc(yo,rc.bottom+4); + end; + + // resize group and dialog + MoveWindow(result,x,y,dx,yo,false); + if (flags and ACF_NOBORDER)=0 then + MoveWindow(group,0,0,dx,yo,false); + + ClearResultFields(result); +end; + +function SetResultValue(Dialog:HWND;flags:dword):integer; +var + w:HWND; + btn:cardinal; + sh,sh1:integer; +begin + if Dialog=0 then + begin + result:=ACF_RNUMBER; + exit; + end; + + // RESULT + sh :=SW_HIDE; + sh1:=SW_HIDE; + w:=GetDlgItem(Dialog,IDC_RES_HEXNUM); + if (flags and ACF_RSTRUCT)<>0 then + result:=ACF_RSTRUCT + else if (flags and (ACF_RSTRING or ACF_RUNICODE))<>0 then + begin + sh:=SW_SHOW; + + if (flags and ACF_RFREEMEM)<>0 then + btn:=BST_CHECKED + else + btn:=BST_UNCHECKED; + CheckDlgButton(Dialog,IDC_RES_FREEMEM,btn); + + if (flags and ACF_RUNICODE)<>0 then + result:=ACF_RUNICODE + else + result:=ACF_RSTRING; + end + else + begin + result:=ACF_RNUMBER; + if w<>0 then + begin + sh1:=SW_SHOW; + if (flags and ACF_RSIGNED)<>0 then + btn:=BST_CHECKED + else + btn:=BST_UNCHECKED; + CheckDlgButton(Dialog,IDC_RES_SIGNED,btn); + if (flags and ACF_RHEXNUM)<>0 then + btn:=BST_CHECKED + else + btn:=BST_UNCHECKED; + CheckDlgButton(Dialog,IDC_RES_HEXNUM,btn); + end; + end; + ShowWindow(GetDlgItem(Dialog,IDC_RES_FREEMEM),sh); + if w<>0 then + begin + ShowWindow(w,sh1); + ShowWindow(GetDlgItem(Dialog,IDC_RES_SIGNED),sh1); + end; + CB_SelectData(Dialog,IDC_RES_TYPE,result); +end; + +function GetResultValue(Dialog:HWND):dword; +begin + if Dialog=0 then + begin + result:=ACF_RNUMBER; + exit; + end; + + case CB_GetData(GetDlgItem(Dialog,IDC_RES_TYPE)) of + ACF_RSTRING: begin + result:=ACF_RSTRING; + if IsDlgButtonChecked(Dialog,IDC_RES_FREEMEM)=BST_CHECKED then + result:=result or ACF_RFREEMEM; + end; + ACF_RUNICODE: begin + result:={!!atavizm ACF_RSTRING or }ACF_RUNICODE; + if IsDlgButtonChecked(Dialog,IDC_RES_FREEMEM)=BST_CHECKED then + result:=result or ACF_RFREEMEM; + end; + ACF_RSTRUCT: result:=ACF_RSTRUCT; + else + result:=ACF_RNUMBER; + if GetDlgItem(Dialog,IDC_RES_HEXNUM)<>0 then + begin + if IsDlgButtonChecked(Dialog,IDC_RES_SIGNED)=BST_CHECKED then + result:=result or ACF_RSIGNED + else if IsDlgButtonChecked(Dialog,IDC_RES_HEXNUM)=BST_CHECKED then + result:=result or ACF_RHEXNUM; + end; + end; + +end; + +end. diff --git a/plugins/Utils.pas/srvblock.pas b/plugins/Utils.pas/srvblock.pas new file mode 100644 index 0000000000..debd99cddf --- /dev/null +++ b/plugins/Utils.pas/srvblock.pas @@ -0,0 +1,488 @@ +unit srvblock; + +interface + +uses + windows; + +const + ACF_SCRIPT_SERVICE = $01000000; // high byte of dword + ACF_SCRIPT_EXPAND = $10000000; // all subblocks are visible + +type + pServiceValue = ^tServiceValue; + tServiceValue = record + service:pAnsiChar; + wparam, + lparam: pointer; + w_flag, + l_flag, + flags:dword; // result etc + end; + +function CreateServiceBlock(parent:HWND;x,y,width,height:integer;flags:dword=0):HWND; +procedure ClearServiceBlock(Dialog:HWND); +procedure SetServiceListMode(Dialog:HWND;mode:integer); + +function SetSrvBlockValue(Dialog:HWND;const value:tServiceValue):boolean; +function GetSrvBlockValue(Dialog:HWND;var value:tServiceValue):boolean; + +// service setting will load templates +procedure SetSrvBlockService(Dialog:HWND; service:pAnsiChar); +function GetSrvBlockService(Dialog:HWND):pAnsiChar; + +implementation + +uses + messages, + common, m_api, + wrapper,Editwrapper, + mApiCardM, sparam; + +const + IDC_S_SERVICE = 2040; + IDC_C_SERVICE = 2041; + IDC_CLOSE_WPAR = 2042; + IDC_CLOSE_LPAR = 2043; + IDC_CLOSE_RES = 2044; + +function GetApiCard(Dialog:HWND):tmApiCard; +begin + result:=tmApiCard(GetWindowLongPtrW(GetDlgItem(Dialog,IDC_S_SERVICE),GWLP_USERDATA)); +end; + +function GetWPar(Dialog:HWND):HWND; +begin + result:=GetWindowLongPtrW(GetDlgItem(Dialog,IDC_CLOSE_WPAR),GWLP_USERDATA); +end; + +function GetLPar(Dialog:HWND):HWND; +begin + result:=GetWindowLongPtrW(GetDlgItem(Dialog,IDC_CLOSE_LPAR),GWLP_USERDATA); +end; + +function GetRes(Dialog:HWND):HWND; +begin + result:=GetWindowLongPtrW(GetDlgItem(Dialog,IDC_CLOSE_RES),GWLP_USERDATA); +end; + +procedure ShowBlock(Dialog:HWND;id:integer); +var + wpar ,lpar ,res:HWND; + wparb,lparb,resb:HWND; + wnd,wndb:HWND; + rc,rc1:TRECT; + pt:TPOINT; +begin + // buttons + wpar:=GetDlgItem(Dialog,IDC_CLOSE_WPAR); + lpar:=GetDlgItem(Dialog,IDC_CLOSE_LPAR); + res :=GetDlgItem(Dialog,IDC_CLOSE_RES); + + // blocks + wparb:=GetWindowLongPtrW(wpar,GWLP_USERDATA); + lparb:=GetWindowLongPtrW(lpar,GWLP_USERDATA); + resb :=GetWindowLongPtrW(res ,GWLP_USERDATA); + + if id=0 then + begin + ShowWindow(wparb,SW_HIDE); + ShowWindow(lparb,SW_HIDE); + ShowWindow(resb ,SW_HIDE); + exit; + end; + + // starting point of coords + GetWindowRect(wpar,rc); + pt.x:=rc.left; + pt.y:=rc.bottom; + ScreenToClient(Dialog,pt); + // show/hide blocks + // enable/disable buttons + // move buttons to new place + case id of + IDC_CLOSE_WPAR: begin + CheckDlgButton(Dialog,IDC_CLOSE_WPAR,BST_CHECKED); + CheckDlgButton(Dialog,IDC_CLOSE_LPAR,BST_UNCHECKED); + CheckDlgButton(Dialog,IDC_CLOSE_RES ,BST_UNCHECKED); + EnableWindow(lpar,true); + EnableWindow(res ,true); + ShowWindow(lparb,SW_HIDE); + ShowWindow(resb ,SW_HIDE); + wnd :=wpar; + wndb:=wparb; + + GetClientRect(wparb,rc1); + SetWindowPos(lpar,HWND_TOP,pt.x,pt.y+rc1.bottom+5,0,0,SWP_NOZORDER or SWP_NOSIZE); + GetClientRect(lpar,rc); + SetWindowPos(res,HWND_TOP,pt.x,pt.y+rc1.bottom+rc.bottom+10,0,0,SWP_NOZORDER or SWP_NOSIZE); + end; + + IDC_CLOSE_LPAR: begin + CheckDlgButton(Dialog,IDC_CLOSE_WPAR,BST_UNCHECKED); + CheckDlgButton(Dialog,IDC_CLOSE_LPAR,BST_CHECKED); + CheckDlgButton(Dialog,IDC_CLOSE_RES ,BST_UNCHECKED); + EnableWindow(wpar,true); + EnableWindow(res ,true); + ShowWindow(wparb,SW_HIDE); + ShowWindow(resb ,SW_HIDE); + wnd :=lpar; + wndb:=lparb; + + SetWindowPos(lpar,HWND_TOP,pt.x,pt.y+5,0,0,SWP_NOZORDER or SWP_NOSIZE); + GetClientRect(lpar ,rc); + GetClientRect(lparb,rc1); + SetWindowPos(res,HWND_TOP,pt.x,pt.y+rc1.bottom+rc.bottom+10,0,0,SWP_NOZORDER or SWP_NOSIZE); + end; + + IDC_CLOSE_RES: begin + CheckDlgButton(Dialog,IDC_CLOSE_WPAR,BST_UNCHECKED); + CheckDlgButton(Dialog,IDC_CLOSE_LPAR,BST_UNCHECKED); + CheckDlgButton(Dialog,IDC_CLOSE_RES ,BST_CHECKED); + EnableWindow(wpar,true); + EnableWindow(lpar,true); + ShowWindow(wparb,SW_HIDE); + ShowWindow(lparb,SW_HIDE); + wnd :=res; + wndb:=resb; + + SetWindowPos(lpar,HWND_TOP,pt.x,pt.y+5,0,0,SWP_NOZORDER or SWP_NOSIZE); + GetClientRect(lpar,rc); + SetWindowPos(res,HWND_TOP,pt.x,pt.y+rc.bottom+10,0,0,SWP_NOZORDER or SWP_NOSIZE); + end; + end; + EnableWindow(wnd ,false); + ShowWindow (wndb,SW_SHOW); +end; + +procedure ReloadService(Dialog:HWND;srv:pAnsiChar;setvalue:boolean); +var + pc:pAnsiChar; + ApiCard:tmApiCard; + flag:dword; +begin + ApiCard:=GetApiCard(Dialog); + ApiCard.Service:=srv; + + pc:=ApiCard.GetParam(true); + if pc<>nil then + begin + FillParam(GetWPar(Dialog),pc); +(* + if GetDlgItemTextA(Dialog,IDC_EDIT_WPAR,buf1,SizeOf(buf1))>0 then + case FixParam(Dialog,@buf1,IDC_FLAG_WPAR) of + ptStruct: begin + if setvalue then + begin + struct:=pAnsiChar(SetWindowLongPtrW(GetDlgItem(Dialog,IDC_WSTRUCT),GWLP_USERDATA, + long_ptr(StrDup(struct,StrScan(pc,'|')+1)))); + mFreeMem(struct); + end; + +{ struct:=pAnsiChar(GetWindowLongPtrW(GetDlgItem(Dialog,IDC_WSTRUCT),GWLP_USERDATA)); + mFreeMem(struct); + StrDup(struct,StrScan(pc,'|')+1); + SetWindowLongPtrW(GetDlgItem(Dialog,IDC_WSTRUCT),GWLP_USERDATA,long_ptr(struct)); +// AnsiToWide(StrScan(pc,'|')+1,wstruct,MirandaCP); +} + end; + end; +*) + mFreeMem(pc); + end; + + pc:=ApiCard.GetParam(false); + if pc<>nil then + begin + FillParam(GetLPar(Dialog),pc); + mFreeMem(pc); + end; + + pc:=ApiCard.ResultType; + flag:=ACF_RNUMBER; + if pc<>nil then + begin + if lstrcmpia(pc,'struct')=0 then flag:=ACF_RSTRUCT + else if lstrcmpia(pc,'str')=0 then + begin + flag:=ACF_RSTRING; + end + else if lstrcmpia(pc,'wide')=0 then + begin + flag:=ACF_RUNICODE; + end; + mFreeMem(pc); + end; + + SetResultValue(GetRes(Dialog),flag); +end; + +procedure FillTemplate(Dialog:HWND); +var + wnd:HWND; + buf:array [0..127] of AnsiChar; +begin + wnd:=GetDlgItem(Dialog,IDC_C_SERVICE); + SendMessageA(wnd,CB_GETLBTEXT,SendMessage(wnd,CB_GETCURSEL,0,0),tlparam(@buf)); + ReloadService(Dialog,@buf,true); +end; + +function DlgServiceProc(Dialog:HWnd;hMessage:uint;wParam:WPARAM;lParam:LPARAM):lresult; stdcall; +var + proc:pointer; + pc:pAnsiChar; + ApiCard:tmApiCard; +begin + result:=0; + + case hMessage of + WM_DESTROY: begin + ApiCard:=GetApiCard(Dialog); + if ApiCard<>nil then + ApiCard.Free; + end; + + WM_HELP: begin + ApiCard:=GetApiCard(Dialog); + pc:=ApiCard.NameFromList(GetDlgItem(Dialog,IDC_C_SERVICE)); + ApiCard.Service:=pc; + mFreeMem(pc); + ApiCard.Show; + + result:=1; + end; + + WM_COMMAND: begin + case wParam shr 16 of + CBN_EDITCHANGE, + EN_CHANGE: begin + SendMessage(GetParent(Dialog),WM_COMMAND,CBN_EDITCHANGE shl 16,Dialog); + end; + + BN_CLICKED: begin + case loword(wParam) of + IDC_CLOSE_WPAR, + IDC_CLOSE_LPAR, + IDC_CLOSE_RES: ShowBlock(Dialog,loword(wParam)); + end; + end; + + CBN_SELCHANGE: begin + case loword(wParam) of + IDC_C_SERVICE: FillTemplate(Dialog); + end; + end; + end; + end; + else + proc:=pointer(GetWindowLongPtrW(Dialog,GWLP_USERDATA)); + result:=CallWindowProc(proc,Dialog,hMessage,wParam,lParam) + end; +end; + +function CreateServiceBlock(parent:HWND;x,y,width,height:integer;flags:dword=0):HWND; +var + hf:HFONT; + ctrl,wnd,srv,srvs:HWND; + proc:pointer; + ApiCard:tmApiCard; + rc,rc1:TRECT; + dx,dy:integer; + ux,uy:integer; + h,bs:integer; +begin + hf:=SendMessageW(parent,WM_GETFONT,0,0); + GetUnitSize(parent,ux,uy); + + // let think what x,y and width is dialog-related + if height=0 then + h:=100 + else + h:=height; + SetRect(rc,x,y,x+width,y+h); + dx:=rc.right-rc.left; + + result:=CreateWindowExW(WS_EX_CONTROLPARENT,'STATIC',nil,WS_CHILD+WS_VISIBLE, + x,y,dx,rc.bottom-rc.top, parent,0,hInstance,nil); + proc:=pointer(SetWindowLongPtrW(result,GWLP_WNDPROC,long_ptr(@DlgServiceProc))); + SetWindowLongPtrW(result,GWLP_USERDATA,long_ptr(proc)); + SendMessageW(result,WM_SETFONT,hf,0); + + dy:=0; + // Service label + rc.bottom:=12*uy div 8; + srvs:=CreateWindowW('STATIC','Service:',WS_CHILD+WS_VISIBLE+SS_CENTERIMAGE+SS_LEFT, + 0,dy,dx,rc.bottom, result,IDC_S_SERVICE,hInstance,nil); + SendMessageW(srvs,WM_SETFONT,hf,0); + inc(dy,rc.bottom+2); + + // Service name combobox + rc.bottom:=14*uy div 8; + srv:=CreateWindowW('COMBOBOX',nil,WS_CHILD+WS_VISIBLE+WS_VSCROLL+CBS_DROPDOWN+CBS_AUTOHSCROLL, + 0,dy,dx,76, result,IDC_C_SERVICE,hInstance,nil); + SendMessageW(srv,WM_SETFONT,hf,0); + inc(dy,rc.bottom+2); + MakeEditField(result,IDC_C_SERVICE); + + if (flags and ACF_SCRIPT_EXPAND)<>0 then + bs:=WS_CHILD+BS_AUTOCHECKBOX+BS_PUSHLIKE + else + bs:=WS_CHILD+WS_VISIBLE+BS_AUTOCHECKBOX+BS_PUSHLIKE; + + // wParam button+block + rc.bottom:=11*uy div 8; + ctrl:=CreateWindowW('BUTTON','wParam',bs, + 0,dy,dx,rc.bottom, result,IDC_CLOSE_WPAR,hInstance,nil); + SendMessageW(ctrl,WM_SETFONT,hf,0); + if (flags and ACF_SCRIPT_EXPAND)=0 then + inc(dy,rc.bottom+4); + + wnd:=CreateParamBlock(result,0,dy,dx,flags); + SetWindowLongPtrW(ctrl,GWLP_USERDATA,wnd); + SetParamLabel(wnd,'wParam'); + GetClientRect(wnd,rc1); + if (flags and ACF_SCRIPT_EXPAND)<>0 then + inc(dy,rc1.bottom+8); + + // lParam button+block + ctrl:=CreateWindowW('BUTTON','lParam',bs, + 0,dy,dx,rc.bottom, result,IDC_CLOSE_LPAR,hInstance,nil); + SendMessageW(ctrl,WM_SETFONT,hf,0); + if (flags and ACF_SCRIPT_EXPAND)=0 then + inc(dy,rc.bottom+4); + + wnd:=CreateParamBlock(result,0,dy,dx,flags); + SetWindowLongPtrW(ctrl,GWLP_USERDATA,wnd); + SetParamLabel(wnd,'lParam'); + if (flags and ACF_SCRIPT_EXPAND)<>0 then + inc(dy,rc1.bottom+8); + + // result button+block + ctrl:=CreateWindowW('BUTTON','Result',bs, + 0,dy,dx,rc.bottom, result,IDC_CLOSE_RES,hInstance,nil); + SendMessageW(ctrl,WM_SETFONT,hf,0); + if (flags and ACF_SCRIPT_EXPAND)=0 then + inc(dy,rc.bottom+4); + + wnd:=CreateResultBlock(result,0,dy,dx,flags); + SetWindowLongPtrW(ctrl,GWLP_USERDATA,wnd); + GetClientRect(wnd,rc); + + // autoresize panel + if height=0 then + begin + if (flags and ACF_SCRIPT_EXPAND)=0 then + begin + if rc1.bottom>rc.bottom then + h:=rc1.bottom + else + h:=rc.bottom; + end + else + begin + h:=rc.bottom; + end; + MoveWindow(result,x,y,dx,dy+h,false); + end; + + // additional + ApiCard:=CreateServiceCard(result); + ApiCard.FillList(srv); + SetWindowLongPtrW(srvs,GWLP_USERDATA,long_ptr(ApiCard)); + + if (flags and ACF_SCRIPT_EXPAND)=0 then + ShowBlock(result,IDC_CLOSE_WPAR); +end; + +procedure ClearServiceBlock(Dialog:HWND); +begin + if Dialog=0 then + exit; + + SetDlgItemTextA(Dialog,IDC_C_SERVICE,''); + SetEditFlags(GetDlgItem(Dialog,IDC_C_SERVICE),EF_SCRIPT,0); + + SetParamValue (GetWPar(Dialog),ACF_NUMBER,nil); + SetParamValue (GetLPar(Dialog),ACF_NUMBER,nil); + SetResultValue(GetRes (Dialog),ACF_RNUMBER); +end; + +procedure SetServiceListMode(Dialog:HWND;mode:integer); +var + ApiCard:tmApiCard; +begin + if Dialog=0 then + exit; + + ApiCard:=GetApiCard(Dialog); + ApiCard.FillList(GetDlgItem(Dialog,IDC_C_SERVICE),mode); +end; + +function SetSrvBlockValue(Dialog:HWND;const value:tServiceValue):boolean; +begin + if Dialog=0 then + begin + result:=false; + exit; + end; + + result:=true; + + if CB_SelectData(Dialog,IDC_C_SERVICE,Hash(value.service,StrLen(value.service)))<>CB_ERR then +;{ + ReloadService(Dialog,value.service,false) + else +} + SetDlgItemTextA(Dialog,IDC_C_SERVICE,value.service); + + SetEditFlags(GetDlgItem(Dialog,IDC_C_SERVICE),EF_SCRIPT, + ord((value.flags and ACF_SCRIPT_SERVICE)<>0)); + + SetParamValue (GetWPar(Dialog),value.w_flag,value.wparam); + SetParamValue (GetLPar(Dialog),value.l_flag,value.lparam); + SetResultValue(GetRes (Dialog),value.flags and ACF_RTYPE); +end; + +function GetSrvBlockValue(Dialog:HWND;var value:tServiceValue):boolean; +var + ApiCard:tmApiCard; +begin + if Dialog=0 then + begin + result:=false; + exit; + end; + + result:=true; + + ApiCard:=GetApiCard(Dialog); + value.service:=ApiCard.NameFromList(GetDlgItem(Dialog,IDC_C_SERVICE)); + + GetParamValue(GetWPar(Dialog),value.w_flag,value.wparam); + GetParamValue(GetLPar(Dialog),value.l_flag,value.lparam); + value.flags:=GetResultValue(GetRes(Dialog)); + + if (GetEditFlags(Dialog,IDC_C_SERVICE) and EF_SCRIPT)<>0 then + value.flags:=value.flags or ACF_SCRIPT_SERVICE; +end; + +procedure SetSrvBlockService(Dialog:HWND; service:pAnsiChar); +begin + if Dialog=0 then + exit; + + ReloadService(Dialog,service,true); +end; + +function GetSrvBlockService(Dialog:HWND):pAnsiChar; +begin + if Dialog=0 then + begin + result:=nil; + exit; + end; + + result:=GetDlgText(Dialog,IDC_C_SERVICE); +end; + +end. diff --git a/plugins/Utils.pas/strans.pas b/plugins/Utils.pas/strans.pas index b9c9a335f6..0ed7c44bad 100644 --- a/plugins/Utils.pas/strans.pas +++ b/plugins/Utils.pas/strans.pas @@ -10,6 +10,7 @@ const char_hex = '$'; char_return = '*'; char_script = '%'; + char_size = '@'; {$IFDEF Miranda} char_mmi = '&'; {$ENDIF} @@ -30,6 +31,7 @@ const SF_RETURN = $00000001; SF_SCRIPT = $00000002; SF_MMI = $00000004; + SF_SIZE = $00000008; SF_LAST = $00000080; type // int_ptr = to use aligned structure data at start @@ -177,6 +179,7 @@ begin begin case txt^ of char_return: res.flags:=res.flags or SF_RETURN; + char_size : res.flags:=res.flags or SF_SIZE; {$IFDEF Miranda} char_script: res.flags:=res.flags or SF_SCRIPT; char_mmi : res.flags:=res.flags or SF_MMI; @@ -609,6 +612,11 @@ begin p:=StrScan(pc,char_separator); GetOneElement(pc,element,false); + if (element.flags and SF_SIZE)<>0 then + begin + element.value:=summ-addsize; + end; + if (element.flags and SF_SCRIPT)<>0 then begin {$IFDEF Miranda} diff --git a/plugins/Utils.pas/uRect.pas b/plugins/Utils.pas/uRect.pas new file mode 100644 index 0000000000..6d383ef518 --- /dev/null +++ b/plugins/Utils.pas/uRect.pas @@ -0,0 +1,283 @@ +unit uRect; + +interface + +uses windows; + +{ +type + PPoint = ^TPoint; + TPoint = packed record + X: Longint; + Y: Longint; + end; + + PSmallPoint = ^TSmallPoint; + TSmallPoint = packed record + x: SmallInt; + y: SmallInt; + end; + + PRect = ^TRect; + TRect = packed record + case Integer of + 0: (Left, Top, Right, Bottom: Longint); + 1: (TopLeft, BottomRight: TPoint); + end; +} +{ +-function SetRect(var lprc: TRect; xLeft, yTop, xRight, yBottom: Integer): BOOL; stdcall; +-function CopyRect(var lprcDst: TRect; const lprcSrc: TRect): BOOL; stdcall; +-function InflateRect(var lprc: TRect; dx, dy: Integer): BOOL; stdcall; +function SubtractRect(var lprcDst: TRect; const lprcSrc1, lprcSrc2: TRect): BOOL; stdcall; +-function SetRectEmpty(var lprc: TRect): BOOL; stdcall; +-function IntersectRect(var lprcDst: TRect; const lprcSrc1, lprcSrc2: TRect): BOOL; stdcall; +-function UnionRect(var lprcDst: TRect; const lprcSrc1, lprcSrc2: TRect): BOOL; stdcall; +-function OffsetRect(var lprc: TRect; dx, dy: Integer): BOOL; stdcall; +-function IsRectEmpty(const lprc: TRect): BOOL; stdcall; +-function EqualRect(const lprc1, lprc2: TRect): BOOL; stdcall; +-function PtInRect(const lprc: TRect; pt: TPoint): BOOL; stdcall; +} + +function Point(X, Y: Integer): TPoint; overload; +procedure Point(var pt:TPoint; X, Y: Integer); overload; + +function SmallPoint(X, Y: Integer): TSmallPoint; overload; +function SmallPoint(XY: LongWord): TSmallPoint; overload; + +function CenterPoint(const Rect: TRect): TPoint; overload; +procedure CenterPoint(const Rect: TRect; var pt:TPoint); overload; +function PointInRect(const P: TPoint; const Rect: TRect): Boolean; +function PtInRect (const Rect: TRect; const P: TPoint): Boolean; + +function Rect (Left, Top, Right, Bottom: Integer): TRect; overload; +procedure Rect (var Rect:TRect; Left, Top, Right, Bottom: Integer); overload; +procedure SetRect(var Rect:TRect; Left, Top, Right, Bottom: Integer); +function CopyRect(var Rect: TRect; const R1: TRect):Boolean; +function SetRectEmpty(var Rect: TRect): Boolean; + +function Bounds(ALeft, ATop, AWidth, AHeight: Integer): TRect; overload; +procedure Bounds(var Rect:TRect; ALeft, ATop, AWidth, AHeight: Integer); overload; + +function EqualRect(const R1, R2: TRect): Boolean; +function IsRectInside(const R1, R2: TRect): Boolean; +function IsRectEmpty(const Rect: TRect): Boolean; +function InflateRect(var Rect: TRect; dx, dy: Integer): Boolean; +function OffsetRect(var Rect: TRect; DX: Integer; DY: Integer): Boolean; +function IntersectRect(var Rect: TRect; const R1, R2: TRect): Boolean; overload; +function IntersectRect(const R1, R2: TRect): Boolean; overload; +function UnionRect(var Rect: TRect; const R1, R2: TRect): Boolean; + + +implementation + +function Point(X, Y: Integer): TPoint; +begin + Result.X := X; + Result.Y := Y; +end; + +procedure Point(var pt:TPoint; X, Y: Integer); +begin + pt.X := X; + pt.Y := Y; +end; + +function SmallPoint(X, Y: Integer): TSmallPoint; +begin + Result.X := X; + Result.Y := Y; +end; + +function SmallPoint(XY: LongWord): TSmallPoint; +begin + Result.X := SmallInt(XY and $0000FFFF); + Result.Y := SmallInt(XY shr 16); +end; + +function PointInRect(const P: TPoint; const Rect: TRect): Boolean; +begin + Result := + (P.X >= Rect.Left) and + (P.X < Rect.Right) and + (P.Y >= Rect.Top) and + (P.Y < Rect.Bottom); +end; + +function PtInRect(const Rect: TRect; const P: TPoint): Boolean; +begin + Result := + (P.X >= Rect.Left) and + (P.X < Rect.Right) and + (P.Y >= Rect.Top) and + (P.Y < Rect.Bottom); +end; + +function CenterPoint(const Rect: TRect): TPoint; +begin + with Rect do + begin + Result.X := (Right - Left) div 2 + Left; + Result.Y := (Bottom - Top ) div 2 + Top; + end; +end; + +procedure CenterPoint(const Rect: TRect; var pt:TPoint); +begin + with Rect do + begin + pt.X := (Right - Left) div 2 + Left; + pt.Y := (Bottom - Top ) div 2 + Top; + end; +end; + +//----- TRect ----- + +function Rect(Left, Top, Right, Bottom: Integer): TRect; +begin + Result.Left := Left; + Result.Top := Top; + Result.Bottom := Bottom; + Result.Right := Right; +end; + +procedure Rect(var Rect:TRect; Left, Top, Right, Bottom: Integer); +begin + Rect.Left := Left; + Rect.Top := Top; + Rect.Bottom := Bottom; + Rect.Right := Right; +end; + +procedure SetRect(var Rect:TRect; Left, Top, Right, Bottom: Integer); +begin + Rect.Left := Left; + Rect.Top := Top; + Rect.Bottom := Bottom; + Rect.Right := Right; +end; + +function CopyRect(var Rect: TRect; const R1: TRect): Boolean; +begin + Rect := R1; + Result := not IsRectEmpty(Rect); +end; + +function SetRectEmpty(var Rect: TRect): Boolean; +begin + FillChar(Rect,SizeOf(Rect),0); + Result := True; +end; + +function EqualRect(const R1, R2: TRect): Boolean; +begin + Result := + (R1.Left = R2.Left) and + (R1.Right = R2.Right) and + (R1.Top = R2.Top) and + (R1.Bottom = R2.Bottom); +end; + +function IsRectInside(const R1, R2: TRect): Boolean; +begin + Result := + (R1.Left >= R2.Left) and + (R1.Right <= R2.Right) and + (R1.Top >= R2.Top) and + (R1.Bottom <= R2.Bottom); +end; + +function IsRectEmpty(const Rect: TRect): Boolean; +begin + Result := (Rect.Right <= Rect.Left) or (Rect.Bottom <= Rect.Top); +end; + +function IntersectRect(const R1, R2: TRect): Boolean; +var + ml,mr,mt,mb:longint; +begin + if R1.Left > R2.Left then ml := R1.Left else ml := R2.Left; + if R1.Right < R2.Right then mr := R1.Right else mr := R2.Right; + if R1.Top > R2.Top then mt := R1.Top else mt := R2.Top; + if R1.Bottom < R2.Bottom then mb := R1.Bottom else mb := R2.Bottom; + + Result := (ml < mr) and (mt < mb); +end; + +function IntersectRect(var Rect: TRect; const R1, R2: TRect): Boolean; +var + lRect:TRect; +begin + lRect := R1; + if R2.Left > R1.Left then lRect.Left := R2.Left; + if R2.Top > R1.Top then lRect.Top := R2.Top; + if R2.Right < R1.Right then lRect.Right := R2.Right; + if R2.Bottom < R1.Bottom then lRect.Bottom := R2.Bottom; + Result := not IsRectEmpty(lRect); + if not Result then FillChar(lRect, SizeOf(lRect), 0); + Rect:=lRect; +end; + +function UnionRect(var Rect: TRect; const R1, R2: TRect): Boolean; +begin + Rect := R1; + if not IsRectEmpty(R2) then + begin + if R2.Left < R1.Left then Rect.Left := R2.Left; + if R2.Top < R1.Top then Rect.Top := R2.Top; + if R2.Right > R1.Right then Rect.Right := R2.Right; + if R2.Bottom > R1.Bottom then Rect.Bottom := R2.Bottom; + end; + Result := not IsRectEmpty(Rect); + if not Result then FillChar(Rect, SizeOf(Rect), 0); +end; + +function InflateRect(var Rect: TRect; dx, dy: Integer): Boolean; +begin + with Rect do + begin + Left := Left - dx; + Right := Right + dx; + Top := Top - dy; + Bottom := Bottom + dy; + end; + Result := not IsRectEmpty(Rect); +end; + +function OffsetRect(var Rect: TRect; DX: Integer; DY: Integer): Boolean; +begin + if @Rect <> nil then // Test to increase compatiblity with Windows + begin + Inc(Rect.Left , DX); + Inc(Rect.Right , DX); + Inc(Rect.Top , DY); + Inc(Rect.Bottom, DY); + Result := True; + end + else + Result := False; +end; + +function Bounds(ALeft, ATop, AWidth, AHeight: Integer): TRect; +begin + with Result do + begin + Left := ALeft; + Top := ATop; + Right := ALeft + AWidth; + Bottom := ATop + AHeight; + end; +end; + +procedure Bounds(var Rect:TRect; ALeft, ATop, AWidth, AHeight: Integer); +begin + with Rect do + begin + Left := ALeft; + Top := ATop; + Right := ALeft + AWidth; + Bottom := ATop + AHeight; + end; +end; + +end. diff --git a/plugins/Utils.pas/wrapper.pas b/plugins/Utils.pas/wrapper.pas index fb7b079774..25b23a05f0 100644 --- a/plugins/Utils.pas/wrapper.pas +++ b/plugins/Utils.pas/wrapper.pas @@ -23,8 +23,10 @@ function StringToGUID(const astr:PWideChar):TGUID; overload; function CB_SelectData(cb:HWND;data:lparam):lresult; overload; function CB_SelectData(Dialog:HWND;id:cardinal;data:lparam):lresult; overload; function CB_GetData (cb:HWND;idx:integer=-1):lresult; overload; -function CB_AddStrData (cb:HWND;astr:pAnsiChar;data:lparam=0;idx:integer=-1):HWND; -function CB_AddStrDataW(cb:HWND;astr:pWideChar;data:lparam=0;idx:integer=-1):HWND; +function CB_AddStrData (cb:HWND;astr:pAnsiChar;data:lparam=0;idx:integer=-1):HWND; overload; +function CB_AddStrData (Dialog:HWND;id:cardinal;astr:pAnsiChar;data:lparam=0;idx:integer=-1):HWND; overload; +function CB_AddStrDataW(cb:HWND;astr:pWideChar;data:lparam=0;idx:integer=-1):HWND; overload; +function CB_AddStrDataW(Dialog:HWND;id:cardinal;astr:pWideChar;data:lparam=0;idx:integer=-1):HWND; overload; // CommCtrl - ListView Procedure ListView_GetItemTextA(hwndLV:hwnd;i:WPARAM;iSubItem:integer;pszText:Pointer;cchTextMax:integer); @@ -43,6 +45,8 @@ function LV_CheckDirection(list:HWND):integer; // bit 0 - can move up, bit 1 - function ShowDlg (dst:PAnsiChar;fname:PAnsiChar=nil;Filter:PAnsiChar=nil;open:boolean=true):boolean; function ShowDlgW(dst:PWideChar;fname:PWideChar=nil;Filter:PWideChar=nil;open:boolean=true):boolean; +procedure GetUnitSize(wnd:HWND; var baseUnitX, baseUnitY: integer); + implementation uses messages,common,commctrl,commdlg; @@ -220,6 +224,11 @@ begin SendMessageA(cb,CB_SETITEMDATA,idx,data); end; +function CB_AddStrData(Dialog:HWND;id:cardinal;astr:pAnsiChar;data:lparam=0;idx:integer=-1):HWND; +begin + result:=CB_AddStrData(GetDlgItem(Dialog,id),astr,data,idx); +end; + function CB_AddStrDataW(cb:HWND;astr:pWideChar;data:lparam=0;idx:integer=-1):HWND; begin result:=cb; @@ -230,6 +239,11 @@ begin SendMessage(cb,CB_SETITEMDATA,idx,data); end; +function CB_AddStrDataW(Dialog:HWND;id:cardinal;astr:pWideChar;data:lparam=0;idx:integer=-1):HWND; +begin + result:=CB_AddStrDataW(GetDlgItem(Dialog,id),astr,data,idx); +end; + function StringToGUID(const astr:PAnsiChar):TGUID; var i:integer; @@ -456,6 +470,11 @@ function ShowDlg(dst:PAnsiChar;fname:PAnsiChar=nil;Filter:PAnsiChar=nil;open:boo var NameRec:OpenFileNameA; begin + if dst=nil then + begin + result:=false; + exit; + end; FillChar(NameRec,SizeOf(NameRec),0); with NameRec do begin @@ -485,6 +504,11 @@ function ShowDlgW(dst:PWideChar;fname:PWideChar=nil;Filter:PWideChar=nil;open:bo var NameRec:OpenFileNameW; begin + if dst=nil then + begin + result:=false; + exit; + end; FillChar(NameRec,SizeOf(NameRec),0); with NameRec do begin @@ -510,4 +534,21 @@ begin result:=GetSaveFileNameW({$IFDEF FPC}@{$ENDIF}NameRec) end; +procedure GetUnitSize(wnd:HWND; var baseUnitX, baseUnitY: integer); +var + DC :HDC; + hfo :HFONT; + tm :TTEXTMETRIC; + size:TSIZE; +begin + dc:=GetDC(wnd); + hfo:=SelectObject(dc,SendMessage(wnd,WM_GETFONT,0,0)); + GetTextMetrics(dc,tm); + GetTextExtentPoint32(dc,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz',52,size); + SelectObject(dc,hfo); + ReleaseDC(wnd,dc); + baseUnitX:=(size.cx div 26+1) div 2; + baseUnitY:=tm.tmHeight; +end; + end. -- cgit v1.2.3