Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- a form3 contain button and virtualtreeview
- unit Unit3;
- interface
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, ImgList, StdCtrls, VirtualTrees, Contnrs;
- type
- TForm3 = class(TForm)
- VirtualStringTree1: TVirtualStringTree;
- Button1: TButton;
- ImageList1: TImageList;
- procedure Button1Click(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure VirtualStringTree1GetNodeDataSize(Sender: TBaseVirtualTree;
- var NodeDataSize: Integer);
- procedure VirtualStringTree1GetImageIndex(Sender: TBaseVirtualTree;
- Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
- var Ghosted: Boolean; var ImageIndex: Integer);
- procedure VirtualStringTree1GetText(Sender: TBaseVirtualTree;
- Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
- var CellText: string);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
- TFile = class(TObject)
- private
- FFullPath: string;
- FFileName: string;
- FIconIndex: Integer;
- FFileIcon : hIcon;
- public
- constructor Create(Path: string);
- property FullPath: string read FFullPath write FFullPath;
- property FileName: string read FFileName write FFileName;
- property IconIndex: Integer read FIconIndex write FIconIndex;
- property FileIcon: hIcon read FFileIcon write FFileIcon;
- end;
- TFiles = class(TObjectList)
- private
- function SameIcon(HIcon1, HIcon2: HIcon): Boolean;
- function StreamsAreIdentical(Stream1, Stream2: TStream): Boolean;
- public
- function Add(Path: string): TFile; reintroduce;
- end;
- PFileNode =^TFileNode;
- TFileNode = record
- FileObj: TFile;
- end;
- var
- Form3: TForm3;
- Files: TFiles;
- implementation
- uses ShellApi, CommCtrl;
- {$R *.dfm}
- procedure TForm3.Button1Click(Sender: TObject);
- var
- i: Integer;
- OpenDialog: TOpenDialog;
- FileRec: PFileNode;
- begin
- OpenDialog := TOpenDialog.Create(Self);
- OpenDialog.Options := [ofAllowMultiSelect];
- if not(OpenDialog.Execute) then Exit;
- for I := 0 to OpenDialog.Files.Count - 1 do
- begin
- FileRec := VirtualStringTree1.GetNodeData(VirtualStringTree1.AddChild(nil));
- FileRec.FileObj := Files.Add(OpenDialog.Files[i]);
- end;
- end;
- { TFile }
- constructor TFile.Create(Path: string);
- var
- FileInfo: SHFILEINFO;
- begin
- FullPath := Path;
- SHGetFileInfo(PChar(FullPath), FILE_ATTRIBUTE_NORMAL, FileInfo, SizeOf(FileInfo), SHGFI_DISPLAYNAME
- or SHGFI_TYPENAME
- or SHGFI_ICON
- or SHGFI_USEFILEATTRIBUTES or SHGFI_SMALLICON);
- FileName := ExtractFileName(FullPath);
- FileIcon := FileInfo.hIcon;
- end;
- { TFiles }
- function TFiles.Add(Path: string): TFile;
- var
- i: Integer;
- TmpFile: TFile;
- begin
- TmpFile := TFile.Create(Path);
- TmpFile.IconIndex := ImageList_AddIcon(Form3.ImageList1.Handle, TmpFile.FileIcon);
- Result := TmpFile;
- inherited Add(Result);
- //here where i want to check for duplicates
- { for I := 0 to Count - 1 do
- begin
- if SameIcon(TmpFile.FileIcon, TFile(Items[i]).FileIcon) then
- TmpFile.IconIndex := TFile(Items[i]).IconIndex else
- // if the icon found in Items[i] don't add the icon to imagelsist
- // dont add new icon to imagelist just get the iconindex of the existing icon
- TmpFile.IconIndex := ImageList_AddIcon(Form3.ImageList1.Handle, TmpFile.FileIcon);
- //else add the new icon
- Result := TmpFile;
- inherited Add(Result);
- end;}
- end;
- function TFiles.SameIcon(HIcon1, HIcon2: HIcon): Boolean;
- var
- Icon1, Icon2: TIcon;
- MS1, MS2: TMemoryStream;
- begin
- Icon1 := TIcon.Create;
- Icon1.Handle := HIcon1;
- Icon2 := TIcon.Create;
- Icon2.Handle := HIcon2;
- MS1 := TMemoryStream.Create;
- MS2 := TMemoryStream.Create;
- try
- Icon1.SaveToStream(MS1);
- Icon2.SaveToStream(MS2);
- Result := StreamsAreIdentical(MS1, MS2);
- finally
- MS1.Free;
- MS2.Free;
- Icon1.Free;
- Icon2.Free;
- end;
- end;
- function TFiles.StreamsAreIdentical(Stream1, Stream2: TStream): Boolean;
- const
- Block_Size = 4096;
- var
- Buffer_1: array[0..Block_Size-1] of byte;
- Buffer_2: array[0..Block_Size-1] of byte;
- Buffer_Length: integer;
- begin
- Result := False;
- if Stream1.Size <> Stream2.Size then exit;
- Stream1.Position := 0;
- Stream2.Position := 0;
- while Stream1.Position < Stream1.Size do
- begin
- Buffer_Length := Stream1.Read(Buffer_1, Block_Size);
- Stream2.Read(Buffer_2, Block_Size);
- if not CompareMem(@Buffer_1, @Buffer_2, Buffer_Length) then exit;
- end;
- Result := True;
- end;
- procedure TForm3.FormCreate(Sender: TObject);
- begin
- Files := TFiles.Create;
- end;
- procedure TForm3.FormDestroy(Sender: TObject);
- begin
- Files.Free;
- end;
- procedure TForm3.VirtualStringTree1GetImageIndex(Sender: TBaseVirtualTree;
- Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
- var Ghosted: Boolean; var ImageIndex: Integer);
- var
- FileRec: PFileNode;
- begin
- FileRec := Sender.GetNodeData(Node);
- if Kind in [ikNormal , ikSelected] then
- begin
- if Column = 1 then ImageIndex := FileRec.FileObj.IconIndex;
- end;
- end;
- procedure TForm3.VirtualStringTree1GetNodeDataSize(Sender: TBaseVirtualTree;
- var NodeDataSize: Integer);
- begin
- NodeDataSize := SizeOf(TFileNode);
- end;
- procedure TForm3.VirtualStringTree1GetText(Sender: TBaseVirtualTree;
- Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
- var CellText: string);
- var
- FileRec: PFileNode;
- begin
- FileRec := Sender.GetNodeData(Node);
- case Column of
- 0: CellText := FileRec.FileObj.FullPath;
- 1: CellText := FileRec.FileObj.FileName;
- end;
- end;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement