diff options
Diffstat (limited to 'plugins/Utils.pas')
| -rw-r--r-- | plugins/Utils.pas/CustomGraph.pas | 56 | ||||
| -rw-r--r-- | plugins/Utils.pas/appcmdapi.pas | 2 | ||||
| -rw-r--r-- | plugins/Utils.pas/contact.pas | 129 | ||||
| -rw-r--r-- | plugins/Utils.pas/datetime.pas | 58 | ||||
| -rw-r--r-- | plugins/Utils.pas/dbsettings.pas | 13 | ||||
| -rw-r--r-- | plugins/Utils.pas/inouttext.pas | 194 | ||||
| -rw-r--r-- | plugins/Utils.pas/kolsizer.pas | 2 | ||||
| -rw-r--r-- | plugins/Utils.pas/mircontacts.pas | 673 | ||||
| -rw-r--r-- | plugins/Utils.pas/mirevents.pas | 536 | ||||
| -rw-r--r-- | plugins/Utils.pas/mirutils.pas | 373 | ||||
| -rw-r--r-- | plugins/Utils.pas/rtfole.pas | 560 | ||||
| -rw-r--r-- | plugins/Utils.pas/rtfutils.pas | 586 | ||||
| -rw-r--r-- | plugins/Utils.pas/syswin.pas | 9 | ||||
| -rw-r--r-- | plugins/Utils.pas/tlb_richedit.pas | 898 |
14 files changed, 3550 insertions, 539 deletions
diff --git a/plugins/Utils.pas/CustomGraph.pas b/plugins/Utils.pas/CustomGraph.pas index 638967df0c..fcd14c1ec6 100644 --- a/plugins/Utils.pas/CustomGraph.pas +++ b/plugins/Utils.pas/CustomGraph.pas @@ -5,32 +5,32 @@ interface uses windows;
const
- clScrollBar = TCOLORREF(COLOR_SCROLLBAR or $80000000);
- clBackground = TCOLORREF(COLOR_BACKGROUND or $80000000);
- clActiveCaption = TCOLORREF(COLOR_ACTIVECAPTION or $80000000);
- clInactiveCaption = TCOLORREF(COLOR_INACTIVECAPTION or $80000000);
- clMenu = TCOLORREF(COLOR_MENU or $80000000);
- clWindow = TCOLORREF(COLOR_WINDOW or $80000000);
- clWindowFrame = TCOLORREF(COLOR_WINDOWFRAME or $80000000);
- clMenuText = TCOLORREF(COLOR_MENUTEXT or $80000000);
- clWindowText = TCOLORREF(COLOR_WINDOWTEXT or $80000000);
- clCaptionText = TCOLORREF(COLOR_CAPTIONTEXT or $80000000);
- clActiveBorder = TCOLORREF(COLOR_ACTIVEBORDER or $80000000);
- clInactiveBorder = TCOLORREF(COLOR_INACTIVEBORDER or $80000000);
- clAppWorkSpace = TCOLORREF(COLOR_APPWORKSPACE or $80000000);
- clHighlight = TCOLORREF(COLOR_HIGHLIGHT or $80000000);
- clHighlightText = TCOLORREF(COLOR_HIGHLIGHTTEXT or $80000000);
- clBtnFace = TCOLORREF(COLOR_BTNFACE or $80000000);
- clBtnShadow = TCOLORREF(COLOR_BTNSHADOW or $80000000);
- clGrayText = TCOLORREF(COLOR_GRAYTEXT or $80000000);
- clGreyText = TCOLORREF(COLOR_GRAYTEXT or $80000000);
- clBtnText = TCOLORREF(COLOR_BTNTEXT or $80000000);
+ clScrollBar = TCOLORREF(COLOR_SCROLLBAR or $80000000);
+ clBackground = TCOLORREF(COLOR_BACKGROUND or $80000000);
+ clActiveCaption = TCOLORREF(COLOR_ACTIVECAPTION or $80000000);
+ clInactiveCaption = TCOLORREF(COLOR_INACTIVECAPTION or $80000000);
+ clMenu = TCOLORREF(COLOR_MENU or $80000000);
+ clWindow = TCOLORREF(COLOR_WINDOW or $80000000);
+ clWindowFrame = TCOLORREF(COLOR_WINDOWFRAME or $80000000);
+ clMenuText = TCOLORREF(COLOR_MENUTEXT or $80000000);
+ clWindowText = TCOLORREF(COLOR_WINDOWTEXT or $80000000);
+ clCaptionText = TCOLORREF(COLOR_CAPTIONTEXT or $80000000);
+ clActiveBorder = TCOLORREF(COLOR_ACTIVEBORDER or $80000000);
+ clInactiveBorder = TCOLORREF(COLOR_INACTIVEBORDER or $80000000);
+ clAppWorkSpace = TCOLORREF(COLOR_APPWORKSPACE or $80000000);
+ clHighlight = TCOLORREF(COLOR_HIGHLIGHT or $80000000);
+ clHighlightText = TCOLORREF(COLOR_HIGHLIGHTTEXT or $80000000);
+ clBtnFace = TCOLORREF(COLOR_BTNFACE or $80000000);
+ clBtnShadow = TCOLORREF(COLOR_BTNSHADOW or $80000000);
+ clGrayText = TCOLORREF(COLOR_GRAYTEXT or $80000000);
+ clGreyText = TCOLORREF(COLOR_GRAYTEXT or $80000000);
+ clBtnText = TCOLORREF(COLOR_BTNTEXT or $80000000);
clInactiveCaptionText = TCOLORREF(COLOR_INACTIVECAPTIONTEXT or $80000000);
- clBtnHighlight = TCOLORREF(COLOR_BTNHIGHLIGHT or $80000000);
- cl3DDkShadow = TCOLORREF(COLOR_3DDKSHADOW or $80000000);
- cl3DLight = TCOLORREF(COLOR_3DLIGHT or $80000000);
- clInfoText = TCOLORREF(COLOR_INFOTEXT or $80000000);
- clInfoBk = TCOLORREF(COLOR_INFOBK or $80000000);
+ clBtnHighlight = TCOLORREF(COLOR_BTNHIGHLIGHT or $80000000);
+ cl3DDkShadow = TCOLORREF(COLOR_3DDKSHADOW or $80000000);
+ cl3DLight = TCOLORREF(COLOR_3DLIGHT or $80000000);
+ clInfoText = TCOLORREF(COLOR_INFOTEXT or $80000000);
+ clInfoBk = TCOLORREF(COLOR_INFOBK or $80000000);
clBlack = TCOLORREF( $000000 );
clMaroon = TCOLORREF( $000080 );
@@ -67,9 +67,9 @@ const clGRushHiLight = TCOLORREF( $F3706C );
clGRushLighten = TCOLORREF( $F1EEDF );
- clGRushLight = TCOLORREF( $e1cebf );
- clGRushNormal = TCOLORREF( $D1beaf );
- clGRushMedium = TCOLORREF( $b6bFc6 );
+ clGRushLight = TCOLORREF( $E1CEBF );
+ clGRushNormal = TCOLORREF( $D1BEAF );
+ clGRushMedium = TCOLORREF( $B6BFC6 );
clGRushDark = TCOLORREF( $9EACB4 );
function ColorToRGB(Color: TCOLORREF):TCOLORREF;
diff --git a/plugins/Utils.pas/appcmdapi.pas b/plugins/Utils.pas/appcmdapi.pas index b316838ba3..5140e74f65 100644 --- a/plugins/Utils.pas/appcmdapi.pas +++ b/plugins/Utils.pas/appcmdapi.pas @@ -91,7 +91,7 @@ const function SendMMCommand(wnd:HWND; cmd:integer):integer;
begin
// result:=ord(SendMessageW(wnd,WM_APPCOMMAND,wnd,cmd shl 16));
- result:=ord(SendnotifyMessageW(wnd,WM_APPCOMMAND,wnd,cmd shl 16));
+ result:=ord(SendNotifyMessageW(wnd,WM_APPCOMMAND,wnd,cmd shl 16));
end;
end.
diff --git a/plugins/Utils.pas/contact.pas b/plugins/Utils.pas/contact.pas deleted file mode 100644 index 128d4fa6a7..0000000000 --- a/plugins/Utils.pas/contact.pas +++ /dev/null @@ -1,129 +0,0 @@ -{Contact list in combo}
-unit contact;
-
-interface
-
-uses windows, m_api;
-
-procedure FillContactList(list:HWND; filter:boolean=true;format:pWideChar=nil);
-function FindContact(list:HWND;contact:TMCONTACT):integer;
-
-implementation
-
-uses messages, common, dbsettings, mirutils;
-
-const
- defformat = '%name% - %uid% (%account%:%group%)';
-
-procedure FillContactList(list:HWND; filter:boolean=true;format:pWideChar=nil);
-var
- hContact:TMCONTACT;
- buf:array [0..511] of WideChar;
- buf1:array [0..63] of WideChar;
- p:PWideChar;
- uid:pAnsiChar;
- ldbv:TDBVARIANT;
- acc:pAnsiChar;
- lName,
- lGroup,
- lAccount,
- lUID:boolean;
-begin
- if format=nil then format:=defformat;
-
- SendMessage(list,CB_RESETCONTENT,0,0);
- hContact:=db_find_first();
-
- lName :=StrPosW(format,'%name%')<>nil;
- lGroup :=StrPosW(format,'%group%')<>nil;
- lAccount:=StrPosW(format,'%account%')<>nil;
- lUID :=StrPosW(format,'%uid%')<>nil;
-
- while hContact<>0 do
- begin
- if ((not filter) and ((IsContactActive(hContact)+1)>=0)) or // + disabled (not deleted)
- (filter and (IsContactActive(hContact) >=0)) then
- begin
- StrCopyW(buf,format);
- if lName then
- StrReplaceW(buf,'%name%',
- PWideChar(CallService(MS_CLIST_GETCONTACTDISPLAYNAME,hContact,GCDNF_UNICODE)));
-
- if lGroup then
- begin
- p:=DBReadUnicode(hContact,strCList,'Group',nil);
- StrReplaceW(buf,'%group%',p);
- mFreeMem(p);
- end;
-
- if lAccount then
- begin
- acc:=GetContactProtoAcc(hContact);
- StrReplaceW(buf,'%account%',FastAnsiToWideBuf(acc,buf1));
- end
- else
- acc:=nil;
-
- if lUID then
- begin
- if acc=nil then
- acc:=GetContactProtoAcc(hContact);
- if IsChat(hContact) then
- begin
- p:=DBReadUnicode(hContact,acc,'ChatRoomID');
- StrReplaceW(buf,'%uid%',p);
- mFreeMem(p);
- end
- else
- begin
- uid:=pAnsiChar(CallProtoService(acc,PS_GETCAPS,PFLAG_UNIQUEIDSETTING,0));
- if uid<>pAnsiChar(CALLSERVICE_NOTFOUND) then
- begin
- if DBReadSetting(hContact,acc,uid,@ldbv)=0 then
- begin
- case ldbv._type of
- DBVT_DELETED: p:='[deleted]';
- DBVT_BYTE : p:=IntToStr(buf1,ldbv.bVal);
- DBVT_WORD : p:=IntToStr(buf1,ldbv.wVal);
- DBVT_DWORD : p:=IntToStr(buf1,ldbv.dVal);
- DBVT_UTF8 : UTF8ToWide(ldbv.szVal.A,p);
- DBVT_ASCIIZ : AnsiToWide(ldbv.szVal.A,p,MirandaCP);
- DBVT_WCHAR : p:=ldbv.szVal.W;
- DBVT_BLOB : p:='blob';
- end;
- StrReplaceW(buf,'%uid%',p);
- if ldbv._type in [DBVT_UTF8,DBVT_ASCIIZ] then
- mFreeMem(p);
- DBFreeVariant(@ldbv);
- end;
- end;
- StrReplaceW(buf,'%uid%',nil);
- end;
- end;
-
- SendMessage(list,CB_SETITEMDATA,
- SendMessageW(list,CB_ADDSTRING,0,tlparam(@buf)),
- hContact);
- end;
- hContact:=db_find_next(hContact);
- end;
-end;
-
-function FindContact(list:HWND;contact:TMCONTACT):integer;
-var
- j:integer;
-begin
- result:=0;
- j:=SendMessage(list,CB_GETCOUNT,0,0);
- while j>0 do
- begin
- dec(j);
- if TMCONTACT(SendMessage(list,CB_GETITEMDATA,j,0))=contact then
- begin
- result:=j;
- break;
- end;
- end;
-end;
-
-end.
diff --git a/plugins/Utils.pas/datetime.pas b/plugins/Utils.pas/datetime.pas index f30d186b4e..4b13d7b3f4 100644 --- a/plugins/Utils.pas/datetime.pas +++ b/plugins/Utils.pas/datetime.pas @@ -18,7 +18,8 @@ function IsLeapYear(Year:word):Boolean; function EncodeTime(Hour, Minute, Sec: cardinal):TDateTime;
function EncodeDate(Year, Month , Day: cardinal):TDateTime;
-function Timestamp(Year,Month,Day:cardinal;Hour:cardinal=0;Minute:cardinal=0;Sec:cardinal=0):dword;
+function Timestamp(Year,Month,Day:cardinal;Hour:cardinal=0;Minute:cardinal=0;Sec:cardinal=0):dword; overload;
+function Timestamp(const st:TSystemTime):dword; overload;
function GetCurrentTimestamp:DWord;
procedure UnixTimeToFileTime(ts:int_ptr; var pft:TFILETIME);
@@ -31,6 +32,10 @@ function DateTimeToStr(Time:Dword; Format:pWideChar=nil):pWideChar; function DateToStr (Time:Dword; Format:pWideChar=nil):pWideChar;
function TimeToStr (Time:Dword; Format:pWideChar=nil):pWideChar;
+function CompareDate(const one,two:TSystemTime):integer;
+function CompareTime(const one,two:TSystemTime):integer;
+function TimeToMidnight(const t:TSystemTime):integer;
+
implementation
uses
@@ -83,6 +88,12 @@ begin result:=Round((t - UnixDateDelta) * SecondsPerDay);
end;
+function Timestamp(const st:TSystemTime):dword;
+ {$IFDEF AllowInline}inline;{$ENDIF}
+begin
+ result:=Timestamp(st.wYear,st.wMonth,st.wDay,st.wHour,st.wMinute,st.wSecond);
+end;
+
function GetCurrentTimestamp:dword;
var
st:tSystemTime;
@@ -171,4 +182,49 @@ begin StrDupW(result,buf);
end;
+function CompareDate(const one,two:TSystemTime):integer;
+var
+ t1,t2:integer;
+begin
+ t1:=((one.wYear*12)+one.wMonth)*32+one.wDay;
+ t2:=((two.wYear*12)+two.wMonth)*32+two.wDay;
+ result:=t1-t2;
+{
+ result:=one.wYear-two.wYear;
+ if result=0 then
+ begin
+ result:=one.wMonth-two.wMonth;
+ if result=0 then
+ begin
+ result:=one.wDay-two.wDay;
+ end;
+ end;
+}
+end;
+
+function CompareTime(const one,two:TSystemTime):integer;
+var
+ t1,t2:integer;
+begin
+ t1:=one.wHour*3600+one.wMinute*60+one.wSecond;
+ t2:=two.wHour*3600+two.wMinute*60+two.wSecond;
+ result:=t1-t2;
+{
+ result:=one.wHour-two.wHour;
+ if result=0 then
+ begin
+ result:=one.wMinute-two.wMinute;
+ if result=0 then
+ begin
+ result:=one.wSecond-two.wSecond;
+ end;
+ end;
+}
+end;
+
+function TimeToMidnight(const t:TSystemTime):integer;
+begin
+ result:=SecondsPerDay-(t.wHour*3600+t.wMinute*60+t.wSecond);
+end;
+
end.
diff --git a/plugins/Utils.pas/dbsettings.pas b/plugins/Utils.pas/dbsettings.pas index 1963248587..5679ef9fd1 100644 --- a/plugins/Utils.pas/dbsettings.pas +++ b/plugins/Utils.pas/dbsettings.pas @@ -37,7 +37,7 @@ function DBDeleteSetting(hContact:TMCONTACT;szModule:PAnsiChar;szSetting:PAnsiCh function DBDeleteGroup(hContact:TMCONTACT;szModule:PAnsiChar;prefix:pAnsiChar=nil):int_ptr;
-function DBDeleteModule(szModule:PAnsiChar):integer; // 0.8.0+
+function DBDeleteModule(hContact:TMCONTACT;szModule:PAnsiChar):integer;
function DBGetSettingType(hContact:TMCONTACT;szModule:PAnsiChar;szSetting:PAnsiChar):integer;
@@ -236,6 +236,13 @@ var len:cardinal;
mask:array [0..31] of AnsiChar;
begin
+ if (prefix=nil) or (prefix^=#0) then
+ begin
+ DBDeleteModule(hContact,szModule);
+ result:=0;
+ exit;
+ end;
+
ces.szModule:=szModule;
num:=0;
//calculate size for setting names buffer
@@ -308,10 +315,10 @@ begin FreeMem(p);
end;
-function DBDeleteModule(szModule:PAnsiChar):integer;
+function DBDeleteModule(hContact:TMCONTACT;szModule:PAnsiChar):integer;
begin
result:=0;
- CallService(MS_DB_MODULE_DELETE,0,lParam(szModule));
+ CallService(MS_DB_MODULE_DELETE,hContact,lParam(szModule));
end;
function DBGetSettingType(hContact:TMCONTACT;szModule:PAnsiChar;szSetting:PAnsiChar):integer;
diff --git a/plugins/Utils.pas/inouttext.pas b/plugins/Utils.pas/inouttext.pas new file mode 100644 index 0000000000..d4013a815e --- /dev/null +++ b/plugins/Utils.pas/inouttext.pas @@ -0,0 +1,194 @@ +unit inouttext;
+
+interface
+
+type
+ TTextExport = class
+ private
+ FCurrent:PAnsiChar;
+ FItems :array of PAnsiChar;
+ FItem :integer;
+ FIndent :integer;
+ FLineLen:integer;
+ FDoTab :boolean;
+
+ function AddTab:boolean;
+ function GetItems(i:integer):PAnsiChar;
+
+ public
+ constructor Create(cnt:integer);
+ destructor Destroy; override;
+
+ function NextItem:integer;
+ procedure EndItem;
+ procedure addText (name:PAnsichar; value:PAnsiChar);
+ procedure addTextW(name:PAnsichar; value:PWideChar);
+ procedure addDWord(name:PAnsichar; value:cardinal);
+ procedure addFlag (name:PAnsichar; value:boolean=true);
+ procedure addNewLine;
+ procedure ShiftRight;
+ procedure ShiftLeft;
+
+ property Items[i:integer]:PAnsiChar read GetItems;
+ end;
+
+implementation
+
+uses Common;
+
+const
+ BUFSIZE = 65536;
+
+constructor TTextExport.Create(cnt:integer);
+begin
+ SetLength(FItems,cnt);
+ FIndent :=0;
+ FDoTab :=true;
+ FLineLen:=0;
+ FItem :=-1;
+end;
+
+destructor TTextExport.Destroy;
+var
+ i:integer;
+begin
+ for i:=0 to HIGH(FItems) do
+ mFreeMem(FItems[i]);
+ FItems:=nil;
+
+ inherited;
+end;
+
+function TTextExport.GetItems(i:integer):PAnsiChar;
+begin
+ if (i>=0) and (i<HIGH(FItems)) then
+ result:=FItems[i]
+ else
+ result:=nil;
+end;
+
+function TTextExport.NextItem:integer;
+begin
+ inc(FItem);
+ mGetMem(FItems[FItem],BUFSIZE);
+ FCurrent:=FItems[FItem];
+ result:=FItem;
+end;
+
+procedure TTextExport.EndItem;
+var
+ p:PAnsiChar;
+begin
+ if FItem>=0 then
+ begin
+ FCurrent^:=#0;
+ p:=FItems[FItem];
+ StrDup(FItems[FItem],p);
+ mFreeMem(p);
+ end;
+end;
+
+function TTextExport.AddTab:boolean;
+var
+ i:integer;
+begin
+ result:=FDoTab;
+ if FDoTab then
+ begin
+ for i:=0 to FIndent-1 do
+ begin
+ FCurrent^:=' '; inc(FCurrent); inc(FLineLen);
+ end;
+ FDoTab:=false;
+ end;
+end;
+
+procedure TTextExport.addText(name:PAnsichar; value:PAnsiChar);
+begin
+ if not AddTab then
+ if (FCurrent-1)^ <> #10 then //!!
+ begin
+ FCurrent^:=' '; inc(FCurrent); inc(FLineLen);
+ end;
+
+ FCurrent:=StrCopyE(FCurrent,name); FCurrent^:='='; inc(FCurrent); inc(FLineLen, StrLen(name)+1);
+ // check and make borders ', " or []
+ FCurrent^:='"'; inc(FCurrent); inc(FLineLen);
+ // delim-start
+ FCurrent:=StrCopyE(FCurrent,value);
+ // delim-end
+ FCurrent^:='"'; inc(FCurrent); inc(FLineLen);
+end;
+
+procedure TTextExport.addTextW(name:PAnsichar; value:PWideChar);
+var
+ pc:PAnsiChar;
+begin
+ if not AddTab then
+ if (FCurrent-1)^ <> #10 then //!!
+ begin
+ FCurrent^:=' '; inc(FCurrent); inc(FLineLen);
+ end;
+
+ FCurrent:=StrCopyE(FCurrent,name); FCurrent^:='='; inc(FCurrent); inc(FLineLen, StrLen(name)+1);
+ // check and make borders ', " or []
+ FCurrent^:='"'; inc(FCurrent); inc(FLineLen);
+ // delim-start
+ FCurrent:=StrCopyE(FCurrent,WideToUTF8(value, pc));
+ // delim-end
+ FCurrent^:='"'; inc(FCurrent); inc(FLineLen);
+
+ mFreeMem(pc);
+end;
+
+procedure TTextExport.addDWord(name:PAnsichar; value:cardinal);
+var
+ p:PAnsiChar;
+begin
+ if not AddTab then
+ begin
+ FCurrent^:=' '; inc(FCurrent); inc(FLineLen);
+ end;
+ FCurrent:=StrCopyE(FCurrent,name);
+ inc(FLineLen,StrLen(name));
+ FCurrent^:='='; inc(FCurrent); inc(FLineLen);
+ p:=IntToStr(FCurrent,value);
+ inc(FLineLen,StrLen(p));
+ FCurrent:=StrEnd(p);
+end;
+
+procedure TTextExport.addFlag(name:PAnsichar; value:boolean=true);
+begin
+ // if set "name=0/1", change here
+ if value then
+ begin
+ if not AddTab then
+ begin
+ FCurrent^:=' '; inc(FCurrent); inc(FLineLen);
+ end;
+ FCurrent:=StrCopyE(FCurrent,name);
+ inc(FLineLen,StrLen(name));
+ end;
+end;
+
+procedure TTextExport.addNewLine;
+begin
+ FCurrent^:=#13; inc(FCurrent);
+ FCurrent^:=#10; inc(FCurrent);
+ FDoTab :=true;
+ FLineLen:=0;
+end;
+
+procedure TTextExport.ShiftRight;
+begin
+ inc(FIndent,2);
+end;
+
+procedure TTextExport.ShiftLeft;
+begin
+ dec(FIndent,2);
+ if FIndent<0 then
+ FIndent:=0;
+end;
+
+end.
diff --git a/plugins/Utils.pas/kolsizer.pas b/plugins/Utils.pas/kolsizer.pas index 1004e1de57..7ba46a5f2a 100644 --- a/plugins/Utils.pas/kolsizer.pas +++ b/plugins/Utils.pas/kolsizer.pas @@ -40,7 +40,7 @@ type procedure DoKeyUp( Sender: PControl; var Key: Longint; Shift: dword);
procedure DoChar( Sender: PControl; var Key: KOLChar; Shift: dword);
public
- destructor destroy;virtual;
+ destructor Destroy; virtual;//override;
procedure Connect(aName: KOLString; aControl: pControl; flags:cardinal=0);
procedure DisConnect(aControl: pControl);
procedure Paintgrid(sender:pControl;DC:HDC);
diff --git a/plugins/Utils.pas/mircontacts.pas b/plugins/Utils.pas/mircontacts.pas new file mode 100644 index 0000000000..50d700b802 --- /dev/null +++ b/plugins/Utils.pas/mircontacts.pas @@ -0,0 +1,673 @@ +{$INCLUDE compilers.inc}
+unit mircontacts;
+
+interface
+
+uses
+ Windows,
+ m_api;
+
+//----- Contact info -----
+
+function GetContactProtoAcc(hContact:TMCONTACT):PAnsiChar;
+function GetContactProto(hContact: TMCONTACT): pAnsiChar; overload;
+function GetContactProto(hContact: TMCONTACT; var SubContact: TMCONTACT; var SubProtocol: pAnsiChar): pAnsiChar; overload;
+function GetContactDisplayName(hContact: TMCONTACT; Proto: pAnsiChar = nil; Contact: boolean = false): PWideChar;
+function GetContactID(hContact: TMCONTACT; Proto: pAnsiChar = nil; Contact: boolean = false): PAnsiChar;
+
+function GetContactCodePage (hContact: TMCONTACT; Proto: pAnsiChar; var UsedDefault: boolean): Cardinal; overload;
+function GetContactCodePage (hContact: TMCONTACT; const Proto: pAnsiChar = nil): Cardinal; overload;
+function WriteContactCodePage(hContact: TMCONTACT; CodePage: Cardinal; Proto: pAnsiChar = nil): boolean;
+
+function GetContactStatus(hContact:TMCONTACT):integer;
+
+//----- Contact type check -----
+
+function IsChat(hContact:TMCONTACT):bool;
+function IsMirandaUser(hContact:TMCONTACT):integer; // >0=Miranda; 0=Not miranda; -1=unknown
+
+// -2 - deleted account, -1 - disabled account, 0 - hidden
+// 1 - metacontact, 2 - submetacontact, positive - active
+// proto - ASSIGNED buffer
+function IsContactActive(hContact:TMCONTACT;proto:pAnsiChar=nil):integer;
+
+//----- Save / Load contact -----
+
+function LoadContact(group,setting:PAnsiChar):TMCONTACT;
+function SaveContact(hContact:TMCONTACT;group,setting:PAnsiChar):integer;
+function FindContactHandle(proto:pAnsiChar;const dbv:TDBVARIANT;is_chat:boolean=false):TMCONTACT;
+
+//----- Another functions -----
+
+function SetCListSelContact(hContact:TMCONTACT):TMCONTACT;
+function GetCListSelContact:TMCONTACT;
+
+function WndToContact(wnd:HWND):TMCONTACT; overload;
+function WndToContact:TMCONTACT; overload;
+
+procedure ShowContactDialog(hContact:TMCONTACT;DblClk:boolean=true;anystatus:boolean=true);
+procedure SendToChat(hContact:TMCONTACT;pszText:PWideChar);
+
+//----- List of contacts (combobox) -----
+
+procedure FillContactList(list:HWND;filter:boolean=true;format:pWideChar=nil);
+function FindContact (list:HWND;contact:TMCONTACT):integer;
+
+
+implementation
+
+uses
+ messages,
+ common, syswin,
+ dbsettings;
+
+//----- Contact info -----
+
+function GetContactProtoAcc(hContact:TMCONTACT):PAnsiChar;
+begin
+ if ServiceExists(MS_PROTO_GETCONTACTBASEACCOUNT)<>0 then
+ result:=PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEACCOUNT,hContact,0))
+ else
+ result:=PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO,hContact,0));
+end;
+
+function GetContactProto(hContact: TMCONTACT): pAnsiChar;
+{$IFDEF AllowInline}inline;{$ENDIF}
+begin
+ Result := PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO, hContact, 0));
+end;
+
+function GetContactProto(hContact: TMCONTACT; var SubContact: TMCONTACT; var SubProtocol: pAnsiChar): pAnsiChar;
+begin
+ Result := GetContactProto(hContact);
+ if StrCmp(Result, META_PROTO)=0 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: TMCONTACT; Proto: pAnsiChar = nil; Contact: boolean = false): PWideChar;
+var
+ ci: TContactInfo;
+ pUnk:PWideChar;
+begin
+ if (hContact = 0) and Contact then
+ StrDupW(Result, TranslateW('Server'))
+ else
+ begin
+ if Proto = nil then
+ Proto := GetContactProto(hContact);
+ pUnk := TranslateW('''(Unknown Contact)''');
+ if Proto = nil then
+ StrDupW(Result, pUnk)
+ else
+ begin
+ ci.cbSize := SizeOf(ci);
+ ci.hContact := hContact;
+ ci.szProto := Proto;
+ ci.dwFlag := CNF_DISPLAY + CNF_UNICODE;
+ if CallService(MS_CONTACT_GETCONTACTINFO, 0, LPARAM(@ci)) = 0 then
+ begin
+ if StrCmpW(ci.retval.szVal.w, pUnk)=0 then
+ AnsiToWide(GetContactID(hContact, Proto), Result, CP_ACP)
+ else
+ StrDupW(Result, ci.retval.szVal.w);
+ mir_free(ci.retval.szVal.w);
+ end
+ else
+ AnsiToWide(GetContactID(hContact, Proto), Result);
+
+ if (Result = nil) or (Result^ = #0) then
+ AnsiToWide(Translate(Proto), Result, CallService(MS_LANGPACK_GETCODEPAGE, 0, 0));
+ end;
+ end;
+end;
+
+function GetContactID(hContact: TMCONTACT; Proto: pAnsiChar = nil; Contact: boolean = false): PAnsiChar;
+var
+ uid: PAnsiChar;
+ dbv: TDBVARIANT;
+ buf: array [0..15] of AnsiChar;
+ cp: Cardinal;
+begin
+ Result := nil;
+ if not((hContact = 0) and Contact) then
+ begin
+ if Proto = nil then
+ Proto := GetContactProto(hContact);
+ uid := PAnsiChar(CallProtoService(Proto, PS_GETCAPS, PFLAG_UNIQUEIDSETTING, 0));
+ if (int_ptr(uid) <> CALLSERVICE_NOTFOUND) and (uid <> nil) then
+ begin
+ // DBGetContactSettingStr comparing to DBGetContactSetting don't translate strings
+ // when uType=0 (DBVT_ASIS)
+ if DBGetContactSettingStr(hContact, Proto, uid, @dbv, DBVT_ASIS) = 0 then
+ begin
+ case dbv._type of
+ DBVT_BYTE: StrDup(Result, IntToStr(buf,dbv.bVal));
+ DBVT_WORD: StrDup(Result, IntToStr(buf,dbv.wVal));
+ DBVT_DWORD: StrDup(Result, IntToStr(buf,dbv.dVal));
+ DBVT_ASCIIZ: StrDup(Result, dbv.szVal.a);
+ DBVT_UTF8,
+ DBVT_WCHAR: begin
+ cp := CallService(MS_LANGPACK_GETCODEPAGE, 0, 0);
+ if dbv._type = DBVT_UTF8 then
+ UTF8ToAnsi(dbv.szVal.a, Result, cp)
+ else // dbv._type = DBVT_WCHAR then
+ WideToAnsi(dbv.szVal.w, Result, cp);
+ end;
+ end;
+ // free variant
+ DBFreeVariant(@dbv);
+ end;
+ end;
+ end;
+end;
+
+function GetContactCodePage(hContact: TMCONTACT; Proto: pAnsiChar; var UsedDefault: boolean) : Cardinal;
+begin
+ if Proto = nil then
+ Proto := GetContactProto(hContact);
+ if Proto = nil then
+ Result := CallService(MS_LANGPACK_GETCODEPAGE, 0, 0)
+ else
+ begin
+ Result := DBReadWord(hContact, Proto, 'AnsiCodePage', $FFFF);
+ If Result = $FFFF then
+ Result := DBReadWord(0, Proto, 'AnsiCodePage', CP_ACP);
+ end;
+ UsedDefault := (Result = CP_ACP);
+ if UsedDefault then
+ Result := GetACP();
+end;
+
+function GetContactCodePage(hContact: TMCONTACT; const Proto: pAnsiChar = nil): Cardinal;
+var
+ def: boolean;
+begin
+ Result := GetContactCodePage(hContact, Proto, def);
+end;
+
+function WriteContactCodePage(hContact: TMCONTACT; CodePage: Cardinal; Proto: pAnsiChar = nil): boolean;
+begin
+ Result := false;
+ if Proto = nil then
+ Proto := GetContactProto(hContact);
+ if Proto = nil then
+ exit;
+ DBWriteWord(hContact, Proto, 'AnsiCodePage', CodePage);
+ Result := True;
+end;
+
+function GetContactStatus(hContact:TMCONTACT):integer;
+var
+ szProto:PAnsiChar;
+begin
+ szProto:=GetContactProto(hContact);
+ if szProto=nil then
+ result:=ID_STATUS_OFFLINE
+ else
+ result:=DBReadWord(hContact,szProto,'Status',ID_STATUS_OFFLINE);
+end;
+
+//----- Contact type check -----
+
+function IsChat(hContact:TMCONTACT):bool;
+begin
+ result:=DBReadByte(hContact,GetContactProto(hContact),'ChatRoom',0)=1;
+end;
+
+function IsMirandaUser(hContact:TMCONTACT):integer; // >0=Miranda; 0=Not miranda; -1=unknown
+var
+ sz:PAnsiChar;
+begin
+ sz:=DBReadString(hContact,GetContactProto(hContact),'MirVer');
+ if sz<>nil then
+ begin
+ result:=int_ptr(StrPos(sz,'Miranda'));
+ mFreeMem(sz);
+ end
+ else
+ result:=-1;
+end;
+
+function IsContactActive(hContact:TMCONTACT;proto:pAnsiChar=nil):integer;
+var
+ p:PPROTOACCOUNT;
+ name: array [0..31] of AnsiChar;
+begin
+
+ if db_get_static(hContact,'Protocol','p',@name,SizeOf(name))=0 then
+ begin
+ result:=0;
+
+ if ServiceExists(MS_PROTO_GETACCOUNT)<>0 then
+ begin
+ p:=PPROTOACCOUNT(CallService(MS_PROTO_GETACCOUNT,0,lparam(@name)));
+ if p=nil then
+ result:=-2 // deleted
+ else if (not p^.bIsEnabled) or p^.bDynDisabled then
+ result:=-1; // disabled
+ end
+ else
+ begin
+ if CallService(MS_PROTO_ISPROTOCOLLOADED,0,lparam(@name))=0 then
+ result:=-1;
+ end;
+
+ if (result=0) and (DBReadByte(hContact,strCList,'Hidden',0)=0) then
+ begin
+ result:=255;
+ if db_mc_getMeta(hContact)<>0 then
+ result:=2;
+ if StrCmp(GetContactProto(hContact),META_PROTO)=0 then
+ result:=1;
+ end;
+ if proto<>nil then
+ StrCopy(proto,@name);
+ end
+ else
+ begin
+ result:=-2;
+ if proto<>nil then
+ proto^:=#0;
+ end;
+end;
+
+//----- Save / Load contact -----
+
+const
+ opt_cproto = 'cproto';
+ opt_cuid = 'cuid';
+ opt_ischat = 'ischat';
+
+function FindContactHandle(proto:pAnsiChar;const dbv:TDBVARIANT;is_chat:boolean=false):TMCONTACT;
+var
+ uid:pAnsiChar;
+ ldbv:TDBVARIANT;
+ hContact:TMCONTACT;
+ pw:pWideChar;
+begin
+ result:=0;
+ uid:=nil;
+ if not is_chat then
+ begin
+ uid:=pAnsiChar(CallProtoService(proto,PS_GETCAPS,PFLAG_UNIQUEIDSETTING,0));
+ if uid=pAnsiChar(CALLSERVICE_NOTFOUND) then exit;
+ end;
+
+ hContact:=db_find_first();
+ while hContact<>0 do
+ begin
+ if is_chat then
+ begin
+ if IsChat(hContact) then
+ begin
+ pw:=DBReadUnicode(hContact,proto,'ChatRoomID');
+ if StrCmpW(pw,dbv.szVal.W)=0 then result:=hContact;
+ mFreeMem(pw);
+ end
+ end
+ else
+ begin
+ if DBReadSetting(hContact,proto,uid,@ldbv)=0 then
+ begin
+ if dbv._type=ldbv._type then
+ begin
+ case dbv._type of
+// DBVT_DELETED: ;
+ DBVT_BYTE : if dbv.bVal=ldbv.bVal then result:=hContact;
+ DBVT_WORD : if dbv.wVal=ldbv.wVal then result:=hContact;
+ DBVT_DWORD : if dbv.dVal=ldbv.dVal then result:=hContact;
+ DBVT_UTF8,
+ DBVT_ASCIIZ : if StrCmp (dbv.szVal.A,ldbv.szVal.A)=0 then result:=hContact;
+ DBVT_WCHAR : if StrCmpW(dbv.szVal.W,ldbv.szVal.W)=0 then result:=hContact;
+ DBVT_BLOB : begin
+ if dbv.cpbVal = ldbv.cpbVal then
+ begin
+ if CompareMem(dbv.pbVal,ldbv.pbVal,dbv.cpbVal) then
+ result:=hContact;
+ end;
+ end;
+ end;
+ end;
+ DBFreeVariant(@ldbv);
+ end;
+ end;
+ // added 2011.04.20
+ if result<>0 then break;
+ hContact:=db_find_next(hContact);
+ end;
+end;
+
+function LoadContact(group,setting:PAnsiChar):TMCONTACT;
+var
+ p,proto:pAnsiChar;
+ section:array [0..63] of AnsiChar;
+ dbv:TDBVARIANT;
+ is_chat:boolean;
+begin
+ p:=StrCopyE(section,setting);
+ StrCopy(p,opt_cproto); proto :=DBReadString(0,group,section);
+ StrCopy(p,opt_ischat); is_chat:=DBReadByte (0,group,section,0)<>0;
+ StrCopy(p,opt_cuid );
+ if is_chat then
+ dbv.szVal.W:=DBReadUnicode(0,group,section,@dbv)
+ else
+ DBReadSetting(0,group,section,@dbv);
+
+ result:=FindContactHandle(proto,dbv,is_chat);
+
+ mFreeMem(proto);
+ if not is_chat then
+ DBFreeVariant(@dbv)
+ else
+ mFreeMem(dbv.szVal.W);
+end;
+
+function SaveContact(hContact:TMCONTACT;group,setting:PAnsiChar):integer;
+var
+ p,proto,uid:pAnsiChar;
+ cws:TDBVARIANT;
+ section:array [0..63] of AnsiChar;
+ pw:pWideChar;
+ is_chat:boolean;
+begin
+ result:=0;
+ proto:=GetContactProtoAcc(hContact);
+ if proto<>nil then
+ begin
+ p:=StrCopyE(section,setting);
+ is_chat:=IsChat(hContact);
+ if is_chat then
+ begin
+ pw:=DBReadUnicode(hContact,proto,'ChatRoomID');
+ StrCopy(p,opt_cuid); DBWriteUnicode(0,group,section,pw);
+ mFreeMem(pw);
+ result:=1;
+ end
+ else
+ begin
+ uid:=pAnsiChar(CallProtoService(proto,PS_GETCAPS,PFLAG_UNIQUEIDSETTING,0));
+ if uid<>pAnsiChar(CALLSERVICE_NOTFOUND) then
+ begin
+ if DBReadSetting(hContact,proto,uid,@cws)=0 then
+ begin
+ StrCopy(p,opt_cuid); DBWriteSetting(0,group,section,@cws);
+ DBFreeVariant(@cws);
+ result:=1;
+ end;
+ end;
+ end;
+ if result<>0 then
+ begin
+ StrCopy(p,opt_cproto); DBWriteString(0,group,section,proto);
+ StrCopy(p,opt_ischat); DBWriteByte (0,group,section,ord(is_chat));
+ end;
+ end;
+end;
+
+//----- Another functions -----
+
+function SetCListSelContact(hContact:TMCONTACT):TMCONTACT;
+var
+ wnd:HWND;
+begin
+ wnd:=CallService(MS_CLUI_GETHWNDTREE,0,0);
+ result:=hContact;
+// hContact:=SendMessage(wnd,CLM_FINDCONTACT ,hContact,0);
+ SendMessage(wnd,CLM_SELECTITEM ,hContact,0);
+// SendMessage(wnd,CLM_ENSUREVISIBLE,hContact,0);
+end;
+
+function GetCListSelContact:TMCONTACT;
+begin
+ result:=SendMessageW(CallService(MS_CLUI_GETHWNDTREE,0,0),CLM_GETSELECTION,0,0);
+end;
+
+function WndToContact(wnd:HWND):TMCONTACT;
+var
+ hContact:TMCONTACT;
+ mwid:TMessageWindowInputData;
+ mwod:TMessageWindowOutputData;
+begin
+ wnd:=GetParent(wnd); //!!
+ hContact:=db_find_first();
+ with mwid do
+ begin
+ cbSize:=SizeOf(mwid);
+ uFlags:=MSG_WINDOW_UFLAG_MSG_BOTH;
+ end;
+ mwod.cbSize:=SizeOf(mwod);
+ while hContact<>0 do
+ begin
+ mwid.hContact:=hContact;
+ if CallService(MS_MSG_GETWINDOWDATA,wparam(@mwid),lparam(@mwod))=0 then
+ begin
+ if {((mwod.uState and MSG_WINDOW_STATE_FOCUS)<>0) and} (mwod.hwndWindow=wnd) then
+ begin
+ result:=mwid.hContact;
+ exit;
+ end
+ end;
+ hContact:=db_find_next(hContact);
+ end;
+ result:=0;
+end;
+
+function WndToContact:TMCONTACT; overload;
+var
+ wnd:HWND;
+begin
+ wnd:=GetFocus;
+ if wnd=0 then
+ wnd:=WaitFocusedWndChild(GetForegroundWindow);
+ if wnd<>0 then
+ result:=WndToContact(wnd)
+ else
+ result:=0;
+ if result=0 then
+ result:=GetCListSelContact;
+end;
+
+procedure ShowContactDialog(hContact:TMCONTACT;DblClk:boolean=true;anystatus:boolean=true);
+var
+ pc:array [0..127] of AnsiChar;
+begin
+{
+CallService(MS_CLIST_CONTACTDOUBLECLICKED,hContact,0);
+}
+ if (hContact<>0) and (CallService(MS_DB_CONTACT_IS,hContact,0)<>0) then
+ begin
+ if StrCopy(pc,GetContactProto(hContact))<>nil then
+ if DblClk or (DBReadByte(hContact,pc,'ChatRoom',0)=1) then // chat room
+ begin
+ if not anystatus then
+ begin
+ StrCat(pc,PS_GETSTATUS);
+ anystatus:=(CallService(pc,0,0)<>ID_STATUS_OFFLINE);
+ end;
+ if anystatus then
+ begin
+ CallService(MS_CLIST_CONTACTDOUBLECLICKED,hContact,0); //??
+ // if chat exist, open chat
+ // else create new session
+ end;
+ end
+ else
+ begin
+ if ServiceExists(MS_MSG_CONVERS)<>0 then // Convers compat.
+ CallService(MS_MSG_CONVERS,hContact,0)
+ else
+ CallService(MS_MSG_SENDMESSAGE,hContact,0)
+ end;
+ end;
+end;
+
+procedure SendChatText(pszID:pointer;pszModule:PAnsiChar;pszText:pointer);
+var
+ gcd:TGCDEST;
+ gce:TGCEVENT;
+begin
+ gcd.pszModule:=pszModule;
+ gcd.iType :=GC_EVENT_SENDMESSAGE;
+ gcd.szID.w :=pszID;
+
+ FillChar(gce,SizeOf(TGCEVENT),0);
+ gce.cbSize :=SizeOf(TGCEVENT);
+ gce.pDest :=@gcd;
+ gce.bIsMe :=true;
+ gce.szText.w:=pszText;
+ gce.dwFlags :=GCEF_ADDTOLOG;
+ gce.time :=GetCurrentTime;
+
+ CallServiceSync(MS_GC_EVENT,0,lparam(@gce));
+end;
+
+procedure SendToChat(hContact:TMCONTACT;pszText:PWideChar);
+var
+ gci:TGC_INFO;
+ pszModule:PAnsiChar;
+ i,cnt:integer;
+begin
+ pszModule:=GetContactProto(hContact);
+ cnt:=CallService(MS_GC_GETSESSIONCOUNT,0,lparam(pszModule));
+ i:=0;
+ gci.pszModule:=pszModule;
+ while i<cnt do
+ begin
+ gci.iItem:=i;
+ gci.Flags:=GCF_BYINDEX+GCF_HCONTACT+GCF_ID;
+ CallService(MS_GC_GETINFO,0,lparam(@gci));
+ if gci.hContact=hContact then
+ begin
+ SendChatText(gci.pszID.w,pszModule,pszText);
+ break;
+ end;
+ inc(i);
+ end;
+end;
+
+//----- List of contacts -----
+
+const
+ defformat = '%name% - %uid% (%account%:%group%)';
+
+procedure FillContactList(list:HWND; filter:boolean=true;format:pWideChar=nil);
+var
+ hContact:TMCONTACT;
+ buf:array [0..511] of WideChar;
+ buf1:array [0..63] of WideChar;
+ p:PWideChar;
+ uid:pAnsiChar;
+ ldbv:TDBVARIANT;
+ acc:pAnsiChar;
+ lName,
+ lGroup,
+ lAccount,
+ lUID:boolean;
+begin
+ if format=nil then format:=defformat;
+
+ SendMessage(list,CB_RESETCONTENT,0,0);
+ hContact:=db_find_first();
+
+ lName :=StrPosW(format,'%name%')<>nil;
+ lGroup :=StrPosW(format,'%group%')<>nil;
+ lAccount:=StrPosW(format,'%account%')<>nil;
+ lUID :=StrPosW(format,'%uid%')<>nil;
+
+ while hContact<>0 do
+ begin
+ if ((not filter) and ((IsContactActive(hContact)+1)>=0)) or // + disabled (not deleted)
+ (filter and (IsContactActive(hContact) >=0)) then
+ begin
+ StrCopyW(buf,format);
+ if lName then
+ StrReplaceW(buf,'%name%',
+ PWideChar(CallService(MS_CLIST_GETCONTACTDISPLAYNAME,hContact,GCDNF_UNICODE)));
+
+ if lGroup then
+ begin
+ p:=DBReadUnicode(hContact,strCList,'Group',nil);
+ StrReplaceW(buf,'%group%',p);
+ mFreeMem(p);
+ end;
+
+ if lAccount then
+ begin
+ acc:=GetContactProtoAcc(hContact);
+ StrReplaceW(buf,'%account%',FastAnsiToWideBuf(acc,buf1));
+ end
+ else
+ acc:=nil;
+
+ if lUID then
+ begin
+ if acc=nil then
+ acc:=GetContactProtoAcc(hContact);
+ if IsChat(hContact) then
+ begin
+ p:=DBReadUnicode(hContact,acc,'ChatRoomID');
+ StrReplaceW(buf,'%uid%',p);
+ mFreeMem(p);
+ end
+ else
+ begin
+ uid:=pAnsiChar(CallProtoService(acc,PS_GETCAPS,PFLAG_UNIQUEIDSETTING,0));
+ if uid<>pAnsiChar(CALLSERVICE_NOTFOUND) then
+ begin
+ if DBReadSetting(hContact,acc,uid,@ldbv)=0 then
+ begin
+ case ldbv._type of
+ DBVT_DELETED: p:='[deleted]';
+ DBVT_BYTE : p:=IntToStr(buf1,ldbv.bVal);
+ DBVT_WORD : p:=IntToStr(buf1,ldbv.wVal);
+ DBVT_DWORD : p:=IntToStr(buf1,ldbv.dVal);
+ DBVT_UTF8 : UTF8ToWide(ldbv.szVal.A,p);
+ DBVT_ASCIIZ : AnsiToWide(ldbv.szVal.A,p,CallService(MS_LANGPACK_GETCODEPAGE,0,0));
+ DBVT_WCHAR : p:=ldbv.szVal.W;
+ DBVT_BLOB : p:='blob';
+ end;
+ StrReplaceW(buf,'%uid%',p);
+ if ldbv._type in [DBVT_UTF8,DBVT_ASCIIZ] then
+ mFreeMem(p);
+ DBFreeVariant(@ldbv);
+ end;
+ end;
+ StrReplaceW(buf,'%uid%',nil);
+ end;
+ end;
+
+ SendMessage(list,CB_SETITEMDATA,
+ SendMessageW(list,CB_ADDSTRING,0,tlparam(@buf)),
+ hContact);
+ end;
+ hContact:=db_find_next(hContact);
+ end;
+end;
+
+function FindContact(list:HWND;contact:TMCONTACT):integer;
+var
+ j:integer;
+begin
+ result:=0;
+ j:=SendMessage(list,CB_GETCOUNT,0,0);
+ while j>0 do
+ begin
+ dec(j);
+ if TMCONTACT(SendMessage(list,CB_GETITEMDATA,j,0))=contact then
+ begin
+ result:=j;
+ break;
+ end;
+ end;
+end;
+
+
+end.
diff --git a/plugins/Utils.pas/mirevents.pas b/plugins/Utils.pas/mirevents.pas new file mode 100644 index 0000000000..62ffecb61e --- /dev/null +++ b/plugins/Utils.pas/mirevents.pas @@ -0,0 +1,536 @@ +{$Include compilers.inc}
+unit mirevents;
+
+interface
+
+uses
+ Windows,
+ m_api;
+
+type
+ TBaseEventType = (
+ mtUnknown,
+ mtMessage, mtUrl, mtFile, mtSystem, mtContacts, mtStatus,
+ mtOther);
+
+ PMessageTypes = ^TMessageTypes;
+ TMessageTypes = set of TBaseEventType;
+
+const
+ BaseEventNames: array[TBaseEventType] of PAnsiChar = (
+ 'Unknown',
+ 'Message', // SKINICON_EVENT_MESSAGE
+ 'Link', // SKINICON_EVENT_URL
+ 'File transfer', // SKINICON_EVENT_FILE
+ 'System message', // SKINICON_OTHER_MIRANDA, SKINICON_OTHER_MIRANDAWEB,
+ 'Contacts', // SKINICON_OTHER_ADDCONTACT, SKINICON_OTHER_USERDETAILS
+ 'Status changes', // SKINICON_OTHER_STATUS, SKINICON_STATUS_* (MS_SKIN_LOADPROTOICON)
+ 'Other events (unknown)'
+ );
+
+//----- Event info -----
+
+procedure GetEventInfo (hDBEvent: THANDLE; var EventInfo: TDBEventInfo);
+function GetEventTimestamp(hDBEvent: THANDLE): DWord;
+function GetEventDateTime (hDBEvent: THANDLE): TDateTime;
+function GetEventCoreText (const EventInfo: TDBEventInfo; CP: integer = CP_ACP): PWideChar;
+
+//----- Event check -----
+
+function IsIncomingEvent(const EventInfo: TDBEventInfo):boolean; overload;
+function IsIncomingEvent(hDBEvent: THANDLE):boolean; overload;
+function IsOutgoingEvent(const EventInfo: TDBEventInfo):boolean; overload;
+function IsOutgoingEvent(hDBEvent: THANDLE):boolean; overload;
+function IsReadedEvent (const EventInfo: TDBEventInfo):boolean; overload;
+function IsReadedEvent (hDBEvent: THANDLE):boolean; overload;
+
+function GetEventBaseType(EventInfo: TDBEventInfo): TBaseEventType; overload;
+function GetEventBaseType(hDBEvent : THANDLE ): TBaseEventType; overload;
+
+//----- Custom events processing -----
+
+//procedure ReadEvent (hDBEvent: THANDLE; var EventInfo: TDBEventInfo; UseCP: Cardinal = CP_ACP);
+//function GetEventName(const Hi: THistoryItem):pAnsiChar;
+
+function GetEventText(hDBEvent: THANDLE ; custom:boolean; cp:integer=CP_ACP):PWideChar; overload;
+function GetEventText(const EventInfo: TDBEventInfo; custom:boolean; cp:integer=CP_ACP):PWideChar; overload;
+
+
+implementation
+
+uses
+ common,
+ datetime;
+
+//----- Event info -----
+
+procedure GetEventInfo(hDBEvent: THANDLE; var EventInfo: TDBEventInfo);
+var
+ BlobSize: integer;
+begin
+ ZeroMemory(@EventInfo, SizeOf(EventInfo));
+ EventInfo.cbSize := SizeOf(EventInfo);
+ BlobSize := db_event_getBlobSize(hDBEvent);
+ if BlobSize > 0 then
+ begin
+ mGetMem(EventInfo.pBlob,BlobSize+2); // cheat, for possible crash avoid
+ end
+ else
+ BlobSize := 0;
+ EventInfo.cbBlob := BlobSize;
+ if db_event_get(hDBEvent, @EventInfo) = 0 then
+ begin
+ EventInfo.cbBlob := BlobSize;
+ if BlobSize > 0 then
+ begin
+ pAnsiChar(EventInfo.pBlob)[BlobSize ]:=#0;
+ pAnsiChar(EventInfo.pBlob)[BlobSize+1]:=#0;
+ end;
+ end
+ else
+ EventInfo.cbBlob := 0;
+end;
+
+function GetEventCoreText(const EventInfo: TDBEventInfo; CP: integer = CP_ACP): PWideChar;
+var
+ dbegt: TDBEVENTGETTEXT;
+ msg: pWideChar;
+begin
+ dbegt.dbei := @EventInfo;
+ dbegt.datatype := DBVT_WCHAR;
+ dbegt.codepage := CP;
+
+ msg := pWideChar(CallService(MS_DB_EVENT_GETTEXT,0,LPARAM(@dbegt)));
+
+ result := AdjustLineBreaks(msg);
+ result := rtrimw(result);
+
+ mir_free(msg);
+end;
+
+//----- Info functions (no blob required) -----
+var
+ RecentEvent: THANDLE = 0;
+ RecentEventInfo: TDBEventInfo;
+
+procedure CheckRecent(hDBEvent: THANDLE);
+begin
+ if RecentEvent <> hDBEvent then
+ begin
+ ZeroMemory(@RecentEventInfo, SizeOf(RecentEventInfo));
+ RecentEventInfo.cbSize := SizeOf(RecentEventInfo);
+ RecentEventInfo.cbBlob := 0;
+ db_event_get(hDBEvent, @RecentEventInfo);
+ RecentEvent := hDBEvent;
+ end;
+end;
+
+function GetEventTimestamp(hDBEvent: THANDLE): DWord;
+begin
+ CheckRecent(hDBEvent);
+ Result := RecentEventInfo.timestamp;
+end;
+
+function GetEventDateTime(hDBEvent: THANDLE): TDateTime;
+begin
+ Result := TimestampToDateTime(GetEventTimestamp(hDBEvent));
+end;
+
+//----- Event check -----
+
+function IsIncomingEvent(const EventInfo: TDBEventInfo):boolean;
+ {$IFDEF AllowInline}inline;{$ENDIF}
+begin
+ Result:=(EventInfo.flags and DBEF_SENT) = 0
+end;
+
+function IsIncomingEvent(hDBEvent: THANDLE):boolean;
+begin
+ CheckRecent(hDBEvent);
+ Result:=(RecentEventInfo.flags and DBEF_SENT) = 0
+end;
+
+function IsOutgoingEvent(const EventInfo: TDBEventInfo):boolean;
+ {$IFDEF AllowInline}inline;{$ENDIF}
+begin
+ result:=(EventInfo.flags and DBEF_SENT) <> 0;
+end;
+
+function IsOutgoingEvent(hDBEvent: THANDLE):boolean;
+begin
+ CheckRecent(hDBEvent);
+ result:=(RecentEventInfo.flags and DBEF_SENT) <> 0;
+end;
+
+function IsReadedEvent(const EventInfo: TDBEventInfo):boolean;
+ {$IFDEF AllowInline}inline;{$ENDIF}
+begin
+ result:=(EventInfo.flags and DBEF_READ) <> 0;
+end;
+
+function IsReadedEvent(hDBEvent: THANDLE):boolean;
+begin
+ CheckRecent(hDBEvent);
+ result:=(RecentEventInfo.flags and DBEF_READ) <> 0;
+end;
+
+//----- Not pure miranda functions -----
+
+type
+ TEventTableItem = record
+ EventType : Word;
+ MessageType : TBaseEventType;
+ end;
+
+var
+ BuiltinEventTable: array[0..6] of TEventTableItem = (
+ // must be the first item in array for unknown events
+ (EventType: MaxWord; MessageType: mtOther),
+ // events definitions
+ (EventType: EVENTTYPE_MESSAGE; MessageType: mtMessage),
+ (EventType: EVENTTYPE_FILE; MessageType: mtFile),
+ (EventType: EVENTTYPE_URL; MessageType: mtUrl),
+ (EventType: EVENTTYPE_AUTHREQUEST; MessageType: mtSystem),
+ (EventType: EVENTTYPE_ADDED; MessageType: mtSystem),
+ (EventType: EVENTTYPE_CONTACTS; MessageType: mtContacts)
+ );
+
+function GetEventBaseType(EventInfo: TDBEventInfo): TBaseEventType;
+var
+ i: Integer;
+ EventIndex: Integer;
+begin
+ EventIndex := 0;
+
+ if EventInfo.szModule = nil then
+ begin
+ for i := 1 to High(BuiltinEventTable) do
+ if BuiltinEventTable[i].EventType = EventInfo.EventType then
+ begin
+ EventIndex := i;
+ break;
+ end;
+ end;
+
+ Result := BuiltinEventTable[EventIndex].MessageType;
+end;
+
+function GetEventBaseType(hDBEvent: THANDLE): TBaseEventType;
+begin
+ CheckRecent(hDBEvent);
+ Result := GetEventBaseType(RecentEventInfo);
+end;
+
+//----- Custom events processing -----
+
+
+function _WideCharType(WC: WideChar; dwInfoType: Cardinal): Word;
+begin
+ GetStringTypeExW(GetThreadLocale, dwInfoType, PWideChar(@WC), 1, Result)
+end;
+
+function IsWideCharAlphaNumeric(WC: WideChar): Boolean;
+begin
+ Result := (_WideCharType(WC, CT_CTYPE1) and (C1_ALPHA + C1_DIGIT)) <> 0;
+end;
+
+const
+ UrlPrefix: array[0..1] of pWideChar = (
+ 'www.',
+ 'ftp.');
+
+const
+ UrlProto: array[0..12] of record
+ Proto: PWideChar;
+ Idn : Boolean;
+ end = (
+ (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;));
+
+function TextHasUrls(Text: pWideChar): Boolean;
+var
+ i,len: Integer;
+ buf,pPos: PWideChar;
+begin
+ Result := False;
+ len := StrLenW(Text);
+ if len=0 then exit;
+
+ // search in URL Prefixes like "www"
+ // make Case-insensitive??
+
+ for i := 0 to High(UrlPrefix) do
+ begin
+ pPos := StrPosW(Text, UrlPrefix[i]);
+ if not Assigned(pPos) then
+ continue;
+ Result := ((uint_ptr(pPos) = uint_ptr(Text)) or not IsWideCharAlphaNumeric((pPos - 1)^)) and
+ IsWideCharAlphaNumeric((pPos + StrLenW(UrlPrefix[i]))^);
+ if Result then
+ exit;
+ end;
+
+ // search in url protos like "http:/"
+
+ if StrPosW(Text,':/') = nil then exit;
+
+ StrDupW(buf,Text);
+
+ CharLowerBuffW(buf,len);
+ for i := 0 to High(UrlProto) do
+ begin
+ pPos := StrPosW(buf, UrlProto[i].proto);
+ if not Assigned(pPos) then
+ continue;
+ Result := ((uint_ptr(pPos) = uint_ptr(buf)) or
+ not IsWideCharAlphaNumeric((pPos - 1)^));
+ if Result then
+ break;
+ end;
+ mFreeMem(buf);
+end;
+
+
+// reads event from hDbEvent handle
+// reads all THistoryItem fields
+// *EXCEPT* Proto field. Fill it manually, plz
+(*
+procedure ReadEvent(hDBEvent: THANDLE; var hi: THistoryItem; UseCP: Cardinal = CP_ACP);
+var
+ EventInfo: TDBEventInfo;
+ EventIndex: integer;
+ Handled: Boolean;
+begin
+ ZeroMemory(@hi,SizeOf(hi));
+ hi.Height := -1;
+ GetEventInfo(hDBEvent, EventInfo);
+
+ hi.Module := EventInfo.szModule; {*}
+ hi.proto := nil;
+ hi.Time := EventInfo.Timestamp; {*}
+ hi.IsRead := Boolean(EventInfo.flags and DBEF_READ); {*}
+ hi.MessageType := GetMessageType(EventInfo, EventIndex); {!}
+ hi.CodePage := UseCP; {?}
+ // enable autoRTL feature
+ if Boolean(EventInfo.flags and DBEF_RTL) then
+ hi.RTLMode := hppRTLEnable; {*}
+
+ hi.Text := GetEventCoreText(EventInfo, UseCP);
+{!!
+ if hi.Text = nil then
+ EventTable[EventIndex].TextFunction(EventInfo, hi);
+}
+ hi.Text := AdjustLineBreaks(hi.Text);
+ hi.Text := rtrimw(hi.Text);
+
+ if hi.MessageType.code=mtMessage then
+ if TextHasUrls(hi.Text) then
+ begin
+ hi.MessageType.code:=mtUrl;
+ end;
+
+ mFreeMem(EventInfo.pBlob);
+end;
+*)
+(*
+function GetEventName(const Hi: THistoryItem):pAnsiChar;
+var
+ MesType: THppMessageType;
+ mt: TBuiltinMessageType;
+ etd: PDBEVENTTYPEDESCR;
+begin
+ MesType := Hi.MessageType;
+ for mt := Low(BuiltinEventNames) to High(BuiltinEventNames) do
+ begin
+ if MesType.code = mt then
+ begin
+ Result := BuiltinEventNames[mt];
+ exit;
+ end;
+ end;
+
+ etd := Pointer(CallService(MS_DB_EVENT_GETTYPE, WPARAM(Hi.Module), LPARAM(Hi.MessageType.event)));
+ if etd = nil then
+ begin
+ Result := BuiltinEventNames[mtOther];
+ end
+ else
+ Result := etd.descr;
+
+end;
+*)
+
+type
+ TCustomEvent = record
+ Module : PAnsiChar;
+ EventType : Word;
+ MessageType : TBaseEventType;
+ end;
+const
+ CustomEventTable: array [0..4] of TCustomEvent = (
+ (Module:'WATrack' ; EventType:EVENTTYPE_WAT_REQUEST {; MessageType:}),
+ (Module:'WATrack' ; EventType:EVENTTYPE_WAT_ANSWER {; MessageType:}),
+ (Module:'WATrack' ; EventType:EVENTTYPE_WAT_MESSAGE {; MessageType:}),
+ (Module:'NewStatusNotify'; EventType:EVENTTYPE_STATUSCHANGE {; MessageType:}),
+ (Module:'Nudge' ; EventType:1 {; MessageType:})
+// (Module:nil; EventType:EVENTTYPE_AVATAR_CHANGE {; MessageType:}),
+// (Module:nil; EventType:ICQEVENTTYPE_MISSEDMESSAGE {; MessageType:}), ICQ_DB_GETEVENTTEXT_MISSEDMESSAGE
+// (Module:nil; EventType:ICQEVENTTYPE_EMAILEXPRESS {; MessageType:}),
+// (Module:nil; EventType:ICQEVENTTYPE_WEBPAGER {; MessageType:}),
+// (Module:nil; EventType:EVENTTYPE_SMS {; MessageType:}),
+// (Module:nil; EventType:EVENTTYPE_SMSCONFIRMATION {; MessageType:}),
+// (Module:nil; EventType:TWITTER_DB_EVENT_TYPE_TWEET {; MessageType:}),
+ );
+
+//----- Support functions -----
+
+//----- Custom standard event text -----
+
+function GetEventTextForUrl(const EventInfo: TDBEventInfo):PWideChar;
+var
+ pc:PAnsiChar;
+ len,lend,lenf:integer;
+
+ url,desc: PAnsiChar;
+ urlw: PWideChar;
+// cp: Cardinal;
+begin
+ //blob is: URL(ASCII) or URL(ASCIIZ),description(ASCIIZ)
+ len := StrLen(PAnsiChar(EventInfo.pBlob));
+ if (integer(EventInfo.cbBlob)-len)>2 then // possible have description
+ begin
+ desc := PAnsiChar(EventInfo.pBlob) + len + 1;
+ lend := StrLen(desc);
+ end
+ else
+ begin
+ desc := nil;
+ lend := 0;
+ end;
+
+ lenf := len;
+ if lend > 0 then
+ inc(lenf, lend + 2 + 1); // #13#10 + #0
+ mGetMem(url, lenf);
+ pc := StrCopyE(url, PAnsiChar(EventInfo.pBlob));
+ if lend > 0 then
+ begin
+ pc^ := #13; inc(pc);
+ pc^ := #10; inc(pc);
+ StrCopy(pc,desc);
+ end;
+
+ if (EventInfo.flags and DBEF_UTF)<>0 then
+ UTF8ToWide(url,urlw)
+ else
+ AnsiToWide(url,urlw); // with proper codepage must be
+ mFreeMem(url);
+ result := FormatStrW('URL: %s', [urlw]);
+ mFreeMem(urlw);
+// hi.Extended := PAnsiChar(EventInfo.pBlob);
+end;
+
+function GetEventTextForFile(const EventInfo: TDBEventInfo):PWideChar;
+var
+ pc,filea,fname,desc:PAnsiChar;
+ format, filew:PWideChar;
+ len:integer;
+// cp: Cardinal;
+begin
+ //blob is: sequenceid(DWORD),filename(ASCIIZ),description(ASCIIZ)
+ fname:=PAnsiChar(EventInfo.pBlob) + SizeOf(DWORD);
+ len :=StrLen(fname);
+ desc :=fname + len + 1;
+ if desc^ <> #0 then
+ inc(len, 2 + StrLen(desc)); // +#13#10
+ mGetMem(filea, len + 1); // +#0
+ pc := StrCopyE(filea, fname);
+ if desc^ <> #0 then
+ begin
+ pc^ := #13; inc(pc);
+ pc^ := #10; inc(pc);
+ StrCopy(pc,desc);
+ end;
+
+ if (EventInfo.flags and DBEF_SENT) <> 0 then
+ format := 'Outgoing file transfer: %s'
+ else
+ format := 'Incoming file transfer: %s';
+
+ if (EventInfo.flags and DBEF_UTF)<>0 then
+ UTF8ToWide(filea,filew)
+ else
+ AnsiToWide(filea,filew); // with proper codepage must be
+ mFreeMem(filea);
+ result := FormatStrW(format, [filew]);
+ mFreeMem(filew);
+// Hi.Extended := PAnsiChar(EventInfo.pBlob) + SizeOf(DWORD);
+end;
+
+
+function GetEventText(const EventInfo: TDBEventInfo; custom:boolean; cp:integer=CP_ACP):PWideChar;
+begin
+ result:=nil;
+ if not custom then
+ begin
+ result:=GetEventCoreText(EventInfo);
+ // ok if registered with text service
+ // ok if have text in blob
+ end;
+ if (result = nil) or custom then
+ begin
+ end;
+end;
+
+function GetEventText(hDBEvent: THANDLE; custom:boolean; cp:integer=CP_ACP):PWideChar;
+var
+ EventInfo: TDBEventInfo;
+begin
+ GetEventInfo(hDBEvent, EventInfo);
+ result:=GetEventText(EventInfo, custom);
+end;
+
+function GetStandardEventIcon(const EventInfo: TDBEventInfo):HICON;
+var
+ idx:integer;
+begin
+ case GetEventBaseType(EventInfo) of
+ mtMessage : idx:=SKINICON_EVENT_MESSAGE;
+ mtUrl : idx:=SKINICON_EVENT_URL;
+ mtFile : idx:=SKINICON_EVENT_FILE;
+// mtSystem : idx:=;
+// mtContacts: idx:=;
+ mtStatus : begin
+ result:=0;
+ exit;
+ end;
+ else
+ idx:=0;
+ end;
+ result:=CallService(MS_SKIN_LOADICON,idx,0);
+{
+ case EventInfo.eventType of
+ EVENTTYPE_MESSAGE: idx:=SKINICON_EVENT_MESSAGE;
+ EVENTTYPE_FILE: idx:=SKINICON_EVENT_FILE;
+ EVENTTYPE_URL: idx:=SKINICON_EVENT_URL;
+ EVENTTYPE_AUTHREQUEST: idx:=SKINICON_AUTH_REQUEST;
+ EVENTTYPE_ADDED: idx:=SKINICON_AUTH_ADD;
+ EVENTTYPE_CONTACTS: idx:=
+ EVENTTYPE_SMS: idx:=SKINICON_OTHER_SMS;
+ else
+ end;
+}
+end;
+
+end.
diff --git a/plugins/Utils.pas/mirutils.pas b/plugins/Utils.pas/mirutils.pas index 918f615390..976ee5bca1 100644 --- a/plugins/Utils.pas/mirutils.pas +++ b/plugins/Utils.pas/mirutils.pas @@ -35,26 +35,6 @@ function ParseVarString(astr:pAnsiChar;aContact:TMCONTACT=0;extra:pAnsiChar=nil) function ParseVarString(astr:pWideChar;aContact:TMCONTACT=0;extra:pWideChar=nil):pWideChar; overload;
function ShowVarHelp(dlg:HWND;id:integer=0):integer;
-function IsChat(hContact:TMCONTACT):bool;
-procedure SendToChat(hContact:TMCONTACT;pszText:PWideChar);
-
-function LoadContact(group,setting:PAnsiChar):TMCONTACT;
-function SaveContact(hContact:TMCONTACT;group,setting:PAnsiChar):integer;
-
-function SetCListSelContact(hContact:TMCONTACT):TMCONTACT;
-function GetCListSelContact:TMCONTACT; {$IFDEF DELPHI_10_UP}inline;{$ENDIF}
-function GetContactProtoAcc(hContact:TMCONTACT):PAnsiChar;
-function IsMirandaUser(hContact:TMCONTACT):integer; // >0=Miranda; 0=Not miranda; -1=unknown
-procedure ShowContactDialog(hContact:TMCONTACT;DblClk:boolean=true;anystatus:boolean=true);
-function FindContactHandle(proto:pAnsiChar;const dbv:TDBVARIANT;is_chat:boolean=false):TMCONTACT;
-function WndToContact(wnd:HWND):TMCONTACT; overload;
-function WndToContact:TMCONTACT; overload;
-function GetContactStatus(hContact:TMCONTACT):integer;
-// -2 - deleted account, -1 - disabled account, 0 - hidden
-// 1 - metacontact, 2 - submetacontact, positive - active
-// proto - ASSIGNED buffer
-function IsContactActive(hContact:TMCONTACT;proto:pAnsiChar=nil):integer;
-
function CreateGroupW(name:pWideChar;hContact:TMCONTACT):integer;
function MakeGroupMenu(idxfrom:integer=100):HMENU;
@@ -79,7 +59,7 @@ implementation uses
Messages,
dbsettings,freeimage,
- common,io,syswin;
+ common,io;
const
clGroup = 'Group';
@@ -165,13 +145,6 @@ begin result:=MirCP;
end;
-function IsChat(hContact:TMCONTACT):bool;
-begin
- result:=DBReadByte(hContact,
- PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO,hContact,0)),
- 'ChatRoom',0)=1;
-end;
-
function isVarsInstalled:bool;
{$IFDEF AllowInline}inline;{$ENDIF}
begin
@@ -306,168 +279,6 @@ begin end;
end;
-function GetContactProtoAcc(hContact:TMCONTACT):PAnsiChar;
-begin
- if ServiceExists(MS_PROTO_GETCONTACTBASEACCOUNT)<>0 then
- result:=PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEACCOUNT,hContact,0))
- else
- result:=PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO,hContact,0));
-end;
-
-function IsMirandaUser(hContact:TMCONTACT):integer; // >0=Miranda; 0=Not miranda; -1=unknown
-var
- sz:PAnsiChar;
-begin
- sz:=PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO,hContact,0));
- sz:=DBReadString(hContact,sz,'MirVer');
- if sz<>nil then
- begin
- result:=int_ptr(StrPos(sz,'Miranda'));
- mFreeMem(sz);
- end
- else
- result:=-1;
-end;
-
-function SetCListSelContact(hContact:TMCONTACT):TMCONTACT;
-var
- wnd:HWND;
-begin
- wnd:=CallService(MS_CLUI_GETHWNDTREE,0,0);
- result:=hContact;
-// hContact:=SendMessage(wnd,CLM_FINDCONTACT ,hContact,0);
- SendMessage(wnd,CLM_SELECTITEM ,hContact,0);
-// SendMessage(wnd,CLM_ENSUREVISIBLE,hContact,0);
-end;
-
-function GetCListSelContact:TMCONTACT;
-begin
- result:=SendMessageW(CallService(MS_CLUI_GETHWNDTREE,0,0),CLM_GETSELECTION,0,0);
-end;
-
-function LoadContact(group,setting:PAnsiChar):TMCONTACT;
-var
- p,proto:pAnsiChar;
- section:array [0..63] of AnsiChar;
- dbv:TDBVARIANT;
- is_chat:boolean;
-begin
- p:=StrCopyE(section,setting);
- StrCopy(p,opt_cproto); proto :=DBReadString(0,group,section);
- StrCopy(p,opt_ischat); is_chat:=DBReadByte (0,group,section,0)<>0;
- StrCopy(p,opt_cuid );
- if is_chat then
- dbv.szVal.W:=DBReadUnicode(0,group,section,@dbv)
- else
- DBReadSetting(0,group,section,@dbv);
-
- result:=FindContactHandle(proto,dbv,is_chat);
-
- mFreeMem(proto);
- if not is_chat then
- DBFreeVariant(@dbv)
- else
- mFreeMem(dbv.szVal.W);
-end;
-
-function SaveContact(hContact:TMCONTACT;group,setting:PAnsiChar):integer;
-var
- p,proto,uid:pAnsiChar;
- cws:TDBVARIANT;
- section:array [0..63] of AnsiChar;
- pw:pWideChar;
- is_chat:boolean;
-begin
- result:=0;
- proto:=GetContactProtoAcc(hContact);
- if proto<>nil then
- begin
- p:=StrCopyE(section,setting);
- is_chat:=IsChat(hContact);
- if is_chat then
- begin
- pw:=DBReadUnicode(hContact,proto,'ChatRoomID');
- StrCopy(p,opt_cuid); DBWriteUnicode(0,group,section,pw);
- mFreeMem(pw);
- result:=1;
- end
- else
- begin
- uid:=pAnsiChar(CallProtoService(proto,PS_GETCAPS,PFLAG_UNIQUEIDSETTING,0));
- if uid<>pAnsiChar(CALLSERVICE_NOTFOUND) then
- begin
- if DBReadSetting(hContact,proto,uid,@cws)=0 then
- begin
- StrCopy(p,opt_cuid); DBWriteSetting(0,group,section,@cws);
- DBFreeVariant(@cws);
- result:=1;
- end;
- end;
- end;
- if result<>0 then
- begin
- StrCopy(p,opt_cproto); DBWriteString(0,group,section,proto);
- StrCopy(p,opt_ischat); DBWriteByte (0,group,section,ord(is_chat));
- end;
- end;
-end;
-
-function WndToContact(wnd:HWND):TMCONTACT; overload;
-var
- hContact:TMCONTACT;
- mwid:TMessageWindowInputData;
- mwod:TMessageWindowOutputData;
-begin
- wnd:=GetParent(wnd); //!!
- hContact:=db_find_first();
- with mwid do
- begin
- cbSize:=SizeOf(mwid);
- uFlags:=MSG_WINDOW_UFLAG_MSG_BOTH;
- end;
- mwod.cbSize:=SizeOf(mwod);
- while hContact<>0 do
- begin
- mwid.hContact:=hContact;
- if CallService(MS_MSG_GETWINDOWDATA,wparam(@mwid),lparam(@mwod))=0 then
- begin
- if {((mwod.uState and MSG_WINDOW_STATE_FOCUS)<>0) and} (mwod.hwndWindow=wnd) then
- begin
- result:=mwid.hContact;
- exit;
- end
- end;
- hContact:=db_find_next(hContact);
- end;
- result:=0;
-end;
-
-function WndToContact:TMCONTACT; overload;
-var
- wnd:HWND;
-begin
- wnd:=GetFocus;
- if wnd=0 then
- wnd:=WaitFocusedWndChild(GetForegroundWindow);
- if wnd<>0 then
- result:=WndToContact(wnd)
- else
- result:=0;
- if result=0 then
- result:=GetCListSelContact;
-end;
-
-function GetContactStatus(hContact:TMCONTACT):integer;
-var
- szProto:PAnsiChar;
-begin
- szProto:=PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO,hContact,0));
- if szProto=NIL then
- result:=ID_STATUS_OFFLINE
- else
- result:=DBReadWord(hContact,szProto,'Status',ID_STATUS_OFFLINE);
-end;
-
function CheckPath(filename,profilepath,path:PAnsiChar):PAnsiChar;
var
buf:array [0..511] of AnsiChar;
@@ -547,188 +358,6 @@ begin end;
end;
-procedure ShowContactDialog(hContact:TMCONTACT;DblClk:boolean=true;anystatus:boolean=true);
-var
- pc:array [0..127] of AnsiChar;
-begin
-{
-CallService(MS_CLIST_CONTACTDOUBLECLICKED,hContact,0);
-}
- if (hContact<>0) and (CallService(MS_DB_CONTACT_IS,hContact,0)<>0) then
- begin
- if StrCopy(pc,PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO,hContact,0)))<>nil then
- if DblClk or (DBReadByte(hContact,pc,'ChatRoom',0)=1) then // chat room
- begin
- if not anystatus then
- begin
- StrCat(pc,PS_GETSTATUS);
- anystatus:=(CallService(pc,0,0)<>ID_STATUS_OFFLINE);
- end;
- if anystatus then
- begin
- CallService(MS_CLIST_CONTACTDOUBLECLICKED,hContact,0); //??
- // if chat exist, open chat
- // else create new session
- end;
- end
- else
- begin
- if ServiceExists(MS_MSG_CONVERS)<>0 then // Convers compat.
- CallService(MS_MSG_CONVERS,hContact,0)
- else
- CallService(MS_MSG_SENDMESSAGE,hContact,0)
- end;
- end;
-end;
-
-procedure SendChatText(pszID:pointer;pszModule:PAnsiChar;pszText:pointer);
-var
- gcd:TGCDEST;
- gce:TGCEVENT;
-begin
- gcd.pszModule:=pszModule;
- gcd.iType :=GC_EVENT_SENDMESSAGE;
- gcd.szID.w :=pszID;
-
- FillChar(gce,SizeOf(TGCEVENT),0);
- gce.cbSize :=SizeOf(TGCEVENT);
- gce.pDest :=@gcd;
- gce.bIsMe :=true;
- gce.szText.w:=pszText;
- gce.dwFlags :=GCEF_ADDTOLOG;
- gce.time :=GetCurrentTime;
-
- CallServiceSync(MS_GC_EVENT,0,lparam(@gce));
-end;
-
-procedure SendToChat(hContact:TMCONTACT;pszText:PWideChar);
-var
- gci:TGC_INFO;
- pszModule:PAnsiChar;
- i,cnt:integer;
-begin
- pszModule:=PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO,hContact,0));
- cnt:=CallService(MS_GC_GETSESSIONCOUNT,0,lparam(pszModule));
- i:=0;
- gci.pszModule:=pszModule;
- while i<cnt do
- begin
- gci.iItem:=i;
- gci.Flags:=GCF_BYINDEX+GCF_HCONTACT+GCF_ID;
- CallService(MS_GC_GETINFO,0,lparam(@gci));
- if gci.hContact=hContact then
- begin
- SendChatText(gci.pszID.w,pszModule,pszText);
- break;
- end;
- inc(i);
- end;
-end;
-
-function FindContactHandle(proto:pAnsiChar;const dbv:TDBVARIANT;is_chat:boolean=false):TMCONTACT;
-var
- uid:pAnsiChar;
- ldbv:TDBVARIANT;
- hContact:TMCONTACT;
- pw:pWideChar;
-begin
- result:=0;
- uid:=nil;
- if not is_chat then
- begin
- uid:=pAnsiChar(CallProtoService(proto,PS_GETCAPS,PFLAG_UNIQUEIDSETTING,0));
- if uid=pAnsiChar(CALLSERVICE_NOTFOUND) then exit;
- end;
-
- hContact:=db_find_first();
- while hContact<>0 do
- begin
- if is_chat then
- begin
- if IsChat(hContact) then
- begin
- pw:=DBReadUnicode(hContact,proto,'ChatRoomID');
- if StrCmpW(pw,dbv.szVal.W)=0 then result:=hContact;
- mFreeMem(pw);
- end
- end
- else
- begin
- if DBReadSetting(hContact,proto,uid,@ldbv)=0 then
- begin
- if dbv._type=ldbv._type then
- begin
- case dbv._type of
-// DBVT_DELETED: ;
- DBVT_BYTE : if dbv.bVal=ldbv.bVal then result:=hContact;
- DBVT_WORD : if dbv.wVal=ldbv.wVal then result:=hContact;
- DBVT_DWORD : if dbv.dVal=ldbv.dVal then result:=hContact;
- DBVT_UTF8,
- DBVT_ASCIIZ : if StrCmp (dbv.szVal.A,ldbv.szVal.A)=0 then result:=hContact;
- DBVT_WCHAR : if StrCmpW(dbv.szVal.W,ldbv.szVal.W)=0 then result:=hContact;
- DBVT_BLOB : begin
- if dbv.cpbVal = ldbv.cpbVal then
- begin
- if CompareMem(dbv.pbVal,ldbv.pbVal,dbv.cpbVal) then
- result:=hContact;
- end;
- end;
- end;
- end;
- DBFreeVariant(@ldbv);
- end;
- end;
- // added 2011.04.20
- if result<>0 then break;
- hContact:=db_find_next(hContact);
- end;
-end;
-
-function IsContactActive(hContact:TMCONTACT;proto:pAnsiChar=nil):integer;
-var
- p:PPROTOACCOUNT;
- name: array [0..31] of AnsiChar;
-begin
-
- if db_get_static(hContact,'Protocol','p',@name,SizeOf(name))=0 then
- begin
- result:=0;
-
- if ServiceExists(MS_PROTO_GETACCOUNT)<>0 then
- begin
- p:=PPROTOACCOUNT(CallService(MS_PROTO_GETACCOUNT,0,lparam(@name)));
- if p=nil then
- result:=-2 // deleted
- else if (not p^.bIsEnabled) or p^.bDynDisabled then
- result:=-1; // disabled
- end
- else
- begin
- if CallService(MS_PROTO_ISPROTOCOLLOADED,0,lparam(@name))=0 then
- result:=-1;
- end;
-
- if (result=0) and (DBReadByte(hContact,strCList,'Hidden',0)=0) then
- begin
- result:=255;
- if db_mc_getMeta(hContact)<>0 then
- result:=2;
- if StrCmp(
- PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO,hContact,0)),
- META_PROTO)=0 then
- result:=1;
- end;
- if proto<>nil then
- StrCopy(proto,@name);
- end
- else
- begin
- result:=-2;
- if proto<>nil then
- proto^:=#0;
- end;
-end;
-
// Import plugin function adaptation
function CreateGroupW(name:pWideChar;hContact:TMCONTACT):integer;
var
diff --git a/plugins/Utils.pas/rtfole.pas b/plugins/Utils.pas/rtfole.pas new file mode 100644 index 0000000000..1e646f53c1 --- /dev/null +++ b/plugins/Utils.pas/rtfole.pas @@ -0,0 +1,560 @@ +unit rtfole;
+
+interface
+
+uses
+ Windows, RichEdit, ActiveX,
+ tlb_richedit;
+
+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}';
+
+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
+
+type
+ 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;
+{$IFDEF FPC}
+ function SetData(const formatetc: TFormatEtc; const medium: TStgMedium; fRelease: BOOL): HResult; stdcall;
+ function EnumFormatEtc(dwDirection: dword; out enumFormatEtc: IEnumFormatEtc): HResult; stdcall;
+ function DAdvise(const formatetc: TFormatEtc; advf: dword; const advSink: IAdviseSink; out dwConnection: dword): HResult; stdcall;
+ function DUnadvise(dwConnection: dword): HResult; stdcall;
+{$ELSE}
+ 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;
+{$ENDIF}
+ function EnumDAdvise(out enumAdvise: IEnumStatData): HResult; stdcall;
+ public
+ destructor Destroy; override;
+ function InsertBitmap(Wnd: HWND; Bitmap: hBitmap; cp: Cardinal): Boolean;
+ end;
+
+ 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;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ function QueryInterface(
+ {$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} 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;
+
+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 InitRichEditLibrary;
+
+const
+ RichEditClass:pAnsiChar = nil;
+
+implementation
+
+{
+type
+ EOleError = class(Exception);
+
+const
+ SOleError = 'OLE2 error occured. Error code: %.8xH';
+}
+{ OLE Specific }
+
+function FailedHR(hr: HResult): Boolean;
+begin
+ Result := Failed(hr);
+end;
+
+function OleErrorMsg(ErrorCode: HResult): String;
+begin
+ Result:='';
+//!! 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);
+// if not Succeeded(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;
+
+{ TRichEditOleCallback }
+
+constructor TRichEditOleCallback.Create;
+begin
+ inherited Create;
+end;
+
+destructor TRichEditOleCallback.Destroy;
+begin
+ inherited Destroy;
+end;
+
+function TRichEditOleCallback.QueryInterface(
+{$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid: TGUID; out Obj): HResult; stdcall;
+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;
+{
+ OleCheck(CreateILockBytesOnHGlobal(0, True, LockBytes));
+ OleCheck(StgCreateDocfileOnILockBytes(LockBytes,
+ STGM_READWRITE or STGM_SHARE_EXCLUSIVE or STGM_CREATE, 0, Result));
+}
+end;
+
+function TRichEditOleCallback.GetInPlaceContext(
+ out Frame: IOleInPlaceFrame; out Doc: IOleInPlaceUIWindow;
+ lpFrameInfo: POleInPlaceFrameInfo): HResult;
+begin
+ Result := E_NOTIMPL;
+{
+ Doc := nil; //Document window is same as frame window
+ FrameInfo.hWndFrame := 0; // Form.Handle;
+ FrameInfo.fMDIApp := False;
+ FrameInfo.hAccel := 0;
+ FrameInfo.cAccelEntries := 0;
+}
+end;
+
+function TRichEditOleCallback.QueryInsertObject(const clsid: TCLSID; const stg: IStorage; cp: Longint): HResult;
+begin
+ Result := NOERROR;
+end;
+
+const
+ OLECLOSE_NOSAVE = 1;
+
+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;
+{
+ Menu := 0
+}
+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 }
+
+{$IFDEF FPC}
+function TImageDataObject.DAdvise(const formatetc: TFormatEtc; advf: dword; const advSink: IAdviseSink; out dwConnection: dword): HResult;
+{$ELSE}
+function TImageDataObject.DAdvise(const formatetc: TFormatEtc; advf: longint; const advSink: IAdviseSink; out dwConnection: longint): HResult;
+{$ENDIF}
+begin
+ Result := E_NOTIMPL;
+end;
+
+{$IFDEF FPC}
+function TImageDataObject.DUnadvise(dwConnection: dword): HResult;
+{$ELSE}
+function TImageDataObject.DUnadvise(dwConnection: longint): HResult;
+{$ENDIF}
+begin
+ Result := E_NOTIMPL;
+end;
+
+function TImageDataObject.EnumDAdvise(out enumAdvise: IEnumStatData): HResult;
+begin
+ Result := E_NOTIMPL;
+end;
+
+{$IFDEF FPC}
+function TImageDataObject.EnumFormatEtc(dwDirection: dword; out enumFormatEtc: IEnumFormatEtc): HResult;
+{$ELSE}
+function TImageDataObject.EnumFormatEtc(dwDirection: longint; out enumFormatEtc: IEnumFormatEtc): HResult;
+{$ENDIF}
+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);
+ inherited;
+end;
+
+function TImageDataObject.GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium): HResult;
+begin
+ FillChar(medium,SizeOf(medium),0);
+ medium.tymed := TYMED_GDI;
+ medium.hBitmap := FMedium.hBitmap;
+(*
+{$IFDEF FPC}
+ medium.punkForRelease := nil;
+{$ELSE}
+ medium.unkForRelease := nil;
+{$ENDIF}
+*)
+ Result:=S_OK;
+end;
+
+{$IFDEF FPC}
+function TImageDataObject.SetData(const formatetc: TFormatEtc; const medium: TStgMedium; fRelease: BOOL): HResult;
+{$ELSE}
+function TImageDataObject.SetData(const formatetc: TFormatEtc; var medium: TStgMedium; fRelease: BOOL): HResult;
+{$ENDIF}
+begin
+ FFormatEtc := formatetc;
+ FMedium := medium;
+ Result:= S_OK;
+end;
+
+procedure TImageDataObject.SetBitmap(bmp: hBitmap);
+var
+ stgm: TStgMedium;
+ fm: TFormatEtc;
+begin
+ FillChar(stgm,SizeOf(stgm),0);
+ stgm.tymed := TYMED_GDI;
+ stgm.hBitmap := bmp;
+(*
+{$IFDEF FPC}
+ stgm.pUnkForRelease := nil;
+{$ELSE}
+ stgm.UnkForRelease := nil;
+{$ENDIF}
+*)
+ fm.cfFormat := CF_BITMAP;
+ fm.ptd := nil;
+ fm.dwAspect := DVASPECT_CONTENT;
+ fm.lindex := -1;
+ fm.tymed := TYMED_GDI;
+ SetData(fm, stgm, FALSE);
+end;
+
+const
+ OLERENDER_FORMAT = 2;
+
+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;
+
+const
+ RichEditLibnames: array[ 0..3 ] of PAnsiChar =
+ ( 'msftedit', 'riched20', 'riched32', 'riched' );
+ RichEditClasses: array[ 0..3 ] of PAnsiChar =
+ ( 'RichEdit50W', 'RichEdit20A', 'RichEdit', 'RichEdit' );
+
+const
+ FRichEditModule:THANDLE = 0;
+
+procedure InitRichEditLibrary;
+var
+ SaveErrMode:integer;
+ i:integer;
+begin
+ if FRichEditModule = 0 then
+ begin
+ SaveErrMode := SetErrorMode(SEM_NOOPENFILEERRORBOX or SEM_FAILCRITICALERRORS);
+
+ for i:=0 to HIGH(RichEditLibNames) do
+ begin
+ FRichEditModule := LoadLibraryA(RichEditLibNames[i]);
+ if FRichEditModule > HINSTANCE_ERROR then
+ begin
+ RichEditClass := RichEditClasses[i];
+ break;
+ end
+ else
+ FRichEditModule := 0;
+ end;
+
+ if FRichEditModule = 0 then
+ RichEditClass := RichEditClasses[HIGH(RichEditClasses)];
+
+ SetErrorMode(SaveErrMode);
+ end;
+end;
+
+initialization
+ InitRichEditLibrary;
+
+finalization
+ if FRichEditModule <> 0 then FreeLibrary(FRichEditModule);
+
+end.
diff --git a/plugins/Utils.pas/rtfutils.pas b/plugins/Utils.pas/rtfutils.pas new file mode 100644 index 0000000000..905c98ef0e --- /dev/null +++ b/plugins/Utils.pas/rtfutils.pas @@ -0,0 +1,586 @@ +unit rtfutils;
+
+interface
+
+uses
+ richedit,
+ windows;
+
+
+function IsRTF(const Value: pWideChar): Boolean;
+
+//used for Export only
+function GetRichRTFW(RichEditHandle: THANDLE; var RTFStream: PWideChar;
+ SelectionOnly, PlainText, NoObjects, PlainRTF: Boolean): Integer;
+function GetRichRTFA(RichEditHandle: THANDLE; var RTFStream: PAnsiChar;
+ SelectionOnly, PlainText, NoObjects, PlainRTF: Boolean): Integer;
+
+function GetRichString(RichEditHandle: THANDLE; SelectionOnly: Boolean = false): PWideChar;
+
+function SetRichRTFW(RichEditHandle: THANDLE; const RTFStream: PWideChar;
+ SelectionOnly, PlainText, PlainRTF: Boolean): Integer;
+function SetRichRTFA(RichEditHandle: THANDLE; const RTFStream: PAnsiChar;
+ SelectionOnly, PlainText, PlainRTF: Boolean): Integer;
+
+function FormatString2RTFW(Source: PWideChar; Suffix: PAnsiChar = nil): PAnsiChar;
+function FormatString2RTFA(Source: PAnsiChar; Suffix: PAnsiChar = nil): PAnsiChar;
+
+procedure ReplaceCharFormatRange(RichEditHandle: THANDLE;
+ const fromCF, toCF: CHARFORMAT2; idx, len: Integer);
+procedure ReplaceCharFormat(RichEditHandle: THANDLE; const fromCF, toCF: CHARFORMAT2);
+
+function GetTextLength(RichEditHandle:THANDLE): Integer;
+function GetTextRange (RichEditHandle:THANDLE; cpMin,cpMax: Integer): PWideChar;
+
+function BitmapToRTF(pict: HBITMAP): pAnsiChar;
+
+implementation
+
+uses
+ common;
+
+function IsRTF(const Value: pWideChar): Boolean;
+const
+ RTF_BEGIN_1 = '{\RTF';
+ RTF_BEGIN_2 = '{URTF';
+begin
+ Result := (StrPosW(Value,RTF_BEGIN_1) = Value)
+ or (StrPosW(Value,RTF_BEGIN_2) = Value);
+end;
+
+type
+ PTextStream = ^TTextStream;
+ TTextStream = record
+ Size: Integer;
+ case Boolean of
+ false: (Data: PAnsiChar);
+ true: (DataW: PWideChar);
+ end;
+
+function RichEditStreamLoad(dwCookie: DWORD_PTR; pbBuff: PByte; cb: Longint; var pcb: Longint): dword; 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: DWORD_PTR; pbBuff: PByte; cb: Longint; var pcb: Longint): dword; 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 := DWORD_PTR(TextStream);
+ es.dwError := 0;
+ es.pfnCallback := @RichEditStreamSave;
+ SendMessage(RichEditHandle, EM_STREAMOUT, format, LPARAM(@es));
+ Result := es.dwError;
+end;
+
+function GetRichRTFW(RichEditHandle: THANDLE; var RTFStream: PWideChar;
+ 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
+ StrDupW(RTFStream, Stream.DataW, Stream.Size div SizeOf(WideChar))
+ else
+ AnsiToWide(Stream.Data, RTFStream, CP_ACP);
+ FreeMem(Stream.Data, Stream.Size);
+ end
+ else
+ RTFStream := nil;
+end;
+
+function GetRichRTFA(RichEditHandle: THANDLE; var RTFStream: PAnsiChar;
+ 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
+ StrDup(RTFStream, Stream.Data, Stream.Size - 1);
+ FreeMem(Stream.Data, Stream.Size);
+ end
+ else
+ RTFStream := nil;
+end;
+
+function GetRichString(RichEditHandle: THANDLE; SelectionOnly: Boolean = false): PWideChar;
+begin
+ GetRichRTFW(RichEditHandle,Result,SelectionOnly,True,True,False);
+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 SetRichRTFW(RichEditHandle: THANDLE; const RTFStream: PWideChar;
+ SelectionOnly, PlainText, PlainRTF: Boolean): Integer;
+var
+ Stream: TTextStream;
+ Buffer: PAnsiChar;
+begin
+ if PlainText then
+ begin
+ Stream.DataW := RTFStream;
+ Stream.Size := StrLenW(RTFStream) * SizeOf(WideChar);
+ Buffer := nil;
+ end
+ else
+ begin
+ WideToAnsi(RTFStream, Buffer, CP_ACP);
+ Stream.Data := Buffer;
+ Stream.Size := StrLen(Buffer);
+ end;
+ Result := _SetRichRTF(RichEditHandle, @Stream,
+ SelectionOnly, PlainText, PlainRTF, PlainText);
+ mFreeMem(Buffer);
+end;
+
+function SetRichRTFA(RichEditHandle: THANDLE; const RTFStream: PAnsiChar;
+ SelectionOnly, PlainText, PlainRTF: Boolean): Integer;
+var
+ Stream: TTextStream;
+begin
+ Stream.Data := RTFStream;
+ Stream.Size := StrLen(RTFStream);
+ Result := _SetRichRTF(RichEditHandle, @Stream,
+ SelectionOnly, PlainText, PlainRTF, False);
+end;
+
+function FormatString2RTFW(Source: PWideChar; Suffix: PAnsiChar = nil): PAnsiChar;
+var
+ Text: PWideChar;
+ res: PAnsiChar;
+ buf: array [0..15] of AnsiChar;
+ len: integer;
+begin
+ // calculate len
+ len:=Length('{\uc1 ');
+ Text := PWideChar(Source);
+ while Text[0] <> #0 do
+ begin
+ if (Text[0] = #13) and (Text[1] = #10) then
+ begin
+ inc(len,Length('\par '));
+ Inc(Text);
+ end
+ else
+ case Text[0] of
+ #10: inc(len,Length('\par '));
+ #09: inc(len,Length('\tab '));
+ '\', '{', '}':
+ inc(len,2);
+ else
+ if Word(Text[0]) < 128 then
+ inc(len)
+ else
+ inc(len,3+IntStrLen(Word(Text[0]),10));
+ end;
+ Inc(Text);
+ end;
+ inc(len,StrLen(Suffix)+2);
+
+ // replace
+ Text := PWideChar(Source);
+ GetMem(Result,len);
+ res:=StrCopyE(Result,'{\uc1 ');
+ while Text[0] <> #0 do
+ begin
+ if (Text[0] = #13) and (Text[1] = #10) then
+ begin
+ res:=StrCopyE(res,'\par ');
+ Inc(Text);
+ end
+ else
+ case Text[0] of
+ #10: res:=StrCopyE(res,'\par ');
+ #09: res:=StrCopyE(res,'\tab ');
+ '\', '{', '}': begin
+ res^:='\'; inc(res);
+ res^:=AnsiChar(Text[0]); inc(res);
+ end;
+ else
+ if Word(Text[0]) < 128 then
+ begin
+ res^:=AnsiChar(Word(Text[0])); inc(res);
+ end
+ else
+ begin
+ res:=StrCopyE(
+ StrCopyE(res,'\u'),
+ IntToStr(buf,Word(Text[0])));
+ res^:='?'; inc(res);
+ end;
+ end;
+ Inc(Text);
+ end;
+
+ res:=StrCopyE(res, Suffix);
+ res^:='}'; inc(res); res^:=#0;
+end;
+
+function FormatString2RTFA(Source: PAnsiChar; Suffix: PAnsiChar = nil): PAnsiChar;
+var
+ Text,res: PAnsiChar;
+ len: integer;
+begin
+ // calculate len
+ len:=1;
+ Text := PAnsiChar(Source);
+ while Text[0] <> #0 do
+ begin
+ if (Text[0] = #13) and (Text[1] = #10) then
+ begin
+ inc(len,Length('\line '));
+ Inc(Text);
+ end
+ else
+ case Text[0] of
+ #10: inc(len,Length('\line '));
+ #09: inc(len,Length('\tab '));
+ '\', '{', '}':
+ inc(len,2);
+ else
+ inc(len);
+ end;
+ Inc(Text);
+ end;
+ inc(len,StrLen(Suffix)+2);
+
+ // replace
+ Text := PAnsiChar(Source);
+ GetMem(Result,len);
+ res:=Result;
+ res^ := '{'; inc(res);
+ while Text[0] <> #0 do
+ begin
+ if (Text[0] = #13) and (Text[1] = #10) then
+ begin
+ res:=StrCopyE(res,'\line ');
+ Inc(Text);
+ end
+ else
+ case Text[0] of
+ #10: res:=StrCopyE(res,'\line ');
+ #09: res:=StrCopyE(res,'\tab ');
+ '\', '{', '}': begin
+ res^:='\'; inc(res);
+ res^:=Text[0]; inc(res);
+ end;
+ else
+ res^:=Text[0]; inc(res);
+ end;
+ Inc(Text);
+ end;
+
+ res:=StrCopyE(res, Suffix);
+ res^:='}'; inc(res); res^:=#0;
+end;
+
+function GetTextLength(RichEditHandle: THANDLE): Integer;
+var
+ gtxl: GETTEXTLENGTHEX;
+begin
+ gtxl.flags := GTL_DEFAULT or GTL_PRECISE;
+ gtxl.codepage := 1200; // Unicode
+ gtxl.flags := gtxl.flags or GTL_NUMCHARS;
+ Result := SendMessage(RichEditHandle, EM_GETTEXTLENGTHEX, WPARAM(@gtxl), 0);
+end;
+
+procedure ReplaceCharFormatRange(RichEditHandle: THANDLE;
+ 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;
+ SendMessage(RichEditHandle, EM_EXSETSEL, 0, LPARAM(@cr));
+ ZeroMemory(@cf, SizeOf(cf));
+ cf.cbSize := SizeOf(cf);
+ cf.dwMask := fromCF.dwMask;
+ res := SendMessage(RichEditHandle, 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);
+ SendMessage(RichEditHandle, EM_EXSETSEL, 0, LPARAM(@cr));
+ SendMessage(RichEditHandle, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@toCF));
+ end
+ else
+ begin
+ loglen := len div 2;
+ ReplaceCharFormatRange(RichEditHandle, fromCF, toCF, idx, loglen);
+ ReplaceCharFormatRange(RichEditHandle, fromCF, toCF, idx + loglen, len - loglen);
+ end;
+ end
+ else if (cf.dwEffects and fromCF.dwEffects) = fromCF.dwEffects then
+ SendMessage(RichEditHandle, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@toCF));
+end;
+
+procedure ReplaceCharFormat(RichEditHandle: THANDLE; const fromCF, toCF: CHARFORMAT2);
+begin
+ ReplaceCharFormatRange(RichEditHandle,fromCF,toCF,0,GetTextLength(RichEditHandle));
+end;
+
+
+function GetTextRange(RichEditHandle: THANDLE; cpMin,cpMax: Integer): PWideChar;
+var
+ tr: TextRangeW;
+begin
+ tr.chrg.cpMin := cpMin;
+ tr.chrg.cpMax := cpMax;
+ GetMem(Result,(cpMax-cpMin+1)*SizeOf(WideChar));
+ tr.lpstrText := Result;
+
+ SendMessageW(RichEditHandle,EM_GETTEXTRANGE,0,LPARAM(@tr));
+end;
+
+{ Direct Bitmap to RTF insertion }
+
+function BytesPerScanline(PixelsPerScanline, BitsPerPixel, Alignment: Longint): Longint;
+begin
+ Dec(Alignment);
+ Result := ((PixelsPerScanline * BitsPerPixel) + Alignment) and not Alignment;
+ Result := Result div 8;
+end;
+
+procedure InitializeBitmapInfoHeader(Bitmap: HBITMAP; var BI: TBitmapInfoHeader; Colors: Integer);
+var
+ DS: TDIBSection;
+ Bytes: Integer;
+begin
+ DS.dsbmih.biSize := 0;
+ Bytes := GetObject(Bitmap, SizeOf(DS), @DS);
+ if Bytes = 0 then {InvalidBitmap}
+ else if (Bytes >= (sizeof(DS.dsbm) + sizeof(DS.dsbmih))) and
+ (DS.dsbmih.biSize >= DWORD(sizeof(DS.dsbmih))) then
+ BI := DS.dsbmih
+ else
+ begin
+ FillChar(BI, sizeof(BI), 0);
+ with BI, DS.dsbm do
+ begin
+ biSize := SizeOf(BI);
+ biWidth := bmWidth;
+ biHeight := bmHeight;
+ end;
+ end;
+ case Colors of
+ 2: BI.biBitCount := 1;
+ 3..16:
+ begin
+ BI.biBitCount := 4;
+ BI.biClrUsed := Colors;
+ end;
+ 17..256:
+ begin
+ BI.biBitCount := 8;
+ BI.biClrUsed := Colors;
+ end;
+ else
+ BI.biBitCount := DS.dsbm.bmBitsPixel * DS.dsbm.bmPlanes;
+ end;
+ BI.biPlanes := 1;
+ if BI.biClrImportant > BI.biClrUsed then
+ BI.biClrImportant := BI.biClrUsed;
+ if BI.biSizeImage = 0 then
+ BI.biSizeImage := BytesPerScanLine(BI.biWidth, BI.biBitCount, 32) * Abs(BI.biHeight);
+end;
+
+procedure InternalGetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: DWORD;
+ var ImageSize: DWORD; Colors: Integer);
+var
+ BI: TBitmapInfoHeader;
+begin
+ InitializeBitmapInfoHeader(Bitmap, BI, Colors);
+ if BI.biBitCount > 8 then
+ begin
+ InfoHeaderSize := SizeOf(TBitmapInfoHeader);
+ if (BI.biCompression and BI_BITFIELDS) <> 0 then
+ Inc(InfoHeaderSize, 12);
+ end
+ else
+ if BI.biClrUsed = 0 then
+ InfoHeaderSize := SizeOf(TBitmapInfoHeader) +
+ SizeOf(TRGBQuad) * (1 shl BI.biBitCount)
+ else
+ InfoHeaderSize := SizeOf(TBitmapInfoHeader) +
+ SizeOf(TRGBQuad) * BI.biClrUsed;
+ ImageSize := BI.biSizeImage;
+end;
+
+procedure GetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: DWORD; var ImageSize: DWORD);
+begin
+ InternalGetDIBSizes(Bitmap, InfoHeaderSize, ImageSize, 0);
+end;
+
+function InternalGetDIB(Bitmap: HBITMAP; Palette: HPALETTE;
+ var BitmapInfo; var Bits; Colors: Integer): Boolean;
+var
+ OldPal: HPALETTE;
+ DC: HDC;
+begin
+ InitializeBitmapInfoHeader(Bitmap, TBitmapInfoHeader(BitmapInfo), Colors);
+ OldPal := 0;
+ DC := CreateCompatibleDC(0);
+ try
+ if Palette <> 0 then
+ begin
+ OldPal := SelectPalette(DC, Palette, False);
+ RealizePalette(DC);
+ end;
+ Result := GetDIBits(DC, Bitmap, 0, TBitmapInfoHeader(BitmapInfo).biHeight, @Bits,
+ TBitmapInfo(BitmapInfo), DIB_RGB_COLORS) <> 0;
+ finally
+ if OldPal <> 0 then SelectPalette(DC, OldPal, False);
+ DeleteDC(DC);
+ end;
+end;
+
+function GetDIB(Bitmap: HBITMAP; Palette: HPALETTE; var BitmapInfo; var Bits): Boolean;
+begin
+ Result := InternalGetDIB(Bitmap, Palette, BitmapInfo, Bits, 0);
+end;
+
+const
+ HexDigitChr: array [0..15] of AnsiChar = ('0','1','2','3','4','5','6','7',
+ '8','9','A','B','C','D','E','F');
+
+function BitmapToRTF(pict: HBITMAP): pAnsiChar;
+const
+ prefix = '{\rtf1 {\pict\dibitmap ';
+ postfix = ' }}';
+var
+ tmp, bi, bb, rtf: pAnsiChar;
+ bis, bbs: cardinal;
+ len,cnt: integer;
+begin
+ GetDIBSizes(pict, bis, bbs);
+ GetMem(bi, bis);
+ GetMem(bb, bbs);
+ GetDIB(pict, {pict.Palette}0, bi^, bb^);
+
+ len:=(bis+bbs)*2+cardinal(Length(prefix)+Length(postfix))+1;
+ GetMem(result,len);
+
+ rtf:=StrCopyE(result,prefix);
+ tmp:=bi;
+ for cnt := 0 to bis-1 do
+ begin
+ rtf^ := HexDigitChr[ord(tmp^) shr 4]; inc(rtf);
+ rtf^ := HexDigitChr[ord(tmp^) and $F]; inc(rtf);
+ inc(tmp);
+ end;
+ tmp:=bb;
+ for cnt := 0 to bbs-1 do
+ begin
+ rtf^ := HexDigitChr[ord(tmp^) shr 4]; inc(rtf);
+ rtf^ := HexDigitChr[ord(tmp^) and $F]; inc(rtf);
+ inc(tmp);
+ end;
+ StrCopy(rtf,postfix);
+
+ FreeMem(bi);
+ FreeMem(bb);
+end;
+
+
+initialization
+finalization
+
+end.
diff --git a/plugins/Utils.pas/syswin.pas b/plugins/Utils.pas/syswin.pas index 9b75f711fa..661963d5e6 100644 --- a/plugins/Utils.pas/syswin.pas +++ b/plugins/Utils.pas/syswin.pas @@ -38,7 +38,7 @@ function IsExeRunning(exename:PWideChar):boolean; {hwnd} implementation
uses
- {$IFNDEF FPC}shellapi,{$ENDIF}
+// {$IFNDEF FPC}shellapi,{$ENDIF}
{$IFDEF COMPILER_16_UP}
WinAPI.PsApi,
{$ELSE}
@@ -46,12 +46,13 @@ uses {$ENDIF}
common,messages;
-{ shellapi import
+{$IFNDEF FPC} // shellapi import
function FindExecutableA(FileName, Directory: PAnsiChar; Result: PAnsiChar): HINST; stdcall;
external 'shell32.dll' name 'FindExecutableA';
function FindExecutableW(FileName, Directory: PWideChar; Result: PWideChar): HINST; stdcall;
external 'shell32.dll' name 'FindExecutableW';
-}
+{$ENDIF}
+
{$IFDEF COMPILER_16_UP}
type pqword = ^int64;
{$ENDIF}
@@ -197,7 +198,7 @@ begin len:=4;
typ:=REG_DWORD;
if RegQueryValueEx(lKey,'GlobalUserOffline',NIL,@typ,@result,@len)=ERROR_SUCCESS then
- ;
+ ;
RegCloseKey(lKey);
end;
end;
diff --git a/plugins/Utils.pas/tlb_richedit.pas b/plugins/Utils.pas/tlb_richedit.pas new file mode 100644 index 0000000000..1805aee9b6 --- /dev/null +++ b/plugins/Utils.pas/tlb_richedit.pas @@ -0,0 +1,898 @@ +unit tlb_richedit;
+
+interface
+
+uses
+ Windows, Messages, RichEdit, ActiveX;
+
+
+const
+ IID_ITextDocument : TGUID = '{8CC497C0-A1DF-11CE-8098-00AA0047BE5D}';
+ IID_ITextSelection : TGUID = '{8CC497C1-A1DF-11CE-8098-00AA0047BE5D}';
+ IID_ITextRange : TGUID = '{8CC497C2-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}';
+ IID_ITextDocument2 : TGUID = '{01C25500-4268-11D1-883A-3C8B00C10000}';
+ IID_ITextMsgFilter : TGUID = '{A3787420-4267-11D1-883A-3C8B00C10000}';
+
+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
+ 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;
+ ITextMsgFilter = interface;
+
+// *********************************************************************//
+// Interface: ITextDocument
+// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable
+// GUID: {8CC497C0-A1DF-11CE-8098-00AA0047BE5D}
+// *********************************************************************//
+ 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;
+
+// *********************************************************************//
+// DispIntf: ITextDocumentDisp
+// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable
+// GUID: {8CC497C0-A1DF-11CE-8098-00AA0047BE5D}
+// *********************************************************************//
+ 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;
+
+// *********************************************************************//
+// Interface: ITextRange
+// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable
+// GUID: {8CC497C2-A1DF-11CE-8098-00AA0047BE5D}
+// *********************************************************************//
+ 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;
+
+// *********************************************************************//
+// DispIntf: ITextRangeDisp
+// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable
+// GUID: {8CC497C2-A1DF-11CE-8098-00AA0047BE5D}
+// *********************************************************************//
+ 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;
+
+// *********************************************************************//
+// Interface: ITextSelection
+// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable
+// GUID: {8CC497C1-A1DF-11CE-8098-00AA0047BE5D}
+// *********************************************************************//
+ 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;
+
+// *********************************************************************//
+// DispIntf: ITextSelectionDisp
+// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable
+// GUID: {8CC497C1-A1DF-11CE-8098-00AA0047BE5D}
+// *********************************************************************//
+ 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;
+
+// *********************************************************************//
+// Interface: ITextFont
+// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable
+// GUID: {8CC497C3-A1DF-11CE-8098-00AA0047BE5D}
+// *********************************************************************//
+ 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;
+
+// *********************************************************************//
+// DispIntf: ITextFontDisp
+// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable
+// GUID: {8CC497C3-A1DF-11CE-8098-00AA0047BE5D}
+// *********************************************************************//
+ 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;
+
+// *********************************************************************//
+// Interface: ITextPara
+// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable
+// GUID: {8CC497C4-A1DF-11CE-8098-00AA0047BE5D}
+// *********************************************************************//
+ 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;
+
+// *********************************************************************//
+// DispIntf: ITextParaDisp
+// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable
+// GUID: {8CC497C4-A1DF-11CE-8098-00AA0047BE5D}
+// *********************************************************************//
+ 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;
+
+// *********************************************************************//
+// Interface: ITextStoryRanges
+// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable
+// GUID: {8CC497C5-A1DF-11CE-8098-00AA0047BE5D}
+// *********************************************************************//
+ 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;
+
+// *********************************************************************//
+// DispIntf: ITextStoryRangesDisp
+// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable
+// GUID: {8CC497C5-A1DF-11CE-8098-00AA0047BE5D}
+// *********************************************************************//
+ 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;
+
+// *********************************************************************//
+// Interface: ITextDocument2
+// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable
+// GUID: {01C25500-4268-11D1-883A-3C8B00C10000}
+// *********************************************************************//
+ 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;
+
+// *********************************************************************//
+// DispIntf: ITextDocument2Disp
+// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable
+// GUID: {01C25500-4268-11D1-883A-3C8B00C10000}
+// *********************************************************************//
+ 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;
+
+// *********************************************************************//
+// Interface: ITextMsgFilter
+// Flags: (128) NonExtensible
+// GUID: {A3787420-4267-11D1-883A-3C8B00C10000}
+// *********************************************************************//
+ ITextMsgFilter = interface(IUnknown)
+ ['{A3787420-4267-11D1-883A-3C8B00C10000}']
+ function AttachDocument(var hwnd: TGUID; const pTextDoc: ITextDocument2; const punk: IUnknown): HResult; stdcall;
+ function HandleMessage(var pmsg: SYSUINT; var pwparam: UINT_PTR; var plparam: LONG_PTR;
+ out plres: LONG_PTR): HResult; stdcall;
+ function AttachMsgFilter(const pMsgFilter: ITextMsgFilter): HResult; stdcall;
+ end;
+
+
+implementation
+
+end.
|