- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
- 33
- 34
- 35
- 36
- 37
- 38
- 39
- 40
- 41
- 42
- 43
- 44
- 45
- 46
- 47
- 48
- 49
- 50
- 51
- 52
- 53
- 54
- 55
- 56
- 57
- 58
- 59
- 60
- 61
- 62
- 63
- 64
- 65
- 66
- 67
- 68
- 69
- 70
- 71
- 72
- 73
- 74
- 75
1
1
Имеется графический обозреватель картинок, где мини-изображения хранятся в ImageList, а выводятся ListView (поименованные графические файлы). При открытие папок с картинками (где большое количество картинок) возникает торможение отображения. Вся программа начинает тормозить, ожидая загрузки картинок в ListView. Чтобы избежать такого, я вынес загрузку ListBox в отдельный процесс Thread. В результате возникла другая проблема: при загрузке картинок, часть загружается просто черными квадратами. Как избавиться от этого неприятного эффекта?
Код выбора папки для дальнейшего просмотра содержимого:
procedure TForm1.DirectoryListBox1Change(Sender: TObject);
begin
Form1.ListView1.Clear;
Form1.ImageList1.Clear;
NewThread:=TNewThread.Create(false);
NewThread.FreeOnTerminate:=true;
NewThread.Priority:=tpHighest;
NewThread.Resume;
end;
Код отдельно выделенного процесса:
procedure TNewThread.Execute;
begin
Form1.FillListView(form1.DirectoryListBox1.Directory , '*.jpg');
Form1.FillListView(form1.DirectoryListBox1.Directory, '*.bmp');
end;
И наконец код обработки графических файлов с последующей загрузкой в ListBox:
procedure TForm1.fillListView(path: string; mask: string = '*.jpg');
var
sr: TSearchRec;
img: TPicture;
bmp: TBitmap;
pic: TBitMap;
x,y: integer;
begin
img := TPicture.Create;
bmp := TBitMap.Create;
pic := TBitMap.Create;
With Form1 do
if FindFirst(path +'\'+mask, faAnyFile, sr) = 0 then
begin
repeat
if (sr.Name<>'.') and (sr.Name<>'..') and (sr.Attr<>faDirectory) then
//if (sr.Attr and $20) = $20 then
begin
try
img.LoadFromFile(path +'\'+ sr.Name);
except
Continue;
end;
bmp.Assign(img.Graphic);
x:=bmp.Width;
y:=bmp.Height;
pic.Width := ImageList1.Width;
pic.Height:= ImageList1.Height;
pic.Canvas.Brush.Color :=clWhite;
pic.Canvas.FillRect(Canvas.ClipRect);
pic.Canvas.StretchDraw(Rect(0,0,pic.Width, Round((pic.Height*y)/x)), bmp);
ImageList1.Add(pic, nil);
with ListView1.Items.Add do
begin
Caption := sr.Name;
ImageIndex := ListView1.Items.Count-1;
end;
end;
until FindNext(sr) <> 0;
FindClose(sr);
end;
img.Free;
bmp.Free;
pic.Free;
end;
Не сопротивляйся, смерть сладка.
http://hashcode.ru/questions/86688/delphi-%D1%80%D0%B0%D0%B1%D0%BE%D1%82%D0%B0-%D1%81-listview-%D0%B2-%D0%B4%D0%B5%D0%BB%D1%84%D0%B8
Follow us!