::: 델파이 Tip&Trick :::

델파이 Tip&Trick 성격에 맞지 않는 광고,비방,질문의 글은 즉시 삭제하며
내용을 복사하여 사용할 경우 반드시 이곳(http://www.howto.pe.kr)을 출처로 명시하여 주세요


Category

  김영대(2004-12-10 13:08:52, Hit : 5804, Vote : 1225
 http://www.howto.pe.kr
 내 프로그램에서 선택한 text를 다른 프로그램에 Drag&Drop으로 주기

// 사용예:
//   폼위의 메모장에서 텍스트를 선택하고 드래그하여 윈도우즈 위드패드나 MS-WORD에 드롭해보세요
// 단, 모든 프로그램으로 드롭되는것은 아니며 그 프로그램이 COM drag-and-drop을 지원해야 합니다
// 참고 콤포넌트: http://www.torry.net/vcl/system/draganddrop/dragdrop.exe

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActiveX, ComObj, StdCtrls;

type
  TDragResult = (drFailed, drCancelled, drCopied);

  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Memo1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    OldWndProc, NewWndProc: pointer;
    procedure MemoWndProc(var Message: TMessage);
  public
    { Public declarations }
  end;

  TMyDataObject = class(TInterfacedObject, IDataObject)
  private
    Data: string;
  public
    function GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium):
      HResult; stdcall;
    function GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium):
      HResult; stdcall;
    function QueryGetData(const formatetc: TFormatEtc): HResult;
      stdcall;
    function GetCanonicalFormatEtc(const formatetc: TFormatEtc;
      out formatetcOut: TFormatEtc): HResult; stdcall;
    function SetData(const formatetc: TFormatEtc; var medium: TStgMedium;
      fRelease: BOOL): HResult; stdcall;
    function EnumFormatEtc(dwDirection: Longint; out enumFormatEtc:
      IEnumFormatEtc): HResult; stdcall;
    function DAdvise(const formatetc: TFormatEtc; advf: Longint;
      const advSink: IAdviseSink; out dwConnection: Longint): HResult; stdcall;
    function DUnadvise(dwConnection: Longint): HResult; stdcall;
    function EnumDAdvise(out enumAdvise: IEnumStatData): HResult;
      stdcall;
    constructor Create(s: string);
  end;

  TMyEnum = class(TInterfacedObject, IEnumFormatEtc)
  private
    Index: integer;
  public
    function Next(celt: Longint; out elt;
      pceltFetched: PLongint): HResult; stdcall;
    function Skip(celt: Longint): HResult; stdcall;
    function Reset: HResult; stdcall;
    function Clone(out Enum: IEnumFormatEtc): HResult; stdcall;
  end;

  TDropSourceOLE = class(TInterfacedObject, IDropSource)
  private
  public
    function QueryContinueDrag(fEscapePressed: BOOL;
      grfKeyState: Longint): HResult; stdcall;
    function GiveFeedback(dwEffect: Longint): HResult; stdcall;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TMyDataObject }
constructor TMyDataObject.Create(s: string);
begin
  inherited Create;
  Data := s;
end;

function TMyDataObject.GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium):
      HResult; stdcall;
var
  h: HGlobal;
  p: PChar;
begin
  if Failed(QueryGetData(formatetcIn)) then
    Result := DV_E_FORMATETC
  else begin
    h := GlobalAlloc(0, Length(Data)+1);
    if h = 0 then begin
      Result := E_OUTOFMEMORY;
      Exit;
    end;

    p := PChar(GlobalLock(h));
    StrPCopy(p, Data);
    GlobalUnlock(h);

    with medium do begin
      tymed := TYMED_HGLOBAL;
      hGlobal := h;
      unkForRelease := nil;
    end;

    Result := S_OK;
  end;
end;

function TMyDataObject.GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium):
      HResult; stdcall;
begin
  Result := E_NOTIMPL;
end;

function TMyDataObject.QueryGetData(const formatetc: TFormatEtc): HResult;
      stdcall;
begin
  with formatetc do begin
    if cfFormat <> CF_TEXT then
      Result := DV_E_FORMATETC
    else if (tymed and TYMED_HGLOBAL) = 0 then
      Result := DV_E_TYMED
    else
      Result := S_OK;
  end;
end;

function TMyDataObject.GetCanonicalFormatEtc(const formatetc: TFormatEtc;
      out formatetcOut: TFormatEtc): HResult; stdcall;
begin
  Result := E_NOTIMPL;
end;

function TMyDataObject.SetData(const formatetc: TFormatEtc; var medium: TStgMedium;
      fRelease: BOOL): HResult; stdcall;
begin
  Result := E_NOTIMPL;
end;

function TMyDataObject.EnumFormatEtc(dwDirection: Longint; out enumFormatEtc:
      IEnumFormatEtc): HResult; stdcall;
begin
  if dwDirection = DATADIR_GET then begin
    enumFormatEtc := TMyEnum.Create;
    Result := S_OK;
  end else begin
    enumFormatEtc := nil;
    Result := E_NOTIMPL;
  end;
end;

function TMyDataObject.DAdvise(const formatetc: TFormatEtc; advf: Longint;
      const advSink: IAdviseSink; out dwConnection: Longint): HResult; stdcall;
begin
  Result := E_NOTIMPL;
end;

function TMyDataObject.DUnadvise(dwConnection: Longint): HResult; stdcall;
begin
  Result := E_NOTIMPL;
end;

function TMyDataObject.EnumDAdvise(out enumAdvise: IEnumStatData): HResult;
      stdcall;
begin
  Result := E_NOTIMPL;
end;


{ TMyEnum }
function TMyEnum.Next(celt: Longint; out elt;
      pceltFetched: PLongint): HResult; stdcall;
begin
  Result := S_FALSE;
  if (Index = 0) and (celt > 0) then begin
    Inc(Index);
    with TFormatEtc(elt) do begin
      cfFormat := CF_TEXT;
      ptd := nil;
      dwAspect := DVASPECT_CONTENT;
      lindex := -1;
      tymed := TYMED_HGLOBAL;
    end;

    if pceltFetched <> nil then pceltFetched^ := 1;
    if celt = 1 then Result := S_OK;
  end else begin
    if pceltFetched <> nil then pceltFetched^ := 0;
  end;
end;

function TMyEnum.Skip(celt: Longint): HResult; stdcall;
begin
  Inc(Index, celt);
  if Index > 1 then Result := S_FALSE else Result := S_OK;
end;

function TMyEnum.Reset: HResult; stdcall;
begin
  Index := 0;
  Result := S_OK;
end;

function TMyEnum.Clone(out Enum: IEnumFormatEtc): HResult; stdcall;
begin
  enum := TMyEnum.Create;
  TMyEnum(enum).Index := Index;
  Result := S_OK;
end;


{ TMyDropDSource }
function TDropSourceOLE.QueryContinueDrag(fEscapePressed: BOOL;
      grfKeyState: Longint): HResult; stdcall;
begin
  if fEscapePressed then
    Result := DRAGDROP_S_CANCEL
  else if (grfKeyState and MK_LBUTTON) = 0 then
    Result := DRAGDROP_S_DROP
  else
    Result := NOERROR;
end;

function TDropSourceOLE.GiveFeedback(dwEffect: Longint): HResult; stdcall;
begin
  Result := DRAGDROP_S_USEDEFAULTCURSORS;
end;


{ Global Function }
function DragIt(s: string): TDragResult;
var
  MyData: TMyDataObject;
  MyDrop: TDropSourceOLE;
  Effect: LongInt;
begin
  Result := drFailed;
  try
    MyData := TMyDataObject.Create(s);
    try
      MyDrop := TDropSourceOLE.Create;
      try
        if (DoDragDrop(IDataObject(MyData), IDropSource(MyDrop),
                       DROPEFFECT_COPY, Effect) = DRAGDROP_S_DROP) and
           (Effect = DROPEFFECT_COPY) then
          Result := drCopied
        else
          Result := drCancelled;
      finally
        MyData.Free;
      end;
    finally
      MyDrop.Free;
    end;
  except
  end;    
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  OleInitialize(nil);

  NewWndProc := MakeObjectInstance(MemoWndProc);
  OldWndProc := Pointer(SetWindowLong(Memo1.Handle, GWL_WNDPROC, LongInt(NewWndProc)));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  SetWindowLong(Memo1.Handle, GWL_WNDPROC, LongInt(OldWndProc));
  FreeObjectInstance(NewWndProc);

  OleUninitialize;
end;

procedure TForm1.MemoWndProc(var Message: TMessage);
begin
  with Message do begin
    if (Msg = WM_LBUTTONDOWN) and (Memo1.SelText <> '') then begin
      DragIt(Memo1.SelText);
      Result := 0;
      Memo1.SelLength := 0;
    end else
      Result := CallWindowProc(OldWndProc, Memo1.Handle, Msg, WParam, LParam);
  end;
end;

procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  with Sender as TMemo do if (Button = mbLeft) and (SelText <> '') then
    DragIt(SelText);
end;

end.





  [COM/OLE] 내 프로그램에서 선택한 text를 다른 프로그램에 Drag&Drop으로 주기  김영대 2004/12/10 5804 1225
410   [COM/OLE] TWebBrowser에서 JavaScript 호출하기  김영대 2004/10/09 5565 1225
409   [일반/컴포넌트] Task bar 에 나타나는 프로그램 아이콘 바꾸기  김영대 2004/08/11 5067 1225
408   [데이터베이스] DB에서 자음(ㄱ,ㄴ,ㄷ....)으로 SELECT 하기  김영대 2003/03/12 5168 1225
407   [일반/컴포넌트] 한글이 포함된 문자열 자르기 - 반쪽 한글  김영대 2003/03/04 6355 1225
406   [윈도우즈 API] 실행중인 모든 프로그램 Minimized 시키기  김영대 2003/03/06 4606 1224
405   [윈도우즈 API] 원도우 이동시 다시 그리기 설정/해제  김영대 2003/03/07 4500 1223
404   [데이터베이스] 테이블,인덱스 복사하기  김영대 2003/03/07 4078 1223
403   [시스템] 윈도우즈 서비스 목록 구하기  김영대 2004/07/22 4521 1222
402   [네트웍/인터넷] Winsock WriteFile and Overlapped IO  김영대 2003/11/18 5384 1222
401   [시스템] 윈도우즈 전체의 키보드 입력 금지  김영대 2003/03/07 4558 1222
400   [멀티미디어] JPEG, WAVE 를 resource 파일에 넣고 읽어오기  김영대 2003/03/06 5137 1222
399   [윈도우즈 API] 정의되지 않은 Alt+키 입력시 Beep음 제거  김영대 2003/03/07 4336 1221
398   [윈도우즈 API] 작업관리자의 task switching 금지시키기  김영대 2003/03/07 4637 1221
397   [일반/컴포넌트] TForm을 BMP파일로 저장하기  김영대 2003/03/05 4809 1221
396   [일반/컴포넌트] 한 장당 두 페이지 인쇄하기  김영대 2003/03/05 4759 1221
395   [윈도우즈 API] 떠다니는 윈도우  김영대 2003/03/05 4540 1220
394   [일반/컴포넌트] LZExpand를 사용한 파일 복사하기  김영대 2003/03/04 4045 1220
393   [시스템] DOS-matrix 프린터에 인쇄하기  김영대 2003/03/07 4519 1219
392   [시스템] Locking/ Unlocking floppy driver or CD  김영대 2003/03/07 4267 1218
391   [시스템] 현재 내 PC의 비디오 정보  김영대 2003/03/04 4565 1218
390   [일반/컴포넌트] Image의 90도 회전  김영대 2003/03/04 5429 1218
389   [시스템] 윈도우즈 캡션의 높이 읽기/설정  김영대 2003/03/07 4436 1217
388   [알고리즘] 임의의 밑수(radix)를 사용한 진법변환  김영대 2004/12/08 4889 1216
387   [일반/컴포넌트] 문자열 프로시저명으로 실제 프로시저 호출하기2  김영대 2004/10/08 4767 1216
386   [윈도우즈 API] Active Desktop 활성화 여부  김영대 2004/08/25 4638 1216
385   [일반/컴포넌트] IE Toolbar 에 버튼 올리기  김영대 2003/03/26 4751 1215
384   [윈도우즈 API] 휴지통에 파일을 버리는 법  신훈재 2003/03/10 4578 1215
383   [윈도우즈 API] Window Handle 로 실행파일명 구하기  김영대 2003/03/07 4700 1215
382   [윈도우즈 API] Taskbar 감추기/보이기  김영대 2003/03/05 4655 1215
381   [일반/컴포넌트] 주어진 문자열에 잘못된 숫자값이 들어있는지 검사  김영대 2003/03/04 4182 1215
380   [일반/컴포넌트] ListView 의 item 을 강제로 편집상태로 만들기  김영대 2003/03/07 4604 1213
379   [일반/컴포넌트] ListBox의 내용을 파일로 저장하고 불러오기  김영대 2003/03/04 4333 1213
378   [시스템] 윈도우즈 부팅 모드(정상, 안전)  김영대 2004/08/05 4250 1212
377   [일반/컴포넌트] Windows의 사용자이름, 작업그룹 구하기  김영대 2003/04/01 4854 1212
376   [일반/컴포넌트] Form이 생성되어 있는지 검사하기  김영대 2003/03/05 4113 1212
375   [윈도우즈 API] 윈도우즈 "시작" 메뉴 표시하기/감추기  김영대 2003/03/07 4532 1211
374   [시스템] 기본 프린터가 있어야 실행하지 ?  김영대 2003/03/05 4568 1211
373   [일반/컴포넌트] TEdit의 OnChange에서 Text 바꾸기  김영대 2003/03/04 4171 1211
372   [일반/컴포넌트] StringGrid의 Column의 크기(width) 자동 조절  김영대 2003/03/04 6628 1211

[이전 10개] [1]..[11][12][13][14] 15 [16][17][18][19][20]..[25] [다음 10개]
 

Copyright 1999-2021 Zeroboard / skin by zero