続きです。



implementation

procedure Register;
begin
  RegisterComponents('Samples', [TRichEditEx]);
end;

(* RichEditOle用コールバックの実装 *)

constructor TRichEditOleCallback.Create(Owner:IRichEditOle);
begin
  FRichEditOle := Owner;
  FRichEditOle.GetClientSite(FOleClientSite);
end;

function TRichEditOleCallback.QueryInterface(const iid: TIID; var obj):
HResult;
var
  P: IUnknown;
begin
  if IsEqualIID(iid, IID_IUnknown) or IsEqualIID(iid,
IID_IOleClientSite) then
    P := FOleClientSite
  else if IsEqualIID(iid, IID_IOleInPlaceSite) then
    P := FOleInPlaceSite
  else if IsEqualIID(iid, IID_IAdviseSink) then
    P := FAdviseSink
  else
    P := nil;
  Pointer(obj) := P;
  if P = nil then
    Result := E_NOINTERFACE
  else
  begin
    P.AddRef;
    Result := S_OK;
  end;
end;

function TRichEditOleCallback.Release: Longint;
begin
  Dec(FRefCount);
  Result := FRefCount;
end;

function TRichEditOleCallback.AddRef: Longint;
begin
  Inc(FRefCount);
  Result := FRefCount;
end;

function TRichEditOleCallback.GetNewStorage(var
Storage:IStorage):HResult;
begin
  CreateILockBytesOnHGlobal(0, True, FLockBytes);
  StgCreateDocfileOnILockBytes(FLockBytes, STGM_CREATE or STGM_READWRITE
or STGM_SHARE_EXCLUSIVE , 0, Storage);
  Result := S_OK;
end;

function TRichEditOleCallback.GetInPlaceContext(var
frame:IOleInPlaceFrame; var doc:IOleInPlaceUIWindow; var
frameInfo:TOleInPlaceFrameInfo):HResult;
begin
  Result := E_NOTIMPL;
end;

function TRichEditOleCallback.ShowContainerUI(fShow:BOOL):HResult;
begin
  Result := S_OK;
end;

function TRichEditOleCallback.QueryInsertObject(var clsid:TCLSID; var
Storage:IStorage; cp:LongInt):HResult;
begin
  Result := S_OK;
end;

function TRichEditOleCallback.DeleteObject(var obj:IOleObject):HResult;
begin
  Result := S_OK;
end;

function TRichEditOleCallback.QueryAcceptData(var dataobj:IDataObject;
var
cfFormat:TClipFormat;Reco:LongInt;fReally:BOOL;MetaPict:HGlobal):HResult
;
begin
  cfFormat := 0;
  Result := S_OK;
end;

function
TRichEditOleCallback.ContextSensitiveHelp(enterMode:BOOL):HResult;
begin
  Result := E_NOTIMPL;
end;

function TRichEditOleCallback.GetClipboardData(var chrg:TCharRange;reco:
LongInt;var dataobj:IDataObject):HResult;
begin
  Result := FRichEditOle.GetClipboardData(chrg,reco,dataobj);
end;

function TRichEditOleCallback.GetDragDropEffect(flag:BOOL;
grfKeyState:LongInt ; var dwEffect:LongInt):HResult;
begin
  dwEffect := DROPEFFECT_COPY;
  Result := S_OK;
end;

function TRichEditOleCallback.GetContextMenu( seltyp:Word ; var
oleobj:IOleObject ; var chrg:TCharRange ; var menu:HMenu):HResult;
begin
  Result := E_NOTIMPL;
end;

(* TRichEditEx *)

constructor TRichEditEx.Create(Owner:TComponent);
begin
  inherited Create(Owner);
end;

destructor TRichEditEx.Destroy;
begin
  inherited Destroy;
end;

procedure TRichEditEx.SetUseOle(flag:Boolean);
begin
  if flag then
  begin
    SendMessage(Handle, EM_GETOLEINTERFACE, 0, LParam(@FRichEditOle));
    FRichEditOleCallback := TRichEditOleCallback.Create(FRichEditOle);
    SendMessage(Handle, EM_SETOLEINTERFACE, 0,
LParam(FRichEditOleCallback));
    FUseOle := True;
  end
  else
  begin
    SendMessage(Handle, EM_SETOLEINTERFACE, 0, 0);
    FUseOle := False;
  end;
end;

function TRichEditEx.GetClipboardData(var range:TCharRange;reco:LongInt;
var obj:IDataObject):HResult;
begin
  Result := FRichEditOle.GetClipboardData(range, reco, obj);
end;

function TRichEditEx.ImportDataObject(var
obj:IDataObject;cf:TClipFormat;metaPict:HGlobal):HResult;
begin
  Result := FRichEditOle.ImportDataObject(obj, cf, metaPict);
end;

procedure TRichEditEx.PasteFromClipboard;
begin
  if PlainText then
    SelText := Clipboard.AsText
  else
    SendMessage(Handle, WM_PASTE,0,0);
end;

procedure TRichEditEx.CopyToClipboard;
begin
  SendMessage(Handle, WM_COPY,0,0);
end;

function TRichEditEx.GetCursorX:Integer;
var
  LineNo, CharPos:Integer;
begin
  CharPos := SelStart;
  LineNo := Perform(EM_LINEFROMCHAR, CharPos, 0);
  Result := CharPos - Perform(EM_LINEINDEX, LineNo, 0);
end;

function TRichEditEx.GetCursorY:Integer;
begin
  Result := Perform(EM_LINEFROMCHAR, SelStart, 0);
end;

end.

               98/2/8(Sun) 00:32am [AirCraft 97開発] HHH02417 DUDE

Original document by DUDE            氏 ID:(PFF01344)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。