Цитата:
Сообщение от Kailon
А какой интервал у таймера?
|
Интервал 10мс.
Цитата:
Сообщение от lmikle
Ну и для безопасности надо делать так:
|
Попробую сделать так, потом отпишусь.
Я могу выложить код целиком, но в коде используются сторонние компоненты, так что проверить его Вы не сможете без этих компонентов, но если уж так надо, то вот код целиком, без "вырезанных" кусков:
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, cmpGFXListBox, pngimage, PngImageList, ImgList,
ExtCtrls;
type
TForm1 = class(TForm)
GFXListBox1: TGFXListBox;
Button1: TButton;
Memo1: TMemo;
PngImageList1: TPngImageList;
Timer1: TTimer;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
PNG: TPngObject;
idirs: integer;
icount: integer;
implementation
{$R *.dfm}
function MatchAttrs(flags, attrs: DWORD): Boolean;
begin
MatchAttrs := (flags and attrs) = flags;
end;
function SearchInFolder(folder: String; names: TStrings): Boolean;
var
hSearch: Thandle;
FindData: WIN32_FIND_DATA;
strSearchPath: String;
bRes: Boolean;
begin
strSearchPath := folder + '\*.*';
bRes:= false;
hSearch := FindFirstFile(PAnsiChar(strSearchPath), FindData);
if hSearch <> INVALID_HANDLE_VALUE then
repeat
if (String(FindData.cFileName) <> '..') and
(String(FindData.cFileName) <> '.') then
if MatchAttrs(FILE_ATTRIBUTE_DIRECTORY, FindData.dwFileAttributes) then
begin
names.Add(FindData.cFileName);
bRes:=True;
end;
until FindNextFile(hSearch, FindData) = False;
SearchInFolder := bRes;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
//ShowMessage(Memo1.Lines.Strings[0]);
//ShowMessage(IntToStr(idirs));
{
PNG.LoadFromFile(ExtractFilePath(Application.ExeName)+'img\'+Memo1.Lines.Strings[0]+'\test1.png');
PngImageList1.InsertPng(0, PNG, 0);
GFXListBox1.AddItem(Memo1.Lines.Strings[0], cbChecked, 0);
}
Timer1.Enabled:=True;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
if not SearchInFolder(ExtractFilePath(Application.ExeName)+'img\', Memo1.Lines) then
ShowMessage('Error');
idirs:=Memo1.Lines.Count;
icount:=-1;
ShowMessage('icount: ' + IntToStr(icount) + ' idirs: ' + IntToStr(idirs));
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
If icount = idirs - 1 then
Timer1.Enabled:=False
else begin
Inc(icount);
PNG:= TPngObject.Create;
PNG.LoadFromFile(ExtractFilePath(Application.ExeName)+'img\'+Memo1.Lines.Strings[icount]+'\test1.png');
ShowMessage('PNG Loaded! icount: '+ IntToStr(icount));
PngImageList1.InsertPng(icount, PNG, 0);
GFXListBox1.AddItem(Memo1.Lines.Strings[icount], cbChecked, icount);
//ShowMessage('List Added!');
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Inc(icount);
ShowMessage('icount: ' + IntToStr(icount));
end;
end.
Код сканирует папку, на наличие других папок и выдает их список, далее по идее он должен выдать этот список в сторонний компонент (GFXListBox, это по сути CheckListBox с поддержкой картинок), при этом подгрузив картинку, из каждой папки свою (хоть имена у них и одинаковые).
И не надо кидаться тапками, я не профи программист, пишу как умею.