diff options
| author | Alexey Kulakov <panda75@bk.ru> | 2012-07-04 13:17:29 +0000 |
|---|---|---|
| committer | Alexey Kulakov <panda75@bk.ru> | 2012-07-04 13:17:29 +0000 |
| commit | a5a3db4393d85407ff4c5668d88860e06158abd0 (patch) | |
| tree | bcc8f716833034e33984a539ab7d1debfdd6a7d3 | |
| parent | 88ec2ae53ddc811d08763b2fb3a0073b571a321c (diff) | |
History++ sources upload (all files, no project)
git-svn-id: http://svn.miranda-ng.org/main/trunk@756 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c
117 files changed, 35635 insertions, 0 deletions
diff --git a/plugins/HistoryPlusPlus/Base64.pas b/plugins/HistoryPlusPlus/Base64.pas new file mode 100644 index 0000000000..37e37a5553 --- /dev/null +++ b/plugins/HistoryPlusPlus/Base64.pas @@ -0,0 +1,140 @@ +{******************************************************************************}
+{* DCPcrypt v2.0 written by David Barton (davebarton@bigfoot.com) *************}
+{******************************************************************************}
+{* A Base64 encoding/decoding unit ********************************************}
+{******************************************************************************}
+{* Copyright (c) 1999-2000 David Barton *}
+{* Permission is hereby granted, free of charge, to any person obtaining a *}
+{* copy of this software and associated documentation files (the "Software"), *}
+{* to deal in the Software without restriction, including without limitation *}
+{* the rights to use, copy, modify, merge, publish, distribute, sublicense, *}
+{* and/or sell copies of the Software, and to permit persons to whom the *}
+{* Software is furnished to do so, subject to the following conditions: *}
+{* *}
+{* The above copyright notice and this permission notice shall be included in *}
+{* all copies or substantial portions of the Software. *}
+{* *}
+{* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR *}
+{* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *}
+{* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *}
+{* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *}
+{* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *}
+{* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *}
+{* DEALINGS IN THE SOFTWARE. *}
+{******************************************************************************}
+unit Base64;
+
+interface
+
+function Base64EncodeStr(const Value: AnsiString): AnsiString;
+ { Encode a AnsiString into Base64 format }
+function Base64DecodeStr(const Value: AnsiString): AnsiString;
+ { Decode a Base64 format AnsiString }
+function Base64Encode(pInput: pointer; pOutput: pointer; Size: longint): longint;
+ { Encode a lump of raw data (output is (4/3) times bigger than input) }
+function Base64Decode(pInput: pointer; pOutput: pointer; Size: longint): longint;
+ { Decode a lump of raw data }
+
+
+{******************************************************************************}
+{******************************************************************************}
+implementation
+
+type {from Sysutils}
+ PByteArray = ^TByteArray;
+ TByteArray = array[0..32767] of Byte;
+
+const
+ B64: array[0..63] of byte= (65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,
+ 81,82,83,84,85,86,87,88,89,90,97,98,99,100,101,102,103,104,105,106,107,108,
+ 109,110,111,112,113,114,115,116,117,118,119,120,121,122,48,49,50,51,52,53,
+ 54,55,56,57,43,47);
+
+function Base64Encode(pInput: pointer; pOutput: pointer; Size: longint): longint;
+var
+ i, iptr, optr: integer;
+ Input, Output: PByteArray;
+begin
+ Input:= PByteArray(pInput); Output:= PByteArray(pOutput);
+ iptr:= 0; optr:= 0;
+ for i:= 1 to (Size div 3) do
+ begin
+ Output^[optr+0]:= B64[Input^[iptr] shr 2];
+ Output^[optr+1]:= B64[((Input^[iptr] and 3) shl 4) + (Input^[iptr+1] shr 4)];
+ Output^[optr+2]:= B64[((Input^[iptr+1] and 15) shl 2) + (Input^[iptr+2] shr 6)];
+ Output^[optr+3]:= B64[Input^[iptr+2] and 63];
+ Inc(optr,4); Inc(iptr,3);
+ end;
+ case (Size mod 3) of
+ 1: begin
+ Output^[optr+0]:= B64[Input^[iptr] shr 2];
+ Output^[optr+1]:= B64[(Input^[iptr] and 3) shl 4];
+ Output^[optr+2]:= byte('=');
+ Output^[optr+3]:= byte('=');
+ end;
+ 2: begin
+ Output^[optr+0]:= B64[Input^[iptr] shr 2];
+ Output^[optr+1]:= B64[((Input^[iptr] and 3) shl 4) + (Input^[iptr+1] shr 4)];
+ Output^[optr+2]:= B64[(Input^[iptr+1] and 15) shl 2];
+ Output^[optr+3]:= byte('=');
+ end;
+ end;
+ Result:= ((Size+2) div 3) * 4;
+end;
+
+function Base64EncodeStr(const Value: AnsiString): AnsiString;
+begin
+ SetLength(Result,((Length(Value)+2) div 3) * 4);
+ Base64Encode(@Value[1],@Result[1],Length(Value));
+end;
+
+function Base64Decode(pInput: pointer; pOutput: pointer; Size: longint): longint;
+var
+ i, j, iptr, optr: integer;
+ Temp: array[0..3] of byte;
+ Input, Output: PByteArray;
+begin
+ Input:= PByteArray(pInput); Output:= PByteArray(pOutput);
+ iptr:= 0; optr:= 0;
+ Result:= 0;
+ for i:= 1 to (Size div 4) do
+ begin
+ for j:= 0 to 3 do
+ begin
+ case Input^[iptr] of
+ 65..90 : Temp[j]:= Input^[iptr] - Ord('A');
+ 97..122: Temp[j]:= Input^[iptr] - Ord('a') + 26;
+ 48..57 : Temp[j]:= Input^[iptr] - Ord('0') + 52;
+ 43 : Temp[j]:= 62;
+ 47 : Temp[j]:= 63;
+ 61 : Temp[j]:= $FF;
+ end;
+ Inc(iptr);
+ end;
+ Output^[optr]:= (Temp[0] shl 2) or (Temp[1] shr 4);
+ Result:= optr+1;
+ if (Temp[2]<> $FF) and (Temp[3]= $FF) then
+ begin
+ Output^[optr+1]:= (Temp[1] shl 4) or (Temp[2] shr 2);
+ Result:= optr+2;
+ Inc(optr)
+ end
+ else if (Temp[2]<> $FF) then
+ begin
+ Output^[optr+1]:= (Temp[1] shl 4) or (Temp[2] shr 2);
+ Output^[optr+2]:= (Temp[2] shl 6) or Temp[3];
+ Result:= optr+3;
+ Inc(optr,2);
+ end;
+ Inc(optr);
+ end;
+end;
+
+function Base64DecodeStr(const Value: AnsiString): AnsiString;
+begin
+ SetLength(Result,(Length(Value) div 4) * 3);
+ SetLength(Result,Base64Decode(@Value[1],@Result[1],Length(Value)));
+end;
+
+
+end.
diff --git a/plugins/HistoryPlusPlus/Checksum.inc b/plugins/HistoryPlusPlus/Checksum.inc new file mode 100644 index 0000000000..42e6d2df3e --- /dev/null +++ b/plugins/HistoryPlusPlus/Checksum.inc @@ -0,0 +1,7 @@ +{$A+,B-,E-,F-,G+,H+,I-,J+,K-,N+,P+,Q-,R-,S-,T-,V+,W-,X+,Y-}
+
+
+{.$DEFINE 486GE} // Assembler Core only for >= 486 CPU
+{$DEFINE UseASM} // use Assembler optimated core
+
+{.$DEFINE ManualRegisterClasses} // all Cipher- and Hashclasses must be manual register
\ No newline at end of file diff --git a/plugins/HistoryPlusPlus/Checksum.pas b/plugins/HistoryPlusPlus/Checksum.pas new file mode 100644 index 0000000000..dab601641a --- /dev/null +++ b/plugins/HistoryPlusPlus/Checksum.pas @@ -0,0 +1,363 @@ +{-----------------------------------------------------------------------------
+ Checksum (History++ project)
+
+ Version: 1.0
+ Created: 29.03.2003
+
+ [ Description ]
+
+
+
+ [ History ]
+
+
+-----------------------------------------------------------------------------}
+
+
+{Copyright: Hagen Reddmann mailto:HaReddmann@AOL.COM
+ Author: Hagen Reddmann
+ Remarks: freeware, but this Copyright must be included
+ known Problems: none
+ Version: 3.0, Delphi Encryption Compendium
+ Delphi 2-4, BCB 3-4, designed and testet under D3 and D4
+ Description: Utilitys for the DEC Packages
+
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ''AS IS'' AND ANY EXPRESS
+ * OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+ * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+ * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+ * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
+ * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+}
+unit Checksum;
+
+interface
+
+uses SysUtils, Windows, Base64;
+
+type
+ TDig64 = array[0..1] of DWord;
+
+function DigToBase(Digest: TDig64): AnsiString;
+function BaseToDig(Str: AnsiString): TDig64;
+//function StrToDig(Str: AnsiString): TDig64;
+function DigToStr(Digest: TDig64): AnsiString;
+function SameDigest(Dig1,Dig2: TDig64): Boolean;
+procedure CalcCRC32(Data: Pointer; DataSize: DWord; var CRCValue: DWord);
+//function CRC32(CRC: DWord; Data: Pointer; DataSize: DWord): LongWord; assembler;
+//function CRC32a(CRC: DWord; Data: Pointer; DataSize: DWord): DWord;
+function HashString(Str: AnsiString): TDig64;
+procedure CalcSampleHash(const Data: Pointer; DataSize: Integer; var Digest: TDig64);
+
+var
+ ZeroDig: TDig64 = (0,0);
+
+implementation
+
+const
+ DIGEST_DIV = '-';
+const
+ InitDigest: TDig64 = ($F3C55C5C,$05000000);
+ InitCRC: DWord = $F3C55C5C;
+
+function DigToBase(Digest: TDig64): AnsiString;
+var
+ DigStr: AnsiString;
+begin
+ SetLength(DigStr, SizeOf(Digest));
+ Move(Digest, DigStr[1], SizeOf(Digest));
+ Result := Base64EncodeStr(DigStr);
+end;
+
+function BaseToDig(Str: AnsiString): TDig64;
+var
+ DigStr: AnsiString;
+begin
+ DigStr := Base64DecodeStr(Str);
+ Move(DigStr[1], Result, SizeOf(Result));
+end;
+
+function HashString(Str: AnsiString): TDig64;
+begin
+ Result := ZeroDig;
+ Result[0] := InitCRC;
+ CalcCRC32(@Str[1], Length(Str), Result[0]);
+ // CalcSampleHash(@Str[1],Length(Str),Result);
+end;
+(*
+function StrToDig(Str: AnsiString): TDig64;
+var
+ Dig1, Dig2: AnsiString;
+ n: Integer;
+begin
+ Result[0] := 0;
+ Result[1] := 0;
+ n := Pos(DIGEST_DIV, Str);
+ if n = 0 then
+ exit;
+
+ Dig1 := Copy(Str, 1, n - 1);
+ Dig2 := Copy(Str, n + 1, Length(Str));
+
+ Result[0] := StrToInt('$' + Dig1);
+ Result[1] := StrToInt('$' + Dig2);
+end;
+*)
+function DigToStr(Digest: TDig64): AnsiString;
+begin
+ Result := AnsiString(IntToHex(Digest[0], 8)) + DIGEST_DIV + AnsiString(IntToHex(Digest[1], 8));
+end;
+
+function SameDigest(Dig1, Dig2: TDig64): Boolean;
+begin
+ Result := (Dig1[0] = Dig2[0]) and (Dig1[1] = Dig2[1]);
+end;
+
+{
+ function CRC32a(CRC: DWord; Data: Pointer; DataSize: DWord): DWord;
+ begin
+ Result := CRC32(CRC,Data,DataSize);
+ end;
+}
+type
+ PInteger = ^Integer;
+
+procedure CalcSampleHash(const Data: Pointer; DataSize: Integer; var Digest: TDig64);
+var
+ B: ^DWord;
+ T: DWord;
+begin
+ Digest := InitDigest;
+ B := Data;
+ while DataSize >= SizeOf(DWord) do
+ begin
+ T := Digest[0];
+ Inc(Digest[0], B^);
+ if Digest[0] < T then
+ Inc(Digest[1]);
+ Inc(B);
+ Dec(DataSize, SizeOf(DWord));
+ end;
+ if DataSize > 0 then
+ begin
+ T := 0;
+ Move(B^, T, DataSize);
+ Inc(Digest[0], T);
+ end;
+end;
+
+const
+ CRC32Table: array[0..255] of DWord =
+ ($00000000, $77073096, $EE0E612C, $990951BA,
+ $076DC419, $706AF48F, $E963A535, $9E6495A3,
+ $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988,
+ $09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91,
+ $1DB71064, $6AB020F2, $F3B97148, $84BE41DE,
+ $1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7,
+ $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
+ $14015C4F, $63066CD9, $FA0F3D63, $8D080DF5,
+ $3B6E20C8, $4C69105E, $D56041E4, $A2677172,
+ $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B,
+ $35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940,
+ $32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59,
+ $26D930AC, $51DE003A, $C8D75180, $BFD06116,
+ $21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
+ $2802B89E, $5F058808, $C60CD9B2, $B10BE924,
+ $2F6F7C87, $58684C11, $C1611DAB, $B6662D3D,
+
+ $76DC4190, $01DB7106, $98D220BC, $EFD5102A,
+ $71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433,
+ $7807C9A2, $0F00F934, $9609A88E, $E10E9818,
+ $7F6A0DBB, $086D3D2D, $91646C97, $E6635C01,
+ $6B6B51F4, $1C6C6162, $856530D8, $F262004E,
+ $6C0695ED, $1B01A57B, $8208F4C1, $F50FC457,
+ $65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C,
+ $62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65,
+ $4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2,
+ $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB,
+ $4369E96A, $346ED9FC, $AD678846, $DA60B8D0,
+ $44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
+ $5005713C, $270241AA, $BE0B1010, $C90C2086,
+ $5768B525, $206F85B3, $B966D409, $CE61E49F,
+ $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4,
+ $59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD,
+
+ $EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A,
+ $EAD54739, $9DD277AF, $04DB2615, $73DC1683,
+ $E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
+ $E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1,
+ $F00F9344, $8708A3D2, $1E01F268, $6906C2FE,
+ $F762575D, $806567CB, $196C3671, $6E6B06E7,
+ $FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC,
+ $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5,
+ $D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252,
+ $D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
+ $D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60,
+ $DF60EFC3, $A867DF55, $316E8EEF, $4669BE79,
+ $CB61B38C, $BC66831A, $256FD2A0, $5268E236,
+ $CC0C7795, $BB0B4703, $220216B9, $5505262F,
+ $C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04,
+ $C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D,
+
+ $9B64C2B0, $EC63F226, $756AA39C, $026D930A,
+ $9C0906A9, $EB0E363F, $72076785, $05005713,
+ $95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38,
+ $92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21,
+ $86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E,
+ $81BE16CD, $F6B9265B, $6FB077E1, $18B74777,
+ $88085AE6, $FF0F6A70, $66063BCA, $11010B5C,
+ $8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
+ $A00AE278, $D70DD2EE, $4E048354, $3903B3C2,
+ $A7672661, $D06016F7, $4969474D, $3E6E77DB,
+ $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0,
+ $A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9,
+ $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6,
+ $BAD03605, $CDD70693, $54DE5729, $23D967BF,
+ $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
+ $B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);
+(*
+function CRC32(CRC: LongWord; Data: Pointer; DataSize: LongWord): LongWord; assembler;
+asm
+ AND EDX,EDX
+ JZ @Exit
+ AND ECX,ECX
+ JLE @Exit
+ PUSH EBX
+ PUSH EDI
+ XOR EBX,EBX
+ LEA EDI,CS:[OFFSET @CRC32]
+@Start: MOV BL,AL
+ SHR EAX,8
+ XOR BL,[EDX]
+ XOR EAX,[EDI + EBX * 4]
+ INC EDX
+ DEC ECX
+ JNZ @Start
+ POP EDI
+ POP EBX
+@Exit: RET
+ DB 0, 0, 0, 0, 0 // Align Table
+@CRC32: DD 000000000h, 077073096h, 0EE0E612Ch, 0990951BAh
+ DD 0076DC419h, 0706AF48Fh, 0E963A535h, 09E6495A3h
+ DD 00EDB8832h, 079DCB8A4h, 0E0D5E91Eh, 097D2D988h
+ DD 009B64C2Bh, 07EB17CBDh, 0E7B82D07h, 090BF1D91h
+ DD 01DB71064h, 06AB020F2h, 0F3B97148h, 084BE41DEh
+ DD 01ADAD47Dh, 06DDDE4EBh, 0F4D4B551h, 083D385C7h
+ DD 0136C9856h, 0646BA8C0h, 0FD62F97Ah, 08A65C9ECh
+ DD 014015C4Fh, 063066CD9h, 0FA0F3D63h, 08D080DF5h
+ DD 03B6E20C8h, 04C69105Eh, 0D56041E4h, 0A2677172h
+ DD 03C03E4D1h, 04B04D447h, 0D20D85FDh, 0A50AB56Bh
+ DD 035B5A8FAh, 042B2986Ch, 0DBBBC9D6h, 0ACBCF940h
+ DD 032D86CE3h, 045DF5C75h, 0DCD60DCFh, 0ABD13D59h
+ DD 026D930ACh, 051DE003Ah, 0C8D75180h, 0BFD06116h
+ DD 021B4F4B5h, 056B3C423h, 0CFBA9599h, 0B8BDA50Fh
+ DD 02802B89Eh, 05F058808h, 0C60CD9B2h, 0B10BE924h
+ DD 02F6F7C87h, 058684C11h, 0C1611DABh, 0B6662D3Dh
+ DD 076DC4190h, 001DB7106h, 098D220BCh, 0EFD5102Ah
+ DD 071B18589h, 006B6B51Fh, 09FBFE4A5h, 0E8B8D433h
+ DD 07807C9A2h, 00F00F934h, 09609A88Eh, 0E10E9818h
+ DD 07F6A0DBBh, 0086D3D2Dh, 091646C97h, 0E6635C01h
+ DD 06B6B51F4h, 01C6C6162h, 0856530D8h, 0F262004Eh
+ DD 06C0695EDh, 01B01A57Bh, 08208F4C1h, 0F50FC457h
+ DD 065B0D9C6h, 012B7E950h, 08BBEB8EAh, 0FCB9887Ch
+ DD 062DD1DDFh, 015DA2D49h, 08CD37CF3h, 0FBD44C65h
+ DD 04DB26158h, 03AB551CEh, 0A3BC0074h, 0D4BB30E2h
+ DD 04ADFA541h, 03DD895D7h, 0A4D1C46Dh, 0D3D6F4FBh
+ DD 04369E96Ah, 0346ED9FCh, 0AD678846h, 0DA60B8D0h
+ DD 044042D73h, 033031DE5h, 0AA0A4C5Fh, 0DD0D7CC9h
+ DD 05005713Ch, 0270241AAh, 0BE0B1010h, 0C90C2086h
+ DD 05768B525h, 0206F85B3h, 0B966D409h, 0CE61E49Fh
+ DD 05EDEF90Eh, 029D9C998h, 0B0D09822h, 0C7D7A8B4h
+ DD 059B33D17h, 02EB40D81h, 0B7BD5C3Bh, 0C0BA6CADh
+ DD 0EDB88320h, 09ABFB3B6h, 003B6E20Ch, 074B1D29Ah
+ DD 0EAD54739h, 09DD277AFh, 004DB2615h, 073DC1683h
+ DD 0E3630B12h, 094643B84h, 00D6D6A3Eh, 07A6A5AA8h
+ DD 0E40ECF0Bh, 09309FF9Dh, 00A00AE27h, 07D079EB1h
+ DD 0F00F9344h, 08708A3D2h, 01E01F268h, 06906C2FEh
+ DD 0F762575Dh, 0806567CBh, 0196C3671h, 06E6B06E7h
+ DD 0FED41B76h, 089D32BE0h, 010DA7A5Ah, 067DD4ACCh
+ DD 0F9B9DF6Fh, 08EBEEFF9h, 017B7BE43h, 060B08ED5h
+ DD 0D6D6A3E8h, 0A1D1937Eh, 038D8C2C4h, 04FDFF252h
+ DD 0D1BB67F1h, 0A6BC5767h, 03FB506DDh, 048B2364Bh
+ DD 0D80D2BDAh, 0AF0A1B4Ch, 036034AF6h, 041047A60h
+ DD 0DF60EFC3h, 0A867DF55h, 0316E8EEFh, 04669BE79h
+ DD 0CB61B38Ch, 0BC66831Ah, 0256FD2A0h, 05268E236h
+ DD 0CC0C7795h, 0BB0B4703h, 0220216B9h, 05505262Fh
+ DD 0C5BA3BBEh, 0B2BD0B28h, 02BB45A92h, 05CB36A04h
+ DD 0C2D7FFA7h, 0B5D0CF31h, 02CD99E8Bh, 05BDEAE1Dh
+ DD 09B64C2B0h, 0EC63F226h, 0756AA39Ch, 0026D930Ah
+ DD 09C0906A9h, 0EB0E363Fh, 072076785h, 005005713h
+ DD 095BF4A82h, 0E2B87A14h, 07BB12BAEh, 00CB61B38h
+ DD 092D28E9Bh, 0E5D5BE0Dh, 07CDCEFB7h, 00BDBDF21h
+ DD 086D3D2D4h, 0F1D4E242h, 068DDB3F8h, 01FDA836Eh
+ DD 081BE16CDh, 0F6B9265Bh, 06FB077E1h, 018B74777h
+ DD 088085AE6h, 0FF0F6A70h, 066063BCAh, 011010B5Ch
+ DD 08F659EFFh, 0F862AE69h, 0616BFFD3h, 0166CCF45h
+ DD 0A00AE278h, 0D70DD2EEh, 04E048354h, 03903B3C2h
+ DD 0A7672661h, 0D06016F7h, 04969474Dh, 03E6E77DBh
+ DD 0AED16A4Ah, 0D9D65ADCh, 040DF0B66h, 037D83BF0h
+ DD 0A9BCAE53h, 0DEBB9EC5h, 047B2CF7Fh, 030B5FFE9h
+ DD 0BDBDF21Ch, 0CABAC28Ah, 053B39330h, 024B4A3A6h
+ DD 0BAD03605h, 0CDD70693h, 054DE5729h, 023D967BFh
+ DD 0B3667A2Eh, 0C4614AB8h, 05D681B02h, 02A6F2B94h
+ DD 0B40BBE37h, 0C30C8EA1h, 05A05DF1Bh, 02D02EF8Dh
+ DD 074726F50h, 0736E6F69h, 0706F4320h, 067697279h
+ DD 028207468h, 031202963h, 020393939h, 048207962h
+ DD 06E656761h, 064655220h, 06E616D64h, 06FBBA36Eh
+end;
+*)
+
+procedure CalcCRC32(Data: Pointer; DataSize: DWord; var CRCValue: DWord);
+ // The following is a little cryptic (but executes very quickly).
+ // The algorithm is as follows:
+ // 1. exclusive-or the input byte with the low-order byte of
+ // the CRC register to get an INDEX
+ // 2. shift the CRC register eight bits to the right
+ // 3. exclusive-or the CRC register with the contents of Table[INDEX]
+ // 4. repeat steps 1 through 3 for all bytes
+var
+ i: Integer;
+ q: ^Byte;
+begin
+ q := Data;
+ if DataSize = 0 then
+ exit;
+ for i := 0 to DataSize - 1 do
+ begin
+ CRCValue := (CRCValue SHR 8) XOR CRC32Table[q^ XOR (CRCValue AND $000000FF)];
+ Inc(q);
+ end;
+end;
+
+{a Random generated Testvector 256bit - 32 Bytes, it's used for Self Test}
+{
+function GetTestVector: PAnsiChar; assembler; register;
+asm
+ MOV EAX,OFFSET @Vector
+ RET
+@Vector: DB 030h,044h,0EDh,06Eh,045h,0A4h,096h,0F5h
+ DB 0F6h,035h,0A2h,0EBh,03Dh,01Ah,05Dh,0D6h
+ DB 0CBh,01Dh,009h,082h,02Dh,0BDh,0F5h,060h
+ DB 0C2h,0B8h,058h,0A1h,091h,0F9h,081h,0B1h
+ DB 000h,000h,000h,000h,000h,000h,000h,000h
+end;
+}
+var
+ TableCRC: DWord;
+
+initialization
+ {this calculate a Checksum (CRC32) over the function CRC32 and the TestVector,
+ if InitTestIsOk = False any modification from Testvector or CRC32() detected, :-) }
+ TableCRC := $FFFFFFFF;
+ CalcCRC32(@CRC32Table[0], SizeOf(CRC32Table), TableCRC);
+ TableCRC := not TableCRC;
+ if TableCRC <> $6FCF9E13 then
+ raise Exception.Create('Bad case, wrong CRC table');
+
+finalization
+end.
diff --git a/plugins/HistoryPlusPlus/CustomizeFiltersForm.dfm b/plugins/HistoryPlusPlus/CustomizeFiltersForm.dfm new file mode 100644 index 0000000000..32a113ef61 --- /dev/null +++ b/plugins/HistoryPlusPlus/CustomizeFiltersForm.dfm @@ -0,0 +1,226 @@ +object fmCustomizeFilters: TfmCustomizeFilters
+ Left = 227
+ Top = 70
+ BorderStyle = bsDialog
+ Caption = 'Customize Filters'
+ ClientHeight = 466
+ ClientWidth = 370
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ KeyPreview = True
+ OldCreateOrder = False
+ Position = poOwnerFormCenter
+ OnClose = FormClose
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnKeyDown = FormKeyDown
+ PixelsPerInch = 96
+ TextHeight = 13
+ object paClient: TPanel
+ Left = 0
+ Top = 0
+ Width = 370
+ Height = 466
+ Align = alClient
+ BevelOuter = bvNone
+ BorderWidth = 4
+ TabOrder = 0
+ DesignSize = (
+ 370
+ 466)
+ object bnCancel: TButton
+ Left = 89
+ Top = 433
+ Width = 75
+ Height = 25
+ Anchors = [akLeft, akBottom]
+ Cancel = True
+ Caption = '&Cancel'
+ TabOrder = 3
+ OnClick = bnCancelClick
+ end
+ object bnOK: TButton
+ Left = 8
+ Top = 433
+ Width = 75
+ Height = 25
+ Anchors = [akLeft, akBottom]
+ Caption = 'OK'
+ Default = True
+ TabOrder = 2
+ OnClick = bnOKClick
+ end
+ object bnReset: TButton
+ Left = 231
+ Top = 433
+ Width = 131
+ Height = 25
+ Anchors = [akRight, akBottom]
+ Caption = 'R&eset to Default'
+ TabOrder = 4
+ OnClick = bnResetClick
+ end
+ object gbFilter: THppGroupBox
+ Left = 4
+ Top = 145
+ Width = 362
+ Height = 281
+ Align = alCustom
+ Anchors = [akLeft, akTop, akRight, akBottom]
+ Caption = 'Filter Properties'
+ Color = clBtnFace
+ ParentBackground = False
+ ParentColor = False
+ TabOrder = 1
+ DesignSize = (
+ 362
+ 281)
+ object laFilterName: TLabel
+ Left = 12
+ Top = 23
+ Width = 31
+ Height = 13
+ Caption = '&Name:'
+ FocusControl = edFilterName
+ end
+ object edFilterName: THppEdit
+ Left = 60
+ Top = 20
+ Width = 292
+ Height = 21
+ Anchors = [akLeft, akTop, akRight]
+ MaxLength = 63
+ TabOrder = 0
+ OnChange = edFilterNameChange
+ OnKeyPress = edEditKeyPress
+ end
+ object clEvents: TCheckListBox
+ Left = 12
+ Top = 88
+ Width = 340
+ Height = 153
+ OnClickCheck = clEventsClickCheck
+ Anchors = [akLeft, akTop, akRight, akBottom]
+ ItemHeight = 13
+ Style = lbOwnerDrawFixed
+ TabOrder = 3
+ OnDrawItem = clEventsDrawItem
+ end
+ object cbCustomEvent: TCheckBox
+ Left = 12
+ Top = 248
+ Width = 249
+ Height = 21
+ Anchors = [akLeft, akRight, akBottom]
+ Caption = 'Include custom event type (0-65535)'
+ TabOrder = 4
+ OnClick = cbCustomEventClick
+ end
+ object edCustomEvent: THppEdit
+ Left = 267
+ Top = 248
+ Width = 85
+ Height = 21
+ Anchors = [akRight, akBottom]
+ MaxLength = 5
+ TabOrder = 5
+ OnChange = edCustomEventChange
+ OnKeyPress = edEditKeyPress
+ end
+ object rbInclude: TRadioButton
+ Left = 12
+ Top = 50
+ Width = 340
+ Height = 17
+ Anchors = [akLeft, akTop, akRight]
+ Caption = 'Show only selected events'
+ TabOrder = 1
+ OnClick = rbPropertyClick
+ end
+ object rbExclude: TRadioButton
+ Left = 12
+ Top = 69
+ Width = 340
+ Height = 17
+ Anchors = [akLeft, akTop, akRight]
+ Caption = 'Show all except selected events'
+ TabOrder = 2
+ OnClick = rbPropertyClick
+ end
+ end
+ object gbFilters: THppGroupBox
+ Left = 4
+ Top = 4
+ Width = 362
+ Height = 137
+ Align = alTop
+ Caption = 'Filters'
+ Color = clBtnFace
+ ParentBackground = False
+ ParentColor = False
+ TabOrder = 0
+ DesignSize = (
+ 362
+ 137)
+ object lbFilters: TListBox
+ Left = 12
+ Top = 20
+ Width = 249
+ Height = 105
+ Style = lbOwnerDrawFixed
+ Anchors = [akLeft, akTop, akRight, akBottom]
+ DragMode = dmAutomatic
+ ItemHeight = 13
+ TabOrder = 0
+ OnClick = lbFiltersClick
+ OnDragDrop = lbFiltersDragDrop
+ OnDragOver = lbFiltersDragOver
+ OnDrawItem = lbFiltersDrawItem
+ end
+ object bnDown: TButton
+ Left = 267
+ Top = 102
+ Width = 85
+ Height = 23
+ Anchors = [akTop, akRight]
+ Caption = '&Down'
+ TabOrder = 4
+ OnClick = bnDownClick
+ end
+ object bnUp: TButton
+ Left = 267
+ Top = 74
+ Width = 85
+ Height = 23
+ Anchors = [akTop, akRight]
+ Caption = '&Up'
+ TabOrder = 3
+ OnClick = bnUpClick
+ end
+ object bnDelete: TButton
+ Left = 267
+ Top = 47
+ Width = 85
+ Height = 23
+ Anchors = [akTop, akRight]
+ Caption = 'D&elete'
+ TabOrder = 2
+ OnClick = bnDeleteClick
+ end
+ object bnAdd: TButton
+ Left = 267
+ Top = 20
+ Width = 85
+ Height = 23
+ Anchors = [akTop, akRight]
+ Caption = '&Add'
+ TabOrder = 1
+ OnClick = bnAddClick
+ end
+ end
+ end
+end
diff --git a/plugins/HistoryPlusPlus/CustomizeFiltersForm.pas b/plugins/HistoryPlusPlus/CustomizeFiltersForm.pas new file mode 100644 index 0000000000..bb49c9db46 --- /dev/null +++ b/plugins/HistoryPlusPlus/CustomizeFiltersForm.pas @@ -0,0 +1,717 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+unit CustomizeFiltersForm;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,Dialogs,
+ HistoryControls,m_api,
+ StdCtrls, CheckLst,
+ hpp_global, hpp_events, hpp_eventfilters, ExtCtrls;
+
+type
+ TfmCustomizeFilters = class(TForm)
+ bnOK: TButton;
+ bnCancel: TButton;
+ gbFilter: THppGroupBox;
+ edFilterName: THppEdit;
+ clEvents: TCheckListBox;
+ bnReset: TButton;
+ rbExclude: TRadioButton;
+ rbInclude: TRadioButton;
+ gbFilters: THppGroupBox;
+ lbFilters: TListBox;
+ bnDown: TButton;
+ bnUp: TButton;
+ bnDelete: TButton;
+ bnAdd: TButton;
+ laFilterName: TLabel;
+ edCustomEvent: THppEdit;
+ cbCustomEvent: TCheckBox;
+ paClient: TPanel;
+ procedure FormCreate(Sender: TObject);
+ procedure bnOKClick(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure FormDestroy(Sender: TObject);
+ procedure lbFiltersClick(Sender: TObject);
+ procedure edFilterNameChange(Sender: TObject);
+ procedure bnAddClick(Sender: TObject);
+ procedure bnCancelClick(Sender: TObject);
+ procedure bnUpClick(Sender: TObject);
+ procedure bnDownClick(Sender: TObject);
+ procedure bnDeleteClick(Sender: TObject);
+ procedure clEventsClickCheck(Sender: TObject);
+ procedure bnResetClick(Sender: TObject);
+ procedure rbPropertyClick(Sender: TObject);
+ procedure lbFiltersDragDrop(Sender, Source: TObject; X, Y: Integer);
+ procedure lbFiltersDragOver(Sender, Source: TObject; X, Y: Integer;
+ State: TDragState; var Accept: Boolean);
+ procedure clEventsDrawItem(Control: TWinControl; Index: Integer;
+ Rect: TRect; State: TOwnerDrawState);
+ procedure lbFiltersDrawItem(Control: TWinControl; Index: Integer;
+ Rect: TRect; State: TOwnerDrawState);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure cbCustomEventClick(Sender: TObject);
+ procedure edCustomEventChange(Sender: TObject);
+ procedure edEditKeyPress(Sender: TObject; var Key: Char);
+ private
+ LocalFilters: ThppEventFilterArray;
+
+ IncOutWrong: Boolean;
+ EventsWrong: Boolean;
+ EventsHeaderIndex: Integer;
+
+ DragOverIndex: Integer;
+
+ procedure LoadLocalFilters;
+ procedure SaveLocalFilters;
+ procedure FillFiltersList;
+ procedure FillEventsCheckListBox;
+
+ procedure MoveItem(Src,Dst: Integer);
+ procedure UpdateEventsState;
+ procedure UpdateUpDownButtons;
+
+ procedure TranslateForm;
+ public
+ { Public declarations }
+ end;
+
+var
+ fmCustomizeFilters: TfmCustomizeFilters = nil;
+
+implementation
+
+uses hpp_forms, HistoryForm, hpp_options, TypInfo, Math, GlobalSearch;
+
+const
+ // commented to use all events in system history
+ //IgnoreEvents: TMessageTypes = [mtSystem, mtWebPager, mtEmailExpress];
+ IgnoreEvents: TMessageTypes = [];
+
+{$R *.dfm}
+
+procedure TfmCustomizeFilters.bnAddClick(Sender: TObject);
+var
+ NewNameFmt,NewName: String;
+ NameExists: Boolean;
+ num,i: Integer;
+begin
+ NewNameFmt := TranslateW('New Filter #%d');
+ num := 1;
+ while True do begin
+ NewName := Format(NewNameFmt,[num]);
+ NameExists := False;
+ for i := 0 to Length(LocalFilters) - 1 do
+ if NewName = LocalFilters[i].Name then
+ begin
+ NameExists := true;
+ break;
+ end;
+ if not NameExists then break;
+ Inc(num);
+ end;
+
+ i := Length(LocalFilters);
+ SetLength(LocalFilters,i+1);
+ LocalFilters[i].Name := NewName;
+ LocalFilters[i].filMode := FM_INCLUDE;
+ LocalFilters[i].filEvents := [mtIncoming,mtOutgoing,mtMessage,mtUrl,mtFile];
+ LocalFilters[i].Events := GenerateEvents(LocalFilters[i].filMode,LocalFilters[i].filEvents);
+
+ lbFilters.Items.Add(NewName);
+ lbFilters.ItemIndex := i;
+ lbFiltersClick(Self);
+ if edFilterName.CanFocus then edFilterName.SetFocus;
+end;
+
+procedure TfmCustomizeFilters.bnCancelClick(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure TfmCustomizeFilters.bnDeleteClick(Sender: TObject);
+var
+ n,i: Integer;
+begin
+ if lbFilters.ItemIndex = -1 then exit;
+ n := lbFilters.ItemIndex;
+ if (LocalFilters[n].filMode = FM_EXCLUDE) and
+ (LocalFilters[n].filEvents = []) then
+ exit; // don't delete Show All Events
+
+ for i := n to Length(LocalFilters) - 2 do
+ LocalFilters[i] := LocalFilters[i+1];
+ SetLength(LocalFilters,Length(LocalFilters)-1);
+ lbFilters.DeleteSelected;
+ if n >= lbFilters.Count then
+ Dec(n);
+ lbFilters.ItemIndex := n;
+ lbFiltersClick(Self);
+end;
+
+procedure TfmCustomizeFilters.bnDownClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ if lbFilters.ItemIndex = -1 then exit;
+ if lbFilters.ItemIndex = lbFilters.Count-1 then exit;
+ i := lbFilters.ItemIndex;
+ MoveItem(i,i+1);
+end;
+
+procedure TfmCustomizeFilters.bnOKClick(Sender: TObject);
+begin
+ SaveLocalFilters;
+ Close;
+end;
+
+procedure TfmCustomizeFilters.bnResetClick(Sender: TObject);
+begin
+ CopyEventFilters(hppDefEventFilters,LocalFilters);
+
+ FillFiltersList;
+ FillEventsCheckListBox;
+
+ SaveLocalFilters;
+
+ if lbFilters.Items.Count > 0 then lbFilters.ItemIndex := 0;
+ lbFiltersClick(Self);
+end;
+
+procedure TfmCustomizeFilters.bnUpClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ if lbFilters.ItemIndex = -1 then exit;
+ if lbFilters.ItemIndex = 0 then exit;
+ i := lbFilters.ItemIndex;
+ MoveItem(i,i-1);
+end;
+
+procedure TfmCustomizeFilters.clEventsClickCheck(Sender: TObject);
+var
+ n,i: Integer;
+begin
+ UpdateEventsState;
+ if EventsWrong or IncOutWrong then exit;
+ n := lbFilters.ItemIndex;
+ if rbInclude.Checked then
+ LocalFilters[n].filMode := FM_INCLUDE
+ else
+ LocalFilters[n].filMode := FM_EXCLUDE;
+ LocalFilters[n].filEvents := [];
+ for i := 0 to clEvents.Count - 1 do
+ begin
+ if clEvents.Header[i] then continue;
+ if clEvents.Checked[i] then
+ Include(LocalFilters[n].filEvents,TMessageType(Integer(clEvents.Items.Objects[i])));
+ end;
+ if cbCustomEvent.Checked then
+ LocalFilters[n].filEvents := LocalFilters[n].filEvents + EventsCustom;
+ LocalFilters[n].Events := GenerateEvents(LocalFilters[n].filMode,LocalFilters[n].filEvents);
+end;
+
+procedure TfmCustomizeFilters.clEventsDrawItem(Control: TWinControl;
+ Index: Integer; Rect: TRect; State: TOwnerDrawState);
+var
+ txtW: String;
+ r: TRect;
+ tf: DWord;
+ BrushColor: TColor;
+begin
+ BrushColor := clEvents.Canvas.Brush.Color;
+ txtW := clEvents.Items[Index];
+ r := Rect;
+ tf := DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX;
+ InflateRect(r,-2,0);
+
+ if clEvents.Header[Index] then
+ begin
+ if (EventsWrong) and (Index = EventsHeaderIndex) then
+ if BrushColor = clEvents.HeaderBackgroundColor then clEvents.Canvas.Brush.Color := $008080FF;
+ if (IncOutWrong) and (Index <> EventsHeaderIndex) then
+ if BrushColor = clEvents.HeaderBackgroundColor then clEvents.Canvas.Brush.Color := $008080FF;
+ clEvents.Canvas.FillRect(Rect);
+ DrawText(clEvents.Canvas.Handle,PChar(txtW),Length(txtW),r,tf);
+ clEvents.Canvas.Brush.Color := BrushColor;
+ exit;
+ end;
+
+ if (EventsWrong) and (Index > EventsHeaderIndex) then
+ if BrushColor = clEvents.Color then clEvents.Canvas.Brush.Color := $008080FF;
+ if (IncOutWrong) and (Index < EventsHeaderIndex) then
+ if BrushColor = clEvents.Color then clEvents.Canvas.Brush.Color := $008080FF;
+ clEvents.Canvas.FillRect(Rect);
+ DrawText(clEvents.Canvas.Handle,PChar(txtW),Length(txtW),r,tf);
+ clEvents.Canvas.Brush.Color := BrushColor;
+end;
+
+procedure TfmCustomizeFilters.edFilterNameChange(Sender: TObject);
+begin
+ if lbFilters.ItemIndex = -1 then exit;
+ if edFilterName.Text = '' then
+ edFilterName.Color := $008080FF
+ else
+ edFilterName.Color := clWindow;
+ if edFilterName.Text <> '' then
+ LocalFilters[lbFilters.ItemIndex].Name := edFilterName.Text;
+ lbFilters.Items.BeginUpdate;
+ lbFilters.Items[lbFilters.ItemIndex] := LocalFilters[lbFilters.ItemIndex].Name;
+ lbFilters.Items.EndUpdate;
+end;
+
+procedure TfmCustomizeFilters.FillEventsCheckListBox;
+var
+ mt: TMessageType;
+ mt_name, pretty_name: String;
+ i: Integer;
+begin
+ clEvents.Items.BeginUpdate;
+ clEvents.Items.Clear;
+
+ // add all types except mtOther (we'll add it at the end) and
+ // message types in AlwaysExclude and AlwaysInclude
+ for mt := Low(TMessageType) to High(TMessageType) do begin
+ if (mt in EventsExclude) or (mt in EventsInclude) or (mt in IgnoreEvents) then continue;
+ if mt = mtOther then continue; // we'll add mtOther at the end
+ if mt in [mtIncoming,mtMessage] then begin // insert header before incoming and message
+ if mt = mtIncoming then
+ mt_name := TranslateW('Incoming & Outgoing')
+ else
+ mt_name := TranslateW('Events');
+ i := clEvents.Items.Add(mt_name);
+ EventsHeaderIndex := i;
+ clEvents.Header[i] := True;
+ end;
+
+ //pretty_name := GetEnumName(TypeInfo(TMessageType),Ord(mt));
+ //Delete(pretty_name,1,2);
+ // find filter names if we have substitute
+ //for i := 0 to Length(FilterNames) - 1 do
+ // if FilterNames[i].mt = mt then begin
+ // pretty_name := FilterNames[i].Name;
+ // break;
+ // end;
+ pretty_name := TranslateUnicodeString(EventRecords[mt].Name{TRANSLATE-IGNORE});
+ clEvents.Items.AddObject(pretty_name,Pointer(Ord(mt)));
+ end;
+
+ // add mtOther at the end
+ mt := mtOther;
+ //pretty_name := GetEnumName(TypeInfo(TMessageType),Ord(mt));
+ //Delete(pretty_name,1,2);
+ // find filter names if we have substitute
+ //for i := 0 to Length(FilterNames) - 1 do
+ // if FilterNames[i].mt = mt then begin
+ // pretty_name := FilterNames[i].Name;
+ // break;
+ // end;
+ pretty_name := TranslateUnicodeString(EventRecords[mt].Name{TRANSLATE-IGNORE});
+ clEvents.Items.AddObject(pretty_name,Pointer(Ord(mt)));
+ clEvents.Items.EndUpdate;
+end;
+
+procedure TfmCustomizeFilters.FillFiltersList;
+var
+ i: Integer;
+begin
+ lbFilters.Items.BeginUpdate;
+ lbFilters.Items.Clear;
+ for i := 0 to Length(LocalFilters) - 1 do
+ begin
+ lbFilters.Items.Add(LocalFilters[i].Name);
+ end;
+ //meEvents.Lines.Clear;
+ lbFilters.Items.EndUpdate;
+end;
+
+procedure TfmCustomizeFilters.FormCreate(Sender: TObject);
+begin
+ fmCustomizeFilters := Self;
+
+ DesktopFont := True;
+ MakeFontsParent(Self);
+ DoubleBuffered := True;
+ MakeDoubleBufferedParent(Self);
+
+ TranslateForm;
+
+ LoadLocalFilters;
+ FillFiltersList;
+ FillEventsCheckListBox;
+
+ if lbFilters.Items.Count > 0 then lbFilters.ItemIndex := 0;
+ lbFiltersClick(Self);
+ edFilterName.MaxLength := MAX_FILTER_NAME_LENGTH;
+end;
+
+procedure TfmCustomizeFilters.lbFiltersClick(Sender: TObject);
+var
+ i: Integer;
+ Lock: Boolean;
+begin
+ if lbFilters.ItemIndex = -1 then exit;
+ Lock := false;
+ if Visible then Lock := LockWindowUpdate(Handle);
+ try
+ rbInclude.Checked := (LocalFilters[lbFilters.ItemIndex].filMode = FM_INCLUDE);
+ rbExclude.Checked := (LocalFilters[lbFilters.ItemIndex].filMode = FM_EXCLUDE);
+ for i := 0 to clEvents.Items.Count - 1 do begin
+ if clEvents.Header[i] then continue;
+ clEvents.Checked[i] := TMessageType(Pointer(clEvents.Items.Objects[i])) in LocalFilters[lbFilters.ItemIndex].filEvents;
+ end;
+
+ cbCustomEvent.Checked := (LocalFilters[lbFilters.ItemIndex].filEvents*EventsCustom = EventsCustom);
+ edCustomEvent.Text := IntToStr(LocalFilters[lbFilters.ItemIndex].filCustom);
+
+ edFilterName.Text := lbFilters.Items[lbFilters.ItemIndex];
+
+ edFilterName.Enabled := (lbFilters.ItemIndex <> GetShowAllEventsIndex(LocalFilters));
+ laFilterName.Enabled := edFilterName.Enabled;
+ rbInclude.Enabled := edFilterName.Enabled;
+ rbExclude.Enabled := edFilterName.Enabled;
+ clEvents.Enabled := edFilterName.Enabled;
+ cbCustomEvent.Enabled := edFilterName.Enabled;
+ edCustomEvent.Enabled := edFilterName.Enabled and cbCustomEvent.Checked;
+ bnDelete.Enabled := edFilterName.Enabled;
+ finally
+ UpdateUpDownButtons;
+ UpdateEventsState;
+ if Visible and Lock then LockWindowUpdate(0);
+ end;
+end;
+
+procedure TfmCustomizeFilters.lbFiltersDragDrop(Sender, Source: TObject; X, Y: Integer);
+var
+ src,dst: Integer;
+begin
+ // we insert always *before* droped item, unless we drop on the empty area
+ // in this case be insert dragged item at the end
+ dst := lbFilters.ItemAtPos(Point(x,y),False);
+ src := lbFilters.ItemIndex;
+ if src = dst then exit;
+ if src < dst then Dec(dst);
+ if src = dst then exit;
+ MoveItem(src,dst);
+end;
+
+procedure TfmCustomizeFilters.lbFiltersDragOver(Sender, Source: TObject; X,
+ Y: Integer; State: TDragState; var Accept: Boolean);
+var
+ r: TRect;
+ idx: Integer;
+begin
+ Accept := True;
+ idx := DragOverIndex;
+ if idx = lbFilters.Count then Dec(idx);
+ r := lbFilters.ItemRect(idx);
+ DragOverIndex := lbFilters.ItemAtPos(Point(x,y),False);
+ InvalidateRect(lbFilters.Handle,@r,False);
+ idx := DragOverIndex;
+ if idx = lbFilters.Count then Dec(idx);
+ r := lbFilters.ItemRect(idx);
+ InvalidateRect(lbFilters.Handle,@r,False);
+ lbFilters.Update;
+end;
+
+procedure TfmCustomizeFilters.lbFiltersDrawItem(Control: TWinControl;
+ Index: Integer; Rect: TRect; State: TOwnerDrawState);
+var
+ BrushColor: TColor;
+ txtW: String;
+ r: TRect;
+ tf: DWord;
+ {src,}dst: Integer;
+begin
+ BrushColor := lbFilters.Canvas.Brush.Color;
+ txtW := lbFilters.Items[Index];
+ r := Rect;
+ InflateRect(r,-2,0);
+ lbFilters.Canvas.FillRect(Rect);
+ tf := DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX;
+ DrawText(lbFilters.Canvas.Handle,PChar(txtW),Length(txtW),r,tf);
+ if lbFilters.Dragging then begin
+// src := lbFilters.ItemIndex;
+ dst := DragOverIndex;
+ if (dst = lbFilters.Count) and (Index = lbFilters.Count-1) then
+ begin
+ lbFilters.Canvas.Brush.Color := clHighlight;
+ r := Classes.Rect(Rect.Left,Rect.Bottom-1,Rect.Right,Rect.Bottom);
+ lbFilters.Canvas.FillRect(r);
+ end;
+ if (dst = Index) then
+ begin
+ lbFilters.Canvas.Brush.Color := clHighlight;
+ r := Classes.Rect(Rect.Left,Rect.Top,Rect.Right,Rect.Top+1);
+ lbFilters.Canvas.FillRect(r);
+ end;
+ end;
+ lbFilters.Canvas.Brush.Color := BrushColor;
+end;
+
+procedure TfmCustomizeFilters.LoadLocalFilters;
+begin
+ CopyEventFilters(hppEventFilters,LocalFilters);
+end;
+
+procedure TfmCustomizeFilters.MoveItem(Src, Dst: Integer);
+var
+ ef: ThppEventFilter;
+ i: Integer;
+begin
+ if Src = Dst then exit;
+
+ lbFilters.Items.Move(Src,Dst);
+
+ ef := LocalFilters[Src];
+ if Dst > Src then
+ for i := Src to Dst-1 do
+ LocalFilters[i] := LocalFilters[i+1]
+ else
+ for i := Src downto Dst+1 do
+ LocalFilters[i] := LocalFilters[i-1];
+ LocalFilters[Dst] := ef;
+
+ lbFilters.ItemIndex := Dst;
+ UpdateUpDownButtons;
+end;
+
+procedure TfmCustomizeFilters.rbPropertyClick(Sender: TObject);
+var
+ n: Integer;
+begin
+ n := lbFilters.ItemIndex;
+ UpdateEventsState;
+ if IncOutWrong or EventsWrong then exit;
+ if rbInclude.Checked then
+ LocalFilters[n].filMode := FM_INCLUDE
+ else
+ LocalFilters[n].filMode := FM_EXCLUDE;
+ LocalFilters[n].Events := GenerateEvents(LocalFilters[n].filMode,LocalFilters[n].filEvents);
+end;
+
+procedure TfmCustomizeFilters.SaveLocalFilters;
+begin
+ CopyEventFilters(LocalFilters,hppEventFilters);
+ WriteEventFilters;
+end;
+
+procedure TfmCustomizeFilters.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+ Action := caFree;
+end;
+
+procedure TfmCustomizeFilters.FormDestroy(Sender: TObject);
+begin
+ fmCustomizeFilters := nil;
+ try
+ if Owner is THistoryFrm then
+ THistoryFrm(Owner).CustomizeFiltersForm := nil
+ else if Owner is TfmGlobalSearch then
+ TfmGlobalSearch(Owner).CustomizeFiltersForm := nil;
+ except
+ // "eat" exceptions if any
+ end;
+end;
+
+procedure TfmCustomizeFilters.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+var
+ Mask: Integer;
+begin
+ with Sender as TWinControl do
+ begin
+ if Perform(CM_CHILDKEY, Key, LPARAM(Sender)) <> 0 then
+ Exit;
+ Mask := 0;
+ case Key of
+ VK_TAB:
+ Mask := DLGC_WANTTAB;
+ VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN:
+ // added to change radio buttons from keyboard
+ if (Self.ActiveControl is TRadioButton) then Mask := DLGC_WANTARROWS;
+ VK_RETURN, VK_EXECUTE, VK_ESCAPE, VK_CANCEL:
+ Mask := DLGC_WANTALLKEYS;
+ end;
+ if (Mask <> 0)
+ and (Perform(CM_WANTSPECIALKEY, Key, 0) = 0)
+ and (Perform(WM_GETDLGCODE, 0, 0) and Mask = 0)
+ and (Self.Perform(CM_DIALOGKEY, Key, 0) <> 0)
+ then Exit;
+ end;
+end;
+
+procedure TfmCustomizeFilters.TranslateForm;
+begin
+ Caption := TranslateUnicodeString(Caption);
+ gbFilters.Caption := TranslateUnicodeString(gbFilters.Caption);
+ bnAdd.Caption := TranslateUnicodeString(bnAdd.Caption);
+ bnDelete.Caption := TranslateUnicodeString(bnDelete.Caption);
+ bnUp.Caption := TranslateUnicodeString(bnUp.Caption);
+ bnDown.Caption := TranslateUnicodeString(bnDown.Caption);
+ gbFilter.Caption := TranslateUnicodeString(gbFilter.Caption);
+ laFilterName.Caption := TranslateUnicodeString(laFilterName.Caption);
+ rbInclude.Caption := TranslateUnicodeString(rbInclude.Caption);
+ rbExclude.Caption := TranslateUnicodeString(rbExclude.Caption);
+ cbCustomEvent.Caption := TranslateUnicodeString(cbCustomEvent.Caption);
+ bnOK.Caption := TranslateUnicodeString(bnOK.Caption);
+ bnCancel.Caption := TranslateUnicodeString(bnCancel.Caption);
+ bnReset.Caption := TranslateUnicodeString(bnReset.Caption);
+end;
+
+procedure TfmCustomizeFilters.UpdateEventsState;
+var
+ IncOutChecked,IncOutUnchecked,
+ EventsChecked,EventsUnchecked: Boolean;
+ InsideEvents: Boolean;
+ InsideIncOut: Boolean;
+// HeadEvents: Integer;
+ i: Integer;
+begin
+ if not clEvents.Enabled then begin
+ IncOutWrong := False;
+ EventsWrong := False;
+ bnOK.Enabled := True;
+ exit;
+ end;
+ IncOutChecked := True;
+ IncOutUnchecked := True;
+ EventsChecked := True;
+ EventsUnchecked := True;
+ InsideEvents := False;
+ InsideIncOut := False;
+// HeadEvents := 0;
+ for i := 0 to clEvents.Count - 1 do
+ begin
+
+ if clEvents.Header[i] then
+ begin
+ if InsideIncOut then
+ begin
+// HeadEvents := i;
+ InsideEvents := True;
+ end else
+ InsideIncOut := True;
+ continue;
+ end;
+
+ if InsideEvents then
+ begin
+ if EventsChecked and (not clEvents.Checked[i]) then
+ EventsChecked := False;
+ if EventsUnchecked and clEvents.Checked[i] then
+ EventsUnchecked := False;
+ if (not EventsChecked) and (not EventsUnchecked) then break;
+ end
+ else
+ begin
+ if IncOutChecked and (not clEvents.Checked[i]) then
+ IncOutChecked := False;
+ if IncOutUnchecked and clEvents.Checked[i] then
+ IncOutUnchecked := False;
+ end;
+
+ end;
+
+ if EventsChecked and not cbCustomEvent.Checked then
+ EventsChecked := False;
+ if EventsUnchecked and cbCustomEvent.Checked then
+ EventsUnchecked := False;
+
+ if rbInclude.Checked then
+ begin
+ EventsWrong := EventsUnchecked;
+ IncOutWrong := IncOutUnchecked;
+ end
+ else
+ begin
+ EventsWrong := EventsChecked;
+ IncOutWrong := IncOutChecked;
+ end;
+
+ // we probably need some help text to show why the filter selection is wrong
+ // explanation is given in comments below
+ if (rbExclude.Checked) and (EventsUnchecked) and (IncOutUnchecked) then
+ begin
+ EventsWrong := True;
+ IncOutWrong := True;
+ // not allowed to duplicate Show All Events filter
+ end
+ else if (rbInclude.Checked) and (EventsChecked) and (IncOutChecked) then
+ begin
+ EventsWrong := True;
+ IncOutWrong := True;
+ // not allowed to quasi-duplicate Show All Events filter
+ end
+ else
+ begin
+ if (EventsWrong) or (IncOutWrong) then
+ ;// no events will be shown
+ end;
+
+ clEvents.Repaint;
+ bnOK.Enabled := not (EventsWrong or IncOutWrong);
+end;
+
+procedure TfmCustomizeFilters.UpdateUpDownButtons;
+begin
+ bnUp.Enabled := (lbFilters.ItemIndex <> 0);
+ bnDown.Enabled := (lbFilters.ItemIndex <> lbFilters.Count-1);
+end;
+
+procedure TfmCustomizeFilters.cbCustomEventClick(Sender: TObject);
+begin
+ edCustomEvent.Enabled := cbCustomEvent.Checked;
+ if lbFilters.ItemIndex = -1 then exit;
+ edCustomEvent.Text := IntToStr(LocalFilters[lbFilters.ItemIndex].filCustom);
+ clEvents.OnClickCheck(Self);
+end;
+
+procedure TfmCustomizeFilters.edCustomEventChange(Sender: TObject);
+var
+ CustomType: Integer;
+begin
+ if lbFilters.ItemIndex = -1 then exit;
+ if not ((edCustomEvent.Text <> '') and
+ TryStrToInt(edCustomEvent.Text,CustomType)) then CustomType := -1;
+ if CustomType > $FFFF then
+ CustomType := -1;
+ if CustomType >= 0 then
+ begin
+ LocalFilters[lbFilters.ItemIndex].filCustom := Word(CustomType);
+ edCustomEvent.Color := clWindow;
+ end
+ else
+ edCustomEvent.Color := $008080FF;
+ bnOK.Enabled := (CustomType >= 0);
+end;
+
+procedure TfmCustomizeFilters.edEditKeyPress(Sender: TObject; var Key: Char);
+begin
+ // to prevent ** BLING ** when press Enter
+ // to prevent ** BLING ** when press Tab
+ // to prevent ** BLING ** when press Esc
+ if Ord(Key) in [VK_RETURN,VK_TAB,VK_ESCAPE] then Key := #0;
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/CustomizeToolbar.dfm b/plugins/HistoryPlusPlus/CustomizeToolbar.dfm new file mode 100644 index 0000000000..625a20409e --- /dev/null +++ b/plugins/HistoryPlusPlus/CustomizeToolbar.dfm @@ -0,0 +1,155 @@ +object fmCustomizeToolbar: TfmCustomizeToolbar
+ Left = 264
+ Top = 202
+ BorderStyle = bsDialog
+ Caption = 'Customize Toolbar'
+ ClientHeight = 363
+ ClientWidth = 518
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ KeyPreview = True
+ OldCreateOrder = False
+ Position = poOwnerFormCenter
+ OnClose = FormClose
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnKeyDown = FormKeyDown
+ DesignSize = (
+ 518
+ 363)
+ PixelsPerInch = 96
+ TextHeight = 13
+ object laAvailable: TLabel
+ Left = 8
+ Top = 5
+ Width = 87
+ Height = 13
+ Caption = 'A&vailable buttons:'
+ FocusControl = lbAvailable
+ end
+ object laAdded: TLabel
+ Left = 310
+ Top = 5
+ Width = 93
+ Height = 13
+ Caption = 'Buttons on &toolbar:'
+ FocusControl = lbAdded
+ end
+ object Bevel1: TBevel
+ Left = 8
+ Top = 323
+ Width = 501
+ Height = 2
+ Anchors = [akLeft, akRight, akBottom]
+ end
+ object bnAdd: TButton
+ Left = 215
+ Top = 24
+ Width = 88
+ Height = 25
+ Caption = '&Add >>'
+ TabOrder = 1
+ OnClick = bnAddClick
+ end
+ object bnRemove: TButton
+ Left = 215
+ Top = 49
+ Width = 88
+ Height = 25
+ Caption = '<< &Remove'
+ TabOrder = 2
+ OnClick = bnRemoveClick
+ end
+ object lbAdded: TListBox
+ Left = 310
+ Top = 24
+ Width = 200
+ Height = 292
+ Style = lbOwnerDrawFixed
+ DragMode = dmAutomatic
+ IntegralHeight = True
+ ItemHeight = 24
+ TabOrder = 5
+ OnClick = lbAvailableClick
+ OnDragDrop = lbAddedDragDrop
+ OnDragOver = lbAddedDragOver
+ OnDrawItem = lbAvailableDrawItem
+ end
+ object lbAvailable: TListBox
+ Left = 8
+ Top = 24
+ Width = 200
+ Height = 292
+ Style = lbOwnerDrawFixed
+ Anchors = [akLeft, akTop, akBottom]
+ DragMode = dmAutomatic
+ IntegralHeight = True
+ ItemHeight = 24
+ TabOrder = 0
+ OnClick = lbAvailableClick
+ OnDragDrop = lbAvailableDragDrop
+ OnDragOver = lbAvailableDragOver
+ OnDrawItem = lbAvailableDrawItem
+ end
+ object bnUp: TButton
+ Left = 215
+ Top = 80
+ Width = 88
+ Height = 25
+ Caption = '&Up'
+ TabOrder = 3
+ OnClick = bnUpClick
+ end
+ object bnDown: TButton
+ Left = 215
+ Top = 105
+ Width = 88
+ Height = 25
+ Caption = '&Down'
+ TabOrder = 4
+ OnClick = bnDownClick
+ end
+ object bnOK: TButton
+ Left = 8
+ Top = 330
+ Width = 77
+ Height = 25
+ Anchors = [akLeft, akBottom]
+ Caption = 'OK'
+ Default = True
+ TabOrder = 6
+ OnClick = bnOKClick
+ end
+ object bnCancel: TButton
+ Left = 91
+ Top = 330
+ Width = 77
+ Height = 25
+ Anchors = [akLeft, akBottom]
+ Cancel = True
+ Caption = '&Cancel'
+ TabOrder = 7
+ OnClick = bnCancelClick
+ end
+ object bnReset: TButton
+ Left = 380
+ Top = 331
+ Width = 130
+ Height = 25
+ Anchors = [akRight, akBottom]
+ Caption = 'R&eset to Default'
+ TabOrder = 8
+ OnClick = bnResetClick
+ end
+ object tiScroll: TTimer
+ Enabled = False
+ Interval = 250
+ OnTimer = tiScrollTimer
+ Left = 376
+ Top = 212
+ end
+end
diff --git a/plugins/HistoryPlusPlus/CustomizeToolbar.pas b/plugins/HistoryPlusPlus/CustomizeToolbar.pas new file mode 100644 index 0000000000..9637ac0706 --- /dev/null +++ b/plugins/HistoryPlusPlus/CustomizeToolbar.pas @@ -0,0 +1,603 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+unit CustomizeToolbar;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Dialogs, CommCtrl,
+ Forms, ComCtrls, StdCtrls, ExtCtrls, CheckLst, Buttons,
+ hpp_global, HistoryControls,
+ m_api, hpp_forms;
+
+type
+ TfmCustomizeToolbar = class(TForm)
+ bnAdd: TButton;
+ bnRemove: TButton;
+ lbAdded: TListBox;
+ lbAvailable: TListBox;
+ laAvailable: TLabel;
+ laAdded: TLabel;
+ bnUp: TButton;
+ bnDown: TButton;
+ Bevel1: TBevel;
+ bnOK: TButton;
+ bnCancel: TButton;
+ bnReset: TButton;
+ tiScroll: TTimer;
+ procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure lbAvailableDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
+ State: TOwnerDrawState);
+ procedure lbAddedDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState;
+ var Accept: Boolean);
+ procedure lbAddedDragDrop(Sender, Source: TObject; X, Y: Integer);
+ procedure lbAvailableDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState;
+ var Accept: Boolean);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure lbAvailableDragDrop(Sender, Source: TObject; X, Y: Integer);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure bnResetClick(Sender: TObject);
+ procedure OnWMChar(var Message: TWMChar); message WM_CHAR;
+ procedure bnAddClick(Sender: TObject);
+ procedure bnOKClick(Sender: TObject);
+ procedure bnCancelClick(Sender: TObject);
+ procedure tiScrollTimer(Sender: TObject);
+ procedure lbAvailableClick(Sender: TObject);
+ procedure bnUpClick(Sender: TObject);
+ procedure bnDownClick(Sender: TObject);
+ procedure bnRemoveClick(Sender: TObject);
+ private
+ ItemBmp: TBitmap;
+ DragOverIndex: Integer;
+ TimerScrollDirection: Integer;
+ procedure FillButtons;
+ procedure UpdateControlButtons;
+ procedure TranslateForm;
+
+ procedure AddItem(src: Integer; dst: Integer = -1);
+ procedure RemoveItem(src: Integer);
+
+ function GenerateToolbarString: AnsiString;
+ procedure SaveToolbar(ToolbarStr: AnsiString);
+
+ procedure HMIcons2Changed(var M: TMessage); message HM_NOTF_ICONS2CHANGED;
+ public
+ { Public declarations }
+ end;
+
+var
+ fmCustomizeToolbar: TfmCustomizeToolbar = nil;
+
+implementation
+
+uses HistoryForm, hpp_database, hpp_options;
+
+{$R *.dfm}
+
+procedure TfmCustomizeToolbar.lbAddedDragDrop(Sender, Source: TObject; X, Y: Integer);
+var
+ src, dst: Integer;
+begin
+ tiScroll.Enabled := False;
+ if Source = lbAvailable then
+ begin
+ src := lbAvailable.ItemIndex;
+ dst := lbAdded.ItemAtPos(Point(X, Y), False);
+ AddItem(src, dst);
+ end
+ else
+ begin
+ src := lbAdded.ItemIndex;
+ dst := lbAdded.ItemAtPos(Point(X, Y), True);
+ lbAdded.Items.Move(src, dst);
+ lbAdded.ItemIndex := dst;
+ end;
+ lbAdded.SetFocus;
+
+ UpdateControlButtons;
+end;
+
+procedure TfmCustomizeToolbar.lbAddedDragOver(Sender, Source: TObject; X, Y: Integer;
+ State: TDragState; var Accept: Boolean);
+var
+ idx: Integer;
+ r: TRect;
+begin
+ Accept := True;
+
+ if (lbAdded.ClientHeight - Y) < 10 then
+ TimerScrollDirection := 1
+ else if Y < 10 then
+ TimerScrollDirection := 2
+ else
+ TimerScrollDirection := 0;
+
+ tiScroll.Enabled := (TimerScrollDirection <> 0);
+
+ idx := DragOverIndex;
+ if idx = lbAdded.Count then
+ Dec(idx);
+ r := lbAdded.ItemRect(idx);
+ InvalidateRect(lbAdded.Handle, @r, False);
+ DragOverIndex := lbAdded.ItemAtPos(Point(X, Y), False);
+ idx := DragOverIndex;
+ if idx = lbAdded.Count then
+ Dec(idx);
+ r := lbAdded.ItemRect(idx);
+ InvalidateRect(lbAdded.Handle, @r, False);
+ lbAdded.Update;
+end;
+
+procedure TfmCustomizeToolbar.lbAvailableClick(Sender: TObject);
+begin
+ UpdateControlButtons;
+end;
+
+procedure TfmCustomizeToolbar.lbAvailableDragDrop(Sender, Source: TObject; X, Y: Integer);
+begin
+ RemoveItem(lbAdded.ItemIndex);
+ lbAvailable.SetFocus;
+end;
+
+procedure TfmCustomizeToolbar.lbAvailableDragOver(Sender, Source: TObject; X, Y: Integer;
+ State: TDragState; var Accept: Boolean);
+begin
+ Accept := (Source = lbAdded) and (lbAdded.ItemIndex <> -1);
+end;
+
+procedure TfmCustomizeToolbar.lbAvailableDrawItem(Control: TWinControl; Index: Integer;
+ Rect: TRect; State: TOwnerDrawState);
+var
+ txtW: String;
+ r: TRect;
+ r2: TRect;
+ but: THppToolButton;
+ fm: THistoryFrm;
+ src, dst: Integer;
+ lb: TListBox;
+ can: TCanvas;
+ tf: DWord;
+ DrawLineTop, DrawLineBottom: Boolean;
+begin
+ if Control = lbAdded then
+ lb := lbAdded
+ else
+ lb := lbAvailable;
+
+ ItemBmp.Width := Rect.Right - Rect.Left;
+ ItemBmp.Height := Rect.Bottom - Rect.Top;
+ can := ItemBmp.Canvas;
+ can.Font := lb.Font;
+
+ r := can.ClipRect;
+ if (odSelected in State) and (odFocused in State) then
+ begin
+ can.Brush.Color := clHighlight;
+ can.Font.Color := clHighlightText;
+ end
+ else
+ begin
+ can.Brush.Color := clWindow;
+ can.Font.Color := clWindowText;
+ end;
+
+ can.FillRect(r);
+
+ tf := DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX;
+ txtW := lb.Items[Index];
+
+ if (odSelected in State) and (not(odFocused in State)) then
+ begin
+ r2 := r;
+ InflateRect(r2, -1, -1);
+ can.Pen.Color := clHighlight;
+ can.Rectangle(r2);
+ end;
+
+ if txtW <> '-' then
+ begin
+ r2 := r;
+ r2.Left := r2.Left + 20 + 4;
+ DrawText(can.Handle, PChar(txtW), Length(txtW), r2, tf);
+ r2 := Classes.Rect(r.Left + 2, r.Top + 2, r.Left + 20 + 2, r.Bottom - 2);
+ { can.Brush.Color := clBtnFace;
+ can.FillRect(r2); }
+ fm := THistoryFrm(Owner);
+ if lb.Items.Objects[Index] is THppToolButton then
+ begin
+ but := THppToolButton(lb.Items.Objects[Index]);
+ ImageList_Draw(fm.ilToolbar.Handle, but.ImageIndex, can.Handle, r2.Left + 2, r2.Top + 2,
+ ILD_NORMAL);
+ end
+ else if lb.Items.Objects[Index] = fm.tbEventsFilter then
+ begin
+ DrawIconEx(can.Handle, r2.Left + 2, r2.Top + 2, hppIcons[HPP_ICON_DROPDOWNARROW].Handle,
+ 16, 16, 0, 0, DI_NORMAL);
+ end
+ else if lb.Items.Objects[Index] = fm.tbHistory then
+ begin
+ DrawIconEx(can.Handle, r2.Left + 2, r2.Top + 2, hppIcons[HPP_ICON_CONTACTHISTORY].Handle,
+ 16, 16, 0, 0, DI_NORMAL);
+ end;
+ end
+ else
+ begin
+ r2 := Classes.Rect(r.Left, r.Top + ((r.Bottom - r.Top) div 2), r.Right, r.Bottom);
+ r2.Bottom := r2.Top + 1;
+ InflateRect(r2, -((r2.Right - r2.Left) div 10), 0);
+ can.Pen.Color := can.Font.Color;
+ can.MoveTo(r2.Left, r2.Top);
+ can.LineTo(r2.Right, r2.Top);
+ end;
+
+ if (lbAdded.Dragging) or (lbAvailable.Dragging) and (lb = lbAdded) then
+ begin
+ DrawLineTop := False;
+ DrawLineBottom := False;
+ dst := DragOverIndex;
+ can.Pen.Color := clHighlight;
+ if lbAdded.Dragging then
+ begin
+ src := lbAdded.ItemIndex;
+ if Index = dst then
+ begin
+ if (dst < src) then
+ DrawLineTop := True
+ else
+ DrawLineBottom := True
+ end;
+ end
+ else
+ begin
+ if Index = dst then
+ DrawLineTop := True;
+ end;
+ if (dst = lb.Count) and (Index = lb.Count - 1) then
+ DrawLineBottom := True;
+
+ if DrawLineTop then
+ begin
+ can.MoveTo(r.Left, r.Top);
+ can.LineTo(r.Right, r.Top);
+ end;
+ if DrawLineBottom then
+ begin
+ can.MoveTo(r.Left, r.Bottom - 1);
+ can.LineTo(r.Right, r.Bottom - 1);
+ end;
+ end;
+
+ BitBlt(lb.Canvas.Handle,Rect.Left,Rect.Top,ItemBmp.Width,ItemBmp.Height,can.Handle,0,0,SRCCOPY);
+end;
+
+procedure TfmCustomizeToolbar.OnWMChar(var Message: TWMChar);
+begin
+ if not(csDesigning in ComponentState) then
+ with Message do
+ begin
+ Result := 1;
+ if (Perform(WM_GETDLGCODE, 0, 0) and DLGC_WANTCHARS = 0) and
+ (GetParentForm(Self).Perform(CM_DIALOGCHAR, CharCode, KeyData) <> 0) then
+ Exit;
+ Result := 0;
+ end;
+end;
+
+procedure TfmCustomizeToolbar.RemoveItem(src: Integer);
+begin
+ if (src = -1) or (src > lbAdded.Count - 1) then
+ Exit;
+
+ if (lbAdded.Items.Objects[src] <> nil) then
+ begin
+ // delete last item -- separator
+ lbAvailable.Items.Delete(lbAvailable.Items.Count - 1);
+ // add item
+ lbAvailable.AddItem(lbAdded.Items[src], lbAdded.Items.Objects[src]);
+ // sort
+ lbAvailable.Sorted := True;
+ lbAvailable.Sorted := False;
+ // add separator back
+ lbAvailable.AddItem('-', nil);
+ end;
+ lbAvailable.ItemIndex := lbAvailable.Items.IndexOfObject(lbAdded.Items.Objects[src]);
+
+ lbAdded.Items.Delete(src);
+ if src < lbAdded.Count then
+ lbAdded.ItemIndex := src
+ else if src - 1 < lbAdded.Count then
+ lbAdded.ItemIndex := src - 1;
+
+ UpdateControlButtons;
+end;
+
+procedure TfmCustomizeToolbar.SaveToolbar(ToolbarStr: AnsiString);
+begin
+ if ToolbarStr = '' then
+ ToolbarStr := DEF_HISTORY_TOOLBAR;
+ if ToolbarStr = DEF_HISTORY_TOOLBAR then
+ DBDeleteContactSetting(0, hppDBName, 'HistoryToolbar')
+ else
+ WriteDBStr(hppDBName, 'HistoryToolbar', ToolbarStr);
+end;
+
+procedure TfmCustomizeToolbar.tiScrollTimer(Sender: TObject);
+begin
+ case TimerScrollDirection of
+ 1: lbAdded.Perform(WM_VSCROLL, SB_LINEDOWN, 0);
+ 2: lbAdded.Perform(WM_VSCROLL, SB_LINEUP, 0)
+ else
+ tiScroll.Enabled := False;
+ end;
+end;
+
+procedure TfmCustomizeToolbar.AddItem(src, dst: Integer);
+begin
+ if (src = -1) or (src > lbAvailable.Count - 1) then
+ Exit;
+
+ lbAdded.AddItem(lbAvailable.Items[src], lbAvailable.Items.Objects[src]);
+ if lbAvailable.Items[src] <> '-' then
+ lbAvailable.Items.Delete(src);
+ if (dst <> lbAdded.Count - 1) and (dst <> -1) then
+ begin
+ lbAdded.Items.Move(lbAdded.Count - 1, dst);
+ lbAdded.ItemIndex := dst;
+ end
+ else
+ lbAdded.ItemIndex := lbAdded.Count - 1;
+ if src < lbAvailable.Count then
+ lbAvailable.ItemIndex := src
+ else if src - 1 < lbAvailable.Count then
+ lbAvailable.ItemIndex := src - 1;
+
+ UpdateControlButtons;
+end;
+
+procedure TfmCustomizeToolbar.bnAddClick(Sender: TObject);
+begin
+ AddItem(lbAvailable.ItemIndex, lbAdded.ItemIndex);
+end;
+
+procedure TfmCustomizeToolbar.FillButtons;
+var
+ i: Integer;
+ fm: THistoryFrm;
+ but: TControl;
+ txt: String;
+begin
+ lbAdded.Clear;
+ lbAvailable.Clear;
+ fm := THistoryFrm(Owner);
+
+ for i := 0 to fm.Toolbar.ButtonCount - 1 do
+ begin
+ but := fm.Toolbar.Buttons[i];
+ txt := '';
+ if but is THppToolButton then
+ begin
+ if THppToolButton(but).Style in [tbsSeparator, tbsDivider] then
+ txt := '-'
+ else
+ txt := THppToolButton(but).Hint
+ end
+ else if but = fm.tbEventsFilter then
+ txt := TranslateW('Event Filters')
+ else if but is TSpeedButton then
+ txt := TSpeedButton(but).Hint;
+
+ if txt <> '' then
+ begin
+ if but.Visible then
+ begin
+ if txt = '-' then
+ lbAdded.AddItem(txt, nil)
+ else
+ lbAdded.AddItem(txt, but);
+ end
+ else
+ lbAvailable.AddItem(txt, but);
+ end;
+ end;
+ lbAvailable.Sorted := True;
+ lbAvailable.Sorted := False;
+ lbAvailable.AddItem('-', nil);
+
+ if lbAdded.Count > 0 then
+ begin
+ lbAdded.ItemIndex := 0;
+ if Visible then
+ lbAdded.SetFocus
+ else
+ ActiveControl := lbAdded;
+ end
+ else
+ begin
+ lbAvailable.ItemIndex := 0;
+ if Visible then
+ lbAvailable.SetFocus
+ else
+ ActiveControl := lbAvailable;
+ end;
+ UpdateControlButtons;
+end;
+
+procedure TfmCustomizeToolbar.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+ Action := caFree;
+end;
+
+procedure TfmCustomizeToolbar.FormCreate(Sender: TObject);
+begin
+ fmCustomizeToolbar := Self;
+
+ DesktopFont := True;
+ MakeFontsParent(Self);
+ TranslateForm;
+
+ ItemBmp := TBitmap.Create;
+ FillButtons;
+end;
+
+procedure TfmCustomizeToolbar.FormDestroy(Sender: TObject);
+begin
+ fmCustomizeToolbar := nil;
+ ItemBmp.Free;
+ try
+ THistoryFrm(Owner).CustomizeToolbarForm := nil;
+ except
+ // "eat" exceptions if any
+ end;
+end;
+
+procedure TfmCustomizeToolbar.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+var
+ Mask: Integer;
+begin
+ with Sender as TWinControl do
+ begin
+ if Perform(CM_CHILDKEY, Key, LPARAM(Sender)) <> 0 then
+ Exit;
+ Mask := 0;
+ case Key of
+ VK_TAB:
+ Mask := DLGC_WANTTAB;
+ VK_RETURN, VK_EXECUTE, VK_ESCAPE, VK_CANCEL:
+ Mask := DLGC_WANTALLKEYS;
+ end;
+ if (Mask <> 0) and (Perform(CM_WANTSPECIALKEY, Key, 0) = 0) and
+ (Perform(WM_GETDLGCODE, 0, 0) and Mask = 0) and (Self.Perform(CM_DIALOGKEY, Key, 0) <> 0)
+ then
+ Exit;
+ end;
+end;
+
+function TfmCustomizeToolbar.GenerateToolbarString: AnsiString;
+var
+ i: Integer;
+ but: TControl;
+ but_str: AnsiString;
+ fm: THistoryFrm;
+begin
+ Result := '';
+ fm := THistoryFrm(Owner);
+ for i := 0 to lbAdded.Count - 1 do
+ begin
+ but := TControl(lbAdded.Items.Objects[i]);
+ if but = nil then but_str := ' '
+ else if but = fm.tbSessions then but_str := '[SESS]'
+ else if but = fm.tbBookmarks then but_str := '[BOOK]'
+ else if but = fm.tbSearch then but_str := '[SEARCH]'
+ else if but = fm.tbFilter then but_str := '[FILTER]'
+ else if but = fm.tbCopy then but_str := '[COPY]'
+ else if but = fm.tbDelete then but_str := '[DELETE]'
+ else if but = fm.tbSave then but_str := '[SAVE]'
+ else if but = fm.tbHistory then but_str := '[HISTORY]'
+ else if but = fm.tbHistorySearch then but_str := '[GLOBSEARCH]'
+ else if but = fm.tbEventsFilter then but_str := '[EVENTS]'
+ else if but = fm.tbUserMenu then but_str := '[USERMENU]'
+ else if but = fm.tbUserDetails then but_str := '[USERDETAILS]';
+ Result := Result + but_str;
+ end;
+end;
+
+procedure TfmCustomizeToolbar.HMIcons2Changed(var M: TMessage);
+begin
+ lbAvailable.Repaint;
+ lbAdded.Repaint;
+end;
+
+procedure TfmCustomizeToolbar.bnOKClick(Sender: TObject);
+begin
+ SaveToolbar(GenerateToolbarString);
+ NotifyAllForms(HM_NOTF_TOOLBARCHANGED, 0, 0);
+ close;
+end;
+
+procedure TfmCustomizeToolbar.bnCancelClick(Sender: TObject);
+begin
+ close;
+end;
+
+procedure TfmCustomizeToolbar.bnDownClick(Sender: TObject);
+var
+ idx: Integer;
+begin
+ idx := lbAdded.ItemIndex;
+ if (idx < 0) or (idx > lbAdded.Count - 1) then
+ Exit;
+ lbAdded.Items.Move(idx, idx + 1);
+ lbAdded.ItemIndex := idx + 1;
+ UpdateControlButtons;
+end;
+
+procedure TfmCustomizeToolbar.bnRemoveClick(Sender: TObject);
+begin
+ RemoveItem(lbAdded.ItemIndex);
+end;
+
+procedure TfmCustomizeToolbar.bnResetClick(Sender: TObject);
+begin
+ DBDeleteContactSetting(0, hppDBName, 'HistoryToolbar');
+ NotifyAllForms(HM_NOTF_TOOLBARCHANGED, 0, 0);
+ FillButtons;
+ UpdateControlButtons;
+end;
+
+procedure TfmCustomizeToolbar.bnUpClick(Sender: TObject);
+var
+ idx: Integer;
+begin
+ idx := lbAdded.ItemIndex;
+ if idx < 1 then
+ Exit;
+ lbAdded.Items.Move(idx, idx - 1);
+ lbAdded.ItemIndex := idx - 1;
+ UpdateControlButtons;
+end;
+
+procedure TfmCustomizeToolbar.TranslateForm;
+begin
+ Caption := TranslateUnicodeString(Caption);
+ laAvailable.Caption := TranslateUnicodeString(laAvailable.Caption);
+ laAdded.Caption := TranslateUnicodeString(laAdded.Caption);
+ bnOK.Caption := TranslateUnicodeString(bnOK.Caption);
+ bnCancel.Caption := TranslateUnicodeString(bnCancel.Caption);
+ bnReset.Caption := TranslateUnicodeString(bnReset.Caption);
+ bnAdd.Caption := TranslateUnicodeString(bnAdd.Caption);
+ bnRemove.Caption := TranslateUnicodeString(bnRemove.Caption);
+ bnUp.Caption := TranslateUnicodeString(bnUp.Caption);
+ bnDown.Caption := TranslateUnicodeString(bnDown.Caption);
+end;
+
+procedure TfmCustomizeToolbar.UpdateControlButtons;
+begin
+ bnAdd.Enabled := (lbAvailable.ItemIndex <> -1);
+ bnRemove.Enabled := (lbAdded.ItemIndex <> -1);
+ bnUp.Enabled := (lbAdded.ItemIndex <> -1) and (lbAdded.ItemIndex > 0);
+ bnDown.Enabled := (lbAdded.ItemIndex <> -1) and (lbAdded.ItemIndex < lbAdded.Count - 1);
+ bnOK.Enabled := (lbAdded.Count > 0);
+end;
+
+end.
+
diff --git a/plugins/HistoryPlusPlus/EmptyHistoryForm.dfm b/plugins/HistoryPlusPlus/EmptyHistoryForm.dfm new file mode 100644 index 0000000000..0bec7e7226 --- /dev/null +++ b/plugins/HistoryPlusPlus/EmptyHistoryForm.dfm @@ -0,0 +1,106 @@ +object EmptyHistoryFrm: TEmptyHistoryFrm
+ Left = 346
+ Top = 283
+ BorderStyle = bsDialog
+ BorderWidth = 8
+ Caption = 'Empty History'
+ ClientHeight = 79
+ ClientWidth = 274
+ Color = clBtnFace
+ DefaultMonitor = dmDesktop
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'MS Sans Serif'
+ Font.Style = []
+ FormStyle = fsStayOnTop
+ KeyPreview = True
+ OldCreateOrder = True
+ Position = poScreenCenter
+ OnCreate = FormCreate
+ OnKeyDown = FormKeyDown
+ OnShow = FormShow
+ DesignSize = (
+ 274
+ 79)
+ PixelsPerInch = 96
+ TextHeight = 13
+ object Image: TImage
+ Left = 0
+ Top = 0
+ Width = 32
+ Height = 32
+ end
+ object Text: TLabel
+ Caption = ''
+ Left = 42
+ Top = 0
+ Width = 232
+ Height = 32
+ Anchors = [akLeft, akTop, akRight]
+ AutoSize = False
+ Layout = tlCenter
+ WordWrap = True
+ end
+ object paButtons: TPanel
+ Left = 0
+ Top = 54
+ Width = 274
+ Height = 25
+ Align = alBottom
+ AutoSize = True
+ BevelOuter = bvNone
+ TabOrder = 0
+ object btYes: TButton
+ Left = 0
+ Top = 0
+ Width = 75
+ Height = 25
+ Caption = 'Yes'
+ ModalResult = 6
+ TabOrder = 0
+ OnClick = btYesClick
+ end
+ object btNo: TButton
+ Left = 85
+ Top = 0
+ Width = 75
+ Height = 25
+ Cancel = True
+ Caption = 'No'
+ ModalResult = 7
+ TabOrder = 1
+ end
+ object btCancel: TButton
+ Left = 168
+ Top = 0
+ Width = 75
+ Height = 25
+ Cancel = True
+ Caption = 'Cancel'
+ Default = True
+ ModalResult = 2
+ TabOrder = 2
+ end
+ end
+ object paContacts: TPanel
+ Left = 0
+ Top = 31
+ Width = 274
+ Height = 23
+ Align = alBottom
+ BevelOuter = bvNone
+ TabOrder = 1
+ Visible = False
+ object cbInclude: TCheckBox
+ Left = 0
+ Top = 0
+ Width = 274
+ Height = 23
+ Caption = 'Empty history of subcontacts also'
+ Checked = True
+ State = cbChecked
+ TabOrder = 0
+ end
+ end
+end
diff --git a/plugins/HistoryPlusPlus/EmptyHistoryForm.pas b/plugins/HistoryPlusPlus/EmptyHistoryForm.pas new file mode 100644 index 0000000000..1895cc6bf1 --- /dev/null +++ b/plugins/HistoryPlusPlus/EmptyHistoryForm.pas @@ -0,0 +1,318 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+{-----------------------------------------------------------------------------
+ EmptyHistoryForm (historypp project)
+
+ Version: 1.0
+ Created: 15.03.2008
+ Author: theMIROn
+
+ [ Description ]
+
+ Empty history dialog
+
+ [ History ]
+
+ 1.0 (15.04.08) First version.
+
+ [ Modifications ]
+
+ [ Known Issues ]
+
+ Contributors: theMIROn, Art Fedorov
+-----------------------------------------------------------------------------}
+
+unit EmptyHistoryForm;
+
+interface
+
+uses Windows, Classes, Controls, Graphics,
+ Forms, Buttons, StdCtrls, ExtCtrls,
+ HistoryControls,
+ PassForm, PassCheckForm,
+ hpp_global, hpp_forms, hpp_contacts, hpp_database, hpp_bookmarks,
+ m_api;
+
+type
+ TEmptyHistoryFrm = class(TForm)
+ btYes: TButton;
+ btNo: TButton;
+ paContacts: TPanel;
+ paButtons: TPanel;
+ Image: TImage;
+ Text: TLabel;
+ cbInclude: TCheckBox;
+ btCancel: TButton;
+ procedure FormCreate(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure FormShow(Sender: TObject);
+ procedure btYesClick(Sender: TObject);
+ private
+ FContact: THandle;
+ FContacts: Array of THandle;
+ FPasswordMode: Boolean;
+ procedure TranslateForm;
+ procedure PrepareForm;
+ procedure SetContact(const Value: THandle);
+ procedure SetPasswordMode(const Value: Boolean);
+ procedure EmptyHistory(hContact: THandle);
+ protected
+ function GetFormText: String;
+ public
+ property Contact: THandle read FContact write SetContact;
+ property PasswordMode: Boolean read FPasswordMode write SetPasswordMode;
+ end;
+
+implementation
+
+uses Math, SysUtils, HistoryForm;
+
+{$R *.dfm}
+
+function GetAveCharSize(Canvas: TCanvas): TPoint;
+var
+ I: Integer;
+ Buffer: array[0..51] of WideChar;
+ tm: TTextMetric;
+begin
+ for I := 0 to 25 do Buffer[I] := WideChar(I + Ord('A'));
+ for I := 0 to 25 do Buffer[I + 26] := WideChar(I + Ord('a'));
+ GetTextMetrics(Canvas.Handle, tm);
+ GetTextExtentPointW(Canvas.Handle, Buffer, 52, TSize(Result));
+ Result.X := (Result.X div 26 + 1) div 2;
+ Result.Y := tm.tmHeight;
+end;
+
+function TEmptyHistoryFrm.GetFormText: String;
+var
+ DividerLine, ButtonCaptions, IncludeContacts: String;
+ I: integer;
+begin
+ DividerLine := StringOfChar('-', 27) + sLineBreak;
+ for I := 0 to ComponentCount - 1 do
+ if Components[I] is TButton then
+ ButtonCaptions := ButtonCaptions +
+ TButton(Components[I]).Caption + StringOfChar(' ', 3);
+ ButtonCaptions := StringReplace(ButtonCaptions,'&','', [rfReplaceAll]);
+ if paContacts.Visible then
+ begin
+ if cbInclude.Checked then
+ IncludeContacts := '[x]'
+ else
+ IncludeContacts := '[ ]';
+ IncludeContacts := sLineBreak + IncludeContacts + ' ' + cbInclude.Caption + sLineBreak;
+ end
+ else
+ IncludeContacts := '';
+ Result := DividerLine + Caption + sLineBreak +
+ DividerLine + Text.Caption + sLineBreak +
+ IncludeContacts +
+ DividerLine + ButtonCaptions + sLineBreak +
+ DividerLine;
+end;
+
+procedure TEmptyHistoryFrm.TranslateForm;
+begin
+ Caption := TranslateUnicodeString(Caption);
+ cbInclude.Caption := TranslateUnicodeString(cbInclude.Caption);
+ btYes.Caption := TranslateUnicodeString(btYes.Caption);
+ btNo.Caption := TranslateUnicodeString(btNo.Caption);
+ btCancel.Caption := TranslateUnicodeString(btCancel.Caption);
+end;
+
+procedure TEmptyHistoryFrm.PrepareForm;
+const
+ mcSpacing = 8;
+ mcButtonWidth = 50;
+ mcButtonHeight = 14;
+ mcButtonSpacing = 4;
+var
+ DialogUnits: TPoint;
+ HorzSpacing, VertSpacing,
+ ButtonWidth, ButtonHeight, ButtonSpacing, ButtonGroupWidth,
+ IconTextWidth, IconTextHeight: Integer;
+ TextRect,ContRect: TRect;
+begin
+ DialogUnits := GetAveCharSize(Canvas);
+ HorzSpacing := MulDiv(mcSpacing, DialogUnits.X, 8);
+ VertSpacing := MulDiv(mcSpacing, DialogUnits.X, 4);
+ ButtonWidth := MulDiv(mcButtonWidth, DialogUnits.X, 4);
+ ButtonHeight := MulDiv(mcButtonHeight, DialogUnits.Y, 8);
+ ButtonSpacing := MulDiv(mcButtonSpacing, DialogUnits.X, 4);
+
+ SetRect(TextRect, 0, 0, Screen.Width div 2, 0);
+ DrawTextW(Canvas.Handle, PChar(Text.Caption),
+ Length(Text.Caption)+1, TextRect,
+ DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or
+ DrawTextBiDiModeFlagsReadingOnly);
+
+ IconTextWidth := Image.Width + HorzSpacing + TextRect.Right;
+ IconTextHeight := Max(Image.Height,TextRect.Bottom);
+
+ if PasswordMode then
+ ButtonGroupWidth := ButtonWidth
+ else
+ ButtonGroupWidth := ButtonWidth*2 + ButtonSpacing;
+
+ BorderWidth := VertSpacing;
+ ClientWidth := Max(IconTextWidth, ButtonGroupWidth);
+ if paContacts.Visible then
+ begin
+ ContRect := Rect(0,0,0,0);
+ DrawTextW(Canvas.Handle,
+ PChar(cbInclude.Caption), -1,
+ ContRect, DT_CALCRECT or DT_LEFT or DT_SINGLELINE or
+ DrawTextBiDiModeFlagsReadingOnly);
+ Inc(ContRect.Right, HorzSpacing*4);
+ cbInclude.SetBounds((ClientWidth - ContRect.Right) div 2,0,
+ ContRect.Right, ContRect.Bottom);
+ paContacts.Height := cbInclude.Height + VertSpacing;
+ ClientHeight := IconTextHeight + VertSpacing + paContacts.Height + paButtons.Height;
+ end
+ else
+ ClientHeight := IconTextHeight + VertSpacing + paButtons.Height;
+ Text.SetBounds(Image.Width + HorzSpacing, 0,
+ TextRect.Right, TextRect.Bottom);
+
+ if PasswordMode then
+ begin
+ btCancel.SetBounds((ClientWidth - ButtonGroupWidth) div 2,0, ButtonWidth, ButtonHeight);
+ end
+ else
+ begin
+ btYes.SetBounds((ClientWidth - ButtonGroupWidth) div 2,0, ButtonWidth, ButtonHeight);
+ btNo.SetBounds(btYes.Left + btYes.Width + ButtonSpacing,0, ButtonWidth, ButtonHeight);
+ end;
+end;
+
+procedure TEmptyHistoryFrm.FormShow(Sender: TObject);
+begin
+ TranslateForm;
+ PrepareForm;
+end;
+
+procedure TEmptyHistoryFrm.FormCreate(Sender: TObject);
+var
+ NonClientMetrics: TNonClientMetrics;
+begin
+ NonClientMetrics.cbSize := sizeof(NonClientMetrics);
+ if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
+ Font.Handle := CreateFontIndirect(NonClientMetrics.lfMessageFont);
+ MakeFontsParent(Self);
+ Canvas.Font := Font;
+ DoubleBuffered := True;
+ MakeDoubleBufferedParent(Self);
+end;
+
+procedure TEmptyHistoryFrm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+ if (Shift = [ssCtrl]) and (Key = Word('C')) then
+ begin
+ CopyToClip(GetFormText,CP_ACP);
+ Key := 0;
+ end;
+end;
+
+procedure TEmptyHistoryFrm.SetContact(const Value: THandle);
+var
+ hContact: THandle;
+ Proto: AnsiString;
+ i,num: Integer;
+begin
+ FContact := Value;
+ SetLength(FContacts,0);
+ GetContactProto(FContact,hContact,Proto);
+ if Value <> hContact then
+ begin
+ num := CallService(MS_MC_GETNUMCONTACTS,FContact,0);
+ for i := 0 to num-1 do
+ begin
+ hContact := CallService(MS_MC_GETSUBCONTACT,FContact,i);
+ if hContact <> THandle(-1) then
+ begin
+ SetLength(FContacts,Length(FContacts)+1);
+ FContacts[High(FContacts)] := hContact;
+ end;
+ end;
+ end;
+ if Assigned(Owner) and (Owner is THistoryFrm) then
+ PasswordMode := THistoryFrm(Owner).PasswordMode
+ else
+ PasswordMode := (not IsPasswordBlank(GetPassword)) and IsUserProtected(FContact);
+ paContacts.Visible := not PasswordMode and (Length(FContacts) > 0);
+end;
+
+procedure TEmptyHistoryFrm.SetPasswordMode(const Value: Boolean);
+begin
+ FPasswordMode := Value;
+ if PasswordMode then
+ begin
+ Image.Picture.Icon.Handle := LoadIcon(0, IDI_EXCLAMATION);
+ Text.Caption := TranslateW('History of this contact is password protected');
+ end
+ else
+ begin
+ Image.Picture.Icon.Handle := LoadIcon(0, IDI_QUESTION);
+ Text.Caption :=
+ TranslateW('Do you really want to delete ALL items for this contact?')+#10#13+
+ #10#13+
+ TranslateW('Note: It can take several minutes for large histories');
+ end;
+ btYes.Visible := not FPasswordMode;
+ btYes.Default := not FPasswordMode;
+ btNo.Visible := not FPasswordMode;
+ btCancel.Visible := FPasswordMode;
+ btCancel.Default := FPasswordMode;
+end;
+
+procedure TEmptyHistoryFrm.EmptyHistory(hContact: THandle);
+var
+ hDBEvent,prevhDbEvent: THandle;
+begin
+ BookmarkServer.Contacts[hContact].Clear;
+ hDBEvent := CallService(MS_DB_EVENT_FINDLAST,hContact,0);
+ SetSafetyMode(False);
+ while hDBEvent <> 0 do
+ begin
+ prevhDbEvent := CallService(MS_DB_EVENT_FINDPREV,hDBEvent,0);
+ if CallService(MS_DB_EVENT_DELETE,hContact,hDBEvent) = 0 then
+ hDBEvent := prevhDbEvent
+ else
+ hDBEvent := 0;
+ end;
+ SetSafetyMode(True);
+end;
+
+procedure TEmptyHistoryFrm.btYesClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ if Assigned(Owner) and (Owner is THistoryFrm) then
+ THistoryFrm(Owner).EmptyHistory
+ else
+ EmptyHistory(FContact);
+ if paContacts.Visible and cbInclude.Checked then
+ for i := 0 to High(FContacts) do
+ EmptyHistory(FContacts[i]);
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/EventDetailForm.dfm b/plugins/HistoryPlusPlus/EventDetailForm.dfm new file mode 100644 index 0000000000..4a19c20cfa --- /dev/null +++ b/plugins/HistoryPlusPlus/EventDetailForm.dfm @@ -0,0 +1,307 @@ +object EventDetailsFrm: TEventDetailsFrm
+ Left = 269
+ Top = 168
+ Width = 466
+ Height = 389
+ BorderWidth = 4
+ Caption = 'Event Details'
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'MS Sans Serif'
+ Font.Style = []
+ KeyPreview = True
+ OldCreateOrder = False
+ ShowHint = True
+ OnClose = FormClose
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnKeyDown = FormKeyDown
+ PixelsPerInch = 96
+ TextHeight = 13
+ object paBottom: TPanel
+ Left = 0
+ Top = 322
+ Width = 450
+ Height = 32
+ Align = alBottom
+ BevelOuter = bvNone
+ TabOrder = 1
+ object PrevBtn: TSpeedButton
+ Left = 0
+ Top = 4
+ Width = 100
+ Height = 25
+ Hint = 'Prevous message'
+ Caption = 'Prev'
+ OnClick = PrevBtnClick
+ end
+ object NextBtn: TSpeedButton
+ Left = 110
+ Top = 4
+ Width = 100
+ Height = 25
+ Hint = 'Next message'
+ Caption = 'Next'
+ OnClick = NextBtnClick
+ end
+ object Panel3: TPanel
+ Left = 250
+ Top = 0
+ Width = 200
+ Height = 32
+ Align = alRight
+ BevelOuter = bvNone
+ TabOrder = 0
+ object bnReply: TButton
+ Left = 4
+ Top = 4
+ Width = 116
+ Height = 25
+ Caption = 'Reply &Quoted'
+ TabOrder = 0
+ OnClick = bnReplyClick
+ end
+ object CloseBtn: TButton
+ Left = 125
+ Top = 4
+ Width = 75
+ Height = 25
+ Cancel = True
+ Caption = '&Close'
+ Default = True
+ TabOrder = 1
+ OnClick = CloseBtnClick
+ end
+ end
+ end
+ object paInfo: TPanel
+ Left = 0
+ Top = 0
+ Width = 450
+ Height = 101
+ Align = alTop
+ BevelOuter = bvNone
+ TabOrder = 2
+ object GroupBox: THppGroupBox
+ Left = 0
+ Top = 0
+ Width = 450
+ Height = 101
+ Align = alClient
+ Caption = 'Event Info'
+ TabOrder = 0
+ DesignSize = (
+ 450
+ 101)
+ object laType: TLabel
+ Left = 8
+ Top = 16
+ Width = 27
+ Height = 13
+ Caption = 'Type:'
+ Transparent = True
+ end
+ object laDateTime: TLabel
+ Left = 8
+ Top = 36
+ Width = 54
+ Height = 13
+ Caption = 'Date/Time:'
+ Transparent = True
+ end
+ object laFrom: TLabel
+ Left = 8
+ Top = 56
+ Width = 26
+ Height = 13
+ Caption = 'From:'
+ Transparent = True
+ end
+ object laTo: TLabel
+ Left = 8
+ Top = 76
+ Width = 16
+ Height = 13
+ Caption = 'To:'
+ Transparent = True
+ end
+ object EFromMore: TSpeedButton
+ Left = 420
+ Top = 56
+ Width = 20
+ Height = 20
+ Hint = 'Show sender information'
+ Anchors = [akTop, akRight]
+ Flat = True
+ Layout = blGlyphTop
+ OnClick = EFromMoreClick
+ end
+ object EToMore: TSpeedButton
+ Left = 420
+ Top = 76
+ Width = 20
+ Height = 20
+ Hint = 'Show receiver information'
+ Anchors = [akTop, akRight]
+ Flat = True
+ Layout = blGlyphTop
+ OnClick = EToMoreClick
+ end
+ object imDirection: TImage
+ Left = 422
+ Top = 18
+ Width = 16
+ Height = 16
+ Hint = 'Message direction'
+ Anchors = [akTop, akRight]
+ Center = True
+ Transparent = True
+ end
+ object EMsgType: THppEdit
+ Left = 80
+ Top = 16
+ Width = 337
+ Height = 21
+ Anchors = [akLeft, akTop, akRight]
+ BorderStyle = bsNone
+ Color = clBtnFace
+ ReadOnly = True
+ TabOrder = 0
+ end
+ object EFrom: THppEdit
+ Left = 80
+ Top = 56
+ Width = 337
+ Height = 21
+ Anchors = [akLeft, akTop, akRight]
+ BorderStyle = bsNone
+ Color = clBtnFace
+ ReadOnly = True
+ TabOrder = 2
+ end
+ object ETo: THppEdit
+ Left = 80
+ Top = 76
+ Width = 337
+ Height = 21
+ Anchors = [akLeft, akTop, akRight]
+ BorderStyle = bsNone
+ Color = clBtnFace
+ ReadOnly = True
+ TabOrder = 3
+ end
+ object EDateTime: THppEdit
+ Left = 80
+ Top = 36
+ Width = 337
+ Height = 21
+ Anchors = [akLeft, akTop, akRight]
+ BorderStyle = bsNone
+ Color = clBtnFace
+ ReadOnly = True
+ TabOrder = 1
+ end
+ end
+ end
+ object paText: TPanel
+ Left = 0
+ Top = 101
+ Width = 450
+ Height = 6
+ Align = alTop
+ BevelOuter = bvNone
+ TabOrder = 3
+ end
+ object EText: THPPRichEdit
+ Left = 0
+ Top = 107
+ Width = 450
+ Height = 215
+ Align = alClient
+ BevelInner = bvNone
+ BevelOuter = bvNone
+ BiDiMode = bdLeftToRight
+ ParentBiDiMode = False
+ PopupMenu = pmEText
+ ReadOnly = True
+ ScrollBars = ssVertical
+ TabOrder = 0
+ OnMouseMove = ETextMouseMove
+ OnResizeRequest = ETextResizeRequest
+ OnURLClick = ETextURLClick
+ end
+ object pmEText: TPopupMenu
+ BiDiMode = bdLeftToRight
+ ParentBiDiMode = False
+ OnPopup = pmETextPopup
+ Left = 68
+ Top = 173
+ object BrowseReceivedFiles: TMenuItem
+ Caption = '&Browse Received Files'
+ OnClick = BrowseReceivedFilesClick
+ end
+ object OpenFileFolder: TMenuItem
+ Caption = '&Open file folder'
+ OnClick = OpenFileFolderClick
+ end
+ object CopyFilename: TMenuItem
+ Caption = 'Copy &Filename'
+ OnClick = CopyLinkClick
+ end
+ object N3: TMenuItem
+ Caption = '-'
+ end
+ object OpenLinkNW: TMenuItem
+ Caption = 'Open in &new window'
+ OnClick = OpenLinkNWClick
+ end
+ object OpenLink: TMenuItem
+ Caption = 'Open in existing &window'
+ OnClick = OpenLinkClick
+ end
+ object CopyLink: TMenuItem
+ Caption = 'Copy &Link'
+ OnClick = CopyLinkClick
+ end
+ object N4: TMenuItem
+ Caption = '-'
+ end
+ object CopyText: TMenuItem
+ Caption = '&Copy'
+ ShortCut = 16451
+ OnClick = CopyTextClick
+ end
+ object CopyAll: TMenuItem
+ Caption = 'Copy All'
+ OnClick = CopyAllClick
+ end
+ object SelectAll: TMenuItem
+ Caption = 'Select &All'
+ ShortCut = 16449
+ OnClick = SelectAllClick
+ end
+ object N1: TMenuItem
+ Caption = '-'
+ end
+ object ToogleItemProcessing: TMenuItem
+ Caption = 'Text Formatting'
+ ShortCut = 16464
+ OnClick = ToogleItemProcessingClick
+ end
+ object N2: TMenuItem
+ Caption = '-'
+ end
+ object SendMessage1: TMenuItem
+ Caption = 'Send &Message'
+ ShortCut = 16461
+ OnClick = SendMessage1Click
+ end
+ object ReplyQuoted1: TMenuItem
+ Caption = '&Reply Quoted'
+ ShortCut = 16466
+ OnClick = ReplyQuoted1Click
+ end
+ end
+end
diff --git a/plugins/HistoryPlusPlus/EventDetailForm.pas b/plugins/HistoryPlusPlus/EventDetailForm.pas new file mode 100644 index 0000000000..9b7a793cec --- /dev/null +++ b/plugins/HistoryPlusPlus/EventDetailForm.pas @@ -0,0 +1,692 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+{ -----------------------------------------------------------------------------
+ EventDetailForm (historypp project)
+
+ Version: 1.4
+ Created: 31.03.2003
+ Author: Oxygen
+
+ [ Description ]
+
+ Form for details about event
+
+ [ History ]
+
+ 1.4
+ - Added horz scroll bar to memo
+
+ 1.0 (31.03.2003) - Initial version
+
+ [ Modifications ]
+ * (29.05.2003) Added scroll bar to memo
+
+ [ Knows Inssues ]
+ None
+
+ Contributors: theMIROn, Art Fedorov, Christian Kastner
+ ----------------------------------------------------------------------------- }
+
+unit EventDetailForm;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ StdCtrls, ExtCtrls,
+ HistoryGrid, HistoryForm,
+ m_api, hpp_messages,
+ hpp_global, hpp_contacts, hpp_events, hpp_forms, hpp_richedit,
+ ComCtrls,
+ Menus, RichEdit, Buttons, HistoryControls, ShellAPI;
+
+type
+
+ TEventDetailsFrm = class(TForm)
+ paBottom: TPanel;
+ Panel3: TPanel;
+ paInfo: TPanel;
+ GroupBox: THppGroupBox;
+ laType: TLabel;
+ laDateTime: TLabel;
+ EMsgType: THppEdit;
+ bnReply: TButton;
+ CloseBtn: TButton;
+ laFrom: TLabel;
+ laTo: TLabel;
+ EFrom: THppEdit;
+ ETo: THppEdit;
+ EText: THPPRichEdit;
+ pmEText: TPopupMenu;
+ CopyText: TMenuItem;
+ CopyAll: TMenuItem;
+ SelectAll: TMenuItem;
+ N1: TMenuItem;
+ ReplyQuoted1: TMenuItem;
+ SendMessage1: TMenuItem;
+ paText: TPanel;
+ N2: TMenuItem;
+ ToogleItemProcessing: TMenuItem;
+ EFromMore: TSpeedButton;
+ EDateTime: THppEdit;
+ EToMore: TSpeedButton;
+ PrevBtn: TSpeedButton;
+ NextBtn: TSpeedButton;
+ OpenLinkNW: TMenuItem;
+ OpenLink: TMenuItem;
+ CopyLink: TMenuItem;
+ N4: TMenuItem;
+ imDirection: TImage;
+ N3: TMenuItem;
+ BrowseReceivedFiles: TMenuItem;
+ OpenFileFolder: TMenuItem;
+ CopyFilename: TMenuItem;
+ procedure PrevBtnClick(Sender: TObject);
+ procedure NextBtnClick(Sender: TObject);
+ procedure EFromMoreClick(Sender: TObject);
+ procedure EToMoreClick(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure CloseBtnClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure bnReplyClick(Sender: TObject);
+ procedure pmETextPopup(Sender: TObject);
+ procedure SelectAllClick(Sender: TObject);
+ procedure CopyTextClick(Sender: TObject);
+ procedure CopyAllClick(Sender: TObject);
+ procedure SendMessage1Click(Sender: TObject);
+ procedure ReplyQuoted1Click(Sender: TObject);
+ procedure ToogleItemProcessingClick(Sender: TObject);
+ procedure ETextResizeRequest(Sender: TObject; Rect: TRect);
+ procedure OpenLinkNWClick(Sender: TObject);
+ procedure OpenLinkClick(Sender: TObject);
+ procedure CopyLinkClick(Sender: TObject);
+ procedure ETextMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
+ procedure BrowseReceivedFilesClick(Sender: TObject);
+ procedure OpenFileFolderClick(Sender: TObject);
+ procedure ETextURLClick(Sender: TObject; const URLText: String; Button: TMouseButton);
+ private
+ FParentForm: THistoryFrm;
+ FItem: Integer;
+ FRichHeight: Integer;
+ FOverURL: Boolean;
+ SavedLinkUrl: String;
+ FOverFile: Boolean;
+ SavedFileDir: String;
+ hSubContactFrom, hSubContactTo: THandle;
+ FNameFrom, FNameTo: String;
+ FProtocol: AnsiString;
+
+ procedure OnCNChar(var Message: TWMChar); message WM_CHAR;
+ procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
+ procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
+ procedure WMSysColorChange(var Message: TMessage); message WM_SYSCOLORCHANGE;
+ procedure LoadPosition;
+ procedure SavePosition;
+ procedure SetItem(const Value: Integer);
+ procedure TranslateForm;
+ procedure LoadButtonIcons;
+ procedure LoadMessageIcons;
+ { Private declarations }
+ procedure HMIconsChanged(var M: TMessage); message HM_NOTF_ICONSCHANGED;
+ procedure HMIcons2Changed(var M: TMessage); message HM_NOTF_ICONS2CHANGED;
+ procedure HMEventDeleted(var Message: TMessage); message HM_MIEV_EVENTDELETED;
+ function GetPrevItem: Integer;
+ function GetNextItem: Integer;
+ function IsFileEvent: Boolean;
+ protected
+ property PrevItem: Integer read GetPrevItem;
+ property NextItem: Integer read GetNextItem;
+ public
+ hContactTo, hContactFrom: THandle;
+ property ParentForm: THistoryFrm read FParentForm write FParentForm;
+ property Item: Integer read FItem write SetItem;
+ procedure ProcessRichEdit(const FItem: Integer);
+ procedure ResetItem;
+ end;
+
+var
+ EventDetailsFrm: TEventDetailsFrm;
+
+implementation
+
+uses hpp_database, hpp_options, hpp_services;
+
+{$R *.DFM}
+{ TForm1 }
+
+procedure TEventDetailsFrm.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
+begin
+ inherited;
+ with Message.MinMaxInfo^ do
+ begin
+ ptMinTrackSize.X := 376;
+ ptMinTrackSize.Y := 240;
+ end
+end;
+
+procedure TEventDetailsFrm.ProcessRichEdit(const FItem: Integer);
+var
+ ItemRenderDetails: TItemRenderDetails;
+begin
+ ZeroMemory(@ItemRenderDetails, SizeOf(ItemRenderDetails));
+ ItemRenderDetails.cbSize := SizeOf(ItemRenderDetails);
+ ItemRenderDetails.hContact := ParentForm.hContact;
+ ItemRenderDetails.hDBEvent := ParentForm.History[ParentForm.GridIndexToHistory(FItem)];
+ ItemRenderDetails.pProto := PAnsiChar(ParentForm.hg.Items[FItem].Proto);
+ ItemRenderDetails.pModule := PAnsiChar(ParentForm.hg.Items[FItem].Module);
+ ItemRenderDetails.pText := nil;
+ ItemRenderDetails.pExtended := PAnsiChar(ParentForm.hg.Items[FItem].Extended);
+ ItemRenderDetails.dwEventTime := ParentForm.hg.Items[FItem].Time;
+ ItemRenderDetails.wEventType := ParentForm.hg.Items[FItem].EventType;
+ ItemRenderDetails.IsEventSent := (mtOutgoing in ParentForm.hg.Items[FItem].MessageType);
+ { TODO: Add flag for special event details form treatment? }
+ ItemRenderDetails.dwFlags := ItemRenderDetails.dwFlags or IRDF_EVENT;
+ if ParentForm.hContact = 0 then
+ ItemRenderDetails.bHistoryWindow := IRDHW_GLOBALHISTORY
+ else
+ ItemRenderDetails.bHistoryWindow := IRDHW_CONTACTHISTORY;
+ NotifyEventHooks(hHppRichEditItemProcess, EText.Handle, LPARAM(@ItemRenderDetails));
+end;
+
+procedure TEventDetailsFrm.EFromMoreClick(Sender: TObject);
+begin
+ CallService(MS_USERINFO_SHOWDIALOG, hContactFrom, 0);
+end;
+
+procedure TEventDetailsFrm.EToMoreClick(Sender: TObject);
+begin
+ CallService(MS_USERINFO_SHOWDIALOG, hContactTo, 0);
+end;
+
+procedure TEventDetailsFrm.FormDestroy(Sender: TObject);
+begin
+ try
+ FParentForm.EventDetailForm := nil;
+ except
+ end;
+end;
+
+procedure TEventDetailsFrm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+var
+ Mask: Integer;
+begin
+ if IsFormShortCut([pmEText], Key, Shift) then
+ Key := 0;
+
+ with Sender as TWinControl do
+ begin
+ if Perform(CM_CHILDKEY, Key, LPARAM(Sender)) <> 0 then
+ Exit;
+ Mask := 0;
+ case Key of
+ VK_TAB:
+ Mask := DLGC_WANTTAB;
+ VK_RETURN, VK_EXECUTE, VK_ESCAPE, VK_CANCEL:
+ Mask := DLGC_WANTALLKEYS;
+ end;
+ if (Mask <> 0) and (Perform(CM_WANTSPECIALKEY, Key, 0) = 0) and
+ (Perform(WM_GETDLGCODE, 0, 0) and Mask = 0) and (Self.Perform(CM_DIALOGKEY, Key, 0) <> 0)
+ then
+ Exit;
+ end;
+end;
+
+procedure TEventDetailsFrm.OnCNChar(var Message: TWMChar);
+// make tabs work!
+begin
+ if not(csDesigning in ComponentState) then
+ with Message do
+ begin
+ Result := 1;
+ if (Perform(WM_GETDLGCODE, 0, 0) and DLGC_WANTCHARS = 0) and
+ (GetParentForm(Self).Perform(CM_DIALOGCHAR, CharCode, KeyData) <> 0) then
+ Exit;
+ Result := 0;
+ end;
+end;
+
+procedure TEventDetailsFrm.LoadPosition;
+begin
+ Utils_RestoreFormPosition(Self, 0, hppDBName, 'EventDetail.');
+end;
+
+procedure TEventDetailsFrm.SavePosition;
+begin
+ Utils_SaveFormPosition(Self, 0, hppDBName, 'EventDetail.');
+end;
+
+procedure TEventDetailsFrm.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+ Action := caFree;
+ SavePosition;
+end;
+
+procedure TEventDetailsFrm.CloseBtnClick(Sender: TObject);
+begin
+ SavePosition;
+ Self.Release;
+end;
+
+procedure TEventDetailsFrm.FormCreate(Sender: TObject);
+begin
+ Icon.ReleaseHandle;
+
+ DesktopFont := True;
+ MakeFontsParent(Self);
+
+ DoubleBuffered := True;
+ MakeDoubleBufferedParent(Self);
+
+ LoadButtonIcons;
+ TranslateForm;
+
+ LoadPosition;
+end;
+
+procedure TEventDetailsFrm.SetItem(const Value: Integer);
+var
+ FromContact, ToContact: Boolean;
+begin
+ Assert(Assigned(FParentForm));
+ if Value = -1 then
+ Exit;
+ FItem := Value;
+ EMsgType.Text := TranslateUnicodeString(GetEventRecord(FParentForm.hg.Items[FItem])
+ .Name { TRANSLATE-IGNORE } );
+ EMsgType.Text := Format('%s [%s/%u]', [EMsgType.Text, FParentForm.hg.Items[FItem].Module,
+ FParentForm.hg.Items[FItem].EventType]);
+ EDateTime.Text := TimestampToString(FParentForm.hg.Items[FItem].Time);
+ if FParentForm.hContact = 0 then
+ FProtocol := FParentForm.hg.Items[FItem].Proto
+ else
+ FProtocol := FParentForm.SubProtocol;
+ FromContact := false;
+ ToContact := false;
+ if mtIncoming in FParentForm.hg.Items[FItem].MessageType then
+ begin
+ hContactFrom := FParentForm.hContact;
+ hSubContactFrom := FParentForm.hSubContact;
+ hContactTo := 0;
+ hSubContactTo := 0;
+ FNameFrom := FParentForm.hg.ContactName;
+ FNameTo := GetContactDisplayName(0, FProtocol);
+ FromContact := (hContactFrom = 0);
+ end
+ else
+ begin
+ hContactFrom := 0;
+ hSubContactFrom := 0;
+ hContactTo := FParentForm.hContact;
+ hSubContactTo := FParentForm.hSubContact;
+ FNameFrom := GetContactDisplayName(0, FProtocol);
+ FNameTo := FParentForm.hg.ContactName;
+ ToContact := (hContactTo = 0);
+ end;
+
+ LoadMessageIcons;
+
+ EFromMore.Enabled := not FromContact;
+ EFrom.Text := FNameFrom;
+ if not FromContact then
+ EFrom.Text := EFrom.Text + ' (' + AnsiToWideString
+ (FProtocol + ': ' + GetContactID(hSubContactFrom, FProtocol, FromContact),
+ ParentForm.UserCodepage) + ')';
+ EToMore.Enabled := not ToContact;
+ ETo.Text := FNameTo;
+ if not ToContact then
+ ETo.Text := ETo.Text + ' (' + AnsiToWideString
+ (FProtocol + ': ' + GetContactID(hSubContactTo, FProtocol, ToContact),
+ ParentForm.UserCodepage) + ')';
+
+ EText.Lines.BeginUpdate;
+ ParentForm.hg.ApplyItemToRich(FItem, EText, True);
+ EText.Brush.Style := bsClear;
+ EText.SelStart := 0;
+ EText.SelLength := 0;
+
+ SendMessage(EText.Handle, EM_REQUESTRESIZE, 0, 0);
+ EText.Lines.EndUpdate;
+
+ if FromContact or ToContact then
+ bnReply.Enabled := false
+ else
+ bnReply.Enabled := True;
+
+ // check forward and back buttons
+ NextBtn.Enabled := (NextItem <> -1);
+ PrevBtn.Enabled := (PrevItem <> -1);
+
+ FOverFile := IsFileEvent;
+end;
+
+procedure TEventDetailsFrm.PrevBtnClick(Sender: TObject);
+begin
+ SetItem(PrevItem);
+ Assert(Assigned(FParentForm));
+ if FParentForm.hg.Selected <> FItem then
+ FParentForm.hg.Selected := FItem;
+end;
+
+procedure TEventDetailsFrm.NextBtnClick(Sender: TObject);
+begin
+ SetItem(NextItem);
+ Assert(Assigned(FParentForm));
+ if FParentForm.hg.Selected <> FItem then
+ FParentForm.hg.Selected := FItem;
+end;
+
+procedure TEventDetailsFrm.ResetItem;
+begin
+ SetItem(FItem);
+end;
+
+procedure TEventDetailsFrm.bnReplyClick(Sender: TObject);
+begin
+ FParentForm.ReplyQuoted(FItem);
+end;
+
+procedure TEventDetailsFrm.TranslateForm;
+begin
+ Caption := TranslateUnicodeString(Caption);
+ GroupBox.Caption := TranslateUnicodeString(GroupBox.Caption);
+ laType.Caption := TranslateUnicodeString(laType.Caption);
+ laDateTime.Caption := TranslateUnicodeString(laDateTime.Caption);
+ laFrom.Caption := TranslateUnicodeString(laFrom.Caption);
+ laTo.Caption := TranslateUnicodeString(laTo.Caption);
+ EFromMore.Hint := TranslateUnicodeString(EFromMore.Hint);
+ EToMore.Hint := TranslateUnicodeString(EToMore.Hint);
+ PrevBtn.Caption := TranslateUnicodeString(PrevBtn.Caption);
+ NextBtn.Caption := TranslateUnicodeString(NextBtn.Caption);
+ CloseBtn.Caption := TranslateUnicodeString(CloseBtn.Caption);
+ bnReply.Caption := TranslateUnicodeString(bnReply.Caption);
+ imDirection.Hint := TranslateUnicodeString(imDirection.Hint);
+ TranslateMenu(pmEText.Items);
+end;
+
+procedure TEventDetailsFrm.pmETextPopup(Sender: TObject);
+begin
+ CopyText.Enabled := (EText.SelLength > 0);
+ SendMessage1.Enabled := (ParentForm.hContact <> 0);
+ ReplyQuoted1.Enabled := (ParentForm.hContact <> 0);
+ ToogleItemProcessing.Checked := GridOptions.TextFormatting;
+ OpenLinkNW.Visible := FOverURL;
+ OpenLink.Visible := FOverURL;
+ CopyLink.Visible := FOverURL;
+ BrowseReceivedFiles.Visible := FOverFile and not FOverURL;
+ OpenFileFolder.Visible := FOverFile and not FOverURL and (SavedFileDir <> '');
+ CopyFilename.Visible := FOverFile and not FOverURL;
+end;
+
+procedure TEventDetailsFrm.SelectAllClick(Sender: TObject);
+begin
+ EText.SelectAll;
+end;
+
+procedure TEventDetailsFrm.CopyTextClick(Sender: TObject);
+begin
+ EText.CopyToClipboard;
+end;
+
+procedure TEventDetailsFrm.CopyAllClick(Sender: TObject);
+var
+ ss, sl: Integer;
+begin
+ // CopyToClip(EText.Lines.Text,Handle,ParentForm.UserCodepage);
+ EText.Lines.BeginUpdate;
+ ss := EText.SelStart;
+ sl := EText.SelLength;
+ EText.SelectAll;
+ EText.CopyToClipboard;
+ EText.SelStart := ss;
+ EText.SelLength := sl;
+ EText.Lines.EndUpdate;
+end;
+
+procedure TEventDetailsFrm.SendMessage1Click(Sender: TObject);
+begin
+ if ParentForm.hContact = 0 then
+ Exit;
+ SendMessageTo(ParentForm.hContact);
+end;
+
+procedure TEventDetailsFrm.ReplyQuoted1Click(Sender: TObject);
+begin
+ if ParentForm.hContact = 0 then
+ Exit;
+ FParentForm.ReplyQuoted(FItem);
+end;
+
+procedure TEventDetailsFrm.WMSetCursor(var Message: TWMSetCursor);
+var
+ p: TPoint;
+begin
+ if (FRichHeight > 0) and (Message.CursorWnd = EText.Handle) and (Message.HitTest = HTCLIENT)
+ then
+ begin
+ p := EText.ScreenToClient(Mouse.CursorPos);
+ if p.Y > FRichHeight then
+ begin
+ if Windows.GetCursor <> Screen.Cursors[crIBeam] then
+ Windows.SetCursor(Screen.Cursors[crIBeam]);
+ Message.Result := 1;
+ Exit;
+ end;
+ end;
+ inherited;
+end;
+
+procedure TEventDetailsFrm.ToogleItemProcessingClick(Sender: TObject);
+begin
+ GridOptions.TextFormatting := not GridOptions.TextFormatting;
+end;
+
+procedure TEventDetailsFrm.LoadButtonIcons;
+begin
+ with EFromMore.Glyph do
+ begin
+ Width := 16;
+ Height := 16;
+ Canvas.Brush.Color := clBtnFace;
+ Canvas.FillRect(Canvas.ClipRect);
+ DrawIconEx(Canvas.Handle, 0, 0, hppIcons[HPP_ICON_CONTACDETAILS].Handle, 16, 16, 0,
+ Canvas.Brush.Handle, DI_NORMAL);
+ end;
+ with EToMore.Glyph do
+ begin
+ Width := 16;
+ Height := 16;
+ Canvas.Brush.Color := clBtnFace;
+ Canvas.FillRect(Canvas.ClipRect);
+ DrawIconEx(Canvas.Handle, 0, 0, hppIcons[HPP_ICON_CONTACDETAILS].Handle, 16, 16, 0,
+ Canvas.Brush.Handle, DI_NORMAL);
+ end;
+ with PrevBtn.Glyph do
+ begin
+ PrevBtn.NumGlyphs := 2;
+ Width := 16 * 2;
+ Height := 16;
+ Canvas.Brush.Color := clBtnFace;
+ Canvas.FillRect(Canvas.ClipRect);
+ DrawIconEx(Canvas.Handle, 0, 0, hppIcons[HPP_ICON_SEARCHUP].Handle, 16, 16, 0,
+ Canvas.Brush.Handle, DI_NORMAL);
+ DrawState(Canvas.Handle, 0, nil, hppIcons[HPP_ICON_SEARCHUP].Handle, 0, 16, 0, 16, 16,
+ DST_ICON or DSS_DISABLED);
+ end;
+ with NextBtn.Glyph do
+ begin
+ NextBtn.NumGlyphs := 2;
+ Width := 16 * 2;
+ Height := 16;
+ Canvas.Brush.Color := clBtnFace;
+ Canvas.FillRect(Canvas.ClipRect);
+ DrawIconEx(Canvas.Handle, 0, 0, hppIcons[HPP_ICON_SEARCHDOWN].Handle, 16, 16, 0,
+ Canvas.Brush.Handle, DI_NORMAL);
+ DrawState(Canvas.Handle, 0, nil, hppIcons[HPP_ICON_SEARCHDOWN].Handle, 0, 16, 0, 16, 16,
+ DST_ICON or DSS_DISABLED);
+ end;
+end;
+
+procedure TEventDetailsFrm.LoadMessageIcons;
+var
+ ic: hIcon;
+ er: PEventRecord;
+begin
+ er := GetEventRecord(FParentForm.hg.Items[FItem]);
+ if er.i = -1 then
+ ic := 0
+ else if er.iSkin = -1 then
+ ic := hppIcons[er.i].Handle
+ else
+ ic := skinIcons[er.i].Handle;
+ if ic = 0 then
+ ic := hppIcons[HPP_ICON_CONTACTHISTORY].Handle;
+ Icon.Handle := CopyIcon(ic);
+ with imDirection.Picture.Bitmap do
+ begin
+ Width := 16;
+ Height := 16;
+ Canvas.Brush.Color := clBtnFace;
+ Canvas.FillRect(Canvas.ClipRect);
+ if mtIncoming in FParentForm.hg.Items[FItem].MessageType then
+ ic := hppIcons[EventRecords[mtIncoming].i].Handle
+ else if mtOutgoing in FParentForm.hg.Items[FItem].MessageType then
+ ic := hppIcons[EventRecords[mtOutgoing].i].Handle
+ else
+ Exit;
+ DrawIconEx(Canvas.Handle, 0, 0, ic, 16, 16, 0, Canvas.Brush.Handle, DI_NORMAL);
+ end;
+end;
+
+procedure TEventDetailsFrm.HMIconsChanged(var M: TMessage);
+begin
+ LoadMessageIcons;
+end;
+
+procedure TEventDetailsFrm.HMIcons2Changed(var M: TMessage);
+begin
+ LoadMessageIcons;
+ LoadButtonIcons;
+end;
+
+procedure TEventDetailsFrm.ETextResizeRequest(Sender: TObject; Rect: TRect);
+begin
+ FRichHeight := Rect.Bottom - Rect.Top;
+end;
+
+procedure TEventDetailsFrm.HMEventDeleted(var Message: TMessage);
+begin
+ if Cardinal(Message.WParam) = ParentForm.History[ParentForm.GridIndexToHistory(FItem)] then
+ Close;
+end;
+
+procedure TEventDetailsFrm.WMSysColorChange(var Message: TMessage);
+begin
+ inherited;
+ LoadMessageIcons;
+ LoadButtonIcons;
+ Repaint;
+end;
+
+procedure TEventDetailsFrm.OpenLinkNWClick(Sender: TObject);
+begin
+ if SavedLinkUrl = '' then
+ Exit;
+ OpenUrl(SavedLinkUrl, True);
+ SavedLinkUrl := '';
+end;
+
+procedure TEventDetailsFrm.OpenLinkClick(Sender: TObject);
+begin
+ if SavedLinkUrl = '' then
+ Exit;
+ OpenUrl(SavedLinkUrl, false);
+ SavedLinkUrl := '';
+end;
+
+procedure TEventDetailsFrm.CopyLinkClick(Sender: TObject);
+begin
+ if SavedLinkUrl = '' then
+ Exit;
+ CopyToClip(SavedLinkUrl, CP_ACP);
+ SavedLinkUrl := '';
+end;
+
+procedure TEventDetailsFrm.ETextMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
+begin
+ FOverURL := false;
+end;
+
+function TEventDetailsFrm.GetPrevItem: Integer;
+begin
+ if Assigned(FParentForm) then
+ Result := FParentForm.hg.GetPrev(FItem)
+ else
+ Result := -1;
+end;
+
+function TEventDetailsFrm.GetNextItem: Integer;
+begin
+ if Assigned(FParentForm) then
+ Result := FParentForm.hg.GetNext(FItem)
+ else
+ Result := -1;
+end;
+
+function TEventDetailsFrm.IsFileEvent: Boolean;
+begin
+ Result := Assigned(FParentForm) and (mtFile in FParentForm.hg.Items[FItem].MessageType);
+ if Result then
+ begin
+ // Auto CP_ACP usage
+ SavedLinkUrl := ExtractFileName(String(FParentForm.hg.Items[FItem].Extended));
+ SavedFileDir := ExtractFileDir(String(FParentForm.hg.Items[FItem].Extended));
+ end;
+end;
+
+procedure TEventDetailsFrm.OpenFileFolderClick(Sender: TObject);
+begin
+ if SavedFileDir = '' then
+ Exit;
+ ShellExecuteW(0, 'open', PChar(SavedFileDir), nil, nil, SW_SHOW);
+ SavedFileDir := '';
+end;
+
+procedure TEventDetailsFrm.BrowseReceivedFilesClick(Sender: TObject);
+var
+ Path: Array [0 .. MAX_PATH] of AnsiChar;
+begin
+ CallService(MS_FILE_GETRECEIVEDFILESFOLDER, FParentForm.hContact, LPARAM(@Path));
+ ShellExecuteA(0, 'open', Path, nil, nil, SW_SHOW);
+end;
+
+procedure TEventDetailsFrm.ETextURLClick(Sender: TObject; const URLText: String; Button: TMouseButton);
+begin
+ SavedLinkUrl := URLText;
+ case Button of
+ mbLeft : OpenLinkNW.Click;
+ mbRight: FOverURL := True;
+ end;
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/GlobalSearch.dfm b/plugins/HistoryPlusPlus/GlobalSearch.dfm new file mode 100644 index 0000000000..8ba4c9419d --- /dev/null +++ b/plugins/HistoryPlusPlus/GlobalSearch.dfm @@ -0,0 +1,915 @@ +object fmGlobalSearch: TfmGlobalSearch
+ Left = 259
+ Top = 118
+ Width = 559
+ Height = 544
+ Caption = 'Global History Search'
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'MS Sans Serif'
+ Font.Style = []
+ KeyPreview = True
+ OldCreateOrder = False
+ ShowHint = True
+ OnClose = FormClose
+ OnCloseQuery = FormCloseQuery
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnKeyDown = FormKeyDown
+ OnMouseWheel = FormMouseWheel
+ OnShow = FormShow
+ PixelsPerInch = 96
+ TextHeight = 13
+ object paClient: TPanel
+ Left = 0
+ Top = 0
+ Width = 551
+ Height = 493
+ Align = alClient
+ BevelOuter = bvNone
+ BorderWidth = 2
+ TabOrder = 0
+ object spContacts: TSplitter
+ Left = 157
+ Top = 248
+ Height = 189
+ ResizeStyle = rsUpdate
+ Visible = False
+ end
+ object paSearch: TPanel
+ Left = 2
+ Top = 32
+ Width = 547
+ Height = 32
+ Align = alTop
+ BevelOuter = bvNone
+ TabOrder = 5
+ DesignSize = (
+ 547
+ 32)
+ object laSearch: TLabel
+ Left = 4
+ Top = 10
+ Width = 49
+ Height = 13
+ Caption = 'Search for'
+ FocusControl = edSearch
+ Transparent = True
+ end
+ object edSearch: THppEdit
+ Left = 70
+ Top = 6
+ Width = 374
+ Height = 21
+ Anchors = [akLeft, akTop, akRight]
+ TabOrder = 0
+ OnChange = edSearchChange
+ OnEnter = edSearchEnter
+ OnKeyDown = edSearchKeyUp
+ OnKeyPress = edSearchKeyPress
+ end
+ object bnSearch: TButton
+ Left = 450
+ Top = 5
+ Width = 89
+ Height = 23
+ Anchors = [akTop, akRight]
+ Caption = 'Search'
+ Enabled = False
+ TabOrder = 1
+ OnClick = bnSearchClick
+ end
+ end
+ object paProgress: TPanel
+ Left = 2
+ Top = 437
+ Width = 547
+ Height = 54
+ Align = alBottom
+ BevelInner = bvRaised
+ BevelOuter = bvLowered
+ TabOrder = 3
+ Visible = False
+ DesignSize = (
+ 547
+ 54)
+ object laProgress: TLabel
+ Left = 12
+ Top = 7
+ Width = 519
+ Height = 13
+ Alignment = taCenter
+ Anchors = [akLeft, akTop, akRight]
+ AutoSize = False
+ Caption = '-'
+ Transparent = True
+ end
+ object pb: TProgressBar
+ Left = 12
+ Top = 29
+ Width = 519
+ Height = 16
+ Anchors = [akLeft, akRight, akBottom]
+ Position = 34
+ TabOrder = 0
+ end
+ end
+ object paPassword: TPanel
+ Left = 2
+ Top = 202
+ Width = 547
+ Height = 46
+ Align = alTop
+ BevelOuter = bvNone
+ TabOrder = 1
+ Visible = False
+ DesignSize = (
+ 547
+ 46)
+ object bePassword: TBevel
+ Left = 12
+ Top = 10
+ Width = 519
+ Height = 5
+ Anchors = [akLeft, akTop, akRight]
+ Shape = bsTopLine
+ end
+ object laPass: TLabel
+ Left = 8
+ Top = 25
+ Width = 49
+ Height = 13
+ Caption = 'Password:'
+ end
+ object laPasswordHead: TLabel
+ Left = 4
+ Top = 4
+ Width = 154
+ Height = 13
+ Caption = 'Search Protected Contacts'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'MS Sans Serif'
+ Font.Style = [fsBold]
+ ParentFont = False
+ Transparent = False
+ end
+ object sbPasswordClose: TSpeedButton
+ Left = 521
+ Top = 2
+ Width = 18
+ Height = 17
+ Anchors = [akTop, akRight]
+ Flat = True
+ Transparent = False
+ OnClick = sbPasswordCloseClick
+ end
+ object laPassNote: TLabel
+ Caption = ''
+ Left = 199
+ Top = 25
+ Width = 3
+ Height = 13
+ end
+ object edPass: TEdit
+ Left = 65
+ Top = 21
+ Width = 125
+ Height = 21
+ TabOrder = 0
+ PasswordChar = '*'
+ OnKeyDown = edSearchKeyUp
+ OnKeyPress = edPassKeyPress
+ end
+ end
+ object paContacts: TPanel
+ Left = 2
+ Top = 248
+ Width = 155
+ Height = 189
+ Align = alLeft
+ BevelOuter = bvNone
+ TabOrder = 2
+ Visible = False
+ object lvContacts: TListView
+ Left = 0
+ Top = 0
+ Width = 155
+ Height = 189
+ Align = alClient
+ Columns = <
+ item
+ Width = -1
+ WidthType = (
+ -1)
+ end>
+ ColumnClick = False
+ FlatScrollBars = True
+ ReadOnly = True
+ RowSelect = True
+ ShowColumnHeaders = False
+ SmallImages = ilContacts
+ TabOrder = 0
+ ViewStyle = vsReport
+ OnContextPopup = lvContactsContextPopup
+ OnDblClick = lvContactsDblClick
+ OnSelectItem = lvContactsSelectItem
+ end
+ end
+ object paHistory: TPanel
+ Left = 160
+ Top = 248
+ Width = 389
+ Height = 189
+ Align = alClient
+ BevelOuter = bvNone
+ TabOrder = 4
+ object hg: THistoryGrid
+ Left = 0
+ Top = 0
+ Width = 389
+ Height = 161
+ VertScrollBar.Increment = 1
+ ShowBottomAligned = False
+ ShowBookmarks = True
+ MultiSelect = True
+ ShowHeaders = False
+ ExpandHeaders = False
+ TxtStartup = 'Starting up...'
+ TxtNoItems = 'No items found'
+ TxtNoSuch = 'No items for your current filter'
+ TxtFullLog = 'Full History Log'
+ TxtPartLog = 'Partial History Log'
+ TxtHistExport = 'History++ export'
+ TxtGenHist1 = '### (generated by history++ plugin)'
+ TxtGenHist2 = '<h6>Generated by <b>History++</b> Plugin</h6>'
+ TxtSessions = 'Conversation started at %s'
+ OnDblClick = hgDblClick
+ OnItemData = hgItemData
+ OnNameData = hgNameData
+ OnPopup = hgPopup
+ OnTranslateTime = hgTranslateTime
+ OnSearchFinished = hgSearchFinished
+ OnItemDelete = hgItemDelete
+ OnKeyDown = hgKeyDown
+ OnKeyUp = hgKeyUp
+ OnInlineKeyDown = hgInlineKeyDown
+ OnInlinePopup = hgInlinePopup
+ OnChar = hgChar
+ OnState = hgState
+ OnSelect = hgSelect
+ OnRTLChange = hgRTLEnabled
+ OnUrlClick = hgUrlClick
+ OnBookmarkClick = hgBookmarkClick
+ OnItemFilter = hgItemFilter
+ OnProcessRichText = hgProcessRichText
+ OnSearchItem = hgSearchItem
+ Reversed = False
+ ReversedHeader = False
+ Align = alClient
+ TabStop = True
+ BevelInner = bvNone
+ BevelOuter = bvNone
+ Padding = 4
+ HideScrollBar = False
+ ShowHint = True
+ end
+ object paFilter: TPanel
+ Left = 0
+ Top = 161
+ Width = 389
+ Height = 28
+ Align = alBottom
+ BevelOuter = bvNone
+ TabOrder = 1
+ DesignSize = (
+ 389
+ 28)
+ object sbClearFilter: TSpeedButton
+ Left = 27
+ Top = 4
+ Width = 23
+ Height = 21
+ Hint = 'Clear Search'
+ Flat = True
+ OnClick = sbClearFilterClick
+ end
+ object pbFilter: TPaintBox
+ Left = 6
+ Top = 6
+ Width = 16
+ Height = 16
+ OnPaint = pbFilterPaint
+ end
+ object edFilter: THppEdit
+ Left = 52
+ Top = 4
+ Width = 319
+ Height = 21
+ Anchors = [akLeft, akTop, akRight]
+ TabOrder = 0
+ OnChange = edFilterChange
+ OnKeyDown = edFilterKeyDown
+ OnKeyPress = edFilterKeyPress
+ OnKeyUp = edFilterKeyUp
+ end
+ end
+ end
+ object paAdvanced: TPanel
+ Left = 2
+ Top = 64
+ Width = 547
+ Height = 46
+ Align = alTop
+ BevelOuter = bvNone
+ TabOrder = 6
+ Visible = False
+ DesignSize = (
+ 547
+ 46)
+ object beAdvanced: TBevel
+ Left = 16
+ Top = 10
+ Width = 515
+ Height = 5
+ Anchors = [akLeft, akTop, akRight]
+ Shape = bsTopLine
+ end
+ object laAdvancedHead: TLabel
+ Left = 4
+ Top = 4
+ Width = 149
+ Height = 13
+ Caption = 'Advanced Search Options'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'MS Sans Serif'
+ Font.Style = [fsBold]
+ ParentFont = False
+ Transparent = False
+ end
+ object sbAdvancedClose: TSpeedButton
+ Left = 521
+ Top = 2
+ Width = 18
+ Height = 17
+ Anchors = [akTop, akRight]
+ Flat = True
+ Transparent = False
+ OnClick = sbAdvancedCloseClick
+ end
+ object rbAny: TRadioButton
+ Left = 8
+ Top = 24
+ Width = 155
+ Height = 17
+ Caption = 'Search any word'
+ Checked = True
+ TabOrder = 0
+ TabStop = True
+ end
+ object rbAll: TRadioButton
+ Left = 169
+ Top = 24
+ Width = 156
+ Height = 17
+ Caption = 'Search all words'
+ TabOrder = 1
+ end
+ object rbExact: TRadioButton
+ Left = 331
+ Top = 24
+ Width = 163
+ Height = 17
+ Caption = 'Search exact phrase'
+ TabOrder = 2
+ end
+ end
+ object paRange: TPanel
+ Left = 2
+ Top = 156
+ Width = 547
+ Height = 46
+ Align = alTop
+ BevelOuter = bvNone
+ TabOrder = 7
+ Visible = False
+ DesignSize = (
+ 547
+ 46)
+ object laRange1: TLabel
+ Left = 8
+ Top = 25
+ Width = 126
+ Height = 13
+ AutoSize = False
+ Caption = 'Search messages from'
+ Transparent = True
+ end
+ object laRange2: TLabel
+ Left = 223
+ Top = 25
+ Width = 38
+ Height = 13
+ Alignment = taCenter
+ AutoSize = False
+ Caption = 'to'
+ end
+ object beRange: TBevel
+ Left = 16
+ Top = 10
+ Width = 515
+ Height = 5
+ Anchors = [akLeft, akTop, akRight]
+ Shape = bsTopLine
+ end
+ object laRangeHead: TLabel
+ Left = 4
+ Top = 4
+ Width = 112
+ Height = 13
+ Caption = 'Limit Search Range'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'MS Sans Serif'
+ Font.Style = [fsBold]
+ ParentFont = False
+ Transparent = False
+ end
+ object sbRangeClose: TSpeedButton
+ Left = 521
+ Top = 2
+ Width = 18
+ Height = 17
+ Anchors = [akTop, akRight]
+ Flat = True
+ Transparent = False
+ OnClick = sbRangeCloseClick
+ end
+ object dtRange1: TDateTimePicker
+ Left = 135
+ Top = 21
+ Width = 87
+ Height = 21
+ BiDiMode = bdLeftToRight
+ Date = 29221.000000000000000000
+ Time = 29221.000000000000000000
+ ParentBiDiMode = False
+ TabOrder = 0
+ end
+ object dtRange2: TDateTimePicker
+ Left = 262
+ Top = 22
+ Width = 87
+ Height = 21
+ BiDiMode = bdLeftToRight
+ Date = 29221.999988425930000000
+ Time = 29221.999988425930000000
+ ParentBiDiMode = False
+ TabOrder = 1
+ end
+ end
+ object TopPanel: TPanel
+ Left = 2
+ Top = 2
+ Width = 547
+ Height = 30
+ Align = alTop
+ AutoSize = True
+ BevelOuter = bvNone
+ TabOrder = 0
+ object ToolBar: THppToolBar
+ Left = 0
+ Top = 0
+ Width = 547
+ Height = 30
+ AutoSize = True
+ BorderWidth = 2
+ EdgeBorders = []
+ Flat = True
+ Images = ilToolbar
+ TabOrder = 0
+ Transparent = True
+ object tbAdvanced: THppToolButton
+ Left = 0
+ Top = 0
+ Hint = 'Advanced search options'
+ HelpKeyword = 'F4'
+ Caption = 'Advanced search options'
+ Style = tbsCheck
+ OnClick = tbAdvancedClick
+ end
+ object tbRange: THppToolButton
+ Left = 23
+ Top = 0
+ Hint = 'Limit search range'
+ HelpKeyword = 'F5'
+ Caption = 'Limit search range'
+ Style = tbsCheck
+ OnClick = tbRangeClick
+ end
+ object tbEvents: THppToolButton
+ Left = 46
+ Top = 0
+ Hint = 'Limit event types'
+ HelpKeyword = 'F6'
+ Caption = 'Limit event types'
+ Style = tbsCheck
+ OnClick = tbEventsClick
+ end
+ object tbPassword: THppToolButton
+ Left = 69
+ Top = 0
+ Hint = 'Search protected contacts'
+ HelpKeyword = 'F7'
+ Caption = 'Search protected contacts'
+ Style = tbsCheck
+ OnClick = tbPasswordClick
+ end
+ object ToolButton1: THppToolButton
+ Left = 92
+ Top = 0
+ Width = 8
+ Style = tbsSeparator
+ end
+ object tbBookmarks: THppToolButton
+ Left = 100
+ Top = 0
+ Hint = 'Bookmarks'
+ HelpKeyword = 'F9'
+ Caption = 'Bookmarks'
+ Style = tbsCheck
+ OnClick = tbBookmarksClick
+ end
+ object ToolButton2: THppToolButton
+ Left = 123
+ Top = 0
+ Width = 8
+ Style = tbsSeparator
+ end
+ object tbSearch: THppToolButton
+ Left = 131
+ Top = 0
+ Caption = 'Find'
+ Grouped = True
+ Style = tbsCheck
+ Visible = False
+ end
+ object tbFilter: THppToolButton
+ Left = 154
+ Top = 0
+ Caption = 'Filter'
+ Grouped = True
+ Style = tbsCheck
+ Visible = False
+ end
+ object ToolButton3: THppToolButton
+ Left = 177
+ Top = 0
+ Width = 8
+ Style = tbsSeparator
+ Visible = False
+ end
+ object tbEventsFilter: TSpeedButton
+ Left = 185
+ Top = 0
+ Width = 110
+ Height = 22
+ Enabled = False
+ Flat = True
+ Layout = blGlyphTop
+ PopupMenu = pmEventsFilter
+ Spacing = -5
+ Transparent = False
+ OnClick = tbEventsFilterClick
+ end
+ object ToolButton4: THppToolButton
+ Left = 295
+ Top = 0
+ Width = 8
+ Style = tbsSeparator
+ end
+ object tbCopy: THppToolButton
+ Left = 303
+ Top = 0
+ Hint = 'Copy'
+ Caption = 'Copy'
+ OnClick = tbCopyClick
+ end
+ object tbDelete: THppToolButton
+ Left = 326
+ Top = 0
+ Hint = 'Delete'
+ Caption = 'Delete'
+ OnClick = tbDeleteClick
+ end
+ object tbSave: THppToolButton
+ Left = 349
+ Top = 0
+ Hint = 'Save'
+ Caption = 'Save'
+ OnClick = tbSaveClick
+ end
+ end
+ end
+ object paEvents: TPanel
+ Left = 2
+ Top = 110
+ Width = 547
+ Height = 46
+ Align = alTop
+ BevelOuter = bvNone
+ TabOrder = 8
+ Visible = False
+ DesignSize = (
+ 547
+ 46)
+ object laEvents: TLabel
+ Left = 8
+ Top = 25
+ Width = 145
+ Height = 13
+ AutoSize = False
+ Caption = 'Search messages matched to'
+ Transparent = True
+ end
+ object beEvents: TBevel
+ Left = 16
+ Top = 10
+ Width = 515
+ Height = 5
+ Anchors = [akLeft, akTop, akRight]
+ Shape = bsTopLine
+ end
+ object laEventsHead: TLabel
+ Left = 4
+ Top = 4
+ Width = 102
+ Height = 13
+ Caption = 'Limit Event Types'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'MS Sans Serif'
+ Font.Style = [fsBold]
+ ParentFont = False
+ Transparent = False
+ end
+ object sbEventsClose: TSpeedButton
+ Left = 521
+ Top = 2
+ Width = 18
+ Height = 17
+ Anchors = [akTop, akRight]
+ Flat = True
+ Transparent = False
+ OnClick = sbEventsCloseClick
+ end
+ object cbEvents: TComboBox
+ Left = 159
+ Top = 21
+ Width = 214
+ Height = 21
+ AutoCloseUp = True
+ Style = csDropDownList
+ BiDiMode = bdLeftToRight
+ ItemHeight = 13
+ ParentBiDiMode = False
+ TabOrder = 0
+ end
+ end
+ end
+ object sb: TStatusBar
+ Left = 0
+ Top = 493
+ Width = 551
+ Height = 19
+ Panels = <>
+ SimplePanel = True
+ end
+ object pmGrid: TPopupMenu
+ BiDiMode = bdLeftToRight
+ ParentBiDiMode = False
+ Left = 206
+ Top = 266
+ object Open1: TMenuItem
+ Caption = 'Sh&ow in context'
+ OnClick = hgDblClick
+ end
+ object Bookmark1: TMenuItem
+ Caption = 'Set &Bookmark'
+ ShortCut = 16450
+ OnClick = Bookmark1Click
+ end
+ object SpeakMessage1: TMenuItem
+ Caption = 'Speak Message'
+ OnClick = SpeakMessage1Click
+ end
+ object N3: TMenuItem
+ Caption = '-'
+ end
+ object SendMessage1: TMenuItem
+ Caption = 'Send &Message'
+ ShortCut = 16461
+ OnClick = SendMessage1Click
+ end
+ object ReplyQuoted1: TMenuItem
+ Caption = 'Reply &Quoted'
+ ShortCut = 16466
+ OnClick = ReplyQuoted1Click
+ end
+ object N2: TMenuItem
+ Caption = '-'
+ end
+ object Copy1: TMenuItem
+ Caption = '&Copy'
+ ShortCut = 16451
+ OnClick = tbCopyClick
+ end
+ object CopyText1: TMenuItem
+ Caption = 'Copy &Text'
+ ShortCut = 16468
+ OnClick = CopyText1Click
+ end
+ object Delete1: TMenuItem
+ Caption = '&Delete'
+ ShortCut = 46
+ OnClick = tbDeleteClick
+ end
+ object N1: TMenuItem
+ Caption = '-'
+ Visible = False
+ end
+ object SaveSelected1: TMenuItem
+ Caption = '&Save Selected...'
+ ShortCut = 16467
+ OnClick = tbSaveClick
+ end
+ object N5: TMenuItem
+ Caption = '-'
+ Visible = False
+ end
+ object SelectAll1: TMenuItem
+ Caption = 'Select &All'
+ ShortCut = 16449
+ Visible = False
+ OnClick = SelectAll1Click
+ end
+ end
+ object ilContacts: TImageList
+ ShareImages = True
+ Left = 470
+ Top = 262
+ end
+ object SaveDialog: TSaveDialog
+ FilterIndex = 0
+ Options = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofShareAware, ofEnableSizing]
+ Title = 'Save History'
+ Left = 506
+ Top = 260
+ end
+ object tiFilter: TTimer
+ Enabled = False
+ Interval = 300
+ OnTimer = tiFilterTimer
+ Left = 352
+ Top = 376
+ end
+ object ilToolbar: TImageList
+ Left = 520
+ Top = 2
+ end
+ object pmEventsFilter: TPopupMenu
+ OnPopup = pmEventsFilterPopup
+ Left = 450
+ Top = 2
+ object N4: TMenuItem
+ Caption = '-'
+ end
+ object Customize1: TMenuItem
+ Caption = '&Customize...'
+ OnClick = Customize1Click
+ end
+ end
+ object pmInline: TPopupMenu
+ BiDiMode = bdLeftToRight
+ ParentBiDiMode = False
+ Left = 204
+ Top = 301
+ object InlineCopy: TMenuItem
+ Caption = '&Copy'
+ ShortCut = 16451
+ OnClick = InlineCopyClick
+ end
+ object InlineCopyAll: TMenuItem
+ Caption = 'Copy &Text'
+ ShortCut = 16468
+ OnClick = InlineCopyAllClick
+ end
+ object InlineSelectAll: TMenuItem
+ Caption = 'Select &All'
+ ShortCut = 16449
+ OnClick = InlineSelectAllClick
+ end
+ object MenuItem10: TMenuItem
+ Caption = '-'
+ end
+ object InlineTextFormatting: TMenuItem
+ Caption = 'Text Formatting'
+ ShortCut = 16464
+ OnClick = InlineTextFormattingClick
+ end
+ object MenuItem6: TMenuItem
+ Caption = '-'
+ end
+ object InlineSendMessage: TMenuItem
+ Caption = 'Send &Message'
+ ShortCut = 16461
+ OnClick = SendMessage1Click
+ end
+ object InlineReplyQuoted: TMenuItem
+ Caption = '&Reply Quoted'
+ ShortCut = 16466
+ OnClick = InlineReplyQuotedClick
+ end
+ end
+ object pmLink: TPopupMenu
+ BiDiMode = bdLeftToRight
+ ParentBiDiMode = False
+ Left = 244
+ Top = 266
+ object OpenLinkNW: TMenuItem
+ Caption = 'Open in &new window'
+ Default = True
+ OnClick = OpenLinkNWClick
+ end
+ object OpenLink: TMenuItem
+ Caption = '&Open in existing window'
+ OnClick = OpenLinkClick
+ end
+ object MenuItem2: TMenuItem
+ Caption = '-'
+ end
+ object CopyLink: TMenuItem
+ Caption = '&Copy Link'
+ OnClick = CopyLinkClick
+ end
+ end
+ object mmAcc: TMainMenu
+ Left = 482
+ Top = 2
+ object mmToolbar: TMenuItem
+ Caption = 'Toolbar'
+ OnClick = mmToolbarClick
+ end
+ object mmService: TMenuItem
+ Caption = 'Service'
+ object mmHideMenu: TMenuItem
+ Caption = 'Hide Menu'
+ ShortCut = 16505
+ OnClick = mmHideMenuClick
+ end
+ end
+ object mmShortcuts: TMenuItem
+ Caption = '--'
+ Visible = False
+ object mmBookmark: TMenuItem
+ Caption = '--'
+ ShortCut = 16450
+ OnClick = Bookmark1Click
+ end
+ end
+ end
+ object pmFile: TPopupMenu
+ BiDiMode = bdLeftToRight
+ ParentBiDiMode = False
+ Left = 244
+ Top = 302
+ object N7: TMenuItem
+ Caption = '-'
+ end
+ object FileActions: TMenuItem
+ Caption = '&File Actions'
+ object BrowseReceivedFiles: TMenuItem
+ Caption = '&Browse Received Files'
+ OnClick = BrowseReceivedFilesClick
+ end
+ object OpenFileFolder: TMenuItem
+ Caption = '&Open file folder'
+ OnClick = OpenFileFolderClick
+ end
+ object N6: TMenuItem
+ Caption = '-'
+ end
+ object CopyFilename: TMenuItem
+ Caption = '&Copy Filename'
+ OnClick = CopyLinkClick
+ end
+ end
+ end
+end
diff --git a/plugins/HistoryPlusPlus/GlobalSearch.pas b/plugins/HistoryPlusPlus/GlobalSearch.pas new file mode 100644 index 0000000000..0294f6124d --- /dev/null +++ b/plugins/HistoryPlusPlus/GlobalSearch.pas @@ -0,0 +1,2668 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+{ -----------------------------------------------------------------------------
+ GlobalSearch (historypp project)
+
+ Version: 1.0
+ Created: 05.08.2004
+ Author: Oxygen
+
+ [ Description ]
+
+ Here we have the form and UI for global searching. Curious
+ can go to hpp_searchthread for internals of searching.
+
+ [ History ]
+
+ 1.5 (05.08.2004)
+ First version
+
+ [ Modifications ]
+ none
+
+ [ Known Issues ]
+
+ * When doing HotSearch, and then backspacing to empty search AnsiString
+ grid doesn't return to the first item HotSearch started from
+ unlike in HistoryForm. Probably shouldn't be done, because too much checking
+ to reset LastHotIdx should be done, considering how much filtering &
+ sorting is performed.
+
+ Contributors: theMIROn, Art Fedorov
+ ----------------------------------------------------------------------------- }
+
+unit GlobalSearch;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ StdCtrls, ExtCtrls, ComCtrls, Menus,
+ HistoryGrid,
+ m_api,
+ hpp_global, hpp_events, hpp_services, hpp_contacts, hpp_database, hpp_searchthread,
+ hpp_eventfilters, hpp_bookmarks, hpp_richedit, RichEdit,
+ ImgList, HistoryControls, Buttons, Math, CommCtrl,
+ Contnrs, hpp_forms, ToolWin, ShellAPI;
+
+const
+ HM_SRCH_CONTACTICONCHANGED = HM_SRCH_BASE + 3;
+
+type
+ THPPContactInfo = class(TObject)
+ public
+ Proto: AnsiString;
+ Codepage: Cardinal;
+ RTLMode: TRTLMode;
+ Name: String;
+ ProfileName: String;
+ Handle: THandle;
+ end;
+
+ TSearchItem = record
+ hDBEvent: THandle;
+ Contact: THPPContactInfo;
+ end;
+
+ TfmGlobalSearch = class(TForm)
+ paClient: TPanel;
+ paSearch: TPanel;
+ laSearch: TLabel;
+ edSearch: THppEdit;
+ bnSearch: TButton;
+ sb: TStatusBar;
+ paProgress: TPanel;
+ pb: TProgressBar;
+ laProgress: TLabel;
+ pmGrid: TPopupMenu;
+ Open1: TMenuItem;
+ Copy1: TMenuItem;
+ CopyText1: TMenuItem;
+ N1: TMenuItem;
+ N2: TMenuItem;
+ spContacts: TSplitter;
+ paPassword: TPanel;
+ edPass: TEdit;
+ laPass: TLabel;
+ ilContacts: TImageList;
+ paContacts: TPanel;
+ lvContacts: TListView;
+ SendMessage1: TMenuItem;
+ ReplyQuoted1: TMenuItem;
+ SaveSelected1: TMenuItem;
+ SaveDialog: TSaveDialog;
+ tiFilter: TTimer;
+ paHistory: TPanel;
+ hg: THistoryGrid;
+ paFilter: TPanel;
+ sbClearFilter: TSpeedButton;
+ edFilter: THppEdit;
+ pbFilter: TPaintBox;
+ Delete1: TMenuItem;
+ N3: TMenuItem;
+ Bookmark1: TMenuItem;
+ ToolBar: THppToolBar;
+ tbPassword: THppToolButton;
+ paAdvanced: TPanel;
+ paRange: TPanel;
+ rbAny: TRadioButton;
+ rbAll: TRadioButton;
+ rbExact: TRadioButton;
+ laAdvancedHead: TLabel;
+ sbAdvancedClose: TSpeedButton;
+ sbRangeClose: TSpeedButton;
+ sbPasswordClose: TSpeedButton;
+ dtRange1: TDateTimePicker;
+ laRange1: TLabel;
+ laRange2: TLabel;
+ dtRange2: TDateTimePicker;
+ laPasswordHead: TLabel;
+ laRangeHead: TLabel;
+ tbEventsFilter: TSpeedButton;
+ tbAdvanced: THppToolButton;
+ tbRange: THppToolButton;
+ ToolButton2: THppToolButton;
+ ilToolbar: TImageList;
+ bePassword: TBevel;
+ beRange: TBevel;
+ beAdvanced: TBevel;
+ ToolButton3: THppToolButton;
+ tbSearch: THppToolButton;
+ tbFilter: THppToolButton;
+ laPassNote: TLabel;
+ pmEventsFilter: TPopupMenu;
+ N4: TMenuItem;
+ Customize1: TMenuItem;
+ pmInline: TPopupMenu;
+ InlineCopy: TMenuItem;
+ InlineCopyAll: TMenuItem;
+ InlineSelectAll: TMenuItem;
+ MenuItem10: TMenuItem;
+ InlineTextFormatting: TMenuItem;
+ MenuItem6: TMenuItem;
+ InlineSendMessage: TMenuItem;
+ InlineReplyQuoted: TMenuItem;
+ pmLink: TPopupMenu;
+ OpenLink: TMenuItem;
+ OpenLinkNW: TMenuItem;
+ MenuItem2: TMenuItem;
+ CopyLink: TMenuItem;
+ mmAcc: TMainMenu;
+ mmToolbar: TMenuItem;
+ mmService: TMenuItem;
+ mmHideMenu: TMenuItem;
+ mmShortcuts: TMenuItem;
+ mmBookmark: TMenuItem;
+ tbBookmarks: THppToolButton;
+ ToolButton1: THppToolButton;
+ TopPanel: TPanel;
+ N5: TMenuItem;
+ SelectAll1: TMenuItem;
+ pmFile: TPopupMenu;
+ FileActions: TMenuItem;
+ BrowseReceivedFiles: TMenuItem;
+ OpenFileFolder: TMenuItem;
+ N6: TMenuItem;
+ CopyFilename: TMenuItem;
+ N7: TMenuItem;
+ paEvents: TPanel;
+ laEvents: TLabel;
+ beEvents: TBevel;
+ laEventsHead: TLabel;
+ sbEventsClose: TSpeedButton;
+ tbEvents: THppToolButton;
+ cbEvents: TComboBox;
+ ToolButton4: THppToolButton;
+ tbCopy: THppToolButton;
+ tbDelete: THppToolButton;
+ tbSave: THppToolButton;
+ SpeakMessage1: TMenuItem;
+ procedure pbFilterPaint(Sender: TObject);
+ procedure edFilterKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure tiFilterTimer(Sender: TObject);
+ procedure sbClearFilterClick(Sender: TObject);
+ procedure edPassKeyPress(Sender: TObject; var Key: Char);
+ procedure edSearchKeyPress(Sender: TObject; var Key: Char);
+ procedure hgItemDelete(Sender: TObject; Index: Integer);
+ procedure OnCNChar(var Message: TWMChar); message WM_CHAR;
+ procedure tbSaveClick(Sender: TObject);
+ procedure hgPopup(Sender: TObject);
+ procedure ReplyQuoted1Click(Sender: TObject);
+ procedure SendMessage1Click(Sender: TObject);
+ procedure edFilterKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure hgItemFilter(Sender: TObject; Index: Integer; var Show: Boolean);
+ procedure edFilterChange(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure edSearchChange(Sender: TObject);
+ procedure hgKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure hgState(Sender: TObject; State: TGridState);
+ procedure hgSearchFinished(Sender: TObject; Text: String; Found: Boolean);
+ procedure hgSearchItem(Sender: TObject; Item, ID: Integer; var Found: Boolean);
+ // procedure FormHide(Sender: TObject);
+ procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer;
+ MousePos: TPoint; var Handled: Boolean);
+ procedure lvContactsSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
+ procedure hgNameData(Sender: TObject; Index: Integer; var Name: String);
+ procedure hgTranslateTime(Sender: TObject; Time: Cardinal; var Text: String);
+ procedure FormCreate(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure bnSearchClick(Sender: TObject);
+ procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+ procedure hgItemData(Sender: TObject; Index: Integer; var Item: THistoryItem);
+ procedure hgDblClick(Sender: TObject);
+ procedure edSearchEnter(Sender: TObject);
+ procedure edSearchKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure hgProcessRichText(Sender: TObject; Handle: Cardinal; Item: Integer);
+ procedure FormShow(Sender: TObject);
+ procedure hgKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure hgUrlClick(Sender: TObject; Item: Integer; URLText: String; Button: TMouseButton);
+ procedure edPassKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure hgSelect(Sender: TObject; Item, OldItem: Integer);
+ procedure tbCopyClick(Sender: TObject);
+ procedure CopyText1Click(Sender: TObject);
+ procedure tbDeleteClick(Sender: TObject);
+ procedure hgRTLEnabled(Sender: TObject; BiDiMode: TBiDiMode);
+ procedure Bookmark1Click(Sender: TObject);
+ procedure hgBookmarkClick(Sender: TObject; Item: Integer);
+ procedure lvContactsContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
+ procedure tbAdvancedClick(Sender: TObject);
+ procedure tbRangeClick(Sender: TObject);
+ procedure tbPasswordClick(Sender: TObject);
+ procedure sbAdvancedCloseClick(Sender: TObject);
+ procedure sbRangeCloseClick(Sender: TObject);
+ procedure sbPasswordCloseClick(Sender: TObject);
+ procedure tbEventsFilterClick(Sender: TObject);
+ procedure EventsFilterItemClick(Sender: TObject);
+ procedure Customize1Click(Sender: TObject);
+ procedure InlineCopyClick(Sender: TObject);
+ procedure hgInlinePopup(Sender: TObject);
+ procedure hgInlineKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure InlineCopyAllClick(Sender: TObject);
+ procedure InlineSelectAllClick(Sender: TObject);
+ procedure InlineTextFormattingClick(Sender: TObject);
+ procedure InlineReplyQuotedClick(Sender: TObject);
+ procedure CopyLinkClick(Sender: TObject);
+ procedure OpenLinkClick(Sender: TObject);
+ procedure OpenLinkNWClick(Sender: TObject);
+ procedure mmHideMenuClick(Sender: TObject);
+ procedure mmToolbarClick(Sender: TObject);
+ procedure pmEventsFilterPopup(Sender: TObject);
+ procedure tbBookmarksClick(Sender: TObject);
+ procedure SelectAll1Click(Sender: TObject);
+ procedure OpenFileFolderClick(Sender: TObject);
+ procedure BrowseReceivedFilesClick(Sender: TObject);
+ procedure tbEventsClick(Sender: TObject);
+ procedure sbEventsCloseClick(Sender: TObject);
+ procedure lvContactsDblClick(Sender: TObject);
+ procedure SpeakMessage1Click(Sender: TObject);
+ procedure hgChar(Sender: TObject; var achar: WideChar; Shift: TShiftState);
+ procedure edFilterKeyPress(Sender: TObject; var Key: Char);
+ private
+ UsedPassword: AnsiString;
+ UserMenu: hMenu;
+ UserMenuContact: THandle;
+ WasReturnPressed: Boolean;
+ LastUpdateTime: Cardinal;
+ HotString: String;
+ hHookContactIconChanged: THandle;
+ FContactFilter: THandle;
+ FFiltered: Boolean;
+ IsSearching: Boolean;
+ IsBookmarksMode: Boolean;
+ History: array of TSearchItem;
+ FilterHistory: array of Integer;
+ CurContact: THandle;
+ SearchThread: TSearchThread;
+ stime: DWord;
+ ContactsFound: Integer;
+ AllItems: Integer;
+ AllContacts: Integer;
+ HotFilterString: String;
+ FormState: TGridState;
+ SavedLinkUrl: String;
+ SavedFileDir: String;
+
+ procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
+ procedure WMSysColorChange(var Message: TMessage); message WM_SYSCOLORCHANGE;
+
+ procedure SMPrepare(var M: TMessage); message HM_STRD_PREPARE;
+ procedure SMProgress(var M: TMessage); message HM_STRD_PROGRESS;
+ procedure SMItemsFound(var M: TMessage); message HM_STRD_ITEMSFOUND;
+ procedure SMNextContact(var M: TMessage); message HM_STRD_NEXTCONTACT;
+ procedure SMFinished(var M: TMessage); message HM_STRD_FINISHED;
+
+ function FindHistoryItemByHandle(hDBEvent: THandle): Integer;
+ procedure DeleteEventFromLists(Item: Integer);
+
+ procedure HMEventDeleted(var M: TMessage); message HM_MIEV_EVENTDELETED;
+ procedure HMPreShutdown(var M: TMessage); message HM_MIEV_PRESHUTDOWN;
+ procedure HMContactDeleted(var M: TMessage); message HM_MIEV_CONTACTDELETED;
+ // procedure HMMetaDefaultChanged(var M: TMessage); message HM_MIEV_METADEFCHANGED;
+
+ procedure HMContactIconChanged(var M: TMessage); message HM_SRCH_CONTACTICONCHANGED;
+
+ procedure HMIcons2Changed(var M: TMessage); message HM_NOTF_ICONS2CHANGED;
+ procedure HMBookmarksChanged(var M: TMessage); message HM_NOTF_BOOKMARKCHANGED;
+ procedure HMFiltersChanged(var M: TMessage); message HM_NOTF_FILTERSCHANGED;
+ procedure HMAccChanged(var M: TMessage); message HM_NOTF_ACCCHANGED;
+ procedure HMNickChanged(var M: TMessage); message HM_NOTF_NICKCHANGED;
+ procedure TranslateForm;
+
+ procedure HookEvents;
+ procedure UnhookEvents;
+
+ procedure ShowContacts(Show: Boolean);
+
+ procedure SearchNext(Rev: Boolean; Warp: Boolean = True);
+ procedure ReplyQuoted(Item: Integer);
+ procedure StartHotFilterTimer;
+ procedure EndHotFilterTimer;
+
+ procedure StopSearching;
+ private
+ LastAddedContact: THPPContactInfo;
+ ContactList: TObjectList;
+ // function FindContact(hContact: Integer): THPPContactInfo;
+ function AddContact(hContact: THandle): THPPContactInfo;
+ protected
+ procedure LoadPosition;
+ procedure SavePosition;
+ procedure WndProc(var Message: TMessage); override;
+
+ function IsFileEvent(Index: Integer): Boolean;
+
+ procedure ToggleAdvancedPanel(Show: Boolean);
+ procedure ToggleRangePanel(Show: Boolean);
+ procedure ToggleEventsPanel(Show: Boolean);
+ procedure TogglePasswordPanel(Show: Boolean);
+ procedure OrganizePanels;
+ procedure ToggleMainMenu(Enabled: Boolean);
+
+ procedure SetEventFilter(FilterIndex: Integer = -1);
+ procedure CreateEventsFilterMenu;
+ public
+ CustomizeFiltersForm: TForm;
+ procedure SetRecentEventsPosition(OnTop: Boolean);
+ published
+ // fix for splitter baug:
+ procedure AlignControls(Control: TControl; var ARect: TRect); override;
+
+ function GetSearchItem(GridIndex: Integer): TSearchItem;
+ function GetContactInfo(hContact: THandle): THPPContactInfo;
+
+ procedure DisableFilter;
+ procedure FilterOnContact(hContact: THandle);
+
+ procedure LoadButtonIcons;
+ procedure LoadContactsIcons;
+ procedure LoadToolbarIcons;
+
+ procedure LoadAccMenu;
+ procedure LoadEventFilterButton;
+ public
+ { Public declarations }
+ end;
+
+var
+ fmGlobalSearch: TfmGlobalSearch;
+
+const
+ DEFAULT_SEARCH_TEXT = 'http: ftp: www. ftp.';
+
+var
+ GlobalSearchAllResultsIcon: Integer = -1;
+
+implementation
+
+uses hpp_options, PassForm, hpp_itemprocess, hpp_messages, CustomizeFiltersForm;
+
+{$R *.DFM}
+
+{$include inc\m_speak.inc}
+
+function TfmGlobalSearch.AddContact(hContact: THandle): THPPContactInfo;
+var
+ ci: THPPContactInfo;
+ SubContact: THandle;
+ SubProtocol: AnsiString;
+begin
+ ci := THPPContactInfo.Create;
+ ci.Handle := hContact;
+ ci.Proto := GetContactProto(CurContact, SubContact, SubProtocol);
+ ci.Codepage := GetContactCodePage(hContact, ci.Proto);
+ ci.Name := GetContactDisplayName(ci.Handle, ci.Proto, True);
+ ci.ProfileName := GetContactDisplayName(0, SubProtocol);
+ ci.RTLMode := GetContactRTLModeTRTL(ci.Handle, ci.Proto);
+ ContactList.Add(ci);
+ Result := ci;
+end;
+
+// fix for infamous splitter bug!
+// thanks to Greg Chapman
+// http://groups.google.com/group/borland.public.delphi.objectpascal/browse_thread/thread/218a7511123851c3/5ada76e08038a75b%235ada76e08038a75b?sa=X&oi=groupsr&start=2&num=3
+procedure TfmGlobalSearch.AlignControls(Control: TControl; var ARect: TRect);
+begin
+ inherited;
+ if paContacts.Width = 0 then
+ paContacts.Left := spContacts.Left;
+end;
+
+procedure TfmGlobalSearch.FormCreate(Sender: TObject);
+// var
+// NonClientMetrics: TNonClientMetrics;
+begin
+ // Setting different system font different way. For me works the same
+ // but some said it produces better results than DesktopFont
+ // Leave it here for possible future use.
+ //
+ // NonClientMetrics.cbSize := SizeOf(NonClientMetrics);
+ // SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0);
+ // Font.Handle := CreateFontIndirect(NonClientMetrics.lfMessageFont);
+ // if Scaled then begin
+ // Font.Height := NonClientMetrics.lfMessageFont.lfHeight;
+ // end;
+ Icon.ReleaseHandle;
+ Icon.Handle := CopyIcon(hppIcons[HPP_ICON_GLOBALSEARCH].Handle);
+
+ DesktopFont := True;
+ MakeFontsParent(Self);
+
+ DoubleBuffered := True;
+ MakeDoubleBufferedParent(Self);
+ TopPanel.DoubleBuffered := False;
+ hg.DoubleBuffered := False;
+
+ FormState := gsIdle;
+
+ ContactList := TObjectList.Create;
+
+ ilContacts.Handle := CallService(MS_CLIST_GETICONSIMAGELIST, 0, 0);
+ // delphi 2006 doesn't save toolbar's flat property in dfm if it is True
+ // delphi 2006 doesn't save toolbar's edgeborder property in dfm
+ ToolBar.Flat := True;
+ ToolBar.EdgeBorders := [];
+
+ LoadToolbarIcons;
+ LoadButtonIcons;
+ LoadContactsIcons;
+
+ TranslateForm;
+
+ // File actions from context menu support
+ AddMenuArray(pmGrid, [FileActions], -1);
+
+ LoadAccMenu; // load accessability menu before LoadToolbar
+ // put here because we want to translate everything
+ // before copying to menu
+ ToggleMainMenu(GetDBBool(hppDBName, 'Accessability', False));
+end;
+
+procedure TfmGlobalSearch.SMFinished(var M: TMessage);
+// var
+// sbt: WideString;
+begin
+ stime := GetTickCount - SearchThread.SearchStart;
+ AllContacts := SearchThread.AllContacts;
+ AllItems := SearchThread.AllEvents;
+ IsSearching := False;
+ bnSearch.Caption := TranslateW('Search');
+ paProgress.Hide;
+ // paFilter.Show;
+ // if change, change also in hg.State:
+ // sbt := WideFormat(TranslateW('%.0n items in %d contacts found. Searched for %.1f sec in %.0n items.'),[Length(History)/1, ContactsFound, stime/1000, AllItems/1]);
+ // sb.SimpleText := sbt;
+ hgState(Self, hg.State);
+ if Length(History) = 0 then
+ ShowContacts(False);
+end;
+
+procedure TfmGlobalSearch.SMItemsFound(var M: TMessage);
+var
+ li: TListItem;
+ ci: THPPContactInfo;
+ Buffer: PDBArray;
+ FiltOldSize, OldSize, i, BufCount: Integer;
+begin
+ // wParam - array of hDBEvent, lParam - array size
+ Buffer := PDBArray(M.wParam);
+ BufCount := Integer(M.LParam);
+ OldSize := Length(History);
+ SetLength(History, OldSize + BufCount);
+
+ if (LastAddedContact = nil) or (LastAddedContact.Handle <> CurContact) then
+ begin
+ ci := AddContact(CurContact);
+ LastAddedContact := ci;
+ end;
+
+ for i := 0 to BufCount - 1 do
+ begin
+ History[OldSize + i].hDBEvent := Buffer^[i];
+ History[OldSize + i].Contact := LastAddedContact;
+ // History[OldSize + i].hContact := CurContact;
+ // History[OldSize + i].ContactName := CurContactName;
+ // History[OldSize + i].ProfileName := CurProfileName;
+ // History[OldSize + i].Proto := CurProto;
+ end;
+
+ FreeMem(Buffer, SizeOf(Buffer^));
+
+ if (lvContacts.Items.Count = 0) or
+ (THandle(lvContacts.Items.Item[lvContacts.Items.Count - 1].Data) <> CurContact) then
+ begin
+ if lvContacts.Items.Count = 0 then
+ begin
+ li := lvContacts.Items.Add;
+ li.Caption := TranslateW('All Results');
+ li.ImageIndex := GlobalSearchAllResultsIcon;
+ li.Selected := True;
+ end;
+ li := lvContacts.Items.Add;
+ if CurContact = 0 then
+ li.Caption := TranslateW('System History')
+ else
+ begin
+ li.Caption := LastAddedContact.Name;
+ // li.Caption := CurContactName;
+ Inc(ContactsFound);
+ end;
+ li.ImageIndex := CallService(MS_CLIST_GETCONTACTICON, CurContact, 0);
+ // meTest.Lines.Add(CurContactName+' icon is '+IntToStr(CallService(MS_CLIST_GETCONTACTICON,CurContact,0)));
+ li.Data := Pointer(CurContact);
+ end;
+
+ if FFiltered then
+ begin
+ if CurContact = FContactFilter then
+ begin
+ FiltOldSize := Length(FilterHistory);
+ for i := 0 to BufCount - 1 do
+ FilterHistory[FiltOldSize + i] := OldSize + i;
+ hg.Allocate(Length(FilterHistory));
+ end;
+ end
+ else
+ hg.Allocate(Length(History));
+
+ if (hg.Count > 0) and (hg.Selected = -1) then
+ hg.Selected := 0;
+
+ paFilter.Visible := True;
+ if not paContacts.Visible then
+ begin
+ ShowContacts(True);
+ hg.Selected := 0;
+ hg.SetFocus;
+ end;
+
+ tbEventsFilter.Enabled := True;
+ // dirty hack: readjust scrollbars
+ hg.Perform(WM_SIZE, SIZE_RESTORED, MakeLParam(hg.ClientWidth, hg.ClientHeight));
+ // hg.Repaint;
+ // Application.ProcessMessages;
+end;
+
+procedure TfmGlobalSearch.SMNextContact(var M: TMessage);
+var
+ CurProto: AnsiString;
+begin
+ // wParam - hContact, lParam - 0
+ CurContact := M.wParam;
+ if CurContact = 0 then
+ CurProto := 'ICQ'
+ else
+ CurProto := GetContactProto(CurContact);
+ laProgress.Caption := Format(TranslateW('Searching "%s"...'),
+ [GetContactDisplayName(CurContact, CurProto, True)]);
+end;
+
+procedure TfmGlobalSearch.SMPrepare(var M: TMessage);
+begin
+ LastUpdateTime := 0;
+ ContactsFound := 0;
+ AllItems := 0;
+ AllContacts := 0;
+ FFiltered := False;
+
+ // hg.Filter := GenerateEvents(FM_EXCLUDE,[]);
+ hg.Selected := -1;
+ hg.Allocate(0);
+
+ SetLength(FilterHistory, 0);
+ SetLength(History, 0);
+
+ IsSearching := True;
+ bnSearch.Caption := TranslateW('Stop');
+
+ tbEventsFilter.Enabled := False;
+ sb.SimpleText := TranslateW('Searching... Please wait.');
+ laProgress.Caption := TranslateW('Preparing search...');
+ pb.Position := 0;
+ paProgress.Show;
+ paFilter.Visible := False;
+ // ShowContacts(False);
+ lvContacts.Items.Clear;
+ ContactList.Clear;
+ LastAddedContact := nil;
+end;
+
+procedure TfmGlobalSearch.SMProgress(var M: TMessage);
+begin
+ // wParam - progress; lParam - max
+
+ if (GetTickCount - LastUpdateTime) < 100 then
+ exit;
+ LastUpdateTime := GetTickCount;
+
+ pb.Max := M.LParam;
+ pb.Position := M.wParam;
+ // Application.ProcessMessages;
+
+ // if change, change also in hg.OnState
+ sb.SimpleText := Format(TranslateW('Searching... %.0n items in %d contacts found'),
+ [Length(History) / 1, ContactsFound]);
+end;
+
+procedure TfmGlobalSearch.StartHotFilterTimer;
+begin
+ if tiFilter.Interval = 0 then
+ EndHotFilterTimer
+ else
+ begin
+ tiFilter.Enabled := False;
+ tiFilter.Enabled := True;
+ if pbFilter.Tag <> 1 then
+ begin // use Tag to not repaint every keystroke
+ pbFilter.Tag := 1;
+ pbFilter.Repaint;
+ end;
+ end;
+end;
+
+procedure TfmGlobalSearch.tbAdvancedClick(Sender: TObject);
+begin
+ // when called from menu item handler
+ if Sender <> tbAdvanced then
+ tbAdvanced.Down := not tbAdvanced.Down;
+ ToggleAdvancedPanel(tbAdvanced.Down);
+end;
+
+procedure TfmGlobalSearch.tbEventsFilterClick(Sender: TObject);
+var
+ p: TPoint;
+begin
+ p := tbEventsFilter.ClientOrigin;
+ tbEventsFilter.ClientToScreen(p);
+ pmEventsFilter.Popup(p.X, p.Y + tbEventsFilter.Height);
+end;
+
+procedure TfmGlobalSearch.tbPasswordClick(Sender: TObject);
+begin
+ if Sender <> tbPassword then
+ tbPassword.Down := not tbPassword.Down;
+ TogglePasswordPanel(tbPassword.Down);
+end;
+
+procedure TfmGlobalSearch.tbRangeClick(Sender: TObject);
+begin
+ if Sender <> tbRange then
+ tbRange.Down := not tbRange.Down;
+ ToggleRangePanel(tbRange.Down);
+end;
+
+procedure TfmGlobalSearch.tiFilterTimer(Sender: TObject);
+begin
+ EndHotFilterTimer;
+end;
+
+procedure TfmGlobalSearch.edFilterChange(Sender: TObject);
+begin
+ StartHotFilterTimer;
+end;
+
+procedure TfmGlobalSearch.edFilterKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+ if Key in [VK_UP, VK_DOWN, VK_NEXT, VK_PRIOR] then
+ begin
+ SendMessage(hg.Handle, WM_KEYDOWN, Key, 0);
+ Key := 0;
+ end;
+end;
+
+procedure TfmGlobalSearch.edFilterKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+ if Key = VK_RETURN then
+ begin
+ hg.SetFocus;
+ Key := 0;
+ end;
+end;
+
+procedure TfmGlobalSearch.FormDestroy(Sender: TObject);
+begin
+ fmGlobalSearch := nil;
+ if Assigned(CustomizeFiltersForm) then
+ CustomizeFiltersForm.Release;
+ ContactList.Free;
+end;
+
+procedure TfmGlobalSearch.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
+begin
+ inherited;
+ with Message.MinMaxInfo^ do
+ begin
+ ptMinTrackSize.X := 320;
+ ptMinTrackSize.Y := 240;
+ end
+end;
+
+procedure TfmGlobalSearch.FormMouseWheel(Sender: TObject; Shift: TShiftState;
+ WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
+var
+ Ctrl: TControl;
+begin
+ Handled := True;
+ Ctrl := paClient.ControlAtPos(paClient.ScreenToClient(MousePos), False, True);
+{$RANGECHECKS OFF}
+ if Assigned(Ctrl) then
+ begin
+ if Ctrl.Name = 'paContacts' then
+ begin
+ Handled := not TListView(Ctrl).Focused;
+ if Handled then
+ begin
+ // ??? what to do here?
+ // how to tell listview to scroll?
+ end;
+ end
+ else
+ begin
+ hg.Perform(WM_MOUSEWHEEL, MakeLong(MK_CONTROL, WheelDelta), 0);
+ end;
+ end;
+{$RANGECHECKS ON}
+end;
+
+procedure TfmGlobalSearch.ToggleAdvancedPanel(Show: Boolean);
+var
+ Lock: Boolean;
+begin
+ Lock := Visible;
+ if Lock then
+ Lock := LockWindowUpdate(Handle);
+ try
+ tbAdvanced.Down := Show;
+ paAdvanced.Visible := Show and tbAdvanced.Enabled;
+ OrganizePanels;
+ finally
+ if Lock then
+ LockWindowUpdate(0);
+ end;
+end;
+
+procedure TfmGlobalSearch.TogglePasswordPanel(Show: Boolean);
+var
+ Lock: Boolean;
+begin
+ Lock := Visible;
+ if Lock then
+ Lock := LockWindowUpdate(Handle);
+ try
+ if GetPassMode = PASSMODE_PROTALL then
+ Show := True;
+ tbPassword.Down := Show;
+ paPassword.Visible := Show;
+ laPassNote.Caption := '';
+ OrganizePanels;
+ finally
+ if Lock then
+ LockWindowUpdate(0);
+ end;
+end;
+
+procedure TfmGlobalSearch.ToggleRangePanel(Show: Boolean);
+var
+ Lock: Boolean;
+begin
+ Lock := Visible;
+ if Lock then
+ Lock := LockWindowUpdate(Handle);
+ try
+ tbRange.Down := Show;
+ paRange.Visible := Show and tbRange.Enabled;
+ edSearchChange(Self);
+ OrganizePanels;
+ finally
+ if Lock then
+ LockWindowUpdate(0);
+ end;
+end;
+
+procedure TfmGlobalSearch.ToggleEventsPanel(Show: Boolean);
+var
+ Lock: Boolean;
+begin
+ Lock := Visible;
+ if Lock then
+ Lock := LockWindowUpdate(Handle);
+ try
+ tbEvents.Down := Show;
+ paEvents.Visible := Show and tbEvents.Enabled;
+ edSearchChange(Self);
+ OrganizePanels;
+ finally
+ if Lock then
+ LockWindowUpdate(0);
+ end;
+end;
+
+procedure TfmGlobalSearch.mmToolbarClick(Sender: TObject);
+var
+ i, n: Integer;
+ pm: TPopupMenu;
+ mi: TMenuItem;
+ flag: Boolean;
+begin
+ for i := 0 to mmToolbar.Count - 1 do
+ begin
+ if mmToolbar.Items[i].Owner is THppToolButton then
+ begin
+ flag := TToolButton(mmToolbar.Items[i].Owner).Enabled
+ end
+ else if mmToolbar.Items[i].Owner is TSpeedButton then
+ begin
+ TMenuItem(mmToolbar.Items[i]).Caption := TSpeedButton(mmToolbar.Items[i].Owner).Hint;
+ flag := TSpeedButton(mmToolbar.Items[i].Owner).Enabled
+ end
+ else
+ flag := True;
+ mmToolbar.Items[i].Enabled := flag;
+ if mmToolbar.Items[i].Tag = 0 then
+ continue;
+ pm := TPopupMenu(Pointer(mmToolbar.Items[i].Tag));
+ for n := pm.Items.Count - 1 downto 0 do
+ begin
+ mi := TMenuItem(pm.Items[n]);
+ pm.Items.Remove(mi);
+ mmToolbar.Items[i].Insert(0, mi);
+ end;
+ end;
+end;
+
+procedure TfmGlobalSearch.sbAdvancedCloseClick(Sender: TObject);
+begin
+ ToggleAdvancedPanel(False);
+end;
+
+procedure TfmGlobalSearch.sbClearFilterClick(Sender: TObject);
+begin
+ edFilter.Text := '';
+ EndHotFilterTimer;
+ hg.SetFocus;
+end;
+
+procedure TfmGlobalSearch.sbPasswordCloseClick(Sender: TObject);
+begin
+ TogglePasswordPanel(False);
+end;
+
+procedure TfmGlobalSearch.sbRangeCloseClick(Sender: TObject);
+begin
+ ToggleRangePanel(False);
+end;
+
+procedure TfmGlobalSearch.TranslateForm;
+begin
+ Caption := TranslateUnicodeString(Caption);
+
+ laSearch.Caption := TranslateUnicodeString(laSearch.Caption);
+ bnSearch.Caption := TranslateUnicodeString(bnSearch.Caption);
+ edSearch.Left := laSearch.Left + laSearch.Width + 5;
+ edSearch.Width := bnSearch.Left - edSearch.Left - 5;
+
+ laAdvancedHead.Caption := TranslateUnicodeString(laAdvancedHead.Caption);
+ rbAny.Caption := TranslateUnicodeString(rbAny.Caption);
+ rbAll.Caption := TranslateUnicodeString(rbAll.Caption);
+ rbExact.Caption := TranslateUnicodeString(rbExact.Caption);
+
+ laRangeHead.Caption := TranslateUnicodeString(laRangeHead.Caption);
+ laRange1.Caption := TranslateUnicodeString(laRange1.Caption);
+ laRange2.Caption := TranslateUnicodeString(laRange2.Caption);
+
+ laEventsHead.Caption := TranslateUnicodeString(laEventsHead.Caption);
+ laEvents.Caption := TranslateUnicodeString(laEvents.Caption);
+ cbEvents.Left := laEvents.Left + laEvents.Width + 10;
+
+ laPasswordHead.Caption := TranslateUnicodeString(laPasswordHead.Caption);
+ laPass.Caption := TranslateUnicodeString(laPass.Caption);
+ edPass.Left := laPass.Left + laPass.Width + 10;
+
+ sbClearFilter.Hint := TranslateUnicodeString(sbClearFilter.Hint);
+
+ SaveDialog.Title := TranslateUnicodeString(PWideChar(SaveDialog.Title));
+
+ TranslateToolbar(ToolBar);
+
+ TranslateMenu(pmGrid.Items);
+ TranslateMenu(pmInline.Items);
+ TranslateMenu(pmLink.Items);
+ TranslateMenu(pmFile.Items);
+ TranslateMenu(pmEventsFilter.Items);
+
+ hg.TxtFullLog := TranslateUnicodeString(hg.TxtFullLog);
+ hg.TxtGenHist1 := TranslateUnicodeString(hg.TxtGenHist1);
+ hg.TxtGenHist2 := TranslateUnicodeString(hg.TxtGenHist2);
+ hg.TxtHistExport := TranslateUnicodeString(hg.TxtHistExport);
+ hg.TxtNoItems := TranslateUnicodeString(hg.TxtNoItems);
+ hg.TxtNoSuch := TranslateUnicodeString(hg.TxtNoSuch);
+ hg.TxtPartLog := TranslateUnicodeString(hg.TxtPartLog);
+ hg.TxtStartUp := TranslateUnicodeString(hg.TxtStartUp);
+ hg.TxtSessions := TranslateUnicodeString(hg.TxtSessions);
+end;
+
+procedure TfmGlobalSearch.FilterOnContact(hContact: THandle);
+var
+ i: Integer;
+begin
+ if FFiltered and (FContactFilter = hContact) then
+ exit;
+ FFiltered := True;
+ FContactFilter := hContact;
+ SetLength(FilterHistory, 0);
+ for i := 0 to Length(History) - 1 do
+ begin
+ if History[i].Contact.Handle = hContact then
+ begin
+ SetLength(FilterHistory, Length(FilterHistory) + 1);
+ FilterHistory[High(FilterHistory)] := i;
+ end;
+ end;
+ hg.Allocate(0);
+ if Length(FilterHistory) > 0 then
+ begin
+ hg.Allocate(Length(FilterHistory));
+ hg.Selected := 0;
+ end
+ else
+ hg.Selected := -1;
+ // dirty hack: readjust scrollbars
+ hg.Perform(WM_SIZE, SIZE_RESTORED, MakeLParam(hg.ClientWidth, hg.ClientHeight));
+end;
+
+{ function TfmGlobalSearch.FindContact(hContact: Integer): THPPContactInfo;
+ begin
+ Result := nil;
+ end; }
+
+function TfmGlobalSearch.FindHistoryItemByHandle(hDBEvent: THandle): Integer;
+var
+ i: Integer;
+begin
+ Result := -1;
+ for i := 0 to Length(History) - 1 do
+ begin
+ if History[i].hDBEvent = hDBEvent then
+ begin
+ Result := i;
+ break;
+ end;
+ end;
+end;
+
+procedure TfmGlobalSearch.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+ try
+ Action := caFree;
+ SavePosition;
+ UnhookEvents;
+ except
+ end;
+end;
+
+procedure TfmGlobalSearch.StopSearching;
+begin
+ bnSearch.Enabled := False;
+ try
+ SearchThread.Terminate(tpHigher);
+ while IsSearching do
+ Application.ProcessMessages;
+ finally
+ bnSearch.Enabled := True;
+ if edSearch.CanFocus then
+ edSearch.SetFocus;
+ end;
+end;
+
+procedure TfmGlobalSearch.bnSearchClick(Sender: TObject);
+var
+ SearchProtected: Boolean;
+ PassMode: Byte;
+begin
+ if IsSearching then
+ begin
+ StopSearching;
+ exit;
+ end;
+ // if edSearch.Text = '' then
+ // raise Exception.Create('Enter text to search');
+
+ SearchProtected := False;
+ if paPassword.Visible then
+ begin
+ PassMode := GetPassMode;
+ if PassMode = PASSMODE_PROTNONE then
+ laPassNote.Caption := TranslateW('History is not protected, searching all contacts')
+ else
+ begin
+ if (PassMode <> PASSMODE_PROTALL) and (edPass.Text = '') then
+ laPassNote.Caption := TranslateW('Searching unprotected contacts only')
+ else
+ begin
+ if CheckPassword(AnsiString(edPass.Text)) then
+ begin
+ SearchProtected := True;
+ laPassNote.Caption := TranslateW('Searching all contacts');
+ end
+ else
+ begin
+ HppMessageBox(Handle, TranslateW('You have entered the wrong password.'),
+ TranslateW('History++ Password Protection'), MB_OK or MB_DEFBUTTON1 or MB_ICONSTOP);
+ edPass.SetFocus;
+ edPass.SelectAll;
+ laPassNote.Caption := TranslateW('Wrong password');
+ exit;
+ end;
+ end;
+ end;
+ end;
+
+ UsedPassword := AnsiString(edPass.Text);
+
+ if Assigned(SearchThread) then
+ FreeAndNil(SearchThread);
+ SearchThread := TSearchThread.Create(True);
+
+ if IsBookmarksMode then
+ SearchThread.SearchMethod := [smBookmarks]
+ else if edSearch.Text = '' then
+ SearchThread.SearchMethod := []
+ else if rbAny.Checked then
+ SearchThread.SearchMethod := [smAnyWord]
+ else if rbAll.Checked then
+ SearchThread.SearchMethod := [smAllWords]
+ else
+ SearchThread.SearchMethod := [smExact];
+
+ if paRange.Visible then
+ begin
+ SearchThread.SearchMethod := SearchThread.SearchMethod + [smRange];
+ SearchThread.SearchRangeFrom := dtRange1.Date;
+ SearchThread.SearchRangeTo := dtRange2.Date;
+ end;
+
+ if paEvents.Visible and (cbEvents.ItemIndex <> -1) then
+ begin
+ SearchThread.SearchMethod := SearchThread.SearchMethod + [smEvents];
+ SearchThread.SearchEvents := hppEventFilters[cbEvents.ItemIndex].Events;
+ end;
+
+ SearchThread.Priority := tpLower;
+ SearchThread.ParentHandle := Handle;
+ SearchThread.SearchText := edSearch.Text;
+ SearchThread.SearchProtectedContacts := SearchProtected;
+ SearchThread.Resume;
+end;
+
+// takes index from *History* array as parameter
+procedure TfmGlobalSearch.DeleteEventFromLists(Item: Integer);
+var
+ i: Integer;
+ EventDeleted: Boolean;
+begin
+ if Item = -1 then
+ exit;
+
+ i := High(History);
+ if Item <> i then
+ Move(History[Item + 1], History[Item], (i - Item) * SizeOf(History[0]));
+ SetLength(History, i);
+
+ if not FFiltered then
+ exit;
+
+ EventDeleted := False;
+ for i := 0 to Length(FilterHistory) - 1 do
+ begin
+ if EventDeleted then
+ begin
+ if i < Length(FilterHistory) - 1 then
+ FilterHistory[i] := FilterHistory[i + 1];
+ Dec(FilterHistory[i]);
+ end
+ else if FilterHistory[i] = Item then
+ EventDeleted := True;
+ end;
+ if EventDeleted then
+ SetLength(FilterHistory, Length(FilterHistory) - 1);
+end;
+
+procedure TfmGlobalSearch.DisableFilter;
+begin
+ if not FFiltered then
+ exit;
+ FFiltered := False;
+ SetLength(FilterHistory, 0);
+ hg.Allocate(0);
+ if Length(History) > 0 then
+ begin
+ hg.Allocate(Length(History));
+ hg.Selected := 0;
+ end
+ else
+ hg.Selected := -1;
+ // dirty hack: readjust scrollbars
+ hg.Perform(WM_SIZE, SIZE_RESTORED, MakeLParam(hg.ClientWidth, hg.ClientHeight));
+end;
+
+procedure TfmGlobalSearch.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+var
+ flag: UINT;
+ AppSysMenu: THandle;
+begin
+ CanClose := (hg.State in [gsIdle, gsInline]);
+ if CanClose and IsSearching then
+ begin
+ // disable close button
+ AppSysMenu := GetSystemMenu(Handle, False);
+ flag := MF_GRAYED;
+ EnableMenuItem(AppSysMenu, SC_CLOSE, MF_BYCOMMAND or flag);
+ // laProgress.Caption := TranslateW('Please wait while closing the window...');
+ // laProgress.Font.Style := [fsBold];
+ // pb.Visible := False;
+ if paProgress.Visible then
+ paProgress.Hide;
+ sb.SimpleText := TranslateW('Please wait while closing the window...');
+ // terminate thread
+ SearchThread.Terminate(tpHigher);
+ repeat
+ Application.ProcessMessages
+ until not IsSearching;
+ end;
+ if CanClose and Assigned(SearchThread) then
+ FreeAndNil(SearchThread);
+end;
+
+procedure TfmGlobalSearch.hgItemData(Sender: TObject; Index: Integer; var Item: THistoryItem);
+begin
+ Item := ReadEvent(GetSearchItem(Index).hDBEvent, GetSearchItem(Index).Contact.Codepage);
+ Item.Proto := GetSearchItem(Index).Contact.Proto;
+ Item.RTLMode := GetSearchItem(Index).Contact.RTLMode;
+ Item.Bookmarked := BookmarkServer[GetSearchItem(Index).Contact.Handle].Bookmarked
+ [GetSearchItem(Index).hDBEvent];
+end;
+
+procedure TfmGlobalSearch.hgItemDelete(Sender: TObject; Index: Integer);
+var
+ si: TSearchItem;
+begin
+ si := GetSearchItem(Index);
+ if (FormState = gsDelete) and (si.hDBEvent <> 0) then
+ CallService(MS_DB_EVENT_DELETE, si.Contact.Handle, si.hDBEvent);
+ if FFiltered then
+ Index := FilterHistory[Index];
+ DeleteEventFromLists(Index);
+ hgState(hg, hg.State);
+ Application.ProcessMessages;
+end;
+
+procedure TfmGlobalSearch.hgItemFilter(Sender: TObject; Index: Integer; var Show: Boolean);
+begin
+ if HotFilterString = '' then
+ exit;
+ if Pos(WideUpperCase(HotFilterString), WideUpperCase(hg.Items[Index].Text)) = 0 then
+ Show := False;
+end;
+
+procedure TfmGlobalSearch.hgBookmarkClick(Sender: TObject; Item: Integer);
+var
+ val: Boolean;
+ hContact, hDBEvent: THandle;
+begin
+ hContact := GetSearchItem(Item).Contact.Handle;
+ hDBEvent := GetSearchItem(Item).hDBEvent;
+ val := not BookmarkServer[hContact].Bookmarked[hDBEvent];
+ BookmarkServer[hContact].Bookmarked[hDBEvent] := val;
+end;
+
+procedure TfmGlobalSearch.hgDblClick(Sender: TObject);
+var
+ oep: TOpenEventParams;
+begin
+ if hg.Selected = -1 then
+ exit;
+ oep.cbSize := SizeOf(oep);
+ oep.hContact := GetSearchItem(hg.Selected).Contact.Handle;
+ oep.hDBEvent := GetSearchItem(hg.Selected).hDBEvent;
+ oep.pPassword := PAnsiChar(UsedPassword);
+ CallService(MS_HPP_OPENHISTORYEVENT, wParam(@oep), 0);
+end;
+
+procedure TfmGlobalSearch.edSearchChange(Sender: TObject);
+begin
+ bnSearch.Enabled := (edSearch.Text <> '') or paRange.Visible or paEvents.Visible;
+end;
+
+procedure TfmGlobalSearch.edSearchEnter(Sender: TObject);
+begin
+ // edSearch.SelectAll;
+end;
+
+procedure TfmGlobalSearch.LoadAccMenu;
+var
+ i: Integer;
+ wstr: String;
+ menuitem: TMenuItem;
+ pm: TPopupMenu;
+begin
+ mmToolbar.Clear;
+ for i := ToolBar.ButtonCount - 1 downto 0 do
+ begin
+ if ToolBar.Buttons[i].Style = tbsSeparator then
+ begin
+ menuitem := TMenuItem.Create(mmToolbar);
+ menuitem.Caption := '-';
+ end
+ else
+ begin
+ menuitem := TMenuItem.Create(ToolBar.Buttons[i]);
+ wstr := ToolBar.Buttons[i].Caption;
+ if wstr = '' then
+ wstr := ToolBar.Buttons[i].Hint;
+ if wstr <> '' then
+ begin
+ pm := TPopupMenu(ToolBar.Buttons[i].PopupMenu);
+ if pm = nil then
+ menuitem.OnClick := ToolBar.Buttons[i].OnClick
+ else
+ begin
+ menuitem.Tag := THandle(Pointer(pm));
+ end;
+ menuitem.Caption := wstr;
+ menuitem.ShortCut := TextToShortCut(ToolBar.Buttons[i].HelpKeyword);
+ menuitem.Enabled := ToolBar.Buttons[i].Enabled;
+ menuitem.Visible := ToolBar.Buttons[i].Visible;
+ end;
+ end;
+ mmToolbar.Insert(0, menuitem);
+ end;
+ mmToolbar.RethinkHotkeys;
+end;
+
+procedure LoadHPPIcons(var sb:TSpeedButton;idx:integer);
+begin
+ with sb.Glyph do
+ begin
+ Width := 16;
+ Height := 16;
+ Canvas.Brush.Color := clBtnFace;
+ Canvas.FillRect(Canvas.ClipRect);
+ DrawiconEx(Canvas.Handle, 0, 0, hppIcons[idx].Handle, 16, 16, 0,
+ Canvas.Brush.Handle, DI_NORMAL);
+ end;
+end;
+
+procedure TfmGlobalSearch.LoadButtonIcons;
+begin
+ LoadHPPIcons(sbClearFilter,HPP_ICON_HOTFILTERCLEAR);
+ LoadHPPIcons(sbAdvancedClose,HPP_ICON_SESS_HIDE);
+ LoadHPPIcons(sbRangeClose,HPP_ICON_SESS_HIDE);
+ LoadHPPIcons(sbEventsClose,HPP_ICON_SESS_HIDE);
+ LoadHPPIcons(sbPasswordClose,HPP_ICON_SESS_HIDE);
+end;
+
+procedure TfmGlobalSearch.LoadContactsIcons;
+begin
+ lvContacts.Items.BeginUpdate;
+
+ if GlobalSearchAllResultsIcon = -1 then
+ GlobalSearchAllResultsIcon := ImageList_AddIcon(ilContacts.Handle,
+ hppIcons[HPP_ICON_SEARCH_ALLRESULTS].Handle)
+ else
+ ImageList_ReplaceIcon(ilContacts.Handle, GlobalSearchAllResultsIcon,
+ hppIcons[HPP_ICON_SEARCH_ALLRESULTS].Handle);
+
+ lvContacts.Items.EndUpdate;
+end;
+
+procedure TfmGlobalSearch.LoadEventFilterButton;
+var
+ pad: DWord;
+ PadH, { PadV, } GlyphHeight: Integer;
+ sz: TSize;
+ FirstName, Name: String;
+ PaintRect: TRect;
+ DrawTextFlags: Cardinal;
+ GlyphWidth: Integer;
+begin
+ FirstName := hppEventFilters[0].Name;
+ Name := hppEventFilters[tbEventsFilter.Tag].Name;
+ tbEventsFilter.Hint := Name; // show hint because the whole name may not fit in button
+
+ pad := SendMessage(ToolBar.Handle, TB_GETPADDING, 0, 0);
+ // PadV := HiWord(pad);
+ PadH := LoWord(pad);
+
+ tbEventsFilter.Glyph.Canvas.Font := tbEventsFilter.Font;
+ sz := tbEventsFilter.Glyph.Canvas.TextExtent(FirstName);
+ GlyphHeight := Max(sz.cy, 16);
+ GlyphWidth := 16 + sz.cx + tbEventsFilter.Spacing;
+
+ tbEventsFilter.Glyph.Height := GlyphHeight;
+ tbEventsFilter.Glyph.Width := GlyphWidth * 2;
+ tbEventsFilter.Glyph.Canvas.Brush.Color := clBtnFace;
+ tbEventsFilter.Glyph.Canvas.FillRect(tbEventsFilter.Glyph.Canvas.ClipRect);
+ DrawiconEx(tbEventsFilter.Glyph.Canvas.Handle, sz.cx + tbEventsFilter.Spacing,
+ ((GlyphHeight - 16) div 2), hppIcons[HPP_ICON_DROPDOWNARROW].Handle, 16, 16, 0,
+ tbEventsFilter.Glyph.Canvas.Brush.Handle, DI_NORMAL);
+ DrawState(tbEventsFilter.Glyph.Canvas.Handle, 0, nil,
+ hppIcons[HPP_ICON_DROPDOWNARROW].Handle, 0, sz.cx + tbEventsFilter.Spacing +
+ GlyphWidth, ((GlyphHeight - 16) div 2), 0, 0, DST_ICON or DSS_DISABLED);
+
+ PaintRect := Rect(0, ((GlyphHeight - sz.cy) div 2), GlyphWidth - 16 - tbEventsFilter.Spacing,
+ tbEventsFilter.Glyph.Height);
+ DrawTextFlags := DT_END_ELLIPSIS or DT_NOPREFIX or DT_CENTER;
+ tbEventsFilter.Glyph.Canvas.Font.Color := clWindowText;
+ DrawTextW(tbEventsFilter.Glyph.Canvas.Handle, @Name[1], Length(Name), PaintRect,
+ DrawTextFlags);
+ OffsetRect(PaintRect, GlyphWidth, 0);
+ tbEventsFilter.Glyph.Canvas.Font.Color := clGrayText;
+ DrawTextW(tbEventsFilter.Glyph.Canvas.Handle, @Name[1], Length(Name), PaintRect,
+ DrawTextFlags);
+ tbEventsFilter.Width := GlyphWidth + 2 * PadH;
+ tbEventsFilter.NumGlyphs := 2;
+end;
+
+procedure TfmGlobalSearch.LoadPosition;
+var
+ n: Integer;
+begin
+ // if Utils_RestoreWindowPosition(Self.Handle,0,0,hppDBName,'GlobalSearchWindow.') <> 0 then begin
+ // Self.Left := (Screen.Width-Self.Width) div 2;
+ // Self.Top := (Screen.Height - Self.Height) div 2;
+ // end;
+ Utils_RestoreFormPosition(Self, 0, hppDBName, 'GlobalSearchWindow.');
+ // if we are password-protected (cbPass.Enabled) and
+ // have PROTSEL (not (cbPass.Checked)) then load
+ // checkbox from DB
+ if not paPassword.Visible then
+ TogglePasswordPanel(GetDBBool(hppDBName, 'GlobalSearchWindow.PassChecked', False));
+
+ n := GetDBInt(hppDBName, 'GlobalSearchWindow.ContactListWidth', -1);
+ if n <> -1 then
+ begin
+ paContacts.Width := n;
+ end;
+ spContacts.Left := paContacts.Left + paContacts.Width + 1;
+ edFilter.Width := paFilter.Width - edFilter.Left - 2;
+
+ SetRecentEventsPosition(GetDBInt(hppDBName, 'SortOrder', 0) <> 0);
+
+ ToggleAdvancedPanel(GetDBBool(hppDBName, 'GlobalSearchWindow.ShowAdvanced', False));
+ case GetDBInt(hppDBName, 'GlobalSearchWindow.AdvancedOptions', 0) of
+ 0:
+ rbAny.Checked := True;
+ 1:
+ rbAll.Checked := True;
+ 2:
+ rbExact.Checked := True
+ else
+ rbAny.Checked := True;
+ end;
+ ToggleRangePanel(GetDBBool(hppDBName, 'GlobalSearchWindow.ShowRange', False));
+ ToggleEventsPanel(GetDBBool(hppDBName, 'GlobalSearchWindow.ShowEvents', False));
+ dtRange1.Date := Trunc(GetDBDateTime(hppDBName, 'GlobalSearchWindow.RangeFrom', Now));
+ dtRange2.Date := Trunc(GetDBDateTime(hppDBName, 'GlobalSearchWindow.RangeTo', Now));
+ edSearch.Text := GetDBWideStr(hppDBName, 'GlobalSearchWindow.LastSearch',
+ DEFAULT_SEARCH_TEXT);
+end;
+
+procedure TfmGlobalSearch.LoadToolbarIcons;
+var
+ il: HIMAGELIST;
+ ii: Integer;
+begin
+ ImageList_Remove(ilToolbar.Handle, -1); // clears image list
+ il := ImageList_Create(16, 16, ILC_COLOR32 or ILC_MASK, 10, 2);
+ if il <> 0 then
+ ilToolbar.Handle := il
+ else
+ il := ilToolbar.Handle;
+ ToolBar.Images := ilToolbar;
+
+ ii := ImageList_AddIcon(il, hppIcons[HPP_ICON_SEARCHADVANCED].Handle);
+ tbAdvanced.ImageIndex := ii;
+ ii := ImageList_AddIcon(il, hppIcons[HPP_ICON_SEARCHRANGE].Handle);
+ tbRange.ImageIndex := ii;
+ ii := ImageList_AddIcon(il, hppIcons[HPP_ICON_HOTFILTER].Handle);
+ tbEvents.ImageIndex := ii;
+ ii := ImageList_AddIcon(il, hppIcons[HPP_ICON_SEARCHPROTECTED].Handle);
+ tbPassword.ImageIndex := ii;
+ ii := ImageList_AddIcon(il, hppIcons[HPP_ICON_BOOKMARK].Handle);
+ tbBookmarks.ImageIndex := ii;
+
+ ii := ImageList_AddIcon(il, hppIcons[HPP_ICON_HOTFILTER].Handle);
+ tbFilter.ImageIndex := ii;
+ ii := ImageList_AddIcon(il, hppIcons[HPP_ICON_HOTSEARCH].Handle);
+ tbSearch.ImageIndex := ii;
+
+ ii := ImageList_AddIcon(il, hppIcons[HPP_ICON_TOOL_COPY].Handle);
+ tbCopy.ImageIndex := ii;
+ ii := ImageList_AddIcon(il, hppIcons[HPP_ICON_TOOL_DELETE].Handle);
+ tbDelete.ImageIndex := ii;
+ ii := ImageList_AddIcon(il, hppIcons[HPP_ICON_TOOL_SAVE].Handle);
+ tbSave.ImageIndex := ii;
+
+ LoadEventFilterButton;
+end;
+
+procedure TfmGlobalSearch.lvContactsContextPopup(Sender: TObject; MousePos: TPoint;
+ var Handled: Boolean);
+var
+ Item: TListItem;
+ hContact: THandle;
+begin
+ Handled := True;
+ Item := TListItem(lvContacts.GetItemAt(MousePos.X, MousePos.Y));
+ if Item = nil then
+ exit;
+ hContact := THandle(Item.Data);
+ if hContact = 0 then
+ exit;
+ UserMenu := CallService(MS_CLIST_MENUBUILDCONTACT, hContact, 0);
+ if UserMenu <> 0 then
+ begin
+ UserMenuContact := hContact;
+ MousePos := lvContacts.ClientToScreen(MousePos);
+ Application.CancelHint;
+ TrackPopupMenu(UserMenu, TPM_TOPALIGN or TPM_LEFTALIGN or TPM_LEFTBUTTON, MousePos.X,
+ MousePos.Y, 0, Handle, nil);
+ DestroyMenu(UserMenu);
+ UserMenu := 0;
+ // UserMenuContact := 0;
+ end;
+end;
+
+procedure TfmGlobalSearch.lvContactsSelectItem(Sender: TObject; Item: TListItem;
+ Selected: Boolean);
+var
+ hCont: THandle;
+ // i,Index: Integer;
+begin
+ if not Selected then
+ exit;
+
+ { Index := -1;
+ hCont := THANDLE(Item.Data);
+ for i := 0 to Length(History) - 1 do
+ if History[i].hContact = hCont then begin
+ Index := i;
+ break;
+ end;
+ if Index = -1 then exit;
+ hg.Selected := Index; }
+
+ // OXY: try to make selected item the topmost
+ // while hg.GetFirstVisible <> Index do begin
+ // if hg.VertScrollBar.Position = hg.VertScrollBar.Range then break;
+ // hg.VertScrollBar.Position := hg.VertScrollBar.Position + 1;
+ // end;
+
+ if Item.Index = 0 then
+ DisableFilter
+ else
+ begin
+ hCont := THANDLE(Item.Data);
+ FilterOnContact(hCont);
+ end;
+end;
+
+procedure TfmGlobalSearch.OnCNChar(var Message: TWMChar);
+// make tabs work!
+begin
+ if not(csDesigning in ComponentState) then
+ with Message do
+ begin
+ Result := 1;
+ if (Perform(WM_GETDLGCODE, 0, 0) and DLGC_WANTCHARS = 0) and
+ (GetParentForm(Self).Perform(CM_DIALOGCHAR, CharCode, KeyData) <> 0) then
+ exit;
+ Result := 0;
+ end;
+end;
+
+procedure TfmGlobalSearch.OrganizePanels;
+var
+ PrevPanel: TPanel;
+begin
+ PrevPanel := paSearch;
+ if paAdvanced.Visible then
+ begin
+ paAdvanced.Top := PrevPanel.Top + PrevPanel.Width;
+ PrevPanel := paAdvanced;
+ end;
+ if paRange.Visible then
+ begin
+ paRange.Top := PrevPanel.Top + PrevPanel.Width;
+ PrevPanel := paRange;
+ end;
+ if paEvents.Visible then
+ begin
+ paEvents.Top := PrevPanel.Top + PrevPanel.Width;
+ PrevPanel := paEvents;
+ end;
+ if paPassword.Visible then
+ begin
+ paPassword.Top := PrevPanel.Top + PrevPanel.Width;
+ // PrevPanel := paPassword;
+ end;
+end;
+
+procedure TfmGlobalSearch.pbFilterPaint(Sender: TObject);
+var
+ ic: hIcon;
+begin
+ if tiFilter.Enabled then
+ ic := hppIcons[HPP_ICON_HOTFILTERWAIT].Handle
+ else
+ ic := hppIcons[HPP_ICON_HOTFILTER].Handle;
+
+ DrawiconEx(pbFilter.Canvas.Handle, 0, 0, ic, 16, 16, 0, pbFilter.Canvas.Brush.Handle,
+ DI_NORMAL);
+end;
+
+procedure TfmGlobalSearch.pmEventsFilterPopup(Sender: TObject);
+var
+ i: Integer;
+ pmi, mi: TMenuItem;
+begin
+ if Customize1.Parent <> pmEventsFilter.Items then
+ begin
+ pmi := TMenuItem(Customize1.Parent);
+ for i := pmi.Count - 1 downto 0 do
+ begin
+ mi := TMenuItem(pmi.Items[i]);
+ pmi.Remove(mi);
+ pmEventsFilter.Items.Insert(0, mi);
+ end;
+ end;
+ Application.CancelHint;
+end;
+
+procedure TfmGlobalSearch.ReplyQuoted(Item: Integer);
+begin
+ if (GetSearchItem(Item).Contact.Handle = 0) or (hg.SelCount = 0) then
+ exit;
+ SendMessageTo(GetSearchItem(Item).Contact.Handle,
+ hg.FormatSelected(GridOptions.ReplyQuotedFormat));
+end;
+
+procedure TfmGlobalSearch.ReplyQuoted1Click(Sender: TObject);
+begin
+ if hg.Selected <> -1 then
+ begin
+ if GetSearchItem(hg.Selected).Contact.Handle = 0 then
+ exit;
+ ReplyQuoted(hg.Selected);
+ end;
+end;
+
+procedure TfmGlobalSearch.tbSaveClick(Sender: TObject);
+var
+ t, t1: String;
+ SaveFormat: TSaveFormat;
+ RecentFormat: TSaveFormat;
+begin
+ if hg.Selected = -1 then
+ exit;
+ RecentFormat := TSaveFormat(GetDBInt(hppDBName, 'ExportFormat', 0));
+ SaveFormat := RecentFormat;
+ PrepareSaveDialog(SaveDialog, SaveFormat, True);
+ t1 := TranslateW('Partial History [%s] - [%s]');
+ t1 := Format(t1, [hg.ProfileName, hg.ContactName]);
+ t := MakeFileName(t1);
+ SaveDialog.FileName := t;
+ if not SaveDialog.Execute then
+ exit;
+ for SaveFormat := High(SaveFormats) downto Low(SaveFormats) do
+ if SaveDialog.FilterIndex = SaveFormats[SaveFormat].Index then
+ break;
+ if SaveFormat <> sfAll then
+ RecentFormat := SaveFormat;
+ hg.SaveSelected(SaveDialog.Files[0], RecentFormat);
+ WriteDBInt(hppDBName, 'ExportFormat', Integer(RecentFormat));
+end;
+
+procedure TfmGlobalSearch.SavePosition;
+begin
+ // Utils_SaveWindowPosition(Self.Handle,0,'HistoryPlusPlus','GlobalSearchWindow.');
+ Utils_SaveFormPosition(Self, 0, hppDBName, 'GlobalSearchWindow.');
+ // if we are password-protected (cbPass.Enabled) and
+ // have PROTSEL (GetPassMode = PASSMODE_PROTSEL) then save
+ // checkbox to DB
+ WriteDBBool(hppDBName, 'GlobalSearchWindow.PassChecked', paPassword.Visible);
+
+ WriteDBInt(hppDBName, 'GlobalSearchWindow.ContactListWidth', paContacts.Width);
+
+ WriteDBBool(hppDBName, 'GlobalSearchWindow.ShowAdvanced', paAdvanced.Visible);
+ if rbAny.Checked then
+ WriteDBInt(hppDBName, 'GlobalSearchWindow.AdvancedOptions', 0)
+ else if rbAll.Checked then
+ WriteDBInt(hppDBName, 'GlobalSearchWindow.AdvancedOptions', 1)
+ else
+ WriteDBInt(hppDBName, 'GlobalSearchWindow.AdvancedOptions', 2);
+
+ WriteDBBool(hppDBName, 'GlobalSearchWindow.ShowRange', paRange.Visible);
+ WriteDBBool(hppDBName, 'GlobalSearchWindow.ShowEvents', paEvents.Visible);
+
+ if Trunc(dtRange1.Date) = Trunc(Now) then
+ DBDelete(hppDBName, 'GlobalSearchWindow.RangeFrom')
+ else
+ WriteDBDateTime(hppDBName, 'GlobalSearchWindow.RangeFrom', Trunc(dtRange1.Date));
+ if Trunc(dtRange2.Date) = Trunc(Now) then
+ DBDelete(hppDBName, 'GlobalSearchWindow.RangeTo')
+ else
+ WriteDBDateTime(hppDBName, 'GlobalSearchWindow.RangeTo', Trunc(dtRange2.Date));
+
+ WriteDBWideStr(hppDBName, 'GlobalSearchWindow.LastSearch', edSearch.Text);
+end;
+
+procedure TfmGlobalSearch.edSearchKeyPress(Sender: TObject; var Key: Char);
+begin
+ // to prevent ** BLING ** when press Enter
+ // to prevent ** BLING ** when press Tab
+ // to prevent ** BLING ** when press Esc
+ if Ord(Key) in [VK_RETURN, VK_TAB, VK_ESCAPE] then
+ Key := #0;
+end;
+
+procedure TfmGlobalSearch.edSearchKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+ if (Key = VK_RETURN) and bnSearch.Enabled then
+ bnSearch.Click;
+end;
+
+procedure TfmGlobalSearch.EndHotFilterTimer;
+begin
+ tiFilter.Enabled := False;
+ HotFilterString := edFilter.Text;
+ hg.GridUpdate([guFilter]);
+ if pbFilter.Tag <> 0 then
+ begin
+ pbFilter.Tag := 0;
+ pbFilter.Repaint;
+ end;
+end;
+
+procedure TfmGlobalSearch.EventsFilterItemClick(Sender: TObject);
+begin
+ SetEventFilter(TMenuItem(Sender).Tag);
+end;
+
+function TfmGlobalSearch.IsFileEvent(Index: Integer): Boolean;
+begin
+ Result := (Index <> -1) and (mtFile in hg.Items[Index].MessageType);
+ if Result then
+ begin
+ SavedLinkUrl := ExtractFileName(String(hg.Items[Index].Extended));
+ SavedFileDir := ExtractFileDir(String(hg.Items[Index].Extended));
+ end;
+end;
+
+procedure TfmGlobalSearch.hgPopup(Sender: TObject);
+begin
+ SpeakMessage1.Visible := MeSpeakEnabled;
+ Delete1.Visible := False;
+ SaveSelected1.Visible := False;
+ if hg.Selected <> -1 then
+ begin
+ Delete1.Visible := True;
+ SaveSelected1.Visible := (hg.SelCount > 1);
+ if GetSearchItem(hg.Selected).Contact.Handle = 0 then
+ begin
+ SendMessage1.Visible := False;
+ ReplyQuoted1.Visible := False;
+ end;
+ if hg.Items[hg.Selected].Bookmarked then
+ Bookmark1.Caption := TranslateW('Remove &Bookmark')
+ else
+ Bookmark1.Caption := TranslateW('Set &Bookmark');
+ FileActions.Visible := IsFileEvent(hg.Selected);
+ if FileActions.Visible then
+ OpenFileFolder.Visible := (SavedFileDir <> '');
+ pmGrid.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
+ end;
+end;
+
+procedure TfmGlobalSearch.hgProcessRichText(Sender: TObject; Handle: Cardinal; Item: Integer);
+var
+ ItemRenderDetails: TItemRenderDetails;
+begin
+ ZeroMemory(@ItemRenderDetails, SizeOf(ItemRenderDetails));
+ ItemRenderDetails.cbSize := SizeOf(ItemRenderDetails);
+ ItemRenderDetails.hContact := GetSearchItem(Item).Contact.Handle;
+ ItemRenderDetails.hDBEvent := GetSearchItem(Item).hDBEvent;
+ ItemRenderDetails.pProto := PAnsiChar(hg.Items[Item].Proto);
+ ItemRenderDetails.pModule := PAnsiChar(hg.Items[Item].Module);
+ ItemRenderDetails.pText := nil;
+ ItemRenderDetails.pExtended := PAnsiChar(hg.Items[Item].Extended);
+ ItemRenderDetails.dwEventTime := hg.Items[Item].Time;
+ ItemRenderDetails.wEventType := hg.Items[Item].EventType;
+ ItemRenderDetails.IsEventSent := (mtOutgoing in hg.Items[Item].MessageType);
+
+ if Handle = hg.InlineRichEdit.Handle then
+ ItemRenderDetails.dwFlags := ItemRenderDetails.dwFlags or IRDF_INLINE;
+ if hg.IsSelected(Item) then
+ ItemRenderDetails.dwFlags := ItemRenderDetails.dwFlags or IRDF_SELECTED;
+
+ ItemRenderDetails.bHistoryWindow := IRDHW_GLOBALSEARCH;
+
+ NotifyEventHooks(hHppRichEditItemProcess, Handle, LPARAM(@ItemRenderDetails));
+end;
+
+procedure TfmGlobalSearch.hgTranslateTime(Sender: TObject; Time: Cardinal; var Text: String);
+begin
+ Text := TimestampToString(Time);
+end;
+
+procedure TfmGlobalSearch.HookEvents;
+begin
+ hHookContactIconChanged := HookEventMessage(ME_CLIST_CONTACTICONCHANGED,
+ Self.Handle, HM_SRCH_CONTACTICONCHANGED);
+end;
+
+procedure TfmGlobalSearch.UnhookEvents;
+begin
+ UnhookEvent(hHookContactIconChanged);
+end;
+
+procedure TfmGlobalSearch.WndProc(var Message: TMessage);
+begin
+ case Message.Msg of
+ WM_COMMAND:
+ begin
+ if mmAcc.DispatchCommand(Message.wParam) then
+ exit;
+ inherited;
+ if Message.Result <> 0 then
+ exit;
+ Message.Result := CallService(MS_CLIST_MENUPROCESSCOMMAND,
+ MAKEWPARAM(Message.WParamLo, MPCF_CONTACTMENU), UserMenuContact);
+ exit;
+ end;
+ WM_MEASUREITEM:
+ if Self.UserMenu <> 0 then
+ begin
+ Message.Result := CallService(MS_CLIST_MENUMEASUREITEM, Message.wParam,
+ Message.LParam);
+ if Message.Result <> 0 then
+ exit;
+ end;
+ WM_DRAWITEM:
+ if Self.UserMenu <> 0 then
+ begin
+ Message.Result := CallService(MS_CLIST_MENUDRAWITEM, Message.wParam,
+ Message.LParam);
+ if Message.Result <> 0 then
+ exit;
+ end;
+ end;
+ inherited;
+end;
+
+procedure TfmGlobalSearch.FormShow(Sender: TObject);
+var
+ PassMode: Byte;
+begin
+ paFilter.Visible := False;
+ ToggleAdvancedPanel(False);
+ ShowContacts(False);
+
+ IsSearching := False;
+ SearchThread := nil;
+
+ PassMode := GetPassMode;
+ if (PassMode = PASSMODE_PROTALL) then
+ TogglePasswordPanel(True);
+
+ hg.Codepage := hppCodepage;
+ hg.RTLMode := hppRTLDefault;
+ hg.TxtStartUp := TranslateW('Ready to search') + #10#13#10#13 +
+ TranslateW('Click Search button to start');
+ hg.Allocate(0);
+
+ LoadPosition;
+
+ HookEvents;
+
+ edSearch.SetFocus;
+ edSearch.SelectAll;
+ edSearchChange(Self);
+
+ CreateEventsFilterMenu;
+ // SetEventFilter(0);
+ SetEventFilter(GetShowAllEventsIndex);
+end;
+
+function TfmGlobalSearch.GetSearchItem(GridIndex: Integer): TSearchItem;
+begin
+ if not FFiltered then
+ Result := History[GridIndex]
+ else
+ Result := History[FilterHistory[GridIndex]];
+end;
+
+function TfmGlobalSearch.GetContactInfo(hContact: THandle): THPPContactInfo;
+var
+ i: Integer;
+begin
+ Result := nil;
+ for i := 0 to ContactList.Count - 1 do
+ if hContact = THPPContactInfo(ContactList.Items[i]).Handle then
+ begin
+ Result := THPPContactInfo(ContactList.Items[i]);
+ break;
+ end;
+end;
+
+procedure TfmGlobalSearch.HMContactDeleted(var M: TMessage);
+// var
+// ci: THPPContactInfo;
+// i: Integer;
+begin
+ { wParam - hContact; lParam - zero }
+ // do here something because the contact is deleted
+ if IsSearching then
+ exit;
+ // need to remove contact
+ // ci := GetContactInfo(M.WParam);
+ // if ci = nil then exit;
+ // for i := 1 to lvContacts.Items.Count - 1 do
+ // if ci.Handle = THandle(lvContacts.Items[i].Data) then begin
+ // lvContacts.Items.Delete(i);
+ // break;
+ // end;
+ // ContactList.Remove(ci);
+end;
+
+procedure TfmGlobalSearch.HMNickChanged(var M: TMessage);
+var
+ ci: THPPContactInfo;
+ i: Integer;
+ SubContact: THandle;
+ SubProtocol: AnsiString;
+begin
+ { wParam - hContact; lParam - zero }
+ if IsSearching then
+ exit;
+ ci := GetContactInfo(M.wParam);
+ if ci = nil then
+ exit;
+ GetContactProto(CurContact, SubContact, SubProtocol);
+ ci.ProfileName := GetContactDisplayName(0, SubProtocol);
+ ci.Name := GetContactDisplayName(ci.Handle, ci.Proto, True);
+ for i := 1 to lvContacts.Items.Count - 1 do
+ if M.wParam = THandle(lvContacts.Items[i].Data) then
+ begin
+ lvContacts.Items[i].Caption := ci.Name;
+ break;
+ end;
+ hg.Invalidate;
+end;
+
+procedure TfmGlobalSearch.HMContactIconChanged(var M: TMessage);
+var
+ i: Integer;
+begin
+ { wParam - hContact; lParam - IconID }
+ // contact icon has changed
+ // meTest.Lines.Add(GetContactDisplayName(M.wParam)+' changed icon to '+IntToStr(m.LParam));
+ if not paContacts.Visible then
+ exit;
+ for i := 0 to lvContacts.Items.Count - 1 do
+ begin
+ if THandle(M.wParam) = THandle(lvContacts.Items[i].Data) then
+ begin
+ lvContacts.Items[i].ImageIndex := Integer(M.LParam);
+ break;
+ end;
+ end;
+end;
+
+procedure TfmGlobalSearch.HMEventDeleted(var M: TMessage);
+var
+ i: Integer;
+begin
+ { wParam - hContact; lParam - hDBEvent }
+ if hg.State = gsDelete then
+ exit;
+ // if WPARAM(message.wParam) <> hContact then exit;
+ for i := 0 to hg.Count - 1 do
+ if GetSearchItem(i).hDBEvent = THandle(M.LParam) then
+ begin
+ hg.Delete(i);
+ hgState(hg, hg.State);
+ exit;
+ end;
+ // if event is not in filter, we must search the overall array
+ if FFiltered then
+ begin
+ i := FindHistoryItemByHandle(M.LParam);
+ if i <> -1 then
+ DeleteEventFromLists(i);
+ end;
+end;
+
+procedure TfmGlobalSearch.HMFiltersChanged(var M: TMessage);
+begin
+ CreateEventsFilterMenu;
+ SetEventFilter(0);
+end;
+
+procedure TfmGlobalSearch.HMIcons2Changed(var M: TMessage);
+begin
+ Icon.Handle := CopyIcon(hppIcons[HPP_ICON_GLOBALSEARCH].Handle);
+ LoadToolbarIcons;
+ LoadButtonIcons;
+ LoadContactsIcons;
+ pbFilter.Repaint;
+ // hg.Repaint;
+end;
+
+procedure TfmGlobalSearch.mmHideMenuClick(Sender: TObject);
+begin
+ WriteDBBool(hppDBName, 'Accessability', False);
+ NotifyAllForms(HM_NOTF_ACCCHANGED, WPARAM(False), 0);
+end;
+
+procedure TfmGlobalSearch.HMAccChanged(var M: TMessage);
+begin
+ ToggleMainMenu(Boolean(M.wParam));
+end;
+
+procedure TfmGlobalSearch.HMBookmarksChanged(var M: TMessage);
+var
+ i: Integer;
+ Found: Boolean;
+begin
+ Found := False;
+ for i := 0 to hg.Count - 1 do
+ if GetSearchItem(i).hDBEvent = THandle(M.LParam) then
+ begin
+ hg.ResetItem(i);
+ Found := True;
+ break;
+ end;
+ if Found then
+ hg.Repaint;
+end;
+
+procedure TfmGlobalSearch.HMPreShutdown(var M: TMessage);
+begin
+ Close;
+end;
+
+procedure TfmGlobalSearch.hgKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+var
+ pm: TPopupMenu;
+begin
+ if hg.State = gsInline then
+ pm := pmInline
+ else
+ pm := pmGrid;
+
+ if IsFormShortCut([pm], Key, Shift) then
+ begin
+ Key := 0;
+ exit;
+ end;
+
+ WasReturnPressed := (Key = VK_RETURN);
+end;
+
+procedure TfmGlobalSearch.hgKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+ if not WasReturnPressed then
+ exit;
+
+ if (Key = VK_RETURN) and (Shift = []) then
+ begin
+ if hg.Selected <> -1 then
+ hg.EditInline(hg.Selected);
+ end;
+ if (Key = VK_RETURN) and (Shift = [ssCtrl]) then
+ begin
+ hgDblClick(hg);
+ end;
+end;
+
+procedure TfmGlobalSearch.hgNameData(Sender: TObject; Index: Integer; var Name: String);
+var
+ si: TSearchItem;
+begin
+ si := GetSearchItem(Index);
+ if FFiltered then
+ begin
+ if mtIncoming in hg.Items[Index].MessageType then
+ Name := si.Contact.Name
+ else if not GridOptions.ForceProfileName then
+ Name := si.Contact.ProfileName;
+ end
+ else
+ begin
+ if mtIncoming in hg.Items[Index].MessageType then
+ Name := WideFormat(TranslateW('From %s'), [si.Contact.Name])
+ else
+ Name := WideFormat(TranslateW('To %s'), [si.Contact.Name]);
+ end;
+ // there should be anoter way to use bookmarks names
+ // if IsBookmarksMode then
+ // Name := Name + ' [' + BookmarkServer[si.Contact.Handle].BookmarkName[si.hDBEvent] + ']';
+end;
+
+procedure TfmGlobalSearch.hgUrlClick(Sender: TObject; Item: Integer; URLText: String;
+ Button: TMouseButton);
+begin
+ if URLText = '' then
+ exit;
+ if (Button = mbLeft) or (Button = mbMiddle) then
+ OpenUrl(URLText, True)
+ else
+ begin
+ SavedLinkUrl := URLText;
+ pmLink.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
+ end;
+end;
+
+procedure TfmGlobalSearch.edPassKeyPress(Sender: TObject; var Key: Char);
+begin
+ // to prevent ** BLING ** when press Enter
+ // to prevent ** BLING ** when press Tab
+ // to prevent ** BLING ** when press Esc
+ if Ord(Key) in [VK_RETURN, VK_TAB, VK_ESCAPE] then
+ Key := #0;
+end;
+
+procedure TfmGlobalSearch.edPassKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+ if Key = VK_RETURN then
+ begin
+ bnSearch.Click;
+ Key := 0;
+ end;
+end;
+
+procedure TfmGlobalSearch.ShowContacts(Show: Boolean);
+begin
+ paContacts.Visible := Show;
+ spContacts.Visible := Show;
+ if (Show) and (paContacts.Width > 0) then
+ spContacts.Left := paContacts.Width + paContacts.Left + 1;
+end;
+
+procedure TfmGlobalSearch.SearchNext(Rev: Boolean; Warp: Boolean = True);
+var
+ stext: String;
+ res: Integer;
+ mcase, Down: Boolean;
+ WndHandle: HWND;
+begin
+ stext := HotString;
+ mcase := False;
+ if stext = '' then
+ exit;
+ Down := not hg.Reversed;
+ if Rev then
+ Down := not Down;
+ res := hg.Search(stext, mcase, not Warp, False, Warp, Down);
+ if res <> -1 then
+ begin
+ // found
+ hg.Selected := res;
+ sb.SimpleText := Format(TranslateW('HotSearch: %s (F3 to find next)'), [stext]);
+ end
+ else
+ begin
+ WndHandle := Handle;
+ // not found
+ if Warp and (Down = not hg.Reversed) then
+ begin
+ // do warp?
+ if HppMessageBox(WndHandle, TranslateW('You have reached the end of the history.') +
+ #10#13 + TranslateW('Do you want to continue searching at the beginning?'),
+ TranslateW('History++ Search'), MB_YESNOCANCEL or MB_DEFBUTTON1 or MB_ICONQUESTION) = ID_YES
+ then
+ SearchNext(Rev, False);
+ end
+ else
+ begin
+ // not warped
+ hgState(Self, gsIdle);
+ HppMessageBox(WndHandle, WideFormat('"%s" not found', [stext]),
+ TranslateW('History++ Search'), MB_OK or MB_DEFBUTTON1 or 0);
+ end;
+ end;
+end;
+
+procedure TfmGlobalSearch.SendMessage1Click(Sender: TObject);
+begin
+ if hg.Selected <> -1 then
+ begin
+ if GetSearchItem(hg.Selected).Contact.Handle = 0 then
+ exit;
+ SendMessageTo(GetSearchItem(hg.Selected).Contact.Handle);
+ end;
+end;
+
+procedure TfmGlobalSearch.SetEventFilter(FilterIndex: Integer);
+var
+ i, fi: Integer;
+ mi: TMenuItem;
+begin
+ if FilterIndex = -1 then
+ begin
+ fi := tbEventsFilter.Tag + 1;
+ if fi > High(hppEventFilters) then
+ fi := 0;
+ end
+ else
+ fi := FilterIndex;
+
+ tbEventsFilter.Tag := fi;
+ LoadEventFilterButton;
+ // tbEventsFilter.Repaint;
+ mi := TMenuItem(Customize1.Parent);
+ for i := 0 to mi.Count - 1 do
+ if mi[i].RadioItem then
+ mi[i].Checked := (mi[i].Tag = fi);
+
+ hg.Filter := hppEventFilters[fi].Events;
+end;
+
+procedure TfmGlobalSearch.SetRecentEventsPosition(OnTop: Boolean);
+begin
+ hg.Reversed := not OnTop;
+end;
+
+procedure TfmGlobalSearch.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+var
+ Mask: Integer;
+begin
+ if (Key = VK_ESCAPE) or ((Key = VK_F4) and (ssAlt in Shift)) then
+ begin
+ if (Key = VK_ESCAPE) and IsSearching then
+ StopSearching
+ else
+ Close;
+ Key := 0;
+ exit;
+ end;
+
+ if (Key = VK_F10) and (Shift = []) then
+ begin
+ WriteDBBool(hppDBName, 'Accessability', True);
+ NotifyAllForms(HM_NOTF_ACCCHANGED, WPARAM(True), 0);
+ Key := 0;
+ exit;
+ end;
+
+ if (Key = VK_F3) and ((Shift = []) or (Shift = [ssShift])) and (Length(History) > 0) then
+ begin
+ SearchNext(ssShift in Shift, True);
+ Key := 0;
+ end;
+
+ if hg.State = gsInline then
+ exit;
+
+ if IsFormShortCut([mmAcc], Key, Shift) then
+ begin
+ Key := 0;
+ exit;
+ end;
+
+ with Sender as TWinControl do
+ begin
+ if Perform(CM_CHILDKEY, Key, LParam(Sender)) <> 0 then
+ exit;
+ Mask := 0;
+ case Key of
+ VK_TAB:
+ Mask := DLGC_WANTTAB;
+ VK_RETURN, VK_EXECUTE, VK_ESCAPE, VK_CANCEL:
+ Mask := DLGC_WANTALLKEYS;
+ end;
+ if (Mask <> 0) and (Perform(CM_WANTSPECIALKEY, Key, 0) = 0) and
+ (Perform(WM_GETDLGCODE, 0, 0) and Mask = 0) and (Self.Perform(CM_DIALOGKEY, Key, 0) <> 0)
+ then
+ exit;
+ end;
+end;
+
+procedure TfmGlobalSearch.hgSearchFinished(Sender: TObject; Text: String; Found: Boolean);
+var
+ t: String;
+begin
+ if Text = '' then
+ begin
+ HotString := Text;
+ hgState(Self, gsIdle);
+ exit;
+ end;
+ HotString := Text;
+
+ if not Found then
+ t := HotString
+ else
+ t := Text;
+ sb.SimpleText := Format(TranslateW('HotSearch: %s (F3 to find next)'), [t]);
+end;
+
+procedure TfmGlobalSearch.hgSearchItem(Sender: TObject; Item, ID: Integer; var Found: Boolean);
+begin
+ Found := (THandle(ID) = GetSearchItem(Item).hDBEvent);
+end;
+
+procedure TfmGlobalSearch.hgSelect(Sender: TObject; Item, OldItem: Integer);
+{ var
+ i,hCont,Index: Integer; }
+begin
+ tbCopy.Enabled := (Item <> -1);
+ tbDelete.Enabled := (Item <> -1);
+ tbSave.Enabled := (hg.SelCount > 1);
+
+ if hg.HotString = '' then
+ begin
+ // redraw status bar
+ hgState(hg, gsIdle);
+ end;
+
+ { if Item = -1 then exit;
+ index := -1;
+ hCont := History[Item].hContact;
+ for i := 0 to lvContacts.Items.Count-1 do
+ if THandle(lvContacts.Items.Item[i].Data) = hCont then begin
+ Index := i;
+ break;
+ end;
+ if Index = -1 then exit;
+ lvContacts.OnSelectItem := nil;
+ lvContacts.Items.Item[index].MakeVisible(false);
+ lvContacts.Items.Item[index].Selected := true;
+ lvContacts.OnSelectItem := self.lvContactsSelectItem; }
+end;
+
+procedure TfmGlobalSearch.hgState(Sender: TObject; State: TGridState);
+var
+ t: String;
+begin
+ if csDestroying in ComponentState then
+ exit;
+ if IsSearching then
+ t := Format(TranslateW('Searching... %.0n items in %d contacts found'),
+ [Length(History) / 1, ContactsFound])
+ else
+ case State of
+ gsIdle:
+ t := Format
+ (TranslateW('%.0n items in %d contacts found. Searched for %.1f sec in %.0n items.'),
+ [Length(History) / 1, ContactsFound, stime / 1000, AllItems / 1]);
+ gsLoad:
+ t := TranslateW('Loading...');
+ gsSave:
+ t := TranslateW('Saving...');
+ gsSearch:
+ t := TranslateW('Searching...');
+ gsDelete:
+ t := TranslateW('Deleting...');
+ end;
+ sb.SimpleText := t;
+end;
+
+procedure TfmGlobalSearch.tbCopyClick(Sender: TObject);
+begin
+ if hg.Selected = -1 then
+ exit;
+ CopyToClip(hg.FormatSelected(GridOptions.ClipCopyFormat), Handle,
+ GetSearchItem(hg.Selected).Contact.Codepage);
+end;
+
+procedure TfmGlobalSearch.CopyText1Click(Sender: TObject);
+begin
+ if hg.Selected = -1 then
+ exit;
+ CopyToClip(hg.FormatSelected(GridOptions.ClipCopyTextFormat), Handle,
+ GetSearchItem(hg.Selected).Contact.Codepage);
+end;
+
+procedure TfmGlobalSearch.CreateEventsFilterMenu;
+var
+ i: Integer;
+ mi: TMenuItem;
+ ShowAllEventsIndex: Integer;
+begin
+ for i := pmEventsFilter.Items.Count - 1 downto 0 do
+ if pmEventsFilter.Items[i].RadioItem then
+ pmEventsFilter.Items.Delete(i);
+ cbEvents.Items.Clear;
+
+ ShowAllEventsIndex := GetShowAllEventsIndex;
+ for i := 0 to High(hppEventFilters) do
+ begin
+ mi := TMenuItem.Create(pmEventsFilter);
+ mi.Caption := StringReplace(hppEventFilters[i].Name, '&', '&&', [rfReplaceAll]);
+ mi.GroupIndex := 1;
+ mi.RadioItem := True;
+ mi.Tag := i;
+ mi.OnClick := EventsFilterItemClick;
+ if i = ShowAllEventsIndex then
+ mi.Default := True;
+ pmEventsFilter.Items.Insert(i, mi);
+ cbEvents.Items.Insert(i, mi.Caption);
+ end;
+
+ cbEvents.DropDownCount := Length(hppEventFilters);
+ cbEvents.ItemIndex := ShowAllEventsIndex;
+end;
+
+procedure TfmGlobalSearch.Customize1Click(Sender: TObject);
+begin
+ if not Assigned(fmCustomizeFilters) then
+ begin
+ CustomizeFiltersForm := TfmCustomizeFilters.Create(Self);
+ CustomizeFiltersForm.Show;
+ end
+ else
+ begin
+ BringFormToFront(fmCustomizeFilters);
+ end;
+end;
+
+procedure TfmGlobalSearch.tbDeleteClick(Sender: TObject);
+begin
+ if hg.SelCount = 0 then
+ exit;
+ if hg.SelCount > 1 then
+ begin
+ if HppMessageBox(Handle,
+ WideFormat(TranslateW('Do you really want to delete selected items (%.0f)?'),
+ [hg.SelCount / 1]), TranslateW('Delete Selected'), MB_YESNOCANCEL or MB_DEFBUTTON1 or
+ MB_ICONQUESTION) <> IDYES then
+ exit;
+ end
+ else
+ begin
+ if HppMessageBox(Handle, TranslateW('Do you really want to delete selected item?'),
+ TranslateW('Delete'), MB_YESNOCANCEL or MB_DEFBUTTON1 or MB_ICONQUESTION) <> IDYES then
+ exit;
+ end;
+ SetSafetyMode(False);
+ try
+ FormState := gsDelete;
+ hg.DeleteSelected;
+ FormState := gsIdle;
+ finally
+ SetSafetyMode(True);
+ end;
+end;
+
+procedure TfmGlobalSearch.hgRTLEnabled(Sender: TObject; BiDiMode: TBiDiMode);
+begin
+ edPass.BiDiMode := BiDiMode;
+ edSearch.BiDiMode := BiDiMode;
+ edFilter.BiDiMode := BiDiMode;
+ dtRange1.BiDiMode := BiDiMode;
+ dtRange2.BiDiMode := BiDiMode;
+ // lvContacts.BiDiMode := BiDiMode;
+end;
+
+procedure TfmGlobalSearch.Bookmark1Click(Sender: TObject);
+var
+ val: Boolean;
+ hDBEvent: THandle;
+begin
+ hDBEvent := GetSearchItem(hg.Selected).hDBEvent;
+ val := not BookmarkServer[GetSearchItem(hg.Selected).Contact.Handle].Bookmarked[hDBEvent];
+ BookmarkServer[GetSearchItem(hg.Selected).Contact.Handle].Bookmarked[hDBEvent] := val;
+end;
+
+procedure TfmGlobalSearch.hgInlinePopup(Sender: TObject);
+begin
+ InlineCopy.Enabled := hg.InlineRichEdit.SelLength > 0;
+ InlineReplyQuoted.Enabled := InlineCopy.Enabled;
+ InlineTextFormatting.Checked := GridOptions.TextFormatting;
+ if hg.Selected <> -1 then
+ begin
+ InlineSendMessage.Visible := (GetSearchItem(hg.Selected).Contact.Handle <> 0);
+ InlineReplyQuoted.Visible := (GetSearchItem(hg.Selected).Contact.Handle <> 0);
+ end;
+ pmInline.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
+end;
+
+procedure TfmGlobalSearch.InlineCopyClick(Sender: TObject);
+begin
+ if hg.InlineRichEdit.SelLength = 0 then
+ exit;
+ hg.InlineRichEdit.CopyToClipboard;
+end;
+
+procedure TfmGlobalSearch.InlineCopyAllClick(Sender: TObject);
+var
+ cr: TCharRange;
+begin
+ hg.InlineRichEdit.Lines.BeginUpdate;
+ hg.InlineRichEdit.Perform(EM_EXGETSEL, 0, LParam(@cr));
+ hg.InlineRichEdit.SelectAll;
+ hg.InlineRichEdit.CopyToClipboard;
+ hg.InlineRichEdit.Perform(EM_EXSETSEL, 0, LParam(@cr));
+ hg.InlineRichEdit.Lines.EndUpdate;
+end;
+
+procedure TfmGlobalSearch.InlineSelectAllClick(Sender: TObject);
+begin
+ hg.InlineRichEdit.SelectAll;
+end;
+
+procedure TfmGlobalSearch.InlineTextFormattingClick(Sender: TObject);
+begin
+ GridOptions.TextFormatting := not GridOptions.TextFormatting;
+end;
+
+procedure TfmGlobalSearch.InlineReplyQuotedClick(Sender: TObject);
+begin
+ if hg.Selected <> -1 then
+ begin
+ if GetSearchItem(hg.Selected).Contact.Handle = 0 then
+ exit;
+ if hg.InlineRichEdit.SelLength = 0 then
+ exit;
+ SendMessageTo(GetSearchItem(hg.Selected).Contact.Handle,
+ hg.FormatSelected(GridOptions.ReplyQuotedTextFormat));
+ end;
+end;
+
+procedure TfmGlobalSearch.hgInlineKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+ if IsFormShortCut([mmAcc, pmInline], Key, Shift) then
+ begin
+ Key := 0;
+ exit;
+ end;
+ { if (ssCtrl in Shift) then begin
+ if key=Ord('T') then begin
+ InlineCopyAll.Click;
+ key:=0;
+ end;
+ if key=Ord('P') then begin
+ InlineTextFormatting.Click;
+ key:=0;
+ end;
+ if key=Ord('M') then begin
+ SendMessage1.Click;
+ key:=0;
+ end;
+ if key=Ord('R') then begin
+ InlineReplyQuoted.Click;
+ key:=0;
+ end;
+ end; }
+end;
+
+procedure TfmGlobalSearch.OpenLinkClick(Sender: TObject);
+begin
+ if SavedLinkUrl = '' then
+ exit;
+ OpenUrl(SavedLinkUrl, False);
+ SavedLinkUrl := '';
+end;
+
+procedure TfmGlobalSearch.OpenLinkNWClick(Sender: TObject);
+begin
+ if SavedLinkUrl = '' then
+ exit;
+ OpenUrl(SavedLinkUrl, True);
+ SavedLinkUrl := '';
+end;
+
+procedure TfmGlobalSearch.CopyLinkClick(Sender: TObject);
+begin
+ if SavedLinkUrl = '' then
+ exit;
+ CopyToClip(SavedLinkUrl, Handle, CP_ACP);
+ SavedLinkUrl := '';
+end;
+
+procedure TfmGlobalSearch.ToggleMainMenu(Enabled: Boolean);
+begin
+ if Enabled then
+ begin
+ ToolBar.EdgeBorders := [ebTop];
+ Menu := mmAcc
+ end
+ else
+ begin
+ ToolBar.EdgeBorders := [];
+ Menu := nil;
+ end;
+end;
+
+procedure TfmGlobalSearch.WMSysColorChange(var Message: TMessage);
+begin
+ inherited;
+ LoadToolbarIcons;
+ LoadButtonIcons;
+ Repaint;
+end;
+
+procedure TfmGlobalSearch.tbBookmarksClick(Sender: TObject);
+begin
+ if Sender <> tbBookmarks then
+ tbBookmarks.Down := not tbBookmarks.Down;
+ IsBookmarksMode := tbBookmarks.Down;
+
+ if IsSearching then
+ StopSearching;
+
+ paSearch.Visible := not IsBookmarksMode;
+ tbAdvanced.Enabled := not IsBookmarksMode;
+ ToggleAdvancedPanel(tbAdvanced.Down);
+ tbRange.Enabled := not IsBookmarksMode;
+ ToggleRangePanel(tbRange.Down);
+ tbEvents.Enabled := not IsBookmarksMode;
+ ToggleEventsPanel(tbEvents.Down);
+
+ if IsBookmarksMode then
+ bnSearch.Click
+ else if edSearch.CanFocus then
+ edSearch.SetFocus;
+end;
+
+procedure TfmGlobalSearch.SelectAll1Click(Sender: TObject);
+begin
+ hg.SelectAll;
+end;
+
+procedure TfmGlobalSearch.OpenFileFolderClick(Sender: TObject);
+begin
+ if SavedFileDir = '' then
+ exit;
+ ShellExecuteW(0, 'open', PWideChar(SavedFileDir), nil, nil, SW_SHOW);
+ SavedFileDir := '';
+end;
+
+procedure TfmGlobalSearch.BrowseReceivedFilesClick(Sender: TObject);
+var
+ Path: Array [0 .. MAX_PATH] of AnsiChar;
+ hContact: THandle;
+begin
+ hContact := GetSearchItem(hg.Selected).Contact.Handle;
+ CallService(MS_FILE_GETRECEIVEDFILESFOLDER, hContact, LParam(@Path));
+ ShellExecuteA(0, 'open', Path, nil, nil, SW_SHOW);
+end;
+
+procedure TfmGlobalSearch.tbEventsClick(Sender: TObject);
+begin
+ if Sender <> tbEvents then
+ tbEvents.Down := not tbEvents.Down;
+ ToggleEventsPanel(tbEvents.Down);
+end;
+
+procedure TfmGlobalSearch.sbEventsCloseClick(Sender: TObject);
+begin
+ ToggleEventsPanel(False);
+end;
+
+procedure TfmGlobalSearch.lvContactsDblClick(Sender: TObject);
+var
+ hContact: THandle;
+begin
+ if lvContacts.Selected = nil then
+ exit;
+ hContact := THandle(lvContacts.Selected.Data);
+ if hContact = 0 then
+ exit;
+ SendMessageTo(hContact);
+end;
+
+procedure TfmGlobalSearch.SpeakMessage1Click(Sender: TObject);
+var
+ mesW: String;
+ mesA: AnsiString;
+ hContact: THandle;
+begin
+ if not MeSpeakEnabled then
+ exit;
+ if hg.Selected = -1 then
+ exit;
+ hContact := GetSearchItem(hg.Selected).Contact.Handle;
+ mesW := hg.Items[hg.Selected].Text;
+ if GridOptions.BBCodesEnabled then
+ mesW := DoStripBBCodes(mesW);
+ if Boolean(ServiceExists(MS_SPEAK_SAY_W)) then
+ CallService(MS_SPEAK_SAY_W, hContact, LParam(PChar(mesW)))
+ else
+ begin
+ mesA := WideToAnsiString(mesW, GetSearchItem(hg.Selected).Contact.Codepage);
+ CallService(MS_SPEAK_SAY_A, hContact, LParam(PAnsiChar(mesA)));
+ end;
+end;
+
+procedure TfmGlobalSearch.hgChar(Sender: TObject; var achar: WideChar; Shift: TShiftState);
+var
+ Mes: TWMChar;
+begin
+ edFilter.SetFocus;
+ edFilter.SelStart := Length(edFilter.Text);
+ edFilter.SelLength := 0;
+ // edFilter.Text := AnsiChar;
+ ZeroMemory(@Mes, SizeOf(Mes));
+ Mes.Msg := WM_CHAR;
+ Mes.CharCode := Word(achar);
+ Mes.KeyData := ShiftStateToKeyData(Shift);
+ edFilter.Perform(WM_CHAR, TMessage(Mes).wParam, TMessage(Mes).LParam);
+ achar := #0;
+end;
+
+procedure TfmGlobalSearch.edFilterKeyPress(Sender: TObject; var Key: Char);
+begin
+ // to prevent ** BLING ** when press Enter
+ // to prevent ** BLING ** when press Tab
+ // to prevent ** BLING ** when press Esc
+ if Ord(Key) in [VK_RETURN, VK_TAB, VK_ESCAPE] then
+ Key := #0;
+end;
+
+initialization
+
+ fmGlobalSearch := nil;
+
+end.
diff --git a/plugins/HistoryPlusPlus/HistoryControls.pas b/plugins/HistoryPlusPlus/HistoryControls.pas new file mode 100644 index 0000000000..e0da805ab6 --- /dev/null +++ b/plugins/HistoryPlusPlus/HistoryControls.pas @@ -0,0 +1,477 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+unit HistoryControls;
+
+{$I compilers.inc}
+
+interface
+
+uses
+ Windows, Messages, Classes, Forms,
+ Controls, StdCtrls, ComCtrls, ExtCtrls, Buttons, Graphics;
+
+type
+
+ THppEdit = class(TEdit)
+ private
+ procedure WMChar(var Message: TWMKey); message WM_CHAR;
+ end;
+
+ THppToolBar = class(TToolBar)
+ private
+ procedure AddToolButtonStyle(const Control: TControl; var Style: Byte);
+ protected
+ procedure WndProc(var Message: TMessage); override;
+ end;
+
+ THppToolButton = class(TToolButton)
+ private
+ FWholeDropDown: Boolean; // ignored unless Style = tbsDropDown is set
+ procedure SetWholeDropDown(const Value: Boolean);
+ published
+ property WholeDropDown: Boolean read FWholeDropDown write SetWholeDropDown default False;
+ end;
+
+ THppSpeedButton = class(TSpeedButton)
+ protected
+ procedure Paint{Button}; override;
+ end;
+
+ THppGroupBox = class(TGroupBox)
+ protected
+ procedure Paint; override;
+ end;
+
+ THppForm = class(TForm)
+ private
+ FIconBig: TIcon;
+ function IsIconBigStored: Boolean;
+ procedure IconChanged(Sender: TObject);
+ procedure SetIcons(hIcon: HICON; hIconBig: HICON);
+ procedure SetIconBig(Value: TIcon);
+ procedure CMIconChanged(var Message: TMessage); message CM_ICONCHANGED;
+ protected
+ procedure CreateWnd; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ published
+ property IconBig: TIcon read FIconBig write SetIconBig stored IsIconBigStored;
+ end;
+
+ { //Saved for probably future use
+ THppSaveDialog = class(TSaveDialog)
+ private
+ FShowModal: Boolean;
+ public
+ constructor Create(AOwner: TComponent); override;
+ protected
+ function TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool; override;
+ published
+ property ShowModal: Boolean read FShowModal write FShowModal;
+ end;
+ }
+
+implementation
+
+uses CommCtrl, Themes, UxTheme, SysUtils, hpp_global;
+
+{ THppEdit }
+
+function IsWordSeparator(WC: WideChar): Boolean;
+begin
+ Result := (WC = WideChar(#0)) or IsWideCharSpace(WC) or IsWideCharPunct(WC);
+end;
+
+procedure THppEdit.WMChar(var Message: TWMKey);
+var
+ ss,sl: integer;
+ txt: String;
+ lastWS: Boolean;
+ currentWS: Boolean;
+begin
+ // Ctrl+Backspace workaround
+ if (Message.CharCode = 127) and (KeyDataToShiftState(Message.KeyData) = [ssCtrl]) then
+ begin
+ Message.Result := 0;
+ Perform(EM_GETSEL,wParam(@ss),lParam(@sl));
+ if (ss = 0) or (ss <> sl) then exit;
+ sl := 0;
+ txt := Text;
+ lastWS := IsWordSeparator(txt[ss]);
+ while ss > 0 do
+ begin
+ currentWS := IsWordSeparator(txt[ss]);
+ if not lastWS and currentWS then break;
+ lastWS := currentWS;
+ Dec(ss);
+ Inc(sl);
+ end;
+ Delete(txt,ss+1,sl);
+ Text := txt;
+ Perform(EM_SETSEL,wParam(@ss),lParam(@ss));
+ end
+ else
+ inherited;
+end;
+
+{ THppToolBar }
+
+procedure THppToolBar.AddToolButtonStyle(const Control: TControl; var Style: Byte);
+const
+ BTNS_WHOLEDROPDOWN = $0080;
+ WholeDropDownStyles: array[Boolean] of DWORD = (0, BTNS_WHOLEDROPDOWN);
+begin
+ if Control.InheritsFrom(THppToolButton) and
+ (GetComCtlVersion >= ComCtlVersionIE5) then
+ Style := Style or WholeDropDownStyles[THppToolButton(Control).WholeDropDown];
+end;
+
+procedure THppToolBar.WndProc(var Message: TMessage);
+var
+ BT: PTBButton;
+ BI: PTBButtonInfoW;
+begin
+ case Message.Msg of
+ TB_INSERTBUTTON: begin
+ BT := PTBButton(Message.LParam);
+ AddToolButtonStyle(TControl(BT.dwData), BT.fsStyle);
+ end;
+ TB_SETBUTTONINFO: begin
+ BI := PTBButtonInfoW(Message.LParam);
+ AddToolButtonStyle(TControl(BI.lParam), BI.fsStyle);
+ end;
+ end;
+ inherited;
+end;
+
+{ THppToolButton }
+
+// Note: ignored unless Style = tbsDropDown is set
+procedure THppToolButton.SetWholeDropDown(const Value: Boolean);
+begin
+ if FWholeDropDown = Value then exit;
+ FWholeDropDown := Value;
+ RefreshControl;
+ // Trick: resize tool buttons.
+ // TODO: refresh only when theme is loaded.
+ if Assigned(FToolBar) then FToolBar.Invalidate;
+ Width := 1;
+end;
+
+{ THppSpeedButton }
+
+type
+ EAbortPaint = class(EAbort);
+
+// hack to prepaint non transparent sppedbuttons with themed
+// parent control, such as doublebuffered toolbar.
+// VCL bug.
+procedure THppSpeedButton.Paint{Button};
+begin
+ {$IFDEF THEME_7_UP}
+ with ThemeServices do
+ if not Transparent and ThemesEnabled and Assigned(Parent) then
+ DrawParentBackground(Parent.Handle, Canvas.Handle, nil, True);
+ {$ENDIF}
+ inherited;
+end;
+
+
+{ THppGroupBox }
+
+procedure THppGroupBox.Paint;
+var
+ spCaption: String;
+
+ {$IFDEF THEME_7_UP}
+ procedure PaintThemedGroupBox;
+ var
+ CaptionRect: TRect;
+ OuterRect: TRect;
+ Box: TThemedButton;
+ Details: TThemedElementDetails;
+ begin
+ if Enabled then
+ Box := tbGroupBoxNormal
+ else
+ Box := tbGroupBoxDisabled;
+ Details := ThemeServices.GetElementDetails(Box);
+ with Canvas do
+ begin
+ if spCaption <> '' then
+ begin
+ with Details do
+ UxTheme.GetThemeTextExtent(ThemeServices.Theme[Element],Handle,
+ Part,State,PChar(spCaption),Length(spCaption),DT_LEFT, nil,CaptionRect);
+ if not UseRightToLeftAlignment then
+ OffsetRect(CaptionRect, 8, 0)
+ else
+ OffsetRect(CaptionRect, Width - 8 - CaptionRect.Right, 0);
+ end
+ else
+ CaptionRect := Rect(0, 0, 0, 0);
+
+ OuterRect := ClientRect;
+ OuterRect.Top := (CaptionRect.Bottom - CaptionRect.Top) div 2;
+ with CaptionRect do
+ ExcludeClipRect(Handle, Left, Top, Right, Bottom);
+ ThemeServices.DrawElement(Handle, Details, OuterRect);
+
+ SelectClipRgn(Handle, 0);
+ if Caption <> '' then
+ ThemeServices.DrawText(Handle, Details, spCaption, CaptionRect, DT_LEFT, 0);
+ end;
+ end;
+ {$ENDIF}
+
+ procedure PaintGroupBox;
+ var
+ H: Integer;
+ R: TRect;
+ Flags: Longint;
+ begin
+ with Canvas do
+ begin
+ H := Canvas.TextExtent('0').cY;
+ R := Rect(0, H div 2 - 1, Width, Height);
+ if Ctl3D then
+ begin
+ Inc(R.Left);
+ Inc(R.Top);
+ Brush.Color := clBtnHighlight;
+ FrameRect(R);
+ OffsetRect(R, -1, -1);
+ Brush.Color := clBtnShadow;
+ end
+ else
+ Brush.Color := clWindowFrame;
+ FrameRect(R);
+ if spCaption <> '' then
+ begin
+ if not UseRightToLeftAlignment then
+ R := Rect(8, 0, 0, H)
+ else
+ R := Rect(R.Right - Canvas.TextExtent(spCaption).cX - 8, 0, 0, H);
+ Flags := DrawTextBiDiModeFlags(DT_SINGLELINE);
+ DrawTextW(Handle, PChar(spCaption), Length(spCaption), R, Flags or DT_CALCRECT);
+ Brush.Color := Color;
+ DrawTextW(Handle, PChar(spCaption), Length(spCaption), R, Flags);
+ end;
+ end;
+ end;
+
+begin
+ spCaption := Caption;
+ if spCaption <> '' then
+ spCaption := ' '+spCaption+' ';
+ Canvas.Font := Self.Font;
+ {$IFDEF THEME_7_UP}
+ if ThemeServices.ThemesEnabled then
+ PaintThemedGroupBox
+ else
+ {$ENDIF}
+ PaintGroupBox;
+end;
+
+{ THppForm }
+
+function THppForm.IsIconBigStored: Boolean;
+begin
+ Result := (not IsControl) and (FIconBig.Handle <> 0);
+end;
+
+procedure THppForm.SetIcons(hIcon: HICON; hIconBig: HICON);
+begin
+ if NewStyleControls then
+ begin
+ if HandleAllocated and (BorderStyle <> bsDialog) then
+ begin
+ SendMessage(Handle, WM_SETICON, ICON_SMALL, hIcon);
+ SendMessage(Handle, WM_SETICON, ICON_BIG, hIconBig);
+ end;
+ end
+ else
+ if IsIconic(Handle) then Invalidate;
+end;
+
+procedure THppForm.IconChanged(Sender: TObject);
+begin
+ if FIconBig.Handle = 0 then
+ SetIcons(0, Icon.Handle)
+ else
+ SetIcons(Icon.Handle, FIconBig.Handle);
+end;
+
+procedure THppForm.SetIconBig(Value: TIcon);
+begin
+ FIconBig.Assign(Value);
+end;
+
+procedure THppForm.CMIconChanged(var Message: TMessage);
+begin
+ if (Icon.Handle = 0) or (FIconBig.Handle = 0) then
+ IconChanged(nil);
+end;
+
+procedure THppForm.CreateWnd;
+begin
+ inherited CreateWnd;
+ if NewStyleControls then
+ if BorderStyle <> bsDialog then
+ IconChanged(nil)
+ else
+ SetIcons(0, 0);
+end;
+
+constructor THppForm.Create(AOwner: TComponent);
+begin
+ FIconBig := TIcon.Create;
+ FIconBig.Width := GetSystemMetrics(SM_CXICON);
+ FIconBig.Height := GetSystemMetrics(SM_CYICON);
+ FIconBig.OnChange := IconChanged;
+ inherited Create(AOwner);
+ Icon.OnChange := IconChanged;
+end;
+
+destructor THppForm.Destroy;
+begin
+ inherited Destroy;
+ FIconBig.Free;
+end;
+
+{ THppSaveDialog }
+{ //Saved for probably future use
+
+type
+ THackCommonDialog = class(TComponent)
+ protected
+ FCtl3D: Boolean;
+ FDefWndProc: Pointer;
+ FHelpContext: THelpContext;
+ FHandle: HWnd;
+ FObjectInstance: Pointer;
+ FTemplate: PAnsiChar;
+ end;
+var
+ sCreationControl: TCommonDialog = nil;
+
+procedure CenterWindow(Wnd: HWnd);
+var
+ Rect: TRect;
+ Monitor: TMonitor;
+begin
+ GetWindowRect(Wnd, Rect);
+ if Application.MainForm <> nil then
+ begin
+ if Assigned(Screen.ActiveForm) then
+ Monitor := Screen.ActiveForm.Monitor
+ else
+ Monitor := Application.MainForm.Monitor;
+ end
+ else
+ Monitor := Screen.Monitors[0];
+ SetWindowPos(Wnd, 0,
+ Monitor.Left + ((Monitor.Width - Rect.Right + Rect.Left) div 2),
+ Monitor.Top + ((Monitor.Height - Rect.Bottom + Rect.Top) div 3),
+ 0, 0, SWP_NOACTIVATE or SWP_NOSIZE or SWP_NOZORDER);
+end;
+
+function DialogHook(Wnd: HWnd; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UINT; stdcall;
+begin
+ Result := 0;
+ if Msg = WM_INITDIALOG then
+ begin
+ CenterWindow(Wnd);
+ THackCommonDialog(sCreationControl).FHandle := Wnd;
+ THackCommonDialog(sCreationControl).FDefWndProc := Pointer(SetWindowLongPtr(Wnd, GWL_WNDPROC,
+ Longint(THackCommonDialog(sCreationControl).FObjectInstance)));
+ CallWindowProc(THackCommonDialog(sCreationControl).FObjectInstance, Wnd, Msg, WParam, LParam);
+ sCreationControl := nil;
+ end;
+end;
+
+function ExplorerHook(Wnd: HWnd; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UINT; stdcall;
+begin
+ Result := 0;
+ if Msg = WM_INITDIALOG then
+ begin
+ THackCommonDialog(sCreationControl).FHandle := Wnd;
+ THackCommonDialog(sCreationControl).FDefWndProc := Pointer(SetWindowLongPtr(Wnd, GWL_WNDPROC,
+ Longint(THackCommonDialog(sCreationControl).FObjectInstance)));
+ CallWindowProc(THackCommonDialog(sCreationControl).FObjectInstance, Wnd, Msg, WParam, LParam);
+ sCreationControl := nil;
+ end
+ else if (Msg = WM_NOTIFY) and (POFNotify(LParam)^.hdr.code = CDN_INITDONE) then
+ CenterWindow(GetWindowLongPtr(Wnd, GWLP_HWNDPARENT));
+end;
+
+constructor THppSaveDialog.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FShowModal := False;
+end;
+
+function THppSaveDialog.TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool;
+type
+ TDialogFunc = function(var DialogData): Bool stdcall;
+var
+ ActiveWindow: HWnd;
+ FPUControlWord: Word;
+ FocusState: TFocusState;
+ WasEnabled: Boolean;
+begin
+ if FShowModal then
+ Result := inherited TaskModalDialog(DialogFunc,DialogData)
+ else begin
+ if (ofOldStyleDialog in Options) or not NewStyleControls then
+ TOpenFilename(DialogData).lpfnHook := DialogHook else
+ TOpenFilename(DialogData).lpfnHook := ExplorerHook;
+ ActiveWindow := GetActiveWindow;
+ WasEnabled := IsWindowEnabled(ActiveWindow);
+ if WasEnabled then EnableWindow(ActiveWindow, False);
+ FocusState := SaveFocusState;
+ try
+ Application.HookMainWindow(MessageHook);
+ asm
+ // Avoid FPU control word change in NETRAP.dll, NETAPI32.dll, etc
+ FNSTCW FPUControlWord
+ end;
+ try
+ sCreationControl := Self;
+ Result := TDialogFunc(DialogFunc)(DialogData);
+ finally
+ asm
+ FNCLEX
+ FLDCW FPUControlWord
+ end;
+ Application.UnhookMainWindow(MessageHook);
+ end;
+ finally
+ if WasEnabled then EnableWindow(ActiveWindow, True);
+ SetActiveWindow(ActiveWindow);
+ RestoreFocusState(FocusState);
+ end;
+ end;
+end;}
+
+end.
diff --git a/plugins/HistoryPlusPlus/HistoryControls_Design.pas b/plugins/HistoryPlusPlus/HistoryControls_Design.pas new file mode 100644 index 0000000000..1f0c018d8f --- /dev/null +++ b/plugins/HistoryPlusPlus/HistoryControls_Design.pas @@ -0,0 +1,59 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+unit HistoryControls_Design;
+
+{$I compilers.inc}
+
+interface
+
+procedure Register;
+
+implementation
+
+uses Classes, HistoryControls, DesignIntf, DesignEditors;
+
+type
+
+ THppFormCustomModule = class(TCustomModule)
+ public
+ class function DesignClass: TComponentClass; override;
+ end;
+
+procedure Register;
+begin
+ RegisterComponents('History++', [THppEdit]);
+ RegisterComponents('History++', [THppToolBar]);
+ RegisterComponents('History++', [THppToolButton]);
+ RegisterComponents('History++', [THppSpeedButton]);
+ RegisterComponents('History++', [THppGroupBox]);
+ RegisterCustomModule(THppForm, THppFormCustomModule);
+ {RegisterComponents('History++', [THppSaveDialog]);}
+end;
+
+{ THppFormCustomModule }
+
+class function THppFormCustomModule.DesignClass: TComponentClass;
+begin
+ Result := THppForm;
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/HistoryForm.dfm b/plugins/HistoryPlusPlus/HistoryForm.dfm new file mode 100644 index 0000000000..c3d1d49214 --- /dev/null +++ b/plugins/HistoryPlusPlus/HistoryForm.dfm @@ -0,0 +1,1011 @@ +object HistoryFrm: THistoryFrm
+ Left = 245
+ Top = 167
+ Width = 586
+ Height = 424
+ VertScrollBar.Tracking = True
+ VertScrollBar.Visible = False
+ ActiveControl = hg
+ Caption = '%s - History++'
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'MS Sans Serif'
+ Font.Style = []
+ KeyPreview = True
+ OldCreateOrder = False
+ Position = poDefault
+ ShowHint = True
+ OnClose = FormClose
+ OnCloseQuery = FormCloseQuery
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnKeyDown = FormKeyDown
+ OnMouseWheel = FormMouseWheel
+ OnShow = FormShow
+ PixelsPerInch = 96
+ TextHeight = 13
+ object paClient: TPanel
+ Left = 0
+ Top = 0
+ Width = 578
+ Height = 378
+ Align = alClient
+ BevelOuter = bvNone
+ BorderWidth = 2
+ TabOrder = 0
+ object spHolder: TSplitter
+ Left = 158
+ Top = 32
+ Height = 319
+ AutoSnap = False
+ MinSize = 100
+ ResizeStyle = rsUpdate
+ Visible = False
+ end
+ object paGrid: TPanel
+ Left = 161
+ Top = 32
+ Width = 415
+ Height = 319
+ Align = alClient
+ BevelOuter = bvNone
+ TabOrder = 0
+ object hg: THistoryGrid
+ Left = 0
+ Top = 0
+ Width = 415
+ Height = 319
+ VertScrollBar.Increment = 1
+ ShowBottomAligned = False
+ ShowBookmarks = True
+ MultiSelect = True
+ ShowHeaders = False
+ ExpandHeaders = False
+ TxtStartup = 'Starting up...'
+ TxtNoItems = 'History is empty'
+ TxtNoSuch = 'No such items'
+ TxtFullLog = 'Full History Log'
+ TxtPartLog = 'Partial History Log'
+ TxtHistExport = 'History++ export'
+ TxtGenHist1 = '### (generated by history++ plugin)'
+ TxtGenHist2 = '<h6>Generated by <b>History++</b> Plugin</h6>'
+ TxtSessions = 'Conversation started at %s'
+ OnDblClick = hgDblClick
+ OnItemData = hgItemData
+ OnPopup = hgPopup
+ OnTranslateTime = hgTranslateTime
+ OnSearchFinished = hgSearchFinished
+ OnItemDelete = hgItemDelete
+ OnKeyDown = hgKeyDown
+ OnKeyUp = hgKeyUp
+ OnInlineKeyDown = hgInlineKeyDown
+ OnInlinePopup = hgInlinePopup
+ OnProcessInlineChange = hgProcessInlineChange
+ OnOptionsChange = hgOptionsChange
+ OnChar = hgChar
+ OnState = hgState
+ OnSelect = hgSelect
+ OnXMLData = hgXMLData
+ OnMCData = hgMCData
+ OnRTLChange = hgRTLEnabled
+ OnUrlClick = hgUrlClick
+ OnBookmarkClick = hgBookmarkClick
+ OnItemFilter = hgItemFilter
+ OnProcessRichText = hgProcessRichText
+ OnSearchItem = hgSearchItem
+ OnFilterChange = hgFilterChange
+ Reversed = False
+ ReversedHeader = False
+ Align = alClient
+ TabStop = True
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'MS Shell Dlg'
+ Font.Style = []
+ BevelInner = bvNone
+ BevelOuter = bvNone
+ Padding = 4
+ HideScrollBar = False
+ ShowHint = True
+ end
+ end
+ object paSearch: TPanel
+ Left = 2
+ Top = 351
+ Width = 574
+ Height = 25
+ Align = alBottom
+ BevelOuter = bvNone
+ TabOrder = 1
+ Visible = False
+ object paSearchPanel: TPanel
+ Left = 0
+ Top = 0
+ Width = 495
+ Height = 25
+ Align = alClient
+ BevelOuter = bvNone
+ TabOrder = 0
+ DesignSize = (
+ 495
+ 25)
+ object pbSearch: TPaintBox
+ Left = 2
+ Top = 6
+ Width = 16
+ Height = 16
+ OnPaint = pbSearchPaint
+ end
+ object sbClearFilter: TSpeedButton
+ Left = 21
+ Top = 4
+ Width = 23
+ Height = 21
+ Hint = 'Clear Search'
+ Flat = True
+ OnClick = sbClearFilterClick
+ end
+ object pbFilter: TPaintBox
+ Left = 2
+ Top = 6
+ Width = 16
+ Height = 16
+ OnPaint = pbFilterPaint
+ end
+ object edSearch: THppEdit
+ Left = 47
+ Top = 3
+ Width = 443
+ Height = 21
+ Anchors = [akLeft, akTop, akRight]
+ TabOrder = 0
+ OnChange = edSearchChange
+ OnKeyDown = edSearchKeyDown
+ OnKeyPress = edPassKeyPress
+ OnKeyUp = edSearchKeyUp
+ end
+ end
+ object paSearchButtons: TPanel
+ Left = 532
+ Top = 0
+ Width = 42
+ Height = 25
+ Align = alRight
+ AutoSize = True
+ BevelOuter = bvNone
+ TabOrder = 1
+ DesignSize = (
+ 42
+ 25)
+ object sbSearchNext: TSpeedButton
+ Left = 0
+ Top = 4
+ Width = 21
+ Height = 21
+ Anchors = [akTop, akRight]
+ Flat = True
+ Layout = blGlyphTop
+ Spacing = 0
+ OnClick = sbSearchNextClick
+ end
+ object sbSearchPrev: TSpeedButton
+ Left = 21
+ Top = 4
+ Width = 21
+ Height = 21
+ Anchors = [akTop, akRight]
+ Flat = True
+ Layout = blGlyphTop
+ Spacing = 0
+ OnClick = sbSearchPrevClick
+ end
+ end
+ object paSearchStatus: TPanel
+ Left = 495
+ Top = 0
+ Width = 37
+ Height = 25
+ Align = alRight
+ BevelOuter = bvNone
+ BorderWidth = 3
+ TabOrder = 2
+ Visible = False
+ object laSearchState: TLabel
+ Left = 22
+ Top = 3
+ Width = 12
+ Height = 19
+ Align = alRight
+ Caption = '>>'
+ Transparent = True
+ Layout = tlCenter
+ end
+ object imSearchEndOfPage: TImage
+ Left = 3
+ Top = 6
+ Width = 16
+ Height = 16
+ end
+ object imSearchNotFound: TImage
+ Left = 3
+ Top = 6
+ Width = 16
+ Height = 16
+ Transparent = True
+ end
+ end
+ end
+ object TopPanel: TPanel
+ Left = 2
+ Top = 2
+ Width = 574
+ Height = 30
+ Align = alTop
+ AutoSize = True
+ BevelOuter = bvNone
+ TabOrder = 2
+ object Toolbar: THppToolBar
+ Left = 0
+ Top = 0
+ Width = 574
+ Height = 30
+ AutoSize = True
+ BorderWidth = 2
+ EdgeBorders = []
+ Flat = True
+ Images = ilToolbar
+ PopupMenu = pmToolbar
+ TabOrder = 0
+ Transparent = True
+ Wrapable = False
+ OnDblClick = ToolbarDblClick
+ object tbUserDetails: THppToolButton
+ Left = 0
+ Top = 0
+ Hint = 'User Details'
+ HelpKeyword = 'Ctrl+I'
+ Caption = 'User Details'
+ OnClick = tbUserDetailsClick
+ end
+ object tbUserMenu: THppToolButton
+ Left = 23
+ Top = 0
+ Hint = 'User Menu'
+ Caption = 'User Menu'
+ OnClick = tbUserMenuClick
+ end
+ object ToolButton1: THppToolButton
+ Left = 46
+ Top = 0
+ Width = 8
+ Style = tbsDivider
+ end
+ object tbSessions: THppToolButton
+ Left = 54
+ Top = 0
+ Hint = 'Conversations'
+ HelpKeyword = 'F4'
+ Caption = 'Conversations'
+ Style = tbsCheck
+ OnClick = tbSessionsClick
+ end
+ object tbBookmarks: THppToolButton
+ Left = 77
+ Top = 0
+ Hint = 'Bookmarks'
+ HelpKeyword = 'F5'
+ Caption = 'Bookmarks'
+ Style = tbsCheck
+ OnClick = tbBookmarksClick
+ end
+ object ToolButton2: THppToolButton
+ Left = 100
+ Top = 0
+ Width = 7
+ Style = tbsSeparator
+ end
+ object tbSearch: THppToolButton
+ Left = 107
+ Top = 0
+ Hint = 'Find'
+ HelpKeyword = 'Ctrl+F'
+ AllowAllUp = True
+ Caption = 'Find'
+ Grouped = True
+ Style = tbsCheck
+ OnClick = tbSearchClick
+ end
+ object tbFilter: THppToolButton
+ Left = 130
+ Top = 0
+ Hint = 'Filter'
+ HelpKeyword = 'Ctrl+E'
+ AllowAllUp = True
+ Caption = 'Filter'
+ Grouped = True
+ Style = tbsCheck
+ OnClick = tbFilterClick
+ end
+ object ToolButton3: THppToolButton
+ Left = 153
+ Top = 0
+ Width = 7
+ Style = tbsSeparator
+ end
+ object tbEventsFilter: TSpeedButton
+ Left = 160
+ Top = 0
+ Width = 110
+ Height = 22
+ Flat = True
+ Layout = blGlyphTop
+ PopupMenu = pmEventsFilter
+ Spacing = -5
+ Transparent = False
+ OnClick = tbEventsFilterClick
+ end
+ object ToolButton4: THppToolButton
+ Left = 270
+ Top = 0
+ Width = 7
+ Style = tbsSeparator
+ end
+ object tbCopy: THppToolButton
+ Left = 277
+ Top = 0
+ Hint = 'Copy'
+ Caption = 'Copy'
+ OnClick = tbCopyClick
+ end
+ object tbDelete: THppToolButton
+ Left = 300
+ Top = 0
+ Hint = 'Delete'
+ Caption = 'Delete'
+ OnClick = tbDeleteClick
+ end
+ object tbSave: THppToolButton
+ Left = 323
+ Top = 0
+ Hint = 'Save'
+ Caption = 'Save'
+ OnClick = tbSaveClick
+ end
+ object ToolButton5: THppToolButton
+ Left = 346
+ Top = 0
+ Width = 8
+ Style = tbsSeparator
+ end
+ object tbHistory: THppToolButton
+ Left = 354
+ Top = 0
+ Hint = 'History Actions'
+ Caption = 'History Actions'
+ DropdownMenu = pmHistory
+ PopupMenu = pmHistory
+ Style = tbsDropDown
+ OnClick = tbHistoryClick
+ WholeDropDown = True
+ end
+ object tbHistorySearch: THppToolButton
+ Left = 386
+ Top = 0
+ Hint = 'History Search'
+ Caption = 'History Search'
+ OnClick = tbHistorySearchClick
+ end
+ end
+ end
+ object paHolder: TPanel
+ Left = 2
+ Top = 32
+ Width = 156
+ Height = 319
+ Align = alLeft
+ BevelOuter = bvNone
+ TabOrder = 3
+ Visible = False
+ OnResize = paHolderResize
+ object spBook: TSplitter
+ Left = 0
+ Top = 150
+ Width = 156
+ Height = 3
+ Cursor = crVSplit
+ Align = alTop
+ AutoSnap = False
+ MinSize = 60
+ ResizeStyle = rsUpdate
+ Visible = False
+ OnMoved = spBookMoved
+ end
+ object paBook: TPanel
+ Left = 0
+ Top = 153
+ Width = 156
+ Height = 166
+ Align = alClient
+ BevelOuter = bvNone
+ TabOrder = 0
+ Visible = False
+ object paBookInt: TPanel
+ Left = 0
+ Top = 0
+ Width = 156
+ Height = 21
+ Align = alTop
+ BevelInner = bvRaised
+ BevelOuter = bvLowered
+ TabOrder = 0
+ DesignSize = (
+ 156
+ 21)
+ object laBook: TLabel
+ Left = 6
+ Top = 2
+ Width = 128
+ Height = 17
+ Anchors = [akLeft, akTop, akRight]
+ AutoSize = False
+ Caption = 'Bookmarks'
+ Transparent = True
+ Layout = tlCenter
+ end
+ object sbCloseBook: TSpeedButton
+ Left = 135
+ Top = 2
+ Width = 18
+ Height = 17
+ AllowAllUp = True
+ Anchors = [akTop, akRight]
+ Flat = True
+ OnClick = sbCloseBookClick
+ end
+ end
+ object lvBook: TListView
+ Left = 0
+ Top = 21
+ Width = 156
+ Height = 145
+ Align = alClient
+ BevelInner = bvNone
+ BevelOuter = bvNone
+ Columns = <
+ item
+ AutoSize = True
+ end>
+ FlatScrollBars = True
+ RowSelect = True
+ ShowColumnHeaders = False
+ SmallImages = ilBook
+ TabOrder = 1
+ ViewStyle = vsReport
+ OnContextPopup = lvBookContextPopup
+ OnEdited = lvBookEdited
+ OnKeyDown = lvBookKeyDown
+ OnSelectItem = lvBookSelectItem
+ end
+ end
+ object paSess: TPanel
+ Left = 0
+ Top = 0
+ Width = 156
+ Height = 150
+ Align = alTop
+ BevelOuter = bvNone
+ TabOrder = 1
+ Visible = False
+ object paSessInt: TPanel
+ Left = 0
+ Top = 0
+ Width = 156
+ Height = 21
+ Align = alTop
+ BevelInner = bvRaised
+ BevelOuter = bvLowered
+ TabOrder = 0
+ DesignSize = (
+ 156
+ 21)
+ object laSess: TLabel
+ Left = 6
+ Top = 2
+ Width = 128
+ Height = 17
+ Anchors = [akLeft, akTop, akRight]
+ AutoSize = False
+ Caption = 'Conversations'
+ Transparent = True
+ Layout = tlCenter
+ end
+ object sbCloseSess: TSpeedButton
+ Left = 135
+ Top = 2
+ Width = 18
+ Height = 17
+ AllowAllUp = True
+ Anchors = [akTop, akRight]
+ Flat = True
+ OnClick = sbCloseSessClick
+ end
+ end
+ object tvSess: TTreeView
+ Left = 0
+ Top = 21
+ Width = 156
+ Height = 129
+ Align = alClient
+ BevelInner = bvNone
+ BevelOuter = bvNone
+ Images = ilSessions
+ Indent = 19
+ MultiSelect = True
+ PopupMenu = pmSessions
+ ReadOnly = True
+ RightClickSelect = True
+ RowSelect = True
+ TabOrder = 1
+ ToolTips = False
+ OnChange = tvSessChange
+ OnGetSelectedIndex = tvSessGetSelectedIndex
+ OnKeyDown = tvSessKeyDown
+ OnKeyPress = edPassKeyPress
+ OnMouseMove = tvSessMouseMove
+ end
+ end
+ end
+ end
+ object sb: TStatusBar
+ Left = 0
+ Top = 378
+ Width = 578
+ Height = 19
+ Panels = <>
+ SimplePanel = True
+ end
+ object paPassHolder: TPanel
+ Left = 179
+ Top = 95
+ Width = 325
+ Height = 153
+ BevelOuter = bvNone
+ BorderStyle = bsSingle
+ Enabled = False
+ TabOrder = 2
+ Visible = False
+ OnResize = paPassHolderResize
+ object paPassword: TPanel
+ Left = 8
+ Top = 16
+ Width = 301
+ Height = 117
+ BevelOuter = bvNone
+ TabOrder = 0
+ object laPass: TLabel
+ Left = 54
+ Top = 7
+ Width = 236
+ Height = 46
+ AutoSize = False
+ Caption = 'You need password to access this history'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'MS Sans Serif'
+ Font.Style = [fsBold]
+ ParentFont = False
+ Transparent = True
+ WordWrap = True
+ end
+ object Image1: TImage
+ Left = 10
+ Top = 8
+ Width = 32
+ Height = 29
+ AutoSize = True
+ Transparent = True
+ end
+ object laPass2: TLabel
+ Left = 10
+ Top = 60
+ Width = 49
+ Height = 13
+ Caption = 'Password:'
+ Transparent = True
+ end
+ object edPass: TEdit
+ Left = 80
+ Top = 56
+ Width = 211
+ Height = 21
+ MaxLength = 100
+ TabOrder = 0
+ PasswordChar = '*'
+ OnKeyPress = edPassKeyPress
+ OnKeyUp = edPassKeyUp
+ end
+ object bnPass: TButton
+ Left = 208
+ Top = 82
+ Width = 83
+ Height = 25
+ Caption = 'Enter'
+ Default = True
+ TabOrder = 1
+ OnClick = bnPassClick
+ end
+ end
+ end
+ object SaveDialog: TSaveDialog
+ FilterIndex = 0
+ Options = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofShareAware, ofEnableSizing]
+ Title = 'Save History'
+ Left = 540
+ Top = 40
+ end
+ object pmGrid: TPopupMenu
+ BiDiMode = bdLeftToRight
+ ParentBiDiMode = False
+ OnPopup = pmGridPopup
+ Left = 324
+ Top = 257
+ object Details1: TMenuItem
+ Caption = '&Open'
+ OnClick = Details1Click
+ end
+ object Bookmark1: TMenuItem
+ Caption = 'Set &Bookmark'
+ ShortCut = 16450
+ OnClick = Bookmark1Click
+ end
+ object SpeakMessage1: TMenuItem
+ Caption = 'Speak Message'
+ OnClick = SpeakMessage1Click
+ end
+ object N8: TMenuItem
+ Caption = '-'
+ end
+ object SendMessage1: TMenuItem
+ Caption = 'Send &Message'
+ ShortCut = 16461
+ OnClick = SendMessage1Click
+ end
+ object ReplyQuoted1: TMenuItem
+ Caption = '&Reply Quoted'
+ ShortCut = 16466
+ OnClick = ReplyQuoted1Click
+ end
+ object N12: TMenuItem
+ Caption = '-'
+ end
+ object Copy1: TMenuItem
+ Caption = '&Copy'
+ ShortCut = 16451
+ OnClick = tbCopyClick
+ end
+ object CopyText1: TMenuItem
+ Caption = 'Copy &Text'
+ ShortCut = 16468
+ OnClick = CopyText1Click
+ end
+ object Delete1: TMenuItem
+ Caption = '&Delete'
+ ShortCut = 46
+ OnClick = tbDeleteClick
+ end
+ object N2: TMenuItem
+ Caption = '-'
+ end
+ object SaveSelected1: TMenuItem
+ Caption = '&Save Selected...'
+ ShortCut = 16467
+ OnClick = tbSaveClick
+ end
+ object N13: TMenuItem
+ Caption = '-'
+ Visible = False
+ end
+ object SelectAll1: TMenuItem
+ Caption = 'Select &All'
+ ShortCut = 16449
+ Visible = False
+ OnClick = SelectAll1Click
+ end
+ end
+ object pmLink: TPopupMenu
+ BiDiMode = bdLeftToRight
+ ParentBiDiMode = False
+ Left = 368
+ Top = 258
+ object OpenLinkNW: TMenuItem
+ Caption = 'Open in &new window'
+ Default = True
+ OnClick = OpenLinkNWClick
+ end
+ object OpenLink: TMenuItem
+ Caption = '&Open in existing window'
+ OnClick = OpenLinkClick
+ end
+ object N1: TMenuItem
+ Caption = '-'
+ end
+ object CopyLink: TMenuItem
+ Caption = '&Copy Link'
+ OnClick = CopyLinkClick
+ end
+ end
+ object ilSessions: TImageList
+ BkColor = clWhite
+ Left = 164
+ Top = 60
+ end
+ object tiFilter: TTimer
+ Enabled = False
+ Interval = 300
+ OnTimer = tiFilterTimer
+ Left = 540
+ Top = 72
+ end
+ object ilToolbar: TImageList
+ Left = 540
+ Top = 4
+ end
+ object pmHistory: TPopupMenu
+ BiDiMode = bdLeftToRight
+ ParentBiDiMode = False
+ OnPopup = pmHistoryPopup
+ Left = 444
+ Top = 20
+ object SaveSelected2: TMenuItem
+ Caption = '&Save Selected...'
+ OnClick = tbSaveClick
+ end
+ object N4: TMenuItem
+ Caption = '-'
+ end
+ object SaveasHTML2: TMenuItem
+ Caption = 'Export as &HTML...'
+ OnClick = SaveasHTML2Click
+ end
+ object SaveasXML2: TMenuItem
+ Caption = 'Export as &XML...'
+ OnClick = SaveasXML2Click
+ end
+ object SaveasRTF2: TMenuItem
+ Caption = 'Export as &RTF...'
+ OnClick = SaveasRTF2Click
+ end
+ object SaveasMContacts2: TMenuItem
+ Caption = 'Export as &mContacts...'
+ OnClick = SaveasMContacts2Click
+ end
+ object SaveasText2: TMenuItem
+ Caption = 'Export as &Text...'
+ OnClick = SaveasText2Click
+ end
+ object N3: TMenuItem
+ Caption = '-'
+ end
+ object EmptyHistory1: TMenuItem
+ Caption = 'Empty history...'
+ OnClick = EmptyHistory1Click
+ end
+ object N6: TMenuItem
+ Caption = '-'
+ end
+ object ContactRTLmode: TMenuItem
+ Caption = 'Text direction'
+ object RTLDefault2: TMenuItem
+ AutoCheck = True
+ Caption = 'Default'
+ Checked = True
+ RadioItem = True
+ OnClick = ContactRTLmode1Click
+ end
+ object RTLEnabled2: TMenuItem
+ AutoCheck = True
+ Caption = 'Always RTL'
+ RadioItem = True
+ OnClick = ContactRTLmode1Click
+ end
+ object RTLDisabled2: TMenuItem
+ AutoCheck = True
+ Caption = 'Always LTR'
+ RadioItem = True
+ OnClick = ContactRTLmode1Click
+ end
+ end
+ object ANSICodepage: TMenuItem
+ Caption = 'ANSI Encoding'
+ object SystemCodepage: TMenuItem
+ AutoCheck = True
+ Caption = 'System default codepage'
+ Checked = True
+ RadioItem = True
+ OnClick = CodepageChangeClick
+ end
+ object UnknownCodepage: TMenuItem
+ AutoCheck = True
+ Caption = 'Unknown codepage %u'
+ RadioItem = True
+ Visible = False
+ OnClick = CodepageChangeClick
+ end
+ end
+ object N7: TMenuItem
+ Caption = '-'
+ end
+ object Passwordprotection1: TMenuItem
+ Caption = 'Password protection...'
+ OnClick = Passwordprotection1Click
+ end
+ end
+ object pmEventsFilter: TPopupMenu
+ BiDiMode = bdLeftToRight
+ ParentBiDiMode = False
+ OnPopup = pmEventsFilterPopup
+ Left = 412
+ Top = 20
+ object Showall1: TMenuItem
+ Caption = '-'
+ end
+ object Customize1: TMenuItem
+ Caption = '&Customize...'
+ OnClick = Customize1Click
+ end
+ end
+ object pmSessions: TPopupMenu
+ BiDiMode = bdLeftToRight
+ ParentBiDiMode = False
+ Left = 198
+ Top = 61
+ object SessCopy: TMenuItem
+ Caption = '&Copy'
+ Enabled = False
+ end
+ object SessSelect: TMenuItem
+ Caption = 'Select'
+ OnClick = SessSelectClick
+ end
+ object SessDelete: TMenuItem
+ Caption = 'Delete'
+ Enabled = False
+ end
+ object SessSave: TMenuItem
+ Caption = 'Save...'
+ Enabled = False
+ end
+ end
+ object pmToolbar: TPopupMenu
+ Images = ilToolbar
+ OnPopup = pmToolbarPopup
+ Left = 476
+ Top = 20
+ object N5: TMenuItem
+ Caption = '-'
+ end
+ object Customize2: TMenuItem
+ Caption = '&Customize...'
+ OnClick = Customize2Click
+ end
+ end
+ object ilBook: TImageList
+ BkColor = clWhite
+ Left = 8
+ Top = 60
+ end
+ object pmBook: TPopupMenu
+ Left = 42
+ Top = 61
+ object RenameBookmark1: TMenuItem
+ Caption = '&Rename Bookmark'
+ OnClick = RenameBookmark1Click
+ end
+ object N11: TMenuItem
+ Caption = '-'
+ end
+ object DeleteBookmark1: TMenuItem
+ Caption = 'Remove &Bookmark'
+ ShortCut = 16450
+ OnClick = Bookmark1Click
+ end
+ end
+ object pmInline: TPopupMenu
+ BiDiMode = bdLeftToRight
+ ParentBiDiMode = False
+ Left = 324
+ Top = 293
+ object InlineCopy: TMenuItem
+ Caption = '&Copy'
+ ShortCut = 16451
+ OnClick = InlineCopyClick
+ end
+ object InlineCopyAll: TMenuItem
+ Caption = 'Copy &Text'
+ ShortCut = 16468
+ OnClick = InlineCopyAllClick
+ end
+ object InlineSelectAll: TMenuItem
+ Caption = 'Select &All'
+ ShortCut = 16449
+ OnClick = InlineSelectAllClick
+ end
+ object MenuItem10: TMenuItem
+ Caption = '-'
+ end
+ object InlineTextFormatting: TMenuItem
+ Caption = 'Text Formatting'
+ ShortCut = 16464
+ OnClick = InlineTextFormattingClick
+ end
+ object MenuItem6: TMenuItem
+ Caption = '-'
+ end
+ object InlineSendMessage: TMenuItem
+ Caption = 'Send &Message'
+ ShortCut = 16461
+ OnClick = SendMessage1Click
+ end
+ object InlineReplyQuoted: TMenuItem
+ Caption = '&Reply Quoted'
+ ShortCut = 16466
+ OnClick = InlineReplyQuotedClick
+ end
+ end
+ object mmAcc: TMainMenu
+ Left = 10
+ Top = 98
+ object mmToolbar: TMenuItem
+ Caption = 'Toolbar'
+ OnClick = mmToolbarClick
+ end
+ object mmService: TMenuItem
+ Caption = 'Service'
+ object mmHideMenu: TMenuItem
+ Caption = 'Hide Menu'
+ ShortCut = 16505
+ OnClick = mmHideMenuClick
+ end
+ end
+ object mmShortcuts: TMenuItem
+ Caption = '--'
+ Visible = False
+ object mmBookmark: TMenuItem
+ Caption = '--'
+ ShortCut = 16450
+ OnClick = Bookmark1Click
+ end
+ end
+ end
+ object pmFile: TPopupMenu
+ BiDiMode = bdLeftToRight
+ ParentBiDiMode = False
+ Left = 368
+ Top = 294
+ object N10: TMenuItem
+ Caption = '-'
+ end
+ object FileActions: TMenuItem
+ Caption = '&File Actions'
+ object BrowseReceivedFiles: TMenuItem
+ Caption = '&Browse Received Files'
+ OnClick = BrowseReceivedFilesClick
+ end
+ object OpenFileFolder: TMenuItem
+ Caption = '&Open file folder'
+ OnClick = OpenFileFolderClick
+ end
+ object N9: TMenuItem
+ Caption = '-'
+ end
+ object CopyFilename: TMenuItem
+ Caption = '&Copy Filename'
+ OnClick = CopyLinkClick
+ end
+ end
+ end
+end
diff --git a/plugins/HistoryPlusPlus/HistoryForm.pas b/plugins/HistoryPlusPlus/HistoryForm.pas new file mode 100644 index 0000000000..e6e83eb404 --- /dev/null +++ b/plugins/HistoryPlusPlus/HistoryForm.pas @@ -0,0 +1,4120 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+{ -----------------------------------------------------------------------------
+ HistoryForm (historypp project)
+
+ Version: 1.4
+ Created: xx.03.2003
+ Author: Oxygen
+
+ [ Description ]
+
+ Main window with history listing
+
+ [ History ]
+
+ 1.4
+ - Fixed bug on closing history window with FindDialog opened
+
+ 1.3 ()
+ + Added XML export
+ + URL & File highlight handling
+ * "Reply Quoted" now is "Forward Message", and it forwards now,
+ instead of sending
+ - Fixed possible bug when opening hist. window and deleting contact
+ now hist. window closes on contact deletion.
+ 1.2
+ 1.1
+ 1.0 (xx.02.03) First version.
+
+ [ Modifications ]
+ * (29.05.2003) Added FindDialog.CloseDialog to Form.OnClose so now
+ closing history window without closing find dialog don't throws
+ exception
+
+ [ Known Issues ]
+
+ * Not very good support of EmailExpress events (togeter
+ with HistoryGrid.pas)
+
+ Contributors: theMIROn, Art Fedorov
+ ----------------------------------------------------------------------------- }
+
+unit HistoryForm;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, RichEdit,
+ Graphics, Controls, Forms, Dialogs, Buttons, StdCtrls, Menus, ComCtrls, ExtCtrls,
+ m_api,
+ hpp_global, hpp_database, hpp_messages, hpp_events, hpp_contacts, hpp_itemprocess,
+ hpp_bookmarks, hpp_forms, hpp_richedit, hpp_sessionsthread,
+ HistoryGrid, Checksum, DateUtils,
+ ImgList, HistoryControls, CommCtrl, ToolWin, ShellAPI, Themes;
+
+type
+
+ TLastSearch = (lsNone, lsHotSearch, lsSearch);
+ TSearchMode = (smNone, smSearch, smFilter, smHotSearch);
+ // smHotSearch for possible future use
+ THistoryPanel = (hpSessions, hpBookmarks);
+ THistoryPanels = set of THistoryPanel;
+
+ THistoryFrm = class(TForm)
+ SaveDialog: TSaveDialog;
+ pmGrid: TPopupMenu;
+ paClient: TPanel;
+ paGrid: TPanel;
+ hg: THistoryGrid;
+ sb: TStatusBar;
+ pmLink: TPopupMenu;
+ paSess: TPanel;
+ spHolder: TSplitter;
+ ilSessions: TImageList;
+ paSessInt: TPanel;
+ laSess: TLabel;
+ sbCloseSess: TSpeedButton;
+ N13: TMenuItem;
+ SaveSelected1: TMenuItem;
+ N2: TMenuItem;
+ Delete1: TMenuItem;
+ CopyText1: TMenuItem;
+ Copy1: TMenuItem;
+ N12: TMenuItem;
+ ReplyQuoted1: TMenuItem;
+ SendMessage1: TMenuItem;
+ N8: TMenuItem;
+ Details1: TMenuItem;
+ CopyLink: TMenuItem;
+ N1: TMenuItem;
+ OpenLinkNW: TMenuItem;
+ OpenLink: TMenuItem;
+ ContactRTLmode: TMenuItem;
+ ANSICodepage: TMenuItem;
+ RTLDisabled2: TMenuItem;
+ RTLEnabled2: TMenuItem;
+ RTLDefault2: TMenuItem;
+ SystemCodepage: TMenuItem;
+ sbClearFilter: TSpeedButton;
+ pbFilter: TPaintBox;
+ tiFilter: TTimer;
+ ilToolbar: TImageList;
+ Toolbar: THppToolBar;
+ paPassHolder: TPanel;
+ paPassword: TPanel;
+ laPass: TLabel;
+ Image1: TImage;
+ laPass2: TLabel;
+ edPass: TEdit;
+ bnPass: TButton;
+ pmHistory: TPopupMenu;
+ SaveasMContacts2: TMenuItem;
+ SaveasRTF2: TMenuItem;
+ SaveasXML2: TMenuItem;
+ SaveasHTML2: TMenuItem;
+ SaveasText2: TMenuItem;
+ tbSearch: THppToolButton;
+ ToolButton3: THppToolButton;
+ paSearch: TPanel;
+ tbFilter: THppToolButton;
+ tbDelete: THppToolButton;
+ tbSessions: THppToolButton;
+ ToolButton2: THppToolButton;
+ paSearchStatus: TPanel;
+ laSearchState: TLabel;
+ paSearchPanel: TPanel;
+ sbSearchNext: TSpeedButton;
+ sbSearchPrev: TSpeedButton;
+ edSearch: THppEdit;
+ pbSearch: TPaintBox;
+ tvSess: TTreeView;
+ tbSave: THppToolButton;
+ tbCopy: THppToolButton;
+ tbHistorySearch: THppToolButton;
+ imSearchEndOfPage: TImage;
+ imSearchNotFound: TImage;
+ ToolButton4: THppToolButton;
+ N4: TMenuItem;
+ EmptyHistory1: TMenuItem;
+ pmEventsFilter: TPopupMenu;
+ ShowAll1: TMenuItem;
+ Customize1: TMenuItem;
+ N6: TMenuItem;
+ Passwordprotection1: TMenuItem;
+ TopPanel: TPanel;
+ paSearchButtons: TPanel;
+ pmSessions: TPopupMenu;
+ SessCopy: TMenuItem;
+ SessSelect: TMenuItem;
+ SessDelete: TMenuItem;
+ N7: TMenuItem;
+ SessSave: TMenuItem;
+ tbUserMenu: THppToolButton;
+ tbUserDetails: THppToolButton;
+ ToolButton1: THppToolButton;
+ tbEventsFilter: TSpeedButton;
+ ToolButton5: THppToolButton;
+ pmToolbar: TPopupMenu;
+ Customize2: TMenuItem;
+ Bookmark1: TMenuItem;
+ paBook: TPanel;
+ paBookInt: TPanel;
+ laBook: TLabel;
+ sbCloseBook: TSpeedButton;
+ lvBook: TListView;
+ ilBook: TImageList;
+ tbBookmarks: THppToolButton;
+ pmBook: TPopupMenu;
+ DeleteBookmark1: TMenuItem;
+ N3: TMenuItem;
+ SaveSelected2: TMenuItem;
+ N11: TMenuItem;
+ RenameBookmark1: TMenuItem;
+ pmInline: TPopupMenu;
+ InlineReplyQuoted: TMenuItem;
+ MenuItem6: TMenuItem;
+ InlineCopy: TMenuItem;
+ InlineCopyAll: TMenuItem;
+ MenuItem10: TMenuItem;
+ InlineSelectAll: TMenuItem;
+ InlineTextFormatting: TMenuItem;
+ InlineSendMessage: TMenuItem;
+ N5: TMenuItem;
+ mmAcc: TMainMenu;
+ mmToolbar: TMenuItem;
+ mmService: TMenuItem;
+ mmHideMenu: TMenuItem;
+ mmShortcuts: TMenuItem;
+ mmBookmark: TMenuItem;
+ SelectAll1: TMenuItem;
+ tbHistory: THppToolButton;
+ paHolder: TPanel;
+ spBook: TSplitter;
+ UnknownCodepage: TMenuItem;
+ OpenFileFolder: TMenuItem;
+ BrowseReceivedFiles: TMenuItem;
+ N9: TMenuItem;
+ CopyFilename: TMenuItem;
+ FileActions: TMenuItem;
+ N10: TMenuItem;
+ pmFile: TPopupMenu;
+ SpeakMessage1: TMenuItem;
+ procedure tbHistoryClick(Sender: TObject);
+ procedure SaveasText2Click(Sender: TObject);
+ procedure SaveasMContacts2Click(Sender: TObject);
+ procedure SaveasRTF2Click(Sender: TObject);
+ procedure SaveasXML2Click(Sender: TObject);
+ procedure SaveasHTML2Click(Sender: TObject);
+ procedure tbSessionsClick(Sender: TObject);
+ procedure pbSearchStatePaint(Sender: TObject);
+ procedure tbDeleteClick(Sender: TObject);
+ procedure sbSearchPrevClick(Sender: TObject);
+ procedure sbSearchNextClick(Sender: TObject);
+ procedure edSearchChange(Sender: TObject);
+ procedure hgChar(Sender: TObject; var achar: WideChar; Shift: TShiftState);
+ procedure edSearchKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure edSearchKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure tbSearchClick(Sender: TObject);
+ procedure tbFilterClick(Sender: TObject);
+ procedure pbSearchPaint(Sender: TObject);
+ procedure paPassHolderResize(Sender: TObject);
+ procedure tvSessMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
+ // procedure tvSessClick(Sender: TObject);
+ procedure sbCloseSessClick(Sender: TObject);
+ procedure hgItemFilter(Sender: TObject; Index: Integer; var Show: Boolean);
+ procedure tvSessChange(Sender: TObject; Node: TTreeNode);
+ // procedure bnConversationClick(Sender: TObject);
+
+ procedure LoadHistory(Sender: TObject);
+ procedure OnCNChar(var Message: TWMChar); message WM_CHAR;
+
+ procedure FormCreate(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer;
+ MousePos: TPoint; var Handled: Boolean);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+ procedure FormDestroy(Sender: TObject);
+
+ procedure hgItemData(Sender: TObject; Index: Integer; var Item: THistoryItem);
+ procedure hgTranslateTime(Sender: TObject; Time: Cardinal; var Text: String);
+ procedure hgPopup(Sender: TObject);
+
+ procedure hgSearchFinished(Sender: TObject; Text: String; Found: Boolean);
+ procedure hgDblClick(Sender: TObject);
+ procedure tbSaveClick(Sender: TObject);
+ procedure hgItemDelete(Sender: TObject; Index: Integer);
+ procedure tbCopyClick(Sender: TObject);
+ procedure Details1Click(Sender: TObject);
+ procedure hgKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure hgState(Sender: TObject; State: TGridState);
+
+ procedure hgSelect(Sender: TObject; Item, OldItem: Integer);
+ procedure hgXMLData(Sender: TObject; Index: Integer; var Item: TXMLItem);
+ procedure hgMCData(Sender: TObject; Index: Integer; var Item: TMCItem; Stage: TSaveStage);
+ procedure OpenLinkClick(Sender: TObject);
+ procedure OpenLinkNWClick(Sender: TObject);
+ procedure CopyLinkClick(Sender: TObject);
+ procedure bnPassClick(Sender: TObject);
+ procedure edPassKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure edPassKeyPress(Sender: TObject; var Key: Char);
+ procedure CopyText1Click(Sender: TObject);
+ procedure hgUrlClick(Sender: TObject; Item: Integer; URLText: String; Button: TMouseButton);
+ procedure hgProcessRichText(Sender: TObject; Handle: THandle; Item: Integer);
+ procedure hgSearchItem(Sender: TObject; Item, ID: Integer; var Found: Boolean);
+ procedure hgKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure ContactRTLmode1Click(Sender: TObject);
+ procedure SendMessage1Click(Sender: TObject);
+ procedure ReplyQuoted1Click(Sender: TObject);
+ procedure CodepageChangeClick(Sender: TObject);
+ procedure sbClearFilterClick(Sender: TObject);
+ procedure pbFilterPaint(Sender: TObject);
+ procedure StartHotFilterTimer;
+ procedure EndHotFilterTimer(DoClearFilter: Boolean = False);
+ procedure tiFilterTimer(Sender: TObject);
+ procedure tbHistorySearchClick(Sender: TObject);
+ procedure EmptyHistory1Click(Sender: TObject);
+ procedure EventsFilterItemClick(Sender: TObject);
+ procedure Passwordprotection1Click(Sender: TObject);
+ procedure SessSelectClick(Sender: TObject);
+ procedure pmGridPopup(Sender: TObject);
+ procedure pmHistoryPopup(Sender: TObject);
+ procedure tbUserMenuClick(Sender: TObject);
+ procedure tvSessGetSelectedIndex(Sender: TObject; Node: TTreeNode);
+ procedure Customize1Click(Sender: TObject);
+ procedure tbEventsFilterClick(Sender: TObject);
+ procedure hgRTLEnabled(Sender: TObject; BiDiMode: TBiDiMode);
+ procedure ToolbarDblClick(Sender: TObject);
+ procedure Customize2Click(Sender: TObject);
+ procedure Bookmark1Click(Sender: TObject);
+ procedure tbUserDetailsClick(Sender: TObject);
+ procedure hgBookmarkClick(Sender: TObject; Item: Integer);
+ procedure tbBookmarksClick(Sender: TObject);
+ procedure sbCloseBookClick(Sender: TObject);
+ procedure lvBookSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
+ procedure lvBookContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
+ procedure lvBookEdited(Sender: TObject; Item: TListItem; var S: String);
+ procedure RenameBookmark1Click(Sender: TObject);
+ procedure hgProcessInlineChange(Sender: TObject; Enabled: Boolean);
+ procedure hgInlinePopup(Sender: TObject);
+ procedure InlineCopyClick(Sender: TObject);
+ procedure InlineCopyAllClick(Sender: TObject);
+ procedure InlineSelectAllClick(Sender: TObject);
+ procedure InlineTextFormattingClick(Sender: TObject);
+ procedure hgInlineKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure InlineReplyQuotedClick(Sender: TObject);
+ procedure pmEventsFilterPopup(Sender: TObject);
+ procedure mmToolbarClick(Sender: TObject);
+ procedure mmHideMenuClick(Sender: TObject);
+ procedure SelectAll1Click(Sender: TObject);
+ procedure lvBookKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure tvSessKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure paHolderResize(Sender: TObject);
+ procedure spBookMoved(Sender: TObject);
+ procedure pmToolbarPopup(Sender: TObject);
+ procedure hgFilterChange(Sender: TObject);
+ procedure OpenFileFolderClick(Sender: TObject);
+ procedure BrowseReceivedFilesClick(Sender: TObject);
+ procedure SpeakMessage1Click(Sender: TObject);
+ procedure hgOptionsChange(Sender: TObject);
+ private
+ DelayedFilter: TMessageTypes;
+ StartTimestamp: DWord;
+ EndTimestamp: DWord;
+ FhContact, FhSubContact: THandle;
+ FProtocol, FSubProtocol: AnsiString;
+ FPasswordMode: Boolean;
+ SavedLinkUrl: String;
+ SavedFileDir: String;
+ HotFilterString: String;
+ FormState: TGridState;
+ PreHotSearchMode: TSearchMode;
+ FSearchMode: TSearchMode;
+ UserMenu: hMenu;
+ FPanel: THistoryPanels;
+ IsLoadingSessions: Boolean;
+
+ procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
+ procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
+ procedure WMSysColorChange(var Message: TMessage); message WM_SYSCOLORCHANGE;
+ procedure LoadPosition;
+ procedure SavePosition;
+
+ procedure HMEventAdded(var Message: TMessage); message HM_MIEV_EVENTADDED;
+ procedure HMEventDeleted(var Message: TMessage); message HM_MIEV_EVENTDELETED;
+ procedure HMPreShutdown(var Message: TMessage); message HM_MIEV_PRESHUTDOWN;
+ procedure HMContactDeleted(var Message: TMessage); message HM_MIEV_CONTACTDELETED;
+ procedure HMMetaDefaultChanged(var M: TMessage); message HM_MIEV_METADEFCHANGED;
+
+ procedure HMIcons2Changed(var M: TMessage); message HM_NOTF_ICONS2CHANGED;
+ procedure HMAccChanged(var M: TMessage); message HM_NOTF_ACCCHANGED;
+ procedure HMNickChanged(var M: TMessage); message HM_NOTF_NICKCHANGED;
+
+ procedure OpenDetails(Item: Integer);
+ procedure SetPasswordMode(const Value: Boolean);
+ procedure ProcessPassword;
+ procedure TranslateForm;
+
+ procedure SethContact(const Value: THandle);
+ procedure LoadInOptions();
+ function IsFileEvent(Index: Integer): Boolean;
+
+ procedure PreLoadHistory;
+ procedure PostLoadHistory;
+ procedure SetSearchMode(const Value: TSearchMode);
+ procedure SetPanel(const Value: THistoryPanels);
+ procedure ToggleMainMenu(Enabled: Boolean);
+
+ protected
+ procedure LoadPendingHeaders(rowidx: Integer; count: Integer);
+ property SearchMode: TSearchMode read FSearchMode write SetSearchMode;
+ property Panel: THistoryPanels read FPanel write SetPanel;
+ procedure WndProc(var Message: TMessage); override;
+
+ public
+ UserCodepage: Cardinal;
+ UseDefaultCP: Boolean;
+ LastSearch: TLastSearch;
+ HotString: String;
+ LastHotIdx: Integer;
+ EventDetailForm: TForm;
+ CustomizeFiltersForm: TForm;
+ CustomizeToolbarForm: TForm;
+ WindowList: TList;
+ History: array of THandle;
+ HistoryLength: Integer;
+ RecentFormat: TSaveFormat;
+ SessThread: TSessionsThread;
+ Sessions: TSessArray;
+ SeparatorButtonWidth: Integer;
+
+ procedure SearchNext(Rev: Boolean; Warp: Boolean = True);
+ procedure DeleteHistoryItem(ItemIdx: Integer);
+ procedure AddHistoryItem(hDBEvent: THandle);
+ procedure Load;
+ function GridIndexToHistory(Index: Integer): Integer;
+ function HistoryIndexToGrid(Index: Integer): Integer;
+ function GetItemData(Index: Integer): THistoryItem;
+
+ procedure ReplyQuoted(Item: Integer);
+ procedure OpenPassword;
+ procedure EmptyHistory;
+
+ procedure SMPrepare(var M: TMessage); message HM_SESS_PREPARE;
+ procedure SMItemsFound(var M: TMessage); message HM_SESS_ITEMSFOUND;
+ procedure SMFinished(var M: TMessage); message HM_SESS_FINISHED;
+ procedure AddEventToSessions(hDBEvent: THandle);
+ procedure DeleteEventFromSessions(ItemIdx: Integer);
+
+ procedure LoadSessionIcons;
+ procedure LoadBookIcons;
+ procedure LoadToolbarIcons;
+ procedure LoadEventFilterButton;
+ procedure LoadButtonIcons;
+
+ procedure CustomizeToolbar;
+ procedure LoadToolbar;
+ procedure LoadAccMenu;
+ procedure HMToolbarChanged(var M: TMessage); message HM_NOTF_TOOLBARCHANGED;
+
+ procedure SetRecentEventsPosition(OnTop: Boolean);
+ procedure Search(Next: Boolean; FromNext: Boolean = False);
+
+ procedure ShowAllEvents;
+ procedure ShowItem(Value: Integer);
+ procedure SetEventFilter(FilterIndex: Integer = -1; DelayApply: Boolean = False);
+ procedure CreateEventsFilterMenu;
+ procedure HMFiltersChanged(var M: TMessage); message HM_NOTF_FILTERSCHANGED;
+
+ procedure FillBookmarks;
+ procedure HMBookmarkChanged(var M: TMessage); message HM_NOTF_BOOKMARKCHANGED;
+
+ property PasswordMode: Boolean read FPasswordMode write SetPasswordMode;
+ property hContact: THandle read FhContact write SethContact;
+ property Protocol: AnsiString read FProtocol;
+ property hSubContact: THandle read FhSubContact;
+ property SubProtocol: AnsiString read FSubProtocol;
+ published
+ procedure AlignControls(Control: TControl; var ARect: TRect); override;
+ end;
+
+var
+ HistoryFrm: THistoryFrm;
+
+const
+ DEF_HISTORY_TOOLBAR = '[SESS][BOOK] [SEARCH][FILTER] [EVENTS] [COPY][DELETE] [HISTORY]';
+
+ // function ParseUrlItem(Item: THistoryItem; out Url,Mes: WideString): Boolean;
+ // function ParseFileItem(Item: THistoryItem; out FileName,Mes: WideString): Boolean;
+
+implementation
+
+uses EventDetailForm, PassForm, hpp_options, hpp_services, hpp_eventfilters,
+ CustomizeFiltersForm, CustomizeToolbar;
+
+{$R *.DFM}
+
+{$include inc\m_speak.inc}
+
+const
+ HPP_SESS_YEARFORMAT = 'yyyy';
+ HPP_SESS_MONTHFORMAT = 'mmmm';
+ HPP_SESS_DAYFORMAT = 'd (h:nn)';
+
+function Max(a, b: Integer): Integer;
+begin
+ if b > a then
+ Result := b
+ else
+ Result := a
+end;
+
+function NotZero(X: THandle): THandle;
+// used that array doesn't store 0 for already loaded data
+begin
+ if X = 0 then
+ Result := 1
+ else
+ Result := X
+end;
+
+{ function ParseUrlItem(Item: THistoryItem; out Url,Mes: WideString): Boolean;
+ var
+ tmp1,tmp2: WideString;
+ n: Integer;
+ begin
+ Url := '';
+ Mes := '';
+ Result := False;
+ if not (mtUrl in Item.MessageType) then exit;
+ tmp1 := Item.Text;
+ if tmp1 = '' then exit;
+ Result := True;
+
+ n := Pos(#10,tmp1);
+ if n <> 0 then begin
+ tmp2 := Copy(tmp1,1,n-2);
+ Delete(tmp1,1,n);
+ end else begin
+ tmp2 := tmp1;
+ tmp1 := '';
+ end;
+
+ Mes := tmp1;
+
+ n := Pos(':',tmp2);
+ if n <> 0 then begin
+ tmp2 := Copy(tmp2,n+2,Length(tmp2));
+ end else begin
+ Result := False;
+ tmp2 := '';
+ end;
+
+ url := tmp2;
+ end; }
+
+{ function ParseFileItem(Item: THistoryItem; out FileName,Mes: WideString): Boolean;
+ var
+ tmp1,tmp2: AnsiString;
+ n: Integer;
+ begin
+ Result := False;
+ FileName := '';
+ Mes := '';
+ if not (mtFile in Item.MessageType) then exit;
+ tmp1 := Item.Text;
+
+ n := Pos(#10,tmp1);
+ if n <> 0 then begin
+ Delete(tmp1,1,n)
+ end else
+ exit;
+
+ Result := True;
+
+ n := Pos(#10,tmp1);
+ if n <> 0 then begin
+ tmp2 := tmp1;
+ tmp1 := Copy(tmp2,1,n-2);
+ Delete(tmp2,1,n);
+ end;
+
+ Mes := tmp2;
+ FileName := tmp1;
+ end; }
+
+{ function GetEventInfo(hDBEvent: DWord): TDBEVENTINFO;
+ var
+ BlobSize:Integer;
+ begin
+ ZeroMemory(@Result,SizeOf(Result));
+ Result.cbSize:=SizeOf(Result);
+ Result.pBlob:=nil;
+ BlobSize:=CallService(MS_DB_EVENT_GETBLOBSIZE,hDBEvent,0);
+
+ GetMem(Result.pBlob,BlobSize);
+ Result.cbBlob:=BlobSize;
+
+ CallService(MS_DB_EVENT_GET,hDBEvent,LPARAM(@Result));
+ end; }
+
+(*
+ This function gets only name of the file
+ and tries to make it FAT-happy, so we trim out and
+ ":"-s, "\"-s and so on...
+*)
+
+procedure THistoryFrm.LoadHistory(Sender: TObject);
+// Load the History from the Database and Display it in the grid
+ procedure FastLoadHandles;
+ var
+ hDBEvent: THandle;
+ LineIdx: Integer;
+ ToRead: Integer;
+ begin
+ HistoryLength := CallService(MS_DB_EVENT_GETCOUNT, hContact, 0);
+ if HistoryLength = -1 then
+ begin
+ // contact is missing
+ // or other error ?
+ HistoryLength := 0;
+ end;
+ SetLength(History, HistoryLength);
+ if HistoryLength = 0 then
+ Exit;
+ hDBEvent := CallService(MS_DB_EVENT_FINDLAST, hContact, 0);
+ History[HistoryLength - 1] := NotZero(hDBEvent);
+ { if NeedhDBEvent = 0 then toRead := Max(0,HistoryLength-hppLoadBlock-1)
+ else toRead := 0; }
+ ToRead := Max(0, HistoryLength - hppFirstLoadBlock - 1);
+ LineIdx := HistoryLength - 2;
+ repeat
+ hDBEvent := CallService(MS_DB_EVENT_FINDPREV, hDBEvent, 0);
+ History[LineIdx] := NotZero(hDBEvent);
+ { if NeedhDBEvent = hDbEvent then begin
+ Result := HistoryLength-LineIdx-1;
+ toRead := Max(0,Result-hppLoadBlock shr 1);
+ end; }
+ dec(LineIdx);
+ until LineIdx < ToRead;
+ end;
+
+begin
+ FastLoadHandles;
+
+ hg.Contact := hContact;
+ hg.Protocol := Protocol;
+ // hContact,hSubContact,Protocol,SubProtocol should be
+ // already filled by calling hContact := Value;
+ hg.ProfileName := GetContactDisplayName(0, SubProtocol);
+ hg.ContactName := GetContactDisplayName(hContact, Protocol, True);
+ UserCodepage := GetContactCodePage(hContact, Protocol, UseDefaultCP);
+ hg.Codepage := UserCodepage;
+ hg.RTLMode := GetContactRTLModeTRTL(hContact, Protocol);
+ UnknownCodepage.Tag := Integer(UserCodepage);
+ UnknownCodepage.Caption := Format(TranslateW('Unknown codepage %u'), [UserCodepage]);
+ if hContact = 0 then
+ Caption := TranslateW('System History')
+ else
+ Caption := Format(TranslateW('%s - History++'), [hg.ContactName]);
+ hg.Allocate(HistoryLength);
+end;
+
+procedure THistoryFrm.FormCreate(Sender: TObject);
+var
+ i: Integer;
+ mi: TMenuItem;
+begin
+ hg.BeginUpdate;
+
+ Icon.ReleaseHandle;
+ Icon.Handle := CopyIcon(hppIcons[HPP_ICON_CONTACTHISTORY].Handle);
+
+ // delphi 2006 doesn't save toolbar's flat property in dfm if it is True
+ // delphi 2006 doesn't save toolbar's edgeborder property in dfm
+ Toolbar.Flat := True;
+ Toolbar.EdgeBorders := [];
+
+ LoadToolbarIcons;
+ LoadButtonIcons;
+ LoadSessionIcons;
+ LoadBookIcons;
+ Image1.Picture.Icon.Handle := CopyIcon(hppIntIcons[0].Handle);
+
+ DesktopFont := True;
+ MakeFontsParent(Self);
+
+ DoubleBuffered := True;
+ MakeDoubleBufferedParent(Self);
+ TopPanel.DoubleBuffered := False;
+ hg.DoubleBuffered := False;
+
+ IsLoadingSessions := False;
+ SessThread := nil;
+
+ FormState := gsIdle;
+
+ DelayedFilter := [];
+ // if we do so, we'll never get selected if filters match
+ // hg.Filter := GenerateEvents(FM_EXCLUDE,[]);
+
+ for i := 0 to High(cpTable) do
+ begin
+ mi := NewItem(cpTable[i].name, 0, False, True, nil, 0, 'cp' + intToStr(i));
+ mi.Tag := cpTable[i].cp;
+ mi.OnClick := CodepageChangeClick;
+ mi.AutoCheck := True;
+ mi.RadioItem := True;
+ ANSICodepage.Add(mi);
+ end;
+
+ TranslateForm;
+
+ // File actions from context menu support
+ AddMenuArray(pmGrid, [FileActions], -1);
+
+ LoadAccMenu; // load accessability menu before LoadToolbar
+ // put here because we want to translate everything
+ // before copying to menu
+
+ // cbFilter.ItemIndex := 0;
+ RecentFormat := sfHtml;
+ // hg.InlineRichEdit.PopupMenu := pmGridInline;
+ // for i := 0 to pmOptions.Items.Count-1 do
+ // pmOptions.Items.Remove(pmOptions.Items[0]);
+end;
+
+procedure THistoryFrm.LoadPosition;
+// load last position and filter setting
+// var
+// filt: Integer;
+// w,h,l,t: Integer;
+begin
+ // removed Utils_RestoreWindowPosition because it shows window sooner than we expect
+ Utils_RestoreFormPosition(Self, 0, hppDBName, 'HistoryWindow.');
+ SearchMode := TSearchMode(GetDBByte(hppDBName, 'SearchMode', 0));
+end;
+
+procedure THistoryFrm.LoadSessionIcons;
+var
+ il: THandle;
+begin
+ tvSess.Items.BeginUpdate;
+ try
+ ImageList_Remove(ilSessions.Handle, -1); // clears image list
+ il := ImageList_Create(16, 16, ILC_COLOR32 or ILC_MASK, 8, 2);
+ if il <> 0 then
+ ilSessions.Handle := il
+ else
+ il := ilSessions.Handle;
+
+ ImageList_AddIcon(il, hppIcons[HPP_ICON_SESSION].Handle);
+ ImageList_AddIcon(il, hppIcons[HPP_ICON_SESS_SUMMER].Handle);
+ ImageList_AddIcon(il, hppIcons[HPP_ICON_SESS_AUTUMN].Handle);
+ ImageList_AddIcon(il, hppIcons[HPP_ICON_SESS_WINTER].Handle);
+ ImageList_AddIcon(il, hppIcons[HPP_ICON_SESS_SPRING].Handle);
+ ImageList_AddIcon(il, hppIcons[HPP_ICON_SESS_YEAR].Handle);
+ finally
+ tvSess.Items.EndUpdate;
+ // tvSess.Update;
+ end;
+
+ // simple hack to avoid dark icons
+ ilSessions.BkColor := tvSess.Color;
+
+end;
+
+// to do:
+// SAVEALL (???)
+// DELETEALL
+// SENDMES (???)
+// REPLQUOTED (???)
+// COPYTEXT (???)
+procedure THistoryFrm.LoadToolbar;
+var
+ tool: array of TControl;
+ i, n: Integer;
+ tb_butt: THppToolButton;
+ butt: TControl;
+ butt_str, tb_str, str: String;
+begin
+ tb_str := String(GetDBStr(hppDBName, 'HistoryToolbar', DEF_HISTORY_TOOLBAR));
+
+ if (tb_str = '') then
+ begin // toolbar is disabled
+ Toolbar.Visible := False;
+ // should add "else T.Visible := True" to make it dynamic in run-time, but I will ignore it
+ // you can never know which Toolbar bugs & quirks you'll trigger with it :)
+ end;
+
+ if hContact = 0 then
+ begin
+ tb_str := StringReplace(tb_str, '[SESS]', '', [rfReplaceAll]);
+ // tb_str := StringReplace(tb_str,'[BOOK]','',[rfReplaceAll]);
+ // tb_str := StringReplace(tb_str,'[EVENTS]','',[rfReplaceAll]);
+ end;
+ str := tb_str;
+
+ i := 0;
+ while True do
+ begin
+ if i = Toolbar.ControlCount then
+ break;
+ if Toolbar.Controls[i] is THppToolButton then
+ begin
+ tb_butt := THppToolButton(Toolbar.Controls[i]);
+ if (tb_butt.Style = tbsSeparator) or (tb_butt.Style = tbsDivider) then
+ begin
+ // adding separator in runtime results in too wide separators
+ // we'll remeber the currect width and later re-apply it
+ SeparatorButtonWidth := tb_butt.Width;
+ tb_butt.Free;
+ dec(i);
+ end
+ else
+ tb_butt.Visible := False;
+ end
+ else if Toolbar.Controls[i] is TSpeedButton then
+ TSpeedButton(Toolbar.Controls[i]).Visible := False;
+ Inc(i);
+ end;
+
+ try
+ while True do
+ begin
+ if str = '' then
+ break;
+ if (str[1] = ' ') or (str[1] = '|') then
+ begin
+ if (Length(tool) > 0) and (tool[High(tool)] is THppToolButton) then
+ begin
+ // don't add separator if previous button is separator
+ tb_butt := THppToolButton(tool[High(tool)]);
+ if (tb_butt.Style = tbsDivider) or (tb_butt.Style = tbsSeparator) then
+ begin
+ Delete(str, 1, 1);
+ continue;
+ end;
+ end
+ else if (Length(tool) = 0) then
+ begin
+ // don't add separator as first button
+ Delete(str, 1, 1);
+ continue;
+ end;
+ SetLength(tool, Length(tool) + 1);
+ tb_butt := THppToolButton.Create(Toolbar);
+ tb_butt.Visible := False;
+ if str[1] = ' ' then
+ tb_butt.Style := tbsSeparator
+ else
+ tb_butt.Style := tbsDivider;
+ Delete(str, 1, 1);
+ tb_butt.Parent := Toolbar;
+ tb_butt.Width := SeparatorButtonWidth;
+ tool[High(tool)] := tb_butt;
+ end
+ else if str[1] = '[' then
+ begin
+ n := Pos(']', str);
+ if n = -1 then
+ raise EAbort.Create('Wrong toolbar string format');
+ butt_str := Copy(str, 2, n - 2);
+ Delete(str, 1, n);
+ if butt_str = 'SESS' then butt := tbSessions
+ else if butt_str = 'BOOK' then butt := tbBookmarks
+ else if butt_str = 'SEARCH' then butt := tbSearch
+ else if butt_str = 'FILTER' then butt := tbFilter
+ else if butt_str = 'COPY' then butt := tbCopy
+ else if butt_str = 'DELETE' then butt := tbDelete
+ else if butt_str = 'SAVE' then butt := tbSave
+ else if butt_str = 'HISTORY' then butt := tbHistory
+ else if butt_str = 'GLOBSEARCH' then butt := tbHistorySearch
+ else if butt_str = 'EVENTS' then butt := tbEventsFilter
+ else if butt_str = 'USERMENU' then butt := tbUserMenu
+ else if butt_str = 'USERDETAILS' then butt := tbUserDetails
+ else
+ butt := nil;
+
+ if butt <> nil then
+ begin
+ SetLength(tool, Length(tool) + 1);
+ tool[High(tool)] := butt;
+ end;
+ end
+ else
+ raise EAbort.Create('Wrong toolbar string format');
+ end;
+ except
+ // if we have error, try loading default toolbar config or
+ // show error if it doesn't work
+ if tb_str = DEF_HISTORY_TOOLBAR then
+ begin
+ // don't think it should be translated:
+ HppMessageBox(Handle, 'Can not apply default toolbar configuration.' + #10#13 +
+ 'Looks like it is an internal problem.' + #10#13 + #10#13 +
+ 'Download new History++ version or report the error to the authors' + #10#13 +
+ '(include plugin version number and file date in the report).' + #10#13 + #10#13 +
+ 'You can find authors'' emails and plugin website in the Options->Plugins page.',
+ TranslateW('Error'), MB_OK or MB_ICONERROR);
+ Exit;
+ end
+ else
+ begin
+ DBDeleteContactSetting(0, hppDBName, 'HistoryToolbar');
+ LoadToolbar;
+ Exit;
+ end;
+ end;
+
+ // move buttons in reverse order and set parent afterwards
+ // thanks Luu Tran for this tip
+ // http://groups.google.com/group/borland.public.delphi.vcl.components.using/browse_thread/thread/da4e4da814baa745/c1ce8b671c1dac20
+ for i := High(tool) downto 0 do
+ begin
+ if not(tool[i] is TSpeedButton) then
+ tool[i].Parent := nil;
+ tool[i].Left := -3;
+ tool[i].Visible := True;
+ if not(tool[i] is TSpeedButton) then
+ tool[i].Parent := Toolbar;
+ end;
+
+ // Thanks Primoz Gabrijeleie for this trick!
+ // http://groups.google.com/group/alt.comp.lang.borland-delphi/browse_thread/thread/da77e8db6d8f418a/dc4fd87eee6b1d54
+ // This f***ing toolbar has almost got me!
+ // A bit of explanation: without the following line loading toolbar when
+ // window is show results in unpredictable buttons placed on toolbar
+ Toolbar.Perform(CM_RECREATEWND, 0, 0);
+end;
+
+procedure THistoryFrm.LoadToolbarIcons;
+var
+ il: HIMAGELIST;
+begin
+ try
+ ImageList_Remove(ilToolbar.Handle, -1); // clears image list
+ il := ImageList_Create(16, 16, ILC_COLOR32 or ILC_MASK, 10, 2);
+ if il <> 0 then
+ ilToolbar.Handle := il
+ else
+ il := ilToolbar.Handle;
+ Toolbar.Images := ilToolbar;
+
+ // add other icons without processing
+ tbUserDetails.ImageIndex := ImageList_AddIcon(il, hppIcons[HPP_ICON_CONTACDETAILS].Handle);
+ tbUserMenu.ImageIndex := ImageList_AddIcon(il, hppIcons[HPP_ICON_CONTACTMENU].Handle);
+ tbFilter.ImageIndex := ImageList_AddIcon(il, hppIcons[HPP_ICON_HOTFILTER].Handle);
+ tbSearch.ImageIndex := ImageList_AddIcon(il, hppIcons[HPP_ICON_HOTSEARCH].Handle);
+ tbDelete.ImageIndex := ImageList_AddIcon(il, hppIcons[HPP_ICON_TOOL_DELETE].Handle);
+ tbSessions.ImageIndex := ImageList_AddIcon(il, hppIcons[HPP_ICON_TOOL_SESSIONS].Handle);
+ tbSave.ImageIndex := ImageList_AddIcon(il, hppIcons[HPP_ICON_TOOL_SAVE].Handle);
+ tbCopy.ImageIndex := ImageList_AddIcon(il, hppIcons[HPP_ICON_TOOL_COPY].Handle);
+ tbHistorySearch.ImageIndex := ImageList_AddIcon(il, hppIcons[HPP_ICON_GLOBALSEARCH].Handle);
+ tbBookmarks.ImageIndex := ImageList_AddIcon(il, hppIcons[HPP_ICON_BOOKMARK].Handle);
+ tbHistory.ImageIndex := ImageList_AddIcon(il, hppIcons[HPP_ICON_CONTACTHISTORY].Handle);
+
+ LoadEventFilterButton;
+ finally
+ end;
+end;
+
+procedure THistoryFrm.SavePosition;
+// save position and filter setting
+var
+ SearchModeForSave: TSearchMode;
+begin
+ Utils_SaveFormPosition(Self, 0, hppDBName, 'HistoryWindow.');
+
+ if (not PasswordMode) and (HistoryLength > 0) then
+ begin
+ if hContact = 0 then
+ begin
+ WriteDBBool(hppDBName, 'ShowBookmarksSystem', paBook.Visible);
+ if paBook.Visible then
+ WriteDBInt(hppDBName, 'PanelWidth', paBook.Width);
+ end
+ else
+ begin
+ WriteDBBool(hppDBName, 'ShowSessions', paSess.Visible);
+ WriteDBBool(hppDBName, 'ShowBookmarks', paBook.Visible);
+ if paHolder.Visible then
+ WriteDBInt(hppDBName, 'PanelWidth', paHolder.Width);
+ if spBook.Visible then
+ WriteDBByte(hppDBName, 'PanelSplit', spBook.Tag);
+ end;
+ end;
+
+ if hContact <> 0 then
+ WriteDBBool(hppDBName, 'ExpandHeaders', hg.ExpandHeaders);
+ if SearchMode = smHotSearch then
+ SearchModeForSave := PreHotSearchMode
+ else
+ SearchModeForSave := SearchMode;
+ WriteDBByte(hppDBName, 'SearchMode', Byte(SearchModeForSave));
+end;
+
+procedure THistoryFrm.HMEventAdded(var Message: TMessage);
+// new message added to history (wparam=hcontact, lparam=hdbevent)
+begin
+ // if for this contact
+ if THandle(message.wParam) = hContact then
+ begin
+ // receive message from database
+ AddHistoryItem(message.lParam);
+ hgState(hg, hg.State);
+ end;
+end;
+
+procedure THistoryFrm.HMEventDeleted(var Message: TMessage);
+var
+ i: Integer;
+begin
+ { wParam - hContact; lParam - hDBEvent }
+ if hg.State = gsDelete then
+ Exit;
+ if THandle(message.wParam) <> hContact then
+ Exit;
+ for i := 0 to hg.count - 1 do
+ if (History[GridIndexToHistory(i)] = THandle(Message.lParam)) then
+ begin
+ hg.Delete(i);
+ hgState(hg, hg.State);
+ Exit;
+ end;
+end;
+
+procedure THistoryFrm.HMFiltersChanged(var M: TMessage);
+begin
+ CreateEventsFilterMenu;
+ SetEventFilter(0);
+end;
+
+procedure THistoryFrm.HMIcons2Changed(var M: TMessage);
+begin
+ Icon.Handle := CopyIcon(hppIcons[HPP_ICON_CONTACTHISTORY].Handle);
+ LoadToolbarIcons;
+ LoadButtonIcons;
+ LoadSessionIcons;
+ LoadBookIcons;
+ pbFilter.Repaint;
+ // hg.Repaint;
+end;
+
+procedure THistoryFrm.HMAccChanged(var M: TMessage);
+begin
+ ToggleMainMenu(Boolean(M.wParam));
+end;
+
+procedure THistoryFrm.HMBookmarkChanged(var M: TMessage);
+var
+ i: Integer;
+begin
+ if THandle(M.wParam) <> hContact then
+ Exit;
+ for i := 0 to hg.count - 1 do
+ if History[GridIndexToHistory(i)] = THandle(M.lParam) then
+ begin
+ hg.Bookmarked[i] := BookmarkServer[hContact].Bookmarked[M.lParam];
+ break;
+ end;
+ FillBookmarks;
+end;
+
+procedure THistoryFrm.HMPreShutdown(var Message: TMessage);
+begin
+ Close;
+end;
+
+procedure THistoryFrm.HMContactDeleted(var Message: TMessage);
+begin
+ if THandle(Message.wParam) <> hContact then
+ Exit;
+ Close;
+end;
+
+procedure THistoryFrm.HMToolbarChanged(var M: TMessage);
+begin
+ LoadToolbar;
+end;
+
+procedure THistoryFrm.HMNickChanged(var M: TMessage);
+begin
+ if SubProtocol = '' then
+ Exit;
+ hg.BeginUpdate;
+ if M.wParam = 0 then
+ hg.ProfileName := GetContactDisplayName(0, SubProtocol)
+ else if THandle(M.wParam) = hContact then
+ begin
+ hg.ProfileName := GetContactDisplayName(0, SubProtocol);
+ hg.ContactName := GetContactDisplayName(hContact, Protocol, True);
+ Caption := Format(TranslateW('%s - History++'), [hg.ContactName]);
+ end;
+ hg.EndUpdate;
+ hg.Invalidate;
+ if Assigned(EventDetailForm) then
+ TEventDetailsFrm(EventDetailForm).ResetItem;
+end;
+
+procedure THistoryFrm.HMMetaDefaultChanged(var M: TMessage);
+var
+ newSubContact: THandle;
+ newSubProtocol: AnsiString;
+begin
+ if THandle(M.wParam) <> hContact then
+ Exit;
+ GetContactProto(hContact, newSubContact, newSubProtocol);
+ if (hSubContact <> newSubContact) or (SubProtocol <> newSubProtocol) then
+ begin
+ hg.BeginUpdate;
+ FhSubContact := newSubContact;
+ FSubProtocol := newSubProtocol;
+ hg.ProfileName := GetContactDisplayName(0, newSubProtocol);
+ hg.ContactName := GetContactDisplayName(hContact, Protocol, True);
+ Caption := Format(TranslateW('%s - History++'), [hg.ContactName]);
+ hg.EndUpdate;
+ hg.Invalidate;
+ if Assigned(EventDetailForm) then
+ TEventDetailsFrm(EventDetailForm).ResetItem;
+ end;
+end;
+
+{ Unfortunatly when you make a form from a dll this form won't become the
+ normal messages specified by the VCL but only the basic windows messages.
+ Therefore neither tabs nor button shortcuts work on this form. As a workaround
+ i've make some functions: }
+
+procedure THistoryFrm.OnCNChar(var Message: TWMChar);
+// make tabs work!
+begin
+ if not(csDesigning in ComponentState) then
+ with Message do
+ begin
+ Result := 1;
+ if (Perform(WM_GETDLGCODE, 0, 0) and DLGC_WANTCHARS = 0) and
+ (GetParentForm(Self).Perform(CM_DIALOGCHAR, CharCode, KeyData) <> 0) then
+ Exit;
+ Result := 0;
+ end;
+end;
+
+procedure THistoryFrm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+var
+ Mask: Integer;
+begin
+ if (Key = VK_ESCAPE) or ((Key = VK_F4) and (ssAlt in Shift)) then
+ begin
+ if (Key = VK_ESCAPE) and edSearch.Focused then
+ SearchMode := smNone
+ else
+ Close;
+ Key := 0;
+ Exit;
+ end;
+
+ if (Key = VK_F10) and (Shift = []) and (not PasswordMode) then
+ begin
+ WriteDBBool(hppDBName, 'Accessability', True);
+ NotifyAllForms(HM_NOTF_ACCCHANGED, ORD(True), 0);
+ Key := 0;
+ Exit;
+ end;
+
+ if (Key = VK_F3) and ((Shift = []) or (Shift = [ssShift])) and (not PasswordMode) and
+ (SearchMode in [smSearch, smHotSearch]) then
+ begin
+ if ssShift in Shift then
+ sbSearchPrev.Click
+ else
+ sbSearchNext.Click;
+ Key := 0;
+ end;
+
+ // let only search keys be accepted if inline
+ if hg.State = gsInline then
+ Exit;
+
+ if not PasswordMode then
+ begin
+ if IsFormShortCut([mmAcc], Key, Shift) then
+ begin
+ Key := 0;
+ Exit;
+ end;
+ end;
+
+ with Sender as TWinControl do
+ begin
+ if Perform(CM_CHILDKEY, Key, lParam(Sender)) <> 0 then
+ Exit;
+ Mask := 0;
+ case Key of
+ VK_TAB:
+ Mask := DLGC_WANTTAB;
+ VK_RETURN, VK_EXECUTE, VK_ESCAPE, VK_CANCEL:
+ Mask := DLGC_WANTALLKEYS;
+ end;
+ if (Mask <> 0) and (Perform(CM_WANTSPECIALKEY, Key, 0) = 0) and
+ (Perform(WM_GETDLGCODE, 0, 0) and Mask = 0) and (Perform(CM_DIALOGKEY, Key, 0) <> 0) then
+ Exit;
+ end;
+end;
+
+procedure THistoryFrm.FillBookmarks;
+var
+ li: TListItem;
+ cb: TContactBookmarks;
+ i: Integer;
+ hi: THistoryItem;
+ hDBEvent: THandle;
+ txt: String;
+begin
+ lvBook.Items.BeginUpdate;
+ try
+ lvBook.Items.Clear;
+ // prefetch contact bookmarks object so we don't seek for it every time
+ cb := BookmarkServer[hContact];
+ for i := 0 to cb.count - 1 do
+ begin
+ li := lvBook.Items.Add;
+ hDBEvent := cb.Items[i];
+ txt := cb.Names[i];
+ if txt = '' then
+ begin
+ hi := ReadEvent(hDBEvent, UserCodepage);
+ txt := Copy(hi.Text, 1, 100);
+ txt := StringReplace(txt, #13#10, ' ', [rfReplaceAll]);
+ // without freeing Module AnsiString mem manager complains about memory leak! WTF???
+ Finalize(hi);
+ // hi.Module := '';
+ // hi.Proto := '';
+ // hi.Text := '';
+ end;
+ // compress spaces here!
+ li.Caption := txt;
+ li.Data := Pointer(hDBEvent);
+ li.ImageIndex := 0;
+ end;
+ finally
+ lvBook.Items.EndUpdate;
+ end;
+end;
+
+procedure THistoryFrm.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+ try
+ Action := caFree;
+ if Assigned(WindowList) then
+ begin
+ if WindowList.count = 1 then
+ begin
+ // we are the last left
+ if Assigned(PassCheckFm) then
+ FreeAndNil(PassCheckFm);
+ if Assigned(PassFm) then
+ FreeAndNil(PassFm);
+ end;
+ WindowList.Delete(WindowList.IndexOf(Self));
+ // Windows.ShowCaret(Handle);
+ // Windows.ShowCursor(True);
+ end;
+ SavePosition;
+ except
+ end;
+end;
+
+procedure THistoryFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+var
+ Flag: UINT;
+ AppSysMenu: THandle;
+begin
+ CanClose := (hg.State in [gsIdle, gsInline]);
+ if CanClose and IsLoadingSessions then
+ begin
+ // disable close button
+ AppSysMenu := GetSystemMenu(Handle, False);
+ Flag := MF_GRAYED;
+ EnableMenuItem(AppSysMenu, SC_CLOSE, MF_BYCOMMAND or Flag);
+ sb.SimpleText := TranslateW('Please wait while closing the window...');
+ // terminate thread
+ SessThread.Terminate(tpHigher);
+ repeat
+ Application.ProcessMessages
+ until not IsLoadingSessions;
+ end;
+ if CanClose and Assigned(SessThread) then
+ FreeAndNil(SessThread);
+end;
+
+procedure THistoryFrm.Load;
+begin
+ PreLoadHistory;
+ LoadHistory(Self);
+ PostLoadHistory;
+end;
+
+procedure THistoryFrm.LoadAccMenu;
+var
+ i: Integer;
+ wstr: String;
+ menuitem: TMenuItem;
+ pm: TPopupMenu;
+begin
+ mmToolbar.Clear;
+ for i := Toolbar.ButtonCount - 1 downto 0 do
+ begin
+ if Toolbar.Buttons[i].Style = tbsSeparator then
+ begin
+ menuitem := TMenuItem.Create(mmToolbar);
+ menuitem.Caption := '-';
+ end
+ else
+ begin
+ menuitem := TMenuItem.Create(Toolbar.Buttons[i]);
+ wstr := Toolbar.Buttons[i].Caption;
+ if wstr = '' then
+ wstr := Toolbar.Buttons[i].Hint;
+ if wstr <> '' then
+ begin
+ pm := TPopupMenu(Toolbar.Buttons[i].PopupMenu);
+ if pm = nil then
+ menuitem.OnClick := Toolbar.Buttons[i].OnClick
+ else
+ begin
+ menuitem.Tag := uint_ptr(Pointer(pm));
+ end;
+ menuitem.Caption := wstr;
+ menuitem.ShortCut := TextToShortCut(Toolbar.Buttons[i].HelpKeyword);
+ menuitem.Enabled := Toolbar.Buttons[i].Enabled;
+ menuitem.Visible := Toolbar.Buttons[i].Visible;
+ end;
+ end;
+ mmToolbar.Insert(0, menuitem);
+ end;
+ mmToolbar.RethinkHotkeys;
+end;
+
+var
+ SearchUpHint: String = 'Search Up (Ctrl+Up)';
+ SearchDownHint: String = 'Search Down (Ctrl+Down)';
+
+procedure THistoryFrm.LoadBookIcons;
+var
+ il: THandle;
+begin
+ lvBook.Items.BeginUpdate;
+ try
+ ImageList_Remove(ilBook.Handle, -1); // clears image list
+ il := ImageList_Create(16, 16, ILC_COLOR32 or ILC_MASK, 8, 2);
+ if il <> 0 then
+ ilBook.Handle := il
+ else
+ il := ilBook.Handle;
+
+ ImageList_AddIcon(il, hppIcons[HPP_ICON_BOOKMARK_ON].Handle);
+ finally
+ lvBook.Items.EndUpdate;
+ end;
+ // simple hack to avoid dark icons
+ ilBook.BkColor := lvBook.Color;
+end;
+
+procedure sButtonIcon(var sb: TSpeedButton; Icon: HICON);
+begin
+ with sb.Glyph do
+ begin
+ Width := 16;
+ Height := 16;
+ Canvas.Brush.Color := clBtnFace;
+ Canvas.FillRect(Canvas.ClipRect);
+ DrawiconEx(Canvas.Handle, 0, 0, Icon, 16, 16, 0, Canvas.Brush.Handle, DI_NORMAL);
+ end;
+end;
+
+procedure THistoryFrm.LoadButtonIcons;
+var
+ previc: HICON;
+ nextic: HICON;
+ // prev_hint, next_hint: WideString;
+begin
+ if hg.Reversed then
+ begin
+ nextic := hppIcons[HPP_ICON_SEARCHUP].Handle;
+ previc := hppIcons[HPP_ICON_SEARCHDOWN].Handle;
+ sbSearchNext.Hint := SearchUpHint;
+ sbSearchPrev.Hint := SearchDownHint;
+ end
+ else
+ begin
+ nextic := hppIcons[HPP_ICON_SEARCHDOWN].Handle;
+ previc := hppIcons[HPP_ICON_SEARCHUP].Handle;
+ sbSearchNext.Hint := SearchDownHint;
+ sbSearchPrev.Hint := SearchUpHint;
+ end;
+
+ sButtonIcon(sbSearchPrev, previc);
+ sButtonIcon(sbSearchNext, nextic);
+ sButtonIcon(sbClearFilter, hppIcons[HPP_ICON_HOTFILTERCLEAR].Handle);
+ sButtonIcon(sbCloseSess, hppIcons[HPP_ICON_SESS_HIDE].Handle);
+ sButtonIcon(sbCloseBook, hppIcons[HPP_ICON_SESS_HIDE].Handle);
+ {
+ with sbSearchPrev.Glyph do begin
+ Width := 16;
+ Height := 16;
+ Canvas.Brush.Color := clBtnFace;
+ Canvas.FillRect(Canvas.ClipRect);
+ DrawiconEx(Canvas.Handle,0,0,
+ previc,16,16,0,Canvas.Brush.Handle,DI_NORMAL);
+ end;
+ with sbSearchNext.Glyph do begin
+ Width := 16;
+ Height := 16;
+ Canvas.Brush.Color := clBtnFace;
+ Canvas.FillRect(Canvas.ClipRect);
+ DrawiconEx(Canvas.Handle,0,0,
+ nextic,16,16,0,Canvas.Brush.Handle,DI_NORMAL);
+ end;
+ with sbClearFilter.Glyph do begin
+ Width := 16;
+ Height := 16;
+ Canvas.Brush.Color := clBtnFace;
+ Canvas.FillRect(Canvas.ClipRect);
+ DrawiconEx(Canvas.Handle,0,0,
+ hppIcons[HPP_ICON_HOTFILTERCLEAR].Handle,16,16,0,Canvas.Brush.Handle,DI_NORMAL);
+ end;
+ with sbCloseSess.Glyph do begin
+ Width := 16;
+ Height := 16;
+ Canvas.Brush.Color := clBtnFace;
+ Canvas.FillRect(Canvas.ClipRect);
+ DrawiconEx(Canvas.Handle,0,0,
+ hppIcons[HPP_ICON_SESS_HIDE].Handle,16,16,0,Canvas.Brush.Handle,DI_NORMAL);
+ end;
+ with sbCloseBook.Glyph do begin
+ Width := 16;
+ Height := 16;
+ Canvas.Brush.Color := clBtnFace;
+ Canvas.FillRect(Canvas.ClipRect);
+ DrawiconEx(Canvas.Handle,0,0,
+ hppIcons[HPP_ICON_SESS_HIDE].Handle,16,16,0,Canvas.Brush.Handle,DI_NORMAL);
+ end;
+ }
+ imSearchNotFound.Picture.Icon.Handle := CopyIcon(hppIcons[HPP_ICON_SEARCH_NOTFOUND].Handle);
+ imSearchEndOfPage.Picture.Icon.Handle := CopyIcon(hppIcons[HPP_ICON_SEARCH_ENDOFPAGE].Handle);
+end;
+
+procedure THistoryFrm.LoadEventFilterButton;
+var
+ pad: DWord;
+ { PadV, } PadH, GlyphHeight: Integer;
+ sz: TSize;
+ FirstName, name: String;
+ PaintRect: TRect;
+ DrawTextFlags: Cardinal;
+ GlyphWidth: Integer;
+begin
+ FirstName := hppEventFilters[0].name;
+ Name := hppEventFilters[tbEventsFilter.Tag].name;
+ tbEventsFilter.Hint := Name; // show hint because the whole name may not fit in button
+
+ pad := SendMessage(Toolbar.Handle, TB_GETPADDING, 0, 0);
+ // PadV := HiWord(pad);
+ PadH := LoWord(pad);
+
+ tbEventsFilter.Glyph.Canvas.Font := tbEventsFilter.Font;
+ sz := tbEventsFilter.Glyph.Canvas.TextExtent(FirstName);
+ GlyphHeight := Max(sz.cy, 16);
+ GlyphWidth := 16 + sz.cx + tbEventsFilter.Spacing;
+
+ tbEventsFilter.Glyph.Height := GlyphHeight;
+ tbEventsFilter.Glyph.Width := GlyphWidth * 2;
+ tbEventsFilter.Glyph.Canvas.Brush.Color := clBtnFace;
+ tbEventsFilter.Glyph.Canvas.FillRect(tbEventsFilter.Glyph.Canvas.ClipRect);
+ DrawiconEx(tbEventsFilter.Glyph.Canvas.Handle, sz.cx + tbEventsFilter.Spacing,
+ ((GlyphHeight - 16) div 2), hppIcons[HPP_ICON_DROPDOWNARROW].Handle, 16, 16, 0,
+ tbEventsFilter.Glyph.Canvas.Brush.Handle, DI_NORMAL);
+ DrawState(tbEventsFilter.Glyph.Canvas.Handle, 0, nil,
+ hppIcons[HPP_ICON_DROPDOWNARROW].Handle, 0, sz.cx + tbEventsFilter.Spacing +
+ GlyphWidth, ((GlyphHeight - 16) div 2), 0, 0, DST_ICON or DSS_DISABLED);
+
+ tbEventsFilter.Glyph.Canvas.Brush.Style := bsClear;
+ PaintRect := Rect(0, ((GlyphHeight - sz.cy) div 2), GlyphWidth - 16 - tbEventsFilter.Spacing,
+ tbEventsFilter.Glyph.Height);
+ DrawTextFlags := DT_END_ELLIPSIS or DT_NOPREFIX or DT_CENTER;
+ tbEventsFilter.Glyph.Canvas.Font.Color := clWindowText;
+ DrawTextW(tbEventsFilter.Glyph.Canvas.Handle, @Name[1], Length(Name), PaintRect,
+ DrawTextFlags);
+ OffsetRect(PaintRect, GlyphWidth, 0);
+ tbEventsFilter.Glyph.Canvas.Font.Color := clGrayText;
+ DrawTextW(tbEventsFilter.Glyph.Canvas.Handle, @Name[1], Length(Name), PaintRect,
+ DrawTextFlags);
+ tbEventsFilter.Width := GlyphWidth + 2 * PadH;
+ tbEventsFilter.NumGlyphs := 2;
+end;
+
+procedure THistoryFrm.LoadPendingHeaders(rowidx: Integer; count: Integer);
+// reads hDBEvents from the database until this row (begin from end which was loaded at the startup)
+// 2006.02.13 reads a windows with rowidx at center. Prefeching
+var
+ // startrowidx: integer;
+ fromRow, tillRow: Integer;
+ fromRowIdx, tillRowIdx: Integer;
+ ridx: Integer;
+ hDBEvent: THandle;
+begin
+ if History[rowidx] <> 0 then
+ Exit;
+{$IFDEF DEBUG}
+ OutPutDebugString(PWideChar('Loading pending headers = ' + intToStr(rowidx)));
+{$ENDIF}
+ Screen.Cursor := crHourGlass;
+ try
+ fromRow := rowidx + hppLoadBlock shr 1;
+ if fromRow > HistoryLength - 1 then
+ fromRow := HistoryLength - 1;
+ fromRowIdx := rowidx;
+ repeat
+ Inc(fromRowIdx)
+ until (fromRowIdx > HistoryLength - 1) or (History[fromRowIdx] <> 0);
+
+ tillRow := rowidx - hppLoadBlock shr 1;
+ if tillRow < 0 then
+ tillRow := 0;
+ tillRowIdx := rowidx;
+ repeat
+ dec(tillRowIdx)
+ until (tillRowIdx < 0) or (History[tillRowIdx] <> 0);
+
+ if fromRowIdx - rowidx < rowidx - tillRowIdx then
+ begin
+ if fromRowIdx > HistoryLength - 1 then
+ begin
+ fromRowIdx := HistoryLength - 1;
+ hDBEvent := CallService(MS_DB_EVENT_FINDLAST, hContact, 0);
+ History[fromRowIdx] := hDBEvent;
+ end
+ else
+ hDBEvent := History[fromRowIdx];
+ for ridx := fromRowIdx - 1 downto tillRow do
+ begin
+ if History[ridx] <> 0 then
+ break;
+ hDBEvent := CallService(MS_DB_EVENT_FINDPREV, hDBEvent, 0);
+ History[ridx] := NotZero(hDBEvent);
+ end;
+ end
+ else
+ begin
+ if tillRowIdx < 0 then
+ begin
+ tillRowIdx := 0;
+ hDBEvent := CallService(MS_DB_EVENT_FINDFIRST, hContact, 0);
+ History[tillRowIdx] := hDBEvent;
+ end
+ else
+ hDBEvent := History[tillRowIdx];
+ for ridx := tillRowIdx + 1 to fromRow do
+ begin
+ if History[ridx] <> 0 then
+ break;
+ hDBEvent := CallService(MS_DB_EVENT_FINDNEXT, hDBEvent, 0);
+ History[ridx] := NotZero(hDBEvent);
+ end;
+ end;
+{$IFDEF DEBUG}
+ OutPutDebugString(PWideChar('... pending headers from ' + intToStr(fromRow) + ' to ' +
+ intToStr(tillRow)));
+{$ENDIF}
+ finally
+ Screen.Cursor := crDefault;
+ end;
+end;
+
+procedure THistoryFrm.FormDestroy(Sender: TObject);
+begin
+ // this is the only event fired when history is open
+ // and miranda is closed
+ // (added: except now I added ME_SYSTEM_PRESHUTDOWN hook, which should work)
+ if Assigned(CustomizeToolbarForm) then
+ CustomizeToolbarForm.Release;
+ if Assigned(CustomizeFiltersForm) then
+ CustomizeFiltersForm.Release;
+ if Assigned(EventDetailForm) then
+ EventDetailForm.Release;
+end;
+
+procedure THistoryFrm.DeleteHistoryItem(ItemIdx: Integer);
+// history[itemidx] löschen (also row-1)
+// var
+// p: integer;
+begin
+ // for p:=ItemIdx to HistoryLength-2 do
+ // History[p]:=history[p+1];
+ dec(HistoryLength);
+ if ItemIdx <> HistoryLength then
+ begin
+ Move(History[ItemIdx + 1], History[ItemIdx], (HistoryLength - ItemIdx) *
+ SizeOf(History[0]));
+ // reset has_header and linked_to_pervous_messages fields
+ hg.ResetItem(HistoryIndexToGrid(ItemIdx));
+ end;
+ SetLength(History, HistoryLength);
+end;
+
+procedure THistoryFrm.AddEventToSessions(hDBEvent: THandle);
+var
+ ts: DWord;
+ dt: TDateTime;
+ idx: Integer;
+ year, month, day: TTreeNode;
+ AddNewSession: Boolean;
+begin
+ ts := GetEventTimestamp(hDBEvent);
+ AddNewSession := True;
+ if Length(Sessions) > 0 then
+ begin
+ idx := High(Sessions);
+ if (ts - Sessions[idx].TimestampLast) <= SESSION_TIMEDIFF then
+ begin
+ Sessions[idx].hDBEventLast := hDBEvent;
+ Sessions[idx].TimestampLast := ts;
+ Inc(Sessions[idx].ItemsCount);
+ AddNewSession := False;
+ end;
+ end;
+ if AddNewSession then
+ begin
+ idx := Length(Sessions);
+ SetLength(Sessions, idx + 1);
+ Sessions[idx].hDBEventFirst := hDBEvent;
+ Sessions[idx].TimestampFirst := ts;
+ Sessions[idx].hDBEventLast := Sessions[idx].hDBEventFirst;
+ Sessions[idx].TimestampLast := Sessions[idx].TimestampFirst;
+ Sessions[idx].ItemsCount := 1;
+
+ dt := TimestampToDateTime(ts);
+ year := nil;
+ if tvSess.Items.GetFirstNode <> nil then
+ begin
+ year := tvSess.Items.GetFirstNode;
+ while year.getNextSibling <> nil do
+ year := year.getNextSibling;
+ if int_ptr(year.Data) <> YearOf(dt) then
+ year := nil;
+ end;
+ if year = nil then
+ begin
+ year := tvSess.Items.AddChild(nil, FormatDateTime(HPP_SESS_YEARFORMAT, dt));
+ year.Data := Pointer(YearOf(dt));
+ year.ImageIndex := 5;
+ // year.SelectedIndex := year.ImageIndex;
+ end;
+ month := nil;
+ if year.GetLastChild <> nil then
+ begin
+ month := year.GetLastChild;
+ if int_ptr(month.Data) <> MonthOf(dt) then
+ month := nil;
+ end;
+ if month = nil then
+ begin
+ month := tvSess.Items.AddChild(year, FormatDateTime(HPP_SESS_MONTHFORMAT, dt));
+ month.Data := Pointer(MonthOf(dt));
+ case MonthOf(dt) of
+ 12, 1 .. 2: month.ImageIndex := 3;
+ 3 .. 5: month.ImageIndex := 4;
+ 6 .. 8: month.ImageIndex := 1;
+ 9 .. 11: month.ImageIndex := 2;
+ end;
+ // month.SelectedIndex := month.ImageIndex;
+ end;
+ day := tvSess.Items.AddChild(month, FormatDateTime(HPP_SESS_DAYFORMAT, dt));
+ day.Data := Pointer(idx);
+ day.ImageIndex := 0;
+ // day.SelectedIndex := day.ImageIndex;
+ end;
+end;
+
+procedure THistoryFrm.AddHistoryItem(hDBEvent: THandle);
+// only add single lines, not whole histories, because this routine is pretty
+// slow
+begin
+ Inc(HistoryLength);
+ SetLength(History, HistoryLength);
+ History[HistoryLength - 1] := hDBEvent;
+ hg.AddItem;
+ if HistoryLength = 1 then
+ if GetDBBool(hppDBName, 'ShowSessions', False) and not(hpSessions in Panel) then
+ Panel := Panel + [hpSessions];
+end;
+
+procedure THistoryFrm.hgItemData(Sender: TObject; Index: Integer; var Item: THistoryItem);
+var
+ PrevTimestamp: DWord;
+ PrevMessageType: TMessageTypes;
+ HistoryIndex: Integer;
+begin
+ HistoryIndex := GridIndexToHistory(Index);
+ Item := GetItemData(HistoryIndex);
+ if hContact = 0 then
+ Item.Proto := Item.Module
+ else
+ Item.Proto := Protocol;
+ Item.Bookmarked := BookmarkServer[hContact].Bookmarked[History[HistoryIndex]];
+ if HistoryIndex = 0 then
+ Item.HasHeader := IsEventInSession(Item.EventType)
+ else
+ begin
+ if History[HistoryIndex - 1] = 0 then
+ LoadPendingHeaders(HistoryIndex - 1, HistoryLength);
+ PrevTimestamp := GetEventTimestamp(History[HistoryIndex - 1]);
+ if IsEventInSession(Item.EventType) then
+ Item.HasHeader := ((DWord(Item.Time) - PrevTimestamp) > SESSION_TIMEDIFF);
+ if not Item.Bookmarked then
+ begin
+ PrevMessageType := GetEventMessageType(History[HistoryIndex - 1]);
+ if Item.MessageType = PrevMessageType then
+ Item.LinkedToPrev := ((DWord(Item.Time) - PrevTimestamp) < 60);
+ end;
+ end;
+end;
+
+procedure THistoryFrm.hgTranslateTime(Sender: TObject; Time: Cardinal; var Text: String);
+begin
+ Text := TimestampToString(Time);
+end;
+
+procedure THistoryFrm.hgPopup(Sender: TObject);
+begin
+ SpeakMessage1.Visible := MeSpeakEnabled;
+ Delete1.Visible := False;
+ SaveSelected1.Visible := False;
+ if hContact = 0 then
+ begin
+ SendMessage1.Visible := False;
+ ReplyQuoted1.Visible := False;
+ end;
+ if hg.Selected <> -1 then
+ begin
+ Delete1.Visible := True;
+ if GridOptions.OpenDetailsMode then
+ Details1.Caption := TranslateW('&Pseudo-edit')
+ else
+ Details1.Caption := TranslateW('&Open');
+ SaveSelected1.Visible := (hg.SelCount > 1);
+ FileActions.Visible := IsFileEvent(hg.Selected);
+ if FileActions.Visible then
+ OpenFileFolder.Visible := (SavedFileDir <> '');
+ pmGrid.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
+ end;
+end;
+
+procedure THistoryFrm.hgSearchFinished(Sender: TObject; Text: String; Found: Boolean);
+var
+ t: String;
+begin
+ if LastSearch <> lsHotSearch then
+ LastHotIdx := hg.Selected;
+ LastSearch := lsHotSearch;
+ if Text = '' then
+ begin
+ if (LastHotIdx <> -1) and (HotString <> '') then
+ hg.Selected := LastHotIdx;
+ LastSearch := lsNone;
+ HotString := Text;
+ hgState(Self, gsIdle);
+ Exit;
+ end;
+ HotString := Text;
+ {
+ if Found then t := 'Search: "'+Text+'" (Ctrl+Enter to search again)'
+ else t := 'Search: "'+Text+'" (not found)';
+ sb.SimpleText := t;
+ }
+
+ if not Found then
+ t := HotString
+ else
+ t := Text;
+ sb.SimpleText := Format(TranslateW('HotSearch: %s (F3 to find next)'), [t]);
+ // if Found then HotString := Text;
+end;
+
+procedure THistoryFrm.hgBookmarkClick(Sender: TObject; Item: Integer);
+var
+ val: Boolean;
+ hDBEvent: THandle;
+begin
+ hDBEvent := History[GridIndexToHistory(Item)];
+ val := not BookmarkServer[hContact].Bookmarked[hDBEvent];
+ BookmarkServer[hContact].Bookmarked[hDBEvent] := val;
+end;
+
+procedure THistoryFrm.hgChar(Sender: TObject; var achar: WideChar; Shift: TShiftState);
+var
+ Mes: TWMChar;
+begin
+ if SearchMode = smNone then
+ SearchMode := smSearch;
+ edSearch.SetFocus;
+ edSearch.SelStart := Length(edSearch.Text);
+ edSearch.SelLength := 0;
+ // edSearch.Text := AnsiChar;
+ ZeroMemory(@Mes, SizeOf(Mes));
+ Mes.Msg := WM_CHAR;
+ Mes.CharCode := Word(achar);
+ Mes.KeyData := ShiftStateToKeyData(Shift);
+ edSearch.Perform(WM_CHAR, TMessage(Mes).wParam, TMessage(Mes).lParam);
+ achar := #0;
+end;
+
+procedure THistoryFrm.hgDblClick(Sender: TObject);
+begin
+ if hg.Selected = -1 then
+ Exit;
+ if GridOptions.OpenDetailsMode then
+ OpenDetails(hg.Selected)
+ else
+ hg.EditInline(hg.Selected);
+end;
+
+procedure THistoryFrm.tbSaveClick(Sender: TObject);
+var
+ t: String;
+ SaveFormat: TSaveFormat;
+begin
+ if hg.Selected = -1 then
+ Exit;
+ RecentFormat := TSaveFormat(GetDBInt(hppDBName, 'ExportFormat', 0));
+ SaveFormat := RecentFormat;
+ PrepareSaveDialog(SaveDialog, SaveFormat, True);
+ t := TranslateW('Partial History [%s] - [%s]');
+ t := Format(t, [hg.ProfileName, hg.ContactName]);
+ t := MakeFileName(t);
+ // t := t + SaveDialog.DefaultExt;
+ SaveDialog.FileName := t;
+ if not SaveDialog.Execute then
+ Exit;
+ // why SaveDialog.FileName shows '' here???
+ // who knows? In debugger FFileName shows right file, but
+ // FileName property returns ''
+ for SaveFormat := High(SaveFormats) downto Low(SaveFormats) do
+ if SaveDialog.FilterIndex = SaveFormats[SaveFormat].Index then
+ break;
+ if SaveFormat <> sfAll then
+ RecentFormat := SaveFormat;
+ // hg.SaveSelected(SaveDialog.FileName,RecentFormat);
+ hg.SaveSelected(SaveDialog.Files[0], RecentFormat);
+ WriteDBInt(hppDBName, 'ExportFormat', Integer(RecentFormat));
+end;
+
+procedure THistoryFrm.sbCloseBookClick(Sender: TObject);
+begin
+ Panel := Panel - [hpBookmarks]
+end;
+
+procedure THistoryFrm.sbCloseSessClick(Sender: TObject);
+begin
+ Panel := Panel - [hpSessions]
+end;
+
+procedure THistoryFrm.sbSearchNextClick(Sender: TObject);
+begin
+ Search(True, True);
+end;
+
+procedure THistoryFrm.sbSearchPrevClick(Sender: TObject);
+begin
+ Search(False, True);
+end;
+
+procedure THistoryFrm.hgItemDelete(Sender: TObject; Index: Integer);
+var
+ idx: Integer;
+ hDBEvent: THANDLE;
+begin
+ if Index = -1 then
+ begin // routine is called from DeleteAll
+ if FormState = gsDelete then
+ begin // probably unnecessary considering prev check
+ hDBEvent := CallService(MS_DB_EVENT_FINDFIRST, hContact, 0);
+ CallService(MS_DB_EVENT_DELETE, hContact, hDBEvent);
+ end;
+ end
+ else
+ begin
+ idx := GridIndexToHistory(Index);
+ if (FormState = gsDelete) and (History[idx] <> 0) then
+ CallService(MS_DB_EVENT_DELETE, hContact, History[idx]);
+ DeleteEventFromSessions(idx);
+ DeleteHistoryItem(idx);
+ end;
+ hgState(hg, hg.State);
+ Application.ProcessMessages;
+end;
+
+procedure THistoryFrm.hgItemFilter(Sender: TObject; Index: Integer; var Show: Boolean);
+begin
+
+ // if we have AnsiString filter
+ if HotFilterString <> '' then
+ begin
+ if Pos(WideUpperCase(HotFilterString), WideUpperCase(hg.Items[Index].Text)) = 0 then
+ Show := False;
+ Exit;
+ end;
+
+ // if filter by sessions disabled, then exit
+ if StartTimestamp <> 0 then
+ begin
+ // Show := False;
+ if hg.Items[Index].Time >= StartTimestamp then
+ begin
+ if EndTimestamp = 0 then
+ Exit
+ else
+ begin
+ if hg.Items[Index].Time < EndTimestamp then
+ Exit
+ else
+ Show := False;
+ end;
+ end
+ else
+ Show := False;
+ end;
+end;
+
+procedure THistoryFrm.tbDeleteClick(Sender: TObject);
+begin
+ if hg.SelCount = 0 then
+ Exit;
+ if hg.SelCount > 1 then
+ begin
+ if HppMessageBox(Handle,
+ WideFormat(TranslateW('Do you really want to delete selected items (%.0f)?'),
+ [hg.SelCount / 1]), TranslateW('Delete Selected'), MB_YESNOCANCEL or MB_DEFBUTTON1 or
+ MB_ICONQUESTION) <> IDYES then
+ Exit;
+ end
+ else
+ begin
+ if HppMessageBox(Handle, TranslateW('Do you really want to delete selected item?'),
+ TranslateW('Delete'), MB_YESNOCANCEL or MB_DEFBUTTON1 or MB_ICONQUESTION) <> IDYES then
+ Exit;
+ end;
+
+ if hg.SelCount = hg.count then
+ EmptyHistory
+ else
+ begin
+ SetSafetyMode(False);
+ try
+ FormState := gsDelete;
+ hg.DeleteSelected;
+ finally
+ FormState := gsIdle;
+ SetSafetyMode(True);
+ end;
+ end;
+end;
+
+function THistoryFrm.GridIndexToHistory(Index: Integer): Integer;
+begin
+ Result := HistoryLength - 1 - Index;
+end;
+
+function THistoryFrm.HistoryIndexToGrid(Index: Integer): Integer;
+begin
+ Result := HistoryLength - 1 - Index;
+end;
+
+procedure THistoryFrm.mmHideMenuClick(Sender: TObject);
+begin
+ WriteDBBool(hppDBName, 'Accessability', False);
+ NotifyAllForms(HM_NOTF_ACCCHANGED, WPARAM(False), 0);
+end;
+
+procedure THistoryFrm.tbCopyClick(Sender: TObject);
+begin
+ if hg.Selected = -1 then
+ Exit;
+ CopyToClip(hg.FormatSelected(GridOptions.ClipCopyFormat), Handle, UserCodepage);
+end;
+
+procedure THistoryFrm.Details1Click(Sender: TObject);
+begin
+ if hg.Selected = -1 then
+ Exit;
+ if GridOptions.OpenDetailsMode then
+ hg.EditInline(hg.Selected)
+ else
+ OpenDetails(hg.Selected);
+end;
+
+procedure THistoryFrm.OpenDetails(Item: Integer);
+begin
+ if not Assigned(EventDetailForm) then
+ begin
+ EventDetailForm := TEventDetailsFrm.Create(Self);
+ TEventDetailsFrm(EventDetailForm).ParentForm := Self;
+ TEventDetailsFrm(EventDetailForm).Item := Item;
+ TEventDetailsFrm(EventDetailForm).Show;
+ end
+ else
+ begin
+ TEventDetailsFrm(EventDetailForm).Item := Item;
+ TEventDetailsFrm(EventDetailForm).Show;
+ end;
+end;
+
+function THistoryFrm.GetItemData(Index: Integer): THistoryItem;
+var
+ hDBEvent: THandle;
+begin
+ hDBEvent := History[Index];
+ if hDBEvent = 0 then
+ begin
+ LoadPendingHeaders(Index, HistoryLength);
+ hDBEvent := History[Index];
+ if hDBEvent = 0 then
+ raise EAbort.Create('can''t load event');
+ end;
+ Result := ReadEvent(hDBEvent, UserCodepage);
+{$IFDEF DEBUG}
+ OutPutDebugString(PWideChar('Get item data from DB ' + intToStr(Index) + ' #' + intToStr(hDBEvent)));
+{$ENDIF}
+end;
+
+var
+ WasReturnPressed: Boolean = False;
+
+procedure THistoryFrm.hgKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+var
+ pm: TPopupMenu;
+begin
+ if hg.State = gsInline then
+ pm := pmInline
+ else
+ pm := pmGrid;
+
+ if IsFormShortCut([pm], Key, Shift) then
+ begin
+ Key := 0;
+ Exit;
+ end;
+
+ WasReturnPressed := (Key = VK_RETURN);
+end;
+
+procedure THistoryFrm.hgState(Sender: TObject; State: TGridState);
+var
+ t: String;
+begin
+ if csDestroying in ComponentState then
+ Exit;
+ if PasswordMode then
+ t := ''
+ else
+ case State of
+ gsIdle:
+ t := Format(TranslateW('%.0n items in history'), [HistoryLength / 1]);
+ gsLoad:
+ t := TranslateW('Loading...');
+ gsSave:
+ t := TranslateW('Saving...');
+ gsSearch:
+ t := TranslateW('Searching...');
+ gsDelete:
+ t := TranslateW('Deleting...');
+ gsInline:
+ t := TranslateW('Pseudo-edit mode...');
+ end;
+ sb.SimpleText := t;
+end;
+
+procedure THistoryFrm.DeleteEventFromSessions(ItemIdx: Integer);
+var
+ ts: DWord;
+ dt: TDateTime;
+ year, month, day: TTreeNode;
+ i, idx: Integer;
+ hDBEvent: THandle;
+begin
+ hDBEvent := History[ItemIdx];
+ ts := GetEventTimestamp(hDBEvent);
+
+ // find idx in sessions array
+ idx := -1;
+ for i := Length(Sessions) - 1 downto 0 do
+ if (ts >= Sessions[i].TimestampFirst) and (ts <= Sessions[i].TimestampLast) then
+ begin
+ idx := i;
+ break;
+ end;
+ if idx = -1 then
+ Exit;
+
+ dec(Sessions[idx].ItemsCount);
+
+ // if the event is not first, we can do it faster
+ if Sessions[idx].hDBEventFirst <> hDBEvent then
+ begin
+ if Sessions[idx].hDBEventLast = hDBEvent then
+ begin
+ hDBEvent := CallService(MS_DB_EVENT_FINDPREV, hDBEvent, 0);
+ if hDBEvent <> 0 then
+ begin
+ Sessions[idx].hDBEventLast := hDBEvent;
+ Sessions[idx].TimestampLast := GetEventTimestamp(hDBEvent);
+ end
+ else
+ begin // ????
+ Sessions[idx].hDBEventLast := Sessions[idx].hDBEventFirst;
+ Sessions[idx].TimestampLast := Sessions[idx].TimestampFirst;
+ end;
+ end;
+ Exit;
+ end;
+
+ // now, the even is the first, probably the last in session
+ dt := TimestampToDateTime(ts);
+ year := tvSess.Items.GetFirstNode;
+ while year <> nil do
+ begin
+ if int_ptr(year.Data) = YearOf(dt) then
+ break;
+ year := year.getNextSibling;
+ end;
+ if year = nil then
+ Exit; // ???
+ month := year.getFirstChild;
+ while month <> nil do
+ begin
+ if int_ptr(month.Data) = MonthOf(dt) then
+ break;
+ month := month.getNextSibling;
+ end;
+ if month = nil then
+ Exit; // ???
+ day := month.getFirstChild;
+ while day <> nil do
+ begin
+ if int_ptr(day.Data) = idx then
+ break;
+ day := day.getNextSibling;
+ end;
+ if day = nil then
+ Exit; // ???
+ if Sessions[idx].ItemsCount = 0 then
+ begin
+ day.Delete;
+ if month.count = 0 then
+ month.Delete;
+ if year.count = 0 then
+ year.Delete;
+ // hmm... should we delete record in sessions array?
+ // I'll not do it for the speed, I don't think there would be problems
+ Sessions[idx].hDBEventFirst := 0;
+ Sessions[idx].TimestampFirst := 0;
+ Sessions[idx].hDBEventLast := 0;
+ Sessions[idx].TimestampLast := 0;
+ Exit;
+ end;
+ hDBEvent := CallService(MS_DB_EVENT_FINDNEXT, hDBEvent, 0);
+ if hDBEvent <> 0 then
+ begin
+ Sessions[idx].hDBEventFirst := hDBEvent;
+ Sessions[idx].TimestampFirst := GetEventTimestamp(hDBEvent);
+ end
+ else
+ begin // ????
+ Sessions[idx].hDBEventFirst := Sessions[idx].hDBEventLast;
+ Sessions[idx].TimestampFirst := Sessions[idx].TimestampLast;
+ end;
+ ts := Sessions[idx].TimestampFirst;
+ dt := TimestampToDateTime(ts);
+ day.Text := FormatDateTime(HPP_SESS_DAYFORMAT, dt);
+ // next item
+ // Inc(ItemIdx);
+ // if ItemIdx >= HistoryLength then exit;
+ // hg.ResetItem(HistoryIndexToGrid(ItemIdx));
+end;
+
+procedure THistoryFrm.SaveasHTML2Click(Sender: TObject);
+var
+ t: String;
+begin
+ PrepareSaveDialog(SaveDialog, sfHtml);
+ t := Format(TranslateW('Full History [%s] - [%s]'), [hg.ProfileName, hg.ContactName]);
+ t := MakeFileName(t);
+ SaveDialog.FileName := t;
+ if not SaveDialog.Execute then
+ Exit;
+ RecentFormat := sfHtml;
+ hg.SaveAll(SaveDialog.Files[0], sfHtml);
+ WriteDBInt(hppDBName, 'ExportFormat', Integer(RecentFormat));
+end;
+
+procedure THistoryFrm.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
+begin
+ inherited;
+ with Message.MinMaxInfo^ do
+ begin
+ ptMinTrackSize.X := 320;
+ ptMinTrackSize.Y := 240;
+ end
+end;
+
+procedure THistoryFrm.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer;
+ MousePos: TPoint; var Handled: Boolean);
+begin
+ if PasswordMode then
+ Exit;
+ Handled := True;
+ (* we can get range check error (???) here
+ it looks that without range check it works ok
+ so turn it off *)
+{$RANGECHECKS OFF}
+ hg.Perform(WM_MOUSEWHEEL, MakeLong(MK_CONTROL, WheelDelta), 0);
+{$RANGECHECKS ON}
+end;
+
+procedure THistoryFrm.hgSelect(Sender: TObject; Item, OldItem: Integer);
+begin
+ tbCopy.Enabled := (Item <> -1);
+ tbDelete.Enabled := (Item <> -1);
+ tbSave.Enabled := (hg.SelCount > 1);
+
+ if hg.HotString = '' then
+ begin
+ LastHotIdx := -1;
+ // redraw status bar
+ hgState(hg, gsIdle);
+ end;
+end;
+
+procedure THistoryFrm.Search(Next, FromNext: Boolean);
+var
+ Down: Boolean;
+ Item: Integer;
+ ShowEndOfPage: Boolean;
+ ShowNotFound: Boolean;
+begin
+ if edSearch.Text = '' then
+ begin
+ paSearchStatus.Visible := False;
+ edSearch.Color := clWindow;
+ Exit;
+ end;
+ if Next then
+ Down := not hg.Reversed
+ else
+ Down := hg.Reversed;
+ Item := hg.Search(edSearch.Text, False, False, False, FromNext, Down);
+ ShowEndOfPage := (Item = -1);
+ if Item = -1 then
+ Item := hg.Search(edSearch.Text, False, True, False, FromNext, Down);
+ if Item <> -1 then
+ begin
+ hg.Selected := Item;
+ edSearch.Color := clWindow;
+ ShowNotFound := False;
+ end
+ else
+ begin
+ edSearch.Color := $008080FF;
+ ShowEndOfPage := False;
+ ShowNotFound := True;
+ end;
+ if ShowNotFound or ShowEndOfPage then
+ begin
+ imSearchNotFound.Visible := ShowNotFound;
+ imSearchEndOfPage.Visible := ShowEndOfPage;
+ if ShowNotFound then
+ laSearchState.Caption := TranslateW('Phrase not found')
+ else if ShowEndOfPage then
+ begin
+ if Down then
+ laSearchState.Caption := TranslateW('Continued from the top')
+ else
+ laSearchState.Caption := TranslateW('Continued from the bottom');
+ end;
+ paSearchStatus.Width := 22 + laSearchState.Width + 3;
+ paSearchStatus.Left := paSearchButtons.Left - paSearchStatus.Width;
+ paSearchStatus.Visible := True;
+ end
+ else
+ begin
+ paSearchStatus.Visible := False;
+ // paSearchStatus.Width := 0;
+ end;
+ // paSearch2.Width := paSearchButtons.Left + paSearchButtons.Width;
+end;
+
+procedure THistoryFrm.SearchNext(Rev: Boolean; Warp: Boolean = True);
+// var
+// stext,t,tCap: WideString;
+// res: Integer;
+// mcase,down: Boolean;
+// WndHandle: HWND;
+begin
+ { if LastSearch = lsNone then exit;
+ if LastSearch = lsHotSearch then begin
+ stext := HotString;
+ mcase := False;
+ end else begin
+ stext := FindDialog.FindText;
+ mcase := (frMatchCase in FindDialog.Options);
+ end;
+ if stext = '' then exit;
+ down := not hg.reversed;
+ if Rev then Down := not Down;
+ res := hg.Search(stext, mcase, not Warp, False, Warp, Down);
+ if res <> -1 then begin
+ // found
+ hg.Selected := res;
+ if LastSearch = lsSearch then
+ t := TranslateW('Search: %s (F3 to find next)')
+ else
+ t := TranslateW('HotSearch: %s (F3 to find next)');
+ sb.SimpleText := WideFormat(t,[stext]);
+ end else begin
+ if (LastSearch = lsSearch) and (FindDialog.Handle <> 0) then
+ WndHandle := FindDialog.Handle
+ else
+ WndHandle := Handle;
+ tCap := TranslateW('History++ Search');
+ // not found
+ if Warp and (down = not hg.Reversed) then begin
+ // do warp?
+ if HppMessageBox(WndHandle,
+ TranslateW('You have reached the end of the history.')+#10#13+
+ TranslateW('Do you want to continue searching at the beginning?'),
+ tCap, MB_YESNOCANCEL or MB_DEFBUTTON1 or MB_ICONQUESTION) = ID_YES then
+ SearchNext(Rev,False);
+ end else begin
+ // not warped
+ hgState(Self,gsIdle);
+ // 25.03.03 OXY: FindDialog looses focus when
+ // calling ShowMessage, using MessageBox instead
+ t := TranslateW('"%s" not found');
+ HppMessageBox(WndHandle, WideFormat(t,[stext]),tCap, MB_OK or MB_DEFBUTTON1 or 0);
+ end;
+ end; }
+end;
+
+procedure THistoryFrm.ReplyQuoted(Item: Integer);
+begin
+ if (hContact = 0) or (hg.SelCount = 0) then
+ Exit;
+ SendMessageTo(hContact, hg.FormatSelected(GridOptions.ReplyQuotedFormat));
+end;
+
+procedure THistoryFrm.SaveasXML2Click(Sender: TObject);
+var
+ t: String;
+begin
+ PrepareSaveDialog(SaveDialog, sfXML);
+ t := Format(TranslateW('Full History [%s] - [%s]'), [hg.ProfileName, hg.ContactName]);
+ t := MakeFileName(t);
+ SaveDialog.FileName := t;
+ if not SaveDialog.Execute then
+ Exit;
+ hg.SaveAll(SaveDialog.Files[0], sfXML);
+ RecentFormat := sfXML;
+ WriteDBInt(hppDBName, 'ExportFormat', Integer(RecentFormat));
+end;
+
+procedure THistoryFrm.SaveasText2Click(Sender: TObject);
+var
+ t: String;
+ SaveFormat: TSaveFormat;
+begin
+ SaveFormat := sfUnicode;
+ PrepareSaveDialog(SaveDialog, SaveFormat);
+ t := Format(TranslateW('Full History [%s] - [%s]'), [hg.ProfileName, hg.ContactName]);
+ t := MakeFileName(t);
+ SaveDialog.FileName := t;
+ if not SaveDialog.Execute then
+ Exit;
+ case SaveDialog.FilterIndex of
+ 1: SaveFormat := sfUnicode;
+ 2: SaveFormat := sfText;
+ end;
+ RecentFormat := SaveFormat;
+ hg.SaveAll(SaveDialog.Files[0], SaveFormat);
+ // hg.SaveAll(SaveDialog.FileName,SaveFormat);
+ WriteDBInt(hppDBName, 'ExportFormat', Integer(RecentFormat));
+end;
+
+procedure THistoryFrm.hgXMLData(Sender: TObject; Index: Integer; var Item: TXMLItem);
+var
+ tmp: AnsiString;
+ dt: TDateTime;
+ Mes: String;
+begin
+ dt := TimestampToDateTime(hg.Items[Index].Time);
+ Item.Time := MakeTextXMLedA(AnsiString(FormatDateTime('hh:mm:ss', dt)));
+ Item.Date := MakeTextXMLedA(AnsiString(FormatDateTime('yyyy-mm-dd', dt)));
+
+ Item.Contact := UTF8Encode(MakeTextXMLedW(hg.ContactName));
+ if mtIncoming in hg.Items[Index].MessageType then
+ Item.From := Item.Contact
+ else
+ Item.From := '&ME;';
+
+ Item.EventType := '&' + GetEventRecord(hg.Items[Index]).XML + ';';
+
+ Mes := hg.Items[Index].Text;
+ if GridOptions.RawRTFEnabled and IsRTF(Mes) then
+ begin
+ hg.ApplyItemToRich(Index);
+ Mes := GetRichString(hg.RichEdit.Handle, False);
+ end;
+ if GridOptions.BBCodesEnabled then
+ Mes := DoStripBBCodes(Mes);
+ Item.Mes := UTF8Encode(MakeTextXMLedW(Mes));
+
+ if mtFile in hg.Items[Index].MessageType then
+ begin
+ tmp := hg.Items[Index].Extended;
+ if tmp = '' then
+ Item.FileName := '&UNK;'
+ else
+ Item.FileName := UTF8Encode(MakeTextXMLedA(tmp));
+ end
+ else if mtUrl in hg.Items[Index].MessageType then
+ begin
+ tmp := hg.Items[Index].Extended;
+ if tmp = '' then
+ Item.Url := '&UNK;'
+ else
+ Item.Url := UTF8Encode(MakeTextXMLedA(tmp));
+ end
+ else if mtAvatarChange in hg.Items[Index].MessageType then
+ begin
+ tmp := hg.Items[Index].Extended;
+ if tmp = '' then
+ Item.FileName := '&UNK;'
+ else
+ Item.FileName := UTF8Encode(MakeTextXMLedA(tmp));
+ end;
+
+ { 2.8.2004 OXY: Change protocol guessing order. Now
+ first use protocol name, then, if missing, use module }
+
+ Item.Protocol := hg.Items[Index].Proto;
+ if Item.Protocol = '' then
+ Item.Protocol := MakeTextXMLedA(hg.Items[Index].Module);
+ if Item.Protocol = '' then
+ Item.Protocol := '&UNK;';
+
+ if mtIncoming in hg.Items[Index].MessageType then
+ Item.ID := GetContactID(hContact, Protocol, True)
+ else
+ Item.ID := GetContactID(0, SubProtocol);
+ if Item.ID = '' then
+ Item.ID := '&UNK;'
+ else
+ Item.ID := MakeTextXMLedA(Item.ID);
+end;
+
+procedure THistoryFrm.OpenLinkClick(Sender: TObject);
+begin
+ if SavedLinkUrl = '' then
+ Exit;
+ OpenUrl(SavedLinkUrl, False);
+ SavedLinkUrl := '';
+end;
+
+procedure THistoryFrm.OpenLinkNWClick(Sender: TObject);
+begin
+ if SavedLinkUrl = '' then
+ Exit;
+ OpenUrl(SavedLinkUrl, True);
+ SavedLinkUrl := '';
+end;
+
+procedure THistoryFrm.CopyLinkClick(Sender: TObject);
+begin
+ if SavedLinkUrl = '' then
+ Exit;
+ CopyToClip(SavedLinkUrl, Handle, CP_ACP);
+ SavedLinkUrl := '';
+end;
+
+procedure THistoryFrm.SetPanel(const Value: THistoryPanels);
+var
+ Lock: Boolean;
+begin
+ FPanel := Value;
+ if (HistoryLength = 0) or ((hContact = 0) and (hpSessions in FPanel)) then
+ exclude(FPanel, hpSessions);
+ tbSessions.Down := (hpSessions in Panel);
+ tbBookmarks.Down := (hpBookmarks in Panel);
+ hg.BeginUpdate;
+ Lock := Visible;
+ if Lock then
+ Lock := LockWindowUpdate(Handle);
+ try
+ // if (FPanel = hpBookmarks) and paSess.Visible then
+ // paBook.Width := paSess.Width;
+ // if (FPanel = hpSessions) and paBook.Visible then
+ // paSess.Width := paBook.Width;
+
+ paSess.Visible := (hpSessions in Panel);
+ paBook.Visible := (hpBookmarks in Panel);
+
+ paHolder.Visible := paBook.Visible or paSess.Visible;
+ spHolder.Visible := paHolder.Visible;
+ spHolder.Left := paHolder.Left + paHolder.Width + 1;
+
+ spBook.Visible := paBook.Visible and paSess.Visible;
+ paHolderResize(Self);
+ spBook.Top := paSess.Top + paSess.Height + 1;
+
+ finally
+ if Lock then
+ LockWindowUpdate(0);
+ hg.EndUpdate;
+ end;
+end;
+
+procedure THistoryFrm.SetPasswordMode(const Value: Boolean);
+var
+ enb: Boolean;
+begin
+ FPasswordMode := Value;
+ enb := not Value;
+ hgState(hg, hg.State);
+ hg.Enabled := enb;
+ hg.Visible := enb;
+ paClient.Enabled := enb;
+ paClient.Visible := enb;
+
+ if Value then
+ paPassHolder.Align := TAlign(alClient);
+ paPassHolder.Enabled := not enb;
+ paPassHolder.Visible := not enb;
+ if Value then
+ begin
+ paPassword.Left := (paPassHolder.ClientWidth - paPassword.Width) div 2;
+ paPassword.Top := (paPassHolder.ClientHeight - paPassword.Height) div 2;
+ if Self.Visible then
+ edPass.SetFocus
+ else
+ Self.ActiveControl := edPass;
+ end
+ else
+ begin
+ ToggleMainMenu(GetDBBool(hppDBName, 'Accessability', False));
+ // reset selected
+ hg.Selected := hg.Selected;
+ if Self.Visible then
+ hg.SetFocus
+ else
+ Self.ActiveControl := hg;
+ end;
+end;
+
+procedure THistoryFrm.SetRecentEventsPosition(OnTop: Boolean);
+begin
+ hg.Reversed := not OnTop;
+ LoadButtonIcons;
+end;
+
+procedure THistoryFrm.SetSearchMode(const Value: TSearchMode);
+var
+ SaveStr: String;
+ NotFound, Lock: Boolean;
+begin
+ if FSearchMode = Value then
+ Exit;
+
+ if Value = smHotSearch then
+ PreHotSearchMode := FSearchMode;
+ if FSearchMode = smFilter then
+ EndHotFilterTimer(True);
+
+ FSearchMode := Value;
+
+ Lock := Visible;
+ if Lock then
+ Lock := LockWindowUpdate(Handle);
+ try
+ tbFilter.Down := (FSearchMode = smFilter);
+ tbSearch.Down := (FSearchMode = smSearch);
+ paSearch.Visible := not(SearchMode = smNone);
+ if SearchMode = smNone then
+ begin
+ edSearch.Text := '';
+ edSearch.Color := clWindow;
+ if Self.Visible then
+ hg.SetFocus
+ else
+ Self.ActiveControl := hg;
+ Exit;
+ end;
+ SaveStr := edSearch.Text;
+ hg.BeginUpdate;
+ try
+ pbSearch.Visible := (FSearchMode in [smSearch, smHotSearch]);
+ pbFilter.Visible := (FSearchMode = smFilter);
+ if (FSearchMode = smFilter) then
+ paSearchStatus.Visible := False;
+ paSearchButtons.Visible := not(FSearchMode = smFilter);
+ NotFound := not(edSearch.Color = clWindow);
+ edSearch.Text := '';
+ edSearch.Color := clWindow;
+ finally
+ hg.EndUpdate;
+ end;
+ // don't search or filter if the AnsiString is not found
+ if not NotFound then
+ edSearch.Text := SaveStr;
+ finally
+ if Lock then
+ LockWindowUpdate(0);
+ end;
+end;
+
+procedure THistoryFrm.EventsFilterItemClick(Sender: TObject);
+begin
+ // tbEventsFilter.Caption := TMenuItem(Sender).Caption;
+ SetEventFilter(TMenuItem(Sender).Tag);
+end;
+
+procedure THistoryFrm.ShowAllEvents;
+begin
+ // TODO
+ // we run UpdateFilter two times here, one when set
+ // Filter property in SetEventFilter, one when reset hot filter
+ // make Begin/EndUpdate support batch UpdateFilter requests
+ // so we can make it run only one time on EndUpdate
+ hg.BeginUpdate;
+ SetEventFilter(GetShowAllEventsIndex);
+ edSearch.Text := '';
+ EndHotFilterTimer(True);
+ hg.EndUpdate;
+end;
+
+procedure THistoryFrm.ShowItem(Value: Integer);
+begin
+ hg.MakeTopmost(Value);
+ hg.Selected := Value;
+end;
+
+procedure THistoryFrm.bnPassClick(Sender: TObject);
+begin
+ if DigToBase(HashString(AnsiString(edPass.Text))) = GetPassword then
+ PasswordMode := False
+ else
+ { DONE: sHure }
+ HppMessageBox(Handle, TranslateW('You have entered the wrong password'),
+ TranslateW('History++ Password Protection'), MB_OK or MB_DEFBUTTON1 or MB_ICONSTOP);
+end;
+
+procedure THistoryFrm.edPassKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin;
+end;
+
+procedure THistoryFrm.edSearchChange(Sender: TObject);
+begin
+ if SearchMode = smFilter then
+ StartHotFilterTimer
+ else
+ Search(True, False);
+end;
+
+procedure THistoryFrm.edSearchKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+ if SearchMode = smFilter then
+ begin
+ if Key in [VK_UP, VK_DOWN, VK_NEXT, VK_PRIOR, VK_END, VK_HOME] then
+ begin
+ SendMessage(hg.Handle, WM_KEYDOWN, Key, 0);
+ Key := 0;
+ end;
+ end
+ else
+ begin
+ if (Shift = []) and (Key in [VK_UP, VK_DOWN, VK_NEXT, VK_PRIOR, VK_END, VK_HOME]) then
+ begin
+ SendMessage(hg.Handle, WM_KEYDOWN, Key, 0);
+ Key := 0;
+ Exit;
+ end;
+ if (Shift = [ssCtrl]) and (Key in [VK_UP, VK_DOWN]) then
+ begin
+ if (Key = VK_UP) xor hg.Reversed then
+ sbSearchNext.Click
+ else
+ sbSearchPrev.Click;
+ Key := 0;
+ Exit;
+ end;
+ end;
+end;
+
+procedure THistoryFrm.edSearchKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+ // to prevent ** BLING ** when press Enter
+ if (Key = VK_RETURN) then
+ begin
+ if hg.State in [gsIdle, gsInline] then
+ hg.SetFocus;
+ Key := 0;
+ end;
+end;
+
+procedure THistoryFrm.edPassKeyPress(Sender: TObject; var Key: Char);
+begin
+ // to prevent ** BLING ** when press Enter
+ // to prevent ** BLING ** when press Tab
+ // to prevent ** BLING ** when press Esc
+ if ORD(Key) in [VK_RETURN, VK_TAB, VK_ESCAPE] then
+ Key := #0;
+end;
+
+procedure THistoryFrm.PostLoadHistory;
+var
+ tPanel: THistoryPanels;
+begin
+ LoadPosition;
+ ProcessPassword;
+ if not PasswordMode then
+ ToggleMainMenu(GetDBBool(hppDBName, 'Accessability', False));
+
+ // if hContact = 0 then paTop.Visible := False;
+ // set reversed here, after Allocate, because of some scrollbar
+ // "features", we'll load end of the list if put before Allocate
+ SetRecentEventsPosition(GetDBBool(hppDBName, 'SortOrder', False));
+ // set ShowSessions here because we check for empty history
+ paHolder.Width := GetDBInt(hppDBName, 'PanelWidth', 150);
+ spBook.Tag := GetDBByte(hppDBName, 'PanelSplit', 127);
+ if hContact = 0 then
+ begin
+ if GetDBBool(hppDBName, 'ShowBookmarksSystem', False) then
+ Panel := [hpBookmarks];
+ end
+ else
+ begin
+ if GetDBBool(hppDBName, 'ShowSessions', False) then
+ include(tPanel, hpSessions);
+ if GetDBBool(hppDBName, 'ShowBookmarks', False) then
+ include(tPanel, hpBookmarks);
+ Panel := tPanel;
+ end;
+
+ CreateEventsFilterMenu;
+ // delay event filter applying till showing form
+ if hContact = 0 then
+ SetEventFilter(GetShowAllEventsIndex, True)
+ else
+ SetEventFilter(0, True);
+end;
+
+procedure THistoryFrm.PreLoadHistory;
+begin
+ // LoadPosition;
+ hg.ShowHeaders := (hContact <> 0);
+ hg.ExpandHeaders := GetDBBool(hppDBName, 'ExpandHeaders', False);
+ hg.GroupLinked := GetDBBool(hppDBName, 'GroupHistoryItems', False);
+ if hContact = 0 then
+ begin
+ tbUserDetails.Enabled := False;
+ tbUserMenu.Enabled := False;
+ // tbEventsFilter.Enabled := False;
+ tbSessions.Enabled := False;
+ // hg.ShowBookmarks := False;
+ Customize2.Enabled := False; // disable toolbar customization
+ end;
+
+ if tbSessions.Enabled then
+ begin
+ SessThread := TSessionsThread.Create(True);
+ SessThread.ParentHandle := Handle;
+ SessThread.Contact := hContact;
+ SessThread.Priority := tpLower;
+ SessThread.Resume;
+ end;
+
+end;
+
+procedure THistoryFrm.ProcessPassword;
+begin
+ if IsPasswordBlank(GetPassword) then
+ Exit;
+ if IsUserProtected(hContact) or IsUserProtected(hSubContact) then
+ PasswordMode := True;
+end;
+
+procedure THistoryFrm.OpenPassword;
+begin
+ RunPassForm;
+end;
+
+procedure THistoryFrm.FormShow(Sender: TObject);
+begin
+ // EndUpdate is better here, not in PostHistoryLoad, because it's faster
+ // when called from OnShow. Don't know why.
+ // Other form-modifying routines are better be kept at PostHistoryLoad for
+ // speed too.
+ hg.EndUpdate;
+ LoadToolbar;
+ FillBookmarks;
+end;
+
+procedure THistoryFrm.mmToolbarClick(Sender: TObject);
+var
+ i, n: Integer;
+ pm: TPopupMenu;
+ mi: TMenuItem;
+ Flag: Boolean;
+begin
+ for i := 0 to mmToolbar.count - 1 do
+ begin
+ if mmToolbar.Items[i].Owner is THppToolButton then
+ begin
+ Flag := TToolButton(mmToolbar.Items[i].Owner).Enabled
+ end
+ else if mmToolbar.Items[i].Owner is TSpeedButton then
+ begin
+ TMenuItem(mmToolbar.Items[i]).Caption := TSpeedButton(mmToolbar.Items[i].Owner).Hint;
+ Flag := TSpeedButton(mmToolbar.Items[i].Owner).Enabled
+ end
+ else
+ Flag := True;
+ mmToolbar.Items[i].Enabled := Flag;
+ if mmToolbar.Items[i].Tag = 0 then
+ continue;
+ pm := TPopupMenu(Pointer(mmToolbar.Items[i].Tag));
+ for n := pm.Items.count - 1 downto 0 do
+ begin
+ mi := TMenuItem(pm.Items[n]);
+ pm.Items.Remove(mi);
+ mmToolbar.Items[i].Insert(0, mi);
+ end;
+ end;
+end;
+
+procedure THistoryFrm.ToolbarDblClick(Sender: TObject);
+begin
+ CustomizeToolbar;
+end;
+
+procedure THistoryFrm.paPassHolderResize(Sender: TObject);
+begin
+ if PasswordMode then
+ begin
+ paPassword.Left := (ClientWidth - paPassword.Width) div 2;
+ paPassword.Top := (ClientHeight - paPassword.Height) div 2;
+ end;
+end;
+
+procedure THistoryFrm.Passwordprotection1Click(Sender: TObject);
+begin
+ OpenPassword;
+end;
+
+procedure THistoryFrm.TranslateForm;
+begin
+ Caption := TranslateUnicodeString(Caption);
+
+ hg.TxtFullLog := TranslateUnicodeString(hg.TxtFullLog);
+ hg.TxtGenHist1 := TranslateUnicodeString(hg.TxtGenHist1);
+ hg.TxtGenHist2 := TranslateUnicodeString(hg.TxtGenHist2);
+ hg.TxtHistExport := TranslateUnicodeString(hg.TxtHistExport);
+ hg.TxtNoItems := TranslateUnicodeString(hg.TxtNoItems);
+ hg.TxtNoSuch := TranslateUnicodeString(hg.TxtNoSuch);
+ hg.TxtPartLog := TranslateUnicodeString(hg.TxtPartLog);
+ hg.TxtStartUp := TranslateUnicodeString(hg.TxtStartUp);
+ hg.TxtSessions := TranslateUnicodeString(hg.TxtSessions);
+
+ SearchUpHint := TranslateUnicodeString(SearchUpHint);
+ SearchDownHint := TranslateUnicodeString(SearchDownHint);
+
+ sbClearFilter.Hint := TranslateUnicodeString(sbClearFilter.Hint);
+
+ bnPass.Caption := TranslateUnicodeString(bnPass.Caption);
+ laPass.Caption := TranslateUnicodeString(laPass.Caption);
+ laPass2.Caption := TranslateUnicodeString(laPass2.Caption);
+ laSess.Caption := TranslateUnicodeString(laSess.Caption);
+ laBook.Caption := TranslateUnicodeString(laBook.Caption);
+
+ SaveDialog.Title := TranslateUnicodeString(PWideChar(SaveDialog.Title));
+
+ TranslateToolbar(Toolbar);
+
+ TranslateMenu(pmGrid.Items);
+ TranslateMenu(pmInline.Items);
+
+ TranslateMenu(pmLink.Items);
+ TranslateMenu(pmFile.Items);
+ TranslateMenu(pmHistory.Items);
+ TranslateMenu(pmEventsFilter.Items);
+ TranslateMenu(pmSessions.Items);
+ TranslateMenu(pmToolbar.Items);
+ TranslateMenu(pmBook.Items);
+end;
+
+procedure THistoryFrm.tvSessChange(Sender: TObject; Node: TTreeNode);
+var
+ Index, i: Integer;
+ Event: THandle;
+begin
+ if IsLoadingSessions then
+ Exit;
+ if Node = nil then
+ Exit;
+ if Node.Level <> 2 then
+ begin
+ Node := Node.getFirstChild;
+ if (Node <> nil) and (Node.Level <> 2) then
+ Node := Node.getFirstChild;
+ if Node = nil then
+ Exit;
+ end;
+
+ Event := Sessions[uint_ptr(Node.Data)].hDBEventFirst;
+ Index := -1;
+ // looks like history starts to load from end?
+ // well, of course, we load from the last event!
+ for i := HistoryLength - 1 downto 0 do
+ begin
+ if History[i] = 0 then
+ LoadPendingHeaders(i, HistoryLength);
+ if History[i] = Event then
+ begin
+ Index := i;
+ break;
+ end;
+ end;
+ if Index = -1 then
+ Exit;
+ if hg.State = gsInline then
+ hg.CancelInline;
+ Index := HistoryIndexToGrid(Index);
+ ShowItem(Index);
+
+ // exit;
+ // OXY: try to make selected item the topmost
+ // while hg.GetFirstVisible <> Index do begin
+ // if hg.VertScrollBar.Position = hg.VertScrollBar.Range then break;
+ // hg.VertScrollBar.Position := hg.VertScrollBar.Position + 1;
+ // end;
+
+ { if Node = nil then begin
+ StartTimestamp := 0;
+ EndTimestamp := 0;
+ hg.GridUpdate([guFilter]);
+ exit;
+ end;
+
+ if Node.Level <> 2 then exit;
+
+ StartTimestamp := Sessions[uint_ptr(Node.Data)][1];
+ EndTimestamp := 0;
+ if uint_ptr(Node.Data) <= Length(Sessions)-2 then begin
+ EndTimestamp := Sessions[uint_ptr(Node.Data)+1][1];
+ end;
+ hg.GridUpdate([guFilter]); }
+end;
+
+{ procedure THistoryFrm.tvSessClick(Sender: TObject);
+ var
+ Node: TTreeNode;
+ begin
+ Node := tvSess.Selected;
+ if Node = nil then exit;
+ //tvSessChange(Self,Node);
+ end; }
+
+procedure THistoryFrm.tvSessMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
+var
+ Node: TTreeNode;
+ count, Time: DWord;
+ t: String;
+ dt: TDateTime;
+ timestr: String;
+begin
+ Node := tvSess.GetNodeAt(X, Y);
+ if (Node = nil) or (Node.Level <> 2) then
+ begin
+ Application.CancelHint;
+ tvSess.ShowHint := False;
+ Exit;
+ end;
+ if uint_ptr(tvSess.Tag) <> (uint_ptr(Node.Data) + 1) then
+ begin
+ Application.CancelHint;
+ tvSess.ShowHint := False;
+ tvSess.Tag := uint_ptr(Node.Data) + 1;
+ // +1 because we have tag = 0 by default, and it will not catch first session then
+ end;
+ // else
+ // exit; // we are already showing the hint for this node
+
+ with Sessions[uint_ptr(Node.Data)] do
+ begin
+ Time := TimestampLast - TimestampFirst;
+ count := ItemsCount;
+ dt := TimestampToDateTime(TimestampFirst);
+ end;
+
+ t := FormatDateTime('[yyyy, mmmm, d]', dt) + #13#10;
+ if Time / 60 > 60 then
+ timestr := Format('%0.1n h', [Time / (60 * 60)])
+ else
+ timestr := Format('%d min', [Time div 60]);
+
+ if count = 1 then
+ tvSess.Hint := t + Format('' + TranslateW('%d event'), [count])
+ else
+ tvSess.Hint := t + Format('' + TranslateW('%0.n events (%s)'), [count / 1, timestr]);
+ tvSess.ShowHint := True;
+end;
+
+procedure THistoryFrm.CopyText1Click(Sender: TObject);
+begin
+ if hg.Selected = -1 then
+ Exit;
+ CopyToClip(hg.FormatSelected(GridOptions.ClipCopyTextFormat), Handle, UserCodepage);
+ // rtf copy works only if not more then one selected
+ // hg.ApplyItemToRich(hg.Selected,hg.RichEdit,False);
+ // hg.RichEdit.SelectAll;
+ // hg.RichEdit.CopyToClipboard;
+end;
+
+procedure THistoryFrm.CreateEventsFilterMenu;
+var
+ i: Integer;
+ mi: TMenuItem;
+ ShowAllEventsIndex: Integer;
+begin
+ for i := pmEventsFilter.Items.count - 1 downto 0 do
+ if pmEventsFilter.Items[i].RadioItem then
+ pmEventsFilter.Items.Delete(i);
+
+ ShowAllEventsIndex := GetShowAllEventsIndex;
+ for i := 0 to Length(hppEventFilters) - 1 do
+ begin
+ mi := TMenuItem.Create(pmEventsFilter);
+ mi.Caption := StringReplace(hppEventFilters[i].name, '&', '&&', [rfReplaceAll]);
+ mi.GroupIndex := 1;
+ mi.RadioItem := True;
+ mi.Tag := i;
+ mi.OnClick := EventsFilterItemClick;
+ if i = ShowAllEventsIndex then
+ mi.Default := True;
+ pmEventsFilter.Items.Insert(i, mi);
+ end;
+end;
+
+procedure THistoryFrm.Customize1Click(Sender: TObject);
+begin
+ if not Assigned(fmCustomizeFilters) then
+ begin
+ CustomizeFiltersForm := TfmCustomizeFilters.Create(Self);
+ CustomizeFiltersForm.Show;
+ end
+ else
+ begin
+ BringFormToFront(fmCustomizeFilters);
+ end;
+end;
+
+procedure THistoryFrm.Customize2Click(Sender: TObject);
+begin
+ CustomizeToolbar;
+end;
+
+procedure THistoryFrm.CustomizeToolbar;
+begin
+ if hContact = 0 then
+ Exit;
+
+ if not Assigned(fmCustomizeToolbar) then
+ begin
+ CustomizeToolbarForm := TfmCustomizeToolbar.Create(Self);
+ CustomizeToolbarForm.Show;
+ end
+ else
+ begin
+ BringFormToFront(fmCustomizeToolbar);
+ end;
+end;
+
+procedure THistoryFrm.hgUrlClick(Sender: TObject; Item: Integer; URLText: String; Button: TMouseButton);
+begin
+ if URLText = '' then
+ Exit;
+ if (Button = mbLeft) or (Button = mbMiddle) then
+ OpenUrl(URLText, True)
+ else
+ begin
+ SavedLinkUrl := URLText;
+ pmLink.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
+ end;
+end;
+
+procedure THistoryFrm.hgProcessRichText(Sender: TObject; Handle: THandle; Item: Integer);
+var
+ ItemRenderDetails: TItemRenderDetails;
+begin
+ if Assigned(EventDetailForm) then
+ if Handle = TEventDetailsFrm(EventDetailForm).EText.Handle then
+ begin
+ TEventDetailsFrm(EventDetailForm).ProcessRichEdit(Item);
+ Exit;
+ end;
+ ZeroMemory(@ItemRenderDetails, SizeOf(ItemRenderDetails));
+ ItemRenderDetails.cbSize := SizeOf(ItemRenderDetails);
+ // use meta's subcontact info, if available
+ // ItemRenderDetails.hContact := hContact;
+ ItemRenderDetails.hContact := FhSubContact;
+ ItemRenderDetails.hDBEvent := History[GridIndexToHistory(Item)];
+ // use meta's subcontact info, if available
+ if hContact = 0 then
+ ItemRenderDetails.pProto := PAnsiChar(hg.Items[Item].Proto)
+ else
+ ItemRenderDetails.pProto := PAnsiChar(FSubProtocol);
+ ItemRenderDetails.pModule := PAnsiChar(hg.Items[Item].Module);
+ ItemRenderDetails.pText := nil;
+ ItemRenderDetails.pExtended := PAnsiChar(hg.Items[Item].Extended);
+ ItemRenderDetails.dwEventTime := hg.Items[Item].Time;
+ ItemRenderDetails.wEventType := hg.Items[Item].EventType;
+ ItemRenderDetails.IsEventSent := (mtOutgoing in hg.Items[Item].MessageType);
+ if Handle = hg.InlineRichEdit.Handle then
+ ItemRenderDetails.dwFlags := ItemRenderDetails.dwFlags or IRDF_INLINE;
+ if hg.IsSelected(Item) then
+ ItemRenderDetails.dwFlags := ItemRenderDetails.dwFlags or IRDF_SELECTED;
+ if hContact = 0 then
+ ItemRenderDetails.bHistoryWindow := IRDHW_GLOBALHISTORY
+ else
+ ItemRenderDetails.bHistoryWindow := IRDHW_CONTACTHISTORY;
+ NotifyEventHooks(hHppRichEditItemProcess, wParam(Handle), lParam(@ItemRenderDetails));
+end;
+
+procedure THistoryFrm.hgSearchItem(Sender: TObject; Item, ID: Integer; var Found: Boolean);
+begin
+ Found := (Cardinal(ID) = History[GridIndexToHistory(Item)]);
+end;
+
+procedure THistoryFrm.hgKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+ // this workaround was done because when we have password and
+ // press enter, if password is ok, we a brought to the
+ // history grid, and have VK_RETURN onkeyup event. So we have
+ // this var to help us. And no, if move this code to OnKeyDown,
+ // we will have problems with inline richedit not appearing
+ // on enter
+ if not WasReturnPressed then
+ Exit;
+ WasReturnPressed := False;
+
+ if (Key = VK_RETURN) and (Shift = []) then
+ begin
+ hgDblClick(hg);
+ Key := 0;
+ end;
+ if (Key = VK_RETURN) and (Shift = [ssCtrl]) then
+ begin
+ Details1.Click;
+ Key := 0;
+ end;
+end;
+
+function THistoryFrm.IsFileEvent(Index: Integer): Boolean;
+begin
+ Result := (Index <> -1) and (mtFile in hg.Items[Index].MessageType);
+ if Result then
+ begin
+ // Auto CP_ACP usage
+ SavedLinkUrl := ExtractFileName(String(hg.Items[Index].Extended));
+ SavedFileDir := ExtractFileDir(String(hg.Items[Index].Extended));
+ end;
+end;
+
+procedure THistoryFrm.LoadInOptions();
+var
+ i: Integer;
+begin
+ if hContact = 0 then
+ begin
+ ContactRTLmode.Visible := False;
+ ANSICodepage.Visible := False;
+ end
+ else
+ begin
+ case hg.RTLMode of
+ hppRTLDefault: Self.RTLDefault2.Checked := True;
+ hppRTLEnable: Self.RTLEnabled2.Checked := True;
+ hppRTLDisable: Self.RTLDisabled2.Checked := True;
+ end;
+ if UseDefaultCP then
+ SystemCodepage.Checked := True
+ else
+ for i := 1 to ANSICodepage.count - 1 do
+ if ANSICodepage.Items[i].Tag = Integer(UserCodepage) then
+ begin
+ ANSICodepage.Items[i].Checked := True;
+ if i > 1 then
+ break;
+ end;
+ // no need to make it invisible if it was turned on
+ if UnknownCodepage.Checked then
+ UnknownCodepage.Visible := True;
+ end;
+end;
+
+// use that to delay events filtering until window will be visible
+procedure THistoryFrm.CMShowingChanged(var Message: TMessage);
+begin
+ inherited;
+ if Visible and (DelayedFilter <> []) then
+ begin
+ hg.ShowBottomAligned := True;
+ hg.Filter := DelayedFilter;
+ DelayedFilter := [];
+ end;
+end;
+
+procedure THistoryFrm.SetEventFilter(FilterIndex: Integer = -1; DelayApply: Boolean = False);
+var
+ i, fi: Integer;
+ mi: TMenuItem;
+begin
+ if FilterIndex = -1 then
+ begin
+ fi := tbEventsFilter.Tag + 1;
+ if fi > High(hppEventFilters) then
+ fi := 0;
+ end
+ else
+ fi := FilterIndex;
+
+ tbEventsFilter.Tag := fi;
+ LoadEventFilterButton;
+ mi := TMenuItem(Customize1.Parent);
+ for i := 0 to mi.count - 1 do
+ if mi[i].RadioItem then
+ mi[i].Checked := (mi[i].Tag = fi);
+ hg.ShowHeaders := (tbSessions.Enabled) and (mtMessage in hppEventFilters[fi].Events);
+
+ if DelayApply then
+ DelayedFilter := hppEventFilters[fi].Events
+ else
+ begin
+ DelayedFilter := [];
+ hg.Filter := hppEventFilters[fi].Events;
+ end;
+end;
+
+procedure THistoryFrm.SethContact(const Value: THandle);
+begin
+ // if FhContact = Value then exit;
+ FhContact := Value;
+ if FhContact = 0 then
+ begin
+ FhSubContact := 0;
+ FProtocol := 'ICQ';
+ FSubProtocol := FProtocol;
+ end
+ else
+ begin
+ FProtocol := GetContactProto(hContact, FhSubContact, FSubProtocol);
+ end;
+end;
+
+// fix for infamous splitter bug!
+// thanks to Greg Chapman
+// http://groups.google.com/group/borland.public.delphi.objectpascal/browse_thread/thread/218a7511123851c3/5ada76e08038a75b%235ada76e08038a75b?sa=X&oi=groupsr&start=2&num=3
+procedure THistoryFrm.AlignControls(Control: TControl; var ARect: TRect);
+begin
+ inherited;
+ if paHolder.Width = 0 then
+ paHolder.Left := spHolder.Left;
+ if paSess.Height = 0 then
+ paSess.Top := spBook.Top;
+end;
+
+procedure THistoryFrm.ContactRTLmode1Click(Sender: TObject);
+begin
+ if RTLDefault2.Checked then
+ hg.RTLMode := hppRTLDefault
+ else
+ begin
+ if RTLEnabled2.Checked then
+ hg.RTLMode := hppRTLEnable
+ else
+ hg.RTLMode := hppRTLDisable;
+ end;
+ WriteContactRTLMode(hContact, hg.RTLMode, Protocol);
+end;
+
+procedure THistoryFrm.SMPrepare(var M: TMessage);
+begin
+ if tvSess.Visible then
+ tvSess.Enabled := False;
+ IsLoadingSessions := True;
+end;
+
+procedure THistoryFrm.SMItemsFound(var M: TMessage);
+var
+ ti: TTreeNode;
+ i: Integer;
+ dt: TDateTime;
+ ts: DWord;
+ PrevYearNode, PrevMonthNode: TTreeNode;
+begin
+{$RANGECHECKS OFF}
+ // wParam - array of hDBEvent, lParam - array size
+ PrevYearNode := nil;
+ PrevMonthNode := nil;
+ ti := nil;
+ Sessions := PSessArray(M.wParam)^;
+ FreeMem(PSessArray(M.wParam));
+ tvSess.Items.BeginUpdate;
+ try
+ for i := 0 to Length(Sessions) - 1 do
+ begin
+ ts := Sessions[i].TimestampFirst;
+ dt := TimestampToDateTime(ts);
+ if (PrevYearNode = nil) or (uint_ptr(PrevYearNode.Data) <> YearOf(dt)) then
+ begin
+ PrevYearNode := tvSess.Items.AddChild(nil, FormatDateTime(HPP_SESS_YEARFORMAT, dt));
+ PrevYearNode.Data := Pointer(YearOf(dt));
+ PrevYearNode.ImageIndex := 5;
+ // PrevYearNode.SelectedIndex := PrevYearNode.ImageIndex;
+ PrevMonthNode := nil;
+ end;
+ if (PrevMonthNode = nil) or (uint_ptr(PrevMonthNode.Data) <> MonthOf(dt)) then
+ begin
+ PrevMonthNode := tvSess.Items.AddChild(PrevYearNode,
+ FormatDateTime(HPP_SESS_MONTHFORMAT, dt));
+ PrevMonthNode.Data := Pointer(MonthOf(dt));
+ case MonthOf(dt) of
+ 12, 1 .. 2: PrevMonthNode.ImageIndex := 3;
+ 3 .. 5: PrevMonthNode.ImageIndex := 4;
+ 6 .. 8: PrevMonthNode.ImageIndex := 1;
+ 9 .. 11: PrevMonthNode.ImageIndex := 2;
+ end;
+ // PrevMonthNode.SelectedIndex := PrevMonthNode.ImageIndex;
+ end;
+ ti := tvSess.Items.AddChild(PrevMonthNode, FormatDateTime(HPP_SESS_DAYFORMAT, dt));
+ ti.Data := Pointer(i);
+ ti.ImageIndex := 0;
+ // ti.SelectedIndex := ti.ImageIndex;
+ end;
+ if PrevYearNode <> nil then
+ begin
+ PrevYearNode.Expand(False);
+ PrevMonthNode.Expand(True);
+ end;
+ if ti <> nil then
+ ti.Selected := True;
+ finally
+ tvSess.Items.EndUpdate;
+ end;
+{$RANGECHECKS ON}
+end;
+
+procedure THistoryFrm.SMFinished(var M: TMessage);
+begin
+ if not tvSess.Enabled then
+ tvSess.Enabled := True;
+ IsLoadingSessions := False;
+end;
+
+procedure THistoryFrm.SendMessage1Click(Sender: TObject);
+begin
+ if hContact <> 0 then
+ SendMessageTo(hContact);
+end;
+
+procedure THistoryFrm.ReplyQuoted1Click(Sender: TObject);
+begin
+ if hContact = 0 then
+ Exit;
+ if hg.Selected <> -1 then
+ ReplyQuoted(hg.Selected);
+end;
+
+procedure THistoryFrm.CodepageChangeClick(Sender: TObject);
+var
+ val: Cardinal;
+begin
+ val := (Sender as TMenuItem).Tag;
+ WriteContactCodePage(hContact, val, Protocol);
+ // UserCodepage := val;
+ UserCodepage := GetContactCodePage(hContact, Protocol, UseDefaultCP);
+ hg.Codepage := UserCodepage;
+end;
+
+procedure THistoryFrm.sbClearFilterClick(Sender: TObject);
+begin
+ if SearchMode = smFilter then
+ EndHotFilterTimer;
+ edSearch.Text := '';
+ edSearch.Color := clWindow;
+ if Self.Visible then
+ hg.SetFocus
+ else
+ Self.ActiveControl := hg;
+end;
+
+procedure THistoryFrm.pbFilterPaint(Sender: TObject);
+var
+ ic: HICON;
+begin
+ if tiFilter.Enabled then
+ ic := hppIcons[HPP_ICON_HOTFILTERWAIT].Handle
+ else
+ ic := hppIcons[HPP_ICON_HOTFILTER].Handle;
+
+ DrawiconEx(pbFilter.Canvas.Handle, 0, 0, ic, 16, 16, 0, pbFilter.Canvas.Brush.Handle,
+ DI_NORMAL);
+end;
+
+procedure THistoryFrm.pbSearchPaint(Sender: TObject);
+begin
+ DrawiconEx(pbSearch.Canvas.Handle, 0, 0, hppIcons[HPP_ICON_HOTSEARCH].Handle, 16, 16, 0,
+ pbSearch.Canvas.Brush.Handle, DI_NORMAL);
+end;
+
+procedure THistoryFrm.pbSearchStatePaint(Sender: TObject);
+begin
+ { case laSearchState.Tag of
+ 1: DrawIconEx(pbSearchState.Canvas.Handle,0,0,hppIcons[HPP_ICON_HOTSEARCH].Handle,
+ 16,16,0,pbSearchState.Canvas.Brush.Handle,DI_NORMAL);
+ 2: DrawIconEx(pbSearchState.Canvas.Handle,0,0,hppIcons[HPP_ICON_HOTSEARCH].Handle,
+ 16,16,0,pbSearchState.Canvas.Brush.Handle,DI_NORMAL)
+ else
+ pbSearchState.Canvas.FillRect(pbSearchState.Canvas.ClipRect);
+ end; }
+end;
+
+procedure THistoryFrm.StartHotFilterTimer;
+// var
+// RepaintIcon: Boolean;
+begin
+ if tiFilter.Interval = 0 then
+ EndHotFilterTimer
+ else
+ begin
+ tiFilter.Enabled := False;
+ tiFilter.Enabled := True;
+ if pbFilter.Tag <> 1 then
+ begin // use Tag to not repaint every keystroke
+ pbFilter.Tag := 1;
+ pbFilter.Repaint;
+ end;
+ end;
+end;
+
+procedure THistoryFrm.EmptyHistory;
+begin
+ if Assigned(EventDetailForm) then
+ EventDetailForm.Release;
+
+ HistoryLength := 0;
+ SetLength(History, HistoryLength);
+
+ SetLength(Sessions, 0);
+ BookmarkServer.Contacts[hContact].Clear;
+ tvSess.Items.Clear;
+ lvBook.Items.Clear;
+
+ SetSafetyMode(False);
+ try
+ FormState := gsDelete;
+ hg.DeleteAll;
+ finally
+ FormState := gsIdle;
+ SetSafetyMode(True);
+ end;
+end;
+
+procedure THistoryFrm.EmptyHistory1Click(Sender: TObject);
+begin
+ CallService(MS_HPP_EMPTYHISTORY, hContact, 0);
+end;
+
+procedure THistoryFrm.EndHotFilterTimer(DoClearFilter: Boolean = False);
+begin
+ tiFilter.Enabled := False;
+ if DoClearFilter then
+ HotFilterString := ''
+ else
+ HotFilterString := edSearch.Text;
+ hg.GridUpdate([guFilter]);
+ if pbFilter.Tag <> 0 then
+ begin
+ pbFilter.Tag := 0;
+ pbFilter.Repaint;
+ end;
+ if (not DoClearFilter) and (hg.Selected = -1) then
+ edSearch.Color := $008080FF
+ else
+ edSearch.Color := clWindow;
+end;
+
+procedure THistoryFrm.tbBookmarksClick(Sender: TObject);
+begin
+ // when called from menu item handler
+ if Sender <> tbBookmarks then
+ tbBookmarks.Down := not tbBookmarks.Down;
+
+ if tbBookmarks.Down then
+ Panel := Panel + [hpBookmarks]
+ else
+ Panel := Panel - [hpBookmarks];
+end;
+
+procedure THistoryFrm.tbEventsFilterClick(Sender: TObject);
+var
+ p: TPoint;
+begin
+ p := tbEventsFilter.ClientOrigin;
+ tbEventsFilter.ClientToScreen(p);
+ pmEventsFilter.Popup(p.X, p.Y + tbEventsFilter.Height);
+end;
+
+procedure THistoryFrm.tbSearchClick(Sender: TObject);
+begin
+ // when called from menu item handler
+ if Sender <> tbSearch then
+ tbSearch.Down := not tbSearch.Down;
+
+ if tbSearch.Down then
+ SearchMode := smSearch
+ else if tbFilter.Down then
+ SearchMode := smFilter
+ else
+ SearchMode := smNone;
+
+ if paSearch.Visible then
+ edSearch.SetFocus;
+end;
+
+procedure THistoryFrm.tbFilterClick(Sender: TObject);
+begin
+ // when called from menu item handler
+ if Sender <> tbFilter then
+ tbFilter.Down := not tbFilter.Down;
+
+ if tbSearch.Down then
+ SearchMode := smSearch
+ else if tbFilter.Down then
+ SearchMode := smFilter
+ else
+ SearchMode := smNone;
+
+ if paSearch.Visible then
+ edSearch.SetFocus;
+end;
+
+procedure THistoryFrm.tbHistoryClick(Sender: TObject);
+begin
+ tbHistory.Down := True;
+ tbHistory.CheckMenuDropdown;
+ tbHistory.Down := False;
+ { if hg.SelCount > 1 then begin
+ SaveSelected1.Click
+ exit;
+ end;
+ RecentFormat := TSaveFormat(GetDBInt(hppDBName,'ExportFormat',0));
+ SaveFormat := RecentFormat;
+ PrepareSaveDialog(SaveDialog,SaveFormat,True);
+ t := Translate('Full History [%s] - [%s]');
+ t := Format(t,[WideToAnsiString(hg.ProfileName,CP_ACP),WideToAnsiString(hg.ContactName,CP_ACP)]);
+ t := MakeFileName(t);
+ SaveDialog.FileName := t;
+ if not SaveDialog.Execute then exit;
+ case SaveDialog.FilterIndex of
+ 1: SaveFormat := sfHtml;
+ 2: SaveFormat := sfXml;
+ 3: SaveFormat := sfRTF;
+ 4: SaveFormat := sfUnicode;
+ 5: SaveFormat := sfText;
+ end;
+ RecentFormat := SaveFormat;
+ hg.SaveAll(SaveDialog.Files[0],sfXML);
+ WriteDBInt(hppDBName,'ExportFormat',Integer(RecentFormat)); }
+end;
+
+procedure THistoryFrm.tbSessionsClick(Sender: TObject);
+begin
+ // when called from menu item handler
+ if Sender <> tbSessions then
+ tbSessions.Down := not tbSessions.Down;
+
+ if tbSessions.Down then
+ Panel := Panel + [hpSessions]
+ else
+ Panel := Panel - [hpSessions];
+
+end;
+
+procedure THistoryFrm.tiFilterTimer(Sender: TObject);
+begin
+ EndHotFilterTimer;
+end;
+
+procedure THistoryFrm.SaveasRTF2Click(Sender: TObject);
+var
+ t: String;
+begin
+ PrepareSaveDialog(SaveDialog, sfRTF);
+ t := Format(TranslateW('Full History [%s] - [%s]'), [hg.ProfileName, hg.ContactName]);
+ t := MakeFileName(t);
+ SaveDialog.FileName := t;
+ if not SaveDialog.Execute then
+ Exit;
+ hg.SaveAll(SaveDialog.Files[0], sfRTF);
+ RecentFormat := sfRTF;
+ WriteDBInt(hppDBName, 'ExportFormat', Integer(RecentFormat));
+end;
+
+procedure THistoryFrm.SaveasMContacts2Click(Sender: TObject);
+var
+ t: String;
+begin
+ PrepareSaveDialog(SaveDialog, sfMContacts);
+ t := Format(TranslateW('Full History [%s] - [%s]'), [hg.ProfileName, hg.ContactName]);
+ t := MakeFileName(t);
+ SaveDialog.FileName := t;
+ if not SaveDialog.Execute then
+ Exit;
+ hg.SaveAll(SaveDialog.Files[0], sfMContacts);
+ RecentFormat := sfMContacts;
+ WriteDBInt(hppDBName, 'ExportFormat', Integer(RecentFormat));
+end;
+
+procedure THistoryFrm.tbHistorySearchClick(Sender: TObject);
+begin
+ CallService(MS_HPP_SHOWGLOBALSEARCH, 0, 0);
+end;
+
+procedure THistoryFrm.SessSelectClick(Sender: TObject);
+var
+ Items: Array of Integer;
+
+ function BuildIndexesFromSession(const Node: TTreeNode): Boolean;
+ var
+ First, Last: THandle;
+ fFirst, fLast: Integer;
+ a, b, i, cnt: Integer;
+ begin
+ Result := False;
+ if Node = nil then
+ Exit;
+ if Node.Level = 2 then
+ begin
+ First := Sessions[uint_ptr(Node.Data)].hDBEventFirst;
+ Last := Sessions[uint_ptr(Node.Data)].hDBEventLast;
+ fFirst := -1;
+ fLast := -1;
+ for i := HistoryLength - 1 downto 0 do
+ begin
+ if History[i] = 0 then
+ LoadPendingHeaders(i, HistoryLength);
+ if History[i] = First then
+ fFirst := i;
+ if History[i] = Last then
+ fLast := i;
+ if (fLast >= 0) and (fFirst >= 0) then
+ break;
+ end;
+ if (fLast >= 0) and (fFirst >= 0) then
+ begin
+ if fFirst > fLast then
+ begin
+ a := fLast;
+ b := fFirst;
+ end
+ else
+ begin
+ a := fFirst;
+ b := fLast;
+ end;
+ cnt := Length(Items);
+ SetLength(Items, cnt + b - a + 1);
+ for i := b downto a do
+ Items[cnt + b - i] := HistoryIndexToGrid(i);
+ Result := True;
+ end;
+ end
+ else
+ for i := 0 to Node.count - 1 do
+ Result := BuildIndexesFromSession(Node.Item[i]) or Result;
+ end;
+
+begin
+ if IsLoadingSessions then
+ Exit;
+ BuildIndexesFromSession(tvSess.Selected);
+ hg.SelectRange(Items[0], Items[High(Items)]);
+ // w := w + hg.Items[i].Text+#13#10+'--------------'+#13#10;
+ // CopyToClip(w,Handle,UserCodepage);
+ SetLength(Items, 0);
+ // Index := HistoryIndexToGrid(Index);
+ // ShowItem(Index);
+ // exit;
+ // Events := MakeSessionEvents();
+end;
+
+{ procedure THistoryFrm.tvSessMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+ var
+ Node: TTreeNode;
+ begin
+ exit;
+ if (Button = mbRight) then begin
+ Node := tvSess.GetNodeAt(X,Y);
+ if Node <> nil then begin
+ if not Node.Selected then
+ tvSess.Select(Node);
+ tvSessChange(tvSess,Node);
+ if not Node.Focused then
+ Node.Focused := True;
+ tvSess.Invalidate;
+ end;
+ end;
+ end; }
+
+procedure THistoryFrm.pmEventsFilterPopup(Sender: TObject);
+var
+ i: Integer;
+ pmi, mi: TMenuItem;
+begin
+ if Customize1.Parent <> pmEventsFilter.Items then
+ begin
+ pmi := TMenuItem(Customize1.Parent);
+ for i := pmi.count - 1 downto 0 do
+ begin
+ mi := TMenuItem(pmi.Items[i]);
+ pmi.Remove(mi);
+ pmEventsFilter.Items.Insert(0, mi);
+ end;
+ end;
+ Application.CancelHint;
+end;
+
+procedure THistoryFrm.pmGridPopup(Sender: TObject);
+begin
+ LoadInOptions();
+ if hg.Items[hg.Selected].Bookmarked then
+ Bookmark1.Caption := TranslateW('Remove &Bookmark')
+ else
+ Bookmark1.Caption := TranslateW('Set &Bookmark');
+ AddMenuArray(pmGrid, [ContactRTLmode, ANSICodepage], -1);
+end;
+
+procedure THistoryFrm.pmHistoryPopup(Sender: TObject);
+var
+ pmi, mi: TMenuItem;
+ i: Integer;
+begin
+ if SaveSelected2.Parent <> pmHistory.Items then
+ begin
+ pmi := TMenuItem(SaveSelected2.Parent);
+ for i := pmi.count - 1 downto 0 do
+ begin
+ mi := TMenuItem(pmi.Items[i]);
+ pmi.Remove(mi);
+ pmHistory.Items.Insert(0, mi);
+ end;
+ end;
+ LoadInOptions();
+ SaveSelected2.Visible := (hg.SelCount > 1);
+ AddMenuArray(pmHistory, [ContactRTLmode, ANSICodepage], 7);
+ Application.CancelHint;
+end;
+
+procedure THistoryFrm.WndProc(var Message: TMessage);
+begin
+ case Message.Msg of
+ WM_COMMAND:
+ begin
+ if mmAcc.DispatchCommand(Message.wParam) then
+ Exit;
+ inherited;
+ if Message.Result <> 0 then
+ Exit;
+ Message.Result := CallService(MS_CLIST_MENUPROCESSCOMMAND,
+ MAKEWPARAM(Message.WParamLo, MPCF_CONTACTMENU), hContact);
+ Exit;
+ end;
+ WM_MEASUREITEM:
+ if Self.UserMenu <> 0 then
+ begin
+ Message.Result := CallService(MS_CLIST_MENUMEASUREITEM, Message.wParam,
+ Message.lParam);
+ if Message.Result <> 0 then
+ Exit;
+ end;
+ WM_DRAWITEM:
+ if Self.UserMenu <> 0 then
+ begin
+ Message.Result := CallService(MS_CLIST_MENUDRAWITEM, Message.wParam,
+ Message.lParam);
+ if Message.Result <> 0 then
+ Exit;
+ end;
+ end;
+ inherited;
+end;
+
+procedure THistoryFrm.tbUserMenuClick(Sender: TObject);
+var
+ p: TPoint;
+begin
+ UserMenu := CallService(MS_CLIST_MENUBUILDCONTACT, hContact, 0);
+ if UserMenu <> 0 then
+ begin
+ p := tbUserMenu.ClientToScreen(Point(0, tbUserMenu.Height));
+ Application.CancelHint;
+ TrackPopupMenu(UserMenu, TPM_TOPALIGN or TPM_LEFTALIGN or TPM_LEFTBUTTON, p.X, p.Y, 0,
+ Handle, nil);
+ DestroyMenu(UserMenu);
+ UserMenu := 0;
+ end;
+end;
+
+procedure THistoryFrm.tvSessGetSelectedIndex(Sender: TObject; Node: TTreeNode);
+begin
+ // and we don't need to set SelectedIndex manually anymore
+ Node.SelectedIndex := Node.ImageIndex;
+end;
+
+procedure THistoryFrm.tvSessKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+ if IsFormShortCut([pmBook], Key, Shift) then
+ Key := 0;
+end;
+
+procedure THistoryFrm.hgRTLEnabled(Sender: TObject; BiDiMode: TBiDiMode);
+begin
+ edPass.BiDiMode := BiDiMode;
+ edSearch.BiDiMode := BiDiMode;
+ // tvSess.BiDiMode := BiDiMode;
+ if Assigned(EventDetailForm) then
+ TEventDetailsFrm(EventDetailForm).ResetItem;
+end;
+
+procedure THistoryFrm.Bookmark1Click(Sender: TObject);
+var
+ val: Boolean;
+ hDBEvent: THandle;
+begin
+ hDBEvent := History[GridIndexToHistory(hg.Selected)];
+ val := not BookmarkServer[hContact].Bookmarked[hDBEvent];
+ BookmarkServer[hContact].Bookmarked[hDBEvent] := val;
+end;
+
+procedure THistoryFrm.tbUserDetailsClick(Sender: TObject);
+begin
+ if hContact = 0 then
+ Exit;
+ CallService(MS_USERINFO_SHOWDIALOG, hContact, 0);
+end;
+
+procedure THistoryFrm.lvBookSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
+var
+ Index, i: Integer;
+ Event: THandle;
+begin
+ if not Selected then
+ Exit;
+ Event := THandle(Item.Data);
+ Index := -1;
+ // looks like history starts to load from end?
+ // well, of course, we load from the last event!
+ for i := HistoryLength - 1 downto 0 do
+ begin
+ if History[i] = 0 then
+ LoadPendingHeaders(i, HistoryLength);
+ if History[i] = Event then
+ begin
+ Index := i;
+ break;
+ end;
+ end;
+ if Index = -1 then
+ Exit;
+ if hg.State = gsInline then
+ hg.CancelInline;
+ Index := HistoryIndexToGrid(Index);
+ hg.BeginUpdate;
+ ShowAllEvents;
+ ShowItem(Index);
+ hg.EndUpdate;
+end;
+
+procedure THistoryFrm.SelectAll1Click(Sender: TObject);
+begin
+ hg.SelectAll;
+end;
+
+procedure THistoryFrm.lvBookContextPopup(Sender: TObject; MousePos: TPoint;
+ var Handled: Boolean);
+var
+ Item: TListItem;
+begin
+ Handled := True;
+ Item := TListItem(lvBook.GetItemAt(MousePos.X, MousePos.Y));
+ if Item = nil then
+ Exit;
+ lvBook.Selected := Item;
+ if BookmarkServer[hContact].Bookmarked[THandle(Item.Data)] then
+ begin
+ MousePos := lvBook.ClientToScreen(MousePos);
+ pmBook.Popup(MousePos.X, MousePos.Y);
+ end;
+end;
+
+procedure THistoryFrm.lvBookEdited(Sender: TObject; Item: TListItem; var S: String);
+begin
+ BookmarkServer[hContact].BookmarkName[THandle(Item.Data)] := S;
+end;
+
+procedure THistoryFrm.lvBookKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+ if IsFormShortCut([pmBook], Key, Shift) then
+ Key := 0;
+end;
+
+procedure THistoryFrm.RenameBookmark1Click(Sender: TObject);
+begin
+ lvBook.Selected.EditCaption;
+end;
+
+procedure THistoryFrm.hgProcessInlineChange(Sender: TObject; Enabled: Boolean);
+begin
+ if Assigned(EventDetailForm) then
+ TEventDetailsFrm(EventDetailForm).ResetItem;
+end;
+
+procedure THistoryFrm.hgInlinePopup(Sender: TObject);
+begin
+ InlineCopy.Enabled := hg.InlineRichEdit.SelLength > 0;
+ InlineReplyQuoted.Enabled := InlineCopy.Enabled;
+ InlineTextFormatting.Checked := GridOptions.TextFormatting;
+ InlineSendMessage.Visible := (hContact <> 0);
+ InlineReplyQuoted.Visible := (hContact <> 0);
+ pmInline.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
+end;
+
+procedure THistoryFrm.InlineCopyClick(Sender: TObject);
+begin
+ if hg.InlineRichEdit.SelLength = 0 then
+ Exit;
+ hg.InlineRichEdit.CopyToClipboard;
+end;
+
+procedure THistoryFrm.InlineCopyAllClick(Sender: TObject);
+var
+ cr: TCharRange;
+begin
+ hg.InlineRichEdit.Lines.BeginUpdate;
+ hg.InlineRichEdit.Perform(EM_EXGETSEL, 0, lParam(@cr));
+ hg.InlineRichEdit.SelectAll;
+ hg.InlineRichEdit.CopyToClipboard;
+ hg.InlineRichEdit.Perform(EM_EXSETSEL, 0, lParam(@cr));
+ hg.InlineRichEdit.Lines.EndUpdate;
+end;
+
+procedure THistoryFrm.InlineSelectAllClick(Sender: TObject);
+begin
+ hg.InlineRichEdit.SelectAll;
+end;
+
+procedure THistoryFrm.InlineTextFormattingClick(Sender: TObject);
+begin
+ GridOptions.TextFormatting := not GridOptions.TextFormatting;
+end;
+
+procedure THistoryFrm.InlineReplyQuotedClick(Sender: TObject);
+begin
+ if (hg.Selected = -1) or (hContact = 0) then
+ Exit;
+ if hg.InlineRichEdit.SelLength = 0 then
+ Exit;
+ SendMessageTo(hContact, hg.FormatSelected(GridOptions.ReplyQuotedTextFormat));
+end;
+
+procedure THistoryFrm.hgInlineKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+ if IsFormShortCut([mmAcc, pmInline], Key, Shift) then
+ begin
+ Key := 0;
+ Exit;
+ end;
+ { if (ssCtrl in Shift) then begin
+ if key=Ord('T') then begin
+ InlineCopyAll.Click;
+ key:=0;
+ end;
+ if key=Ord('P') then begin
+ InlineTextFormatting.Click;
+ key:=0;
+ end;
+ if key=Ord('M') then begin
+ SendMessage1.Click;
+ key:=0;
+ end;
+ if key=Ord('R') then begin
+ InlineReplyQuoted.Click;
+ key:=0;
+ end;
+ end; }
+end;
+
+procedure THistoryFrm.ToggleMainMenu(Enabled: Boolean);
+begin
+ if Enabled then
+ begin
+ Toolbar.EdgeBorders := [ebTop];
+ Menu := mmAcc
+ end
+ else
+ begin
+ Toolbar.EdgeBorders := [];
+ Menu := nil;
+ end;
+end;
+
+procedure THistoryFrm.WMSysColorChange(var Message: TMessage);
+begin
+ inherited;
+ LoadToolbarIcons;
+ LoadButtonIcons;
+ LoadSessionIcons;
+ LoadBookIcons;
+ Repaint;
+end;
+
+procedure THistoryFrm.spBookMoved(Sender: TObject);
+begin
+ spBook.Tag := MulDiv(paSess.Height, 255, paHolder.ClientHeight);
+end;
+
+procedure THistoryFrm.paHolderResize(Sender: TObject);
+begin
+ if spBook.Visible then
+ paSess.Height := Max(spBook.MinSize, MulDiv(paHolder.ClientHeight, spBook.Tag, 255))
+ else if paSess.Visible then
+ paSess.Height := paHolder.ClientHeight;
+end;
+
+procedure THistoryFrm.pmToolbarPopup(Sender: TObject);
+begin
+ Application.CancelHint;
+end;
+
+procedure THistoryFrm.hgFilterChange(Sender: TObject);
+begin
+ if Assigned(EventDetailForm) then
+ TEventDetailsFrm(EventDetailForm).ResetItem;
+end;
+
+procedure THistoryFrm.OpenFileFolderClick(Sender: TObject);
+begin
+ if SavedFileDir = '' then
+ Exit;
+ ShellExecuteW(0, 'open', PWideChar(SavedFileDir), nil, nil, SW_SHOW);
+ SavedFileDir := '';
+end;
+
+procedure THistoryFrm.BrowseReceivedFilesClick(Sender: TObject);
+var
+ Path: Array [0 .. MAX_PATH] of AnsiChar;
+begin
+ CallService(MS_FILE_GETRECEIVEDFILESFOLDER, hContact, lParam(@Path));
+ ShellExecuteA(0, 'open', Path, nil, nil, SW_SHOW);
+end;
+
+procedure THistoryFrm.SpeakMessage1Click(Sender: TObject);
+var
+ mesW: String;
+ mesA: AnsiString;
+begin
+ if not MeSpeakEnabled then
+ Exit;
+ if hg.Selected = -1 then
+ Exit;
+ mesW := hg.Items[hg.Selected].Text;
+ if GridOptions.BBCodesEnabled then
+ mesW := DoStripBBCodes(mesW);
+ if Boolean(ServiceExists(MS_SPEAK_SAY_W)) then
+ CallService(MS_SPEAK_SAY_W, hContact, lParam(PChar(mesW)))
+ else
+ begin
+ mesA := WideToAnsiString(mesW, UserCodepage);
+ CallService(MS_SPEAK_SAY_A, hContact, lParam(PAnsiChar(mesA)));
+ end;
+end;
+
+procedure THistoryFrm.hgOptionsChange(Sender: TObject);
+begin
+ if Assigned(EventDetailForm) then
+ TEventDetailsFrm(EventDetailForm).ResetItem;
+end;
+
+procedure THistoryFrm.hgMCData(Sender: TObject; Index: Integer; var Item: TMCItem; Stage: TSaveStage);
+var
+ DBEventInfo: TDBEventInfo;
+ hDBEvent: THandle;
+ DataOffset: PAnsiChar;
+begin
+ if Stage = ssInit then
+ begin
+ Item.Size := 0;
+ hDBEvent := History[GridIndexToHistory(Index)];
+ if hDBEvent <> 0 then
+ begin
+ DBEventInfo := GetEventInfo(hDBEvent);
+ DBEventInfo.szModule := nil;
+ DBEventInfo.flags := DBEventInfo.flags and not DBEF_FIRST;
+ Item.Size := Cardinal(DBEventInfo.cbSize) + Cardinal(DBEventInfo.cbBlob);
+ end;
+ if Item.Size > 0 then
+ begin
+ GetMem(Item.Buffer, Item.Size);
+ DataOffset := PAnsiChar(Item.Buffer) + DBEventInfo.cbSize;
+ Move(DBEventInfo, Item.Buffer^, DBEventInfo.cbSize);
+ Move(DBEventInfo.pBlob^, DataOffset^, DBEventInfo.cbBlob);
+ end;
+ end
+ else if Stage = ssDone then
+ begin
+ if Item.Size > 0 then
+ FreeMem(Item.Buffer, Item.Size);
+ end;
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/HistoryGrid.pas b/plugins/HistoryPlusPlus/HistoryGrid.pas new file mode 100644 index 0000000000..2dec9ab957 --- /dev/null +++ b/plugins/HistoryPlusPlus/HistoryGrid.pas @@ -0,0 +1,6780 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+{ -----------------------------------------------------------------------------
+ HistoryGrid (historypp project)
+
+ Version: 1.4
+ Created: xx.02.2003
+ Author: Oxygen
+
+ [ Description ]
+
+ THistoryGrid to display history items for History++ plugin
+
+ [ History ]
+
+ 1.4
+ - Fixed bug when Select All, Delete causes crash
+
+ 1.3 ()
+ + Fixed scrollbar! Now scrolling is much better
+ + Added XML export
+ + URL & File Highlighting
+ - Fixed bug with changing System font in options, and TextAuthRequest
+ doesn't get changed
+ 1.2
+ 1.1
+ 1.0 (xx.02.03) First version.
+
+ [ Modifications ]
+
+ * (07.03.2006) Added OnFilterData event and UpdateFilter to manually
+ filter messages. Now when filtering, current selection isn't lost
+ (when possible)
+
+ * (01.03.2006) Added OnNameData event. Now you can supply your own
+ user name for each event separately.
+
+ * (29.05.2003) Selecting all and then deleting now works without
+ crashing, just added one check at THistoryGrid.DeleteSelected
+
+ * (31.03.2003) Scrolling now works perfectly! (if you ever can
+ do this with such way of doing scroll)
+
+ [ Known Issues ]
+ * Some visual bugs when track-scrolling. See WMVScroll for details.
+ * Not very good support of EmailExpress events (togeter
+ with HistoryForm.pas)
+
+ Contributors: theMIROn, Art Fedorov
+ ----------------------------------------------------------------------------- }
+
+unit HistoryGrid;
+
+{$I compilers.inc}
+
+interface
+
+{$DEFINE CUST_SB}
+{$IFDEF CUST_SB}
+ {$DEFINE PAGE_SIZE}
+{$ENDIF}
+{$DEFINE RENDER_RICH}
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ComCtrls, CommCtrl,
+ Menus,
+ StrUtils, WideStrUtils,
+ StdCtrls, Math, mmsystem,
+ hpp_global, hpp_contacts, hpp_itemprocess, hpp_events, hpp_eventfilters,
+ hpp_richedit, hpp_olesmileys, m_api,
+ Contnrs,
+ VertSB,
+ RichEdit, ShellAPI;
+
+type
+
+ TMsgFilter = record
+ nmhdr: nmhdr;
+ msg: UINT;
+ wParam: wParam;
+ lParam: lParam;
+ end;
+
+ TMouseMoveKey = (mmkControl, mmkLButton, mmkMButton, mmkRButton, mmkShift);
+ TMouseMoveKeys = set of TMouseMoveKey;
+
+ TGridState = (gsIdle, gsDelete, gsSearch, gsSearchItem, gsLoad, gsSave, gsInline);
+
+ TXMLItem = record
+ Protocol: AnsiString;
+ Time: AnsiString;
+ Date: AnsiString;
+ Mes: AnsiString;
+ Url: AnsiString;
+ FileName: AnsiString;
+ Contact: AnsiString;
+ From: AnsiString;
+ EventType: AnsiString;
+ ID: AnsiString;
+ end;
+
+ TMCItem = record
+ Size: Integer;
+ Buffer: PByte;
+ end;
+
+ TOnSelect = procedure(Sender: TObject; Item, OldItem: Integer) of object;
+ TOnBookmarkClick = procedure(Sender: TObject; Item: Integer) of object;
+ TGetItemData = procedure(Sender: TObject; Index: Integer; var Item: THistoryItem) of object;
+ TGetNameData = procedure(Sender: TObject; Index: Integer; var Name: String) of object;
+ TGetXMLData = procedure(Sender: TObject; Index: Integer; var Item: TXMLItem) of object;
+ TGetMCData = procedure(Sender: TObject; Index: Integer; var Item: TMCItem; Stage: TSaveStage) of object;
+ TOnPopup = TNotifyEvent;
+ TOnTranslateTime = procedure(Sender: TObject; Time: DWord; var Text: String) of object;
+ TOnProgress = procedure(Sender: TObject; Position, Max: Integer) of object;
+ TOnSearchFinished = procedure(Sender: TObject; Text: String; Found: Boolean) of object;
+ TOnSearched = TOnSearchFinished;
+ TOnItemDelete = procedure(Sender: TObject; Index: Integer) of object;
+ TOnState = procedure(Sender: TObject; State: TGridState) of object;
+ TOnItemFilter = procedure(Sender: TObject; Index: Integer; var Show: Boolean) of object;
+ TOnChar = procedure(Sender: TObject; var achar: WideChar; Shift: TShiftState) of object;
+ TOnRTLChange = procedure(Sender: TObject; BiDiMode: TBiDiMode) of object;
+ TOnProcessInlineChange = procedure(Sender: TObject; Enabled: Boolean) of object;
+ TOnOptionsChange = procedure(Sender: TObject) of object;
+ TOnProcessRichText = procedure(Sender: TObject; Handle: THandle; Item: Integer) of object;
+ TOnSearchItem = procedure(Sender: TObject; Item: Integer; ID: Integer; var Found: Boolean) of object;
+ TOnSelectRequest = TNotifyEvent;
+ TOnFilterChange = TNotifyEvent;
+
+ THistoryGrid = class;
+
+ { IFDEF RENDER_RICH }
+ TUrlClickItemEvent = procedure(Sender: TObject; Item: Integer; Url: String;
+ Button: TMouseButton) of object;
+ { ENDIF }
+ TOnShowIcons = procedure;
+ TOnTextFormatting = procedure(Value: Boolean);
+
+ TGridHitTest = (ghtItem, ghtHeader, ghtText, ghtLink, ghtUnknown, ghtButton, ghtSession,
+ ghtSessHideButton, ghtSessShowButton, ghtBookmark);
+ TGridHitTests = set of TGridHitTest;
+
+ TItemOption = record
+ MessageType: TMessageTypes;
+ textFont: TFont;
+ textColor: TColor;
+ end;
+
+ TItemOptions = array of TItemOption;
+
+ TGridOptions = class(TPersistent)
+ private
+ FLocks: Integer;
+ Changed: Integer;
+ Grids: array of THistoryGrid;
+
+ FColorDivider: TColor;
+ FColorSelectedText: TColor;
+ FColorSelected: TColor;
+ FColorSessHeader: TColor;
+ FColorBackground: TColor;
+ FColorLink: TColor;
+
+ FFontProfile: TFont;
+ FFontContact: TFont;
+ FFontIncomingTimestamp: TFont;
+ FFontOutgoingTimestamp: TFont;
+ FFontSessHeader: TFont;
+ FFontMessage: TFont;
+
+ FItemOptions: TItemOptions;
+
+ // FIconMessage: TIcon;
+ // FIconFile: TIcon;
+ // FIconUrl: TIcon;
+ // FIconOther: TIcon;
+
+ FRTLEnabled: Boolean;
+ // FShowAvatars: Boolean;
+ FShowIcons: Boolean;
+ FOnShowIcons: TOnShowIcons;
+
+ FBBCodesEnabled: Boolean;
+ FSmileysEnabled: Boolean;
+ FMathModuleEnabled: Boolean;
+ FRawRTFEnabled: Boolean;
+ FAvatarsHistoryEnabled: Boolean;
+
+ FTextFormatting: Boolean;
+ FOnTextFormatting: TOnTextFormatting;
+
+ FClipCopyTextFormat: String;
+ FClipCopyFormat: String;
+ FReplyQuotedFormat: String;
+ FReplyQuotedTextFormat: String;
+ FSelectionFormat: String;
+
+ FOpenDetailsMode: Boolean;
+
+ FForceProfileName: Boolean;
+ FProfileName: String;
+ FDateTimeFormat: String;
+
+ procedure SetColorDivider(const Value: TColor);
+ procedure SetColorSelectedText(const Value: TColor);
+ procedure SetColorSelected(const Value: TColor);
+ procedure SetColorSessHeader(const Value: TColor);
+ procedure SetColorBackground(const Value: TColor);
+ procedure SetColorLink(const Value: TColor);
+
+ procedure SetFontContact(const Value: TFont);
+ procedure SetFontProfile(const Value: TFont);
+ procedure SetFontIncomingTimestamp(const Value: TFont);
+ procedure SetFontOutgoingTimestamp(const Value: TFont);
+ procedure SetFontSessHeader(const Value: TFont);
+ procedure SetFontMessage(const Value: TFont);
+
+ // procedure SetIconOther(const Value: TIcon);
+ // procedure SetIconFile(const Value: TIcon);
+ // procedure SetIconURL(const Value: TIcon);
+ // procedure SetIconMessage(const Value: TIcon);
+
+ procedure SetRTLEnabled(const Value: Boolean);
+ procedure SetShowIcons(const Value: Boolean);
+ // procedure SetShowAvatars(const Value: Boolean);
+
+ procedure SetBBCodesEnabled(const Value: Boolean);
+ procedure SetSmileysEnabled(const Value: Boolean);
+ procedure SetMathModuleEnabled(const Value: Boolean);
+ procedure SetRawRTFEnabled(const Value: Boolean);
+ procedure SetAvatarsHistoryEnabled(const Value: Boolean);
+ procedure SetProfileName(const Value: String);
+ procedure SetTextFormatting(const Value: Boolean);
+
+ function GetLocked: Boolean;
+ procedure SetDateTimeFormat(const Value: String);
+ protected
+ procedure DoChange;
+ procedure AddGrid(Grid: THistoryGrid);
+ procedure DeleteGrid(Grid: THistoryGrid);
+ procedure FontChanged(Sender: TObject);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure StartChange;
+ procedure EndChange(const Forced: Boolean = False);
+ function AddItemOptions: Integer;
+ function GetItemOptions(Mes: TMessageTypes; out textFont: TFont; out textColor: TColor): Integer;
+ property OnShowIcons: TOnShowIcons read FOnShowIcons write FOnShowIcons;
+ property OnTextFormatting: TOnTextFormatting read FOnTextFormatting write FOnTextFormatting;
+ published
+ property ClipCopyFormat: String read FClipCopyFormat write FClipCopyFormat;
+ property ClipCopyTextFormat: String read FClipCopyTextFormat write FClipCopyTextFormat;
+ property ReplyQuotedFormat: String read FReplyQuotedFormat write FReplyQuotedFormat;
+ property ReplyQuotedTextFormat: String read FReplyQuotedTextFormat write FReplyQuotedTextFormat;
+ property SelectionFormat: String read FSelectionFormat write FSelectionFormat;
+
+ property Locked: Boolean read GetLocked;
+
+ // property IconOther: TIcon read FIconOther write SetIconOther;
+ // property IconFile: TIcon read FIconFile write SetIconFile;
+ // property IconUrl: TIcon read FIconUrl write SetIconUrl;
+ // property IconMessage: TIcon read FIconMessage write SetIconMessage;
+
+ // property IconHistory: hIcon read FIconHistory write FIconHistory;
+ // property IconSearch: hIcon read FIconSearch write FIconSearch;
+
+ property ColorDivider: TColor read FColorDivider write SetColorDivider;
+ property ColorSelectedText: TColor read FColorSelectedText write SetColorSelectedText;
+ property ColorSelected: TColor read FColorSelected write SetColorSelected;
+ property ColorSessHeader: TColor read FColorSessHeader write SetColorSessHeader;
+ property ColorBackground: TColor read FColorBackground write SetColorBackground;
+ property ColorLink: TColor read FColorLink write SetColorLink;
+
+ property FontProfile: TFont read FFontProfile write SetFontProfile;
+ property FontContact: TFont read FFontContact write SetFontContact;
+ property FontIncomingTimestamp: TFont read FFontIncomingTimestamp write SetFontIncomingTimestamp;
+ property FontOutgoingTimestamp: TFont read FFontOutgoingTimestamp write SetFontOutgoingTimestamp;
+ property FontSessHeader: TFont read FFontSessHeader write SetFontSessHeader;
+ property FontMessage: TFont read FFontMessage write SetFontMessage;
+
+ property ItemOptions: TItemOptions read FItemOptions write FItemOptions;
+
+ property RTLEnabled: Boolean read FRTLEnabled write SetRTLEnabled;
+ property ShowIcons: Boolean read FShowIcons write SetShowIcons;
+ // property ShowAvatars: Boolean read FShowAvatars write SetShowAvatars;
+
+ property BBCodesEnabled: Boolean read FBBCodesEnabled write SetBBCodesEnabled;
+ property SmileysEnabled: Boolean read FSmileysEnabled write SetSmileysEnabled;
+ property MathModuleEnabled: Boolean read FMathModuleEnabled write SetMathModuleEnabled;
+ property RawRTFEnabled: Boolean read FRawRTFEnabled write SetRawRTFEnabled;
+ property AvatarsHistoryEnabled: Boolean read FAvatarsHistoryEnabled write SetAvatarsHistoryEnabled;
+
+ property OpenDetailsMode: Boolean read FOpenDetailsMode write FOpenDetailsMode;
+ property ForceProfileName: Boolean read FForceProfileName;
+ property ProfileName: String read FProfileName write SetProfileName;
+
+ property DateTimeFormat: String read FDateTimeFormat write SetDateTimeFormat;
+ property TextFormatting: Boolean read FTextFormatting write SetTextFormatting;
+ end;
+
+ PRichItem = ^TRichItem;
+
+ TRichItem = record
+ Rich: THPPRichEdit;
+ Bitmap: TBitmap;
+ BitmapDrawn: Boolean;
+ Height: Integer;
+ GridItem: Integer;
+ end;
+
+ PLockedItem = ^TLockedItem;
+
+ TLockedItem = record
+ RichItem: PRichItem;
+ SaveRect: TRect;
+ end;
+
+ TRichCache = class(TObject)
+ private
+ LogX, LogY: Integer;
+ RichEventMasks: DWord;
+ Grid: THistoryGrid;
+ FRichWidth: Integer;
+ FRichHeight: Integer;
+ FLockedList: TList;
+
+ function FindGridItem(GridItem: Integer): Integer;
+ procedure PaintRichToBitmap(Item: PRichItem);
+ procedure ApplyItemToRich(Item: PRichItem);
+
+ procedure OnRichResize(Sender: TObject; Rect: TRect);
+ protected
+ Items: array of PRichItem;
+ procedure MoveToTop(Index: Integer);
+ procedure SetWidth(const Value: Integer);
+ public
+ constructor Create(AGrid: THistoryGrid); overload;
+ destructor Destroy; override;
+
+ procedure ResetAllItems;
+ procedure ResetItems(GridItems: array of Integer);
+ procedure ResetItem(GridItem: Integer);
+ property Width: Integer read FRichWidth write SetWidth;
+ procedure SetHandles;
+
+ procedure WorkOutItemAdded(GridItem: Integer);
+ procedure WorkOutItemDeleted(GridItem: Integer);
+
+ function RequestItem(GridItem: Integer): PRichItem;
+ function CalcItemHeight(GridItem: Integer): Integer;
+ function GetItemRich(GridItem: Integer): THPPRichEdit;
+ function GetItemRichBitmap(GridItem: Integer): TBitmap;
+ function GetItemByHandle(Handle: THandle): PRichItem;
+ function LockItem(Item: PRichItem; SaveRect: TRect): Integer;
+ function UnlockItem(Item: Integer): TRect;
+ end;
+
+ TGridUpdate = (guSize, guAllocate, guFilter, guOptions);
+ TGridUpdates = set of TGridUpdate;
+
+ THistoryGrid = class(TScrollingWinControl)
+ private
+ LogX, LogY: Integer;
+ SessHeaderHeight: Integer;
+ CHeaderHeight, PHeaderheight: Integer;
+ IsCanvasClean: Boolean;
+ ProgressRect: TRect;
+ BarAdjusted: Boolean;
+ Allocated: Boolean;
+ LockCount: Integer;
+ ClipRect: TRect;
+ ShowProgress: Boolean;
+ ProgressPercent: Byte;
+ SearchPattern: String;
+ GridUpdates: TGridUpdates;
+ VLineScrollSize: Integer;
+ FSelItems, TempSelItems: array of Integer;
+ FSelected: Integer;
+ FGetItemData: TGetItemData;
+ FGetNameData: TGetNameData;
+ FPadding: Integer;
+ FItems: array of THistoryItem;
+ FClient: TBitmap;
+ FCanvas: TCanvas;
+ FContact: THandle;
+ FProtocol: AnsiString;
+ FLoadedCount: Integer;
+ FContactName: String;
+ FProfileName: String;
+ FOnPopup: TOnPopup;
+ FTranslateTime: TOnTranslateTime;
+ FFilter: TMessageTypes;
+ FDblClick: TNotifyEvent;
+ FSearchFinished: TOnSearchFinished;
+ FOnProcessRichText: TOnProcessRichText;
+ FItemDelete: TOnItemDelete;
+ FState: TGridState;
+ FHideSelection: Boolean;
+ FGridNotFocused: Boolean;
+
+ FTxtNoItems: String;
+ FTxtStartup: String;
+ FTxtNoSuch: String;
+
+ FTxtFullLog: String;
+ FTxtPartLog: String;
+ FTxtHistExport: String;
+ FTxtGenHist1: String;
+ FTxtGenHist2: String;
+ FTxtSessions: String;
+
+ FSelectionString: String;
+ FSelectionStored: Boolean;
+
+ FOnState: TOnState;
+ FReversed: Boolean;
+ FReversedHeader: Boolean;
+ FOptions: TGridOptions;
+ FMultiSelect: Boolean;
+ FOnSelect: TOnSelect;
+ FOnFilterChange: TOnFilterChange;
+ FGetXMLData: TGetXMLData;
+ FGetMCData: TGetMCData;
+ FOnItemFilter: TOnItemFilter;
+{$IFDEF CUST_SB}
+ FVertScrollBar: TVertScrollBar;
+{$ENDIF}
+{$IFDEF RENDER_RICH}
+ FRichCache: TRichCache;
+ FOnUrlClick: TUrlClickItemEvent;
+ FRich: THPPRichEdit;
+ FRichInline: THPPRichEdit;
+ FItemInline: Integer;
+ FRichSave: THPPRichEdit;
+ FRichSaveItem: THPPRichEdit;
+ FRichSaveOLECB: TRichEditOleCallback;
+
+ FOnInlineKeyDown: TKeyEvent;
+ FOnInlineKeyUp: TKeyEvent;
+ FOnInlinePopup: TOnPopup;
+
+ FRichHeight: Integer;
+ FRichParamsSet: Boolean;
+ FOnSearchItem: TOnSearchItem;
+
+ FRTLMode: TRTLMode;
+ FOnRTLChange: TOnRTLChange;
+
+ FOnOptionsChange: TOnOptionsChange;
+
+ TopItemOffset: Integer;
+ MaxSBPos: Integer;
+ FShowHeaders: Boolean;
+ FCodepage: Cardinal;
+ FOnChar: TOnChar;
+ WindowPrePainting: Boolean;
+ WindowPrePainted: Boolean;
+ FExpandHeaders: Boolean;
+ FOnProcessInlineChange: TOnProcessInlineChange;
+
+ FOnBookmarkClick: TOnBookmarkClick;
+ FShowBookmarks: Boolean;
+ FGroupLinked: Boolean;
+ FShowBottomAligned: Boolean;
+ FOnSelectRequest: TOnSelectRequest;
+ FBorderStyle: TBorderStyle;
+
+ FWheelAccumulator: Integer;
+ FWheelLastTick: Cardinal;
+
+ FHintRect: TRect;
+ // !! function GetHint: WideString;
+ // !! procedure SetHint(const Value: WideString);
+ // !! function IsHintStored: Boolean;
+ procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
+
+ procedure SetBorderStyle(Value: TBorderStyle);
+
+ procedure SetCodepage(const Value: Cardinal);
+ procedure SetShowHeaders(const Value: Boolean);
+ function GetIdx(Index: Integer): Integer;
+ // Item offset support
+ // procedure SetScrollBar
+ procedure ScrollGridBy(Offset: Integer; Update: Boolean = True);
+ procedure SetSBPos(Position: Integer);
+ // FRich events
+ // procedure OnRichResize(Sender: TObject; Rect: TRect);
+ // procedure OnMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
+{$ENDIF}
+ procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
+ procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
+ procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
+ procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
+ procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
+ procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
+ procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
+ procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
+ procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
+ procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
+ procedure WMLButtonDblClick(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
+ procedure WMMButtonDown(var Message: TWMRButtonDown); message WM_MBUTTONDOWN;
+ procedure WMMButtonUp(var Message: TWMRButtonDown); message WM_MBUTTONUP;
+ procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
+ procedure WMSize(var Message: TWMSize); message WM_SIZE;
+ procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
+ procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
+ procedure CNVScroll(var Message: TWMVScroll); message CN_VSCROLL;
+ procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
+ procedure WMKeyUp(var Message: TWMKeyUp); message WM_KEYUP;
+ procedure WMSysKeyUp(var Message: TWMSysKeyUp); message WM_SYSKEYUP;
+ procedure WMChar(var Message: TWMChar); message WM_CHAR;
+ procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL;
+ procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;
+ procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
+ procedure WMCommand(var Message: TWMCommand); message WM_COMMAND;
+ procedure EMGetSel(var Message: TMessage); message EM_GETSEL;
+ procedure EMExGetSel(var Message: TMessage); message EM_EXGETSEL;
+ procedure EMSetSel(var Message: TMessage); message EM_SETSEL;
+ procedure EMExSetSel(var Message: TMessage); message EM_EXSETSEL;
+ procedure WMGetText(var Message: TWMGetText); message WM_GETTEXT;
+ procedure WMGetTextLength(var Message: TWMGetTextLength); message WM_GETTEXTLENGTH;
+ procedure WMSetText(var Message: TWMSetText); message WM_SETTEXT;
+ function GetCount: Integer;
+ procedure SetContact(const Value: THandle);
+ procedure SetPadding(Value: Integer);
+ procedure SetSelected(const Value: Integer);
+ procedure AddSelected(Item: Integer);
+ procedure RemoveSelected(Item: Integer);
+ procedure MakeRangeSelected(FromItem, ToItem: Integer);
+ procedure MakeSelectedTo(Item: Integer);
+ procedure MakeVisible(Item: Integer);
+ procedure MakeSelected(Value: Integer);
+ function GetSelCount: Integer;
+ procedure SetFilter(const Value: TMessageTypes);
+ function GetTime(Time: DWord): String;
+ function GetItems(Index: Integer): THistoryItem;
+ function IsMatched(Index: Integer): Boolean;
+ function IsUnknown(Index: Integer): Boolean;
+ procedure WriteString(fs: TFileStream; Text: AnsiString);
+ procedure WriteWideString(fs: TFileStream; Text: String);
+ procedure CheckBusy;
+ function GetSelItems(Index: Integer): Integer;
+ procedure SetSelItems(Index: Integer; Item: Integer);
+ procedure SetState(const Value: TGridState);
+ procedure SetReversed(const Value: Boolean);
+ procedure SetReversedHeader(const Value: Boolean);
+ procedure AdjustScrollBar;
+ procedure SetOptions(const Value: TGridOptions);
+ procedure SetMultiSelect(const Value: Boolean);
+{$IFDEF CUST_SB}
+ procedure SetVertScrollBar(const Value: TVertScrollBar);
+ function GetHideScrollBar: Boolean;
+ procedure SetHideScrollBar(const Value: Boolean);
+{$ENDIF}
+ function GetHitTests(X, Y: Integer): TGridHitTests;
+{$IFDEF RENDER_RICH}
+ function GetLinkAtPoint(X, Y: Integer): String;
+ function GetHintAtPoint(X, Y: Integer; var ObjectHint: WideString; var ObjectRect: TRect): Boolean;
+ function GetRichEditRect(Item: Integer; DontClipTop: Boolean = False): TRect;
+{$ENDIF}
+ procedure SetRTLMode(const Value: TRTLMode);
+ procedure SetExpandHeaders(const Value: Boolean);
+ procedure SetProcessInline(const Value: Boolean);
+ function GetBookmarked(Index: Integer): Boolean;
+ procedure SetBookmarked(Index: Integer; const Value: Boolean);
+ procedure SetGroupLinked(const Value: Boolean);
+ procedure SetHideSelection(const Value: Boolean);
+
+ // FRichInline events
+ { procedure OnInlinePopup(Sender: TObject);
+ procedure OnInlineCopyClick(Sender: TObject);
+ procedure OnInlineCopyAllClick(Sender: TObject);
+ procedure OnInlineSelectAllClick(Sender: TObject);
+ procedure OnInlineToggleProcessingClick(Sender: TObject);
+ procedure OnInlineCancelClick(Sender: TObject); }
+
+ procedure OnInlineOnExit(Sender: TObject);
+ procedure OnInlineOnKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure OnInlineOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure OnInlineOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+ procedure OnInlineOnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+ procedure OnInlineOnURLClick(Sender: TObject; const URLText: String; Button: TMouseButton);
+
+ function GetProfileName: String;
+ procedure SetProfileName(const Value: String);
+ procedure SetContactName(const Value: String);
+
+ function IsLinkAtPoint(RichEditRect: TRect; X, Y, Item: Integer): Boolean;
+
+ protected
+ DownHitTests: TGridHitTests;
+ HintHitTests: TGridHitTests;
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure CreateParams(var Params: TCreateParams); override;
+ // procedure WndProc(var Message: TMessage); override;
+ property Canvas: TCanvas read FCanvas;
+ procedure Paint;
+ procedure PaintHeader(Index: Integer; ItemRect: TRect);
+ procedure PaintItem(Index: Integer; ItemRect: TRect);
+ procedure DrawProgress;
+ procedure DrawMessage(Text: String);
+ procedure LoadItem(Item: Integer; LoadHeight: Boolean = True; Reload: Boolean = False);
+ procedure DoOptionsChanged;
+ procedure DoKeyDown(var Key: Word; ShiftState: TShiftState);
+ procedure DoKeyUp(var Key: Word; ShiftState: TShiftState);
+ procedure DoChar(var Ch: WideChar; ShiftState: TShiftState);
+ procedure DoLButtonDblClick(X, Y: Integer; Keys: TMouseMoveKeys);
+ procedure DoLButtonDown(X, Y: Integer; Keys: TMouseMoveKeys);
+ procedure DoLButtonUp(X, Y: Integer; Keys: TMouseMoveKeys);
+ procedure DoMouseMove(X, Y: Integer; Keys: TMouseMoveKeys);
+ procedure DoRButtonDown(X, Y: Integer; Keys: TMouseMoveKeys);
+ procedure DoRButtonUp(X, Y: Integer; Keys: TMouseMoveKeys);
+ procedure DoMButtonDown(X, Y: Integer; Keys: TMouseMoveKeys);
+ procedure DoMButtonUp(X, Y: Integer; Keys: TMouseMoveKeys);
+ // procedure DoUrlMouseMove(Url: WideString);
+ procedure DoProgress(Position, Max: Integer);
+ function CalcItemHeight(Item: Integer): Integer;
+ procedure ScrollBy(DeltaX, DeltaY: Integer);
+ procedure DeleteItem(Item: Integer);
+ procedure SaveStart(Stream: TFileStream; SaveFormat: TSaveFormat; Caption: String);
+ procedure SaveItem(Stream: TFileStream; Item: Integer; SaveFormat: TSaveFormat);
+ procedure SaveEnd(Stream: TFileStream; SaveFormat: TSaveFormat);
+
+ procedure GridUpdateSize;
+ function GetSelectionString: String;
+ procedure URLClick(Item: Integer; const URLText: String; Button: TMouseButton); dynamic;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ property Count: Integer read GetCount;
+ property Contact: THandle read FContact write SetContact;
+ property Protocol: AnsiString read FProtocol write FProtocol;
+ property LoadedCount: Integer read FLoadedCount;
+ procedure Allocate(ItemsCount: Integer; Scroll: Boolean = True);
+ property Selected: Integer read FSelected write SetSelected;
+ property SelCount: Integer read GetSelCount;
+ function FindItemAt(X, Y: Integer; out ItemRect: TRect): Integer; overload;
+ function FindItemAt(P: TPoint; out ItemRect: TRect): Integer; overload;
+ function FindItemAt(P: TPoint): Integer; overload;
+ function FindItemAt(X, Y: Integer): Integer; overload;
+ function GetItemRect(Item: Integer): TRect;
+ function IsSelected(Item: Integer): Boolean;
+ procedure BeginUpdate;
+ procedure EndUpdate;
+ procedure GridUpdate(Updates: TGridUpdates);
+ function IsVisible(Item: Integer; Partially: Boolean = True): Boolean;
+ procedure Delete(Item: Integer);
+ procedure DeleteSelected;
+ procedure DeleteAll;
+ procedure SelectRange(FromItem, ToItem: Integer);
+ procedure SelectAll;
+ property Items[Index: Integer]: THistoryItem read GetItems;
+ property Bookmarked[Index: Integer]: Boolean read GetBookmarked write SetBookmarked;
+ property SelectedItems[Index: Integer]: Integer read GetSelItems write SetSelItems;
+ function Search(Text: String; CaseSensitive: Boolean; FromStart: Boolean = False;
+ SearchAll: Boolean = False; FromNext: Boolean = False; Down: Boolean = True): Integer;
+ function SearchItem(ItemID: Integer): Integer;
+ procedure AddItem;
+ procedure SaveSelected(FileName: String; SaveFormat: TSaveFormat);
+ procedure SaveAll(FileName: String; SaveFormat: TSaveFormat);
+ function GetNext(Item: Integer; Force: Boolean = False): Integer;
+ function GetDown(Item: Integer): Integer;
+ function GetPrev(Item: Integer; Force: Boolean = False): Integer;
+ function GetUp(Item: Integer): Integer;
+ function GetTopItem: Integer;
+ function GetBottomItem: Integer;
+ property State: TGridState read FState write SetState;
+ function GetFirstVisible: Integer;
+ procedure UpdateFilter;
+
+ procedure EditInline(Item: Integer);
+ procedure CancelInline(DoSetFocus: Boolean = True);
+ procedure AdjustInlineRichedit;
+ function GetItemInline: Integer;
+ property InlineRichEdit: THPPRichEdit read FRichInline write FRichInline;
+ property RichEdit: THPPRichEdit read FRich write FRich;
+
+ property Options: TGridOptions read FOptions write SetOptions;
+ property HotString: String read SearchPattern;
+ property RTLMode: TRTLMode read FRTLMode write SetRTLMode;
+
+ procedure MakeTopmost(Item: Integer);
+ procedure ScrollToBottom;
+ procedure ResetItem(Item: Integer);
+ procedure ResetAllItems;
+
+ procedure IntFormatItem(Item: Integer; var Tokens: TWideStrArray; var SpecialTokens: TIntArray);
+ procedure PrePaintWindow;
+
+ property Codepage: Cardinal read FCodepage write SetCodepage;
+ property Filter: TMessageTypes read FFilter write SetFilter;
+
+ property SelectionString: String read GetSelectionString;
+ published
+ procedure SetRichRTL(RTL: Boolean; RichEdit: THPPRichEdit; ProcessTag: Boolean = True);
+ function GetItemRTL(Item: Integer): Boolean;
+
+ // procedure CopyToClipSelected(const Format: WideString; ACodepage: Cardinal = CP_ACP);
+ procedure ApplyItemToRich(Item: Integer; RichEdit: THPPRichEdit = nil; ForceInline: Boolean = False);
+
+ function FormatItem(Item: Integer; Format: String): String;
+ function FormatItems(ItemList: array of Integer; Format: String): String;
+ function FormatSelected(const Format: String): String;
+
+ property ShowBottomAligned: Boolean read FShowBottomAligned write FShowBottomAligned;
+ property ShowBookmarks: Boolean read FShowBookmarks write FShowBookmarks;
+ property MultiSelect: Boolean read FMultiSelect write SetMultiSelect;
+ property ShowHeaders: Boolean read FShowHeaders write SetShowHeaders;
+ property ExpandHeaders: Boolean read FExpandHeaders write SetExpandHeaders default True;
+ property GroupLinked: Boolean read FGroupLinked write SetGroupLinked default False;
+ property ProcessInline: Boolean write SetProcessInline;
+ property TxtStartup: String read FTxtStartup write FTxtStartup;
+ property TxtNoItems: String read FTxtNoItems write FTxtNoItems;
+ property TxtNoSuch: String read FTxtNoSuch write FTxtNoSuch;
+ property TxtFullLog: String read FTxtFullLog write FTxtFullLog;
+ property TxtPartLog: String read FTxtPartLog write FTxtPartLog;
+ property TxtHistExport: String read FTxtHistExport write FTxtHistExport;
+ property TxtGenHist1: String read FTxtGenHist1 write FTxtGenHist1;
+ property TxtGenHist2: String read FTxtGenHist2 write FTxtGenHist2;
+ property TxtSessions: String read FTxtSessions write FTxtSessions;
+ // property Filter: TMessageTypes read FFilter write SetFilter;
+ property ProfileName: String read GetProfileName write SetProfileName;
+ property ContactName: String read FContactName write SetContactName;
+ property OnDblClick: TNotifyEvent read FDblClick write FDblClick;
+ property OnItemData: TGetItemData read FGetItemData write FGetItemData;
+ property OnNameData: TGetNameData read FGetNameData write FGetNameData;
+ property OnPopup: TOnPopup read FOnPopup write FOnPopup;
+ property OnTranslateTime: TOnTranslateTime read FTranslateTime write FTranslateTime;
+ property OnSearchFinished: TOnSearchFinished read FSearchFinished write FSearchFinished;
+ property OnItemDelete: TOnItemDelete read FItemDelete write FItemDelete;
+ property OnKeyDown;
+ property OnKeyUp;
+ property OnInlineKeyDown: TKeyEvent read FOnInlineKeyDown write FOnInlineKeyDown;
+ property OnInlineKeyUp: TKeyEvent read FOnInlineKeyUp write FOnInlineKeyUp;
+ property OnInlinePopup: TOnPopup read FOnInlinePopup write FOnInlinePopup;
+ property OnProcessInlineChange: TOnProcessInlineChange read FOnProcessInlineChange write FOnProcessInlineChange;
+ property OnOptionsChange: TOnOptionsChange read FOnOptionsChange write FOnOptionsChange;
+ property OnChar: TOnChar read FOnChar write FOnChar;
+ property OnState: TOnState read FOnState write FOnState;
+ property OnSelect: TOnSelect read FOnSelect write FOnSelect;
+ property OnXMLData: TGetXMLData read FGetXMLData write FGetXMLData;
+ property OnMCData: TGetMCData read FGetMCData write FGetMCData;
+ property OnRTLChange: TOnRTLChange read FOnRTLChange write FOnRTLChange;
+ { IFDEF RENDER_RICH }
+ property OnUrlClick: TUrlClickItemEvent read FOnUrlClick write FOnUrlClick;
+ { ENDIF }
+ property OnBookmarkClick: TOnBookmarkClick read FOnBookmarkClick write FOnBookmarkClick;
+ property OnItemFilter: TOnItemFilter read FOnItemFilter write FOnItemFilter;
+ property OnProcessRichText: TOnProcessRichText read FOnProcessRichText write FOnProcessRichText;
+ property OnSearchItem: TOnSearchItem read FOnSearchItem write FOnSearchItem;
+ property OnSelectRequest: TOnSelectRequest read FOnSelectRequest write FOnSelectRequest;
+ property OnFilterChange: TOnFilterChange read FOnFilterChange write FOnFilterChange;
+
+ property Reversed: Boolean read FReversed write SetReversed;
+ property ReversedHeader: Boolean read FReversedHeader write SetReversedHeader;
+ property TopItem: Integer read GetTopItem;
+ property BottomItem: Integer read GetBottomItem;
+ property ItemInline: Integer read GetItemInline;
+ property HideSelection: Boolean read FHideSelection write SetHideSelection default False;
+ property Align;
+ property Anchors;
+ property TabStop;
+ property Font;
+ property Color;
+ property ParentColor;
+ property BiDiMode;
+ property ParentBiDiMode;
+ property BevelEdges;
+ property BevelInner;
+ property BevelKind;
+ property BevelOuter;
+ property BevelWidth;
+ property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
+ property BorderWidth;
+ property Ctl3D;
+ property ParentCtl3D;
+ property Padding: Integer read FPadding write SetPadding;
+{$IFDEF CUST_SB}
+ property VertScrollBar: TVertScrollBar read FVertScrollBar write SetVertScrollBar;
+ property HideScrollBar: Boolean read GetHideScrollBar write SetHideScrollBar;
+{$ENDIF}
+ // !! property Hint: String read GetHint write SetHint stored IsHintStored;
+ property ShowHint;
+ end;
+
+procedure Register;
+
+implementation
+
+{$I compilers.inc}
+
+uses
+ hpp_options, hpp_arrays, hpp_strparser,
+ ComObj;
+
+type
+ TMCHeader = packed record
+ Signature: array [0 .. 1] of AnsiChar;
+ Version: Integer;
+ DataSize: Integer;
+ end;
+
+const
+ HtmlStop = [#0, #10, #13, '<', '>', '[', ']', ' ', '''', '"'];
+
+var
+ mcHeader: TMCHeader = (Signature: 'HB'; Version: - 1; DataSize: 0;);
+
+function UrlHighlightHtml(Text: AnsiString): AnsiString;
+var
+ UrlStart, UrlCent, UrlEnd: Integer;
+ UrlStr: String;
+begin
+ Result := Text;
+ UrlCent := AnsiPos('://', string(Text));
+ while UrlCent > 0 do
+ begin
+ Text[UrlCent] := '!';
+ UrlStart := UrlCent;
+ UrlEnd := UrlCent + 2;
+ while UrlStart > 0 do
+ begin
+ if (Text[UrlStart - 1] in HtmlStop) then
+ break;
+ Dec(UrlStart);
+ end;
+ while UrlEnd < Length(Text) do
+ begin
+ if (Text[UrlEnd + 1] in HtmlStop) then
+ break;
+ Inc(UrlEnd);
+ end;
+ if (UrlEnd - 2 - UrlCent > 0) and (UrlCent - UrlStart - 1 > 0) then
+ begin
+ UrlStr := '<a class=url href="' + Copy(Result, UrlStart, UrlEnd - UrlStart + 1) + '">';
+ Insert(UrlStr, Result, UrlStart);
+ Insert('</a>', Result, UrlEnd + Length(UrlStr) + 1);
+ UrlStr := StringReplace(UrlStr, '://', '!//', [rfReplaceAll]);
+ Insert(UrlStr, Text, UrlStart);
+ Insert('</a>', Text, UrlEnd + Length(UrlStr) + 1);
+ end;
+ UrlCent := AnsiPos('://', Text);
+ end;
+end;
+
+function MakeTextHtmled(T: AnsiString): AnsiString;
+begin
+ Result := T;
+ // change & to &
+ Result := StringReplace(Result, '&', '&', [rfReplaceAll]);
+ Result := StringReplace(Result, '>', '>', [rfReplaceAll]);
+ Result := StringReplace(Result, '<', '<', [rfReplaceAll]);
+ Result := StringReplace(Result, #9, ' ', [rfReplaceAll]);
+ Result := StringReplace(Result, #13#10, '<br>', [rfReplaceAll]);
+end;
+
+function PointInRect(Pnt: TPoint; Rct: TRect): Boolean;
+begin
+ Result := (Pnt.X >= Rct.Left) and (Pnt.X <= Rct.Right) and (Pnt.Y >= Rct.Top) and
+ (Pnt.Y <= Rct.Bottom);
+end;
+
+function DoRectsIntersect(R1, R2: TRect): Boolean;
+begin
+ Result := (Max(R1.Left, R2.Left) < Min(R1.Right, R2.Right)) and
+ (Max(R1.Top, R2.Top) < Min(R1.Bottom, R2.Bottom));
+end;
+
+function TranslateKeys(const Keys: Integer): TMouseMoveKeys;
+begin
+ Result := [];
+ if Keys and MK_CONTROL > 0 then Result := Result + [mmkControl];
+ if Keys and MK_LBUTTON > 0 then Result := Result + [mmkLButton];
+ if Keys and MK_MBUTTON > 0 then Result := Result + [mmkMButton];
+ if Keys and MK_RBUTTON > 0 then Result := Result + [mmkRButton];
+ if Keys and MK_SHIFT > 0 then Result := Result + [mmkShift];
+end;
+
+function NotZero(X: DWord): DWord; // used that array doesn't store 0 for already loaded data
+begin
+ if X = 0 then
+ Result := 1
+ else
+ Result := X;
+end;
+
+procedure Register;
+begin
+ RegisterComponents('History++', [THistoryGrid]);
+end;
+
+{ THistoryGrid }
+
+constructor THistoryGrid.Create(AOwner: TComponent);
+const
+ GridStyle = [csCaptureMouse, csClickEvents, csDoubleClicks, csReflector, csOpaque,
+ csNeedsBorderPaint];
+var
+ dc: HDC;
+begin
+ inherited;
+ ShowHint := True;
+ HintHitTests := [];
+
+{$IFDEF RENDER_RICH}
+ FRichCache := TRichCache.Create(Self);
+
+ { tmp
+ FRich := TRichEdit.Create(Self);
+ FRich.Name := 'OrgFRich';
+ FRich.Visible := False;
+ // just a dirty hack to workaround problem with
+ // SmileyAdd making richedit visible all the time
+ FRich.Height := 1000;
+ FRich.Top := -1001;
+ // </hack>
+
+ // Don't give him grid as parent, or we'll have
+ // wierd problems with scroll bar
+ FRich.Parent := nil;
+ // on 9x wrong sizing
+ //FRich.PlainText := True;
+ FRich.WordWrap := True;
+ FRich.BorderStyle := bsNone;
+ FRich.OnResizeRequest := OnRichResize;
+ FRich.OnMouseMove := OnMouseMove;
+ // we cann't set specific params to FRich because
+ // it's handle is unknown yet. We do it in WMSize, but
+ // to prevent setting it multiple times
+ // we have this variable
+ }
+ FRichParamsSet := False;
+
+ // Ok, now inlined richedit
+ FRichInline := THPPRichEdit.Create(Self);
+ // workaround of SmileyAdd making richedit visible all the time
+ FRichInline.Top := -MaxInt;
+ FRichInline.Height := -1;
+ FRichInline.Name := 'FRichInline';
+ FRichInline.Visible := False;
+ // FRichInline.Parent := Self.Parent;
+ // FRichInline.PlainText := True;
+ FRichInline.WordWrap := True;
+ FRichInline.BorderStyle := bsNone;
+ FRichInline.ReadOnly := True;
+
+ FRichInline.ScrollBars := ssVertical;
+ FRichInline.HideScrollBars := True;
+
+ FRichInline.OnExit := OnInlineOnExit;
+ FRichInline.OnKeyDown := OnInlineOnKeyDown;
+ FRichInline.OnKeyUp := OnInlineOnKeyUp;
+ FRichInline.OnMouseDown := OnInlineOnMouseDown;
+ FRichInline.OnMouseUp := OnInlineOnMouseUp;
+ FRichInline.OnUrlClick := OnInlineOnURLClick;
+
+ FRichInline.Brush.Style := bsClear;
+
+ FItemInline := -1;
+
+{$ENDIF}
+ FCodepage := CP_ACP;
+ // FRTLMode := hppRTLDefault;
+
+ CHeaderHeight := -1;
+ PHeaderheight := -1;
+ FExpandHeaders := False;
+
+ TabStop := True;
+ MultiSelect := True;
+
+ TxtStartup := 'Starting up...';
+ TxtNoItems := 'History is empty';
+ TxtNoSuch := 'No such items';
+ TxtFullLog := 'Full History Log';
+ TxtPartLog := 'Partial History Log';
+ TxtHistExport := hppName + ' export';
+ TxtGenHist1 := '### (generated by ' + hppName + ' plugin)';
+ TxtGenHist2 := '<h6>Generated by <b dir="ltr">' + hppName + '</b> Plugin</h6>';
+ TxtSessions := 'Conversation started at %s';
+
+ FReversed := False;
+ FReversedHeader := False;
+
+ FState := gsIdle;
+
+ IsCanvasClean := False;
+
+ BarAdjusted := False;
+ Allocated := False;
+
+ ShowBottomAligned := False;
+
+ ProgressPercent := 255;
+ ShowProgress := False;
+
+ if NewStyleControls then
+ ControlStyle := GridStyle
+ else
+ ControlStyle := GridStyle + [csFramed];
+
+ LockCount := 0;
+
+ // fill all events with unknown to force filter reset
+ FFilter := GenerateEvents(FM_EXCLUDE, []) + [mtUnknown, mtCustom];
+
+ FSelected := -1;
+ FContact := 0;
+ FProtocol := '';
+ FPadding := 4;
+ FShowBookmarks := True;
+
+ FClient := TBitmap.Create;
+ FClient.Width := 1;
+ FClient.Height := 1;
+
+ FCanvas := FClient.Canvas;
+ FCanvas.Font.Name := 'MS Shell Dlg';
+
+ // get line scroll size depending on current dpi
+ // default is 13px for standard 96dpi
+ dc := GetDC(0);
+ LogX := GetDeviceCaps(dc, LOGPIXELSX);
+ LogY := GetDeviceCaps(dc, LOGPIXELSY);
+ ReleaseDC(0, dc);
+ VLineScrollSize := MulDiv(LogY, 13, 96);
+
+{$IFDEF CUST_SB}
+ FVertScrollBar := TVertScrollBar.Create(Self, sbVertical);
+{$ENDIF}
+ VertScrollBar.Increment := VLineScrollSize;
+
+ FBorderStyle := bsSingle;
+
+ FHideSelection := False;
+ FGridNotFocused := True;
+
+ FSelectionString := '';
+ FSelectionStored := False;
+end;
+
+destructor THistoryGrid.Destroy;
+begin
+{$IFDEF CUST_SB}
+ FVertScrollBar.Free;
+{$ENDIF}
+{$IFDEF RENDER_RICH}
+ FRichInline.Free;
+ // it gets deleted autmagically because FRich.Owner = Self
+ // FRich.Free;
+ FRich := nil;
+ FRichCache.Free;
+{$ENDIF}
+ if Assigned(Options) then
+ Options.DeleteGrid(Self);
+ FCanvas := nil;
+ FClient.Free;
+ Finalize(FItems);
+ inherited;
+end;
+
+{ //!!
+ function THistoryGrid.IsHintStored: Boolean;
+ begin
+ Result := TntControl_IsHintStored(Self)
+ end;
+
+ function THistoryGrid.GetHint: String;
+ begin
+ Result := TntControl_GetHint(Self)
+ end;
+
+ procedure THistoryGrid.SetHint(const Value: String);
+ begin
+ TntControl_SetHint(Self, Value);
+ end;
+}
+procedure THistoryGrid.CMHintShow(var Message: TMessage);
+var
+ Item: Integer;
+ tempHint: WideString;
+ tempRect: TRect;
+begin
+ With TCMHintShow(Message).HintInfo^ do
+ begin
+ if ghtButton in HintHitTests then
+ begin
+ CursorRect := FHintRect;
+ if ghtBookmark in HintHitTests then
+ begin
+ Item := FindItemAt(CursorPos);
+ if FItems[Item].Bookmarked then
+ Hint := TranslateW('Remove Bookmark')
+ else
+ Hint := TranslateW('Set Bookmark')
+ end
+ else if ghtSessHideButton in HintHitTests then
+ Hint := TranslateW('Hide headers')
+ else if ghtSessShowButton in HintHitTests then
+ Hint := TranslateW('Show headers');
+ Message.Result := 0;
+ end
+ else if (ghtUnknown in HintHitTests) and GetHintAtPoint(CursorPos.X, CursorPos.Y, tempHint,
+ tempRect) then
+ begin
+ Hint := WideStringReplace(tempHint, '|', '¦', [rfReplaceAll]);
+ CursorRect := tempRect;
+ Message.Result := 0;
+ end
+ else
+ Message.Result := 1;
+ end;
+ // !! ProcessCMHintShowMsg(Message);
+ inherited;
+end;
+
+function THistoryGrid.GetBookmarked(Index: Integer): Boolean;
+begin
+ Result := Items[Index].Bookmarked;
+end;
+
+function THistoryGrid.GetBottomItem: Integer;
+begin
+ if Reversed then
+ Result := GetUp(-1)
+ else
+ Result := GetUp(Count);
+end;
+
+function THistoryGrid.GetCount: Integer;
+begin
+ Result := Length(FItems);
+end;
+
+procedure THistoryGrid.Allocate(ItemsCount: Integer; Scroll: Boolean = True);
+var
+ i: Integer;
+ PrevCount: Integer;
+begin
+ PrevCount := Length(FItems);
+ SetLength(FItems, ItemsCount);
+ for i := PrevCount to ItemsCount - 1 do
+ begin
+ FItems[i].Height := -1;
+ FItems[i].MessageType := [mtUnknown];
+ FRichCache.ResetItem(i);
+ end;
+{$IFDEF PAGE_SIZE}
+ VertScrollBar.Range := ItemsCount + FVertScrollBar.PageSize - 1;
+{$ELSE}
+ VertScrollBar.Range := ItemsCount + ClientHeight;
+{$ENDIF}
+ BarAdjusted := False;
+ Allocated := True;
+ // if ItemsCount > 0 then SetSBPos(GetIdx(0));
+ if Scroll then
+ begin
+ if Reversed xor ReversedHeader then
+ SetSBPos(GetIdx(GetBottomItem))
+ else
+ SetSBPos(GetIdx(GetTopItem));
+ end
+ else
+ AdjustScrollBar;
+ Invalidate;
+end;
+
+procedure THistoryGrid.LoadItem(Item: Integer; LoadHeight: Boolean = True; Reload: Boolean = False);
+begin
+ if Reload or IsUnknown(Item) then
+ if Assigned(FGetItemData) then
+ OnItemData(Self, Item, FItems[Item]);
+ if LoadHeight then
+ if FItems[Item].Height = -1 then
+ FItems[Item].Height := CalcItemHeight(Item);
+end;
+
+procedure THistoryGrid.Paint;
+var
+ TextRect, HeaderRect: TRect;
+ Ch, cw: Integer;
+ idx, cnt: Integer;
+ SumHeight: Integer;
+begin
+ if csDesigning in ComponentState then
+ exit;
+
+ if not Allocated then
+ begin
+ DrawMessage(TxtStartup);
+ exit;
+ end
+ else if ShowProgress then
+ begin
+ DrawProgress;
+ exit;
+ end;
+
+ cnt := Count;
+ if cnt = 0 then
+ begin
+ DrawMessage(TxtNoItems);
+ exit;
+ end;
+
+ idx := GetFirstVisible;
+ { REV
+ idx := GetNext(VertScrollBar.Position-1);
+ }
+ if idx = -1 then
+ begin
+ DrawMessage(TxtNoSuch);
+ exit;
+ end;
+
+ if WindowPrePainted then
+ begin
+ WindowPrePainted := False;
+ exit;
+ end;
+
+ SumHeight := -TopItemOffset;
+ Ch := ClientHeight;
+ cw := ClientWidth;
+
+ while (SumHeight < Ch) and (idx >= 0) and (idx < cnt) do
+ begin
+ LoadItem(idx);
+ TextRect := Bounds(0, SumHeight, cw, FItems[idx].Height);
+ if DoRectsIntersect(ClipRect, TextRect) then
+ begin
+ Canvas.Brush.Color := Options.ColorDivider;
+ Canvas.FillRect(TextRect);
+ if (FItems[idx].HasHeader) and (ShowHeaders) and (ExpandHeaders) then
+ begin
+ if Reversed xor ReversedHeader then
+ begin
+ HeaderRect := Rect(0, TextRect.Top, cw, TextRect.Top + SessHeaderHeight);
+ Inc(TextRect.Top, SessHeaderHeight);
+ end
+ else
+ begin
+ HeaderRect := Rect(0, TextRect.Bottom - SessHeaderHeight, cw, TextRect.Bottom);
+ Dec(TextRect.Bottom, SessHeaderHeight);
+ end;
+ PaintHeader(idx, HeaderRect);
+ end;
+ PaintItem(idx, TextRect);
+ end;
+ Inc(SumHeight, FItems[idx].Height);
+ idx := GetNext(idx);
+ if idx = -1 then
+ break;
+ end;
+ if SumHeight < Ch then
+ begin
+ TextRect := Rect(0, SumHeight, cw, Ch);
+ if DoRectsIntersect(ClipRect, TextRect) then
+ begin
+ Canvas.Brush.Color := Options.ColorBackground;
+ Canvas.FillRect(TextRect);
+ end;
+ end;
+end;
+
+procedure THistoryGrid.PaintHeader(Index: Integer; ItemRect: TRect);
+var
+ Text: String;
+ RTL: Boolean;
+ RIconOffset, IconOffset, IconTop: Integer;
+ TextOffset: Integer;
+ // ArrIcon: Integer;
+ // BackColor: TColor;
+ // TextFont: TFont;
+begin
+ RTL := GetItemRTL(Index);
+ // Options.GetItemOptions(FItems[Index].MessageType,textFont,BackColor);
+
+ if not(RTL = ((Canvas.TextFlags and ETO_RTLREADING) > 0)) then
+ begin
+ if RTL then
+ Canvas.TextFlags := Canvas.TextFlags or ETO_RTLREADING
+ else
+ Canvas.TextFlags := Canvas.TextFlags and not ETO_RTLREADING;
+ end;
+
+ // leave divider lines:
+ // Inc(ItemRect.Top);
+ Dec(ItemRect.Bottom, 1);
+
+ Canvas.Brush.Color := Options.ColorSessHeader;
+ Canvas.FillRect(ItemRect);
+
+ InflateRect(ItemRect, -3, -3);
+
+ IconOffset := 0;
+ RIconOffset := 0;
+ IconTop := ((ItemRect.Bottom - ItemRect.Top - 16) div 2);
+
+ if (ShowHeaders) and (FItems[Index].HasHeader) and (ExpandHeaders) then
+ begin
+ if RTL then
+ DrawIconEx(Canvas.Handle, ItemRect.Left, ItemRect.Top + IconTop,
+ hppIcons[HPP_ICON_SESS_HIDE].Handle, 16, 16, 0, 0, DI_NORMAL)
+ else
+ DrawIconEx(Canvas.Handle, ItemRect.Right - 16, ItemRect.Top + IconTop,
+ hppIcons[HPP_ICON_SESS_HIDE].Handle, 16, 16, 0, 0, DI_NORMAL);
+ Inc(RIconOffset, 16 + Padding);
+ end;
+
+ if hppIcons[HPP_ICON_SESS_DIVIDER].Handle <> 0 then
+ begin
+ if RTL then
+ DrawIconEx(Canvas.Handle, ItemRect.Right - 16 - IconOffset, ItemRect.Top + IconTop,
+ hppIcons[HPP_ICON_SESS_DIVIDER].Handle, 16, 16, 0, 0, DI_NORMAL)
+ else
+ DrawIconEx(Canvas.Handle, ItemRect.Left + IconOffset, ItemRect.Top + IconTop,
+ hppIcons[HPP_ICON_SESS_DIVIDER].Handle, 16, 16, 0, 0, DI_NORMAL);
+ Inc(IconOffset, 16 + Padding);
+ end;
+
+ Text := Format(TxtSessions, [GetTime(Items[Index].Time)]);
+ // Canvas.Font := Options.FontSessHeader;
+ Canvas.Font.Assign(Options.FontSessHeader);
+ Inc(ItemRect.Left, IconOffset);
+ Dec(ItemRect.Right, RIconOffset);
+ if RTL then
+ begin
+ TextOffset := Canvas.TextExtent(Text).cX;
+ Canvas.TextRect(ItemRect, ItemRect.Right - TextOffset, ItemRect.Top, Text);
+ end
+ else
+ Canvas.TextRect(ItemRect, ItemRect.Left, ItemRect.Top, Text);
+end;
+
+procedure THistoryGrid.SetBookmarked(Index: Integer; const Value: Boolean);
+var
+ r: TRect;
+begin
+ // don't set unknown items, we'll got correct bookmarks when we load them anyway
+ if IsUnknown(Index) then
+ exit;
+ if Bookmarked[Index] = Value then
+ exit;
+ FItems[Index].Bookmarked := Value;
+ if IsVisible(Index) then
+ begin
+ r := GetItemRect(Index);
+ InvalidateRect(Handle, @r, False);
+ Update;
+ end;
+end;
+
+procedure THistoryGrid.SetCodepage(const Value: Cardinal);
+begin
+ if FCodepage = Value then
+ exit;
+ FCodepage := Value;
+ ResetAllItems;
+end;
+
+procedure THistoryGrid.SetContact(const Value: THandle);
+begin
+ if FContact = Value then
+ exit;
+ FContact := Value;
+end;
+
+procedure THistoryGrid.SetExpandHeaders(const Value: Boolean);
+var
+ i: Integer;
+begin
+ if FExpandHeaders = Value then
+ exit;
+ FExpandHeaders := Value;
+ for i := 0 to Length(FItems) - 1 do
+ begin
+ if FItems[i].HasHeader then
+ begin
+ FItems[i].Height := -1;
+ FRichCache.ResetItem(i);
+ end;
+ end;
+ BarAdjusted := False;
+ AdjustScrollBar;
+ Invalidate;
+end;
+
+procedure THistoryGrid.SetGroupLinked(const Value: Boolean);
+var
+ i: Integer;
+begin
+ if FGroupLinked = Value then
+ exit;
+ FGroupLinked := Value;
+ for i := 0 to Length(FItems) - 1 do
+ begin
+ if FItems[i].LinkedToPrev then
+ begin
+ FItems[i].Height := -1;
+ FRichCache.ResetItem(i);
+ end;
+ end;
+ BarAdjusted := False;
+ AdjustScrollBar;
+ Invalidate;
+end;
+
+procedure THistoryGrid.SetProcessInline(const Value: Boolean);
+// var
+// cr: CHARRANGE;
+begin
+ if State = gsInline then
+ begin
+ FRichInline.Lines.BeginUpdate;
+ // FRichInline.Perform(EM_EXGETSEL,0,LPARAM(@cr));
+ ApplyItemToRich(Selected, FRichInline);
+ // FRichInline.Perform(EM_EXSETSEL,0,LPARAM(@cr));
+ // FRichInline.Perform(EM_SCROLLCARET, 0, 0);
+ FRichInline.SelStart := 0;
+ FRichInline.Lines.EndUpdate;
+ end;
+ if Assigned(FOnProcessInlineChange) then
+ FOnProcessInlineChange(Self, Value);
+end;
+
+procedure THistoryGrid.WMEraseBkgnd(var Message: TWMEraseBkgnd);
+begin
+ Message.Result := 1;
+end;
+
+procedure THistoryGrid.WMPaint(var Message: TWMPaint);
+var
+ ps: TagPaintStruct;
+ dc: HDC;
+begin
+ if (LockCount > 0) or (csDestroying in ComponentState) then
+ begin
+ Message.Result := 1;
+ exit;
+ end;
+ dc := BeginPaint(Handle, ps);
+ ClipRect := ps.rcPaint;
+ try
+ Paint;
+ BitBlt(dc, ClipRect.Left, ClipRect.Top, ClipRect.Right - ClipRect.Left,
+ ClipRect.Bottom - ClipRect.Top, Canvas.Handle, ClipRect.Left, ClipRect.Top, SRCCOPY);
+ finally
+ EndPaint(Handle, ps);
+ Message.Result := 0;
+ end;
+end;
+
+procedure THistoryGrid.WMSize(var Message: TWMSize);
+// var
+// re_mask: Longint;
+begin
+ BeginUpdate;
+ if not FRichParamsSet then
+ begin
+ FRichCache.SetHandles;
+ FRichParamsSet := True;
+ FRichInline.ParentWindow := Handle;
+ // re_mask := SendMessage(FRichInline.Handle,EM_GETEVENTMASK,0,0);
+ // SendMessage(FRichInline.Handle,EM_SETEVENTMASK,0,re_mask or ENM_LINK);
+ // SendMessage(FRichInline.Handle,EM_AUTOURLDETECT,1,0);
+ // SendMessage(FRichInline.Handle,EM_SETMARGINS,EC_LEFTMARGIN or EC_RIGHTMARGIN,0);
+ end;
+ // Update;
+ GridUpdate([guSize]);
+ EndUpdate;
+end;
+
+procedure THistoryGrid.SetPadding(Value: Integer);
+begin
+ if Value = FPadding then
+ exit;
+ FPadding := Value;
+end;
+
+procedure THistoryGrid.WMVScroll(var Message: TWMVScroll);
+var
+ r: TRect;
+ Item1, Item2, SBPos: Integer;
+ off, idx, first, ind: Integer;
+begin
+ CheckBusy;
+ if Message.ScrollCode = SB_ENDSCROLL then
+ begin
+ Message.Result := 0;
+ exit;
+ end;
+
+ BeginUpdate;
+ try
+
+ if Message.ScrollCode in [SB_LINEUP, SB_LINEDOWN, SB_PAGEDOWN, SB_PAGEUP] then
+ begin
+ Message.Result := 0;
+ case Message.ScrollCode of
+ SB_LINEDOWN:
+ ScrollGridBy(VLineScrollSize);
+ SB_LINEUP:
+ ScrollGridBy(-VLineScrollSize);
+ SB_PAGEDOWN:
+ ScrollGridBy(ClientHeight);
+ SB_PAGEUP:
+ ScrollGridBy(-ClientHeight);
+ end;
+ exit;
+ end;
+
+ idx := VertScrollBar.Position;
+ ind := idx;
+ first := GetFirstVisible;
+
+ // OXY: This code prevents thumb from staying "between" filtered items
+ // but it leads to thumb "jumping" after user finishes thumbtracking
+ // uncomment if this "stuck-in-between" seems to produce bug
+ { if Message.ScrollCode = SB_THUMBPOSITION then begin
+ Message.Pos := GetIdx(first);
+ VertScrollBar.ScrollMessage(Message);
+ exit;
+ end; }
+
+{$IFDEF CUST_SB}
+ if (Message.ScrollBar = 0) and FVertScrollBar.Visible then
+ FVertScrollBar.ScrollMessage(Message)
+ else
+ inherited;
+{$ELSE}
+ inherited;
+{$ENDIF}
+ SBPos := VertScrollBar.Position;
+ off := SBPos - idx;
+
+ // if (VertScrollBar.Position > MaxSBPos) and (off=0) then begin
+ // SetSBPos(VertScrollBar.Position);
+ // exit;
+ // end;
+ { if (off=0) and (VertScrollBar.Position > MaxSBPos) then begin
+ SetSBPos(VertScrollBar.Position);
+ Invalidate;
+ exit;
+ end; }
+
+ if not(VertScrollBar.Position > MaxSBPos) then
+ TopItemOffset := 0;
+ if off = 0 then
+ exit;
+ if off > 0 then
+ begin
+ idx := GetNext(GetIdx(VertScrollBar.Position - 1));
+ if (idx = first) and (idx <> -1) then
+ begin
+ idx := GetNext(idx);
+ if idx = -1 then
+ idx := first;
+ end;
+ if idx = -1 then
+ begin
+ idx := GetPrev(GetIdx(VertScrollBar.Position + 1));
+ if idx = -1 then
+ idx := ind;
+ end;
+ end;
+ if off < 0 then
+ begin
+ idx := GetPrev(GetIdx(VertScrollBar.Position + 1));
+ if (idx = first) and (idx <> -1) then
+ begin
+ idx := GetPrev(idx);
+ // if idx := -1 then idx := Count-1;
+ end;
+ if (idx <> first) and (idx <> -1) then
+ begin
+ first := idx;
+ idx := GetPrev(idx);
+ if idx <> -1 then
+ idx := first
+ else
+ idx := GetIdx(0);
+ end;
+ if idx = -1 then
+ begin
+ idx := GetNext(GetIdx(VertScrollBar.Position - 1));
+ if idx = -1 then
+ idx := ind;
+ end;
+ end;
+ { BUG HERE (not actually here, but..)
+ If you filter by (for example) files and you have several files
+ and large history, then when tracking throu files, you'll see
+ flicker, like constantly scrolling up & down by 1 event. That's
+ because when you scroll down by 1, this proc finds next event and
+ scrolls to it. But when you continue your move, your track
+ position becomes higher then current pos, and we search backwards,
+ and scroll to prev event. That's why flicker takes place. Need to
+ redesign some things to fix it }
+ // OXY 2006-03-05: THIS BUG FIXED!.!
+ // Now while thumbtracking we look if we are closer to next item
+ // than to original item. If we are closer, then scroll. If not, then
+ // don't change position and wait while user scrolls futher.
+ // With this we have ONE MORE bug: when user stops tracking,
+ // we leave thumb were it left, while we need to put it on the item
+
+ Item1 := GetIdx(first);
+ Item2 := GetIdx(idx);
+ if not(Message.ScrollCode in [SB_THUMBTRACK, SB_THUMBPOSITION]) then
+ SetSBPos(Item2)
+ else
+ begin
+ if (SBPos >= Item1) and (Item2 > MaxSBPos) then
+ SetSBPos(Item2)
+ else if Abs(Item1 - SBPos) > Abs(Item2 - SBPos) then
+ SetSBPos(Item2);
+ end;
+
+ AdjustScrollBar;
+
+ r := ClientRect;
+ InvalidateRect(Handle, @r, False);
+ finally
+ EndUpdate;
+ Update;
+ end;
+end;
+
+procedure THistoryGrid.PaintItem(Index: Integer; ItemRect: TRect);
+var
+ TimeStamp, HeaderName: String;
+ OrgRect, ItemClipRect: TRect;
+ TopIconOffset, IconOffset, TimeOffset: Integer;
+ // icon: TIcon;
+ BackColor: TColor;
+ nameFont, timestampFont, textFont: TFont;
+ Sel: Boolean;
+ RTL: Boolean;
+ FullHeader: Boolean;
+ RichBMP: TBitmap;
+ ic: HICON;
+ HeadRect: TRect;
+ dtf: Integer;
+ er: PEventRecord;
+begin
+ // leave divider line
+ Dec(ItemRect.Bottom);
+ OrgRect := ItemRect;
+
+ Sel := IsSelected(Index);
+ Options.GetItemOptions(FItems[Index].MessageType, textFont, BackColor);
+ if Sel then
+ BackColor := Options.ColorSelected;
+
+ IntersectRect(ItemClipRect, ItemRect, ClipRect);
+ Canvas.Brush.Color := BackColor;
+ Canvas.FillRect(ItemClipRect);
+
+ InflateRect(ItemRect, -Padding, -Padding);
+
+ FullHeader := not(FGroupLinked and FItems[Index].LinkedToPrev);
+ if FullHeader then
+ begin
+ HeadRect := ItemRect;
+ HeadRect.Top := HeadRect.Top - Padding + (Padding div 2);
+ if mtIncoming in FItems[Index].MessageType then
+ HeadRect.Bottom := HeadRect.Top + CHeaderHeight
+ else
+ HeadRect.Bottom := HeadRect.Top + PHeaderheight;
+ ItemRect.Top := HeadRect.Bottom + Padding - (Padding div 2);
+ end;
+
+ if FullHeader and DoRectsIntersect(HeadRect, ClipRect) then
+ begin
+{$IFDEF DEBUG}
+ OutputDebugString(PWideChar('Paint item header ' + intToStr(Index) + ' to screen'));
+{$ENDIF}
+ if mtIncoming in FItems[Index].MessageType then
+ begin
+ nameFont := Options.FontContact;
+ timestampFont := Options.FontIncomingTimestamp;
+ HeaderName := ContactName;
+ end
+ else
+ begin
+ nameFont := Options.FontProfile;
+ timestampFont := Options.FontOutgoingTimestamp;
+ HeaderName := ProfileName;
+ end;
+ if Assigned(FGetNameData) then
+ FGetNameData(Self, Index, HeaderName);
+ HeaderName := HeaderName + ':';
+ TimeStamp := GetTime(FItems[Index].Time);
+
+ RTL := GetItemRTL(Index);
+ if not(RTL = ((Canvas.TextFlags and ETO_RTLREADING) > 0)) then
+ begin
+ if RTL then
+ Canvas.TextFlags := Canvas.TextFlags or ETO_RTLREADING
+ else
+ Canvas.TextFlags := Canvas.TextFlags and not ETO_RTLREADING;
+ end;
+
+ TopIconOffset := ((HeadRect.Bottom - HeadRect.Top) - 16) div 2;
+ if (FItems[Index].HasHeader) and (ShowHeaders) and (not ExpandHeaders) then
+ begin
+ if RTL then
+ begin
+ DrawIconEx(Canvas.Handle, HeadRect.Right - 16, HeadRect.Top + TopIconOffset,
+ hppIcons[HPP_ICON_SESS_DIVIDER].Handle, 16, 16, 0, 0, DI_NORMAL);
+ Dec(HeadRect.Right, 16 + Padding);
+ end
+ else
+ begin
+ DrawIconEx(Canvas.Handle, HeadRect.Left, HeadRect.Top + TopIconOffset,
+ hppIcons[HPP_ICON_SESS_DIVIDER].Handle, 16, 16, 0, 0, DI_NORMAL);
+ Inc(HeadRect.Left, 16 + Padding);
+ end;
+ end;
+
+ if Options.ShowIcons then
+ begin
+ er := GetEventRecord(FItems[Index]);
+ if er.i = -1 then
+ ic := 0
+ else if er.iSkin = -1 then
+ ic := hppIcons[er.i].Handle
+ else
+ ic := skinIcons[er.i].Handle;
+ if ic <> 0 then
+ begin
+ // canvas. draw here can sometimes draw 32x32 icon (sic!)
+ if RTL then
+ begin
+ DrawIconEx(Canvas.Handle, HeadRect.Right - 16, HeadRect.Top + TopIconOffset, ic, 16,
+ 16, 0, 0, DI_NORMAL);
+ Dec(HeadRect.Right, 16 + Padding);
+ end
+ else
+ begin
+ DrawIconEx(Canvas.Handle, HeadRect.Left, HeadRect.Top + TopIconOffset, ic, 16, 16, 0,
+ 0, DI_NORMAL);
+ Inc(HeadRect.Left, 16 + Padding);
+ end;
+ end;
+ end;
+
+ // Canvas.Font := nameFont;
+ Canvas.Font.Assign(nameFont);
+ if Sel then
+ Canvas.Font.Color := Options.ColorSelectedText;
+ dtf := DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER;
+ if RTL then
+ dtf := dtf or DT_RTLREADING or DT_RIGHT
+ else
+ dtf := dtf or DT_LEFT;
+ DrawTextW(Canvas.Handle, PWideChar(HeaderName), Length(HeaderName), HeadRect, dtf);
+
+ // Canvas.Font := timestampFont;
+ Canvas.Font.Assign(timestampFont);
+ if Sel then
+ Canvas.Font.Color := Options.ColorSelectedText;
+ TimeOffset := Canvas.TextExtent(TimeStamp).cX;
+ dtf := DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER;
+ if RTL then
+ dtf := dtf or DT_RTLREADING or DT_LEFT
+ else
+ dtf := dtf or DT_RIGHT;
+ DrawTextW(Canvas.Handle, PWideChar(TimeStamp), Length(TimeStamp), HeadRect, dtf);
+
+ if ShowBookmarks and (Sel or FItems[Index].Bookmarked) then
+ begin
+ IconOffset := TimeOffset + Padding;
+ if FItems[Index].Bookmarked then
+ ic := hppIcons[HPP_ICON_BOOKMARK_ON].Handle
+ else
+ ic := hppIcons[HPP_ICON_BOOKMARK_OFF].Handle;
+ if RTL then
+ DrawIconEx(Canvas.Handle, HeadRect.Left + IconOffset, HeadRect.Top + TopIconOffset, ic,
+ 16, 16, 0, 0, DI_NORMAL)
+ else
+ DrawIconEx(Canvas.Handle, HeadRect.Right - IconOffset - 16,
+ HeadRect.Top + TopIconOffset, ic, 16, 16, 0, 0, DI_NORMAL);
+ end;
+ end;
+
+ if DoRectsIntersect(ItemRect, ClipRect) then
+ begin
+{$IFDEF DEBUG}
+ OutputDebugString(PWideChar('Paint item body ' + intToStr(Index) + ' to screen'));
+{$ENDIF}
+ ApplyItemToRich(Index);
+ RichBMP := FRichCache.GetItemRichBitmap(Index);
+ ItemClipRect := Bounds(ItemRect.Left, ItemRect.Top, RichBMP.Width, RichBMP.Height);
+ IntersectRect(ItemClipRect, ItemClipRect, ClipRect);
+ BitBlt(Canvas.Handle, ItemClipRect.Left, ItemClipRect.Top,
+ ItemClipRect.Right - ItemClipRect.Left, ItemClipRect.Bottom - ItemClipRect.Top,
+ RichBMP.Canvas.Handle, ItemClipRect.Left - ItemRect.Left,
+ ItemClipRect.Top - ItemRect.Top, SRCCOPY);
+ end;
+
+ // if (Focused or WindowPrePainting) and (Index = Selected) then begin
+ if (not FGridNotFocused or WindowPrePainting) and (Index = Selected) then
+ begin
+ DrawFocusRect(Canvas.Handle, OrgRect);
+ end;
+end;
+
+procedure THistoryGrid.PrePaintWindow;
+begin
+ ClipRect := Rect(0, 0, ClientWidth, ClientHeight);
+ WindowPrePainting := True;
+ Paint;
+ WindowPrePainting := False;
+ WindowPrePainted := True;
+end;
+
+procedure THistoryGrid.MakeSelected(Value: Integer);
+var
+ OldSelected: Integer;
+begin
+ OldSelected := FSelected;
+ FSelected := Value;
+ if Value <> -1 then
+ MakeVisible(FSelected);
+ if Assigned(FOnSelect) then
+ begin
+ if IsVisible(FSelected) then
+ FOnSelect(Self, FSelected, OldSelected)
+ else
+ FOnSelect(Self, -1, OldSelected);
+ end;
+ FSelectionStored := False;
+end;
+
+procedure THistoryGrid.SetSelected(const Value: Integer);
+begin
+ // if IsSelected(Value) then exit;
+ FRichCache.ResetItem(Value);
+ // FRichCache.ResetItem(FSelected);
+ FRichCache.ResetItems(FSelItems);
+ if Value <> -1 then
+ begin
+ SetLength(FSelItems, 1);
+ FSelItems[0] := Value;
+ end
+ else
+ SetLength(FSelItems, 0);
+ MakeSelected(Value);
+ Invalidate;
+ Update;
+end;
+
+procedure THistoryGrid.SetShowHeaders(const Value: Boolean);
+var
+ i: Integer;
+begin
+ if FShowHeaders = Value then
+ exit;
+ FShowHeaders := Value;
+ for i := 0 to Length(FItems) - 1 do
+ begin
+ if FItems[i].HasHeader then
+ begin
+ FItems[i].Height := -1;
+ FRichCache.ResetItem(i);
+ end;
+ end;
+ BarAdjusted := False;
+ AdjustScrollBar;
+ Invalidate;
+end;
+
+procedure THistoryGrid.AddSelected(Item: Integer);
+begin
+ if IsSelected(Item) then
+ exit;
+ if IsUnknown(Item) then
+ LoadItem(Item, False);
+ if not IsMatched(Item) then
+ exit;
+ IntSortedArray_Add(TIntArray(FSelItems), Item);
+ FRichCache.ResetItem(Item);
+end;
+
+function THistoryGrid.FindItemAt(X, Y: Integer; out ItemRect: TRect): Integer;
+var
+ SumHeight: Integer;
+ idx: Integer;
+begin
+ Result := -1;
+ ItemRect := Rect(0, 0, 0, 0);
+ if Count = 0 then
+ exit;
+
+ SumHeight := TopItemOffset;
+ if Y < 0 then
+ begin
+ idx := GetFirstVisible;
+ while idx >= 0 do
+ begin
+ if Y > -SumHeight then
+ begin
+ Result := idx;
+ break;
+ end;
+ idx := GetPrev(idx);
+ if idx = -1 then
+ break;
+ LoadItem(idx, True);
+ Inc(SumHeight, FItems[idx].Height);
+ end;
+ exit;
+ end;
+
+ idx := GetFirstVisible;
+
+ SumHeight := -TopItemOffset;
+ while (idx >= 0) and (idx < Length(FItems)) do
+ begin
+ LoadItem(idx, True);
+ if Y < SumHeight + FItems[idx].Height then
+ begin
+ Result := idx;
+ break;
+ end;
+ Inc(SumHeight, FItems[idx].Height);
+ idx := GetDown(idx);
+ if idx = -1 then
+ break;
+ end;
+ { FIX: 2004-08-20, can have AV here, how could I miss this line? }
+ if Result = -1 then
+ exit;
+ ItemRect := Rect(0, SumHeight, ClientWidth, SumHeight + FItems[Result].Height);
+end;
+
+function THistoryGrid.FindItemAt(P: TPoint; out ItemRect: TRect): Integer;
+begin
+ Result := FindItemAt(P.X, P.Y, ItemRect);
+end;
+
+function THistoryGrid.FindItemAt(P: TPoint): Integer;
+var
+ r: TRect;
+begin
+ Result := FindItemAt(P.X, P.Y, r);
+end;
+
+function THistoryGrid.FindItemAt(X, Y: Integer): Integer;
+var
+ r: TRect;
+begin
+ Result := FindItemAt(X, Y, r);
+end;
+
+function THistoryGrid.FormatItem(Item: Integer; Format: String): String;
+var
+ tok: TWideStrArray;
+ toksp: TIntArray;
+ i: Integer;
+begin
+ TokenizeString(Format, tok, toksp);
+ LoadItem(Item, False);
+ IntFormatItem(Item, tok, toksp);
+ Result := '';
+ for i := 0 to Length(tok) - 1 do
+ Result := Result + tok[i];
+end;
+
+function THistoryGrid.FormatItems(ItemList: array of Integer; Format: String): String;
+var
+ ifrom, ito, step, i, n: Integer;
+ linebreak: String;
+ tok2, tok: TWideStrArray;
+ toksp, tok_smartdt: TIntArray;
+ prevdt, dt: TDateTime;
+begin
+ // array of items MUST be a sorted list!
+
+ Result := '';
+ linebreak := #13#10;
+ TokenizeString(Format, tok, toksp);
+
+ // detect if we have smart_datetime in the tokens
+ // and cache them if we do
+ for n := 0 to Length(toksp) - 1 do
+ if tok[toksp[n]] = '%smart_datetime%' then
+ begin
+ SetLength(tok_smartdt, Length(tok_smartdt) + 1);
+ tok_smartdt[High(tok_smartdt)] := toksp[n];
+ end;
+ dt := 0;
+ prevdt := 0;
+
+ // start processing all items
+
+ // if Reversed then begin
+ // from older to newer, excluding external grid
+ if not ReversedHeader then
+ begin
+ ifrom := High(ItemList);
+ ito := 0;
+ step := -1;
+ end
+ else
+ begin
+ ifrom := 0;
+ ito := High(ItemList);
+ step := 1;
+ end;
+ i := ifrom;
+ while (i >= 0) and (i <= High(ItemList)) do
+ begin
+ LoadItem(ItemList[i], False);
+ if i = ito then
+ linebreak := ''; // do not put linebr after last item
+ tok2 := Copy(tok, 0, Length(tok));
+
+ // handle smart dates:
+ if Length(tok_smartdt) > 0 then
+ begin
+ dt := TimestampToDateTime(FItems[ItemList[i]].Time);
+ if prevdt <> 0 then
+ if Trunc(dt) = Trunc(prevdt) then
+ for n := 0 to Length(tok_smartdt) - 1 do
+ tok2[tok_smartdt[n]] := '%time%';
+ end; // end smart dates
+
+ IntFormatItem(ItemList[i], tok2, toksp);
+ for n := 0 to Length(tok2) - 1 do
+ Result := Result + tok2[n];
+ Result := Result + linebreak;
+ prevdt := dt;
+ Inc(i, step);
+ end;
+end;
+
+function THistoryGrid.FormatSelected(const Format: String): String;
+begin
+ if SelCount = 0 then
+ Result := ''
+ else
+ Result := FormatItems(FSelItems, Format);
+end;
+
+var
+ // WasDownOnGrid hack was introduced
+ // because I had the following problem: when I have
+ // history of contact A opened and have search results
+ // with messages from A, and if the history is behind the
+ // search results window, when I double click A's message
+ // I get hisory to the front with sometimes multiple messages
+ // selected because it 1) selects right message;
+ // 2) brings history window to front; 3) sends wm_mousemove message
+ // to grid saying that left button is pressed (???) and because
+ // of that shit grid thinks I'm selecting several items. So this
+ // var is used to know whether mouse button was down down on grid
+ // somewhere else
+ WasDownOnGrid: Boolean = False;
+
+procedure THistoryGrid.DoLButtonDown(X, Y: Integer; Keys: TMouseMoveKeys);
+var
+ Item: Integer;
+begin
+ WasDownOnGrid := True;
+ SearchPattern := '';
+ CheckBusy;
+ if Count = 0 then
+ exit;
+
+ DownHitTests := GetHitTests(X, Y);
+
+ // we'll hide/show session headers on button up, don't select item
+ if (ghtButton in DownHitTests) or (ghtLink in DownHitTests) then
+ exit;
+
+ Item := FindItemAt(X, Y);
+
+ if Item <> -1 then
+ begin
+ if (mmkControl in Keys) then
+ begin
+ if IsSelected(Item) then
+ RemoveSelected(Item)
+ else
+ AddSelected(Item);
+ MakeSelected(Item);
+ Invalidate;
+ end
+ else if (Selected <> -1) and (mmkShift in Keys) then
+ begin
+ MakeSelectedTo(Item);
+ MakeSelected(Item);
+ Invalidate;
+ end
+ else
+ Selected := Item;
+ end;
+end;
+
+function THistoryGrid.GetItemRect(Item: Integer): TRect;
+var
+ tmp, idx, SumHeight: Integer;
+ succ: Boolean;
+begin
+ Result := Rect(0, 0, 0, 0);
+ SumHeight := -TopItemOffset;
+ if Item = -1 then
+ exit;
+ if not IsMatched(Item) then
+ exit;
+ if GetIdx(Item) < GetIdx(GetFirstVisible) then
+ begin
+ idx := GetFirstVisible;
+ tmp := GetUp(idx);
+ if tmp <> -1 then
+ idx := tmp;
+ { .TODO: fix here, don't go up, go down from 0 }
+ if Reversed then
+ succ := (idx <= Item)
+ else
+ succ := (idx >= Item);
+ while succ do
+ begin
+ LoadItem(idx);
+ Inc(SumHeight, FItems[idx].Height);
+ idx := GetPrev(idx);
+ if idx = -1 then
+ break;
+ if Reversed then
+ succ := (idx <= Item)
+ else
+ succ := (idx >= Item);
+ end;
+ {
+ for i := VertScrollBar.Position-1 downto Item do begin
+ LoadItem(i);
+ Inc(SumHeight,FItems[i].Height);
+ end;
+ }
+ Result := Rect(0, -SumHeight, ClientWidth, -SumHeight + FItems[Item].Height);
+ exit;
+ end;
+
+ idx := GetFirstVisible; // GetIdx(VertScrollBar.Position);
+
+ while GetIdx(idx) < GetIdx(Item) do
+ begin
+ LoadItem(idx);
+ Inc(SumHeight, FItems[idx].Height);
+ idx := GetNext(idx);
+ if idx = -1 then
+ break;
+ end;
+
+ Result := Rect(0, SumHeight, ClientWidth, SumHeight + FItems[Item].Height);
+end;
+
+function THistoryGrid.GetItemRTL(Item: Integer): Boolean;
+begin
+ if FItems[Item].RTLMode = hppRTLDefault then
+ begin
+ if RTLMode = hppRTLDefault then
+ Result := Options.RTLEnabled
+ else
+ Result := (RTLMode = hppRTLEnable);
+ end
+ else
+ Result := (FItems[Item].RTLMode = hppRTLEnable)
+end;
+
+function THistoryGrid.IsSelected(Item: Integer): Boolean;
+begin
+ Result := False;
+ if FHideSelection and FGridNotFocused then
+ exit;
+ if Item = -1 then
+ exit;
+ Result := IntSortedArray_Find(TIntArray(FSelItems), Item) <> -1;
+end;
+
+function THistoryGrid.GetSelCount: Integer;
+begin
+ Result := Length(FSelItems);
+end;
+
+procedure THistoryGrid.WMLButtonDown(var Message: TWMLButtonDown);
+begin
+ inherited;
+ if FGridNotFocused then
+ Windows.SetFocus(Handle);
+ DoLButtonDown(Message.XPos, Message.YPos, TranslateKeys(Message.Keys));
+end;
+
+procedure THistoryGrid.WMLButtonUp(var Message: TWMLButtonUp);
+begin
+ inherited;
+ DoLButtonUp(Message.XPos, Message.YPos, TranslateKeys(Message.Keys));
+end;
+
+procedure THistoryGrid.WMMButtonDown(var Message: TWMMButtonDown);
+begin
+ inherited;
+ if FGridNotFocused then
+ Windows.SetFocus(Handle);
+ DoMButtonDown(Message.XPos, Message.YPos, TranslateKeys(Message.Keys));
+end;
+
+procedure THistoryGrid.WMMButtonUp(var Message: TWMMButtonUp);
+begin
+ inherited;
+ DoMButtonUp(Message.XPos, Message.YPos, TranslateKeys(Message.Keys));
+end;
+
+{$IFDEF RENDER_RICH}
+
+procedure THistoryGrid.ApplyItemToRich(Item: Integer; RichEdit: THPPRichEdit = nil; ForceInline: Boolean = False);
+var
+ reItemInline: Boolean;
+ reItemSelected: Boolean;
+ reItemUseFormat: Boolean;
+ reItemUseLinkColor: Boolean;
+ textFont: TFont;
+ textColor, BackColor: TColor;
+ RichItem: PRichItem;
+ RTF, Text: AnsiString;
+ cf, cf2: CharFormat2;
+begin
+ if RichEdit = nil then
+ begin
+ RichItem := FRichCache.RequestItem(Item);
+ FRich := RichItem^.Rich;
+ FRichHeight := RichItem^.Height;
+ exit;
+ end;
+
+ reItemInline := ForceInline or (RichEdit = FRichInline);
+ reItemSelected := (not reItemInline) and IsSelected(Item);
+ reItemUseFormat := not(reItemInline and (not Options.TextFormatting));
+ reItemUseLinkColor := not(Options.ColorLink = clBlue);
+
+ if not reItemInline then
+ FRich := RichEdit;
+
+ Options.GetItemOptions(FItems[Item].MessageType, textFont, BackColor);
+ if reItemSelected then
+ begin
+ textColor := Options.ColorSelectedText;
+ BackColor := Options.ColorSelected;
+ end
+ else
+ begin
+ textColor := textFont.Color;
+ BackColor := BackColor;
+ end;
+
+ // RichEdit.Perform(WM_SETTEXT,0,0);
+ RichEdit.Clear;
+
+ SetRichRTL(GetItemRTL(Item), RichEdit);
+ // for use with WM_COPY
+ RichEdit.Codepage := FItems[Item].Codepage;
+
+ if reItemUseFormat and Options.RawRTFEnabled and IsRTF(FItems[Item].Text) then
+ begin
+ // stored text seems to be RTF
+ RTF := WideToAnsiString(FItems[Item].Text, FItems[Item].Codepage) + #0
+ end
+ else
+ begin
+ RTF := '{\rtf1\ansi\deff0{\fonttbl ';
+ // RTF := Format('{\rtf1\ansi\ansicpg%u\deff0\deflang%u{\fonttbl ',[FItems[Item].Codepage,GetLCIDfromCodepage(CodePage)]);
+ RTF := RTF + Format('{\f0\fnil\fcharset%u %s}', [textFont.CharSet, textFont.Name]);
+ RTF := RTF + '}{\colortbl';
+ RTF := RTF + Format('\red%u\green%u\blue%u;', [textColor and $FF, (textColor shr 8) and $FF,
+ (textColor shr 16) and $FF]);
+ RTF := RTF + Format('\red%u\green%u\blue%u;', [BackColor and $FF, (BackColor shr 8) and $FF,
+ (BackColor shr 16) and $FF]);
+ // add color table for BBCodes
+ if Options.BBCodesEnabled then
+ begin
+ // link color ro [url][/url], [img][/img]
+ RTF := RTF + Format('\red%u\green%u\blue%u;', [Options.ColorLink and $FF,
+ (Options.ColorLink shr 8) and $FF, (Options.ColorLink shr 16) and $FF]);
+ if reItemUseFormat then
+ RTF := RTF + rtf_ctable_text;
+ end;
+ RTF := RTF + '}\li30\ri30\fi0\cf0';
+ if GetItemRTL(Item) then
+ RTF := RTF + '\rtlpar\ltrch\rtlch '
+ else
+ RTF := RTF + '\ltrpar\rtlch\ltrch ';
+ RTF := RTF + AnsiString(Format('\f0\b%d\i%d\ul%d\strike%d\fs%u',
+ [Integer(fsBold in textFont.Style), Integer(fsItalic in textFont.Style),
+ Integer(fsUnderline in textFont.Style), Integer(fsStrikeOut in textFont.Style),
+ Integer(textFont.Size shl 1)]));
+ Text := FormatString2RTF(FItems[Item].Text);
+ { if FGroupLinked and FItems[Item].LinkedToPrev then
+ Text := FormatString2RTF(GetTime(FItems[Item].Time)+': '+FItems[Item].Text) else
+ Text := FormatString2RTF(FItems[Item].Text); }
+ if Options.BBCodesEnabled and reItemUseFormat then
+ Text := DoSupportBBCodesRTF(Text, 3, not reItemSelected);
+ RTF := RTF + Text + '\par }';
+ end;
+
+ SetRichRTF(RichEdit.Handle, RTF, False, False, True);
+
+ (* smart date time in linked item
+ if FGroupLinked and FItems[Item].LinkedToPrev then begin
+ if mtIncoming in FItems[Item].MessageType then
+ textFont := Options.FontIncomingTimestamp
+ else
+ textFont := Options.FontOutgoingTimestamp;
+ if NoDefaultColors then
+ tsColor := textFont.Color
+ else
+ tsColor := Options.ColorSelectedText;
+ RTF := '{\rtf1\ansi\deff0{\fonttbl';
+ RTF := RTF + Format('{\f0\fnil\fcharset%u %s}',[textFont.Charset,textFont.Name]);
+ RTF := RTF + '}{\colortbl';
+ RTF := RTF + Format('\red%u\green%u\blue%u;',[tsColor and $FF,(tsColor shr 8) and $FF,(tsColor shr 16) and $FF]);
+ RTF := RTF + '}';
+ RTF := RTF + Format('\f0\b%d\i%d\ul%d\strike%d\fs%u',
+ [Integer(fsBold in textFont.Style),
+ Integer(fsItalic in textFont.Style),
+ Integer(fsUnderline in textFont.Style),
+ Integer(fsStrikeOut in textFont.Style),
+ Integer(textFont.Size shl 1)]);
+ Text := FormatString2RTF(GetTime(
+ FItems[Item].Time));
+ RTF := RTF + Text + '\par }'+#0;
+ SetRichRTF(RichEdit.Handle,RTF,True,False,True);
+ end;
+ *)
+
+ RichEdit.Perform(EM_SETBKGNDCOLOR, 0, BackColor);
+
+ if reItemUseFormat and Assigned(FOnProcessRichText) then
+ begin
+ try
+ FOnProcessRichText(Self, RichEdit.Handle, Item);
+ except
+ end;
+ if reItemUseLinkColor or reItemSelected or reItemInline then
+ begin
+ ZeroMemory(@cf, SizeOf(cf));
+ cf.cbSize := SizeOf(cf);
+ ZeroMemory(@cf2, SizeOf(cf2));
+ cf2.cbSize := SizeOf(cf2);
+ // do not allow change backcolor of selection
+ if reItemSelected then
+ begin
+ // change CFE_LINK to CFE_REVISED
+ cf.dwMask := CFM_LINK;
+ cf.dwEffects := CFE_LINK;
+ cf2.dwMask := CFM_LINK or CFM_REVISED;
+ cf2.dwEffects := CFE_REVISED;
+ RichEdit.ReplaceCharFormat(cf, cf2);
+ cf.dwMask := CFM_COLOR;
+ cf.crTextColor := textColor;
+ RichEdit.Perform(EM_SETBKGNDCOLOR, 0, BackColor);
+ RichEdit.Perform(EM_SETCHARFORMAT, SCF_ALL, lParam(@cf));
+ end
+ else if reItemInline then
+ begin
+ // change CFE_REVISED to CFE_LINK
+ cf.dwMask := CFM_REVISED;
+ cf.dwEffects := CFE_REVISED;
+ cf2.dwMask := CFM_LINK or CFM_REVISED;
+ cf2.dwEffects := CFM_LINK;
+ RichEdit.ReplaceCharFormat(cf, cf2);
+ end
+ else
+ begin
+ // change CFE_REVISED to CFE_LINK and its color
+ cf.dwMask := CFM_LINK;
+ cf.dwEffects := CFE_LINK;
+ cf2.dwMask := CFM_LINK or CFM_REVISED or CFM_COLOR;
+ cf2.dwEffects := CFE_REVISED;
+ cf2.crTextColor := Options.ColorLink;
+ RichEdit.ReplaceCharFormat(cf, cf2);
+ end;
+ end;
+ end;
+
+{$IFDEF DEBUG}
+ OutputDebugString(PWideChar('Applying item ' + intToStr(Item) + ' to rich'));
+{$ENDIF}
+end;
+{$ENDIF}
+
+procedure THistoryGrid.DoRButtonUp(X, Y: Integer; Keys: TMouseMoveKeys);
+var
+ Item: Integer;
+ ht: TGridHitTests;
+begin
+ SearchPattern := '';
+ CheckBusy;
+
+ Item := FindItemAt(X, Y);
+
+ ht := GetHitTests(X, Y);
+ if (ghtLink in ht) then
+ begin
+ URLClick(Item, GetLinkAtPoint(X, Y), mbRight);
+ exit;
+ end;
+
+ if Selected <> Item then
+ begin
+ if IsSelected(Item) then
+ begin
+ FSelected := Item;
+ MakeVisible(Item);
+ Invalidate;
+ end
+ else
+ begin
+ Selected := Item;
+ end;
+ end;
+
+ if Assigned(FOnPopup) then
+ OnPopup(Self);
+end;
+
+procedure THistoryGrid.DoLButtonUp(X, Y: Integer; Keys: TMouseMoveKeys);
+var
+ Item: Integer;
+ ht: TGridHitTests;
+begin
+ ht := GetHitTests(X, Y) * DownHitTests;
+ DownHitTests := [];
+ WasDownOnGrid := False;
+
+ if ((ghtSessHideButton in ht) or (ghtSessShowButton in ht)) then
+ begin
+ ExpandHeaders := (ghtSessShowButton in ht);
+ exit;
+ end;
+
+ if (ghtBookmark in ht) then
+ begin
+ if Assigned(FOnBookmarkClick) then
+ begin
+ Item := FindItemAt(X, Y);
+ FOnBookmarkClick(Self, Item);
+ end;
+ exit;
+ end;
+
+ if (ghtLink in ht) then
+ begin
+ Item := FindItemAt(X, Y);
+ URLClick(Item, GetLinkAtPoint(X, Y), mbLeft);
+ exit;
+ end;
+
+end;
+
+procedure THistoryGrid.DoMButtonDown(X, Y: Integer; Keys: TMouseMoveKeys);
+begin
+ WasDownOnGrid := True;
+ if Count = 0 then
+ exit;
+ DownHitTests := GetHitTests(X, Y);
+end;
+
+procedure THistoryGrid.DoMButtonUp(X, Y: Integer; Keys: TMouseMoveKeys);
+var
+ Item: Integer;
+ ht: TGridHitTests;
+begin
+ ht := GetHitTests(X, Y) * DownHitTests;
+ DownHitTests := [];
+ WasDownOnGrid := False;
+ if (ghtLink in ht) then
+ begin
+ Item := FindItemAt(X, Y);
+ URLClick(Item, GetLinkAtPoint(X, Y), mbMiddle);
+ exit;
+ end;
+end;
+
+procedure THistoryGrid.WMMouseMove(var Message: TWMMouseMove);
+begin
+ inherited;
+ if Focused then
+ DoMouseMove(Message.XPos, Message.YPos, TranslateKeys(Message.Keys))
+end;
+
+procedure THistoryGrid.DoMouseMove(X, Y: Integer; Keys: TMouseMoveKeys);
+var
+ Item: Integer;
+ SelectMove: Boolean;
+begin
+ CheckBusy;
+ if Count = 0 then
+ exit;
+
+ // do we need to process control here?
+ SelectMove := ((mmkLButton in Keys) and not((mmkControl in Keys) or (mmkShift in Keys))) and
+ (MultiSelect) and (WasDownOnGrid);
+ SelectMove := SelectMove and not((ghtButton in DownHitTests) or (ghtLink in DownHitTests));
+
+ if SelectMove then
+ begin
+ if SelCount = 0 then
+ exit;
+ Item := FindItemAt(X, Y);
+ if Item = -1 then
+ exit;
+ // do not do excessive relisting of items
+ if (not((FSelItems[0] = Item) or (FSelItems[High(FSelItems)] = Item))) or (FSelected <> Item)
+ then
+ begin
+ MakeSelectedTo(Item);
+ MakeSelected(Item);
+ Invalidate;
+ end;
+ end;
+end;
+
+procedure THistoryGrid.WMLButtonDblClick(var Message: TWMLButtonDblClk);
+begin
+ DoLButtonDblClick(Message.XPos, Message.YPos, TranslateKeys(Message.Keys));
+end;
+
+function THistoryGrid.CalcItemHeight(Item: Integer): Integer;
+var
+ hh, h: Integer;
+begin
+ Result := -1;
+ if IsUnknown(Item) then
+ exit;
+
+ ApplyItemToRich(Item);
+ Assert(FRichHeight > 0, 'CalcItemHeight: rich is still <= 0 height');
+ // rude hack, but what the fuck??? First item with rtl chars is 1 line heighted always
+ // probably fixed, see RichCache.ApplyItemToRich
+ if FRichHeight <= 0 then
+ exit
+ else
+ h := FRichHeight;
+
+ if FGroupLinked and FItems[Item].LinkedToPrev then
+ hh := 0
+ else if mtIncoming in FItems[Item].MessageType then
+ hh := CHeaderHeight
+ else
+ hh := PHeaderheight;
+
+ { If you change this, be sure to check out DoMouseMove,
+ DoLButtonDown, DoRButtonDown where I compute offset for
+ clicking & moving over invisible off-screen rich edit
+ control }
+ // compute height =
+ // 1 pix -- border
+ // 2*padding
+ // text height
+ // + HEADER_HEIGHT header
+ Result := 1 + 2 * Padding + h + hh;
+ if (FItems[Item].HasHeader) and (ShowHeaders) then
+ begin
+ if ExpandHeaders then
+ Inc(Result, SessHeaderHeight)
+ else
+ Inc(Result, 0);
+ end;
+end;
+
+procedure THistoryGrid.SetFilter(const Value: TMessageTypes);
+begin
+{$IFDEF DEBUG}
+ OutputDebugString('Filter');
+{$ENDIF}
+ if (Filter = Value) or (Value = []) or (Value = [mtUnknown]) then
+ exit;
+ FFilter := Value;
+ GridUpdate([guFilter]);
+ if Assigned(FOnFilterChange) then
+ FOnFilterChange(Self);
+ { CheckBusy;
+ SetLength(FSelItems,0);
+ FSelected := 0;
+ FFilter := Value;
+ ShowProgress := True;
+ State := gsLoad;
+ try
+ VertScrollBar.Range := Count-1+ClientHeight;
+ if Reversed then
+ Selected := GetPrev(-1)
+ else
+ Selected := GetNext(-1);
+ BarAdjusted := False;
+ AdjustScrollBar;
+ finally
+ State := gsIdle;
+ end;
+ Repaint; }
+end;
+
+procedure THistoryGrid.DrawMessage(Text: String);
+var
+ cr, r: TRect;
+begin
+ // Canvas.Font := Screen.MenuFont;
+ // Canvas.Brush.Color := clWindow;
+ // Canvas.Font.Color := clWindowText;
+ Canvas.Font := Options.FontMessage;
+ Canvas.Brush.Color := Options.ColorBackground;
+ r := ClientRect;
+ cr := ClientRect;
+ Canvas.FillRect(r);
+ // make multiline support
+ // DrawText(Canvas.Handle,PAnsiChar(Text),Length(Text),
+ // r,DT_CENTER or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE);
+ DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), r, DT_NOPREFIX or DT_CENTER or
+ DT_CALCRECT);
+ OffsetRect(r, ((cr.Right - cr.Left) - (r.Right - r.Left)) div 2,
+ ((cr.Bottom - cr.Top) - (r.Bottom - r.Top)) div 2);
+ DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), r, DT_NOPREFIX or DT_CENTER);
+end;
+
+procedure THistoryGrid.WMKeyDown(var Message: TWMKeyDown);
+begin
+ DoKeyDown(Message.CharCode, KeyDataToShiftState(Message.KeyData));
+ inherited;
+end;
+
+procedure THistoryGrid.WMKeyUp(var Message: TWMKeyUp);
+begin
+ DoKeyUp(Message.CharCode, KeyDataToShiftState(Message.KeyData));
+ inherited;
+end;
+
+procedure THistoryGrid.WMSysKeyUp(var Message: TWMSysKeyUp);
+begin
+ DoKeyUp(Message.CharCode, KeyDataToShiftState(Message.KeyData));
+ inherited;
+end;
+
+procedure THistoryGrid.DoKeyDown(var Key: Word; ShiftState: TShiftState);
+var
+ NextItem, Item: Integer;
+ r: TRect;
+begin
+ if Count = 0 then
+ exit;
+ if ssAlt in ShiftState then
+ exit;
+ CheckBusy;
+
+ Item := Selected;
+ if Item = -1 then
+ begin
+ if Reversed then
+ Item := GetPrev(-1)
+ else
+ Item := GetNext(-1);
+ end;
+
+ if (Key = VK_HOME) or ((ssCtrl in ShiftState) and (Key = VK_PRIOR)) then
+ begin
+ SearchPattern := '';
+ NextItem := GetNext(GetIdx(-1));
+ if (not(ssShift in ShiftState)) or (not MultiSelect) then
+ begin
+ Selected := NextItem;
+ end
+ else if NextItem <> -1 then
+ begin
+ MakeSelectedTo(NextItem);
+ MakeSelected(NextItem);
+ Invalidate;
+ end;
+ AdjustScrollBar;
+ Key := 0;
+ end
+ else if (Key = VK_END) or ((ssCtrl in ShiftState) and (Key = VK_NEXT)) then
+ begin
+ SearchPattern := '';
+ NextItem := GetPrev(GetIdx(Count));
+ if (not(ssShift in ShiftState)) or (not MultiSelect) then
+ begin
+ Selected := NextItem;
+ end
+ else if NextItem <> -1 then
+ begin
+ MakeSelectedTo(NextItem);
+ MakeSelected(NextItem);
+ Invalidate;
+ end;
+ AdjustScrollBar;
+ Key := 0;
+ end
+ else if Key = VK_NEXT then
+ begin // PAGE DOWN
+ SearchPattern := '';
+ NextItem := Item;
+ r := GetItemRect(NextItem);
+ NextItem := FindItemAt(0, r.Top + ClientHeight);
+ if NextItem = Item then
+ begin
+ NextItem := GetNext(NextItem);
+ if NextItem = -1 then
+ NextItem := Item;
+ end
+ else if NextItem = -1 then
+ begin
+ NextItem := GetPrev(GetIdx(Count));
+ if NextItem = -1 then
+ NextItem := Item;
+ end;
+ if (not(ssShift in ShiftState)) or (not MultiSelect) then
+ begin
+ Selected := NextItem;
+ end
+ else if NextItem <> -1 then
+ begin
+ MakeSelectedTo(NextItem);
+ MakeSelected(NextItem);
+ Invalidate;
+ end;
+ AdjustScrollBar;
+ Key := 0;
+ end
+ else if Key = VK_PRIOR then
+ begin // PAGE UP
+ SearchPattern := '';
+ NextItem := Item;
+ r := GetItemRect(NextItem);
+ NextItem := FindItemAt(0, r.Top - ClientHeight);
+ if NextItem <> -1 then
+ begin
+ if FItems[NextItem].Height < ClientHeight then
+ NextItem := GetNext(NextItem);
+ end
+ else
+ NextItem := GetNext(NextItem);
+ if NextItem = -1 then
+ begin
+ if IsMatched(GetIdx(0)) then
+ NextItem := GetIdx(0)
+ else
+ NextItem := GetNext(GetIdx(0));
+ end;
+ if (not(ssShift in ShiftState)) or (not MultiSelect) then
+ begin
+ Selected := NextItem;
+ end
+ else if NextItem <> -1 then
+ begin
+ MakeSelectedTo(NextItem);
+ MakeSelected(NextItem);
+ Invalidate;
+ end;
+ AdjustScrollBar;
+ Key := 0;
+ end
+ else if Key = VK_UP then
+ begin
+ if ssCtrl in ShiftState then
+ ScrollGridBy(-VLineScrollSize)
+ else
+ begin
+ SearchPattern := '';
+ if GetIdx(Item) > 0 then
+ Item := GetPrev(Item);
+ if Item = -1 then
+ exit;
+ if (ssShift in ShiftState) and (MultiSelect) then
+ begin
+ MakeSelectedTo(Item);
+ MakeSelected(Item);
+ Invalidate;
+ end
+ else
+ Selected := Item;
+ AdjustScrollBar;
+ end;
+ Key := 0;
+ end
+ else if Key = VK_DOWN then
+ begin
+ if ssCtrl in ShiftState then
+ ScrollGridBy(VLineScrollSize)
+ else
+ begin
+ SearchPattern := '';
+ if GetIdx(Item) < Count - 1 then
+ Item := GetNext(Item);
+ if Item = -1 then
+ exit;
+ if (ssShift in ShiftState) and (MultiSelect) then
+ begin
+ MakeSelectedTo(Item);
+ MakeSelected(Item);
+ Invalidate;
+ end
+ else
+ Selected := Item;
+ AdjustScrollBar;
+ end;
+ Key := 0;
+ end;
+
+end;
+
+procedure THistoryGrid.DoKeyUp(var Key: Word; ShiftState: TShiftState);
+begin
+ if Count = 0 then
+ exit;
+ if (ssAlt in ShiftState) or (ssCtrl in ShiftState) then
+ exit;
+ if (Key = VK_APPS) or ((Key = VK_F10) and (ssShift in ShiftState)) then
+ begin
+ CheckBusy;
+ if Selected = -1 then
+ begin
+ if Reversed then
+ Selected := GetPrev(-1)
+ else
+ Selected := GetNext(-1);
+ end;
+ if Assigned(FOnPopup) then
+ OnPopup(Self);
+ Key := 0;
+ end;
+end;
+
+procedure THistoryGrid.WMGetDlgCode(var Message: TWMGetDlgCode);
+type
+ PWMMsgKey = ^TWMMsgKey;
+
+ TWMMsgKey = packed record
+ hwnd: hwnd;
+ msg: Cardinal;
+ CharCode: Word;
+ Unused: Word;
+ KeyData: Longint;
+ Result: Longint;
+ end;
+
+begin
+ inherited;
+ Message.Result := DLGC_WANTALLKEYS;
+ if (TMessage(Message).lParam <> 0) then
+ begin
+ with PWMMsgKey(TMessage(Message).lParam)^ do
+ begin
+ if (msg = WM_KEYDOWN) or (msg = WM_CHAR) or (msg = WM_SYSCHAR) then
+ case CharCode of
+ VK_TAB:
+ Message.Result := DLGC_WANTARROWS;
+ end;
+ end;
+ end;
+ Message.Result := Message.Result or DLGC_HASSETSEL;
+end;
+
+function THistoryGrid.GetSelectionString: String;
+begin
+ if FSelectionStored then
+ begin
+ Result := FSelectionString;
+ exit;
+ end
+ else
+ Result := '';
+ if csDestroying in ComponentState then
+ exit;
+ if Count = 0 then
+ exit;
+ if State = gsInline then
+ Result := GetRichString(FRichInline.Handle, True)
+ else if Selected <> -1 then
+ begin
+ FSelectionString := FormatSelected(Options.SelectionFormat);
+ FSelectionStored := True;
+ Result := FSelectionString;
+ end;
+end;
+
+procedure THistoryGrid.EMGetSel(var Message: TMessage);
+var
+ M: TWMGetTextLength;
+begin
+ WMGetTextLength(M);
+ Puint_ptr(Message.wParam)^ := 0;
+ Puint_ptr(Message.lParam)^ := M.Result;
+end;
+
+procedure THistoryGrid.EMExGetSel(var Message: TMessage);
+var
+ M: TWMGetTextLength;
+begin
+ Message.wParam := 0;
+ if Message.lParam = 0 then
+ exit;
+ WMGetTextLength(M);
+ TCharRange(Pointer(Message.lParam)^).cpMin := 0;
+ TCharRange(Pointer(Message.lParam)^).cpMax := M.Result;
+end;
+
+procedure THistoryGrid.EMSetSel(var Message: TMessage);
+begin
+ FSelectionStored := False;
+ if csDestroying in ComponentState then
+ exit;
+ if Assigned(FOnSelectRequest) then
+ FOnSelectRequest(Self);
+end;
+
+procedure THistoryGrid.EMExSetSel(var Message: TMessage);
+begin
+ FSelectionStored := False;
+ if csDestroying in ComponentState then
+ exit;
+ if Assigned(FOnSelectRequest) then
+ FOnSelectRequest(Self);
+end;
+
+procedure THistoryGrid.WMGetText(var Message: TWMGetText);
+var
+ len: Integer;
+ str: String;
+begin
+ str := SelectionString;
+ len := Min(Message.TextMax - 1, Length(str));
+ if len >= 0 then { W }
+ StrLCopy(PChar(Message.Text), PChar(str), len);
+ Message.Result := len;
+end;
+
+procedure THistoryGrid.WMGetTextLength(var Message: TWMGetTextLength);
+var
+ str: String;
+begin
+ str := SelectionString;
+ Message.Result := Length(str);
+end;
+
+procedure THistoryGrid.WMSetText(var Message: TWMSetText);
+begin
+ // inherited;
+ FSelectionStored := False;
+end;
+
+procedure THistoryGrid.MakeRangeSelected(FromItem, ToItem: Integer);
+var
+ i: Integer;
+ StartItem, EndItem: Integer;
+ len: Integer;
+ Changed: TIntArray;
+begin
+ // detect start and end
+ if FromItem <= ToItem then
+ begin
+ StartItem := FromItem;
+ EndItem := ToItem;
+ end
+ else
+ begin
+ StartItem := ToItem;
+ EndItem := FromItem;
+ end;
+
+ // fill selected items list
+ len := 0;
+ for i := StartItem to EndItem do
+ begin
+ if IsUnknown(i) then
+ LoadItem(i, False);
+ if not IsMatched(i) then
+ continue;
+ Inc(len);
+ SetLength(TempSelItems, len);
+ TempSelItems[len - 1] := i;
+ end;
+
+ // determine and update changed items
+ Changed := IntSortedArray_NonIntersect(TIntArray(FSelItems), TIntArray(TempSelItems));
+ FRichCache.ResetItems(Changed);
+
+ // set selection
+ FSelItems := TempSelItems;
+end;
+
+procedure THistoryGrid.SelectRange(FromItem, ToItem: Integer);
+begin
+ if (FromItem = -1) or (ToItem = -1) then
+ exit;
+ MakeRangeSelected(FromItem, ToItem);
+ if SelCount = 0 then
+ MakeSelected(-1)
+ else
+ MakeSelected(FSelItems[0]);
+ Invalidate;
+end;
+
+procedure THistoryGrid.SelectAll;
+begin
+ if Count = 0 then
+ exit;
+ MakeRangeSelected(0, Count - 1);
+ if SelCount = 0 then
+ MakeSelected(-1)
+ else
+ MakeSelected(FSelected);
+ Invalidate;
+end;
+
+procedure THistoryGrid.MakeSelectedTo(Item: Integer);
+var
+ first: Integer;
+begin
+ if (FSelected = -1) or (Item = -1) then
+ exit;
+ if FSelItems[0] = FSelected then
+ first := FSelItems[High(FSelItems)]
+ else if FSelItems[High(FSelItems)] = FSelected then
+ first := FSelItems[0]
+ else
+ first := FSelected;
+ MakeRangeSelected(first, Item);
+end;
+
+procedure THistoryGrid.MakeTopmost(Item: Integer);
+begin
+ if (Item < 0) or (Item >= Count) then
+ exit;
+ SetSBPos(GetIdx(Item));
+end;
+
+procedure THistoryGrid.MakeVisible(Item: Integer);
+var
+ first: Integer;
+ SumHeight: Integer;
+ BottomAlign: Boolean;
+begin
+ BottomAlign := ShowBottomAligned and Reversed;
+ ShowBottomAligned := False;
+ if Item = -1 then
+ exit;
+ // load it to make positioning correct
+ LoadItem(Item, True);
+ if not IsMatched(Item) then
+ exit;
+ first := GetFirstVisible;
+ if Item = first then
+ begin
+ if FItems[Item].Height > ClientHeight then
+ begin
+ if BottomAlign or (TopItemOffset > FItems[Item].Height - ClientHeight) then
+ begin
+ TopItemOffset := FItems[Item].Height - ClientHeight;
+ end;
+ ScrollGridBy(0, False);
+ end
+ else
+ ScrollGridBy(-TopItemOffset, False);
+ end
+ else if GetIdx(Item) < GetIdx(first) then
+ SetSBPos(GetIdx(Item))
+ else
+ begin
+ // if IsVisible(Item) then exit;
+ if IsVisible(Item, False) then
+ exit;
+ SumHeight := 0;
+ first := Item;
+ while (Item >= 0) and (Item < Count) do
+ begin
+ LoadItem(Item, True);
+ if (SumHeight + FItems[Item].Height) >= ClientHeight then
+ break;
+ Inc(SumHeight, FItems[Item].Height);
+ Item := GetUp(Item);
+ end;
+ if GetIdx(Item) >= MaxSBPos then
+ begin
+ SetSBPos(GetIdx(Item) + 1);
+ // strange, but if last message is bigger then client,
+ // it always scrolls to down, but grid thinks, that it's
+ // aligned to top (when entering inline mode, for ex.)
+ if Item = first then
+ TopItemOffset := 0;
+ end
+ else
+ begin
+ SetSBPos(GetIdx(Item));
+ if Item <> first then
+ TopItemOffset := (SumHeight + FItems[Item].Height) - ClientHeight;
+ end;
+ end;
+end;
+
+procedure THistoryGrid.DoRButtonDown(X, Y: Integer; Keys: TMouseMoveKeys);
+begin;
+end;
+
+procedure THistoryGrid.WMRButtonDown(var Message: TWMRButtonDown);
+begin
+ inherited;
+ if FGridNotFocused then
+ Windows.SetFocus(Handle);
+ DoRButtonDown(Message.XPos, Message.YPos, TranslateKeys(Message.Keys));
+end;
+
+procedure THistoryGrid.WMRButtonUp(var Message: TWMRButtonDown);
+begin
+ inherited;
+ DoRButtonUp(Message.XPos, Message.YPos, TranslateKeys(Message.Keys));
+end;
+
+procedure THistoryGrid.BeginUpdate;
+begin
+ Inc(LockCount);
+end;
+
+procedure THistoryGrid.EndUpdate;
+begin
+ if LockCount > 0 then
+ Dec(LockCount);
+ if LockCount > 0 then
+ exit;
+ try
+ if guSize in GridUpdates then
+ GridUpdateSize;
+ if guOptions in GridUpdates then
+ DoOptionsChanged;
+ if guFilter in GridUpdates then
+ UpdateFilter;
+ finally
+ GridUpdates := [];
+ end;
+end;
+
+procedure THistoryGrid.GridUpdate(Updates: TGridUpdates);
+begin
+ BeginUpdate;
+ GridUpdates := GridUpdates + Updates;
+ EndUpdate;
+end;
+
+function THistoryGrid.GetTime(Time: DWord): String;
+begin
+ if Assigned(FTranslateTime) then
+ OnTranslateTime(Self, Time, Result)
+ else
+ Result := '';
+end;
+
+function THistoryGrid.GetTopItem: Integer;
+begin
+ if Reversed then
+ Result := GetDown(Count)
+ else
+ Result := GetDown(-1);
+end;
+
+function THistoryGrid.GetUp(Item: Integer): Integer;
+begin
+ Result := GetPrev(Item, False);
+end;
+
+procedure THistoryGrid.GridUpdateSize;
+var
+ w, h: Integer;
+ NewClient: TBitmap;
+ i: Integer;
+ WidthWasUpdated: Boolean;
+begin
+ if State = gsInline then
+ CancelInline;
+
+ w := ClientWidth;
+ h := ClientHeight;
+ WidthWasUpdated := (FClient.Width <> w);
+
+ // avatars!.!
+ // FRichCache.Width := ClientWidth - 3*FPadding - 64;
+ FRichCache.Width := ClientWidth - 2 * FPadding;
+
+ if (w <> 0) and (h <> 0) then
+ begin
+ NewClient := TBitmap.Create;
+ NewClient.Width := w;
+ NewClient.Height := h;
+ NewClient.Canvas.Font.Assign(Canvas.Font);
+ NewClient.Canvas.TextFlags := Canvas.TextFlags;
+
+ FClient.Free;
+ FClient := NewClient;
+ FCanvas := FClient.Canvas;
+ end;
+
+ IsCanvasClean := False;
+
+ if WidthWasUpdated then
+ for i := 0 to Count - 1 do
+ FItems[i].Height := -1;
+
+ BarAdjusted := False;
+ if Allocated then
+ AdjustScrollBar;
+end;
+
+function THistoryGrid.GetDown(Item: Integer): Integer;
+begin
+ Result := GetNext(Item, False);
+end;
+
+function THistoryGrid.GetItems(Index: Integer): THistoryItem;
+begin
+ if (Index < 0) or (Index > High(FItems)) then
+ exit;
+ if IsUnknown(Index) then
+ LoadItem(Index, False);
+ Result := FItems[Index];
+end;
+
+// Call this function to get the link url at given point in grid
+// Call it when you are sure that the point has a link,
+// if no link at a point, the result is ''
+// To know if there's a link, use GetHitTests and look for ghtLink
+function THistoryGrid.GetLinkAtPoint(X, Y: Integer): String;
+var
+ P: TPoint;
+ cr: CHARRANGE;
+ cf: CharFormat2;
+ res: DWord;
+ RichEditRect: TRect;
+ cp, Max, Item: Integer;
+begin
+ Result := '';
+ Item := FindItemAt(X, Y);
+ if Item = -1 then
+ exit;
+ RichEditRect := GetRichEditRect(Item, True);
+
+ P := Point(X - RichEditRect.Left, Y - RichEditRect.Top);
+ ApplyItemToRich(Item);
+
+ cp := FRich.Perform(EM_CHARFROMPOS, 0, lParam(@P));
+ if cp = -1 then
+ exit; // out of richedit area
+ cr.cpMin := cp;
+ cr.cpMax := cp + 1;
+ FRich.Perform(EM_EXSETSEL, 0, lParam(@cr));
+
+ ZeroMemory(@cf, SizeOf(cf));
+ cf.cbSize := SizeOf(cf);
+ cf.dwMask := CFM_LINK or CFM_REVISED;
+ res := FRich.Perform(EM_GETCHARFORMAT, SCF_SELECTION, lParam(@cf));
+ // no link under point
+ if (((res and CFM_LINK) = 0) or ((cf.dwEffects and CFE_LINK) = 0)) and
+ (((res and CFM_REVISED) = 0) or ((cf.dwEffects and CFE_REVISED) = 0)) then
+ exit;
+
+ while cr.cpMin > 0 do
+ begin
+ Dec(cr.cpMin);
+ FRich.Perform(EM_EXSETSEL, 0, lParam(@cr));
+ cf.cbSize := SizeOf(cf);
+ cf.dwMask := CFM_LINK or CFM_REVISED;
+ res := FRich.Perform(EM_GETCHARFORMAT, SCF_SELECTION, lParam(@cf));
+ if (((res and CFM_LINK) = 0) or ((cf.dwEffects and CFE_LINK) = 0)) and
+ (((res and CFM_REVISED) = 0) or ((cf.dwEffects and CFE_REVISED) = 0)) then
+ begin
+ Inc(cr.cpMin);
+ break;
+ end;
+ end;
+
+ Max := FRich.GetTextLength;
+ while cr.cpMax < Max do
+ begin
+ Inc(cr.cpMax);
+ FRich.Perform(EM_EXSETSEL, 0, lParam(@cr));
+ cf.cbSize := SizeOf(cf);
+ cf.dwMask := CFM_LINK or CFM_REVISED;
+ res := FRich.Perform(EM_GETCHARFORMAT, SCF_SELECTION, lParam(@cf));
+ if (((res and CFM_LINK) = 0) or ((cf.dwEffects and CFE_LINK) = 0)) and
+ (((res and CFM_REVISED) = 0) or ((cf.dwEffects and CFE_REVISED) = 0)) then
+ begin
+ Dec(cr.cpMax);
+ break;
+ end;
+ end;
+
+ Result := FRich.GetTextRange(cr.cpMin, cr.cpMax);
+
+ if (Length(Result) > 10) and (Pos('HYPERLINK', Result) = 1) then
+ begin
+ cr.cpMin := PosEx('"', Result, 10);
+ if cr.cpMin > 0 then
+ Inc(cr.cpMin)
+ else
+ exit;
+ cr.cpMax := PosEx('"', Result, cr.cpMin);
+ if cr.cpMin = 0 then
+ exit;
+ Result := Copy(Result, cr.cpMin, cr.cpMax - cr.cpMin);
+ end;
+
+end;
+
+function THistoryGrid.GetHintAtPoint(X, Y: Integer; var ObjectHint: WideString; var ObjectRect: TRect): Boolean;
+var
+ P: TPoint;
+ RichEditRect: TRect;
+ cp, Item: Integer;
+ textDoc: ITextDocument;
+ textRange: ITextRange;
+ iObject: IUnknown;
+ iTooltipCtrl: ITooltipData;
+ Size: TPoint;
+
+begin
+ ObjectHint := '';
+ Result := False;
+
+ Item := FindItemAt(X, Y);
+ if Item = -1 then
+ exit;
+ RichEditRect := GetRichEditRect(Item, True);
+ P := Point(X - RichEditRect.Left, Y - RichEditRect.Top);
+ ApplyItemToRich(Item);
+
+ if FRich.Version < 30 then
+ exit; // TOM is supported from RE 3.0
+ if not Assigned(FRich.RichEditOle) then
+ exit;
+
+ repeat
+ if FRich.RichEditOle.QueryInterface(IID_ITextDocument, textDoc) <> S_OK then
+ break;
+ P := FRich.ClientToScreen(P);
+ textRange := textDoc.RangeFromPoint(P.X, P.Y);
+ if not Assigned(textRange) then
+ break;
+ iObject := textRange.GetEmbeddedObject;
+ if not Assigned(iObject) then
+ begin
+ cp := textRange.Start;
+ textRange.Start := cp - 1;
+ textRange.End_ := cp;
+ iObject := textRange.GetEmbeddedObject;
+ end;
+ if not Assigned(iObject) then
+ break;
+
+ if iObject.QueryInterface(IID_ITooltipData, iTooltipCtrl) = S_OK then
+ OleCheck(iTooltipCtrl.GetTooltip(ObjectHint))
+ else if Supports(iObject, IID_IGifSmileyCtrl) then ObjectHint := TranslateW('Running version of AniSmiley is not supported')
+ else if Supports(iObject, IID_ISmileyAddSmiley) then ObjectHint := TranslateW('Running version of SmileyAdd is not supported')
+ else if Supports(iObject, IID_IEmoticonsImage) then ObjectHint := TranslateW('Running version of Emoticons is not supported')
+ else
+ break;
+ if ObjectHint = '' then
+ break;
+
+ textRange.GetPoint(tomStart + TA_TOP + TA_LEFT, Size.X, Size.Y);
+ Size := FRich.ScreenToClient(Size);
+ ObjectRect.TopLeft := Size;
+
+ textRange.GetPoint(tomStart + TA_BOTTOM + TA_RIGHT, Size.X, Size.Y);
+ Size := FRich.ScreenToClient(Size);
+ ObjectRect.BottomRight := Size;
+
+ OffsetRect(ObjectRect, RichEditRect.Left, RichEditRect.Top);
+ InflateRect(ObjectRect, 1, 1);
+
+ Result := PtInRect(ObjectRect, Point(X, Y));
+ until True;
+
+ if not Result then
+ ObjectHint := '';
+
+ ReleaseObject(iTooltipCtrl);
+ ReleaseObject(iObject);
+ ReleaseObject(textRange);
+ ReleaseObject(textDoc);
+end;
+
+const
+ Substs: array [0 .. 3] of array [0 .. 1] of String = (('\n', #13#10),
+ ('\t', #9), ('\\', '\'), ('\%', '%'));
+
+procedure THistoryGrid.IntFormatItem(Item: Integer; var Tokens: TWideStrArray;
+ var SpecialTokens: TIntArray);
+var
+ i, n: Integer;
+ tok: TWideStrArray;
+ toksp: TIntArray;
+ subst: String;
+ from_nick, to_nick, nick: String;
+ dt: TDateTime;
+ Mes, selmes: String;
+begin
+ // item MUST be loaded before calling IntFormatItem!
+
+ tok := Tokens;
+ toksp := SpecialTokens;
+
+ for i := 0 to Length(toksp) - 1 do
+ begin
+ subst := '';
+ if tok[toksp[i]][1] = '\' then
+ begin
+ for n := 0 to Length(Substs) - 1 do
+ if tok[toksp[i]] = Substs[n][0] then
+ begin
+ subst := Substs[n][1];
+ break;
+ end;
+ end
+ else
+ begin
+ Mes := FItems[Item].Text;
+ if Options.RawRTFEnabled and IsRTF(Mes) then
+ begin
+ ApplyItemToRich(Item);
+ Mes := GetRichString(FRich.Handle, False);
+ end;
+ if State = gsInline then
+ selmes := GetRichString(FRichInline.Handle, True)
+ else
+ selmes := Mes;
+ if mtIncoming in FItems[Item].MessageType then
+ begin
+ from_nick := ContactName;
+ to_nick := ProfileName;
+ end
+ else
+ begin
+ from_nick := ProfileName;
+ to_nick := ContactName;
+ end;
+ nick := from_nick;
+ if Assigned(FGetNameData) then
+ FGetNameData(Self, Item, nick);
+ dt := TimestampToDateTime(FItems[Item].Time);
+ // we are doing many if's here, because I don't want to pre-compose all the
+ // possible tokens into array. That's because some tokens take some time to
+ // be generated, and if they're not used, this time would be wasted.
+ if tok[toksp[i]] = '%mes%' then
+ subst := Mes
+ else if tok[toksp[i]] = '%adj_mes%' then
+ subst := WrapText(Mes, #13#10, [' ', #9, '-'], 72)
+ else if tok[toksp[i]] = '%quot_mes%' then
+ begin
+ subst := WideStringReplace('» ' + Mes, #13#10, #13#10 + '» ', [rfReplaceAll]);
+ subst := WrapText(subst, #13#10 + '» ', [' ', #9, '-'], 70)
+ end
+ else if tok[toksp[i]] = '%selmes%' then
+ subst := selmes
+ else if tok[toksp[i]] = '%adj_selmes%' then
+ subst := WrapText(selmes, #13#10, [' ', #9, '-'], 72)
+ else if tok[toksp[i]] = '%quot_selmes%' then
+ begin
+ subst := WideStringReplace('» ' + selmes, #13#10, #13#10 + '» ', [rfReplaceAll]);
+ subst := WrapText(subst, #13#10 + '» ', [' ', #9, '-'], 70)
+ end
+ else if tok[toksp[i]] = '%nick%' then
+ subst := nick
+ else if tok[toksp[i]] = '%from_nick%' then
+ subst := from_nick
+ else if tok[toksp[i]] = '%to_nick%' then
+ subst := to_nick
+ else if tok[toksp[i]] = '%datetime%' then
+ subst := DateTimeToStr(dt)
+ else if tok[toksp[i]] = '%smart_datetime%' then
+ subst := DateTimeToStr(dt)
+ else if tok[toksp[i]] = '%date%' then
+ subst := DateToStr(dt)
+ else if tok[toksp[i]] = '%time%' then
+ subst := TimeToStr(dt);
+ end;
+ tok[toksp[i]] := subst;
+ end;
+end;
+
+function THistoryGrid.IsMatched(Index: Integer): Boolean;
+var
+ mts: TMessageTypes;
+begin
+ mts := FItems[Index].MessageType;
+ Result := ((MessageTypesToDWord(FFilter) and MessageTypesToDWord(mts)) >=
+ MessageTypesToDWord(mts));
+ if Assigned(FOnItemFilter) then
+ FOnItemFilter(Self, Index, Result);
+end;
+
+function THistoryGrid.IsUnknown(Index: Integer): Boolean;
+begin
+ Result := (mtUnknown in FItems[Index].MessageType);
+end;
+
+function THistoryGrid.GetItemInline: Integer;
+begin
+ if State = gsInline then
+ Result := FItemInline
+ else
+ Result := -1;
+end;
+
+procedure THistoryGrid.AdjustInlineRichedit;
+var
+ r: TRect;
+begin
+ if (ItemInline = -1) or (ItemInline > Count) then
+ exit;
+ r := GetRichEditRect(ItemInline);
+ if IsRectEmpty(r) then
+ exit;
+ // variant 1: move richedit around
+ // variant 2: adjust TopItemOffset
+ // variant 3: made logic changes in adjust toolbar to respect TopItemOffset
+ // FRichInline.Top := r.top;
+ Inc(TopItemOffset, r.Top - FRichInline.Top);
+end;
+
+procedure THistoryGrid.AdjustScrollBar;
+var
+ maxidx, SumHeight, ind, idx: Integer;
+ R1, R2: TRect;
+begin
+ if BarAdjusted then
+ exit;
+ MaxSBPos := -1;
+ if Count = 0 then
+ begin
+ VertScrollBar.Range := 0;
+ exit;
+ end;
+ SumHeight := 0;
+ idx := GetFirstVisible;
+
+ if idx >= 0 then
+ repeat
+ LoadItem(idx);
+ if IsMatched(idx) then
+ Inc(SumHeight, FItems[idx].Height);
+ idx := GetDown(idx);
+ until ((SumHeight > ClientHeight) or (idx < 0) or (idx >= Length(FItems)));
+
+ maxidx := idx;
+ // see if the idx is the last
+ if maxidx <> -1 then
+ if GetDown(maxidx) = -1 then
+ maxidx := -1;
+
+ // if we are at the end, look up to find first visible
+ if (maxidx = -1) and (SumHeight > 0) then
+ begin
+ SumHeight := 0;
+ maxidx := GetIdx(Length(FItems));
+ // idx := 0;
+ repeat
+ idx := GetUp(maxidx);
+ if idx = -1 then
+ break;
+ maxidx := idx;
+ LoadItem(maxidx, True);
+ if IsMatched(maxidx) then
+ Inc(SumHeight, FItems[maxidx].Height);
+ until ((SumHeight >= ClientHeight) or (maxidx < 0) or (maxidx >= Length(FItems)));
+ BarAdjusted := True;
+ VertScrollBar.Visible := (idx <> -1);
+{$IFDEF PAGE_SIZE}
+ VertScrollBar.Range := GetIdx(maxidx) + VertScrollBar.PageSize - 1 + 1;
+{$ELSE}
+ VertScrollBar.Range := GetIdx(maxidx) + ClientHeight + 1;
+{$ENDIF}
+ MaxSBPos := GetIdx(maxidx);
+ // if VertScrollBar.Position > MaxSBPos then
+ SetSBPos(VertScrollBar.Position);
+ AdjustInlineRichedit;
+ exit;
+ end;
+
+ if SumHeight = 0 then
+ begin
+ VertScrollBar.Range := 0;
+ exit;
+ end;
+
+ VertScrollBar.Visible := True;
+{$IFDEF PAGE_SIZE}
+ VertScrollBar.Range := Count + VertScrollBar.PageSize - 1;
+{$ELSE}
+ VertScrollBar.Range := Count + ClientHeight;
+{$ENDIF}
+ MaxSBPos := Count - 1;
+ exit;
+
+ if SumHeight < ClientHeight then
+ begin
+ idx := GetPrev(GetIdx(Count));
+ if idx = -1 then
+ Assert(False);
+ R1 := GetItemRect(idx);
+ idx := FindItemAt(0, R1.Bottom - ClientHeight);
+ if idx = -1 then
+ begin
+ idx := GetIdx(0);
+ end
+ else
+ begin
+ ind := idx;
+ R2 := GetItemRect(idx);
+ if R1.Bottom - R2.Top > ClientHeight then
+ begin
+ idx := GetNext(idx);
+ if idx = -1 then
+ idx := ind;
+ end;
+ end;
+ BarAdjusted := True;
+{$IFDEF PAGE_SIZE}
+ VertScrollBar.Range := GetIdx(idx) + VertScrollBar.PageSize - 1;
+{$ELSE}
+ VertScrollBar.Range := GetIdx(idx) + ClientHeight;
+{$ENDIF}
+ MaxSBPos := GetIdx(idx) - 1;
+ SetSBPos(VertScrollBar.Range);
+ end
+ else
+ begin
+{$IFDEF PAGE_SIZE}
+ VertScrollBar.Range := Count + VertScrollBar.PageSize - 1;
+{$ELSE}
+ VertScrollBar.Range := Count + ClientHeight;
+{$ENDIF}
+ MaxSBPos := Count - 1;
+ end;
+end;
+
+procedure THistoryGrid.CreateWindowHandle(const Params: TCreateParams);
+begin
+ // CreateUnicodeHandle(Self, Params, '');
+ inherited;
+end;
+
+procedure THistoryGrid.CreateParams(var Params: TCreateParams);
+const
+ BorderStyles: array [TBorderStyle] of DWord = (0, WS_BORDER);
+ ReadOnlys: array [Boolean] of DWord = (0, ES_READONLY);
+begin
+ inherited CreateParams(Params);
+ with Params do
+ begin
+ Style := dword(Style) or BorderStyles[FBorderStyle] or ReadOnlys[True];
+ if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
+ begin
+ Style := Style and not WS_BORDER;
+ ExStyle := ExStyle or WS_EX_CLIENTEDGE;
+ end;
+ with WindowClass do
+ // style := style or CS_HREDRAW or CS_VREDRAW or CS_BYTEALIGNCLIENT or CS_BYTEALIGNWINDOW;
+ Style := Style or CS_HREDRAW or CS_VREDRAW;
+ end;
+end;
+
+function THistoryGrid.GetNext(Item: Integer; Force: Boolean = False): Integer;
+var
+ Max: Integer;
+ WasLoaded: Boolean;
+begin
+ Result := -1;
+ { REV }
+ if not Force then
+ if Reversed then
+ begin
+ Result := GetPrev(Item, True);
+ exit;
+ end;
+ Inc(Item);
+ Max := Count - 1;
+ WasLoaded := False;
+ { AF 31.03.03 }
+ if Item < 0 then
+ Item := 0;
+ while (Item >= 0) and (Item < Count) do
+ begin
+ if ShowProgress then
+ WasLoaded := not IsUnknown(Item);
+ LoadItem(Item, False);
+ if (State = gsLoad) and ShowProgress and (not WasLoaded) then
+ DoProgress(Item, Max);
+ if IsMatched(Item) then
+ begin
+ Result := Item;
+ break;
+ end;
+ Inc(Item);
+ end;
+ if (State = gsLoad) and ShowProgress then
+ begin
+ ShowProgress := False;
+ DoProgress(0, 0);
+ end;
+end;
+
+function THistoryGrid.GetPrev(Item: Integer; Force: Boolean = False): Integer;
+begin
+ Result := -1;
+ if not Force then
+ if Reversed then
+ begin
+ Result := GetNext(Item, True);
+ exit;
+ end;
+ Dec(Item);
+ { AF 31.03.03 }
+ if Item >= Count then
+ Item := Count - 1;
+
+ while (Item < Count) and (Item >= 0) do
+ begin
+ LoadItem(Item, False);
+ if IsMatched(Item) then
+ begin
+ Result := Item;
+ break;
+ end;
+ Dec(Item);
+ end;
+end;
+
+procedure THistoryGrid.CNVScroll(var Message: TWMVScroll);
+begin;
+end;
+
+(*
+ Return is item is visible on client area
+ EVEN IF IT IS *PARTIALLY* VISIBLE
+*)
+function THistoryGrid.IsVisible(Item: Integer; Partially: Boolean = True): Boolean;
+var
+ idx, SumHeight: Integer;
+begin
+ Result := False;
+ if Item = -1 then
+ exit;
+ if GetIdx(Item) < GetIdx(GetFirstVisible) then
+ exit;
+ if not IsMatched(Item) then
+ exit;
+ SumHeight := -TopItemOffset;
+ idx := GetFirstVisible;
+ LoadItem(idx, True);
+ while (SumHeight < ClientHeight) and (Item <> -1) and (Item < Count) do
+ begin
+ if Item = idx then
+ begin
+ if Partially then
+ Result := True
+ else
+ Result := (SumHeight + FItems[idx].Height <= ClientHeight);
+ break;
+ end;
+ Inc(SumHeight, FItems[idx].Height);
+ idx := GetNext(idx);
+ if idx = -1 then
+ break;
+ LoadItem(idx, True);
+ end;
+end;
+
+procedure THistoryGrid.DoLButtonDblClick(X, Y: Integer; Keys: TMouseMoveKeys);
+var
+ Item: Integer;
+ ht: TGridHitTests;
+begin
+ SearchPattern := '';
+ CheckBusy;
+ ht := GetHitTests(X, Y);
+ if (ghtSessShowButton in ht) or (ghtSessHideButton in ht) or (ghtBookmark in ht) then
+ exit;
+ if ghtLink in ht then
+ begin
+ DownHitTests := ht;
+ DoLButtonUp(X, Y, Keys);
+ exit;
+ end;
+ Item := FindItemAt(X, Y);
+ if Item <> Selected then
+ begin
+ Selected := Item;
+ exit;
+ end;
+ if Assigned(OnDblClick) then
+ OnDblClick(Self);
+end;
+
+procedure THistoryGrid.DrawProgress;
+var
+ r: TRect;
+begin
+ r := ClientRect;
+ // Canvas.Brush.Color := clWindow;
+ // Canvas.Font.Color := clWindowText;
+ Canvas.Font := Options.FontMessage;
+ Canvas.Brush.Color := Options.ColorBackground;
+ Canvas.Pen.Color := Options.FontMessage.Color;
+ if not IsCanvasClean then
+ begin
+ Canvas.FillRect(r);
+ ProgressRect := r;
+ InflateRect(r, -30, -((ClientHeight - 17) div 2));
+ IsCanvasClean := True;
+ end
+ else
+ begin
+ InflateRect(r, -30, -((ClientHeight - 17) div 2));
+ ProgressRect := r;
+ end;
+ Canvas.FrameRect(r);
+ // Canvas.FillRect(r);
+ InflateRect(r, -1, -1);
+ // InflateRect(r,-30,-((ClientHeight - 15) div 2));
+ Canvas.Rectangle(r);
+ InflateRect(r, -2, -2);
+ // Canvas.Brush.Color := clHighlight;
+ // Canvas.Brush.Color := Options.ColorSelected;
+ Canvas.Brush.Color := Options.FontMessage.Color;
+ if ProgressPercent < 100 then
+ r.Right := r.Left + Round(((r.Right - r.Left) * ProgressPercent) / 100);
+ Canvas.FillRect(r);
+ // t := IntToStr(ProgressPercent)+'%';
+ // DrawTExt(Canvas.Handle,PAnsiChar(t),Length(t),
+ // r,DT_CENTER or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE);
+end;
+
+procedure THistoryGrid.DoProgress(Position, Max: Integer);
+var
+ dc: HDC;
+ newp: Byte;
+begin
+ if not ShowProgress then
+ begin
+ IsCanvasClean := False;
+ Invalidate;
+ // InvalidateRect(Handle,@ProgressRect,False);
+ ProgressPercent := 255;
+ exit;
+ end;
+
+ if Max = 0 then
+ exit;
+ newp := (Position * 100 div Max);
+ if newp = ProgressPercent then
+ exit;
+ ProgressPercent := newp;
+ if Position = 0 then
+ exit;
+
+ Paint;
+
+ dc := GetDC(Handle);
+
+ try
+ BitBlt(dc, ProgressRect.Left, ProgressRect.Top, ProgressRect.Right - ProgressRect.Left,
+ ProgressRect.Bottom - ProgressRect.Top, Canvas.Handle, ProgressRect.Left,
+ ProgressRect.Top, SRCCOPY);
+ finally
+ ReleaseDC(Handle, dc);
+ end;
+ Application.ProcessMessages;
+end;
+
+procedure THistoryGrid.WMSetCursor(var Message: TWMSetCursor);
+var
+ P: TPoint;
+ NewCursor: TCursor;
+begin
+ inherited;
+ if State <> gsIdle then
+ exit;
+ if Message.HitTest = SmallInt(HTERROR) then
+ exit;
+ NewCursor := crDefault;
+ P := ScreenToClient(Mouse.CursorPos);
+ HintHitTests := GetHitTests(P.X, P.Y);
+ if HintHitTests * [ghtButton, ghtLink] <> [] then
+ NewCursor := crHandPoint;
+ if Windows.GetCursor <> Screen.Cursors[NewCursor] then
+ begin
+ Windows.SetCursor(Screen.Cursors[NewCursor]);
+ Message.Result := 1;
+ end
+ else
+ Message.Result := 0;
+end;
+
+procedure THistoryGrid.WMSetFocus(var Message: TWMSetFocus);
+var
+ r: TRect;
+begin
+ if not((csDestroying in ComponentState) or IsChild(Handle, Message.FocusedWnd)) then
+ begin
+ CheckBusy;
+ if FHideSelection and FGridNotFocused then
+ begin
+ if SelCount > 0 then
+ begin
+ FRichCache.ResetItems(FSelItems);
+ Invalidate;
+ end;
+ end
+ else if (FSelected <> -1) and IsVisible(FSelected) then
+ begin
+ r := GetItemRect(Selected);
+ InvalidateRect(Handle, @r, False);
+ end;
+ end;
+ FGridNotFocused := False;
+ inherited;
+end;
+
+procedure THistoryGrid.WMKillFocus(var Message: TWMKillFocus);
+var
+ r: TRect;
+begin
+ if not((csDestroying in ComponentState) or IsChild(Handle, Message.FocusedWnd)) then
+ begin
+ if FHideSelection and not FGridNotFocused then
+ begin
+ if SelCount > 0 then
+ begin
+ FRichCache.ResetItems(FSelItems);
+ Invalidate;
+ end;
+ end
+ else if (FSelected <> -1) and IsVisible(FSelected) then
+ begin
+ r := GetItemRect(Selected);
+ InvalidateRect(Handle, @r, False);
+ end;
+ FGridNotFocused := True;
+ end;
+ inherited;
+end;
+
+procedure THistoryGrid.WMCommand(var Message: TWMCommand);
+begin
+ inherited;
+{$IFDEF RENDER_RICH}
+ if csDestroying in ComponentState then
+ exit;
+ if Message.Ctl = FRichInline.Handle then
+ begin
+ case Message.NotifyCode of
+ EN_SETFOCUS:
+ begin
+ if State <> gsInline then
+ begin
+ FGridNotFocused := False;
+ Windows.SetFocus(Handle);
+ FGridNotFocused := True;
+ PostMessage(Handle, WM_SETFOCUS, Handle, 0);
+ end;
+ end;
+ EN_KILLFOCUS:
+ begin
+ if State = gsInline then
+ begin
+ CancelInline(False);
+ PostMessage(Handle, WM_KILLFOCUS, Handle, 0);
+ end;
+ Message.Result := 0;
+ end;
+ end;
+ end;
+{$ENDIF}
+end;
+
+procedure THistoryGrid.WMNotify(var Message: TWMNotify);
+var
+ nmh: PFVCNDATA_NMHDR;
+ RichItem: PRichItem;
+ reRect, smRect: TRect;
+begin
+{$IFDEF RENDER_RICH}
+ if Message.nmhdr^.code = NM_FIREVIEWCHANGE then
+ begin
+ if csDestroying in ComponentState then
+ exit;
+ if Message.nmhdr^.hwndFrom = FRichInline.Handle then
+ exit;
+ nmh := PFVCNDATA_NMHDR(Message.nmhdr);
+ if (nmh.bEvent = FVCN_PREFIRE) and (nmh.bAction = FVCA_DRAW) then
+ begin
+ RichItem := FRichCache.GetItemByHandle(Message.nmhdr^.hwndFrom);
+ nmh.bAction := FVCA_NONE;
+ if Assigned(RichItem) then
+ begin
+ if RichItem.GridItem = -1 then
+ exit;
+ if not RichItem.BitmapDrawn then
+ exit;
+ if (LockCount > 0) or (RichItem.GridItem = FItemInline) or
+ (not IsVisible(RichItem^.GridItem)) then
+ begin
+ RichItem.BitmapDrawn := False;
+ exit;
+ end;
+ nmh.bAction := FVCA_SKIPDRAW;
+ if (State = gsIdle) or (State = gsInline) then
+ begin
+ reRect := GetRichEditRect(RichItem.GridItem, True);
+ smRect := nmh.rcRect;
+ OffsetRect(smRect, reRect.Left, reRect.Top);
+ ClipRect := Canvas.ClipRect;
+ if DoRectsIntersect(smRect, ClipRect) then
+ begin
+ nmh.bAction := FVCA_CUSTOMDRAW;
+ nmh.HDC := RichItem.Bitmap.Canvas.Handle;
+ nmh.clrBackground := RichItem.Bitmap.TransparentColor;
+ nmh.fTransparent := False;
+ nmh.lParam := FRichCache.LockItem(RichItem, smRect);
+ end;
+ end;
+ end;
+ end
+ else if (nmh.bEvent = FVCN_POSTFIRE) and (nmh.bAction = FVCA_CUSTOMDRAW) then
+ begin
+ smRect := FRichCache.UnlockItem(nmh.lParam);
+ IntersectRect(smRect, smRect, ClipRect);
+ if not IsRectEmpty(smRect) then
+ InvalidateRect(Handle, @smRect, False);
+ end
+ else if (nmh.bEvent = FVCN_GETINFO) and (nmh.bAction = FVCA_NONE) then
+ begin
+ RichItem := FRichCache.GetItemByHandle(Message.nmhdr^.hwndFrom);
+ if not Assigned(RichItem) then
+ exit;
+ if (RichItem.GridItem = -1) or (RichItem.GridItem = FItemInline) then
+ exit;
+ if not RichItem.BitmapDrawn then
+ exit;
+ // if (State = gsIdle) or (State = gsInline) then
+ nmh.bAction := FVCA_INFO;
+ nmh.rcRect := GetRichEditRect(RichItem.GridItem, True);
+ nmh.clrBackground := RichItem.Bitmap.TransparentColor;
+ nmh.fTransparent := False;
+ end;
+ end
+ else
+{$ENDIF}
+ inherited;
+end;
+
+procedure THistoryGrid.ScrollBy(DeltaX, DeltaY: Integer);
+begin
+ inherited;
+end;
+
+procedure THistoryGrid.ScrollGridBy(Offset: Integer; Update: Boolean = True);
+var
+ previdx, idx, first: Integer;
+ Pos, SumHeight: Integer;
+
+ function SmoothScrollWindow(hwnd: hwnd; XAmount, YAmount: Integer;
+ Rect, ClipRect: PRect): BOOL;
+ begin
+ Result := ScrollWindow(hwnd, XAmount, YAmount, Rect, ClipRect);
+ UpdateWindow(Handle);
+ end;
+
+begin
+ first := GetFirstVisible;
+ if first = -1 then
+ exit;
+ SumHeight := -TopItemOffset;
+ idx := first;
+
+ while (Offset > 0) do
+ begin
+ LoadItem(idx, True);
+ if SumHeight + FItems[idx].Height > Offset + ClientHeight then
+ break;
+ Inc(SumHeight, FItems[idx].Height);
+ idx := GetDown(idx);
+ if idx = -1 then
+ begin
+ // we scroll to the last item, let's SetSBPos do the job
+ SetSBPos(MaxSBPos + 1);
+ Repaint;
+ exit;
+ end;
+ end;
+
+ SumHeight := -TopItemOffset;
+ idx := first;
+ while (Offset > 0) and (idx <> -1) and (idx >= 0) and (idx < Count) do
+ begin
+ LoadItem(idx, True);
+ if SumHeight + FItems[idx].Height > Offset then
+ begin
+ Pos := GetIdx(idx);
+ VertScrollBar.Position := Pos;
+ TopItemOffset := Offset - SumHeight;
+ if Update then
+ SmoothScrollWindow(Handle, 0, -Offset, nil, nil);
+ break;
+ end;
+ Inc(SumHeight, FItems[idx].Height);
+ idx := GetDown(idx);
+ end;
+
+ SumHeight := -TopItemOffset;
+ while (Offset < 0) and (idx <> -1) and (idx >= 0) and (idx < Count) do
+ begin
+ previdx := idx;
+ idx := GetUp(idx);
+ if SumHeight <= Offset then
+ begin
+ if idx = -1 then
+ VertScrollBar.Position := 0
+ else
+ VertScrollBar.Position := GetIdx(previdx);
+ TopItemOffset := Offset - SumHeight;
+ if Update then
+ SmoothScrollWindow(Handle, 0, -Offset, nil, nil);
+ break;
+ end;
+ if idx = -1 then
+ begin
+ if previdx = first then
+ VertScrollBar.Position := 0
+ else
+ VertScrollBar.Position := GetIdx(previdx);
+ TopItemOffset := 0;
+ // to lazy to calculate proper offset
+ if Update then
+ Repaint;
+ break;
+ end;
+ LoadItem(idx, True);
+ Dec(SumHeight, FItems[idx].Height);
+ end;
+end;
+
+procedure THistoryGrid.ScrollToBottom;
+begin
+ if not BarAdjusted then
+ AdjustScrollBar;
+ SetSBPos(Count);
+end;
+
+procedure THistoryGrid.Delete(Item: Integer);
+var
+ NextItem, Temp, PrevSelCount: Integer;
+begin
+ if Item = -1 then
+ exit;
+ State := gsDelete;
+ NextItem := 0; // to avoid compiler warning
+ try
+ PrevSelCount := SelCount;
+ if Selected = Item then
+ begin
+ // NextItem := -1;
+ if Reversed then
+ NextItem := GetNext(Item)
+ else
+ NextItem := GetPrev(Item);
+ end;
+ DeleteItem(Item);
+ if Selected = Item then
+ begin
+ FSelected := -1;
+ if Reversed then
+ Temp := GetPrev(NextItem)
+ else
+ Temp := GetNext(NextItem);
+ if Temp <> -1 then
+ NextItem := Temp;
+ if PrevSelCount = 1 then
+ // rebuild FSelItems
+ Selected := NextItem
+ else if PrevSelCount > 1 then
+ begin
+ // don't rebuild, just change focus
+ FSelected := NextItem;
+ // check if we're out of SelItems
+ if FSelected > Math.Max(FSelItems[High(FSelItems)], FSelItems[Low(FSelItems)]) then
+ FSelected := Math.Max(FSelItems[High(FSelItems)], FSelItems[Low(FSelItems)]);
+ if FSelected < Math.Min(FSelItems[High(FSelItems)], FSelItems[Low(FSelItems)]) then
+ FSelected := Math.Min(FSelItems[High(FSelItems)], FSelItems[Low(FSelItems)]);
+ end;
+ end
+ else
+ begin
+ if SelCount > 0 then
+ begin
+ if Item <= FSelected then
+ Dec(FSelected);
+ end;
+ end;
+ BarAdjusted := False;
+ AdjustScrollBar;
+ Invalidate;
+ finally
+ State := gsIdle;
+ end;
+end;
+
+procedure THistoryGrid.DeleteAll;
+var
+ cur, Max: Integer;
+begin
+ State := gsDelete;
+ try
+ BarAdjusted := False;
+
+ FRichCache.ResetAllItems;
+ SetLength(FSelItems, 0);
+ FSelected := -1;
+
+ Max := Length(FItems) - 1;
+ // cur := 0;
+
+ ShowProgress := True;
+
+ for cur := 0 to Max do
+ begin
+ if Assigned(FItemDelete) then
+ FItemDelete(Self, -1);
+ DoProgress(cur, Max);
+ if cur = 0 then
+ Invalidate;
+ end;
+ SetLength(FItems, 0);
+
+ AdjustScrollBar;
+ ShowProgress := False;
+ DoProgress(0, 0);
+ Invalidate;
+ Update;
+ finally
+ State := gsIdle;
+ end;
+end;
+
+const
+ MIN_ITEMS_TO_SHOW_PROGRESS = 10;
+
+procedure THistoryGrid.DeleteSelected;
+var
+ NextItem: Integer;
+ Temp: Integer;
+ s, { e, } Max, cur: Integer;
+begin
+ if SelCount = 0 then
+ exit;
+
+ State := gsDelete;
+ try
+
+ Max := Length(FSelItems) - 1;
+ cur := 0;
+
+ s := Math.Min(FSelItems[0], FSelItems[High(FSelItems)]);
+ // e := Math.Max(FSelItems[0],FSelItems[High(FSelItems)]);
+
+ // nextitem := -1;
+
+ if Reversed then
+ NextItem := GetNext(s)
+ else
+ NextItem := GetPrev(s);
+
+ ShowProgress := (Length(FSelItems) >= MIN_ITEMS_TO_SHOW_PROGRESS);
+ while Length(FSelItems) <> 0 do
+ begin
+ DeleteItem(FSelItems[0]);
+ if ShowProgress then
+ DoProgress(cur, Max);
+ if (ShowProgress) and (cur = 0) then
+ Invalidate;
+ Inc(cur);
+ end;
+
+ BarAdjusted := False;
+ AdjustScrollBar;
+
+ if NextItem < 0 then
+ NextItem := -1;
+ FSelected := -1;
+ if Reversed then
+ Temp := GetPrev(NextItem)
+ else
+ Temp := GetNext(NextItem);
+ if Temp = -1 then
+ Selected := NextItem
+ else
+ Selected := Temp;
+
+ if ShowProgress then
+ begin
+ ShowProgress := False;
+ DoProgress(0, 0);
+ end
+ else
+ Invalidate;
+ Update;
+ finally
+ State := gsIdle;
+ end;
+end;
+
+function THistoryGrid.Search(Text: String; CaseSensitive: Boolean;
+ FromStart: Boolean = False; SearchAll: Boolean = False; FromNext: Boolean = False;
+ Down: Boolean = True): Integer;
+var
+ StartItem: Integer;
+ C, Item: Integer;
+begin
+ Result := -1;
+
+ if not CaseSensitive then
+ Text := WideUpperCase(Text);
+
+ if Selected = -1 then
+ begin
+ FromStart := True;
+ FromNext := False;
+ end;
+
+ if FromStart then
+ begin
+ if Down then
+ StartItem := GetTopItem
+ else
+ StartItem := GetBottomItem;
+ end
+ else if FromNext then
+ begin
+ if Down then
+ StartItem := GetNext(Selected)
+ else
+ StartItem := GetPrev(Selected);
+
+ if StartItem = -1 then
+ begin
+ StartItem := Selected;
+ end;
+ end
+ else
+ begin
+ StartItem := Selected;
+ if Selected = -1 then
+ StartItem := GetNext(-1, True);
+ end;
+
+ Item := StartItem;
+
+ C := Count;
+ CheckBusy;
+ State := gsSearch;
+ try
+ while (Item >= 0) and (Item < C) do
+ begin
+ if CaseSensitive then
+ begin
+ // need to strip bbcodes
+ if Pos(Text, FItems[Item].Text) <> 0 then
+ begin
+ Result := Item;
+ break;
+ end;
+ end
+ else
+ begin
+ // need to strip bbcodes
+ if Pos(Text, string(WideUpperCase(FItems[Item].Text))) <> 0 then
+ begin
+ Result := Item;
+ break;
+ end;
+ end;
+
+ if SearchAll then
+ Inc(Item)
+ else if Down then
+ Item := GetNext(Item)
+ else
+ Item := GetPrev(Item);
+
+ if Item <> -1 then
+ begin
+ // prevent GetNext from drawing progress
+ IsCanvasClean := True;
+ ShowProgress := True;
+ DoProgress(Item, C - 1);
+ ShowProgress := False;
+ end;
+ end;
+
+ ShowProgress := False;
+ DoProgress(0, 0);
+ finally
+ State := gsIdle;
+ end;
+end;
+
+procedure THistoryGrid.WMChar(var Message: TWMChar);
+var
+ Key: WideChar;
+begin
+ Key := WideChar(Message.CharCode); // GetWideCharFromWMCharMsg(Message);
+ DoChar(Key, KeyDataToShiftState(Message.KeyData));
+ Message.CharCode := Word(Key); // SetWideCharForWMCharMsg(Message,Key);
+ inherited;
+end;
+
+const
+ BT_BACKSPACE = #8;
+ // #9 -- TAB
+ // #13 -- ENTER
+ // #27 -- ESC
+ ForbiddenChars: array [0 .. 2] of WideChar = (#9, #13, #27);
+
+procedure THistoryGrid.DoChar(var Ch: WideChar; ShiftState: TShiftState);
+var
+ ForbiddenChar: Boolean;
+ i: Integer;
+begin
+ CheckBusy;
+ ForbiddenChar := ((ssAlt in ShiftState) or (ssCtrl in ShiftState));
+ i := 0;
+ While (not ForbiddenChar) and (i <= High(ForbiddenChars)) do
+ begin
+ ForbiddenChar := (Ch = ForbiddenChars[i]);
+ Inc(i);
+ end;
+ if ForbiddenChar then
+ exit;
+ if Assigned(FOnChar) then
+ FOnChar(Self, Ch, ShiftState);
+end;
+
+procedure THistoryGrid.AddItem;
+var
+ i: Integer;
+begin
+ SetLength(FItems, Count + 1);
+
+ FRichCache.WorkOutItemAdded(0);
+
+ // for i := Length(FItems)-1 downto 1 do
+ // FItems[i] := FItems[i-1];
+ Move(FItems[0], FItems[1], (Length(FItems) - 1) * SizeOf(FItems[0]));
+ FillChar(FItems[0], SizeOf(FItems[0]), 0);
+
+ FItems[0].MessageType := [mtUnknown];
+ FItems[0].Height := -1;
+ FItems[0].Text := '';
+ // change selected here
+ if Selected <> -1 then
+ Inc(FSelected);
+ // change inline edited item
+ if ItemInline <> -1 then
+ Inc(FItemInline);
+ for i := 0 to SelCount - 1 do
+ Inc(FSelItems[i]);
+ BarAdjusted := False;
+ AdjustScrollBar;
+ // or window in background isn't repainted. weired
+ // if IsVisible(0) then begin
+ Invalidate;
+ // end;
+end;
+
+procedure THistoryGrid.WMMouseWheel(var Message: TWMMouseWheel);
+var
+ Lines, code: Integer;
+ FWheelCurrTick: Cardinal;
+begin
+ if State = gsInline then
+ begin
+ with TMessage(Message) do
+ FRichInline.Perform(WM_MOUSEWHEEL, wParam, lParam);
+ exit;
+ end;
+ if (Cardinal(Message.WheelDelta) = WHEEL_PAGESCROLL) or (Mouse.WheelScrollLines < 0) then
+ begin
+ Lines := 1;
+ if Message.WheelDelta < 0 then
+ code := SB_PAGEDOWN
+ else
+ code := SB_PAGEUP;
+ end
+ else
+ begin
+ Lines := Mouse.WheelScrollLines;
+ if Message.WheelDelta < 0 then
+ code := SB_LINEDOWN
+ else
+ code := SB_LINEUP;
+ end;
+
+ // some kind of acceleraion. mb the right place is in WM_VSCROLL?
+ FWheelCurrTick := GetTickCount;
+ if FWheelCurrTick - FWheelLastTick < 10 then
+ begin
+ Lines := Lines shl 1;
+ end;
+ FWheelLastTick := FWheelCurrTick;
+
+ FWheelAccumulator := FWheelAccumulator + Message.WheelDelta * Lines;
+ while Abs(FWheelAccumulator) >= WHEEL_DELTA do
+ begin
+ FWheelAccumulator := Abs(FWheelAccumulator) - WHEEL_DELTA;
+ PostMessage(Self.Handle, WM_VSCROLL, code, 0);
+ end;
+end;
+
+procedure THistoryGrid.DeleteItem(Item: Integer);
+var
+ i: Integer;
+ SelIdx: Integer;
+begin
+ // find item pos in selected array if it is there
+ // and fix other positions becouse we have
+ // to decrease some after we delete the item
+ // from main array
+ SelIdx := -1;
+ FRichCache.WorkOutItemDeleted(Item);
+ for i := 0 to SelCount - 1 do
+ begin
+ if FSelItems[i] = Item then
+ SelIdx := i
+ else if FSelItems[i] > Item then
+ Dec(FSelItems[i]);
+ end;
+
+ // delete item from main array
+ // for i := Item to Length(FItems)-2 do
+ // FItems[i] := FItems[i+1];
+ if Item <> High(FItems) then
+ begin
+ Finalize(FItems[Item]);
+ Move(FItems[Item + 1], FItems[Item], (High(FItems) - Item) * SizeOf(FItems[0]));
+ FillChar(FItems[High(FItems)], SizeOf(FItems[0]), 0);
+ end;
+ SetLength(FItems, High(FItems));
+
+ // if it was in selected array delete there also
+ if SelIdx <> -1 then
+ begin
+ // for i := SelIdx to SelCount-2 do
+ // FSelItems[i] := FSelItems[i+1];
+ if SelIdx <> High(FSelItems) then
+ Move(FSelItems[SelIdx + 1], FSelItems[SelIdx], (High(FSelItems) - SelIdx) *
+ SizeOf(FSelItems[0]));
+ SetLength(FSelItems, High(FSelItems));
+ end;
+
+ // move/delete inline edited item
+ if ItemInline = Item then
+ FItemInline := -1
+ else if ItemInline > Item then
+ Dec(FItemInline);
+
+ // tell others they should clear up that item too
+ if Assigned(FItemDelete) then
+ FItemDelete(Self, Item);
+end;
+
+procedure THistoryGrid.SaveAll(FileName: String; SaveFormat: TSaveFormat);
+var
+ i: Integer;
+ fs: TFileStream;
+begin
+ if Count = 0 then
+ raise Exception.Create('History is empty, nothing to save');
+ State := gsSave;
+ try
+ fs := TFileStream.Create(FileName, fmCreate or fmShareExclusive);
+ SaveStart(fs, SaveFormat, TxtFullLog);
+ ShowProgress := True;
+ if ReversedHeader then
+ for i := 0 to SelCount - 1 do
+ begin
+ SaveItem(fs, FSelItems[i], SaveFormat);
+ DoProgress(i, Count - 1);
+ end
+ else
+ for i := Count - 1 downto 0 do
+ begin
+ SaveItem(fs, i, SaveFormat);
+ DoProgress(Count - 1 - i, Count - 1);
+ end;
+ SaveEnd(fs, SaveFormat);
+ fs.Free;
+ ShowProgress := False;
+ DoProgress(0, 0);
+ finally
+ State := gsIdle;
+ end;
+end;
+
+procedure THistoryGrid.SaveSelected(FileName: String; SaveFormat: TSaveFormat);
+var
+ fs: TFileStream;
+ i: Integer;
+begin
+ Assert((SelCount > 0), 'Save Selection is available when more than 1 item is selected');
+ State := gsSave;
+ try
+ fs := TFileStream.Create(FileName, fmCreate or fmShareExclusive);
+ SaveStart(fs, SaveFormat, TxtPartLog);
+ ShowProgress := True;
+ if (FSelItems[0] > FSelItems[High(FSelItems)]) xor ReversedHeader then
+ for i := 0 to SelCount - 1 do
+ begin
+ SaveItem(fs, FSelItems[i], SaveFormat);
+ DoProgress(i, SelCount);
+ end
+ else
+ for i := SelCount - 1 downto 0 do
+ begin
+ SaveItem(fs, FSelItems[i], SaveFormat);
+ DoProgress(SelCount - 1 - i, SelCount);
+ end;
+ SaveEnd(fs, SaveFormat);
+ fs.Free;
+ ShowProgress := False;
+ DoProgress(0, 0);
+ finally
+ State := gsIdle;
+ end;
+end;
+
+const
+ css = 'h3 { color: #666666; text-align: center; font-family: Verdana, Helvetica, Arial, sans-serif; font-size: 16pt; }'
+ + #13#10 +
+ 'h4 { text-align: center; font-family: Verdana, Helvetica, Arial, sans-serif; font-size: 14pt; }'
+ + #13#10 +
+ 'h6 { font-weight: normal; color: #000000; text-align: center; font-family: Verdana, Helvetica, Arial, sans-serif; font-size: 8pt; }'
+ + #13#10 +
+ '.mes { border-top-width: 1px; border-right-width: 0px; border-bottom-width: 0px;' +
+ 'border-left-width: 0px; border-top-style: solid; border-right-style: solid; border-bottom-style: solid; '
+ + 'border-left-style: solid; border-top-color: #666666; border-bottom-color: #666666; ' +
+ 'padding: 4px; }' + #13#10 + '.text { clear: both; }' + #13#10;
+
+ xml = '<?xml version="1.0" encoding="%s"?>' + #13#10 + '<!DOCTYPE IMHISTORY [' + #13#10 +
+ '<!ELEMENT IMHISTORY (EVENT*)>' + #13#10 +
+ '<!ELEMENT EVENT (CONTACT, FROM, TIME, DATE, PROTOCOL, ID?, TYPE, FILE?, URL?, MESSAGE?)>' +
+ #13#10 + '<!ELEMENT CONTACT (#PCDATA)>' + #13#10 + '<!ELEMENT FROM (#PCDATA)>' + #13#10 +
+ '<!ELEMENT TIME (#PCDATA)>' + #13#10 + '<!ELEMENT DATE (#PCDATA)>' + #13#10 +
+ '<!ELEMENT PROTOCOL (#PCDATA)>' + #13#10 + '<!ELEMENT ID (#PCDATA)>' + #13#10 +
+ '<!ELEMENT TYPE (#PCDATA)>' + #13#10 + '<!ELEMENT FILE (#PCDATA)>' + #13#10 +
+ '<!ELEMENT URL (#PCDATA)>' + #13#10 + '<!ELEMENT MESSAGE (#PCDATA)>' + #13#10 +
+ '<!ENTITY ME "%s">' + #13#10 + '%s' + '<!ENTITY UNK "UNKNOWN">' + #13#10 + ']>' + #13#10 +
+ '<IMHISTORY>' + #13#10;
+
+function ColorToCss(Color: TColor): AnsiString;
+var
+ first2, mid2, last2: AnsiString;
+begin
+ // Result := IntToHex(ColorToRGB(Color),6);
+ Result := IntToHex(Color, 6);
+ if Length(Result) > 6 then
+ SetLength(Result, 6);
+ // rotate for HTML color format from AA AB AC to AC AB AA
+ first2 := Copy(Result, 1, 2);
+ mid2 := Copy(Result, 3, 2);
+ last2 := Copy(Result, 5, 2);
+ Result := '#' + last2 + mid2 + first2;
+end;
+
+function FontToCss(Font: TFont): AnsiString;
+begin
+ Result := 'color: ' + ColorToCss(Font.Color) + '; font: '; // color
+ if fsItalic in Font.Style then // font-style
+ Result := Result + 'italic '
+ else
+ Result := Result + 'normal ';
+ Result := Result + 'normal '; // font-variant
+ if fsBold in Font.Style then // font-weight
+ Result := Result + 'bold '
+ else
+ Result := Result + 'normal ';
+ Result := Result + intToStr(Font.Size) + 'pt '; // font-size
+ Result := Result + 'normal '; // line-height
+ Result := Result + // font-family
+ Font.Name + ', Tahoma, Verdana, Arial, sans-serif; ';
+ Result := Result + 'text-decoration: none;'; // decoration
+end;
+
+procedure THistoryGrid.SaveStart(Stream: TFileStream; SaveFormat: TSaveFormat; Caption: String);
+var
+ ProfileID, ContactID, Proto: String;
+
+ procedure SaveHTML;
+ var
+ title, head1, head2: AnsiString;
+ i: Integer;
+ begin
+ title := UTF8Encode(WideFormat('%s [%s] - [%s]', [Caption, ProfileName, ContactName]));
+ head1 := UTF8Encode(WideFormat('%s', [Caption]));
+ head2 := UTF8Encode(WideFormat('%s (%s: %s) - %s (%s: %s)', [ProfileName, Proto, ProfileID,
+ ContactName, Proto, ContactID]));
+ WriteString(Stream, '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">'
+ + #13#10);
+ // if Options.RTLEnabled then WriteString(Stream,'<html dir="rtl">')
+ if (RTLMode = hppRTLEnable) or ((RTLMode = hppRTLDefault) and Options.RTLEnabled) then
+ WriteString(Stream, '<html dir="rtl">')
+ else
+ WriteString(Stream, '<html dir="ltr">');
+ WriteString(Stream, '<head>' + #13#10);
+ WriteString(Stream, '<meta http-equiv="Content-Type" content="text/html; charset=utf-8">'
+ + #13#10);
+ WriteString(Stream, '<title>' + MakeTextHtmled(title) + '</title>' + #13#10);
+ WriteString(Stream, '<style type="text/css"><!--' + #13#10);
+ WriteString(Stream, css);
+
+ // if Options.RTLEnabled then begin
+ if (RTLMode = hppRTLEnable) or ((RTLMode = hppRTLDefault) and Options.RTLEnabled) then
+ begin
+ WriteString(Stream, '.nick { float: right; }' + #13#10);
+ WriteString(Stream, '.date { float: left; clear: left; }' + #13#10);
+ end
+ else
+ begin
+ WriteString(Stream, '.nick { float: left; }' + #13#10);
+ WriteString(Stream, '.date { float: right; clear: right; }' + #13#10);
+ end;
+ WriteString(Stream, '.nick#inc { ' + FontToCss(Options.FontContact) + ' }' + #13#10);
+ WriteString(Stream, '.nick#out { ' + FontToCss(Options.FontProfile) + ' }' + #13#10);
+ WriteString(Stream, '.date#inc { ' + FontToCss(Options.FontIncomingTimestamp) + ' }'
+ + #13#10);
+ WriteString(Stream, '.date#out { ' + FontToCss(Options.FontOutgoingTimestamp) + ' }'
+ + #13#10);
+ WriteString(Stream, '.url { color: ' + ColorToCss(Options.ColorLink) + '; }' + #13#10);
+ for i := 0 to High(Options.ItemOptions) do
+ WriteString(Stream, AnsiString('.mes#event' + intToStr(i) + ' { background-color: ' +
+ ColorToCss(Options.ItemOptions[i].textColor) + '; ' + FontToCss(Options.ItemOptions[i].textFont) + ' }' + #13#10));
+ if ShowHeaders then
+ WriteString(Stream, '.mes#session { background-color: ' +
+ ColorToCss(Options.ColorSessHeader) + '; ' + FontToCss(Options.FontSessHeader) + ' }'
+ + #13#10);
+ WriteString(Stream, '--></style>' + #13#10 + '</head><body>' + #13#10);
+ WriteString(Stream, '<h4>' + MakeTextHtmled(head1) + '</h4>' + #13#10);
+ WriteString(Stream, '<h3>' + MakeTextHtmled(head2) + '</h3>' + #13#10);
+ end;
+
+ procedure SaveXML;
+ var
+ mt: TMessageType;
+ Messages, enc: String;
+ begin
+ // enc := 'windows-'+IntToStr(GetACP);
+ enc := 'utf-8';
+ Messages := '';
+ for mt := Low(EventRecords) to High(EventRecords) do
+ begin
+ if not(mt in EventsDirection + EventsExclude) then
+ Messages := Messages + Format('<!ENTITY %s "%s">' + #13#10,
+ [EventRecords[mt].xml, UTF8Encode(TranslateUnicodeString(EventRecords[mt].Name))
+ ] { TRANSLATE-IGNORE } );
+ end;
+ WriteString(Stream, AnsiString(Format(xml, [enc, UTF8Encode(ProfileName), Messages])));
+ end;
+
+ procedure SaveUnicode;
+ begin
+ WriteString(Stream, #255#254);
+ WriteWideString(Stream, '###'#13#10);
+ if Caption = '' then
+ Caption := TxtHistExport;
+ WriteWideString(Stream, WideFormat('### %s'#13#10, [Caption]));
+ WriteWideString(Stream, WideFormat('### %s (%s: %s) - %s (%s: %s)'#13#10,
+ [ProfileName, Proto, ProfileID, ContactName, Proto, ContactID]));
+ WriteWideString(Stream, TxtGenHist1 + #13#10);
+ WriteWideString(Stream, '###'#13#10#13#10);
+ end;
+
+ procedure SaveText;
+ begin
+ WriteString(Stream, '###'#13#10);
+ if Caption = '' then
+ Caption := TxtHistExport;
+ WriteString(Stream, WideToAnsiString(WideFormat('### %s'#13#10, [Caption]), Codepage));
+ WriteString(Stream, WideToAnsiString(WideFormat('### %s (%s: %s) - %s (%s: %s)'#13#10,
+ [ProfileName, Proto, ProfileID, ContactName, Proto, ContactID]), Codepage));
+ WriteString(Stream, WideToAnsiString(TxtGenHist1 + #13#10, Codepage));
+ WriteString(Stream, '###'#13#10#13#10);
+ end;
+
+ procedure SaveRTF;
+ begin
+ FRichSaveItem := THPPRichEdit.CreateParented(Handle);
+ FRichSave := THPPRichEdit.CreateParented(Handle);
+ FRichSaveOLECB := TRichEditOleCallback.Create(FRichSave);
+ FRichSave.Perform(EM_SETOLECALLBACK, 0,
+ lParam(TRichEditOleCallback(FRichSaveOLECB) as IRichEditOleCallback));
+ end;
+
+ procedure SaveMContacts;
+ begin
+ mcHeader.DataSize := 0;
+ Stream.Write(mcHeader, SizeOf(mcHeader))
+ end;
+
+begin
+ Proto := AnsiToWideString(Protocol, Codepage);
+ ProfileID := AnsiToWideString(GetContactID(0, Protocol, False), Codepage);
+ ContactID := AnsiToWideString(GetContactID(Contact, Protocol, True), Codepage);
+ case SaveFormat of
+ sfHTML:
+ SaveHTML;
+ sfXML:
+ SaveXML;
+ sfMContacts:
+ SaveMContacts;
+ sfRTF:
+ SaveRTF;
+ sfUnicode:
+ SaveUnicode;
+ sfText:
+ SaveText;
+ end;
+end;
+
+procedure THistoryGrid.SaveEnd(Stream: TFileStream; SaveFormat: TSaveFormat);
+
+ procedure SaveHTML;
+ begin
+ WriteString(Stream, '<div class=mes></div>' + #13#10);
+ WriteString(Stream, UTF8Encode(TxtGenHist2) + #13#10);
+ WriteString(Stream, '</body></html>');
+ end;
+
+ procedure SaveXML;
+ begin
+ WriteString(Stream, '</IMHISTORY>');
+ end;
+
+ procedure SaveUnicode;
+ begin;
+ end;
+
+ procedure SaveText;
+ begin;
+ end;
+
+ procedure SaveRTF;
+ begin
+ FRichSave.Lines.SaveToStream(Stream);
+ FRichSave.Perform(EM_SETOLECALLBACK, 0, 0);
+ FRichSave.Destroy;
+ FRichSaveItem.Destroy;
+ FRichSaveOLECB.Free;
+ end;
+
+ procedure SaveMContacts;
+ begin
+ Stream.Seek(SizeOf(mcHeader) - SizeOf(mcHeader.DataSize), soFromBeginning);
+ Stream.Write(mcHeader.DataSize, SizeOf(mcHeader.DataSize));
+ end;
+
+begin
+ case SaveFormat of
+ sfHTML: SaveHTML;
+ sfXML: SaveXML;
+ sfRTF: SaveRTF;
+ sfMContacts: SaveMContacts;
+ sfUnicode: SaveUnicode;
+ sfText: SaveText;
+ end;
+end;
+
+procedure THistoryGrid.SaveItem(Stream: TFileStream; Item: Integer; SaveFormat: TSaveFormat);
+
+ procedure MesTypeToStyle(mt: TMessageTypes; out mes_id, type_id: AnsiString);
+ var
+ i: Integer;
+ Found: Boolean;
+ begin
+ mes_id := 'unknown';
+ if mtIncoming in mt then
+ type_id := 'inc'
+ else
+ type_id := 'out';
+ i := 0;
+ Found := False;
+ while (not Found) and (i <= High(Options.ItemOptions)) do
+ if (MessageTypesToDWord(Options.ItemOptions[i].MessageType) and MessageTypesToDWord(mt))
+ >= MessageTypesToDWord(mt) then
+ Found := True
+ else
+ Inc(i);
+ mes_id := 'event' + intToStr(i);
+ end;
+
+ procedure SaveHTML;
+ var
+ mes_id, type_id: AnsiString;
+ nick, Mes, Time: String;
+ txt: AnsiString;
+ FullHeader: Boolean;
+ begin
+ MesTypeToStyle(FItems[Item].MessageType, mes_id, type_id);
+ FullHeader := not(FGroupLinked and FItems[Item].LinkedToPrev);
+ if FullHeader then
+ begin
+ Time := GetTime(Items[Item].Time);
+ if mtIncoming in FItems[Item].MessageType then
+ nick := ContactName
+ else
+ nick := ProfileName;
+ if Assigned(FGetNameData) then
+ FGetNameData(Self, Item, nick);
+ nick := nick + ':';
+ end;
+ Mes := FItems[Item].Text;
+ if Options.RawRTFEnabled and IsRTF(FItems[Item].Text) then
+ begin
+ ApplyItemToRich(Item);
+ Mes := GetRichString(FRich.Handle, False);
+ end;
+ txt := MakeTextHtmled(UTF8Encode(Mes));
+ try
+ txt := UrlHighlightHtml(txt);
+ except
+ end;
+ if Options.BBCodesEnabled then
+ begin
+ try
+ txt := DoSupportBBCodesHTML(txt);
+ except
+ end;
+ end;
+ if ShowHeaders and FItems[Item].HasHeader then
+ begin
+ WriteString(Stream, '<div class=mes id=session>' + #13#10);
+ WriteString(Stream, #9 + '<div class=text>' +
+ MakeTextHtmled(UTF8Encode(WideFormat(TxtSessions, [Time]))) + '</div>' + #13#10);
+ WriteString(Stream, '</div>' + #13#10);
+ end;
+ WriteString(Stream, '<div class=mes id=' + mes_id + '>' + #13#10);
+ if FullHeader then
+ begin
+ WriteString(Stream, #9 + '<div class=nick id=' + type_id + '>' +
+ MakeTextHtmled(UTF8Encode(nick)) + '</div>' + #13#10);
+ WriteString(Stream, #9 + '<div class=date id=' + type_id + '>' +
+ MakeTextHtmled(UTF8Encode(Time)) + '</div>' + #13#10);
+ end;
+ WriteString(Stream, #9 + '<div class=text>' + #13#10#9 + txt + #13#10#9 + '</div>'
+ + #13#10);
+ WriteString(Stream, '</div>' + #13#10);
+ end;
+
+ procedure SaveXML;
+ var
+ XmlItem: TXMLItem;
+ begin
+ if not Assigned(FGetXMLData) then
+ exit;
+ FGetXMLData(Self, Item, XmlItem);
+ WriteString(Stream, '<EVENT>' + #13#10);
+ WriteString(Stream, #9 + '<CONTACT>' + XmlItem.Contact + '</CONTACT>' + #13#10);
+ WriteString(Stream, #9 + '<FROM>' + XmlItem.From + '</FROM>' + #13#10);
+ WriteString(Stream, #9 + '<TIME>' + XmlItem.Time + '</TIME>' + #13#10);
+ WriteString(Stream, #9 + '<DATE>' + XmlItem.Date + '</DATE>' + #13#10);
+ WriteString(Stream, #9 + '<PROTOCOL>' + XmlItem.Protocol + '</PROTOCOL>' + #13#10);
+ WriteString(Stream, #9 + '<ID>' + XmlItem.ID + '</ID>' + #13#10);
+ WriteString(Stream, #9 + '<TYPE>' + XmlItem.EventType + '</TYPE>' + #13#10);
+ if XmlItem.Mes <> '' then
+ WriteString(Stream, #9 + '<MESSAGE>' + XmlItem.Mes + '</MESSAGE>' + #13#10);
+ if XmlItem.FileName <> '' then
+ WriteString(Stream, #9 + '<FILE>' + XmlItem.FileName + '</FILE>' + #13#10);
+ if XmlItem.Url <> '' then
+ WriteString(Stream, #9 + '<URL>' + XmlItem.Url + '</URL>' + #13#10);
+ WriteString(Stream, '</EVENT>' + #13#10);
+ end;
+
+ procedure SaveUnicode;
+ var
+ nick, Mes, Time: String;
+ FullHeader: Boolean;
+ begin
+ FullHeader := not(FGroupLinked and FItems[Item].LinkedToPrev);
+ if FullHeader then
+ begin
+ Time := GetTime(FItems[Item].Time);
+ if mtIncoming in FItems[Item].MessageType then
+ nick := ContactName
+ else
+ nick := ProfileName;
+ if Assigned(FGetNameData) then
+ FGetNameData(Self, Item, nick);
+ end;
+ Mes := FItems[Item].Text;
+ if Options.RawRTFEnabled and IsRTF(Mes) then
+ begin
+ ApplyItemToRich(Item);
+ Mes := GetRichString(FRich.Handle, False);
+ end;
+ if Options.BBCodesEnabled then
+ Mes := DoStripBBCodes(Mes);
+ if FullHeader then
+ WriteWideString(Stream, WideFormat('[%s] %s:'#13#10, [Time, nick]));
+ WriteWideString(Stream, Mes + #13#10 + #13#10);
+ end;
+
+ procedure SaveText;
+ var
+ Time: AnsiString;
+ nick, Mes: String;
+ FullHeader: Boolean;
+ begin
+ FullHeader := not(FGroupLinked and FItems[Item].LinkedToPrev);
+ if FullHeader then
+ begin
+ Time := WideToAnsiString(GetTime(FItems[Item].Time), Codepage);
+ if mtIncoming in FItems[Item].MessageType then
+ nick := ContactName
+ else
+ nick := ProfileName;
+ if Assigned(FGetNameData) then
+ FGetNameData(Self, Item, nick);
+ end;
+ Mes := FItems[Item].Text;
+ if Options.RawRTFEnabled and IsRTF(Mes) then
+ begin
+ ApplyItemToRich(Item);
+ Mes := GetRichString(FRich.Handle, False);
+ end;
+ if Options.BBCodesEnabled then
+ Mes := DoStripBBCodes(Mes);
+ if FullHeader then
+ WriteString(Stream, AnsiString(Format('[%s] %s:'#13#10, [Time, nick])));
+ WriteString(Stream, WideToAnsiString(Mes, Codepage) + #13#10 + #13#10);
+ end;
+
+ procedure SaveRTF;
+ var
+ RTFStream: AnsiString;
+ Text: String;
+ FullHeader: Boolean;
+ begin
+ FullHeader := not(FGroupLinked and FItems[Item].LinkedToPrev);
+ if FullHeader then
+ begin
+ if mtIncoming in FItems[Item].MessageType then
+ Text := ContactName
+ else
+ Text := ProfileName;
+ if Assigned(FGetNameData) then
+ FGetNameData(Self, Item, Text);
+ Text := Text + ' [' + GetTime(FItems[Item].Time) + ']:';
+ RTFStream := '{\rtf1\par\b1 ' + FormatString2RTF(Text) + '\b0\par}';
+ SetRichRTF(FRichSave.Handle, RTFStream, True, False, False);
+ end;
+ ApplyItemToRich(Item, FRichSaveItem, True);
+ GetRichRTF(FRichSaveItem.Handle, RTFStream, False, False, False, False);
+ SetRichRTF(FRichSave.Handle, RTFStream, True, False, False);
+ end;
+
+ procedure SaveMContacts;
+ var
+ MCItem: TMCItem;
+ begin
+ if not Assigned(FGetMCData) then
+ exit;
+ FGetMCData(Self, Item, MCItem, ssInit);
+ Stream.Write(MCItem.Buffer^, MCItem.Size);
+ FGetMCData(Self, Item, MCItem, ssDone);
+ Inc(mcHeader.DataSize, MCItem.Size);
+ end;
+
+begin
+ LoadItem(Item, False);
+ case SaveFormat of
+ sfHTML:
+ SaveHTML;
+ sfXML:
+ SaveXML;
+ sfRTF:
+ SaveRTF;
+ sfMContacts:
+ SaveMContacts;
+ sfUnicode:
+ SaveUnicode;
+ sfText:
+ SaveText;
+ end;
+end;
+
+procedure THistoryGrid.WriteString(fs: TFileStream; Text: AnsiString);
+begin
+ fs.Write(Text[1], Length(Text));
+end;
+
+procedure THistoryGrid.WriteWideString(fs: TFileStream; Text: String);
+begin
+ fs.Write(Text[1], Length(Text) * SizeOf(Char));
+end;
+
+procedure THistoryGrid.CheckBusy;
+begin
+ if State = gsInline then
+ CancelInline;
+ if State <> gsIdle then
+ raise EAbort.Create('Grid is busy');
+end;
+
+function THistoryGrid.GetSelItems(Index: Integer): Integer;
+begin
+ Result := FSelItems[Index];
+end;
+
+procedure THistoryGrid.SetSelItems(Index: Integer; Item: Integer);
+begin
+ AddSelected(Item);
+end;
+
+procedure THistoryGrid.SetState(const Value: TGridState);
+begin
+ FState := Value;
+ if Assigned(FOnState) then
+ FOnState(Self, FState);
+end;
+
+procedure THistoryGrid.SetReversed(const Value: Boolean);
+var
+ vis_idx: Integer;
+begin
+ if FReversed = Value then
+ exit;
+ if not Allocated then
+ begin
+ FReversed := Value;
+ exit;
+ end;
+ if Selected = -1 then
+ begin
+ vis_idx := GetFirstVisible;
+ end
+ else
+ begin
+ vis_idx := Selected;
+ end;
+ FReversed := Value;
+
+ // VertScrollBar.Position := getIdx(0);
+ BarAdjusted := False;
+ SetSBPos(GetIdx(0));
+ AdjustScrollBar;
+ MakeVisible(vis_idx);
+ Invalidate;
+ Update;
+end;
+
+procedure THistoryGrid.SetReversedHeader(const Value: Boolean);
+begin
+ if FReversedHeader = Value then
+ exit;
+ FReversedHeader := Value;
+ if not Allocated then
+ exit;
+ Invalidate;
+ Update;
+end;
+
+procedure THistoryGrid.SetRichRTL(RTL: Boolean; RichEdit: THPPRichEdit; ProcessTag: Boolean = True);
+var
+ pf: PARAFORMAT2;
+ ExStyle: DWord;
+begin
+ // we use RichEdit.Tag here to save previous RTL state to prevent from
+ // reapplying same state, because SetRichRTL is called VERY OFTEN
+ // (from ApplyItemToRich)
+ if (RichEdit.Tag = Integer(RTL)) and ProcessTag then
+ exit;
+ ZeroMemory(@pf, SizeOf(pf));
+ pf.cbSize := SizeOf(pf);
+ pf.dwMask := PFM_RTLPARA;
+ ExStyle := DWord(GetWindowLongPtr(RichEdit.Handle, GWL_EXSTYLE)) and
+ not(WS_EX_RTLREADING or WS_EX_LEFTSCROLLBAR or WS_EX_RIGHT or WS_EX_LEFT);
+ if RTL then
+ begin
+ ExStyle := ExStyle or (WS_EX_RTLREADING or WS_EX_LEFTSCROLLBAR or WS_EX_LEFT);
+ pf.wReserved := PFE_RTLPARA;
+ end
+ else
+ begin
+ ExStyle := ExStyle or WS_EX_RIGHT;
+ pf.wReserved := 0;
+ end;
+ RichEdit.Perform(EM_SETPARAFORMAT, 0, lParam(@pf));
+ SetWindowLongPtr(RichEdit.Handle, GWL_EXSTYLE, ExStyle);
+ if ProcessTag then
+ RichEdit.Tag := Integer(RTL);
+end;
+
+(* Index to Position *)
+function THistoryGrid.GetIdx(Index: Integer): Integer;
+begin
+ if Reversed then
+ Result := Count - 1 - Index
+ else
+ Result := Index;
+end;
+
+function THistoryGrid.GetFirstVisible: Integer;
+var
+ Pos: Integer;
+begin
+ Pos := VertScrollBar.Position;
+ if MaxSBPos > -1 then
+ Pos := Min(MaxSBPos, VertScrollBar.Position);
+ Result := GetDown(GetIdx(Pos - 1));
+ if Result = -1 then
+ Result := GetUp(GetIdx(Pos + 1));
+end;
+
+procedure THistoryGrid.SetMultiSelect(const Value: Boolean);
+begin
+ FMultiSelect := Value;
+end;
+
+{ ThgVertScrollBar }
+
+procedure THistoryGrid.DoOptionsChanged;
+var
+ i: Integer;
+ Ch, ph, pth, cth, sh: Integer;
+ // pf: PARAFORMAT2;
+begin
+ // recalc fonts
+ for i := 0 to Length(FItems) - 1 do
+ begin
+ FItems[i].Height := -1;
+ end;
+ FRichCache.ResetAllItems;
+
+ // pf.cbSize := SizeOf(pf);
+ // pf.dwMask := PFM_RTLPARA;
+
+ // RTLEnabled := Options.RTLEnabled;
+
+ // if Options.RTLEnabled then begin
+ { if (RTLMode = hppRTLEnable) or ((RTLMode = hppRTLDefault) and Options.RTLEnabled) then begin
+ // redundant, we do it in ApplyItemToRich
+ //SetRichRTL(True);
+ //pf.wReserved := PFE_RTLPARA;
+ // redundant, we do it PaintItem
+ // Canvas.TextFlags := Canvas.TextFlags or ETO_RTLREADING;
+ end else begin
+ // redundant, we do it in ApplyItemToRich
+ // SetRichRTL(False);
+ //pf.wReserved := 0;
+ // redundant, we do it PaintItem
+ // Canvas.TextFlags := Canvas.TextFlags and not ETO_RTLREADING;
+ end; }
+ // SendMessage(FRich.Handle,EM_SETPARAFORMAT,0,LPARAM(@pf));
+ // SendMessage(FRichInline.Handle,EM_SETPARAFORMAT,0,LPARAM(@pf));
+ // FRich.Perform(EM_SETPARAFORMAT,0,LPARAM(@pf));
+ // FRichInline.Perform(EM_SETPARAFORMAT,0,LPARAM(@pf));
+
+ Canvas.Font := Options.FontProfile; ph := Canvas.TextExtent('Wy').cY;
+ Canvas.Font := Options.FontContact; Ch := Canvas.TextExtent('Wy').cY;
+ Canvas.Font := Options.FontOutgoingTimestamp; pth := Canvas.TextExtent('Wy').cY;
+ Canvas.Font := Options.FontIncomingTimestamp; cth := Canvas.TextExtent('Wy').cY;
+ Canvas.Font := Options.FontSessHeader; sh := Canvas.TextExtent('Wy').cY;
+ // find heighest and don't forget about icons
+ PHeaderheight := Max(ph, pth);
+ CHeaderHeight := Max(Ch, cth);
+ SessHeaderHeight := sh + 1 + 3 * 2;
+ if Options.ShowIcons then
+ begin
+ CHeaderHeight := Max(CHeaderHeight, 16);
+ PHeaderheight := Max(PHeaderheight, 16);
+ end;
+
+ Inc(CHeaderHeight, Padding);
+ Inc(PHeaderheight, Padding);
+
+ SetRTLMode(RTLMode);
+ if Assigned(Self.FOnOptionsChange) then
+ FOnOptionsChange(Self);
+
+ BarAdjusted := False;
+ AdjustScrollBar;
+ Invalidate;
+ Update; // cos when you change from Options it updates with lag
+end;
+
+{ ThgVertScrollBar }
+procedure THistoryGrid.SetOptions(const Value: TGridOptions);
+begin
+ BeginUpdate;
+ { disconnect from options }
+ if Assigned(Options) then
+ Options.DeleteGrid(Self);
+ FOptions := Value;
+ { connect to options }
+ if Assigned(Options) then
+ Options.AddGrid(Self);
+ GridUpdate([guOptions]);
+ EndUpdate;
+end;
+
+procedure THistoryGrid.SetRTLMode(const Value: TRTLMode);
+var
+ NewBiDiMode: TBiDiMode;
+begin
+ if FRTLMode <> Value then
+ begin
+ FRTLMode := Value;
+ FRichCache.ResetAllItems;
+ Repaint;
+ end;
+ if (RTLMode = hppRTLEnable) or ((RTLMode = hppRTLDefault) and Options.RTLEnabled) then
+ NewBiDiMode := bdRightToLeft
+ else
+ NewBiDiMode := bdLeftToRight;
+ if NewBiDiMode <> BiDiMode then
+ begin
+ BiDiMode := NewBiDiMode;
+ if Assigned(FOnRTLChange) then
+ OnRTLChange(Self, NewBiDiMode);
+ end;
+ // no need in it?
+ // cause we set rich's RTL in ApplyItemToRich and
+ // canvas'es RTL in PaintItem
+ // DoOptionsChanged;
+end;
+
+procedure THistoryGrid.SetSBPos(Position: Integer);
+var
+ SumHeight: Integer;
+ // DoAdjust: Boolean;
+ idx: Integer;
+begin
+ TopItemOffset := 0;
+ VertScrollBar.Position := Position;
+ AdjustScrollBar;
+ if GetUp(GetIdx(VertScrollBar.Position)) = -1 then
+ VertScrollBar.Position := 0;
+ if MaxSBPos = -1 then
+ exit;
+ if VertScrollBar.Position > MaxSBPos then
+ begin
+ SumHeight := 0;
+ idx := GetIdx(Length(FItems) - 1);
+ repeat
+ LoadItem(idx, True);
+ if IsMatched(idx) then
+ Inc(SumHeight, FItems[idx].Height);
+ idx := GetUp(idx);
+ if idx = -1 then
+ break;
+ until ((SumHeight >= ClientHeight) or (idx < 0) or (idx >= Length(FItems)));
+ if SumHeight > ClientHeight then
+ begin
+ TopItemOffset := SumHeight - ClientHeight;
+ // Repaint;
+ end;
+ end;
+ {
+ if Allocated and VertScrollBar.Visible then begin
+ idx := GetFirstVisible;
+ SumHeight := -TopItemOffset;
+ DoAdjust := False;
+ while (idx <> -1) do begin
+ DoAdjust := True;
+ LoadItem(idx,True);
+ if SumHeight + FItems[idx].Height >= ClientHeight then begin
+ DoAdjust := False;
+ break;
+ end;
+ Inc(Sumheight,FItems[idx].Height);
+ idx := GetDown(idx);
+ end;
+ if DoAdjust then begin
+ AdjustScrollBar;
+ ScrollGridBy(-(ClientHeight-SumHeight),False);
+
+ end;
+ //TopItemOffset := TopItemOffset + (ClientHeight-SumHeight);
+ end; }
+end;
+
+{$IFDEF CUST_SB}
+
+procedure THistoryGrid.SetVertScrollBar(const Value: TVertScrollBar);
+begin
+ FVertScrollBar.Assign(Value);
+end;
+
+function THistoryGrid.GetHideScrollBar: Boolean;
+begin
+ Result := FVertScrollBar.Hidden;
+end;
+
+procedure THistoryGrid.SetHideScrollBar(const Value: Boolean);
+begin
+ FVertScrollBar.Hidden := Value;
+end;
+{$ENDIF}
+
+procedure THistoryGrid.UpdateFilter;
+begin
+ if not Allocated then
+ exit;
+ CheckBusy;
+ FRichCache.ResetItems(FSelItems);
+ SetLength(FSelItems, 0);
+ State := gsLoad;
+ try
+ VertScrollBar.Visible := True;
+{$IFDEF PAGE_SIZE}
+ VertScrollBar.Range := Count + FVertScrollBar.PageSize - 1;
+{$ELSE}
+ VertScrollBar.Range := Count + ClientHeight;
+{$ENDIF}
+ BarAdjusted := False;
+ if (FSelected = -1) or (not IsMatched(FSelected)) then
+ begin
+ ShowProgress := True;
+ try
+ if FSelected <> -1 then
+ begin
+ FSelected := GetDown(FSelected);
+ if FSelected = -1 then
+ FSelected := GetUp(FSelected);
+ end
+ else
+ begin
+ // FSelected := 0;
+ // SetSBPos(GetIdx(FSelected));
+ if Reversed then
+ // we have multiple selection sets
+ FSelected := GetPrev(-1)
+ else
+ // we have multiple selection sets
+ FSelected := GetNext(-1);
+ end;
+ finally
+ ShowProgress := False;
+ end;
+ end;
+ AdjustScrollBar;
+ finally
+ State := gsIdle;
+ Selected := FSelected;
+ end;
+ Repaint;
+end;
+
+function THistoryGrid.IsLinkAtPoint(RichEditRect: TRect; X, Y, Item: Integer): Boolean;
+var
+ P: TPoint;
+ cr: CHARRANGE;
+ cf: CharFormat2;
+ cp: Integer;
+ res: DWord;
+begin
+ Result := False;
+ P := Point(X - RichEditRect.Left, Y - RichEditRect.Top);
+ ApplyItemToRich(Item);
+
+ cp := FRich.Perform(EM_CHARFROMPOS, 0, lParam(@P));
+ if cp = -1 then
+ exit; // out of richedit area
+ cr.cpMin := cp;
+ cr.cpMax := cp + 1;
+ FRich.Perform(EM_EXSETSEL, 0, lParam(@cr));
+
+ ZeroMemory(@cf, SizeOf(cf));
+ cf.cbSize := SizeOf(cf);
+ cf.dwMask := CFM_LINK;
+ res := FRich.Perform(EM_GETCHARFORMAT, SCF_SELECTION, lParam(@cf));
+ // no link under point
+ Result := (((res and CFM_LINK) > 0) and ((cf.dwEffects and CFE_LINK) > 0)) or
+ (((res and CFM_REVISED) > 0) and ((cf.dwEffects and CFE_REVISED) > 0));
+end;
+
+function THistoryGrid.GetHitTests(X, Y: Integer): TGridHitTests;
+var
+ Item: Integer;
+ ItemRect: TRect;
+ HeaderHeight: Integer;
+ HeaderRect, SessRect: TRect;
+ ButtonRect: TRect;
+ P: TPoint;
+ RTL: Boolean;
+ Sel: Boolean;
+ FullHeader: Boolean;
+ TimestampOffset: Integer;
+begin
+ Result := [];
+ FHintRect := Rect(0, 0, 0, 0);
+ Item := FindItemAt(X, Y);
+ if Item = -1 then
+ exit;
+ Include(Result, ghtItem);
+
+ FullHeader := not(FGroupLinked and FItems[Item].LinkedToPrev);
+ ItemRect := GetItemRect(Item);
+ RTL := GetItemRTL(Item);
+ Sel := IsSelected(Item);
+ P := Point(X, Y);
+
+ if FullHeader and (ShowHeaders) and (ExpandHeaders) and (FItems[Item].HasHeader) then
+ begin
+ if Reversed xor ReversedHeader then
+ begin
+ SessRect := Rect(ItemRect.Left, ItemRect.Top, ItemRect.Right,
+ ItemRect.Top + SessHeaderHeight);
+ Inc(ItemRect.Top, SessHeaderHeight);
+ end
+ else
+ begin
+ SessRect := Rect(ItemRect.Left, ItemRect.Bottom - SessHeaderHeight - 1, ItemRect.Right,
+ ItemRect.Bottom - 1);
+ Dec(ItemRect.Bottom, SessHeaderHeight);
+ end;
+ if PtInRect(SessRect, P) then
+ begin
+ Include(Result, ghtSession);
+ InflateRect(SessRect, -3, -3);
+ if RTL then
+ ButtonRect := Rect(SessRect.Left, SessRect.Top, SessRect.Left + 16, SessRect.Bottom)
+ else
+ ButtonRect := Rect(SessRect.Right - 16, SessRect.Top, SessRect.Right, SessRect.Bottom);
+ if PtInRect(ButtonRect, P) then
+ begin
+ Include(Result, ghtSessHideButton);
+ Include(Result, ghtButton);
+ FHintRect := ButtonRect;
+ end;
+ end;
+ end;
+
+ Dec(ItemRect.Bottom); // divider
+ InflateRect(ItemRect, -Padding, -Padding); // paddings
+
+ if FullHeader then
+ begin
+ Dec(ItemRect.Top, Padding);
+ Inc(ItemRect.Top, Padding div 2);
+
+ if mtIncoming in FItems[Item].MessageType then
+ HeaderHeight := CHeaderHeight
+ else
+ HeaderHeight := PHeaderheight;
+
+ HeaderRect := Rect(ItemRect.Left, ItemRect.Top, ItemRect.Right,
+ ItemRect.Top + HeaderHeight);
+ Inc(ItemRect.Top, HeaderHeight + (Padding - (Padding div 2)));
+ if PtInRect(HeaderRect, P) then
+ begin
+ Include(Result, ghtHeader);
+ if (ShowHeaders) and (not ExpandHeaders) and (FItems[Item].HasHeader) then
+ begin
+ if RTL then
+ ButtonRect := Rect(HeaderRect.Right - 16, HeaderRect.Top, HeaderRect.Right,
+ HeaderRect.Bottom)
+ else
+ ButtonRect := Rect(HeaderRect.Left, HeaderRect.Top, HeaderRect.Left + 16,
+ HeaderRect.Bottom);
+ if PtInRect(ButtonRect, P) then
+ begin
+ Include(Result, ghtSessShowButton);
+ Include(Result, ghtButton);
+ FHintRect := ButtonRect;
+ end;
+ end;
+ if ShowBookmarks and (Sel or FItems[Item].Bookmarked) then
+ begin
+ // TimeStamp := GetTime(FItems[Item].Time);
+ // Canvas.Font.Assign(Options.FontTimeStamp);
+ if mtIncoming in FItems[Item].MessageType then
+ Canvas.Font.Assign(Options.FontIncomingTimestamp)
+ else
+ Canvas.Font.Assign(Options.FontOutgoingTimestamp);
+ TimestampOffset := Canvas.TextExtent(GetTime(FItems[Item].Time)).cX + Padding;
+ if RTL then
+ ButtonRect := Rect(HeaderRect.Left + TimestampOffset, HeaderRect.Top,
+ HeaderRect.Left + TimestampOffset + 16, HeaderRect.Bottom)
+ else
+ ButtonRect := Rect(HeaderRect.Right - 16 - TimestampOffset, HeaderRect.Top,
+ HeaderRect.Right - TimestampOffset, HeaderRect.Bottom);
+ if PtInRect(ButtonRect, P) then
+ begin
+ Include(Result, ghtBookmark);
+ Include(Result, ghtButton);
+ FHintRect := ButtonRect;
+ end;
+ end;
+ end;
+ end;
+
+ if PtInRect(ItemRect, P) then
+ begin
+ Include(Result, ghtText);
+ FHintRect := ItemRect;
+ if IsLinkAtPoint(ItemRect, X, Y, Item) then
+ Include(Result, ghtLink)
+ else
+ Include(Result, ghtUnknown);
+ end;
+end;
+
+procedure THistoryGrid.EditInline(Item: Integer);
+var
+ r: TRect;
+ // cr: CHARRANGE;
+begin
+ if State = gsInline then
+ CancelInline(False);
+ MakeVisible(Item);
+ r := GetRichEditRect(Item);
+ if IsRectEmpty(r) then
+ exit;
+
+ // dunno why, but I have to fix it by 1 pixel
+ // or positioning will be not perfectly correct
+ // who knows why? i want to know! I already make corrections of margins!
+ // Dec(r.left,1);
+ Inc(r.Right, 1);
+
+ // below is not optimal way to show rich edit
+ // (ie me better show it after applying item),
+ // but it's done because now when we have OnProcessItem
+ // event grid state is gsInline, which is how it should be
+ // and you can't set it inline before setting focus
+ // because of CheckBusy abort exception
+ // themiron 03.10.2006. don't need to, 'cose there's check
+ // if inline richedit got the focus
+
+ // FRichInline.Show;
+ // FRichInline.SetFocus;
+ // State := gsInline;
+
+ State := gsInline;
+ FItemInline := Item;
+ ApplyItemToRich(Item, FRichInline);
+
+ // set bounds after applying to avoid vertical scrollbar
+ FRichInline.SetBounds(r.Left, r.Top, r.Right - r.Left, r.Bottom - r.Top);
+ FRichInline.SelLength := 0;
+ FRichInline.SelStart := 0;
+
+ FRichInline.Show;
+ FRichInline.SetFocus;
+end;
+
+procedure THistoryGrid.CancelInline(DoSetFocus: Boolean = True);
+begin
+ if State <> gsInline then
+ exit;
+ FRichInline.Hide;
+ State := gsIdle;
+ FRichInline.Clear;
+ FRichInline.Top := -MaxInt;
+ FRichInline.Height := -1;
+ FItemInline := -1;
+ if DoSetFocus then
+ Windows.SetFocus(Handle);
+end;
+
+procedure THistoryGrid.RemoveSelected(Item: Integer);
+begin
+ IntSortedArray_Remove(TIntArray(FSelItems), Item);
+ FRichCache.ResetItem(Item);
+end;
+
+procedure THistoryGrid.ResetItem(Item: Integer);
+begin
+ // we need to adjust scrollbar after ResetItem if GetIdx(Item) >= MaxSBPos
+ // as it's currently used to handle deletion with headers, adjust
+ // is run after deletion ends, so no point in doing it here
+ if IsUnknown(Item) then
+ exit;
+ FItems[Item].Height := -1;
+ FItems[Item].MessageType := [mtUnknown];
+ FRichCache.ResetItem(Item);
+end;
+
+procedure THistoryGrid.ResetAllItems;
+var
+ DoChanges: Boolean;
+ i: Integer;
+begin
+ if not Allocated then
+ exit;
+ BeginUpdate;
+ DoChanges := False;
+ for i := 0 to Length(FItems) - 1 do
+ if not IsUnknown(i) then
+ begin
+ DoChanges := True;
+ // cose it's faster :)
+ FItems[i].MessageType := [mtUnknown];
+ end;
+ if DoChanges then
+ GridUpdate([guOptions]);
+ EndUpdate;
+end;
+
+procedure THistoryGrid.OnInlineOnExit(Sender: TObject);
+begin
+ CancelInline;
+end;
+
+procedure THistoryGrid.OnInlineOnKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+ if ((Key = VK_ESCAPE) or (Key = VK_RETURN)) then
+ begin
+ CancelInline;
+ Key := 0;
+ end
+ else if Assigned(FOnInlineKeyDown) then
+ FOnInlineKeyDown(Sender, Key, Shift);
+end;
+
+procedure THistoryGrid.OnInlineOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+ if not FRichInline.Visible then
+ begin
+ CancelInline;
+ Key := 0;
+ end
+ else
+
+ if (Key = VK_APPS) or ((Key = VK_F10) and (ssShift in Shift)) then
+ begin
+ if Assigned(FOnInlinePopup) then
+ FOnInlinePopup(Sender);
+ Key := 0;
+ end
+ else
+
+ if Assigned(FOnInlineKeyUp) then
+ FOnInlineKeyUp(Sender, Key, Shift);
+end;
+
+procedure THistoryGrid.OnInlineOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+begin;
+end;
+
+procedure THistoryGrid.OnInlineOnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+begin
+ if (Button = mbRight) and Assigned(FOnInlinePopup) then
+ FOnInlinePopup(Sender);
+end;
+
+procedure THistoryGrid.OnInlineOnURLClick(Sender: TObject; const URLText: String; Button: TMouseButton);
+var
+ P: TPoint;
+ Item: Integer;
+begin
+ if Button = mbLeft then
+ begin
+ P := ScreenToClient(Mouse.CursorPos);
+ Item := FindItemAt(P.X, P.Y);
+ URLClick(Item, URLText, Button);
+ end;
+end;
+
+function THistoryGrid.GetRichEditRect(Item: Integer; DontClipTop: Boolean): TRect;
+var
+ res: TRect;
+ hh: Integer;
+begin
+ Result := Rect(0, 0, 0, 0);
+ if Item = -1 then
+ exit;
+ Result := GetItemRect(Item);
+ Inc(Result.Left, Padding);
+ Dec(Result.Right, Padding);
+ /// avatars!.!
+ // Dec(Result.Right,64+Padding);
+ if FGroupLinked and FItems[Item].LinkedToPrev then
+ hh := 0
+ else if mtIncoming in FItems[Item].MessageType then
+ hh := CHeaderHeight
+ else
+ hh := PHeaderheight;
+ Inc(Result.Top, hh + Padding);
+ Dec(Result.Bottom, Padding + 1);
+ if (Items[Item].HasHeader) and (ShowHeaders) and (ExpandHeaders) then
+ begin
+ if Reversed xor ReversedHeader then
+ Inc(Result.Top, SessHeaderHeight)
+ else
+ Dec(Result.Bottom, SessHeaderHeight);
+ end;
+ res := ClientRect;
+{$IFDEF DEBUG}
+ OutputDebugString
+ (PWideChar(Format('GetRichEditRect client: Top:%d Left:%d Bottom:%d Right:%d',
+ [res.Top, res.Left, res.Bottom, res.Right])));
+ OutputDebugString
+ (PWideChar(Format('GetRichEditRect item_2: Top:%d Left:%d Bottom:%d Right:%d',
+ [Result.Top, Result.Left, Result.Bottom, Result.Right])));
+{$ENDIF}
+ if DontClipTop and (Result.Top < res.Top) then
+ res.Top := Result.Top;
+ IntersectRect(Result, res, Result);
+end;
+
+function THistoryGrid.SearchItem(ItemID: Integer): Integer;
+var
+ i { ,FirstItem } : Integer;
+ Found: Boolean;
+begin
+ if not Assigned(OnSearchItem) then
+ raise Exception.Create('You must handle OnSearchItem event to use SearchItem function');
+ Result := -1;
+ State := gsSearchItem;
+ try
+ // FirstItem := GetNext(-1,True);
+ State := gsSearchItem;
+ ShowProgress := True;
+ for i := 0 to Count - 1 do
+ begin
+ if IsUnknown(i) then
+ LoadItem(i, False);
+ Found := False;
+ OnSearchItem(Self, i, ItemID, Found);
+ if Found then
+ begin
+ Result := i;
+ break;
+ end;
+ DoProgress(i + 1, Count);
+ end;
+ ShowProgress := False;
+ finally
+ State := gsIdle;
+ end;
+end;
+
+procedure THistoryGrid.SetBorderStyle(Value: TBorderStyle);
+var
+ Style, ExStyle: DWord;
+begin
+ if FBorderStyle = Value then
+ exit;
+ FBorderStyle := Value;
+ if HandleAllocated then
+ begin
+ Style := DWord(GetWindowLongPtr(Handle, GWL_STYLE)) and WS_BORDER;
+ ExStyle := DWord(GetWindowLongPtr(Handle, GWL_EXSTYLE)) and not WS_EX_CLIENTEDGE;
+ if Ctl3D and NewStyleControls and (FBorderStyle = bsSingle) then
+ begin
+ Style := Style and not WS_BORDER;
+ ExStyle := ExStyle or WS_EX_CLIENTEDGE;
+ end;
+ SetWindowLongPtr(Handle, GWL_STYLE, Style);
+ SetWindowLongPtr(Handle, GWL_EXSTYLE, ExStyle);
+ end;
+end;
+
+procedure THistoryGrid.CMBiDiModeChanged(var Message: TMessage);
+var
+ ExStyle: Cardinal;
+begin
+ // inherited;
+ if HandleAllocated then
+ begin
+ ExStyle := DWord(GetWindowLongPtr(Handle, GWL_EXSTYLE)) and
+ not(WS_EX_RTLREADING or WS_EX_LEFTSCROLLBAR or WS_EX_RIGHT or WS_EX_LEFT);
+ AddBiDiModeExStyle(ExStyle);
+ SetWindowLongPtr(Handle, GWL_EXSTYLE, ExStyle);
+ end;
+end;
+
+procedure THistoryGrid.CMCtl3DChanged(var Message: TMessage);
+var
+ Style, ExStyle: DWord;
+begin
+ if HandleAllocated then
+ begin
+ Style := DWord(GetWindowLongPtr(Handle, GWL_STYLE)) and WS_BORDER;
+ ExStyle := DWord(GetWindowLongPtr(Handle, GWL_EXSTYLE)) and not WS_EX_CLIENTEDGE;
+ if Ctl3D and NewStyleControls and (FBorderStyle = bsSingle) then
+ begin
+ Style := Style and not WS_BORDER;
+ ExStyle := ExStyle or WS_EX_CLIENTEDGE;
+ end;
+ SetWindowLongPtr(Handle, GWL_STYLE, Style);
+ SetWindowLongPtr(Handle, GWL_EXSTYLE, ExStyle);
+ end;
+end;
+
+procedure THistoryGrid.SetHideSelection(const Value: Boolean);
+begin
+ if FHideSelection = Value then
+ exit;
+ FHideSelection := Value;
+ if FGridNotFocused and (SelCount > 0) then
+ begin
+ FRichCache.ResetItems(FSelItems);
+ Invalidate;
+ end;
+end;
+
+function THistoryGrid.GetProfileName: String;
+begin
+ if Assigned(Options) and Options.ForceProfileName then
+ Result := Options.ProfileName
+ else
+ Result := FProfileName;
+end;
+
+procedure THistoryGrid.SetProfileName(const Value: String);
+begin
+ if FProfileName = Value then
+ exit;
+ FProfileName := Value;
+ if Assigned(Options) and Options.ForceProfileName then
+ exit;
+ Update;
+end;
+
+procedure THistoryGrid.SetContactName(const Value: String);
+begin
+ if FContactName = Value then
+ exit;
+ FContactName := Value;
+ Update;
+end;
+
+procedure THistoryGrid.URLClick(Item: Integer; const URLText: String; Button: TMouseButton);
+begin
+ Application.CancelHint;
+ Cursor := crDefault;
+ if Assigned(OnUrlClick) then
+ OnUrlClick(Self, Item, URLText, Button);
+end;
+
+{ TGridOptions }
+
+procedure TGridOptions.AddGrid(Grid: THistoryGrid);
+var
+ i: Integer;
+begin
+ for i := 0 to Length(Grids) - 1 do
+ if Grids[i] = Grid then
+ exit;
+ SetLength(Grids, Length(Grids) + 1);
+ Grids[High(Grids)] := Grid;
+end;
+
+constructor TGridOptions.Create;
+begin
+ inherited;
+
+ FRTLEnabled := False;
+ FShowIcons := False;
+ // FShowAvatars := False;
+
+ FSmileysEnabled := False;
+ FBBCodesEnabled := False;
+ FMathModuleEnabled := False;
+ FRawRTFEnabled := False;
+ FAvatarsHistoryEnabled := False;
+
+ FOpenDetailsMode := False;
+
+ FProfileName := '';
+ FForceProfileName := False;
+
+ FTextFormatting := True;
+
+ FLocks := 0;
+ Changed := 0;
+
+ // FIconOther := TIcon.Create;
+ // FIconOther.OnChange := FontChanged;
+ // FIconFile := TIcon.Create;
+ // FIconFile.OnChange := FontChanged;
+ // FIconUrl := TIcon.Create;
+ // FIconUrl.OnChange := FontChanged;
+ // FIconMessage := TIcon.Create;
+ // FIconMessage.OnChange := FontChanged;
+
+ FFontContact := TFont.Create;
+ FFontContact.OnChange := FontChanged;
+ FFontProfile := TFont.Create;
+ FFontProfile.OnChange := FontChanged;
+ FFontIncomingTimestamp := TFont.Create;
+ FFontIncomingTimestamp.OnChange := FontChanged;
+ FFontOutgoingTimestamp := TFont.Create;
+ FFontOutgoingTimestamp.OnChange := FontChanged;
+ FFontSessHeader := TFont.Create;
+ FFontSessHeader.OnChange := FontChanged;
+ FFontMessage := TFont.Create;
+ FFontMessage.OnChange := FontChanged;
+
+ // FItemFont := TFont.Create;
+
+end;
+
+procedure TGridOptions.DeleteGrid(Grid: THistoryGrid);
+var
+ i: Integer;
+ idx: Integer;
+begin
+ idx := -1;
+ for i := 0 to Length(Grids) - 1 do
+ if Grids[i] = Grid then
+ begin
+ idx := i;
+ break;
+ end;
+ if idx = -1 then
+ exit;
+ for i := idx to Length(Grids) - 2 do
+ Grids[i] := Grids[i + 1];
+ SetLength(Grids, Length(Grids) - 1);
+end;
+
+destructor TGridOptions.Destroy;
+var
+ i: Integer;
+begin
+ FFontContact.Free;
+ FFontProfile.Free;
+ FFontIncomingTimestamp.Free;
+ FFontOutgoingTimestamp.Free;
+ FFontSessHeader.Free;
+ FFontMessage.Free;
+ // FIconUrl.Free;
+ // FIconMessage.Free;
+ // FIconFile.Free;
+ // FIconOther.Free;
+ for i := 0 to Length(FItemOptions) - 1 do
+ begin
+ FItemOptions[i].textFont.Free;
+ end;
+ // SetLength(FItemOptions,0);
+ Finalize(FItemOptions);
+ // SetLength(Grids,0);
+ Finalize(Grids);
+ inherited;
+end;
+
+procedure TGridOptions.DoChange;
+var
+ i: Integer;
+begin
+ Inc(Changed);
+ if FLocks > 0 then
+ exit;
+ for i := 0 to Length(Grids) - 1 do
+ Grids[i].GridUpdate([guOptions]);
+ Changed := 0;
+end;
+
+procedure TGridOptions.EndChange(const Forced: Boolean = False);
+begin
+ if FLocks = 0 then
+ exit;
+ Dec(FLocks);
+ if Forced then
+ Inc(Changed);
+ if (FLocks = 0) and (Changed > 0) then
+ DoChange;
+end;
+
+procedure TGridOptions.FontChanged(Sender: TObject);
+begin
+ DoChange;
+end;
+
+function TGridOptions.AddItemOptions: Integer;
+var
+ i: Integer;
+begin
+ i := Length(FItemOptions);
+ SetLength(FItemOptions, i + 1);
+ FItemOptions[i].MessageType := [mtOther];
+ FItemOptions[i].textFont := TFont.Create;
+ // FItemOptions[i].textFont.Assign(FItemFont);
+ // FItemOptions[i].textColor := clWhite;
+ Result := i;
+end;
+
+function TGridOptions.GetItemOptions(Mes: TMessageTypes; out textFont: TFont; out textColor: TColor): Integer;
+var
+ i: Integer;
+begin
+ i := 0;
+ Result := 0;
+ while i <= High(FItemOptions) do
+ if (MessageTypesToDWord(FItemOptions[i].MessageType) and MessageTypesToDWord(Mes)) >=
+ MessageTypesToDWord(Mes) then
+ begin
+ textFont := FItemOptions[i].textFont;
+ textColor := FItemOptions[i].textColor;
+ Result := i;
+ break;
+ end
+ else
+ begin
+ if mtOther in FItemOptions[i].MessageType then
+ begin
+ textFont := FItemOptions[i].textFont;
+ textColor := FItemOptions[i].textColor;
+ Result := i;
+ end;
+ Inc(i);
+ end;
+end;
+
+function TGridOptions.GetLocked: Boolean;
+begin
+ Result := (FLocks > 0);
+end;
+
+procedure TGridOptions.SetColorDivider(const Value: TColor);
+begin
+ if FColorDivider = Value then
+ exit;
+ FColorDivider := Value;
+ DoChange;
+end;
+
+procedure TGridOptions.SetColorSelectedText(const Value: TColor);
+begin
+ if FColorSelectedText = Value then
+ exit;
+ FColorSelectedText := Value;
+ DoChange;
+end;
+
+procedure TGridOptions.SetColorSelected(const Value: TColor);
+begin
+ if FColorSelected = Value then
+ exit;
+ FColorSelected := Value;
+ DoChange;
+end;
+
+procedure TGridOptions.SetColorSessHeader(const Value: TColor);
+begin
+ if FColorSessHeader = Value then
+ exit;
+ FColorSessHeader := Value;
+ DoChange;
+end;
+
+procedure TGridOptions.SetDateTimeFormat(const Value: String);
+var
+ NewValue: String;
+begin
+ NewValue := Value;
+ try
+ FormatDateTime(NewValue, Now);
+ except
+ NewValue := DEFFORMAT_DATETIME;
+ end;
+ if FDateTimeFormat = NewValue then
+ exit;
+ FDateTimeFormat := NewValue;
+ DoChange;
+end;
+
+procedure TGridOptions.SetTextFormatting(const Value: Boolean);
+var
+ i: Integer;
+begin
+ if FTextFormatting = Value then
+ exit;
+ FTextFormatting := Value;
+ if FLocks > 0 then
+ exit;
+ try
+ for i := 0 to Length(Grids) - 1 do
+ Grids[i].ProcessInline := Value;
+ finally
+ if Assigned(FOnTextFormatting) then
+ FOnTextFormatting(Value);
+ end;
+end;
+
+procedure TGridOptions.SetColorBackground(const Value: TColor);
+begin
+ if FColorBackground = Value then
+ exit;
+ FColorBackground := Value;
+ DoChange;
+end;
+
+procedure TGridOptions.SetColorLink(const Value: TColor);
+begin
+ if FColorLink = Value then
+ exit;
+ FColorLink := Value;
+ DoChange;
+end;
+
+// procedure TGridOptions.SetIconOther(const Value: TIcon);
+// begin
+// FIconOther.Assign(Value);
+// FIconOther.OnChange := FontChanged;
+// DoChange;
+// end;
+
+// procedure TGridOptions.SetIconFile(const Value: TIcon);
+// begin
+// FIconFile.Assign(Value);
+// FIconFile.OnChange := FontChanged;
+// DoChange;
+// end;
+
+// procedure TGridOptions.SetIconMessage(const Value: TIcon);
+// begin
+// FIconMessage.Assign(Value);
+// FIconMessage.OnChange := FontChanged;
+// DoChange;
+// end;
+
+// procedure TGridOptions.SetIconUrl(const Value: TIcon);
+// begin
+// FIconUrl.Assign(Value);
+// FIconUrl.OnChange := FontChanged;
+// DoChange;
+// end;
+
+procedure TGridOptions.SetShowIcons(const Value: Boolean);
+begin
+ if FShowIcons = Value then
+ exit;
+ FShowIcons := Value;
+ Self.StartChange;
+ try
+ if Assigned(FOnShowIcons) then
+ FOnShowIcons;
+ DoChange;
+ finally
+ Self.EndChange;
+ end;
+end;
+
+procedure TGridOptions.SetRTLEnabled(const Value: Boolean);
+begin
+ if FRTLEnabled = Value then
+ exit;
+ FRTLEnabled := Value;
+ Self.StartChange;
+ try
+ DoChange;
+ finally
+ Self.EndChange;
+ end;
+end;
+
+{ procedure TGridOptions.SetShowAvatars(const Value: Boolean);
+ begin
+ if FShowAvatars = Value then exit;
+ FShowAvatars := Value;
+ Self.StartChange;
+ try
+ DoChange;
+ finally
+ Self.EndChange;
+ end;
+ end; }
+
+procedure TGridOptions.SetBBCodesEnabled(const Value: Boolean);
+begin
+ if FBBCodesEnabled = Value then
+ exit;
+ FBBCodesEnabled := Value;
+ Self.StartChange;
+ try
+ DoChange;
+ finally
+ Self.EndChange;
+ end;
+end;
+
+procedure TGridOptions.SetSmileysEnabled(const Value: Boolean);
+begin
+ if FSmileysEnabled = Value then
+ exit;
+ FSmileysEnabled := Value;
+ Self.StartChange;
+ try
+ DoChange;
+ finally
+ Self.EndChange;
+ end;
+end;
+
+procedure TGridOptions.SetMathModuleEnabled(const Value: Boolean);
+begin
+ if FMathModuleEnabled = Value then
+ exit;
+ FMathModuleEnabled := Value;
+ Self.StartChange;
+ try
+ DoChange;
+ finally
+ Self.EndChange;
+ end;
+end;
+
+procedure TGridOptions.SetRawRTFEnabled(const Value: Boolean);
+begin
+ if FRawRTFEnabled = Value then
+ exit;
+ FRawRTFEnabled := Value;
+ Self.StartChange;
+ try
+ DoChange;
+ finally
+ Self.EndChange;
+ end;
+end;
+
+procedure TGridOptions.SetAvatarsHistoryEnabled(const Value: Boolean);
+begin
+ if FAvatarsHistoryEnabled = Value then
+ exit;
+ FAvatarsHistoryEnabled := Value;
+ Self.StartChange;
+ try
+ DoChange;
+ finally
+ Self.EndChange;
+ end;
+end;
+
+procedure TGridOptions.SetFontContact(const Value: TFont);
+begin
+ FFontContact.Assign(Value);
+ FFontContact.OnChange := FontChanged;
+ DoChange;
+end;
+
+procedure TGridOptions.SetFontProfile(const Value: TFont);
+begin
+ FFontProfile.Assign(Value);
+ FFontProfile.OnChange := FontChanged;
+ DoChange;
+end;
+
+procedure TGridOptions.SetFontIncomingTimestamp(const Value: TFont);
+begin
+ FFontIncomingTimestamp.Assign(Value);
+ FFontIncomingTimestamp.OnChange := FontChanged;
+ DoChange;
+end;
+
+procedure TGridOptions.SetFontOutgoingTimestamp(const Value: TFont);
+begin
+ FFontOutgoingTimestamp.Assign(Value);
+ FFontOutgoingTimestamp.OnChange := FontChanged;
+ DoChange;
+end;
+
+procedure TGridOptions.SetFontSessHeader(const Value: TFont);
+begin
+ FFontSessHeader.Assign(Value);
+ FFontSessHeader.OnChange := FontChanged;
+ DoChange;
+end;
+
+procedure TGridOptions.SetFontMessage(const Value: TFont);
+begin
+ FFontMessage.Assign(Value);
+ FFontMessage.OnChange := FontChanged;
+ DoChange;
+end;
+
+procedure TGridOptions.StartChange;
+begin
+ Inc(FLocks);
+end;
+
+procedure TGridOptions.SetProfileName(const Value: String);
+begin
+ if Value = FProfileName then
+ exit;
+ FProfileName := Value;
+ FForceProfileName := (Value <> '');
+ DoChange;
+end;
+
+{ TRichCache }
+
+procedure TRichCache.ApplyItemToRich(Item: PRichItem);
+begin
+ // force to send the size:
+ FRichHeight := -1;
+ // Item^.Rich.HandleNeeded;
+ Item^.Rich.Perform(EM_SETEVENTMASK, 0, 0);
+ Grid.ApplyItemToRich(Item^.GridItem, Item^.Rich);
+ Item^.Rich.Perform(EM_SETEVENTMASK, 0, ENM_REQUESTRESIZE);
+ Item^.Rich.Perform(EM_REQUESTRESIZE, 0, 0);
+ Assert(FRichHeight > 0, 'RichCache.ApplyItemToRich: rich is still <= 0 height');
+ Item^.Rich.Perform(EM_SETEVENTMASK, 0, RichEventMasks);
+end;
+
+function TRichCache.CalcItemHeight(GridItem: Integer): Integer;
+var
+ Item: PRichItem;
+begin
+ Item := RequestItem(GridItem);
+ Assert(Item <> nil);
+ Result := Item^.Height;
+end;
+
+constructor TRichCache.Create(AGrid: THistoryGrid);
+var
+ i: Integer;
+ RichItem: PRichItem;
+ dc: HDC;
+begin
+ inherited Create;
+
+ FRichWidth := -1;
+ FRichHeight := -1;
+ Grid := AGrid;
+ // cache size
+ SetLength(Items, 20);
+
+ RichEventMasks := ENM_LINK;
+
+ dc := GetDC(0);
+ LogX := GetDeviceCaps(dc, LOGPIXELSX);
+ LogY := GetDeviceCaps(dc, LOGPIXELSY);
+ ReleaseDC(0, dc);
+
+ FLockedList := TList.Create;
+
+ for i := 0 to Length(Items) - 1 do
+ begin
+ New(RichItem);
+ RichItem^.Bitmap := TBitmap.Create;
+ RichItem^.Height := -1;
+ RichItem^.GridItem := -1;
+ RichItem^.Rich := THPPRichEdit.Create(nil);
+ RichItem^.Rich.Name := 'CachedRichEdit' + intToStr(i);
+ // workaround of SmileyAdd making richedit visible all the time
+ RichItem^.Rich.Top := -MaxInt;
+ RichItem^.Rich.Height := -1;
+ RichItem^.Rich.Visible := False;
+ { Don't give him grid as parent, or we'll have
+ wierd problems with scroll bar }
+ RichItem^.Rich.Parent := nil;
+ RichItem^.Rich.WordWrap := True;
+ RichItem^.Rich.BorderStyle := bsNone;
+ RichItem^.Rich.OnResizeRequest := OnRichResize;
+ Items[i] := RichItem;
+ end;
+end;
+
+destructor TRichCache.Destroy;
+var
+ i: Integer;
+begin
+ for i := 0 to FLockedList.Count - 1 do
+ Dispose(PLockedItem(FLockedList.Items[i]));
+ FLockedList.Free;
+ for i := 0 to Length(Items) - 1 do
+ begin
+ FreeAndNil(Items[i]^.Rich);
+ FreeAndNil(Items[i]^.Bitmap);
+ Dispose(Items[i]);
+ end;
+ Finalize(Items);
+ inherited;
+end;
+
+function TRichCache.FindGridItem(GridItem: Integer): Integer;
+var
+ i: Integer;
+begin
+ Result := -1;
+ if GridItem = -1 then
+ exit;
+ for i := 0 to Length(Items) - 1 do
+ if Items[i].GridItem = GridItem then
+ begin
+ Result := i;
+ break;
+ end;
+end;
+
+function TRichCache.GetItemRich(GridItem: Integer): THPPRichEdit;
+var
+ Item: PRichItem;
+begin
+ Item := RequestItem(GridItem);
+ Assert(Item <> nil);
+ Result := Item^.Rich;
+end;
+
+function TRichCache.GetItemRichBitmap(GridItem: Integer): TBitmap;
+var
+ Item: PRichItem;
+begin
+ Item := RequestItem(GridItem);
+ Assert(Item <> nil);
+ if not Item^.BitmapDrawn then
+ PaintRichToBitmap(Item);
+ Result := Item^.Bitmap;
+end;
+
+function TRichCache.GetItemByHandle(Handle: THandle): PRichItem;
+var
+ i: Integer;
+begin
+ Result := nil;
+ for i := 0 to High(Items) do
+ if Items[i].Rich.Handle = Handle then
+ begin
+ if Items[i].Height = -1 then
+ break;
+ Result := Items[i];
+ break;
+ end;
+end;
+
+function TRichCache.LockItem(Item: PRichItem; SaveRect: TRect): Integer;
+var
+ LockedItem: PLockedItem;
+begin
+ Result := -1;
+ Assert(Item <> nil);
+ try
+ New(LockedItem);
+ except
+ LockedItem := nil;
+ end;
+ if Assigned(LockedItem) then
+ begin
+ Item.Bitmap.Canvas.Lock;
+ LockedItem.RichItem := Item;
+ LockedItem.SaveRect := SaveRect;
+ Result := FLockedList.Add(LockedItem);
+ end;
+end;
+
+function TRichCache.UnlockItem(Item: Integer): TRect;
+var
+ LockedItem: PLockedItem;
+begin
+ Result := Rect(0, 0, 0, 0);
+ if Item = -1 then
+ exit;
+ LockedItem := FLockedList.Items[Item];
+ if not Assigned(LockedItem) then
+ exit;
+ if Assigned(LockedItem.RichItem) then
+ LockedItem.RichItem.Bitmap.Canvas.Unlock;
+ Result := LockedItem.SaveRect;
+ Dispose(LockedItem);
+ FLockedList.Delete(Item);
+end;
+
+procedure TRichCache.MoveToTop(Index: Integer);
+var
+ i: Integer;
+ Item: PRichItem;
+begin
+ if Index = 0 then
+ exit;
+ Assert(Index < Length(Items));
+ Item := Items[Index];
+ for i := Index downto 1 do
+ Items[i] := Items[i - 1];
+ // Move(Items[0],Items[1],Index*SizeOf(Items[0]));
+ Items[0] := Item;
+end;
+
+procedure TRichCache.OnRichResize(Sender: TObject; Rect: TRect);
+begin
+ FRichHeight := Rect.Bottom - Rect.Top;
+end;
+
+procedure TRichCache.PaintRichToBitmap(Item: PRichItem);
+var
+ BkColor: TCOLORREF;
+ Range: TFormatRange;
+begin
+ if (Item^.Bitmap.Width <> Item^.Rich.Width) or (Item^.Bitmap.Height <> Item^.Height) then
+ begin
+ // to prevent image copy
+ Item^.Bitmap.Assign(nil);
+ Item^.Bitmap.SetSize(Item^.Rich.Width, Item^.Height);
+ end;
+ // because RichEdit sometimes paints smaller image
+ // than it said when calculating height, we need
+ // to fill the background
+ BkColor := Item^.Rich.Perform(EM_SETBKGNDCOLOR, 0, 0);
+ Item^.Rich.Perform(EM_SETBKGNDCOLOR, 0, BkColor);
+ Item^.Bitmap.TransparentColor := BkColor;
+ Item^.Bitmap.Canvas.Brush.Color := BkColor;
+ Item^.Bitmap.Canvas.FillRect(Item^.Bitmap.Canvas.ClipRect);
+ with Range do
+ begin
+ HDC := Item^.Bitmap.Canvas.Handle;
+ hdcTarget := HDC;
+ rc := Rect(0, 0, MulDiv(Item^.Bitmap.Width, 1440, LogX),
+ MulDiv(Item^.Bitmap.Height, 1440, LogY));
+ rcPage := rc;
+ chrg.cpMin := 0;
+ chrg.cpMax := -1;
+ end;
+ SetBkMode(Range.hdcTarget, TRANSPARENT);
+ Item^.Rich.Perform(EM_FORMATRANGE, 1, lParam(@Range));
+ Item^.Rich.Perform(EM_FORMATRANGE, 0, 0);
+ Item^.BitmapDrawn := True;
+end;
+
+function TRichCache.RequestItem(GridItem: Integer): PRichItem;
+var
+ idx: Integer;
+begin
+ Assert(GridItem > -1);
+ idx := FindGridItem(GridItem);
+ if idx <> -1 then
+ begin
+ Result := Items[idx];
+ end
+ else
+ begin
+ idx := High(Items);
+ Result := Items[idx];
+ Result.GridItem := GridItem;
+ Result.Height := -1;
+ end;
+ if Result.Height = -1 then
+ begin
+ ApplyItemToRich(Result);
+ Result.Height := FRichHeight;
+ Result.Rich.Height := FRichHeight;
+ Result.BitmapDrawn := False;
+ MoveToTop(idx);
+ end;
+end;
+
+procedure TRichCache.ResetAllItems;
+var
+ i: Integer;
+begin
+ for i := 0 to High(Items) do
+ begin
+ Items[i].Height := -1;
+ end;
+end;
+
+procedure TRichCache.ResetItem(GridItem: Integer);
+var
+ idx: Integer;
+begin
+ if GridItem = -1 then
+ exit;
+ idx := FindGridItem(GridItem);
+ if idx = -1 then
+ exit;
+ Items[idx].Height := -1;
+end;
+
+procedure TRichCache.ResetItems(GridItems: array of Integer);
+var
+ i: Integer;
+ idx: Integer;
+ ItemsReset: Integer;
+begin
+ ItemsReset := 0;
+ for i := 0 to Length(GridItems) - 1 do
+ begin
+ idx := FindGridItem(GridItems[i]);
+ if idx <> -1 then
+ begin
+ Items[idx].Height := -1;
+ Inc(ItemsReset);
+ end;
+ // no point in searching, we've reset all items
+ if ItemsReset >= Length(Items) then
+ break;
+ end;
+end;
+
+procedure TRichCache.SetHandles;
+var
+ i: Integer;
+ ExStyle: DWord;
+begin
+ for i := 0 to Length(Items) - 1 do
+ begin
+ Items[i].Rich.ParentWindow := Grid.Handle;
+ // make richedit transparent:
+ ExStyle := GetWindowLongPtr(Items[i].Rich.Handle, GWL_EXSTYLE);
+ ExStyle := ExStyle or WS_EX_TRANSPARENT;
+ SetWindowLongPtr(Items[i].Rich.Handle, GWL_EXSTYLE, ExStyle);
+ Items[i].Rich.Brush.Style := bsClear;
+ end;
+end;
+
+procedure TRichCache.SetWidth(const Value: Integer);
+var
+ i: Integer;
+begin
+ if FRichWidth = Value then
+ exit;
+ FRichWidth := Value;
+ for i := 0 to Length(Items) - 1 do
+ begin
+ Items[i].Rich.Width := Value;
+ Items[i].Height := -1;
+ end;
+end;
+
+procedure TRichCache.WorkOutItemAdded(GridItem: Integer);
+var
+ i: Integer;
+begin
+ for i := 0 to Length(Items) - 1 do
+ if Items[i].Height <> -1 then
+ begin
+ if Items[i].GridItem >= GridItem then
+ Inc(Items[i].GridItem);
+ end;
+end;
+
+procedure TRichCache.WorkOutItemDeleted(GridItem: Integer);
+var
+ i: Integer;
+begin
+ for i := 0 to Length(Items) - 1 do
+ if Items[i].Height <> -1 then
+ begin
+ if Items[i].GridItem = GridItem then
+ Items[i].Height := -1
+ else if Items[i].GridItem > GridItem then
+ Dec(Items[i].GridItem);
+ end;
+end;
+
+initialization
+
+ Screen.Cursors[crHandPoint] := LoadCursor(0, IDC_HAND);
+ if Screen.Cursors[crHandPoint] = 0 then
+ Screen.Cursors[crHandPoint] := LoadCursor(hInstance, 'CR_HAND');
+
+end.
diff --git a/plugins/HistoryPlusPlus/PassCheckForm.dfm b/plugins/HistoryPlusPlus/PassCheckForm.dfm new file mode 100644 index 0000000000..3db1ed206c --- /dev/null +++ b/plugins/HistoryPlusPlus/PassCheckForm.dfm @@ -0,0 +1,100 @@ +object fmPassCheck: TfmPassCheck
+ Left = 398
+ Top = 290
+ ActiveControl = edPass
+ BorderIcons = [biSystemMenu]
+ BorderStyle = bsDialog
+ Caption = 'Password Check'
+ ClientHeight = 166
+ ClientWidth = 280
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'MS Sans Serif'
+ Font.Style = []
+ KeyPreview = True
+ OldCreateOrder = False
+ Position = poScreenCenter
+ OnClose = FormClose
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnKeyDown = FormKeyDown
+ PixelsPerInch = 96
+ TextHeight = 13
+ object Label1: TLabel
+ Left = 10
+ Top = 92
+ Width = 49
+ Height = 13
+ Caption = 'Password:'
+ end
+ object Image1: TImage
+ Left = 10
+ Top = 10
+ Width = 32
+ Height = 29
+ AutoSize = True
+ Transparent = True
+ end
+ object Label2: TLabel
+ Left = 50
+ Top = 10
+ Width = 220
+ Height = 31
+ AutoSize = False
+ Caption = 'Enter password'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'MS Sans Serif'
+ Font.Style = [fsBold]
+ ParentFont = False
+ WordWrap = True
+ end
+ object Label3: TLabel
+ Left = 10
+ Top = 46
+ Width = 260
+ Height = 37
+ AutoSize = False
+ Caption = 'To access Password Protection options you need to enter password'
+ WordWrap = True
+ end
+ object Bevel1: TBevel
+ Left = 10
+ Top = 124
+ Width = 260
+ Height = 2
+ end
+ object edPass: TEdit
+ Left = 77
+ Top = 88
+ Width = 193
+ Height = 21
+ MaxLength = 100
+ TabOrder = 0
+ PasswordChar = '*'
+ OnKeyPress = edPassKeyPress
+ end
+ object bnOK: TButton
+ Left = 118
+ Top = 134
+ Width = 75
+ Height = 25
+ Caption = 'OK'
+ Default = True
+ TabOrder = 1
+ OnClick = bnOKClick
+ end
+ object bnCancel: TButton
+ Left = 196
+ Top = 134
+ Width = 75
+ Height = 25
+ Cancel = True
+ Caption = 'Cancel'
+ TabOrder = 2
+ OnClick = bnCancelClick
+ end
+end
diff --git a/plugins/HistoryPlusPlus/PassCheckForm.pas b/plugins/HistoryPlusPlus/PassCheckForm.pas new file mode 100644 index 0000000000..d90e1054ff --- /dev/null +++ b/plugins/HistoryPlusPlus/PassCheckForm.pas @@ -0,0 +1,149 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+unit PassCheckForm;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ StdCtrls, Checksum, ExtCtrls,m_api, hpp_forms,
+ HistoryControls;
+
+type
+ TfmPassCheck = class(TForm)
+ Label1: TLabel;
+ edPass: TEdit;
+ bnOK: TButton;
+ bnCancel: TButton;
+ Image1: TImage;
+ Label2: TLabel;
+ Label3: TLabel;
+ Bevel1: TBevel;
+ procedure FormDestroy(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure bnOKClick(Sender: TObject);
+ procedure bnCancelClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure edPassKeyPress(Sender: TObject; var Key: Char);
+ procedure FormCreate(Sender: TObject);
+ private
+ procedure TranslateForm;
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ fmPassCheck: TfmPassCheck;
+
+implementation
+
+uses hpp_options, hpp_services, hpp_global, PassForm;
+
+{$R *.DFM}
+
+procedure TfmPassCheck.FormDestroy(Sender: TObject);
+begin
+ try
+ PassCheckFm := nil;
+ except
+ end;
+end;
+
+procedure TfmPassCheck.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+ Action := caFree;
+end;
+
+procedure TfmPassCheck.bnOKClick(Sender: TObject);
+begin
+ if CheckPassword(AnsiString(edPass.Text)) then
+ begin
+ if not Assigned(PassFm) then
+ begin
+ PassFm := TfmPass.Create(nil);
+ end;
+ PassFm.Show;
+ Close;
+ end
+ else
+ begin
+ { DONE: sHure }
+ HppMessageBox(Handle, TranslateW('You have entered the wrong password.'),
+ TranslateW('History++ Password Protection'), MB_OK or MB_DEFBUTTON1 or MB_ICONSTOP);
+ end;
+end;
+
+procedure TfmPassCheck.bnCancelClick(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure TfmPassCheck.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+var
+ Mask: Integer;
+begin
+ with Sender as TWinControl do
+ begin
+ if Perform(CM_CHILDKEY, Key, LPARAM(Sender)) <> 0 then
+ Exit;
+ Mask := 0;
+ case Key of
+ VK_TAB:
+ Mask := DLGC_WANTTAB;
+ VK_RETURN, VK_EXECUTE, VK_ESCAPE, VK_CANCEL:
+ Mask := DLGC_WANTALLKEYS;
+ end;
+ if (Mask <> 0) and (Perform(CM_WANTSPECIALKEY, Key, 0) = 0) and
+ (Perform(WM_GETDLGCODE, 0, 0) and Mask = 0) and (Self.Perform(CM_DIALOGKEY, Key, 0) <> 0)
+ then
+ Exit;
+ end;
+end;
+
+procedure TfmPassCheck.edPassKeyPress(Sender: TObject; var Key: Char);
+begin
+ if (Key = Chr(VK_RETURN)) or
+ (Key = Chr(VK_TAB)) or
+ (Key = Chr(VK_ESCAPE)) then
+ Key := #0;
+end;
+
+procedure TfmPassCheck.TranslateForm;
+begin
+ Caption := TranslateUnicodeString(Caption);
+ Label3.Caption := TranslateUnicodeString(Label3.Caption);
+ Label2.Caption := TranslateUnicodeString(Label2.Caption);
+ Label1.Caption := TranslateUnicodeString(Label1.Caption);
+ bnOK.Caption := TranslateUnicodeString(bnOK.Caption);
+ bnCancel.Caption := TranslateUnicodeString(bnCancel.Caption);
+end;
+
+procedure TfmPassCheck.FormCreate(Sender: TObject);
+begin
+ DesktopFont := True;
+ MakeFontsParent(Self);
+ TranslateForm;
+ Image1.Picture.Icon.Handle := CopyIcon(hppIntIcons[0].handle);
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/PassForm.dfm b/plugins/HistoryPlusPlus/PassForm.dfm new file mode 100644 index 0000000000..ced13628fe --- /dev/null +++ b/plugins/HistoryPlusPlus/PassForm.dfm @@ -0,0 +1,136 @@ +object fmPass: TfmPass
+ Left = 359
+ Top = 180
+ BorderIcons = [biSystemMenu]
+ BorderStyle = bsDialog
+ Caption = 'History++ Password Protection'
+ ClientHeight = 329
+ ClientWidth = 300
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'MS Sans Serif'
+ Font.Style = []
+ KeyPreview = True
+ OldCreateOrder = False
+ Position = poScreenCenter
+ OnClose = FormClose
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnKeyDown = FormKeyDown
+ PixelsPerInch = 96
+ TextHeight = 13
+ object Image1: TImage
+ Left = 10
+ Top = 10
+ Width = 32
+ Height = 29
+ AutoSize = True
+ Transparent = True
+ end
+ object laPassState: TLabel
+ Left = 106
+ Top = 254
+ Width = 174
+ Height = 25
+ AutoSize = False
+ Caption = '-'
+ Layout = tlCenter
+ WordWrap = True
+ end
+ object Bevel1: TBevel
+ Left = 10
+ Top = 291
+ Width = 280
+ Height = 2
+ end
+ object Label1: TLabel
+ Left = 50
+ Top = 10
+ Width = 102
+ Height = 13
+ Caption = 'Password Options'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'MS Sans Serif'
+ Font.Style = [fsBold]
+ ParentFont = False
+ end
+ object rbProtAll: TRadioButton
+ Left = 10
+ Top = 53
+ Width = 280
+ Height = 17
+ Caption = 'Protect all contacts'
+ Checked = True
+ TabOrder = 0
+ TabStop = True
+ OnClick = rbProtSelClick
+ end
+ object rbProtSel: TRadioButton
+ Left = 10
+ Top = 73
+ Width = 280
+ Height = 17
+ Caption = 'Protect only selected contacts'
+ TabOrder = 1
+ TabStop = True
+ OnClick = rbProtSelClick
+ end
+ object lvCList: TListView
+ Left = 10
+ Top = 93
+ Width = 280
+ Height = 150
+ Checkboxes = True
+ Columns = <
+ item
+ Width = 276
+ end>
+ ReadOnly = True
+ RowSelect = True
+ PopupMenu = PopupMenu1
+ ShowColumnHeaders = False
+ SortType = stText
+ TabOrder = 2
+ ViewStyle = vsReport
+ end
+ object bnPass: TButton
+ Left = 10
+ Top = 254
+ Width = 89
+ Height = 25
+ Caption = 'Password...'
+ TabOrder = 3
+ OnClick = bnPassClick
+ end
+ object bnCancel: TButton
+ Left = 215
+ Top = 299
+ Width = 75
+ Height = 25
+ Cancel = True
+ Caption = 'Cancel'
+ TabOrder = 5
+ OnClick = bnCancelClick
+ end
+ object bnOK: TButton
+ Left = 135
+ Top = 299
+ Width = 75
+ Height = 25
+ Caption = 'OK'
+ TabOrder = 4
+ OnClick = bnOKClick
+ end
+ object PopupMenu1: TPopupMenu
+ Left = 186
+ Top = 144
+ object Refresh1: TMenuItem
+ Caption = '&Refresh List'
+ OnClick = Refresh1Click
+ end
+ end
+end
diff --git a/plugins/HistoryPlusPlus/PassForm.pas b/plugins/HistoryPlusPlus/PassForm.pas new file mode 100644 index 0000000000..299a5a6959 --- /dev/null +++ b/plugins/HistoryPlusPlus/PassForm.pas @@ -0,0 +1,353 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+unit PassForm;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ ComCtrls, Menus, Checksum, ExtCtrls, StdCtrls,
+ m_api,
+ hpp_global, hpp_contacts, hpp_database, hpp_forms;
+
+type
+ TfmPass = class(TForm)
+ Image1: TImage;
+ rbProtAll: TRadioButton;
+ rbProtSel: TRadioButton;
+ lvCList: TListView;
+ bnPass: TButton;
+ laPassState: TLabel;
+ Bevel1: TBevel;
+ bnCancel: TButton;
+ bnOK: TButton;
+ PopupMenu1: TPopupMenu;
+ Refresh1: TMenuItem;
+ Label1: TLabel;
+ procedure bnCancelClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure rbProtSelClick(Sender: TObject);
+ procedure bnPassClick(Sender: TObject);
+ procedure bnOKClick(Sender: TObject);
+ procedure Refresh1Click(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure FormDestroy(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ private
+ PassMode: Byte;
+ Password: AnsiString;
+ FLastContact: THandle;
+ procedure FillList;
+ procedure UpdatePassword;
+ procedure SetlastContact(const Value: THandle);
+ procedure TranslateForm;
+ public
+ property LastContact: THandle read FLastContact write SetLastContact;
+ { Public declarations }
+ end;
+
+var
+ fmPass: TfmPass;
+
+const
+ PASSMODE_PROTNONE = 0; // no protection, not used
+ PASSMODE_PROTALL = 1; // protect all contacts
+ PASSMODE_PROTSEL = 2; // protect ONLY selected contacts
+ PASSMODE_PROTNOTSEL = 3; // protect ALL, except selected contacts (not used)
+
+function ReadPassModeFromDB: Byte;
+function GetPassMode: Byte;
+function GetPassword: AnsiString;
+function IsPasswordBlank(Password: AnsiString): Boolean;
+function IsUserProtected(hContact: THandle): Boolean;
+function CheckPassword(Pass: AnsiString): Boolean;
+
+procedure RunPassForm;
+
+implementation
+
+uses PassNewForm, hpp_options, hpp_services, PassCheckForm;
+
+{$R *.DFM}
+
+procedure RunPassForm;
+begin
+ if Assigned(PassFm) then
+ begin
+ PassFm.Show;
+ exit;
+ end;
+ if Assigned(PassCheckFm) then
+ begin
+ PassCheckFm.Show;
+ exit;
+ end;
+ if IsPasswordBlank(GetPassword) then
+ begin
+ if not Assigned(PassFm) then
+ begin
+ PassFm := TfmPass.Create(nil);
+ end;
+ PassFm.Show;
+ end
+ else
+ begin
+ PassCheckFm := TfmPassCheck.Create(nil);
+ PassCheckFm.Show;
+ end;
+end;
+
+function CheckPassword(Pass: AnsiString): Boolean;
+begin
+ Result := (DigToBase(HashString(Pass)) = GetPassword);
+end;
+
+function IsUserProtected(hContact: THandle): Boolean;
+begin
+ Result := False;
+ case GetPassMode of
+ PASSMODE_PROTNONE: Result := False;
+ PASSMODE_PROTALL: Result := True;
+ PASSMODE_PROTSEL: Result := (DBGetContactSettingByte(hContact, hppDBName, 'PasswordProtect', 0) = 1);
+ PASSMODE_PROTNOTSEL: Result := (DBGetContactSettingByte(hContact, hppDBName, 'PasswordProtect', 1) = 1);
+ end;
+ if IsPasswordBlank(GetPassword) then;
+end;
+
+function IsPasswordBlank(Password: AnsiString): Boolean;
+begin
+ Result := (Password = DigToBase(HashString('')));
+end;
+
+function GetPassword: AnsiString;
+begin
+ Result := GetDBStr(hppDBName,'Password',DigToBase(HashString('')));
+end;
+
+function ReadPassModeFromDB: Byte;
+begin
+ Result := GetDBByte(hppDBName,'PasswordMode',PASSMODE_PROTALL);
+end;
+
+function GetPassMode: Byte;
+begin
+ Result := ReadPassModeFromDB;
+ if IsPasswordBlank(GetPassword) then
+ Result := PASSMODE_PROTNONE;
+end;
+
+procedure TfmPass.bnCancelClick(Sender: TObject);
+begin
+ close;
+end;
+
+procedure AddContact(var lvCList:TListView; Contact: THandle);
+var
+ li: TListItem;
+ Capt: String;
+begin
+ li := lvCList.Items.Add;
+ if Contact = 0 then
+ begin
+ Capt := TranslateW('System History') + ' (' + GetContactDisplayName(Contact, 'ICQ') + ')';
+ end
+ else
+ Capt := GetContactDisplayName(Contact);
+ li.Caption := Capt;
+ li.Data := Pointer(Contact);
+ li.Checked := DBGetContactSettingByte(Contact, hppDBName, 'PasswordProtect', 0) = 1;
+end;
+
+procedure TfmPass.FillList;
+var
+ hCont: THandle;
+begin
+ lvCList.Items.BeginUpdate;
+ try
+ lvCList.Items.Clear;
+ hCont := CallService(MS_DB_CONTACT_FINDFIRST, 0, 0);
+ while hCont <> 0 do
+ begin
+ AddContact(lvCList,hCont);
+ hCont := CallService(MS_DB_CONTACT_FINDNEXT, hCont, 0);
+ end;
+ AddContact(lvCList,0);
+ lvCList.SortType := stNone;
+ lvCList.SortType := stText;
+ finally
+ lvCList.Items.EndUpdate;
+ end;
+end;
+
+procedure TfmPass.FormCreate(Sender: TObject);
+begin
+ DesktopFont := True;
+ MakeFontsParent(Self);
+ TranslateForm;
+ FillList;
+ PassMode := ReadPassModeFromDB;
+ if not(PassMode in [PASSMODE_PROTALL, PASSMODE_PROTSEL]) then
+ PassMode := PASSMODE_PROTALL;
+ Password := GetPassword;
+
+ if PassMode = PASSMODE_PROTSEL then
+ rbProtSel.Checked := True
+ else
+ rbProtAll.Checked := True;
+ rbProtSelClick(Self);
+ UpdatePassword;
+ Image1.Picture.Icon.Handle := CopyIcon(hppIntIcons[0].Handle);
+end;
+
+procedure TfmPass.rbProtSelClick(Sender: TObject);
+begin
+ if rbProtSel.Checked then
+ PassMode := PASSMODE_PROTSEL
+ else if rbProtAll.Checked then
+ PassMode := PASSMODE_PROTALL;
+
+ if rbProtSel.Checked then
+ begin
+ lvCList.Enabled := True;
+ lvCList.Color := clWindow;
+ end
+ else
+ begin
+ lvCList.Enabled := False;
+ lvCList.Color := clInactiveBorder;
+ end;
+end;
+
+procedure TfmPass.bnPassClick(Sender: TObject);
+begin
+ with TfmPassNew.Create(Self) do
+ begin
+ if ShowModal = mrOK then
+ begin
+ Password := DigToBase(HashString(AnsiString(edPass.Text)));
+ UpdatePassword;
+ end;
+ Free;
+ end;
+end;
+
+procedure TfmPass.UpdatePassword;
+begin
+ if Password = DigToBase(HashString('')) then
+ begin
+ // password not set
+ laPassState.Font.Style := laPassState.Font.Style + [fsBold];
+ laPassState.Caption := TranslateW('Password not set');
+ end
+ else
+ begin
+ // password set
+ laPassState.ParentFont := True;
+ laPassState.Caption := TranslateW('Password set');
+ end;
+end;
+
+procedure TfmPass.bnOKClick(Sender: TObject);
+var
+ i: Integer;
+ li: TListItem;
+begin
+ WriteDBByte(hppDBName,'PasswordMode',PassMode);
+ WriteDBStr(hppDBName, 'Password', Password);
+ if PassMode = PASSMODE_PROTSEL then
+ begin
+ for i := 0 to lvCList.Items.Count - 1 do
+ begin
+ li := lvCList.Items[i];
+ if li.Checked then
+ DBWriteContactSettingByte(THANDLE(li.Data), hppDBName, 'PasswordProtect', 1)
+ else
+ DBDeleteContactSetting(THANDLE(li.Data), hppDBName, 'PasswordProtect');
+ end;
+ end;
+
+ close;
+end;
+
+procedure TfmPass.SetlastContact(const Value: THandle);
+begin
+ FLastContact := Value;
+end;
+
+procedure TfmPass.Refresh1Click(Sender: TObject);
+begin
+ FillList;
+end;
+
+procedure TfmPass.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+ Action := caFree;
+end;
+
+procedure TfmPass.FormDestroy(Sender: TObject);
+begin
+ try
+ PassFm := nil;
+ except
+ end;
+end;
+
+procedure TfmPass.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+var
+ Mask: Integer;
+begin
+ with Sender as TWinControl do
+ begin
+ if Perform(CM_CHILDKEY, Key, LPARAM(Sender)) <> 0 then
+ Exit;
+ Mask := 0;
+ case Key of
+ VK_TAB:
+ Mask := DLGC_WANTTAB;
+ VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN:
+ // added to change radio buttons from keyboard
+ // however, we have to disable it when lvCList is focused
+ if not lvCList.Focused then Mask := DLGC_WANTARROWS;
+ VK_RETURN, VK_EXECUTE, VK_ESCAPE, VK_CANCEL:
+ Mask := DLGC_WANTALLKEYS;
+ end;
+ if (Mask <> 0) and
+ (Perform(CM_WANTSPECIALKEY, Key, 0) = 0) and
+ (Perform(WM_GETDLGCODE, 0, 0) and Mask = 0) and
+ (Perform(CM_DIALOGKEY, Key, 0) <> 0) then
+ exit;
+ end;
+end;
+
+procedure TfmPass.TranslateForm;
+begin
+ Caption := TranslateUnicodeString(Caption);
+ Label1.Caption := TranslateUnicodeString(Label1.Caption);
+ rbProtAll.Caption := TranslateUnicodeString(rbProtAll.Caption);
+ rbProtSel.Caption := TranslateUnicodeString(rbProtSel.Caption);
+ bnPass.Caption := TranslateUnicodeString(bnPass.Caption);
+ bnOK.Caption := TranslateUnicodeString(bnOK.Caption);
+ bnCancel.Caption := TranslateUnicodeString(bnCancel.Caption);
+ Refresh1.Caption := TranslateUnicodeString(Refresh1.Caption);
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/PassNewForm.dfm b/plugins/HistoryPlusPlus/PassNewForm.dfm new file mode 100644 index 0000000000..c835d57271 --- /dev/null +++ b/plugins/HistoryPlusPlus/PassNewForm.dfm @@ -0,0 +1,120 @@ +object fmPassNew: TfmPassNew
+ Left = 460
+ Top = 222
+ ActiveControl = edPass
+ BorderIcons = [biSystemMenu]
+ BorderStyle = bsDialog
+ Caption = 'New Password'
+ ClientHeight = 203
+ ClientWidth = 320
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'MS Sans Serif'
+ Font.Style = []
+ OldCreateOrder = False
+ Position = poMainFormCenter
+ OnCreate = FormCreate
+ PixelsPerInch = 96
+ TextHeight = 13
+ object Label1: TLabel
+ Left = 52
+ Top = 10
+ Width = 243
+ Height = 31
+ AutoSize = False
+ Caption = 'Enter new password'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'MS Sans Serif'
+ Font.Style = [fsBold]
+ ParentFont = False
+ end
+ object Label2: TLabel
+ Left = 10
+ Top = 88
+ Width = 49
+ Height = 13
+ Caption = 'Password:'
+ end
+ object Label3: TLabel
+ Left = 10
+ Top = 113
+ Width = 38
+ Height = 13
+ Caption = 'Confirm:'
+ end
+ object Label4: TLabel
+ Left = 10
+ Top = 139
+ Width = 297
+ Height = 18
+ AutoSize = False
+ Caption = 'Leave this fields blank to disable password'
+ WordWrap = True
+ end
+ object Image1: TImage
+ Left = 10
+ Top = 10
+ Width = 32
+ Height = 29
+ AutoSize = True
+ Transparent = True
+ end
+ object Label5: TLabel
+ Left = 10
+ Top = 50
+ Width = 295
+ Height = 27
+ AutoSize = False
+ Caption = 'Pay attention to CAPS LOCK button state'
+ WordWrap = True
+ end
+ object Bevel1: TBevel
+ Left = 10
+ Top = 162
+ Width = 300
+ Height = 2
+ end
+ object edPass: TEdit
+ Left = 72
+ Top = 84
+ Width = 234
+ Height = 21
+ MaxLength = 100
+ PasswordChar = '*'
+ TabOrder = 0
+ end
+ object edConf: TEdit
+ Left = 72
+ Top = 109
+ Width = 234
+ Height = 21
+ MaxLength = 100
+ PasswordChar = '*'
+ TabOrder = 1
+ end
+ object bnCancel: TButton
+ Left = 235
+ Top = 171
+ Width = 75
+ Height = 25
+ Cancel = True
+ Caption = 'Cancel'
+ TabOrder = 3
+ OnClick = bnCancelClick
+ end
+ object bnOK: TButton
+ Left = 156
+ Top = 171
+ Width = 75
+ Height = 25
+ Cancel = True
+ Caption = 'OK'
+ Default = True
+ TabOrder = 2
+ OnClick = bnOKClick
+ end
+end
diff --git a/plugins/HistoryPlusPlus/PassNewForm.pas b/plugins/HistoryPlusPlus/PassNewForm.pas new file mode 100644 index 0000000000..03d08723a6 --- /dev/null +++ b/plugins/HistoryPlusPlus/PassNewForm.pas @@ -0,0 +1,98 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+unit PassNewForm;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ StdCtrls, ExtCtrls,m_api, HistoryControls, hpp_forms;
+
+type
+ TfmPassNew = class(TForm)
+ Label1: TLabel;
+ Label2: TLabel;
+ edPass: TEdit;
+ edConf: TEdit;
+ Label3: TLabel;
+ bnCancel: TButton;
+ bnOK: TButton;
+ Label4: TLabel;
+ Image1: TImage;
+ Label5: TLabel;
+ Bevel1: TBevel;
+ procedure bnCancelClick(Sender: TObject);
+ procedure bnOKClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ private
+ procedure TranslateForm;
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ fmPassNew: TfmPassNew;
+
+implementation
+
+uses hpp_global, hpp_options;
+
+{$R *.DFM}
+
+procedure TfmPassNew.bnCancelClick(Sender: TObject);
+begin
+ ModalResult := mrCancel;
+end;
+
+procedure TfmPassNew.bnOKClick(Sender: TObject);
+begin
+ if edPass.Text <> edConf.Text then
+ begin
+ MessageBox(Handle, TranslateW('Password and Confirm fields should be similar'),
+ TranslateW('Error'), MB_OK or MB_DEFBUTTON1 or MB_ICONEXCLAMATION);
+ exit;
+ end;
+ ModalResult := mrOK;
+end;
+
+procedure TfmPassNew.TranslateForm;
+begin
+ Caption := TranslateUnicodeString(Caption);
+ Label1.Caption := TranslateUnicodeString(Label1.Caption);
+ Label5.Caption := TranslateUnicodeString(Label5.Caption);
+ Label2.Caption := TranslateUnicodeString(Label2.Caption);
+ Label3.Caption := TranslateUnicodeString(Label3.Caption);
+ Label4.Caption := TranslateUnicodeString(Label4.Caption);
+ bnOK.Caption := TranslateUnicodeString(bnOK.Caption);
+ bnCancel.Caption := TranslateUnicodeString(bnCancel.Caption);
+end;
+
+procedure TfmPassNew.FormCreate(Sender: TObject);
+begin
+ TranslateForm;
+ DesktopFont := True;
+ MakeFontsParent(Self);
+ Image1.Picture.Icon.Handle := CopyIcon(hppIntIcons[0].handle);
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/VertSB.pas b/plugins/HistoryPlusPlus/VertSB.pas new file mode 100644 index 0000000000..4629d29c4b --- /dev/null +++ b/plugins/HistoryPlusPlus/VertSB.pas @@ -0,0 +1,601 @@ +{-----------------------------------------------------------------------------
+ VertSB (historypp project)
+
+ Version: 1.0
+ Created: 25.03.2003
+ Author: Oxygen
+
+ [ Description ]
+
+ Reimplementation of TControlScrollBar for use with
+ THistoryGrid to make scrolling much better. Sets Page
+ for scrollbar to different value, instead of using
+ Control's ClientHeight.
+
+ [ History ]
+
+ 1.0 () First Release.
+
+ [ Modifications ]
+
+ * (25.03.2003) Scrolling doesn't calls now Control.ScrollBy so slight
+ flicker is removed
+ * (31.03.2003) Setting pagesize now works!
+
+ [ Known Issues ]
+ None
+
+ Based on Borland's Forms.pas source.
+ Copyright (c) 1995,99 Inprise Corporation
+-----------------------------------------------------------------------------}
+
+
+unit VertSB;
+
+interface
+
+uses
+ Classes, Forms, Graphics, Messages, Controls, Math, Windows;
+
+type
+
+{ TVertScrollBar }
+
+ TScrollBarKind = (sbHorizontal, sbVertical);
+ TScrollBarInc = 1..32767;
+ TScrollBarStyle = (ssRegular, ssFlat, ssHotTrack);
+
+ TVertScrollBar = class(TPersistent)
+ private
+ FControl: TScrollingWinControl;
+ FIncrement: TScrollBarInc;
+ FPageIncrement: TScrollbarInc;
+ FPosition: Integer;
+ FRange: Integer;
+ FCalcRange: Integer;
+ FKind: TScrollBarKind;
+ FMargin: Word;
+ FVisible: Boolean;
+ FTracking: Boolean;
+ FPageSize: Integer;
+ FScaled: Boolean;
+ FSmooth: Boolean;
+ FDelay: Integer;
+ FButtonSize: Integer;
+ FColor: TColor;
+ FParentColor: Boolean;
+ FSize: Integer;
+ FStyle: TScrollBarStyle;
+ FThumbSize: Integer;
+ FPageDiv: Integer;
+ FLineDiv: Integer;
+ FUpdatingScrollBars: Boolean;
+ FUpdateNeeded: Boolean;
+ FHidden: Boolean;
+// procedure CalcAutoRange;
+ function ControlSize(ControlSB, AssumeSB: Boolean): Integer;
+ procedure DoSetRange(Value: Integer);
+ function GetScrollPos: Integer;
+ function NeedsScrollBarVisible: Boolean;
+ function IsIncrementStored: Boolean;
+ procedure SetButtonSize(Value: Integer);
+ procedure SetColor(Value: TColor);
+ procedure SetParentColor(Value: Boolean);
+ procedure SetPosition(Value: Integer);
+ procedure SetRange(Value: Integer);
+ procedure SetSize(Value: Integer);
+ procedure SetStyle(Value: TScrollBarStyle);
+ procedure SetThumbSize(Value: Integer);
+ procedure SetVisible(Value: Boolean);
+ function IsRangeStored: Boolean;
+ procedure Update(ControlSB, AssumeSB: Boolean);
+ procedure WINUpdateScrollBars;
+ procedure SetHidden(Value: Boolean);
+ public
+ constructor Create(AControl: TScrollingWinControl; AKind: TScrollBarKind);
+ procedure Assign(Source: TPersistent); override;
+ procedure ChangeBiDiPosition;
+ property Kind: TScrollBarKind read FKind;
+ function IsScrollBarVisible: Boolean;
+ property ScrollPos: Integer read GetScrollPos;
+ procedure ScrollMessage(var Msg: TWMScroll);
+ published
+ property ButtonSize: Integer read FButtonSize write SetButtonSize default 0;
+ property Color: TColor read FColor write SetColor default clBtnHighlight;
+ property Increment: TScrollBarInc read FIncrement write FIncrement stored IsIncrementStored default 8;
+ property Margin: Word read FMargin write FMargin default 0;
+ property ParentColor: Boolean read FParentColor write SetParentColor default True;
+ property Position: Integer read FPosition write SetPosition default 0;
+ property Range: Integer read FRange write SetRange stored IsRangeStored default 0;
+ property Smooth: Boolean read FSmooth write FSmooth default False;
+ property Size: Integer read FSize write SetSize default 0;
+ property Style: TScrollBarStyle read FStyle write SetStyle default ssRegular;
+ property ThumbSize: Integer read FThumbSize write SetThumbSize default 0;
+ property Tracking: Boolean read FTracking write FTracking default True;
+ property Visible: Boolean read FVisible write SetVisible default True;
+ property PageSize: Integer read FPageSize write FPageSize default 20;
+ property Hidden: Boolean read FHidden write SetHidden default False;
+ end;
+
+implementation
+
+uses FlatSB, CommCtrl;
+
+{ TVertScrollBar }
+
+procedure TVertScrollBar.WINUpdateScrollBars;
+begin
+ if not FUpdatingScrollBars and FControl.HandleAllocated then
+ try
+ FUpdatingScrollBars := True;
+ if NeedsScrollBarVisible{OXY: FControl.VertScrollBar.NeedsScrollBarVisible} then
+ begin
+ //FHorzScrollBar.Update(False, True);
+ Update(True, False);
+ end
+ else if False {OXY: FHorzScrollBar.NeedsScrollBarVisible} then
+ begin
+ Update(False, True);
+ //FHorzScrollBar.Update(True, False);
+ end
+ else
+ begin
+ Update(False, False);
+ //FHorzScrollBar.Update(True, False);
+ end;
+ finally
+ FUpdatingScrollBars := False;
+ end;
+end;
+
+constructor TVertScrollBar.Create(AControl: TScrollingWinControl; AKind: TScrollBarKind);
+begin
+ inherited Create;
+ FPageSize := 20;
+ FControl := AControl;
+ FKind := AKind;
+ FTracking := True;
+ FPageIncrement := 80;
+ FUpdatingScrollBars := False;
+ FIncrement := FPageIncrement div 10;
+ FVisible := True;
+ FDelay := 10;
+ FLineDiv := 1;
+ FPageDiv := 1;
+ FColor := clBtnHighlight;
+ FParentColor := True;
+ FUpdateNeeded := True;
+ FHidden := False;
+end;
+
+function TVertScrollBar.IsIncrementStored: Boolean;
+begin
+ Result := not Smooth;
+end;
+
+procedure TVertScrollBar.Assign(Source: TPersistent);
+begin
+ if Source is TVertScrollBar then
+ begin
+ Visible := TVertScrollBar(Source).Visible;
+ Range := TVertScrollBar(Source).Range;
+ Position := TVertScrollBar(Source).Position;
+ Increment := TVertScrollBar(Source).Increment;
+ Exit;
+ end;
+ inherited Assign(Source);
+end;
+
+procedure TVertScrollBar.ChangeBiDiPosition;
+begin
+ if Kind = sbHorizontal then
+ if IsScrollBarVisible then
+ if FControl.UseRightToLeftScrollBar then
+ Position := 0
+ else
+ Position := Range;
+end;
+(*
+procedure TVertScrollBar.CalcAutoRange;
+var
+ NewRange, AlignMargin: Integer;
+
+ procedure ProcessHorz(Control: TControl);
+ begin
+ if Control.Visible then
+ case Control.Align of
+ alLeft, alNone:
+ if (Control.Align = alLeft) or (Control.Anchors * [akLeft, akRight] = [akLeft]) then
+ NewRange := Max(NewRange, Position + Control.Left + Control.Width);
+ alRight: Inc(AlignMargin, Control.Width);
+ end;
+ end;
+
+ procedure ProcessVert(Control: TControl);
+ begin
+ if Control.Visible then
+ case Control.Align of
+ alTop, alNone:
+ if (Control.Align = alTop) or (Control.Anchors * [akTop, akBottom] = [akTop]) then
+ NewRange := Max(NewRange, Position + Control.Top + Control.Height);
+ alBottom: Inc(AlignMargin, Control.Height);
+ end;
+ end;
+
+var
+ i: Integer;
+begin
+ if False {OXY: FControl.AutoScroll } then
+ begin
+ if False {OXY: FControl.AutoScrollEnabled } then
+ begin
+ NewRange := 0;
+ AlignMargin := 0;
+ for i := 0 to FControl.ControlCount - 1 do
+ if Kind = sbHorizontal then
+ ProcessHorz(FControl.Controls[I]) else
+ ProcessVert(FControl.Controls[I]);
+ DoSetRange(NewRange + AlignMargin + Margin);
+ end
+ else DoSetRange(0);
+ end;
+end;
+*)
+
+function TVertScrollBar.IsScrollBarVisible: Boolean;
+var
+ Style: Longint;
+begin
+ Style := WS_HSCROLL;
+ if Kind = sbVertical then Style := WS_VSCROLL;
+ Result := (Visible) and
+ (GetWindowLongPtr(FControl.Handle, GWL_STYLE) and Style <> 0);
+end;
+
+function TVertScrollBar.ControlSize(ControlSB, AssumeSB: Boolean): Integer;
+var
+ BorderAdjust: Integer;
+
+ function ScrollBarVisible(Code: Word): Boolean;
+ var
+ Style: Longint;
+ begin
+ Style := WS_HSCROLL;
+ if Code = SB_VERT then Style := WS_VSCROLL;
+ Result := GetWindowLongPtr(FControl.Handle, GWL_STYLE) and Style <> 0;
+ end;
+
+ function Adjustment(Code, Metric: Word): Integer;
+ begin
+ Result := 0;
+ if not ControlSB then
+ if AssumeSB and not ScrollBarVisible(Code) then
+ Result := -(GetSystemMetrics(Metric) - BorderAdjust)
+ else if not AssumeSB and ScrollBarVisible(Code) then
+ Result := GetSystemMetrics(Metric) - BorderAdjust;
+ end;
+
+begin
+ BorderAdjust := Integer(GetWindowLongPtr(FControl.Handle, GWL_STYLE) and
+ (WS_BORDER or WS_THICKFRAME) <> 0);
+ if Kind = sbVertical then
+ Result := FControl.ClientHeight + Adjustment(SB_HORZ, SM_CXHSCROLL)
+ else
+ Result := FControl.ClientWidth + Adjustment(SB_VERT, SM_CYVSCROLL);
+end;
+
+function TVertScrollBar.GetScrollPos: Integer;
+begin
+ Result := 0;
+ if Visible then Result := Position;
+end;
+
+function TVertScrollBar.NeedsScrollBarVisible: Boolean;
+begin
+ Result := FRange > ControlSize(False, False);
+end;
+
+procedure TVertScrollBar.ScrollMessage(var Msg: TWMScroll);
+var
+ Incr, FinalIncr, Count: Integer;
+ CurrentTime, StartTime, ElapsedTime: Longint;
+
+ function GetRealScrollPosition: Integer;
+ var
+ SI: TScrollInfo;
+ Code: Integer;
+ begin
+ SI.cbSize := SizeOf(TScrollInfo);
+ SI.fMask := SIF_TRACKPOS;
+ Code := SB_HORZ;
+ if FKind = sbVertical then Code := SB_VERT;
+ Result := Msg.Pos;
+ if FlatSB_GetScrollInfo(FControl.Handle, Code, SI) then
+ Result := SI.nTrackPos;
+ end;
+
+begin
+ with Msg do
+ begin
+ if FSmooth and (ScrollCode in [SB_LINEUP, SB_LINEDOWN, SB_PAGEUP, SB_PAGEDOWN]) then
+ begin
+ case ScrollCode of
+ SB_LINEUP, SB_LINEDOWN:
+ begin
+ Incr := FIncrement div FLineDiv;
+ FinalIncr := FIncrement mod FLineDiv;
+ Count := FLineDiv;
+ end;
+ SB_PAGEUP, SB_PAGEDOWN:
+ begin
+ Incr := FPageIncrement;
+ FinalIncr := Incr mod FPageDiv;
+ Incr := Incr div FPageDiv;
+ Count := FPageDiv;
+ end;
+ else
+ Count := 0;
+ Incr := 0;
+ FinalIncr := 0;
+ end;
+ CurrentTime := 0;
+ while Count > 0 do
+ begin
+ StartTime := GetCurrentTime;
+ ElapsedTime := StartTime - CurrentTime;
+ if ElapsedTime < FDelay then Sleep(FDelay - ElapsedTime);
+ CurrentTime := StartTime;
+ case ScrollCode of
+ SB_LINEUP : SetPosition(FPosition - Incr);
+ SB_LINEDOWN: SetPosition(FPosition + Incr);
+ SB_PAGEUP : SetPosition(FPosition - Incr);
+ SB_PAGEDOWN: SetPosition(FPosition + Incr);
+ end;
+ FControl.Update;
+ Dec(Count);
+ end;
+ if FinalIncr > 0 then
+ begin
+ case ScrollCode of
+ SB_LINEUP : SetPosition(FPosition - FinalIncr);
+ SB_LINEDOWN: SetPosition(FPosition + FinalIncr);
+ SB_PAGEUP : SetPosition(FPosition - FinalIncr);
+ SB_PAGEDOWN: SetPosition(FPosition + FinalIncr);
+ end;
+ end;
+ end
+ else
+ case ScrollCode of
+ SB_LINEUP : SetPosition(FPosition - FIncrement);
+ SB_LINEDOWN : SetPosition(FPosition + FIncrement);
+ SB_PAGEUP : SetPosition(FPosition - FPageSize);
+ SB_PAGEDOWN: SetPosition(FPosition + FPageSize);
+ SB_THUMBPOSITION:
+ if FCalcRange > 32767 then
+ SetPosition(GetRealScrollPosition)
+ else
+ SetPosition(Pos);
+ SB_THUMBTRACK:
+ if Tracking then
+ if FCalcRange > 32767 then
+ SetPosition(GetRealScrollPosition)
+ else
+ SetPosition(Pos);
+ SB_TOP: SetPosition(0);
+ SB_BOTTOM: SetPosition(FCalcRange);
+ SB_ENDSCROLL: begin end;
+ end;
+ end;
+end;
+
+procedure TVertScrollBar.SetButtonSize(Value: Integer);
+const
+ SysConsts: array[TScrollBarKind] of Integer = (SM_CXHSCROLL, SM_CXVSCROLL);
+var
+ NewValue: Integer;
+begin
+ if Value <> ButtonSize then
+ begin
+ NewValue := Value;
+ if NewValue = 0 then
+ Value := GetSystemMetrics(SysConsts[Kind]);
+ FButtonSize := Value;
+ FUpdateNeeded := True;
+ WINUpdateScrollBars;
+ if NewValue = 0 then
+ FButtonSize := 0;
+ end;
+end;
+
+procedure TVertScrollBar.SetColor(Value: TColor);
+begin
+ if Value <> Color then
+ begin
+ FColor := Value;
+ FParentColor := False;
+ FUpdateNeeded := True;
+ WINUpdateScrollBars;
+ end;
+end;
+
+procedure TVertScrollBar.SetParentColor(Value: Boolean);
+begin
+ if ParentColor <> Value then
+ begin
+ FParentColor := Value;
+ if Value then Color := clBtnHighlight;
+ end;
+end;
+
+procedure TVertScrollBar.SetPosition(Value: Integer);
+var
+ Code: Word;
+ Form: TCustomForm;
+// OldPos: Integer;
+begin
+ if csReading in FControl.ComponentState then
+ FPosition := Value
+ else
+ begin
+ if Value > FCalcRange then Value := FCalcRange
+ else if Value < 0 then Value := 0;
+ if Kind = sbHorizontal then
+ Code := SB_HORZ
+ else
+ Code := SB_VERT;
+ if Value <> FPosition then
+ begin
+// OldPos := FPosition;
+ FPosition := Value;
+ {OXY:
+ if Kind = sbHorizontal then
+ FControl.ScrollBy(OldPos - Value, 0) else
+ FControl.ScrollBy(0, OldPos - Value);
+ }
+ if csDesigning in FControl.ComponentState then
+ begin
+ Form := GetParentForm(FControl);
+ if (Form <> nil) and (Form.Designer <> nil) then
+ Form.Designer.Modified;
+ end;
+ end;
+ if FlatSB_GetScrollPos(FControl.Handle, Code) <> FPosition then
+ FlatSB_SetScrollPos(FControl.Handle, Code, FPosition, True);
+ end;
+end;
+
+procedure TVertScrollBar.SetSize(Value: Integer);
+const
+ SysConsts: array[TScrollBarKind] of Integer = (SM_CYHSCROLL, SM_CYVSCROLL);
+var
+ NewValue: Integer;
+begin
+ if Value <> Size then
+ begin
+ NewValue := Value;
+ if NewValue = 0 then
+ Value := GetSystemMetrics(SysConsts[Kind]);
+ FSize := Value;
+ FUpdateNeeded := True;
+ WINUpdateScrollBars;
+ if NewValue = 0 then
+ FSize := 0;
+ end;
+end;
+
+procedure TVertScrollBar.SetStyle(Value: TScrollBarStyle);
+begin
+ if Style <> Value then
+ begin
+ FStyle := Value;
+ FUpdateNeeded := True;
+ WINUpdateScrollBars;
+ end;
+end;
+
+procedure TVertScrollBar.SetThumbSize(Value: Integer);
+begin
+ if Value <> ThumbSize then
+ begin
+ FThumbSize := Value;
+ FUpdateNeeded := True;
+ WINUpdateScrollBars;
+ end;
+end;
+
+procedure TVertScrollBar.DoSetRange(Value: Integer);
+begin
+ FRange := Value;
+ if FRange < 0 then FRange := 0;
+ WINUpdateScrollBars;
+end;
+
+procedure TVertScrollBar.SetRange(Value: Integer);
+begin
+ //OXY: FControl.FAutoScroll := False;
+ FScaled := True;
+ DoSetRange(Value);
+end;
+
+function TVertScrollBar.IsRangeStored: Boolean;
+begin
+ Result := not False;// OXY: FControl.AutoScroll;
+end;
+
+procedure TVertScrollBar.SetVisible(Value: Boolean);
+begin
+ FVisible := Value;
+ WINUpdateScrollBars;
+end;
+
+procedure TVertScrollBar.Update(ControlSB, AssumeSB: Boolean);
+type
+ TPropKind = (pkStyle, pkButtonSize, pkThumbSize, pkSize, pkBkColor);
+const
+ Props: array[TScrollBarKind, TPropKind] of Integer = (
+ { Horizontal }
+ (WSB_PROP_HSTYLE, WSB_PROP_CXHSCROLL, WSB_PROP_CXHTHUMB, WSB_PROP_CYHSCROLL,
+ WSB_PROP_HBKGCOLOR),
+ { Vertical }
+ (WSB_PROP_VSTYLE, WSB_PROP_CYVSCROLL, WSB_PROP_CYVTHUMB, WSB_PROP_CXVSCROLL,
+ WSB_PROP_VBKGCOLOR));
+ Kinds: array[TScrollBarKind] of Integer = (WSB_PROP_HSTYLE, WSB_PROP_VSTYLE);
+ Styles: array[TScrollBarStyle] of Integer = (FSB_REGULAR_MODE,
+ FSB_ENCARTA_MODE, FSB_FLAT_MODE);
+var
+ Code: Word;
+ ScrollInfo: TScrollInfo;
+
+ procedure UpdateScrollProperties(Redraw: Boolean);
+ begin
+ FlatSB_SetScrollProp(FControl.Handle, Props[Kind, pkStyle], Styles[Style], Redraw);
+ if ButtonSize > 0 then
+ FlatSB_SetScrollProp(FControl.Handle, Props[Kind, pkButtonSize], ButtonSize, False);
+ if ThumbSize > 0 then
+ FlatSB_SetScrollProp(FControl.Handle, Props[Kind, pkThumbSize], ThumbSize, False);
+ if Size > 0 then
+ FlatSB_SetScrollProp(FControl.Handle, Props[Kind, pkSize], Size, False);
+ FlatSB_SetScrollProp(FControl.Handle, Props[Kind, pkBkColor],
+ ColorToRGB(Color), False);
+ end;
+
+begin
+ FCalcRange := 0;
+ Code := SB_HORZ;
+ if Kind = sbVertical then Code := SB_VERT;
+ if Visible then
+ begin
+ FCalcRange := Range - FPageSize + 1;
+ if FCalcRange < 0 then FCalcRange := 0;
+ end;
+ ScrollInfo.cbSize := SizeOf(ScrollInfo);
+ ScrollInfo.fMask := SIF_ALL;
+ ScrollInfo.nMin := 0;
+ if not Hidden and (FCalcRange > 0) then
+ ScrollInfo.nMax := Range else
+ ScrollInfo.nMax := 0;
+ //if Hidden then
+ // ScrollInfo.nPage := ScrollInfo.nMax+1
+ //else
+ ScrollInfo.nPage := FPageSize;
+ ScrollInfo.nPos := FPosition;
+ ScrollInfo.nTrackPos := FPosition;
+ UpdateScrollProperties(FUpdateNeeded);
+ FUpdateNeeded := False;
+ FlatSB_SetScrollInfo(FControl.Handle, Code, ScrollInfo, True);
+ SetPosition(FPosition);
+ FPageIncrement := (FPageSize+1 * 9) div 10;
+ if Smooth then FIncrement := FPageIncrement div 10;
+end;
+
+procedure TVertScrollBar.SetHidden(Value: Boolean);
+begin
+ if Hidden <> Value then
+ begin
+ FHidden := Value;
+ FUpdateNeeded := True;
+ WINUpdateScrollBars;
+ end;
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/alpha.inc b/plugins/HistoryPlusPlus/alpha.inc new file mode 100644 index 0000000000..afa3a3a81b --- /dev/null +++ b/plugins/HistoryPlusPlus/alpha.inc @@ -0,0 +1 @@ +'debug'
\ No newline at end of file diff --git a/plugins/HistoryPlusPlus/compilers.inc b/plugins/HistoryPlusPlus/compilers.inc new file mode 100644 index 0000000000..2117ad3506 --- /dev/null +++ b/plugins/HistoryPlusPlus/compilers.inc @@ -0,0 +1,361 @@ +//
+// This file is a copy of tntComplers.inc from TNT controls distribution
+// http://www.tntware.com/delphicontrols/unicode/
+// All copyright and stuff belongs to respective owners
+//
+//----------------------------------------------------------------------------------------------------------------------
+// Include file to determine which compiler is currently being used to build the project/component.
+// This file uses ideas from Brad Stowers DFS.inc file (www.delphifreestuff.com).
+//
+// Portions created by Mike Lischke are Copyright
+// (C) 1999-2002 Dipl. Ing. Mike Lischke. All Rights Reserved.
+//----------------------------------------------------------------------------------------------------------------------
+// The following symbols are defined:
+//
+// COMPILER_1 : Kylix/Delphi/BCB 1.x is the compiler.
+// COMPILER_1_UP : Kylix/Delphi/BCB 1.x or higher is the compiler.
+// COMPILER_2 : Kylix/Delphi 2.x or BCB 1.x is the compiler.
+// COMPILER_2_UP : Kylix/Delphi 2.x or higher, or BCB 1.x or higher is the compiler.
+// COMPILER_3 : Kylix/Delphi/BCB 3.x is the compiler.
+// COMPILER_3_UP : Kylix/Delphi/BCB 3.x or higher is the compiler.
+// COMPILER_4 : Kylix/Delphi/BCB 4.x is the compiler.
+// COMPILER_4_UP : Kylix/Delphi/BCB 4.x or higher is the compiler.
+// COMPILER_5 : Kylix/Delphi/BCB 5.x is the compiler.
+// COMPILER_5_UP : Kylix/Delphi/BCB 5.x or higher is the compiler.
+// COMPILER_6 : Kylix/Delphi/BCB 6.x is the compiler.
+// COMPILER_6_UP : Kylix/Delphi/BCB 6.x or higher is the compiler.
+// COMPILER_7 : Kylix/Delphi/BCB 7.x is the compiler.
+// COMPILER_7_UP : Kylix/Delphi/BCB 7.x or higher is the compiler.
+//
+// Only defined if Windows is the target:
+// CPPB : Any version of BCB is being used.
+// CPPB_1 : BCB v1.x is being used.
+// CPPB_3 : BCB v3.x is being used.
+// CPPB_3_UP : BCB v3.x or higher is being used.
+// CPPB_4 : BCB v4.x is being used.
+// CPPB_4_UP : BCB v4.x or higher is being used.
+// CPPB_5 : BCB v5.x is being used.
+// CPPB_5_UP : BCB v5.x or higher is being used.
+// CPPB_6 : BCB v6.x is being used.
+// CPPB_6_UP : BCB v6.x or higher is being used.
+//
+// Only defined if Windows is the target:
+// DELPHI : Any version of Delphi is being used.
+// DELPHI_1 : Delphi v1.x is being used.
+// DELPHI_2 : Delphi v2.x is being used.
+// DELPHI_2_UP : Delphi v2.x or higher is being used.
+// DELPHI_3 : Delphi v3.x is being used.
+// DELPHI_3_UP : Delphi v3.x or higher is being used.
+// DELPHI_4 : Delphi v4.x is being used.
+// DELPHI_4_UP : Delphi v4.x or higher is being used.
+// DELPHI_5 : Delphi v5.x is being used.
+// DELPHI_5_UP : Delphi v5.x or higher is being used.
+// DELPHI_6 : Delphi v6.x is being used.
+// DELPHI_6_UP : Delphi v6.x or higher is being used.
+// DELPHI_7 : Delphi v7.x is being used.
+// DELPHI_7_UP : Delphi v7.x or higher is being used.
+//
+// Only defined if Linux is the target:
+// KYLIX : Any version of Kylix is being used.
+// KYLIX_1 : Kylix 1.x is being used.
+// KYLIX_1_UP : Kylix 1.x or higher is being used.
+// KYLIX_2 : Kylix 2.x is being used.
+// KYLIX_2_UP : Kylix 2.x or higher is being used.
+// KYLIX_3 : Kylix 3.x is being used.
+// KYLIX_3_UP : Kylix 3.x or higher is being used.
+//
+// Only defined if Linux is the target:
+// QT_CLX : Trolltech's QT library is being used.
+//----------------------------------------------------------------------------------------------------------------------
+
+{$ifdef Win32}
+
+ {$ifdef VER180}
+ {$define COMPILER_10}
+ {$define DELPHI}
+ {$define DELPHI_10}
+ {$endif}
+
+ {$ifdef VER170}
+ {$define COMPILER_9}
+ {$define DELPHI}
+ {$define DELPHI_9}
+ {$endif}
+
+ {$ifdef VER150}
+ {$define COMPILER_7}
+ {$define DELPHI}
+ {$define DELPHI_7}
+ {$endif}
+
+ {$ifdef VER140}
+ {$define COMPILER_6}
+ {$ifdef BCB}
+ {$define CPPB}
+ {$define CPPB_6}
+ {$else}
+ {$define DELPHI}
+ {$define DELPHI_6}
+ {$endif}
+ {$endif}
+
+ {$ifdef VER130}
+ {$define COMPILER_5}
+ {$ifdef BCB}
+ {$define CPPB}
+ {$define CPPB_5}
+ {$else}
+ {$define DELPHI}
+ {$define DELPHI_5}
+ {$endif}
+ {$endif}
+
+ {$ifdef VER125}
+ {$define COMPILER_4}
+ {$define CPPB}
+ {$define CPPB_4}
+ {$endif}
+
+ {$ifdef VER120}
+ {$define COMPILER_4}
+ {$define DELPHI}
+ {$define DELPHI_4}
+ {$endif}
+
+ {$ifdef VER110}
+ {$define COMPILER_3}
+ {$define CPPB}
+ {$define CPPB_3}
+ {$endif}
+
+ {$ifdef VER100}
+ {$define COMPILER_3}
+ {$define DELPHI}
+ {$define DELPHI_3}
+ {$endif}
+
+ {$ifdef VER93}
+ {$define COMPILER_2} // C++ Builder v1 compiler is really v2
+ {$define CPPB}
+ {$define CPPB_1}
+ {$endif}
+
+ {$ifdef VER90}
+ {$define COMPILER_2}
+ {$define DELPHI}
+ {$define DELPHI_2}
+ {$endif}
+
+ {$ifdef VER80}
+ {$define COMPILER_1}
+ {$define DELPHI}
+ {$define DELPHI_1}
+ {$endif}
+
+ {$ifdef DELPHI_2}
+ {$define DELPHI_2_UP}
+ {$endif}
+
+ {$ifdef DELPHI_3}
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$endif}
+
+ {$ifdef DELPHI_4}
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$define DELPHI_4_UP}
+ {$endif}
+
+ {$ifdef DELPHI_5}
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$define DELPHI_4_UP}
+ {$define DELPHI_5_UP}
+ {$endif}
+
+ {$ifdef DELPHI_6}
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$define DELPHI_4_UP}
+ {$define DELPHI_5_UP}
+ {$define DELPHI_6_UP}
+ {$endif}
+
+ {$ifdef DELPHI_7}
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$define DELPHI_4_UP}
+ {$define DELPHI_5_UP}
+ {$define DELPHI_6_UP}
+ {$define DELPHI_7_UP}
+ {$endif}
+
+ {$ifdef DELPHI_9}
+ {$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_9_UP}
+ {$endif}
+
+ {$ifdef DELPHI_10}
+ {$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_9_UP}
+ {$define DELPHI_10_UP}
+ {$endif}
+
+ {$ifdef CPPB_3}
+ {$define CPPB_3_UP}
+ {$endif}
+
+ {$ifdef CPPB_4}
+ {$define CPPB_3_UP}
+ {$define CPPB_4_UP}
+ {$endif}
+
+ {$ifdef CPPB_5}
+ {$define CPPB_3_UP}
+ {$define CPPB_4_UP}
+ {$define CPPB_5_UP}
+ {$endif}
+
+ {$ifdef CPPB_6}
+ {$define CPPB_3_UP}
+ {$define CPPB_4_UP}
+ {$define CPPB_5_UP}
+ {$define CPPB_6_UP}
+ {$endif}
+
+ {$ifdef CPPB_3_UP}
+ // C++ Builder requires this if you use Delphi components in run-time packages.
+ {$ObjExportAll On}
+ {$endif}
+
+{$else (not Windows)}
+ // Linux is the target
+ {$define QT_CLX}
+
+ {$define KYLIX}
+ {$define KYLIX_1}
+ {$define KYLIX_1_UP}
+
+ {$ifdef VER150}
+ {$define COMPILER_7}
+ {$define KYLIX_3}
+ {$endif}
+
+ {$ifdef VER140}
+ {$define COMPILER_6}
+ {$define KYLIX_2}
+ {$endif}
+
+ {$ifdef KYLIX_2}
+ {$define KYLIX_2_UP}
+ {$endif}
+
+ {$ifdef KYLIX_3}
+ {$define KYLIX_2_UP}
+ {$define KYLIX_3_UP}
+ {$endif}
+
+{$endif}
+
+// Compiler defines common to all platforms.
+{$ifdef COMPILER_1}
+ {$define COMPILER_1_UP}
+{$endif}
+
+{$ifdef COMPILER_2}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+{$endif}
+
+{$ifdef COMPILER_3}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+ {$define COMPILER_3_UP}
+{$endif}
+
+{$ifdef COMPILER_4}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+ {$define COMPILER_3_UP}
+ {$define COMPILER_4_UP}
+{$endif}
+
+{$ifdef COMPILER_5}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+ {$define COMPILER_3_UP}
+ {$define COMPILER_4_UP}
+ {$define COMPILER_5_UP}
+{$endif}
+
+{$ifdef COMPILER_6}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+ {$define COMPILER_3_UP}
+ {$define COMPILER_4_UP}
+ {$define COMPILER_5_UP}
+ {$define COMPILER_6_UP}
+{$endif}
+
+{$ifdef COMPILER_7}
+ {$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}
+{$endif}
+
+{$ifdef COMPILER_9}
+ {$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_9_UP}
+{$endif}
+
+{$ifdef COMPILER_10}
+ {$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_9_UP}
+ {$define COMPILER_10_UP}
+{$endif}
+
+//----------------------------------------------------------------------------------------------------------------------
+
+{$ALIGN ON}
+{$BOOLEVAL OFF}
+
+{$ifdef COMPILER_7_UP}
+ {$define THEME_7_UP} { Allows experimental theme support on pre-Delphi 7. }
+{$endif}
+
+{$IFDEF COMPILER_6_UP}
+{$WARN SYMBOL_PLATFORM OFF} { We are going to use Win32 specific symbols! }
+{$ENDIF}
+
+{$IFDEF COMPILER_7_UP}
+{$WARN UNSAFE_CODE OFF} { We are not going to be "safe"! }
+{$WARN UNSAFE_TYPE OFF}
+{$WARN UNSAFE_CAST OFF}
+{$ENDIF}
\ No newline at end of file diff --git a/plugins/HistoryPlusPlus/historypp.dpr b/plugins/HistoryPlusPlus/historypp.dpr new file mode 100644 index 0000000000..f4716c5024 --- /dev/null +++ b/plugins/HistoryPlusPlus/historypp.dpr @@ -0,0 +1,627 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+ {$WEAKLINKRTTI ON}
+ {.$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
+library historypp;
+
+{$IMAGEBASE $02630000}
+
+{$R 'hpp_resource.res' 'hpp_resource.rc'}
+{$R 'hpp_res_ver.res' 'hpp_res_ver.rc'}
+{$R 'hpp_opt_dialog.res' 'hpp_opt_dialog.rc'}
+
+{$I compilers.inc}
+
+uses
+ Windows,
+ SysUtils,
+ m_api in '..\inc\m_api.pas',
+ Forms,
+ hpp_global in 'hpp_global.pas',
+ hpp_contacts in 'hpp_contacts.pas',
+ hpp_database in 'hpp_database.pas',
+ hpp_events in 'hpp_events.pas',
+ hpp_services in 'hpp_services.pas',
+ hpp_itemprocess in 'hpp_itemprocess.pas',
+ hpp_options in 'hpp_options.pas',
+ hpp_messages in 'hpp_messages.pas',
+ HistoryGrid in 'HistoryGrid.pas',
+ VertSB in 'VertSB.pas',
+ HistoryForm in 'HistoryForm.pas' {HistoryFrm},
+ EventDetailForm in 'EventDetailForm.pas' {EventDetailsFrm},
+ EmptyHistoryForm in 'EmptyHistoryForm.pas' {EmptyHistoryFrm},
+ PassForm in 'PassForm.pas' {fmPass},
+ PassNewForm in 'PassNewForm.pas' {fmPassNew},
+ PassCheckForm in 'PassCheckForm.pas' {fmPassCheck},
+ GlobalSearch in 'GlobalSearch.pas' {fmGlobalSearch},
+ hpp_searchthread in 'hpp_searchthread.pas',
+ hpp_bookmarks in 'hpp_bookmarks.pas',
+ hpp_sessionsthread in 'hpp_sessionsthread.pas',
+ hpp_arrays in 'hpp_arrays.pas',
+ hpp_strparser in 'hpp_strparser.pas',
+ hpp_forms in 'hpp_forms.pas',
+ hpp_opt_dialog in 'hpp_opt_dialog.pas',
+ hpp_eventfilters in 'hpp_eventfilters.pas',
+ hpp_mescatcher in 'hpp_mescatcher.pas',
+ CustomizeFiltersForm in 'CustomizeFiltersForm.pas' {fmCustomizeFilters},
+ CustomizeToolbar in 'CustomizeToolbar.pas' {fmCustomizeToolbar},
+ hpp_external in 'hpp_external.pas',
+ hpp_externalgrid in 'hpp_externalgrid.pas',
+ hpp_richedit in 'hpp_richedit.pas',
+ hpp_olesmileys in 'hpp_olesmileys.pas',
+ HistoryControls in 'HistoryControls.pas',
+ Base64 in 'Base64.pas',
+ Checksum in 'Checksum.pas',
+ hpp_JclSysUtils in 'hpp_JclSysUtils.pas',
+ hpp_puny in 'hpp_puny.pas';
+
+type
+ TMenuHandles = record
+ Handle: THandle;
+ Name: pWideChar;
+ end;
+
+const
+ miContact = 0;
+ miSystem = 1;
+ miSearch = 2;
+ miEmpty = 3;
+ miSysEmpty = 4;
+
+var
+ MenuCount: Integer = -1;
+ PrevShowHistoryCount: Boolean = False;
+ MenuHandles: array[0..4] of TMenuHandles = (
+ (Handle:0; Name:'View &History'),
+ (Handle:0; Name:'&System History'),
+ (Handle:0; Name:'His&tory Search'),
+ (Handle:0; Name:'&Empty History'),
+ (Handle:0; Name:'&Empty System History'));
+
+const
+ hLangpack:THANDLE = 0;
+
+var
+ HookModulesLoad,
+ HookOptInit,
+ HookSettingsChanged,
+ HookSmAddChanged,
+ HookIconChanged,
+ HookIcon2Changed,
+ //hookContactChanged,
+ HookContactDelete,
+ HookFSChanged,
+ HookTTBLoaded,
+ HookBuildMenu,
+ HookEventAdded,
+ HookEventDeleted,
+ HookMetaDefaultChanged,
+ HookPreshutdown: THandle;
+
+function OnModulesLoad(awParam:WPARAM; alParam:LPARAM):int; cdecl; forward;
+function OnSettingsChanged(wParam: WPARAM; lParam: LPARAM): Integer; cdecl; forward;
+function OnSmAddSettingsChanged(wParam: WPARAM; lParam: LPARAM): Integer; cdecl; forward;
+function OnIconChanged(wParam: WPARAM; lParam: LPARAM): Integer; cdecl; forward;
+function OnIcon2Changed(awParam: WPARAM; alParam: LPARAM): Integer; cdecl; forward;
+function OnOptInit(awParam: WPARAM; alParam: LPARAM): Integer; cdecl; forward;
+function OnContactChanged(wParam: wParam; lParam: LPARAM): Integer; cdecl; forward;
+function OnContactDelete(wParam: wParam; lParam: LPARAM): Integer; cdecl; forward;
+function OnFSChanged(wParam: WPARAM; lParam: LPARAM): Integer; cdecl; forward;
+function OnTTBLoaded(awParam: WPARAM; alParam: LPARAM): Integer; cdecl; forward;
+function OnBuildContactMenu(awParam: WPARAM; alParam: LPARAM): Integer; cdecl; forward;
+function OnEventAdded(wParam: WPARAM; lParam: LPARAM): Integer; cdecl; forward;
+function OnEventDeleted(wParam: WPARAM; lParam: LPARAM): Integer; cdecl; forward;
+function OnMetaDefaultChanged(wParam: WPARAM; lParam: LPARAM): Integer; cdecl; forward;
+function OnPreshutdown(wParam: WPARAM; lParam: LPARAM): Integer; cdecl; forward;
+
+// tell Miranda about this plugin ExVersion
+function MirandaPluginInfoEx(mirandaVersion:DWORD): PPLUGININFOEX; cdecl;
+begin
+ PluginInfo.cbSize:= SizeOf(TPLUGININFOEX);
+ PluginInfo.shortName:= hppShortNameV;
+ PluginInfo.version:= hppVersion;
+ PluginInfo.description:= hppDescription;
+ PluginInfo.author:= hppAuthor;
+ PluginInfo.authorEmail:= hppAuthorEmail;
+ PluginInfo.copyright:= hppCopyright;
+ PluginInfo.homepage:= hppHomePageURL;
+ PluginInfo.flags:= UNICODE_AWARE;
+ PluginInfo.uuid:= MIID_HISTORYPP;
+ Result := @PluginInfo;
+end;
+
+var
+ PluginInterfaces: array[0..2] of TGUID;
+
+// tell Miranda about supported interfaces
+function MirandaPluginInterfaces:PMUUID; cdecl;
+begin
+ PluginInterfaces[0]:=MIID_UIHISTORY;
+ PluginInterfaces[1]:=MIID_LOGWINDOW;
+ PluginInterfaces[2]:=MIID_LAST;
+ Result := @PluginInterfaces;
+end;
+
+// load function called by miranda
+function Load():Integer; cdecl;
+begin
+
+ CallService(MS_LANGPACK_REGISTER,WPARAM(@hLangpack),LPARAM(@PluginInfo));
+
+ // Getting langpack codepage for ansi translation
+ hppCodepage := CallService(MS_LANGPACK_GETCODEPAGE, 0, 0);
+ if (hppCodepage = CALLSERVICE_NOTFOUND) or (hppCodepage = CP_ACP) then
+ hppCodepage := GetACP();
+ // Checking the version of richedit is available, need 2.0+
+ hppRichEditVersion := InitRichEditLibrary;
+ if hppRichEditVersion < 20 then
+ begin
+ hppMessagebox(hppMainWindow, FormatCString( // single line to translation script
+ TranslateW
+ ('History++ module could not be loaded, richedit 2.0+ module is missing.\nPress OK to continue loading Miranda.')
+ ), hppName + ' Information', MB_OK or MB_ICONINFORMATION);
+ Result := 1;
+ exit;
+ end;
+
+ // Get profile dir
+ SetLength(hppProfileDir, MAX_PATH);
+ CallService(MS_DB_GETPROFILEPATH, MAX_PATH, lParam(@hppProfileDir[1]));
+ SetLength(hppProfileDir, StrLen(pAnsiChar(@hppProfileDir[1])));
+ // Get plugins dir
+ SetLength(hppPluginsDir, MAX_PATH);
+ SetLength(hppPluginsDir, GetModuleFileNameW(hInstance, @hppPluginsDir[1], MAX_PATH));
+ hppDllName := ExtractFileName(hppPluginsDir);
+ hppPluginsDir := ExtractFilePath(hppPluginsDir);
+ // init history functions later
+ HookModulesLoad := HookEvent(ME_SYSTEM_MODULESLOADED, OnModulesLoad);
+ HookOptInit := HookEvent(ME_OPT_INITIALISE, OnOptInit);
+ hppRegisterServices;
+{$IFNDEF NO_EXTERNALGRID}
+ RegisterExtGridServices;
+{$ENDIF}
+ hppRegisterMainWindow;
+ Result := 0;
+end;
+
+// unload
+function Unload:Integer; cdecl;
+begin
+ Result:=0;
+
+ // unhook events
+ UnhookEvent(hookOptInit);
+ UnhookEvent(HookPreshutdown);
+ UnhookEvent(HookModulesLoad);
+
+ UnhookEvent(HookEventAdded);
+ UnhookEvent(HookEventDeleted);
+ UnhookEvent(HookSettingsChanged);
+ UnhookEvent(HookIconChanged);
+ UnhookEvent(HookContactDelete);
+ UnhookEvent(HookBuildMenu);
+
+ if SmileyAddEnabled then
+ UnhookEvent(HookSmAddChanged);
+ UnhookEvent(HookIcon2Changed);
+ UnhookEvent(HookFSChanged);
+ if MetaContactsEnabled then
+ UnhookEvent(HookMetaDefaultChanged);
+
+ try
+ // destroy hidden main window
+ hppUnregisterMainWindow;
+ {$IFNDEF NO_EXTERNALGRID}
+ UnregisterExtGridServices;
+ {$ENDIF}
+ // unregistering events
+ hppUnregisterServices;
+ // unregister bookmarks
+ hppDeinitBookmarkServer;
+
+ except
+ on E: Exception do
+ HppMessageBox(hppMainWindow,
+ 'Error while closing '+hppName+':'+#10#13+E.Message,
+ hppName+' Error',MB_OK or MB_ICONERROR);
+ end;
+
+end;
+
+// init plugin
+function OnModulesLoad(awParam{0}:WPARAM; alParam{0}:LPARAM):integer; cdecl;
+var
+ menuItem:TCLISTMENUITEM;
+ upd: TUpdate;
+ hppVersionStr: AnsiString;
+begin
+ // register
+ hppRegisterGridOptions;
+ // pretranslate strings
+ hppPrepareTranslation;
+
+ LoadIcons;
+ LoadIcons2;
+ LoadIntIcons;
+
+ // TopToolBar support
+ HookTTBLoaded := HookEvent(ME_TTB_MODULELOADED,OnTTBLoaded);
+
+ hppInitBookmarkServer;
+
+ InitEventFilters;
+ ReadEventFilters;
+
+ ZeroMemory(@menuitem,SizeOf(menuItem));
+
+ //create contact item in contact menu
+ menuItem.cbSize := SizeOf(menuItem);
+ menuItem.pszContactOwner := nil; //all contacts
+ menuItem.flags := CMIF_UNICODE;
+
+ menuItem.Position := 1000090000;
+ menuItem.szName.w := MenuHandles[miContact].Name;
+ menuItem.pszService := MS_HISTORY_SHOWCONTACTHISTORY;
+ menuItem.hIcon := hppIcons[HPP_ICON_CONTACTHISTORY].handle;
+ MenuHandles[miContact].Handle := Menu_AddContactMenuItem(@menuItem);
+
+ //create empty item in contact menu
+ menuItem.Position := 1000090001;
+ menuItem.szName.w := MenuHandles[miEmpty].Name;
+ menuItem.pszService := MS_HPP_EMPTYHISTORY;
+ menuItem.hIcon := hppIcons[HPP_ICON_TOOL_DELETEALL].handle;
+ MenuHandles[miEmpty].Handle := Menu_AddContactMenuItem(@menuItem);
+
+ //create menu item in main menu for system history
+ menuItem.Position:=500060000;
+ menuItem.szName.w:=MenuHandles[miSystem].Name;
+ menuItem.pszService := MS_HISTORY_SHOWCONTACTHISTORY;
+ menuItem.hIcon := hppIcons[HPP_ICON_CONTACTHISTORY].handle;
+ MenuHandles[miSystem].Handle := Menu_AddMainMenuItem(@menuitem);
+
+ //create menu item in main menu for history search
+ menuItem.Position:=500060001;
+ menuItem.szName.w:=MenuHandles[miSearch].Name;
+ menuItem.pszService := MS_HPP_SHOWGLOBALSEARCH;
+ menuItem.hIcon := hppIcons[HPP_ICON_GLOBALSEARCH].handle;
+ MenuHandles[miSearch].Handle := Menu_AddMainMenuItem(@menuItem);
+
+ //create menu item in main menu for empty system history
+ menuItem.Position:=500060002;
+ menuItem.szName.w:=MenuHandles[miSysEmpty].Name;
+ menuItem.pszService := MS_HPP_EMPTYHISTORY;
+ menuItem.hIcon := hppIcons[HPP_ICON_TOOL_DELETEALL].handle;
+ MenuHandles[miSysEmpty].Handle := Menu_AddMainMenuItem(@menuItem);
+
+ LoadGridOptions;
+
+ HookSettingsChanged := HookEvent(ME_DB_CONTACT_SETTINGCHANGED,OnSettingsChanged);
+ HookIconChanged := HookEvent(ME_SKIN_ICONSCHANGED,OnIconChanged);
+ HookContactDelete := HookEvent(ME_DB_CONTACT_DELETED,OnContactDelete);
+ HookBuildMenu := HookEvent(ME_CLIST_PREBUILDCONTACTMENU,OnBuildContactMenu);
+
+ HookEventAdded := HookEvent(ME_DB_EVENT_ADDED,OnEventAdded);
+ HookEventDeleted := HookEvent(ME_DB_EVENT_DELETED,OnEventDeleted);
+ HookPreshutdown := HookEvent(ME_SYSTEM_PRESHUTDOWN,OnPreshutdown);
+
+ if SmileyAddEnabled then HookSmAddChanged := HookEvent(ME_SMILEYADD_OPTIONSCHANGED,OnSmAddSettingsChanged);
+ HookIcon2Changed := HookEvent(ME_SKIN2_ICONSCHANGED,OnIcon2Changed);
+ HookFSChanged := HookEvent(ME_FONT_RELOAD,OnFSChanged);
+ if MetaContactsEnabled then HookMetaDefaultChanged := HookEvent(ME_MC_DEFAULTTCHANGED,OnMetaDefaultChanged);
+
+ // Register in updater
+ if Boolean(ServiceExists(MS_UPDATE_REGISTER)) then
+ begin
+ ZeroMemory(@upd,SizeOf(upd));
+ upd.cbSize := SizeOf(upd);
+ upd.szComponentName := hppShortName;
+
+ hppVersionStr := AnsiString(Format('%d.%d.%d.%d',[hppVerMajor,hppVerMinor,hppVerRelease,hppVerBuild]));
+
+ upd.pbVersion := @hppVersionStr[1];
+ upd.cpbVersion := Length(hppVersionStr);
+ // file listing section
+ //upd.szUpdateURL = UPDATER_AUTOREGISTER;
+ upd.szUpdateURL := hppFLUpdateURL;
+ upd.szVersionURL := hppFLVersionURL;
+ upd.pbVersionPrefix := hppFLVersionPrefix;
+ upd.cpbVersionPrefix := Length(hppFLVersionPrefix);
+ // alpha-beta section
+ upd.szBetaUpdateURL := hppUpdateURL;
+ upd.szBetaVersionURL := hppVersionURL;
+ upd.pbBetaVersionPrefix := hppVersionPrefix;
+ upd.cpbBetaVersionPrefix := Length(hppVersionPrefix);
+ upd.szBetaChangelogURL := hppChangelogURL;
+ CallService(MS_UPDATE_REGISTER, 0, LPARAM(@upd));
+ end;
+
+ // Register in dbeditor
+ CallService(MS_DBEDIT_REGISTERSINGLEMODULE, WPARAM(PAnsiChar(hppDBName)), 0);
+
+ // return successfully
+ Result:=0;
+end;
+
+// Called when the toolbar services are available
+// wParam = lParam = 0
+function OnTTBLoaded(awParam: WPARAM; alParam: LPARAM): Integer; cdecl;
+var
+ ttb: TTBButton;
+begin
+ if Boolean(ServiceExists(MS_TTB_ADDBUTTON)) then
+ begin
+ ZeroMemory(@ttb,SizeOf(ttb));
+ ttb.cbSize := SizeOf(ttb);
+
+ ttb.hIconUp := hppIcons[HPP_ICON_GLOBALSEARCH].handle;
+ ttb.hIconDn := hppIcons[HPP_ICON_GLOBALSEARCH].handle;
+
+ ttb.pszService := MS_HPP_SHOWGLOBALSEARCH;
+ ttb.dwFlags := TTBBF_VISIBLE or TTBBF_SHOWTOOLTIP;
+ ttb.name := PAnsiChar(Translate('Global History Search'));
+ CallService(MS_TTB_ADDBUTTON,WPARAM(@ttb), 0);
+ UnhookEvent(HookTTBLoaded);
+ end;
+ Result := 0;
+end;
+
+// Called when setting in DB have changed
+// wParam = hContact, lParam = PDbContactWriteSetting
+function OnSettingsChanged(wParam: WPARAM; lParam: LPARAM): Integer; cdecl;
+var
+ cws: PDBContactWriteSetting;
+ szProto: PAnsiChar;
+begin
+ Result := 0;
+ // Log('OnSettChanged','Started. wParam: '+IntToStr(wParam)+', lParam: '+IntToStr(lParam));
+ cws := PDBContactWriteSetting(lParam);
+
+ if wParam = 0 then
+ begin
+ // check for own nick changed
+ if (StrPos('Nick,yahoo_id', cws.szSetting) <> nil) then
+ begin
+ NotifyAllForms(HM_NOTF_NICKCHANGED, 0, 0)
+ end
+ else
+ // check for history++ setings changed
+ if StrComp(cws.szModule, hppDBName) = 0 then
+ begin
+ if GridOptions.Locked then
+ exit;
+ if StrComp(cws.szSetting, 'FormatCopy') = 0 then
+ GridOptions.ClipCopyFormat := GetDBWideStr(hppDBName, 'FormatCopy', DEFFORMAT_CLIPCOPY)
+ else if StrComp(cws.szSetting, 'FormatCopyText') = 0 then
+ GridOptions.ClipCopyTextFormat := GetDBWideStr(hppDBName, 'FormatCopyText', DEFFORMAT_CLIPCOPYTEXT)
+ else if StrComp(cws.szSetting, 'FormatReplyQuoted') = 0 then
+ GridOptions.ReplyQuotedFormat := GetDBWideStr(hppDBName, 'FormatReplyQuoted', DEFFORMAT_REPLYQUOTED)
+ else if StrComp(cws.szSetting, 'FormatReplyQuotedText') = 0 then
+ GridOptions.ReplyQuotedTextFormat := GetDBWideStr(hppDBName, 'FormatReplyQuotedText', DEFFORMAT_REPLYQUOTEDTEXT)
+ else if StrComp(cws.szSetting, 'FormatSelection') = 0 then
+ GridOptions.SelectionFormat := GetDBWideStr(hppDBName, 'FormatSelection', DEFFORMAT_SELECTION)
+ else if StrComp(cws.szSetting, 'ProfileName') = 0 then
+ GridOptions.ProfileName := GetDBWideStr(hppDBName, 'ProfileName', '')
+ else if StrComp(cws.szSetting, 'DateTimeFormat') = 0 then
+ GridOptions.DateTimeFormat := GetDBWideStr(hppDBName, 'DateTimeFormat', DEFFORMAT_DATETIME);
+ end;
+ exit;
+ end;
+
+ szProto := pAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO, wParam, 0));
+ if (StrComp(cws.szModule, 'CList') <> 0) and
+ ((szProto = nil) or (StrComp(cws.szModule, szProto) <> 0)) then
+ exit;
+
+ if MetaContactsEnabled and (StrComp(cws.szModule, pAnsiChar(MetaContactsProto)) = 0) and
+ (StrComp(cws.szSetting, 'Nick') = 0) then
+ exit;
+
+ // check for contact nick changed
+ if (StrPos('MyHandle,Nick', cws.szSetting) <> nil) then
+ NotifyAllForms(HM_NOTF_NICKCHANGED, wParam, 0);
+end;
+
+// Called when smilayadd settings have changed
+//wParam = Contact handle which options have changed, NULL if global options changed
+//lParam = (LPARAM) 0; not used
+function OnSmAddSettingsChanged(wParam: WPARAM; lParam: LPARAM): Integer; cdecl;
+begin
+ Result := 0;
+ if GridOptions.Locked then exit;
+ LoadGridOptions;
+end;
+
+// Called when setting in FontService have changed
+// wParam = 0, lParam = 0
+function OnFSChanged(wParam: WPARAM; lParam: LPARAM): Integer; cdecl;
+begin
+ Result := 0;
+ if GridOptions.Locked then exit;
+ LoadGridOptions;
+end;
+
+// Called when setting in DB have changed
+// wParam = hContact, lParam = PDbContactWriteSetting
+function OnContactChanged(wParam: WPARAM; lParam: LPARAM): Integer; cdecl;
+begin
+ Result := 0;
+ if GridOptions.Locked then exit;
+ LoadGridOptions;
+end;
+
+// Called when contact is deleted
+// wParam - hContact
+function OnContactDelete(wParam: wParam; lParam: LPARAM): Integer; cdecl;
+begin
+ Result := 0;
+ NotifyAllForms(HM_MIEV_CONTACTDELETED,wParam,lParam);
+end;
+
+function OnOptInit(awParam: WPARAM; alParam: LPARAM): Integer; cdecl;
+var
+ odp: TOPTIONSDIALOGPAGE;
+begin
+ ZeroMemory(@odp,SizeOf(odp));
+ odp.cbSize := sizeof(odp);
+ odp.Position := 0;
+ odp.hInstance := hInstance;
+ odp.pszTemplate := MakeIntResourceA(IDD_OPT_HISTORYPP);
+ odp.szTitle.a := 'History';
+ odp.szGroup.a := nil;
+ odp.pfnDlgProc := @OptDialogProc;
+ odp.flags := ODPF_BOLDGROUPS;
+ Options_AddPage(awParam,@odp);
+ Result:=0;
+end;
+
+//sent when the icons DLL has been changed in the options dialog, and everyone
+//should re-make their image lists
+//wParam=lParam=0
+function OnIconChanged(wParam: WPARAM; lParam: LPARAM): Integer; cdecl;
+begin
+ Result := 0;
+ if not GridOptions.ShowIcons then exit;
+ LoadIcons;
+ NotifyAllForms(HM_NOTF_ICONSCHANGED,0,0);
+end;
+
+function OnIcon2Changed(awParam: WPARAM; alParam: LPARAM): Integer; cdecl;
+var
+ menuItem: TCLISTMENUITEM;
+begin
+ Result := 0;
+ LoadIcons2;
+ NotifyAllForms(HM_NOTF_ICONS2CHANGED,0,0);
+ //change menu icons
+ ZeroMemory(@menuitem,SizeOf(menuItem));
+ menuItem.cbSize := SizeOf(menuItem);
+ menuItem.flags := CMIM_ICON;
+ menuItem.hIcon := hppIcons[HPP_ICON_CONTACTHISTORY].handle;
+ CallService(MS_CLIST_MODIFYMENUITEM, MenuHandles[miContact].Handle, LPARAM(@menuItem));
+ CallService(MS_CLIST_MODIFYMENUITEM, MenuHandles[miSystem].Handle, LPARAM(@menuItem));
+ menuItem.hIcon := hppIcons[HPP_ICON_GLOBALSEARCH].handle;
+ CallService(MS_CLIST_MODIFYMENUITEM, MenuHandles[miSearch].Handle, LPARAM(@menuItem));
+ menuItem.hIcon := hppIcons[HPP_ICON_TOOL_DELETEALL].handle;
+ CallService(MS_CLIST_MODIFYMENUITEM, MenuHandles[miEmpty].Handle, LPARAM(@menuItem));
+ CallService(MS_CLIST_MODIFYMENUITEM, MenuHandles[miSysEmpty].Handle, LPARAM(@menuItem));
+end;
+
+//the context menu for a contact is about to be built v0.1.0.1+
+//wParam=(WPARAM)(HANDLE)hContact
+//lParam=0
+//modules should use this to change menu items that are specific to the
+//contact that has them
+function OnBuildContactMenu(awParam: WPARAM; alParam: LPARAM): Integer; cdecl;
+var
+ menuItem: TCLISTMENUITEM;
+ count: Integer;
+ res: Integer;
+begin
+ Result := 0;
+ count := CallService(MS_DB_EVENT_GETCOUNT, awParam, 0);
+ if (PrevShowHistoryCount xor ShowHistoryCount) or (count <> MenuCount) then
+ begin
+ ZeroMemory(@menuitem, SizeOf(menuItem));
+ menuItem.cbSize := SizeOf(menuItem);
+ menuItem.flags := CMIM_FLAGS;
+ if count = 0 then
+ menuItem.flags := menuItem.flags or CMIF_HIDDEN;
+ CallService(MS_CLIST_MODIFYMENUITEM, MenuHandles[miEmpty].Handle,
+ lParam(@menuitem));
+ if ShowHistoryCount then
+ begin
+ menuItem.flags := menuItem.flags or dword(CMIM_NAME) or CMIF_UNICODE;
+ menuItem.szName.w :=
+ pChar(Format('%s [%u]',[TranslateW(MenuHandles[miContact].Name),count]));
+ end
+ else if PrevShowHistoryCount then
+ begin
+ menuItem.flags := menuItem.flags or DWord(CMIM_NAME);
+ menuItem.szName.w := TranslateW(MenuHandles[miContact].Name);
+ end;
+ res := CallService(MS_CLIST_MODIFYMENUITEM, MenuHandles[miContact].Handle,
+ lParam(@menuitem));
+ if res = 0 then
+ MenuCount := count;
+ PrevShowHistoryCount := ShowHistoryCount;
+ end;
+end;
+
+//wParam : HCONTACT
+//lParam : HDBCONTACT
+//Called when a new event has been added to the event chain
+//for a contact, HCONTACT contains the contact who added the event,
+//HDBCONTACT a handle to what was added.
+function OnEventAdded(wParam: WPARAM; lParam: LPARAM): Integer; cdecl;
+begin
+ Result := 0;
+ NotifyAllForms(HM_MIEV_EVENTADDED,wParam,lParam);
+end;
+
+//wParam : HCONTACT
+//lParam : HDBEVENT
+//Affect : Called when an event is about to be deleted from the event chain
+//for a contact, see notes
+function OnEventDeleted(wParam: WPARAM; lParam: LPARAM): Integer; cdecl;
+begin
+ Result := 0;
+ NotifyAllForms(HM_MIEV_EVENTDELETED,wParam,lParam);
+end;
+
+//wParam : hMetaContact
+//lParam : hDefaultContact
+//Affect : Called when a metacontact's default contact changes
+function OnMetaDefaultChanged(wParam: WPARAM; lParam: LPARAM): Integer; cdecl;
+begin
+ Result := 0;
+ NotifyAllForms(HM_MIEV_METADEFCHANGED,wParam,lParam);
+end;
+
+//wParam=0
+//lParam=0
+//This hook is fired just before the thread unwind stack is used,
+//it allows MT plugins to shutdown threads if they have any special
+//processing to do, etc.
+function OnPreshutdown(wParam: WPARAM; lParam: LPARAM): Integer; cdecl;
+begin
+ Result := 0;
+ NotifyAllForms(HM_MIEV_PRESHUTDOWN,0,0);
+end;
+
+exports
+ MirandaPluginInfoEx,
+ MirandaPluginInterfaces,
+ Load,
+ Unload;
+
+begin
+
+ // decreasing ref count to oleaut32.dll as said
+ // in plugins doc
+ FreeLibrary(GetModuleHandle('oleaut32.dll'));
+ // to use RTL on LTR systems
+ SysLocale.MiddleEast := true;
+
+ // shadow is back again...
+ Forms.HintWindowClass := THppHintWindow;
+
+end.
diff --git a/plugins/HistoryPlusPlus/historypp_Icon.ico b/plugins/HistoryPlusPlus/historypp_Icon.ico Binary files differnew file mode 100644 index 0000000000..cfd8992a5b --- /dev/null +++ b/plugins/HistoryPlusPlus/historypp_Icon.ico diff --git a/plugins/HistoryPlusPlus/historypp_icons.dpr b/plugins/HistoryPlusPlus/historypp_icons.dpr new file mode 100644 index 0000000000..cb44b85500 --- /dev/null +++ b/plugins/HistoryPlusPlus/historypp_icons.dpr @@ -0,0 +1,28 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+library historypp_icons;
+
+{$R 'historypp_icons.res' 'historypp_icons.rc'}
+
+begin
+
+end.
diff --git a/plugins/HistoryPlusPlus/historypp_icons.rc b/plugins/HistoryPlusPlus/historypp_icons.rc new file mode 100644 index 0000000000..d76f198aa8 --- /dev/null +++ b/plugins/HistoryPlusPlus/historypp_icons.rc @@ -0,0 +1,48 @@ +1 Icon res\historypp_contact.ico
+2 Icon res\historypp_search.ico
+3 Icon res\historypp_session_div.ico
+4 Icon res\sess_session.ico
+5 Icon res\sess_summer.ico
+6 Icon res\sess_autumn.ico
+7 Icon res\sess_winter.ico
+8 Icon res\sess_spring.ico
+9 Icon res\sess_year.ico
+10 Icon res\historypp_hotfilter.ico
+11 Icon res\historypp_hotfilterwait.ico
+12 Icon res\historypp_search_allresults.ico
+13 Icon res\toolbar_saveall.ico
+14 Icon res\historypp_hotsearch.ico
+15 Icon res\historypp_searchup.ico
+16 Icon res\historypp_searchdown.ico
+17 Icon res\toolbar_deleteall.ico
+18 Icon res\toolbar_delete.ico
+19 Icon res\toolbar_sessions.ico
+20 Icon res\toolbar_save.ico
+21 Icon res\toolbar_copy.ico
+22 Icon res\search_endofpage.ico
+23 Icon res\search_notfound.ico
+24 Icon res\historypp_hotfilterclear.ico
+25 Icon res\historypp_session_hide.ico
+26 Icon res\toolbar_eventsfilter.ico
+27 Icon res\historypp_contactdetails.ico
+28 Icon res\historypp_contactmenu.ico
+29 Icon res\historypp_bookmark.ico
+30 Icon res\historypp_bookmark_on.ico
+31 Icon res\historypp_bookmark_off.ico
+32 Icon res\gsearch_advanced.ico
+33 Icon res\gsearch_limitrange.ico
+34 Icon res\gsearch_searchprotected.ico
+35 Icon res\event_incoming.ico
+36 Icon res\event_outgoing.ico
+37 Icon res\event_system.ico
+38 Icon res\event_contacts.ico
+39 Icon res\event_sms.ico
+40 Icon res\event_webpager.ico
+41 Icon res\event_eexpress.ico
+42 Icon res\event_status.ico
+43 Icon res\event_smtpsimple.ico
+44 Icon res\event_nick.ico
+45 Icon res\event_avatar.ico
+46 Icon res\event_watrack.ico
+47 Icon res\event_statusmes.ico
+48 Icon res\event_voicecall.ico
diff --git a/plugins/HistoryPlusPlus/hpp_JclSysUtils.pas b/plugins/HistoryPlusPlus/hpp_JclSysUtils.pas new file mode 100644 index 0000000000..68107ffc8d --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_JclSysUtils.pas @@ -0,0 +1,398 @@ +//****************************************************************// +// This is cut-and-pasted version of JclSysUtils.pas library from // +// JEDI Code Library (JCL). Copyright (c) see contributors // +// // +// For use with History++ plugin // +// // +// This unit is not covered under GPL license, // +// actual license is provided below // +//****************************************************************// + +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is JclSysUtils.pas. } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. } +{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. All rights reserved. } +{ } +{ Contributors: } +{ Alexander Radchenko, } +{ Andreas Hausladen (ahuser) } +{ Anthony Steele } +{ Bernhard Berger } +{ Heri Bender } +{ Jeff } +{ Jeroen Speldekamp } +{ Marcel van Brakel } +{ Peter Friese } +{ Petr Vones (pvones) } +{ Python } +{ Robert Marquardt (marquardt) } +{ Robert R. Marsh } +{ Robert Rossmair (rrossmair) } +{ Rudy Velthuis } +{ Uwe Schuster (uschuster) } +{ Wayne Sherman } +{ } +{**************************************************************************************************} +{ } +{ Description: Various pointer and class related routines. } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/12/26 20:30:07 $ +// For history see end of file + +unit hpp_JclSysUtils; + +interface + +uses Windows, Classes; + +type + TDynByteArray = array of Byte; + Float = Extended; + PFloat = ^Float; + + +// Binary search +function SearchSortedList(List: TList; SortFunc: TListSortCompare; Item: Pointer; + Nearest: Boolean = False): Integer; + +type + TUntypedSearchCompare = function(Param: Pointer; ItemIndex: Integer; const Value): Integer; + +function SearchSortedUntyped(Param: Pointer; ItemCount: Integer; SearchFunc: TUntypedSearchCompare; + const Value; Nearest: Boolean = False): Integer; + +// Dynamic array sort and search routines +type + TDynArraySortCompare = function (Item1, Item2: Pointer): Integer; + +procedure SortDynArray(const ArrayPtr: Pointer; ElementSize: Cardinal; SortFunc: TDynArraySortCompare); +// Usage: SortDynArray(Array, SizeOf(Array[0]), SortFunction); +function SearchDynArray(const ArrayPtr: Pointer; ElementSize: Cardinal; SortFunc: TDynArraySortCompare; + ValuePtr: Pointer; Nearest: Boolean = False): Integer; +// Usage: SearchDynArray(Array, SizeOf(Array[0]), SortFunction, @SearchedValue); + +{ Various compare functions for basic types } + +function DynArrayCompareByte(Item1, Item2: Pointer): Integer; +function DynArrayCompareShortInt(Item1, Item2: Pointer): Integer; +function DynArrayCompareWord(Item1, Item2: Pointer): Integer; +function DynArrayCompareSmallInt(Item1, Item2: Pointer): Integer; +function DynArrayCompareInteger(Item1, Item2: Pointer): Integer; +function DynArrayCompareCardinal(Item1, Item2: Pointer): Integer; +function DynArrayCompareInt64(Item1, Item2: Pointer): Integer; + +function DynArrayCompareSingle(Item1, Item2: Pointer): Integer; +function DynArrayCompareDouble(Item1, Item2: Pointer): Integer; +function DynArrayCompareExtended(Item1, Item2: Pointer): Integer; +function DynArrayCompareFloat(Item1, Item2: Pointer): Integer; + +function DynArrayCompareAnsiString(Item1, Item2: Pointer): Integer; +function DynArrayCompareAnsiText(Item1, Item2: Pointer): Integer; +function DynArrayCompareString(Item1, Item2: Pointer): Integer; +function DynArrayCompareText(Item1, Item2: Pointer): Integer; + +implementation + +uses SysUtils; + +//=== Binary search ========================================================== + +function SearchSortedList(List: TList; SortFunc: TListSortCompare; Item: Pointer; Nearest: Boolean): Integer; +var + L, H, I, C: Integer; + B: Boolean; +begin + Result := -1; + if List <> nil then + begin + L := 0; + H := List.Count - 1; + B := False; + while L <= H do + begin + I := (L + H) shr 1; + C := SortFunc(List.List[I], Item); + if C < 0 then + L := I + 1 + else + begin + H := I - 1; + if C = 0 then + begin + B := True; + L := I; + end; + end; + end; + if B then + Result := L + else + if Nearest and (H >= 0) then + Result := H; + end; +end; + +function SearchSortedUntyped(Param: Pointer; ItemCount: Integer; SearchFunc: TUntypedSearchCompare; + const Value; Nearest: Boolean): Integer; +var + L, H, I, C: Integer; + B: Boolean; +begin + Result := -1; + if ItemCount > 0 then + begin + L := 0; + H := ItemCount - 1; + B := False; + while L <= H do + begin + I := (L + H) shr 1; + C := SearchFunc(Param, I, Value); + if C < 0 then + L := I + 1 + else + begin + H := I - 1; + if C = 0 then + begin + B := True; + L := I; + end; + end; + end; + if B then + Result := L + else + if Nearest and (H >= 0) then + Result := H; + end; +end; + +//=== Dynamic array sort and search routines ================================= + +procedure SortDynArray(const ArrayPtr: Pointer; ElementSize: Cardinal; SortFunc: TDynArraySortCompare); +var + TempBuf: TDynByteArray; + + function ArrayItemPointer(Item: Integer): Pointer; + begin + Result := Pointer(uint_ptr(ArrayPtr) + (uint_ptr(Item) * ElementSize)); + end; + + procedure QuickSort(L, R: Integer); + var + I, J, T: Integer; + P, IPtr, JPtr: Pointer; + begin + repeat + I := L; + J := R; + P := ArrayItemPointer((L + R) shr 1); + repeat + while SortFunc(ArrayItemPointer(I), P) < 0 do + Inc(I); + while SortFunc(ArrayItemPointer(J), P) > 0 do + Dec(J); + if I <= J then + begin + IPtr := ArrayItemPointer(I); + JPtr := ArrayItemPointer(J); + case ElementSize of + SizeOf(Byte): + begin + T := PByte(IPtr)^; + PByte(IPtr)^ := PByte(JPtr)^; + PByte(JPtr)^ := T; + end; + SizeOf(Word): + begin + T := PWord(IPtr)^; + PWord(IPtr)^ := PWord(JPtr)^; + PWord(JPtr)^ := T; + end; + SizeOf(Integer): + begin + T := PInteger(IPtr)^; + PInteger(IPtr)^ := PInteger(JPtr)^; + PInteger(JPtr)^ := T; + end; + else + Move(IPtr^, TempBuf[0], ElementSize); + Move(JPtr^, IPtr^, ElementSize); + Move(TempBuf[0], JPtr^, ElementSize); + end; + if P = IPtr then + P := JPtr + else + if P = JPtr then + P := IPtr; + Inc(I); + Dec(J); + end; + until I > J; + if L < J then + QuickSort(L, J); + L := I; + until I >= R; + end; + +begin + if ArrayPtr <> nil then + begin + SetLength(TempBuf, ElementSize); + QuickSort(0, PInteger(uint_ptr(ArrayPtr) - SizeOf(pointer))^ - 1); //!!!! + end; +end; + +function SearchDynArray(const ArrayPtr: Pointer; ElementSize: Cardinal; SortFunc: TDynArraySortCompare; + ValuePtr: Pointer; Nearest: Boolean): Integer; +var + L, H, I, C: Integer; + B: Boolean; +begin + Result := -1; + if ArrayPtr <> nil then + begin + L := 0; + H := PInteger(uint_ptr(ArrayPtr) - SizeOf(pointer))^ - 1; //!!!! + B := False; + while L <= H do + begin + I := (L + H) shr 1; + C := SortFunc(Pointer(uint_ptr(ArrayPtr) + (uint_ptr(I) * ElementSize)), ValuePtr); + if C < 0 then + L := I + 1 + else + begin + H := I - 1; + if C = 0 then + begin + B := True; + L := I; + end; + end; + end; + if B then + Result := L + else + if Nearest and (H >= 0) then + Result := H; + end; +end; + +{ Various compare functions for basic types } + +function DynArrayCompareByte(Item1, Item2: Pointer): Integer; +begin + Result := PByte(Item1)^ - PByte(Item2)^; +end; + +function DynArrayCompareShortInt(Item1, Item2: Pointer): Integer; +begin + Result := PShortInt(Item1)^ - PShortInt(Item2)^; +end; + +function DynArrayCompareWord(Item1, Item2: Pointer): Integer; +begin + Result := PWord(Item1)^ - PWord(Item2)^; +end; + +function DynArrayCompareSmallInt(Item1, Item2: Pointer): Integer; +begin + Result := PSmallInt(Item1)^ - PSmallInt(Item2)^; +end; + +function DynArrayCompareInteger(Item1, Item2: Pointer): Integer; +begin + Result := PInteger(Item1)^ - PInteger(Item2)^; +end; + +function DynArrayCompareCardinal(Item1, Item2: Pointer): Integer; +begin + Result := PInteger(Item1)^ - PInteger(Item2)^; +end; + +function DynArrayCompareInt64(Item1, Item2: Pointer): Integer; +begin + Result := PInt64(Item1)^ - PInt64(Item2)^; +end; + +function DynArrayCompareSingle(Item1, Item2: Pointer): Integer; +begin + if PSingle(Item1)^ < PSingle(Item2)^ then + Result := -1 + else + if PSingle(Item1)^ > PSingle(Item2)^ then + Result := 1 + else + Result := 0; +end; + +function DynArrayCompareDouble(Item1, Item2: Pointer): Integer; +begin + if PDouble(Item1)^ < PDouble(Item2)^ then + Result := -1 + else + if PDouble(Item1)^ > PDouble(Item2)^ then + Result := 1 + else + Result := 0; +end; + +function DynArrayCompareExtended(Item1, Item2: Pointer): Integer; +begin + if PExtended(Item1)^ < PExtended(Item2)^ then + Result := -1 + else + if PExtended(Item1)^ > PExtended(Item2)^ then + Result := 1 + else + Result := 0; +end; + +function DynArrayCompareFloat(Item1, Item2: Pointer): Integer; +begin + if PFloat(Item1)^ < PFloat(Item2)^ then + Result := -1 + else + if PFloat(Item1)^ > PFloat(Item2)^ then + Result := 1 + else + Result := 0; +end; + +function DynArrayCompareAnsiString(Item1, Item2: Pointer): Integer; +begin + Result := AnsiCompareStr(PAnsiString(Item1)^, PAnsiString(Item2)^); +end; + +function DynArrayCompareAnsiText(Item1, Item2: Pointer): Integer; +begin + Result := AnsiCompareText(PAnsiString(Item1)^, PAnsiString(Item2)^); +end; + +function DynArrayCompareString(Item1, Item2: Pointer): Integer; +begin + Result := CompareStr(PAnsiString(Item1)^, PAnsiString(Item2)^); +end; + +function DynArrayCompareText(Item1, Item2: Pointer): Integer; +begin + Result := CompareText(PAnsiString(Item1)^, PAnsiString(Item2)^); +end; + +end. diff --git a/plugins/HistoryPlusPlus/hpp_arrays.pas b/plugins/HistoryPlusPlus/hpp_arrays.pas new file mode 100644 index 0000000000..f564fa9805 --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_arrays.pas @@ -0,0 +1,158 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+unit hpp_arrays;
+
+interface
+
+uses hpp_jclSysUtils, hpp_global;
+
+function IntSortedArray_Add(var A: TIntArray; Value: Integer): Integer;
+procedure IntSortedArray_Remove(var A: TIntArray; Value: Integer);
+function IntSortedArray_Find(var A: TIntArray; Value: Integer): Integer;
+procedure IntSortedArray_Sort(var A: TIntArray);
+function IntSortedArray_NonIntersect(var A, B: TIntArray): TIntArray;
+
+procedure IntArrayRemove(var A: TIntArray; Index: Integer);
+procedure IntArrayInsert(var A: TIntArray; Index: Integer; Value: Integer);
+
+implementation
+
+procedure IntArrayRemove(var A: TIntArray; Index: Integer);
+var
+ i: Integer;
+begin
+ for i := Index to Length(A) - 2 do
+ A[i] := A[i + 1];
+ SetLength(A, Length(A) - 1);
+end;
+
+procedure IntArrayInsert(var A: TIntArray; Index: Integer; Value: Integer);
+var
+ i: Integer;
+begin
+ SetLength(A, Length(A) + 1);
+ for i := Length(A) - 1 downto Index do
+ A[i] := A[i - 1];
+ A[Index] := Value;
+end;
+
+function IntSortedArray_Add(var A: TIntArray; Value: Integer): Integer;
+begin
+ Result := SearchDynArray(A, SizeOf(Integer), DynArrayCompareInteger, @Value, True);
+ if Result <> -1 then // we have nearest or match
+ begin
+ if A[Result] = Value then
+ exit;
+ if A[Result] < Value then
+ Inc(Result);
+ end
+ else // we don't have any nearest values, array is empty
+ Result := 0;
+ IntArrayInsert(A, Result, Value);
+end;
+
+procedure IntSortedArray_Remove(var A: TIntArray; Value: Integer);
+var
+ idx: Integer;
+begin
+ idx := SearchDynArray(A, SizeOf(Integer), DynArrayCompareInteger, @Value);
+ if idx = -1 then
+ exit;
+ IntArrayRemove(A, idx);
+end;
+
+function IntSortedArray_Find(var A: TIntArray; Value: Integer): Integer;
+begin
+ Result := SearchDynArray(A, SizeOf(Integer), DynArrayCompareInteger, @Value);
+end;
+
+procedure IntSortedArray_Sort(var A: TIntArray);
+begin
+ SortDynArray(A, SizeOf(Integer), DynArrayCompareInteger);
+end;
+
+function IntSortedArray_NonIntersect(var A, B: TIntArray): TIntArray;
+var
+ ia, ib: Integer;
+ lenr, lena, lenb: Integer;
+
+ procedure AddToResult(Item: Integer);
+ begin
+ Inc(lenr);
+ SetLength(Result, lenr);
+ Result[lenr - 1] := Item;
+ end;
+
+begin
+ SetLength(Result, 0);
+ lenr := 0;
+ lena := Length(A);
+ lenb := Length(B);
+ ib := 0;
+ ia := 0;
+
+ while ia < lena do
+ begin
+
+ if ib >= lenb then
+ begin
+ AddToResult(A[ia]);
+ Inc(ia);
+ continue;
+ end;
+
+ if A[ia] = B[ib] then
+ begin
+ Inc(ib);
+ Inc(ia);
+ continue;
+ end;
+
+ if A[ia] > B[ib] then
+ begin
+ while A[ia] > B[ib] do
+ begin
+ AddToResult(B[ib]);
+ Inc(ib);
+ if ib >= lenb then
+ break;
+ end;
+ continue;
+ end;
+
+ if A[ia] < B[ib] then
+ begin
+ AddToResult(A[ia]);
+ Inc(ia);
+ continue;
+ end;
+
+ end;
+
+ while ib < lenb do
+ begin
+ AddToResult(B[ib]);
+ Inc(ib);
+ end;
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/hpp_bookmarks.pas b/plugins/HistoryPlusPlus/hpp_bookmarks.pas new file mode 100644 index 0000000000..a98f2a381a --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_bookmarks.pas @@ -0,0 +1,692 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+{-----------------------------------------------------------------------------
+ hpp_bookmarks.pas (historypp project)
+
+ Version: 1.5
+ Created: 02.04.2006
+ Author: Oxygen
+
+ [ Description ]
+
+ Hello, this is dummy text
+
+
+ [ History ]
+
+ 1.5 (02.04.2006)
+ First version
+
+ [ Modifications ]
+ none
+
+ [ Known Issues ]
+ none
+
+ Contributors: theMIROn, Art Fedorov
+-----------------------------------------------------------------------------}
+
+unit hpp_bookmarks;
+
+interface
+
+uses windows, m_api, hpp_jclSysUtils, SysUtils;
+
+type
+ TEventData = record
+ hDBEvent: THandle;
+ CRC32: DWord;
+ Timestamp: Cardinal;
+ end;
+ PEventData = ^TEventData;
+
+ TBookmarksHash = class;
+
+ TContactBookmarks = class(TObject)
+ private
+ Bookmarks: TBookmarksHash;
+ hContact: THandle;
+ FContactCP: Cardinal;
+ function GetBookmarked(Index: THandle): Boolean;
+ procedure SetBookmarked(Index: THandle; const Value: Boolean);
+ function GetBookmarkName(Index: THandle): String;
+ procedure SetBookmarkName(Index: THandle; const Value: String);
+ procedure LoadBookmarks;
+ procedure SaveBookmarks;
+ procedure DeleteBookmarks;
+ function GetCount: Integer;
+ function GetItems(Index: Integer): THandle;
+ function GetNames(Index: Integer): String;
+ public
+ constructor Create(AContact: THandle);
+ destructor Destroy; override;
+ procedure Clear;
+ property Bookmarked[Index: THandle]: Boolean read GetBookmarked write SetBookmarked;
+ property BookmarkName[Index: THandle]: String read GetBookmarkName write SetBookmarkName;
+ property Items[Index: Integer]: THandle read GetItems;
+ property Names[Index: Integer]: String read GetNames;
+ property Count: Integer read GetCount;
+ property Contact: THandle read hContact;
+ property ContactCP: Cardinal read FContactCP;
+ end;
+ PContactBookmarks = ^TContactBookmarks;
+
+ TPseudoHashEntry = record
+ Key: uint_ptr;
+ Value: pointer;
+ end;
+ PPseudoHashEntry = ^TPseudoHashEntry;
+
+ TPseudoHash = class(TObject)
+ private
+ Table: array of TPseudoHashEntry;
+ procedure RemoveByIndex(Index: Integer);
+// procedure InsertByIndex(Index: Integer; Key:Cardinal;Value: pointer);
+ protected
+ function AddKey(Key:uint_ptr; Value: pointer): Boolean;
+ function GetKey(Key:uint_ptr; var Value: pointer): Boolean;
+ function RemoveKey(Key: uint_ptr): Boolean;
+ public
+ destructor Destroy; override;
+ end;
+
+ TContactsHash = class(TPseudoHash)
+ private
+ function GetContactBookmarks(Index: THandle): TContactBookmarks;
+ public
+ property Items[Index: THandle]: TContactBookmarks read GetContactBookmarks; default;
+ function RemoveItem(Index: THandle): Boolean;
+ destructor Destroy; override;
+ end;
+
+ TBookmarksHash = class(TPseudoHash)
+ private
+ Contact: TContactBookmarks;
+ function GetHasItem(Index: THandle): Boolean;
+// function GetBookmark(hDBEvent: THandle; var EventData: TEventData): Boolean;
+ function AddItem(hDBEvent: THandle): Boolean;
+ function RemoveItem(hDBEvent: THandle): Boolean;
+ function AddItemName(hDBEvent: THandle; Value: String): Boolean;
+ function GetItemName(hDBEvent: THandle): String;
+ function RemoveItemName(hDBEvent: THandle): Boolean;
+ function FindEventByTimestampAndCrc(ped: PEventData): Boolean;
+ public
+ constructor Create(AContact: TContactBookmarks);
+ destructor Destroy; override;
+ function Clear: Integer;
+ function AddEventData(var EventData: TEventData): Boolean;
+ property HasItem[Index: THandle]: Boolean read GetHasItem; default;
+ end;
+
+ TBookmarkServer = class(TObject)
+ private
+ hookContactDeleted,
+ hookEventDeleted,
+ hookEventAdded: THandle;
+ CachedContacts: TContactsHash;
+ function GetContacts(Index: THandle): TContactBookmarks;
+ protected
+ procedure ContactDeleted(hContact: THandle);
+ procedure EventDeleted(hContact,hDBEvent: THandle);
+ procedure EventAdded(hContact,hDBEvent: THandle);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ property Contacts[Index: THandle]: TContactBookmarks read GetContacts; default;
+ end;
+
+var
+ BookmarkServer: TBookmarkServer;
+
+procedure hppInitBookmarkServer;
+procedure hppDeinitBookmarkServer;
+
+implementation
+
+uses hpp_events, hpp_contacts, hpp_global, Checksum, hpp_database, hpp_forms;
+
+procedure hppInitBookmarkServer;
+begin
+ BookmarkServer := TBookmarkServer.Create;
+end;
+
+procedure hppDeinitBookmarkServer;
+begin
+ BookmarkServer.Free;
+end;
+
+function ContactDeletedHelper(wParam: WPARAM; lParam: LPARAM): Integer; cdecl;
+// wParam: hContact, lParam: 0
+begin
+ if Assigned(BookmarkServer) then
+ BookmarkServer.ContactDeleted(wParam);
+ Result := 0;
+end;
+
+function EventDeletedHelper(wParam: WPARAM; lParam: LPARAM): Integer; cdecl;
+// wParam: hContact, lParam: hDBEvent
+begin
+ if Assigned(BookmarkServer) then
+ BookmarkServer.EventDeleted(wParam,lParam);
+ Result := 0;
+end;
+
+function EventAddedHelper(wParam: WPARAM; lParam: LPARAM): Integer; cdecl;
+// wParam: hContact, lParam: hDBEvent
+begin
+ if Assigned(BookmarkServer) then
+ BookmarkServer.EventAdded(wParam,lParam);
+ Result := 0;
+end;
+
+function DynArrayComparePseudoHash(Item1, Item2: Pointer): Integer;
+begin
+ {$OVERFLOWCHECKS ON}
+ Result := PInteger(@PPseudoHashEntry(Item1)^.Key)^ - PInteger(@PPseudoHashEntry(Item2)^.Key)^;
+ {$OVERFLOWCHECKS OFF}
+end;
+
+{ TBookmarkServer }
+
+function TBookmarkServer.GetContacts(Index: THandle): TContactBookmarks;
+begin
+ Result := CachedContacts[Index];
+end;
+
+constructor TBookmarkServer.Create;
+begin
+ inherited;
+ CachedContacts := TContactsHash.Create;
+ hookContactDeleted := HookEvent(ME_DB_CONTACT_DELETED,ContactDeletedHelper);
+ hookEventDeleted := HookEvent(ME_DB_EVENT_DELETED,EventDeletedHelper);
+ hookEventAdded := HookEvent(ME_DB_EVENT_ADDED,EventAddedHelper);
+end;
+
+destructor TBookmarkServer.Destroy;
+begin
+ UnhookEvent(hookContactDeleted);
+ UnhookEvent(hookEventDeleted);
+ UnhookEvent(hookEventAdded);
+ CachedContacts.Free;
+ BookmarkServer := nil;
+ inherited;
+end;
+
+procedure TBookmarkServer.ContactDeleted(hContact: THandle);
+begin
+ // do we really need to delete bookmarks from contact,
+ // if he is about to be deleted? I think don't
+ //Contacts[hContact].DeleteBookmarks;
+ CachedContacts.RemoveItem(hContact);
+end;
+
+procedure TBookmarkServer.EventDeleted(hContact, hDBEvent: THandle);
+begin
+ Contacts[hContact].Bookmarked[hDBEvent] := false;
+end;
+
+procedure TBookmarkServer.EventAdded(hContact, hDBEvent: THandle);
+begin
+ ;
+end;
+
+{ TContactBookmarks }
+
+constructor TContactBookmarks.Create(AContact: THandle);
+begin
+ hContact := AContact;
+ FContactCP := GetContactCodepage(hContact);
+ Bookmarks := TBookmarksHash.Create(Self);
+ // read bookmarks from DB here
+ LoadBookmarks;
+end;
+
+procedure TContactBookmarks.DeleteBookmarks;
+begin
+ DBDelete(hContact,hppDBName,'Bookmarks');
+end;
+
+destructor TContactBookmarks.Destroy;
+begin
+ Bookmarks.Free;
+ inherited;
+end;
+
+function TContactBookmarks.GetBookmarked(Index: THandle): Boolean;
+begin
+ Result := Bookmarks[Index];
+end;
+
+function TContactBookmarks.GetCount: Integer;
+begin
+ Result := Length(Bookmarks.Table);
+end;
+
+function TContactBookmarks.GetItems(Index: Integer): THandle;
+begin
+ Result := PEventData(Bookmarks.Table[Index].Value)^.hDBEvent;
+end;
+
+function TContactBookmarks.GetNames(Index: Integer): String;
+var
+ hDBEvent: THandle;
+begin
+ hDBEvent := PEventData(Bookmarks.Table[Index].Value)^.hDBEvent;
+ Result := Bookmarks.GetItemName(hDBEvent)
+end;
+
+procedure TContactBookmarks.LoadBookmarks;
+var
+ i: Integer;
+ mem: PEventData;
+ mem_org: Pointer;
+ mem_len: Integer;
+ rec_size: Word;
+ count: Integer;
+ ed: PEventData;
+ AllOk: Boolean;
+begin
+ if not GetDBBlob(hContact, hppDBName, 'Bookmarks', mem_org, mem_len) then
+ exit;
+ try
+ AllOk := True;
+ if mem_len < SizeOf(Word) then
+ raise EAbort.Create('Too small bookmarks rec');
+ rec_size := PWord(mem_org)^;
+ if rec_size < SizeOf(TEventData) then
+ raise EAbort.Create('Bookmark size is too small');
+ Count := (mem_len - SizeOf(Word)) div rec_size;
+ mem := pointer(uint_ptr(mem_org) + SizeOf(Word));
+ for i := 0 to Count - 1 do
+ begin
+ ed := PEventData(int_ptr(mem) + i * rec_size);
+ if not Bookmarks.AddEventData(ed^) then
+ AllOk := false;
+ end;
+ FreeMem(mem_org, mem_len);
+ // if we found that some items are missing or different, save
+ // correct copy:
+ if not AllOk then
+ SaveBookmarks;
+ except
+ DeleteBookmarks;
+ end;
+end;
+
+procedure TContactBookmarks.SaveBookmarks;
+var
+ mem: Pointer;
+ mem_len: Integer;
+ i: Integer;
+ src,dst: PEventData;
+begin
+ if Length(Bookmarks.Table) > 0 then
+ begin
+ mem_len := Length(Bookmarks.Table) * SizeOf(TEventData) + SizeOf(Word);
+ GetMem(mem, mem_len);
+ PWord(mem)^ := Word(SizeOf(TEventData));
+ for i := 0 to High(Bookmarks.Table) do
+ begin
+ src := PEventData(Bookmarks.Table[i].Value);
+ dst := PEventData(int_ptr(mem) + SizeOf(Word) + i * SizeOf(TEventData));
+ Move(src^, dst^, SizeOf(src^));
+ end;
+ WriteDBBlob(hContact, hppDBName, 'Bookmarks', mem, mem_len);
+ FreeMem(mem, mem_len);
+ end
+ else
+ begin
+ DeleteBookmarks;
+ end;
+end;
+
+procedure TContactBookmarks.SetBookmarked(Index: THandle; const Value: Boolean);
+var
+ res: Boolean;
+begin
+ if Value then
+ res := Bookmarks.AddItem(Index)
+ else
+ res := Bookmarks.RemoveItem(Index);
+ if res then
+ begin
+ SaveBookmarks;
+ NotifyAllForms(HM_NOTF_BOOKMARKCHANGED, hContact, Index);
+ end;
+end;
+
+procedure TContactBookmarks.SetBookmarkName(Index: THandle; const Value: String);
+begin
+ Bookmarks.AddItemName(Index,Value);
+end;
+
+function TContactBookmarks.GetBookmarkName(Index: THandle): String;
+begin
+ Result := Bookmarks.GetItemName(Index);
+end;
+
+procedure TContactBookmarks.Clear;
+begin
+ Bookmarks.Clear;
+ DeleteBookmarks;
+ //NotifyAllForms(HM_NOTF_BOOKMARKCHANGED,hContact,0);
+end;
+
+{ TPseudoHash }
+
+function TPseudoHash.AddKey(Key:uint_ptr; Value: pointer): Boolean;
+var
+ Nearest: Integer;
+ ph: TPseudoHashEntry;
+ i: Integer;
+begin
+ Result := False;
+ ph.Key := Key;
+ Nearest := SearchDynArray(Table,SizeOf(TPseudoHashEntry),DynArrayComparePseudoHash,@ph,True);
+ if Nearest <> -1 then begin // we have nearest or match
+ if Table[Nearest].Key = Key then
+ exit;
+ if Table[Nearest].Key < Key then
+ Inc(Nearest);
+ end
+ else
+ Nearest := 0; // table is empty
+
+ SetLength(Table,Length(Table)+1);
+ for i := Length(Table)-1 downto Nearest do
+ Table[i] := Table[i-1];
+
+ Table[Nearest].Key := Key;
+ Table[Nearest].Value := Value;
+
+ Result := True;
+end;
+
+destructor TPseudoHash.Destroy;
+begin
+ SetLength(Table,0);
+ inherited;
+end;
+
+function TPseudoHash.GetKey(Key: uint_ptr; var Value: pointer): Boolean;
+var
+ ph: TPseudoHashEntry;
+ res: Integer;
+begin
+ Result := false;
+ ph.Key := Key;
+ res := SearchDynArray(Table, SizeOf(TPseudoHashEntry), DynArrayComparePseudoHash, @ph, false);
+ if res <> -1 then
+ begin
+ Result := True;
+ Value := Table[res].Value;
+ end;
+end;
+(*
+procedure TPseudoHash.InsertByIndex(Index: Integer; Key:cardinal; Value: pointer);
+begin
+ //
+end;
+*)
+procedure TPseudoHash.RemoveByIndex(Index: Integer);
+var
+ i: Integer;
+begin
+ for i := Index to Length(Table) - 2 do
+ Table[i] := Table[i+1];
+ SetLength(Table,Length(Table)-1);
+end;
+
+function TPseudoHash.RemoveKey(Key: uint_ptr): Boolean;
+var
+ idx: Integer;
+ ph: TPseudoHashEntry;
+begin
+ Result := False;
+ ph.Key := Key;
+ idx := SearchDynArray(Table,SizeOf(TPseudoHashEntry),DynArrayComparePseudoHash,@ph,False);
+ if idx = -1 then exit;
+ RemoveByIndex(idx);
+ Result := True;
+end;
+
+{ TContactsHash }
+
+destructor TContactsHash.Destroy;
+var
+ i: Integer;
+begin
+ for i := 0 to Length(Table) - 1 do
+ TContactBookmarks(Pointer(Table[i].Value)).Free;
+ inherited;
+end;
+
+function TContactsHash.GetContactBookmarks(Index: THandle): TContactBookmarks;
+var
+ val: Pointer;
+begin
+ // Result := nil;
+ if GetKey(Cardinal(Index), val) then
+ Result := TContactBookmarks(val)
+ else
+ begin
+ Result := TContactBookmarks.Create(Index);
+ AddKey(Cardinal(Index), pointer(Result));
+ end;
+end;
+
+function TContactsHash.RemoveItem(Index: THandle): Boolean;
+var
+ val: Pointer;
+begin
+ Result := false;
+ if GetKey(Cardinal(Index), val) then
+ begin
+ RemoveKey(Cardinal(Index));
+ TContactBookmarks(val).Free;
+ Result := True;
+ end;
+end;
+
+{ TBookmarksHash }
+
+function TBookmarksHash.AddEventData(var EventData: TEventData): Boolean;
+var
+ ped: PEventData;
+ ts: Cardinal;
+ ItemExists, ItemCorrect, NewItemFound: Boolean;
+begin
+ GetMem(ped, SizeOf(TEventData));
+ ped^.hDBEvent := EventData.hDBEvent;
+ ped^.CRC32 := EventData.CRC32;
+ ped^.Timestamp := EventData.Timestamp;
+ ItemExists := (CallService(MS_DB_EVENT_GETBLOBSIZE, EventData.hDBEvent, 0) >= 0);
+ ItemCorrect := false; // added by Awkward, default value
+ if ItemExists then
+ begin
+ ts := GetEventTimestamp(EventData.hDBEvent);
+ ItemCorrect := (ts = ped^.Timestamp);
+ // we might check for CRC32 here also?
+ end;
+ if (not ItemExists) or (not ItemCorrect) then
+ begin
+ Result := false;
+ NewItemFound := FindEventByTimestampAndCrc(ped); // try to find the item
+ if not NewItemFound then
+ begin // can not find
+ FreeMem(ped, SizeOf(TEventData));
+ exit;
+ end
+ else
+ AddKey(ped^.hDBEvent, ped);
+ // exit, but leave Result = False as we want to resave after this load
+ end
+ else
+ Result := AddKey(ped^.hDBEvent, ped); // item exists, add as normal
+end;
+
+function TBookmarksHash.AddItem(hDBEvent: THandle): Boolean;
+var
+ ped: PEventData;
+ hi: THistoryItem;
+begin
+ GetMem(ped,SizeOf(TEventData));
+ ped^.hDBEvent := hDBEvent;
+ hi := ReadEvent(hDBEvent,Contact.ContactCP);
+ ped^.Timestamp := hi.Time;
+ CalcCRC32(PWideChar(hi.Text),Length(hi.Text)*SizeOf(WideChar),Cardinal(ped^.CRC32));
+ Result := AddKey(hDBEvent,ped);
+end;
+
+function TBookmarksHash.AddItemName(hDBEvent: THandle; Value: String): Boolean;
+begin
+ Result := (WriteDBWideStr(Contact.hContact,hppDBName,AnsiString('bm'+intToStr(hDBEvent)),Value) = 0);
+end;
+
+function TBookmarksHash.GetItemName(hDBEvent: THandle): String;
+begin
+ Result := GetDBWideStr(Contact.hContact,hppDBName,AnsiString('bm'+intToStr(hDBEvent)),'');
+end;
+
+function TBookmarksHash.RemoveItemName(hDBEvent: THandle): Boolean;
+begin
+ if DBExists(Contact.hContact,hppDBName,AnsiString('bm'+intToStr(hDBEvent))) then
+ Result := DBDelete(Contact.hContact,hppDBName,AnsiString('bm'+intToStr(hDBEvent)))
+ else
+ Result := True;
+end;
+
+constructor TBookmarksHash.Create(AContact: TContactBookmarks);
+begin
+ Contact := AContact;
+end;
+
+destructor TBookmarksHash.Destroy;
+begin
+ Clear;
+ inherited;
+end;
+
+function TBookmarksHash.Clear: Integer;
+var
+ i: Integer;
+begin
+ for i := 0 to Length(Table) - 1 do
+ FreeMem(PEventData(Table[i].Value),SizeOf(TEventData));
+ Result := Length(Table);
+ SetLength(Table,0);
+end;
+
+// currently finds events with similar timestamp ONLY
+function TBookmarksHash.FindEventByTimestampAndCrc(ped: PEventData): Boolean;
+var
+ hDBEvent: THandle;
+ first_ts,last_ts,ts,cur_ts: Integer;
+ StartFromFirst: Boolean;
+begin
+ Result := false;
+
+ hDBEvent := CallService(MS_DB_EVENT_FINDFIRST, Contact.hContact, 0);
+ if hDBEvent = 0 then
+ exit;
+ first_ts := GetEventTimestamp(hDBEvent);
+ hDBEvent := CallService(MS_DB_EVENT_FINDLAST, Contact.hContact, 0);
+ if hDBEvent = 0 then
+ exit;
+ last_ts := GetEventTimestamp(hDBEvent);
+ ts := ped^.Timestamp;
+ if (ts < first_ts) or (ts > last_ts) then
+ exit;
+ StartFromFirst := ((ts - first_ts) < (last_ts - ts));
+
+ if StartFromFirst then
+ begin
+ hDBEvent := CallService(MS_DB_EVENT_FINDFIRST, Contact.hContact, 0);
+ while hDBEvent <> 0 do
+ begin
+ cur_ts := GetEventTimestamp(hDBEvent);
+ if cur_ts > ts then
+ break;
+ if cur_ts = ts then
+ begin
+ ped^.hDBEvent := hDBEvent;
+ Result := True;
+ break;
+ end;
+ hDBEvent := CallService(MS_DB_EVENT_FINDNEXT, hDBEvent, 0);
+ end;
+ end
+ else
+ begin
+ hDBEvent := CallService(MS_DB_EVENT_FINDLAST, Contact.hContact, 0);
+ while hDBEvent <> 0 do
+ begin
+ cur_ts := GetEventTimestamp(hDBEvent);
+ if ts > cur_ts then
+ break;
+ if cur_ts = ts then
+ begin
+ ped^.hDBEvent := hDBEvent;
+ Result := True;
+ break;
+ end;
+ hDBEvent := CallService(MS_DB_EVENT_FINDPREV, hDBEvent, 0);
+ end;
+ end;
+end;
+(*
+function TBookmarksHash.GetBookmark(hDBEvent: THandle;
+ var EventData: TEventData): Boolean;
+var
+ val: Pointer;
+begin
+ Result := False;
+ if GetKey(Cardinal(hDBEvent),val) then begin
+ EventData := PEventData(val)^;
+ Result := True;
+ end;
+end;
+*)
+function TBookmarksHash.GetHasItem(Index: THandle): Boolean;
+var
+ val: Pointer;
+begin
+ Result := False;
+ if GetKey(uint_ptr(Index),val) then
+ Result := True;
+end;
+
+function TBookmarksHash.RemoveItem(hDBEvent: THandle): Boolean;
+var
+ ped: PEventData;
+begin
+ Result := false;
+ if GetKey(uint_ptr(hDBEvent), pointer(ped)) then
+ begin
+ RemoveKey(uint_ptr(hDBEvent));
+ FreeMem(ped, SizeOf(ped^));
+ RemoveItemName(hDBEvent);
+ Result := True;
+ end;
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/hpp_contacts.pas b/plugins/HistoryPlusPlus/hpp_contacts.pas new file mode 100644 index 0000000000..32d938224e --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_contacts.pas @@ -0,0 +1,269 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+{ -----------------------------------------------------------------------------
+ hpp_contacts (historypp project)
+
+ Version: 1.0
+ Created: 31.03.2003
+ Author: Oxygen
+
+ [ Description ]
+
+ Some helper routines for contacts
+
+ [ History ]
+ 1.0 (31.03.2003) - Initial version
+
+ [ Modifications ]
+
+ [ Knows Inssues ]
+ None
+
+ Contributors: theMIROn, Art Fedorov
+ ----------------------------------------------------------------------------- }
+
+unit hpp_contacts;
+
+interface
+
+uses
+ Windows, SysUtils,
+ Forms,
+ hpp_global,
+ hpp_database;
+
+function GetContactDisplayName(hContact: THandle; Proto: AnsiString = ''; Contact: boolean = false): String;
+function GetContactProto(hContact: THandle): AnsiString; overload;
+function GetContactProto(hContact: THandle; var SubContact: THandle; var SubProtocol: AnsiString): AnsiString; overload;
+function GetContactID(hContact: THandle; Proto: AnsiString = ''; Contact: boolean = false): AnsiString;
+function GetContactCodePage(hContact: THandle; Proto: AnsiString = ''): Cardinal; overload;
+function GetContactCodePage(hContact: THandle; Proto: AnsiString; var UsedDefault: boolean): Cardinal; overload;
+function WriteContactCodePage(hContact: THandle; CodePage: Cardinal; Proto: AnsiString = ''): boolean;
+function GetContactRTLMode(hContact: THandle; Proto: AnsiString = ''): boolean;
+function GetContactRTLModeTRTL(hContact: THandle; Proto: AnsiString = ''): TRTLMode;
+function WriteContactRTLMode(hContact: THandle; RTLMode: TRTLMode; Proto: AnsiString = ''): boolean;
+
+implementation
+
+uses hpp_options, m_api;
+
+function GetContactProto(hContact: THandle): AnsiString;
+begin
+ Result := PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO, hContact, 0));
+end;
+
+function GetContactProto(hContact: THandle; var SubContact: THandle; var SubProtocol: AnsiString): AnsiString;
+begin
+ Result := PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO, hContact, 0));
+ if MetaContactsEnabled and (Result = MetaContactsProto) then
+ begin
+ SubContact := CallService(MS_MC_GETMOSTONLINECONTACT, hContact, 0);
+ SubProtocol := PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO, SubContact, 0));
+ end
+ else
+ begin
+ SubContact := hContact;
+ SubProtocol := Result;
+ end;
+end;
+
+function GetContactDisplayName(hContact: THandle; Proto: AnsiString = ''; Contact: boolean = false): String;
+var
+ ci: TContactInfo;
+ RetPWideChar, UW: PChar;
+begin
+ if (hContact = 0) and Contact then
+ Result := TranslateW('Server')
+ else
+ begin
+ if Proto = '' then
+ Proto := GetContactProto(hContact);
+ if Proto = '' then
+ Result := TranslateW('''(Unknown Contact)''' { TRANSLATE-IGNORE } )
+ else
+ begin
+ ci.cbSize := SizeOf(ci);
+ ci.hContact := hContact;
+ ci.szProto := PAnsiChar(Proto);
+ ci.dwFlag := CNF_DISPLAY + CNF_UNICODE;
+ if CallService(MS_CONTACT_GETCONTACTINFO, 0, LPARAM(@ci)) = 0 then
+ begin
+ RetPWideChar := ci.retval.szVal.w;
+ UW := TranslateW('''(Unknown Contact)''' { TRANSLATE-IGNORE } );
+ if WideCompareText(RetPWideChar, UW) = 0 then
+ Result := AnsiToWideString(GetContactID(hContact, Proto), CP_ACP)
+ else
+ Result := RetPWideChar;
+ mir_free(RetPWideChar);
+ end
+ else
+ Result := String(GetContactID(hContact, Proto));
+ if Result = '' then
+ Result := TranslateAnsiW(Proto { TRANSLATE-IGNORE } );
+ end;
+ end;
+end;
+
+function GetContactID(hContact: THandle; Proto: AnsiString = ''; Contact: boolean = false): AnsiString;
+var
+ uid: PAnsiChar;
+ dbv: TDBVARIANT;
+ cgs: TDBCONTACTGETSETTING;
+ tmp: String;
+begin
+ Result := '';
+ if not((hContact = 0) and Contact) then
+ begin
+ if Proto = '' then
+ Proto := GetContactProto(hContact);
+ uid := PAnsiChar(CallProtoService(PAnsiChar(Proto), PS_GETCAPS, PFLAG_UNIQUEIDSETTING, 0));
+ if (Cardinal(uid) <> CALLSERVICE_NOTFOUND) and (uid <> nil) then
+ begin
+ cgs.szModule := PAnsiChar(Proto);
+ cgs.szSetting := uid;
+ cgs.pValue := @dbv;
+ if CallService(MS_DB_CONTACT_GETSETTING, hContact, LPARAM(@cgs)) = 0 then
+ begin
+ case dbv._type of
+ DBVT_BYTE:
+ Result := AnsiString(intToStr(dbv.bVal));
+ DBVT_WORD:
+ Result := AnsiString(intToStr(dbv.wVal));
+ DBVT_DWORD:
+ Result := AnsiString(intToStr(dbv.dVal));
+ DBVT_ASCIIZ:
+ Result := AnsiString(dbv.szVal.a);
+ DBVT_UTF8:
+ begin
+ tmp := AnsiToWideString(dbv.szVal.a, CP_UTF8);
+ Result := WideToAnsiString(tmp, hppCodepage);
+ end;
+ DBVT_WCHAR:
+ Result := WideToAnsiString(dbv.szVal.w, hppCodepage);
+ end;
+ // free variant
+ DBFreeVariant(@dbv);
+ end;
+ end;
+ end;
+end;
+
+function WriteContactCodePage(hContact: THandle; CodePage: Cardinal; Proto: AnsiString = ''): boolean;
+begin
+ Result := false;
+ if Proto = '' then
+ Proto := GetContactProto(hContact);
+ if Proto = '' then
+ exit;
+ WriteDBWord(hContact, Proto, 'AnsiCodePage', CodePage);
+ Result := True;
+end;
+
+function _GetContactCodePage(hContact: THandle; Proto: AnsiString; var UsedDefault: boolean) : Cardinal;
+begin
+ if Proto = '' then
+ Proto := GetContactProto(hContact);
+ if Proto = '' then
+ Result := hppCodepage
+ else
+ begin
+ Result := GetDBWord(hContact, Proto, 'AnsiCodePage', $FFFF);
+ If Result = $FFFF then
+ Result := GetDBWord(0, Proto, 'AnsiCodePage', CP_ACP);
+ UsedDefault := (Result = CP_ACP);
+ if UsedDefault then
+ Result := GetACP();
+ end;
+end;
+
+function GetContactCodePage(hContact: THandle; Proto: AnsiString = ''): Cardinal;
+var
+ def: boolean;
+begin
+ Result := _GetContactCodePage(hContact, Proto, def);
+end;
+
+function GetContactCodePage(hContact: THandle; Proto: AnsiString; var UsedDefault: boolean): Cardinal; overload;
+begin
+ Result := _GetContactCodePage(hContact, Proto, UsedDefault);
+end;
+
+// OXY: 2006-03-30
+// Changed default RTL mode from SysLocale.MiddleEast to
+// Application.UseRightToLeftScrollBar because it's more correct and
+// doesn't bug on MY SYSTEM!
+function GetContactRTLMode(hContact: THandle; Proto: AnsiString = ''): boolean;
+var
+ Temp: Byte;
+begin
+ if Proto = '' then
+ Proto := GetContactProto(hContact);
+ if Proto = '' then
+ Result := GetDBBool(hppDBName, 'RTL', Application.UseRightToLeftScrollBar)
+ else
+ begin
+ Temp := GetDBByte(hContact, Proto, 'RTL', 255);
+ // we have no per-proto rtl setup ui, use global instead
+ // if Temp = 255 then
+ // Temp := GetDBByte(0,Proto,'RTL',255);
+ if Temp = 255 then
+ Temp := GetDBByte(hppDBName, 'RTL', Byte(Application.UseRightToLeftScrollBar));
+ Result := boolean(Temp);
+ end;
+end;
+
+function WriteContactRTLMode(hContact: THandle; RTLMode: TRTLMode; Proto: AnsiString = ''): boolean;
+begin
+ Result := false;
+ if Proto = '' then
+ Proto := GetContactProto(hContact);
+ if Proto = '' then
+ exit;
+ case RTLMode of
+ hppRTLDefault: DBDeleteContactSetting(hContact, PAnsiChar(Proto), 'RTL');
+ hppRTLEnable: WriteDBByte(hContact, Proto, 'RTL', Byte(True));
+ hppRTLDisable: WriteDBByte(hContact, Proto, 'RTL', Byte(false));
+ end;
+ Result := True;
+end;
+
+function GetContactRTLModeTRTL(hContact: THandle; Proto: AnsiString = ''): TRTLMode;
+var
+ Temp: Byte;
+begin
+ if Proto = '' then
+ Proto := GetContactProto(hContact);
+ if Proto = '' then
+ Result := hppRTLDefault
+ else
+ begin
+ Temp := GetDBByte(hContact, Proto, 'RTL', 255);
+ case Temp of
+ 0: Result := hppRTLDisable;
+ 1: Result := hppRTLEnable;
+ else
+ Result := hppRTLDefault;
+ end;
+ end;
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/hpp_database.pas b/plugins/HistoryPlusPlus/hpp_database.pas new file mode 100644 index 0000000000..79c0c456aa --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_database.pas @@ -0,0 +1,432 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+{-----------------------------------------------------------------------------
+ hpp_database (historypp project)
+
+ Version: 1.0
+ Created: 31.03.2003
+ Author: Oxygen
+
+ [ Description ]
+
+ Helper routines for database use
+
+ [ History ]
+ 1.0 (31.03.2003) - Initial version
+
+ [ Modifications ]
+
+ [ Knows Inssues ]
+ None
+
+ Contributors: theMIROn, Art Fedorov
+-----------------------------------------------------------------------------}
+
+
+unit hpp_database;
+
+interface
+
+uses m_api, windows, hpp_global;
+
+procedure SetSafetyMode(Safe: Boolean);
+
+function DBGetContactSettingString(hContact: THandle; const szModule: PAnsiChar; const szSetting: PAnsiChar; ErrorValue: PAnsiChar): AnsiString;
+function DBGetContactSettingWideString(hContact: THandle; const szModule: PAnsiChar; const szSetting: PAnsiChar; ErrorValue: PWideChar): WideString;
+function DBWriteContactSettingWideString(hContact: THandle; const szModule: PAnsiChar; const szSetting: PAnsiChar; const val: PWideChar): Integer;
+
+function DBDelete(const Module, Param: AnsiString): Boolean; overload;
+function DBDelete(const hContact: THandle; const Module, Param: AnsiString): Boolean; overload;
+function DBExists(const Module, Param: AnsiString): Boolean; overload;
+function DBExists(const hContact: THandle; const Module, Param: AnsiString): Boolean; overload;
+
+function GetDBBlob(const Module,Param: AnsiString; var Value: Pointer; var Size: Integer): Boolean; overload;
+function GetDBBlob(const hContact: THandle; const Module,Param: AnsiString; var Value: Pointer; var Size: Integer): Boolean; overload;
+function GetDBStr(const Module,Param: AnsiString; Default: AnsiString): AnsiString; overload;
+function GetDBStr(const hContact: THandle; const Module,Param: AnsiString; Default: AnsiString): AnsiString; overload;
+function GetDBWideStr(const Module,Param: AnsiString; Default: WideString): WideString; overload;
+function GetDBWideStr(const hContact: THandle; const Module,Param: AnsiString; Default: WideString): WideString; overload;
+function GetDBInt(const Module,Param: AnsiString; Default: Integer): Integer; overload;
+function GetDBInt(const hContact: THandle; const Module,Param: AnsiString; Default: Integer): Integer; overload;
+function GetDBWord(const Module,Param: AnsiString; Default: Word): Word; overload;
+function GetDBWord(const hContact: THandle; const Module,Param: AnsiString; Default: Word): Word; overload;
+function GetDBDWord(const Module,Param: AnsiString; Default: DWord): DWord; overload;
+function GetDBDWord(const hContact: THandle; const Module,Param: AnsiString; Default: DWord): DWord; overload;
+function GetDBByte(const Module,Param: AnsiString; Default: Byte): Byte; overload;
+function GetDBByte(const hContact: THandle; const Module,Param: AnsiString; Default: Byte): Byte; overload;
+function GetDBBool(const Module,Param: AnsiString; Default: Boolean): Boolean; overload;
+function GetDBBool(const hContact: THandle; const Module,Param: AnsiString; Default: Boolean): Boolean; overload;
+function GetDBDateTime(const hContact: THandle; const Module,Param: AnsiString; Default: TDateTime): TDateTime; overload;
+function GetDBDateTime(const Module,Param: AnsiString; Default: TDateTime): TDateTime; overload;
+
+function WriteDBBlob(const Module,Param: AnsiString; Value: Pointer; Size: Integer): Integer; overload;
+function WriteDBBlob(const hContact: THandle; const Module,Param: AnsiString; Value: Pointer; Size: Integer): Integer; overload;
+function WriteDBByte(const Module,Param: AnsiString; Value: Byte): Integer; overload;
+function WriteDBByte(const hContact: THandle; const Module,Param: AnsiString; Value: Byte): Integer; overload;
+function WriteDBWord(const Module,Param: AnsiString; Value: Word): Integer; overload;
+function WriteDBWord(const hContact: THandle; const Module,Param: AnsiString; Value: Word): Integer; overload;
+function WriteDBDWord(const Module,Param: AnsiString; Value: DWord): Integer; overload;
+function WriteDBDWord(const hContact: THandle; const Module,Param: AnsiString; Value: DWord): Integer; overload;
+function WriteDBInt(const Module,Param: AnsiString; Value: Integer): Integer; overload;
+function WriteDBInt(const hContact: THandle; const Module,Param: AnsiString; Value: Integer): Integer; overload;
+function WriteDBStr(const Module,Param: AnsiString; Value: AnsiString): Integer; overload;
+function WriteDBStr(const hContact: THandle; const Module,Param: AnsiString; Value: AnsiString): Integer; overload;
+function WriteDBWideStr(const Module,Param: AnsiString; Value: WideString): Integer; overload;
+function WriteDBWideStr(const hContact: THandle; const Module,Param: AnsiString; Value: WideString): Integer; overload;
+function WriteDBBool(const Module,Param: AnsiString; Value: Boolean): Integer; overload;
+function WriteDBBool(const hContact: THandle; const Module,Param: AnsiString; Value: Boolean): Integer; overload;
+function WriteDBDateTime(const hContact: THandle; const Module,Param: AnsiString; Value: TDateTime): Integer; overload;
+function WriteDBDateTime(const Module,Param: AnsiString; Value: TDateTime): Integer; overload;
+
+implementation
+
+procedure SetSafetyMode(Safe: Boolean);
+begin
+ CallService(MS_DB_SETSAFETYMODE,WPARAM(Safe),0);
+end;
+
+function DBExists(const Module, Param: AnsiString): Boolean;
+begin
+ Result := DBExists(0,Module,Param);
+end;
+
+function DBExists(const hContact: THandle; const Module, Param: AnsiString): Boolean;
+var
+ dbv: TDBVARIANT;
+ cgs: TDBCONTACTGETSETTING;
+begin
+ cgs.szModule := PAnsiChar(Module);
+ cgs.szSetting := PAnsiChar(Param);
+ cgs.pValue := @dbv;
+ Result := (CallService(MS_DB_CONTACT_GETSETTING, hContact, lParam(@cgs)) = 0);
+ if Result then
+ DBFreeVariant(@dbv);
+end;
+
+function DBDelete(const Module, Param: AnsiString): Boolean;
+begin
+ Result := DBDelete(0,Module,Param);
+end;
+
+function DBDelete(const hContact: THandle; const Module, Param: AnsiString): Boolean;
+begin
+ Result := (DBDeleteContactSetting(hContact,PAnsiChar(Module),PAnsiChar(Param)) = 0);
+end;
+
+function WriteDBBool(const Module,Param: AnsiString; Value: Boolean): Integer;
+begin
+ Result := WriteDBBool(0,Module,Param,Value);
+end;
+
+function WriteDBBool(const hContact: THandle; const Module,Param: AnsiString; Value: Boolean): Integer;
+begin
+ Result := WriteDBByte(hContact,Module,Param,Byte(Value));
+end;
+
+function WriteDBByte(const Module,Param: AnsiString; Value: Byte): Integer;
+begin
+ Result := WriteDBByte(0,Module,Param,Value);
+end;
+
+function WriteDBByte(const hContact: THandle; const Module,Param: AnsiString; Value: Byte): Integer;
+begin
+ Result := DBWriteContactSettingByte(hContact,PAnsiChar(Module), PAnsiChar(Param), Value);
+end;
+
+function WriteDBWord(const Module,Param: AnsiString; Value: Word): Integer;
+begin
+ Result := WriteDBWord(0,Module,Param,Value);
+end;
+
+function WriteDBWord(const hContact: THandle; const Module,Param: AnsiString; Value: Word): Integer;
+begin
+ Result := DBWriteContactSettingWord(hContact,PAnsiChar(Module),PAnsiChar(Param),Value);
+end;
+
+function WriteDBDWord(const Module,Param: AnsiString; Value: DWord): Integer;
+begin
+ Result := WriteDBWord(0,Module,Param,Value);
+end;
+
+function WriteDBDWord(const hContact: THandle; const Module,Param: AnsiString; Value: DWord): Integer;
+begin
+ Result := DBWriteContactSettingDWord(hContact,PAnsiChar(Module),PAnsiChar(Param),Value);
+end;
+
+function WriteDBInt(const Module,Param: AnsiString; Value: Integer): Integer;
+begin
+ Result := WriteDBInt(0,Module,Param,Value);
+end;
+
+function WriteDBInt(const hContact: THandle; const Module,Param: AnsiString; Value: Integer): Integer;
+var
+ cws: TDBCONTACTWRITESETTING;
+begin
+ cws.szModule := PAnsiChar(Module);
+ cws.szSetting := PAnsiChar(Param);
+ cws.value._type := DBVT_DWORD;
+ cws.value.dVal := Value;
+ Result := CallService(MS_DB_CONTACT_WRITESETTING, hContact, lParam(@cws));
+end;
+
+function WriteDBStr(const Module,Param: AnsiString; Value: AnsiString): Integer;
+begin
+ Result := WriteDBStr(0,Module,Param,Value);
+end;
+
+function WriteDBStr(const hContact: THandle; const Module,Param: AnsiString; Value: AnsiString): Integer;
+begin
+ Result := DBWriteContactSettingString(hContact,PAnsiChar(Module),PAnsiChar(Param),PAnsiChar(Value));
+end;
+
+function WriteDBWideStr(const Module,Param: AnsiString; Value: WideString): Integer;
+begin
+ Result := WriteDBWideStr(0,Module,Param,Value);
+end;
+
+function WriteDBWideStr(const hContact: THandle; const Module,Param: AnsiString; Value: WideString): Integer;
+begin
+ Result := DBWriteContactSettingWideString(hContact,PAnsiChar(Module),PAnsiChar(Param),PWideChar(Value));
+end;
+
+function DBWriteContactSettingWideString(hContact: THandle; const szModule: PAnsiChar; const szSetting: PAnsiChar; const val: PWideChar): Integer;
+var
+ cws: TDBCONTACTWRITESETTING;
+begin
+ cws.szModule := szModule;
+ cws.szSetting := szSetting;
+ cws.value._type := DBVT_WCHAR;
+ cws.value.szVal.w := val;
+ Result := CallService(MS_DB_CONTACT_WRITESETTING, hContact, lParam(@cws));
+end;
+
+function WriteDBBlob(const Module,Param: AnsiString; Value: Pointer; Size: Integer): Integer;
+begin
+ Result := WriteDBBlob(0,Module,Param,Value,Size);
+end;
+
+function WriteDBBlob(const hContact: THandle; const Module,Param: AnsiString; Value: Pointer; Size: Integer): Integer;
+var
+ cws: TDBContactWriteSetting;
+begin
+ ZeroMemory(@cws,SizeOf(cws));
+ cws.szModule := PAnsiChar(Module);
+ cws.szSetting := PAnsiChar(Param);
+ cws.value._type := DBVT_BLOB;
+ cws.value.pbVal := Value;
+ cws.value.cpbVal := Word(Size);
+ Result := CallService(MS_DB_CONTACT_WRITESETTING,hContact,lParam(@cws));
+end;
+
+function WriteDBDateTime(const hContact: THandle; const Module,Param: AnsiString; Value: TDateTime): Integer; overload;
+var
+ p: PDateTime;
+begin
+ GetMem(p,SizeOf(TDateTime));
+ p^ := Value;
+ Result := WriteDBBlob(hContact,Module,Param,p,SizeOf(TDateTime));
+ FreeMem(p,SizeOf(TDateTime));
+end;
+
+function WriteDBDateTime(const Module,Param: AnsiString; Value: TDateTime): Integer; overload;
+begin
+ Result := WriteDBDateTime(0,Module,Param,Value);
+end;
+
+function GetDBBlob(const Module,Param: AnsiString; var Value: Pointer; var Size: Integer): Boolean;
+begin
+ Result := GetDBBlob(0,Module,Param,Value,Size);
+end;
+
+function GetDBBlob(const hContact: THandle; const Module,Param: AnsiString; var Value: Pointer; var Size: Integer): Boolean;
+var
+ cgs: TDBContactGetSetting;
+ dbv: TDBVARIANT;
+begin
+ Result := False;
+ ZeroMemory(@cgs,SizeOf(cgs));
+ cgs.szModule := PAnsiChar(Module);
+ cgs.szSetting := PAnsiChar(Param);
+ cgs.pValue := @dbv;
+ if CallService(MS_DB_CONTACT_GETSETTING, hContact, lParam(@cgs)) <> 0 then exit;
+ Size := dbv.cpbVal;
+ Value := nil;
+ if dbv.cpbVal = 0 then exit;
+ GetMem(Value,dbv.cpbVal);
+ Move(dbv.pbVal^,PByte(Value)^,dbv.cpbVal);
+ DBFreeVariant(@dbv);
+ Result := True;
+end;
+
+function GetDBBool(const Module,Param: AnsiString; Default: Boolean): Boolean;
+begin
+ Result := GetDBBool(0,Module,Param,Default);
+end;
+
+function GetDBBool(const hContact: THandle; const Module,Param: AnsiString; Default: Boolean): Boolean;
+begin
+ Result := Boolean(GetDBByte(hContact,Module,Param,Byte(Default)));
+end;
+
+function GetDBByte(const Module,Param: AnsiString; Default: Byte): Byte;
+begin
+ Result := GetDBByte(0,Module,Param,Default);
+end;
+
+function GetDBByte(const hContact: THandle; const Module,Param: AnsiString; Default: Byte): Byte;
+begin
+ Result := DBGetContactSettingByte(hContact,PAnsiChar(Module),PAnsiChar(Param),Default);
+end;
+
+function GetDBWord(const Module,Param: AnsiString; Default: Word): Word;
+begin
+ Result := GetDBWord(0,Module,Param,Default);
+end;
+
+function GetDBWord(const hContact: THandle; const Module,Param: AnsiString; Default: Word): Word;
+begin
+ Result := DBGetContactSettingWord(hContact,PAnsiChar(Module),PAnsiChar(Param),Default);
+end;
+
+function GetDBDWord(const Module,Param: AnsiString; Default: DWord): DWord;
+begin
+ Result := GetDBDWord(0,Module,Param,Default);
+end;
+
+function GetDBDWord(const hContact: THandle; const Module,Param: AnsiString; Default: DWord): DWord;
+begin
+ Result := DBGetContactSettingDWord(hContact,PAnsiChar(Module),PAnsiChar(Param),Default);
+end;
+
+function GetDBInt(const Module,Param: AnsiString; Default: Integer): Integer;
+begin
+ Result := GetDBInt(0,Module,Param,Default);
+end;
+
+function GetDBInt(const hContact: THandle; const Module,Param: AnsiString; Default: Integer): Integer;
+var
+ cws:TDBCONTACTGETSETTING;
+ dbv:TDBVariant;
+begin
+ dbv._type := DBVT_DWORD;
+ dbv.dVal:=Default;
+ cws.szModule:=PAnsiChar(Module);
+ cws.szSetting:=PAnsiChar(Param);
+ cws.pValue:=@dbv;
+ if CallService(MS_DB_CONTACT_GETSETTING,hContact,LPARAM(@cws))<>0 then
+ Result:=default
+ else
+ Result:=dbv.dval;
+end;
+
+function GetDBStr(const Module,Param: AnsiString; Default: AnsiString): AnsiString;
+begin
+ Result := GetDBStr(0,Module,Param,Default);
+end;
+
+function GetDBStr(const hContact: THandle; const Module,Param: AnsiString; Default: AnsiString): AnsiString;
+begin
+ Result := DBGetContactSettingString(hContact,PAnsiChar(Module),PAnsiChar(Param),PAnsiChar(Default));
+end;
+
+function DBGetContactSettingString(hContact: THandle; const szModule: PAnsiChar; const szSetting: PAnsiChar; ErrorValue: PAnsiChar): AnsiString;
+var
+ dbv: TDBVARIANT;
+ cgs: TDBCONTACTGETSETTING;
+ tmp: WideString;
+begin
+ cgs.szModule := szModule;
+ cgs.szSetting := szSetting;
+ cgs.pValue := @dbv;
+ if CallService(MS_DB_CONTACT_GETSETTING, hContact, lParam(@cgs)) <> 0 then
+ Result := ErrorValue
+ else begin
+ case dbv._type of
+ DBVT_ASCIIZ:
+ Result := AnsiString(dbv.szVal.a);
+ DBVT_UTF8: begin
+ tmp := AnsiToWideString(dbv.szVal.a,CP_UTF8);
+ Result := WideToAnsiString(tmp,hppCodepage);
+ end;
+ DBVT_WCHAR:
+ Result := WideToAnsiString(dbv.szVal.w,hppCodepage);
+ end;
+ // free variant
+ DBFreeVariant(@dbv);
+ end;
+end;
+
+function GetDBWideStr(const Module,Param: AnsiString; Default: WideString): WideString;
+begin
+ Result := GetDBWideStr(0,Module,Param,Default);
+end;
+
+function GetDBWideStr(const hContact: THandle; const Module,Param: AnsiString; Default: WideString): WideString;
+begin
+ Result := DBGetContactSettingWideString(hContact,PAnsiChar(Module),PAnsiChar(Param),PWideChar(Default));
+end;
+
+function DBGetContactSettingWideString(hContact: THandle; const szModule: PAnsiChar; const szSetting: PAnsiChar; ErrorValue: PWideChar): WideString;
+var
+ dbv: TDBVARIANT;
+ cgs: TDBCONTACTGETSETTING;
+begin
+ cgs.szModule := szModule;
+ cgs.szSetting := szSetting;
+ cgs.pValue := @dbv;
+ if CallService(MS_DB_CONTACT_GETSETTING, hContact, lParam(@cgs)) <> 0 then
+ Result := ErrorValue
+ else begin
+ case dbv._type of
+ DBVT_ASCIIZ:
+ Result := AnsiToWideString(dbv.szVal.a,hppCodepage);
+ DBVT_UTF8:
+ Result := AnsiToWideString(dbv.szVal.a,CP_UTF8);
+ DBVT_WCHAR:
+ Result := WideString(dbv.szVal.w);
+ end;
+ // free variant
+ DBFreeVariant(@dbv);
+ end;
+end;
+
+function GetDBDateTime(const hContact: THandle; const Module,Param: AnsiString; Default: TDateTime): TDateTime; overload;
+var
+ p: Pointer;
+ s: Integer;
+begin
+ Result := Default;
+ if not GetDBBlob(hContact,Module,Param,p,s) then exit;
+ if s <> SizeOf(TDateTime) then begin
+ FreeMem(p,s);
+ exit;
+ end;
+ Result := PDateTime(p)^;
+ FreeMem(p,s);
+end;
+
+function GetDBDateTime(const Module,Param: AnsiString; Default: TDateTime): TDateTime; overload;
+begin
+ Result := GetDBDateTime(0,Module,Param,Default);
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/hpp_eventfilters.pas b/plugins/HistoryPlusPlus/hpp_eventfilters.pas new file mode 100644 index 0000000000..1c58e7da1e --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_eventfilters.pas @@ -0,0 +1,360 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+unit hpp_eventfilters;
+
+interface
+
+uses Types, SysUtils, Classes, m_api, hpp_global;
+
+const
+ // filter modes
+ FM_INCLUDE = 0; // show all events from filEvents (default)
+ FM_EXCLUDE = 1; // show all events except from filEvents
+
+const
+ MAX_FILTER_NAME_LENGTH = 33; // make it uneven, so our db record would align in 4 bytes
+
+type
+ ThppEventFilter = record
+ Name : String;
+ Events : TMessageTypes; // resulting events mask generated from filMode and filEvents, filled in runtime
+ filMode : Byte; // FM_* consts
+ filEvents: TMessageTypes; // filter events which are combined with filMode
+ filCustom: Word; // filter events which are combined with filMode
+ end;
+
+ ThppEventFilterArray = array of ThppEventFilter;
+
+var
+ hppEventFilters: ThppEventFilterArray;
+ hppDefEventFilters: ThppEventFilterArray;
+
+ procedure InitEventFilters;
+ procedure ReadEventFilters;
+ procedure WriteEventFilters;
+ procedure ResetEventFiltersToDefault;
+ procedure CopyEventFilters(var Src,Dest: ThppEventFilterArray);
+ function GetShowAllEventsIndex(Arr: ThppEventFilterArray = nil): Integer;
+
+ function MessageTypesToDWord(mt: TMessageTypes): DWord;
+
+ // compile filMode & filEvents into Events:
+ function GenerateEvents(filMode: Byte; filEvents: TMessageTypes): TMessageTypes;
+ // compile filMode & filEvents into Events for all filters
+ procedure GenerateEventFilters(var Filters: array of ThppEventFilter);
+
+const
+ EventsInclude: TMessageTypes = [];
+ EventsDirection: TMessageTypes = [mtIncoming,mtOutgoing];
+ EventsExclude: TMessageTypes = [mtUnknown,mtCustom];
+ EventsCustom: TMessageTypes = [mtCustom];
+
+implementation
+
+uses
+ hpp_database, hpp_forms;
+
+var
+ filterAll: TMessageTypes;
+
+const
+ hppIntDefEventFilters: array[0..12] of ThppEventFilter = (
+ (Name: 'Show all events'; Events: []; filMode: FM_EXCLUDE; filEvents: []),
+ (Name: 'Messages'; Events: []; filMode: FM_INCLUDE; filEvents: [mtMessage,mtIncoming,mtOutgoing]),
+ (Name: 'Link URLs'; Events: []; filMode: FM_INCLUDE; filEvents: [mtUrl,mtIncoming,mtOutgoing]),
+ (Name: 'Files'; Events: []; filMode: FM_INCLUDE; filEvents: [mtFile,mtIncoming,mtOutgoing]),
+ (Name: 'Contacts'; Events: []; filMode: FM_INCLUDE; filEvents: [mtContacts,mtIncoming,mtOutgoing]),
+ (Name: 'Status changes'; Events: []; filMode: FM_INCLUDE; filEvents: [mtStatus,mtIncoming,mtOutgoing]),
+ (Name: 'Status message changes'; Events: []; filMode: FM_INCLUDE; filEvents: [mtStatusMessage,mtIncoming,mtOutgoing]),
+ (Name: 'Nick changes'; Events: []; filMode: FM_INCLUDE; filEvents: [mtNickChange,mtIncoming,mtOutgoing]),
+ (Name: 'Avatar changes'; Events: []; filMode: FM_INCLUDE; filEvents: [mtAvatarChange,mtIncoming,mtOutgoing]),
+ (Name: 'WATrack notify'; Events: []; filMode: FM_INCLUDE; filEvents: [mtWATrack,mtIncoming,mtOutgoing]),
+ (Name: 'Voice calls'; Events: []; filMode: FM_INCLUDE; filEvents: [mtVoiceCall,mtIncoming,mtOutgoing]),
+ (Name: 'All except changes'; Events: []; filMode: FM_EXCLUDE; filEvents: [mtStatus,mtStatusMessage,mtNickChange,mtAvatarChange]),
+ (Name: 'All except system'; Events: []; filMode: FM_EXCLUDE; filEvents: [mtSystem])
+ );
+
+
+function IsSameAsDefault: Boolean;
+var
+ i: Integer;
+begin
+ Result := False;
+ if Length(hppDefEventFilters) <> Length(hppEventFilters) then
+ exit;
+ for i := 0 to Length(hppEventFilters) - 1 do
+ begin
+ if hppEventFilters[i].Name <> hppDefEventFilters[i].Name then
+ exit;
+ if hppEventFilters[i].Events <> hppDefEventFilters[i].Events then
+ exit;
+ end;
+ Result := True;
+end;
+
+function DWordToMessageTypes(dwmt: DWord): TMessageTypes;
+begin
+ Result := [];
+ Move(dwmt,Result,SizeOf(Result));
+end;
+
+function MessageTypesToDWord(mt: TMessageTypes): DWord;
+begin
+ Result := 0;
+ Move(mt,Result,SizeOf(mt));
+end;
+
+procedure UpdateEventFiltersOnForms;
+begin
+ NotifyAllForms(HM_NOTF_FILTERSCHANGED,0,0);
+end;
+
+function GenerateEvents(filMode: Byte; filEvents: TMessageTypes): TMessageTypes;
+begin
+ if filMode = FM_INCLUDE then
+ Result := filEvents
+ else
+ Result := filterAll - filEvents;
+ Result := Result - EventsExclude + EventsInclude;
+end;
+
+procedure GenerateEventFilters(var Filters: array of ThppEventFilter);
+var
+ i: Integer;
+begin
+ for i := 0 to Length(Filters) - 1 do
+ begin
+ Filters[i].Events := GenerateEvents(Filters[i].filMode, Filters[i].filEvents);
+ end;
+end;
+
+procedure CopyEventFilters(var Src,Dest: ThppEventFilterArray);
+var
+ i: Integer;
+begin
+ SetLength(Dest,Length(Src));
+ for i := 0 to Length(Src) - 1 do
+ begin
+ Dest[i].Name := Src[i].Name;
+ Dest[i].Events := Src[i].Events;
+ Dest[i].filMode := Src[i].filMode;
+ Dest[i].filEvents := Src[i].filEvents;
+ Dest[i].filCustom := Src[i].filCustom;
+ end;
+end;
+
+function GetShowAllEventsIndex(Arr: ThppEventFilterArray = nil): Integer;
+var
+ i: Integer;
+begin
+ if Arr = nil then
+ Arr := hppEventFilters;
+ Result := 0;
+ for i := 0 to Length(Arr) - 1 do
+ if (Arr[i].filMode = FM_EXCLUDE) and (Arr[i].filEvents = []) then
+ begin
+ Result := i;
+ break;
+ end;
+end;
+
+procedure DeleteEventFilterSettings;
+var
+ i: Integer;
+begin
+ i := 1;
+ while True do
+ begin
+ if not DBDelete(hppDBName, AnsiString('EventFilter' + IntToStr(i))) then
+ break;
+ Inc(i);
+ end;
+end;
+
+procedure ResetEventFiltersToDefault;
+begin
+ CopyEventFilters(hppDefEventFilters,hppEventFilters);
+ DeleteEventFilterSettings;
+ UpdateEventFiltersOnForms;
+end;
+
+//----- Stealed fro Tnt -----
+function ExtractStringFromStringArray(var P: PChar; Separator: Char = #0): String;
+var
+ Start: PChar;
+begin
+ Start := P;
+ P := StrScan(Start, Separator);
+ if P = nil then
+ begin
+ Result := Start;
+ P := StrEnd(Start);
+ end
+ else
+ begin
+ SetString(Result, Start, P - Start);
+ Inc(P);
+ end;
+end;
+
+function ExtractStringsFromStringArray(P: PChar; Separator: Char = #0): TWideStringDynArray;
+const
+ GROW_COUNT = 256;
+var
+ Count: Integer;
+ Item: WideString;
+begin
+ Count := 0;
+ SetLength(Result, GROW_COUNT);
+ Item := ExtractStringFromStringArray(P, Separator);
+ While Item <> '' do
+ begin
+ if Count > High(Result) then
+ SetLength(Result, Length(Result) + GROW_COUNT);
+ Result[Count] := Item;
+ Inc(Count);
+ Item := ExtractStringFromStringArray(P, Separator);
+ end;
+ SetLength(Result, Count);
+end;
+//----- end of Tnt -----
+procedure ReadEventFilters;
+var
+ i: Integer;
+ FilterStr: String;
+ hexs: TWideStringDynArray;
+ filEvents: DWord;
+ filMode: Byte;
+ filCustom: Word;
+begin
+ SetLength(hppEventFilters, 0);
+ try
+ i := 1;
+ while True do
+ begin
+ if not DBExists(hppDBName, AnsiString('EventFilter' + IntToStr(i))) then
+ begin
+ if Length(hppEventFilters) = 0 then
+ raise EAbort.Create('No filters');
+ break;
+ end;
+ FilterStr := GetDBWideStr(hppDBName, AnsiString('EventFilter' + IntToStr(i)), '');
+ if FilterStr = '' then
+ break;
+ SetLength(hppEventFilters, Length(hppEventFilters) + 1);
+ // parse String
+ hexs := ExtractStringsFromStringArray(PWideChar(FilterStr),',');
+ if Length(hexs) < 4 then
+ raise EAbort.Create('Wrong filter (' + IntToStr(i) + ') format');
+ filMode := 0;
+ filEvents := 0;
+ filCustom := 0;
+ hppEventFilters[i - 1].Name := hexs[0];
+ // read filMode
+ HexToBin(PWideChar(hexs[1]), @filMode, SizeOf(filMode));
+ hppEventFilters[i - 1].filMode := filMode;
+ // read filEvents
+ HexToBin(PWideChar(hexs[2]), @filEvents, SizeOf(filEvents));
+ hppEventFilters[i - 1].filEvents := DWordToMessageTypes(filEvents);
+ // read filCustom
+ HexToBin(PWideChar(hexs[3]), @filEvents, SizeOf(filCustom));
+ hppEventFilters[i - 1].filCustom := filCustom;
+ Inc(i);
+ end;
+ GenerateEventFilters(hppEventFilters);
+ except
+ ResetEventFiltersToDefault;
+ end;
+end;
+
+procedure WriteEventFilters;
+var
+ i: Integer;
+ FilterStr: String;
+ hex: String;
+begin
+ if Length(hppEventFilters) = 0 then
+ begin
+ ResetEventFiltersToDefault;
+ exit;
+ end;
+ if IsSameAsDefault then
+ begin
+ // revert to default state
+ DeleteEventFilterSettings;
+ UpdateEventFiltersOnForms;
+ exit;
+ end;
+
+ for i := 0 to Length(hppEventFilters) - 1 do
+ begin
+ FilterStr := Copy(hppEventFilters[i].Name, 1, MAX_FILTER_NAME_LENGTH);
+ // add filMode
+ SetLength(hex, SizeOf(hppEventFilters[i].filMode) * 2);
+ BinToHex(@hppEventFilters[i].filMode, PChar(hex),SizeOf(hppEventFilters[i].filMode));
+ FilterStr := FilterStr + ',' + hex;
+ // add filEvents
+ SetLength(hex, SizeOf(hppEventFilters[i].filEvents) * 2);
+ BinToHex(@hppEventFilters[i].filEvents, PChar(hex),SizeOf(hppEventFilters[i].filEvents));
+ FilterStr := FilterStr + ',' + hex;
+ // add filCustom
+ SetLength(hex, SizeOf(hppEventFilters[i].filCustom) * 2);
+ BinToHex(@hppEventFilters[i].filCustom, PChar(hex),SizeOf(hppEventFilters[i].filCustom));
+ FilterStr := FilterStr + ',' + hex;
+
+ WriteDBWideStr(hppDBName, AnsiString('EventFilter' + IntToStr(i + 1)), FilterStr);
+ end;
+ // delete left filters if we have more than Length(hppEventFilters)
+ i := Length(hppEventFilters) + 1;
+ while True do
+ begin
+ if not DBDelete(hppDBName, AnsiString('EventFilter' + IntToStr(i))) then
+ break;
+ Inc(i);
+ end;
+ UpdateEventFiltersOnForms;
+end;
+
+procedure InitEventFilters;
+var
+ i: Integer;
+ mt: TMessageType;
+begin
+ // translate and copy internal default static array to dynamic array
+ SetLength(hppDefEventFilters, Length(hppIntDefEventFilters));
+ for i := 0 to High(hppIntDefEventFilters) do
+ begin
+ hppDefEventFilters[i].Name := Copy(TranslateUnicodeString(hppIntDefEventFilters[i].Name), 1,
+ MAX_FILTER_NAME_LENGTH { TRANSLATE-IGNORE } );
+ hppDefEventFilters[i].filMode := hppIntDefEventFilters[i].filMode;
+ hppDefEventFilters[i].filEvents := hppIntDefEventFilters[i].filEvents;
+ hppDefEventFilters[i].filCustom := hppIntDefEventFilters[i].filCustom;
+ end;
+
+ filterAll := [];
+ for mt := Low(TMessageType) to High(TMessageType) do
+ Include(filterAll, mt);
+
+ GenerateEventFilters(hppDefEventFilters);
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/hpp_events.pas b/plugins/HistoryPlusPlus/hpp_events.pas new file mode 100644 index 0000000000..88f8a5d388 --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_events.pas @@ -0,0 +1,1049 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+{-----------------------------------------------------------------------------
+ hpp_events (historypp project)
+
+ Version: 1.5
+ Created: 05.08.2004
+ Author: Oxygen
+
+ [ Description ]
+
+ Some refactoring we have here, so now all event reading
+ routines are here. By event reading I mean getting usefull
+ info out of DB and translating it into human words,
+ like reading different types of messages and such.
+
+ [ History ]
+
+ 1.5 (05.08.2004)
+ First version
+
+ [ Modifications ]
+ none
+
+ [ Known Issues ]
+ none
+
+ Contributors: theMIROn, Art Fedorov
+-----------------------------------------------------------------------------}
+
+unit hpp_events;
+
+interface
+
+{$I compilers.inc}
+
+uses
+ Windows, SysUtils,
+ m_api,
+ hpp_global, hpp_contacts;
+
+type
+ TTextFunction = procedure(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+
+ TEventTableItem = record
+ EventType: Word;
+ MessageType: TMessageType;
+ TextFunction: TTextFunction;
+ end;
+
+ PEventRecord = ^TEventRecord;
+ TEventRecord = record
+ Name: String;
+ XML: AnsiString;
+ i: SmallInt;
+ iName: PAnsiChar;
+ iSkin: SmallInt;
+ end;
+
+const
+ EVENTTYPE_STATUSCHANGE = 25368; // from srmm's
+ EVENTTYPE_SMTPSIMPLE = 2350; // from SMTP Simple
+ EVENTTYPE_NICKNAMECHANGE = 9001; // from pescuma
+ EVENTTYPE_STATUSMESSAGECHANGE = 9002; // from pescuma
+ EVENTTYPE_AVATARCHANGE = 9003; // from pescuma
+ EVENTTYPE_CONTACTLEFTCHANNEL = 9004; // from pescuma
+ EVENTTYPE_VOICE_CALL = 8739; // from pescuma
+
+ EventRecords: array[TMessageType] of TEventRecord = (
+ (Name:'Unknown'; XML:''; i:-1; iSkin:-1),
+ (Name:'Incoming events'; XML:''; i:HPP_ICON_EVENT_INCOMING; iName:'hppevn_inc'; iSkin:-1),
+ (Name:'Outgoing events'; XML:''; i:HPP_ICON_EVENT_OUTGOING; iName:'hppevn_out'; iSkin:-1),
+ (Name:'Message'; XML:'MSG'; i:HPP_SKIN_EVENT_MESSAGE; iSkin: SKINICON_EVENT_MESSAGE),
+ (Name:'Link'; XML:'URL'; i:HPP_SKIN_EVENT_URL; iSkin:SKINICON_EVENT_URL),
+ (Name:'File transfer'; XML:'FILE'; i:HPP_SKIN_EVENT_FILE; iSkin:SKINICON_EVENT_FILE),
+ (Name:'System message'; XML:'SYS'; i:HPP_ICON_EVENT_SYSTEM; iName:'hppevn_sys'; iSkin:-1),
+ (Name:'Contacts'; XML:'ICQCNT'; i:HPP_ICON_EVENT_CONTACTS; iName:'hppevn_icqcnt'; iSkin:-1),
+ (Name:'SMS message'; XML:'SMS'; i:HPP_ICON_EVENT_SMS; iName:'hppevn_sms'; iSkin:-1),
+ (Name:'Webpager message'; XML:'ICQWP'; i:HPP_ICON_EVENT_WEBPAGER; iName:'hppevn_icqwp'; iSkin:-1),
+ (Name:'EMail Express message'; XML:'ICQEX'; i:HPP_ICON_EVENT_EEXPRESS; iName:'hppevn_icqex'; iSkin:-1),
+ (Name:'Status changes'; XML:'STATUSCNG'; i:HPP_ICON_EVENT_STATUS; iName:'hppevn_status'; iSkin:-1),
+ (Name:'SMTP Simple Email'; XML:'SMTP'; i:HPP_ICON_EVENT_SMTPSIMPLE; iName:'hppevn_smtp'; iSkin:-1),
+ (Name:'Other events (unknown)'; XML:'OTHER'; i:HPP_SKIN_OTHER_MIRANDA; iSkin:SKINICON_OTHER_MIRANDA),
+ (Name:'Nick changes'; XML:'NICKCNG'; i:HPP_ICON_EVENT_NICK; iName:'hppevn_nick'; iSkin:-1),
+ (Name:'Avatar changes'; XML:'AVACNG'; i:HPP_ICON_EVENT_AVATAR; iName:'hppevn_avatar'; iSkin:-1),
+ (Name:'WATrack notify'; XML:'WATRACK'; i:HPP_ICON_EVENT_WATRACK; iName:'hppevn_watrack'; iSkin:-1),
+ (Name:'Status message changes'; XML:'STATUSMSGCHG'; i:HPP_ICON_EVENT_STATUSMES; iName:'hppevn_statuschng'; iSkin:-1),
+ (Name:'Voice call'; XML:'VCALL'; i:HPP_ICON_EVENT_VOICECALL; iName:'hppevn_vcall'; iSkin:-1),
+ (Name:'Custom'; XML:''; i:-1; iSkin:-1)
+ );
+
+// General timstamp function
+function UnixTimeToDateTime(const UnixTime: DWord): TDateTime;
+function DateTimeToUnixTime(const DateTime: TDateTime): DWord;
+// Miranda timestamp to TDateTime
+function TimestampToDateTime(const Timestamp: DWord): TDateTime;
+function TimestampToString(const Timestamp: DWord): String;
+// general routine
+function ReadEvent(hDBEvent: THandle; UseCP: Cardinal = CP_ACP): THistoryItem;
+function GetEventInfo(hDBEvent: DWord): TDBEventInfo;
+function GetEventTimestamp(hDBEvent: THandle): DWord;
+function GetEventMessageType(hDBEvent: THandle): TMessageTypes;
+function GetEventDateTime(hDBEvent: THandle): TDateTime;
+function GetEventRecord(const Hi: THistoryItem): PEventRecord;
+function GetMessageType(EventInfo: TDBEventInfo; var EventIndex: Integer): TMessageTypes;
+// global routines
+function GetEventCoreText(EventInfo: TDBEventInfo; var Hi: THistoryItem): Boolean;
+function GetEventModuleText(EventInfo: TDBEventInfo; var Hi: THistoryItem): Boolean;
+// specific routines
+procedure GetEventTextForMessage(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+procedure GetEventTextForFile(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+procedure GetEventTextForUrl(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+procedure GetEventTextForAuthRequest(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+procedure GetEventTextForYouWereAdded(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+procedure GetEventTextForSms(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+procedure GetEventTextForContacts(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+procedure GetEventTextForWebPager(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+procedure GetEventTextForEmailExpress(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+procedure GetEventTextForStatusChange(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+procedure GetEventTextForAvatarChange(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+procedure GetEventTextForICQAuthGranted(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+procedure GetEventTextForICQAuthDenied(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+procedure GetEventTextForICQSelfRemove(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+procedure GetEventTextForICQFutureAuth(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+procedure GetEventTextForICQClientChange(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+procedure GetEventTextForICQCheckStatus(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+procedure GetEventTextForICQIgnoreCheckStatus(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+procedure GetEventTextForICQBroadcast(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+procedure GetEventTextForJabberChatStates(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+procedure GetEventTextWATrackRequest(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+procedure GetEventTextWATrackAnswer(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+procedure GetEventTextWATrackError(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+procedure GetEventTextForOther(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+// service routines
+function TextHasUrls(var Text: String): Boolean;
+function Utf8ToWideChar(Dest: PWideChar; MaxDestChars: Integer; Source: PAnsiChar; SourceBytes: Integer; CodePage: Cardinal = CP_ACP): Integer;
+
+implementation
+
+uses
+ hpp_options;
+
+{$include inc\m_music.inc}
+
+const // registered Jabber db event types (not public)
+ JABBER_DB_EVENT_TYPE_CHATSTATES = 2000;
+// JS_DB_GETEVENTTEXT_CHATSTATES = '/GetEventText2000';
+ JABBER_DB_EVENT_CHATSTATES_GONE = 1;
+
+const // ICQ db events (didn't found anywhere)
+ //auth
+ //db event added to NULL contact
+ //blob format is:
+ //ASCIIZ text
+ //DWORD uin
+ //HANDLE hContact
+ ICQEVENTTYPE_AUTH_GRANTED = 2004; //database event type
+ ICQEVENTTYPE_AUTH_DENIED = 2005; //database event type
+ ICQEVENTTYPE_SELF_REMOVE = 2007; //database event type
+ ICQEVENTTYPE_FUTURE_AUTH = 2008; //database event type
+ ICQEVENTTYPE_CLIENT_CHANGE = 2009; //database event type
+ ICQEVENTTYPE_CHECK_STATUS = 2010; //database event type
+ ICQEVENTTYPE_IGNORECHECK_STATUS = 2011;//database event type
+ //broadcast from server
+ //ASCIIZ text
+ //ASCIIZ from name
+ //ASCIIZ from e-mail
+ ICQEVENTTYPE_BROADCAST = 2006; //database event type
+
+type
+ TModuleEventRecord = record
+ EventDesc: PDBEVENTTYPEDESCR;
+ EventRecord: TEventRecord;
+ end;
+
+// OXY:
+// Routines UnixTimeToDate and DateTimeToUnixTime are taken
+// from JclDateTime.pas
+// See JclDateTime.pas for copyright and license information
+// JclDateTime.pas is part of Project JEDI Code Library (JCL)
+// [http://www.delphi-jedi.org], [http://jcl.sourceforge.net]
+const
+ // 1970-01-01T00:00:00 in TDateTime
+ UnixTimeStart = 25569;
+ SecondsPerDay = 60* 24 * 60;
+
+var
+ EventTable: array[0..28] of TEventTableItem = (
+ // must be the first item in array for unknown events
+ (EventType: MaxWord; MessageType: mtOther; TextFunction: GetEventTextForOther),
+ // events definitions
+ (EventType: EVENTTYPE_MESSAGE; MessageType: mtMessage; TextFunction: GetEventTextForMessage),
+ (EventType: EVENTTYPE_FILE; MessageType: mtFile; TextFunction: GetEventTextForFile),
+ (EventType: EVENTTYPE_URL; MessageType: mtUrl; TextFunction: GetEventTextForUrl),
+ (EventType: EVENTTYPE_AUTHREQUEST; MessageType: mtSystem; TextFunction: GetEventTextForAuthRequest),
+ (EventType: EVENTTYPE_ADDED; MessageType: mtSystem; TextFunction: GetEventTextForYouWereAdded),
+ (EventType: EVENTTYPE_CONTACTS; MessageType: mtContacts; TextFunction: GetEventTextForContacts),
+ (EventType: EVENTTYPE_STATUSCHANGE; MessageType: mtStatus; TextFunction: GetEventTextForStatusChange),
+ (EventType: EVENTTYPE_SMTPSIMPLE; MessageType: mtSMTPSimple; TextFunction: GetEventTextForMessage),
+ (EventType: ICQEVENTTYPE_SMS; MessageType: mtSMS; TextFunction: GetEventTextForSMS),
+ (EventType: ICQEVENTTYPE_WEBPAGER; MessageType: mtWebPager; TextFunction: GetEventTextForWebPager),
+ (EventType: ICQEVENTTYPE_EMAILEXPRESS; MessageType: mtEmailExpress; TextFunction: GetEventTextForEmailExpress),
+ (EventType: EVENTTYPE_NICKNAMECHANGE; MessageType: mtNickChange; TextFunction: GetEventTextForMessage),
+ (EventType: EVENTTYPE_STATUSMESSAGECHANGE; MessageType: mtStatusMessage; TextFunction: GetEventTextForMessage),
+ (EventType: EVENTTYPE_AVATARCHANGE; MessageType: mtAvatarChange; TextFunction: GetEventTextForAvatarChange),
+ (EventType: ICQEVENTTYPE_AUTH_GRANTED; MessageType: mtSystem; TextFunction: GetEventTextForICQAuthGranted),
+ (EventType: ICQEVENTTYPE_AUTH_DENIED; MessageType: mtSystem; TextFunction: GetEventTextForICQAuthDenied),
+ (EventType: ICQEVENTTYPE_SELF_REMOVE; MessageType: mtSystem; TextFunction: GetEventTextForICQSelfRemove),
+ (EventType: ICQEVENTTYPE_FUTURE_AUTH; MessageType: mtSystem; TextFunction: GetEventTextForICQFutureAuth),
+ (EventType: ICQEVENTTYPE_CLIENT_CHANGE; MessageType: mtSystem; TextFunction: GetEventTextForICQClientChange),
+ (EventType: ICQEVENTTYPE_CHECK_STATUS; MessageType: mtSystem; TextFunction: GetEventTextForICQCheckStatus),
+ (EventType: ICQEVENTTYPE_IGNORECHECK_STATUS; MessageType: mtSystem; TextFunction: GetEventTextForICQIgnoreCheckStatus),
+ (EventType: ICQEVENTTYPE_BROADCAST; MessageType: mtSystem; TextFunction: GetEventTextForICQBroadcast),
+ (EventType: JABBER_DB_EVENT_TYPE_CHATSTATES; MessageType: mtStatus; TextFunction: GetEventTextForJabberChatStates),
+ (EventType: EVENTTYPE_CONTACTLEFTCHANNEL; MessageType: mtStatus; TextFunction: GetEventTextForMessage),
+ (EventType: EVENTTYPE_WAT_REQUEST; MessageType: mtWATrack; TextFunction: GetEventTextWATrackRequest),
+ (EventType: EVENTTYPE_WAT_ANSWER; MessageType: mtWATrack; TextFunction: GetEventTextWATrackAnswer),
+ (EventType: EVENTTYPE_WAT_ERROR; MessageType: mtWATrack; TextFunction: GetEventTextWATrackError),
+ (EventType: EVENTTYPE_VOICE_CALL; MessageType: mtVoiceCall; TextFunction: GetEventTextForMessage)
+ );
+
+var
+ ModuleEventRecords: array of TModuleEventRecord;
+ RecentEvent: THandle = 0;
+ RecentEventInfo: TDBEventInfo;
+
+const
+ SHRINK_ON_CALL = 50;
+ SHRINK_TO_LEN = 512;
+
+var
+ EventBuffer: THppBuffer;
+ TextBuffer: THppBuffer;
+
+function UnixTimeToDateTime(const UnixTime: DWord): TDateTime;
+begin
+ Result:= UnixTimeStart + (UnixTime / SecondsPerDay);
+end;
+
+function DateTimeToUnixTime(const DateTime: TDateTime): DWord;
+begin
+ Result := Trunc((DateTime-UnixTimeStart) * SecondsPerDay);
+end;
+
+// Miranda timestamp to TDateTime
+function TimestampToDateTime(const Timestamp: DWord): TDateTime;
+begin
+ Result := UnixTimeToDateTime(CallService(MS_DB_TIME_TIMESTAMPTOLOCAL,WPARAM(Timestamp),0));
+end;
+
+// should probably add function param to use
+// custom grid options object and not the global one
+function TimestampToString(const Timestamp: DWord): String;
+begin
+ Result := FormatDateTime(GridOptions.DateTimeFormat,TimestampToDateTime(Timestamp));
+end;
+
+function GetEventTimestamp(hDBEvent: THandle): DWord;
+begin
+ if RecentEvent <> hDBEvent then
+ begin
+ ZeroMemory(@RecentEventInfo, SizeOf(RecentEventInfo));
+ RecentEventInfo.cbSize := SizeOf(RecentEventInfo);
+ RecentEventInfo.cbBlob := 0;
+ CallService(MS_DB_EVENT_GET, hDBEvent, LPARAM(@RecentEventInfo));
+ RecentEvent := hDBEvent;
+ end;
+ Result := RecentEventInfo.timestamp;
+end;
+
+function GetEventMessageType(hDBEvent: THandle): TMessageTypes;
+var
+ EventIndex: Integer;
+begin
+ if RecentEvent <> hDBEvent then
+ begin
+ ZeroMemory(@RecentEventInfo, SizeOf(RecentEventInfo));
+ RecentEventInfo.cbSize := SizeOf(RecentEventInfo);
+ RecentEventInfo.cbBlob := 0;
+ CallService(MS_DB_EVENT_GET, hDBEvent, LPARAM(@RecentEventInfo));
+ RecentEvent := hDBEvent;
+ end;
+ Result := GetMessageType(RecentEventInfo,EventIndex);
+end;
+
+function GetEventDateTime(hDBEvent: THandle): TDateTime;
+begin
+ Result := TimestampToDateTime(GetEventTimestamp(hDBEvent));
+end;
+
+function GetEventRecord(const Hi: THistoryItem): PEventRecord;
+var
+ MesType: TMessageTypes;
+ mt: TMessageType;
+ etd: PDBEVENTTYPEDESCR;
+ i,count: integer;
+begin
+ MesType := Hi.MessageType;
+ exclude(MesType, mtIncoming);
+ exclude(MesType, mtOutgoing);
+ exclude(MesType, mtOther);
+ for mt := Low(EventRecords) to High(EventRecords) do
+ begin
+ if mt in MesType then
+ begin
+ Result := @EventRecords[mt];
+ exit;
+ end;
+ end;
+ etd := Pointer(CallService(MS_DB_EVENT_GETTYPE, WPARAM(PAnsiChar(Hi.Module)),
+ LPARAM(Hi.EventType)));
+ if etd = nil then
+ begin
+ Result := @EventRecords[mtOther];
+ exit;
+ end;
+ count := Length(ModuleEventRecords);
+ for i := 0 to count - 1 do
+ if ModuleEventRecords[i].EventDesc = etd then
+ begin
+ Result := @ModuleEventRecords[i].EventRecord;
+ exit;
+ end;
+ SetLength(ModuleEventRecords, count + 1);
+ ModuleEventRecords[count].EventDesc := etd;
+ ModuleEventRecords[count].EventRecord := EventRecords[mtOther];
+ ModuleEventRecords[count].EventRecord.Name := AnsiToWideString(etd.descr, CP_ACP);
+ Result := @ModuleEventRecords[count].EventRecord;
+end;
+
+function Utf8ToWideChar(Dest: PWideChar; MaxDestChars: Integer; Source: PAnsiChar; SourceBytes: Integer; CodePage: Cardinal = CP_ACP): Integer;
+const
+ MB_ERR_INVALID_CHARS = 8;
+var
+ Src,SrcEnd: PAnsiChar;
+ Dst,DstEnd: PWideChar;
+begin
+ if (Source = nil) or (SourceBytes <= 0) then
+ begin
+ Result := 0;
+ end
+ else if (Dest = nil) or (MaxDestChars <= 0) then
+ begin
+ Result := -1;
+ end
+ else
+ begin
+ Src := Source;
+ SrcEnd := Source + SourceBytes;
+ Dst := Dest;
+ DstEnd := Dst + MaxDestChars;
+ while (PAnsiChar(Src) < PAnsiChar(SrcEnd)) and (Dst < DstEnd) do
+ begin
+ if (Byte(Src[0]) and $80) = 0 then
+ begin
+ Dst[0] := WideChar(Src[0]);
+ Inc(Src);
+ end
+ else if (Byte(Src[0]) and $E0) = $E0 then
+ begin
+ if Src + 2 >= SrcEnd then
+ break;
+ if (Src[1] = #0) or ((Byte(Src[1]) and $C0) <> $80) then
+ break;
+ if (Src[2] = #0) or ((Byte(Src[2]) and $C0) <> $80) then
+ break;
+ Dst[0] := WideChar(((Byte(Src[0]) and $0F) shl 12) + ((Byte(Src[1]) and $3F) shl 6) +
+ ((Byte(Src[2]) and $3F)));
+ Inc(Src, 3);
+ end
+ else if (Byte(Src[0]) and $E0) = $C0 then
+ begin
+ if Src + 1 >= SrcEnd then
+ break;
+ if (Src[1] = #0) or ((Byte(Src[1]) and $C0) <> $80) then
+ break;
+ Dst[0] := WideChar(((Byte(Src[0]) and $1F) shl 6) + ((Byte(Src[1]) and $3F)));
+ Inc(Src, 2);
+ end
+ else
+ begin
+ if MultiByteToWideChar(CodePage, MB_ERR_INVALID_CHARS, Src, 1, Dst, 1) = 0 then
+ Dst[0] := '?';
+ Inc(Src);
+ end;
+ Inc(Dst);
+ end;
+ Dst[0] := #0;
+ Inc(Dst);
+ Result := Dst - Dest;
+ end;
+end;
+
+function TextHasUrls(var Text: String): Boolean;
+var
+ i,len,lenW: Integer;
+ pText,pPos: PChar;
+begin
+ Result := False;
+ len := Length(Text);
+ if len=0 then exit;
+
+ pText := PChar(Text);
+ for i := 0 to High(UrlPrefix) do
+ begin
+ pPos := StrPos(pText, PChar(UrlPrefix[i]));
+ if not Assigned(pPos) then
+ continue;
+ Result := ((uint_ptr(pPos) = uint_ptr(pText)) or not IsWideCharAlphaNumeric((pPos - 1)^)) and
+ IsWideCharAlphaNumeric((pPos + Length(UrlPrefix[i]))^);
+ if Result then
+ exit;
+ end;
+
+ if not Assigned(StrPos(PChar(Text),':/')) then exit;
+
+ lenW := (len+1)*SizeOf(Char);
+
+ TextBuffer.Lock;
+ TextBuffer.Allocate(lenW);
+ Move(Text[1],TextBuffer.Buffer^,lenW);
+ CharLowerBuffW(PChar(TextBuffer.Buffer),len);
+ for i := 0 to High(UrlProto) do
+ begin
+ pPos := StrPos(PChar(TextBuffer.Buffer), PChar(UrlProto[i].proto));
+ if not Assigned(pPos) then
+ continue;
+ Result := ((uint_ptr(pPos) = uint_ptr(TextBuffer.Buffer)) or
+ not IsWideCharAlphaNumeric((pPos - 1)^));
+ if Result then
+ break;
+ end;
+ TextBuffer.Unlock;
+end;
+
+function GetEventInfo(hDBEvent: DWord): TDBEventInfo;
+var
+ BlobSize: integer;
+begin
+ ZeroMemory(@Result, SizeOf(Result));
+ Result.cbSize := SizeOf(Result);
+ BlobSize := CallService(MS_DB_EVENT_GETBLOBSIZE, hDBEvent, 0);
+ if BlobSize > 0 then
+ begin
+ EventBuffer.Allocate(BlobSize);
+ Result.pBlob := EventBuffer.Buffer;
+ end
+ else
+ BlobSize := 0;
+ Result.cbBlob := BlobSize;
+ if CallService(MS_DB_EVENT_GET, hDBEvent, LPARAM(@Result)) = 0 then
+ Result.cbBlob := BlobSize
+ else
+ Result.cbBlob := 0;
+end;
+
+function GetMessageType(EventInfo: TDBEventInfo; var EventIndex: Integer): TMessageTypes;
+var
+ i: Integer;
+begin
+ EventIndex := 0;
+ for i := 1 to High(EventTable) do
+ if EventTable[i].EventType = EventInfo.EventType then
+ begin
+ EventIndex := i;
+ break;
+ end;
+ Result := [EventTable[EventIndex].MessageType];
+ if (EventInfo.flags and DBEF_SENT) = 0 then
+ include(Result, mtIncoming)
+ else
+ include(Result, mtOutgoing);
+end;
+
+// reads event from hDbEvent handle
+// reads all THistoryItem fields
+// *EXCEPT* Proto field. Fill it manually, plz
+function ReadEvent(hDBEvent: THandle; UseCP: Cardinal = CP_ACP): THistoryItem;
+var
+ EventInfo: TDBEventInfo;
+ EventIndex: integer;
+ Handled: Boolean;
+begin
+ ZeroMemory(@Result,SizeOf(Result));
+ Result.Height := -1;
+ EventBuffer.Lock;
+ EventInfo := GetEventInfo(hDBEvent);
+ try
+ Result.Module := EventInfo.szModule;
+ Result.proto := '';
+ Result.Time := EventInfo.Timestamp;
+ Result.EventType := EventInfo.EventType;
+ Result.IsRead := Boolean(EventInfo.flags and DBEF_READ);
+ // enable autoRTL feature
+ if Boolean(EventInfo.flags and DBEF_RTL) then
+ Result.RTLMode := hppRTLEnable;
+ Result.MessageType := GetMessageType(EventInfo, EventIndex);
+ Result.CodePage := UseCP;
+ // Handled := true;
+ // if Handled then Handled := GetEventCoreText(EventInfo,Result);
+ { if Handled then } Handled := GetEventModuleText(EventInfo, Result);
+ if not Handled then
+ EventTable[EventIndex].TextFunction(EventInfo, Result);
+ Result.Text := AdjustLineBreaks(Result.Text);
+ Result.Text := TrimRight(Result.Text);
+ if mtMessage in Result.MessageType then
+ if TextHasUrls(Result.Text) then
+ begin
+ exclude(Result.MessageType, mtMessage);
+ include(Result.MessageType, mtUrl);
+ end;
+ finally
+ EventBuffer.Unlock;
+ end;
+end;
+
+procedure ReadStringTillZeroA(Text: PAnsiChar; Size: LongWord; var Result: AnsiString; var Pos: LongWord);
+begin
+ while (Pos < Size) and ((Text+Pos)^ <> #0) do
+ begin
+ Result := Result + (Text+Pos)^;
+ Inc(Pos);
+ end;
+ Inc(Pos);
+end;
+
+procedure ReadStringTillZeroW(Text: PChar; Size: LongWord; var Result: String; var Pos: LongWord);
+begin
+ while (Pos < Size) and ((Text+Pos)^ <> #0) do
+ begin
+ Result := Result + (Text+Pos)^;
+ Inc(Pos,SizeOf(Char));
+ end;
+ Inc(Pos,SizeOf(Char));
+end;
+
+function GetEventCoreText(EventInfo: TDBEventInfo; var Hi: THistoryItem): Boolean;
+var
+ dbegt: TDBEVENTGETTEXT;
+ msg: Pointer;
+begin
+ Result := False;
+ dbegt.dbei := @EventInfo;
+ dbegt.datatype := DBVT_WCHAR;
+ dbegt.codepage := hi.Codepage;
+ msg := nil;
+ try
+ msg := Pointer(CallService(MS_DB_EVENT_GETTEXT,0,LPARAM(@dbegt)));
+ Result := Assigned(msg);
+ except
+ if Assigned(msg) then mir_free(msg);
+ end;
+ if Result then
+ begin
+ SetString(hi.Text,PChar(msg),StrLen(PChar(msg)));
+ mir_free(msg);
+ end;
+end;
+
+function GetEventModuleText(EventInfo: TDBEventInfo; var Hi: THistoryItem): Boolean;
+const
+ maxServiceLength = 99;
+var
+ dbegt: TDBEVENTGETTEXT;
+ msg: Pointer;
+ szServiceName: array[0..maxServiceLength] of AnsiChar;
+begin
+ Result := False;
+ dbegt.dbei := @EventInfo;
+ dbegt.datatype := DBVT_WCHAR;
+ dbegt.codepage := hi.Codepage;
+ try
+ StrLFmt(szServiceName,maxServiceLength,'%s/GetEventText%u',[EventInfo.szModule,EventInfo.eventType]);
+ Result := Boolean(ServiceExists(szServiceName));
+ except
+ end;
+ if not Result then exit;
+ msg := nil;
+ try
+ msg := Pointer(CallService(szServiceName,0,LPARAM(@dbegt)));
+ Result := Assigned(msg);
+ except
+ if Assigned(msg) then mir_free(msg);
+ end;
+ if Result then begin
+ SetString(hi.Text,PChar(msg),StrLen(PChar(msg)));
+ mir_free(msg);
+ end;
+end;
+
+procedure GetEventTextForMessage(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+var
+ msgA: PAnsiChar;
+ msgW: PChar;
+ msglen,lenW: Cardinal;
+ i: integer;
+begin
+ msgA := PAnsiChar(EventInfo.pBlob);
+ msgW := nil;
+ msglen := lstrlenA(PAnsiChar(EventInfo.pBlob)) + 1;
+ if msglen > Cardinal(EventInfo.cbBlob) then
+ msglen := EventInfo.cbBlob;
+ if Boolean(EventInfo.flags and DBEF_UTF) then
+ begin
+ SetLength(Hi.Text, msglen);
+ lenW := Utf8ToWideChar(PChar(Hi.Text), msglen, msgA, msglen - 1, Hi.CodePage);
+ if Integer(lenW) > 0 then
+ SetLength(Hi.Text, lenW - 1)
+ else
+ Hi.Text := AnsiToWideString(msgA, Hi.CodePage, msglen - 1);
+ end
+ else
+ begin
+ lenW := 0;
+ if Cardinal(EventInfo.cbBlob) >= msglen * SizeOf(Char) then
+ begin
+ msgW := PChar(msgA + msglen);
+ for i := 0 to ((Cardinal(EventInfo.cbBlob) - msglen) div SizeOf(Char)) - 1 do
+ if msgW[i] = #0 then
+ begin
+ lenW := i;
+ break;
+ end;
+ end;
+ if (lenW > 0) and (lenW < msglen) then
+ SetString(Hi.Text, msgW, lenW)
+ else
+ Hi.Text := AnsiToWideString(msgA, Hi.CodePage, msglen - 1);
+ end;
+end;
+
+procedure GetEventTextForUrl(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+var
+ BytePos:LongWord;
+ Url,Desc: AnsiString;
+ cp: Cardinal;
+begin
+ BytePos:=0;
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob),EventInfo.cbBlob,Url,BytePos);
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob),EventInfo.cbBlob,Desc,BytePos);
+ if Boolean(EventInfo.flags and DBEF_UTF) then
+ cp := CP_UTF8
+ else
+ cp := Hi.CodePage;
+ hi.Text := Format(TranslateW('URL: %s'),[AnsiToWideString(url+#13#10+desc,cp)]);
+ hi.Extended := Url;
+end;
+
+procedure GetEventTextForFile(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+var
+ BytePos: LongWord;
+ FileName,Desc: AnsiString;
+ cp: Cardinal;
+begin
+ //blob is: sequenceid(DWORD),filename(ASCIIZ),description(ASCIIZ)
+ BytePos := 4;
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob), EventInfo.cbBlob, FileName, BytePos);
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob), EventInfo.cbBlob, Desc, BytePos);
+ if Boolean(EventInfo.flags and DBEF_SENT) then
+ Hi.Text := 'Outgoing file transfer: %s'
+ else
+ Hi.Text := 'Incoming file transfer: %s';
+ if Boolean(EventInfo.flags and DBEF_UTF) then
+ cp := CP_UTF8
+ else
+ cp := Hi.CodePage;
+ Hi.Text := Format(TranslateUnicodeString(Hi.Text), [AnsiToWideString(FileName + #13#10 + Desc, cp)]);
+ Hi.Extended := FileName;
+end;
+
+procedure GetEventTextForAuthRequest(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+var
+ BytePos: LongWord;
+ uin:integer;
+ hContact: THandle;
+ Nick,Name,Email,Reason: AnsiString;
+ NickW,ReasonW,ReasonUTF,ReasonACP: String;
+begin
+ // blob is: uin(DWORD), hContact(THANDLE), nick(ASCIIZ), first(ASCIIZ), last(ASCIIZ), email(ASCIIZ)
+ uin := PDWord(EventInfo.pBlob)^;
+ hContact := PInt_ptr(int_ptr(Pointer(EventInfo.pBlob)) + SizeOf(dword))^;
+ BytePos := SizeOf(dword) + SizeOf(THandle); // !!
+ // read nick
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob), EventInfo.cbBlob, Nick, BytePos);
+ if Nick = '' then
+ NickW := GetContactDisplayName(hContact, '', true)
+ else
+ NickW := AnsiToWideString(Nick, CP_ACP);
+ // read first name
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob), EventInfo.cbBlob, Name, BytePos);
+ Name := Name + ' ';
+ // read last name
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob), EventInfo.cbBlob, Name, BytePos);
+ Name := AnsiString(Trim(String(Name)));
+ if Name <> '' then
+ Name := Name + ', ';
+ // read Email
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob), EventInfo.cbBlob, Email, BytePos);
+ if Email <> '' then
+ Email := Email + ', ';
+ // read reason
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob), EventInfo.cbBlob, Reason, BytePos);
+
+ ReasonUTF := AnsiToWideString(Reason, CP_UTF8);
+ ReasonACP := AnsiToWideString(Reason, hppCodepage);
+ if (Length(ReasonUTF) > 0) and (Length(ReasonUTF) < Length(ReasonACP)) then
+ ReasonW := ReasonUTF
+ else
+ ReasonW := ReasonACP;
+ Hi.Text := Format(TranslateW('Authorisation request by %s (%s%d): %s'),
+ [NickW, AnsiToWideString(Name + Email, hppCodepage), uin, ReasonW]);
+end;
+
+procedure GetEventTextForYouWereAdded(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+var
+ BytePos: LongWord;
+ uin: integer;
+ hContact:THandle;
+ Nick,Name,Email: AnsiString;
+ NickW: String;
+begin
+ // blob is: uin(DWORD), hContact(THANDLE), nick(ASCIIZ), first(ASCIIZ), last(ASCIIZ), email(ASCIIZ)
+ uin := PDWord(EventInfo.pBlob)^;
+ hContact := PInt_ptr(int_ptr(Pointer(EventInfo.pBlob)) + SizeOf(dword))^;
+ BytePos := SizeOf(dword) + SizeOf(THandle); // !!
+ // read nick
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob), EventInfo.cbBlob, Nick, BytePos);
+ if Nick = '' then
+ NickW := GetContactDisplayName(hContact, '', true)
+ else
+ NickW := AnsiToWideString(Nick, CP_ACP);
+ // read first name
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob), EventInfo.cbBlob, Name, BytePos);
+ Name := Name + ' ';
+ // read last name
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob), EventInfo.cbBlob, Name, BytePos);
+ Name := AnsiString(Trim(String(Name)));
+ if Name <> '' then
+ Name := Name + ', ';
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob), EventInfo.cbBlob, Email, BytePos);
+ if Email <> '' then
+ Email := Email + ', ';
+ Hi.Text := Format(TranslateW('You were added by %s (%s%d)'),
+ [NickW, AnsiToWideString(Name + Email, hppCodepage), uin]);
+end;
+
+procedure GetEventTextForSms(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+var
+ cp: Cardinal;
+begin
+ if Boolean(EventInfo.flags and DBEF_UTF) then
+ cp := CP_UTF8
+ else
+ cp := Hi.CodePage;
+ Hi.Text := AnsiToWideString(PAnsiChar(EventInfo.pBlob), cp);
+end;
+
+procedure GetEventTextForContacts(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+var
+ BytePos: LongWord;
+ Contacts: AnsiString;
+ cp: Cardinal;
+begin
+ BytePos := 0;
+ Contacts := '';
+ While BytePos < Cardinal(EventInfo.cbBlob) do
+ begin
+ Contacts := Contacts + #13#10;
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob), EventInfo.cbBlob, Contacts, BytePos);
+ Contacts := Contacts + ' (ICQ: ';
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob), EventInfo.cbBlob, Contacts, BytePos);
+ Contacts := Contacts + ')';
+ end;
+ if Boolean(EventInfo.flags and DBEF_SENT) then
+ Hi.Text := 'Outgoing contacts: %s'
+ else
+ Hi.Text := 'Incoming contacts: %s';
+ if Boolean(EventInfo.flags and DBEF_UTF) then
+ cp := CP_UTF8
+ else
+ cp := Hi.CodePage;
+ hi.Text := Format(TranslateUnicodeString(hi.Text),[AnsiToWideString(Contacts,cp)]);
+end;
+
+procedure GetEventTextForWebPager(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+var
+ BytePos: LongWord;
+ Body,Name,Email: AnsiString;
+ cp: Cardinal;
+begin
+ BytePos := 0;
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob),EventInfo.cbBlob,Body,BytePos);
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob),EventInfo.cbBlob,Name,BytePos);
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob),EventInfo.cbBlob,Email,BytePos);
+ if Boolean(EventInfo.flags and DBEF_UTF) then
+ cp := CP_UTF8
+ else
+ cp := hppCodepage;
+ hi.Text := Format(TranslateW('Webpager message from %s (%s): %s'),
+ [AnsiToWideString(Name,cp),
+ AnsiToWideString(Email,cp),
+ AnsiToWideString(#13#10+Body,cp)]);
+end;
+
+procedure GetEventTextForEmailExpress(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+var
+ BytePos: LongWord;
+ Body,Name,Email: AnsiString;
+ cp: Cardinal;
+begin
+ BytePos := 0;
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob),EventInfo.cbBlob,Body,BytePos);
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob),EventInfo.cbBlob,Name,BytePos);
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob),EventInfo.cbBlob,Email,BytePos);
+ if Boolean(EventInfo.flags and DBEF_UTF) then
+ cp := CP_UTF8
+ else
+ cp := hppCodepage;
+ Hi.Text := Format(TranslateW('Email express from %s (%s): %s'),
+ [AnsiToWideString(Name, cp), AnsiToWideString(Email, cp),
+ AnsiToWideString(#13#10 + Body, cp)]);
+end;
+
+procedure GetEventTextForStatusChange(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+var
+ tmp: THistoryItem;
+begin
+ tmp.Codepage := hppCodepage;
+ GetEventTextForMessage(EventInfo,tmp);
+ hi.Text := Format(TranslateW('Status change: %s'),[tmp.Text]);
+end;
+
+procedure GetEventTextForAvatarChange(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+var
+ msgA: PAnsiChar;
+ msgW: PWideChar;
+ msglen,lenW: Cardinal;
+ i: integer;
+begin
+ msgA := PAnsiChar(EventInfo.pBlob);
+ msgW := nil;
+ msglen := lstrlenA(PAnsiChar(EventInfo.pBlob)) + 1;
+ if msglen > Cardinal(EventInfo.cbBlob) then
+ msglen := EventInfo.cbBlob;
+ if Boolean(EventInfo.flags and DBEF_UTF) then
+ begin
+ SetLength(Hi.Text, msglen);
+ lenW := Utf8ToWideChar(PWideChar(Hi.Text), msglen, msgA, msglen - 1, Hi.CodePage);
+ if Integer(lenW) > 0 then
+ SetLength(Hi.Text, lenW - 1)
+ else
+ Hi.Text := AnsiToWideString(msgA, Hi.CodePage, msglen - 1);
+ end
+ else
+ begin
+ lenW := 0;
+ if Cardinal(EventInfo.cbBlob) >= msglen * SizeOf(WideChar) then
+ begin
+ msgW := PWideChar(msgA + msglen);
+ for i := 0 to ((Cardinal(EventInfo.cbBlob) - msglen) div SizeOf(WideChar)) - 1 do
+ if msgW[i] = #0 then
+ begin
+ lenW := i;
+ break;
+ end;
+ end;
+ if (lenW > 0) and (lenW < msglen) then
+ SetString(Hi.Text, msgW, lenW)
+ else
+ Hi.Text := AnsiToWideString(msgA, Hi.CodePage, msglen - 1);
+ msglen := msglen + (lenW + 1) * SizeOf(WideChar);
+ end;
+ if msglen < Cardinal(EventInfo.cbBlob) then
+ begin
+ msgA := msgA + msglen;
+ if lstrlenA(msgA) > 0 then
+ Hi.Extended := msgA;
+ end;
+end;
+
+function GetEventTextForICQSystem(EventInfo: TDBEventInfo; Template: String): String;
+var
+ BytePos: LongWord;
+ Body: AnsiString;
+ uin: Integer;
+ Name: WideString;
+ cp: Cardinal;
+begin
+ BytePos := 0;
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob), EventInfo.cbBlob, Body, BytePos);
+ if Cardinal(EventInfo.cbBlob) < (BytePos + 4) then
+ uin := 0
+ else
+ uin := PDWord(PAnsiChar(EventInfo.pBlob) + BytePos)^;
+ if Cardinal(EventInfo.cbBlob) < (BytePos + 8) then
+ Name := TranslateW('''(Unknown Contact)''' { TRANSLATE-IGNORE } )
+ else
+ Name := GetContactDisplayName(PDWord(PAnsiChar(EventInfo.pBlob) + BytePos + 4)^, '', true);
+ if Boolean(EventInfo.flags and DBEF_UTF) then
+ cp := CP_UTF8
+ else
+ cp := hppCodepage;
+ Result := Format(Template, [Name, uin, AnsiToWideString(#13#10 + Body, cp)]);
+end;
+
+procedure GetEventTextForICQAuthGranted(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+begin
+ hi.Text := GetEventTextForICQSystem(EventInfo,
+ TranslateW('Authorization request granted by %s (%d): %s'));
+end;
+
+procedure GetEventTextForICQAuthDenied(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+begin
+ hi.Text := GetEventTextForICQSystem(EventInfo,
+ TranslateW('Authorization request denied by %s (%d): %s'));
+end;
+
+procedure GetEventTextForICQSelfRemove(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+begin
+ hi.Text := GetEventTextForICQSystem(EventInfo,
+ TranslateW('User %s (%d) removed himself from your contact list: %s'));
+end;
+
+procedure GetEventTextForICQFutureAuth(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+begin
+ hi.Text := GetEventTextForICQSystem(EventInfo,
+ TranslateW('Authorization future request by %s (%d): %s'));
+end;
+
+procedure GetEventTextForICQClientChange(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+begin
+ hi.Text := GetEventTextForICQSystem(EventInfo,
+ TranslateW('User %s (%d) changed icq client: %s'));
+end;
+
+procedure GetEventTextForICQCheckStatus(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+begin
+ hi.Text := GetEventTextForICQSystem(EventInfo,
+ TranslateW('Status request by %s (%d):%s'));
+end;
+
+procedure GetEventTextForICQIgnoreCheckStatus(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+begin
+ hi.Text := GetEventTextForICQSystem(EventInfo,
+ TranslateW('Ignored status request by %s (%d):%s'));
+end;
+
+procedure GetEventTextForICQBroadcast(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+var
+ BytePos: LongWord;
+ Body,Name,Email: AnsiString;
+ cp: Cardinal;
+begin
+ BytePos := 0;
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob),EventInfo.cbBlob,Body,BytePos);
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob),EventInfo.cbBlob,Name,BytePos);
+ ReadStringTillZeroA(Pointer(EventInfo.pBlob),EventInfo.cbBlob,Email,BytePos);
+ hi.Text := TranslateW('Broadcast message from %s (%s): %s');
+ if Boolean(EventInfo.flags and DBEF_UTF) then
+ cp := CP_UTF8
+ else
+ cp := hppCodepage;
+ hi.Text := Format(hi.Text,[AnsiToWideString(Name,cp),
+ AnsiToWideString(Email,cp),
+ AnsiToWideString(#13#10+Body,cp)]);
+end;
+
+procedure GetEventTextForJabberChatStates(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+begin
+ if EventInfo.cbBlob = 0 then exit;
+ case PByte(EventInfo.pBlob)^ of
+ JABBER_DB_EVENT_CHATSTATES_GONE:
+ hi.Text := TranslateW('closed chat session');
+ end;
+end;
+
+procedure GetEventTextWATrackRequest(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+begin
+ hi.Text := TranslateW('WATrack: information request');
+end;
+
+procedure GetEventTextWATrackAnswer(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+var
+ BytePos: LongWord;
+ Artist,Title,Album,Template: String;
+begin
+ BytePos := 0;
+ ReadStringTillZeroW(Pointer(EventInfo.pBlob),EventInfo.cbBlob,Artist,BytePos);
+ ReadStringTillZeroW(Pointer(EventInfo.pBlob),EventInfo.cbBlob,Title,BytePos);
+ ReadStringTillZeroW(Pointer(EventInfo.pBlob),EventInfo.cbBlob,Album,BytePos);
+ ReadStringTillZeroW(Pointer(EventInfo.pBlob),EventInfo.cbBlob,Template,BytePos);
+ if (Artist <> '') or (Title <> '') or (Album <> '') then
+ begin
+ if Template <> '' then
+ Template := Template + #13#10;
+ Template := Template + WideFormat
+ (FormatCString(TranslateW('Artist: %s\r\nTitle: %s\r\nAlbum: %s')),
+ [Artist, Title, Album]);
+ end;
+ hi.Text := Format(TranslateW('WATrack: %s'),[Template]);
+end;
+
+procedure GetEventTextWATrackError(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+begin
+ hi.Text := TranslateW('WATrack: request denied');
+end;
+
+procedure GetEventTextForOther(EventInfo: TDBEventInfo; var Hi: THistoryItem);
+var
+ cp: Cardinal;
+begin
+ TextBuffer.Allocate(EventInfo.cbBlob+1);
+ StrLCopy(TextBuffer.Buffer,PAnsiChar(EventInfo.pBlob),EventInfo.cbBlob);
+ if Boolean(EventInfo.flags and DBEF_UTF) then
+ cp := CP_UTF8
+ else
+ cp := Hi.CodePage;
+ hi.Text := AnsiToWideString(PAnsiChar(TextBuffer.Buffer),cp);
+end;
+
+initialization
+ EventBuffer := THppBuffer.Create;
+ TextBuffer := THppBuffer.Create;
+
+finalization
+ EventBuffer.Destroy;
+ TextBuffer.Destroy;
+ SetLength(ModuleEventRecords,0);
+
+end.
diff --git a/plugins/HistoryPlusPlus/hpp_external.pas b/plugins/HistoryPlusPlus/hpp_external.pas new file mode 100644 index 0000000000..6be84f51ca --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_external.pas @@ -0,0 +1,379 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+unit hpp_external;
+
+interface
+
+uses
+ Classes, Windows,
+ m_api,
+ hpp_global, hpp_database, hpp_externalgrid;
+
+type
+ TExternalGrids = class(TObject)
+ private
+ FGrids: array[TExGridMode] of TList;
+ procedure SetGroupLinked(Value: Boolean);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Add(const ExtGrid: TExternalGrid; GridMode: TExGridMode);
+ function Find(Handle: HWND; GridMode: TExGridMode): TExternalGrid;
+ function Delete(Handle: HWND; GridMode: TExGridMode): Boolean;
+ function Clear(GridMode: TExGridMode): Boolean;
+ procedure Perform(Msg: Cardinal; wParam: WPARAM; lParam: LPARAM);
+ property GroupLinked: Boolean write SetGroupLinked;
+ end;
+
+
+const
+ MS_HPP_EG_WINDOW = 'History++/ExtGrid/NewWindow';
+ MS_HPP_EG_EVENT = 'History++/ExtGrid/Event';
+ MS_HPP_EG_NAVIGATE = 'History++/ExtGrid/Navigate';
+ ME_HPP_EG_OPTIONSCHANGED = 'History++/ExtGrid/OptionsChanged';
+
+var
+ hExtWindowIE, hExtEventIE, hExtNavigateIE, hExtOptChangedIE: THandle;
+ hExtWindow, hExtEvent, hExtNavigate, hExtOptChanged: THandle;
+ ImitateIEView: boolean;
+ ExternalGrids: TExternalGrids;
+
+procedure RegisterExtGridServices;
+procedure UnregisterExtGridServices;
+
+implementation
+
+{$include inc\m_ieview.inc}
+
+function _ExtWindow(wParam:WPARAM; lParam: LPARAM; GridMode: TExGridMode): int_ptr;
+var
+ par: PIEVIEWWINDOW;
+ ExtGrid: TExternalGrid;
+ ControlID: Cardinal;
+begin
+ Result := 0;
+ //try
+ par := PIEVIEWWINDOW(lParam);
+ Assert(par <> nil, 'Empty IEVIEWWINDOW structure');
+ case par.iType of
+ IEW_CREATE: begin
+ {$IFDEF DEBUG}
+ OutputDebugString('IEW_CREATE');
+ {$ENDIF}
+ case par.dwMode of
+ IEWM_TABSRMM: ControlID := 1006; // IDC_LOG from tabSRMM
+ IEWM_SCRIVER: ControlID := 1001; // IDC_LOG from Scriver
+ IEWM_MUCC: ControlID := 0;
+ IEWM_CHAT: ControlID := 0;
+ IEWM_HISTORY: ControlID := 0;
+ else ControlID := 0;
+ end;
+ ExtGrid := TExternalGrid.Create(par.Parent,ControlID);
+ case par.dwMode of
+ IEWM_MUCC,IEWM_CHAT: begin
+ ExtGrid.ShowHeaders := False;
+ ExtGrid.GroupLinked := False;
+ ExtGrid.ShowBookmarks := False;
+ end;
+ IEWM_HISTORY:
+ ExtGrid.GroupLinked := False;
+ end;
+ ExtGrid.SetPosition(par.x,par.y,par.cx,par.cy);
+ ExternalGrids.Add(ExtGrid,GridMode);
+ par.Hwnd := ExtGrid.GridHandle;
+ end;
+ IEW_DESTROY: begin
+ {$IFDEF DEBUG}
+ OutputDebugString('IEW_DESTROY');
+ {$ENDIF}
+ ExternalGrids.Delete(par.Hwnd,GridMode);
+ end;
+ IEW_SETPOS: begin
+ {$IFDEF DEBUG}
+ OutputDebugString('IEW_SETPOS');
+ {$ENDIF}
+ ExtGrid := ExternalGrids.Find(par.Hwnd,GridMode);
+ if ExtGrid <> nil then
+ ExtGrid.SetPosition(par.x,par.y,par.cx,par.cy);
+ end;
+ IEW_SCROLLBOTTOM: begin
+ {$IFDEF DEBUG}
+ OutputDebugString('IEW_SCROLLBOTTOM');
+ {$ENDIF}
+ ExtGrid := ExternalGrids.Find(par.Hwnd,GridMode);
+ if ExtGrid <> nil then
+ ExtGrid.ScrollToBottom;
+ end;
+ end;
+ //except
+ //end;
+end;
+
+function ExtWindowNative(wParam:WPARAM; lParam: LPARAM): int_ptr; cdecl;
+begin
+ Result := _ExtWindow(wParam,lParam,gmNative);
+end;
+
+function ExtWindowIEView(wParam:WPARAM; lParam: LPARAM): int_ptr; cdecl;
+begin
+ Result := _ExtWindow(wParam,lParam,gmIEView);
+end;
+
+function _ExtEvent(wParam:WPARAM; lParam: LPARAM; GridMode: TExGridMode): int_ptr; cdecl;
+var
+ event: PIEVIEWEVENT;
+ customEvent: PIEVIEWEVENTDATA;
+ UsedCodepage: Cardinal;
+ hDBNext: THandle;
+ eventCount: Integer;
+ ExtGrid: TExternalGrid;
+ CustomItem: TExtCustomItem;
+begin
+ Result := 0;
+ //try
+ {$IFDEF DEBUG}
+ OutputDebugString('MS_IEVIEW_EVENT');
+ {$ENDIF}
+ event := PIEVIEWEVENT(lParam);
+ Assert(event <> nil, 'Empty IEVIEWEVENT structure');
+ ExtGrid := ExternalGrids.Find(event.Hwnd,GridMode);
+ if ExtGrid = nil then exit;
+ case event.iType of
+ IEE_LOG_DB_EVENTS: begin
+ if event.cbSize >= IEVIEWEVENT_SIZE_V2 then
+ UsedCodepage := event.Codepage
+ else
+ UsedCodepage := CP_ACP;
+ eventCount := event.Count;
+ hDBNext := event.Event.hDBEventFirst;
+ ExtGrid.BeginUpdate;
+ while (eventCount <> 0) and (hDBNext <> 0) do
+ begin
+ ExtGrid.AddEvent(event.hContact, hDBNext, UsedCodepage,
+ boolean(event.dwFlags and IEEF_RTL),
+ not boolean(event.dwFlags and IEEF_NO_SCROLLING));
+ if eventCount > 0 then Dec(eventCount);
+ if eventCount <> 0 then
+ hDBNext := CallService(MS_DB_EVENT_FINDNEXT,hDBNext,0);
+ end;
+ ExtGrid.EndUpdate;
+ end;
+ IEE_LOG_MEM_EVENTS: begin
+ if event.cbSize >= IEVIEWEVENT_SIZE_V2 then
+ UsedCodepage := event.Codepage
+ else
+ UsedCodepage := CP_ACP;
+ eventCount := event.Count;
+ customEvent := event.Event.eventData;
+ ExtGrid.BeginUpdate;
+ while (eventCount <> 0) and (customEvent <> nil) do
+ begin
+ if boolean(customEvent.dwFlags and IEEDF_UNICODE_TEXT) then
+ SetString(CustomItem.Text,customEvent.Text.w,lstrlenW(customEvent.Text.w))
+ else
+ CustomItem.Text := AnsiToWideString(AnsiString(customEvent.Text.a),UsedCodepage);
+ if boolean(customEvent.dwFlags and IEEDF_UNICODE_NICK) then
+ SetString(CustomItem.Nick,customEvent.Nick.w,lstrlenW(customEvent.Nick.w))
+ else
+ CustomItem.Nick := AnsiToWideString(AnsiString(customEvent.Nick.a),UsedCodepage);
+ CustomItem.Sent := boolean(customEvent.bIsMe);
+ CustomItem.Time := customEvent.time;
+ ExtGrid.AddCustomEvent(event.hContact, CustomItem, UsedCodepage,
+ boolean(event.dwFlags and IEEF_RTL),
+ not boolean(event.dwFlags and IEEF_NO_SCROLLING));
+ if eventCount > 0 then Dec(eventCount);
+ customEvent := customEvent.next;
+ end;
+ ExtGrid.EndUpdate;
+ end;
+ IEE_CLEAR_LOG: begin
+ ExtGrid.BeginUpdate;
+ ExtGrid.Clear;
+ ExtGrid.EndUpdate;
+ end;
+ IEE_GET_SELECTION: begin
+ Result := int_ptr(ExtGrid.GetSelection(boolean(event.dwFlags and IEEF_NO_UNICODE)));
+ end;
+ IEE_SAVE_DOCUMENT: begin
+ ExtGrid.SaveSelected;
+ end;
+ end;
+ //except
+ //end;
+end;
+
+function ExtEventNative(wParam:WPARAM; lParam: LPARAM): int_ptr; cdecl;
+begin
+ Result := _ExtEvent(wParam,lParam,gmNative);
+end;
+
+function ExtEventIEView(wParam:WPARAM; lParam: LPARAM): int_ptr; cdecl;
+begin
+ Result := _ExtEvent(wParam,lParam,gmIEView);
+end;
+
+function ExtNavigate(wParam:WPARAM; lParam: LPARAM): int_ptr; cdecl;
+begin
+ Result := 0;
+ //try
+ {$IFDEF DEBUG}
+ OutputDebugString('MS_IEVIEW_NAVIGATE');
+ {$ENDIF}
+ //except
+ //end;
+end;
+
+procedure RegisterExtGridServices;
+begin
+ ExternalGrids := TExternalGrids.Create;
+ ImitateIEView := GetDBBool(hppDBName,'IEViewAPI',false);
+ if ImitateIEView then
+ begin
+ hExtWindowIE := CreateServiceFunction(MS_IEVIEW_WINDOW,ExtWindowIEView);
+ hExtEventIE := CreateServiceFunction(MS_IEVIEW_EVENT,ExtEventIEView);
+ hExtNavigateIE := CreateServiceFunction(MS_IEVIEW_NAVIGATE,ExtNavigate);
+ hExtOptChangedIE := CreateHookableEvent(ME_IEVIEW_OPTIONSCHANGED);
+ end;
+ hExtWindow := CreateServiceFunction(MS_HPP_EG_WINDOW,ExtWindowNative);
+ hExtEvent := CreateServiceFunction(MS_HPP_EG_EVENT,ExtEventNative);
+ hExtNavigate := CreateServiceFunction(MS_HPP_EG_NAVIGATE,ExtNavigate);
+ hExtOptChanged := CreateHookableEvent(ME_HPP_EG_OPTIONSCHANGED);
+end;
+
+procedure UnregisterExtGridServices;
+begin
+ if ImitateIEView then
+ begin
+ DestroyServiceFunction(hExtWindowIE);
+ DestroyServiceFunction(hExtEventIE);
+ DestroyServiceFunction(hExtNavigateIE);
+ DestroyHookableEvent(hExtOptChangedIE);
+ end;
+ DestroyServiceFunction(hExtWindow);
+ DestroyServiceFunction(hExtEvent);
+ DestroyServiceFunction(hExtNavigate);
+ DestroyHookableEvent(hExtOptChanged);
+ ExternalGrids.Destroy;
+end;
+
+constructor TExternalGrids.Create;
+var
+ GridMode: TExGridMode;
+begin
+ for GridMode := Low(TExGridMode) to High(TExGridMode) do
+ FGrids[GridMode] := TList.Create;
+end;
+
+destructor TExternalGrids.Destroy;
+var
+ GridMode: TExGridMode;
+begin
+ for GridMode := Low(TExGridMode) to High(TExGridMode) do begin
+ Clear(GridMode);
+ FGrids[GridMode].Free;
+ end;
+ inherited;
+end;
+
+procedure TExternalGrids.Add(const ExtGrid: TExternalGrid; GridMode: TExGridMode);
+begin
+ FGrids[GridMode].Add(ExtGrid);
+end;
+
+function TExternalGrids.Find(Handle: HWND; GridMode: TExGridMode): TExternalGrid;
+var
+ i: Integer;
+ ExtGrid: TExternalGrid;
+begin
+ Result := nil;
+ for i := 0 to FGrids[GridMode].Count-1 do
+ begin
+ ExtGrid := TExternalGrid(FGrids[GridMode].Items[i]);
+ if ExtGrid.GridHandle = Handle then
+ begin
+ Result := ExtGrid;
+ break;
+ end;
+ end;
+end;
+
+function TExternalGrids.Delete(Handle: HWND; GridMode: TExGridMode): Boolean;
+var
+ i: Integer;
+ ExtGrid: TExternalGrid;
+begin
+ Result := True;
+ for i := 0 to FGrids[GridMode].Count-1 do
+ begin
+ ExtGrid := TExternalGrid(FGrids[GridMode].Items[i]);
+ if ExtGrid.GridHandle = Handle then
+ begin
+ try
+ ExtGrid.Free;
+ except
+ Result := False;
+ end;
+ FGrids[GridMode].Delete(i);
+ break;
+ end;
+ end;
+end;
+
+function TExternalGrids.Clear(GridMode: TExGridMode): Boolean;
+var
+ i: Integer;
+ ExtGrid: TExternalGrid;
+begin
+ Result := True;
+ for i := 0 to FGrids[GridMode].Count-1 do
+ begin
+ ExtGrid := TExternalGrid(FGrids[GridMode].Items[i]);
+ try
+ ExtGrid.Free;
+ except
+ Result := False;
+ end;
+ end;
+ FGrids[GridMode].Clear;
+end;
+
+procedure TExternalGrids.Perform(Msg: Cardinal; wParam: WPARAM; lParam: LPARAM);
+var
+ i: Integer;
+ GridMode: TExGridMode;
+begin
+ for GridMode := Low(TExGridMode) to High(TExGridMode) do
+ for i := FGrids[GridMode].Count-1 downto 0 do
+ TExternalGrid(FGrids[GridMode].Items[i]).Perform(Msg,wParam,lParam);
+end;
+
+procedure TExternalGrids.SetGroupLinked(Value: Boolean);
+var
+ i: Integer;
+ GridMode: TExGridMode;
+begin
+ for GridMode := Low(TExGridMode) to High(TExGridMode) do
+ for i := FGrids[GridMode].Count-1 downto 0 do
+ TExternalGrid(FGrids[GridMode].Items[i]).GroupLinked := Value;
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/hpp_externalgrid.pas b/plugins/HistoryPlusPlus/hpp_externalgrid.pas new file mode 100644 index 0000000000..6f05e24a4b --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_externalgrid.pas @@ -0,0 +1,1399 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+unit hpp_externalgrid;
+
+interface
+
+uses
+ Windows, Classes, Controls, Forms, Graphics, Messages, SysUtils, Dialogs,
+ m_api,
+ hpp_global, hpp_events, hpp_contacts, hpp_services, hpp_forms, hpp_bookmarks,
+ hpp_richedit, hpp_messages, hpp_eventfilters, hpp_database, hpp_itemprocess,
+ HistoryGrid,
+ RichEdit, Menus, ShellAPI;
+
+type
+ TExGridMode = (gmNative, gmIEView);
+
+ PExtCustomItem = ^TExtCustomItem;
+
+ TExtCustomItem = record
+ Nick: String;
+ Text: String;
+ Sent: Boolean;
+ Time: DWord;
+ end;
+
+ TExtItem = record
+ hDBEvent: THandle;
+ hContact: THandle;
+ Codepage: THandle;
+ RTLMode: TRTLMode;
+ Custom: Boolean;
+ CustomEvent: TExtCustomItem;
+ end;
+
+ TOnDestroyWindow = procedure(Sender: TObject; Handle: HWND) of object;
+
+ TExtHistoryGrid = class(THistoryGrid)
+ private
+ FCachedHandle: HWND;
+ FControlID: Cardinal;
+ FSavedKeyMessage: TWMKey;
+ FOnDestroyWindow: TOnDestroyWindow;
+ procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
+ procedure WMKeyUp(var Message: TWMKeyUp); message WM_KEYUP;
+ procedure WMSysKeyUp(var Message: TWMSysKeyUp); message WM_SYSKEYUP;
+ procedure WMChar(var Message: TWMChar); message WM_CHAR;
+ procedure WMDestroy(var Message: TWMNCDestroy); message WM_DESTROY;
+ procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY;
+ protected
+ function GetCachedHandle: HWND;
+ function SendMsgFilterMessage(var Message: TMessage): Integer;
+ public
+ constructor Create(AOwner: TComponent); override;
+ property CachedHandle: HWND read GetCachedHandle;
+ property ControlID: Cardinal read FControlID write FControlID;
+ property OnDestroyWindow: TOnDestroyWindow read FOnDestroyWindow write FOnDestroyWindow;
+ end;
+
+ TExternalGrid = class(TObject)
+ private
+ Items: array of TExtItem;
+ Grid: TExtHistoryGrid;
+ FParentWindow: HWND;
+ FSelection: Pointer;
+ SavedLinkUrl: String;
+ SavedFileDir: String;
+ pmGrid: TPopupMenu;
+ pmLink: TPopupMenu;
+ miEventsFilter: TMenuItem;
+ WasKeyPressed: Boolean;
+ FGridMode: TExGridMode;
+ FUseHistoryRTLMode: Boolean;
+ FExternalRTLMode: TRTLMode;
+ FUseHistoryCodepage: Boolean;
+ FExternalCodepage: Cardinal;
+ FGridState: TGridState;
+ SaveDialog: TSaveDialog;
+ RecentFormat: TSaveFormat;
+ FSubContact: THandle;
+ FSubProtocol: AnsiString;
+
+ function GetGridHandle: HWND;
+ procedure SetUseHistoryRTLMode(const Value: Boolean);
+ procedure SetUseHistoryCodepage(const Value: Boolean);
+ procedure SetGroupLinked(const Value: Boolean);
+ procedure SetShowHeaders(const Value: Boolean);
+ procedure SetShowBookmarks(const Value: Boolean);
+ procedure CreateEventsFilterMenu;
+ procedure SetEventFilter(FilterIndex: Integer = -1);
+ function IsFileEvent(Index: Integer): Boolean;
+ protected
+ procedure GridItemData(Sender: TObject; Index: Integer; var Item: THistoryItem);
+ procedure GridTranslateTime(Sender: TObject; Time: DWord; var Text: String);
+ procedure GridNameData(Sender: TObject; Index: Integer; var Name: String);
+ procedure GridProcessRichText(Sender: TObject; Handle: THandle; Item: Integer);
+ procedure GridUrlClick(Sender: TObject; Item: Integer; URLText: String; Button: TMouseButton);
+ procedure GridBookmarkClick(Sender: TObject; Item: Integer);
+ procedure GridSelectRequest(Sender: TObject);
+ procedure GridDblClick(Sender: TObject);
+ procedure GridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure GridKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure GridPopup(Sender: TObject);
+ procedure GridInlineKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure GridItemDelete(Sender: TObject; Index: Integer);
+ procedure GridXMLData(Sender: TObject; Index: Integer; var Item: TXMLItem);
+ procedure GridMCData(Sender: TObject; Index: Integer; var Item: TMCItem; Stage: TSaveStage);
+ procedure OnCopyClick(Sender: TObject);
+ procedure OnCopyTextClick(Sender: TObject);
+ procedure OnSelectAllClick(Sender: TObject);
+ procedure OnTextFormattingClick(Sender: TObject);
+ procedure OnReplyQuotedClick(Sender: TObject);
+ procedure OnBookmarkClick(Sender: TObject);
+ procedure OnOpenClick(Sender: TObject);
+ procedure OnOpenLinkClick(Sender: TObject);
+ procedure OnOpenLinkNWClick(Sender: TObject);
+ procedure OnCopyLinkClick(Sender: TObject);
+ procedure OnDeleteClick(Sender: TObject);
+ procedure OnBidiModeLogClick(Sender: TObject);
+ procedure OnBidiModeHistoryClick(Sender: TObject);
+ procedure OnCodepageLogClick(Sender: TObject);
+ procedure OnCodepageHistoryClick(Sender: TObject);
+ procedure OnSaveSelectedClick(Sender: TObject);
+ procedure OnEventsFilterItemClick(Sender: TObject);
+ procedure OnBrowseReceivedFilesClick(Sender: TObject);
+ procedure OnOpenFileFolderClick(Sender: TObject);
+ procedure OnSpeakMessage(Sender: TObject);
+ public
+ constructor Create(AParentWindow: HWND; ControlID: Cardinal = 0);
+ destructor Destroy; override;
+ procedure AddEvent(hContact, hDBEvent: THandle; Codepage: Integer; RTL: Boolean; DoScroll: Boolean);
+ procedure AddCustomEvent(hContact: THandle; CustomItem: TExtCustomItem; Codepage: Integer;
+ RTL: Boolean; DoScroll: Boolean);
+ procedure SetPosition(x, y, cx, cy: Integer);
+ procedure ScrollToBottom;
+ function GetSelection(NoUnicode: Boolean): PAnsiChar;
+ procedure SaveSelected;
+ procedure Clear;
+ property ParentWindow: HWND read FParentWindow;
+ property GridHandle: HWND read GetGridHandle;
+ property GridMode: TExGridMode read FGridMode write FGridMode;
+ property UseHistoryRTLMode: Boolean read FUseHistoryRTLMode write SetUseHistoryRTLMode;
+ property UseHistoryCodepage: Boolean read FUseHistoryCodepage write SetUseHistoryCodepage;
+ function Perform(Msg: Cardinal; WParam:WPARAM; LParam: LPARAM): LRESULT;
+ procedure HMBookmarkChanged(var M: TMessage); message HM_NOTF_BOOKMARKCHANGED;
+ // procedure HMIcons2Changed(var M: TMessage); message HM_NOTF_ICONS2CHANGED;
+ procedure HMFiltersChanged(var M: TMessage); message HM_NOTF_FILTERSCHANGED;
+ procedure HMNickChanged(var M: TMessage); message HM_NOTF_NICKCHANGED;
+ procedure HMEventDeleted(var M: TMessage); message HM_MIEV_EVENTDELETED;
+ procedure HMMetaDefaultChanged(var M: TMessage); message HM_MIEV_METADEFCHANGED;
+ procedure BeginUpdate;
+ procedure EndUpdate;
+ property ShowHeaders: Boolean write SetShowHeaders;
+ property GroupLinked: Boolean write SetGroupLinked;
+ property ShowBookmarks: Boolean write SetShowBookmarks;
+ end;
+
+implementation
+
+uses hpp_options, hpp_sessionsthread;
+
+{$include inc\m_speak.inc}
+
+{ TExtHistoryGrid }
+
+constructor TExtHistoryGrid.Create(AOwner: TComponent);
+begin
+ FCachedHandle := 0;
+ FControlID := 0;
+ inherited;
+end;
+
+function TExtHistoryGrid.GetCachedHandle: HWND;
+begin
+ if (FCachedHandle = 0) or HandleAllocated then
+ Result := Handle
+ else
+ Result := FCachedHandle;
+end;
+
+function TExtHistoryGrid.SendMsgFilterMessage(var Message: TMessage): Integer;
+var
+ mf: TMsgFilter;
+begin
+ Result := 0;
+ if FControlID <> 0 then
+ begin
+ mf.nmhdr.hwndFrom := WindowHandle;
+ mf.nmhdr.idFrom := FControlID;
+ mf.nmhdr.code := EN_MSGFILTER;
+ mf.Msg := Message.Msg;
+ mf.wParam := Message.wParam;
+ mf.lParam := Message.lParam;
+ Result := SendMessage(ParentWindow, WM_NOTIFY, FControlID, LParam(@mf));
+ end;
+end;
+
+procedure TExtHistoryGrid.WMKeyDown(var Message: TWMKeyDown);
+begin
+ inherited;
+ FSavedKeyMessage := Message;
+ if Message.CharCode <> 0 then
+ SendMsgFilterMessage(TMessage(Message))
+end;
+
+procedure TExtHistoryGrid.WMKeyUp(var Message: TWMKeyUp);
+begin
+ inherited;
+ if FSavedKeyMessage.CharCode = 0 then
+ exit;
+ if Message.CharCode <> 0 then
+ SendMsgFilterMessage(TMessage(Message))
+end;
+
+procedure TExtHistoryGrid.WMSysKeyUp(var Message: TWMSysKeyUp);
+begin
+ inherited;
+ if FSavedKeyMessage.CharCode = 0 then
+ exit;
+ if Message.CharCode <> 0 then
+ SendMsgFilterMessage(TMessage(Message))
+end;
+
+procedure TExtHistoryGrid.WMChar(var Message: TWMChar);
+begin
+ inherited;
+ if FSavedKeyMessage.CharCode = 0 then
+ exit;
+ if Message.CharCode <> 0 then
+ SendMsgFilterMessage(TMessage(Message))
+end;
+
+procedure TExtHistoryGrid.WMDestroy(var Message: TWMDestroy);
+begin
+ if not(csDestroyingHandle in ControlState) then
+ FCachedHandle := Handle;
+ inherited;
+end;
+
+procedure TExtHistoryGrid.WMNCDestroy(var Message: TWMNCDestroy);
+begin
+ inherited;
+ if not(csDestroyingHandle in ControlState) then
+ if Assigned(FOnDestroyWindow) then
+ FOnDestroyWindow(Self, FCachedHandle);
+end;
+
+{ TExternalGrid }
+
+function TExternalGrid.Perform(Msg: Cardinal; WParam:WPARAM; LParam: LPARAM): LRESULT;
+var
+ M: TMessage;
+begin
+ M.Msg := Msg;
+ M.WParam := WParam;
+ M.LParam := LParam;
+ Dispatch(M);
+ Result := M.Result;
+end;
+
+procedure TExternalGrid.AddEvent(hContact, hDBEvent: THandle; Codepage: Integer; RTL: Boolean;
+ DoScroll: Boolean);
+var
+ RTLMode: TRTLMode;
+begin
+ SetLength(Items, Length(Items) + 1);
+ Items[High(Items)].hDBEvent := hDBEvent;
+ Items[High(Items)].hContact := hContact;
+ Items[High(Items)].Codepage := Codepage;
+ Items[High(Items)].Custom := False;
+ if RTL then
+ RTLMode := hppRTLEnable
+ else
+ RTLMode := hppRTLDefault;
+ Items[High(Items)].RTLMode := RTLMode;
+ if THandle(Grid.Contact) <> hContact then
+ begin
+ Grid.Contact := hContact;
+ Grid.Protocol := GetContactProto(hContact, FSubContact, FSubProtocol);
+ FExternalRTLMode := RTLMode;
+ UseHistoryRTLMode := GetDBBool(Grid.Contact, Grid.Protocol, 'UseHistoryRTLMode',
+ FUseHistoryRTLMode);
+ FExternalCodepage := Codepage;
+ UseHistoryRTLMode := GetDBBool(Grid.Contact, Grid.Protocol, 'UseHistoryCodepage',
+ FUseHistoryCodepage);
+ end;
+ // comment or we'll get rerendering the whole grid
+ // if Grid.Codepage <> Codepage then Grid.Codepage := Codepage;
+ Grid.Allocate(Length(Items), DoScroll and (Grid.State <> gsInline));
+end;
+
+procedure TExternalGrid.AddCustomEvent(hContact: THandle; CustomItem: TExtCustomItem;
+ Codepage: Integer; RTL: Boolean; DoScroll: Boolean);
+var
+ RTLMode: TRTLMode;
+begin
+ SetLength(Items, Length(Items) + 1);
+ Items[High(Items)].hDBEvent := 0;
+ Items[High(Items)].hContact := hContact;
+ Items[High(Items)].Codepage := Codepage;
+ Items[High(Items)].Custom := True;
+ Items[High(Items)].CustomEvent.Nick := CustomItem.Nick;
+ Items[High(Items)].CustomEvent.Text := CustomItem.Text;
+ Items[High(Items)].CustomEvent.Sent := CustomItem.Sent;
+ Items[High(Items)].CustomEvent.Time := CustomItem.Time;
+ if RTL then
+ RTLMode := hppRTLEnable
+ else
+ RTLMode := hppRTLDefault;
+ Items[High(Items)].RTLMode := RTLMode;
+ if THandle(Grid.Contact) <> hContact then
+ begin
+ Grid.Contact := hContact;
+ Grid.Protocol := GetContactProto(hContact, FSubContact, FSubProtocol);
+ FExternalRTLMode := RTLMode;
+ UseHistoryRTLMode := GetDBBool(Grid.Contact, Grid.Protocol, 'UseHistoryRTLMode',
+ FUseHistoryRTLMode);
+ FExternalCodepage := Codepage;
+ UseHistoryRTLMode := GetDBBool(Grid.Contact, Grid.Protocol, 'UseHistoryCodepage',
+ FUseHistoryCodepage);
+ end;
+ // comment or we'll get rerendering the whole grid
+ // if Grid.Codepage <> Codepage then Grid.Codepage := Codepage;
+ Grid.Allocate(Length(Items), DoScroll and (Grid.State <> gsInline));
+end;
+
+function RadioItem(Value: Boolean; mi: TMenuItem): TMenuItem;
+begin
+ Result := mi;
+ Result.RadioItem := Value;
+end;
+
+constructor TExternalGrid.Create(AParentWindow: HWND; ControlID: Cardinal = 0);
+begin
+ FParentWindow := AParentWindow;
+ WasKeyPressed := False;
+ FGridMode := gmNative;
+ FUseHistoryRTLMode := False;
+ FExternalRTLMode := hppRTLDefault;
+ FUseHistoryCodepage := False;
+ FExternalCodepage := CP_ACP;
+ FSelection := nil;
+ FGridState := gsIdle;
+ RecentFormat := sfHtml;
+
+ Grid := TExtHistoryGrid.CreateParented(ParentWindow);
+
+ Grid.Reversed := False;
+ Grid.ShowHeaders := True;
+ Grid.ReversedHeader := True;
+ Grid.ExpandHeaders := GetDBBool(hppDBName, 'ExpandLogHeaders', False);
+ Grid.HideSelection := True;
+ Grid.ControlID := ControlID;
+
+ Grid.ParentCtl3D := False;
+ Grid.Ctl3D := True;
+ Grid.ParentColor := False;
+ Grid.Color := clBtnFace;
+
+ Grid.BevelEdges := [beLeft, beTop, beRight, beBottom];
+ Grid.BevelKind := bkNone;
+ Grid.BevelInner := bvNone;
+ Grid.BevelOuter := bvNone;
+ Grid.BevelWidth := 1;
+
+ if GetDBBool(hppDBName, 'NoLogBorder', False) then
+ Grid.BorderStyle := bsNone
+ else
+ Grid.BorderStyle := bsSingle;
+ Grid.BorderWidth := 0;
+
+ Grid.HideScrollBar := GetDBBool(hppDBName, 'NoLogScrollBar', False);
+
+ Grid.OnItemData := GridItemData;
+ Grid.OnTranslateTime := GridTranslateTime;
+ Grid.OnNameData := GridNameData;
+ Grid.OnProcessRichText := GridProcessRichText;
+ Grid.OnUrlClick := GridUrlClick;
+ Grid.OnBookmarkClick := GridBookmarkClick;
+ Grid.OnSelectRequest := GridSelectRequest;
+ Grid.OnDblClick := GridDblClick;
+ Grid.OnKeyDown := GridKeyDown;
+ Grid.OnKeyUp := GridKeyUp;
+ Grid.OnPopup := GridPopup;
+ Grid.OnInlinePopup := GridPopup;
+ Grid.OnInlineKeyDown := GridInlineKeyDown;
+ Grid.OnItemDelete := GridItemDelete;
+ Grid.OnXMLData := GridXMLData;
+ Grid.OnMCData := GridMCData;
+
+ Grid.TxtFullLog := TranslateUnicodeString(Grid.TxtFullLog { TRANSLATE-IGNORE } );
+ Grid.TxtGenHist1 := TranslateUnicodeString(Grid.TxtGenHist1 { TRANSLATE-IGNORE } );
+ Grid.TxtGenHist2 := TranslateUnicodeString(Grid.TxtGenHist2 { TRANSLATE-IGNORE } );
+ Grid.TxtHistExport := TranslateUnicodeString(Grid.TxtHistExport { TRANSLATE-IGNORE } );
+ Grid.TxtNoItems := '';
+ Grid.TxtNoSuch := TranslateUnicodeString(Grid.TxtNoSuch { TRANSLATE-IGNORE } );
+ Grid.TxtPartLog := TranslateUnicodeString(Grid.TxtPartLog { TRANSLATE-IGNORE } );
+ Grid.TxtStartUp := TranslateUnicodeString(Grid.TxtStartUp { TRANSLATE-IGNORE } );
+ Grid.TxtSessions := TranslateUnicodeString(Grid.TxtSessions { TRANSLATE-IGNORE } );
+
+ Grid.Options := GridOptions;
+
+ Grid.GroupLinked := GetDBBool(hppDBName, 'GroupLogItems', False);
+
+ pmGrid := TPopupMenu.Create(Grid);
+ pmGrid.ParentBiDiMode := False;
+ pmGrid.Items.Add(NewItem('Sh&ow in history', 0, False, True, OnOpenClick, 0, 'pmOpen'));
+ pmGrid.Items.Add(NewItem('Speak Message', 0, False, True, OnSpeakMessage, 0, 'pmSpeakMessage'));
+ pmGrid.Items.Add(NewItem('-', 0, False, True, nil, 0, 'pmN1'));
+ pmGrid.Items.Add(NewItem('&Copy', TextToShortCut('Ctrl+C'), False, True, OnCopyClick, 0, 'pmCopy'));
+ pmGrid.Items.Add(NewItem('Copy &Text', TextToShortCut('Ctrl+T'), False, True, OnCopyTextClick, 0, 'pmCopyText'));
+ pmGrid.Items.Add(NewItem('Select &All', TextToShortCut('Ctrl+A'), False, True, OnSelectAllClick, 0, 'pmSelectAll'));
+ pmGrid.Items.Add(NewItem('&Delete', TextToShortCut('Del'), False, True, OnDeleteClick, 0, 'pmDelete'));
+ pmGrid.Items.Add(NewItem('-', 0, False, True, nil, 0, 'pmN2'));
+ pmGrid.Items.Add(NewItem('Text Formatting', TextToShortCut('Ctrl+P'), False, True, OnTextFormattingClick, 0, 'pmTextFormatting'));
+ pmGrid.Items.Add(NewItem('-', 0, False, True, nil, 0, 'pmN3'));
+ pmGrid.Items.Add(NewItem('&Reply Quoted', TextToShortCut('Ctrl+R'), False, True, OnReplyQuotedClick, 0, 'pmReplyQuoted'));
+ pmGrid.Items.Add(NewItem('Set &Bookmark', TextToShortCut('Ctrl+B'), False, True, OnBookmarkClick, 0, 'pmBookmark'));
+ pmGrid.Items.Add(NewItem('-', 0, False, True, nil, 0, 'pmN4'));
+ pmGrid.Items.Add(NewItem('&Save Selected...', TextToShortCut('Ctrl+S'), False, True, OnSaveSelectedClick, 0, 'pmSaveSelected'));
+ pmGrid.Items.Add(NewItem('-', 0, False, True, nil, 0, 'pmN5'));
+ pmGrid.Items.Add(NewSubMenu('&File Actions', 0, 'pmFileActions',
+ [NewItem('&Browse Received Files', 0, False, True, OnBrowseReceivedFilesClick, 0,'pmBrowseReceivedFiles'),
+ NewItem('&Open file folder', 0, False, True, OnOpenFileFolderClick, 0, 'pmOpenFileFolder'),
+ NewItem('-', 0, False, True, nil, 0, 'pmN7'),
+ NewItem('&Copy Filename', 0, False, True, OnCopyLinkClick, 0, 'pmCopyLink')], True));
+ pmGrid.Items.Add(NewSubMenu('Text direction', 0, 'pmBidiMode',
+ [RadioItem(True, NewItem('Log default', 0, True, True, OnBidiModeLogClick, 0, 'pmBidiModeLog')),
+ RadioItem(True, NewItem('History default', 0, False, True, OnBidiModeHistoryClick, 0, 'pmBidiModeHistory'))], True));
+ pmGrid.Items.Add(NewSubMenu('ANSI Encoding', 0, 'pmCodepage',
+ [RadioItem(True, NewItem('Log default', 0, True, True, OnCodepageLogClick, 0, 'pmCodepageLog')),
+ RadioItem(True, NewItem('History default', 0, False, True, OnCodepageHistoryClick, 0, 'pmCodepageHistory'))], True));
+ pmGrid.Items.Add(NewItem('-', 0, False, True, nil, 0, 'pmN6'));
+
+ miEventsFilter := TMenuItem.Create(pmGrid);
+ miEventsFilter.Caption := 'Events filter';
+ pmGrid.Items.Add(miEventsFilter);
+
+ pmLink := TPopupMenu.Create(Grid);
+ pmLink.ParentBiDiMode := False;
+ pmLink.Items.Add(NewItem('Open &Link', 0, False, True, OnOpenLinkClick, 0, 'pmOpenLink'));
+ pmLink.Items.Add(NewItem('Open Link in New &Window', 0, False, True, OnOpenLinkNWClick, 0, 'pmOpenLinkNW'));
+ pmLink.Items.Add(NewItem('-', 0, False, True, nil, 0, 'pmN4'));
+ pmLink.Items.Add(NewItem('&Copy Link', 0, False, True, OnCopyLinkClick, 0, 'pmCopyLink'));
+
+ TranslateMenu(pmGrid.Items);
+ TranslateMenu(pmLink.Items);
+
+ CreateEventsFilterMenu;
+ // SetEventFilter(GetDBInt(hppDBName,'RecentLogFilter',GetShowAllEventsIndex));
+ SetEventFilter(GetShowAllEventsIndex);
+end;
+
+destructor TExternalGrid.Destroy;
+begin
+ WriteDBBool(hppDBName, 'ExpandLogHeaders', Grid.ExpandHeaders);
+ if FSelection <> nil then
+ FreeMem(FSelection);
+ Grid.Free;
+ Finalize(Items);
+ inherited;
+end;
+
+function TExternalGrid.GetGridHandle: HWND;
+begin
+ Result := Grid.CachedHandle;
+end;
+
+procedure TExternalGrid.BeginUpdate;
+begin
+ Grid.BeginUpdate;
+end;
+
+procedure TExternalGrid.EndUpdate;
+begin
+ Grid.EndUpdate;
+end;
+
+procedure TExternalGrid.GridItemData(Sender: TObject; Index: Integer; var Item: THistoryItem);
+const
+ Direction: array [False .. True] of TMessageTypes = ([mtIncoming], [mtOutgoing]);
+var
+ PrevTimestamp: DWord;
+ Codepage: Cardinal;
+begin
+ if FUseHistoryCodepage then
+ Codepage := Grid.Codepage
+ else
+ Codepage := Items[Index].Codepage;
+ if Items[Index].Custom then
+ begin
+ Item.Height := -1;
+ Item.Time := Items[Index].CustomEvent.Time;
+ Item.MessageType := [mtOther] + Direction[Items[Index].CustomEvent.Sent];
+ Item.Text := Items[Index].CustomEvent.Text;
+ Item.IsRead := True;
+ end
+ else
+ begin
+ Item := ReadEvent(Items[Index].hDBEvent, Codepage);
+ Item.Bookmarked := BookmarkServer[Items[Index].hContact].Bookmarked[Items[Index].hDBEvent];
+ end;
+ Item.Proto := Grid.Protocol;
+ if Index = 0 then
+ Item.HasHeader := IsEventInSession(Item.EventType)
+ else
+ begin
+ if Items[Index].Custom then
+ PrevTimestamp := Items[Index - 1].CustomEvent.Time
+ else
+ PrevTimestamp := GetEventTimestamp(Items[Index - 1].hDBEvent);
+ if IsEventInSession(Item.EventType) then
+ Item.HasHeader := ((DWord(Item.Time) - PrevTimestamp) > SESSION_TIMEDIFF);
+ if (not Item.Bookmarked) and (Item.MessageType = Grid.Items[Index - 1].MessageType) then
+ Item.LinkedToPrev := ((DWord(Item.Time) - PrevTimestamp) < 60);
+ end;
+ if (not FUseHistoryRTLMode) and (Item.RTLMode <> hppRTLEnable) then
+ Item.RTLMode := Items[Index].RTLMode;
+ // tabSRMM still doesn't marks events read in case of hpp log is in use...
+ // if (FGridMode = gmIEView) and
+ if (mtIncoming in Item.MessageType) and (MessageTypesToDWord(Item.MessageType) and
+ MessageTypesToDWord([mtMessage, mtUrl]) > 0) then
+ begin
+ if (not Item.IsRead) then
+ CallService(MS_DB_EVENT_MARKREAD, Items[Index].hContact,
+ Items[Index].hDBEvent);
+ CallService(MS_CLIST_REMOVEEVENT, Items[Index].hContact, Items[Index].hDBEvent);
+ end
+ else if (not Item.IsRead) and (MessageTypesToDWord(Item.MessageType) and
+ MessageTypesToDWord([mtStatus, mtNickChange, mtAvatarChange]) > 0) then
+ begin
+ CallService(MS_DB_EVENT_MARKREAD, Items[Index].hContact, Items[Index].hDBEvent);
+ end;
+end;
+
+procedure TExternalGrid.GridTranslateTime(Sender: TObject; Time: DWord; var Text: String);
+begin
+ Text := TimestampToString(Time);
+end;
+
+procedure TExternalGrid.GridNameData(Sender: TObject; Index: Integer; var Name: String);
+begin
+ if Name = '' then
+ begin
+ if Grid.Protocol = '' then
+ begin
+ if Items[Index].hContact = 0 then
+ begin
+ Grid.Protocol := 'ICQ';
+ FSubProtocol := Grid.Protocol;
+ end
+ else
+ Grid.Protocol := GetContactProto(Items[Index].hContact, FSubContact, FSubProtocol);
+ end;
+ if Items[Index].Custom then
+ Name := Items[Index].CustomEvent.Nick
+ else if mtIncoming in Grid.Items[Index].MessageType then
+ begin
+ Grid.ContactName := GetContactDisplayName(Items[Index].hContact, Grid.Protocol, True);
+ Name := Grid.ContactName;
+ end
+ else
+ begin
+ Grid.ProfileName := GetContactDisplayName(0, FSubProtocol);
+ Name := Grid.ProfileName;
+ end;
+ end;
+end;
+
+procedure TExternalGrid.GridProcessRichText(Sender: TObject; Handle: THandle; Item: Integer);
+var
+ ItemRenderDetails: TItemRenderDetails;
+begin
+ ZeroMemory(@ItemRenderDetails, SizeOf(ItemRenderDetails));
+ ItemRenderDetails.cbSize := SizeOf(ItemRenderDetails);
+ // use meta's subcontact info, if available
+ // ItemRenderDetails.hContact := Items[Item].hContact;
+ ItemRenderDetails.hContact := FSubContact;
+ ItemRenderDetails.hDBEvent := Items[Item].hDBEvent;
+ // use meta's subcontact info, if available
+ // ItemRenderDetails.pProto := PAnsiChar(Grid.Items[Item].Proto);
+ ItemRenderDetails.pProto := PAnsiChar(FSubProtocol);
+ ItemRenderDetails.pModule := PAnsiChar(Grid.Items[Item].Module);
+ ItemRenderDetails.pText := nil;
+ ItemRenderDetails.pExtended := PAnsiChar(Grid.Items[Item].Extended);
+ ItemRenderDetails.dwEventTime := Grid.Items[Item].Time;
+ ItemRenderDetails.wEventType := Grid.Items[Item].EventType;
+ ItemRenderDetails.IsEventSent := (mtOutgoing in Grid.Items[Item].MessageType);
+
+ if Handle = Grid.InlineRichEdit.Handle then
+ ItemRenderDetails.dwFlags := ItemRenderDetails.dwFlags or IRDF_INLINE;
+ if Grid.IsSelected(Item) then
+ ItemRenderDetails.dwFlags := ItemRenderDetails.dwFlags or IRDF_SELECTED;
+ ItemRenderDetails.bHistoryWindow := IRDHW_EXTERNALGRID;
+ NotifyEventHooks(hHppRichEditItemProcess, WParam(Handle), LParam(@ItemRenderDetails));
+end;
+
+procedure TExternalGrid.ScrollToBottom;
+begin
+ if Grid.State <> gsInline then
+ begin
+ Grid.ScrollToBottom;
+ Grid.Invalidate;
+ end;
+end;
+
+procedure TExternalGrid.SetPosition(x, y, cx, cy: Integer);
+begin
+ Grid.Left := x;
+ Grid.Top := y;
+ Grid.Width := cx;
+ Grid.Height := cy;
+ if Grid.HandleAllocated then
+ SetWindowPos(Grid.Handle, 0, x, y, cx, cy, SWP_SHOWWINDOW);
+end;
+
+function TExternalGrid.GetSelection(NoUnicode: Boolean): PAnsiChar;
+var
+ TextW: String;
+ TextA: AnsiString;
+ Source: Pointer;
+ Size: Integer;
+begin
+ TextW := Grid.SelectionString;
+ if Length(TextW) > 0 then
+ begin
+ TextW := TextW + #0;
+ if NoUnicode then
+ begin
+ TextA := WideToAnsiString(TextW, CP_ACP);
+ Source := @TextA[1];
+ Size := Length(TextA);
+ end
+ else
+ begin
+ Source := @TextW[1];
+ Size := Length(TextW) * SizeOf(Char);
+ end;
+ ReallocMem(FSelection, Size);
+ Move(Source^, FSelection^, Size);
+ Result := FSelection;
+ end
+ else
+ Result := nil;
+end;
+
+procedure TExternalGrid.Clear;
+begin
+ Finalize(Items);
+ Grid.Allocate(0);
+ // Grid.Repaint;
+end;
+
+procedure TExternalGrid.GridUrlClick(Sender: TObject; Item: Integer; URLText: String; Button: TMouseButton);
+begin
+ if URLText = '' then
+ exit;
+ if (Button = mbLeft) or (Button = mbMiddle) then
+ OpenUrl(URLText, True)
+ else if Button = mbRight then
+ begin
+ SavedLinkUrl := URLText;
+ pmLink.Popup(Mouse.CursorPos.x, Mouse.CursorPos.y);
+ end;
+end;
+
+procedure TExternalGrid.GridBookmarkClick(Sender: TObject; Item: Integer);
+var
+ val: Boolean;
+ hContact, hDBEvent: THandle;
+begin
+ if Items[Item].Custom then
+ exit;
+ hContact := Items[Item].hContact;
+ hDBEvent := Items[Item].hDBEvent;
+ val := not BookmarkServer[hContact].Bookmarked[hDBEvent];
+ BookmarkServer[hContact].Bookmarked[hDBEvent] := val;
+end;
+
+procedure TExternalGrid.HMBookmarkChanged(var M: TMessage);
+var
+ i: Integer;
+begin
+ if M.WParam <> Grid.Contact then
+ exit;
+ for i := 0 to Grid.Count - 1 do
+ if Items[i].hDBEvent = THandle(M.LParam) then
+ begin
+ Grid.Bookmarked[i] := BookmarkServer[M.WParam].Bookmarked[M.LParam];
+ Grid.ResetItem(i);
+ Grid.Invalidate;
+ exit;
+ end;
+end;
+
+// procedure TExternalGrid.HMIcons2Changed(var M: TMessage);
+// begin
+// Grid.Repaint;
+// end;
+
+procedure TExternalGrid.GridSelectRequest(Sender: TObject);
+begin
+ if (Grid.Selected <> -1) and Grid.IsVisible(Grid.Selected) then
+ exit;
+ if Grid.Count > 0 then
+ Grid.Selected := Grid.BottomItem;
+end;
+
+procedure TExternalGrid.GridDblClick(Sender: TObject);
+begin
+ if Grid.Selected = -1 then
+ exit;
+ Grid.EditInline(Grid.Selected);
+end;
+
+procedure TExternalGrid.GridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+ if (Shift = [ssCtrl]) and (Key = VK_INSERT) then
+ Key := Ord('C');
+ if IsFormShortCut([pmGrid], Key, Shift) then
+ begin
+ Key := 0;
+ exit;
+ end;
+ WasKeyPressed := (Key in [VK_RETURN, VK_ESCAPE]);
+end;
+
+procedure TExternalGrid.GridKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+ if not WasKeyPressed then
+ exit;
+ WasKeyPressed := False;
+ if (Key = VK_RETURN) and (Shift = []) then
+ begin
+ GridDblClick(Grid);
+ Key := 0;
+ end;
+ if (Key = VK_RETURN) and (Shift = [ssCtrl]) then
+ begin
+ OnOpenClick(Grid);
+ Key := 0;
+ end;
+ if (Key = VK_ESCAPE) and (Shift = []) then
+ begin
+ PostMessage(FParentWindow, WM_CLOSE, 0, 0);
+ Key := 0;
+ end;
+end;
+
+function TExternalGrid.IsFileEvent(Index: Integer): Boolean;
+begin
+ Result := (Index <> -1) and (mtFile in Grid.Items[Index].MessageType);
+ if Result then
+ begin
+ // Auto CP_ACP usage
+ SavedLinkUrl := ExtractFileName(String(Grid.Items[Index].Extended));
+ SavedFileDir := ExtractFileDir(String(Grid.Items[Index].Extended));
+ end;
+end;
+
+procedure TExternalGrid.GridPopup(Sender: TObject);
+var
+ GridSelected: Boolean;
+begin
+ GridSelected := (Grid.Selected <> -1);
+ pmGrid.Items[0].Visible := GridSelected and (Grid.State = gsIdle) and not Items[Grid.Selected].Custom;
+ pmGrid.Items[1].Visible := MeSpeakEnabled;
+ pmGrid.Items[3].Visible := GridSelected;
+ pmGrid.Items[4].Visible := GridSelected;
+ pmGrid.Items[5].Visible := GridSelected and (Grid.State = gsInline);
+ // works even if not in pseudo-edit
+ pmGrid.Items[6].Visible := GridSelected;
+ pmGrid.Items[8].Visible := GridSelected and (Grid.State = gsInline);
+ pmGrid.Items[9].Visible := GridSelected;
+ if GridSelected then
+ begin
+ pmGrid.Items[8].Checked := GridOptions.TextFormatting;
+ if Grid.State = gsInline then
+ pmGrid.Items[3].Enabled := Grid.InlineRichEdit.SelLength > 0
+ else
+ pmGrid.Items[3].Enabled := True;
+ pmGrid.Items[9].Enabled := pmGrid.Items[2].Enabled;
+ end;
+ pmGrid.Items[10].Visible := GridSelected and not Items[Grid.Selected].Custom;
+ pmGrid.Items[11].Visible := GridSelected;
+ if GridSelected then
+ begin
+ if Items[Grid.Selected].Custom then
+ pmGrid.Items[11].Visible := False
+ else if Grid.Items[Grid.Selected].Bookmarked then
+ TMenuItem(pmGrid.Items[11]).Caption := TranslateW('Remove &Bookmark')
+ else
+ TMenuItem(pmGrid.Items[11]).Caption := TranslateW('Set &Bookmark');
+ end;
+ pmGrid.Items[13].Visible := (Grid.SelCount > 1);
+ pmGrid.Items[15].Visible := GridSelected and IsFileEvent(Grid.Selected);
+ if pmGrid.Items[15].Visible then
+ pmGrid.Items[15].Items[1].Visible := (SavedFileDir <> '');
+ pmGrid.Items[16].Visible := (Grid.State = gsIdle);
+ pmGrid.Items[16].Items[0].Checked := not FUseHistoryRTLMode;
+ pmGrid.Items[16].Items[1].Checked := FUseHistoryRTLMode;
+ pmGrid.Items[17].Visible := (Grid.State = gsIdle);
+ pmGrid.Items[17].Items[0].Checked := not FUseHistoryCodepage;
+ pmGrid.Items[17].Items[1].Checked := FUseHistoryCodepage;
+ pmGrid.Items[19].Visible := (Grid.State = gsIdle);
+ pmGrid.Popup(Mouse.CursorPos.x, Mouse.CursorPos.y);
+end;
+
+procedure TExternalGrid.OnCopyClick(Sender: TObject);
+begin
+ if Grid.Selected = -1 then
+ exit;
+ if Grid.State = gsInline then
+ begin
+ if Grid.InlineRichEdit.SelLength = 0 then
+ exit;
+ Grid.InlineRichEdit.CopyToClipboard;
+ end
+ else
+ begin
+ CopyToClip(Grid.FormatSelected(GridOptions.ClipCopyFormat), Grid.Handle,
+ Items[Grid.Selected].Codepage);
+ end;
+end;
+
+procedure TExternalGrid.OnCopyTextClick(Sender: TObject);
+var
+ cr: TCharRange;
+begin
+ if Grid.Selected = -1 then
+ exit;
+ if Grid.State = gsInline then
+ begin
+ Grid.InlineRichEdit.Lines.BeginUpdate;
+ Grid.InlineRichEdit.Perform(EM_EXGETSEL, 0, LParam(@cr));
+ Grid.InlineRichEdit.SelectAll;
+ Grid.InlineRichEdit.CopyToClipboard;
+ Grid.InlineRichEdit.Perform(EM_EXSETSEL, 0, LParam(@cr));
+ Grid.InlineRichEdit.Lines.EndUpdate;
+ end
+ else
+ CopyToClip(Grid.FormatSelected(GridOptions.ClipCopyTextFormat), Grid.Handle,
+ Items[Grid.Selected].Codepage);
+end;
+
+procedure TExternalGrid.OnSelectAllClick(Sender: TObject);
+begin
+ if Grid.State = gsInline then
+ begin
+ if Grid.Selected = -1 then
+ exit;
+ Grid.InlineRichEdit.SelectAll;
+ end
+ else
+ begin
+ Grid.SelectAll;
+ end;
+end;
+
+procedure TExternalGrid.OnDeleteClick(Sender: TObject);
+begin
+ if Grid.SelCount = 0 then
+ exit;
+ if Grid.SelCount > 1 then
+ begin
+ if HppMessageBox(FParentWindow,
+ WideFormat(TranslateW('Do you really want to delete selected items (%.0f)?'),
+ [Grid.SelCount / 1]), TranslateW('Delete Selected'), MB_YESNOCANCEL or MB_DEFBUTTON1 or
+ MB_ICONQUESTION) <> IDYES then
+ exit;
+ end
+ else
+ begin
+ if HppMessageBox(FParentWindow, TranslateW('Do you really want to delete selected item?'),
+ TranslateW('Delete'), MB_YESNOCANCEL or MB_DEFBUTTON1 or MB_ICONQUESTION) <> IDYES then
+ exit;
+ end;
+ SetSafetyMode(False);
+ try
+ FGridState := gsDelete;
+ Grid.DeleteSelected;
+ finally
+ FGridState := gsIdle;
+ SetSafetyMode(True);
+ end;
+end;
+
+procedure TExternalGrid.OnTextFormattingClick(Sender: TObject);
+begin
+ if (Grid.Selected = -1) or (Grid.State <> gsInline) then
+ exit;
+ GridOptions.TextFormatting := not GridOptions.TextFormatting;
+end;
+
+procedure TExternalGrid.OnReplyQuotedClick(Sender: TObject);
+begin
+ if Grid.Selected = -1 then
+ exit;
+ if Grid.State = gsInline then
+ begin
+ if Grid.InlineRichEdit.SelLength = 0 then
+ exit;
+ SendMessageTo(Items[Grid.Selected].hContact,
+ Grid.FormatSelected(GridOptions.ReplyQuotedTextFormat));
+ end
+ else
+ begin
+ // if (hContact = 0) or (hg.SelCount = 0) then exit;
+ SendMessageTo(Items[Grid.Selected].hContact,
+ Grid.FormatSelected(GridOptions.ReplyQuotedFormat));
+ end;
+end;
+
+procedure TExternalGrid.OnBookmarkClick(Sender: TObject);
+var
+ val: Boolean;
+ hContact, hDBEvent: THandle;
+begin
+ if Grid.Selected = -1 then
+ exit;
+ if Items[Grid.Selected].Custom then
+ exit;
+ hContact := Items[Grid.Selected].hContact;
+ hDBEvent := Items[Grid.Selected].hDBEvent;
+ val := not BookmarkServer[hContact].Bookmarked[hDBEvent];
+ BookmarkServer[hContact].Bookmarked[hDBEvent] := val;
+end;
+
+procedure TExternalGrid.OnOpenClick(Sender: TObject);
+var
+ oep: TOpenEventParams;
+begin
+ if Grid.Selected = -1 then
+ exit;
+ if Items[Grid.Selected].Custom then
+ exit;
+ oep.cbSize := SizeOf(oep);
+ oep.hContact := Items[Grid.Selected].hContact;
+ oep.hDBEvent := Items[Grid.Selected].hDBEvent;
+ oep.pPassword := nil;
+ CallService(MS_HPP_OPENHISTORYEVENT, WParam(@oep), 0);
+end;
+
+procedure TExternalGrid.GridInlineKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+ if IsFormShortCut([pmGrid], Key, Shift) then
+ begin
+ Key := 0;
+ exit;
+ end;
+end;
+
+procedure TExternalGrid.OnOpenLinkClick(Sender: TObject);
+begin
+ if SavedLinkUrl = '' then
+ exit;
+ OpenUrl(SavedLinkUrl, False);
+ SavedLinkUrl := '';
+end;
+
+procedure TExternalGrid.GridItemDelete(Sender: TObject; Index: Integer);
+begin
+ if (FGridState = gsDelete) and (Items[Index].hDBEvent <> 0) and (not Items[Index].Custom) then
+ CallService(MS_DB_EVENT_DELETE, Items[Index].hContact, Items[Index].hDBEvent);
+ if Index <> High(Items) then
+ begin
+ Finalize(Items[Index]);
+ Move(Items[Index + 1], Items[Index], (Length(Items) - Index - 1) * SizeOf(Items[0]));
+ ZeroMemory(@Items[High(Items)], SizeOf(Items[0]));
+ // reset has_header and linked_to_pervous_messages fields
+ Grid.ResetItem(Index);
+ end;
+ SetLength(Items, Length(Items) - 1);
+ // Application.ProcessMessages;
+end;
+
+procedure TExternalGrid.OnOpenLinkNWClick(Sender: TObject);
+begin
+ if SavedLinkUrl = '' then
+ exit;
+ OpenUrl(SavedLinkUrl, True);
+ SavedLinkUrl := '';
+end;
+
+procedure TExternalGrid.OnCopyLinkClick(Sender: TObject);
+begin
+ if SavedLinkUrl = '' then
+ exit;
+ CopyToClip(SavedLinkUrl, Grid.Handle, CP_ACP);
+ SavedLinkUrl := '';
+end;
+
+procedure TExternalGrid.OnBidiModeLogClick(Sender: TObject);
+begin
+ UseHistoryRTLMode := False;
+ WriteDBBool(Grid.Contact, Grid.Protocol, 'UseHistoryRTLMode', UseHistoryRTLMode);
+end;
+
+procedure TExternalGrid.OnBidiModeHistoryClick(Sender: TObject);
+begin
+ UseHistoryRTLMode := True;
+ WriteDBBool(Grid.Contact, Grid.Protocol, 'UseHistoryRTLMode', UseHistoryRTLMode);
+end;
+
+procedure TExternalGrid.SetUseHistoryRTLMode(const Value: Boolean);
+begin
+ if FUseHistoryRTLMode = Value then
+ exit;
+ FUseHistoryRTLMode := Value;
+ if FUseHistoryRTLMode then
+ Grid.RTLMode := GetContactRTLModeTRTL(Grid.Contact, Grid.Protocol)
+ else
+ Grid.RTLMode := FExternalRTLMode;
+end;
+
+procedure TExternalGrid.OnCodepageLogClick(Sender: TObject);
+begin
+ UseHistoryCodepage := False;
+ WriteDBBool(Grid.Contact, Grid.Protocol, 'UseHistoryCodepage', UseHistoryCodepage);
+end;
+
+procedure TExternalGrid.OnCodepageHistoryClick(Sender: TObject);
+begin
+ UseHistoryCodepage := True;
+ WriteDBBool(Grid.Contact, Grid.Protocol, 'UseHistoryCodepage', UseHistoryCodepage);
+end;
+
+procedure TExternalGrid.SetUseHistoryCodepage(const Value: Boolean);
+begin
+ if FUseHistoryCodepage = Value then
+ exit;
+ FUseHistoryCodepage := Value;
+ if FUseHistoryCodepage then
+ Grid.Codepage := GetContactCodePage(Grid.Contact, Grid.Protocol)
+ else
+ Grid.Codepage := FExternalCodepage;
+end;
+
+procedure TExternalGrid.SetGroupLinked(const Value: Boolean);
+begin
+ if Grid.GroupLinked = Value then
+ exit;
+ Grid.GroupLinked := Value;
+end;
+
+procedure TExternalGrid.SetShowHeaders(const Value: Boolean);
+begin
+ if Grid.ShowHeaders = Value then
+ exit;
+ Grid.ShowHeaders := Value;
+end;
+
+procedure TExternalGrid.SetShowBookmarks(const Value: Boolean);
+begin
+ if Grid.ShowBookmarks = Value then
+ exit;
+ Grid.ShowBookmarks := Value;
+end;
+
+procedure TExternalGrid.HMEventDeleted(var M: TMessage);
+var
+ i: Integer;
+begin
+ if Grid.State = gsDelete then
+ exit;
+ if Grid.Contact <> M.WParam then
+ exit;
+ for i := 0 to Grid.Count - 1 do
+ begin
+ if (Items[i].hDBEvent = Cardinal(M.LParam)) then
+ begin
+ Grid.Delete(i);
+ exit;
+ end;
+ end;
+end;
+
+procedure TExternalGrid.HMNickChanged(var M: TMessage);
+begin
+ if FSubProtocol = '' then
+ exit;
+ Grid.BeginUpdate;
+ if M.WParam = 0 then
+ Grid.ProfileName := GetContactDisplayName(0, FSubProtocol)
+ else if Grid.Contact = M.WParam then
+ begin
+ Grid.ProfileName := GetContactDisplayName(0, FSubProtocol);
+ Grid.ContactName := GetContactDisplayName(Grid.Contact, Grid.Protocol, True)
+ end;
+ Grid.EndUpdate;
+ Grid.Invalidate;
+end;
+
+procedure TExternalGrid.HMMetaDefaultChanged(var M: TMessage);
+var
+ newSubContact: THandle;
+ newSubProtocol: AnsiString;
+begin
+ if Grid.Contact <> M.WParam then
+ exit;
+ GetContactProto(Grid.Contact, newSubContact, newSubProtocol);
+ if (FSubContact <> newSubContact) or (FSubProtocol <> newSubProtocol) then
+ begin
+ Grid.BeginUpdate;
+ FSubContact := newSubContact;
+ FSubProtocol := newSubProtocol;
+ Grid.ProfileName := GetContactDisplayName(0, FSubProtocol);
+ Grid.ContactName := GetContactDisplayName(Grid.Contact, Grid.Protocol, True);
+ Grid.GridUpdate([guOptions]);
+ Grid.EndUpdate;
+ // Grid.Invalidate;
+ end;
+end;
+
+procedure TExternalGrid.OnSaveSelectedClick(Sender: TObject);
+var
+ t: String;
+ SaveFormat: TSaveFormat;
+begin
+ if Grid.Selected = -1 then
+ exit;
+ RecentFormat := TSaveFormat(GetDBInt(hppDBName, 'ExportFormat', 0));
+ SaveFormat := RecentFormat;
+ if not Assigned(SaveDialog) then
+ begin
+ SaveDialog := TSaveDialog.Create(Grid);
+ SaveDialog.Title := TranslateW('Save History');
+ SaveDialog.Options := [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofShareAware,
+ ofEnableSizing];
+ end;
+ PrepareSaveDialog(SaveDialog, SaveFormat, True);
+ t := TranslateW('Partial History [%s] - [%s]');
+ t := Format(t, [Grid.ProfileName, Grid.ContactName]);
+ t := MakeFileName(t);
+ SaveDialog.FileName := t;
+ if not SaveDialog.Execute then
+ exit;
+ for SaveFormat := High(SaveFormats) downto Low(SaveFormats) do
+ if SaveDialog.FilterIndex = SaveFormats[SaveFormat].Index then
+ break;
+ if SaveFormat <> sfAll then
+ RecentFormat := SaveFormat;
+ Grid.SaveSelected(SaveDialog.Files[0], SaveFormat);
+ WriteDBInt(hppDBName, 'ExportFormat', Integer(RecentFormat));
+end;
+
+procedure TExternalGrid.SaveSelected;
+begin
+ OnSaveSelectedClick(Self);
+end;
+
+procedure TExternalGrid.GridXMLData(Sender: TObject; Index: Integer; var Item: TXMLItem);
+var
+ tmp: AnsiString;
+ dt: TDateTime;
+ mes: String;
+begin
+ dt := TimestampToDateTime(Grid.Items[Index].Time);
+ Item.Time := MakeTextXMLedA(AnsiString(FormatDateTime('hh:mm:ss', dt)));
+ Item.Date := MakeTextXMLedA(AnsiString(FormatDateTime('yyyy-mm-dd', dt)));
+
+ Item.Contact := UTF8Encode(MakeTextXMLedW(Grid.ContactName));
+ if mtIncoming in Grid.Items[Index].MessageType then
+ Item.From := Item.Contact
+ else
+ Item.From := '&ME;';
+
+ Item.EventType := '&' + GetEventRecord(Grid.Items[Index]).XML + ';';
+
+ mes := Grid.Items[Index].Text;
+ if GridOptions.RawRTFEnabled and IsRTF(mes) then
+ begin
+ Grid.ApplyItemToRich(Index);
+ mes := GetRichString(Grid.RichEdit.Handle, False);
+ end;
+ if GridOptions.BBCodesEnabled then
+ mes := DoStripBBCodes(mes);
+ Item.mes := UTF8Encode(MakeTextXMLedW(mes));
+
+ if mtFile in Grid.Items[Index].MessageType then
+ begin
+ tmp := Grid.Items[Index].Extended;
+ if tmp = '' then
+ Item.FileName := '&UNK;'
+ else
+ Item.FileName := UTF8Encode(MakeTextXMLedA(tmp));
+ end
+ else if mtUrl in Grid.Items[Index].MessageType then
+ begin
+ tmp := Grid.Items[Index].Extended;
+ if tmp = '' then
+ Item.Url := '&UNK;'
+ else
+ Item.Url := UTF8Encode(MakeTextXMLedA(tmp));
+ end
+ else if mtAvatarChange in Grid.Items[Index].MessageType then
+ begin
+ tmp := Grid.Items[Index].Extended;
+ if tmp = '' then
+ Item.FileName := '&UNK;'
+ else
+ Item.FileName := UTF8Encode(MakeTextXMLedA(tmp));
+ end;
+
+ { 2.8.2004 OXY: Change protocol guessing order. Now
+ first use protocol name, then, if missing, use module }
+
+ Item.Protocol := Grid.Items[Index].Proto;
+ if Item.Protocol = '' then
+ Item.Protocol := MakeTextXMLedA(Grid.Items[Index].Module);
+ if Item.Protocol = '' then
+ Item.Protocol := '&UNK;';
+
+ if mtIncoming in Grid.Items[Index].MessageType then
+ Item.ID := GetContactID(Grid.Contact, Grid.Protocol, True)
+ else
+ Item.ID := GetContactID(0, Grid.Protocol);
+ if Item.ID = '' then
+ Item.ID := '&UNK;'
+ else
+ Item.ID := MakeTextXMLedA(Item.ID);
+end;
+
+procedure TExternalGrid.GridMCData(Sender: TObject; Index: Integer; var Item: TMCItem; Stage: TSaveStage);
+var
+ DBEventInfo: TDBEventInfo;
+ hDBEvent: THandle;
+ DataOffset: PAnsiChar;
+ TextUTF: AnsiString;
+begin
+ if Stage = ssInit then
+ begin
+ Item.Size := 0;
+ if Items[Index].Custom then
+ begin
+ ZeroMemory(@DBEventInfo, SizeOf(DBEventInfo));
+ DBEventInfo.cbSize := SizeOf(DBEventInfo);
+ DBEventInfo.timestamp := Items[Index].CustomEvent.Time;
+ DBEventInfo.flags := DBEF_READ or DBEF_UTF;
+ if Items[Index].CustomEvent.Sent then
+ DBEventInfo.flags := DBEventInfo.flags or DBEF_SENT;
+ DBEventInfo.EventType := EVENTTYPE_MESSAGE;
+ TextUTF := UTF8Encode(Items[Index].CustomEvent.Text) + #0;
+ DBEventInfo.cbBlob := Length(TextUTF) + 1;
+ DBEventInfo.pBlob := Pointer(PAnsiChar(TextUTF));
+ Item.Size := Cardinal(DBEventInfo.cbSize) + Cardinal(DBEventInfo.cbBlob);
+ end
+ else
+ begin
+ hDBEvent := Items[Index].hDBEvent;
+ if hDBEvent <> 0 then
+ begin
+ DBEventInfo := GetEventInfo(hDBEvent);
+ DBEventInfo.szModule := nil;
+ DBEventInfo.flags := DBEventInfo.flags and not DBEF_FIRST;
+ Item.Size := Cardinal(DBEventInfo.cbSize) + Cardinal(DBEventInfo.cbBlob);
+ end;
+ end;
+ if Item.Size > 0 then
+ begin
+ GetMem(Item.Buffer, Item.Size);
+ DataOffset := PAnsiChar(Item.Buffer) + DBEventInfo.cbSize;
+ Move(DBEventInfo, Item.Buffer^, DBEventInfo.cbSize);
+ Move(DBEventInfo.pBlob^, DataOffset^, DBEventInfo.cbBlob);
+ end;
+ end
+ else if Stage = ssDone then
+ begin
+ if Item.Size > 0 then
+ FreeMem(Item.Buffer, Item.Size);
+ end;
+end;
+
+procedure TExternalGrid.SetEventFilter(FilterIndex: Integer = -1);
+var
+ i, fi: Integer;
+ ShowAllEventsIndex: Integer;
+begin
+ ShowAllEventsIndex := GetShowAllEventsIndex;
+ if FilterIndex = -1 then
+ begin
+ fi := miEventsFilter.Tag + 1;
+ if fi > High(hppEventFilters) then
+ fi := 0;
+ end
+ else
+ begin
+ fi := FilterIndex;
+ if fi > High(hppEventFilters) then
+ fi := ShowAllEventsIndex;
+ end;
+ miEventsFilter.Tag := fi;
+ for i := 0 to miEventsFilter.Count - 1 do
+ miEventsFilter[i].Checked := (miEventsFilter[i].Tag = fi);
+ if fi = ShowAllEventsIndex then
+ Grid.TxtNoSuch := TranslateW('No such items')
+ else
+ Grid.TxtNoSuch := WideFormat(TranslateW('No "%s" items'), [hppEventFilters[fi].Name]);
+ // Grid.ShowHeaders := mtMessage in hppEventFilters[fi].Events;
+ Grid.Filter := hppEventFilters[fi].Events;
+end;
+
+procedure TExternalGrid.HMFiltersChanged(var M: TMessage);
+begin
+ CreateEventsFilterMenu;
+ SetEventFilter(GetShowAllEventsIndex);
+ // WriteDBInt(hppDBName,'RecentLogFilter',miEventsFilter.Tag);
+end;
+
+procedure TExternalGrid.OnEventsFilterItemClick(Sender: TObject);
+begin
+ SetEventFilter(TMenuItem(Sender).Tag);
+ // WriteDBInt(hppDBName,'RecentLogFilter',miEventsFilter.Tag);
+end;
+
+procedure TExternalGrid.CreateEventsFilterMenu;
+var
+ i: Integer;
+ mi: TMenuItem;
+ ShowAllEventsIndex: Integer;
+begin
+ ShowAllEventsIndex := GetShowAllEventsIndex;
+ miEventsFilter.Clear;
+ for i := 0 to Length(hppEventFilters) - 1 do
+ begin
+ mi := TMenuItem.Create(pmGrid);
+ mi.Caption := StringReplace(hppEventFilters[i].Name, '&', '&&', [rfReplaceAll]);
+ mi.GroupIndex := 1;
+ mi.RadioItem := True;
+ mi.Tag := i;
+ mi.OnClick := OnEventsFilterItemClick;
+ if i = ShowAllEventsIndex then
+ mi.Default := True;
+ miEventsFilter.Insert(i, mi);
+ end;
+end;
+
+procedure TExternalGrid.OnOpenFileFolderClick(Sender: TObject);
+begin
+ if SavedFileDir = '' then
+ exit;
+ ShellExecuteW(0, 'open', PWideChar(SavedFileDir), nil, nil, SW_SHOW);
+ SavedFileDir := '';
+end;
+
+procedure TExternalGrid.OnBrowseReceivedFilesClick(Sender: TObject);
+var
+ Path: Array [0 .. MAX_PATH] of AnsiChar;
+begin
+ if Grid.Selected = -1 then
+ exit;
+ CallService(MS_FILE_GETRECEIVEDFILESFOLDER, Items[Grid.Selected].hContact,LParam(@Path));
+ ShellExecuteA(0, 'open', Path, nil, nil, SW_SHOW);
+end;
+
+procedure TExternalGrid.OnSpeakMessage(Sender: TObject);
+var
+ mesW: String;
+ mesA: AnsiString;
+ hContact: THandle;
+begin
+ if not MeSpeakEnabled then
+ exit;
+ if Grid.Selected = -1 then
+ exit;
+ // if Items[Grid.Selected].Custom then exit;
+ hContact := Items[Grid.Selected].hContact;
+ mesW := Grid.Items[Grid.Selected].Text;
+ if GridOptions.BBCodesEnabled then
+ mesW := DoStripBBCodes(mesW);
+ if Boolean(ServiceExists(MS_SPEAK_SAY_W)) then
+ CallService(MS_SPEAK_SAY_W, hContact, LParam(PChar(mesW)))
+ else
+ begin
+ mesA := WideToAnsiString(mesW, Items[Grid.Selected].Codepage);
+ CallService(MS_SPEAK_SAY_A, hContact, LParam(PAnsiChar(mesA)));
+ end;
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/hpp_forms.pas b/plugins/HistoryPlusPlus/hpp_forms.pas new file mode 100644 index 0000000000..12c23c879a --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_forms.pas @@ -0,0 +1,355 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+unit hpp_forms;
+
+interface
+
+uses Windows, Messages, Classes, Graphics,
+ Controls, Forms, Menus, ComCtrls, StdCtrls,
+ Themes;
+
+type
+ THppHintWindow = class(THintWindow{THintWindow})
+ private
+ procedure CMInvalidate(var Message: TMessage); message CM_INVALIDATE;
+ protected
+ procedure NCPaint(DC: HDC); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ end;
+
+procedure NotifyAllForms(Msg:UInt; wParam:WPARAM; lParam: LPARAM);
+procedure BringFormToFront(Form: TForm);
+procedure MakeFontsParent(Control: TControl);
+procedure MakeDoubleBufferedParent(Control: TWinControl);
+
+//procedure AddMenu(M: TMenuItem; FromM,ToM: TPopupMenu; Index: integer);
+procedure AddMenuArray(Menu: TPopupMenu; List: Array of TMenuItem; Index: integer);
+
+procedure TranslateMenu(mi: TMenuItem);
+procedure TranslateToolbar(const tb: TToolBar);
+
+function ShiftStateToKeyData(ShiftState :TShiftState):Longint;
+function IsFormShortCut(List: Array of TComponent; Key: Word; ShiftState: TShiftState): Boolean;
+
+function Utils_RestoreFormPosition(Form: TForm; hContact: THandle; Module,Prefix: AnsiString): Boolean;
+function Utils_SaveFormPosition(Form: TForm; hContact: THandle; Module,Prefix: AnsiString): Boolean;
+
+implementation
+
+uses hpp_global, hpp_services, hpp_opt_dialog, hpp_database, hpp_mescatcher,
+ HistoryForm, GlobalSearch, m_api,
+ {$IFNDEF NO_EXTERNALGRID}hpp_external,{$ENDIF}
+ CustomizeFiltersForm, CustomizeToolbar;
+
+{procedure AddMenu(M: TMenuItem; FromM,ToM: TPopupMenu; Index: integer);
+//var
+// i: integer;
+// mi: TMenuItem;
+begin
+ if ToM.FindItem(M.Handle,fkHandle) = nil then begin
+ if FromM.FindItem(M.Handle,fkHandle) <> nil then
+ FromM.Items.Remove(M);
+ if Index = -1 then ToM.Items.Add(M)
+ else ToM.Items.Insert(Index,M);
+ end;
+end;}
+
+procedure AddMenuArray(Menu: TPopupMenu; List: Array of TMenuItem; Index: integer);
+var
+ i: integer;
+begin
+ for i := 0 to High(List) do
+ begin
+ if List[i].Parent <> nil then
+ begin
+ if List[i].GetParentMenu = Menu then continue;
+ List[i].Parent.Remove(List[i]);
+ end;
+ if Index = -1 then
+ Menu.Items.Add(List[i])
+ else
+ Menu.Items.Insert(Index+i,List[i]);
+ end;
+end;
+
+function IsFormShortCut(List: Array of TComponent; Key: Word; ShiftState: TShiftState): Boolean;
+var
+ i: integer;
+ mes: TWMKey;
+begin
+ Result := False;
+ if Key = 0 then exit;
+ if Key = VK_INSERT then
+ begin
+ if ShiftState = [ssCtrl] then
+ begin
+ Key := Ord('C')
+ end
+ else if ShiftState = [ssShift] then
+ begin
+ Key := Ord('V'); ShiftState := [ssCtrl];
+ end;
+ end;
+ mes.CharCode := Key;
+ mes.KeyData := ShiftStateToKeyData(ShiftState);
+ for i := 0 to High(List) do
+ begin
+ if List[i] is TMenu then
+ begin
+ Result := TMenu(List[i]).IsShortCut(mes);
+ end
+ else if List[i] is TForm then
+ begin
+ Result := (TForm(List[i]).Menu <> nil) and
+ (TForm(List[i]).Menu.WindowHandle <> 0) and
+ (TForm(List[i]).Menu.IsShortCut(mes));
+ end;
+ if Result then break;
+ end;
+end;
+
+function ShiftStateToKeyData(ShiftState :TShiftState):Longint;
+const
+ AltMask = $20000000;
+begin
+ Result := 0;
+ if ssShift in ShiftState then Result := Result or VK_SHIFT;
+ if ssCtrl in ShiftState then Result := Result or VK_CONTROL;
+ if ssAlt in ShiftState then Result := Result or AltMask;
+end;
+
+function Utils_RestoreFormPosition(Form: TForm; hContact: THandle; Module,Prefix: AnsiString): Boolean;
+var
+ w,h,l,t,mon: Integer;
+ maximized: Boolean;
+ deltaW, deltaH: integer;
+begin
+ Result := True;
+ deltaW := Form.Width - Form.ClientWidth;
+ deltaH := Form.Height - Form.ClientHeight;
+ mon := GetDBWord(Module,Prefix+'monitor',Form.Monitor.MonitorNum);
+ if mon >= Screen.MonitorCount then mon := Form.Monitor.MonitorNum;
+ w := GetDBWord(Module,Prefix+'width',Form.ClientWidth) + deltaW;
+ h := GetDBWord(Module,Prefix+'height',Form.ClientHeight) + deltaH;
+ l := GetDBInt(Module,Prefix+'x',Screen.Monitors[mon].Left+((Screen.Monitors[mon].Width-w) div 2));
+ t := GetDBInt(Module,Prefix+'y',Screen.Monitors[mon].Top+((Screen.Monitors[mon].Height-h) div 2));
+ maximized := GetDBBool(Module,Prefix+'maximized',False);
+ // just to be safe, don't let window jump out of the screen
+ // at least 100 px from each side should be visible
+ if l+100 > Screen.DesktopWidth then l := Screen.DesktopWidth-100;
+ if t+100 > Screen.DesktopHeight then t := Screen.DesktopHeight-100;
+ if l+w < 100 then l := 100-w;
+ if t+h < 100 then t := 100-h;
+ Form.SetBounds(l,t,w,h);
+ if maximized then Form.WindowState := wsMaximized;
+end;
+
+function Utils_SaveFormPosition(Form: TForm; hContact: THandle; Module,Prefix: AnsiString): Boolean;
+var
+ w,h,l,t: Integer;
+ wp: TWindowPlacement;
+ maximized: Boolean;
+begin
+ Result := True;
+ maximized := (Form.WindowState = wsMaximized);
+ if maximized then
+ begin
+ wp.length := SizeOf(TWindowPlacement);
+ GetWindowPlacement(Form.Handle,@wp);
+ l := wp.rcNormalPosition.Left;
+ t := wp.rcNormalPosition.Top;
+ w := wp.rcNormalPosition.Right - wp.rcNormalPosition.Left - (Form.Width - Form.ClientWidth);
+ h := wp.rcNormalPosition.Bottom - wp.rcNormalPosition.Top - (Form.Height - Form.ClientHeight);
+ end
+ else
+ begin
+ l := Form.Left;
+ t := Form.Top;
+ w := Form.ClientWidth;
+ h := Form.ClientHeight;
+ end;
+ WriteDBInt(Module,Prefix+'x',l);
+ WriteDBInt(Module,Prefix+'y',t);
+ WriteDBWord(Module,Prefix+'width',w);
+ WriteDBWord(Module,Prefix+'height',h);
+ WriteDBWord(Module,Prefix+'monitor',Form.Monitor.MonitorNum);
+ WriteDBBool(Module,Prefix+'maximized',maximized);
+end;
+
+procedure BringFormToFront(Form: TForm);
+begin
+ if Form.WindowState = wsMaximized then
+ ShowWindow(Form.Handle,SW_SHOWMAXIMIZED)
+ else
+ ShowWindow(Form.Handle,SW_SHOWNORMAL);
+ Form.BringToFront;
+end;
+
+procedure NotifyAllForms(Msg:UInt; wParam:WPARAM; lParam: LPARAM);
+var
+ i: Integer;
+begin
+ if hDlg <> 0 then
+ SendMessage(hDlg,Msg,wParam,lParam);
+
+ // we are going backwards here because history forms way want to
+ // close themselves on the message, so we would have AVs if go from 0 to Count
+
+ {$IFNDEF NO_EXTERNALGRID}
+ ExternalGrids.Perform(Msg,wParam,lParam);
+ {$ENDIF}
+
+ for i := HstWindowList.Count - 1 downto 0 do
+ begin
+ if Assigned(THistoryFrm(HstWindowList[i]).EventDetailForm) then
+ THistoryFrm(HstWindowList[i]).EventDetailForm.Perform(Msg,wParam,lParam);
+ THistoryFrm(HstWindowList[i]).Perform(Msg,wParam,lParam);
+ end;
+
+ if Assigned(fmGlobalSearch) then
+ fmGlobalSearch.Perform(Msg,wParam,lParam);
+
+ if Assigned(fmCustomizeFilters) then
+ fmCustomizeFilters.Perform(Msg,wParam,lParam);
+
+ if Assigned(fmCustomizeToolbar) then
+ fmCustomizeToolbar.Perform(Msg,wParam,lParam);
+end;
+
+// This procedure scans all control children and if they have
+// no ParentFont, sets ParentFont to true but reapplies font styles,
+// so even having parent font and size, controls remain bold or italic
+//
+// Of course it can be done cleaner and for all controls supporting fonts
+// property through TPropertyEditor and GetPropInfo, but then it would
+// need vcl sources to compile, so not a best alternative for open source plugin
+procedure MakeFontsParent(Control: TControl);
+var
+ i: Integer;
+ fs: TFontStyles;
+begin
+ // Set TLabel & TLabel
+ if (Control is TLabel) and (not TLabel(Control).ParentFont) then
+ begin
+ fs := TLabel(Control).Font.Style;
+ TLabel(Control).ParentFont := True;
+ TLabel(Control).Font.Style := fs;
+ end;
+ if (Control is TLabel) and (not TLabel(Control).ParentFont) then
+ begin
+ fs := TLabel(Control).Font.Style;
+ TLabel(Control).ParentFont := True;
+ TLabel(Control).Font.Style := fs;
+ end;
+ // Process children
+ for i := 0 to Control.ComponentCount - 1 do
+ begin
+ if Control.Components[i] is TControl then
+ begin
+ MakeFontsParent(TControl(Control.Components[i]));
+ end;
+ end;
+end;
+
+{ THppHintWindow }
+
+type
+ THackHintWindow = class(TCustomControl)
+ private
+ FActivating: Boolean;
+ end;
+
+constructor THppHintWindow.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ Color := clInfoBk;
+end;
+
+procedure THppHintWindow.CMInvalidate(var Message: TMessage);
+begin
+ if (THackHintWindow(Self).FActivating) and
+ (Application.Handle = 0) and (ParentWindow = 0) then
+ begin
+ ParentWindow := hppMainWindow;
+ ShowWindow(Handle, SW_SHOWNOACTIVATE);
+ end;
+ inherited;
+end;
+
+procedure THppHintWindow.NCPaint(DC: HDC);
+var
+ R: TRect;
+begin
+ R := Rect(0, 0, Width, Height);
+ DrawEdge(DC, R, EDGE_ETCHED, BF_RECT or BF_MONO);
+end;
+
+// This procedure scans all WinControl children and set them the same
+// DoubleBuffered property.
+procedure MakeDoubleBufferedParent(Control: TWinControl);
+var
+ i: Integer;
+ DoubleBuffered: Boolean;
+begin
+ DoubleBuffered := Control.DoubleBuffered;
+ for i := 0 to Control.ComponentCount - 1 do
+ begin
+ if not (Control.Components[i] is TCustomRichEdit) and
+ (Control.Components[i] is TWinControl) then
+ begin
+ TWinControl(Control.Components[i]).DoubleBuffered := DoubleBuffered;
+ MakeDoubleBufferedParent(TWinControl(Control.Components[i]));
+ end;
+ end;
+end;
+
+procedure TranslateMenu(mi: TMenuItem);
+var
+ i: integer;
+begin
+ for i := 0 to mi.Count-1 do
+ if mi.Items[i].Caption <> '-' then
+ begin
+ TMenuItem(mi.Items[i]).Caption := TranslateUnicodeString(mi.Items[i].Caption{TRANSLATE-IGNORE});
+ if mi.Items[i].Count > 0 then TranslateMenu(mi.Items[i]);
+ end;
+end;
+
+procedure TranslateToolbar(const tb: TToolBar);
+var
+ i: integer;
+begin
+ for i := 0 to tb.ButtonCount-1 do
+ if tb.Buttons[i].Style <> tbsSeparator then
+ begin
+ TToolBar(tb.Buttons[i]).Hint := TranslateUnicodeString(tb.Buttons[i].Hint{TRANSLATE-IGNORE});
+ TToolBar(tb.Buttons[i]).Caption := TranslateUnicodeString(tb.Buttons[i].Caption{TRANSLATE-IGNORE});
+ end;
+end;
+
+initialization
+
+ // init ThemeServices before widows open
+ Themes.StyleServices;
+
+end.
diff --git a/plugins/HistoryPlusPlus/hpp_global.pas b/plugins/HistoryPlusPlus/hpp_global.pas new file mode 100644 index 0000000000..a247076bd6 --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_global.pas @@ -0,0 +1,846 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+{-----------------------------------------------------------------------------
+ hpp_global.pas (historypp project)
+
+ Version: 1.5
+ Created: 30.01.2006
+ Author: Oxygen
+
+ [ Description ]
+
+ After some refactoring, caused by dp_events, had to bring
+ THistoryItem record into independant unit, so we don't have
+ silly dependances of HisotoryGrid on dp_events (HistoryGrid
+ doesn't depend on Miranda!) or dp_events on HistoryGrid (such
+ a hog!)
+
+
+ [ History ]
+
+ 1.5 (30.01.2006)
+ First version
+
+ [ Modifications ]
+ none
+
+ [ Known Issues ]
+ none
+
+ Contributors: theMIROn
+-----------------------------------------------------------------------------}
+
+unit hpp_global;
+
+interface
+
+uses
+ Windows,Messages,SysUtils,m_api;
+
+type
+
+ // note: add new message types to the end, or it will mess users' saved filters
+ // don't worry about customization filters dialog, as mtOther will always
+ // be show as the last entry
+ TMessageType = (mtUnknown,
+ mtIncoming, mtOutgoing,
+ mtMessage, mtUrl, mtFile, mtSystem,
+ mtContacts, mtSMS, mtWebPager, mtEmailExpress, mtStatus, mtSMTPSimple,
+ mtOther,
+ mtNickChange,mtAvatarChange,mtWATrack,mtStatusMessage,mtVoiceCall,mtCustom);
+
+ PMessageTypes = ^TMessageTypes;
+ TMessageTypes = set of TMessageType;
+
+ TRTLMode = (hppRTLDefault,hppRTLEnable,hppRTLDisable);
+
+ PHistoryItem = ^THistoryItem;
+ THistoryItem = record
+ Time: DWord;
+ MessageType: TMessageTypes;
+ EventType: Word;
+ Height: Integer;
+ Module: AnsiString;
+ Proto: AnsiString;
+ Text: String;
+ CodePage: Cardinal;
+ RTLMode: TRTLMode;
+ HasHeader: Boolean; // header for sessions
+ LinkedToPrev: Boolean; // for future use to group messages from one contact together
+ Bookmarked: Boolean;
+ IsRead: Boolean;
+ Extended: AnsiString;
+ end;
+
+ TCodePage = record
+ cp: Cardinal;
+ lid: LCID;
+ name: String;
+ end;
+
+ TSaveFormat = (sfAll,sfHTML,sfXML,sfRTF,sfMContacts,sfUnicode,sfText);
+ TSaveFormats = set of TSaveFormat;
+ TSaveStage = (ssInit,ssDone);
+
+ TWideStrArray = array of String;
+ TIntArray = array of Integer;
+
+ TSendMethod = (smSend,smPost);
+
+ TUrlProto = record
+ Proto: PWideChar;
+ Idn: Boolean;
+ end;
+
+const
+ HM_BASE = WM_APP + 10214; // base for all history++ messages
+ HM_HIST_BASE = HM_BASE + 100; // base for contact's history specific messages
+ HM_SRCH_BASE = HM_BASE + 200; // base for global search specific messages
+ HM_SESS_BASE = HM_BASE + 300; // base for session thread specific messages
+ HM_STRD_BASE = HM_BASE + 400; // base for search thread specific messages
+ HM_NOTF_BASE = HM_BASE + 500; // base for plugin-wide notification messages
+ HM_MIEV_BASE = HM_BASE + 600; // base for miranda event messages
+
+ // notification messages:
+ HM_NOTF_ICONSCHANGED = HM_NOTF_BASE + 1; // Skin icons has changed
+ HM_NOTF_ICONS2CHANGED = HM_NOTF_BASE + 2; // IcoLib icons has changed
+ HM_NOTF_FILTERSCHANGED = HM_NOTF_BASE + 3; // Filters has changed
+ HM_NOTF_TOOLBARCHANGED = HM_NOTF_BASE + 4; // Toolbar has changed
+ HM_NOTF_BOOKMARKCHANGED = HM_NOTF_BASE + 5; // Bookmarks has changed
+ HM_NOTF_ACCCHANGED = HM_NOTF_BASE + 6; // Accessability prefs changed (menu toggle)
+ HM_NOTF_NICKCHANGED = HM_NOTF_BASE + 7; // Nick changed
+
+ // miranda events
+ HM_MIEV_EVENTADDED = HM_MIEV_BASE + 1; // ME_DB_EVENT_ADDED
+ HM_MIEV_EVENTDELETED = HM_MIEV_BASE + 2; // ME_DB_EVENT_DELETED
+ HM_MIEV_PRESHUTDOWN = HM_MIEV_BASE + 3; // ME_SYSTEM_PRESHUTDOWN
+ HM_MIEV_CONTACTDELETED = HM_MIEV_BASE + 4; // ME_DB_CONTACT_DELETED
+ HM_MIEV_METADEFCHANGED = HM_MIEV_BASE + 5; // ME_MC_DEFAULTTCHANGED
+
+const
+
+ hppName = 'History++';
+ hppShortName = 'History++ (2in1)';
+ hppShortNameV = hppShortName{$IFDEF ALPHA}+' [alpha '+{$I 'alpha.inc'}+']'{$ENDIF};
+ hppDBName = 'HistoryPlusPlus';
+ hppVerMajor = {MAJOR_VER}1{/MAJOR_VER};
+ hppVerMinor = {MINOR_VER}5{/MINOR_VER};
+ hppVerRelease = {SUB_VER}1{/SUB_VER};
+ hppVerBuild = {BUILD}5{/BUILD};
+ hppVerAlpha = {$IFDEF ALPHA}True{$ELSE}False{$ENDIF};
+ hppVersion = hppVerMajor shl 24 + hppVerMinor shl 16 + hppVerRelease shl 8 + hppVerBuild;
+
+ MIID_HISTORYPP:TGUID = '{B92282AC-686B-4541-A12D-6E9971A253B7}';
+
+ hppDescription = 'Easy, fast and feature complete history viewer.';
+ hppAuthor = 'theMIROn, Art Fedorov';
+ hppAuthorEmail = 'themiron@mail.ru, artemf@mail.ru';
+ hppCopyright = '© 2006-2009 theMIROn, 2003-2006 Art Fedorov. History+ parts © 2001 Christian Kastner';
+
+ hppFLUpdateURL = 'http://addons.miranda-im.org/feed.php?dlfile=2995';
+ hppFLVersionURL = 'http://addons.miranda-im.org/details.php?action=viewfile&id=2995';
+ hppFLVersionPrefix= '<span class="fileNameHeader">'+hppShortName+' ';
+ hppUpdateURL = 'http://themiron.miranda.im/historypp';
+ hppVersionURL = 'http://themiron.miranda.im/version';
+ hppVersionPrefix = hppName+' version ';
+
+ hppHomePageURL = 'http://themiron.miranda.im/';
+ hppChangelogURL = 'http://themiron.miranda.im/changelog';
+
+ hppIPName = 'historypp_icons.dll';
+
+ hppLoadBlock = 4096;
+ hppFirstLoadBlock = 200;
+
+ cpTable: array[0..14] of TCodePage = (
+ (cp: 874; lid: $041E; name: 'Thai'),
+ (cp: 932; lid: $0411; name: 'Japanese'),
+ (cp: 936; lid: $0804; name: 'Simplified Chinese'),
+ (cp: 949; lid: $0412; name: 'Korean'),
+ (cp: 950; lid: $0404; name: 'Traditional Chinese'),
+ (cp: 1250; lid: $0405; name: 'Central European'),
+ (cp: 1251; lid: $0419; name: 'Cyrillic'),
+ (cp: 1252; lid: $0409; name: 'Latin I'),
+ (cp: 1253; lid: $0408; name: 'Greek'),
+ (cp: 1254; lid: $041F; name: 'Turkish'),
+ (cp: 1255; lid: $040D; name: 'Hebrew'),
+ (cp: 1256; lid: $0801; name: 'Arabic'),
+ (cp: 1257; lid: $0425; name: 'Baltic'),
+ (cp: 1258; lid: $042A; name: 'Vietnamese'),
+ (cp: 1361; lid: $0412; name: 'Korean (Johab)'));
+
+const
+
+ HPP_ICON_CONTACTHISTORY = 0;
+ HPP_ICON_GLOBALSEARCH = 1;
+ HPP_ICON_SESS_DIVIDER = 2;
+ HPP_ICON_SESSION = 3;
+ HPP_ICON_SESS_SUMMER = 4;
+ HPP_ICON_SESS_AUTUMN = 5;
+ HPP_ICON_SESS_WINTER = 6;
+ HPP_ICON_SESS_SPRING = 7;
+ HPP_ICON_SESS_YEAR = 8;
+ HPP_ICON_HOTFILTER = 9;
+ HPP_ICON_HOTFILTERWAIT = 10;
+ HPP_ICON_SEARCH_ALLRESULTS = 11;
+ HPP_ICON_TOOL_SAVEALL = 12;
+ HPP_ICON_HOTSEARCH = 13;
+ HPP_ICON_SEARCHUP = 14;
+ HPP_ICON_SEARCHDOWN = 15;
+ HPP_ICON_TOOL_DELETEALL = 16;
+ HPP_ICON_TOOL_DELETE = 17;
+ HPP_ICON_TOOL_SESSIONS = 18;
+ HPP_ICON_TOOL_SAVE = 19;
+ HPP_ICON_TOOL_COPY = 20;
+ HPP_ICON_SEARCH_ENDOFPAGE = 21;
+ HPP_ICON_SEARCH_NOTFOUND = 22;
+ HPP_ICON_HOTFILTERCLEAR = 23;
+ HPP_ICON_SESS_HIDE = 24;
+ HPP_ICON_DROPDOWNARROW = 25;
+ HPP_ICON_CONTACDETAILS = 26;
+ HPP_ICON_CONTACTMENU = 27;
+ HPP_ICON_BOOKMARK = 28;
+ HPP_ICON_BOOKMARK_ON = 29;
+ HPP_ICON_BOOKMARK_OFF = 30;
+ HPP_ICON_SEARCHADVANCED = 31;
+ HPP_ICON_SEARCHRANGE = 32;
+ HPP_ICON_SEARCHPROTECTED = 33;
+
+ HPP_ICON_EVENT_INCOMING = 34;
+ HPP_ICON_EVENT_OUTGOING = 35;
+ HPP_ICON_EVENT_SYSTEM = 36;
+ HPP_ICON_EVENT_CONTACTS = 37;
+ HPP_ICON_EVENT_SMS = 38;
+ HPP_ICON_EVENT_WEBPAGER = 39;
+ HPP_ICON_EVENT_EEXPRESS = 40;
+ HPP_ICON_EVENT_STATUS = 41;
+ HPP_ICON_EVENT_SMTPSIMPLE = 42;
+ HPP_ICON_EVENT_NICK = 43;
+ HPP_ICON_EVENT_AVATAR = 44;
+ HPP_ICON_EVENT_WATRACK = 45;
+ HPP_ICON_EVENT_STATUSMES = 46;
+ HPP_ICON_EVENT_VOICECALL = 47;
+
+ HppIconsCount = 48;
+
+ HPP_SKIN_EVENT_MESSAGE = 0;
+ HPP_SKIN_EVENT_URL = 1;
+ HPP_SKIN_EVENT_FILE = 2;
+ HPP_SKIN_OTHER_MIRANDA = 3;
+
+ SkinIconsCount = 4;
+
+const
+ UrlPrefix: array[0..1] of String = (
+ 'www.',
+ 'ftp.');
+ UrlProto: array[0..12] of TUrlProto = (
+ (Proto: 'http:/'; Idn: True;),
+ (Proto: 'ftp:/'; Idn: True;),
+ (Proto: 'file:/'; Idn: False;),
+ (Proto: 'mailto:/'; Idn: False;),
+ (Proto: 'https:/'; Idn: True;),
+ (Proto: 'gopher:/'; Idn: False;),
+ (Proto: 'nntp:/'; Idn: False;),
+ (Proto: 'prospero:/'; Idn: False;),
+ (Proto: 'telnet:/'; Idn: False;),
+ (Proto: 'news:/'; Idn: False;),
+ (Proto: 'wais:/'; Idn: False;),
+ (Proto: 'outlook:/'; Idn: False;),
+ (Proto: 'callto:/'; Idn: False;));
+
+var
+ hppCodepage: Cardinal;
+ hppIconPack: String;
+ hppProfileDir: String;
+ hppPluginsDir: String;
+ hppDllName: String;
+ hppRichEditVersion: Integer;
+
+{$I m_historypp.inc}
+
+function AnsiToWideString(const S: AnsiString; CodePage: Cardinal; InLength: Integer = -1): WideString;
+function WideToAnsiString(const WS: WideString; CodePage: Cardinal; InLength: Integer = -1): AnsiString;
+function TranslateAnsiW(const S: AnsiString{TRANSLATE-IGNORE}): WideString;
+function MakeFileName(FileName: String): String;
+function GetLCIDfromCodepage(Codepage: Cardinal): LCID;
+procedure CopyToClip(const WideStr: WideString; Handle: Hwnd; CodePage: Cardinal = CP_ACP; Clear: Boolean = True);
+
+function QuoteURL(const URLText: WideString): AnsiString;
+function EncodeURL(const Src: String; var Dst: String): Boolean;
+procedure OpenUrl(URLText: String; NewWindow: Boolean);
+
+function HppMessageBox(Handle: THandle; const Text: String; const Caption: String; Flags: Integer): Integer;
+
+function MakeTextXMLedA(Text: AnsiString): AnsiString;
+function MakeTextXMLedW(Text: WideString): WideString;
+function FormatCString(Text: WideString): WideString;
+function PassMessage(Handle: THandle; Message: DWord; wParam: WPARAM; lParam: LPARAM; Method: TSendMethod = smSend): Boolean;
+
+//----- added from TNT ------
+function IsRTF(const Value: WideString): Boolean;
+
+function _WideCharType(WC: WideChar; dwInfoType: Cardinal): Word;
+function IsWideCharUpper(WC: WideChar): Boolean;
+function IsWideCharLower(WC: WideChar): Boolean;
+function IsWideCharDigit(WC: WideChar): Boolean;
+function IsWideCharSpace(WC: WideChar): Boolean;
+function IsWideCharPunct(WC: WideChar): Boolean;
+function IsWideCharCntrl(WC: WideChar): Boolean;
+function IsWideCharBlank(WC: WideChar): Boolean;
+function IsWideCharXDigit(WC: WideChar): Boolean;
+function IsWideCharAlpha(WC: WideChar): Boolean;
+function IsWideCharAlphaNumeric(WC: WideChar): Boolean;
+
+type
+ THppBuffer = class
+ private
+ FBuffer: Pointer;
+ FSize: Integer;
+ FCallCount: Integer;
+ FLock: TRTLCriticalSection;
+ protected
+ procedure Shrink;
+ procedure Clear;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ function Reallocate(NewSize: Integer): Integer;
+ function Allocate(NewSize: Integer): Integer;
+ procedure Lock;
+ procedure Unlock;
+ property Buffer: Pointer read FBuffer;
+ property Size: Integer read FSize;
+ end;
+
+
+implementation
+
+uses hpp_puny;
+
+function QuoteURL(const URLText: WideString): AnsiString;
+var
+ i: Integer;
+ code: Byte;
+ URLTextA: AnsiString;
+begin
+ Result := '';
+ URLTextA := UTF8Encode(URLText);
+ for i := 1 to Length(URLTextA) do
+ begin
+ code := Ord(URLTextA[i]);
+ if (code <= 32) or (code >= 127) then
+ Result := Result + '%' + AnsiString(IntToHex(code, 2))
+ else
+ Result := Result + URLTextA[i];
+ end;
+end;
+
+function EncodeURL(const Src: String; var Dst: String): Boolean;
+var
+ Puny: TPunyClass;
+ Start, ProtoEnd, i: Integer;
+ HostStart, HostEnd: Integer;
+ HostStr, EncodedStr: String;
+begin
+ // [scheme://*][user:password@]host[:port][/path]
+ // [mailto:]userinfo@host
+ // \\host\path
+ Result := False;
+
+ for i := 0 to High(UrlPrefix) do
+ begin
+ HostStart := Pos(UrlPrefix[i], Src);
+ if (HostStart = 1) then
+ break;
+ end;
+ if HostStart = 0 then
+ begin
+ Start := Pos(':/', Src);
+ if Start > 0 then
+ begin
+ ProtoEnd := Start + 2;
+ for i := 0 to High(UrlProto) do
+ begin
+ if not UrlProto[i].idn then
+ continue;
+ Start := Pos(UrlProto[i].Proto, Src);
+ if (Start > 0) and (Start + Length(UrlProto[i].Proto) = ProtoEnd) then
+ begin
+ HostStart := ProtoEnd;
+ break;
+ end;
+ end;
+ end;
+ end;
+ if HostStart = 0 then
+ exit;
+
+ for HostStart := HostStart to Length(Src) do
+ if Src[HostStart] <> '/' then
+ break;
+ for HostEnd := HostStart to Length(Src) do
+ if Src[HostEnd] = '/' then
+ break;
+ for i := HostStart to HostEnd - 1 do
+ if Src[i] = '@' then begin
+ HostStart := i + 1;
+ break;
+ end;
+ for i := HostStart to HostEnd - 1 do
+ if Src[i] = ':' then begin
+ HostEnd := i;
+ break;
+ end;
+
+ Dst := Copy(Src, 1, HostStart - 1);
+
+ Puny := TPunyClass.Create;
+ for i := HostStart to HostEnd do
+ begin
+ if (i < HostEnd) and (Src[i] <> '.') then
+ continue;
+ HostStr := Copy(Src, HostStart, i - HostStart);
+ EncodedStr := Puny.Encode(HostStr);
+ if SameStr(HostStr, EncodedStr) then
+ Dst := Dst + HostStr
+ else
+ Dst := Dst + 'xn--' + EncodedStr;
+ if i < HostEnd then
+ Dst := Dst + '.';
+ HostStart := i + 1;
+ end;
+ Puny.Free;
+
+ Dst := Dst + Copy(Src, HostEnd, Length(Src) - HostEnd + 1);
+ Result := True;
+end;
+
+
+
+function AnsiToWideString(const S: AnsiString; CodePage: Cardinal; InLength: Integer = -1): WideString;
+var
+ InputLength,
+ OutputLength: Integer;
+begin
+ Result := '';
+ if S = '' then
+ exit;
+ if CodePage = CP_UTF8 then
+ begin
+ Result := UTF8ToWideString(S); // CP_UTF8 not supported on Windows 95
+ end
+ else
+ begin
+ if InLength < 0 then
+ InputLength := Length(S)
+ else
+ InputLength := InLength;
+ OutputLength := MultiByteToWideChar(CodePage, 0, PAnsiChar(S), InputLength, nil, 0);
+ SetLength(Result, OutputLength);
+ MultiByteToWideChar(CodePage, MB_PRECOMPOSED, PAnsiChar(S), InputLength, PWideChar(Result),
+ OutputLength);
+ end;
+end;
+
+function WideToAnsiString(const WS: WideString; CodePage: Cardinal; InLength: Integer = -1): AnsiString;
+var
+ InputLength,
+ OutputLength: Integer;
+begin
+ Result := '';
+ if WS = '' then
+ exit;
+ if CodePage = CP_UTF8 then
+ Result := UTF8Encode(WS) // CP_UTF8 not supported on Windows 95
+ else
+ begin
+ if InLength < 0 then
+ InputLength := Length(WS)
+ else
+ InputLength := InLength;
+ OutputLength := WideCharToMultiByte(CodePage, 0, PWideChar(WS), InputLength, nil, 0,
+ nil, nil);
+ SetLength(Result, OutputLength);
+ WideCharToMultiByte(CodePage, 0, PWideChar(WS), InputLength, PAnsiChar(Result),
+ OutputLength, nil, nil);
+ end;
+end;
+
+function TranslateAnsiW(const S: AnsiString{TRANSLATE-IGNORE}): WideString;
+begin
+ Result := AnsiToWideString(Translate(PAnsiChar(S)),hppCodepage{TRANSLATE-IGNORE});
+end;
+
+(*
+This function gets only name of the file
+and tries to make it FAT-happy, so we trim out and
+":"-s, "\"-s and so on...
+*)
+function MakeFileName(FileName: String): String;
+begin
+ Result := FileName;
+ Result :=
+ StringReplace(
+ StringReplace(
+ StringReplace(
+ StringReplace(
+ StringReplace(
+ StringReplace(
+ StringReplace(
+ StringReplace(
+ StringReplace(
+ Result,'|','' ,[rfReplaceAll]),
+ '>','[',[rfReplaceAll]),
+ '<',']',[rfReplaceAll]),
+ '"','''',[rfReplaceAll]),
+ '?','_',[rfReplaceAll]),
+ '*','_',[rfReplaceAll]),
+ '/','_',[rfReplaceAll]),
+ '\','_',[rfReplaceAll]),
+ ':','_',[rfReplaceAll]);
+end;
+
+function GetLCIDfromCodepage(Codepage: Cardinal): LCID;
+var
+ i: integer;
+begin
+ if Codepage = CP_ACP then
+ Codepage := GetACP;
+ for i := 0 to High(cpTable) do
+ if cpTable[i].cp = Codepage then
+ begin
+ Result := cpTable[i].lid;
+ exit;
+ end;
+ for i := 0 to Languages.Count - 1 do
+ if Cardinal(LCIDToCodePage(Languages.LocaleID[i])) = Codepage then
+ begin
+ Result := Languages.LocaleID[i];
+ exit;
+ end;
+ Result := 0;
+end;
+
+function StrAllocW(Size: Cardinal): PWideChar;
+begin
+ Size := SizeOf(WideChar) * Size + SizeOf(Cardinal);
+ GetMem(Result, Size);
+ FillChar(Result^, Size, 0);
+ Cardinal(Pointer(Result)^) := Size;
+ Inc(Result, SizeOf(Cardinal) div SizeOf(WideChar));
+end;
+
+procedure StrDisposeW(Str: PWideChar);
+begin
+ if Str <> nil then
+ begin
+ Dec(Str, SizeOf(Cardinal) div SizeOf(WideChar));
+ FreeMem(Str, Cardinal(Pointer(Str)^));
+ end;
+end;
+
+procedure CopyToClip(const WideStr: WideString; Handle: Hwnd; CodePage: Cardinal = CP_ACP; Clear: Boolean = True);
+var
+ WData, AData, LData: THandle;
+ LDataPtr: PCardinal;
+ WDataPtr: PWideChar;
+ ADataPtr: PAnsiChar;
+ ASize,WSize: Integer;
+ AnsiStr: AnsiString;
+begin
+ WSize := (Length(WideStr)+1)*SizeOf(WideChar);
+ if WSize = SizeOf(WideChar) then exit;
+ AnsiStr := WideToAnsiString(WideStr,CodePage);
+ ASize := Length(AnsiStr)+1;
+ OpenClipboard(Handle);
+ try
+ if Clear then EmptyClipboard;
+ WData := GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE, WSize);
+ AData := GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE, ASize);
+ LData := GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE, SizeOf(Cardinal));
+ try
+ WDataPtr := GlobalLock(WData);
+ ADataPtr := GlobalLock(AData);
+ LDataPtr := GlobalLock(LData);
+ try
+ Move(WideStr[1],WDataPtr^,WSize);
+ Move(AnsiStr[1],ADataPtr^,ASize);
+ LDataPtr^ := GetLCIDfromCodepage(CodePage);
+ SetClipboardData(CF_UNICODETEXT, WData);
+ SetClipboardData(CF_TEXT, AData);
+ SetClipboardData(CF_LOCALE, LData);
+ finally
+ GlobalUnlock(WData);
+ GlobalUnlock(AData);
+ GlobalUnlock(LData);
+ end;
+ except
+ GlobalFree(WData);
+ GlobalFree(AData);
+ GlobalFree(LData);
+ raise;
+ end;
+ finally
+ CloseClipBoard;
+ end;
+end;
+
+procedure OpenUrl(URLText: String; NewWindow: Boolean);
+var
+ URLTextW: String;
+ URLTextA: AnsiString;
+begin
+{
+ if EncodeURL(URLText, URLTextW) then
+ begin
+ URLTextA := WideToAnsiString(URLTextW, CP_ACP);
+ if not SameStr(URLTextW, AnsiToWideString(URLTextA, CP_ACP)) then
+ URLTextA := QuoteURL(URLTextW);
+ end
+ else
+ URLTextA := WideToAnsiString(URLText, CP_ACP);
+ CallService(MS_UTILS_OPENURL,WPARAM(NewWindow),LPARAM(@URLTextA[1]));
+}
+ if EncodeURL(URLText, URLTextW) then
+ begin
+ URLTextA := AnsiString(URLTextW);
+ if not SameStr(URLTextW, String(URLTextA)) then
+ URLTextA := QuoteURL(URLTextW);
+ end
+ else
+ URLTextA := AnsiString(URLText);
+ CallService(MS_UTILS_OPENURL,WPARAM(NewWindow),LPARAM(@URLTextA[1]));
+end;
+
+function HppMessageBox(Handle: THandle; const Text: String; const Caption: String; Flags: Integer): Integer;
+begin
+ Result := MessageBox(Handle,PChar(Text),PChar(Caption),Flags);
+end;
+
+function MakeTextXMLedA(Text: AnsiString): AnsiString;
+begin;
+ Result := Text;
+ Result := AnsiString(
+ StringReplace(
+ StringReplace(
+ StringReplace(
+ StringReplace(
+ StringReplace(
+ string(Result),'‘',''',[rfReplaceAll]),
+ '“','"',[rfReplaceAll]),
+ '<','<',[rfReplaceAll]),
+ '>','>',[rfReplaceAll]),
+ '&','&',[rfReplaceAll]));
+end;
+
+function MakeTextXMLedW(Text: WideString): WideString;
+begin;
+ Result := Text;
+ Result := StringReplace(Result,'&','&',[rfReplaceAll]);
+ Result := StringReplace(Result,'>','>',[rfReplaceAll]);
+ Result := StringReplace(Result,'<','<',[rfReplaceAll]);
+ Result := StringReplace(Result,'“','"',[rfReplaceAll]);
+ Result := StringReplace(Result,'‘',''',[rfReplaceAll]);
+end;
+
+function FormatCString(Text: WideString): WideString;
+var
+ inlen,inpos,outpos: integer;
+begin
+ inlen := Length(Text);
+ SetLength(Result,inlen);
+ if inlen = 0 then exit;
+ inpos := 1;
+ outpos := 0;
+ while inpos <= inlen do begin
+ inc(outpos);
+ if (Text[inpos] = '\') and (inpos < inlen) then begin
+ case Text[inpos+1] of
+ 'r': begin Result[outpos] := #13; inc(inpos); end;
+ 'n': begin Result[outpos] := #10; inc(inpos); end;
+ 't': begin Result[outpos] := #09; inc(inpos); end;
+ '\': begin Result[outpos] := '\'; inc(inpos); end;
+ else Result[outpos] := Text[inpos];
+ end;
+ end else
+ Result[outpos] := Text[inpos];
+ inc(inpos);
+ end;
+ SetLength(Result,outpos);
+end;
+
+function PassMessage(Handle: THandle; Message: DWord; wParam: WPARAM; lParam: LPARAM; Method: TSendMethod = smSend): Boolean;
+var
+ Tries: integer;
+begin
+ Result := True;
+ case Method of
+ smSend: SendMessage(Handle,Message,wParam,lParam);
+ smPost: begin
+ Tries := 5;
+ while (Tries > 0) and not PostMessage(Handle,Message,wParam,lParam) do
+ begin
+ Dec(Tries);
+ Sleep(5);
+ end;
+ Result := (Tries > 0);
+ end;
+ end;
+end;
+
+function IsRTF(const Value: WideString): Boolean;
+const
+ RTF_BEGIN_1 = WideString('{\RTF');
+ RTF_BEGIN_2 = WideString('{URTF');
+begin
+ Result := (Pos(RTF_BEGIN_1, Value) = 1)
+ or (Pos(RTF_BEGIN_2, Value) = 1);
+end;
+
+function _WideCharType(WC: WideChar; dwInfoType: Cardinal): Word;
+begin
+ Win32Check(GetStringTypeExW(GetThreadLocale, dwInfoType, PWideChar(@WC), 1, Result))
+end;
+
+function IsWideCharUpper(WC: WideChar): Boolean;
+begin
+ Result := (_WideCharType(WC, CT_CTYPE1) and C1_UPPER) <> 0;
+end;
+
+function IsWideCharLower(WC: WideChar): Boolean;
+begin
+ Result := (_WideCharType(WC, CT_CTYPE1) and C1_LOWER) <> 0;
+end;
+
+function IsWideCharDigit(WC: WideChar): Boolean;
+begin
+ Result := (_WideCharType(WC, CT_CTYPE1) and C1_DIGIT) <> 0;
+end;
+
+function IsWideCharSpace(WC: WideChar): Boolean;
+begin
+ Result := (_WideCharType(WC, CT_CTYPE1) and C1_SPACE) <> 0;
+end;
+
+function IsWideCharPunct(WC: WideChar): Boolean;
+begin
+ Result := (_WideCharType(WC, CT_CTYPE1) and C1_PUNCT) <> 0;
+end;
+
+function IsWideCharCntrl(WC: WideChar): Boolean;
+begin
+ Result := (_WideCharType(WC, CT_CTYPE1) and C1_CNTRL) <> 0;
+end;
+
+function IsWideCharBlank(WC: WideChar): Boolean;
+begin
+ Result := (_WideCharType(WC, CT_CTYPE1) and C1_BLANK) <> 0;
+end;
+
+function IsWideCharXDigit(WC: WideChar): Boolean;
+begin
+ Result := (_WideCharType(WC, CT_CTYPE1) and C1_XDIGIT) <> 0;
+end;
+
+function IsWideCharAlpha(WC: WideChar): Boolean;
+begin
+ Result := (_WideCharType(WC, CT_CTYPE1) and C1_ALPHA) <> 0;
+end;
+
+function IsWideCharAlphaNumeric(WC: WideChar): Boolean;
+begin
+ Result := (_WideCharType(WC, CT_CTYPE1) and (C1_ALPHA + C1_DIGIT)) <> 0;
+end;
+
+{ THppBuffer }
+
+const
+ SHRINK_ON_CALL = 50;
+ SHRINK_TO_LEN = 512;
+
+constructor THppBuffer.Create;
+begin
+ inherited;
+ FBuffer := nil;
+ FSize := 0;
+ FCallCount := SHRINK_ON_CALL+1;
+ InitializeCriticalSection(FLock);
+ Shrink;
+end;
+
+destructor THppBuffer.Destroy;
+begin
+ Clear;
+ DeleteCriticalSection(FLock);
+ inherited;
+end;
+
+function THppBuffer.Reallocate(NewSize: Integer): Integer;
+begin
+ if NewSize > FSize then
+ begin
+ FSize := ((NewSize shr 4) + 1) shl 4;
+ ReallocMem(FBuffer, FSize);
+ end;
+ Result := FSize;
+end;
+
+function THppBuffer.Allocate(NewSize: Integer): Integer;
+begin
+ Shrink;
+ Result := Reallocate(NewSize);
+end;
+
+procedure THppBuffer.Shrink;
+begin
+ // shrink buffer on every SHRINK_ON_CALL event,
+ // so it's not growing to infinity
+ if (FSize > SHRINK_TO_LEN) and (FCallCount >= SHRINK_ON_CALL) then
+ begin
+ FSize := SHRINK_TO_LEN;
+ ReallocMem(FBuffer, FSize);
+ FCallCount := 0;
+ end
+ else
+ Inc(FCallCount);
+end;
+
+procedure THppBuffer.Clear;
+begin
+ FreeMem(FBuffer,FSize);
+ FBuffer := nil;
+ FSize := 0;
+ FCallCount := 0;
+end;
+
+procedure THppBuffer.Lock;
+begin
+ EnterCriticalSection(FLock);
+end;
+
+procedure THppBuffer.Unlock;
+begin
+ LeaveCriticalSection(FLock);
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/hpp_itemprocess.pas b/plugins/HistoryPlusPlus/hpp_itemprocess.pas new file mode 100644 index 0000000000..392aa195b5 --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_itemprocess.pas @@ -0,0 +1,558 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+{-----------------------------------------------------------------------------
+ hpp_itemprocess (historypp project)
+
+ Version: 1.5
+ Created: 05.08.2004
+ Author: Oxygen
+
+ [ Description ]
+
+ Module for people to help get aquanted with ME_HPP_RICHEDIT_ITEMPROCESS
+ Has samples for SmileyAdd, TextFormat, Math Module and new procedure
+ called SeparateDialogs. It makes message black if previous was hour ago,
+ kinda of conversation separation
+
+ [ History ]
+
+ 1.5 (05.08.2004)
+ First version
+
+ [ Modifications ]
+ none
+
+ [ Known Issues ]
+ none
+
+ Contributors: theMIROn, Art Fedorov
+-----------------------------------------------------------------------------}
+
+{.$DEFINE USE_URL_BBCODE}
+
+unit hpp_itemprocess;
+
+interface
+
+uses
+ Windows;
+
+var
+ rtf_ctable_text: AnsiString;
+
+function DoSupportBBCodesHTML(S: AnsiString): AnsiString;
+function DoSupportBBCodesRTF(S: AnsiString; StartColor: integer; doColorBBCodes: boolean): AnsiString;
+function DoStripBBCodes(S: String): String;
+
+function DoSupportSmileys(awParam:WPARAM; alParam: LPARAM): Integer;
+function DoSupportMathModule(awParam:WPARAM; alParam: LPARAM): Integer;
+function DoSupportAvatarHistory(awParam:WPARAM; alParam: LPARAM): Integer;
+
+implementation
+
+uses
+ Messages,
+ SysUtils, StrUtils,
+ m_api,
+ hpp_global, hpp_richedit, hpp_events{, RichEdit -- used for CHARRANGE and EM_EXTSETSEL};
+
+{$include inc\m_mathmodule.inc}
+
+const
+ EM_EXSETSEL = WM_USER + 55; // from RichEdit
+
+type
+
+ TRTFColorTable = record
+ sz: PAnsiChar;
+ col: COLORREF;
+ end;
+
+ TBBCodeClass = (bbStart,bbEnd);
+ TBBCodeType = (bbSimple, bbColor, bbSize, bbUrl, bbImage);
+
+ TBBCodeString = record
+ ansi: PAnsiChar;
+ wide: String;
+ end;
+
+ TBBCodeInfo = record
+ prefix: TBBCodeString;
+ suffix: TBBCodeString;
+ bbtype: TBBCodeType;
+ rtf: PAnsiChar;
+ html: PAnsiChar;
+ minRE: Integer;
+ end;
+
+const
+ rtf_ctable: array[0..7] of TRTFColorTable = (
+ // BBGGRR
+ (sz:'black'; col:$000000),
+ (sz:'blue'; col:$FF0000),
+ (sz:'green'; col:$00FF00),
+ (sz:'red'; col:$0000FF),
+ (sz:'magenta';col:$FF00FF),
+ (sz:'cyan'; col:$FFFF00),
+ (sz:'yellow'; col:$00FFFF),
+ (sz:'white'; col:$FFFFFF));
+
+const
+ bbCodesCount = {$IFDEF USE_URL_BBCODE}7{$ELSE}6{$ENDIF};
+
+var
+ bbCodes: array[0..bbCodesCount,bbStart..bbEnd] of TBBCodeInfo = (
+ ((prefix:(ansi:'[b]'); suffix:(ansi:nil); bbtype:bbSimple; rtf:'{\b '; html:'<b>'; minRE: 10),
+ (prefix:(ansi:'[/b]'); suffix:(ansi:nil); bbtype:bbSimple; rtf:'}'; html:'</b>')),
+ ((prefix:(ansi:'[i]'); suffix:(ansi:nil); bbtype:bbSimple; rtf:'{\i '; html:'<i>'; minRE: 10),
+ (prefix:(ansi:'[/i]'); suffix:(ansi:nil); bbtype:bbSimple; rtf:'}'; html:'</i>')),
+ ((prefix:(ansi:'[u]'); suffix:(ansi:nil); bbtype:bbSimple; rtf:'{\ul '; html:'<u>'; minRE: 10),
+ (prefix:(ansi:'[/u]'); suffix:(ansi:nil); bbtype:bbSimple; rtf:'}'; html:'</u>')),
+ ((prefix:(ansi:'[s]'); suffix:(ansi:nil); bbtype:bbSimple; rtf:'{\strike '; html:'<s>'; minRE: 10),
+ (prefix:(ansi:'[/s]'); suffix:(ansi:nil); bbtype:bbSimple; rtf:'}'; html:'</s>')),
+ ((prefix:(ansi:'[color='); suffix:(ansi:']'); bbtype:bbColor; rtf:'{\cf%u '; html:'<font style="color:%s">'; minRE: 10),
+ (prefix:(ansi:'[/color]'); suffix:(ansi:nil); bbtype:bbSimple; rtf:'}'; html:'</font>')),
+ {$IFDEF USE_URL_BBCODE}
+ ((prefix:(ansi:'[url='); suffix:(ansi:']'); bbtype:bbUrl; rtf:'{\field{\*\fldinst{HYPERLINK ":%s"}}{\fldrslt{\ul\cf%u'; html:'<a href="%s">'; minRE: 41),
+ (prefix:(ansi:'[/url]'); suffix:(ansi:nil); bbtype:bbSimple; rtf:'}}}'; html:'</a>')),
+ {$ENDIF}
+ ((prefix:(ansi:'[size='); suffix:(ansi:']'); bbtype:bbSize; rtf:'{\fs%u '; html:'<font style="font-size:%spt">'; minRE: 10),
+ (prefix:(ansi:'[/size]'); suffix:(ansi:nil); bbtype:bbSimple; rtf:'}'; html:'</font>')),
+ ((prefix:(ansi:'[img]'); suffix:(ansi:nil); bbtype:bbImage; rtf:'[{\revised\ul\cf%u '; html:'['; minRE: 20),
+ (prefix:(ansi:'[/img]'); suffix:(ansi:nil); bbtype:bbSimple; rtf:'}]'; html:']'))
+ );
+
+const
+ MAX_FMTBUF = 4095;
+
+var
+ i: integer;
+ TextBuffer: THppBuffer;
+
+function GetColorRTF(code: AnsiString; colcount: integer): integer;
+var
+ i: integer;
+begin
+ Result := 0;
+ if colcount >= 0 then
+ for i := 0 to High(rtf_ctable) do
+ if rtf_ctable[i].sz = code then
+ begin
+ Result := colcount + i;
+ break;
+ end;
+end;
+
+function StrReplace(strStart, str, strEnd: PAnsiChar; var strTrail: PAnsiChar): PAnsiChar;
+var
+ len,delta: integer;
+ tmpStartPos,tmpEndPos,tmpTrailPos: Integer;
+ tmpStart,tmpEnd,tmpTrail: PAnsiChar;
+begin
+ if str = nil then
+ len := 0
+ else
+ len := StrLen(str);
+ delta := len - (strTrail - strStart);
+ tmpStartPos := strStart - TextBuffer.Buffer;
+ tmpTrailPos := strTrail - TextBuffer.Buffer;
+ tmpEndPos := strEnd - TextBuffer.Buffer;
+ TextBuffer.Reallocate(tmpEndPos + delta + 1);
+ tmpStart := PAnsiChar(TextBuffer.Buffer) + tmpStartPos;
+ tmpTrail := PAnsiChar(TextBuffer.Buffer) + tmpTrailPos;
+ tmpEnd := PAnsiChar(TextBuffer.Buffer) + tmpEndPos;
+ strTrail := tmpTrail + delta;
+ StrMove(strTrail, tmpTrail, tmpEnd - tmpTrail + 1);
+ if len > 0 then
+ StrMove(tmpStart, str, len);
+ Result := tmpEnd + delta;
+end;
+
+function StrAppend(str, strEnd: PAnsiChar): PAnsiChar;
+var
+ len: integer;
+ tmpEndPos: integer;
+ tmpEnd: PAnsiChar;
+begin
+ if str = nil then
+ begin
+ Result := strEnd;
+ exit;
+ end;
+ len := StrLen(str);
+ tmpEndPos := strEnd - TextBuffer.Buffer;
+ TextBuffer.Reallocate(tmpEndPos + len + 1);
+ tmpEnd := PAnsiChar(TextBuffer.Buffer) + tmpEndPos;
+ StrMove(tmpEnd, str, len + 1);
+ Result := tmpEnd + len;
+end;
+
+function StrSearch(str,prefix,suffix: PAnsiChar; var strStart,strEnd,strCode: PAnsiChar; var lenCode: integer): Boolean;
+begin
+ Result := false;
+ strStart := StrPos(str, prefix);
+ if strStart = nil then
+ exit;
+ strCode := strStart + StrLen(prefix);
+ if suffix = nil then
+ begin
+ lenCode := 0;
+ strEnd := strCode
+ end
+ else
+ begin
+ strEnd := StrPos(strCode, suffix);
+ if strEnd = nil then
+ exit;
+ lenCode := strEnd - strCode;
+ strEnd := strEnd + StrLen(suffix);
+ end;
+ Result := true;
+end;
+
+(* commented out fo future use
+function ParseLinksInRTF(S: AnsiString): AnsiString;
+const
+ urlStopChars = [' ','{','}','\','[',']'];
+ url41fmt = '{\field{\*\fldinst{HYPERLINK "%s"}}{\fldrslt{{\v #}\ul\cf1 %0:s}}}';
+var
+ bufPos,bufEnd: PAnsiChar;
+ urlStart,urlEnd: PAnsiChar;
+ newCode: PAnsiChar;
+ fmt_buffer: array[0..MAX_FMTBUF] of AnsiChar;
+ code: AnsiString;
+begin
+ ShrinkTextBuffer;
+ AllocateTextBuffer(Length(S)+1);
+ bufEnd := StrECopy(buffer,PAnsiChar(S));
+ bufPos := StrPos(buffer,'://');
+ while Assigned(bufPos) do begin
+ urlStart := bufPos;
+ urlEnd := bufPos+3;
+ while urlStart > buffer do begin
+ Dec(urlStart);
+ if urlStart[0] in urlStopChars then begin
+ Inc(urlStart);
+ break;
+ end;
+ end;
+ while urlEnd < bufEnd do begin
+ Inc(UrlEnd);
+ if urlEnd[0] in urlStopChars then break;
+ end;
+ if (urlStart<bufPos) and (urlEnd>bufPos+3) then begin
+ SetString(code,urlStart,urlEnd-urlStart);
+ newCode := StrLFmt(fmt_buffer,MAX_FMTBUF,url41fmt,[code]);
+ bufEnd := StrReplace(urlStart,newCode,bufEnd,urlEnd);
+ bufPos := urlEnd;
+ end;
+ bufPos := StrPos(bufPos,'://');
+ end;
+ SetString(Result,buffer,bufEnd-buffer);
+end;
+*)
+
+function DoSupportBBCodesRTF(S: AnsiString; StartColor: integer; doColorBBCodes: boolean): AnsiString;
+var
+ bufPos,bufEnd: PAnsiChar;
+ strStart,strTrail: PAnsiChar;
+ strCode,newCode: PAnsiChar;
+ i,n,lenCode: Integer;
+ sfound,efound: Boolean;
+ fmt_buffer: array[0..MAX_FMTBUF] of AnsiChar;
+ code: AnsiString;
+begin
+ TextBuffer.Lock;
+ TextBuffer.Allocate(Length(S)+1);
+ bufEnd := StrECopy(TextBuffer.Buffer,PAnsiChar(S));
+ for i := 0 to High(bbCodes) do
+ begin
+ if hppRichEditVersion < bbCodes[i, bbStart].minRE then
+ continue;
+ bufPos := TextBuffer.Buffer;
+ repeat
+ newCode := nil;
+ sfound := StrSearch(TextBuffer.Buffer, bbCodes[i, bbStart].prefix.ansi,
+ bbCodes[i, bbStart].suffix.ansi, strStart, strTrail, strCode, lenCode);
+ if sfound then
+ begin
+ case bbCodes[i, bbStart].bbtype of
+ bbSimple:
+ newCode := bbCodes[i, bbStart].rtf;
+ bbColor:
+ begin
+ if doColorBBCodes then
+ begin
+ SetString(code, strCode, lenCode);
+ n := GetColorRTF(code, StartColor);
+ newCode := StrLFmt(fmt_buffer, MAX_FMTBUF, bbCodes[i, bbStart].rtf, [n]);
+ end;
+ end;
+ bbSize:
+ begin
+ SetString(code, strCode, lenCode);
+ if TryStrToInt(String(code), n) then
+ newCode := StrLFmt(fmt_buffer, MAX_FMTBUF, bbCodes[i, bbStart].rtf, [n shl 1]);
+ end;
+{$IFDEF USE_URL_BBCODE}
+ bbUrl:
+ begin
+ SetString(code, strCode, lenCode);
+ if doColorBBCodes then
+ n := 2
+ else // link color
+ n := 0;
+ newCode := StrLFmt(fmt_buffer, MAX_FMTBUF, bbCodes[i, bbStart].rtf, [PAnsiChar(code), n]);
+ end;
+{$ENDIF}
+ bbImage:
+ begin
+ if doColorBBCodes then
+ n := 2
+ else // link color
+ n := 0;
+ newCode := StrLFmt(fmt_buffer, MAX_FMTBUF, bbCodes[i, bbStart].rtf, [n]);
+ end;
+ end;
+ bufEnd := StrReplace(strStart, newCode, bufEnd, strTrail);
+ bufPos := strTrail;
+ end;
+ repeat
+ efound := StrSearch(bufPos, bbCodes[i, bbEnd].prefix.ansi,
+ bbCodes[i, bbEnd].suffix.ansi, strStart, strTrail, strCode, lenCode);
+ if sfound and (newCode <> nil) then
+ strCode := bbCodes[i, bbEnd].rtf
+ else
+ strCode := nil;
+ if efound then
+ begin
+ bufEnd := StrReplace(strStart, strCode, bufEnd, strTrail);
+ bufPos := strTrail;
+ end
+ else
+ bufEnd := StrAppend(strCode, bufEnd);
+ until sfound or not efound;
+ until not sfound;
+ end;
+ SetString(Result, PAnsiChar(TextBuffer.Buffer), bufEnd - TextBuffer.Buffer);
+ TextBuffer.Unlock;
+end;
+
+function DoSupportBBCodesHTML(S: AnsiString): AnsiString;
+var
+ bufPos,bufEnd: PAnsiChar;
+ strStart,strTrail,strCode: PAnsiChar;
+ i,lenCode: Integer;
+ sfound,efound: Boolean;
+ fmt_buffer: array[0..MAX_FMTBUF] of AnsiChar;
+ code: AnsiString;
+begin
+ TextBuffer.Lock;
+ TextBuffer.Allocate(Length(S) + 1);
+ bufEnd := StrECopy(TextBuffer.Buffer, PAnsiChar(S));
+ for i := 0 to High(bbCodes) do
+ begin
+ bufPos := TextBuffer.Buffer;
+ repeat
+ sfound := StrSearch(TextBuffer.Buffer, bbCodes[i, bbStart].prefix.ansi,
+ bbCodes[i, bbStart].suffix.ansi, strStart, strTrail, strCode, lenCode);
+ if sfound then
+ begin
+ if bbCodes[i, bbStart].bbtype = bbSimple then
+ strCode := bbCodes[i, bbStart].html
+ else
+ begin
+ SetString(code, strCode, lenCode);
+ strCode := StrLFmt(fmt_buffer, MAX_FMTBUF, bbCodes[i, bbStart].html,
+ [PAnsiChar(code)]);
+ end;
+ bufEnd := StrReplace(strStart, strCode, bufEnd, strTrail);
+ bufPos := strTrail;
+ end;
+ repeat
+ efound := StrSearch(bufPos, bbCodes[i, bbEnd].prefix.ansi,
+ bbCodes[i, bbEnd].suffix.ansi, strStart, strTrail, strCode, lenCode);
+ if sfound then
+ strCode := bbCodes[i, bbEnd].html
+ else
+ strCode := nil;
+ if efound then
+ begin
+ bufEnd := StrReplace(strStart, strCode, bufEnd, strTrail);
+ bufPos := strTrail;
+ end
+ else
+ bufEnd := StrAppend(strCode, bufEnd);
+ until sfound or not efound;
+ until not sfound;
+ end;
+ SetString(Result,PAnsiChar(TextBuffer.Buffer),bufEnd-TextBuffer.Buffer);
+ TextBuffer.Unlock;
+end;
+
+function DoStripBBCodes(S: String): String;
+var
+ WideStream: String;
+ i,spos,epos,cpos,slen: integer;
+ trail: String;
+ bbClass: TBBCodeClass;
+begin
+ WideStream := S;
+ for i := 0 to High(bbCodes) do
+ for bbClass := bbStart to bbEnd do
+ begin
+ if bbCodes[i, bbClass].bbtype = bbSimple then
+ WideStream := StringReplace(WideStream, bbCodes[i, bbClass].prefix.wide, '', [rfReplaceAll])
+ else
+ repeat
+ spos := Pos(bbCodes[i, bbClass].prefix.wide, WideStream);
+ epos := 0;
+ if spos > 0 then
+ begin
+ cpos := spos + Length(bbCodes[i, bbClass].prefix.wide);
+ slen := Length(bbCodes[i, bbClass].suffix.wide);
+ if slen = 0 then
+ epos := cpos
+ else
+ epos := PosEx(bbCodes[i, bbClass].suffix.wide, WideStream, cpos);
+ if epos > 0 then
+ begin
+ cpos := epos + slen;
+ trail := Copy(WideStream, cpos, Length(WideStream) - cpos + 1);
+ SetLength(WideStream, spos - 1);
+ WideStream := WideStream + trail;
+ end;
+ end;
+ until (spos = 0) or (epos = 0);
+ end;
+ Result := WideStream;
+end;
+
+function DoSupportSmileys(awParam{hRichEdit}:WPARAM; alParam{PItemRenderDetails}: LPARAM): Integer;
+const
+ mesSent: Array[False..True] of Integer = (0,SAFLRE_OUTGOING);
+var
+ sare: TSMADD_RICHEDIT3;
+ ird: PItemRenderDetails;
+begin
+ ird := Pointer(alParam);
+ sare.cbSize := SizeOf(sare);
+ sare.hwndRichEditControl := awParam;
+ sare.rangeToReplace := nil;
+ sare.ProtocolName := ird^.pProto;
+ //sare.flags := SAFLRE_INSERTEMF + mesSent[ird^.IsEventSent];
+ sare.flags := mesSent[ird^.IsEventSent];
+ sare.disableRedraw := True;
+ sare.hContact := ird^.hContact;
+ CallService(MS_SMILEYADD_REPLACESMILEYS,0,LPARAM(@sare));
+ Result := 0;
+end;
+
+function DoSupportMathModule(awParam{hRichEdit}:WPARAM; alParam{PItemRenderDetails}: LPARAM): Integer;
+var
+ mrei: TMathRicheditInfo;
+begin
+ mrei.hwndRichEditControl := awParam;
+ mrei.sel := nil;
+ mrei.disableredraw := integer(false);
+ Result := CallService(MATH_RTF_REPLACE_FORMULAE,0,LPARAM(@mrei));
+end;
+
+(*
+function DoSupportAvatars(wParam:WPARAM; lParam: LPARAM): Integer;
+const
+ crlf: AnsiString = '{\line }';
+var
+ ird: PItemRenderDetails;
+ ave: PAvatarCacheEntry;
+ msglen: integer;
+begin
+ ird := Pointer(lParam);
+ ave := Pointer(CallService(MS_AV_GETAVATARBITMAP,ird.hContact,0));
+ if (ave <> nil) and (ave.hbmPic <> 0) then begin
+ msglen := SendMessage(wParam,WM_GETTEXTLENGTH,0,0);
+ SendMessage(wParam,EM_SETSEL,msglen,msglen);
+ SetRichRTF(wParam,crlf,True,False,True);
+ InsertBitmapToRichEdit(wParam,ave.hbmPic);
+ end;
+ Result := 0;
+end;
+*)
+
+function DoSupportAvatarHistory(awParam:WPARAM; alParam: LPARAM): int;
+const
+ crlf: AnsiString = '{\rtf1{\line }}';
+var
+ ird: PItemRenderDetails;
+ Link: AnsiString;
+ hBmp: hBitmap;
+ cr: CHARRANGE;
+begin
+ Result := 0;
+ ird := Pointer(alParam);
+ if ird.wEventType <> EVENTTYPE_AVATARCHANGE then
+ exit;
+ if (ird.pExtended = nil) or (lstrlenA(ird.pExtended) < 4) then
+ exit;
+ if ((ird.pExtended[0] = '\') and (ird.pExtended[1] = '\')) or
+ ((ird.pExtended[0] in ['A' .. 'Z', 'a' .. 'z']) and (ird.pExtended[1] = ':') and
+ (ird.pExtended[2] = '\')) then
+ Link := ird.pExtended
+ else
+ Link := AnsiString(hppProfileDir) + '\' + ird.pExtended; //!!
+ hBmp := CallService(MS_UTILS_LOADBITMAP, 0, LPARAM(@Link[1]));
+ if hBmp <> 0 then
+ begin
+ cr.cpMin := SendMessage(awParam, WM_GETTEXTLENGTH, 0, 0);
+ cr.cpMax := cr.cpMin;
+ SendMessage(awParam, EM_EXSETSEL, 0, LPARAM(@cr));
+ SetRichRTF(awParam, crlf, true, false, true);
+ RichEdit_InsertBitmap(awParam, hBmp, Cardinal(-1));
+ end;
+end;
+
+
+initialization
+ rtf_ctable_text := '';
+
+ for i := 0 to High(rtf_ctable) do
+ begin
+ rtf_ctable_text := rtf_ctable_text + AnsiString(format('\red%d\green%d\blue%d;',
+ [rtf_ctable[i].col and $FF,
+ (rtf_ctable[i].col shr 8) and $FF,
+ (rtf_ctable[i].col shr 16) and $FF]));
+ end;
+
+ for i := 0 to High(bbCodes) do
+ begin
+ bbCodes[i, bbStart].prefix.wide := String(bbCodes[i, bbStart].prefix.ansi);
+ bbCodes[i, bbStart].suffix.wide := String(bbCodes[i, bbStart].suffix.ansi);
+ bbCodes[i, bbEnd ].prefix.wide := String(bbCodes[i, bbEnd ].prefix.ansi);
+ bbCodes[i, bbEnd ].suffix.wide := String(bbCodes[i, bbEnd ].suffix.ansi);
+ end;
+
+ TextBuffer := THppBuffer.Create;
+
+finalization
+ TextBuffer.Destroy;
+
+end.
diff --git a/plugins/HistoryPlusPlus/hpp_mescatcher.pas b/plugins/HistoryPlusPlus/hpp_mescatcher.pas new file mode 100644 index 0000000000..bb91be9aa6 --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_mescatcher.pas @@ -0,0 +1,214 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+{-----------------------------------------------------------------------------
+ hpp_mescatcher (historypp project)
+
+ Version: 1.0
+ Created: 09.12.2006
+ Author: theMIROn
+
+ [ Description ]
+
+ Hidden window, used for catching WM messages and hotkeys
+
+ [ History ]
+
+ 1.0 (09.12.2006)
+ First version
+
+ [ Modifications ]
+ none
+
+ [ Known Issues ]
+ none
+
+ Contributors: theMIROn
+-----------------------------------------------------------------------------}
+
+unit hpp_mescatcher;
+
+interface
+
+{$I compilers.inc}
+{.$DEFINE USE_CUSTOMIDLEHOOK}
+
+uses
+ Windows, Messages, Classes, Controls;
+
+const
+ hppWindowClassName = 'History++ MainWindow';
+
+var
+ hppMainWindow: HWND = 0;
+
+procedure hppWakeMainThread(Sender: TObject);
+function hppRegisterMainWindow: Boolean;
+function hppUnregisterMainWindow: Boolean;
+
+implementation
+
+uses Forms, Themes;
+
+{$IFDEF USE_CUSTOMIDLEHOOK}
+type
+ THackApplication = class(TComponent)
+ protected
+ FxxxxxxxxxHandle: HWnd;
+ FxxxxxxxxxBiDiMode: TBiDiMode;
+ FxxxxxxxxxBiDiKeyboard: AnsiString;
+ FxxxxxxxxxNonBiDiKeyboard: AnsiString;
+ FxxxxxxxxxObjectInstance: Pointer;
+ FxxxxxxxxxMainForm: TForm;
+ FMouseControl: TControl;
+ end;
+{$ENDIF}
+
+var
+ SavedWakeMainThread: TNotifyEvent = nil;
+ SavedCheckIniChange: function (var Message: TMessage): Boolean of object = nil;
+ {$IFDEF USE_CUSTOMIDLEHOOK}
+ ForegroundIdleHook: HHOOK;
+ {$ENDIF}
+
+function MainWindowWndProc(hwndDlg: HWND; uMsg: uint; wParam: WPARAM; lParam: LPARAM): lresult; stdcall;
+var
+ Message: TMessage;
+begin
+ Result := 0;
+ if Assigned(SavedCheckIniChange) then
+ begin
+ Message.Msg := uMsg;
+ SavedCheckIniChange(Message);
+ end;
+ case uMsg of
+ //WM_HOTKEY:
+ // place for global hotkeys :)
+ //if wParam = Hotkey then
+ // CallService(MS_HPP_SHOWGLOBALSEARCH,0,0);
+ CM_WINDOWHOOK: begin
+ if (wParam = 0) and not Assigned(SavedCheckIniChange) then
+ SavedCheckIniChange := TWindowHook(Pointer(LParam)^);
+ end;
+ WM_SETTINGCHANGE: begin
+ // workaround to force vcl notice mouse setting changed
+ if wParam = SPI_SETWHEELSCROLLLINES then
+ Mouse.SettingChanged(SPI_GETWHEELSCROLLLINES)
+ else
+ Mouse.SettingChanged(wParam);
+ Result := DefWindowProc(hwndDlg, uMsg, wParam, lParam);
+ end;
+ WM_FONTCHANGE: begin
+ Screen.ResetFonts;
+ Result := DefWindowProc(hwndDlg, uMsg, wParam, lParam);
+ end;
+ WM_THEMECHANGED:
+ StyleServices.ApplyThemeChange;
+ WM_NULL:
+ CheckSynchronize;
+ else
+ Result := DefWindowProc(hwndDlg, uMsg, wParam, lParam);
+ end;
+end;
+
+{$IFDEF USE_CUSTOMIDLEHOOK}
+function IdleHookProc(code: Integer; wParam: WPARAM; lParam: LPARAM): Integer; stdcall;
+var
+ Control: TControl;
+ MouseControl: TControl;
+ CaptureControl: TControl;
+ P: TPoint;
+begin
+ if code < 0 then
+ begin
+ Result := CallNextHookEx(ForegroundIdleHook,code,wParam,lParam);
+ exit;
+ end;
+ GetCursorPos(P);
+ Control := FindDragTarget(P, True);
+ MouseControl := THackApplication(Application).FMouseControl;
+ CaptureControl := GetCaptureControl;
+ if MouseControl <> Control then
+ begin
+ if ((MouseControl <> nil) and (CaptureControl = nil)) or
+ ((CaptureControl <> nil) and (MouseControl = CaptureControl)) then
+ MouseControl.Perform(CM_MOUSELEAVE, 0, 0);
+ MouseControl := Control;
+ if ((MouseControl <> nil) and (CaptureControl = nil)) or
+ ((CaptureControl <> nil) and (MouseControl = CaptureControl)) then
+ MouseControl.Perform(CM_MOUSEENTER, 0, 0);
+ THackApplication(Application).FMouseControl := MouseControl;
+ end;
+ if Application.ShowHint and (MouseControl = nil) then
+ Application.CancelHint;
+ Result := 1;
+end;
+{$ENDIF}
+
+function hppRegisterMainWindow: Boolean;
+var
+ WndClass: TWNDCLASS;
+begin
+ Result := False;
+ ZeroMemory(@WndClass,SizeOf(WndClass));
+ WndClass.lpfnWndProc := @MainWindowWndProc;
+ WndClass.hInstance := GetModuleHandle(nil);
+ WndClass.lpszClassName := hppWindowClassName;
+ if Windows.RegisterClass(WndClass) = 0 then exit;
+ hppMainWindow := CreateWindow(hppWindowClassName,hppWindowClassName,WS_DISABLED,
+ 0,0,0,0,0,0,WndClass.hInstance,nil);
+ Result := (hppMainWindow <> 0);
+ if Result then
+ begin
+ // assign Application.CheckIniChange function
+ Application.Handle := hppMainWindow;
+ Application.Handle := 0;
+ SavedWakeMainThread := Classes.WakeMainThread;
+ @Classes.WakeMainThread := @hppWakeMainThread;
+ end;
+ {$IFDEF USE_CUSTOMIDLEHOOK}
+ ForegroundIdleHook := SetWindowsHookEx(WH_FOREGROUNDIDLE,
+ @IdleHookProc,0,GetCurrentThreadID);
+ {$ENDIF}
+end;
+
+function hppUnregisterMainWindow: Boolean;
+begin
+ if hppMainWindow <> 0 then
+ begin
+ DestroyWindow(hppMainWindow);
+ hppMainWindow := 0;
+ end;
+ Result := Boolean(Windows.UnregisterClass(hppWindowClassName,GetModuleHandle(nil)));
+ Classes.WakeMainThread := SavedWakeMainThread;
+ {$IFDEF USE_CUSTOMIDLEHOOK}
+ if ForegroundIdleHook <> 0 then UnhookWindowsHookEx(ForegroundIdleHook);
+ {$ENDIF}
+end;
+
+procedure hppWakeMainThread(Sender: TObject);
+begin
+ PostMessage(hppMainWindow, WM_NULL, 0, 0);
+ if Assigned(SavedWakeMainThread) then
+ SavedWakeMainThread(Sender);
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/hpp_messages.pas b/plugins/HistoryPlusPlus/hpp_messages.pas new file mode 100644 index 0000000000..96c061c14b --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_messages.pas @@ -0,0 +1,77 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+{-----------------------------------------------------------------------------
+ hpp_messages (historypp project)
+
+ Version: 1.0
+ Created: 31.03.2003
+ Author: Oxygen
+
+ [ Description ]
+
+ Some helper utilities to process messages
+
+ [ History ]
+ 1.0 (31.03.2003) - Initial version
+
+ [ Modifications ]
+
+ [ Knows Inssues ]
+ None
+
+ Contributors: theMIROn, Art Fedorov, Christian Kastner
+-----------------------------------------------------------------------------}
+
+
+unit hpp_messages;
+
+interface
+
+uses
+ Windows, m_api;
+
+function SendMessageTo(hContact: THandle; Text: String = ''): Boolean;
+//function ForwardMessage(Text: AnsiString): Boolean;
+
+implementation
+
+function SendMessageTo(hContact: THandle; Text: String): Boolean;
+var
+ buff: AnsiString;
+begin
+ if boolean(ServiceExists(MS_MSG_SENDMESSAGEW)) then
+ Result := (CallService(MS_MSG_SENDMESSAGEW,WPARAM(hContact),LPARAM(PChar(Text))) = 0)
+ else
+ begin
+ buff := AnsiString(Text);
+ Result := (CallService(MS_MSG_SENDMESSAGE,WPARAM(hContact),LPARAM(PAnsiChar(buff))) = 0);
+ if not Result then
+ Result := (CallService('SRMsg/LaunchMessageWindow',WPARAM(hContact),LPARAM(PAnsiChar(buff))) = 0);
+ end;
+end;
+
+{function ForwardMessage(Text: AnsiString): Boolean;
+begin
+ Result := (CallService(MS_MSG_FORWARDMESSAGE,0,LPARAM(PAnsiChar(Text)))=0);
+end;}
+
+end.
diff --git a/plugins/HistoryPlusPlus/hpp_olesmileys.pas b/plugins/HistoryPlusPlus/hpp_olesmileys.pas new file mode 100644 index 0000000000..4a07d8259f --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_olesmileys.pas @@ -0,0 +1,133 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+{-----------------------------------------------------------------------------
+ hpp_olesmileys (historypp project)
+
+ Version: 1.5
+ Created: 04.02.2007
+ Author: theMIROn
+
+ [ Description ]
+
+ [ History ]
+
+ 1.5 (04.02.2007)
+ First version
+
+ [ Modifications ]
+ none
+
+ [ Known Issues ]
+ none
+
+ Contributors: theMIROn
+-----------------------------------------------------------------------------}
+
+unit hpp_olesmileys;
+
+interface
+
+uses Windows,CommCtrl,ActiveX;
+
+const
+ IID_ITooltipData: TGUID = '{58B32D03-1BD2-4840-992E-9AE799FD4ADE}';
+ IID_IGifSmileyCtrl: TGUID = '{CB64102B-8CE4-4A55-B050-131C435A3A3F}';
+ IID_ISmileyAddSmiley: TGUID = '{105C56DF-6455-4705-A501-51F1CCFCF688}';
+ IID_IEmoticonsImage: TGUID = '{2FD9449B-7EBB-476a-A9DD-AE61382CCE08}';
+
+type
+ ITooltipData = interface(IUnknown)
+ ['{58B32D03-1BD2-4840-992E-9AE799FD4ADE}']
+ function SetTooltip(const bstrHint: WideString): HRESULT; stdcall;
+ function GetTooltip(out bstrHint: WideString): HRESULT; stdcall;
+ end;
+
+ IGifSmileyCtrl = interface(IUnknown)
+ ['{CB64102B-8CE4-4A55-B050-131C435A3A3F}']
+ end;
+
+ ISmileyAddSmiley = interface(IUnknown)
+ ['{105C56DF-6455-4705-A501-51F1CCFCF688}']
+ end;
+
+ IEmoticonsImage = interface(IUnknown)
+ ['{2FD9449B-7EBB-476a-A9DD-AE61382CCE08}']
+ end;
+
+(*
+ NM_FIREVIEWCHANGE is WM_NOTIFY Message for notify parent of host window about smiley are going to be repaint
+
+ The proposed action is next: Owner of RichEdit windows received NM_FIREVIEWCHANGE through WM_NOTIFY
+ twice first time before painting|invalidating (FVCN_PREFIRE) and second time - after (FVCN_POSTFIRE).
+ The Owner window may change any values of received FVCNDATA_NMHDR structure in order to raise needed action.
+ For example it may substitute FVCA_INVALIDATE to FVCA_CUSTOMDRAW event to force painting on self offscreen context.
+
+ It can be:
+ FVCA_CUSTOMDRAW - in this case you need to provide valid HDC to draw on and valid RECT of smiley
+ FVCA_INVALIDATE - to invalidate specified rect of window
+ FVCA_NONE - skip any action. But be aware - animation will be stopped till next repainting of smiley.
+ FVCA_SENDVIEWCHANGE - to notify richedit ole about object changed. Be aware Richedit will fully reconstruct itself
+
+ Another point is moment of received smiley rect - it is only valid if FVCA_DRAW is initially set,
+ and it is PROBABLY valid if FVCA_INVALIDATE is set. And it most probably invalid in case of FVCA_SENDVIEWCHANGE.
+ The smiley position is relative last full paint HDC. Usually it is relative to top-left corner of host
+ richedit (NOT it client area) in windows coordinates.
+
+*)
+
+const
+ // Type of Event one of
+ FVCN_PREFIRE = 1;
+ FVCN_POSTFIRE = 2;
+ FVCN_GETINFO = 255;
+
+ // Action of event are going to be done
+ FVCA_NONE = 0;
+ FVCA_DRAW = 1; // do not modify hdc in case of _DRAW, Use _CUSTOMDRAW
+ FVCA_CUSTOMDRAW = 2;
+ FVCA_INVALIDATE = 3;
+ FVCA_SENDVIEWCHANGE = 4;
+ FVCA_SKIPDRAW = 5;
+ FVCA_INFO = 255;
+
+type
+ // Extended NMHDR structure for WM_NOTIFY
+ PFVCNDATA_NMHDR= ^TFVCNDATA_NMHDR;
+ TFVCNDATA_NMHDR = record
+ nmhdr: TNMHdr;
+ cbSize: Integer;
+ bEvent: Byte;
+ bAction: Byte;
+ hDC: HDC;
+ rcRect: TRect;
+ clrBackground: COLORREF;
+ fTransparent: BOOL;
+ lParam: LPARAM;
+ end;
+
+const
+ // Code of WM_NOTIFY message (code)
+ NM_FIREVIEWCHANGE = NM_FIRST+1;
+
+implementation
+
+end.
diff --git a/plugins/HistoryPlusPlus/hpp_opt_dialog.pas b/plugins/HistoryPlusPlus/hpp_opt_dialog.pas new file mode 100644 index 0000000000..6b3c94dee9 --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_opt_dialog.pas @@ -0,0 +1,277 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+unit hpp_opt_dialog;
+
+interface
+
+uses
+ Windows, Messages, CommCtrl,
+ m_api,
+ hpp_global, hpp_options, hpp_services
+ {$IFNDEF NO_EXTERNALGRID}, hpp_external{$ENDIF};
+
+const
+ IDD_OPT_HISTORYPP = 207; // dialog id
+
+ ID_APPEARANCE_GROUP = 100; // "Appearance options" group
+ IDC_SHOWEVENTICONS = 101; // "Show event icons" checkbox
+ IDC_RTLDEFAULT = 102; // "RTL by default" checkbox
+ IDC_OPENDETAILS = 103; // "Open event details by Enter" checkbox
+ IDC_SHOWEVENTSCOUNT = 104; // "Show events count in menu" checkbox
+ IDC_SHOWAVATARS = 105; // "Show avatars" checkbox
+
+ ID_FORMATTING_GROUP = 200; // "Text formatting options" group
+ IDC_BBCODE = 201; // "Enable BBCodes" checkbox
+ IDC_SMILEY = 202; // "Enable SmileyAdd support" checkbox
+ IDC_MATH = 203; // "Enable MathModule support" checkbox
+ IDC_RAWRTF = 204; // "Enable raw RTF support" checkbox
+ IDC_AVATARSHISTORY = 205; // "Display chanage avatars" checkbox
+
+ ID_MESSAGELOG_GROUP = 300; // "Message log options" group
+ IDC_IEVIEWAPI = 301; // "Imitate IEView API" checkbox
+ IDC_GROUPLOGITEMS = 302; // "Group messages" checkbox
+ IDC_DISABLEBORDER = 303; // "Disable border" checkbox
+ IDC_DISABLESCROLL = 304; // "Disable scrollbar" checkbox
+
+ ID_HISTORYVIEW_GROUP = 500;// "History view options" group
+ IDC_RECENTONTOP = 501; // "Recent events on top" checkbox
+ IDC_GROUPHISTITEMS = 502; // "Group messages" checkbox
+
+ ID_NEEDOPTIONS_LINK = 250; // "Visit Wiki page for more options" hyperlink
+
+ ID_NEED_RESTART = 999; // "Please restart Miranda IM..."
+
+const
+ URL_NEEDOPTIONS = 'http://code.google.com/p/historypp/wiki/AdditionalOptions';
+
+function OptDialogProc(hwndDlg: HWND; uMsg: UInt; wParam: WPARAM; lParam: LPARAM): lresult; stdcall;
+
+var
+ hDlg: HWND = 0;
+
+implementation
+
+uses hpp_database, HistoryForm, GlobalSearch;
+
+{
+function GetText(idCtrl: Integer): AnsiString;
+var
+ dlg_text: array[0..1023] of AnsiChar;
+begin
+ ZeroMemory(@dlg_text,SizeOf(dlg_text));
+ GetDlgItemText(hDlg,idCtrl,@dlg_text,1023);
+ Result := dlg_text;
+end;
+
+procedure SetText(idCtrl: Integer; Text: AnsiString);
+begin
+ SetDlgItemText(hDlg,idCtrl,@Text[1]);
+end;
+}
+procedure SetChecked(idCtrl: Integer; Checked: Boolean);
+begin
+ if Checked then
+ SendDlgItemMessage(hDlg,idCtrl,BM_SETCHECK,BST_CHECKED,0)
+ else
+ SendDlgItemMessage(hDlg,idCtrl,BM_SETCHECK,BST_UNCHECKED,0);
+end;
+
+function GetChecked(idCtrl: Integer): Boolean;
+begin
+ Result := (SendDlgItemMessage(hDlg,idCtrl,BM_GETCHECK,0,0) = BST_CHECKED);
+end;
+
+function AreOptionsChanged: Boolean;
+begin
+ Result := True;
+
+ if GetChecked(IDC_SHOWEVENTICONS) <> GridOptions.ShowIcons then exit;
+ if GetChecked(IDC_RTLDEFAULT) <> GridOptions.RTLEnabled then exit;
+ if GetChecked(IDC_OPENDETAILS) <> GridOptions.OpenDetailsMode then exit;
+ if GetChecked(IDC_SHOWEVENTSCOUNT) <> ShowHistoryCount then exit;
+ //if GetChecked(IDC_SHOWAVATARS) <> GridOptions.ShowAvatars then exit;
+
+ if GetChecked(IDC_BBCODE) <> GridOptions.BBCodesEnabled then exit;
+ if SmileyAddEnabled then
+ if GetChecked(IDC_SMILEY) <> GridOptions.SmileysEnabled then exit;
+ if MathModuleEnabled then
+ if GetChecked(IDC_MATH) <> GridOptions.MathModuleEnabled then exit;
+ if GetChecked(IDC_RAWRTF) <> GridOptions.RawRTFEnabled then exit;
+ if GetChecked(IDC_AVATARSHISTORY) <> GridOptions.AvatarsHistoryEnabled then exit;
+
+ if GetChecked(IDC_RECENTONTOP) <> GetDBBool(hppDBName,'SortOrder',false) then exit;
+ if GetChecked(IDC_GROUPHISTITEMS) <> GetDBBool(hppDBName,'GroupHistoryItems',false) then exit;
+
+ {$IFNDEF NO_EXTERNALGRID}
+ if GetChecked(IDC_IEVIEWAPI) <> GetDBBool(hppDBName,'IEViewAPI',false) then exit;
+ if GetChecked(IDC_GROUPLOGITEMS) <> GetDBBool(hppDBName,'GroupLogItems',false) then exit;
+ if GetChecked(IDC_DISABLEBORDER) <> GetDBBool(hppDBName,'NoLogBorder',false) then exit;
+ if GetChecked(IDC_DISABLESCROLL) <> GetDBBool(hppDBName,'NoLogScrollBar',false) then exit;
+ {$ENDIF}
+
+ Result := False;
+end;
+
+procedure SaveChangedOptions;
+var
+ ShowRestart: Boolean;
+ Checked: Boolean;
+ i: Integer;
+begin
+ ShowRestart := False;
+ GridOptions.StartChange;
+ try
+ GridOptions.ShowIcons := GetChecked(IDC_SHOWEVENTICONS);
+ GridOptions.RTLEnabled := GetChecked(IDC_RTLDEFAULT);
+ GridOptions.OpenDetailsMode := GetChecked(IDC_OPENDETAILS);
+
+ ShowHistoryCount := GetChecked(IDC_SHOWEVENTSCOUNT);
+ if ShowHistoryCount <> GetDBBool(hppDBName,'ShowHistoryCount',false) then
+ WriteDBBool(hppDBName,'ShowHistoryCount',ShowHistoryCount);
+
+ //GridOptions.ShowAvatars := GetChecked(IDC_SHOWAVATARS);
+
+ GridOptions.BBCodesEnabled := GetChecked(IDC_BBCODE);
+ GridOptions.RawRTFEnabled := GetChecked(IDC_RAWRTF);
+ GridOptions.AvatarsHistoryEnabled := GetChecked(IDC_AVATARSHISTORY);
+
+ if SmileyAddEnabled then GridOptions.SmileysEnabled := GetChecked(IDC_SMILEY);
+ if MathModuleEnabled then GridOptions.MathModuleEnabled := GetChecked(IDC_MATH);
+
+ SaveGridOptions;
+ finally
+ GridOptions.EndChange;
+ end;
+
+ Checked := GetChecked(IDC_RECENTONTOP);
+ if Checked <> GetDBBool(hppDBName,'SortOrder',false) then
+ begin
+ WriteDBBool(hppDBName,'SortOrder',Checked);
+ for i := 0 to HstWindowList.Count - 1 do
+ begin
+ THistoryFrm(HstWindowList[i]).SetRecentEventsPosition(Checked);
+ end;
+ if Assigned(fmGlobalSearch) then
+ fmGlobalSearch.SetRecentEventsPosition(Checked);
+ end;
+
+ Checked := GetChecked(IDC_GROUPHISTITEMS);
+ if Checked <> GetDBBool(hppDBName,'GroupHistoryItems',false) then
+ begin
+ WriteDBBool(hppDBName,'GroupHistoryItems',Checked);
+ for i := 0 to HstWindowList.Count - 1 do
+ THistoryFrm(HstWindowList[i]).hg.GroupLinked := Checked;
+ end;
+
+ {$IFNDEF NO_EXTERNALGRID}
+ Checked := GetChecked(IDC_IEVIEWAPI);
+ if Checked <> GetDBBool(hppDBName,'IEViewAPI',false) then
+ WriteDBBool(hppDBName,'IEViewAPI',Checked);
+ ShowRestart := ShowRestart or (Checked <> ImitateIEView);
+
+ Checked := GetChecked(IDC_GROUPLOGITEMS);
+ if Checked <> GetDBBool(hppDBName,'GroupLogItems',false) then
+ begin
+ WriteDBBool(hppDBName,'GroupLogItems',Checked);
+ ExternalGrids.GroupLinked := Checked;
+ end;
+
+ Checked := GetChecked(IDC_DISABLEBORDER);
+ if Checked <> GetDBBool(hppDBName,'NoLogBorder',false) then
+ WriteDBBool(hppDBName,'NoLogBorder',Checked);
+ //ShowRestart := ShowRestart or (Checked <> DisableLogBorder);
+
+ Checked := GetChecked(IDC_DISABLESCROLL);
+ if Checked <> GetDBBool(hppDBName,'NoLogScrollBar',false) then
+ WriteDBBool(hppDBName,'NoLogScrollBar',Checked);
+ //ShowRestart := ShowRestart or (Checked <> DisableLogScrollbar);
+ {$ENDIF}
+
+ if ShowRestart then
+ ShowWindow(GetDlgItem(hDlg,ID_NEED_RESTART),SW_SHOW)
+ else
+ ShowWindow(GetDlgItem(hDlg,ID_NEED_RESTART),SW_HIDE);
+end;
+
+function OptDialogProc(hwndDlg: HWND; uMsg: UInt; wParam: WPARAM; lParam: LPARAM): lresult; stdcall;
+begin
+ Result := 0;
+ case uMsg of
+ WM_DESTROY: hDlg := 0;
+
+ WM_INITDIALOG: begin
+ hDlg := hwndDlg;
+ SetChecked(IDC_SHOWEVENTICONS,GridOptions.ShowIcons);
+ SetChecked(IDC_RTLDEFAULT,GridOptions.RTLEnabled);
+ SetChecked(IDC_OPENDETAILS,GridOptions.OpenDetailsMode);
+ SetChecked(IDC_SHOWEVENTSCOUNT,ShowHistoryCount);
+ //SetChecked(IDC_SHOWAVATARS,GridOptions.ShowAvatars);
+
+ SetChecked(IDC_BBCODE,GridOptions.BBCodesEnabled);
+ EnableWindow(GetDlgItem(hDlg,IDC_SMILEY),SmileyAddEnabled);
+ if SmileyAddEnabled then
+ SetChecked(IDC_SMILEY,GridOptions.SmileysEnabled);
+ EnableWindow(GetDlgItem(hDlg,IDC_MATH),MathModuleEnabled);
+ if MathModuleEnabled then
+ SetChecked(IDC_MATH,GridOptions.MathModuleEnabled);
+ SetChecked(IDC_RAWRTF,GridOptions.RawRTFEnabled);
+ SetChecked(IDC_AVATARSHISTORY,GridOptions.AvatarsHistoryEnabled);
+
+ SetChecked(IDC_RECENTONTOP,GetDBBool(hppDBName,'SortOrder',false));
+ SetChecked(IDC_GROUPHISTITEMS,GetDBBool(hppDBName,'GroupHistoryItems',false));
+
+ SetChecked(IDC_IEVIEWAPI ,GetDBBool(hppDBName,'IEViewAPI',false));
+ SetChecked(IDC_GROUPLOGITEMS,GetDBBool(hppDBName,'GroupLogItems',false));
+ SetChecked(IDC_DISABLEBORDER,GetDBBool(hppDBName,'NoLogBorder',false));
+ SetChecked(IDC_DISABLESCROLL,GetDBBool(hppDBName,'NoLogScrollBar',false));
+
+ TranslateDialogDefault(hwndDlg);
+ end;
+
+ WM_NOTIFY: begin
+ if PNMHDR(lParam)^.code = PSN_APPLY then
+ begin
+ Result := 1;
+ // apply changes here
+ SaveChangedOptions;
+ end;
+ end;
+
+ WM_COMMAND: begin
+ case LoWord(wParam) of
+ ID_NEEDOPTIONS_LINK: begin
+ CallService(MS_UTILS_OPENURL,TWPARAM(True),TLPARAM(PAnsiChar(URL_NEEDOPTIONS)));
+ Result := 1;
+ end;
+ else
+ if AreOptionsChanged then
+ begin
+ Result := 1;
+ SendMessage(GetParent(hDlg),PSM_CHANGED,hDlg,0);
+ end;
+ end;
+ end;
+
+ end;
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/hpp_opt_dialog.rc b/plugins/HistoryPlusPlus/hpp_opt_dialog.rc new file mode 100644 index 0000000000..db602f6c76 --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_opt_dialog.rc @@ -0,0 +1,37 @@ +Z_OPTIONS_CHECKED ICON res\options_checked.ico
+
+207 DIALOGEX 0, 0, 314, 240
+STYLE DS_FIXEDSYS | WS_CHILD | WS_VISIBLE
+EXSTYLE WS_EX_CONTROLPARENT
+CAPTION ""
+LANGUAGE LANG_NEUTRAL, SUBLANG_NEUTRAL
+FONT 8, "MS SHELL DLG"
+{
+ CONTROL "Appearance options", 100, BUTTON, BS_GROUPBOX | WS_CHILD | WS_VISIBLE, 6, 6, 302, 35
+ CONTROL "Show event icons", 101, BUTTON, BS_AUTOCHECKBOX | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 12, 16, 140, 11
+ CONTROL "Use RTL by default", 102, BUTTON, BS_AUTOCHECKBOX | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 12, 26, 140, 11
+ CONTROL "Open event details by Enter", 103, BUTTON, BS_AUTOCHECKBOX | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 166, 16, 140, 11
+ CONTROL "Show events count in menu", 104, BUTTON, BS_AUTOCHECKBOX | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 166, 26, 140, 11
+ //CONTROL "Show avatars", 105, BUTTON, BS_AUTOCHECKBOX | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 166, 36, 140, 11
+
+ CONTROL "Formatting options", 200, BUTTON, BS_GROUPBOX | WS_CHILD | WS_VISIBLE, 6, 44, 302, 45
+ CONTROL "Enable BBCodes", 201, BUTTON, BS_AUTOCHECKBOX | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 12, 54, 140, 11
+ CONTROL "Enable SmileyAdd support", 202, BUTTON, BS_AUTOCHECKBOX | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 12, 64, 140, 11
+ CONTROL "Enable MathModule support", 203, BUTTON, BS_AUTOCHECKBOX | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 12, 74, 140, 11
+ CONTROL "Enable raw RTF support", 204, BUTTON, BS_AUTOCHECKBOX | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 166, 54, 140, 11
+ CONTROL "Display changed avatars", 205, BUTTON, BS_AUTOCHECKBOX | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 166, 64, 140, 11
+
+ CONTROL "Message log options", 300, BUTTON, BS_GROUPBOX | WS_CHILD | WS_VISIBLE, 160, 92, 148, 55
+ CONTROL "Imitate IEView API", 301, BUTTON, BS_AUTOCHECKBOX | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 166, 102, 140, 11
+ CONTROL "Group messages", 302, BUTTON, BS_AUTOCHECKBOX | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 166, 112, 140, 11
+ CONTROL "Disable border", 303, BUTTON, BS_AUTOCHECKBOX | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 166, 122, 140, 11
+ CONTROL "Disable scroll bar", 304, BUTTON, BS_AUTOCHECKBOX | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 166, 132, 140, 11
+
+ CONTROL "History view options", 500, BUTTON, BS_GROUPBOX | WS_CHILD | WS_VISIBLE, 6, 92, 148, 55
+ CONTROL "Recent events on top", 501, BUTTON, BS_AUTOCHECKBOX | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 12, 102, 140, 11
+ CONTROL "Group messages", 502, BUTTON, BS_AUTOCHECKBOX | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 12, 112, 140, 11
+
+ CONTROL "Visit Wiki page for more options", 250, "Hyperlink", WS_CHILD | WS_TABSTOP | 0x1, 23, 217, 268, 10
+
+ CONTROL "Please restart Miranda IM for your changes to take effect.", 999, STATIC, SS_CENTER | NOT WS_VISIBLE, 6, 230, 302, 10
+}
diff --git a/plugins/HistoryPlusPlus/hpp_options.pas b/plugins/HistoryPlusPlus/hpp_options.pas new file mode 100644 index 0000000000..758046d0fd --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_options.pas @@ -0,0 +1,658 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+{-----------------------------------------------------------------------------
+ hpp_options (historypp project)
+
+ Version: 1.0
+ Created: 31.03.2003
+ Author: Oxygen
+
+ [ Description ]
+
+ Options module which has one global options variable and
+ manages all options throu all history windows
+
+ [ History ]
+ 1.0 (31.03.2003) - Initial version
+
+ [ Modifications ]
+
+ [ Knows Inssues ]
+ None
+
+ Contributors: theMIROn, Art Fedorov
+-----------------------------------------------------------------------------}
+
+
+unit hpp_options;
+
+interface
+
+uses
+ Graphics, SysUtils, Windows, Dialogs,
+ m_api,
+ HistoryGrid,
+ hpp_global, hpp_contacts, hpp_events, hpp_mescatcher;
+
+type
+
+ ThppIntIconsRec = record
+ Handle: hIcon;
+ case boolean of
+ true: (name: PAnsiChar);
+ false: (id: SmallInt);
+ end;
+
+ ThppIconsRec = record
+ name: PAnsiChar;
+ desc: PAnsiChar;
+ group: PAnsiChar;
+ i: shortint;
+ end;
+
+ ThppFontType = set of (hppFont, hppColor);
+
+ ThppFontsRec = record
+ _type: ThppFontType;
+ name: PAnsiChar;
+ nameColor: PAnsiChar;
+ Mes: TMessageTypes;
+ style: byte;
+ size: Integer;
+ color: TColor;
+ back: TColor;
+ end;
+
+ TSaveFilter = record
+ Index: Integer;
+ Filter: String;
+ DefaultExt: String;
+ Owned: TSaveFormats;
+ OwnedIndex: Integer;
+ end;
+
+const
+ DEFFORMAT_CLIPCOPY = '%nick%, %smart_datetime%:\n%mes%\n';
+ DEFFORMAT_CLIPCOPYTEXT = '%mes%\n';
+ DEFFORMAT_REPLYQUOTED = '%nick%, %smart_datetime%:\n%quot_mes%\n';
+ DEFFORMAT_REPLYQUOTEDTEXT = '%quot_selmes%\n';
+ DEFFORMAT_SELECTION = '%selmes%\n';
+ DEFFORMAT_DATETIME = 'c'; // ShortDateFormat + LongTimeFormat
+
+ hppIconsDefs : array[0..33] of ThppIconsRec = (
+ (name:'historypp_01'; desc:'Contact history'; group: nil; i:HPP_ICON_CONTACTHISTORY),
+ (name:'historypp_02'; desc:'History search'; group: nil; i:HPP_ICON_GLOBALSEARCH),
+ (name:'historypp_03'; desc:'Conversation divider'; group: 'Conversations'; i:HPP_ICON_SESS_DIVIDER),
+ (name:'historypp_04'; desc:'Conversation icon'; group: 'Conversations'; i:HPP_ICON_SESSION),
+ (name:'historypp_05'; desc:'Conversation summer'; group: 'Conversations'; i:HPP_ICON_SESS_SUMMER),
+ (name:'historypp_06'; desc:'Conversation autumn'; group: 'Conversations'; i:HPP_ICON_SESS_AUTUMN),
+ (name:'historypp_07'; desc:'Conversation winter'; group: 'Conversations'; i:HPP_ICON_SESS_WINTER),
+ (name:'historypp_08'; desc:'Conversation spring'; group: 'Conversations'; i:HPP_ICON_SESS_SPRING),
+ (name:'historypp_09'; desc:'Conversation year'; group: 'Conversations'; i:HPP_ICON_SESS_YEAR),
+ (name:'historypp_10'; desc:'Filter'; group: 'Toolbar'; i:HPP_ICON_HOTFILTER),
+ (name:'historypp_11'; desc:'In-place filter wait'; group: 'Search panel'; i:HPP_ICON_HOTFILTERWAIT),
+ (name:'historypp_12'; desc:'Search All Results'; group: nil; i:HPP_ICON_SEARCH_ALLRESULTS),
+ (name:'historypp_13'; desc:'Save All'; group: 'Toolbar'; i:HPP_ICON_TOOL_SAVEALL),
+ (name:'historypp_14'; desc:'Search'; group: 'Toolbar'; i:HPP_ICON_HOTSEARCH),
+ (name:'historypp_15'; desc:'Search Up'; group: 'Search panel'; i:HPP_ICON_SEARCHUP),
+ (name:'historypp_16'; desc:'Search Down'; group: 'Search panel'; i:HPP_ICON_SEARCHDOWN),
+ (name:'historypp_17'; desc:'Delete All'; group: 'Toolbar'; i:HPP_ICON_TOOL_DELETEALL),
+ (name:'historypp_18'; desc:'Delete'; group: 'Toolbar'; i:HPP_ICON_TOOL_DELETE),
+ (name:'historypp_19'; desc:'Conversations'; group: 'Toolbar'; i:HPP_ICON_TOOL_SESSIONS),
+ (name:'historypp_20'; desc:'Save'; group: 'Toolbar'; i:HPP_ICON_TOOL_SAVE),
+ (name:'historypp_21'; desc:'Copy'; group: 'Toolbar'; i:HPP_ICON_TOOL_COPY),
+ (name:'historypp_22'; desc:'End of page'; group: 'Search panel'; i:HPP_ICON_SEARCH_ENDOFPAGE),
+ (name:'historypp_23'; desc:'Phrase not found'; group: 'Search panel'; i:HPP_ICON_SEARCH_NOTFOUND),
+ (name:'historypp_24'; desc:'Clear in-place filter'; group: 'Search panel'; i:HPP_ICON_HOTFILTERCLEAR),
+ (name:'historypp_25'; desc:'Conversation hide'; group: 'Conversations'; i:HPP_ICON_SESS_HIDE),
+ (name:'historypp_26'; desc:'Drop down arrow'; group: 'Toolbar'; i:HPP_ICON_DROPDOWNARROW),
+ (name:'historypp_27'; desc:'User Details'; group: 'Toolbar'; i:HPP_ICON_CONTACDETAILS),
+ (name:'historypp_28'; desc:'User Menu'; group: 'Toolbar'; i:HPP_ICON_CONTACTMENU),
+ (name:'historypp_29'; desc:'Bookmarks'; group: 'Toolbar'; i:HPP_ICON_BOOKMARK),
+ (name:'historypp_30'; desc:'Bookmark enabled'; group: nil; i:HPP_ICON_BOOKMARK_ON),
+ (name:'historypp_31'; desc:'Bookmark disabled'; group: nil; i:HPP_ICON_BOOKMARK_OFF),
+ (name:'historypp_32'; desc:'Advanced Search Options'; group: 'Toolbar'; i:HPP_ICON_SEARCHADVANCED),
+ (name:'historypp_33'; desc:'Limit Search Range'; group: 'Toolbar'; i:HPP_ICON_SEARCHRANGE),
+ (name:'historypp_34'; desc:'Search Protected Contacts'; group: 'Toolbar'; i:HPP_ICON_SEARCHPROTECTED)
+ );
+
+ hppFontItems: array[0..29] of ThppFontsRec = (
+ (_type:[hppFont,hppColor]; name: 'Incoming nick'; nameColor: 'Divider'; Mes: []; style:DBFONTF_BOLD; size: -11; color: $6B3FC8; back: clGray),
+ (_type:[hppFont,hppColor]; name: 'Outgoing nick'; nameColor: 'Selected text'; Mes: []; style:DBFONTF_BOLD; size: -11; color: $BD6008; back: clHighlightText),
+ (_type:[hppColor]; nameColor: 'Selected background'; Mes: []; back: clHighlight),
+ (_type:[hppFont,hppColor]; name: 'Incoming message'; Mes: [mtMessage,mtIncoming]; style:0; size: -11; color: $000000; back: $DBDBDB),
+ (_type:[hppFont,hppColor]; name: 'Outgoing message'; Mes: [mtMessage,mtOutgoing]; style:0; size: -11; color: $000000; back: $EEEEEE),
+ (_type:[hppFont,hppColor]; name: 'Incoming file'; Mes: [mtFile,mtIncoming]; style:0; size: -11; color: $000000; back: $9BEEE3),
+ (_type:[hppFont,hppColor]; name: 'Outgoing file'; Mes: [mtFile,mtOutgoing]; style:0; size: -11; color: $000000; back: $9BEEE3),
+ (_type:[hppFont,hppColor]; name: 'Incoming url'; Mes: [mtUrl,mtIncoming]; style:0; size: -11; color: $000000; back: $F4D9CC),
+ (_type:[hppFont,hppColor]; name: 'Outgoing url'; Mes: [mtUrl,mtOutgoing]; style:0; size: -11; color: $000000; back: $F4D9CC),
+ (_type:[hppFont,hppColor]; name: 'Incoming SMS Message'; Mes: [mtSMS,mtIncoming]; style:0; size: -11; color: $000000; back: $CFF4FE),
+ (_type:[hppFont,hppColor]; name: 'Outgoing SMS Message'; Mes: [mtSMS,mtOutgoing]; style:0; size: -11; color: $000000; back: $CFF4FE),
+ (_type:[hppFont,hppColor]; name: 'Incoming contacts'; Mes: [mtContacts,mtIncoming]; style:0; size: -11; color: $000000; back: $FEF4CF),
+ (_type:[hppFont,hppColor]; name: 'Outgoing contacts'; Mes: [mtContacts,mtOutgoing]; style:0; size: -11; color: $000000; back: $FEF4CF),
+ (_type:[hppFont,hppColor]; name: 'System message'; Mes: [mtSystem,mtIncoming,mtOutgoing]; style:0; size: -11; color: $000000; back: $CFFEDC),
+ (_type:[hppFont,hppColor]; name: 'Status changes'; Mes: [mtStatus,mtIncoming,mtOutgoing]; style:0; size: -11; color: $000000; back: $F0F0F0),
+ (_type:[hppFont,hppColor]; name: 'SMTP Simple Email'; Mes: [mtSMTPSimple,mtIncoming,mtOutgoing]; style:0; size: -11; color: $000000; back: $FFFFFF),
+ (_type:[hppFont,hppColor]; name: 'Other events (unknown)'; Mes: [mtOther,mtIncoming,mtOutgoing]; style:0; size: -11; color: $000000; back: $FFFFFF),
+ (_type:[hppFont,hppColor]; name: 'Conversation header'; Mes: []; style:0; size: -11; color: $000000; back: $00D7FDFF),
+ (_type:[hppFont,hppColor]; name: 'Nick changes'; Mes: [mtNickChange,mtIncoming,mtOutgoing]; style:0; size: -11; color: $000000; back: $00D7FDFF),
+ (_type:[hppFont,hppColor]; name: 'Avatar changes'; Mes: [mtAvatarChange,mtIncoming,mtOutgoing]; style:0; size: -11; color: $000000; back: $00D7FDFF),
+ (_type:[hppFont]; name: 'Incoming timestamp'; Mes: []; style:0; size: -11; color: $000000),
+ (_type:[hppFont]; name: 'Outgoing timestamp'; Mes: []; style:0; size: -11; color: $000000),
+ (_type:[hppFont,hppColor]; name: 'Grid messages'; nameColor: 'Grid background'; Mes: []; style:0; size: -11; color: $000000; back: $E9EAEB),
+ (_type:[hppFont,hppColor]; name: 'Incoming WATrack notify'; Mes: [mtWATrack,mtIncoming]; style:0; size: -11; color: $C08000; back: $C8FFFF),
+ (_type:[hppFont,hppColor]; name: 'Outgoing WATrack notify'; Mes: [mtWATrack,mtOutgoing]; style:0; size: -11; color: $C08000; back: $C8FFFF),
+ (_type:[hppFont,hppColor]; name: 'Status message changes'; Mes: [mtStatusMessage,mtIncoming,mtOutgoing]; style:0; size: -11; color: $000000; back: $F0F0F0),
+ (_type:[hppFont,hppColor]; name: 'Voice calls'; Mes: [mtVoiceCall,mtIncoming,mtOutgoing]; style:0; size: -11; color: $000000; back: $E9DFAB),
+ (_type:[hppFont,hppColor]; name: 'Webpager message'; Mes: [mtWebPager,mtIncoming,mtOutgoing]; style:0; size: -11; color: $000000; back: $FFFFFF),
+ (_type:[hppFont,hppColor]; name: 'EMail Express message'; Mes: [mtEmailExpress,mtIncoming,mtOutgoing]; style:0; size: -11; color: $000000; back: $FFFFFF),
+ (_type:[hppColor]; nameColor: 'Link'; Mes: []; back: clBlue)
+ );
+
+ SaveFormatsDef: array[TSaveFormat] of TSaveFilter = (
+ (Index: -1; Filter:'All files'; DefaultExt:'*.*'; Owned:[]; OwnedIndex: -1),
+ (Index: 1; Filter:'HTML file'; DefaultExt:'*.html'; Owned:[]; OwnedIndex: -1),
+ (Index: 2; Filter:'XML file'; DefaultExt:'*.xml'; Owned:[]; OwnedIndex: -1),
+ (Index: 3; Filter:'RTF file'; DefaultExt:'*.rtf'; Owned:[]; OwnedIndex: -1),
+ (Index: 4; Filter:'mContacts files'; DefaultExt:'*.dat'; Owned:[]; OwnedIndex: -1),
+ (Index: 5; Filter:'Unicode text file'; DefaultExt:'*.txt'; Owned:[sfUnicode,sfText]; OwnedIndex: 1),
+ (Index: 6; Filter:'Text file'; DefaultExt:'*.txt'; Owned:[sfUnicode,sfText]; OwnedIndex: 2));
+
+var
+ hppIntIcons: array[0..0] of ThppIntIconsRec = (
+ (handle: 0; name:'z_password_protect')
+ );
+
+var
+ GridOptions: TGridOptions;
+ SmileyAddEnabled: Boolean;
+ MathModuleEnabled: Boolean;
+ MetaContactsEnabled: Boolean;
+ MetaContactsProto: AnsiString;
+ MeSpeakEnabled: Boolean;
+ ShowHistoryCount: Boolean;
+ hppIcons: array of ThppIntIconsRec;
+ skinIcons: array of ThppIntIconsRec;
+ SaveFormats: array[TSaveFormat] of TSaveFilter;
+
+procedure LoadGridOptions;
+procedure SaveGridOptions;
+procedure LoadIcons;
+procedure LoadIcons2;
+procedure LoadIntIcons;
+procedure OnShowIcons;
+procedure OnTextFormatting(Value: Boolean);
+procedure hppRegisterGridOptions;
+procedure hppPrepareTranslation;
+procedure PrepareSaveDialog(SaveDialog: TSaveDialog; SaveFormat: TSaveFormat; AllFormats: Boolean = False);
+
+implementation
+
+uses hpp_database, ShellAPI;
+
+{$include inc\m_mathmodule.inc}
+{$include inc\m_speak.inc}
+
+procedure RegisterFont(Name:PAnsiChar; Order:integer; const defFont:TFontSettings);
+var
+ fid: TFontID;
+begin
+ fid.cbSize := sizeof(fid);
+ fid.group := hppName;
+ fid.dbSettingsGroup := hppDBName;
+ fid.flags := FIDF_DEFAULTVALID+FIDF_ALLOWEFFECTS;
+ fid.order := Order;
+ lstrcpya(fid.name,Name);
+ lstrcpya(fid.prefix,PAnsiChar(AnsiString('Font')+AnsiString(intToStr(Order))));
+ fid.deffontsettings := defFont;
+ fid.deffontsettings.size := hppFontItems[Order].size;
+ fid.deffontsettings.style := hppFontItems[Order].style;
+ fid.deffontsettings.colour := ColorToRGB(hppFontItems[Order].color);
+ FontRegister(@fid);
+end;
+
+procedure RegisterColor(Name:PAnsiChar; Order:integer; defColor:TColor);
+var
+ cid: TColourID;
+begin
+ cid.cbSize := sizeof(cid);
+ cid.group := hppName;
+ cid.dbSettingsGroup := hppDBName;
+ cid.order := Order;
+ lstrcpya(cid.name,Name);
+ lstrcpya(cid.setting,PAnsiChar('Color'+AnsiString(intToStr(Order))));
+ cid.defcolour := ColorToRGB(defColor);
+ ColourRegister(@cid);
+end;
+
+procedure OnShowIcons;
+begin
+ if GridOptions.ShowIcons then LoadIcons;
+end;
+
+procedure OnTextFormatting(Value: Boolean);
+begin
+ WriteDBBool(hppDBName,'InlineTextFormatting',Value);
+end;
+
+{function LoadIconFromDB(ID: Integer; Icon: TIcon): Boolean;
+var
+ hic: HIcon;
+begin
+ Result := False;
+ hic := LoadSkinnedIcon(ID);
+ if (hic <> 0) then begin
+ hic := CopyIcon(hic);
+ Icon.Handle := hic;
+ Result := True;
+ end;
+end;}
+
+procedure LoadIcons;
+var
+ i: Integer;
+ ic: hIcon;
+ Changed: Boolean;
+begin
+ Changed := false;
+ GridOptions.StartChange;
+ try
+ // LoadIconFromDB(SKINICON_EVENT_MESSAGE,GridOptions.IconMessage);
+ // LoadIconFromDB(SKINICON_EVENT_URL,GridOptions.IconUrl);
+ // LoadIconFromDB(SKINICON_EVENT_FILE,GridOptions.IconFile);
+ // LoadIconFromDB(SKINICON_OTHER_MIRANDA,GridOptions.IconOther);
+ for i := 0 to High(skinIcons) do
+ begin
+ ic := LoadSkinnedIcon(skinIcons[i].id);
+ if skinIcons[i].handle <> ic then
+ begin
+ skinIcons[i].handle := ic;
+ Changed := true;
+ end;
+ end;
+ finally
+ GridOptions.EndChange(Changed);
+ end;
+end;
+
+procedure LoadIntIcons;
+var
+ i: Integer;
+begin
+ for i := 0 to High(hppIntIcons) do
+ hppIntIcons[i].handle := LoadIconA(hInstance,hppIntIcons[i].name);
+end;
+
+procedure LoadIcons2;
+var
+ i: integer;
+ ic: hIcon;
+ Changed: Boolean;
+begin
+ Changed := false;
+ GridOptions.StartChange;
+ try
+ for i := 0 to High(hppIcons) do
+ begin
+ ic := CallService(MS_SKIN2_GETICON, 0, LPARAM(hppIcons[i].name));
+ if hppIcons[i].handle <> ic then
+ begin
+ hppIcons[i].handle := ic;
+ Changed := true;
+ end;
+ end;
+ finally
+ GridOptions.EndChange(Changed);
+ end;
+end;
+
+function LoadColorDB(Order: integer): TColor;
+begin
+ Result := GetDBInt(hppDBName,PAnsiChar(AnsiString('Color'+intToStr(Order))),
+ ColorToRGB(hppFontItems[Order].back));
+end;
+
+function LoadFont(Order: Integer; F: TFont): TFont;
+const
+ size: Integer = -11;
+var
+ fid: TFontID;
+ lf: TLogFontA;
+ col: TColor;
+begin
+ fid.cbSize := sizeof(fid);
+ fid.group := hppName;
+ lstrcpya(fid.name, hppFontItems[Order].name { TRANSLATE-IGNORE } );
+ col := CallService(MS_FONT_GETA, WPARAM(@fid), LPARAM(@lf));
+ F.handle := CreateFontIndirectA(lf);
+ F.color := col;
+ Result := F;
+end;
+
+procedure LoadGridOptions;
+var
+ i,index: integer;
+begin
+ GridOptions.StartChange;
+ try
+ // load fonts
+ LoadFont(0, GridOptions.FontContact);
+ // GridOptions.FontSelected := LoadFont(2,GridOptions.FontSelected);
+ GridOptions.FontProfile := LoadFont(1, GridOptions.FontProfile);
+ GridOptions.FontSessHeader := LoadFont(17, GridOptions.FontSessHeader);
+ GridOptions.FontIncomingTimestamp := LoadFont(20, GridOptions.FontIncomingTimestamp);
+ GridOptions.FontOutgoingTimestamp := LoadFont(21, GridOptions.FontOutgoingTimestamp);
+ GridOptions.FontMessage := LoadFont(22, GridOptions.FontMessage);
+ // load colors
+ GridOptions.ColorDivider := LoadColorDB(0);
+ GridOptions.ColorSelectedText := LoadColorDB(1);
+ GridOptions.ColorSelected := LoadColorDB(2);
+ GridOptions.ColorSessHeader := LoadColorDB(17);
+ GridOptions.ColorBackground := LoadColorDB(22);
+ GridOptions.ColorLink := LoadColorDB(29);
+
+ // load mestype-related
+ index := 0;
+ for i := 0 to High(hppFontItems) do
+ begin
+ if hppFontItems[i].Mes <> [] then
+ begin
+ if index > High(GridOptions.ItemOptions) then
+ GridOptions.AddItemOptions;
+ with GridOptions.ItemOptions[index] do
+ begin
+ MessageType := hppFontItems[i].Mes;
+ textFont := LoadFont(i, GridOptions.ItemOptions[index].textFont);
+ textColor := LoadColorDB(i);
+ end;
+ Inc(index);
+ end;
+ end;
+
+ // for i := 3 to High(hppFontItems)-1 do begin
+ // if (i-3) > High(GridOptions.ItemOptions) then GridOptions.AddItemOptions;
+ // GridOptions.ItemOptions[i-3].MessageType := hppFontItems[i].Mes;
+ // LoadFont(i,GridOptions.ItemOptions[i-3].textFont);
+ // GridOptions.ItemOptions[i-3].textColor := LoadColorDB(i);
+ // end;
+
+ // load others
+ GridOptions.ShowIcons := GetDBBool(hppDBName, 'ShowIcons', true);
+ GridOptions.RTLEnabled := GetContactRTLMode(0, '');
+ // we have no per-proto rtl setup ui, use global instead
+ // GridOptions.ShowAvatars := GetDBBool(hppDBName,'ShowAvatars',False);
+
+ GridOptions.SmileysEnabled := GetDBBool(hppDBName, 'Smileys', SmileyAddEnabled);
+ GridOptions.BBCodesEnabled := GetDBBool(hppDBName, 'BBCodes', true);
+ GridOptions.MathModuleEnabled := GetDBBool(hppDBName, 'MathModule', MathModuleEnabled);
+ GridOptions.RawRTFEnabled := GetDBBool(hppDBName, 'RawRTF', true);
+ GridOptions.AvatarsHistoryEnabled := GetDBBool(hppDBName, 'AvatarsHistory', true);
+
+ GridOptions.OpenDetailsMode := GetDBBool(hppDBName, 'OpenDetailsMode', false);
+
+ GridOptions.ProfileName := GetDBWideStr(hppDBName, 'ProfileName', '');
+
+ GridOptions.ClipCopyFormat := GetDBWideStr(hppDBName, 'FormatCopy', DEFFORMAT_CLIPCOPY);
+ GridOptions.ClipCopyTextFormat := GetDBWideStr(hppDBName, 'FormatCopyText', DEFFORMAT_CLIPCOPYTEXT);
+ GridOptions.ReplyQuotedFormat := GetDBWideStr(hppDBName, 'FormatReplyQuoted', DEFFORMAT_REPLYQUOTED);
+ GridOptions.ReplyQuotedTextFormat := GetDBWideStr(hppDBName, 'FormatReplyQuotedText', DEFFORMAT_REPLYQUOTEDTEXT);
+ GridOptions.SelectionFormat := GetDBWideStr(hppDBName, 'FormatSelection', DEFFORMAT_SELECTION);
+ GridOptions.DateTimeFormat := GetDBWideStr(hppDBName, 'DateTimeFormat', DEFFORMAT_DATETIME);
+ GridOptions.TextFormatting := GetDBBool(hppDBName, 'InlineTextFormatting', true);
+
+ ShowHistoryCount := GetDBBool(hppDBName, 'ShowHistoryCount', false);
+ finally
+ GridOptions.EndChange;
+ end;
+end;
+
+procedure SaveGridOptions;
+begin
+ GridOptions.StartChange;
+ try
+ WriteDBBool(hppDBName, 'ShowIcons', GridOptions.ShowIcons);
+ WriteDBBool(hppDBName, 'RTL', GridOptions.RTLEnabled);
+ // WriteDBBool(hppDBName,'ShowAvatars',GridOptions.ShowAvatars);
+
+ WriteDBBool(hppDBName, 'BBCodes', GridOptions.BBCodesEnabled);
+ WriteDBBool(hppDBName, 'Smileys', GridOptions.SmileysEnabled);
+ WriteDBBool(hppDBName, 'MathModule', GridOptions.MathModuleEnabled);
+ WriteDBBool(hppDBName, 'RawRTF', GridOptions.RawRTFEnabled);
+ WriteDBBool(hppDBName, 'AvatarsHistory', GridOptions.AvatarsHistoryEnabled);
+
+ WriteDBBool(hppDBName, 'OpenDetailsMode', GridOptions.OpenDetailsMode);
+
+ // WriteDBWideStr(hppDBName,'FormatCopy',GridOptions.ClipCopyFormat);
+ // WriteDBWideStr(hppDBName,'FormatCopyText',GridOptions.ClipCopyTextFormat);
+ finally
+ GridOptions.EndChange;
+ end;
+end;
+
+function FindIconsDll(ForceCheck: boolean): String;
+var
+ hppIconsDir: String;
+ hppMessage: WideString;
+ CountIconsDll: Integer;
+ DoCheck: boolean;
+begin
+ DoCheck := ForceCheck or GetDBBool(hppDBName, 'CheckIconPack', true);
+ hppIconsDir := ExpandFileName(hppPluginsDir + '..\Icons\');
+ if FileExists(hppIconsDir + hppIPName) then
+ Result := hppIconsDir + hppIPName
+ else if FileExists(hppPluginsDir + hppIPName) then
+ Result := hppPluginsDir + hppIPName
+ else
+ begin
+ Result := hppPluginsDir + hppDllName;
+ if DoCheck then
+ begin
+ DoCheck := false;
+ hppMessage :=
+ WideFormat
+ (FormatCString
+ (TranslateW
+ ('Cannot load icon pack (%s) from:\r\n%s\r\nThis can cause no icons will be shown.')),
+ [hppIPName, hppIconsDir + #13#10 + hppPluginsDir]);
+ HppMessageBox(hppMainWindow, hppMessage, hppName + ' Error', MB_ICONERROR or MB_OK);
+ end;
+ end;
+ if DoCheck then
+ begin
+ CountIconsDll := ExtractIconExW(PWideChar(Result), -1, hIcon(nil^), hIcon(nil^), 0);
+ if CountIconsDll < HppIconsCount then
+ begin
+ hppMessage :=
+ WideFormat
+ (FormatCString
+ (TranslateW
+ ('You are using old icon pack from:\r\n%s\r\nThis can cause missing icons, so update the icon pack.')),
+ [Result]);
+ HppMessageBox(hppMainWindow, hppMessage, hppName + ' Warning', MB_ICONWARNING or MB_OK);
+ end;
+ end;
+end;
+
+procedure hppRegisterGridOptions;
+var
+ sid: TSKINICONDESC;
+ defFont: TFontSettings;
+ // sarc: SMADD_REGCAT;
+ i: Integer;
+ mt: TMessageType;
+ str: PAnsiChar;
+begin
+ // Register in IcoLib
+ hppIconPack := FindIconsDll(false);
+ ZeroMemory(@sid, sizeof(sid));
+ sid.cbSize := sizeof(sid);
+ sid.szDefaultFile.a := PAnsiChar(AnsiString(hppIconPack)); // !!
+ for i := 0 to High(hppIconsDefs) do
+ begin
+ hppIcons[hppIconsDefs[i].i].name := hppIconsDefs[i].name;
+ sid.pszName := hppIconsDefs[i].name;
+ sid.szDescription.a := hppIconsDefs[i].desc;
+ if hppIconsDefs[i].group = nil then
+ sid.szSection.a := hppName
+ else
+ sid.szSection.a := PAnsiChar(hppName + '/' + hppIconsDefs[i].group);
+ sid.iDefaultIndex := hppIconsDefs[i].i;
+ Skin_AddIcon(@sid);
+ end;
+
+ for mt := Low(EventRecords) to High(EventRecords) do
+ begin
+ if EventRecords[mt].i = -1 then
+ continue;
+ if EventRecords[mt].iSkin = -1 then
+ begin
+ hppIcons[EventRecords[mt].i].name := EventRecords[mt].iName;
+ sid.pszName := hppIcons[EventRecords[mt].i].name;
+ sid.szDescription.a := PAnsiChar(WideToAnsiString(EventRecords[mt].name, hppCodepage));
+ sid.szSection.a := PAnsiChar(hppName + '/' +'Events');
+ sid.iDefaultIndex := EventRecords[mt].i;
+ Skin_AddIcon(@sid);
+ end
+ else
+ skinIcons[EventRecords[mt].i].id := EventRecords[mt].iSkin;
+ end;
+
+ // Register in FontService
+ defFont.szFace := 'Tahoma';
+ defFont.charset := DEFAULT_CHARSET;
+ for i := 0 to High(hppFontItems) do
+ begin
+ if hppFontItems[i].Mes <> [] then
+ GridOptions.AddItemOptions;
+ if hppFont in hppFontItems[i]._type then
+ begin
+ RegisterFont(hppFontItems[i].name, i, defFont { TRANSLATE-IGNORE } );
+ end;
+ if hppColor in hppFontItems[i]._type then
+ begin
+ if hppFontItems[i].nameColor = '' then
+ RegisterColor(hppFontItems[i].name, i,
+ hppFontItems[i].back { TRANSLATE-IGNORE } )
+ else
+ RegisterColor(hppFontItems[i].nameColor, i,
+ hppFontItems[i].back { TRANSLATE-IGNORE } );
+ end;
+ end;
+ // Register in SmileyAdd
+ SmileyAddEnabled := boolean(ServiceExists(MS_SMILEYADD_REPLACESMILEYS));
+ { if SmileyAddEnabled then begin
+ ZeroMemory(@sarc,SizeOf(sarc));
+ sarc.cbSize := SizeOf(sarc);
+ sarc.name := hppName;
+ sarc.dispname := hppName;
+ CallService(MS_SMILEYADD_REGISTERCATEGORY,0,LPARAM(@sarc));
+ end; }
+ // Register in MathModule
+ MathModuleEnabled := boolean(ServiceExists(MATH_RTF_REPLACE_FORMULAE));
+ // Checking MetaContacts
+ MetaContactsEnabled := boolean(ServiceExists(MS_MC_GETMOSTONLINECONTACT));
+ if MetaContactsEnabled then
+ begin
+ str := PAnsiChar(CallService(MS_MC_GETPROTOCOLNAME, 0, 0));
+ if Assigned(str) then
+ MetaContactsProto := AnsiString(str)
+ else
+ MetaContactsEnabled := false;
+ end;
+ // Checking presence of speech api
+ MeSpeakEnabled := boolean(ServiceExists(MS_SPEAK_SAY_W)) or
+ boolean(ServiceExists(MS_SPEAK_SAY_A));
+end;
+
+procedure PrepareSaveDialog(SaveDialog: TSaveDialog; SaveFormat: TSaveFormat; AllFormats: boolean = false);
+var
+ sf: TSaveFormat;
+begin
+ SaveDialog.Filter := '';
+ if SaveFormat = sfAll then
+ SaveFormat := Succ(SaveFormat);
+ if AllFormats then
+ begin
+ for sf := Low(SaveFormats) to High(SaveFormats) do
+ if sf <> sfAll then
+ SaveDialog.Filter := SaveDialog.Filter + SaveFormats[sf].Filter + '|';
+ SaveDialog.FilterIndex := SaveFormats[SaveFormat].Index;
+ end
+ else
+ begin
+ if SaveFormats[SaveFormat].Owned = [] then
+ begin
+ SaveDialog.Filter := SaveFormats[SaveFormat].Filter + '|';
+ SaveDialog.Filter := SaveDialog.Filter + SaveFormats[sfAll].Filter;
+ SaveDialog.FilterIndex := 1;
+ end
+ else
+ begin
+ for sf := Low(SaveFormats) to High(SaveFormats) do
+ if sf in SaveFormats[SaveFormat].Owned then
+ SaveDialog.Filter := SaveDialog.Filter + SaveFormats[sf].Filter + '|';
+ SaveDialog.FilterIndex := SaveFormats[SaveFormat].OwnedIndex;
+ end;
+ end;
+ SaveDialog.DefaultExt := SaveFormats[SaveFormat].DefaultExt;
+end;
+
+procedure hppPrepareTranslation;
+var
+ sf: TSaveFormat;
+begin
+ for sf := Low(SaveFormatsDef) to High(SaveFormatsDef) do
+ begin
+ SaveFormats[sf] := SaveFormatsDef[sf];
+ SaveFormats[sf].Filter := Format('%s (%s)|%s',
+ [TranslateWideString(SaveFormatsDef[sf].Filter { TRANSLATE-IGNORE } ),
+ SaveFormatsDef[sf].DefaultExt, SaveFormatsDef[sf].DefaultExt]);
+ end;
+end;
+
+procedure LocalFreeIcons;
+var
+ i: Integer;
+begin
+ for i := 0 to High(hppIntIcons) do
+ if hppIntIcons[i].handle <> 0 then
+ DestroyIcon(hppIntIcons[i].handle);
+end;
+
+initialization
+
+ GridOptions := TGridOptions.Create;
+ GridOptions.OnShowIcons := OnShowIcons;
+ GridOptions.OnTextFormatting := OnTextFormatting;
+ SetLength(hppIcons, HppIconsCount);
+ SetLength(skinIcons, SkinIconsCount);
+
+finalization
+
+ LocalFreeIcons;
+
+ Finalize(hppIcons);
+ Finalize(skinIcons);
+
+ GridOptions.Free;
+
+end.
diff --git a/plugins/HistoryPlusPlus/hpp_puny.pas b/plugins/HistoryPlusPlus/hpp_puny.pas new file mode 100644 index 0000000000..228d38df42 --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_puny.pas @@ -0,0 +1,339 @@ +// Punycode Kovertierung
+//
+// Punycode: A Bootstring encoding of Unicode for Internationalized Domain Names in Applications (IDNA)
+// http://www.rfc-editor.org/rfc/rfc3492.txt
+//
+// Delphi-Unit von Daniel Mitte (2005)
+// Original-Code von http://www.activevb.de
+//
+// Beispiel:
+// pc := TPunyClass.Create;
+// e := pc.Encode('müller'); // Verschlüsselt 'müller' zu 'mller-kva'
+// d := pc.Decode(e); // Entschlüsselt 'mller-kva' zu 'müller'
+// pc.Free;
+
+unit hpp_puny;
+
+interface
+
+const
+ BASE: Longint = 36;
+ TMIN: Longint = 1;
+ TMAX: Longint = 26;
+ SKEW: Longint = 38;
+ DAMP: Longint = 700;
+ INITIAL_BIAS: Longint = 72;
+ INITIAL_N: Longint = 128;
+ Delimiter: String = '-';
+ MAX_INT: Longint = 2147483647;
+
+type
+ TPunyClass = class
+ private
+ function GetMinCodePoint(const n: Longint; const data: String): Longint;
+ function IsBasic(const c: String; const n: Longint): Boolean;
+ function Adapt(const delta, numpoints: Longint; const firsttime: Boolean): Longint;
+ function Digit2Codepoint(const d: Longint): Longint;
+ function Codepoint2Digit(const c: Longint): Longint;
+ function UInt(i: Longint): Longint;
+ function Asc(const s: String): Longint;
+ function AscW(const s: String): Longint;
+ function PosRev(const sub, text: String): Longint;
+ public
+ function Encode(const input: String): String;
+ function Decode(const input: String): String;
+ end;
+
+implementation
+
+function TPunyClass.Encode(const input: String): String;
+var
+ n, delta, bias, b, l, h, q, m, k, t: Longint;
+ text, output, c: String;
+ first: Boolean;
+
+begin
+ text := input;
+ output := '';
+
+ try
+ n := INITIAL_N;
+ bias := INITIAL_BIAS;
+ b := 0;
+
+ for l := 1 to Length(text) do
+ begin
+ c := Copy(text, l, 1);
+
+ if IsBasic(c, INITIAL_N) then
+ begin
+ output := output + c;
+ b := b + 1;
+ end;
+ end;
+
+ if Length(output) < Length(text) then
+ if Length(output) > 0 then output := output + Delimiter;
+
+ h := b;
+ delta := 0;
+
+ while h < Length(text) do
+ begin
+ m := GetMinCodePoint(n, text);
+ delta := delta + UInt(m - n) * (h + 1);
+
+ n := m;
+
+ for l := 1 to Length(text) do
+ begin
+ c := Copy(text, l, 1);
+ if IsBasic(c, n) then delta := delta + 1
+ else if UInt(AscW(c)) = n then
+ begin
+ q := delta;
+
+ k := BASE;
+ while k <= MAX_INT do
+ begin
+ if k <= (bias + TMIN) then t := TMIN
+ else if k >= (bias + TMAX) then t := TMAX
+ else t := k - bias;
+
+ if q < t then break;
+
+ output := output + Chr(Digit2Codepoint(t + ((q - t) Mod (BASE - t))));
+ q := (q - t) div (BASE - t);
+
+ k := k + BASE;
+ end;
+
+ output := output + Chr(Digit2Codepoint(q));
+ first := False;
+ if h = b then first := True;
+ bias := Adapt(delta, h + 1, first);
+ delta := 0;
+ h := h + 1;
+ end;
+ end;
+
+ delta := delta + 1;
+ n := n + 1;
+ end;
+ except
+ output := input;
+ end;
+
+ Result := output;
+end;
+
+function TPunyClass.Decode(const input: String): String;
+var
+ n, i, bias, l, ps, oldi, w, k, t: Longint;
+ digit: Byte;
+ text, output, c: String;
+ first: Boolean;
+
+begin
+ text := input;
+ output := '';
+
+ try
+ n := INITIAL_N;
+ bias := INITIAL_BIAS;
+ i := 0;
+
+ ps := PosRev(Delimiter, text);
+
+ if ps > 0 then
+ begin
+ for l := 1 to (ps - 1) do
+ begin
+ c := Copy(text, l, 1);
+
+ if IsBasic(c, INITIAL_N) then output := output + c
+ else
+ begin
+ Result := '';
+ Exit;
+ end;
+ end;
+ end;
+
+ ps := ps + 1;
+
+ while ps <= Length(text) do
+ begin
+ oldi := i;
+ w := 1;
+
+ k := BASE;
+ while ((k <= MAX_INT) and (ps <= Length(text))) do
+ begin
+ c := Copy(text, ps, 1);
+ ps := ps + 1;
+
+ digit := Codepoint2Digit(Asc(c));
+ if ((digit >= BASE) or (digit > ((MAX_INT - i) / w))) then
+ begin
+ Result := '';
+ Exit;
+ end;
+
+ i := i + digit * w;
+
+ if k <= bias then t := TMIN
+ else if k >= (bias + TMAX) then t := TMAX
+ else t := k - bias;
+
+ if digit < t then break;
+
+ if w > (maxint / (BASE - t)) then
+ begin
+ Result := '';
+ Exit;
+ end;
+
+ w := w * (BASE - t);
+
+ k := k + BASE;
+ end;
+
+ first := False;
+ if oldi = 0 then first := True;
+ bias := Adapt(i - oldi, Length(output) + 1, first);
+
+ if (i / (Length(output) + 1)) > (MAX_INT - n) then
+ begin
+ Result := '';
+ Exit;
+ end;
+
+ n := n + i div (Length(output) + 1);
+ i := i mod (Length(output) + 1);
+
+ if IsBasic(Char(n), INITIAL_N) then
+ begin
+ Result := '';
+ Exit;
+ end;
+
+ output := Copy(output, 1, i) + Char(n) + Copy(output, i + 1, Length(output) - (i + 1) + 1);
+ i := i + 1;
+ end;
+ except
+ output := input;
+ end;
+
+ Result := output;
+end;
+
+function TPunyClass.GetMinCodePoint(const n: Longint; const data: String): Longint;
+var
+ t, a, res: Longint;
+
+begin
+ res := 2147483647;
+
+ for t := 1 to Length(data) do
+ begin
+ a := UInt(AscW(Copy(data, t, 1)));
+ if ((a >= n) and (a < res)) then res := a;
+ end;
+
+ Result := res;
+end;
+
+function TPunyClass.IsBasic(const c: String; const n: Longint): Boolean;
+begin
+ Result := False;
+ if UInt(AscW(c)) < n then Result := True;
+end;
+
+function TPunyClass.Adapt(const delta, numpoints: Longint; const firsttime: Boolean): Longint;
+var
+ k, dt: Longint;
+
+begin
+ dt := delta;
+
+ if firsttime then dt := dt div DAMP
+ else dt := dt div 2;
+
+ dt := dt + (dt div numpoints);
+ k := 0;
+
+ while dt > (((BASE - TMIN) * TMAX) div 2) do
+ begin
+ dt := dt div (BASE - TMIN);
+ k := k + BASE;
+ end;
+
+ Result := k + (((BASE - TMIN + 1) * dt) div (dt + SKEW));
+end;
+
+function TPunyClass.Digit2Codepoint(const d: Longint): Longint;
+begin
+ Result := 0;
+
+ if d < 26 then Result := d + 97
+ else if d < 36 then Result := d - 26 + 48;
+end;
+
+function TPunyClass.Codepoint2Digit(const c: Longint): Longint;
+begin
+ Result := BASE;
+
+ if (c - 48) < 10 then Result := c - 22
+ else if (c - 65) < 26 then Result := c - 65
+ else if (c - 97) < 26 then Result := c - 97;
+end;
+
+function TPunyClass.UInt(i: Longint): Longint;
+begin
+ Result := i;
+ if i < 0 then Result := 65536 + i;
+end;
+
+function TPunyClass.Asc(const s: String): Longint;
+var
+ c: Char;
+begin
+ Result := 0;
+
+ if Length(s) > 0 then
+ begin
+ c := s[1];
+ Result := Word(c);
+ end;
+end;
+
+function TPunyClass.AscW(const s: String): Longint;
+var
+ c: Char;
+begin
+ Result := 0;
+
+ if Length(s) > 0 then
+ begin
+ c := s[1];
+ Result := Longint(c);
+ end;
+end;
+
+function TPunyClass.PosRev(const sub, text: String): Longint;
+var
+ p: Longint;
+ s: String;
+
+begin
+ Result := 0;
+
+ s := '';
+ for p := 1 to Length(text) do s := s + Copy(text, Length(text) - p + 1, 1);
+
+ p := Pos(sub, s);
+ if p > 0 then Result := Length(s) - p + 1;
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/hpp_res_ver.rc b/plugins/HistoryPlusPlus/hpp_res_ver.rc new file mode 100644 index 0000000000..fe17f28af2 --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_res_ver.rc @@ -0,0 +1,28 @@ +1 VERSIONINFO
+FILEVERSION 1, 5, 1, 5
+PRODUCTVERSION 1, 5, 1, 5
+FILEFLAGSMASK VS_FFI_FILEFLAGSMASK
+FILEOS VOS__WINDOWS32
+FILETYPE VFT_DLL
+{
+ BLOCK "StringFileInfo"
+ {
+ BLOCK "000004b0"
+ {
+ VALUE "CompanyName", "Miranda Open Source Project\000"
+ VALUE "FileDescription", "History++ plugin for Miranda IM\000"
+ VALUE "FileVersion", "1.5.1.5\000"
+ VALUE "InternalName", "historypp\000"
+ VALUE "LegalCopyright", "© 2006-2009 theMIROn, 2003-2006 Art Fedorov.\000"
+ VALUE "LegalTrademarks", "Gnu General Public License V2\000"
+ VALUE "OriginalFilename", "historypp.dll\000"
+ VALUE "ProductName", "History PlusPlus Module\000"
+ VALUE "ProductVersion", "1.5.1.5\000"
+ VALUE "Comments", "Easy, fast and feature complete history viewer\000"
+ }
+ }
+ BLOCK "VarFileInfo"
+ {
+ VALUE "Translation", 0x0, 1200
+ }
+}
\ No newline at end of file diff --git a/plugins/HistoryPlusPlus/hpp_resource.rc b/plugins/HistoryPlusPlus/hpp_resource.rc new file mode 100644 index 0000000000..b18b6031c7 --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_resource.rc @@ -0,0 +1,2 @@ +z_password_protect Icon res\password_protect.ico
+CR_HAND Cursor res\cr_hand.cur
\ No newline at end of file diff --git a/plugins/HistoryPlusPlus/hpp_richedit.pas b/plugins/HistoryPlusPlus/hpp_richedit.pas new file mode 100644 index 0000000000..aed3ce1237 --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_richedit.pas @@ -0,0 +1,2071 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+{-----------------------------------------------------------------------------
+ hpp_richedit(historypp project)
+
+ Version: 1.0
+ Created: 12.09.2006
+ Author: theMIROn
+
+ [ Description ]
+
+
+ [ History ]
+
+ 1.0 (12.09.2006)
+ First version
+
+ [ Modifications ]
+ none
+
+ [ Known Issues ]
+ none
+
+ Contributors: theMIROn
+-----------------------------------------------------------------------------}
+
+unit hpp_richedit;
+
+interface
+
+{.$DEFINE AllowMSFTEDIT}
+
+uses
+ Windows, Messages, Classes, RichEdit, ActiveX,
+ Controls, StdCtrls, ComCtrls, Forms,
+ hpp_global;
+
+const
+ IID_IOleObject: TGUID = '{00000112-0000-0000-C000-000000000046}';
+ IID_IRichEditOle: TGUID = '{00020D00-0000-0000-C000-000000000046}';
+ IID_IRichEditOleCallback: TGUID = '{00020D03-0000-0000-C000-000000000046}';
+ IID_ITextDocument: TGUID = '{8CC497C0-A1DF-11CE-8098-00AA0047BE5D}';
+ IID_ITextRange: TGUID = '{8CC497C2-A1DF-11CE-8098-00AA0047BE5D}';
+ IID_ITextSelection: TGUID = '{8CC497C1-A1DF-11CE-8098-00AA0047BE5D}';
+ IID_ITextFont: TGUID = '{8CC497C3-A1DF-11CE-8098-00AA0047BE5D}';
+ IID_ITextPara: TGUID = '{8CC497C4-A1DF-11CE-8098-00AA0047BE5D}';
+ IID_ITextStoryRanges: TGUID = '{8CC497C5-A1DF-11CE-8098-00AA0047BE5D}';
+
+type
+ TReObject = packed record
+ cbStruct: DWORD; // Size of structure
+ cp: Integer; // Character position of object
+ clsid: TCLSID; // Class ID of object
+ poleobj: IOleObject; // OLE object interface
+ pstg: IStorage; // Associated storage interface
+ polesite: IOLEClientSite; // Associated client site interface
+ sizel: TSize; // Size of object (may be 0,0)
+ dvaspect: DWORD; // Display aspect to use
+ dwFlags: DWORD; // Object status flags
+ dwUser: DWORD; // Dword for user's use
+ end;
+
+const
+ // Flags to specify which interfaces should be returned in the structure above
+ REO_GETOBJ_NO_INTERFACES = $00000000;
+ REO_GETOBJ_POLEOBJ = $00000001;
+ REO_GETOBJ_PSTG = $00000002;
+ REO_GETOBJ_POLESITE = $00000004;
+ REO_GETOBJ_ALL_INTERFACES = $00000007;
+
+ // Place object at selection
+ REO_CP_SELECTION = ULONG(-1);
+
+ // Use character position to specify object instead of index
+ REO_IOB_SELECTION = ULONG(-1);
+ REO_IOB_USE_CP = ULONG(-1);
+
+ // Object flags
+ REO_NULL = $00000000; // No flags
+ REO_READWRITEMASK = $0000003F; // Mask out RO bits
+ REO_DONTNEEDPALETTE = $00000020; // Object doesn't need palette
+ REO_BLANK = $00000010; // Object is blank
+ REO_DYNAMICSIZE = $00000008; // Object defines size always
+ REO_INVERTEDSELECT = $00000004; // Object drawn all inverted if sel
+ REO_BELOWBASELINE = $00000002; // Object sits below the baseline
+ REO_RESIZABLE = $00000001; // Object may be resized
+ REO_LINK = $80000000; // Object is a link (RO)
+ REO_STATIC = $40000000; // Object is static (RO)
+ REO_SELECTED = $08000000; // Object selected (RO)
+ REO_OPEN = $04000000; // Object open in its server (RO)
+ REO_INPLACEACTIVE = $02000000; // Object in place active (RO)
+ REO_HILITED = $01000000; // Object is to be hilited (RO)
+ REO_LINKAVAILABLE = $00800000; // Link believed available (RO)
+ REO_GETMETAFILE = $00400000; // Object requires metafile (RO)
+
+ // flags for IRichEditOle::GetClipboardData(),
+ // IRichEditOleCallback::GetClipboardData() and
+ // IRichEditOleCallback::QueryAcceptData()
+ RECO_PASTE = $00000000; // paste from clipboard
+ RECO_DROP = $00000001; // drop
+ RECO_COPY = $00000002; // copy to the clipboard
+ RECO_CUT = $00000003; // cut to the clipboard
+ RECO_DRAG = $00000004; // drag
+
+const
+ tomFalse = $00000000;
+ tomTrue = $FFFFFFFF;
+ tomUndefined = $FF676981;
+ tomToggle = $FF676982;
+ tomAutoColor = $FF676983;
+ tomDefault = $FF676984;
+ tomSuspend = $FF676985;
+ tomResume = $FF676986;
+ tomApplyNow = $00000000;
+ tomApplyLater = $00000001;
+ tomTrackParms = $00000002;
+ tomCacheParms = $00000003;
+ tomApplyTmp = $00000004;
+ tomBackward = $C0000001;
+ tomForward = $3FFFFFFF;
+ tomMove = $00000000;
+ tomExtend = $00000001;
+ tomNoSelection = $00000000;
+ tomSelectionIP = $00000001;
+ tomSelectionNormal = $00000002;
+ tomSelectionFrame = $00000003;
+ tomSelectionColumn = $00000004;
+ tomSelectionRow = $00000005;
+ tomSelectionBlock = $00000006;
+ tomSelectionInlineShape = $00000007;
+ tomSelectionShape = $00000008;
+ tomSelStartActive = $00000001;
+ tomSelAtEOL = $00000002;
+ tomSelOvertype = $00000004;
+ tomSelActive = $00000008;
+ tomSelReplace = $00000010;
+ tomEnd = $00000000;
+ tomStart = $00000020;
+ tomCollapseEnd = $00000000;
+ tomCollapseStart = $00000001;
+ tomClientCoord = $00000100;
+ tomAllowOffClient = $00000200;
+ tomNone = $00000000;
+ tomSingle = $00000001;
+ tomWords = $00000002;
+ tomDouble = $00000003;
+ tomDotted = $00000004;
+ tomDash = $00000005;
+ tomDashDot = $00000006;
+ tomDashDotDot = $00000007;
+ tomWave = $00000008;
+ tomThick = $00000009;
+ tomHair = $0000000A;
+ tomDoubleWave = $0000000B;
+ tomHeavyWave = $0000000C;
+ tomLongDash = $0000000D;
+ tomThickDash = $0000000E;
+ tomThickDashDot = $0000000F;
+ tomThickDashDotDot = $00000010;
+ tomThickDotted = $00000011;
+ tomThickLongDash = $00000012;
+ tomLineSpaceSingle = $00000000;
+ tomLineSpace1pt5 = $00000001;
+ tomLineSpaceDouble = $00000002;
+ tomLineSpaceAtLeast = $00000003;
+ tomLineSpaceExactly = $00000004;
+ tomLineSpaceMultiple = $00000005;
+ tomAlignLeft = $00000000;
+ tomAlignCenter = $00000001;
+ tomAlignRight = $00000002;
+ tomAlignJustify = $00000003;
+ tomAlignDecimal = $00000003;
+ tomAlignBar = $00000004;
+ tomAlignInterWord = $00000003;
+ tomAlignInterLetter = $00000004;
+ tomAlignScaled = $00000005;
+ tomAlignGlyphs = $00000006;
+ tomAlignSnapGrid = $00000007;
+ tomSpaces = $00000000;
+ tomDots = $00000001;
+ tomDashes = $00000002;
+ tomLines = $00000003;
+ tomThickLines = $00000004;
+ tomEquals = $00000005;
+ tomTabBack = $FFFFFFFD;
+ tomTabNext = $FFFFFFFE;
+ tomTabHere = $FFFFFFFF;
+ tomListNone = $00000000;
+ tomListBullet = $00000001;
+ tomListNumberAsArabic = $00000002;
+ tomListNumberAsLCLetter = $00000003;
+ tomListNumberAsUCLetter = $00000004;
+ tomListNumberAsLCRoman = $00000005;
+ tomListNumberAsUCRoman = $00000006;
+ tomListNumberAsSequence = $00000007;
+ tomListParentheses = $00010000;
+ tomListPeriod = $00020000;
+ tomListPlain = $00030000;
+ tomCharacter = $00000001;
+ tomWord = $00000002;
+ tomSentence = $00000003;
+ tomParagraph = $00000004;
+ tomLine = $00000005;
+ tomStory = $00000006;
+ tomScreen = $00000007;
+ tomSection = $00000008;
+ tomColumn = $00000009;
+ tomRow = $0000000A;
+ tomWindow = $0000000B;
+ tomCell = $0000000C;
+ tomCharFormat = $0000000D;
+ tomParaFormat = $0000000E;
+ tomTable = $0000000F;
+ tomObject = $00000010;
+ tomPage = $00000011;
+ tomMatchWord = $00000002;
+ tomMatchCase = $00000004;
+ tomMatchPattern = $00000008;
+ tomUnknownStory = $00000000;
+ tomMainTextStory = $00000001;
+ tomFootnotesStory = $00000002;
+ tomEndnotesStory = $00000003;
+ tomCommentsStory = $00000004;
+ tomTextFrameStory = $00000005;
+ tomEvenPagesHeaderStory = $00000006;
+ tomPrimaryHeaderStory = $00000007;
+ tomEvenPagesFooterStory = $00000008;
+ tomPrimaryFooterStory = $00000009;
+ tomFirstPageHeaderStory = $0000000A;
+ tomFirstPageFooterStory = $0000000B;
+ tomNoAnimation = $00000000;
+ tomLasVegasLights = $00000001;
+ tomBlinkingBackground = $00000002;
+ tomSparkleText = $00000003;
+ tomMarchingBlackAnts = $00000004;
+ tomMarchingRedAnts = $00000005;
+ tomShimmer = $00000006;
+ tomWipeDown = $00000007;
+ tomWipeRight = $00000008;
+ tomAnimationMax = $00000008;
+ tomLowerCase = $00000000;
+ tomUpperCase = $00000001;
+ tomTitleCase = $00000002;
+ tomSentenceCase = $00000004;
+ tomToggleCase = $00000005;
+ tomReadOnly = $00000100;
+ tomShareDenyRead = $00000200;
+ tomShareDenyWrite = $00000400;
+ tomPasteFile = $00001000;
+ tomCreateNew = $00000010;
+ tomCreateAlways = $00000020;
+ tomOpenExisting = $00000030;
+ tomOpenAlways = $00000040;
+ tomTruncateExisting = $00000050;
+ tomRTF = $00000001;
+ tomText = $00000002;
+ tomHTML = $00000003;
+ tomWordDocument = $00000004;
+ tomBold = $80000001;
+ tomItalic = $80000002;
+ tomUnderline = $80000004;
+ tomStrikeout = $80000008;
+ tomProtected = $80000010;
+ tomLink = $80000020;
+ tomSmallCaps = $80000040;
+ tomAllCaps = $80000080;
+ tomHidden = $80000100;
+ tomOutline = $80000200;
+ tomShadow = $80000400;
+ tomEmboss = $80000800;
+ tomImprint = $80001000;
+ tomDisabled = $80002000;
+ tomRevised = $80004000;
+ tomNormalCaret = $00000000;
+ tomKoreanBlockCaret = $00000001;
+ tomIncludeInset = $00000001;
+ tomIgnoreCurrentFont = $00000000;
+ tomMatchFontCharset = $00000001;
+ tomMatchFontSignature = $00000002;
+ tomCharset = $80000000;
+ tomRE10Mode = $00000001;
+ tomUseAtFont = $00000002;
+ tomTextFlowMask = $0000000C;
+ tomTextFlowES = $00000000;
+ tomTextFlowSW = $00000004;
+ tomTextFlowWN = $00000008;
+ tomTextFlowNE = $0000000C;
+ tomUsePassword = $00000010;
+ tomNoIME = $00080000;
+ tomSelfIME = $00040000;
+
+type
+ THppRichEdit = class;
+
+ IRichEditOle = interface(IUnknown)
+ ['{00020d00-0000-0000-c000-000000000046}']
+ function GetClientSite(out clientSite: IOleClientSite): HResult; stdcall;
+ function GetObjectCount: HResult; stdcall;
+ function GetLinkCount: HResult; stdcall;
+ function GetObject(iob: Longint; out ReObject: TReObject; dwFlags: DWORD): HResult; stdcall;
+ function InsertObject(var ReObject: TReObject): HResult; stdcall;
+ function ConvertObject(iob: Longint; rclsidNew: TIID; lpstrUserTypeNew: LPCSTR): HResult; stdcall;
+ function ActivateAs(rclsid: TIID; rclsidAs: TIID): HResult; stdcall;
+ function SetHostNames(lpstrContainerApp: LPCSTR; lpstrContainerObj: LPCSTR): HResult; stdcall;
+ function SetLinkAvailable(iob: Longint; fAvailable: BOOL): HResult; stdcall;
+ function SetDvaspect(iob: Longint; dvaspect: DWORD): HResult; stdcall;
+ function HandsOffStorage(iob: Longint): HResult; stdcall;
+ function SaveCompleted(iob: Longint; const stg: IStorage): HResult; stdcall;
+ function InPlaceDeactivate: HResult; stdcall;
+ function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
+ function GetClipboardData(var chrg: TCharRange; reco: DWORD; out dataobj: IDataObject): HResult; stdcall;
+ function ImportDataObject(dataobj: IDataObject; cf: TClipFormat; hMetaPict: HGLOBAL): HResult; stdcall;
+ end;
+
+ IRichEditOleCallback = interface(IUnknown)
+ ['{00020d03-0000-0000-c000-000000000046}']
+ function GetNewStorage(out stg: IStorage): HResult; stdcall;
+ function GetInPlaceContext(out Frame: IOleInPlaceFrame; out Doc: IOleInPlaceUIWindow; lpFrameInfo: POleInPlaceFrameInfo): HResult; stdcall;
+ function ShowContainerUI(fShow: BOOL): HResult; stdcall;
+ function QueryInsertObject(const clsid: TCLSID; const stg: IStorage; cp: Longint): HResult; stdcall;
+ function DeleteObject(const oleobj: IOleObject): HResult; stdcall;
+ function QueryAcceptData(const dataobj: IDataObject; var cfFormat: TClipFormat; reco: DWORD; fReally: BOOL; hMetaPict: HGLOBAL): HResult; stdcall;
+ function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
+ function GetClipboardData(const chrg: TCharRange; reco: DWORD; out dataobj: IDataObject): HResult; stdcall;
+ function GetDragDropEffect(fDrag: BOOL; grfKeyState: DWORD; var dwEffect: DWORD): HResult; stdcall;
+ function GetContextMenu(seltype: Word; const oleobj: IOleObject; const chrg: TCharRange; out menu: HMENU): HResult; stdcall;
+ end;
+
+ TRichEditOleCallback = class(TObject, IUnknown, IRichEditOleCallback)
+ private
+ FRefCount: Longint;
+ FRichEdit: THppRichEdit;
+ public
+ constructor Create(RichEdit: THppRichEdit);
+ destructor Destroy; override;
+ function QueryInterface(const iid: TGUID; out Obj): HResult; stdcall;
+ function _AddRef: Longint; stdcall;
+ function _Release: Longint; stdcall;
+ function GetNewStorage(out stg: IStorage): HResult; stdcall;
+ function GetInPlaceContext(out Frame: IOleInPlaceFrame; out Doc: IOleInPlaceUIWindow; lpFrameInfo: POleInPlaceFrameInfo): HResult; stdcall;
+ function GetClipboardData(const chrg: TCharRange; reco: DWORD; out dataobj: IDataObject): HResult; stdcall;
+ function GetContextMenu(seltype: Word; const oleobj: IOleObject; const chrg: TCharRange; out menu: HMENU): HResult; stdcall;
+ function ShowContainerUI(fShow: BOOL): HResult; stdcall;
+ function QueryInsertObject(const clsid: TCLSID; const stg: IStorage; cp: Longint): HResult; stdcall;
+ function DeleteObject(const oleobj: IOleObject): HResult; stdcall;
+ function QueryAcceptData(const dataobj: IDataObject; var cfFormat: TClipFormat; reco: DWORD; fReally: BOOL; hMetaPict: HGLOBAL): HResult; stdcall;
+ function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
+ function GetDragDropEffect(fDrag: BOOL; grfKeyState: DWORD; var dwEffect: DWORD): HResult; stdcall;
+ end;
+
+ ITextDocument = interface;
+ ITextDocumentDisp = dispinterface;
+ ITextRange = interface;
+ ITextRangeDisp = dispinterface;
+ ITextSelection = interface;
+ ITextSelectionDisp = dispinterface;
+ ITextFont = interface;
+ ITextFontDisp = dispinterface;
+ ITextPara = interface;
+ ITextParaDisp = dispinterface;
+ ITextStoryRanges = interface;
+ ITextStoryRangesDisp = dispinterface;
+ ITextDocument2 = interface;
+ ITextDocument2Disp = dispinterface;
+
+ ITextDocument = interface(IDispatch)
+ ['{8CC497C0-A1DF-11CE-8098-00AA0047BE5D}']
+ function Get_Name: WideString; safecall;
+ function Get_Selection: ITextSelection; safecall;
+ function Get_StoryCount: Integer; safecall;
+ function Get_StoryRanges: ITextStoryRanges; safecall;
+ function Get_Saved: Integer; safecall;
+ procedure Set_Saved(pValue: Integer); safecall;
+ function Get_DefaultTabStop: Single; safecall;
+ procedure Set_DefaultTabStop(pValue: Single); safecall;
+ procedure New; safecall;
+ procedure Open(var pVar: OleVariant; Flags: Integer; CodePage: Integer); safecall;
+ procedure Save(var pVar: OleVariant; Flags: Integer; CodePage: Integer); safecall;
+ function Freeze: Integer; safecall;
+ function Unfreeze: Integer; safecall;
+ procedure BeginEditCollection; safecall;
+ procedure EndEditCollection; safecall;
+ function Undo(Count: Integer): Integer; safecall;
+ function Redo(Count: Integer): Integer; safecall;
+ function Range(cp1: Integer; cp2: Integer): ITextRange; safecall;
+ function RangeFromPoint(x: Integer; y: Integer): ITextRange; safecall;
+ property Name: WideString read Get_Name;
+ property Selection: ITextSelection read Get_Selection;
+ property StoryCount: Integer read Get_StoryCount;
+ property StoryRanges: ITextStoryRanges read Get_StoryRanges;
+ property Saved: Integer read Get_Saved write Set_Saved;
+ property DefaultTabStop: Single read Get_DefaultTabStop write Set_DefaultTabStop;
+ end;
+
+ ITextDocumentDisp = dispinterface
+ ['{8CC497C0-A1DF-11CE-8098-00AA0047BE5D}']
+ property Name: WideString readonly dispid 0;
+ property Selection: ITextSelection readonly dispid 1;
+ property StoryCount: Integer readonly dispid 2;
+ property StoryRanges: ITextStoryRanges readonly dispid 3;
+ property Saved: Integer dispid 4;
+ property DefaultTabStop: Single dispid 5;
+ procedure New; dispid 6;
+ procedure Open(var pVar: OleVariant; Flags: Integer; CodePage: Integer); dispid 7;
+ procedure Save(var pVar: OleVariant; Flags: Integer; CodePage: Integer); dispid 8;
+ function Freeze: Integer; dispid 9;
+ function Unfreeze: Integer; dispid 10;
+ procedure BeginEditCollection; dispid 11;
+ procedure EndEditCollection; dispid 12;
+ function Undo(Count: Integer): Integer; dispid 13;
+ function Redo(Count: Integer): Integer; dispid 14;
+ function Range(cp1: Integer; cp2: Integer): ITextRange; dispid 15;
+ function RangeFromPoint(x: Integer; y: Integer): ITextRange; dispid 16;
+ end;
+
+ ITextRange = interface(IDispatch)
+ ['{8CC497C2-A1DF-11CE-8098-00AA0047BE5D}']
+ function Get_Text: WideString; safecall;
+ procedure Set_Text(const pbstr: WideString); safecall;
+ function Get_Char: Integer; safecall;
+ procedure Set_Char(pch: Integer); safecall;
+ function Get_Duplicate: ITextRange; safecall;
+ function Get_FormattedText: ITextRange; safecall;
+ procedure Set_FormattedText(const ppRange: ITextRange); safecall;
+ function Get_Start: Integer; safecall;
+ procedure Set_Start(pcpFirst: Integer); safecall;
+ function Get_End_: Integer; safecall;
+ procedure Set_End_(pcpLim: Integer); safecall;
+ function Get_Font: ITextFont; safecall;
+ procedure Set_Font(const pFont: ITextFont); safecall;
+ function Get_Para: ITextPara; safecall;
+ procedure Set_Para(const pPara: ITextPara); safecall;
+ function Get_StoryLength: Integer; safecall;
+ function Get_StoryType: Integer; safecall;
+ procedure Collapse(bStart: Integer); safecall;
+ function Expand(Unit_: Integer): Integer; safecall;
+ function GetIndex(Unit_: Integer): Integer; safecall;
+ procedure SetIndex(Unit_: Integer; Index: Integer; Extend: Integer); safecall;
+ procedure SetRange(cpActive: Integer; cpOther: Integer); safecall;
+ function InRange(const pRange: ITextRange): Integer; safecall;
+ function InStory(const pRange: ITextRange): Integer; safecall;
+ function IsEqual(const pRange: ITextRange): Integer; safecall;
+ procedure Select; safecall;
+ function StartOf(Unit_: Integer; Extend: Integer): Integer; safecall;
+ function EndOf(Unit_: Integer; Extend: Integer): Integer; safecall;
+ function Move(Unit_: Integer; Count: Integer): Integer; safecall;
+ function MoveStart(Unit_: Integer; Count: Integer): Integer; safecall;
+ function MoveEnd(Unit_: Integer; Count: Integer): Integer; safecall;
+ function MoveWhile(var Cset: OleVariant; Count: Integer): Integer; safecall;
+ function MoveStartWhile(var Cset: OleVariant; Count: Integer): Integer; safecall;
+ function MoveEndWhile(var Cset: OleVariant; Count: Integer): Integer; safecall;
+ function MoveUntil(var Cset: OleVariant; Count: Integer): Integer; safecall;
+ function MoveStartUntil(var Cset: OleVariant; Count: Integer): Integer; safecall;
+ function MoveEndUntil(var Cset: OleVariant; Count: Integer): Integer; safecall;
+ function FindText(const bstr: WideString; cch: Integer; Flags: Integer): Integer; safecall;
+ function FindTextStart(const bstr: WideString; cch: Integer; Flags: Integer): Integer; safecall;
+ function FindTextEnd(const bstr: WideString; cch: Integer; Flags: Integer): Integer; safecall;
+ function Delete(Unit_: Integer; Count: Integer): Integer; safecall;
+ procedure Cut(out pVar: OleVariant); safecall;
+ procedure Copy(out pVar: OleVariant); safecall;
+ procedure Paste(var pVar: OleVariant; Format: Integer); safecall;
+ function CanPaste(var pVar: OleVariant; Format: Integer): Integer; safecall;
+ function CanEdit: Integer; safecall;
+ procedure ChangeCase(Type_: Integer); safecall;
+ procedure GetPoint(Type_: Integer; out px: Integer; out py: Integer); safecall;
+ procedure SetPoint(x: Integer; y: Integer; Type_: Integer; Extend: Integer); safecall;
+ procedure ScrollIntoView(Value: Integer); safecall;
+ function GetEmbeddedObject: IUnknown; safecall;
+ property Text: WideString read Get_Text write Set_Text;
+ property Char: Integer read Get_Char write Set_Char;
+ property Duplicate: ITextRange read Get_Duplicate;
+ property FormattedText: ITextRange read Get_FormattedText write Set_FormattedText;
+ property Start: Integer read Get_Start write Set_Start;
+ property End_: Integer read Get_End_ write Set_End_;
+ property Font: ITextFont read Get_Font write Set_Font;
+ property Para: ITextPara read Get_Para write Set_Para;
+ property StoryLength: Integer read Get_StoryLength;
+ property StoryType: Integer read Get_StoryType;
+ end;
+
+ ITextRangeDisp = dispinterface
+ ['{8CC497C2-A1DF-11CE-8098-00AA0047BE5D}']
+ property Text: WideString dispid 0;
+ property Char: Integer dispid 513;
+ property Duplicate: ITextRange readonly dispid 514;
+ property FormattedText: ITextRange dispid 515;
+ property Start: Integer dispid 516;
+ property End_: Integer dispid 517;
+ property Font: ITextFont dispid 518;
+ property Para: ITextPara dispid 519;
+ property StoryLength: Integer readonly dispid 520;
+ property StoryType: Integer readonly dispid 521;
+ procedure Collapse(bStart: Integer); dispid 528;
+ function Expand(Unit_: Integer): Integer; dispid 529;
+ function GetIndex(Unit_: Integer): Integer; dispid 530;
+ procedure SetIndex(Unit_: Integer; Index: Integer; Extend: Integer); dispid 531;
+ procedure SetRange(cpActive: Integer; cpOther: Integer); dispid 532;
+ function InRange(const pRange: ITextRange): Integer; dispid 533;
+ function InStory(const pRange: ITextRange): Integer; dispid 534;
+ function IsEqual(const pRange: ITextRange): Integer; dispid 535;
+ procedure Select; dispid 536;
+ function StartOf(Unit_: Integer; Extend: Integer): Integer; dispid 537;
+ function EndOf(Unit_: Integer; Extend: Integer): Integer; dispid 544;
+ function Move(Unit_: Integer; Count: Integer): Integer; dispid 545;
+ function MoveStart(Unit_: Integer; Count: Integer): Integer; dispid 546;
+ function MoveEnd(Unit_: Integer; Count: Integer): Integer; dispid 547;
+ function MoveWhile(var Cset: OleVariant; Count: Integer): Integer; dispid 548;
+ function MoveStartWhile(var Cset: OleVariant; Count: Integer): Integer; dispid 549;
+ function MoveEndWhile(var Cset: OleVariant; Count: Integer): Integer; dispid 550;
+ function MoveUntil(var Cset: OleVariant; Count: Integer): Integer; dispid 551;
+ function MoveStartUntil(var Cset: OleVariant; Count: Integer): Integer; dispid 552;
+ function MoveEndUntil(var Cset: OleVariant; Count: Integer): Integer; dispid 553;
+ function FindText(const bstr: WideString; cch: Integer; Flags: Integer): Integer; dispid 560;
+ function FindTextStart(const bstr: WideString; cch: Integer; Flags: Integer): Integer; dispid 561;
+ function FindTextEnd(const bstr: WideString; cch: Integer; Flags: Integer): Integer; dispid 562;
+ function Delete(Unit_: Integer; Count: Integer): Integer; dispid 563;
+ procedure Cut(out pVar: OleVariant); dispid 564;
+ procedure Copy(out pVar: OleVariant); dispid 565;
+ procedure Paste(var pVar: OleVariant; Format: Integer); dispid 566;
+ function CanPaste(var pVar: OleVariant; Format: Integer): Integer; dispid 567;
+ function CanEdit: Integer; dispid 568;
+ procedure ChangeCase(Type_: Integer); dispid 569;
+ procedure GetPoint(Type_: Integer; out px: Integer; out py: Integer); dispid 576;
+ procedure SetPoint(x: Integer; y: Integer; Type_: Integer; Extend: Integer); dispid 577;
+ procedure ScrollIntoView(Value: Integer); dispid 578;
+ function GetEmbeddedObject: IUnknown; dispid 579;
+ end;
+
+ ITextSelection = interface(ITextRange)
+ ['{8CC497C1-A1DF-11CE-8098-00AA0047BE5D}']
+ function Get_Flags: Integer; safecall;
+ procedure Set_Flags(pFlags: Integer); safecall;
+ function Get_type_: Integer; safecall;
+ function MoveLeft(Unit_: Integer; Count: Integer; Extend: Integer): Integer; safecall;
+ function MoveRight(Unit_: Integer; Count: Integer; Extend: Integer): Integer; safecall;
+ function MoveUp(Unit_: Integer; Count: Integer; Extend: Integer): Integer; safecall;
+ function MoveDown(Unit_: Integer; Count: Integer; Extend: Integer): Integer; safecall;
+ function HomeKey(Unit_: Integer; Extend: Integer): Integer; safecall;
+ function EndKey(Unit_: Integer; Extend: Integer): Integer; safecall;
+ procedure TypeText(const bstr: WideString); safecall;
+ property Flags: Integer read Get_Flags write Set_Flags;
+ property type_: Integer read Get_type_;
+ end;
+
+ ITextSelectionDisp = dispinterface
+ ['{8CC497C1-A1DF-11CE-8098-00AA0047BE5D}']
+ property Flags: Integer dispid 257;
+ property type_: Integer readonly dispid 258;
+ function MoveLeft(Unit_: Integer; Count: Integer; Extend: Integer): Integer; dispid 259;
+ function MoveRight(Unit_: Integer; Count: Integer; Extend: Integer): Integer; dispid 260;
+ function MoveUp(Unit_: Integer; Count: Integer; Extend: Integer): Integer; dispid 261;
+ function MoveDown(Unit_: Integer; Count: Integer; Extend: Integer): Integer; dispid 262;
+ function HomeKey(Unit_: Integer; Extend: Integer): Integer; dispid 263;
+ function EndKey(Unit_: Integer; Extend: Integer): Integer; dispid 264;
+ procedure TypeText(const bstr: WideString); dispid 265;
+ property Text: WideString dispid 0;
+ property Char: Integer dispid 513;
+ property Duplicate: ITextRange readonly dispid 514;
+ property FormattedText: ITextRange dispid 515;
+ property Start: Integer dispid 516;
+ property End_: Integer dispid 517;
+ property Font: ITextFont dispid 518;
+ property Para: ITextPara dispid 519;
+ property StoryLength: Integer readonly dispid 520;
+ property StoryType: Integer readonly dispid 521;
+ procedure Collapse(bStart: Integer); dispid 528;
+ function Expand(Unit_: Integer): Integer; dispid 529;
+ function GetIndex(Unit_: Integer): Integer; dispid 530;
+ procedure SetIndex(Unit_: Integer; Index: Integer; Extend: Integer); dispid 531;
+ procedure SetRange(cpActive: Integer; cpOther: Integer); dispid 532;
+ function InRange(const pRange: ITextRange): Integer; dispid 533;
+ function InStory(const pRange: ITextRange): Integer; dispid 534;
+ function IsEqual(const pRange: ITextRange): Integer; dispid 535;
+ procedure Select; dispid 536;
+ function StartOf(Unit_: Integer; Extend: Integer): Integer; dispid 537;
+ function EndOf(Unit_: Integer; Extend: Integer): Integer; dispid 544;
+ function Move(Unit_: Integer; Count: Integer): Integer; dispid 545;
+ function MoveStart(Unit_: Integer; Count: Integer): Integer; dispid 546;
+ function MoveEnd(Unit_: Integer; Count: Integer): Integer; dispid 547;
+ function MoveWhile(var Cset: OleVariant; Count: Integer): Integer; dispid 548;
+ function MoveStartWhile(var Cset: OleVariant; Count: Integer): Integer; dispid 549;
+ function MoveEndWhile(var Cset: OleVariant; Count: Integer): Integer; dispid 550;
+ function MoveUntil(var Cset: OleVariant; Count: Integer): Integer; dispid 551;
+ function MoveStartUntil(var Cset: OleVariant; Count: Integer): Integer; dispid 552;
+ function MoveEndUntil(var Cset: OleVariant; Count: Integer): Integer; dispid 553;
+ function FindText(const bstr: WideString; cch: Integer; Flags: Integer): Integer; dispid 560;
+ function FindTextStart(const bstr: WideString; cch: Integer; Flags: Integer): Integer; dispid 561;
+ function FindTextEnd(const bstr: WideString; cch: Integer; Flags: Integer): Integer; dispid 562;
+ function Delete(Unit_: Integer; Count: Integer): Integer; dispid 563;
+ procedure Cut(out pVar: OleVariant); dispid 564;
+ procedure Copy(out pVar: OleVariant); dispid 565;
+ procedure Paste(var pVar: OleVariant; Format: Integer); dispid 566;
+ function CanPaste(var pVar: OleVariant; Format: Integer): Integer; dispid 567;
+ function CanEdit: Integer; dispid 568;
+ procedure ChangeCase(Type_: Integer); dispid 569;
+ procedure GetPoint(Type_: Integer; out px: Integer; out py: Integer); dispid 576;
+ procedure SetPoint(x: Integer; y: Integer; Type_: Integer; Extend: Integer); dispid 577;
+ procedure ScrollIntoView(Value: Integer); dispid 578;
+ function GetEmbeddedObject: IUnknown; dispid 579;
+ end;
+
+ ITextFont = interface(IDispatch)
+ ['{8CC497C3-A1DF-11CE-8098-00AA0047BE5D}']
+ function Get_Duplicate: ITextFont; safecall;
+ procedure Set_Duplicate(const ppFont: ITextFont); safecall;
+ function CanChange: Integer; safecall;
+ function IsEqual(const pFont: ITextFont): Integer; safecall;
+ procedure Reset(Value: Integer); safecall;
+ function Get_Style: Integer; safecall;
+ procedure Set_Style(pValue: Integer); safecall;
+ function Get_AllCaps: Integer; safecall;
+ procedure Set_AllCaps(pValue: Integer); safecall;
+ function Get_Animation: Integer; safecall;
+ procedure Set_Animation(pValue: Integer); safecall;
+ function Get_BackColor: Integer; safecall;
+ procedure Set_BackColor(pValue: Integer); safecall;
+ function Get_Bold: Integer; safecall;
+ procedure Set_Bold(pValue: Integer); safecall;
+ function Get_Emboss: Integer; safecall;
+ procedure Set_Emboss(pValue: Integer); safecall;
+ function Get_ForeColor: Integer; safecall;
+ procedure Set_ForeColor(pValue: Integer); safecall;
+ function Get_Hidden: Integer; safecall;
+ procedure Set_Hidden(pValue: Integer); safecall;
+ function Get_Engrave: Integer; safecall;
+ procedure Set_Engrave(pValue: Integer); safecall;
+ function Get_Italic: Integer; safecall;
+ procedure Set_Italic(pValue: Integer); safecall;
+ function Get_Kerning: Single; safecall;
+ procedure Set_Kerning(pValue: Single); safecall;
+ function Get_LanguageID: Integer; safecall;
+ procedure Set_LanguageID(pValue: Integer); safecall;
+ function Get_Name: WideString; safecall;
+ procedure Set_Name(const pbstr: WideString); safecall;
+ function Get_Outline: Integer; safecall;
+ procedure Set_Outline(pValue: Integer); safecall;
+ function Get_Position: Single; safecall;
+ procedure Set_Position(pValue: Single); safecall;
+ function Get_Protected_: Integer; safecall;
+ procedure Set_Protected_(pValue: Integer); safecall;
+ function Get_Shadow: Integer; safecall;
+ procedure Set_Shadow(pValue: Integer); safecall;
+ function Get_Size: Single; safecall;
+ procedure Set_Size(pValue: Single); safecall;
+ function Get_SmallCaps: Integer; safecall;
+ procedure Set_SmallCaps(pValue: Integer); safecall;
+ function Get_Spacing: Single; safecall;
+ procedure Set_Spacing(pValue: Single); safecall;
+ function Get_StrikeThrough: Integer; safecall;
+ procedure Set_StrikeThrough(pValue: Integer); safecall;
+ function Get_Subscript: Integer; safecall;
+ procedure Set_Subscript(pValue: Integer); safecall;
+ function Get_Superscript: Integer; safecall;
+ procedure Set_Superscript(pValue: Integer); safecall;
+ function Get_Underline: Integer; safecall;
+ procedure Set_Underline(pValue: Integer); safecall;
+ function Get_Weight: Integer; safecall;
+ procedure Set_Weight(pValue: Integer); safecall;
+ property Duplicate: ITextFont read Get_Duplicate write Set_Duplicate;
+ property Style: Integer read Get_Style write Set_Style;
+ property AllCaps: Integer read Get_AllCaps write Set_AllCaps;
+ property Animation: Integer read Get_Animation write Set_Animation;
+ property BackColor: Integer read Get_BackColor write Set_BackColor;
+ property Bold: Integer read Get_Bold write Set_Bold;
+ property Emboss: Integer read Get_Emboss write Set_Emboss;
+ property ForeColor: Integer read Get_ForeColor write Set_ForeColor;
+ property Hidden: Integer read Get_Hidden write Set_Hidden;
+ property Engrave: Integer read Get_Engrave write Set_Engrave;
+ property Italic: Integer read Get_Italic write Set_Italic;
+ property Kerning: Single read Get_Kerning write Set_Kerning;
+ property LanguageID: Integer read Get_LanguageID write Set_LanguageID;
+ property Name: WideString read Get_Name write Set_Name;
+ property Outline: Integer read Get_Outline write Set_Outline;
+ property Position: Single read Get_Position write Set_Position;
+ property Protected_: Integer read Get_Protected_ write Set_Protected_;
+ property Shadow: Integer read Get_Shadow write Set_Shadow;
+ property Size: Single read Get_Size write Set_Size;
+ property SmallCaps: Integer read Get_SmallCaps write Set_SmallCaps;
+ property Spacing: Single read Get_Spacing write Set_Spacing;
+ property StrikeThrough: Integer read Get_StrikeThrough write Set_StrikeThrough;
+ property Subscript: Integer read Get_Subscript write Set_Subscript;
+ property Superscript: Integer read Get_Superscript write Set_Superscript;
+ property Underline: Integer read Get_Underline write Set_Underline;
+ property Weight: Integer read Get_Weight write Set_Weight;
+ end;
+
+ ITextFontDisp = dispinterface
+ ['{8CC497C3-A1DF-11CE-8098-00AA0047BE5D}']
+ property Duplicate: ITextFont dispid 0;
+ function CanChange: Integer; dispid 769;
+ function IsEqual(const pFont: ITextFont): Integer; dispid 770;
+ procedure Reset(Value: Integer); dispid 771;
+ property Style: Integer dispid 772;
+ property AllCaps: Integer dispid 773;
+ property Animation: Integer dispid 774;
+ property BackColor: Integer dispid 775;
+ property Bold: Integer dispid 776;
+ property Emboss: Integer dispid 777;
+ property ForeColor: Integer dispid 784;
+ property Hidden: Integer dispid 785;
+ property Engrave: Integer dispid 786;
+ property Italic: Integer dispid 787;
+ property Kerning: Single dispid 788;
+ property LanguageID: Integer dispid 789;
+ property Name: WideString dispid 790;
+ property Outline: Integer dispid 791;
+ property Position: Single dispid 792;
+ property Protected_: Integer dispid 793;
+ property Shadow: Integer dispid 800;
+ property Size: Single dispid 801;
+ property SmallCaps: Integer dispid 802;
+ property Spacing: Single dispid 803;
+ property StrikeThrough: Integer dispid 804;
+ property Subscript: Integer dispid 805;
+ property Superscript: Integer dispid 806;
+ property Underline: Integer dispid 807;
+ property Weight: Integer dispid 808;
+ end;
+
+ ITextPara = interface(IDispatch)
+ ['{8CC497C4-A1DF-11CE-8098-00AA0047BE5D}']
+ function Get_Duplicate: ITextPara; safecall;
+ procedure Set_Duplicate(const ppPara: ITextPara); safecall;
+ function CanChange: Integer; safecall;
+ function IsEqual(const pPara: ITextPara): Integer; safecall;
+ procedure Reset(Value: Integer); safecall;
+ function Get_Style: Integer; safecall;
+ procedure Set_Style(pValue: Integer); safecall;
+ function Get_Alignment: Integer; safecall;
+ procedure Set_Alignment(pValue: Integer); safecall;
+ function Get_Hyphenation: Integer; safecall;
+ procedure Set_Hyphenation(pValue: Integer); safecall;
+ function Get_FirstLineIndent: Single; safecall;
+ function Get_KeepTogether: Integer; safecall;
+ procedure Set_KeepTogether(pValue: Integer); safecall;
+ function Get_KeepWithNext: Integer; safecall;
+ procedure Set_KeepWithNext(pValue: Integer); safecall;
+ function Get_LeftIndent: Single; safecall;
+ function Get_LineSpacing: Single; safecall;
+ function Get_LineSpacingRule: Integer; safecall;
+ function Get_ListAlignment: Integer; safecall;
+ procedure Set_ListAlignment(pValue: Integer); safecall;
+ function Get_ListLevelIndex: Integer; safecall;
+ procedure Set_ListLevelIndex(pValue: Integer); safecall;
+ function Get_ListStart: Integer; safecall;
+ procedure Set_ListStart(pValue: Integer); safecall;
+ function Get_ListTab: Single; safecall;
+ procedure Set_ListTab(pValue: Single); safecall;
+ function Get_ListType: Integer; safecall;
+ procedure Set_ListType(pValue: Integer); safecall;
+ function Get_NoLineNumber: Integer; safecall;
+ procedure Set_NoLineNumber(pValue: Integer); safecall;
+ function Get_PageBreakBefore: Integer; safecall;
+ procedure Set_PageBreakBefore(pValue: Integer); safecall;
+ function Get_RightIndent: Single; safecall;
+ procedure Set_RightIndent(pValue: Single); safecall;
+ procedure SetIndents(StartIndent: Single; LeftIndent: Single; RightIndent: Single); safecall;
+ procedure SetLineSpacing(LineSpacingRule: Integer; LineSpacing: Single); safecall;
+ function Get_SpaceAfter: Single; safecall;
+ procedure Set_SpaceAfter(pValue: Single); safecall;
+ function Get_SpaceBefore: Single; safecall;
+ procedure Set_SpaceBefore(pValue: Single); safecall;
+ function Get_WidowControl: Integer; safecall;
+ procedure Set_WidowControl(pValue: Integer); safecall;
+ function Get_TabCount: Integer; safecall;
+ procedure AddTab(tbPos: Single; tbAlign: Integer; tbLeader: Integer); safecall;
+ procedure ClearAllTabs; safecall;
+ procedure DeleteTab(tbPos: Single); safecall;
+ procedure GetTab(iTab: Integer; out ptbPos: Single; out ptbAlign: Integer;
+ out ptbLeader: Integer); safecall;
+ property Duplicate: ITextPara read Get_Duplicate write Set_Duplicate;
+ property Style: Integer read Get_Style write Set_Style;
+ property Alignment: Integer read Get_Alignment write Set_Alignment;
+ property Hyphenation: Integer read Get_Hyphenation write Set_Hyphenation;
+ property FirstLineIndent: Single read Get_FirstLineIndent;
+ property KeepTogether: Integer read Get_KeepTogether write Set_KeepTogether;
+ property KeepWithNext: Integer read Get_KeepWithNext write Set_KeepWithNext;
+ property LeftIndent: Single read Get_LeftIndent;
+ property LineSpacing: Single read Get_LineSpacing;
+ property LineSpacingRule: Integer read Get_LineSpacingRule;
+ property ListAlignment: Integer read Get_ListAlignment write Set_ListAlignment;
+ property ListLevelIndex: Integer read Get_ListLevelIndex write Set_ListLevelIndex;
+ property ListStart: Integer read Get_ListStart write Set_ListStart;
+ property ListTab: Single read Get_ListTab write Set_ListTab;
+ property ListType: Integer read Get_ListType write Set_ListType;
+ property NoLineNumber: Integer read Get_NoLineNumber write Set_NoLineNumber;
+ property PageBreakBefore: Integer read Get_PageBreakBefore write Set_PageBreakBefore;
+ property RightIndent: Single read Get_RightIndent write Set_RightIndent;
+ property SpaceAfter: Single read Get_SpaceAfter write Set_SpaceAfter;
+ property SpaceBefore: Single read Get_SpaceBefore write Set_SpaceBefore;
+ property WidowControl: Integer read Get_WidowControl write Set_WidowControl;
+ property TabCount: Integer read Get_TabCount;
+ end;
+
+ ITextParaDisp = dispinterface
+ ['{8CC497C4-A1DF-11CE-8098-00AA0047BE5D}']
+ property Duplicate: ITextPara dispid 0;
+ function CanChange: Integer; dispid 1025;
+ function IsEqual(const pPara: ITextPara): Integer; dispid 1026;
+ procedure Reset(Value: Integer); dispid 1027;
+ property Style: Integer dispid 1028;
+ property Alignment: Integer dispid 1029;
+ property Hyphenation: Integer dispid 1030;
+ property FirstLineIndent: Single readonly dispid 1031;
+ property KeepTogether: Integer dispid 1032;
+ property KeepWithNext: Integer dispid 1033;
+ property LeftIndent: Single readonly dispid 1040;
+ property LineSpacing: Single readonly dispid 1041;
+ property LineSpacingRule: Integer readonly dispid 1042;
+ property ListAlignment: Integer dispid 1043;
+ property ListLevelIndex: Integer dispid 1044;
+ property ListStart: Integer dispid 1045;
+ property ListTab: Single dispid 1046;
+ property ListType: Integer dispid 1047;
+ property NoLineNumber: Integer dispid 1048;
+ property PageBreakBefore: Integer dispid 1049;
+ property RightIndent: Single dispid 1056;
+ procedure SetIndents(StartIndent: Single; LeftIndent: Single; RightIndent: Single); dispid 1057;
+ procedure SetLineSpacing(LineSpacingRule: Integer; LineSpacing: Single); dispid 1058;
+ property SpaceAfter: Single dispid 1059;
+ property SpaceBefore: Single dispid 1060;
+ property WidowControl: Integer dispid 1061;
+ property TabCount: Integer readonly dispid 1062;
+ procedure AddTab(tbPos: Single; tbAlign: Integer; tbLeader: Integer); dispid 1063;
+ procedure ClearAllTabs; dispid 1064;
+ procedure DeleteTab(tbPos: Single); dispid 1065;
+ procedure GetTab(iTab: Integer; out ptbPos: Single; out ptbAlign: Integer;
+ out ptbLeader: Integer); dispid 1072;
+ end;
+
+ ITextStoryRanges = interface(IDispatch)
+ ['{8CC497C5-A1DF-11CE-8098-00AA0047BE5D}']
+ function _NewEnum: IUnknown; safecall;
+ function Item(Index: Integer): ITextRange; safecall;
+ function Get_Count: Integer; safecall;
+ property Count: Integer read Get_Count;
+ end;
+
+ ITextStoryRangesDisp = dispinterface
+ ['{8CC497C5-A1DF-11CE-8098-00AA0047BE5D}']
+ function _NewEnum: IUnknown; dispid -4;
+ function Item(Index: Integer): ITextRange; dispid 0;
+ property Count: Integer readonly dispid 2;
+ end;
+
+ ITextDocument2 = interface(ITextDocument)
+ ['{01C25500-4268-11D1-883A-3C8B00C10000}']
+ procedure AttachMsgFilter(const pFilter: IUnknown); safecall;
+ procedure SetEffectColor(Index: Integer; cr: LongWord); safecall;
+ procedure GetEffectColor(Index: Integer; out pcr: LongWord); safecall;
+ function Get_CaretType: Integer; safecall;
+ procedure Set_CaretType(pCaretType: Integer); safecall;
+ function GetImmContext: Integer; safecall;
+ procedure ReleaseImmContext(Context: Integer); safecall;
+ procedure GetPreferredFont(cp: Integer; CodePage: Integer; Option: Integer;
+ curCodepage: Integer; curFontSize: Integer; out pbstr: WideString;
+ out pPitchAndFamily: Integer; out pNewFontSize: Integer); safecall;
+ function Get_NotificationMode: Integer; safecall;
+ procedure Set_NotificationMode(pMode: Integer); safecall;
+ procedure GetClientRect(Type_: Integer; out pLeft: Integer; out pTop: Integer;
+ out pRight: Integer; out pBottom: Integer); safecall;
+ function Get_SelectionEx: ITextSelection; safecall;
+ procedure GetWindow(out phWnd: Integer); safecall;
+ procedure GetFEFlags(out pFlags: Integer); safecall;
+ procedure UpdateWindow; safecall;
+ procedure CheckTextLimit(cch: Integer; var pcch: Integer); safecall;
+ procedure IMEInProgress(Mode: Integer); safecall;
+ procedure SysBeep; safecall;
+ procedure Update(Mode: Integer); safecall;
+ procedure Notify(Notify: Integer); safecall;
+ function GetDocumentFont: ITextFont; safecall;
+ function GetDocumentPara: ITextPara; safecall;
+ function GetCallManager: IUnknown; safecall;
+ procedure ReleaseCallManager(const pVoid: IUnknown); safecall;
+ property CaretType: Integer read Get_CaretType write Set_CaretType;
+ property NotificationMode: Integer read Get_NotificationMode write Set_NotificationMode;
+ property SelectionEx: ITextSelection read Get_SelectionEx;
+ end;
+
+ ITextDocument2Disp = dispinterface
+ ['{01C25500-4268-11D1-883A-3C8B00C10000}']
+ procedure AttachMsgFilter(const pFilter: IUnknown); dispid 21;
+ procedure SetEffectColor(Index: Integer; cr: LongWord); dispid 22;
+ procedure GetEffectColor(Index: Integer; out pcr: LongWord); dispid 23;
+ property CaretType: Integer dispid 24;
+ function GetImmContext: Integer; dispid 25;
+ procedure ReleaseImmContext(Context: Integer); dispid 26;
+ procedure GetPreferredFont(cp: Integer; CodePage: Integer; Option: Integer;
+ curCodepage: Integer; curFontSize: Integer; out pbstr: WideString;
+ out pPitchAndFamily: Integer; out pNewFontSize: Integer); dispid 27;
+ property NotificationMode: Integer dispid 28;
+ procedure GetClientRect(Type_: Integer; out pLeft: Integer; out pTop: Integer;
+ out pRight: Integer; out pBottom: Integer); dispid 29;
+ property SelectionEx: ITextSelection readonly dispid 30;
+ procedure GetWindow(out phWnd: Integer); dispid 31;
+ procedure GetFEFlags(out pFlags: Integer); dispid 32;
+ procedure UpdateWindow; dispid 33;
+ procedure CheckTextLimit(cch: Integer; var pcch: Integer); dispid 34;
+ procedure IMEInProgress(Mode: Integer); dispid 35;
+ procedure SysBeep; dispid 36;
+ procedure Update(Mode: Integer); dispid 37;
+ procedure Notify(Notify: Integer); dispid 38;
+ function GetDocumentFont: ITextFont; dispid 39;
+ function GetDocumentPara: ITextPara; dispid 40;
+ function GetCallManager: IUnknown; dispid 41;
+ procedure ReleaseCallManager(const pVoid: IUnknown); dispid 42;
+ property Name: WideString readonly dispid 0;
+ property Selection: ITextSelection readonly dispid 1;
+ property StoryCount: Integer readonly dispid 2;
+ property StoryRanges: ITextStoryRanges readonly dispid 3;
+ property Saved: Integer dispid 4;
+ property DefaultTabStop: Single dispid 5;
+ procedure New; dispid 6;
+ procedure Open(var pVar: OleVariant; Flags: Integer; CodePage: Integer); dispid 7;
+ procedure Save(var pVar: OleVariant; Flags: Integer; CodePage: Integer); dispid 8;
+ function Freeze: Integer; dispid 9;
+ function Unfreeze: Integer; dispid 10;
+ procedure BeginEditCollection; dispid 11;
+ procedure EndEditCollection; dispid 12;
+ function Undo(Count: Integer): Integer; dispid 13;
+ function Redo(Count: Integer): Integer; dispid 14;
+ function Range(cp1: Integer; cp2: Integer): ITextRange; dispid 15;
+ function RangeFromPoint(x: Integer; y: Integer): ITextRange; dispid 16;
+ end;
+
+ TURLClickEvent = procedure(Sender: TObject; const URLText: String; Button: TMouseButton) of object;
+
+ THppRichEdit = class(TCustomRichEdit)
+ private
+ FVersion: Integer;
+ FCodepage: Cardinal;
+ FClickRange: TCharRange;
+ FClickBtn: TMouseButton;
+ FOnURLClick: TURLClickEvent;
+ FRichEditOleCallback: TRichEditOleCallback;
+ FRichEditOle: IRichEditOle;
+ procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
+ procedure WMDestroy(var Msg: TWMDestroy); message WM_DESTROY;
+ procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
+ procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
+ procedure WMLangChange(var Message: TMessage); message WM_INPUTLANGCHANGE;
+ procedure WMCopy(var Message: TWMCopy); message WM_COPY;
+ procedure WMKeyDown(var Message: TWMKey); message WM_KEYDOWN;
+ procedure SetAutoKeyboard(Enabled: Boolean);
+ procedure LinkNotify(Link: TENLink);
+ procedure CloseObjects;
+ function UpdateHostNames: Boolean;
+ protected
+ procedure CreateParams(var Params: TCreateParams); override;
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure CreateWnd; override;
+ procedure URLClick(const URLText: String; Button: TMouseButton); dynamic;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Clear; override;
+ //function GetTextRangeA(cpMin,cpMax: Integer): AnsiString;
+ function GetTextRange(cpMin,cpMax: Integer): String;
+ function GetTextLength: Integer;
+ procedure ReplaceCharFormatRange(const fromCF, toCF: CHARFORMAT2; idx, len: Integer);
+ procedure ReplaceCharFormat(const fromCF, toCF: CHARFORMAT2);
+ property Codepage: Cardinal read FCodepage write FCodepage default CP_ACP;
+ property Version: Integer read FVersion;
+ property RichEditOle: IRichEditOle read FRichEditOle;
+ published
+ published
+ property Align;
+ property Alignment;
+ property Anchors;
+ property BevelEdges;
+ property BevelInner;
+ property BevelOuter;
+ property BevelKind default bkNone;
+ property BevelWidth;
+ property BiDiMode;
+ property BorderStyle;
+ property BorderWidth;
+ property Color;
+ property Ctl3D;
+ property DragCursor;
+ property DragKind;
+ property DragMode;
+ property Enabled;
+ property Font;
+ property HideSelection;
+ property HideScrollBars;
+ property ImeMode;
+ property ImeName;
+ property Constraints;
+ property Lines;
+ property MaxLength;
+ property ParentBiDiMode;
+ property ParentColor;
+ property ParentCtl3D;
+ property ParentFont;
+ property ParentShowHint;
+ property PlainText;
+ property PopupMenu;
+ property ReadOnly;
+ property ScrollBars;
+ property ShowHint;
+ property TabOrder;
+ property TabStop default True;
+ property Visible;
+ property WantTabs;
+ property WantReturns;
+ property WordWrap;
+ property OnChange;
+ property OnContextPopup;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEndDock;
+ property OnEndDrag;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ property OnMouseWheel;
+ property OnMouseWheelDown;
+ property OnMouseWheelUp;
+ property OnProtectChange;
+ property OnResizeRequest;
+ property OnSaveClipboard;
+ property OnSelectionChange;
+ property OnStartDock;
+ property OnStartDrag;
+ property OnURLClick: TURLClickEvent read FOnURLClick write FOnURLClick;
+ end;
+
+ TImageDataObject = class(TInterfacedObject,IDataObject)
+ private
+ FBmp:hBitmap;
+ FMedium:TStgMedium;
+ FFormatEtc: TFormatEtc;
+ procedure SetBitmap(bmp:hBitmap);
+ function GetOleObject(OleClientSite:IOleClientSite; Storage:IStorage):IOleObject;
+ // IDataObject
+ function GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium): HResult; stdcall;
+ function GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium): HResult; stdcall;
+ function QueryGetData(const formatetc: TFormatEtc): HResult; stdcall;
+ function GetCanonicalFormatEtc(const formatetc: TFormatEtc; out formatetcOut: TFormatEtc): HResult; stdcall;
+ function SetData(const formatetc: TFormatEtc; var medium: TStgMedium; fRelease: BOOL): HResult; stdcall;
+ function EnumFormatEtc(dwDirection: Longint; out enumFormatEtc: IEnumFormatEtc): HResult; stdcall;
+ function DAdvise(const formatetc: TFormatEtc; advf: Longint; const advSink: IAdviseSink; out dwConnection: Longint): HResult; stdcall;
+ function DUnadvise(dwConnection: Longint): HResult; stdcall;
+ function EnumDAdvise(out enumAdvise: IEnumStatData): HResult; stdcall;
+ public
+ destructor Destroy; override;
+ function InsertBitmap(Wnd: HWND; Bitmap: hBitmap; cp: Cardinal): Boolean;
+ end;
+
+ PTextStream = ^TTextStream;
+ TTextStream = record
+ Size: Integer;
+ case Boolean of
+ false: (Data: PAnsiChar);
+ true: (DataW: PChar);
+ end;
+
+function InitRichEditLibrary: Integer;
+
+function GetRichRTF(RichEditHandle: THandle; var RTFStream: String;
+ SelectionOnly, PlainText, NoObjects, PlainRTF: Boolean): Integer; overload;
+function GetRichRTF(RichEditHandle: THandle; var RTFStream: AnsiString;
+ SelectionOnly, PlainText, NoObjects, PlainRTF: Boolean): Integer; overload;
+function SetRichRTF(RichEditHandle: THandle; RTFStream: String;
+ SelectionOnly, PlainText, PlainRTF: Boolean): Integer; overload;
+function SetRichRTF(RichEditHandle: THandle; RTFStream: AnsiString;
+ SelectionOnly, PlainText, PlainRTF: Boolean): Integer; overload;
+function FormatString2RTF(Source: String; Suffix: AnsiString = ''): AnsiString; overload;
+function FormatString2RTF(Source: AnsiString; Suffix: AnsiString = ''): AnsiString; overload;
+//function FormatRTF2String(RichEditHandle: THandle; RTFStream: WideString): WideString; overload;
+//function FormatRTF2String(RichEditHandle: THandle; RTFStream: AnsiString): WideString; overload;
+function GetRichString(RichEditHandle: THandle; SelectionOnly: Boolean = false): String;
+
+function RichEdit_SetOleCallback(Wnd: HWND; const Intf: IRichEditOleCallback): Boolean;
+function RichEdit_GetOleInterface(Wnd: HWND; out Intf: IRichEditOle): Boolean;
+function RichEdit_InsertBitmap(Wnd: HWND; Bitmap: hBitmap; cp: Cardinal): Boolean;
+
+procedure OleCheck(OleResult: HResult);
+procedure ReleaseObject(var Obj);
+
+procedure Register;
+
+implementation
+
+uses Types, SysUtils;
+
+type
+ EOleError = class(Exception);
+
+const
+ SOleError = 'OLE2 error occured. Error code: %.8xH';
+
+ SF_UNICODE = 16;
+ SF_USECODEPAGE = 32;
+
+ RICHEDIT_CLASS20A = 'RICHEDIT20A';
+ RICHEDIT_CLASS20W = 'RICHEDIT20W';
+ MSFTEDIT_CLASS = 'RICHEDIT50W';
+
+var
+ FRichEditModule: THandle = 0;
+ FRichEditVersion: Integer = 0;
+
+procedure Register;
+begin
+ RegisterComponents('History++', [THppRichedit]);
+end;
+
+function GetModuleVersionFile(hModule: THandle): Integer;
+var
+ dwVersion: Cardinal;
+begin
+ Result := -1;
+ if hModule = 0 then exit;
+ try
+ dwVersion := GetFileVersion(GetModuleName(hModule));
+ if dwVersion <> Cardinal(-1) then
+ Result := LoWord(dwVersion);
+ except
+ end;
+end;
+
+function InitRichEditLibrary: Integer;
+const
+ RICHED20_DLL = 'RICHED20.DLL';
+ {$IFDEF AllowMSFTEDIT}
+ MSFTEDIT_DLL = 'MSFTEDIT.DLL';
+ {$ENDIF}
+var
+ {$IFDEF AllowMSFTEDIT}
+ hModule : THandle;
+ hVersion: Integer;
+ {$ENDIF}
+ emError : DWord;
+begin
+ if FRichEditModule = 0 then
+ begin
+ FRichEditVersion := -1;
+ emError := SetErrorMode(SEM_NOOPENFILEERRORBOX);
+ try
+ FRichEditModule := LoadLibrary(RICHED20_DLL);
+ if FRichEditModule <= HINSTANCE_ERROR then
+ FRichEditModule := 0;
+ if FRichEditModule <> 0 then
+ FRichEditVersion := GetModuleVersionFile(FRichEditModule);
+{$IFDEF AllowMSFTEDIT}
+ repeat
+ if FRichEditVersion > 40 then
+ break;
+ hModule := LoadLibrary(MSFTEDIT_DLL);
+ if hModule <= HINSTANCE_ERROR then
+ hModule := 0;
+ if hModule <> 0 then
+ begin
+ hVersion := GetModuleVersionFile(hModule);
+ if hVersion > FRichEditVersion then
+ begin
+ if FRichEditModule <> 0 then
+ FreeLibrary(FRichEditModule);
+ FRichEditModule := hModule;
+ FRichEditVersion := hVersion;
+ break;
+ end;
+ FreeLibrary(hModule);
+ end;
+ until True;
+{$ENDIF}
+ if (FRichEditModule <> 0) and (FRichEditVersion = 0) then
+ FRichEditVersion := 20;
+ finally
+ SetErrorMode(emError);
+ end;
+ end;
+ Result := FRichEditVersion;
+end;
+
+function RichEditStreamLoad(dwCookie: Longint; pbBuff: PByte; cb: Longint; var pcb: Longint): Longint; stdcall;
+var
+ pBuff: PAnsiChar;
+begin
+ with PTextStream(dwCookie)^ do
+ begin
+ pBuff := Data;
+ pcb := Size;
+ if pcb > cb then
+ pcb := cb;
+ Move(pBuff^, pbBuff^, pcb);
+ Inc(Data, pcb);
+ Dec(Size, pcb);
+ end;
+ Result := 0;
+end;
+
+function RichEditStreamSave(dwCookie: Longint; pbBuff: PByte; cb: Longint; var pcb: Longint): Longint; stdcall;
+var
+ prevSize: Integer;
+begin
+ with PTextStream(dwCookie)^ do begin
+ prevSize := Size;
+ Inc(Size,cb);
+ ReallocMem(Data,Size);
+ Move(pbBuff^,(Data+prevSize)^,cb);
+ pcb := cb;
+ end;
+ Result := 0;
+end;
+
+function _GetRichRTF(RichEditHandle: THandle; TextStream: PTextStream;
+ SelectionOnly, PlainText, NoObjects, PlainRTF, Unicode: Boolean): Integer;
+var
+ es: TEditStream;
+ Format: Longint;
+begin
+ format := 0;
+ if SelectionOnly then
+ Format := Format or SFF_SELECTION;
+ if PlainText then
+ begin
+ if NoObjects then
+ Format := Format or SF_TEXT
+ else
+ Format := Format or SF_TEXTIZED;
+ if Unicode then
+ Format := Format or SF_UNICODE;
+ end
+ else
+ begin
+ if NoObjects then
+ Format := Format or SF_RTFNOOBJS
+ else
+ Format := Format or SF_RTF;
+ if PlainRTF then
+ Format := Format or SFF_PLAINRTF;
+ // if Unicode then format := format or SF_USECODEPAGE or (CP_UTF16 shl 16);
+ end;
+ TextStream^.Size := 0;
+ TextStream^.Data := nil;
+ es.dwCookie := LPARAM(TextStream);
+ es.dwError := 0;
+ es.pfnCallback := @RichEditStreamSave;
+ SendMessage(RichEditHandle, EM_STREAMOUT, format, LPARAM(@es));
+ Result := es.dwError;
+end;
+
+function GetRichRTF(RichEditHandle: THandle; var RTFStream: String;
+ SelectionOnly, PlainText, NoObjects, PlainRTF: Boolean): Integer;
+var
+ Stream: TTextStream;
+begin
+ Result := _GetRichRTF(RichEditHandle, @Stream,
+ SelectionOnly, PlainText, NoObjects, PlainRTF, PlainText);
+ if Assigned(Stream.DataW) then
+ begin
+ if PlainText then
+ SetString(RTFStream, Stream.DataW, Stream.Size div SizeOf(Char))
+ else
+ RTFStream := AnsiToWideString(Stream.Data, CP_ACP);
+ FreeMem(Stream.Data, Stream.Size);
+ end;
+end;
+
+function GetRichRTF(RichEditHandle: THandle; var RTFStream: AnsiString;
+ SelectionOnly, PlainText, NoObjects, PlainRTF: Boolean): Integer;
+var
+ Stream: TTextStream;
+begin
+ Result := _GetRichRTF(RichEditHandle, @Stream,
+ SelectionOnly, PlainText, NoObjects, PlainRTF, False);
+ if Assigned(Stream.Data) then
+ begin
+ SetString(RTFStream, Stream.Data, Stream.Size - 1);
+ FreeMem(Stream.Data, Stream.Size);
+ end;
+end;
+
+function _SetRichRTF(RichEditHandle: THandle; TextStream: PTextStream;
+ SelectionOnly, PlainText, PlainRTF, Unicode: Boolean): Integer;
+var
+ es: TEditStream;
+ Format: Longint;
+begin
+ Format := 0;
+ if SelectionOnly then
+ Format := Format or SFF_SELECTION;
+ if PlainText then
+ begin
+ Format := Format or SF_TEXT;
+ if Unicode then
+ Format := Format or SF_UNICODE;
+ end
+ else
+ begin
+ Format := Format or SF_RTF;
+ if PlainRTF then
+ Format := Format or SFF_PLAINRTF;
+ // if Unicode then format := format or SF_USECODEPAGE or (CP_UTF16 shl 16);
+ end;
+ es.dwCookie := LPARAM(TextStream);
+ es.dwError := 0;
+ es.pfnCallback := @RichEditStreamLoad;
+ SendMessage(RichEditHandle, EM_STREAMIN, format, LPARAM(@es));
+ Result := es.dwError;
+end;
+
+function SetRichRTF(RichEditHandle: THandle; RTFStream: String;
+ SelectionOnly, PlainText, PlainRTF: Boolean): Integer;
+var
+ Stream: TTextStream;
+ Buffer: AnsiString;
+begin
+ if PlainText then
+ begin
+ Stream.DataW := @RTFStream[1];
+ Stream.Size := Length(RTFStream) * SizeOf(WideChar);
+ end
+ else
+ begin
+ Buffer := WideToAnsiString(RTFStream, CP_ACP);
+ Stream.Data := @Buffer[1];
+ Stream.Size := Length(Buffer);
+ end;
+ Result := _SetRichRTF(RichEditHandle, @Stream,
+ SelectionOnly, PlainText, PlainRTF, PlainText);
+end;
+
+function SetRichRTF(RichEditHandle: THandle; RTFStream: AnsiString;
+ SelectionOnly, PlainText, PlainRTF: Boolean): Integer;
+var
+ Stream: TTextStream;
+begin
+ Stream.Data := @RTFStream[1];
+ Stream.Size := Length(RTFStream);
+ Result := _SetRichRTF(RichEditHandle, @Stream,
+ SelectionOnly, PlainText, PlainRTF, False);
+end;
+
+function FormatString2RTF(Source: String; Suffix: AnsiString = ''): AnsiString;
+var
+ Text: PChar;
+begin
+ Text := PChar(Source);
+ Result := '{\uc1 ';
+ while Text[0] <> #0 do
+ begin
+ if (Text[0] = #13) and (Text[1] = #10) then
+ begin
+ Result := Result + '\par ';
+ Inc(Text);
+ end
+ else
+ case Text[0] of
+ #10:
+ Result := Result + '\par ';
+ #09:
+ Result := Result + '\tab ';
+ '\', '{', '}':
+ Result := Result + '\' + AnsiChar(Text[0]);
+ else
+ if Word(Text[0]) < 128 then
+ Result := Result + AnsiChar(Word(Text[0]))
+ else
+ Result := Result + AnsiString(Format('\u%d?', [Word(Text[0])]));
+ end;
+ Inc(Text);
+ end;
+ Result := Result + Suffix + '}';
+end;
+
+function FormatString2RTF(Source: AnsiString; Suffix: AnsiString = ''): AnsiString;
+var
+ Text: PAnsiChar;
+begin
+ Text := PAnsiChar(Source);
+ Result := '{';
+ while Text[0] <> #0 do
+ begin
+ if (Text[0] = #13) and (Text[1] = #10) then
+ begin
+ Result := Result + '\line ';
+ Inc(Text);
+ end
+ else
+ case Text[0] of
+ #10:
+ Result := Result + '\line ';
+ #09:
+ Result := Result + '\tab ';
+ '\', '{', '}':
+ Result := Result + '\' + Text[0];
+ else
+ Result := Result + Text[0];
+ end;
+ Inc(Text);
+ end;
+ Result := Result + Suffix + '}';
+end;
+
+{function FormatRTF2String(RichEditHandle: THandle; RTFStream: WideString): WideString;
+begin
+ SetRichRTF(RichEditHandle,RTFStream,False,False,True);
+ GetRichRTF(RichEditHandle,Result,False,True,True,True);
+end;
+
+function FormatRTF2String(RichEditHandle: THandle; RTFStream: AnsiString): WideString;
+begin
+ SetRichRTF(RichEditHandle,RTFStream,False,False,True);
+ GetRichRTF(RichEditHandle,Result,False,True,True,True);
+end;}
+
+function GetRichString(RichEditHandle: THandle; SelectionOnly: Boolean = false): String;
+begin
+ GetRichRTF(RichEditHandle,Result,SelectionOnly,True,True,False);
+end;
+
+{ OLE Specific }
+
+function FailedHR(hr: HResult): Boolean;
+begin
+ Result := Failed(hr);
+end;
+
+function OleErrorMsg(ErrorCode: HResult): String;
+begin
+ FmtStr(Result, SOleError, [Longint(ErrorCode)]);
+end;
+
+procedure OleError(ErrorCode: HResult);
+begin
+ raise EOleError.Create(OleErrorMsg(ErrorCode));
+end;
+
+procedure OleCheck(OleResult: HResult);
+begin
+ if FailedHR(OleResult) then OleError(OleResult);
+end;
+
+procedure ReleaseObject(var Obj);
+begin
+ if IUnknown(Obj) <> nil then IUnknown(Obj) := nil;
+end;
+
+procedure CreateStorage(var Storage: IStorage);
+var
+ LockBytes: ILockBytes;
+begin
+ OleCheck(CreateILockBytesOnHGlobal(0, True, LockBytes));
+ try
+ OleCheck(StgCreateDocfileOnILockBytes(LockBytes,
+ STGM_READWRITE or STGM_SHARE_EXCLUSIVE or STGM_CREATE, 0, Storage));
+ finally
+ ReleaseObject(LockBytes);
+ end;
+end;
+
+{ THPPRichEdit }
+
+constructor THppRichedit.Create(AOwner: TComponent);
+begin
+ FClickRange.cpMin := -1;
+ FClickRange.cpMax := -1;
+ FRichEditOleCallback := TRichEditOleCallback.Create(Self);
+ inherited;
+end;
+
+destructor THppRichedit.Destroy;
+begin
+ inherited Destroy;
+ FRichEditOleCallback.Free;
+end;
+
+procedure THppRichedit.CloseObjects;
+var
+ i: Integer;
+ ReObject: TReObject;
+begin
+ if Assigned(FRichEditOle) then
+ begin
+ ZeroMemory(@ReObject, SizeOf(ReObject));
+ ReObject.cbStruct := SizeOf(ReObject);
+ with IRichEditOle(FRichEditOle) do
+ begin
+ for i := GetObjectCount - 1 downto 0 do
+ if Succeeded(GetObject(i, ReObject, REO_GETOBJ_POLEOBJ)) then
+ begin
+ if ReObject.dwFlags and REO_INPLACEACTIVE <> 0 then
+ IRichEditOle(FRichEditOle).InPlaceDeactivate;
+ ReObject.poleobj.Close(OLECLOSE_NOSAVE);
+ ReleaseObject(ReObject.poleobj);
+ end;
+ end;
+ end;
+end;
+
+procedure THppRichedit.Clear;
+begin
+ CloseObjects;
+ inherited;
+end;
+
+function THppRichedit.UpdateHostNames: Boolean;
+var
+ AppName: String;
+ AnsiAppName:AnsiString;
+begin
+ Result := True;
+ if HandleAllocated and Assigned(FRichEditOle) then
+ begin
+ AppName := Application.Title;
+ if Trim(AppName) = '' then
+ AppName := ExtractFileName(Application.ExeName);
+ AnsiAppName:=AnsiString(AppName);
+ try
+ FRichEditOle.SetHostNames(PAnsiChar(AnsiAppName), PAnsiChar(AnsiAppName));
+ except
+ Result := false;
+ end;
+ end;
+end;
+
+type
+ TAccessCustomMemo = class(TCustomMemo);
+ InheritedCreateParams = procedure(var Params: TCreateParams) of object;
+
+ procedure THppRichedit.CreateParams(var Params: TCreateParams);
+const
+ aHideScrollBars: array[Boolean] of DWORD = (ES_DISABLENOSCROLL, 0);
+ aHideSelections: array[Boolean] of DWORD = (ES_NOHIDESEL, 0);
+ aWordWrap: array[Boolean] of DWORD = (WS_HSCROLL, 0);
+var
+ Method: TMethod;
+begin
+ FVersion := InitRichEditLibrary;
+ Method.Code := @TAccessCustomMemo.CreateParams;
+ Method.Data := Self;
+ InheritedCreateParams(Method)(Params);
+ if FVersion >= 20 then
+ begin
+{$IFDEF AllowMSFTEDIT}
+ if FVersion = 41 then
+ CreateSubClass(Params, MSFTEDIT_CLASS)
+ else
+{$ENDIF}
+ CreateSubClass(Params, RICHEDIT_CLASS20W);
+ end;
+ with Params do
+ begin
+ Style := Style or aHideScrollBars[HideScrollBars] or aHideSelections[HideSelection] and
+ not aWordWrap[WordWrap]; // more compatible with RichEdit 1.0
+ // Fix for repaint richedit in event details form
+ // used if class inherits from TCustomRichEdit
+ // WindowClass.style := WindowClass.style or (CS_HREDRAW or CS_VREDRAW);
+ end;
+end;
+
+procedure THppRichedit.CreateWindowHandle(const Params: TCreateParams);
+begin
+(*
+ {$IFDEF AllowMSFTEDIT}
+ if FVersion = 41 then
+ CreateUnicodeHandle(Self, Params, MSFTEDIT_CLASS) else
+ {$ENDIF}
+ CreateUnicodeHandle(Self, Params, RICHEDIT_CLASS20W);
+*)
+inherited;
+end;
+
+procedure THppRichedit.CreateWnd;
+const
+ EM_SETEDITSTYLE = WM_USER + 204;
+ SES_EXTENDBACKCOLOR = 4;
+begin
+ inherited;
+ //SendMessage(Handle,EM_SETMARGINS,EC_LEFTMARGIN or EC_RIGHTMARGIN,0);
+ Perform(EM_SETMARGINS,EC_LEFTMARGIN or EC_RIGHTMARGIN,0);
+ //SendMessage(Handle,EM_SETEDITSTYLE,SES_EXTENDBACKCOLOR,SES_EXTENDBACKCOLOR);
+ Perform(EM_SETEDITSTYLE,SES_EXTENDBACKCOLOR,SES_EXTENDBACKCOLOR);
+ //SendMessage(Handle,EM_SETOPTIONS,ECOOP_OR,ECO_AUTOWORDSELECTION);
+ Perform(EM_SETOPTIONS,ECOOP_OR,ECO_AUTOWORDSELECTION);
+ //SendMessage(Handle,EM_AUTOURLDETECT,1,0);
+ Perform(EM_AUTOURLDETECT,1,0);
+ //SendMessage(Handle,EM_SETEVENTMASK,0,SendMessage(Handle,EM_GETEVENTMASK,0,0) or ENM_LINK);
+ Perform(EM_SETEVENTMASK,0,Perform(EM_GETEVENTMASK,0,0) or ENM_LINK);
+ RichEdit_SetOleCallback(Handle, FRichEditOleCallback as IRichEditOleCallback);
+ if RichEdit_GetOleInterface(Handle, FRichEditOle) then UpdateHostNames;
+end;
+
+procedure THppRichedit.SetAutoKeyboard(Enabled: Boolean);
+var
+ re_options,new_options: DWord;
+begin
+ // re_options := SendMessage(Handle,EM_GETLANGOPTIONS,0,0);
+ re_options := Perform(EM_GETLANGOPTIONS, 0, 0);
+ if Enabled then
+ new_options := re_options or IMF_AUTOKEYBOARD
+ else
+ new_options := re_options and not IMF_AUTOKEYBOARD;
+ if re_options <> new_options then
+ // SendMessage(Handle,EM_SETLANGOPTIONS,0,new_options);
+ Perform(EM_SETLANGOPTIONS,0,new_options);
+end;
+
+procedure THppRichedit.ReplaceCharFormatRange(const fromCF, toCF: CHARFORMAT2; idx, len: Integer);
+var
+ cr: CHARRANGE;
+ cf: CHARFORMAT2;
+ loglen: Integer;
+ res: DWord;
+begin
+ if len = 0 then
+ exit;
+ cr.cpMin := idx;
+ cr.cpMax := idx + len;
+ Perform(EM_EXSETSEL, 0, LPARAM(@cr));
+ ZeroMemory(@cf, SizeOf(cf));
+ cf.cbSize := SizeOf(cf);
+ cf.dwMask := fromCF.dwMask;
+ res := Perform(EM_GETCHARFORMAT, SCF_SELECTION, LPARAM(@cf));
+ if (res and fromCF.dwMask) = 0 then
+ begin
+ if len = 2 then
+ begin
+ // wtf, msdn tells that cf will get the format of the first AnsiChar,
+ // and then we have to select it, if format match or second, if not
+ // instead we got format of the last AnsiChar... weired
+ if (cf.dwEffects and fromCF.dwEffects) = fromCF.dwEffects then
+ Inc(cr.cpMin)
+ else
+ Dec(cr.cpMax);
+ Perform(EM_EXSETSEL, 0, LPARAM(@cr));
+ Perform(EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@toCF));
+ end
+ else
+ begin
+ loglen := len div 2;
+ ReplaceCharFormatRange(fromCF, toCF, idx, loglen);
+ ReplaceCharFormatRange(fromCF, toCF, idx + loglen, len - loglen);
+ end;
+ end
+ else if (cf.dwEffects and fromCF.dwEffects) = fromCF.dwEffects then
+ Perform(EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@toCF));
+end;
+
+procedure THppRichedit.ReplaceCharFormat(const fromCF, toCF: CHARFORMAT2);
+begin
+ ReplaceCharFormatRange(fromCF,toCF,0,GetTextLength);
+end;
+
+(*
+function THppRichedit.GetTextRangeA(cpMin,cpMax: Integer): AnsiString;
+var
+ WideText: WideString;
+ tr: TextRange;
+begin
+ tr.chrg.cpMin := cpMin;
+ tr.chrg.cpMax := cpMax;
+ SetLength(WideText,cpMax-cpMin);
+ tr.lpstrText := @WideText[1];
+ Perform(EM_GETTEXTRANGE,0,LPARAM(@tr));
+ Result := WideToAnsiString(WideText,Codepage);
+end;
+*)
+
+function THppRichedit.GetTextRange(cpMin,cpMax: Integer): String;
+var
+ tr: TextRange;
+begin
+ tr.chrg.cpMin := cpMin;
+ tr.chrg.cpMax := cpMax;
+ SetLength(Result,cpMax-cpMin);
+ tr.lpstrText := @Result[1];
+
+ Perform(EM_GETTEXTRANGE,0,LPARAM(@tr));
+end;
+
+function THppRichedit.GetTextLength: Integer;
+var
+ gtxl: GETTEXTLENGTHEX;
+begin
+ gtxl.flags := GTL_DEFAULT or GTL_PRECISE;
+ gtxl.codepage := 1200;
+ gtxl.flags := gtxl.flags or GTL_NUMCHARS;
+ Result := Perform(EM_GETTEXTLENGTHEX, WPARAM(@gtxl), 0);
+end;
+
+procedure THppRichedit.URLClick(const URLText: String; Button: TMouseButton);
+begin
+ if Assigned(OnURLClick) then
+ OnURLClick(Self, URLText, Button);
+end;
+
+procedure THppRichedit.LinkNotify(Link: TENLink);
+begin
+ case Link.msg of
+ WM_RBUTTONDOWN: begin
+ FClickRange := Link.chrg;
+ FClickBtn := mbRight;
+ end;
+ WM_RBUTTONUP: begin
+ if (FClickBtn = mbRight) and
+ (FClickRange.cpMin = Link.chrg.cpMin) and (FClickRange.cpMax = Link.chrg.cpMax) then
+ URLClick(GetTextRange(Link.chrg.cpMin, Link.chrg.cpMax), mbRight);
+ FClickRange.cpMin := -1;
+ FClickRange.cpMax := -1;
+ end;
+ WM_LBUTTONDOWN: begin
+ FClickRange := Link.chrg;
+ FClickBtn := mbLeft;
+ end;
+ WM_LBUTTONUP: begin
+ if (FClickBtn = mbLeft) and
+ (FClickRange.cpMin = Link.chrg.cpMin) and (FClickRange.cpMax = Link.chrg.cpMax) then
+ URLClick(GetTextRange(Link.chrg.cpMin, Link.chrg.cpMax), mbLeft);
+ FClickRange.cpMin := -1;
+ FClickRange.cpMax := -1;
+ end;
+ end;
+end;
+
+procedure THppRichedit.CNNotify(var Message: TWMNotify);
+begin
+ case Message.NMHdr^.code of
+ EN_LINK: LinkNotify(TENLINK(Pointer(Message.NMHdr)^));
+ else
+ inherited;
+ end;
+end;
+
+procedure THppRichedit.WMDestroy(var Msg: TWMDestroy);
+begin
+ CloseObjects;
+ ReleaseObject(FRichEditOle);
+ inherited;
+end;
+
+type
+ InheritedWMRButtonUp = procedure(var Message: TWMRButtonUp) of object;
+
+procedure THppRichedit.WMRButtonUp(var Message: TWMRButtonUp);
+
+ function GetDynamicMethod(AClass: TClass; Index: Integer): Pointer;
+ asm call System.@FindDynaClass end;
+
+var
+ Method: TMethod;
+begin
+ Method.Code := GetDynamicMethod(TCustomMemo,WM_RBUTTONUP);
+ Method.Data := Self;
+ InheritedWMRButtonUp(Method)(Message);
+ // RichEdit does not pass the WM_RBUTTONUP message to defwndproc,
+ // so we get no WM_CONTEXTMENU message.
+ // Simulate message here, after EN_LINK defwndproc's notyfy message
+{!!
+ if Assigned(FRichEditOleCallback) or (Win32MajorVersion < 5) then
+ Perform(WM_CONTEXTMENU, Handle, LParam(PointToSmallPoint(
+ ClientToScreen(SmallPointToPoint(TWMMouse(Message).Pos)))));
+}
+end;
+
+procedure THppRichedit.WMSetFocus(var Message: TWMSetFocus);
+begin
+ SetAutoKeyboard(False);
+ inherited;
+end;
+
+procedure THppRichedit.WMLangChange(var Message: TMessage);
+begin
+ SetAutoKeyboard(False);
+ Message.Result:=1;
+end;
+
+procedure THppRichedit.WMCopy(var Message: TWMCopy);
+var
+ Text: String;
+begin
+ inherited;
+ // do not empty clip to not to loose rtf data
+ //EmptyClipboard();
+ Text := GetRichString(Handle,True);
+ CopyToClip(Text,Handle,FCodepage,False);
+end;
+
+procedure THppRichedit.WMKeyDown(var Message: TWMKey);
+begin
+ if (KeyDataToShiftState(Message.KeyData) = [ssCtrl]) then
+ case Message.CharCode of
+ Ord('E'), Ord('J'):
+ Message.Result := 1;
+ Ord('C'), VK_INSERT:
+ begin
+ PostMessage(Handle, WM_COPY, 0, 0);
+ Message.Result := 1;
+ end;
+ end;
+ if Message.Result = 1 then
+ exit;
+ inherited;
+end;
+
+{ TRichEditOleCallback }
+
+constructor TRichEditOleCallback.Create(RichEdit: THppRichEdit);
+begin
+ inherited Create;
+ FRichEdit := RichEdit;
+end;
+
+destructor TRichEditOleCallback.Destroy;
+begin
+ inherited Destroy;
+end;
+
+function TRichEditOleCallback.QueryInterface(const iid: TGUID; out Obj): HResult;
+begin
+ if GetInterface(iid, Obj) then
+ Result := S_OK
+ else
+ Result := E_NOINTERFACE;
+end;
+
+function TRichEditOleCallback._AddRef: Longint;
+begin
+ Inc(FRefCount);
+ Result := FRefCount;
+end;
+
+function TRichEditOleCallback._Release: Longint;
+begin
+ Dec(FRefCount);
+ Result := FRefCount;
+end;
+
+function TRichEditOleCallback.GetNewStorage(out stg: IStorage): HResult;
+begin
+ try
+ CreateStorage(stg);
+ Result := S_OK;
+ except
+ Result:= E_OUTOFMEMORY;
+ end;
+end;
+
+function TRichEditOleCallback.GetInPlaceContext(out Frame: IOleInPlaceFrame; out Doc: IOleInPlaceUIWindow; lpFrameInfo: POleInPlaceFrameInfo): HResult;
+begin
+ Result := E_NOTIMPL;
+end;
+
+function TRichEditOleCallback.QueryInsertObject(const clsid: TCLSID; const stg: IStorage; cp: Longint): HResult;
+begin
+ Result := NOERROR;
+end;
+
+function TRichEditOleCallback.DeleteObject(const oleobj: IOleObject): HResult;
+begin
+ if Assigned(oleobj) then oleobj.Close(OLECLOSE_NOSAVE);
+ Result := NOERROR;
+end;
+
+function TRichEditOleCallback.QueryAcceptData(const dataobj: IDataObject; var cfFormat: TClipFormat; reco: DWORD; fReally: BOOL; hMetaPict: HGLOBAL): HResult;
+begin
+ Result := S_OK;
+end;
+
+function TRichEditOleCallback.ContextSensitiveHelp(fEnterMode: BOOL): HResult;
+begin
+ Result := E_NOTIMPL;
+end;
+
+function TRichEditOleCallback.GetClipboardData(const chrg: TCharRange; reco: DWORD; out dataobj: IDataObject): HResult;
+begin
+ Result := E_NOTIMPL;
+end;
+
+function TRichEditOleCallback.GetDragDropEffect(fDrag: BOOL; grfKeyState: DWORD; var dwEffect: DWORD): HResult;
+begin
+ Result := E_NOTIMPL;
+end;
+
+function TRichEditOleCallback.GetContextMenu(seltype: Word; const oleobj: IOleObject; const chrg: TCharRange; out menu: HMENU): HResult;
+begin
+ Result := E_NOTIMPL;
+end;
+
+function TRichEditOleCallback.ShowContainerUI(fShow: BOOL): HResult;
+begin
+ Result := E_NOTIMPL;
+end;
+
+function RichEdit_SetOleCallback(Wnd: HWND; const Intf: IRichEditOleCallback): Boolean;
+begin
+ Result := SendMessage(Wnd, EM_SETOLECALLBACK, 0, LPARAM(Intf)) <> 0;
+end;
+
+function RichEdit_GetOleInterface(Wnd: HWND; out Intf: IRichEditOle): Boolean;
+begin
+ Result := SendMessage(Wnd, EM_GETOLEINTERFACE, 0, LPARAM(@Intf)) <> 0;
+end;
+
+{ TImageDataObject }
+
+function TImageDataObject.DAdvise(const formatetc: TFormatEtc; advf: Integer; const advSink: IAdviseSink; out dwConnection: Integer): HResult;
+begin
+ Result := E_NOTIMPL;
+end;
+
+function TImageDataObject.DUnadvise(dwConnection: Integer): HResult;
+begin
+ Result := E_NOTIMPL;
+end;
+
+function TImageDataObject.EnumDAdvise(out enumAdvise: IEnumStatData): HResult;
+begin
+ Result := E_NOTIMPL;
+end;
+
+function TImageDataObject.EnumFormatEtc(dwDirection: Integer; out enumFormatEtc: IEnumFormatEtc): HResult;
+begin
+ Result := E_NOTIMPL;
+end;
+
+function TImageDataObject.GetCanonicalFormatEtc(const formatetc: TFormatEtc; out formatetcOut: TFormatEtc): HResult;
+begin
+ Result := E_NOTIMPL;
+end;
+
+function TImageDataObject.GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium): HResult;
+begin
+ Result := E_NOTIMPL;
+end;
+
+function TImageDataObject.QueryGetData(const formatetc: TFormatEtc): HResult;
+begin
+ Result := E_NOTIMPL;
+end;
+
+destructor TImageDataObject.Destroy;
+begin
+ ReleaseStgMedium(FMedium);
+end;
+
+function TImageDataObject.GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium): HResult;
+begin
+ medium.tymed := TYMED_GDI;
+ medium.hBitmap := FMedium.hBitmap;
+ medium.unkForRelease := nil;
+ Result:=S_OK;
+end;
+
+function TImageDataObject.SetData(const formatetc: TFormatEtc; var medium: TStgMedium; fRelease: BOOL): HResult;
+begin
+ FFormatEtc := formatetc;
+ FMedium := medium;
+ Result:= S_OK;
+end;
+
+procedure TImageDataObject.SetBitmap(bmp: hBitmap);
+var
+ stgm: TStgMedium;
+ fm: TFormatEtc;
+begin
+ stgm.tymed := TYMED_GDI;
+ stgm.hBitmap := bmp;
+ stgm.UnkForRelease := nil;
+ fm.cfFormat := CF_BITMAP;
+ fm.ptd := nil;
+ fm.dwAspect := DVASPECT_CONTENT;
+ fm.lindex := -1;
+ fm.tymed := TYMED_GDI;
+ SetData(fm, stgm, FALSE);
+end;
+
+function TImageDataObject.GetOleObject(OleClientSite: IOleClientSite; Storage: IStorage):IOleObject;
+begin
+ if (FMedium.hBitmap = 0) then
+ Result := nil
+ else
+ OleCreateStaticFromData(Self, IID_IOleObject, OLERENDER_FORMAT, @FFormatEtc, OleClientSite,
+ Storage, Result);
+end;
+
+function TImageDataObject.InsertBitmap(Wnd: HWND; Bitmap: hBitmap; cp: Cardinal): Boolean;
+var
+ RichEditOLE: IRichEditOLE;
+ OleClientSite: IOleClientSite;
+ Storage: IStorage;
+ OleObject: IOleObject;
+ ReObject: TReObject;
+ clsid: TGUID;
+begin
+ Result := false;
+ if Bitmap = 0 then
+ exit;
+ if not RichEdit_GetOleInterface(Wnd, RichEditOle) then
+ exit;
+ FBmp := CopyImage(Bitmap, IMAGE_BITMAP, 0, 0, 0);
+ try
+ SetBitmap(FBmp);
+ RichEditOle.GetClientSite(OleClientSite);
+ Storage := nil;
+ try
+ CreateStorage(Storage);
+ if not(Assigned(OleClientSite) and Assigned(Storage)) then
+ exit;
+ try
+ OleObject := GetOleObject(OleClientSite, Storage);
+ if OleObject = nil then
+ exit;
+ OleSetContainedObject(OleObject, True);
+ OleObject.GetUserClassID(clsid);
+ ZeroMemory(@ReObject, SizeOf(ReObject));
+ ReObject.cbStruct := SizeOf(ReObject);
+ ReObject.clsid := clsid;
+ ReObject.cp := cp;
+ ReObject.dvaspect := DVASPECT_CONTENT;
+ ReObject.poleobj := OleObject;
+ ReObject.polesite := OleClientSite;
+ ReObject.pstg := Storage;
+ Result := (RichEditOle.InsertObject(ReObject) = NOERROR);
+ finally
+ ReleaseObject(OleObject);
+ end;
+ finally
+ ReleaseObject(OleClientSite);
+ ReleaseObject(Storage);
+ end;
+ finally
+ DeleteObject(FBmp);
+ ReleaseObject(RichEditOLE);
+ end;
+end;
+
+function RichEdit_InsertBitmap(Wnd: HWND; Bitmap: hBitmap; cp: Cardinal): Boolean;
+begin
+ with TImageDataObject.Create do
+ try
+ Result := InsertBitmap(Wnd,Bitmap,cp);
+ finally
+ Free;
+ end
+end;
+
+initialization
+
+finalization
+ if FRichEditModule <> 0 then FreeLibrary(FRichEditModule);
+
+end.
diff --git a/plugins/HistoryPlusPlus/hpp_searchthread.pas b/plugins/HistoryPlusPlus/hpp_searchthread.pas new file mode 100644 index 0000000000..6406f67bcd --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_searchthread.pas @@ -0,0 +1,560 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+{ -----------------------------------------------------------------------------
+ hpp_searchthread (historypp project)
+
+ Version: 1.0
+ Created: 05.08.2004
+ Author: Oxygen
+
+ [ Description ]
+
+ Global searching in History++ is performed in background so
+ we have separate thread for doing it. Here it is, all bright
+ and shiny. In this module the thread is declared, also you
+ can find all text searching routines used and all search
+ logic. See TSearchThread and independent SearchText* funcs
+
+ The results are sent in batches of 500, for every contact.
+ First batch is no more than 50 for fast display.
+
+ Yeah, all search is CASE-INSENSITIVE (at the time of writing :)
+
+ [ History ]
+
+ 1.5 (05.08.2004)
+ First version
+
+ [ Modifications ]
+ none
+
+ [ Known Issues ]
+ none
+
+ Contributors: theMIROn, Art Fedorov
+ ----------------------------------------------------------------------------- }
+
+unit hpp_searchthread;
+
+interface
+
+uses
+ Windows, SysUtils, Controls, Messages, HistoryGrid, Classes,
+ m_api,
+ hpp_global, hpp_events, hpp_forms, hpp_bookmarks, hpp_eventfilters;
+
+const
+ ST_FIRST_BATCH = 50;
+ ST_BATCH = 500;
+
+type
+ PDBArray = ^TDBArray;
+ TDBArray = array [0 .. ST_BATCH - 1] of THandle;
+
+ TSearchMethod = set of (smExact, smAnyWord, smAllWords, smBookmarks, smRange, smEvents);
+
+ TContactRec = record
+ hContact: THandle;
+ Timestamp: DWord;
+ end;
+
+ TSearchThread = class(TThread)
+ private
+ Buffer: TDBArray;
+ BufCount: Integer;
+ FirstBatch: Boolean;
+ Contacts: array of TContactRec;
+ CurContact: THandle;
+ CurContactCP: Cardinal;
+ CurProgress: Integer;
+ MaxProgress: Integer;
+ FParentHandle: Hwnd;
+ FSearchStart: Cardinal;
+ SearchWords: array of String;
+ FSearchText: String;
+ FSearchMethod: TSearchMethod;
+ FSearchProtected: Boolean;
+ FSearchRangeTo: TDateTime;
+ FSearchRangeFrom: TDateTime;
+ FSearchEvents: TMessageTypes;
+
+ procedure GenerateSearchWords;
+ procedure SetSearchRangeFrom(const Value: TDateTime);
+ procedure SetSearchRangeTo(const Value: TDateTime);
+ procedure SetSearchEvents(const Value: TMessageTypes);
+
+ function SearchEvent(DBEvent: THandle): Boolean;
+ procedure SearchContact(Contact: THandle);
+ procedure SearchBookmarks(Contact: THandle);
+
+ function DoMessage(Message: DWord; wParam: wParam; lParam: lParam): Boolean;
+ function SendItem(hDBEvent: THandle): Boolean;
+ function SendBatch: Boolean;
+
+ function GetContactsCount: Integer;
+ function GetItemsCount(hContact: THandle): Integer;
+ procedure BuildContactsList;
+ procedure CalcMaxProgress;
+ procedure IncProgress;
+ procedure SetProgress(Progress: Integer);
+
+ protected
+ procedure Execute; override;
+
+ public
+ AllContacts, AllEvents: Integer;
+
+ constructor Create(CreateSuspended: Boolean);
+ destructor Destroy; override;
+
+ property SearchProtectedContacts: Boolean read FSearchProtected write FSearchProtected;
+ property SearchText: String read FSearchText write FSearchText;
+ property SearchMethod: TSearchMethod read FSearchMethod write FSearchMethod;
+ property SearchRangeFrom: TDateTime read FSearchRangeFrom write SetSearchRangeFrom;
+ property SearchRangeTo: TDateTime read FSearchRangeTo write SetSearchRangeTo;
+ property SearchEvents: TMessageTypes read FSearchEvents write SetSearchEvents;
+ property SearchStart: Cardinal read FSearchStart;
+ property ParentHandle: Hwnd read FParentHandle write FParentHandle;
+
+ property Terminated;
+ procedure Terminate(NewPriority: TThreadPriority = tpIdle); reintroduce;
+ end;
+
+const
+ HM_STRD_PREPARE = HM_STRD_BASE + 1; // the search is prepared (0,0)
+ HM_STRD_PROGRESS = HM_STRD_BASE + 2; // report the progress (progress, max)
+ HM_STRD_ITEMFOUND = HM_STRD_BASE + 3; // (OBSOLETE) item is found (hDBEvent,0)
+ HM_STRD_NEXTCONTACT = HM_STRD_BASE + 4;
+ // the next contact is searched (hContact, ContactCount)
+ HM_STRD_FINISHED = HM_STRD_BASE + 5; // search finished (0,0)
+ HM_STRD_ITEMSFOUND = HM_STRD_BASE + 6;
+ // (NEW) items are found (array of hDBEvent, array size)
+
+ // helper functions
+function SearchTextExact (MessageText: String; SearchText: String): Boolean;
+function SearchTextAnyWord (MessageText: String; SearchWords: array of String): Boolean;
+function SearchTextAllWords(MessageText: String; SearchWords: array of String): Boolean;
+
+{$DEFINE SMARTSEARCH}
+
+implementation
+
+uses hpp_contacts, PassForm;
+
+function SearchTextExact(MessageText: String; SearchText: String): Boolean;
+begin
+ Result := Pos(SearchText, MessageText) <> 0;
+end;
+
+function SearchTextAnyWord(MessageText: String; SearchWords: array of String): Boolean;
+var
+ i: Integer;
+begin
+ Result := False;
+ for i := 0 to Length(SearchWords) - 1 do
+ begin
+ Result := SearchTextExact(MessageText, SearchWords[i]);
+ if Result then
+ exit;
+ end;
+end;
+
+function SearchTextAllWords(MessageText: String; SearchWords: array of String): Boolean;
+var
+ i: Integer;
+begin
+ Result := False;
+ for i := 0 to Length(SearchWords) - 1 do
+ begin
+ Result := SearchTextExact(MessageText, SearchWords[i]);
+ if not Result then
+ exit;
+ end;
+end;
+
+{ TSearchThread }
+
+procedure TSearchThread.BuildContactsList;
+
+ procedure AddContact(Cont: THandle);
+ var
+ hDB: THandle;
+ begin
+ SetLength(Contacts, Length(Contacts) + 1);
+ Contacts[High(Contacts)].hContact := Cont;
+ Contacts[High(Contacts)].Timestamp := 0;
+ hDB := CallService(MS_DB_EVENT_FINDLAST, Cont, 0);
+ if hDB <> 0 then
+ begin
+ Contacts[High(Contacts)].Timestamp := GetEventTimestamp(hDB);
+ end;
+ end;
+// OXY:
+// Modified version, original taken from JclAlgorithms.pas (QuickSort routine)
+// See JclAlgorithms.pas for copyright and license information
+// JclAlgorithms.pas is part of Project JEDI Code Library (JCL)
+// [http://www.delphi-jedi.org], [http://jcl.sourceforge.net]
+ procedure QuickSort(L, R: Integer);
+ var
+ i, J, P: Integer;
+ Rec: TContactRec;
+ begin
+ repeat
+ i := L;
+ J := R;
+ P := (L + R) shr 1;
+ repeat
+ while (integer(Contacts[i].Timestamp) - integer(Contacts[P].Timestamp)) < 0 do
+ Inc(i);
+ while (Contacts[J].Timestamp - Contacts[P].Timestamp) > 0 do
+ Dec(J);
+ if i <= J then
+ begin
+ Rec := Contacts[i];
+ Contacts[i] := Contacts[J];
+ Contacts[J] := Rec;
+ if P = i then
+ P := J
+ else if P = J then
+ P := i;
+ Inc(i);
+ Dec(J);
+ end;
+ until i > J;
+ if L < J then
+ QuickSort(L, J);
+ L := i;
+ until i >= R;
+ end;
+
+var
+ hCont: THandle;
+begin
+ hCont := CallService(MS_DB_CONTACT_FINDFIRST, 0, 0);
+
+ while hCont <> 0 do
+ begin
+ Inc(AllContacts);
+ // I hope I haven't messed this up by
+ // if yes, also fix the same in CalcMaxProgress
+ if SearchProtectedContacts or (not SearchProtectedContacts and (not IsUserProtected(hCont)))
+ then
+ AddContact(hCont);
+ hCont := CallService(MS_DB_CONTACT_FINDNEXT, hCont, 0);
+ end;
+
+ AddContact(hCont);
+
+ QuickSort(1, Length(Contacts) - 1);
+end;
+
+procedure TSearchThread.CalcMaxProgress;
+var
+ hCont: THandle;
+begin
+ MaxProgress := 0;
+ hCont := CallService(MS_DB_CONTACT_FINDFIRST, 0, 0);
+ while hCont <> 0 do
+ begin
+ // I hope I haven't messed this up by
+ // if yes, also fix the same in Execute
+ if SearchProtectedContacts or (not SearchProtectedContacts and (not IsUserProtected(hCont)))
+ then
+ MaxProgress := MaxProgress + GetItemsCount(hCont);
+ hCont := CallService(MS_DB_CONTACT_FINDNEXT, hCont, 0);
+ end;
+ // add sysem history
+ MaxProgress := MaxProgress + GetItemsCount(hCont);
+end;
+
+constructor TSearchThread.Create(CreateSuspended: Boolean);
+begin
+ inherited Create(CreateSuspended);
+ AllContacts := 0;
+ AllEvents := 0;
+ SearchMethod := [smExact];
+ SearchProtectedContacts := True;
+end;
+
+destructor TSearchThread.Destroy;
+begin
+ SetLength(SearchWords, 0);
+ SetLength(Contacts, 0);
+ inherited;
+end;
+
+function TSearchThread.DoMessage(Message: DWord; wParam: WPARAM; lParam: LPARAM): Boolean;
+begin
+ Result := PassMessage(ParentHandle, Message, wParam, lParam, smSend);
+end;
+
+procedure TSearchThread.Execute;
+var
+{$IFNDEF SMARTSEARCH}
+ hCont: THandle;
+{$ELSE}
+ i: Integer;
+{$ENDIF}
+ BookmarksMode: Boolean;
+begin
+ BufCount := 0;
+ FirstBatch := True;
+ try
+ FSearchStart := GetTickCount;
+ DoMessage(HM_STRD_PREPARE, 0, 0);
+ CalcMaxProgress;
+ SetProgress(0);
+
+ BookmarksMode := (smBookmarks in SearchMethod);
+
+ // search within contacts
+ if not BookmarksMode then
+ begin
+ // make it case-insensitive
+ SearchText := WideUpperCase(SearchText);
+ if SearchMethod * [smAnyWord, smAllWords] <> [] then
+ GenerateSearchWords;
+ end;
+
+{$IFNDEF SMARTSEARCH}
+ hCont := CallService(MS_DB_CONTACT_FINDFIRST, 0, 0);
+ while (hCont <> 0) and not Terminated do
+ begin
+ Inc(AllContacts);
+ // I hope I haven't messed this up by
+ // if yes, also fix the same in CalcMaxProgress
+ if SearchProtectedContacts or
+ (not SearchProtectedContacts and (not IsUserProtected(hCont))) then
+ begin
+ if BookmarksMode then
+ SearchBookmarks(hCont)
+ else
+ SearchContact(hCont);
+ end;
+ hCont := CallService(MS_DB_CONTACT_FINDNEXT, hCont, 0);
+ end;
+ if BookmarksMode then
+ SearchBookmarks(hCont)
+ else
+ SearchContact(hCont);
+{$ELSE}
+ BuildContactsList;
+ for i := Length(Contacts) - 1 downto 0 do
+ begin
+ if BookmarksMode then
+ SearchBookmarks(Contacts[i].hContact)
+ else
+ SearchContact(Contacts[i].hContact);
+ end;
+{$ENDIF}
+ finally
+ // only Post..., not Send... because we wait for this thread
+ // to die in this message
+ DoMessage(HM_STRD_FINISHED, 0, 0);
+ end;
+end;
+
+procedure TSearchThread.Terminate(NewPriority: TThreadPriority = tpIdle);
+begin
+ if (NewPriority <> tpIdle) and (NewPriority <> Priority) then
+ Priority := NewPriority;
+ inherited Terminate;
+end;
+
+procedure TSearchThread.GenerateSearchWords;
+var
+ n: Integer;
+ st: String;
+begin
+ SetLength(SearchWords, 0);
+ st := SearchText;
+ n := Pos(' ', st);
+ while n > 0 do
+ begin
+ if n > 1 then
+ begin
+ SetLength(SearchWords, Length(SearchWords) + 1);
+ SearchWords[High(SearchWords)] := Copy(st, 1, n - 1);
+ end;
+ Delete(st, 1, n);
+ n := Pos(' ', st);
+ end;
+
+ if st <> '' then
+ begin
+ SetLength(SearchWords, Length(SearchWords) + 1);
+ SearchWords[High(SearchWords)] := st;
+ end;
+end;
+
+function TSearchThread.GetContactsCount: Integer;
+begin
+ Result := CallService(MS_DB_CONTACT_GETCOUNT, 0, 0);
+end;
+
+function TSearchThread.GetItemsCount(hContact: THandle): Integer;
+begin
+ Result := CallService(MS_DB_EVENT_GETCOUNT, hContact, 0);
+end;
+
+procedure TSearchThread.IncProgress;
+begin
+ SetProgress(CurProgress + 1);
+end;
+
+procedure TSearchThread.SearchContact(Contact: THandle);
+var
+ hDBEvent: THandle;
+begin
+ if Terminated then
+ exit;
+ CurContactCP := GetContactCodePage(Contact);
+ CurContact := Contact;
+ DoMessage(HM_STRD_NEXTCONTACT, wParam(Contact), lParam(GetContactsCount));
+ hDBEvent := CallService(MS_DB_EVENT_FINDLAST, Contact, 0);
+ while (hDBEvent <> 0) and (not Terminated) do
+ begin
+ if SearchEvent(hDBEvent) then
+ SendItem(hDBEvent);
+ hDBEvent := CallService(MS_DB_EVENT_FINDPREV, hDBEvent, 0);
+ end;
+ SendBatch;
+end;
+
+procedure TSearchThread.SearchBookmarks(Contact: THandle);
+var
+ i: Integer;
+begin
+ if Terminated then
+ exit;
+ DoMessage(HM_STRD_NEXTCONTACT, wParam(Contact), lParam(GetContactsCount));
+ for i := 0 to BookmarkServer[Contact].Count - 1 do
+ begin
+ if Terminated then
+ exit;
+ Inc(AllEvents);
+ SendItem(BookmarkServer[Contact].Items[i]);
+ IncProgress;
+ end;
+ SendBatch;
+end;
+
+function TSearchThread.SearchEvent(DBEvent: THandle): Boolean;
+var
+ hi: THistoryItem;
+ Passed: Boolean;
+ EventDate: TDateTime;
+begin
+ Result := False;
+ if Terminated then
+ exit;
+ Passed := True;
+ if smRange in SearchMethod then
+ begin
+ EventDate := Trunc(GetEventDateTime(DBEvent));
+ Passed := ((SearchRangeFrom <= EventDate) and (SearchRangeTo >= EventDate));
+ end;
+ if Passed then
+ begin
+ if SearchMethod * [smExact, smAnyWord, smAllWords, smEvents] <> [] then
+ begin
+ hi := ReadEvent(DBEvent, CurContactCP);
+ if smEvents in SearchMethod then
+ Passed := ((MessageTypesToDWord(FSearchEvents) and MessageTypesToDWord(hi.MessageType))
+ >= MessageTypesToDWord(hi.MessageType));
+ if Passed then
+ begin
+ if smExact in SearchMethod then Passed := SearchTextExact(WideUpperCase(hi.Text), SearchText)
+ else if smAnyWord in SearchMethod then Passed := SearchTextAnyWord(WideUpperCase(hi.Text), SearchWords)
+ else if smAllWords in SearchMethod then Passed := SearchTextAllWords(WideUpperCase(hi.Text), SearchWords);
+ end;
+ end;
+ end;
+ Inc(AllEvents);
+ IncProgress;
+ Result := Passed;
+end;
+
+function TSearchThread.SendItem(hDBEvent: THandle): Boolean;
+var
+ CurBuf: Integer;
+begin
+ Result := True;
+ if Terminated then
+ exit;
+ Inc(BufCount);
+ if FirstBatch then
+ CurBuf := ST_FIRST_BATCH
+ else
+ CurBuf := ST_BATCH;
+ Buffer[BufCount - 1] := hDBEvent;
+ if BufCount = CurBuf then
+ Result := SendBatch;
+end;
+
+function TSearchThread.SendBatch;
+var
+ Batch: PDBArray;
+begin
+ Result := True;
+ if Terminated then
+ exit;
+ if BufCount > 0 then
+ begin
+ GetMem(Batch, SizeOf(Batch^));
+ CopyMemory(Batch, @Buffer, SizeOf(Buffer));
+ Result := DoMessage(HM_STRD_ITEMSFOUND, wParam(Batch), lParam(BufCount));
+ if not Result then
+ begin
+ FreeMem(Batch, SizeOf(Batch^));
+ Terminate(tpHigher);
+ end;
+ BufCount := 0;
+ FirstBatch := False;
+ end;
+end;
+
+procedure TSearchThread.SetProgress(Progress: Integer);
+begin
+ CurProgress := Progress;
+ if CurProgress > MaxProgress then
+ MaxProgress := CurProgress;
+ if (CurProgress mod 1000 = 0) or (CurProgress = MaxProgress) then
+ DoMessage(HM_STRD_PROGRESS, wParam(CurProgress), lParam(MaxProgress));
+end;
+
+procedure TSearchThread.SetSearchRangeFrom(const Value: TDateTime);
+begin
+ FSearchRangeFrom := Trunc(Value);
+end;
+
+procedure TSearchThread.SetSearchRangeTo(const Value: TDateTime);
+begin
+ FSearchRangeTo := Trunc(Value);
+end;
+
+procedure TSearchThread.SetSearchEvents(const Value: TMessageTypes);
+begin
+ FSearchEvents := Value;
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/hpp_services.pas b/plugins/HistoryPlusPlus/hpp_services.pas new file mode 100644 index 0000000000..378f2aa382 --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_services.pas @@ -0,0 +1,265 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+{ -----------------------------------------------------------------------------
+ hpp_services (historypp project)
+
+ Version: 1.5
+ Created: 05.08.2004
+ Author: Oxygen
+
+ [ Description ]
+
+ Module with history's own services
+
+ [ History ]
+
+ 1.5 (05.08.2004)
+ First version
+
+ [ Modifications ]
+ none
+
+ [ Known Issues ]
+ none
+
+ Contributors: theMIROn, Art Fedorov
+ ----------------------------------------------------------------------------- }
+
+unit hpp_services;
+
+interface
+
+uses
+ Classes, Windows, Controls,
+ m_api,
+ hpp_options,
+ HistoryForm, PassForm, PassCheckForm;
+
+var
+ hAllHistoryRichEditProcess,
+ hHppShowHistory,
+ hHppEmptyHistory,
+ hHppGetVersion,
+ hHppShowGlobalSearch,
+ hHppOpenHistoryEvent,
+ hHppRichEditItemProcess: THandle;
+ HstWindowList: TList;
+ PassFm: TfmPass;
+ PassCheckFm: TfmPassCheck;
+
+procedure hppRegisterServices;
+procedure hppUnregisterServices;
+
+procedure CloseGlobalSearchWindow;
+procedure CloseHistoryWindows;
+function FindContactWindow(hContact: THandle): THistoryFrm;
+function OpenContactHistory(hContact: THandle; Index: Integer = -1): THistoryFrm;
+
+function AllHistoryRichEditProcess(wParam: WPARAM; lParam: LPARAM): Int; cdecl;
+
+implementation
+
+uses
+ SysUtils, GlobalSearch, EmptyHistoryForm,
+ hpp_global, hpp_database, hpp_itemprocess, hpp_forms,
+ hpp_mescatcher, hpp_bookmarks;
+
+// our own processing of RichEdit for all history windows
+function AllHistoryRichEditProcess(wParam { hRichEdit } : WPARAM; lParam { PItemRenderDetails } : LPARAM): Int; cdecl;
+begin
+ Result := 0;
+ if GridOptions.SmileysEnabled then Result := Result or DoSupportSmileys(wParam, lParam);
+ if GridOptions.MathModuleEnabled then Result := Result or DoSupportMathModule(wParam, lParam);
+ if GridOptions.AvatarsHistoryEnabled then Result := Result or DoSupportAvatarHistory(wParam, lParam);
+end;
+
+procedure CloseHistoryWindows;
+var
+ i: Integer;
+begin
+ try
+ for i := HstWindowList.Count - 1 downto 0 do
+ THistoryFrm(HstWindowList[i]).Free;
+ except
+ end;
+end;
+
+procedure CloseGlobalSearchWindow;
+begin
+ try
+ if Assigned(fmGlobalSearch) then
+ fmGlobalSearch.Free;
+ except
+ end;
+end;
+
+function FindContactWindow(hContact: THandle): THistoryFrm;
+var
+ i: Integer;
+begin
+ Result := nil;
+ for i := 0 to HstWindowList.Count - 1 do
+ begin
+ if THistoryFrm(HstWindowList[i]).hContact = hContact then
+ begin
+ Result := THistoryFrm(HstWindowList[i]);
+ break;
+ end;
+ end;
+end;
+
+function OpenContactHistory(hContact: THandle; Index: Integer = -1): THistoryFrm;
+var
+ wHistory: THistoryFrm;
+ NewWindow: Boolean;
+begin
+ // check if window exists, otherwise create one
+ wHistory := FindContactWindow(hContact);
+ NewWindow := not Assigned(wHistory);
+ if NewWindow then
+ begin
+ wHistory := THistoryFrm.Create(nil);
+ HstWindowList.Add(wHistory);
+ wHistory.WindowList := HstWindowList;
+ wHistory.hg.Options := GridOptions;
+ wHistory.hContact := hContact;
+ wHistory.Load;
+ end;
+ if Index <> -1 then
+ begin
+ wHistory.ShowAllEvents;
+ wHistory.ShowItem(index);
+ end;
+ if NewWindow then
+ wHistory.Show
+ else
+ BringFormToFront(wHistory); // restore even if minimized
+ Result := wHistory;
+end;
+
+// MS_HISTORY_SHOWCONTACTHISTORY service
+// show history called by miranda
+function HppShowHistory(wParam { hContact } : WPARAM; lParam { 0 } : LPARAM): int_ptr; cdecl;
+begin
+ OpenContactHistory(wParam);
+ Result := 0;
+end;
+
+// MS_HPP_GETVERSION service
+// See m_historypp.inc for details
+function HppGetVersion(wParam { 0 } : WPARAM; lParam { 0 } : LPARAM): int_ptr; cdecl;
+begin
+ Result := hppVersion;
+end;
+
+// MS_HPP_SHOWGLOBALSEARCH service
+// See m_historypp.inc for details
+function HppShowGlobalSearch(wParam { 0 } : WPARAM; lParam { 0 } : LPARAM): int_ptr; cdecl;
+begin
+ if not Assigned(fmGlobalSearch) then
+ begin
+ fmGlobalSearch := TfmGlobalSearch.Create(nil);
+ fmGlobalSearch.hg.Options := GridOptions;
+ fmGlobalSearch.Show;
+ end
+ else
+ BringFormToFront(fmGlobalSearch);
+ Result := 0;
+end;
+
+// MS_HPP_OPENHISTORYEVENT service
+// See m_historypp.inc for details
+function HppOpenHistoryEvent(wParam { POpenEventParams } : WPARAM; lParam: LPARAM): int_ptr; cdecl;
+var
+ wHistory: THistoryFrm;
+ hDbEvent: THandle;
+ item, sel: Integer;
+ oep: TOpenEventParams;
+begin
+ if Assigned(POpenEventParams(wParam)) then
+ begin
+ oep := POpenEventParams(wParam)^;
+ hDbEvent := CallService(MS_DB_EVENT_FINDLAST, oep.hContact, 0);
+ item := 0;
+ sel := -1;
+ while (hDbEvent <> oep.hDbEvent) and (hDbEvent <> 0) do
+ begin
+ hDbEvent := CallService(MS_DB_EVENT_FINDPREV, hDbEvent, 0);
+ Inc(item);
+ end;
+ if hDbEvent = oep.hDbEvent then
+ sel := item;
+ wHistory := OpenContactHistory(oep.hContact, sel);
+ if wHistory.PasswordMode then
+ if (oep.pPassword <> nil) and CheckPassword(oep.pPassword) then
+ wHistory.PasswordMode := False;
+ Result := int_ptr(not wHistory.PasswordMode);
+ end
+ else
+ Result := 0;
+end;
+
+// MS_HPP_EMPTYHISTORY service
+// See m_historypp.inc for details
+function HppEmptyHistory(wParam { hContact } : WPARAM; lParam { 0 } : LPARAM): int_ptr; cdecl;
+var
+ wHistory: THistoryFrm;
+begin
+ wHistory := FindContactWindow(wParam);
+ with TEmptyHistoryFrm.Create(wHistory) do
+ begin
+ Contact := wParam;
+ Result := int_ptr(ShowModal = mrYes);
+ Free;
+ end;
+end;
+
+procedure hppRegisterServices;
+begin
+ HstWindowList := TList.Create;
+
+ hHppShowHistory := CreateServiceFunction(MS_HISTORY_SHOWCONTACTHISTORY,HppShowHistory);
+ hHppEmptyHistory := CreateServiceFunction(MS_HPP_EMPTYHISTORY, HppEmptyHistory);
+ hHppGetVersion := CreateServiceFunction(MS_HPP_GETVERSION, HppGetVersion);
+ hHppShowGlobalSearch := CreateServiceFunction(MS_HPP_SHOWGLOBALSEARCH,HppShowGlobalSearch);
+ hHppOpenHistoryEvent := CreateServiceFunction(MS_HPP_OPENHISTORYEVENT,HppOpenHistoryEvent);
+
+ hHppRichEditItemProcess := CreateHookableEvent(ME_HPP_RICHEDIT_ITEMPROCESS);
+ hAllHistoryRichEditProcess := HookEvent(ME_HPP_RICHEDIT_ITEMPROCESS,AllHistoryRichEditProcess);
+end;
+
+procedure hppUnregisterServices;
+begin
+ CloseHistoryWindows;
+ CloseGlobalSearchWindow;
+ UnhookEvent(hAllHistoryRichEditProcess);
+ DestroyServiceFunction(hHppShowHistory);
+ DestroyServiceFunction(hHppEmptyHistory);
+ DestroyServiceFunction(hHppGetVersion);
+ DestroyServiceFunction(hHppShowGlobalSearch);
+ DestroyServiceFunction(hHppOpenHistoryEvent);
+ DestroyServiceFunction(hHppEmptyHistory);
+ DestroyHookableEvent(hHppRichEditItemProcess);
+ HstWindowList.Free;
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/hpp_sessionsthread.pas b/plugins/HistoryPlusPlus/hpp_sessionsthread.pas new file mode 100644 index 0000000000..c6d55c13b8 --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_sessionsthread.pas @@ -0,0 +1,272 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+{-----------------------------------------------------------------------------
+ hpp_searchthread (historypp project)
+
+ Version: 1.0
+ Created: 05.08.2004
+ Author: Oxygen
+
+ [ Description ]
+
+ Global searching in History++ is performed in background so
+ we have separate thread for doing it. Here it is, all bright
+ and shiny. In this module the thread is declared, also you
+ can find all text searching routines used and all search
+ logic. See TTimeThread and independent SearchText* funcs
+
+ The results are sent in batches of 500, for every contact.
+ First batch is no more than 50 for fast display.
+
+ Yeah, all search is CASE-INSENSITIVE (at the time of writing :)
+
+ [ History ]
+
+ 1.5 (05.08.2004)
+ First version
+
+ [ Modifications ]
+ none
+
+ [ Known Issues ]
+ none
+
+ Contributors: theMIROn, Art Fedorov
+-----------------------------------------------------------------------------}
+
+unit hpp_sessionsthread;
+
+interface
+
+uses
+ Windows, Classes, m_api, hpp_global;
+
+type
+ PSess = ^TSess;
+ TSess = record
+ hDBEventFirst: THandle;
+ TimestampFirst: DWord;
+ hDBEventLast: THandle;
+ TimestampLast: DWord;
+ ItemsCount: DWord;
+ end;
+
+ PSessArray = ^TSessArray;
+ TSessArray = array of TSess;
+
+ TSessionsThread = class(TThread)
+ private
+ Buffer: TSessArray;
+ BufCount: Integer;
+ FirstBatch: Boolean;
+ FParentHandle: Hwnd;
+ FSearchTime: Cardinal;
+ SearchStart: Cardinal;
+ FContact: THandle;
+ function DoMessage(Message: DWord; wParam: WPARAM; lParam: LPARAM): Boolean;
+ function SendItem(hDBEvent, LastEvent:THandle; Timestamp, LastTimestamp, Count: DWord): Boolean;
+ function SendBatch: Boolean;
+
+ protected
+ procedure Execute; override;
+
+ public
+ AllContacts, AllEvents: Integer;
+
+ constructor Create(CreateSuspended: Boolean);
+ destructor Destroy; override;
+
+ property Contact: THandle read FContact write FContact;
+ property SearchTime: Cardinal read FSearchTime;
+ property ParentHandle: Hwnd read FParentHandle write FParentHandle;
+
+ property Terminated;
+ procedure Terminate(NewPriority: TThreadPriority = tpIdle); reintroduce;
+ end;
+
+const
+ HM_SESS_PREPARE = HM_SESS_BASE + 1; // the search is prepared (0,0)
+ HM_SESS_FINISHED = HM_SESS_BASE + 2; // search finished (0,0)
+ HM_SESS_ITEMSFOUND = HM_SESS_BASE + 3; // (NEW) items are found (array of hDBEvent, array size)
+
+const
+ SESSION_TIMEDIFF = 2*(60*60); // 2 hours
+
+function IsEventInSession(EventType: Word): boolean;
+
+implementation
+
+const
+ SessionEvents: array[0..3] of Word = (
+ EVENTTYPE_MESSAGE,
+ EVENTTYPE_FILE,
+ EVENTTYPE_URL,
+ EVENTTYPE_CONTACTS);
+
+function IsEventInSession(EventType: Word): boolean;
+var
+ i: integer;
+begin
+ Result := False;
+ for i := 0 to High(SessionEvents) do
+ if SessionEvents[i] = EventType then
+ begin
+ Result := True;
+ exit;
+ end;
+end;
+
+{ TSessionsThread }
+
+constructor TSessionsThread.Create(CreateSuspended: Boolean);
+begin
+ inherited Create(CreateSuspended);
+ AllContacts := 0;
+ AllEvents := 0;
+end;
+
+destructor TSessionsThread.Destroy;
+begin
+ inherited;
+ SetLength(Buffer,0);
+end;
+
+function TSessionsThread.DoMessage(Message: DWord; wParam: WPARAM; lParam: LPARAM): Boolean;
+begin
+ SendMessage(ParentHandle,Message,wParam,lParam);
+ Result := true;
+end;
+
+procedure TSessionsThread.Execute;
+var
+ Event: TDBEventInfo;
+ Count, LastTimestamp, FirstTimestamp: DWord;
+ FirstEvent, LastEvent, hDBEvent: THandle;
+ PrevTime, CurTime: DWord;
+begin
+ PrevTime := 0;
+ // to avoid compiler warnings
+ FirstEvent := 0;
+ FirstTimestamp := 0;
+ LastEvent := 0;
+ LastTimestamp := 0;
+
+ SearchStart := GetTickCount;
+ BufCount := 0;
+ Count := 0;
+ FirstBatch := True;
+ try
+ DoMessage(HM_SESS_PREPARE, 0, 0);
+ hDBEvent := CallService(MS_DB_EVENT_FINDFIRST, FContact, 0);
+ while (hDBEvent <> 0) and not Terminated do
+ begin
+ ZeroMemory(@Event, SizeOf(Event));
+ Event.cbSize := SizeOf(Event);
+ Event.cbBlob := 0;
+ CallService(MS_DB_EVENT_GET, hDBEvent, LPARAM(@Event));
+ CurTime := Event.Timestamp;
+ if PrevTime = 0 then
+ begin
+ PrevTime := CurTime;
+ FirstEvent := hDBEvent;
+ FirstTimestamp := PrevTime;
+ LastEvent := hDBEvent;
+ LastTimestamp := PrevTime;
+ Inc(Count);
+ // SendItem(hDBEvent,PrevTime);
+ end
+ else
+ begin
+ if IsEventInSession(Event.EventType) then
+ if (CurTime - PrevTime) > SESSION_TIMEDIFF then
+ begin
+ SendItem(FirstEvent, LastEvent, FirstTimestamp, LastTimestamp, Count);
+ FirstEvent := hDBEvent;
+ FirstTimestamp := CurTime;
+ Count := 0;
+ end;
+ LastEvent := hDBEvent;
+ LastTimestamp := CurTime;
+ Inc(Count);
+ PrevTime := CurTime;
+ end;
+ hDBEvent := CallService(MS_DB_EVENT_FINDNEXT, hDBEvent, 0);
+ end;
+ SendItem(FirstEvent, LastEvent, FirstTimestamp, LastTimestamp, Count);
+ SendBatch;
+ finally
+ FSearchTime := GetTickCount - SearchStart;
+ DoMessage(HM_SESS_FINISHED, 0, 0);
+ end;
+end;
+
+procedure TSessionsThread.Terminate(NewPriority: TThreadPriority = tpIdle);
+begin
+ if (NewPriority <> tpIdle) and (NewPriority <> Priority) then
+ Priority := NewPriority;
+ inherited Terminate;
+end;
+
+function TSessionsThread.SendItem(hDBEvent, LastEvent:THandle; Timestamp, LastTimestamp, Count: DWord): Boolean;
+begin
+ Result := True;
+ if Terminated then
+ exit;
+ BufCount := Length(Buffer);
+ SetLength(Buffer, BufCount + 1);
+ with Buffer[BufCount] do
+ begin
+ hDBEventFirst := hDBEvent;
+ TimestampFirst := Timestamp;
+ hDBEventLast := LastEvent;
+ TimestampLast := LastTimestamp;
+ ItemsCount := Count;
+ end;
+ Inc(BufCount);
+end;
+
+function TSessionsThread.SendBatch: Boolean;
+var
+ Batch: PSessArray;
+begin
+ Result := True;
+ if Terminated then
+ exit;
+{$RANGECHECKS OFF}
+ if Length(Buffer) > 0 then
+ begin
+ GetMem(Batch, SizeOf(Buffer));
+ CopyMemory(Batch, @Buffer, SizeOf(Buffer));
+ Result := DoMessage(HM_SESS_ITEMSFOUND, wParam(Batch), Length(Buffer));
+ if not Result then
+ begin
+ FreeMem(Batch, SizeOf(Buffer));
+ Terminate(tpHigher);
+ end;
+ SetLength(Buffer, 0);
+ BufCount := 0;
+ FirstBatch := False;
+ end;
+{$RANGECHECKS ON}
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/hpp_strparser.pas b/plugins/HistoryPlusPlus/hpp_strparser.pas new file mode 100644 index 0000000000..66fe0e207d --- /dev/null +++ b/plugins/HistoryPlusPlus/hpp_strparser.pas @@ -0,0 +1,176 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+{-----------------------------------------------------------------------------
+ hpp_strparser.pas (historypp project)
+
+ Version: 1.5
+ Created: 18.04.2006
+ Author: Oxygen
+
+ [ Description ]
+
+ This unit provides AnsiString parsing routines. Mainly it was added to
+ parse tokens from the AnsiString. See TokenizeString for description.
+
+ [ Modifications ]
+ none
+
+ [ Known Issues ]
+ none
+
+ Contributors: Art Fedorov
+-----------------------------------------------------------------------------}
+
+unit hpp_strparser;
+
+interface
+
+uses
+ hpp_global;
+
+procedure TokenizeString(const Template: String; var Tokens: TWideStrArray; var SpecialTokens: TIntArray);
+
+implementation
+
+{
+ This procedure splits AnsiString into array.
+
+ The split is based on three token types:
+ 1) general text
+ 2) chars prefixed with '\', like '\n'
+ 3) AnsiString surrounded by %'s, like '%mymom%'
+
+ You input the AnsiString in Template variable and it outputs
+ * Tokens: array of all tokens
+ * SpecialTokens: array of token indexes from the Tokens array,
+ where indexes are of 2nd and 3rd type tokens
+
+ You can get the orginial template AnsiString if you combine all strings
+ from tokens array. It means that Template = Tokens[0]+Tokens[1]+...+Tokens[n]
+
+ The idea is that after recieving special tokens array, you can scan through
+ them and change all the special tokens you want in the tokens array and then
+ combine tokens array to get template with the needed tokens substituted
+
+ *** Examples (special tokens in double quotes here):
+ 'My %mom% is good\not bad' -> 'My '+"%mom%"+' is good'+"\n"+'ot bad'
+ '%My mom% is good' -> "%My mom%"+' is good'
+ *** Placing \'s inside %'s would give you type 2 token, not type 3:
+ '%My \mom% is good' -> '%My '+"\m"+'om% is good'
+ *** \'s and %'s at the end of the line don't get counted:
+ 'My mom\' -> 'My mom\'
+ 'My mom%' -> 'My mom%'
+ 'My mom is %good' -> 'My mom is %good'
+ *** But
+ 'My mom is %good%' -> 'My mom is '+"%good%"
+ *** Double %'s is also counted as token:
+ 'My %% mom' -> 'My '+"%%"+' mom'
+
+ So, feeding it 'My %mom% is good\nNot bad' would output:
+ Tokens =>
+ [0] -> 'My '
+ [1] -> '%mom%'
+ [2] -> ' is good'
+ [3] -> '\n'
+ [4] -> 'Not bad'
+ SpecialTokens =>
+ [0] -> 1
+ [1] -> 3
+}
+procedure TokenizeString(const Template: String; var Tokens: TWideStrArray; var SpecialTokens: TIntArray);
+var
+ i,len: Integer;
+ token_s: Integer;
+ in_token: Boolean;
+
+ procedure PushToken(StartIdx,EndIdx: Integer; Special: Boolean = False);
+ begin
+ if EndIdx < StartIdx then
+ exit;
+ if not Special then
+ begin // if not special, try to append current token to previous
+ if Length(Tokens) > 0 then
+ begin
+ if not ((Length(SpecialTokens) > 0) and
+ (SpecialTokens[High(SpecialTokens)] = High(Tokens))) then // previous was not special
+ begin
+ Tokens[High(Tokens)] := Tokens[High(Tokens)] + Copy(Template,StartIdx,EndIdx-StartIdx+1);
+ exit;
+ end;
+ end;
+ end;
+ SetLength(Tokens,Length(Tokens)+1);
+ Tokens[High(Tokens)] := Copy(Template,StartIdx,EndIdx-StartIdx+1);
+ if Special then
+ begin
+ SetLength(SpecialTokens,Length(SpecialTokens)+1);
+ SpecialTokens[High(SpecialTokens)] := High(Tokens);
+ end;
+ end;
+
+begin
+ len := Length(Template);
+ SetLength(Tokens,0);
+ SetLength(SpecialTokens,0);
+
+ token_s := 1;
+ in_token := False;
+ i := 1;
+ while i <= len do
+ begin
+ if (Template[i]='\') or (Template[i]='%') then
+ begin
+ if Template[i] = '\' then
+ begin
+ if i = len then
+ break;
+ PushToken(token_s,i-1);
+ token_s := i;
+ PushToken(token_s,token_s+1,True);
+ token_s := i+2;
+ i := token_s;
+ in_token := False;
+ continue;
+ end
+ else
+ begin
+ if in_token then
+ begin
+ PushToken(token_s,i,True);
+ token_s := i + 1;
+ in_token := False;
+ end
+ else
+ begin
+ PushToken(token_s,i-1);
+ token_s := i;
+ in_token := True;
+ end;
+ end;
+ end;
+ Inc(i);
+ end;
+
+ PushToken(token_s,len);
+end;
+
+end.
diff --git a/plugins/HistoryPlusPlus/inc/m_icqext.inc b/plugins/HistoryPlusPlus/inc/m_icqext.inc new file mode 100644 index 0000000000..37336d863d --- /dev/null +++ b/plugins/HistoryPlusPlus/inc/m_icqext.inc @@ -0,0 +1,19 @@ + //auth
+ //db event added to NULL contact
+ //blob format is:
+ //ASCIIZ text
+ //DWORD uin
+ //HANDLE hContact
+ ICQEVENTTYPE_AUTH_GRANTED = 2004; //database event type
+ ICQEVENTTYPE_AUTH_DENIED = 2005; //database event type
+ ICQEVENTTYPE_SELF_REMOVE = 2007; //database event type
+ ICQEVENTTYPE_FUTURE_AUTH = 2008; //database event type
+ ICQEVENTTYPE_CLIENT_CHANGE = 2009; //database event type
+ ICQEVENTTYPE_CHECK_STATUS = 2010; //database event type
+ ICQEVENTTYPE_IGNORECHECK_STATUS = 2011;//database event type
+
+ //broadcast from server
+ //ASCIIZ text
+ //ASCIIZ from name
+ //ASCIIZ from e-mail
+ ICQEVENTTYPE_BROADCAST = 2006; //database event type
diff --git a/plugins/HistoryPlusPlus/inc/m_ieview.inc b/plugins/HistoryPlusPlus/inc/m_ieview.inc new file mode 100644 index 0000000000..2881ef5c8c --- /dev/null +++ b/plugins/HistoryPlusPlus/inc/m_ieview.inc @@ -0,0 +1,217 @@ +{
+ IEView Plugin for Miranda IM
+ Copyright (C) 2005 Piotr Piastucki
+
+ This program is free software; you can redistribute it and/or
+ modify it under the terms of the GNU General Public License
+ as published by the Free Software Foundation; either version 2
+ of the License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+{$IFNDEF M_IEVIEW}
+{$DEFINE M_IEVIEW}
+
+const
+ MS_IEVIEW_WINDOW = 'IEVIEW/NewWindow';
+ MS_IEVIEW_EVENT = 'IEVIEW/Event';
+ MS_IEVIEW_NAVIGATE = 'IEVIEW/Navigate';
+
+ ME_IEVIEW_OPTIONSCHANGED = 'IEVIEW/OptionsChanged';
+(*
+ MS_IEVIEW_UTILS = 'IEVIEW/Utils';
+ MS_IEVIEW_SHOWSMILEYSELECTION = 'IEVIEW/ShowSmileySelection';
+ ME_IEVIEW_NOTIFICATION = 'IEVIEW/Notification';
+*)
+ IEW_CREATE = 1; // create new window (control)
+ IEW_DESTROY = 2; // destroy control
+ IEW_SETPOS = 3; // set window position and size
+ IEW_SCROLLBOTTOM = 4; // scroll text to bottom
+
+ IEWM_SRMM = 0; // regular SRMM
+ IEWM_TABSRMM = 1; // TabSRMM-compatible HTML builder
+ IEWM_HTML = 2; // HTML
+ IEWM_SCRIVER = 3; // HTML
+ IEWM_MUCC = 4; // MUCC group chats GUI
+ IEWM_CHAT = 5; // chat.dll group chats GUI
+ IEWM_HISTORY = 6; // history viewer
+ IEWM_BROWSER = 256; // empty browser window
+
+type
+ PIEVIEWWINDOW = ^TIEVIEWWINDOW;
+ TIEVIEWWINDOW = record
+ cbSize : int; // size of the strusture
+ iType : int; // one of IEW_* values
+ dwMode : DWORD; // compatibility mode - one of IEWM_* values
+ dwFlags: DWORD; // flags, one of IEWF_* values
+ parent : HWND; // parent window HWND
+ hwnd : HWND; // IEW_CREATE returns WebBrowser control's HWND here
+ x : int; // IE control horizontal position
+ y : int; // IE control vertical position
+ cx : int; // IE control horizontal size
+ cy : int; // IE control vertical size
+ end;
+
+const
+ IEEDF_UNICODE = 1; // if set pszText is a pointer to wchar_t string instead of AnsiChar string
+ IEEDF_UNICODE_TEXT = 1; // if set pszText is a pointer to wchar_t string instead of AnsiChar string
+ IEEDF_UNICODE_NICK = 2; // if set pszNick is a pointer to wchar_t string instead of AnsiChar string
+ IEEDF_UNICODE_TEXT2 = 4; // if set pszText2 is a pointer to wchar_t string instead of AnsiChar string
+// The following flags are valid only for message events (IEED_EVENT_MESSAGE)
+ IEEDF_FORMAT_FONT = $00000100; // if set pszFont (font name) is valid and should be used
+ IEEDF_FORMAT_SIZE = $00000200; // if set fontSize is valid and should be used
+ IEEDF_FORMAT_COLOR = $00000400; // if set color is valid and should be used
+ IEEDF_FORMAT_STYLE = $00000800; // if set fontSize is valid and should be used
+
+ IEEDF_READ = $00001000; // if set
+ IEEDF_SENT = $00002000; // if set
+ IEEDF_RTL = $00004000; // if set
+
+ IEED_EVENT_MESSAGE = $0001; // message
+ IEED_EVENT_STATUSCHANGE = $0002; // status change
+ IEED_EVENT_FILE = $0003; // file
+ IEED_EVENT_URL = $0004; // url
+ IEED_EVENT_ERRMSG = $0005; // error message
+ IEED_EVENT_SYSTEM = $0006; // system event
+
+ IEED_MUCC_EVENT_MESSAGE = $0001; // message
+ IEED_MUCC_EVENT_TOPIC = $0002; // topic change
+ IEED_MUCC_EVENT_JOINED = $0003; // user joined
+ IEED_MUCC_EVENT_LEFT = $0004; // user left
+ IEED_MUCC_EVENT_ERROR = $0005; // error
+
+// MUCC-related dwData bit flags
+ IEEDD_MUCC_SHOW_NICK = $00000001;
+ IEEDD_MUCC_MSG_ON_NEW_LINE = $00000002;
+ IEEDD_MUCC_SHOW_DATE = $00000010;
+ IEEDD_MUCC_SHOW_TIME = $00000020;
+ IEEDD_MUCC_SECONDS = $00000040;
+ IEEDD_MUCC_LONG_DATE = $00000080;
+
+ IEED_GC_EVENT_HIGHLIGHT = $8000;
+ IEED_GC_EVENT_MESSAGE = $0001;
+ IEED_GC_EVENT_TOPIC = $0002;
+ IEED_GC_EVENT_JOIN = $0003;
+ IEED_GC_EVENT_PART = $0004;
+ IEED_GC_EVENT_QUIT = $0006;
+ IEED_GC_EVENT_NICK = $0007;
+ IEED_GC_EVENT_ACTION = $0008;
+ IEED_GC_EVENT_KICK = $0009;
+ IEED_GC_EVENT_NOTICE = $000A;
+ IEED_GC_EVENT_INFORMATION = $000B;
+ IEED_GC_EVENT_ADDSTATUS = $000C;
+ IEED_GC_EVENT_REMOVESTATUS = $000D;
+
+// GC-related dwData bit flags
+ IEEDD_GC_SHOW_NICK = $00000001;
+ IEEDD_GC_SHOW_TIME = $00000002;
+ IEEDD_GC_SHOW_ICON = $00000004;
+ IEEDD_GC_MSG_ON_NEW_LINE = $00001000;
+
+ IE_FONT_BOLD = $000100; // Bold font flag
+ IE_FONT_ITALIC = $000200; // Italic font flag
+ IE_FONT_UNDERLINE = $000400; // Underlined font flags
+
+type
+ PtagIEVIEWEVENTDATA = ^TtagIEVIEWEVENTDATA;
+ TtagIEVIEWEVENTDATA = record
+ cbSize :int;
+ iType :int; // Event type, one of MUCC_EVENT_* values
+ dwFlags :dword; // Event flags - IEEF_*
+ fontName :PAnsiChar; // Text font name
+ fontSize :int; // Text font size (in pixels)
+ fontStyle:int; // Text font style (combination of IE_FONT_* flags)
+ color :TCOLORREF; // Text color
+ Nick :TChar; // Nick, usage depends on type of event
+ Text :TChar; // Text, usage depends on type of event
+ dwData :dword; // DWORD data e.g. status
+ bIsMe :BOOL; // TRUE if the event is related to the user
+ time :dword; // Time of the event
+ next :PtagIEVIEWEVENTDATA;
+ Text2 :TChar; // Text, usage depends on type of event
+ end;
+ PIEVIEWEVENTDATA = PtagIEVIEWEVENTDATA;
+ TIEVIEWEVENTDATA = TtagIEVIEWEVENTDATA;
+
+const
+ IEE_LOG_DB_EVENTS = 1; // log specified number of DB events
+ IEE_CLEAR_LOG = 2; // clear log
+ IEE_GET_SELECTION = 3; // get selected text
+ IEE_SAVE_DOCUMENT = 4; // save current document
+ IEE_LOG_MEM_EVENTS = 5; // log specified number of IEView events
+
+ IEEF_RTL = 1; // turn on RTL support
+ IEEF_NO_UNICODE = 2; // disable Unicode support
+ IEEF_NO_SCROLLING = 4; // do not scroll logs to bottom
+
+const
+ IEVIEWEVENT_SIZE_V1 = 28;
+ IEVIEWEVENT_SIZE_V2 = 32;
+ IEVIEWEVENT_SIZE_V3 = 36;
+
+type
+ tagIEVIEWEVENT = record
+ case byte of
+ 0: (hDbEventFirst: THANDLE);
+ 1: (eventData :PIEVIEWEVENTDATA);
+ end;
+
+ PIEVIEWEVENT = ^TIEVIEWEVENT;
+ TIEVIEWEVENT = record
+ cbSize :int; // size of the strusture
+ iType :int; // one of IEE_* values
+ dwFlags :DWORD; // one of IEEF_* values
+ hwnd :HWND; // HWND returned by IEW_CREATE
+ hContact :THANDLE; // contact
+ Event :tagIEVIEWEVENT; // first event to log, when IEE_LOG_EVENTS
+ // returns it will contain the last event
+ // actually logged or NULL if no event was logged
+ count :int; // number of events to log
+ codepage :int; // ANSI codepage
+ pszProto :PAnsiChar;
+ end;
+(*
+type
+ PIEVIEWSHOWSMILEYSEL = ^TIEVIEWSHOWSMILEYSEL;
+ TIEVIEWSHOWSMILEYSEL = record
+ cbSize : int; // size of the structure
+ Protocolname : PAnsiChar; // protocol to use... if you have defined a protocol,
+ // u can use your own protocol name. Smiley add will
+ // automatically select the smileypack that is
+ // defined for your protocol. Or, use "Standard" for
+ // standard smiley set. Or "ICQ", "MSN" if you
+ // prefer those icons. If not found or NULL:
+ // "Standard" will be used
+ xPosition : int; // Postition to place the selectwindow
+ yPosition : int;
+ Direction : int; // Direction (i.e. size upwards/downwards/etc) of
+ // the window 0, 1, 2, 3
+ hwndTarget : HWND; // Window, where to send the message when smiley is
+ // selected.
+ targetMessage: DWORD; // Target message, to be sent.
+ targetWParam : LPARAM; // Target WParam to be sent (LParam will be AnsiChar*
+ // to select smiley) see the example file.
+ end;
+*)
+const
+ IEN_NAVIGATE = 1; // navigate to the given destination
+ IENF_UNICODE = 1; // if set urlW is used instead of urlW
+
+type
+ IEVIEWNAVIGATE = record
+ cbSize :int; // size of the strusture
+ iType :int; // one of IEN_* values
+ dwFlags:dword; // one of IEEF_* values
+ hwnd :HWND; // HWND returned by IEW_CREATE
+ url :TChar; // Text, usage depends on type of event
+end;
+
+{$ENDIF}
diff --git a/plugins/HistoryPlusPlus/inc/m_jabber.inc b/plugins/HistoryPlusPlus/inc/m_jabber.inc new file mode 100644 index 0000000000..bbb051e203 --- /dev/null +++ b/plugins/HistoryPlusPlus/inc/m_jabber.inc @@ -0,0 +1,32 @@ +{
+Jabber Protocol Plugin for Miranda IM
+Copyright ( C ) 2002-04 Santithorn Bunchua
+Copyright ( C ) 2005-07 George Hazan
+Copyright ( C ) 2007 Maxim Mluhov
+
+This program is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public License
+as published by the Free Software Foundation; either version 2
+of the License, or ( at your option ) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+{$IFNDEF M_JABBER}
+{$DEFINE M_JABBER}
+
+const
+
+ // registered db event types
+ JABBER_DB_EVENT_TYPE_CHATSTATES = 2000;
+ JS_DB_GETEVENTTEXT_CHATSTATES = '/GetEventText2000';
+ JABBER_DB_EVENT_CHATSTATES_GONE = 1;
+
+{$ENDIF}
diff --git a/plugins/HistoryPlusPlus/inc/m_mathmodule.inc b/plugins/HistoryPlusPlus/inc/m_mathmodule.inc new file mode 100644 index 0000000000..a4d10edfa6 --- /dev/null +++ b/plugins/HistoryPlusPlus/inc/m_mathmodule.inc @@ -0,0 +1,199 @@ +{$IFNDEF M_MATHMODULE}
+{$DEFINE M_MATHMODULE}
+ {--------------------------------------------------- }
+ {
+ 2
+ x + 2 Pi
+ + R
+ Sin(wt)
+
+ Math-Module
+
+ Miranda Plugin by Stephan Kassemeyer
+ MathModule API - (c) Stephan Kassemeyer
+ 8 May, 2004
+ }
+ { --------- }
+ {
+ Miranda Service-functions defined by MathModule
+ call with the
+ int ( CallService)(const AnsiChar servicename,WPARAM,LPARAM)
+ that you get from miranda when Miranda calls the
+ Load(PLUGINLINK link)
+ of your PlugIn-dll
+ the CallService function then is:
+ link->CallServiceSync(Servicename,wparam,lparam)
+ }
+ { --------- }
+
+const
+ MATH_RTF_REPLACE_FORMULAE = 'Math/RtfReplaceFormulae';
+ { replace all formulas in a RichEdit with bitmaps. }
+ { wParam = 0 }
+ { lParam = *TMathRichedit Info }
+ { return: TRUE if replacement succeeded, FALSE if not (disable by user?). }
+ { handle of richedit. }
+ { NULL: replace all. }
+type
+ PMathRicheditInfo = ^TMathRicheditInfo;
+ TMathRicheditInfo = record
+ hwndRichEditControl : HWND;
+ sel : PCHARRANGE;
+ disableredraw : int;
+ end;
+ { WARNING: !!! }
+ { Strange things happen if you use this function twice on the same CHARRANGE: }
+ { if Math-startDelimiter == Math-endDelimiter, there is the following problem: }
+ { it might be that someone forgot an endDelimiter, this results in a lonesome startdelimiter. }
+ { if you try to MATH_REPLACE_FORMULAE the second time, startDelimiters and endDelimiters are mixed up. }
+ { The same problem occours if we have empty formulae, because two succeding delimiters are }
+ { replaced with a single delimiter. }
+
+const
+ MATH_GET_STARTDELIMITER = 'Math/GetStartDelimiter';
+ { returns the delimiter that marks the beginning of a formula }
+ { wparam=0 }
+ { lparam=0 }
+ { result=*AnsiChar Delimiter }
+ { !!! the result-buffer must be deleted with MTH_FREE_MATH_BUFFER }
+
+ MATH_GETENDDELIMITER = 'Math/GetEndDelimiter';
+ { returns the delimiter that marks the end of a formula }
+ { wparam=0 }
+ { lparam=0 }
+ { result=*AnsiChar Delimiter }
+ { !!! the result-buffer must be deleted with MTH_FREE_MATH_BUFFER }
+
+ MTH_FREE_MATH_BUFFER = 'Math/FreeRTFBitmapText';
+ { deletes any buffer that MathModule has created. }
+ { wparam=0 }
+ { lparam=(*AnsiChar) buffer }
+ { result=0 }
+
+ MATH_SETBKGCOLOR = 'Math/SetBackGroundColor';
+ { changes the background color of the next formula to be rendered. }
+ { wparam=0 }
+ { lparam=(COLORREF) color }
+ { result=0 }
+
+ MATH_SET_PARAMS = 'Math/SetParams';
+ { sets a parameter (only integer values) encoded in wparam }
+ { wparam=paramcode }
+ { lparam=parametervalue }
+ { paramcodes: }
+const
+ MATH_PARAM_BKGCOLOR = 0; // (COLORREF) std-rgb-color or TRANSPARENT_Color
+ MATH_PARAM_FONTCOLOR = 1; // (COLORREF) std-rgb-color
+ RESIZE_HWND = 2; // (HWND) preview window resizes RESIZE_HWND when
+ // it is being resized.
+ ToolboxEdit_HWND = 3; // (HWND) If this hwnd (of an edit-box) is set,
+ // MathModule can insert Formula-elements from
+ // the Math-Toolbox.
+// you can make the BKGCOLOR Transparent (default) by using this color:
+ TRANSPARENT_Color = $FFFFFFFF-1; // this is default
+
+const
+ MTH_GETBITMAP = 'Math/GetBitmap';
+ {returns Bitmap that represents the formula given in lparam (string-pointer) }
+ {this formula has NO Delimiters. }
+ {wparam=0 }
+ {lparam=(*AnsiChar)Formula }
+ {result=(HBITMAP) bitmap }
+ {!!! the bitmap must be deleted with DeleteObject(hobject) }
+ {example: }
+ {HBITMAP Bmp=(HBITMAP)CallService(MTH_GETBITMAP,0, (LPARAM)formula); }
+
+ MTH_GET_RTF_BITMAPTEXT = 'Math/GetRTFBitmapText';
+ { returns rich-text stream that includes bitmaps from text given in lparam }
+ { text included between MATH_GET_STARTDELIMITER and MATH_GETENDDELIMITER }
+ { hereby is replaced with a rtf-bitmap-stream that represents the corresponding formula }
+ { wparam=0 }
+ { lparam=*AnsiChar text }
+ { result=*AnsiChar rtfstream }
+ { !!! the result-buffer must be deleted with MTH_FREE_RTF_BITMAPTEXT }
+
+ MTH_FREE_RTF_BITMAPTEXT = 'Math/FreeRTFBitmapText';
+ { deletes the buffer that MTH_GET_RTF_BITMAPTEXT has created. }
+ { wparam=0 }
+ { lparam=(*AnsiChar) buffer }
+ { result=0 }
+
+ { ************************************************************** }
+ { The following is still SRMM - specific. }
+ { I plan to modify it, so that other PlugIns can take advantage of e.g. preview-window.... }
+const
+ MTH_SHOW = 'Math/Show';
+ { shows the preview-window }
+ { wparam=0 }
+ { lparam=0 }
+ { result=0 }
+
+ MTH_HIDE = 'Math/Hide';
+ { hides the preview-window }
+ { wparam=0 }
+ { lparam=0 }
+ { result=0 }
+
+ MTH_RESIZE = 'Math/Resize';
+ { sets the size of the preview-window }
+ { wparam=0 }
+ { lparam=(*TMathWindowInfo) }
+ { result=0 }
+type
+ PTMathWindowInfo = ^TTMathWindowInfo;
+ TTMathWindowInfo = record
+ top : int;
+ left : int;
+ right : int;
+ bottom: int;
+ end;
+
+const
+ MTH_SETFORMULA = 'Math/SetFormula';
+ { sets the text that the preview-window should parse to display formulas found inside }
+ { wparam=0 }
+ { lparam=(*AnsiChar) text }
+ { result=0 }
+
+ MTH_Set_ToolboxEditHwnd = 'Math/SetTBhwnd';
+ { If this hwnd (of an edit-box) is set, MathModule can insert Formula-elements from the Math-Toolbox. }
+ { wparam=0 }
+ { lparam=handle }
+ {übergibt fenster-Handle des aktuellen Message-Dialogs }
+
+ MTH_Set_Srmm_HWND = 'Math/SetSrmmHWND';
+ { If MathModule knows the handle of a SRMM-based window, following features exist: }
+ { - preview window resizes Math-Srmm when it is being resized. }
+ { wparam=0 }
+ { lparam=handle }
+ { result=0 }
+ { todo: umbenennen in MTH_Set_ResizeWindowHandle, zusaetzlich MTH_Set_ToolboxEditHandle erstellen, dann keine SRMM-Abhaengigkeit mehr. }
+ { damit ResizeWindows selbst entscheiden koennen, was sie tun, kann man auch ein miranda-event "MTH_preview_resized" einrichten. }
+
+ MTH_GET_PREVIEW_HEIGHT = 'Math/getPreviewHeight';
+ { returns the height of the whole preview-window (including system-menu-bar) }
+ { consider this when maximizing a window to that preview-window is hooked on top or bottom }
+ { it returns the height no matter whether preview-window is visible or not }
+ { wparam=0 }
+ { lparam=0 }
+ { result=(int) height }
+
+ MTH_GET_PREVIEW_SHOWN = 'Math/getPreviewShown';
+ { returns 1 if preview window is visible }
+ { returns 0 if preview window is invisible }
+ { result=(int) shown }
+
+ MTH_SUBSTITUTE_DELIMITER = 'Math/SubstituteDelimiter';
+ { replaces Substitute given lparam-structure with internal Math-Delimiter }
+ { wparam=0 }
+ { lparam=(TMathSubstInfo) substInfo }
+ { result=0 }
+
+type
+ PTMathSubstInfo = ^TTMathSubstInfo;
+ TTMathSubstInfo = record
+ EditHandle : HWND;
+ Substitute : PAnsiChar;
+ end;
+{--------------------------------------------------- }
+{$ENDIF}
diff --git a/plugins/HistoryPlusPlus/inc/m_music.inc b/plugins/HistoryPlusPlus/inc/m_music.inc new file mode 100644 index 0000000000..aba0bd27f6 --- /dev/null +++ b/plugins/HistoryPlusPlus/inc/m_music.inc @@ -0,0 +1,419 @@ +{$IFNDEF M_MUSIC}
+{$DEFINE M_MUSIC}
+
+// defined in interfaces.inc
+//const MIID_WATRACK:MUUID='{FC6C81F4-837E-4430-9601-A0AA43177AE3}';
+
+type
+ pSongInfoA = ^tSongInfoA;
+ tSongInfoA = record
+ artist :PAnsiChar;
+ title :PAnsiChar;
+ album :PAnsiChar;
+ genre :PAnsiChar;
+ comment :PAnsiChar;
+ year :PAnsiChar;
+ mfile :PAnsiChar; // media file
+ kbps :dword;
+ khz :dword;
+ channels :dword;
+ track :dword;
+ total :dword; // music length
+ time :dword; // elapsed time
+ wndtext :PAnsiChar; // window title
+ player :PAnsiChar; // player name
+ plyver :dword; // player version
+ icon :THANDLE; // player icon
+ fsize :dword; // media file size
+ vbr :dword;
+ status :integer; // WAT_MES_* const
+ plwnd :HWND; // player window
+ // video part
+ codec :dword;
+ width :dword;
+ height :dword;
+ fps :dword;
+ date :int64;
+ txtver :PAnsiChar;
+ lyric :PAnsiChar;
+ cover :PAnsiChar;
+ volume :dword;
+ url :PAnsiChar; // player homepage
+ winampwnd:HWND;
+ end;
+type
+ pSongInfo=^tSongInfo;
+ tSongInfo = record
+ artist :pWideChar;
+ title :pWideChar;
+ album :pWideChar;
+ genre :pWideChar;
+ comment :pWideChar;
+ year :pWideChar;
+ mfile :pWideChar; // media file
+ kbps :dword;
+ khz :dword;
+ channels :dword;
+ track :dword;
+ total :dword; // music length
+ time :dword; // elapsed time
+ wndtext :pWideChar; // window title
+ player :pWideChar; // player name
+ plyver :dword; // player version
+ icon :THANDLE; // player icon
+ fsize :dword; // media file size
+ vbr :dword;
+ status :integer; // WAT_MES_* const
+ plwnd :HWND; // player window
+ // video part
+ codec :dword;
+ width :dword;
+ height :dword;
+ fps :dword;
+ date :int64;
+ txtver :pWideChar;
+ lyric :pWideChar;
+ cover :pWideChar; // cover path
+ volume :dword;
+ url :PWideChar; // player homepage
+ winampwnd:HWND;
+ end;
+ pSongInfoW = pSongInfo;
+ tSongInfoW = tSongInfo;
+
+const
+ // result codes
+ WAT_RES_UNKNOWN = -2;
+ WAT_RES_NOTFOUND = -1;
+ WAT_RES_ERROR = WAT_RES_NOTFOUND;
+ WAT_RES_OK = 0;
+ WAT_RES_ENABLED = WAT_RES_OK;
+ WAT_RES_DISABLED = 1;
+ // internal
+ WAT_RES_NEWFILE = 3;
+ WAT_RES_NEWPLAYER = 4;
+
+// result for MS_WAT_GETMUSICINFO service
+const
+ WAT_PLS_NORMAL = WAT_RES_OK;
+ WAT_PLS_NOMUSIC = WAT_RES_DISABLED;
+ WAT_PLS_NOTFOUND = WAT_RES_NOTFOUND;
+
+const
+ WAT_INF_UNICODE = 0;
+ WAT_INF_ANSI = 1;
+ WAT_INF_UTF8 = 2;
+ WAT_INF_CHANGES = $100;
+
+const
+ MS_WAT_INSERT:PAnsiChar = 'WATrack/Insert';
+ MS_WAT_EXPORT:PAnsiChar = 'WATrack/Export';
+
+const
+{
+ wParam : WAT_INF_* constant
+ lParam : pointer to pSongInfo (Unicode) or pSongInfoA (ANSI/UTF8)
+ Affects: Fill structure by currently played music info
+ returns: WAT_PLS_* constant
+ note: pointer will be point to global SongInfo structure of plugin
+ warning: Non-Unicode data filled only by request
+ if lParam=0 only internal SongInfo structure will be filled
+ Example:
+ var p:pSongInfo;
+ CallService(MS_WAT_GETMUSICINFO,0,dword(@p));
+}
+ MS_WAT_GETMUSICINFO:PAnsiChar = 'WATrack/GetMusicInfo';
+{
+ wParam:0
+ lParam : pointer to pSongInfo (Unicode)
+ Affects: Fill structure by info from file named in SongInfo.mfile
+ returns: 0, if success
+ note: fields, which values can't be obtained, leaves old values.
+ you must free given strings by miranda mir_free
+}
+ MS_WAT_GETFILEINFO:PAnsiChar = 'WATrack/GetFileInfo';
+
+{
+ wParam: encoding (WAT_INF_* consts, 0 = WAT_INF_UNICODE)
+ lParam: codepage (0 = ANSI)
+ Returns Global unicode SongInfo pointer or tranlated to Ansi/UTF8 structure
+}
+ MS_WAT_RETURNGLOBAL:PAnsiChar = 'WATrack/GetMainStructure';
+
+//!! DON'T CHANGE THESE VALUES!
+const
+ WAT_CTRL_FIRST = 1;
+
+ WAT_CTRL_PREV = 1;
+ WAT_CTRL_PLAY = 2;
+ WAT_CTRL_PAUSE = 3;
+ WAT_CTRL_STOP = 4;
+ WAT_CTRL_NEXT = 5;
+ WAT_CTRL_VOLDN = 6;
+ WAT_CTRL_VOLUP = 7;
+ WAT_CTRL_SEEK = 8; // lParam is new position (sec)
+
+ WAT_CTRL_LAST = 8;
+
+{
+ wParam: button code (WAT_CTRL_* const)
+ lParam: 0, or value (see WAT_CTRL_* const comments)
+ Affects: emulate player button pressing
+ returns: 0 if unsuccesful
+}
+ MS_WAT_PRESSBUTTON:PAnsiChar = 'WATrack/PressButton';
+
+{
+ Get user's Music Info
+}
+ MS_WAT_GETCONTACTINFO:PAnsiChar = 'WATrack/GetContactInfo';
+
+// ------------ Plugin/player status ------------
+
+{
+ wParam: 1 - switch off plugin
+ 0 - switch on plugin
+ -1 - switch plugin status
+ 2 - get plugin version
+ other - get plugin status
+ lParam: 0
+ Affects: Switch plugin status to enabled or disabled
+ returns: version, old plugin status, 0, if was enabled
+}
+ MS_WAT_PLUGINSTATUS:PAnsiChar = 'WATrack/PluginStatus';
+
+ ME_WAT_MODULELOADED:PAnsiChar = 'WATrack/ModuleLoaded';
+
+const
+ WAT_EVENT_PLAYERSTATUS = 1; // WAT_PLS_* in loword, WAT_MES_* in hiword
+ WAT_EVENT_NEWTRACK = 2; // SongInfo ptr
+ WAT_EVENT_PLUGINSTATUS = 3; // 0-enabled; 1-dis.temporary; 2-dis.permanent
+ WAT_EVENT_NEWPLAYER = 4; //
+ WAT_EVENT_NEWTEMPLATE = 5; // TM_* constant
+
+{
+ Plugin or player status changed:
+ wParam: type of event (see above)
+ lParam: value
+}
+ ME_WAT_NEWSTATUS:PAnsiChar = 'WATrack/NewStatus';
+
+// ---------- Popup module ------------
+
+{
+ wParam: not used
+ lParam: not used
+ Affects: Show popup or Info window with current music information
+ note: Only Info window will be showed if Popup plugin disabled
+}
+ MS_WAT_SHOWMUSICINFO:PAnsiChar = 'WATrack/ShowMusicInfo';
+
+// --------- Statistic (report) module -------------
+
+{
+ wParam: pointer to log file name or NIL
+ lParam: pointer to report file name or NIL
+ Affects: Create report from log and run it (if option is set)
+ returns: 0 if unsuccesful
+ note: if wParam or lParam is a NIL then file names from options are used
+}
+ MS_WAT_MAKEREPORT :PAnsiChar = 'WATrack/MakeReport';
+// MS_WAT_MAKEREPORTW:PAnsiChar = 'WATrack/MakeReportW';
+
+{
+ wParam, lParam - not used
+ Affects: pack statistic file
+}
+ MS_WAT_PACKLOG:PAnsiChar = 'WATrack/PackLog';
+
+{
+ wParam: not used
+ lParam: pointer to SongInfo
+}
+ MS_WAT_ADDTOLOG:PAnsiChar = 'WATrack/AddToLog';
+
+// ----------- Formats and players -----------
+
+// media file status
+
+const
+ WAT_MES_STOPPED = 0;
+ WAT_MES_PLAYING = 1;
+ WAT_MES_PAUSED = 2;
+ WAT_MES_UNKNOWN = -1;
+
+const
+ WAT_ACT_REGISTER = 1;
+ WAT_ACT_UNREGISTER = 2;
+ WAT_ACT_DISABLE = 3;
+ WAT_ACT_ENABLE = 4;
+ WAT_ACT_GETSTATUS = 5; // not found/enabled/disabled
+ WAT_ACT_SETACTIVE = 6;
+ WAT_ACT_REPLACE = $10000; // can be combined with WAT_REGISTERFORMAT
+
+const
+ // flags
+ WAT_OPT_DISABLED = $00000001; // [formats,players,options] registered but disabled
+ WAT_OPT_ONLYONE = $00000002; // [formats,players] code can't be overwriten
+ WAT_OPT_PLAYERINFO = $00000004; // [players] song info from player
+ WAT_OPT_WINAMPAPI = $00000008; // [players] Winamp API support
+ WAT_OPT_CHECKTIME = $00000010; // [options] check file time for changes
+ WAT_OPT_VIDEO = $00000020; // [formats,options] format is video
+ WAT_OPT_LAST = $00000040; // (internal-Winamp Clone) put to the end of queue
+ WAT_OPT_FIRST = $00000080; // (internal)
+ WAT_OPT_TEMPLATE = $00000100; // (internal)
+ WAT_OPT_IMPLANTANT = $00000200; // [options] use process implantation
+ WAT_OPT_HASURL = $00000400; // [players] URL field present
+ WAT_OPT_CHANGES = $00000800; // (internal) obtain only chaged values
+ // (volume, status, window text, elapsed time)
+ WAT_OPT_APPCOMMAND = $00001000; // [options] Special (multimedia) key support
+ WAT_OPT_CHECKALL = $00002000; // [options] Check all players
+ WAT_OPT_KEEPOLD = $00004000; // [options] Keep Old opened file
+ WAT_OPT_MULTITHREAD = $00008000; // [options] Use multithread scan
+ WAT_OPT_SINGLEINST = $00010000; // [players] Single player instance
+ WAT_OPT_PLAYERDATA = $00020000; // (internal) to obtain player data
+ WAT_OPT_CONTAINER = $00040000; // [formats] format is container (need to check full)
+
+type
+ tReadFormatProc = function(var Info:tSongInfo):boolean; cdecl;
+ pMusicFormat = ^tMusicFormat;
+ tMusicFormat = record
+ proc :tReadFormatProc;
+ ext :array [0..7] of AnsiChar;
+ flags:cardinal;
+ end;
+
+const
+{
+ wParam: action
+ lParam: pointer to tMusicFormat if wParam = WAT_ACT_REGISTER,
+ else - pointer to extension string (ANSI)
+ returns: see result codes
+}
+ MS_WAT_FORMAT:PAnsiChar = 'WATrack/Format';
+
+{
+ wParam: pointer to SongInfo structure (plwind field must be initialized)
+ lParam: flags
+ Affects: trying to fill SongInfo using Winamp API
+}
+ MS_WAT_WINAMPINFO:PAnsiChar = 'WATrack/WinampInfo';
+
+{
+ wParam: window
+ lParam: LoWord - command; HiWord - value
+}
+ MS_WAT_WINAMPCOMMAND:PAnsiChar = 'WATrack/WinampCommand';
+
+type
+ tInitProc = function():integer;cdecl;
+ tDeInitProc = function():integer;cdecl;
+ tStatusProc = function(wnd:HWND):integer;cdecl;
+ tNameProc = function(wnd:HWND;flags:integer):pWideChar;cdecl;
+ tCheckProc = function(wnd:HWND;flags:integer):HWND;cdecl;
+ tInfoProc = function(var SongInfo:tSongInfo;flags:integer):integer;cdecl;
+ tCommandProc = function(wnd:HWND;command:integer;value:integer):integer;cdecl;
+
+ pPlayerCell = ^tPlayerCell;
+ tPlayerCell = record
+ Desc :PAnsiChar; // Short player name
+ flags :cardinal;
+ Icon :HICON; // can be 0. for registration only
+ Init :pointer; // tInitProc; can be NIL. initialize any data
+ DeInit :pointer; // tDeInitProc; can be NIL. finalize player processing
+ Check :pointer; // tCheckProc; check player
+ GetStatus:pointer; // tStatusProc; can be NIL. get player status
+ GetName :pointer; // tNameProc; can be NIL. get media filename
+ GetInfo :pointer; // tInfoProc; can be NIL. get info from player
+ Command :pointer; // tCommandProc; can be NIL. send command to player
+ URL :PAnsiChar; // only if WAT_OPT_HASURL flag present
+ Notes :PWideChar; // any tips, notes etc for this player
+ end;
+
+const
+{
+ wParam: action
+ lParam: pointer to tPlayerCell if wParam = WAT_ACT_REGISTER,
+ else - pointer to player description string (ANSI)
+ returns: player window handle or value>0 if found
+ note: If you use GetName or GetInfo field, please, do not return empty
+ filename even when mediafile is remote!
+}
+ MS_WAT_PLAYER:PAnsiChar = 'WATrack/Player';
+
+// --------- MyShows.ru ---------
+
+{
+ Toggle MyShows scrobbling status
+ wParam,lParam=0
+ Returns: previous state
+}
+const
+ MS_WAT_MYSHOWS:pAnsiChar = 'WATrack/MyShows';
+
+
+const
+ MS_WAT_MYSHOWSINFO:pAnsiChar = 'WATrack/MyShowsInfo';
+
+// --------- Last FM ---------
+
+{
+ Toggle LastFM scrobbling status
+ wParam,lParam=0
+ Returns: previous state
+}
+const
+ MS_WAT_LASTFM:pAnsiChar = 'WATrack/LastFM';
+
+{
+ Get Info based on currently played song
+ wParam: pLastFMInfo
+ lParam: int language (first 2 bytes - 2-letters language code)
+}
+type
+ pLastFMInfo = ^tLastFMInfo;
+ tLastFMInfo = record
+ request:cardinal; // 0 - artist, 1 - album, 2 - track
+ artist :pWideChar; // artist
+ album :pWideChar; // album or similar artists for Artist info request
+ title :pWideChar; // track title
+ tags :pWideChar; // tags
+ info :pWideChar; // artist bio or wiki article
+ image :pAnsiChar; // photo/cover link
+ similar:pWideChar;
+ release:pWideChar;
+ trknum :cardinal;
+ end;
+const
+ MS_WAT_LASTFMINFO:pAnsiChar = 'WATrack/LastFMInfo';
+
+// --------- Templates ----------
+
+const
+{
+ wParam: 0 (standard Info) or pSongInfo
+ lParam: Unicode template
+ returns: New Unicode (replaced) string
+}
+ MS_WAT_REPLACETEXT:PAnsiChar = 'WATrack/ReplaceText';
+
+{
+ event types for History
+ Blob structure for EVENTTYPE_WAT_ANSWER:
+ Uniciode artist#0title#0album#0answer
+}
+const
+ EVENTTYPE_WAT_REQUEST = 9601;
+ EVENTTYPE_WAT_ANSWER = 9602;
+ EVENTTYPE_WAT_ERROR = 9603;
+ EVENTTYPE_WAT_MESSAGE = 9604;
+
+const
+{
+ wParam: 0 or parent window
+ lParam: 0
+ note: Shows Macro help window with edit aliases ability
+}
+ MS_WAT_MACROHELP:pAnsiChar = 'WATrack/MacroHelp';
+
+{$ENDIF M_MUSIC}
diff --git a/plugins/HistoryPlusPlus/inc/m_speak.inc b/plugins/HistoryPlusPlus/inc/m_speak.inc new file mode 100644 index 0000000000..5a90fa98b0 --- /dev/null +++ b/plugins/HistoryPlusPlus/inc/m_speak.inc @@ -0,0 +1,267 @@ +{
+Copyright (C) 2007 Ricardo Pescuma Domenecci
+
+This is free software; you can redistribute it and/or
+modify it under the terms of the GNU Library General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+This is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Library General Public License for more details.
+
+You should have received a copy of the GNU Library General Public
+License along with this file; see the file license.txt. If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.
+}
+
+{$IFNDEF M_SPEAK}
+{$DEFINE M_SPEAK}
+
+(*
+There is 2 ways of using the speak plugin:
+
+1. Older and simple way: just call
+ Speak_Say(hContact, _T("text to speak"))
+and the text will be spoken using contact settings. If hContact is NULL, it will use
+system settings.
+Previous versions only had an ascii version, so if you want to support then you need
+to call
+ Speak_SayA(hContact, "text to speak")
+
+
+2. Integrating with meSpeak GUI: for that you have first to register a speak type and
+then call the speak functions. In both case you have 2 options:
+
+2.1 Sending the full text: meSpeak GUI will only allow to enable/disable the type.
+To register call (in modules loaded):
+ Speak_Register("PluginName (DB key)", "name", "Prety name for GUI", "icon_xyz")
+And to speak call:
+ Speak_SayEx("name", hContact, _T("text to speak"))
+
+2.2 Using templates: you will not pass the text, but some variables. meSpeak handles
+the GUI to allow the user to create the text for those variables. These functions
+end with WT (with templates).
+To register call (in modules loaded):
+ AnsiChar *templates[] = { "Name\nDefault\n%var1%\tDescription 1\n%var2%\tDescription2\n%var3%\tDescription 3" };
+ Speak_RegisterWT("PluginName (DB key)", "name", "Prety name for GUI", "icon_xyz",
+ templates, 1);
+And to speak call:
+ TCHAR *variables[] = { _T("var1"), _T("Value 1"), _T("var2"), _T("Value 2"), _T("var3"), _T("Value 3") };
+ Speak_SayExWT("name", hContact, 0, variables, 3);
+*)
+
+const
+ MIID_SPEAK = '{1ef72725-6a83-483b-aa50-8953e359eead}';
+
+ {*
+ Speak a text
+
+ wParam: (HANDLE) hContact
+ lParam: (AnsiChar *) text
+ return: 0 on success
+ *}
+ MS_SPEAK_SAY_A = 'Speak/Say';
+
+ {*
+ Speak a unicode text
+
+ wParam: (HANDLE) hContact
+ lParam: (WCHAR *) text
+ return: 0 on success
+ *}
+ MS_SPEAK_SAY_W = 'Speak/SayW';
+
+type
+ PSPEAK_TYPE = ^TSPEAK_TYPE;
+ TSPEAK_TYPE = record
+ cbSize: integer;
+ module: PAnsiChar;
+ name: PAnsiChar; // Internal type name
+ description: PAnsiChar; // Will be translated
+ icon: PAnsiChar; // Name off icolib icon
+ // Aditional data if wants to use add to history services
+ templates: ^PAnsiChar; // Each entry is: "Name\nDefault\n%var%\tDescription\n%var%\tDescription\n%var%\tDescription"
+ numTemplates: integer;
+ end;
+
+const
+ {*
+ Register and speak type
+
+ wParam: (SPEAK_TYPE *) type
+ lParam: 0
+ return: 0 on success
+ *}
+ MS_SPEAK_REGISTER = 'Speak/Register';
+
+const
+ SPEAK_CHAR = 1;
+ SPEAK_WCHAR = 2;
+
+type
+ PSPEAK_ITEM = ^TSPEAK_ITEM;
+ TSPEAK_ITEM = record
+ cbSize: integer;
+ _type: PAnsiChar; // Internal type name
+ hContact: THandle;
+ flags: integer; // SPEAK_*
+ templateNum: integer; // -1 to use text
+ case boolean of
+ true: (text: PAnsiChar);
+ false: (
+ variables: Pointer;
+ numVariables: integer;
+ );
+ end;
+
+const
+ {*
+ Speak a text
+
+ wParam: (SPEAK_ITEM *) Item
+ lParam: 0
+ return: 0 on success
+ *}
+ MS_SPEAK_SAYEX = 'Speak/SayEx';
+
+
+{$IFDEF I_AM_A_CONSTANT_THAT_IS_NEVER_DEFINED_BUT_ALLOWS_THE_CODE_BELOW_NOT_TO_BE_COMMENTED}
+// Helper functions
+
+static int Speak_SayA(HANDLE hContact, const AnsiChar *text)
+{
+ return CallService(MS_SPEAK_SAY_A, (WPARAM) hContact, (LPARAM) text);
+}
+
+static int Speak_SayW(HANDLE hContact, const WCHAR *text)
+{
+ return CallService(MS_SPEAK_SAY_W, (WPARAM) hContact, (LPARAM) text);
+}
+
+static int Speak_Register(AnsiChar *module, AnsiChar *name, AnsiChar *description, AnsiChar *icon)
+{
+ SPEAK_TYPE type;
+
+ if (!ServiceExists(MS_SPEAK_REGISTER))
+ return -1;
+
+ type.cbSize = sizeof(type);
+ type.module = module;
+ type.name = name;
+ type.description = description;
+ type.icon = icon;
+ type.templates = NULL;
+ type.numTemplates = 0;
+
+ return CallService(MS_SPEAK_REGISTER, (WPARAM) &type, 0);
+}
+
+static int Speak_RegisterWT(const AnsiChar *module, const AnsiChar *name, const AnsiChar *description,
+ const AnsiChar *icon, AnsiChar **templates, int numTemplates)
+{
+ SPEAK_TYPE type;
+
+ if (!ServiceExists(MS_SPEAK_REGISTER))
+ return -1;
+
+ type.cbSize = sizeof(type);
+ type.module = module;
+ type.name = name;
+ type.description = description;
+ type.icon = icon;
+ type.templates = templates;
+ type.numTemplates = numTemplates;
+
+ return CallService(MS_SPEAK_REGISTER, (WPARAM) &type, 0);
+}
+
+static int Speak_SayExA(AnsiChar *type, HANDLE hContact, const AnsiChar *text)
+{
+ SPEAK_ITEM item;
+
+ if (!ServiceExists(MS_SPEAK_SAYEX))
+ // Try old service
+ return Speak_SayA(hContact, text);
+
+ item.cbSize = sizeof(item);
+ item.flags = SPEAK_CHAR;
+ item.type = type;
+ item.hContact = hContact;
+ item.templateNum = -1;
+ item.text = text;
+
+ return CallService(MS_SPEAK_SAYEX, (WPARAM) &item, 0);
+}
+
+static int Speak_SayExW(AnsiChar *type, HANDLE hContact, const WCHAR *text)
+{
+ SPEAK_ITEM item;
+
+ if (!ServiceExists(MS_SPEAK_SAYEX))
+ // Try old service
+ return Speak_SayW(hContact, text);
+
+ item.cbSize = sizeof(item);
+ item.flags = SPEAK_WCHAR;
+ item.type = type;
+ item.hContact = hContact;
+ item.templateNum = -1;
+ item.text = text;
+
+ return CallService(MS_SPEAK_SAYEX, (WPARAM) &item, 0);
+}
+
+static int Speak_SayExWTA(AnsiChar *type, HANDLE hContact, int templateNum, AnsiChar **variables, int numVariables)
+{
+ SPEAK_ITEM item;
+
+ if (!ServiceExists(MS_SPEAK_SAYEX))
+ return -1;
+
+ item.cbSize = sizeof(item);
+ item.flags = SPEAK_CHAR;
+ item.type = type;
+ item.hContact = hContact;
+ item.templateNum = templateNum;
+ item.variables = variables;
+ item.numVariables = numVariables;
+
+ return CallService(MS_SPEAK_SAYEX, (WPARAM) &item, 0);
+}
+
+static int Speak_SayExWTW(AnsiChar *type, HANDLE hContact, int templateNum, WCHAR **variables, int numVariables)
+{
+ SPEAK_ITEM item;
+
+ if (!ServiceExists(MS_SPEAK_SAYEX))
+ return -1;
+
+ item.cbSize = sizeof(item);
+ item.flags = SPEAK_WCHAR;
+ item.type = type;
+ item.hContact = hContact;
+ item.templateNum = templateNum;
+ item.variables = variables;
+ item.numVariables = numVariables;
+
+ return CallService(MS_SPEAK_SAYEX, (WPARAM) &item, 0);
+}
+
+
+#ifdef UNICODE
+# define MS_SPEAK_SAY MS_SPEAK_SAY_W
+# define Speak_Say Speak_SayW
+# define Speak_SayEx Speak_SayExW
+# define Speak_SayExWT Speak_SayExWTW
+#else
+# define MS_SPEAK_SAY MS_SPEAK_SAY_A
+# define Speak_Say Speak_SayA
+# define Speak_SayEx Speak_SayExA
+# define Speak_SayExWT Speak_SayExWTA
+#endif
+
+{$ENDIF}
+{$ENDIF}
diff --git a/plugins/HistoryPlusPlus/m_historypp.inc b/plugins/HistoryPlusPlus/m_historypp.inc new file mode 100644 index 0000000000..cca7630295 --- /dev/null +++ b/plugins/HistoryPlusPlus/m_historypp.inc @@ -0,0 +1,191 @@ +(*
+ History++ plugin for Miranda IM: the free IM client for Microsoft* Windows*
+
+ Copyright (C) 2006-2009 theMIROn, 2003-2006 Art Fedorov.
+ History+ parts (C) 2001 Christian Kastner
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+*)
+
+{-----------------------------------------------------------------------------
+ m_historypp (historypp project)
+
+ Version: 1.5
+ Created: 06.08.2004
+ Author: Oxygen
+
+ [ Description ]
+
+ Header with History++ services declaration
+
+ [ History ]
+
+ 1.5 (05.08.2004)
+ First version
+
+ [ Modifications ]
+ none
+
+ [ Known Issues ]
+ none
+
+ Contributors: theMIROn, Art Fedorov
+-----------------------------------------------------------------------------}
+
+{$IFNDEF M_HISTORYPP}
+{$DEFINE M_HISTORYPP}
+
+const
+
+ //** VALUES FOR TItemRenderDetails.dwHistoryWindow
+ //** Used in ME_HPP_RICHEDIT_ITEMPROCESS event
+ //** This is one of the following params,
+ //** saying what kind of history window displays
+ //** processed item.
+
+ // IRDHW_CONTACTHISTORY. The window is ordinary
+ // contact history.
+ IRDHW_CONTACTHISTORY = $0001;
+ // IRDHW_GLOBALHISTORY. The window is global
+ // history (system history). Invokes by
+ // Menu -> System History
+ IRDHW_GLOBALHISTORY = $0002;
+ // IRDHW_GLOBALSEARCH. The window is search
+ // window and the processed item is the
+ // result of the global search.
+ IRDHW_GLOBALSEARCH = $0003;
+ // IRDHW_EXTERNAL. The window is external window
+ IRDHW_EXTERNALGRID = $0004;
+
+ //** VALUES FOR TItemRenderDetails.dwFlags
+ //** Used in ME_HPP_RICHEDIT_ITEMPROCESS event
+ //** These flags inform you about what you are
+ //** processing. Like saying that the item is
+ //** selected or it's inline or such stuff
+
+ // IRDF_SELECTED. The processed item is selected.
+ // The background color will always be clHighlight
+ // even if you change it (i will change it back).
+ // Though, I will not touch font or font color.
+ IRDF_SELECTED = $0001;
+ // IRDF_INLINE. The RichEdit provided is not one
+ // that is used for drawing a cell, but the one
+ // used for "inline editing".
+ IRDF_INLINE = $0002;
+ // IRDF_EVENT. The RichEdit provided is from "Open Event"
+ // window. It's the window which opens when you right-click
+ // item in contact's history and select "Open"
+ IRDF_EVENT = $0004;
+
+type
+ TItemRenderDetails = record
+ cbSize: DWord; // size of the structure in bytes
+ hContact: THandle; // handle to the contact for which the event is processed
+ hDBEvent: THandle; // handle to the event which is processed
+ dwEventTime: DWord; // timestamp of the event
+ wEventType: Word; // Event's flags (see m_database, EVENTTYPE_*; m_icq, ICQEVENTTYPE_*)
+ IsEventSent: ByteBool; // Outgoing event. True if DBEF_SENT event flag is present (see m_database)
+ dwFlags: DWord; // Any reasonable combination of IRDF_* flags.
+ bHistoryWindow: Byte; // What kind of window history. See IRDHW_* values
+ pProto: PAnsiChar; // Proto of the event, if available
+ pModule: PAnsiChar; // Module of the event, if available
+ pText: PWideChar; // Text of the event, not used now
+ pExtended: PAnsiChar; // Extended text, used for storing urls, paths and so on
+ end;
+
+ PItemRenderDetails = ^TItemRenderDetails;
+
+const
+ // ME_HPP_RICHEDIT_ITEMPROCESS
+ // (supported from 1.5.0)
+ // Called when next RichEdit history item
+ // is rendered. Third-party plugins can alter it
+ // like adding smileys, changing color and so on.
+ // wParam - RichEdit control handle
+ // lParam - pointer to TItemRenderDetails structure, information
+ // about processed item, see TItemRenderDetails for details
+ //
+ // Note: Changing richedit background color will change the background
+ // color of the whole cell! Additionally, the background color
+ // of the *selected* cell and richedit is ALWAYS clHighlight,
+ // no matter what you do. But font is untouched, so if your
+ // plugin changes font color, you may need to handle selected
+ // cells differently (use IF_SELECTED flag).
+ //
+ // Warn: Remeber about changing fonts. You CAN NOT have *different* fonts
+ // for the *same* item, depening on your wish. For example, the
+ // first time event is fired you set font for Item1 'Arial 10',
+ // and the next time you set font for the same Item1 'Arial 12'.
+ // Because height is calculated only once, and you may have
+ // problems with text painting (when you change font text can
+ // become too large and be cut or override another cell)
+ //
+ // See: hpp_itemprocess_samples.pas for some sample event handlers
+ // like SmileyAdd and TextFormat support and special handler
+ // kinda of conversation separation
+ ME_HPP_RICHEDIT_ITEMPROCESS = 'History++/RichEdit/ItemProcessEvent';
+
+ // MS_HPP_SHOWGLOBALSEARCH
+ // (supported from 1.5.0)
+ // Show Global history search window
+ // If already opened, bring it to front
+ // wParam - zero
+ // lParam - zero
+ MS_HPP_SHOWGLOBALSEARCH = 'History++/ShowGlobalSearch';
+
+ type
+ POpenEventParams = ^TOpenEventParams;
+ TOpenEventParams = record
+ cbSize: DWord;
+ hContact: THandle;
+ hDBEvent: THandle;
+ pPassword: PAnsiChar;
+ end;
+
+const
+
+ // MS_HPP_OPENHISTORYEVENT
+ // (supported from 1.5.0)
+ // (changed in 1.5.110)
+ //
+ // Opens contact's history and selects
+ // provided event
+ // wParam - pointer to TOpenEventParams structure
+ // lParam - zero
+ // Return - BOOL, True if contact opened, False if password
+ // field opened
+ // Note: if you just want to show contact's history,
+ // use system service MS_HISTORY_SHOWCONTACTHISTORY
+ MS_HPP_OPENHISTORYEVENT = 'History++/OpenHistoryEvent2';
+
+ // MS_HPP_GETVERSION
+ // (supported from 1.5.0)
+ // Get current History++ version
+ // Third-party plugins can use it to know if installed
+ // version of History++ supports particular feature
+ // wParam - zero
+ // lParam - zero
+ // Return - current version, via PLUGIN_MAKE_VERSION macro
+ MS_HPP_GETVERSION = 'History++/GetVersion';
+
+ // MS_HPP_EMPTYHISTORY
+ // (supported from 1.5.0.118)
+ // Erases contact's history
+ // wParam - hContact
+ // lParam - zero
+ // Notes - hContact can be NULL(0) to empty system history
+ MS_HPP_EMPTYHISTORY = 'History++/EmptyHistory';
+
+{$ENDIF}
diff --git a/plugins/HistoryPlusPlus/note.txt b/plugins/HistoryPlusPlus/note.txt new file mode 100644 index 0000000000..64cd00de1c --- /dev/null +++ b/plugins/HistoryPlusPlus/note.txt @@ -0,0 +1 @@ +Broken history export (in HTML mode at least) - text exports in wrong (comparing with header) encoding
\ No newline at end of file diff --git a/plugins/HistoryPlusPlus/res/close_box.bmp b/plugins/HistoryPlusPlus/res/close_box.bmp Binary files differnew file mode 100644 index 0000000000..55ce8d3a3d --- /dev/null +++ b/plugins/HistoryPlusPlus/res/close_box.bmp diff --git a/plugins/HistoryPlusPlus/res/cr_hand.cur b/plugins/HistoryPlusPlus/res/cr_hand.cur Binary files differnew file mode 100644 index 0000000000..59475887a2 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/cr_hand.cur diff --git a/plugins/HistoryPlusPlus/res/event_avatar.ico b/plugins/HistoryPlusPlus/res/event_avatar.ico Binary files differnew file mode 100644 index 0000000000..e821b9cafe --- /dev/null +++ b/plugins/HistoryPlusPlus/res/event_avatar.ico diff --git a/plugins/HistoryPlusPlus/res/event_contacts.ico b/plugins/HistoryPlusPlus/res/event_contacts.ico Binary files differnew file mode 100644 index 0000000000..8bc58da983 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/event_contacts.ico diff --git a/plugins/HistoryPlusPlus/res/event_eexpress.ico b/plugins/HistoryPlusPlus/res/event_eexpress.ico Binary files differnew file mode 100644 index 0000000000..4d251e546f --- /dev/null +++ b/plugins/HistoryPlusPlus/res/event_eexpress.ico diff --git a/plugins/HistoryPlusPlus/res/event_incoming.ico b/plugins/HistoryPlusPlus/res/event_incoming.ico Binary files differnew file mode 100644 index 0000000000..b21c7254ba --- /dev/null +++ b/plugins/HistoryPlusPlus/res/event_incoming.ico diff --git a/plugins/HistoryPlusPlus/res/event_nick.ico b/plugins/HistoryPlusPlus/res/event_nick.ico Binary files differnew file mode 100644 index 0000000000..06089cf9b4 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/event_nick.ico diff --git a/plugins/HistoryPlusPlus/res/event_outgoing.ico b/plugins/HistoryPlusPlus/res/event_outgoing.ico Binary files differnew file mode 100644 index 0000000000..138d61e34b --- /dev/null +++ b/plugins/HistoryPlusPlus/res/event_outgoing.ico diff --git a/plugins/HistoryPlusPlus/res/event_sms.ico b/plugins/HistoryPlusPlus/res/event_sms.ico Binary files differnew file mode 100644 index 0000000000..a76eefcb64 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/event_sms.ico diff --git a/plugins/HistoryPlusPlus/res/event_smtpsimple.ico b/plugins/HistoryPlusPlus/res/event_smtpsimple.ico Binary files differnew file mode 100644 index 0000000000..0ac1a1c237 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/event_smtpsimple.ico diff --git a/plugins/HistoryPlusPlus/res/event_status.ico b/plugins/HistoryPlusPlus/res/event_status.ico Binary files differnew file mode 100644 index 0000000000..82dc6588f0 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/event_status.ico diff --git a/plugins/HistoryPlusPlus/res/event_statusmes.ico b/plugins/HistoryPlusPlus/res/event_statusmes.ico Binary files differnew file mode 100644 index 0000000000..9058507d96 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/event_statusmes.ico diff --git a/plugins/HistoryPlusPlus/res/event_system.ico b/plugins/HistoryPlusPlus/res/event_system.ico Binary files differnew file mode 100644 index 0000000000..7fa13607cc --- /dev/null +++ b/plugins/HistoryPlusPlus/res/event_system.ico diff --git a/plugins/HistoryPlusPlus/res/event_voicecall.ico b/plugins/HistoryPlusPlus/res/event_voicecall.ico Binary files differnew file mode 100644 index 0000000000..9e100fee32 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/event_voicecall.ico diff --git a/plugins/HistoryPlusPlus/res/event_watrack.ico b/plugins/HistoryPlusPlus/res/event_watrack.ico Binary files differnew file mode 100644 index 0000000000..2665d2ded3 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/event_watrack.ico diff --git a/plugins/HistoryPlusPlus/res/event_webpager.ico b/plugins/HistoryPlusPlus/res/event_webpager.ico Binary files differnew file mode 100644 index 0000000000..5f5c5fb7df --- /dev/null +++ b/plugins/HistoryPlusPlus/res/event_webpager.ico diff --git a/plugins/HistoryPlusPlus/res/gsearch_advanced.ico b/plugins/HistoryPlusPlus/res/gsearch_advanced.ico Binary files differnew file mode 100644 index 0000000000..5e768973f5 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/gsearch_advanced.ico diff --git a/plugins/HistoryPlusPlus/res/gsearch_limitrange.ico b/plugins/HistoryPlusPlus/res/gsearch_limitrange.ico Binary files differnew file mode 100644 index 0000000000..0febf183b7 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/gsearch_limitrange.ico diff --git a/plugins/HistoryPlusPlus/res/gsearch_searchprotected.ico b/plugins/HistoryPlusPlus/res/gsearch_searchprotected.ico Binary files differnew file mode 100644 index 0000000000..f799b02968 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/gsearch_searchprotected.ico diff --git a/plugins/HistoryPlusPlus/res/historypp_bookmark.ico b/plugins/HistoryPlusPlus/res/historypp_bookmark.ico Binary files differnew file mode 100644 index 0000000000..07bb34089c --- /dev/null +++ b/plugins/HistoryPlusPlus/res/historypp_bookmark.ico diff --git a/plugins/HistoryPlusPlus/res/historypp_bookmark_off.ico b/plugins/HistoryPlusPlus/res/historypp_bookmark_off.ico Binary files differnew file mode 100644 index 0000000000..a6946d5c90 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/historypp_bookmark_off.ico diff --git a/plugins/HistoryPlusPlus/res/historypp_bookmark_on.ico b/plugins/HistoryPlusPlus/res/historypp_bookmark_on.ico Binary files differnew file mode 100644 index 0000000000..115d3375b8 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/historypp_bookmark_on.ico diff --git a/plugins/HistoryPlusPlus/res/historypp_contact.ico b/plugins/HistoryPlusPlus/res/historypp_contact.ico Binary files differnew file mode 100644 index 0000000000..6d53ac6847 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/historypp_contact.ico diff --git a/plugins/HistoryPlusPlus/res/historypp_contactdetails.ico b/plugins/HistoryPlusPlus/res/historypp_contactdetails.ico Binary files differnew file mode 100644 index 0000000000..c9fb1249c6 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/historypp_contactdetails.ico diff --git a/plugins/HistoryPlusPlus/res/historypp_contactmenu.ico b/plugins/HistoryPlusPlus/res/historypp_contactmenu.ico Binary files differnew file mode 100644 index 0000000000..6b191fecf1 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/historypp_contactmenu.ico diff --git a/plugins/HistoryPlusPlus/res/historypp_hotfilter.ico b/plugins/HistoryPlusPlus/res/historypp_hotfilter.ico Binary files differnew file mode 100644 index 0000000000..fc20197c6f --- /dev/null +++ b/plugins/HistoryPlusPlus/res/historypp_hotfilter.ico diff --git a/plugins/HistoryPlusPlus/res/historypp_hotfilterclear.ico b/plugins/HistoryPlusPlus/res/historypp_hotfilterclear.ico Binary files differnew file mode 100644 index 0000000000..8e825c0c37 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/historypp_hotfilterclear.ico diff --git a/plugins/HistoryPlusPlus/res/historypp_hotfilterwait.ico b/plugins/HistoryPlusPlus/res/historypp_hotfilterwait.ico Binary files differnew file mode 100644 index 0000000000..b5818c9712 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/historypp_hotfilterwait.ico diff --git a/plugins/HistoryPlusPlus/res/historypp_hotsearch.ico b/plugins/HistoryPlusPlus/res/historypp_hotsearch.ico Binary files differnew file mode 100644 index 0000000000..a5b6b91b63 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/historypp_hotsearch.ico diff --git a/plugins/HistoryPlusPlus/res/historypp_search.ico b/plugins/HistoryPlusPlus/res/historypp_search.ico Binary files differnew file mode 100644 index 0000000000..b6e87fd671 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/historypp_search.ico diff --git a/plugins/HistoryPlusPlus/res/historypp_search_allresults.ico b/plugins/HistoryPlusPlus/res/historypp_search_allresults.ico Binary files differnew file mode 100644 index 0000000000..7d0a1073f8 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/historypp_search_allresults.ico diff --git a/plugins/HistoryPlusPlus/res/historypp_searchdown.ico b/plugins/HistoryPlusPlus/res/historypp_searchdown.ico Binary files differnew file mode 100644 index 0000000000..adffa30602 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/historypp_searchdown.ico diff --git a/plugins/HistoryPlusPlus/res/historypp_searchup.ico b/plugins/HistoryPlusPlus/res/historypp_searchup.ico Binary files differnew file mode 100644 index 0000000000..c50ef37968 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/historypp_searchup.ico diff --git a/plugins/HistoryPlusPlus/res/historypp_session_div.ico b/plugins/HistoryPlusPlus/res/historypp_session_div.ico Binary files differnew file mode 100644 index 0000000000..4790995cbb --- /dev/null +++ b/plugins/HistoryPlusPlus/res/historypp_session_div.ico diff --git a/plugins/HistoryPlusPlus/res/historypp_session_hide.ico b/plugins/HistoryPlusPlus/res/historypp_session_hide.ico Binary files differnew file mode 100644 index 0000000000..6a05b7fb1b --- /dev/null +++ b/plugins/HistoryPlusPlus/res/historypp_session_hide.ico diff --git a/plugins/HistoryPlusPlus/res/options_checked.ico b/plugins/HistoryPlusPlus/res/options_checked.ico Binary files differnew file mode 100644 index 0000000000..d2a8206958 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/options_checked.ico diff --git a/plugins/HistoryPlusPlus/res/password_protect.ico b/plugins/HistoryPlusPlus/res/password_protect.ico Binary files differnew file mode 100644 index 0000000000..16ebbc30d0 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/password_protect.ico diff --git a/plugins/HistoryPlusPlus/res/search_endofpage.ico b/plugins/HistoryPlusPlus/res/search_endofpage.ico Binary files differnew file mode 100644 index 0000000000..7008a65a81 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/search_endofpage.ico diff --git a/plugins/HistoryPlusPlus/res/search_notfound.ico b/plugins/HistoryPlusPlus/res/search_notfound.ico Binary files differnew file mode 100644 index 0000000000..bc00294dc2 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/search_notfound.ico diff --git a/plugins/HistoryPlusPlus/res/sess_autumn.ico b/plugins/HistoryPlusPlus/res/sess_autumn.ico Binary files differnew file mode 100644 index 0000000000..82434063fb --- /dev/null +++ b/plugins/HistoryPlusPlus/res/sess_autumn.ico diff --git a/plugins/HistoryPlusPlus/res/sess_session.ico b/plugins/HistoryPlusPlus/res/sess_session.ico Binary files differnew file mode 100644 index 0000000000..d817ff2cc1 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/sess_session.ico diff --git a/plugins/HistoryPlusPlus/res/sess_spring.ico b/plugins/HistoryPlusPlus/res/sess_spring.ico Binary files differnew file mode 100644 index 0000000000..a47bebc2d4 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/sess_spring.ico diff --git a/plugins/HistoryPlusPlus/res/sess_summer.ico b/plugins/HistoryPlusPlus/res/sess_summer.ico Binary files differnew file mode 100644 index 0000000000..921fe812ad --- /dev/null +++ b/plugins/HistoryPlusPlus/res/sess_summer.ico diff --git a/plugins/HistoryPlusPlus/res/sess_winter.ico b/plugins/HistoryPlusPlus/res/sess_winter.ico Binary files differnew file mode 100644 index 0000000000..032e4782d1 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/sess_winter.ico diff --git a/plugins/HistoryPlusPlus/res/sess_year.ico b/plugins/HistoryPlusPlus/res/sess_year.ico Binary files differnew file mode 100644 index 0000000000..51fa030d75 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/sess_year.ico diff --git a/plugins/HistoryPlusPlus/res/toolbar_copy.ico b/plugins/HistoryPlusPlus/res/toolbar_copy.ico Binary files differnew file mode 100644 index 0000000000..c09ffca306 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/toolbar_copy.ico diff --git a/plugins/HistoryPlusPlus/res/toolbar_delete.ico b/plugins/HistoryPlusPlus/res/toolbar_delete.ico Binary files differnew file mode 100644 index 0000000000..b4bc60be2d --- /dev/null +++ b/plugins/HistoryPlusPlus/res/toolbar_delete.ico diff --git a/plugins/HistoryPlusPlus/res/toolbar_deleteall.ico b/plugins/HistoryPlusPlus/res/toolbar_deleteall.ico Binary files differnew file mode 100644 index 0000000000..f7504347d3 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/toolbar_deleteall.ico diff --git a/plugins/HistoryPlusPlus/res/toolbar_eventsfilter.ico b/plugins/HistoryPlusPlus/res/toolbar_eventsfilter.ico Binary files differnew file mode 100644 index 0000000000..0303be0478 --- /dev/null +++ b/plugins/HistoryPlusPlus/res/toolbar_eventsfilter.ico diff --git a/plugins/HistoryPlusPlus/res/toolbar_save.ico b/plugins/HistoryPlusPlus/res/toolbar_save.ico Binary files differnew file mode 100644 index 0000000000..bf2fe9859a --- /dev/null +++ b/plugins/HistoryPlusPlus/res/toolbar_save.ico diff --git a/plugins/HistoryPlusPlus/res/toolbar_saveall.ico b/plugins/HistoryPlusPlus/res/toolbar_saveall.ico Binary files differnew file mode 100644 index 0000000000..98ec945a5d --- /dev/null +++ b/plugins/HistoryPlusPlus/res/toolbar_saveall.ico diff --git a/plugins/HistoryPlusPlus/res/toolbar_sessions.ico b/plugins/HistoryPlusPlus/res/toolbar_sessions.ico Binary files differnew file mode 100644 index 0000000000..1ee298ae5b --- /dev/null +++ b/plugins/HistoryPlusPlus/res/toolbar_sessions.ico |
