Сколько видел программ на Free Pascal’е — везде объекты уничтожаются вручную, через Free или FreeAndNil. А ведь можно сделать чтобы это происходило автоматически. Для этого надо с объектами работать через интерфейсы и классы делать производными от TInterfacedObject. Переменная типа interface является интеллектуальным указателем, который контролирует использование объекта. Если пытаться использовать переменную типа interface без инициализации, то компилятор выдаст предупреждение. Когда уже никто не использует объект, переменная-интерфейс уничтожит его автоматически.

(читать всё…)

Подскажите, как убить системный процесс? Раньше на XP было так:
А теперь на windows 10 64 bit как?

function KillTask(ExeFileName: string): integer;
const
  PROCESS_TERMINATE=$0001;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  result := 0;
  FSnapshotHandle := CreateToolhelp32Snapshot
  (TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle,
  FProcessEntry32);
  while integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
    UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
    UpperCase(ExeFileName))) then
      Result := Integer(TerminateProcess(OpenProcess(
      PROCESS_TERMINATE, BOOL(0), FProcessEntry32.th32ProcessID), 0));
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;

(читать всё…)

Видел ли кто-то конвертеры heic в jpg с открытым кодом? Или может, процедуры для Delphi
Чтобы добавить его в свою программу.

Варианты которые меня бы устроили в порядке приоритета
1. Процедура для Delphi, которая выполнит конвертацию
2. Сторонняя dll с описанием процедуры
3. Сторонний exe-движок. То есть, не программа с оболочной, а движок которому в параметры записать имя исходного heic-файла и имя нового jpg-файла

(читать всё…)

Задача заключается в следующем : надо данные из memo считать только, в Шестнадцатеричном формате и записать.
Если данные в hex формате, то проблем записи нет, а вот ,если данные в memo имеют русские буквы, или не содержат формата [‘0’..’9′, ‘A’..’F’, ‘a’..’f’]), то ошибка …

Как реализовать проверку перед записью из memo, чтоб , если данные не соответствуют Шестнадцатеричному формату, то выскакивает окно об ошибке showMessage(‘error’); и запись не производится.
p.s
Запрет на ввод кроме как латинице, не подходит. Так как в memo загружаются имена файлов, которые должны загружаться как в hex, так и русские буквы, а вот запись, только для имён в hex.

(читать всё…)

Написал программу передвижения человека по экрану, периодически меняя картинку, создавая эффект движения. Для всех трех картинок использовал компонент TImage. При однократном нажатии на клавишу d человек передвигается по экрану отлично т.е. все три картинки меняются в нужной последовательности! Но если её удерживать, появляются только две картинки из трех.

Man.zip (3.09 Мб)

(читать всё…)

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

(читать всё…)

Как в Делфи сделать аналог дос команды
copy file1 + file2 + file3 (+ …) file_res
Другими словами, объединить несколько файлов в один копированием.

(читать всё…)

Есть N JPG картинок загруженных в Лист.
Запускаем режим слайдшоу. Выбираем по одной картинке.
Когда перебираем последовательно — все просто.
Как сделать рандомный выбор картинки без повторов.
Присваивать каждой картинке переменную? А если N=500…?
Может есть более хитрый способ исключить из результата «уже использованные»?
(Удалять «уже использованные» из листа не получится он чистится только весь)

(читать всё…)

Реально ли создать событие при входе мышки в НЕпрямоугольную область?

1) Для TImage
2) Для другого компонента

(читать всё…)

Поможете мне устранить такой баг?

У меня в папке «E:\tmp» имеется множество файлов и папок. Мне нужно удалить полностью всю папку.
Вот код:

type TArrayString = array of string;

procedure DirList(Dir: string; var DirArr: TArrayString; Over: byte = 0);
var F: TSearchRec;
begin
   ChDir(Dir);
   if Over=0 then
      SetLength(DirArr, 0);
   SetLength(DirArr, Length(DirArr)+1);
   DirArr[Length(DirArr)-1]:=Dir;
   if Dir[Length(Dir)]<>'\' then
      Dir:=Dir+'\';
   if FindFirst('*', faAnyFile, F)=0 then
   repeat
      if F.Attr and faDirectory <> faDirectory then
         DeleteFile(Dir+F.Name);
   until FindNext(F)<>0;
   if FindFirst('*', faAnyFile, F)=0 then
   repeat
      if F.Attr and faDirectory = faDirectory then
         if not (F.Name='.') and not (F.Name='..') then
         begin
            DirList(Dir+F.Name, DirArr, 1);
            ChDir(Dir);
         end;
   until FindNext(F)<>0;
   FindClose(F);
   if Over=0 then
      ChDir('C:\');
end;

procedure TForm1.Button1Click(Sender: TObject);
var DirArr: TArrayString;
    i: integer;
begin
   DirList('E:\tmp', DirArr);
   for i:=High(DirArr) downto Low(DirArr) do
      RemoveDir(DirArr);
end;

Проблема заключается в том, что программа удаляет папки с ошибками (см. скриншот).
Подробнее: при нажатии на кнопку папка физически не удаляется (она остается), но зайти в нее не получается. Однако, при закрытии программы она автоматически удаляется.

В связи с этим вопрос: как удалить папку с файлами полностью без закрытия приложения?

(читать всё…)