当前位置:主页>销售管理软件> 列表

奇怪的问题,程序一运行就出错,请高手指点 找个人记账软件下载

库存管理软件版1楼: 做了一个小游戏菜单,可是一按button按钮程序就出错
请高手指点如何避免此问题,谢谢。

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls, ToolWin, ShlObj, ImgList, Menus;

type
PShellItem = ^TShellItem;
TShellItem = record
FullID,
ID: PItemIDList;
Empty: Boolean;
DisplayName,
TypeName: string;
ImageIndex,
Size,
Attributes: Integer;
ModDate: string;
end;


TForm1 = class(TForm)
TabControl1: TTabControl;
ListView: TListView;
ImageList1: TImageList;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure ListViewDblClick(Sender: TObject);
private
FIShellFolder, FIDesktopFolder: IShellFolder;
FIDList: TList;
FPIDL: PItemIDList;
FPath: string;
cbPath: TComboBox;
public
procedure SetPath(const Value: string); overload;

procedure SetPath(ID: PItemIDList); overload;
procedure PopulateIDList(ShellFolder: IShellFolder);
procedure ClearIDList;
function ShellItem(Index: Integer): PShellItem;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
uses ShellAPI, ActiveX, ComObj, CommCtrl;

function GetDisplayName(ShellFolder: IShellFolder; PIDL: PItemIDList;
ForParsing: Boolean): string;
var
StrRet: TStrRet;
P: PChar;
Flags: Integer;
begin
Result := '''';
if ForParsing then
Flags := SHGDN_FORPARSING
else
Flags := SHGDN_NORMAL;

ShellFolder.GetDisplayNameOf(PIDL, Flags, StrRet);
case StrRet.uType of
STRRET_CSTR:
SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr));
STRRET_OFFSET:
begin
P := @PIDL.mkid.abID[StrRet.uOffset - SizeOf(PIDL.mkid.cb)];
SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset);


end;
STRRET_WSTR:
Result := StrRet.pOleStr;
end;
end;

function ListSortFunc(Item1, Item2: Pointer): Integer;
begin
Result := SmallInt(Form1.FIShellFolder.CompareIDs(
0,
PShellItem(Item1).ID,
PShellItem(Item2).ID
));
end;

procedure DisposePIDL(ID: PItemIDList);
var
Malloc: IMalloc;
begin
if ID = nil then Exit;
OLECheck(SHGetMalloc(Malloc));
Malloc.Free(ID);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
setpath(''d:\'');
end;

procedure TForm1.ListViewDblClick(Sender: TObject);
begin

if listview.Selected <>nil then
begin
showmessage(listview.selected.Caption)
end;

end;

procedure TForm1.SetPath(const Value: string);
var
P: PWideChar;
NewPIDL: PItemIDList;
Flags,
NumChars: LongWord;
begin
NumChars := Length(Value);
Flags := 0;
P := StringToOleStr(Value);

FIDesktopFolder.ParseDisplayName(Application.Handle,nil,P,NumChars,NewPIDL,Flags);
SetPath(NewPIDL);
end;




procedure TForm1.PopulateIDList(ShellFolder: IShellFolder);
const
Flags = SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or

SHCONTF_INCLUDEHIDDEN;
var
ID: PItemIDList;
EnumList: IEnumIDList;
NumIDs: LongWord;
SaveCursor: TCursor;
ShellItem: PShellItem;
begin
SaveCursor := Screen.Cursor;
try
Screen.Cursor := crHourglass;
OleCheck(
ShellFolder.EnumObjects(
Application.Handle,
Flags,
EnumList)
);

FIShellFolder := ShellFolder;
ClearIDList;
while EnumList.Next(1, ID, NumIDs) = S_OK do
begin
ShellItem := New(PShellItem);
ShellItem.ID := ID;
ShellItem.DisplayName := GetDisplayName(FIShellFolder, ID,False);
ShellItem.Empty := True;
FIDList.Add(ShellItem);
end;

FIDList.Sort(ListSortFunc);

//We need to tell the ListView how many items it has.
ListView.Items.Count := FIDList.Count;

ListView.Repaint;
finally
Screen.Cursor := SaveCursor;
end;
end;

procedure TForm1.SetPath(ID: PItemIDList);
var
Index: Integer;
NewShellFolder: IShellFolder;
begin
OLECheck(
FIDesktopFolder.BindToObject(
ID,
nil,
IID_IShellFolder,
Pointer(NewShellFolder))
);

ListView.Items.BeginUpdate;
try
PopulateIDList(NewShellFolder);
FPIDL := ID;
FPath := GetDisplayName(FIDesktopFolder, FPIDL, True);
Index := cbPath.Items.IndexOf(FPath);
if (Index < 0) then
begin
cbPath.Items.InsertObject(0, FPath, Pointer(FPIDL));
cbPath.Text := cbPath.Items[0];
end
else begin
cbPath.ItemIndex := Index;
cbPath.Text := cbPath.Items[cbPath.ItemIndex];
end;

if ListView.Items.Count > 0 then
begin
ListView.Selected := ListView.Items[0];
ListView.Selected.Focused := True;
ListView.Selected.MakeVisible(False);
end;
finally
ListView.Items.EndUpdate;
end;
end;

procedure TForm1.ClearIDList;
var
I: Integer;
begin
for I := 0 to FIDList.Count-1 do
begin
DisposePIDL(ShellItem(I).ID);
Dispose(ShellItem(I));
end;
FIDList.Clear;
end;


function TForm1.ShellItem(Index: Integer): PShellItem;
begin
Result := PShellItem(FIDList[Index]);
end;


end.

2楼: 自己顶一下,顶到高手出来 如个人记账软件下载

3楼: SetPath(const Value: string);
改为
SetPath(Value: string); 试试

4楼: 还是不行

5楼: Button里写什么了
提示什么错误

6楼: 是這個有問題,你要修改一下:
FIDesktopFolder.ParseDisplayName(Application.Handle,nil,P,NumChars,NewPIDL,Flags);

库存管理软件版7楼: 请问高手如何修改?
我是菜鸟,请多多包含

8楼: 真的没有人知道?

9楼: 自己逐行跟踪调试一下吧。