unit1.pas

一个简单的题库收集以及查询的软件! 直接可以支持IE拖动!

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ExtCtrls, Grids, Wwdbigrd, Wwdbgrid, DBCtrls,
  SUIForm, SUIPageControl, SUITabControl, Buttons, SUIImagePanel, ToolWin,
  DB, ADODB, wwriched,ActiveX, ImgList;

type
  TDragAndDropOLE=Class(TObject,IUnknown,IDropTarget)
  private
   CanDrop:HResult;
   fe:TFormatEtc;//数据的格式，在实现部分给出详细说明
   FRefCount:integer;//引用计数
  protected
   { Iunkown }
   function _AddRef:integer;stdcall;
   function _Release:integer;stdcall;
   function QueryInterface(const IID:TGUID;out Obj):HResult;stdcall;
   { IdropTarget }
   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;
  public
   constructor Create;
   destructor Destroy;override;
  end;

type
  TForm1 = class(TForm)
    suiForm1: TsuiForm;
    suiPageControl1: TsuiPageControl;
    suiTabSheet1: TsuiTabSheet;
    suiTabSheet2: TsuiTabSheet;
    suiPanel1: TsuiPanel;
    lbl1: TLabel;
    edt1: TEdit;
    btn1: TSpeedButton;
    suiPanel2: TsuiPanel;
    wwDBGrid1: TwwDBGrid;
    spl1: TSplitter;
    dbmmo1: TDBMemo;
    lbl2: TLabel;
    suiPanel3: TsuiPanel;
    tlb1: TToolBar;
    btn2: TToolButton;
    btn3: TToolButton;
    btn4: TToolButton;
    btn5: TToolButton;
    btn6: TToolButton;
    btn7: TToolButton;
    btn8: TToolButton;
    dbmmo2: TDBMemo;
    spl2: TSplitter;
    dbmmo3: TDBMemo;
    lbl3: TLabel;
    ds1: TADODataSet;
    ds2: TDataSource;
    ImageList1: TImageList;
    procedure btn2Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure btn4Click(Sender: TObject);
    procedure btn5Click(Sender: TObject);
    procedure btn6Click(Sender: TObject);
    procedure btn7Click(Sender: TObject);
    procedure btn8Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btn1Click(Sender: TObject);
  private
    DragAndDropOLE:TDragAndDropOLE;
  public
    constructor Create(AOwner: TComponent);override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

constructor TDragAndDropOLE.Create;
begin
  FRefCount:=0;
  RegisterDragDrop(Form1.dbmmo2.Handle,self);//上文提到的函数
  RegisterDragDrop(Form1.dbmmo3.Handle,self);//上文提到的函数
end;

destructor TDragAndDropOLE.Destroy;
begin
  RevokeDragDrop(Form1.dbmmo2.Handle);
  RevokeDragDrop(Form1.dbmmo3.Handle);
  inherited;
end;

//接下来实现Iunknown，不再做详细说明：
function TDragAndDropOLE._AddRef: integer;
begin
 result:=InterLockedDecrement(FRefCount);
 if Result=0 then Destroy;
end;
 
function TDragAndDropOLE._Release: integer;
begin
 result:=InterLockedIncrement(FRefCount);
end;
 
function TDragAndDropOLE.QueryInterface(const IID: TGUID;
  out Obj): HResult;
begin
 if GetInterface(IID,Obj) then
  result:=S_OK
 else result:=E_NOINTERFACE;
end;

//最重要的IDropTarget实现：
function TDragAndDropOLE.DragEnter(const dataObj: IDataObject;
  grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
begin
 result:=E_FAIL;
 CanDrop:=E_Fail;
 if assigned(dataObj) then
 begin
  with fe do
  begin
   cfFormat:=CF_TEXT;
   ptd:=nil;
   dwAspect:=DVASPECT_CONTENT;
   lindex:=-1;
   tymed:=TYMED_HGLOBAL;
  end;
  //大家从上面看到的fe是一种我们处理内存数据时常用的转换格式
  //这里它表示将数据格式作为文字（cfFormat），并将其存入一块
  //全局的内存区域（tymed:=TYMED_HGLOBAL），更多的格式请在win32
  //帮助中搜索TFormatEtc
  CanDrop:=dataObj.QueryGetData(fe);//按照fe指定的格式检查数据
  result:=CanDrop;
  if not Failed(result) then
   dwEffect:=DROPEFFECT_COPY
  else dwEffect:=DROPEFFECT_NONE;
  //注意这里我们设置了dwEffect,更多的取值请查看win32帮助
 end;
end;
 
function TDragAndDropOLE.DragLeave: HResult;
begin
 result:=S_OK;
end;
 
function TDragAndDropOLE.DragOver(grfKeyState: Integer; pt: TPoint;
  var dwEffect: Integer): HResult;
begin
 result:=S_OK;
 //我们不需要在这里做其余的操作，当然你可以根据自己的需要完成自己的方法
end;
 
function TDragAndDropOLE.Drop(const dataObj: IDataObject;
  grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var
 medium:stgMedium;
 hData:HGLOBAL;
 handle:THandle;
begin
 result:=E_Fail;
 if not Failed(CanDrop) then
 begin
   result:=dataObj.GetData(fe,medium);
   //按照fe的格式将数据存入内存的一块全局区域，注意medium
   hData:=HGLOBAL(GlobalLock(medium.hGlobal));
   //GlobalLock锁定这块区域，并返回指向它的指针
   handle:=WindowFromPoint(pt);
   if Form1.dbmmo2.Handle=handle then
     Form1.dbmmo2.Text:=pchar(hData)
   else
     Form1.dbmmo3.Text:=pchar(hData);
   GlobalUnlock(hData);//接触锁定
   GlobalFree(hData);//释放
 end;
end;

constructor TForm1.Create(AOwner: TComponent);
begin
  inherited Create(AOWner);
  OleInitialize(nil);
  DragAndDropOLE:=TDragAndDropOLE.Create;
  // TDragAndDropOLE便是我们要实现IDropTarget接口的类
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DragAndDropOLE.Free;
  OleUninitialize;
  inherited;
end;

procedure TForm1.btn2Click(Sender: TObject);
begin
    ds1.Append;
end;

procedure TForm1.btn3Click(Sender: TObject);
begin
  ds1.Post;
end;

procedure TForm1.btn4Click(Sender: TObject);
begin
  ds1.Delete;
end;

procedure TForm1.btn5Click(Sender: TObject);
begin
  ds1.First;
end;

procedure TForm1.btn6Click(Sender: TObject);
begin
  ds1.Prior;
end;

procedure TForm1.btn7Click(Sender: TObject);
begin
  ds1.Next;
end;

procedure TForm1.btn8Click(Sender: TObject);
begin
  ds1.Last;
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
    ds1.Close;
    ds1.CommandText:='select * from 题目 where 题目 like ''%'+edt1.Text+'%''';
    ds1.Open;
end;

end.