Lazarus中文社区

 找回密码
 立即注册(注册审核可向QQ群索取)

QQ登录

只需一步,快速开始

Lazarus IDE and 组件 下载地址版权申明
查看: 1994|回复: 0

没法调用shlobj里的函数

[复制链接]

该用户从未签到

发表于 2012-3-4 20:36:04 | 显示全部楼层 |阅读模式
uses
  shlobj;
///////////////////////////////////////////////////////////////////
// Call back function used to set the initial browse directory.
///////////////////////////////////////////////////////////////////
var
  lg_StartFolder: string;

function BrowseForFolderCallBack(Wnd: HWND; uMsg: UINT;
  lParam, lpData: LPARAM): Integer stdcall;
begin
  if uMsg = BFFM_INITIALIZED then
    SendMessage(Wnd, BFFM_SETSELECTION, 1, Integer(@lg_StartFolder[1]));
  result := 0;
end;

///////////////////////////////////////////////////////////////////
// This function allows the user to browse for a folder
//(* 转载敬请注明-本文出处:南山古桃(nsgtao)的百度空间:http://hi.baidu.com/nsgtao/ *)
// Arguments:-
// browseTitle : The title to display on the browse dialog.
// initialFolder : Optional argument. Use to specify the folder
// initially selected when the dialog opens.
//
// Returns: The empty string if no folder was selected ( i.e. if the
// user clicked cancel), otherwise the full folder path.
///////////////////////////////////////////////////////////////////

function BrowseForFolder(ModalHandle: HWND; const browseTitle: string;
  const initialFolder: string = ''): string;
const
  BIF_NEWDIALOGSTYLE = $40;
var
  browse_info: TBrowseInfo;
  folder: array[0..MAX_PATH] of char;
  find_context: PItemIDList;
begin
  FillChar(browse_info, SizeOf(browse_info), #0);
  lg_StartFolder := initialFolder;
  browse_info.hwndOwner := ModalHandle;
  browse_info.pszDisplayName := @folder[0];
  browse_info.lpszTitle := PChar(browseTitle);
  browse_info.ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
  if initialFolder <> '' then
    browse_info.lpfn := BrowseForFolderCallBack;
  find_context := SHBrowseForFolder(browse_info);
  if Assigned(find_context) then
  begin
    if SHGetPathFromIDList(find_context, folder) then
      result := folder
    else
      result := '';
    GlobalFreePtr(find_context);
  end
  else
    result := '';
end;

procedure TfrmMain.btnAddPathClick(Sender: TObject);
var
  Path: string;
begin
  Path := BrowseForFolder(Handle, '', ''); //启动Windows目录对话框,一句话就解决了。
  if Path <> '' then //如果返回地址为空,则报错
  begin
    ShowMessage(Path); //保存当次的最后路径;
  end;
end;

上面这个函数是打开浏览目录对话框的,在delphi7里只要引用shlobj就行了,可是移植到lazarus时,
TBrowseInfo等结构定义在Lazarus中的shlobj中没有,只在struct.inc里定义了,那么我该怎么引用这些结构呢?
回复

使用道具 举报

*滑块验证:

本版积分规则

QQ|手机版|小黑屋|Lazarus中国|Lazarus中文社区 ( 鄂ICP备16006501号-1 )

GMT+8, 2025-5-3 08:23 , Processed in 0.027586 second(s), 10 queries , Redis On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表