Задать вопрос экспертам!

Эксперты раздела Delphi Смотреть всех

Вопросы раздела Delphi

Изображение услуги

Как строить отношения с мужчиной книги - консультация

Как строить отношения с мужчиной книги — консультация
Как правильно строить отношения с мужчиной за 40 — консультация
Правильное отношение к мужчине — консультация
Как начать отношения с мужчиной — консультация
Психология отношения с мужчиной — консультация
Тест почему не складываются отношения с мужчинами — консультация

Каким образом (или с помощью каких средств) в окне диалога для выбора файлов интерфейса shellapi указать маску отображаемых в диалоге файлов

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TForm1 = class(TForm) Image1: TImage; Button1: TButton; Button2: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } public { Public declarations } end; Masiv = array [1..4,1..3] of real; Masiv_i = array [1..4,1..3] of integer; var Form1: TForm1; Xo,Yo,Mx,My:integer; Matrica_fig:masiv; Komp_kor_Mf:masiv_i; implementation function Xkomp(Xmat:real): integer; begin Xkomp:=round(xo+Xmat*Mx); end; function Ykomp(Ymat:real): integer; begin Ykomp:=round(Yo-Ymat*My); end; procedure Oci(Xo,Yo,Mx,My:integer); var i:integer; begin Form1.Image1.Canvas.Pen.Color:=46061749; for i:=1 to 50 do begin Form1.Image1.Canvas.MoveTo(Xo+i*Mx,5); Form1.Image1.Canvas.LineTo(Xo+i*Mx,Form1.Image1.Height-5); Form1.Image1.Canvas.MoveTo(Xo-i*Mx,5); Form1.Image1.Canvas.LineTo(Xo-i*Mx,Form1.Image1.Height-5); Form1.Image1.Canvas.MoveTo(5,Yo+i*My); Form1.Image1.Canvas.LineTo(Form1.Image1.Width-5,Yo+i*My); Form1.Image1.Canvas.MoveTo(5,Yo-i*My); Form1.Image1.Canvas.LineTo(Form1.Image1.Width-5,Yo-i*My); end; Form1.Image1.Canvas.Pen.Color:=clBlack; Form1.Image1.Canvas.MoveTo(5,Yo); Form1.Image1.Canvas.LineTo(Form1.Image1.Width-5,Yo); Form1.Image1.Canvas.MoveTo(Xo,5); Form1.Image1.Canvas.LineTo(Xo,Form1.Image1.Height-5); end; {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin Xo:=100; Yo:=100; Mx:=10; My:=10; Oci(Xo,Yo,Mx,My); end; procedure Paint (); var i:integer; begin for i:=1 to 4 do begin Komp_kor_Mf[i,1]:= Xkomp(Matrica_fig[i,1]); Komp_kor_Mf[i,2]:= Ykomp(Matrica_fig[i,2]); end; Form1.Image1.Canvas.MoveTo(Komp_kor_Mf[1,1], Komp_kor_Mf[2,2]); for i:=1 to 4 do begin Form1.Image1.Canvas.LineTo(Komp_kor_Mf[i,1], Komp_kor_Mf[i,2]); end; end; procedure TForm1.Button2Click(Sender: TObject); begin Matrica_fig [1,1]:=-2; Matrica_fig [1,2]:=-1; Matrica_fig [1,3]:=1; Matrica_fig [2,1]:=-2; Matrica_fig [2,2]:=1; Matrica_fig [2,3]:=1; Matrica_fig [3,1]:=2; Matrica_fig [3,2]:=1; Matrica_fig [3,3]:=1; Matrica_fig [4,1]:=2; Matrica_fig [4,2] :=-1; Matrica_fig [4,3]:=1; Paint (); // showmessage(inttostr(Komp_kor_Mf[1,1])); //showmessage(inttostr(Komp_kor_Mf[2,1])); end; end. скажите какая ошибка в преобразовании кординат?

Изображение услуги

Удаленная компьютерная помощь через TeamViewer ОНЛАЙН!

☑ Окажу помощь в настройке, администрировании, установке любых программ, драйверов и операционных систем семейства Windows, Mac OS
☑ Помощь в установке и активации редких, узкоспециализированных программ
◄►◄► Избавлю от вирусов, баннеров и прочей гадости. ◄►◄►
☑ Помогу разобраться с железом.
☑ Работа с фото и видео.
◄►◄► Удаленная компьютерная помощь ◄►◄►
☑ Готов решить множество ваших проблем с ПК посредством удаленного управления.
Русификация, навигация для автомобилей из США удаленно!

Добрый вечер! Пытаюсь сделать фильтрацию в dbgrid, ввод в edit. Просто запрос на кнопку Query1.Filter :='Фамилия='+QuotedStr(Edit1.Text); Query1.Filtered :=True; При этом ошибка: Query1:Field 'Ф' not found. Не могу понять почему так? Объясните пожалуйста.

данных. Далее необходима программа на Delphi для того, чтобы отобразить статистику и вывести определенные вычизображение из вопросаисляемые показатели.

Люди помогите. Делаю браузер, когда делаю так что-бы браузер пошёл настраницу назад он выдаёт, что неопознаная ошибка.

произошло деление?(Простите, что пишу глупые вопросы. Но сама не разберусь и помочь некому)(Решение систем уравнений методом крамера).Заранее благодарю.
Код такой:
  1. unit Unit1;
  2. interface
  3. uses
  4. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  5. Dialogs, Grids, StdCtrls, ExtCtrls, ComCtrls;
  6. type
  7. TForm1 = class(TForm)
  8. Panel1: TPanel;
  9. StringGrid1: TStringGrid;
  10. Button1: TButton;
  11. Label7: TLabel;
  12. Panel2: TPanel;
  13. Label1: TLabel;
  14. StringGrid2: TStringGrid;
  15. StringGrid3: TStringGrid;
  16. Label2: TLabel;
  17. StringGrid4: TStringGrid;
  18. Label3: TLabel;
  19. Label4: TLabel;
  20. Label5: TLabel;
  21. Label6: TLabel;
  22. StatusBar1: TStatusBar;
  23. procedure FormCreate(Sender: TObject);
  24. procedure Button1Click(Sender: TObject);
  25. private
  26. { Private declarations }
  27. public
  28. { Public declarations }
  29. end;
  30. type
  31. TMArray =array [0..3] of real;
  32. var
  33. Form1: TForm1;
  34. implementation
  35. {$R *.dfm}
  36. procedure TForm1.FormCreate(Sender: TObject);
  37. begin
  38. StringGrid1.Cells[0,0]:='';
  39. StringGrid1.Cells[1,0]:='';
  40. StringGrid1.Cells[2,0]:='';
  41. StringGrid1.Cells[3,0]:='';
  42. StringGrid1.Cells[0,1]:='';
  43. StringGrid1.Cells[1,1]:='';
  44. StringGrid1.Cells[2,1]:='';
  45. StringGrid1.Cells[3,1]:='';
  46. StringGrid1.Cells[0,2]:='';
  47. StringGrid1.Cells[1,2]:='';
  48. StringGrid1.Cells[2,2]:='';
  49. StringGrid1.Cells[3,2]:='';
  50. end;
  51. function podstanov (mas1,mas2,mas3:TMArray):real;
  52. begin
  53. Result:= mas1[0]*mas2[1]*mas3[2]+mas2[0]*mas3[1]*mas1[2]+mas1[1]*mas2[2]*mas3[0]-
  54. mas3[0]*mas2[1]*mas1[2]-mas2[0]*mas1[1]*mas3[2]-mas3[1]*mas2[2]*mas1[0];
  55. end;
  56. procedure TForm1.Button1Click(Sender: TObject);
  57. var mas1,mas2,mas3:TMArray;
  58. i,j:integer; x1,x2,x3:real;
  59. Delta,Delta1,Delta2,Delta3:real;
  60. begin
  61. for i:=0 to StringGrid1.ColCount-1 do
  62. begin
  63. mas1[i]:=StrToFloat(StringGrid1.cells[i,0]);
  64. mas2[i]:=StrToFloat(StringGrid1.Cells[i,1]);
  65. mas3[i]:=StrToFloat(StringGrid1.Cells[i,2]);
  66. end;
  67. Delta:=podstanov(mas1,mas2,mas3); //дельта
  68. for j:=0 to StringGrid1.RowCount do
  69. begin
  70. StringGrid2.Cells[0,j]:=StringGrid1.Cells[3,j];
  71. StringGrid2.Cells[1,j]:=StringGrid1.Cells[1,j];
  72. StringGrid2.Cells[2,j]:=StringGrid1.Cells[2,j];
  73. StringGrid2.Cells[3,j]:='0';
  74. end;
  75. for i:=0 to StringGrid2.ColCount-1 do
  76. begin
  77. mas1[i]:=StrToFloat(StringGrid2.cells[i,0]);
  78. mas2[i]:=StrToFloat(StringGrid2.Cells[i,1]);
  79. mas3[i]:=StrToFloat(StringGrid2.Cells[i,2]);
  80. end;
  81. Delta1:=podstanov(mas1,mas2,mas3); //дельта
  82. for j:=0 to StringGrid3.RowCount do
  83. begin
  84. StringGrid3.Cells[0,j]:=StringGrid1.Cells[0,j];
  85. StringGrid3.Cells[1,j]:=StringGrid1.Cells[3,j];
  86. StringGrid3.Cells[2,j]:=StringGrid1.Cells[2,j];
  87. StringGrid3.Cells[3,j]:='0';
  88. end;
  89. for i:=0 to StringGrid3.ColCount-1 do
  90. begin
  91. mas1[i]:=StrToFloat(StringGrid3.cells[i,0]);
  92. mas2[i]:=StrToFloat(StringGrid3.Cells[i,1]);
  93. mas3[i]:=StrToFloat(StringGrid3.Cells[i,2]);
  94. end;
  95. Delta2:=podstanov(mas1,mas2,mas3);
  96. for j:=0 to StringGrid4.RowCount do
  97. begin
  98. StringGrid4.Cells[0,j]:=StringGrid1.Cells[0,j];
  99. StringGrid4.Cells[1,j]:=StringGrid1.Cells[1,j];
  100. StringGrid4.Cells[2,j]:=StringGrid1.Cells[3,j];
  101. StringGrid4.Cells[3,j]:='0';
  102. end;
  103. for i:=0 to StringGrid3.ColCount-1 do
  104. begin
  105. mas1[i]:=StrToFloat(StringGrid4.cells[i,0]);
  106. mas2[i]:=StrToFloat(StringGrid4.Cells[i,1]);
  107. mas3[i]:=StrToFloat(StringGrid4.Cells[i,2]);
  108. end;
  109. Delta3:=podstanov(mas1,mas2,mas3);
  110. Label1.Caption:=FloatToStr(Delta1)+#13+'--------------'+#13+FloatToStr(Delta);
  111. Label2.Caption:=FloatToStr(Delta2)+#13+'--------------'+#13+FloatToStr(Delta);
  112. Label3.Caption:=FloatToStr(Delta3)+#13+'--------------'+#13+FloatToStr(Delta);
  113. end;
  114. end.
ИД_клиента, Вид_страхования, Страховая_сумма, ИД_сотрудника FROM Договора WHERE ИД_сотрудника='+DBComboBox1.text); ADOQuery1.Open; выдает ошибку, пишет что неправильный синтаксис "="

Мне нужно чтобы при запуске программы переименовался файл который будет открыт. Т.е я открываю к примеру фильм, и в это время он переименовывает его в другое имя которое я задал. Или можно по возможности сделать чтоб при открытие не изменялся, а уже после закрытия переименовался. Заранее спасибо

Здравствуйте, у меня возник такой вопрос, есть PageCntrol, как сделать чтобы при нажатие на кнопку сдвигалась предыдущая страница и появлялась другая. Какой код нужно прописать на кнопке чтоб такое реализовать?

Разработать программу ввода и вывода коэффициентов уравнения для определения корней полинома пятой степени, представленных в одной строке

Возник такой вопрос, мне нужно чтобы при нажатии на кнопку выводился текст с картинками, но через какой компонент это сделать? Код приветствуется!)

Здравствуйте! Я пользователь одной из онлайн букмекерских контор! Я Зарегестрировался на сайте (букмекерской конторы) более 2 месяцев. Пользуясь этим сайтом я выиграл более 500грн (начиная играть положил в свой кабинет на данном сайте около 30грн), дважды выводил деньги и при очередной попытки вывести деньги, мне пришол отказ, в виде сообщения в котором написано — что для того чтобы в дальнейшемя мог делать ставки и выводить деньги мне нужно отправить копию паспорта(1,2с и прописку) и фото где я с роскрытым паспортом! Если честно то я не совсем понимаю зачем им ето надо! Вопрос: Каким образом мне снять остатки денег? Заранее благодарен за ответы! С Ув. Николай!

procedure TForm1.OnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var i,j:integer; begin x:=x div 32; y:=y div 32; if a[x,y] > 0 then begin //очистка массива для последующего поиска пути for i:=0 to 8 do for j:=0 to 8 do b[i,j]:=0; TempX:=x; TempY:=y; TempZ:=a[x,y]; BALLClick:=true; //шар выбран FindZero(x,y); end; if (a[x,y]=0) and (BALLClick=true) and (b[x,y]=1) then begin Form1.Imagelist1.GetBitmap(0,BMP); Form1.Image1.Canvas.Draw(TempX*32,TempY*32,BMP); Form1.Imagelist1.GetBitmap(TempZ,BMP); Form1.Image1.Canvas.Draw(x*32,y*32,BMP); BALLClick:=false; a[TempX,TempY]:=b[x,y]; a[x,y]:=b[x,y]; RandomBALL; //добавляем шарики end; end;

Начал делать свой браузер, основные компоненты установил такие как назад, вперед, стоп, обновить, но я хочу усовершенствовать его, сделать более функциональным, добавить различные действия, ну и как то внешне оформить бы надо, Подскажите что можно добавить, и каким образом, т.к я в програмирование не силен… Буду очень признателен)))) И еще у меня почему то когда заходишь на какую либодругую страницупо ссылке он открывает его в IE

кто мне поможет сделать задание в Delphi 7 в консольном приложении. до завтра срочно

Возможно ли на Delphi написать игру «танчики»???

здравствуйте, как в Memo вывести текст в ряд, тобишь что бы оно не перескакивало на следущий столбик

function IntToByte(i:Integer):Byte;
begin
if i>255 then Result:=255
else if i<0 then Result:=0
else Result:=i;
end;

procedure Contrast(Bitmap: TBitmap; Value: Integer);
var
p0:pbytearray;
rg,gg,bg,r,g,b,x,y: Integer;
begin
for y:=0 to Bitmap.Height-1 do
begin
p0:=Bitmap.scanline[y];
for x:=0 to Bitmap.Width-1 do
begin
r:=p0[x*3];
g:=p0[x*3+1];
b:=p0[x*3+2];
rg:=(Abs(127-r)*Value)div 255;
gg:=(Abs(127-g)*Value)div 255;
bg:=(Abs(127-b)*Value)div 255;
if r>127 then r:=r+rg else r:=r-rg;
if g>127 then g:=g+gg else g:=g-gg;
if b>127 then b:=b+bg else b:=b-bg;
p0[x*3]:=IntToByte®;
p0[x*3+1]:=IntToByte(g);
p0[x*3+2]:=IntToByte(b);
end;
end;
end;

Я делаю простой калькулятор в программе Делфи и чтоб он считал я создал кнопку 2 editа и label, на кнопке я прописал код: label6.Caption:=IntoStr(StrToInt(edit1.Text)+ StrToInt(edit2.Text)); И он прекрасно считает, но вместо кнопки я поставил картинку и прописал точно такой же код но программа почему то не работает, разве на картинке это функция не работает?

на кнопку а на пустую фарму то она заходит что делать? еще 1 проблема есть не могу добавить добавить текст больше 25 символов обрезает сразу а именно в во вкладке личные данные подразделение
Здравствуйте, мне нужна помощь в разборе небольшого примера кода автоматической правки реестра Windows. Вот этот код. Точнее, пример кода, куда как я понимаю вместо переменных нужно вставить свои значения и пути. Задача кода — править в реестре Windows 4 байта в блоке данных под названием Filterdata. Эти байты отвечают за приоритет (merit) одного системного сплиттера отвечающего за воспроизведение видео в Mpeg 2. Особенность кода в том, что он правит только эти 4 байта в блоке, а не заменяет его весь целиком как при стандартной операции импорта данных в реестр. Такое точечное редактирование требуется в связи с тем, что в разных версиях Windows блок Filterdata содержит немного разные данные, а байты приоритета (merit) и их расположение всегда одинаковые, поэтому правятся только они.

procedure SetMeritHelper(rootkey: Integer; clsid: String; b1, b2, b3, b4: Byte);
var
filterdata: AnsiString;
begin
if RegQueryBinaryValue(rootkey,
'CLSID\{083863F1-70DE-11d0-BD40-00A0C911CE86}\Instance\' + clsid,
'FilterData', filterdata) then begin
if Length(filterdata) < 16 then begin
Log('Invalid filterdata for ' + clsid);
exit;
end;
filterdata[5] := Chr(b1);
filterdata[6] := Chr(b2);
filterdata[7] := Chr(b3);
filterdata[8] := Chr(b4);
RegWriteBinaryValue(rootkey, CLSID_ACTIVEMOVIE_INSTANCE + clsid,
'FilterData', filterdata);
end;
end;
end;

procedure SetMerit32(clsid: String; b1, b2, b3, b4: Byte);
begin
SetMeritHelper(HKCR32, clsid, b1, b2, b3, b4);
end;

procedure SetMeritUnlikely32(clsid: String);
begin
SetMerit32(clsid, 0, 0, 64, 0);
end;

Проблема в том что я никак не могу заставить его работать, а работать он должен в установщике на Inno setup.

С помощью гугла и моих поверхностных знаний удалось понять что RegQueryBinaryValue в коде это у нас чтение данных ключа. В скобках по ходу самим надо прописывать вместо rootkey — HKEY_CLASSES_ROOT ну и т.д. Потом небольшое условие, если содержание параметра меньше 16, то ничего не делаем, как я понял. Дальше идёт перечисление целевых байт, ну а потом судя по всему, операция записи наших данных RegWriteBinaryValue. Вот только не понятно, что здесь делает название другого раздела CLSID_ACTIVEMOVIE_INSTANCE — думаю, оно попало сюда по ошибке. Просто человек который дал мне этот код, забыл поправить, и здесь должен быть тот же путь что и в 1-й операции. Ведь дальше идёт описание самой процедуры, ну и в конце нужно ввести свой приоритет SetMerit32(clsid, 0, 0, 64, 0) и всё.

Вообщем, не смотря на все мои усилия код так и не заработал, надеюсь местные знатоки по синтаксису Delphi подскажут что тут и как. Заранее всем благодарен.

Вот Файл целевого ключа реестра.
C библиотекой шел файл odl в этом файле данная функция есть.
Помогите разобраться как правильно подключить библиотеку.
 

1.Циклические вычислительные процессы

 

Цель работы: научиться создавать простейшие проекты, реализующие  алгоритмы циклических вычислительных процессов, с использованием операторов цикла и стандартных компонентов.

 

Постановка задачи:

 

1 Вычислить таблицу  значений  функции  y=f(x)  и построить график этой функции для значений аргумента X, изменяющегося  в  интервале  от  Хнач  до Хкон с  шагом dX .

Значения Хнач, Хкон, dX вводить с экрана.  Таблицу  и график выводить на экран.

 

Ход работы:

1 Создать выходную форму, поместив на нее нужные компоненты.

   Изменить свойства компонент через IO.

2 Набрать приложение. Для того чтобы система создала заготовку обработчика события, сделать двойной щелчок накнопке.

2.Записать проект в созданную специально дл этого проекта папку.

3.Запустить программу (Run./Run). Если ошибок нет, появляется выходная форма.

4.Проверить результаты.

вид функции                                      x.начальн  x.конечное           dX

y=2x/(3+sin(x/3))                                1.7                  6.3               0.5  

 

 

 

    

Рекомендации к выполнению работы

1 Таблицу и график  выводить на  форму в одном проекте ( но можно сделать 2 разных проекта) .

1.Удобно значения Хнач, Хкон, dX  вводить,  задавая свойство TEXT компонента EDIT.

2.Таблицу  Х     У   можно выводить через компонент– многострочный редактор MEMO,  добавляя строку свойству Lines методом Add, например, Memo1.Lines.Add(‘Ответ’).  В строке многострочного редактора Memo1 появится слово «Ответ» и добавится строка, поэтому  следующий вывод будет выполняться с новой строки. Заголовок таблицы можно сделать  при конструировании: Memo1\ Lines…или в программе.

3. График выводить, используя  компонент Chart со страницы Additional.

Chart1\ Add \  выбрать вид графика   \ Ok \ Close

9 Функцию вычислять через подпрограммуFunction

10 Если наформе недостаточно места, поставьте контейнер PageControl   со страницы   Win32.

Настройка :

PageControl1 \  правой кнопкой вызываем меню \ NewPage…   и т.д. Создаем выходной блокнот с нужным количеством страниц. На каждую страницу помещаем компоненты.  На саму программу не влияет то, что компоненты находятся на разных страницах, но удобство просмотра большого объема информации очевидны.

10 При выводе на график точки разрыва (т.е. аргумент вне ОДЗ) просто пропускать.

Вопрос задан анонимно
24.11.12

Программа dupeGuru2.9.0 также позволяет пользователю настраивать алгоритмы сравнения файлов для более точного поиска, например: типы сканирования, жескость фильтра, заданному слову, разброс похожих слов и другие. При поиске программа выводит список найденных файлов с указанием путей, размеров и процентом совпадения.

Основные возможности:

• Быстрый поиск дубликатов, в том числе среди файлов разных форматов;

• настройка программы под конкретные нужды;

• Безопасность — ни один из нужных файлов не будет удален;

• Функция удаления пустых папок;

• Перемещение и копирование дубликатов, удаление плохих копий.

В этой версии исправлены некоторые ошибки:

• Значительно улучшена скорость и использование памяти при сканировании больших массивов.

• Добавлена поддержка dragdropв панели папок. )

• Исправлена ошибка, приводившая dupeGuruк некорректному отчету при перемещении файлов во время сканирования.

• Прекращена поддержка MacOSX10.4 (Tiger)

 

DupeGuru — небольшая быстрая утилита для поиска дубликатов файлов на компьютере. Интерфейс программы предельно прост: нужно только выбрать область поиска дубликатов (Мои докуметы, все диски, отдельный каталог/типы файлов). Программа просканирует диск и выдаст результат в виде наглядной таблицы. dupeGuruможет просмотреть имена файлов и их содержание. Просмотр имени файла показывает четкий алгоритм соответствия, который может найти двойные имена файла даже когда они не точно похожи.

 

 

Алгоритм:

Производим рекурсивный поиск файлов, по каждому файлу создаем метку = "<имя_файла>:<размер>:<дата>", и сохраняем в бинарное дерево поиска, если такой метки нет, создаем новую, иначе найдены совпадения.

Реализация

Все операции необходимо выполнять в потоке.

type

  TFileSearchThread = class(TThread)

  private

    _TickCountIntervalBeforeRefresh: integer;

    locProgressMax: integer;

    locProgressPosition: integer;

    locSearchFilesDone: integer;

    locCurrentFile: string;

    procedure SetName;

    procedure SetStatus;

    procedure ThreadDone;

    procedure FindFiles(

        paramFolder,

        paramMask: string;

        const paramLevel: integer);

    function GetFilesCount(

        paramFolder: string;

        const paramLevel :integer): integer;

    procedure AddToTree(

        var paramNode: TSearchTreeNode;

        const paramPath: string;

        const paramHash: string;

        const FileSize: integer

        );

  protected

    procedure Execute; override;

  public

    SearchFolder: string;

    Mask: string;

    FilesTree: TSearchTreeNode;

  end;

{$IFDEF MSWINDOWS}

type

  TThreadNameInfo = record

    FType: LongWord;     // must be 0x1000

    FName: PChar;        // pointer to name (in user address space)

    FThreadID: LongWord; // thread ID (-1 indicates caller thread)

    FFlags: LongWord;    // reserved for future use, must be zero

  end;

{$ENDIF}

{ TFileSearchThread }

procedure TFileSearchThread.SetName;

{$IFDEF MSWINDOWS}

var

  ThreadNameInfo: TThreadNameInfo;

{$ENDIF}

begin

{$IFDEF MSWINDOWS}

  ThreadNameInfo.FType := $1000;

  ThreadNameInfo.FName := 'FileSearchThread';

  ThreadNameInfo.FThreadID := $FFFFFFFF;

  ThreadNameInfo.FFlags := 0;

  try

    RaiseException( $406D1388, 0, sizeof(ThreadNameInfo) div sizeof(LongWord), @ThreadNameInfo );

  except

  end;

{$ENDIF}

end;

procedure TFileSearchThread.Execute;

begin

  SetName;

  // Calculate less 2 sec

  _TickCountIntervalBeforeRefresh := GetTickCount()+2000;

  locProgressMax := 0;

  locProgressPosition := 0;

  GetFilesCount(SearchFolder, 0);

  // Start search

  _TickCountIntervalBeforeRefresh := 0;

  findfiles(SearchFolder, Mask, 0);

  // finish

  synchronize(ThreadDone);

end;

Рекурсивный поиск файлов

procedure TFileSearchThread.FindFiles(

      paramFolder,

      paramMask: string;

      const paramLevel: integer);

var

  searchrec: tsearchrec;

  findresult: integer;

  hash: string;

begin

  if self.Terminated then

    exit;

  if paramLevel <= uConst.cLevelCountForCalculateFilesCount then

    Inc(locProgressPosition);

  if locProgressPosition > locProgressMax then

    locProgressMax := locProgressPosition;

  // Update status

  if GetTickCount() > _TickCountIntervalBeforeRefresh then

  begin

    //300 — update thread info interval in msec :

    _TickCountIntervalBeforeRefresh := GetTickCount() + 300; //

    locCurrentFile := paramFolder;

    synchronize(SetStatus);

  end;

  paramFolder:=includetrailingbackslash(paramFolder);

  findresult:=findfirst(paramFolder+paramMask, faanyfile, searchrec);

  try

    while findresult = 0 do

    begin

      if (searchrec.attr and fadirectory)<>0 then

      begin

        if (searchrec.name<>'.') and (searchrec.name<>'..') then

          findfiles(paramFolder+searchrec.name, paramMask, paramLevel+1);

      end

      else

      begin

        hash := searchrec.name;

        hash := hash + ':S'+IntToStr(searchrec.Size);

        hash := hash + ':T'+IntToStr(searchrec.Time);

        AddToTree(FilesTree,paramFolder+searchrec.name,hash,searchrec.Size);

      end;

      findresult:=findnext(searchrec);

    end;

  finally

    findclose(searchrec);

  end;

end;

Сохраняем метку файла в бинарное дерево поиска

procedure TFileSearchThread.AddToTree(

        var paramNode: TSearchTreeNode;

        const paramPath: string;

        const paramHash: string;

        const FileSize: integer

        );

begin

  if not Assigned(paramNode) then

  begin

    paramNode := TSearchTreeNode.Create(nil);

    paramNode.Hash := paramHash;

    paramNode.Files := paramPath+'|'+IntToStr(FileSize);

    paramNode.FilesCount := 1;

  end

  else

  begin

    if paramHash > paramNode.Hash then

      AddToTree(paramNode.HiNode,paramPath,paramHash,FileSize)

     else

    if paramHash < paramNode.Hash then

      AddToTree(paramNode.LowNode,paramPath,paramHash,FileSize)

     else

    begin

      paramNode.FilesCount := paramNode.FilesCount + 1;

      paramNode.Files := paramNode.Files + #13#10+ paramPath+'|'+IntToStr(FileSize);

      // count of entry duplicate files

      if paramNode.FilesCount = 2 then

        Inc(locSearchFilesDone);

    end;

  end;

end;

Предварительное определение общего количества файлов

Для удобства UI, а именно для отображения ProgressBar, нам необходимо приблизительно оценить общее количество файлов, для этого мы рекурсивно подсчитываем число каталогов с вложенностью 2-3(задаем параметром в конфигурационном фале).

functionTFileSearchThread.GetFilesCount(

     paramFolder: string;

     const paramLevel :integer): integer;

var

  searchrec: tsearchrec;

  findresult: integer;

  hash: string;

begin

  // Get folder count in hi 5 levels

  if GetTickCount() > _TickCountIntervalBeforeRefresh then

    exit;

  if paramLevel > uConst.cLevelCountForCalculateFilesCount then

    exit;

  if self.Terminated then

    exit;

  Inc(locProgressMax);

    

  paramFolder := includetrailingbackslash(paramFolder);

  findresult:=findfirst(paramFolder+'*.*', faanyfile, searchrec);

  try

    while findresult = 0 do

    begin

      if (searchrec.attr and fadirectory)<>0 then

      begin

        if (searchrec.name<>'.') and (searchrec.name<>'..') then

          GetFilesCount(paramFolder+searchrec.name, paramLevel+1);

      end;

      findresult:=findnext(searchrec);

    end;

  finally

    findclose(searchrec);

  end;

end;

Здравствуйте, как мне через компонент MathComp сделать так, чтобы график можно было рисовать уже в самой програме?

  
Пользуйтесь нашим приложением Доступно на Google Play Загрузите в App Store
excel   python   wi-fi   windows   windows 7   word   браузер   видеокарта   вики   вирус   драйвера   звук   игры   интернет   клавиатура   комп   компьютер   компьютеры   монитор   ноутбук   ошибка   пк   помогите   помощь   принтер   проблема   программа   программирование   сайт   срочно