ychatu14.pas

Yahoo Messenger for Mobile

unit YchatU14;

interface

uses
  Windows, Messages, SysUtils,  Classes, Graphics, Controls, Forms,
  Richedit, ComCtrls, StdCtrls, ExtCtrls, MyRicheditEx,ActiveX, OleConsts,OleStd,
  Buttons,Dialogs, DynamicSkinForm, SkinCtrls;

type
  TREOleCallBack3 = class (TInterfacedObject, IRichEditOleCallback)
    function GetNewStorage (out stg: IStorage): HRESULT; overload; stdcall;
    function GetInPlaceContext (out Frame: IOleInPlaceFrame; out Doc: IOleInPlaceUIWindow; var FrameInfo: TOleInPlaceFrameInfo): HRESULT; overload; stdcall;
    function ShowContainerUI (fShow: BOOL): HRESULT; overload; stdcall;
    function QueryInsertObject (const clsid: TCLSID; stg: IStorage; cp: longint): HRESULT; overload; stdcall;
    function DeleteObject (oleobj: IOLEObject): HRESULT; overload; stdcall;
    function QueryAcceptData (dataobj: IDataObject; var cfFormat: TClipFormat; reco: DWORD; fReally: BOOL; hMetaPict: HGLOBAL): HRESULT; overload; stdcall;
    function ContextSensitiveHelp (fEnterMode: BOOL): HRESULT; overload; stdcall;
    function GetClipboardData (const chrg: TCharRange; reco: DWORD; out dataobj: IDataObject): HRESULT; overload; stdcall;
    function GetDragDropEffect (fDrag: BOOL; grfKeyState: DWORD; var dwEffect: DWORD): HRESULT; overload; stdcall;
    function GetContextMenu (seltype: Word; oleobj: IOleObject; const chrg: TCharRange; var menu: HMENU): HRESULT; overload; stdcall;
  private
    FItemCount : integer;
    FStorage : IStorage;
  public
    constructor Create;
  end;


type
  TForm14 = class(TForm)
    spDynamicSkinForm1: TspDynamicSkinForm;
    RichEdit1: TMyRichEdit;
    procedure FormCreate(Sender: TObject);
    procedure Richedit1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Richedit1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
   FOleInterface : TREOleCallback3;
   Obj: TRichedit;
   procedure REOleSetCallback2(RichEdit: TCustomRichEdit; OleInterface: IRichEditOleCallback);
    { Public declarations }
  end;

var
  Form14: TForm14;

const
  SubStorageMode = fmOpenReadWrite or fmShareExclusive or fmTransacted;
  StorageMode = SubStorageMode or fmDeleteOnRelease;

implementation

uses YchatU1;

{$R *.dfm}


constructor TREOleCallBack3.Create;
begin
  inherited Create;
  FStorage := OleStdCreateTempRootStorage (StorageMode)
end;

function TREOleCallBack3.GetNewStorage (out Stg: IStorage): HRESULT;
begin
  Result:= ddOk;
  inc (FItemCount);
  Stg := OleStdCreateChildStorage (FStorage, Format ('REOBJ%d', [FItemCount]), SubStorageMode)
end;

function TREOleCallBack3.GetInPlaceContext (out Frame: IOleInPlaceFrame; out Doc: IOleInPlaceUIWindow; var FrameInfo: TOleInPlaceFrameInfo): HRESULT;
begin
  Result:=  ddNotImplemented
end;

function TREOleCallBack3.ShowContainerUI (fShow: BOOL): HRESULT;
begin
  Result:=  ddNotImplemented
end;

function TREOleCallBack3.QueryInsertObject (const clsid: TCLSID; stg: IStorage; cp: longint): HRESULT;
begin
  Result :=  ddOk
end;

function TREOleCallBack3.DeleteObject (oleobj: IOLEObject): HRESULT;
begin
  Result :=  ddNotImplemented
end;

function TREOleCallBack3.QueryAcceptData (dataobj: IDataObject; var cfFormat: TClipFormat; reco: DWORD; fReally: BOOL; hMetaPict: HGLOBAL): HRESULT;
begin
  Result := ddOk
end;

function TREOleCallBack3.ContextSensitiveHelp (fEnterMode: BOOL): HRESULT;
begin
  Result :=  ddNotImplemented
end;

function TREOleCallBack3.GetClipboardData (const chrg: TCharRange; reco: DWORD; out dataobj: IDataObject): HRESULT;
begin
  Result := ddNotImplemented
end;

function TREOleCallBack3.GetDragDropEffect (fDrag: BOOL; grfKeyState: DWORD; var dwEffect: DWORD): HRESULT;
begin
  Result := ddNotImplemented
end;

function TREOleCallBack3.GetContextMenu (seltype: Word; oleobj: IOleObject; const chrg: TCharRange; var menu: HMENU): HRESULT;
begin
  Result := ddNotImplemented
end;

procedure Tform14.REOleSetCallback2 (RichEdit : TCustomRichEdit; OleInterface: IRichEditOleCallback);
begin
  if (not Assigned (Richedit)) or (SendMessage (Richedit.Handle, EM_SETOLECALLBACK, 0, integer (OleInterface)) = 0) then
    raise Exception.Create('Unable to set RichEditOleCallback')
end;

Function UsedSmile(Num: Integer): Boolean;
Begin
End;

Function SmileCaption(Num: Integer): String;
Begin

End;

procedure TForm14.FormCreate(Sender: TObject);
Var
 N: Integer;
Begin
 Richedit1.ScrollBars:=SSVertical;
 FOleInterface := TREOleCallBack3.Create;
 REOleSetCallback2 (Richedit1, FOleInterface);
end;


function SearchForText_AndSelect(RichEdit: TRichEdit; SearchText: string): Boolean;
var 
  StartPos, Position, Endpos: Integer; 
begin 
  StartPos := 0; 
  with Richedit do
  begin 
    Endpos := Length(Richedit.Text);
    Lines.BeginUpdate; 
    while FindText(SearchText, StartPos, Endpos, [stMatchCase])<>-1 do 
    begin
      Endpos   := Length(Richedit.Text) - startpos;
      Position := FindText(SearchText, StartPos, Endpos, [stMatchCase]); 
      Inc(StartPos, Length(SearchText)); 
      SetFocus; 
      SelStart  := Position; 
      SelLength := Length(SearchText); 
    end; 
    Lines.EndUpdate; 
  end; 
end;

procedure TForm14.Richedit1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
Tn,N,iCharIndex, iLineIndex, iCharOffset, i, j: Integer;
Pt: TPoint;
s: string;
begin
//Form1.Caption:=REExtractWordFromPos(Form1.Richedit1,X,Y);
 with TRichEdit(Sender) do
begin
 Pt := Point(X, Y);
// Get Character Index from word under the cursor
 iCharIndex := Perform(Messages.EM_CHARFROMPOS, 0, Integer(@Pt));
 if iCharIndex < 0 then Exit;
// Get line Index
 iLineIndex  := Perform(EM_EXLINEFROMCHAR, 0, iCharIndex);
 iCharOffset := iCharIndex - Perform(EM_LINEINDEX, iLineIndex, 0);
 if Lines.Count - 1 < iLineIndex then Exit;
// store the current line in a variable
s := Lines[iLineIndex];
// Search the beginning of the word
 i := iCharOffset + 1;
 If I<Length(S) then
  Begin
   while (i > 0) and (s[i] <> ' ') do Dec(i);
// Search the end of the word
 j := iCharOffset + 1;
 while (j <= Length(s)) and (s[j] <> ' ') do Inc(j);
// Display Text under Cursor
   If WordStr<>Trim(Copy(s, i, j - i)) Then
    Begin
     Tn:=0;
     For N:=0 to ILineIndex-1 Do
       TN:=TN+Length(Lines[N]);
      WordStr := Trim(Copy(s, i, j - i));
      SelStart:=TN+iCharOffset;
      SelLength:=J-I;
      Form14.Caption:='Click to select image: '+WordStr;
    End;  
//  SearchForText_AndSelect(RichEdit1, WordStr);
 End
  else
   WordStr:='';
  End;
end;

procedure TForm14.Richedit1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
Var
 Ctrl: Boolean;
begin
 Obj.SelText:=WordStr+' ';
 Ctrl:=False;
 If SSCtrl in Shift Then
   Ctrl:=True;
  If Ctrl=False Then
   Begin
    Close;
    Form1.Delay(120);
    Obj.SetFocus;
   End;
// Form1.Richedit2.Focused:=True;
end;

end.