دخول

**S.FATEH** · 04-01-2013, 03:07 PM

اواجه مشكلة كبيرة في التكرار الموجود في ImageList لمن يريد ان يجرب حل المشكل

PHP كود :
http://pastebin.com/pjeWq2uN 

كود :
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.

دخول
اسم المستخدم/البريد الالكتروني :
كلمة المرور :	فقدت كلمة المرور ؟
	تذكرني بالمرة القادمة