dfsrcdem.dpr

这一系列是我平时收集的pascal深入核心编程

program DFSrcDem;

{$R DFSrcDem.res}

uses Windows, Messages, ShellAPI, CommDlg, DFSrc in 'DFSrc.pas';

const
 // 光标资源ID
  IDC_DROPOK = 103;

 // 图标资源ID
  IDI_DFSRCDEMO = 104;

 // 模板资源ID
  IDD_DFSRCDEMO = 105;

 // 控件标识ID 
  IDC_NUMFILES = 1001;
  IDC_SELECTFILES = 1002;
  IDC_PATHNAMELIST = 1003;

 // WM_INITDIALOG消息处理
function DFSrcDemo_OnInitDialog(hWnd, hWndFocus: HWND; lParam: LPARAM): BOOL;
begin
 // 设置窗体图标
  SendMessage(hWnd, WM_SETICON, ICON_BIG, LoadIcon(HInstance, MakeIntResource(IDI_DFSRCDEMO)));

 // 加水平滚动条
  SendMessage(GetDlgItem(hWnd, IDC_PATHNAMELIST),
    LB_SETHORIZONTALEXTENT, MAX_PATH * LOWORD(GetDialogBaseUnits()), 0);

 // 接受默认焦点
  Result := TRUE;
end;

 // WM_COMMAND消息处理
procedure DFSrcDemo_OnCommand(hWnd: HWND; id: Integer; hWndCtl: HWND; codeNotify: UINT);
var
  szAllFileNames: array[0..1024] of Char;
  szPathname: array[0..MAX_PATH] of Char;
  ofn: TOpenFilename;
  nNumFiles, nIndex: Integer;
  hWndLB: LongWord; // HWND
begin
  case (id) of
    IDCANCEL: // 关闭对话框
      begin
        EndDialog(hWnd, id);
      end;

    IDC_SELECTFILES: // 选择文件
      begin
       // 清空ListBox
        hWndLB := GetDlgItem(hWnd, IDC_PATHNAMELIST);
        SendMessage(hWndLB, LB_RESETCONTENT, 0, 0);

       // 初始化ofn结构
        ZeroMemory(@ofn, SizeOf(TOpenFilename));
        ofn.lStructSize := SizeOf(TOpenFilename);

        ofn.hwndOwner := hWnd;
        ofn.lpstrFilter := 'All files'#0'*.*'#0;
        ofn.Flags := OFN_ALLOWMULTISELECT or OFN_FILEMUSTEXIST or OFN_HIDEREADONLY or OFN_EXPLORER;

        szAllFileNames[0] := #0;
        ofn.lpstrFile := @szAllFileNames[0];
        ofn.nMaxFile := SizeOf(szAllFileNames);

       // 选择了文件
        if GetOpenFileName(ofn) then
        begin
         // 选择文件的数量
          nNumFiles := FileOpenUtil_GetNumFiles(@ofn);

         // 添加至ListBox
          for nIndex := 0 to nNumFiles - 1 do
          begin
            FileOpenUtil_GetFile(@ofn, nIndex, szPathname);
            SendMessage(hWndLB, LB_ADDSTRING, 0, Integer(@szPathname[0]));
          end;
        end else
        begin
          nNumFiles := 0;
        end;

       // 选择文件的数量
        SetDlgItemInt(hWnd, IDC_NUMFILES, nNumFiles, FALSE);
      end;
  end; // END: case (id) of
end;

 // WM_LBUTTONDOWN消息处理
procedure DFSrcDemo_OnLButtonDown(hWnd: HWND; fDoubleClick: BOOL; nIndex, y: Integer; keyFlags: UINT);
begin
  if SendMessage(GetDlgItem(hWnd, IDC_PATHNAMELIST), LB_GETCOUNT, 0, 0) = 0 then
   // 文件列表为空
    MessageBox(GetActiveWindow(), 'No files to drop.', 'DFSrcDem', 0)
  else
   // 捕获鼠标消息
    SetCapture(hWnd);
end;

 // WM_MOUSEMOVE消息处理
procedure DFSrcDemo_OnMouseMove(hWnd: HWND; x, y: Integer; keyFlags: UINT);
begin
 // 鼠标并未按下(说明不是'拖拽')
  if (GetCapture() <> hWnd) then Exit;

 // 根据鼠标下窗体的风格设置光标
  if IsWindow(DFSrc_OkToDrop(nil)) then
    SetCursor(LoadCursor(HInstance, MakeIntResource(IDC_DROPOK)))
  else
    SetCursor(LoadCursor(0, IDC_NO));
end;

 // WM_LBUTTONUP消息处理
procedure DFSrcDemo_OnLButtonUp(hWnd: HWND; x, y: Integer; keyFlags: UINT);
var
  hWndTarget, hWndLB: LongWord; // HWND
  rc: TRect;
  ptMousePos: TPoint; // **
  nIndex, nNumFiles: Integer;
  hdrop, hdropT: Longint; // HDROP
  szPathName: array[0..MAX_PATH] of Char;
begin
 // 之前并非拖拽状态
  if (GetCapture() <> hWnd) then Exit;

 // 释放鼠标消息捕捉
  ReleaseCapture();

 // 文件拖放目标窗口
  GetCursorPos(ptMousePos); // **
  hWndTarget := DFSrc_OkToDrop(@ptMousePos);

 // 如果窗口句柄非法
  if (IsWindow(hWndTarget) = FALSE) then Exit;

 // 窗口客户区范围
  GetClientRect(hWndTarget, rc);
  ScreenToClient(hWndTarget, ptMousePos);

 // 分配内存并初始化
  hdrop := DFSrc_Create(@ptMousePos, not PtInRect(rc, ptMousePos), FALSE);
  if (hdrop = 0) then
  begin
    MessageBox(GetActiveWindow(), 'Insufficient memory to drop file(s).', 'DFSrcDem', 0);
    Exit;
  end;

 // ListBox文件数量
  hWndLB := GetDlgItem(hWnd, IDC_PATHNAMELIST);
  nNumFiles := SendMessage(GetDlgItem(hWnd, IDC_PATHNAMELIST), LB_GETCOUNT, 0, 0);
  
 // 添加文件列表
  for nIndex := 0 to nNumFiles - 1 do
  begin
    SendMessage(hWndLB, LB_GETTEXT, nIndex, Integer(@szPathName[0]));
    hdropT := DFSrc_AppendPathname(hdrop, @szPathName[0]);

    if (hdropT = 0) then
    begin
      MessageBox(GetActiveWindow(), 'Insufficient memory to drop file(s).', 'DFSrcDem', 0);
      hdrop := GlobalFree(hdrop);
      Break; // Terminates the 'for' loop.
    end else
    begin
      hdrop := hdropT;
    end;
  end;

 // 添加文件列表成功
  if (hdrop <> 0) then
  begin
   // 向拖放目标发消息
    PostMessage(hWndTarget, WM_DROPFILES, hdrop, 0);

   // 清空文件列表
    SetDlgItemInt(hWnd, IDC_NUMFILES, 0, FALSE);
    SendMessage(hWndLB, LB_RESETCONTENT, 0, 0);

   // 注意: 我们不应该用 GlobalFree(hdrop) 来释放这块内存,
   // 系统会在目标进程空间重新分配内存并作拷贝之后自动释放,
   // 新的内存块, 由目标进程负责调用DragFinish()来释放 ..
  end;
end;

 // 对话框消息处理回调
function DFSrcDemo_Proc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL; stdcall;
begin
  case (uMsg) of
    WM_INITDIALOG:
      begin
        Result := BOOL(SetWindowLong(hWnd, DWL_MSGRESULT,
          Longint(DFSrcDemo_OnInitDialog(hWnd, wParam, lParam))));
      end;

    WM_COMMAND:
      begin
        DFSrcDemo_OnCommand(hWnd, LOWORD(wParam), lParam, HIWORD(wParam));
        Result := TRUE;
      end;

    WM_LBUTTONDOWN:
      begin
        DFSrcDemo_OnLButtonDown(hWnd, FALSE, LOWORD(lParam), HIWORD(lParam), wParam);
        Result := TRUE;
      end;

    WM_MOUSEMOVE:
      begin
        DFSrcDemo_OnMouseMove(hWnd, LOWORD(lParam), HIWORD(lParam), wParam);
        Result := TRUE;
      end;

    WM_LBUTTONUP:
      begin
        DFSrcDemo_OnLButtonUp(hWnd, LOWORD(lParam), HIWORD(lParam), wParam);
        Result := TRUE;
      end;

    else Result := FALSE;
  end;
end;

 // 程序'主线程'入口
begin
  DialogBox(HInstance, MakeIntResource(IDD_DFSRCDEMO), 0, @DFSrcDemo_Proc);
end.