31 мая 2012 г.

Как сделать, чтобы форма показывалась поверх всех окон в системе?

К сожалению, установка свойства формы FormStyle в fsStayOnTop заставляет ее всегда находиться выше других окон в приложении, но не во всей системе.

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

1. Добавьте в секцию private вашей формы метод CreateParams:

TForm1 = class(TForm)
private
  procedure CreateParams(var Params: TCreateParams); override;
end;

2. Ниже вставьте такой код этого метода:

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do begin
    ExStyle := ExStyle or WS_EX_TOPMOST;
    WndParent := GetDesktopWindow;
  end;
end;

Как показать форму не активируя ее?

Без долгих пояснений, вот код:

ShowWindow(Form1.Handle, SW_SHOWNOACTIVATE);
Form1.Visible := True;

Работает идеально, проверял в Delphi XE.

29 апр. 2011 г.

Delphi x64

Просто поражает количество вопросов в сети, касающихся компиляции приложений для Windows x64 в Delphi.

Ну нет 64-х битного компилятора Delphi. Совсем нет. Есть только 32-х битный, который, соответственно, генерит 32-х битный код. И этот код отлично работает под 64-х разрядными виндами.

Уже много лет тянется создание делфового компилятора для 32/64-битных систем. И вроде как работа близка к завершению. По крайней мере есть уже скриншоты нового IDE. Так что ждать осталось недолго. Скорее всего, поддержка 64-битности появится в следующей версии Delphi.

18 апр. 2011 г.

Ошибка «SetThreadContext failed» в Delphi 2007/2009 под Windows 7 x64

Столкнулся с неприятной ошибкой в Delphi 2009 под Windows 7 x64. Как оказалось, точно такая же ошибка присутствует и в Delphi 2007.

При закрытии любого запущенного из IDE приложения появляется сообщение об ошибке: «Assertion failure: "(!"SetThreadContext failed")" in ..\win32src\thread32.cpp at line 412 Continue execution?»

После исследования бескрайних энторнетов на предмет бесплатного решения, было обнаружено, что ошибка действительно имеет место быть. И официального решения для нее до сих пор нет.

Но, разумеется, есть неофициальное.

Трудолюбивые программисты могут почитать объяснение, поковыряться в коде хекс-эдитором и сделать так, чтоб работало.

Ленивые программисты могут просто скачать неофициальный патч.

Учтите, что в любом случае никто не несет ответственности за ваши действия.

22 окт. 2009 г.

Установка компонентов в Delphi

Как установить компоненты, которые находятся в модуле?

Раньше (вплоть до Delphi 7) все было просто: Component > Install Component и в появившемся окне выбираем модуль для установки (автоматически подставляется имя редактируемого в данный момент модуля).

В более поздних версиях Delphi легкий путь убрали (мы же не ищем легких путей, правда?). Остался более сложный, зато он доступен в любых версиях.

Создайте новый Package (в Delphi 2009: File > New > Package - Delphi). Добавьте в него модуль, который хотите установить (в Delphi 2009: Project > Add To Project). После этого в Project Manager используйте команду Install. Сохранять Package не обязательно.

19 окт. 2009 г.

Проводник своими руками

Некоторые даже не догадываются, что в Delphi начиная с шестой версии включены компоненты ShellControls, воссоздающие функциональность Проводника. А некоторые безуспешно пытались найти их в Delphi 2009.

Так вот, радостное известие: они никуда не делись! Все так же входят в комплект поставки, просто спрятаны лучше.

Найти их можно так:

Для пользователей Delphi 7, например:
C:\Program Files\Borland\Delphi7\Demos\ShellControls 

Для пользователей Delphi 2009, например:
С:\Documents and Settings\All Users\Документы\RAD Studio\6.0\Demos\DelphiWin32\VCLWin32\ShellControls

Для остальных версий — подобным образом. После установки четыре пиктограмки будет добавлено в панель Samples.

Набор компонентов ShellControls включает:
  1. TShellListView: список папок и файлов, совсем как в Проводнике Windows.
  2. TShellTreeView: дерево папок, совсем как в Проводнике Windows.
  3. TShellComboBox: выпадающий список папок, совсем как в Проводнике Windows.
  4. ShellChangeNotifier: компонент который отслеживает изменения в заданной папке.
Соединив TShellListView, TShellTreeView и TShellComboBox можно получить большую часть функциональности Проводника без написания кода.

Однако не стоит забывать, что ShellControls не зря не включены в основной набор VCL (в отличие от абсолютно бесполезных Win 3.1 Controls). Компоненты глючноваты и абсолютно недокументированы.

Установка даты/времени для папок

В Delphi есть замечательные функции для установки аттрибутов и даты/времени файлов:

function FileSetAttr(const FileName: string
  Attr: Integer): Integer;
function FileSetDate(const FileName: string
  Age: Integer): Integer;

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

Что-ж, это не впервой. Вооружаемся кнопкой F7 и начинаем трассировку с глубоким проникновением в дебри VCL.

Оказывается, функция FileSetDate выглядит примерно так:

function FileSetDate(const FileName: string
  Age: Integer): Integer;
var
  f: THandle;
begin
  f := FileOpen(FileName, fmOpenWrite);
  if f = THandle(-1) then
    Result := GetLastError
  else
  begin
    Result := FileSetDate(f, Age);
    FileClose(f);
  end;
end;

После вызова FileOpen срабатывает условие f = THandle(-1). Это говорит нам о том, что использовать данную функцию для получения хэндла папки нельзя.

Проникнем в функцию FileOpen. Она представляет собой вызов API-шной функции CreateFile с определенным набором параметров. Сама функция имеет такой набор параметров:

function CreateFile(lpFileName: PWideChar; 
  dwDesiredAccess, dwShareMode: DWORD; 
  lpSecurityAttributes: PSecurityAttributes;
  dwCreationDisposition, dwFlagsAndAttributes: DWORD;
  hTemplateFile: THandle): THandle; stdcall;

MSDN не скрывает от нас того факта, что для получения хэндла папки нобходимо присутствие флага FILE_FLAG_BACKUP_SEMANTICS в параметре dwFlagsAndAttributes. Попробуем это на практике. Напишем свою функцию:

function FileSetDate2(const FileName: string
  Age: Integer): Integer;
var
  F: THandle;
begin
  F := CreateFile(PChar(FileName),
    GENERIC_READ or GENERIC_WRITE, 0, nil,
    OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
  if F = THandle(-1) then
    Result := GetLastError
  else
  begin
    Result := FileSetDate(F, Age);
    FileClose(F);
  end;
end;

По-сути мы скопировали функцию из VCL и только заменили способ создания хэндла. Теперь должно работать и с папками.

Но, увы, не работает.

Теперь хэндл создается корректно. Дальше тоже все работает корректно. И все-таки дата у папки остается прежней. В чем же дело? Лезем еще глубже — в ту версию функции FileSetDate, которая принимает хэндл в качестве параметра.

function FileSetDate(Handle: Integer; 
  Age: Integer): Integer;
var
  LocalFileTime, FileTime: TFileTime;
begin
  Result := 0;
  if DosDateTimeToFileTime(LongRec(Age).Hi, 
    LongRec(Age).Lo, LocalFileTime) and
    LocalFileTimeToFileTime(LocalFileTime, 
    FileTime) and SetFileTime(Handle, nil, nil
    @FileTime) then Exit;
  Result := GetLastError;
end;

Как видно, эта функция приводит дату к нужному виду, а затем просто передает ее в API-функцию SetFileTime, имеющую четыре параметра: хэндл открытого файла или папки, время создания, время последнего обращения и время последнего изменения. В нашем же случае передается только последний параметр, что логично для файла и абсолютно бессмысленно для папки! Ведь у папки есть только время создания.

В конце концов, наша собственная функция начинает работать корректно и для файлов и для папок:

function FileSetDate2(const FileName: string;
  Age: Integer): Integer;
var
  LocalFileTime, FileTime: TFileTime;
  F: THandle;
begin
  F := CreateFile(PChar(FileName),
    GENERIC_READ or GENERIC_WRITE, 0, nil,
    OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
  if F = THandle(-1) then
    Result := GetLastError
  else
  begin
    try
      if DosDateTimeToFileTime(LongRec(Age).Hi,
        LongRec(Age).Lo, LocalFileTime) and
        LocalFileTimeToFileTime(LocalFileTime,
        FileTime) and SetFileTime(F, @FileTime,
        nil, @FileTime) then Exit;
      Result := GetLastError;
    finally
      FileClose(F);
    end;
  end;
end;

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