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

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


Category

  김영대(2004-12-10 13:08:52, Hit : 5359, Vote : 1099
 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.





971   [윈도우즈 API] 작업 표시줄에 보이는 프로그램의 아이콘 정보  김영대 2008/12/09 5960 1438
970   [윈도우즈 API] 실행 파일의 아이콘 바꾸기  김영대 2008/11/27 7460 1382
969   [네트웍/인터넷] TClientSocket 에 Local IP 바인딩하기  김영대 2008/11/25 6253 1502
968   [알고리즘] Boyer-Moore-Horspool Text Searching  김영대 2008/11/24 5012 1349
967   [일반/컴포넌트] Tab, Shift+Tab 키 이벤트 사용하기  김영대 2008/11/21 4887 1386
966   [일반/컴포넌트] TStringList vs. THashedStringList  김영대 2008/11/04 5199 1371
965   [시스템] 프로세스가 원도우즈 원격 터미널에서 실행중인지 검사  김영대 2008/11/04 5174 1477
964   [시스템] 원도우즈 도메인 이름 구하기  김영대 2008/11/04 5699 1347
963   [시스템] 사용중인 USB 포트의 장치정보 구하기  김영대 2008/11/04 11663 1459
962   [일반/컴포넌트] Treeview의 수평 스크롤바 감추고 스크롤 막기  김영대 2006/03/22 5428 1235
961   [윈도우즈 API] 바탕화면의 모든 창 최소화하기  김영대 2006/02/28 5370 1286
960   [일반/컴포넌트] 일정시간 경과후 없어지는 MessageBox  김영대 2006/02/28 6411 1599
959   [시스템] System의 Idle 상태를 알아내는 API  김영대 2006/02/28 6042 1441
958   [일반/컴포넌트] ListBox에 Edit 올려 항목 편집하기  김영대 2006/02/28 4759 1206
957   [일반/컴포넌트] 폼 흔들기  김영대 2006/02/28 5227 1194
956   [일반/컴포넌트] 마우스로 ProgressBar의 Position 바꾸기  김영대 2006/02/28 4805 1249
955   [일반/컴포넌트] ListBox 드래그하여 아이템 이동하기  김영대 2006/02/28 4852 1181
954   [시스템] 폼의 Move/Resize 시작,종료 이벤트 감지하기  김영대 2006/02/28 5139 1354
953   [COM/OLE] IE의 속성을 변경하여 뛰우기  김영대 2006/02/28 5224 1226
952   [윈도우즈 API] 세로 글꼴 제거한 FontDialog  김영대 2006/02/28 5127 1344
951   [시스템] CPU 이름 구하기2  김영대 2005/09/13 5596 1343
950   [네트웍/인터넷] IP Helper API 를 이용한 네트워크 카드 Enable/Disable 시키기  김영대 2005/09/10 6019 1314
949   [일반/컴포넌트] 폼에 자석효과 주기 (Delphi 6 이하)  김영대 2005/08/04 5962 1292
948   [일반/컴포넌트] 객체의 valid검사 Assigned() 대체  김영대 2005/07/29 4717 1246
947   [시스템] 시스템 대기모드/화면 보호기/모니터 끄기 이벤트 감지하기  김영대 2005/07/21 6752 1482
946   [시스템] 윈도우즈 GUI 기본 폰트정보 구하기  김영대 2005/07/14 5428 1346
945   [시스템] 윈도우즈 입력도구모음의 한/영 토글하기  김영대 2005/06/24 5218 1372
944   [COM/OLE] ActiveForm의 OnDestroy 대용  김영대 2005/04/21 5237 1226
943   [일반/컴포넌트] ListView의 타이틀 폰트 바꾸기  김영대 2005/03/31 5152 1233
942   [일반/컴포넌트] 일정시간 경과후 없어지는 MessageDlg/ShowMessage  김영대 2005/03/26 5820 1268
941   [일반/컴포넌트] 프로그램의 bitmap을 MS 그림판으로 편집하여 다시 불러오기  김영대 2005/03/22 5152 1323
940   [일반/컴포넌트] RichEdit 2.0 줄간격 조정  김영대 2005/02/11 7191 1270
939   [COM/OLE] 탐색기에서 파일을 선택하여 ActiveX(ActiveFortm)에 Drag&Drop 하기  김영대 2005/01/06 7529 1267
938   [윈도우즈 API] TDownloadURL를 사용한 파일 다운받기  김영대 2004/12/26 6365 1262
937   [COM/OLE] TWebBrowser에 직접 HTML 소스코드 넣기  김영대 2004/12/26 6017 1266
936   [윈도우즈 API] 윈도우즈 시스템 전체에서 사용자의 마우스와 키보드 입력이 있는지 검사하기  김영대 2004/12/26 6038 1350
935   [일반/컴포넌트] 다이얼로그 박스가 이미 떠있는지 검사하여 강제로 닫기  김영대 2004/12/22 5030 1212
934   [윈도우즈 API] URLDownloadToFile()를 사용한 파일 다운받기  김영대 2004/12/15 7615 1383
  [COM/OLE] 내 프로그램에서 선택한 text를 다른 프로그램에 Drag&Drop으로 주기  김영대 2004/12/10 5359 1099
932   [COM/OLE] 다른 프로그램에서 선택한 text를 내 프로그램에서 Drag&Drop으로 받기  김영대 2004/12/09 5503 1206

1 [2][3][4][5][6][7][8][9][10]..[25] [다음 10개]
 

Copyright 1999-2017 Zeroboard / skin by zero