From a5a3db4393d85407ff4c5668d88860e06158abd0 Mon Sep 17 00:00:00 2001 From: Alexey Kulakov Date: Wed, 4 Jul 2012 13:17:29 +0000 Subject: History++ sources upload (all files, no project) git-svn-id: http://svn.miranda-ng.org/main/trunk@756 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c --- plugins/HistoryPlusPlus/Base64.pas | 140 + plugins/HistoryPlusPlus/Checksum.inc | 7 + plugins/HistoryPlusPlus/Checksum.pas | 363 ++ plugins/HistoryPlusPlus/CustomizeFiltersForm.dfm | 226 + plugins/HistoryPlusPlus/CustomizeFiltersForm.pas | 717 +++ plugins/HistoryPlusPlus/CustomizeToolbar.dfm | 155 + plugins/HistoryPlusPlus/CustomizeToolbar.pas | 603 ++ plugins/HistoryPlusPlus/EmptyHistoryForm.dfm | 106 + plugins/HistoryPlusPlus/EmptyHistoryForm.pas | 318 + plugins/HistoryPlusPlus/EventDetailForm.dfm | 307 + plugins/HistoryPlusPlus/EventDetailForm.pas | 692 ++ plugins/HistoryPlusPlus/GlobalSearch.dfm | 915 +++ plugins/HistoryPlusPlus/GlobalSearch.pas | 2668 ++++++++ plugins/HistoryPlusPlus/HistoryControls.pas | 477 ++ plugins/HistoryPlusPlus/HistoryControls_Design.pas | 59 + plugins/HistoryPlusPlus/HistoryForm.dfm | 1011 +++ plugins/HistoryPlusPlus/HistoryForm.pas | 4120 ++++++++++++ plugins/HistoryPlusPlus/HistoryGrid.pas | 6780 ++++++++++++++++++++ plugins/HistoryPlusPlus/PassCheckForm.dfm | 100 + plugins/HistoryPlusPlus/PassCheckForm.pas | 149 + plugins/HistoryPlusPlus/PassForm.dfm | 136 + plugins/HistoryPlusPlus/PassForm.pas | 353 + plugins/HistoryPlusPlus/PassNewForm.dfm | 120 + plugins/HistoryPlusPlus/PassNewForm.pas | 98 + plugins/HistoryPlusPlus/VertSB.pas | 601 ++ plugins/HistoryPlusPlus/alpha.inc | 1 + plugins/HistoryPlusPlus/compilers.inc | 361 ++ plugins/HistoryPlusPlus/historypp.dpr | 627 ++ plugins/HistoryPlusPlus/historypp_Icon.ico | Bin 0 -> 766 bytes plugins/HistoryPlusPlus/historypp_icons.dpr | 28 + plugins/HistoryPlusPlus/historypp_icons.rc | 48 + plugins/HistoryPlusPlus/hpp_JclSysUtils.pas | 398 ++ plugins/HistoryPlusPlus/hpp_arrays.pas | 158 + plugins/HistoryPlusPlus/hpp_bookmarks.pas | 692 ++ plugins/HistoryPlusPlus/hpp_contacts.pas | 269 + plugins/HistoryPlusPlus/hpp_database.pas | 432 ++ plugins/HistoryPlusPlus/hpp_eventfilters.pas | 360 ++ plugins/HistoryPlusPlus/hpp_events.pas | 1049 +++ plugins/HistoryPlusPlus/hpp_external.pas | 379 ++ plugins/HistoryPlusPlus/hpp_externalgrid.pas | 1399 ++++ plugins/HistoryPlusPlus/hpp_forms.pas | 355 + plugins/HistoryPlusPlus/hpp_global.pas | 846 +++ plugins/HistoryPlusPlus/hpp_itemprocess.pas | 558 ++ plugins/HistoryPlusPlus/hpp_mescatcher.pas | 214 + plugins/HistoryPlusPlus/hpp_messages.pas | 77 + plugins/HistoryPlusPlus/hpp_olesmileys.pas | 133 + plugins/HistoryPlusPlus/hpp_opt_dialog.pas | 277 + plugins/HistoryPlusPlus/hpp_opt_dialog.rc | 37 + plugins/HistoryPlusPlus/hpp_options.pas | 658 ++ plugins/HistoryPlusPlus/hpp_puny.pas | 339 + plugins/HistoryPlusPlus/hpp_res_ver.rc | 28 + plugins/HistoryPlusPlus/hpp_resource.rc | 2 + plugins/HistoryPlusPlus/hpp_richedit.pas | 2071 ++++++ plugins/HistoryPlusPlus/hpp_searchthread.pas | 560 ++ plugins/HistoryPlusPlus/hpp_services.pas | 265 + plugins/HistoryPlusPlus/hpp_sessionsthread.pas | 272 + plugins/HistoryPlusPlus/hpp_strparser.pas | 176 + plugins/HistoryPlusPlus/inc/m_icqext.inc | 19 + plugins/HistoryPlusPlus/inc/m_ieview.inc | 217 + plugins/HistoryPlusPlus/inc/m_jabber.inc | 32 + plugins/HistoryPlusPlus/inc/m_mathmodule.inc | 199 + plugins/HistoryPlusPlus/inc/m_music.inc | 419 ++ plugins/HistoryPlusPlus/inc/m_speak.inc | 267 + plugins/HistoryPlusPlus/m_historypp.inc | 191 + plugins/HistoryPlusPlus/note.txt | 1 + plugins/HistoryPlusPlus/res/close_box.bmp | Bin 0 -> 190 bytes plugins/HistoryPlusPlus/res/cr_hand.cur | Bin 0 -> 326 bytes plugins/HistoryPlusPlus/res/event_avatar.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/event_contacts.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/event_eexpress.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/event_incoming.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/event_nick.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/event_outgoing.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/event_sms.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/event_smtpsimple.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/event_status.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/event_statusmes.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/event_system.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/event_voicecall.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/event_watrack.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/event_webpager.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/gsearch_advanced.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/gsearch_limitrange.ico | Bin 0 -> 2550 bytes .../res/gsearch_searchprotected.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/historypp_bookmark.ico | Bin 0 -> 2550 bytes .../HistoryPlusPlus/res/historypp_bookmark_off.ico | Bin 0 -> 1462 bytes .../HistoryPlusPlus/res/historypp_bookmark_on.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/historypp_contact.ico | Bin 0 -> 2550 bytes .../res/historypp_contactdetails.ico | Bin 0 -> 2550 bytes .../HistoryPlusPlus/res/historypp_contactmenu.ico | Bin 0 -> 2550 bytes .../HistoryPlusPlus/res/historypp_hotfilter.ico | Bin 0 -> 2550 bytes .../res/historypp_hotfilterclear.ico | Bin 0 -> 2550 bytes .../res/historypp_hotfilterwait.ico | Bin 0 -> 2550 bytes .../HistoryPlusPlus/res/historypp_hotsearch.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/historypp_search.ico | Bin 0 -> 2550 bytes .../res/historypp_search_allresults.ico | Bin 0 -> 2550 bytes .../HistoryPlusPlus/res/historypp_searchdown.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/historypp_searchup.ico | Bin 0 -> 2550 bytes .../HistoryPlusPlus/res/historypp_session_div.ico | Bin 0 -> 2550 bytes .../HistoryPlusPlus/res/historypp_session_hide.ico | Bin 0 -> 1462 bytes plugins/HistoryPlusPlus/res/options_checked.ico | Bin 0 -> 5046 bytes plugins/HistoryPlusPlus/res/password_protect.ico | Bin 0 -> 6518 bytes plugins/HistoryPlusPlus/res/search_endofpage.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/search_notfound.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/sess_autumn.ico | Bin 0 -> 1150 bytes plugins/HistoryPlusPlus/res/sess_session.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/sess_spring.ico | Bin 0 -> 1150 bytes plugins/HistoryPlusPlus/res/sess_summer.ico | Bin 0 -> 1150 bytes plugins/HistoryPlusPlus/res/sess_winter.ico | Bin 0 -> 1150 bytes plugins/HistoryPlusPlus/res/sess_year.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/toolbar_copy.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/toolbar_delete.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/toolbar_deleteall.ico | Bin 0 -> 2550 bytes .../HistoryPlusPlus/res/toolbar_eventsfilter.ico | Bin 0 -> 1462 bytes plugins/HistoryPlusPlus/res/toolbar_save.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/toolbar_saveall.ico | Bin 0 -> 2550 bytes plugins/HistoryPlusPlus/res/toolbar_sessions.ico | Bin 0 -> 2550 bytes 117 files changed, 35635 insertions(+) create mode 100644 plugins/HistoryPlusPlus/Base64.pas create mode 100644 plugins/HistoryPlusPlus/Checksum.inc create mode 100644 plugins/HistoryPlusPlus/Checksum.pas create mode 100644 plugins/HistoryPlusPlus/CustomizeFiltersForm.dfm create mode 100644 plugins/HistoryPlusPlus/CustomizeFiltersForm.pas create mode 100644 plugins/HistoryPlusPlus/CustomizeToolbar.dfm create mode 100644 plugins/HistoryPlusPlus/CustomizeToolbar.pas create mode 100644 plugins/HistoryPlusPlus/EmptyHistoryForm.dfm create mode 100644 plugins/HistoryPlusPlus/EmptyHistoryForm.pas create mode 100644 plugins/HistoryPlusPlus/EventDetailForm.dfm create mode 100644 plugins/HistoryPlusPlus/EventDetailForm.pas create mode 100644 plugins/HistoryPlusPlus/GlobalSearch.dfm create mode 100644 plugins/HistoryPlusPlus/GlobalSearch.pas create mode 100644 plugins/HistoryPlusPlus/HistoryControls.pas create mode 100644 plugins/HistoryPlusPlus/HistoryControls_Design.pas create mode 100644 plugins/HistoryPlusPlus/HistoryForm.dfm create mode 100644 plugins/HistoryPlusPlus/HistoryForm.pas create mode 100644 plugins/HistoryPlusPlus/HistoryGrid.pas create mode 100644 plugins/HistoryPlusPlus/PassCheckForm.dfm create mode 100644 plugins/HistoryPlusPlus/PassCheckForm.pas create mode 100644 plugins/HistoryPlusPlus/PassForm.dfm create mode 100644 plugins/HistoryPlusPlus/PassForm.pas create mode 100644 plugins/HistoryPlusPlus/PassNewForm.dfm create mode 100644 plugins/HistoryPlusPlus/PassNewForm.pas create mode 100644 plugins/HistoryPlusPlus/VertSB.pas create mode 100644 plugins/HistoryPlusPlus/alpha.inc create mode 100644 plugins/HistoryPlusPlus/compilers.inc create mode 100644 plugins/HistoryPlusPlus/historypp.dpr create mode 100644 plugins/HistoryPlusPlus/historypp_Icon.ico create mode 100644 plugins/HistoryPlusPlus/historypp_icons.dpr create mode 100644 plugins/HistoryPlusPlus/historypp_icons.rc create mode 100644 plugins/HistoryPlusPlus/hpp_JclSysUtils.pas create mode 100644 plugins/HistoryPlusPlus/hpp_arrays.pas create mode 100644 plugins/HistoryPlusPlus/hpp_bookmarks.pas create mode 100644 plugins/HistoryPlusPlus/hpp_contacts.pas create mode 100644 plugins/HistoryPlusPlus/hpp_database.pas create mode 100644 plugins/HistoryPlusPlus/hpp_eventfilters.pas create mode 100644 plugins/HistoryPlusPlus/hpp_events.pas create mode 100644 plugins/HistoryPlusPlus/hpp_external.pas create mode 100644 plugins/HistoryPlusPlus/hpp_externalgrid.pas create mode 100644 plugins/HistoryPlusPlus/hpp_forms.pas create mode 100644 plugins/HistoryPlusPlus/hpp_global.pas create mode 100644 plugins/HistoryPlusPlus/hpp_itemprocess.pas create mode 100644 plugins/HistoryPlusPlus/hpp_mescatcher.pas create mode 100644 plugins/HistoryPlusPlus/hpp_messages.pas create mode 100644 plugins/HistoryPlusPlus/hpp_olesmileys.pas create mode 100644 plugins/HistoryPlusPlus/hpp_opt_dialog.pas create mode 100644 plugins/HistoryPlusPlus/hpp_opt_dialog.rc create mode 100644 plugins/HistoryPlusPlus/hpp_options.pas create mode 100644 plugins/HistoryPlusPlus/hpp_puny.pas create mode 100644 plugins/HistoryPlusPlus/hpp_res_ver.rc create mode 100644 plugins/HistoryPlusPlus/hpp_resource.rc create mode 100644 plugins/HistoryPlusPlus/hpp_richedit.pas create mode 100644 plugins/HistoryPlusPlus/hpp_searchthread.pas create mode 100644 plugins/HistoryPlusPlus/hpp_services.pas create mode 100644 plugins/HistoryPlusPlus/hpp_sessionsthread.pas create mode 100644 plugins/HistoryPlusPlus/hpp_strparser.pas create mode 100644 plugins/HistoryPlusPlus/inc/m_icqext.inc create mode 100644 plugins/HistoryPlusPlus/inc/m_ieview.inc create mode 100644 plugins/HistoryPlusPlus/inc/m_jabber.inc create mode 100644 plugins/HistoryPlusPlus/inc/m_mathmodule.inc create mode 100644 plugins/HistoryPlusPlus/inc/m_music.inc create mode 100644 plugins/HistoryPlusPlus/inc/m_speak.inc create mode 100644 plugins/HistoryPlusPlus/m_historypp.inc create mode 100644 plugins/HistoryPlusPlus/note.txt create mode 100644 plugins/HistoryPlusPlus/res/close_box.bmp create mode 100644 plugins/HistoryPlusPlus/res/cr_hand.cur create mode 100644 plugins/HistoryPlusPlus/res/event_avatar.ico create mode 100644 plugins/HistoryPlusPlus/res/event_contacts.ico create mode 100644 plugins/HistoryPlusPlus/res/event_eexpress.ico create mode 100644 plugins/HistoryPlusPlus/res/event_incoming.ico create mode 100644 plugins/HistoryPlusPlus/res/event_nick.ico create mode 100644 plugins/HistoryPlusPlus/res/event_outgoing.ico create mode 100644 plugins/HistoryPlusPlus/res/event_sms.ico create mode 100644 plugins/HistoryPlusPlus/res/event_smtpsimple.ico create mode 100644 plugins/HistoryPlusPlus/res/event_status.ico create mode 100644 plugins/HistoryPlusPlus/res/event_statusmes.ico create mode 100644 plugins/HistoryPlusPlus/res/event_system.ico create mode 100644 plugins/HistoryPlusPlus/res/event_voicecall.ico create mode 100644 plugins/HistoryPlusPlus/res/event_watrack.ico create mode 100644 plugins/HistoryPlusPlus/res/event_webpager.ico create mode 100644 plugins/HistoryPlusPlus/res/gsearch_advanced.ico create mode 100644 plugins/HistoryPlusPlus/res/gsearch_limitrange.ico create mode 100644 plugins/HistoryPlusPlus/res/gsearch_searchprotected.ico create mode 100644 plugins/HistoryPlusPlus/res/historypp_bookmark.ico create mode 100644 plugins/HistoryPlusPlus/res/historypp_bookmark_off.ico create mode 100644 plugins/HistoryPlusPlus/res/historypp_bookmark_on.ico create mode 100644 plugins/HistoryPlusPlus/res/historypp_contact.ico create mode 100644 plugins/HistoryPlusPlus/res/historypp_contactdetails.ico create mode 100644 plugins/HistoryPlusPlus/res/historypp_contactmenu.ico create mode 100644 plugins/HistoryPlusPlus/res/historypp_hotfilter.ico create mode 100644 plugins/HistoryPlusPlus/res/historypp_hotfilterclear.ico create mode 100644 plugins/HistoryPlusPlus/res/historypp_hotfilterwait.ico create mode 100644 plugins/HistoryPlusPlus/res/historypp_hotsearch.ico create mode 100644 plugins/HistoryPlusPlus/res/historypp_search.ico create mode 100644 plugins/HistoryPlusPlus/res/historypp_search_allresults.ico create mode 100644 plugins/HistoryPlusPlus/res/historypp_searchdown.ico create mode 100644 plugins/HistoryPlusPlus/res/historypp_searchup.ico create mode 100644 plugins/HistoryPlusPlus/res/historypp_session_div.ico create mode 100644 plugins/HistoryPlusPlus/res/historypp_session_hide.ico create mode 100644 plugins/HistoryPlusPlus/res/options_checked.ico create mode 100644 plugins/HistoryPlusPlus/res/password_protect.ico create mode 100644 plugins/HistoryPlusPlus/res/search_endofpage.ico create mode 100644 plugins/HistoryPlusPlus/res/search_notfound.ico create mode 100644 plugins/HistoryPlusPlus/res/sess_autumn.ico create mode 100644 plugins/HistoryPlusPlus/res/sess_session.ico create mode 100644 plugins/HistoryPlusPlus/res/sess_spring.ico create mode 100644 plugins/HistoryPlusPlus/res/sess_summer.ico create mode 100644 plugins/HistoryPlusPlus/res/sess_winter.ico create mode 100644 plugins/HistoryPlusPlus/res/sess_year.ico create mode 100644 plugins/HistoryPlusPlus/res/toolbar_copy.ico create mode 100644 plugins/HistoryPlusPlus/res/toolbar_delete.ico create mode 100644 plugins/HistoryPlusPlus/res/toolbar_deleteall.ico create mode 100644 plugins/HistoryPlusPlus/res/toolbar_eventsfilter.ico create mode 100644 plugins/HistoryPlusPlus/res/toolbar_save.ico create mode 100644 plugins/HistoryPlusPlus/res/toolbar_saveall.ico create mode 100644 plugins/HistoryPlusPlus/res/toolbar_sessions.ico 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 = '
Generated by History++ Plugin
' + 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 = '
Generated by History++ Plugin
' + 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 := ''; + Insert(UrlStr, Result, UrlStart); + Insert('', Result, UrlEnd + Length(UrlStr) + 1); + UrlStr := StringReplace(UrlStr, '://', '!//', [rfReplaceAll]); + Insert(UrlStr, Text, UrlStart); + Insert('', 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, '
', [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; + // + + // 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 := '
Generated by ' + hppName + ' Plugin
'; + 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 = '' + #13#10 + '' + #13#10 + + '' + + #13#10 + '' + #13#10 + '' + #13#10 + + '' + #13#10 + '' + #13#10 + + '' + #13#10 + '' + #13#10 + + '' + #13#10 + '' + #13#10 + + '' + #13#10 + '' + #13#10 + + '' + #13#10 + '%s' + '' + #13#10 + ']>' + #13#10 + + '' + #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, '' + + #13#10); + // if Options.RTLEnabled then WriteString(Stream,'') + if (RTLMode = hppRTLEnable) or ((RTLMode = hppRTLDefault) and Options.RTLEnabled) then + WriteString(Stream, '') + else + WriteString(Stream, ''); + WriteString(Stream, '' + #13#10); + WriteString(Stream, '' + + #13#10); + WriteString(Stream, '' + MakeTextHtmled(title) + '' + #13#10); + WriteString(Stream, '' + #13#10 + '' + #13#10); + WriteString(Stream, '

' + MakeTextHtmled(head1) + '

' + #13#10); + WriteString(Stream, '

' + MakeTextHtmled(head2) + '

' + #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('' + #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, '
' + #13#10); + WriteString(Stream, UTF8Encode(TxtGenHist2) + #13#10); + WriteString(Stream, ''); + end; + + procedure SaveXML; + begin + WriteString(Stream, ''); + 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, '
' + #13#10); + WriteString(Stream, #9 + '
' + + MakeTextHtmled(UTF8Encode(WideFormat(TxtSessions, [Time]))) + '
' + #13#10); + WriteString(Stream, '
' + #13#10); + end; + WriteString(Stream, '
' + #13#10); + if FullHeader then + begin + WriteString(Stream, #9 + '
' + + MakeTextHtmled(UTF8Encode(nick)) + '
' + #13#10); + WriteString(Stream, #9 + '
' + + MakeTextHtmled(UTF8Encode(Time)) + '
' + #13#10); + end; + WriteString(Stream, #9 + '
' + #13#10#9 + txt + #13#10#9 + '
' + + #13#10); + WriteString(Stream, '
' + #13#10); + end; + + procedure SaveXML; + var + XmlItem: TXMLItem; + begin + if not Assigned(FGetXMLData) then + exit; + FGetXMLData(Self, Item, XmlItem); + WriteString(Stream, '' + #13#10); + WriteString(Stream, #9 + '' + XmlItem.Contact + '' + #13#10); + WriteString(Stream, #9 + '' + XmlItem.From + '' + #13#10); + WriteString(Stream, #9 + '' + #13#10); + WriteString(Stream, #9 + '' + XmlItem.Date + '' + #13#10); + WriteString(Stream, #9 + '' + XmlItem.Protocol + '' + #13#10); + WriteString(Stream, #9 + '' + XmlItem.ID + '' + #13#10); + WriteString(Stream, #9 + '' + XmlItem.EventType + '' + #13#10); + if XmlItem.Mes <> '' then + WriteString(Stream, #9 + '' + XmlItem.Mes + '' + #13#10); + if XmlItem.FileName <> '' then + WriteString(Stream, #9 + '' + XmlItem.FileName + '' + #13#10); + if XmlItem.Url <> '' then + WriteString(Stream, #9 + '' + XmlItem.Url + '' + #13#10); + WriteString(Stream, '' + #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 new file mode 100644 index 0000000000..cfd8992a5b Binary files /dev/null and b/plugins/HistoryPlusPlus/historypp_Icon.ico differ 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= ''+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:''; minRE: 10), + (prefix:(ansi:'[/b]'); suffix:(ansi:nil); bbtype:bbSimple; rtf:'}'; html:'')), + ((prefix:(ansi:'[i]'); suffix:(ansi:nil); bbtype:bbSimple; rtf:'{\i '; html:''; minRE: 10), + (prefix:(ansi:'[/i]'); suffix:(ansi:nil); bbtype:bbSimple; rtf:'}'; html:'')), + ((prefix:(ansi:'[u]'); suffix:(ansi:nil); bbtype:bbSimple; rtf:'{\ul '; html:''; minRE: 10), + (prefix:(ansi:'[/u]'); suffix:(ansi:nil); bbtype:bbSimple; rtf:'}'; html:'')), + ((prefix:(ansi:'[s]'); suffix:(ansi:nil); bbtype:bbSimple; rtf:'{\strike '; html:''; minRE: 10), + (prefix:(ansi:'[/s]'); suffix:(ansi:nil); bbtype:bbSimple; rtf:'}'; html:'')), + ((prefix:(ansi:'[color='); suffix:(ansi:']'); bbtype:bbColor; rtf:'{\cf%u '; html:''; minRE: 10), + (prefix:(ansi:'[/color]'); suffix:(ansi:nil); bbtype:bbSimple; rtf:'}'; html:'')), + {$IFDEF USE_URL_BBCODE} + ((prefix:(ansi:'[url='); suffix:(ansi:']'); bbtype:bbUrl; rtf:'{\field{\*\fldinst{HYPERLINK ":%s"}}{\fldrslt{\ul\cf%u'; html:''; minRE: 41), + (prefix:(ansi:'[/url]'); suffix:(ansi:nil); bbtype:bbSimple; rtf:'}}}'; html:'')), + {$ENDIF} + ((prefix:(ansi:'[size='); suffix:(ansi:']'); bbtype:bbSize; rtf:'{\fs%u '; html:''; minRE: 10), + (prefix:(ansi:'[/size]'); suffix:(ansi:nil); bbtype:bbSimple; rtf:'}'; html:'')), + ((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 (urlStartbufPos+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 new file mode 100644 index 0000000000..55ce8d3a3d Binary files /dev/null and b/plugins/HistoryPlusPlus/res/close_box.bmp differ diff --git a/plugins/HistoryPlusPlus/res/cr_hand.cur b/plugins/HistoryPlusPlus/res/cr_hand.cur new file mode 100644 index 0000000000..59475887a2 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/cr_hand.cur differ diff --git a/plugins/HistoryPlusPlus/res/event_avatar.ico b/plugins/HistoryPlusPlus/res/event_avatar.ico new file mode 100644 index 0000000000..e821b9cafe Binary files /dev/null and b/plugins/HistoryPlusPlus/res/event_avatar.ico differ diff --git a/plugins/HistoryPlusPlus/res/event_contacts.ico b/plugins/HistoryPlusPlus/res/event_contacts.ico new file mode 100644 index 0000000000..8bc58da983 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/event_contacts.ico differ diff --git a/plugins/HistoryPlusPlus/res/event_eexpress.ico b/plugins/HistoryPlusPlus/res/event_eexpress.ico new file mode 100644 index 0000000000..4d251e546f Binary files /dev/null and b/plugins/HistoryPlusPlus/res/event_eexpress.ico differ diff --git a/plugins/HistoryPlusPlus/res/event_incoming.ico b/plugins/HistoryPlusPlus/res/event_incoming.ico new file mode 100644 index 0000000000..b21c7254ba Binary files /dev/null and b/plugins/HistoryPlusPlus/res/event_incoming.ico differ diff --git a/plugins/HistoryPlusPlus/res/event_nick.ico b/plugins/HistoryPlusPlus/res/event_nick.ico new file mode 100644 index 0000000000..06089cf9b4 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/event_nick.ico differ diff --git a/plugins/HistoryPlusPlus/res/event_outgoing.ico b/plugins/HistoryPlusPlus/res/event_outgoing.ico new file mode 100644 index 0000000000..138d61e34b Binary files /dev/null and b/plugins/HistoryPlusPlus/res/event_outgoing.ico differ diff --git a/plugins/HistoryPlusPlus/res/event_sms.ico b/plugins/HistoryPlusPlus/res/event_sms.ico new file mode 100644 index 0000000000..a76eefcb64 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/event_sms.ico differ diff --git a/plugins/HistoryPlusPlus/res/event_smtpsimple.ico b/plugins/HistoryPlusPlus/res/event_smtpsimple.ico new file mode 100644 index 0000000000..0ac1a1c237 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/event_smtpsimple.ico differ diff --git a/plugins/HistoryPlusPlus/res/event_status.ico b/plugins/HistoryPlusPlus/res/event_status.ico new file mode 100644 index 0000000000..82dc6588f0 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/event_status.ico differ diff --git a/plugins/HistoryPlusPlus/res/event_statusmes.ico b/plugins/HistoryPlusPlus/res/event_statusmes.ico new file mode 100644 index 0000000000..9058507d96 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/event_statusmes.ico differ diff --git a/plugins/HistoryPlusPlus/res/event_system.ico b/plugins/HistoryPlusPlus/res/event_system.ico new file mode 100644 index 0000000000..7fa13607cc Binary files /dev/null and b/plugins/HistoryPlusPlus/res/event_system.ico differ diff --git a/plugins/HistoryPlusPlus/res/event_voicecall.ico b/plugins/HistoryPlusPlus/res/event_voicecall.ico new file mode 100644 index 0000000000..9e100fee32 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/event_voicecall.ico differ diff --git a/plugins/HistoryPlusPlus/res/event_watrack.ico b/plugins/HistoryPlusPlus/res/event_watrack.ico new file mode 100644 index 0000000000..2665d2ded3 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/event_watrack.ico differ diff --git a/plugins/HistoryPlusPlus/res/event_webpager.ico b/plugins/HistoryPlusPlus/res/event_webpager.ico new file mode 100644 index 0000000000..5f5c5fb7df Binary files /dev/null and b/plugins/HistoryPlusPlus/res/event_webpager.ico differ diff --git a/plugins/HistoryPlusPlus/res/gsearch_advanced.ico b/plugins/HistoryPlusPlus/res/gsearch_advanced.ico new file mode 100644 index 0000000000..5e768973f5 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/gsearch_advanced.ico differ diff --git a/plugins/HistoryPlusPlus/res/gsearch_limitrange.ico b/plugins/HistoryPlusPlus/res/gsearch_limitrange.ico new file mode 100644 index 0000000000..0febf183b7 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/gsearch_limitrange.ico differ diff --git a/plugins/HistoryPlusPlus/res/gsearch_searchprotected.ico b/plugins/HistoryPlusPlus/res/gsearch_searchprotected.ico new file mode 100644 index 0000000000..f799b02968 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/gsearch_searchprotected.ico differ diff --git a/plugins/HistoryPlusPlus/res/historypp_bookmark.ico b/plugins/HistoryPlusPlus/res/historypp_bookmark.ico new file mode 100644 index 0000000000..07bb34089c Binary files /dev/null and b/plugins/HistoryPlusPlus/res/historypp_bookmark.ico differ diff --git a/plugins/HistoryPlusPlus/res/historypp_bookmark_off.ico b/plugins/HistoryPlusPlus/res/historypp_bookmark_off.ico new file mode 100644 index 0000000000..a6946d5c90 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/historypp_bookmark_off.ico differ diff --git a/plugins/HistoryPlusPlus/res/historypp_bookmark_on.ico b/plugins/HistoryPlusPlus/res/historypp_bookmark_on.ico new file mode 100644 index 0000000000..115d3375b8 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/historypp_bookmark_on.ico differ diff --git a/plugins/HistoryPlusPlus/res/historypp_contact.ico b/plugins/HistoryPlusPlus/res/historypp_contact.ico new file mode 100644 index 0000000000..6d53ac6847 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/historypp_contact.ico differ diff --git a/plugins/HistoryPlusPlus/res/historypp_contactdetails.ico b/plugins/HistoryPlusPlus/res/historypp_contactdetails.ico new file mode 100644 index 0000000000..c9fb1249c6 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/historypp_contactdetails.ico differ diff --git a/plugins/HistoryPlusPlus/res/historypp_contactmenu.ico b/plugins/HistoryPlusPlus/res/historypp_contactmenu.ico new file mode 100644 index 0000000000..6b191fecf1 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/historypp_contactmenu.ico differ diff --git a/plugins/HistoryPlusPlus/res/historypp_hotfilter.ico b/plugins/HistoryPlusPlus/res/historypp_hotfilter.ico new file mode 100644 index 0000000000..fc20197c6f Binary files /dev/null and b/plugins/HistoryPlusPlus/res/historypp_hotfilter.ico differ diff --git a/plugins/HistoryPlusPlus/res/historypp_hotfilterclear.ico b/plugins/HistoryPlusPlus/res/historypp_hotfilterclear.ico new file mode 100644 index 0000000000..8e825c0c37 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/historypp_hotfilterclear.ico differ diff --git a/plugins/HistoryPlusPlus/res/historypp_hotfilterwait.ico b/plugins/HistoryPlusPlus/res/historypp_hotfilterwait.ico new file mode 100644 index 0000000000..b5818c9712 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/historypp_hotfilterwait.ico differ diff --git a/plugins/HistoryPlusPlus/res/historypp_hotsearch.ico b/plugins/HistoryPlusPlus/res/historypp_hotsearch.ico new file mode 100644 index 0000000000..a5b6b91b63 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/historypp_hotsearch.ico differ diff --git a/plugins/HistoryPlusPlus/res/historypp_search.ico b/plugins/HistoryPlusPlus/res/historypp_search.ico new file mode 100644 index 0000000000..b6e87fd671 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/historypp_search.ico differ diff --git a/plugins/HistoryPlusPlus/res/historypp_search_allresults.ico b/plugins/HistoryPlusPlus/res/historypp_search_allresults.ico new file mode 100644 index 0000000000..7d0a1073f8 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/historypp_search_allresults.ico differ diff --git a/plugins/HistoryPlusPlus/res/historypp_searchdown.ico b/plugins/HistoryPlusPlus/res/historypp_searchdown.ico new file mode 100644 index 0000000000..adffa30602 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/historypp_searchdown.ico differ diff --git a/plugins/HistoryPlusPlus/res/historypp_searchup.ico b/plugins/HistoryPlusPlus/res/historypp_searchup.ico new file mode 100644 index 0000000000..c50ef37968 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/historypp_searchup.ico differ diff --git a/plugins/HistoryPlusPlus/res/historypp_session_div.ico b/plugins/HistoryPlusPlus/res/historypp_session_div.ico new file mode 100644 index 0000000000..4790995cbb Binary files /dev/null and b/plugins/HistoryPlusPlus/res/historypp_session_div.ico differ diff --git a/plugins/HistoryPlusPlus/res/historypp_session_hide.ico b/plugins/HistoryPlusPlus/res/historypp_session_hide.ico new file mode 100644 index 0000000000..6a05b7fb1b Binary files /dev/null and b/plugins/HistoryPlusPlus/res/historypp_session_hide.ico differ diff --git a/plugins/HistoryPlusPlus/res/options_checked.ico b/plugins/HistoryPlusPlus/res/options_checked.ico new file mode 100644 index 0000000000..d2a8206958 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/options_checked.ico differ diff --git a/plugins/HistoryPlusPlus/res/password_protect.ico b/plugins/HistoryPlusPlus/res/password_protect.ico new file mode 100644 index 0000000000..16ebbc30d0 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/password_protect.ico differ diff --git a/plugins/HistoryPlusPlus/res/search_endofpage.ico b/plugins/HistoryPlusPlus/res/search_endofpage.ico new file mode 100644 index 0000000000..7008a65a81 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/search_endofpage.ico differ diff --git a/plugins/HistoryPlusPlus/res/search_notfound.ico b/plugins/HistoryPlusPlus/res/search_notfound.ico new file mode 100644 index 0000000000..bc00294dc2 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/search_notfound.ico differ diff --git a/plugins/HistoryPlusPlus/res/sess_autumn.ico b/plugins/HistoryPlusPlus/res/sess_autumn.ico new file mode 100644 index 0000000000..82434063fb Binary files /dev/null and b/plugins/HistoryPlusPlus/res/sess_autumn.ico differ diff --git a/plugins/HistoryPlusPlus/res/sess_session.ico b/plugins/HistoryPlusPlus/res/sess_session.ico new file mode 100644 index 0000000000..d817ff2cc1 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/sess_session.ico differ diff --git a/plugins/HistoryPlusPlus/res/sess_spring.ico b/plugins/HistoryPlusPlus/res/sess_spring.ico new file mode 100644 index 0000000000..a47bebc2d4 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/sess_spring.ico differ diff --git a/plugins/HistoryPlusPlus/res/sess_summer.ico b/plugins/HistoryPlusPlus/res/sess_summer.ico new file mode 100644 index 0000000000..921fe812ad Binary files /dev/null and b/plugins/HistoryPlusPlus/res/sess_summer.ico differ diff --git a/plugins/HistoryPlusPlus/res/sess_winter.ico b/plugins/HistoryPlusPlus/res/sess_winter.ico new file mode 100644 index 0000000000..032e4782d1 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/sess_winter.ico differ diff --git a/plugins/HistoryPlusPlus/res/sess_year.ico b/plugins/HistoryPlusPlus/res/sess_year.ico new file mode 100644 index 0000000000..51fa030d75 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/sess_year.ico differ diff --git a/plugins/HistoryPlusPlus/res/toolbar_copy.ico b/plugins/HistoryPlusPlus/res/toolbar_copy.ico new file mode 100644 index 0000000000..c09ffca306 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/toolbar_copy.ico differ diff --git a/plugins/HistoryPlusPlus/res/toolbar_delete.ico b/plugins/HistoryPlusPlus/res/toolbar_delete.ico new file mode 100644 index 0000000000..b4bc60be2d Binary files /dev/null and b/plugins/HistoryPlusPlus/res/toolbar_delete.ico differ diff --git a/plugins/HistoryPlusPlus/res/toolbar_deleteall.ico b/plugins/HistoryPlusPlus/res/toolbar_deleteall.ico new file mode 100644 index 0000000000..f7504347d3 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/toolbar_deleteall.ico differ diff --git a/plugins/HistoryPlusPlus/res/toolbar_eventsfilter.ico b/plugins/HistoryPlusPlus/res/toolbar_eventsfilter.ico new file mode 100644 index 0000000000..0303be0478 Binary files /dev/null and b/plugins/HistoryPlusPlus/res/toolbar_eventsfilter.ico differ diff --git a/plugins/HistoryPlusPlus/res/toolbar_save.ico b/plugins/HistoryPlusPlus/res/toolbar_save.ico new file mode 100644 index 0000000000..bf2fe9859a Binary files /dev/null and b/plugins/HistoryPlusPlus/res/toolbar_save.ico differ diff --git a/plugins/HistoryPlusPlus/res/toolbar_saveall.ico b/plugins/HistoryPlusPlus/res/toolbar_saveall.ico new file mode 100644 index 0000000000..98ec945a5d Binary files /dev/null and b/plugins/HistoryPlusPlus/res/toolbar_saveall.ico differ diff --git a/plugins/HistoryPlusPlus/res/toolbar_sessions.ico b/plugins/HistoryPlusPlus/res/toolbar_sessions.ico new file mode 100644 index 0000000000..1ee298ae5b Binary files /dev/null and b/plugins/HistoryPlusPlus/res/toolbar_sessions.ico differ -- cgit v1.2.3