Listview'de Listeleme

[sadimba]

Değerli arkadaşlar.
Windows Gezginine benzer bir program hazırlıyorum. Bu programda klasördeki resim dosyalarının name, type, directory, size, Attribute gibi özelliklerini listeliyorum. Yalnız resime ait (width x height) boyutu subitem olarak gösteremiyorum. Nerede hata yaptığımı bulamadım. Yardımcı olacak arkadaşlara şimdiden teşekkür ediyorum.
Kod şöyle;

procedure TForm1.AddButtonClick(Sender: TObject); //Klasör seçiyoruz
const s:integer=0;
var TitleName : string; lpItemID : PItemIDList;
BrowseInfo : TBrowseInfo;
DisplayName : array[0..MAX_PATH] of char;
TempPath : array[0..MAX_PATH] of char;
ISLEM : boolean; boyut,i : integer;
begin
RzListbox1.Clear;
RzEdit1.Text :='';
ListView1.Clear;
ListView1.Items.BeginUpdate;
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
BrowseInfo.hwndOwner := Form1.Handle;
BrowseInfo.pszDisplayName := @DisplayName;
TitleName := 'Lütfen bir klasör seçin';
BrowseInfo.lpszTitle := PChar(TitleName);
BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
lpItemID := SHBrowseForFolder(BrowseInfo);
if lpItemId <> nil then
begin
SHGetPathFromIDList(lpItemID, TempPath);
RzEdit1.Text :=TempPath;
GlobalFreePtr(lpItemID);
boyut:=0;
ISLEM :=TRUE;
DizinSorgula(RzEdit1.TEXT);
ISLEM :=falsE;
GetButtonClick(sender);
end;
end;

procedure TForm1.GetButtonClick(Sender: TObject); //Seçtiğimiz klsördeki dosyaları Listviewe aktarıyoruz
const s:integer=0;
var FileDim,FileOSDate,y,j,i,x:integer; ListItem: TListItem;
sFileOsDim,TheFilename, sFileDimension,sFileSize,sFileName:string;
srFileSR:TSearchRec; FileDT : TDateTime;
begin
ListView1.Clear;
RzListbox1.Update;
for i:=0 to RzListbox1.Count-1 do
begin
ListItem:=ListView1.Items.Add; //1.Column dosya adı girme
ListItem.Caption:=ExtractFileName(RzListBox1.Items);
ListItem.SubItems.Add(ExtractFilePath(RzListbox1.Items)); //2.Column directory adı girme
FindFirst(sFileName,faAnyFile,srFileSR); //3.Column byte dosya uzunluğunu girme

sFileName:=Pchar(RzListbox1.Items);
sFileSize := IntToStr(srFileSR.Size);
Listview1.items.item.Subitems.add(sFileSize);

FileOSDate := FileAge(RzListBox1.Items); // 4.Column Dosya tarihini girme
if FileOSDate = -1 then Exit;
FileDT := FileDateToDateTime(FileOSDate);
Listview1.items.item.Subitems.add(FormatDateTime('dd/mm/yyy', FileDT));
//***********************************************************************************************
//*** Alttaki 3 sırada bir hata var ve resmin boyutu 0x0 olarak görünüyor
sFileOsDim:= Format('%d x %d', [Image1.Picture.Height,Image1.Picture.Width]); //5.Colums dosya boyutu
sFileOsDim := IntToStr(FileDim);
Listview1.items.item.Subitems.add(sFileOsDim);
//***********************************************************************************************
ListView1.Items.EndUpdate;
RzListbox1.Update;
end;end;

[ertank]

Merhaba,

Öncelikle paylaştığınız kod okuması çok zor ve belirli hata kontrolleri yapılmamış bir kod. Bu anlamda son Delphi sürümlerinde editör içinde CTRL+D tuşuna basar iseniz Pascal diline uygun şekilde kod yazım düzenlemesi yapılacaktır.

İlk bakışta göze çarpan konular şu şekildedir;
- Kullanılmayan değişkenler tanımlanmış. Gereksiz yere hafıza kullanımından kaçınılmalıdır.
- begin..end try..finally..end blokları gibi blok arasında kalan kodlar en az iki karakter içeriden yazılmalıdır. Buna özen gösterilmemiş.
- ListView1.BeginUpdate() kullanıldığı zaman hata oluşması ihtimaline karşı try..finally..end bloğu içinde finally kısmında ListView1.EndUpdate() kullanılmalıdır. Böyle bir önlem alınmamış.
- "RzListBox1.Items" ifadesi string değer okumak için kullanılmış. TListBox.Items bir string değer değildir. Bir sınıf tanımıdır. Bu noktada indeks bilgisi verilmesi gerekli idi. Eğer bu bileşen standart TListBox bileşeni değil ise bunu belirtmenizde fayda var.
- TListView1.Items.Add() değeri ListItem değişkenine atanmış olmasına rağmen ilerleyen satırlarda hataya olasılık verebilecek "ListView1.Items.Item.SubItems" şeklinde bir kullanım yapılmış.
- FindFirst() fonksiyonu başarlı bir şekilde ilk dosyayı bulup bulmadığının kontrolü yapılmamış. (Fonksiyon çalışmadan önce birisi ilk dosyayı taşır veya disk üzerinden siler ise hata oluşacak veya hatalı bilgiler ekranda gösterilecektir.
- FindFirst() fonksiyonu normalde dizin isimlerini de listeler. Buna yönelik bir kontrol prosedür içinde yok. Gerekli önlemlerin daha önceki kısımlarda alınmış olduğu varsayıldı.
- Kullanımı kaldırılacak olan "FileAge()" fonksiyonu mevcut kod içinde. Doğru fonksiyon ikinci "overload" fonksiyonu olacaktır. Ancak kullandığınız Delphi sürümünü bildirmediğiniz için bu noktada gerçek anlamda sorun olup olmadığına emin olmak mümkün değil.
- Image1 prosedür çağırılmadan önce her bir resim için otomatik olarak güncelleniyor mu belli değil. Bu noktada gerekli önlemlerin alındığını varsaydım.
- RzListBox1 için hem prosedür başlangıcında hemde bitişinde güncelleme yapılıyor "RzListBox1.Update()" buna gerek olmadığını düşünüyorum. Ancak proje tam anlamı ile kontrol edilebilir şekilde paylaşılmadığı için gerekli olduğu varsayıldı.

Gönderdiğiniz kod ile ilgili aşağıdaki gibi bir düzenleme yaptım. Ancak proje ve test için gerekli diğer dosyalar olmadığı için test etme imkanım olmadı. Eğer yine hata verir ise lütfen sorunu gösteren ufak bir proje hazırlayıp (ilgili resim dosyaları ile birlikte) indirilebilecek bir yere yükleyin.

Aşağıdaki kod Delphi 10.2 ile sorunsuz olarak derlenmektedir. Eğer derleme zamanı hatası alır iseniz yüksek ihtimal ile Delphi 7 benzeri eski bir sürüm kullanmanız kaynaklı olacaktır. Bu durumda hata aldığınız kısımları kendi sürümünüz gereğince düzenlemeniz gerekecektir.

Kod: Tümünü seç

procedure TForm1.GetButtonClick(Sender: TObject);
var
  i: Integer;
  ListItem: TListItem;
  sFileOsDim: string;
  sFileSize: string;
  sFileName: string;
  srFileSR: TSearchRec;
  FileDT: TDateTime;
begin
  ListView1.Clear();
  RzListbox1.Update();
  try
    for i:=0 to RzListbox1.Count-1 do
    begin
      ListItem := ListView1.Items.Add();
      ListItem.Caption := ExtractFileName(RzListBox1.Items[i]);
      ListItem.SubItems.Add(ExtractFilePath(RzListbox1.Items[i]));
      if FindFirst(sFileName, faAnyFile, srFileSR) = 0 then 
      begin
        sFileName:=Pchar(RzListbox1.Items);
        sFileSize := IntToStr(srFileSR.Size);
        ListItem.Subitems.Add(sFileSize);
      end;

      if not FileAge(RzListBox1.Items[i], FileDT, True) then Exit(); // İkinci overload fonksiyon kullanılıyor.
      ListItem.Subitems.Add(FormatDateTime('dd/mm/yyy', FileDT));

      sFileOsDim:= Format('%d x %d', [Image1.Picture.Height, Image1.Picture.Width]);
      ListItem.Subitems.Add(sFileOsDim);
    end;
  finally
    ListView1.Items.EndUpdate();
    RzListbox1.Update();
  end;
end;

Benim anlayabildiğim kadarıyla esas sorun aşağıdaki satırlarda olabilir

Kod: Tümünü seç

sFileOsDim:= Format('%d x %d', [Image1.Picture.Height,Image1.Picture.Width]);
// Aşağıdaki atama hatalı. Derleyici bu satır için sizi "değeri tanımsız olabilir" şeklinde uyarıyor.
// Prosedür içinde FileDim değişkenine başka bir yerde atama yapılmıyor. Dolayısıyla değeri 0 (sıfır) olacaktır.
sFileOsDim := IntToStr(FileDim);
// Aşağıdaki satır, yukarıda sıfır ('0') değerini alan sFileOsDim bilgisini ekranda gösteriliyor olacak
Listview1.items.item.Subitems.add(sFileOsDim);

[sadimba]

Sayın ertank.
Öncelikle bu kadar detaylı bilgiler için çok teşekkür ederim. Verdiğiniz bilgilerle daha düzenli hale geldi. Kaldı ki siz kısaltarak daha düzgün hale getirmişsiniz. Amacım bir klasör seçerek bunu listview'de görmek ve seçim yaptığımda da resmi görmekti. Şu anda sürüm olarak 7.0 kullanıyorum. En aza indirdim.Ama yinede olmadı.
İlgilerinizi bekliyorum.Şimdiden teşekkür ederim
Programın tamamı ise şu şekilde.(biraz basit ama hoşgörünüze sığınıyorum)

procedure TForm1.DizinSorgula(DizinAd: string);
var S : TSearchRec; Found : Integer; t:integer; Islem:boolean;
begin
ChDir(DizinAd);
Found := FindFirst ('*.*', faDirectory, S);
while (Found = 0) do
begin
IF Islem = FALSE THEN Break;
if (S.Name <> '.') and (S.Name <> '..') and (S.Attr and faDirectory <> 0) then
begin
if DizinAd[Length(DizinAd)] = '\' then
DizinSorgula(DizinAd + S.Name)
else DizinSorgula(DizinAd + '\' + S.Name);
ChDir(DizinAd);
end;
Found := FindNext(S);
Application.ProcessMessages;
end;
FindClose(S);
SetCurrentDir('..');
begin
RzFileListBox1.Directory := DizinAd;
RzFileListBox1.Mask := FilterComboBox1.Mask;
if RzFileListBox1.Items.Count > 0 then
begin
for t:=0 to RzFileListBox1.Items.Count -1 do
begin
RzFileListBox1.ItemIndex := t;
if FileExists(RzFileListBox1.FileName ) = True then
begin
RzListbox1.items[RzListbox1.itemindex]:=RzFilelistbox1.filename;
end;end;end;end;end;

procedure TForm1.FormCreate(Sender: TObject);
begin
// Form1.ClientHeight := 260; Form1.ClientWidth := 500;
end;

procedure TForm1.ListView1Click(Sender: TObject);
begin
Image1.Picture.bitmap := nil;
if ListView1.Selected <> nil then
begin
RzListbox1.items.IndexOf(ListView1.Selected.Caption);
RzFileListbox1.Filename := ListView1.Selected.Caption;
RzFileListBox1Click(Sender);
RzEdit1.Text:= ExtractFileName(RzFileListbox1.Filename);
end;end;

procedure TForm1.Button1Click(Sender: TObject); //Klasör seçme
const s:integer=0;
var TitleName : string; lpItemID : PItemIDList; //ShlObj
BrowseInfo : TBrowseInfo;
DisplayName : array[0..MAX_PATH] of char;
TempPath : array[0..MAX_PATH] of char;
ISLEM : boolean; boyut,i : integer;
begin
RzFilelistbox1.Clear;
RzListbox1.Clear;
RzEdit1.Text :='';
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
BrowseInfo.hwndOwner := Form1.Handle;
BrowseInfo.pszDisplayName := @DisplayName;
TitleName := 'Lütfen bir klasör seçin';
BrowseInfo.lpszTitle := PChar(TitleName);
BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
lpItemID := SHBrowseForFolder(BrowseInfo);
if lpItemId <> nil then
begin
SHGetPathFromIDList(lpItemID, TempPath);
RzEdit1.Text :=TempPath;
GlobalFreePtr(lpItemID);
boyut:=0;
ISLEM :=TRUE;
DizinSorgula(RzEdit1.TEXT);
ISLEM :=falsE;
GetButtonClick(sender);
end;
end;

procedure TForm1.RzFileListBox1Click(Sender: TObject);
var FileExt,TheFileName:string;
begin
with Rzfilelistbox1 do
if ItemIndex >= 0 then
begin
RzListbox1.Update();
TheFileName := Items[ItemIndex];
FileExt := AnsiUpperCase(ExtractFileExt(RzFileListbox1.Filename));
if (FileExt = '.BMP') or (FileExt = '.JPG') or (FileExt = '.PNG') then
begin
Image1.Picture.LoadFromFile(RzFilelistbox1.filename);
Image1.Stretch:=false;
Image1.AutoSize:=true;
Image1.align:=alNone;
RzEdit1.Text:= ExtractFilename(RzFileListbox1.Filename);
TheFileName := Items[ItemIndex];
end;end;
end;

procedure TForm1.GetButtonClick(Sender: TObject);
var i:integer;
ListItem: TListItem;
sFileSize, sFileName:string;
srFileSR:TSearchRec;
begin
ListView1.Clear;
RzListbox1.Update;
for i:=0 to RzListbox1.Count-1 do
begin
ListItem:=ListView1.Items.Add;
ListItem.Caption := ExtractFileName(srFilesr.name);
sFileName:=Pchar(RzListbox1.Items);
FindFirst(sFileName, faAnyFile, srFileSR);
if FindFirst(sFileName, faAnyFile, srFileSR) = 0 then
begin
//aşağıdaki iki satır ekrana 0x0 olarak çıkıyor.
sFileName := Format('%d x %d', [Image1.Picture.Height,Image1.Picture.Width]);
ListItem.SubItems.Add(sFileName);
ListView1.Items.EndUpdate;
RzListbox1.Update;
end;
end;
end;

[attachment=0]Listview 8.rar[/attachment]