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

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


Category

  김영대(2005-01-06 16:02:57, Hit : 7529, Vote : 1267
 http://www.howto.pe.kr
 탐색기에서 파일을 선택하여 ActiveX(ActiveFortm)에 Drag&Drop 하기

// 탐색기의 여러 파일을 인터넷 익스플로러내에 있는 ActiveX (ActiveForm)에 드롭하는 것입니다
// 뿐만 아니라 윈도우즈 메모장 같은 데서 문장을 선택하여 마찬가지로 드롭할 수 있습니다

unit ActiveFormImpl1;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ActiveX, AxCtrls, ActiveFormProj1_TLB, StdVcl, StdCtrls, ComObj, ComServ,
  ShellAPI, ShlObj;

type
  TActiveFormX = class(TActiveForm, IActiveFormX)
    procedure ActiveFormCreate(Sender: TObject);
    procedure ActiveFormDestroy(Sender: TObject);
  private
    { Private declarations }
    FEvents: IActiveFormXEvents;
    procedure ActivateEvent(Sender: TObject);
    procedure ClickEvent(Sender: TObject);
    procedure CreateEvent(Sender: TObject);
    procedure DblClickEvent(Sender: TObject);
    procedure DeactivateEvent(Sender: TObject);
    procedure DestroyEvent(Sender: TObject);
    procedure KeyPressEvent(Sender: TObject; var Key: Char);
    procedure PaintEvent(Sender: TObject);
  protected
    { Protected declarations }
    procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
    procedure EventSinkChanged(const EventSink: IUnknown); override;
    function Get_Active: WordBool; safecall;
    function Get_AlignDisabled: WordBool; safecall;
    function Get_AutoScroll: WordBool; safecall;
    function Get_AutoSize: WordBool; safecall;
    function Get_AxBorderStyle: TxActiveFormBorderStyle; safecall;
    function Get_Caption: WideString; safecall;
    function Get_Color: OLE_COLOR; safecall;
    function Get_DoubleBuffered: WordBool; safecall;
    function Get_DropTarget: WordBool; safecall;
    function Get_Enabled: WordBool; safecall;
    function Get_Font: IFontDisp; safecall;
    function Get_HelpFile: WideString; safecall;
    function Get_KeyPreview: WordBool; safecall;
    function Get_PixelsPerInch: Integer; safecall;
    function Get_PrintScale: TxPrintScale; safecall;
    function Get_Scaled: WordBool; safecall;
    function Get_ScreenSnap: WordBool; safecall;
    function Get_SnapBuffer: Integer; safecall;
    function Get_Visible: WordBool; safecall;
    function Get_VisibleDockClientCount: Integer; safecall;
    procedure _Set_Font(var Value: IFontDisp); safecall;
    procedure Set_AutoScroll(Value: WordBool); safecall;
    procedure Set_AutoSize(Value: WordBool); safecall;
    procedure Set_AxBorderStyle(Value: TxActiveFormBorderStyle); safecall;
    procedure Set_Caption(const Value: WideString); safecall;
    procedure Set_Color(Value: OLE_COLOR); safecall;
    procedure Set_DoubleBuffered(Value: WordBool); safecall;
    procedure Set_DropTarget(Value: WordBool); safecall;
    procedure Set_Enabled(Value: WordBool); safecall;
    procedure Set_Font(const Value: IFontDisp); safecall;
    procedure Set_HelpFile(const Value: WideString); safecall;
    procedure Set_KeyPreview(Value: WordBool); safecall;
    procedure Set_PixelsPerInch(Value: Integer); safecall;
    procedure Set_PrintScale(Value: TxPrintScale); safecall;
    procedure Set_Scaled(Value: WordBool); safecall;
    procedure Set_ScreenSnap(Value: WordBool); safecall;
    procedure Set_SnapBuffer(Value: Integer); safecall;
    procedure Set_Visible(Value: WordBool); safecall;
  public
    { Public declarations }
    procedure Initialize; override;
  end;

  TMyDragDrop = class(TInterfacedObject, IDropTarget)
  private
    FDrop: THandle;
  public
    constructor Create;
    function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
      pt: TPoint; var dwEffect: Longint): HResult; stdcall;
    function DragOver(grfKeyState: Longint; pt: TPoint;
      var dwEffect: Longint): HResult; stdcall;
    function DragLeave: HResult; stdcall;
    function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
      var dwEffect: Longint): HResult; stdcall;
    function DEffectFromKeyState(grfKeyState: Longint): Longint;
  end;

implementation
{$R *.DFM}

{ TActiveFormX }

procedure TActiveFormX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
begin
  { Define property pages here.  Property pages are defined by calling
    DefinePropertyPage with the class id of the page.  For example,
      DefinePropertyPage(Class_ActiveFormXPage); }
end;

procedure TActiveFormX.EventSinkChanged(const EventSink: IUnknown);
begin
  FEvents := EventSink as IActiveFormXEvents;
  inherited EventSinkChanged(EventSink);
end;

procedure TActiveFormX.Initialize;
begin
  inherited Initialize;
  OnActivate := ActivateEvent;
  OnClick := ClickEvent;
  OnCreate := CreateEvent;
  OnDblClick := DblClickEvent;
  OnDeactivate := DeactivateEvent;
  OnDestroy := DestroyEvent;
  OnKeyPress := KeyPressEvent;
  OnPaint := PaintEvent;
end;

function TActiveFormX.Get_Active: WordBool;
begin
  Result := Active;
end;

function TActiveFormX.Get_AlignDisabled: WordBool;
begin
  Result := AlignDisabled;
end;

function TActiveFormX.Get_AutoScroll: WordBool;
begin
  Result := AutoScroll;
end;

function TActiveFormX.Get_AutoSize: WordBool;
begin
  Result := AutoSize;
end;

function TActiveFormX.Get_AxBorderStyle: TxActiveFormBorderStyle;
begin
  Result := Ord(AxBorderStyle);
end;

function TActiveFormX.Get_Caption: WideString;
begin
  Result := WideString(Caption);
end;

function TActiveFormX.Get_Color: OLE_COLOR;
begin
  Result := OLE_COLOR(Color);
end;

function TActiveFormX.Get_DoubleBuffered: WordBool;
begin
  Result := DoubleBuffered;
end;

function TActiveFormX.Get_DropTarget: WordBool;
begin
  Result := DropTarget;
end;

function TActiveFormX.Get_Enabled: WordBool;
begin
  Result := Enabled;
end;

function TActiveFormX.Get_Font: IFontDisp;
begin
  GetOleFont(Font, Result);
end;

function TActiveFormX.Get_HelpFile: WideString;
begin
  Result := WideString(HelpFile);
end;

function TActiveFormX.Get_KeyPreview: WordBool;
begin
  Result := KeyPreview;
end;

function TActiveFormX.Get_PixelsPerInch: Integer;
begin
  Result := PixelsPerInch;
end;

function TActiveFormX.Get_PrintScale: TxPrintScale;
begin
  Result := Ord(PrintScale);
end;

function TActiveFormX.Get_Scaled: WordBool;
begin
  Result := Scaled;
end;

function TActiveFormX.Get_ScreenSnap: WordBool;
begin
  Result := ScreenSnap;
end;

function TActiveFormX.Get_SnapBuffer: Integer;
begin
  Result := SnapBuffer;
end;

function TActiveFormX.Get_Visible: WordBool;
begin
  Result := Visible;
end;

function TActiveFormX.Get_VisibleDockClientCount: Integer;
begin
  Result := VisibleDockClientCount;
end;

procedure TActiveFormX._Set_Font(var Value: IFontDisp);
begin
  SetOleFont(Font, Value);
end;

procedure TActiveFormX.ActivateEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnActivate;
end;

procedure TActiveFormX.ClickEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnClick;
end;

procedure TActiveFormX.CreateEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnCreate;
end;

procedure TActiveFormX.DblClickEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDblClick;
end;

procedure TActiveFormX.DeactivateEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDeactivate;
end;

procedure TActiveFormX.DestroyEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDestroy;
end;

procedure TActiveFormX.KeyPressEvent(Sender: TObject; var Key: Char);
var
  TempKey: Smallint;
begin
  TempKey := Smallint(Key);
  if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  Key := Char(TempKey);
end;

procedure TActiveFormX.PaintEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnPaint;
end;

procedure TActiveFormX.Set_AutoScroll(Value: WordBool);
begin
  AutoScroll := Value;
end;

procedure TActiveFormX.Set_AutoSize(Value: WordBool);
begin
  AutoSize := Value;
end;

procedure TActiveFormX.Set_AxBorderStyle(Value: TxActiveFormBorderStyle);
begin
  AxBorderStyle := TActiveFormBorderStyle(Value);
end;

procedure TActiveFormX.Set_Caption(const Value: WideString);
begin
  Caption := TCaption(Value);
end;

procedure TActiveFormX.Set_Color(Value: OLE_COLOR);
begin
  Color := TColor(Value);
end;

procedure TActiveFormX.Set_DoubleBuffered(Value: WordBool);
begin
  DoubleBuffered := Value;
end;

procedure TActiveFormX.Set_DropTarget(Value: WordBool);
begin
  DropTarget := Value;
end;

procedure TActiveFormX.Set_Enabled(Value: WordBool);
begin
  Enabled := Value;
end;

procedure TActiveFormX.Set_Font(const Value: IFontDisp);
begin
  SetOleFont(Font, Value);
end;

procedure TActiveFormX.Set_HelpFile(const Value: WideString);
begin
  HelpFile := String(Value);
end;

procedure TActiveFormX.Set_KeyPreview(Value: WordBool);
begin
  KeyPreview := Value;
end;

procedure TActiveFormX.Set_PixelsPerInch(Value: Integer);
begin
  PixelsPerInch := Value;
end;

procedure TActiveFormX.Set_PrintScale(Value: TxPrintScale);
begin
  PrintScale := TPrintScale(Value);
end;

procedure TActiveFormX.Set_Scaled(Value: WordBool);
begin
  Scaled := Value;
end;

procedure TActiveFormX.Set_ScreenSnap(Value: WordBool);
begin
  ScreenSnap := Value;
end;

procedure TActiveFormX.Set_SnapBuffer(Value: Integer);
begin
  SnapBuffer := Value;
end;

procedure TActiveFormX.Set_Visible(Value: WordBool);
begin
  Visible := Value;
end;

constructor TMyDragDrop.Create;
begin
  inherited Create;
  FDrop := 0;
end;

function TMyDragDrop.DEffectFromKeyState(grfKeyState: Longint): Longint;
begin
  if grfKeyState and MK_SHIFT <> 0 then Result := DROPEFFECT_MOVE
  else Result := DROPEFFECT_COPY;
end;


function TMyDragDrop.DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
      pt: TPoint; var dwEffect: Longint): HResult;
var
  FormatEtc: TFormatEtc;
begin
  Result := E_FAIL;
  dwEffect := DROPEFFECT_NONE;
  if dataObj <> nil then
  begin
    // 탐색기의 파일 drag
    with FormatEtc do
    begin
      cfFormat:= CF_HDROP;
      ptd:= nil;
      dwAspect := DVASPECT_CONTENT;
      lIndex:= -1;
      tymed:= TYMED_HGLOBAL
    end;
    if dataObj.QueryGetData(FormatEtc) = S_Ok then
    begin
      Result := S_Ok;
      dwEffect:= DEffectFromKeyState(grfKeyState);
      Exit;
    end;

    // 선택한 텍스트의 drag
    // 예, 윈도우즈의 워드패드에서 단어를 선택해서 드롭하는 경우
    FormatEtc.cfFormat:= CF_TEXT;
    if dataObj.QueryGetData(FormatEtc) = S_Ok then
    begin
      Result := S_Ok;
      dwEffect:= DEffectFromKeyState(grfKeyState);
      Exit;
    end;
  end;
end;

function TMyDragDrop.DragOver(grfKeyState: Longint; pt: TPoint;
      var dwEffect: Longint): HResult;
begin
  Result := S_OK;
  dwEffect := DEffectFromKeyState(grfKeyState);
end;

function TMyDragDrop.DragLeave: HResult;
begin
  Result := S_OK;
  DragFinish(FDrop);
  FDrop := 0;
end;

function TMyDragDrop.Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
      var dwEffect: Longint): HResult;
var
  FormatEtc: TFormatEtc;
  medium: TStgMedium;
  hData: HGLOBAL;
  buffer: array [0..MAX_PATH] of Char;
  i, numFiles: Integer;
begin
  Result := E_FAIL;
  dwEffect := DROPEFFECT_NONE;

  if dataObj <> nil then
  begin
    with FormatEtc do
    begin
      cfFormat:= CF_HDROP;
      ptd:= nil;
      dwAspect := DVASPECT_CONTENT;
      lIndex:= -1;
      tymed:= TYMED_HGLOBAL
    end;
    if dataObj.QueryGetData(FormatEtc) = S_Ok then // 탐색기의 파일 drop
    begin
      Result := S_Ok;
      dwEffect:= DEffectFromKeyState(grfKeyState);
      
      dataObj.GetData(FormatEtc, medium);
      hData := HGLOBAL(GlobalLock(medium.hGlobal));
      try
        numFiles := DragQueryFile(hData, $FFFFFFFF, nil, 0);
        showmessage('총 드롭되는 파일의 갯수: '+inttostr(numFiles));

        for i := 0 to numFiles-1 do
        begin
          buffer[0] := #0;
          DragQueryFile(medium.hGlobal, i, buffer, SizeOf(buffer));
          showmessage(inttostr(i+1)+' 번째 파일: '+StrPas(buffer));
        end;
      finally
        GlobalUnlock(hData);
        GlobalFree(hData);
      end;  
    end
    else
    begin
      FormatEtc.cfFormat:= CF_TEXT;
      if dataObj.QueryGetData(FormatEtc) = S_Ok then // 선택한 텍스트의 drop
      begin
        Result := S_Ok;
        dwEffect:= DEffectFromKeyState(grfKeyState);

        dataObj.GetData(FormatEtc, medium);
        hData := HGLOBAL(GlobalLock(medium.hGlobal));
        try
          showmessage('텍스트 드롭: '+StrPas(pchar(hData)));
        finally
          GlobalUnlock(hData);
          GlobalFree(hData);
        end;
      end;
    end;  
  end;

  DragFinish(FDrop);
  FDrop := 0;
end;

procedure TActiveFormX.ActiveFormCreate(Sender: TObject);
var
  dd: TMyDragDrop;
  res: HRESULT;
  res1: Integer;
begin
  OleInitialize(NIL);
  dd := TMyDragDrop.Create;
  res1 := CoLockObjectExternal(dd, true, false);
  res := RegisterDragDrop(Handle, dd);
end;

procedure TActiveFormX.ActiveFormDestroy(Sender: TObject);
begin
  RevokeDragDrop(Handle);
  OLEUninitialize;
end;

initialization
  TActiveFormFactory.Create(
    ComServer,
    TActiveFormControl,
    TActiveFormX,
    Class_ActiveFormX,
    1,
    '',
    OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL,
    tmApartment);
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 4888 1386
966   [일반/컴포넌트] TStringList vs. THashedStringList  김영대 2008/11/04 5199 1371
965   [시스템] 프로세스가 원도우즈 원격 터미널에서 실행중인지 검사  김영대 2008/11/04 5175 1477
964   [시스템] 원도우즈 도메인 이름 구하기  김영대 2008/11/04 5699 1347
963   [시스템] 사용중인 USB 포트의 장치정보 구하기  김영대 2008/11/04 11664 1459
962   [일반/컴포넌트] Treeview의 수평 스크롤바 감추고 스크롤 막기  김영대 2006/03/22 5428 1235
961   [윈도우즈 API] 바탕화면의 모든 창 최소화하기  김영대 2006/02/28 5371 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 4853 1181
954   [시스템] 폼의 Move/Resize 시작,종료 이벤트 감지하기  김영대 2006/02/28 5140 1354
953   [COM/OLE] IE의 속성을 변경하여 뛰우기  김영대 2006/02/28 5224 1226
952   [윈도우즈 API] 세로 글꼴 제거한 FontDialog  김영대 2006/02/28 5127 1344
951   [시스템] CPU 이름 구하기2  김영대 2005/09/13 5597 1343
950   [네트웍/인터넷] IP Helper API 를 이용한 네트워크 카드 Enable/Disable 시키기  김영대 2005/09/10 6019 1314
949   [일반/컴포넌트] 폼에 자석효과 주기 (Delphi 6 이하)  김영대 2005/08/04 5963 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 5153 1233
942   [일반/컴포넌트] 일정시간 경과후 없어지는 MessageDlg/ShowMessage  김영대 2005/03/26 5820 1268
941   [일반/컴포넌트] 프로그램의 bitmap을 MS 그림판으로 편집하여 다시 불러오기  김영대 2005/03/22 5153 1323
940   [일반/컴포넌트] RichEdit 2.0 줄간격 조정  김영대 2005/02/11 7191 1270
  [COM/OLE] 탐색기에서 파일을 선택하여 ActiveX(ActiveFortm)에 Drag&Drop 하기  김영대 2005/01/06 7529 1267
938   [윈도우즈 API] TDownloadURL를 사용한 파일 다운받기  김영대 2004/12/26 6366 1262
937   [COM/OLE] TWebBrowser에 직접 HTML 소스코드 넣기  김영대 2004/12/26 6018 1266
936   [윈도우즈 API] 윈도우즈 시스템 전체에서 사용자의 마우스와 키보드 입력이 있는지 검사하기  김영대 2004/12/26 6038 1350
935   [일반/컴포넌트] 다이얼로그 박스가 이미 떠있는지 검사하여 강제로 닫기  김영대 2004/12/22 5030 1212
934   [윈도우즈 API] URLDownloadToFile()를 사용한 파일 다운받기  김영대 2004/12/15 7615 1383
933   [COM/OLE] 내 프로그램에서 선택한 text를 다른 프로그램에 Drag&Drop으로 주기  김영대 2004/12/10 5360 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