vbrus.narod.ru

Последнее обновление: 3 Ноября 2007 г.

На главную страницу
 

Чтиво - программирование на Delphi

    01. Узнаем путь к Windows и System32 в Delphi
    02. Как получить путь к запущенной программе из нее самой? - Delphi
    03. Каким образом можно убрать приложение из Task Bar? - Delphi
    04. Как можно сделать форму прозрачной? - Delphi
    05. Как рисовать прямо на экране? - Delphi
    06. Как использовать анимированные курсоры в программе? - Delphi
    07. Как скопировать файл? - Delphi
    08. Как скопировать директорию с файлами? - Delphi
    09. Как программно создать ярлык? в Delphi
    10. Как перетаскивать форму не только за Caption, но и за любое другое место? Delphi
    11. Как выключить компьютер с любой версией Windows? в Delphi
    12. Работа с реестром в Delphi 1
    13. Объект INIFILES - работа с INI файлами. в Delphi
    14. Как выдать текст под наклоном? - Delphi
    15. Как экспортировать таблицу базы данных в ASCII-файл?
    16. Как выяснить размер BLOB-поля? - Delphi
    17. Как сравнить bookmarks в таблице? - Delphi
    18. Как выделить окошко DBGrid другим цветом? - Delphi
    19. Как закрыть окно подсказки если пользователь закончил приложение? - Delphi
    20. Как установить количество цветов в системной палитре? - Delphi
    21. Как через индекс обратиться к нескольким компонентам? - Delphi
    22. Как копировать и вставлять Bitmap через буфер обмена? - Delphi
    23. Как выяснить положение курсора в МЕМО? - Delphi
    24. Как узнать содержание активной записи в БД? - Delphi
    25. Как выяснить дату последнего изменения файла? - Delphi
    26. Как проверять корректность доступа к базе данных? - Delphi
    27. Как узнать, находится ли дискета в дисководе? - Delphi
    28. Как перейти к указанной записи в БД? - Delphi
    29. Создание db-файла во время работы приложения - Delphi
    30. Как узнать имя компьютера? - Delphi
    31. Как изменить имя компьютера? - Delphi
    32. Работа с корзиной в Windows - Delphi
    33. Как сменить обои на рабочем столе? - Delphi
    34. Снимок рабочего стола - Delphi
    35. Как выключить звук - Delphi
    36. Flash SWF --> EXE - Delphi
    37. Копирвоание файлов для Linux - Delphi
    38. Перетаскивание файла - Delphi
    39. Список всех запущенных приложений - Delphi
    40. Как закрыть приложение или как завершить указанный процесс? - Delphi
    41. Вставить какую-нибудь программу внутрь EXE файла - Delphi
    42. Копирование экрана - Delphi
    43. Как менять разрешение экрана по ходу выполнения программы - Delphi
    44. Как поместить картинку из базы данных, например MsSQL, в компонент TIMAGE ? - Delphi
    45. Как получить горизонтальную прокрутку (scrollbar) в ListBox? - Delphi
    46. Как вставить еще несколько строк в середину StringGrid или после определенной строки? - Delphi
    47. Пример получения позиции курсора из компоненты TMemo. - Delphi
    48. Функция Undo или Отменить в TMemo - Delphi
    49. Как прокрутить текст в Tmemo или в TRichEdit - Delphi
    50. Как определить работает ли уже данное приложение или это первая его копия? - Delphi
    51. Обработка событий от клавиатуры - Delphi
    52. Как сделать так, что при нажатии на Enter происходил переход к следующему элементу формы - Delphi
    53. Перетаскивание файла drag-drop - Delphi
    54. Привлечение внимания к окну - Delphi
    55. Как получить короткий путь файла если имеется длинный ("c:\Program Files" ==> "c:\progra~1") - Delphi
    56. Как создать свою кнопку в заголовке формы (на Caption Bar) - Delphi
    57. Преобразование текста OEM у Ansi - Delphi
    58. Состояние кнопки insert (Insert/Overwrite) - Delphi
    59. IRC клиент на Delphi - Delphi
    60. Работа с Word'om в Делфи - Delphi
    61. Вывод диалога для выбора каталога - Delphi
    62. Как спрятать кнопки в заголовке окна - Delphi
    63. Сколько файлов есть в определённой папке - Delphi
    64. Как выключить монитор в Делфи - Delphi
    65. Как с помощью Проводника открыть конкретный каталог? - Delphi
    66. Как запустить другую программу - Delphi

 

01. Узнаем путь к Windows и System32 в Delphi

    var
    Windir : String;
    WindirP : PChar;
    Res: integer;
    begin
    WinDirP := StrAlloc(MAX_PATH);
    Res := GetWindowsDirectory(WinDirP, MAX_PATH);
    if Res > 0 then WinDir := StrPas(WinDirP);
    Edit1.text:=WinDir;

    Немного другой способ:

    var
    buf: array[0..255] of char;
    begin
    GetWindowsDirectory(buf, sizeof(buf));
    label1.Caption := strpas(buf);

    Если вы хотите узнать путь к папке System32 то тогда место: GetWindowsDirectory замените на GetSystemDirectory

    Наверх

02. Как получить путь к запущенной программе из нее самой?

    Application.EXEName

    Наверх

03. Каким образом можно убрать приложение из Task Bar?

    ShowWindow(Application.Handle,SW_HIDE);

    Наверх

04. Как можно сделать форму прозрачной?

    Для этого необходимо пеpеопpеделить обpаботчик события OnCreate:

    procedure TForm1.FormCreate(Sender: TObject);
    begin
    Brush.Style:=bsClear;
    end;

    Наверх

05. Как рисовать прямо на экране?

    Procedure DrawOnScreen;
    Var DC:HDC;
    DesktopCanvas:TCanvas;
    begin
    DC:=GetDC(0); // получили DC экрана
    try
    DesktopCanvas:=TCanvas.Create;
    DesktopCanvas.Handle:=DC;
    // здесь рисуем на Canvas экрана
    finally
    ReleaseDC(0,DC);
    DesktopCanvas.Free;
    end;
    end;

    Наверх

06. Как использовать анимированные курсоры в программе?

    procedure TForm1.Button1Click(Sender: TObject);
    var
    h:THandle;
    begin
    h:= LoadImage(0,'C:\TheWall\Magic.ani',
    IMAGE_CURSOR, 0, 0,
    LR_DEFAULTSIZE or LR_LOADFROMFILE);
    if h = 0 then ShowMessage('Cursor not loaded')
    else
    begin
    Screen.Cursors[1] := h;
    Form1.Cursor := 1;
    end;
    end;

    Наверх

07. Как скопировать файл?

    Эта процедура позволяет скопиpовать как весь файл пpи From и Count = 0, так и пpоизвольный его кусок.

    function CopyFile( InFile,OutFile: String; From,Count: Longint ): Longint;
    var
    InFS,OutFS: TFileStream;
    begin
    InFS := TFileStream.Create( InFile, fmOpenRead );
    OutFS := TFileStream.Create( OutFile, fmCreate );
    InFS.Seek( From, soFromBeginning );
    Result := OutFS.CopyFrom( InFS, Count );
    InFS.Free;
    OutFS.Free;
    end;

    Наверх

08. Как скопировать директорию с файлами?

    unit FilesOp;

    interface

    uses Forms, SysUtils, ShellAPI, Dialogs;

    procedure CopyFiles(const FromFolder: string; const ToFolder: string);

    implementation

    procedure CopyFiles(const FromFolder: string; const ToFolder: string);
    var
    Fo : TSHFileOpStruct;
    buffer : array[0..4096] of char;
    p : pchar;
    begin
    FillChar(Buffer, sizeof(Buffer), #0);
    p := @buffer;
    StrECopy(p, PChar(FromFolder)); //директория, которую мы хотим скопировать
    FillChar(Fo, sizeof(Fo), #0);
    Fo.Wnd := Application.Handle;
    Fo.wFunc := FO_COPY;
    Fo.pFrom := @Buffer;
    Fo.pTo := PChar(ToFolder); //куда будет скопирована директория
    Fo.fFlags := 0;
    if ((SHFileOperation(Fo) <> 0) or (Fo.fAnyOperationsAborted <> false)) then
    ShowMessage('File copy process cancelled')
    end;

    end.

    Наверх

09. Как программно создать ярлык?

    uses ShlObj, ComObj, ActiveX;

    procedure CreateLink(const PathObj, PathLink, Desc, Param: string);
    var
    IObject: IUnknown;
    SLink: IShellLink;
    PFile: IPersistFile;
    begin
    IObject := CreateComObject(CLSID_ShellLink);
    SLink := IObject as IShellLink;
    PFile := IObject as IPersistFile;
    with SLink do begin
    SetArguments(PChar(Param));
    SetDescription(PChar(Desc));
    SetPath(PChar(PathObj));
    end;
    PFile.Save(PWChar(WideString(PathLink)), FALSE);
    end;

    Наверх

10. Как перетаскивать форму не только за Caption, но и за любое другое место?

    TForm1 = class(TForm)
    private
    procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
    end;

    procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
    begin
    inherited; { вызов унаследованного обpаботчика }
    if M.Result = htClient then { Мышь сидит на окне? }
    M.Result := htCaption; { Если да - то пусть Windows думает, что }
    { мышь на caption bar }
    end;

    Наверх

11. Как выключить компьютер с любой версией Windows?

    function GetWinVersion: string;
    var
    VersionInfo: TOSVersionInfo;
    OSName: string;
    begin
    // устанавливаем размер записи
    VersionInfo.dwOSVersionInfoSize := SizeOf( TOSVersionInfo );
    if Windows.GetVersionEx( VersionInfo ) then
    begin
    with VersionInfo do
    begin
    case dwPlatformId of
    VER_PLATFORM_WIN32s: OSName := 'Win32s';
    VER_PLATFORM_WIN32_WINDOWS: OSName := 'Windows 95';
    VER_PLATFORM_WIN32_NT: OSName := 'Windows NT';
    end; // case dwPlatformId
    Result := OSName + ' Version ' + IntToStr( dwMajorVersion ) + '.' + IntToStr( dwMinorVersion ) +
    #13#10' (Build ' + IntToStr( dwBuildNumber ) + ': ' + szCSDVersion + ')';
    end; // with VersionInfo
    end // if GetVersionEx
    else
    Result := '';
    end;

    procedure ShutDown;
    const
    SE_SHUTDOWN_NAME = 'SeShutdownPrivilege'; // Borland forgot this declaration
    var
    hToken: THandle;
    tkp: TTokenPrivileges;
    tkpo: TTokenPrivileges;
    zero: DWORD;
    begin
    if Pos('Windows NT', GetWinVersion) = 1 then // we've got to do a whole buch of things
    begin
    zero := 0;
    if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
    begin
    MessageBox(0, 'Exit Error', 'OpenProcessToken() Failed', MB_OK);
    Exit;
    end; // if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken)

    if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
    begin
    MessageBox(0, 'Exit Error', 'OpenProcessToken() Failed', MB_OK);
    Exit;
    end; // if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken)

    // SE_SHUTDOWN_NAME
    if not LookupPrivilegeValue( nil, 'SeShutdownPrivilege' , tkp.Privileges[0].Luid ) then
    begin
    MessageBox(0, 'Exit Error', 'LookupPrivilegeValue() Failed', MB_OK);
    Exit;
    end; // if not LookupPrivilegeValue( nil, 'SeShutdownPrivilege' , tkp.Privileges[0].Luid )

    tkp.PrivilegeCount := 1;
    tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

    AdjustTokenPrivileges(hToken, False, tkp, SizeOf( TTokenPrivileges ), tkpo, zero);
    if Boolean(GetLastError()) then
    begin
    MessageBox(0, 'Exit Error', 'AdjustTokenPrivileges() Failed', MB_OK);
    Exit;
    end // if Boolean( GetLastError() )
    else
    ExitWindowsEx( EWX_FORCE or EWX_SHUTDOWN, 0 );

    end // if OSVersion = 'Windows NT'
    else
    begin // just shut the machine down
    ExitWindowsEx( EWX_FORCE or EWX_SHUTDOWN, 0 );
    end; // else
    end;

    Наверх

12. Работа с реестром в Delphi 1

    В Delphi 2 и выше появился объект TRegistry при помощи которого очень просто работать с реестром. Но мы здесь рассмотрим функции API, которые доступны и в Delphi 1.
    Реестр предназначен для хранения системных переменных и позволяет зарегистрировать файлы программы, что обеспечивает их показ в проводнике с соответствующей иконкой, вызов программы при щелчке на этом файле, добавление ряда команд в меню, вызываемое при нажатии правой кнопки мыши над файлом. Кроме того, в реестр можно внести некую свою информацию (переменные, константы, данные о инсталлированной программы ...). Программу можно добавить в список деинсталляции, что позволит удалить ее из менеджера "Установка/Удаление программ" панели управления.
    Для работы с реестром применяется ряд функций API :

    RegCreateKey (Key: HKey; SubKey: PChar; var Result: HKey): Longint;
    Создать подраздел в реестре. Key указывает на "корневой" раздел реестра, в Delphi1 доступен только один - HKEY_CLASSES_ROOT, в в Delphi3 - все. SubKey - имя раздела - строится по принципу пути к файлу в DOS (пример subkey1\subkey2\ ...). Если такой раздел уже существует, то он открывается (в любом случае при успешном вызове Result содержит Handle на раздел). Об успешности вызова судят по возвращаемому значению, если ERROR_SUCCESS, то успешно, если иное - ошибка.

    RegOpenKey(Key: HKey; SubKey: PChar; var Result: HKey): Longint;
    Открыть подраздел Key\SubKey и возвращает Handle на него в переменной Result. Если раздела с таким именем нет, то он не создается. Возврат - код ошибки или ERROR_SUCCESS, если успешно.

    RegCloseKey(Key: HKey): Longint;
    Закрывает раздел, на который ссылается Key. Возврат - код ошибки или ERROR_SUCCESS, если успешно.
    RegDeleteKey(Key: HKey; SubKey: PChar): Longint;
    Удалить подраздел Key\SubKey. Возврат - код ошибки или ERROR_SUCCESS, если нет ошибок.

    RegEnumKey(Key: HKey; index: Longint; Buffer: PChar;cb: Longint): Longint;
    Получить имена всех подразделов раздела Key, где Key - Handle на открытый или созданный раздел (см. RegCreateKey и RegOpenKey), Buffer - указатель на буфер, cb - размер буфера, index - индекс, должен быть равен 0 при первом вызове RegEnumKey. Типичное использование - в цикле While, где index увеличивается до тех пор, пока очередной вызов RegEnumKey не завершится ошибкой (см. пример).

    RegQueryValue(Key: HKey; SubKey: PChar; Value: PChar; var cb: Longint): Longint;

    Возвращает текстовую строку, связанную с ключом Key\SubKey.Value - буфер для строки; cb- размер, на входе - размер буфера, на выходе - длина возвращаемой строки. Возврат - код ошибки.

    RegSetValue(Key: HKey; SubKey: PChar; ValType: Longint; Value: PChar; cb: Longint): Longint; Задать новое значение ключу Key\SubKey, ValType - тип задаваемой переменной, Value - буфер для переменной, cb - размер буфера. В Windows 3.1 допустимо только Value=REG_SZ. Возврат - код ошибки или ERROR_SUCCESS, если нет ошибок.

    Примеры :

    { Создаем список всех подразделов указанного раздела }

    procedure TForm1.Button1Click(Sender: TObject);
    var
    MyKey : HKey; { Handle для работы с разделом }
    Buffer : array[0..1000] of char; { Буфер }
    Err, { Код ошибки }
    index : longint; { Индекс подраздела }
    begin
    Err:=RegOpenKey(HKEY_CLASSES_ROOT,'DelphiUnit',MyKey); { Открыли раздел }
    if Err<> ERROR_SUCCESS then
    begin
    MessageDlg('Нет такого раздела !!',mtError,[mbOk],0);
    exit;
    end;
    index:=0;
    {Определили имя первого подраздела }
    Err:=RegEnumKey(MyKey,index,Buffer,Sizeof(Buffer));
    while err=ERROR_SUCCESS do { Цикл, пока есть подразделы }
    begin
    memo1.lines.add(StrPas(Buffer)); { Добавим имя подраздела в список }
    inc(index); { Увеличим номер подраздела }
    Err:=RegEnumKey(MyKey,index,Buffer,Sizeof(Buffer)); { Запрос }
    end;
    RegCloseKey(MyKey); { Закрыли подраздел }
    end;

    Наверх

13. Объект INIFILES - работа с INI файлами.

    Почему иногда лучше использовать INI-файлы, а не реестр?
    1. INI-файлы можно просмотреть и отредактировать в обычном блокноте.
    2. Если INI-файл хранить в папке с программой, то при переносе папки на другой компьютер настройки сохраняются. (Я еще не написал ни одной программы, которая бы не поместилась на одну дискету :)
    3. Новичку в реестре можно запросто запутаться или (боже упаси), чего-нибудь не то изменить.
    Поэтому для хранения параметров настройки программы удобно использовать стандартные INI файлы Windows. Работа с INI файлами ведется при помощи объекта TIniFiles модуля IniFiles. Краткое описание методов объекта TIniFiles дано ниже.

    Constructor Create('d:\test.INI');
    Создать экземпляр объекта и связать его с файлом. Если такого файла нет, то он создается, но только тогда, когда произведете в него запись информации.

    WriteBool(const Section, Ident: string; Value: Boolean);
    Присвоить элементу с именем Ident раздела Section значение типа boolean

    WriteInteger(const Section, Ident: string; Value: Longint);
    Присвоить элементу с именем Ident раздела Section значение типа Longint

    WriteString(const Section, Ident, Value: string);
    Присвоить элементу с именем Ident раздела Section значение типа String

    ReadSection (const Section: string; Strings: TStrings);
    Прочитать имена всех корректно описанных переменных раздела Section (некорректно описанные опускаются)


    ReadSectionValues(const Section: string; Strings: TStrings);
    Прочитать имена и значения всех корректно описанных переменных раздела Section. Формат :
    имя_переменной = значение


    EraseSection(const Section: string);
    Удалить раздел Section со всем содержимым

    ReadBool(const Section, Ident: string; Default: Boolean): Boolean;
    Прочитать значение переменной типа Boolean раздела Section с именем Ident, и если его нет, то вместо него подставить значение Default.

    ReadInteger(const Section, Ident: string; Default: Longint): Longint;
    Прочитать значение переменной типа Longint раздела Section с именем Ident, и если его нет, то вместо него подставить значение Default.

    ReadString(const Section, Ident, Default: string): string;
    Прочитать значение переменной типа String раздела Section с именем Ident, и если его нет, то вместо него подставить значение Default.

    Free;
    Закрыть и освободить ресурс. Необходимо вызвать при завершении работы с INI файлом

    Property Values[const Name: string]: string;
    Доступ к существующему параметру по имени Name

    Пример :

    Procedure TForm1.FormClose(Sender: TObject);
    var
    IniFile:TIniFile;
    begin
    IniFile := TIniFile.Create('d:\test.INI'); { Создали экземпляр объекта }
    IniFile.WriteBool('Options', 'Sound', True); { Секция Options: Sound:=true }
    IniFile.WriteInteger('Options', 'Level', 3); { Секция Options: Level:=3 }
    IniFile.WriteString('Options' , 'Secret password', Pass);
    { Секция Options: в Secret password записать значение переменной Pass }
    IniFile.ReadSection('Options ', memo1.lines); { Читаем имена переменных}
    IniFile.ReadSectionValues('Options ', memo2.lines); { Читаем имена и значения }
    IniFile.Free; { Закрыли файл, уничтожили объект и освободили память }
    end;

    Наверх

14. Как выдать текст под наклоном?

    Чтобы вывести под любым углом текст необходимо использовать TrueType Fonts (например "Arial"). Например:

    var
    LogFont : TLogFont;

    ...
    GetObject(Canvas.Font.Handle, SizeOf(TLogFont), @LogFont);
    { Вывести текст 1/10 градуса против часовой стрелки }
    LogFont.lfEscapement := Angle*10;
    Canvas.Font.Handle := CreateFontIndirect(LogFont);

    Наверх

15. Как экспортировать таблицу базы данных в ASCII-файл?

    procedure TMyTable.ExportToASCII;

    var
    I: Integer;
    Dlg: TSaveDialog;
    ASCIIFile: TextFile;
    Res: Boolean;

    begin
    if Active then
    if (FieldCount > 0) and (RecordCount > 0) then
    begin
    Dlg := TSaveDialog.Create(Application);
    Dlg.FileName := FASCIIFileName;
    Dlg.Filter := 'ASCII-Fiels (*.asc)|*.asc';
    Dlg.Options := Dlg.Options+[ofPathMustExist,
    ofOverwritePrompt, ofHideReadOnly];
    Dlg.Title := 'Экспоритровать данные в ASCII-файл';
    try
    Res := Dlg.Execute;
    if Res then
    FASCIIFileName := Dlg.FileName;
    finally
    Dlg.Free;
    end;
    if Res then
    begin
    AssignFile(ASCIIFile, FASCIIFileName);
    Rewrite(ASCIIFile);
    First;
    if FASCIIFieldNames then
    begin
    for I := 0 to FieldCount-1 do
    begin
    Write(ASCIIFile, Fields[I].FieldName);
    if I <> FieldCount-1 then
    Write(ASCIIFile, FASCIISeparator);
    end;
    Write(ASCIIFile, #13#10);
    end;
    while not EOF do
    begin
    for I := 0 to FieldCount-1 do
    begin
    Write(ASCIIFile, Fields[I].Text);
    if I <> FieldCount-1 then
    Write(ASCIIFile, FASCIISeparator);
    end;
    Next;
    if not EOF then
    Write(ASCIIFile, #13#10);
    end;
    CloseFile(ASCIIFile);
    if IOResult <> 0 then
    MessageDlg('Ошибка при создании или переписывании '+
    'в ASCII-файл', mtError, [mbOK], 0);
    end;
    end
    else
    MessageDlg('Нет данных для экспортирования.',
    mtInformation, [mbOK], 0)
    else
    MessageDlg('Таблица должна быть открытой, чтобы данные '+
    'можно было экспортировать в ASCII-формат.', mtError,
    [mbOK], 0);
    end;

    Наверх

16. Как выяснить размер BLOB-поля?

    Следующая функция поможет определить размер BLOB-поля.

    Function GetBlobSize(Field: TBlobField): LongInt;
    begin
    with TBlobStream.Create(Field, bmRead) do
    try
    Result := Seek(0, 2);
    finally
    Free;
    end;
    end;

    Наверх

17. Как сравнить bookmarks в таблице?

    function TBDEDirect.CompareBookmarks(Bookmark1,
    Bookmark2: TBookmark): Boolean;
    var
    Res: DBIResult;
    CompareRes: Word;
    begin
    Result := False;
    if CheckDatabase then
    begin
    Res := DbiCompareBookmarks(FDataLink.DataSource.DataSet.Handle,
    Bookmark1, Bookmark2, CompareRes);
    if Res = 0 then
    if CompareRes = 0 then
    Result := True
    else
    else
    Check(Res);
    end;
    end;

    Наверх

18. Как выделить окошко DBGrid другим цветом?

    Необходимо обработать событие "OnDrawCellData". Например для того, чтобы пометить выбранное окошко красным фоном, необходимо сделать следующее:

    procedure TForm1.DBGridDrawDataCell(Sender:TObject; const Rect:TRect;
    Field:TField; State:TGridDrawState);
    begin
    if gdFocused in State then
    with (Sender as TDBGrid).Canvas do
    begin
    Brush.Color := clRed;
    FillRect(Rect);
    TextOut(Rect.Left, Rect.Top, Field.AsString);
    end;
    end;

    Наверх

19. Как закрыть окно подсказки если пользователь закончил приложение?

    procedure TMainForm.FormClose(Sender: TObject;
    var Action: TCloseAction);
    begin
    Winhelp(Handle, 'WINHELP.HLP', HELP_QUIT, 0);
    Action := caFree;
    end;

    Наверх

20. Как установить количество цветов в системной палитре?

    Функция GetNumColors возвращает количество цветов для актуально выбранного разрешения экрана.

    function GetNumColors: LongInt;
    var
    BPP: Integer;
    DC: HDC;
    begin
    DC := CreateDC('DISPLAY', nil, nil, nil);
    if DC <> 0 then begin
    try
    BPP := GetDeviceCaps(DC, BITPIXEL) * GetDeviceCaps(DC, PLANES);
    finally
    DeleteDC(DC);
    end;
    case BPP of
    1: Result := 2;
    4: Result := 16;
    8: Result := 256;
    15: Result := 32768;
    16: Result := 65536;
    24: Result := 16777216;
    end;
    end else
    Result := 0;
    end;

    Наверх

21. Как через индекс обратиться к нескольким компонентам?

    Чтобы найти и сделать видимыми, например, компоненты с именами от "Label1" и до "Label5" можно использовать следующий вариант:

    for t := 1 to 5 do
    FindComponent('Label' + IntToStr(t)).Visible := TRUE;

    Наверх

22. Как копировать и вставлять Bitmap через буфер обмена?

    Некоторые функции для копирования и вставки Bitmap-объектов через буфер обмена.

    function CopyClipToBuf(DC: HDC; Left, Top,
    Width, Height: Integer; Rop: LongInt;
    var CopyDC: HDC;
    var CopyBitmap: HBitmap): Boolean;
    var
    TempBitmap: HBitmap;
    begin
    Result := False;
    CopyDC := 0;
    CopyBitmap := 0;
    if DC <> 0 then
    begin
    CopyDC := CreateCompatibleDC(DC);
    if CopyDC <> 0 then
    begin
    CopyBitmap := CreateCompatibleBitmap(DC,
    Width, Height);
    if CopyBitmap <> 0 then
    begin
    TempBitmap := CopyBitmap;
    CopyBitmap := SelectObject(CopyDC,
    CopyBitmap);
    Result := BitBlt(CopyDC, 0, 0,
    Width, Height, DC,
    Left, Top, Rop);
    CopyBitmap := TempBitmap;
    end;
    end;
    end;
    end;

    function CopyBufToClip(DC: HDC; var CopyDC: HDC;
    var CopyBitmap: HBitmap;
    Left, Top, Width, Height: Integer;
    Rop: LongInt; DeleteObjects: Boolean): Boolean;
    var
    TempBitmap: HBitmap;
    begin
    Result := False;
    if (DC <> 0) and
    (CopyDC <> 0) and
    (CopyBitmap <> 0) then
    begin
    TempBitmap := CopyBitmap;
    CopyBitmap := SelectObject(DC, CopyBitmap);
    Result := BitBlt(DC, Left, Top,
    Width, Height, CopyDC,
    0, 0, Rop);
    CopyBitmap := TempBitmap;
    if DeleteObjects then
    begin
    DeleteDC(CopyDC);
    DeleteObject(CopyBitmap);
    end;
    end;
    end;

    Наверх

23. Как выяснить положение курсора в МЕМО?

    Необходимо вызвать дважды API-функцию "SendMessage":

    var
    xChr,
    xRow,
    xCol: LongInt;
    ...

    xRow := SendMessage(Memo1.Handle, EM_LINEFROMCHAR, Memo1.SelStart, 0);
    xChr := SendMessage(Memo1.Handle, EM_LINEINDEX, Zeile, 0);
    xCol := Memo1.SelStart - xChr + 1;

    Наверх

24. Как узнать содержание активной записи в БД?

    Следующая функция возвращает в виде указателя на строку содержание активной записи в БД.

    function TBDEDirect.GetCurRecord(Lock: DBILockType): PChar;
    var
    Res: DBIResult;
    RecSize: Word;
    RecBuf: PChar;
    Bookmark: TBookmark;
    begin
    Result := StrNew('');
    if CheckDatabase then
    begin
    RecSize := GetPhysicalRecSize;
    RecBuf := StrAlloc(RecSize+1);
    FillChar(RecBuf^, RecSize+1, #0);
    Bookmark := FDataLink.DataSource.DataSet.GetBookmark;
    DbiSetToBookmark(FDataLink.DataSource.DataSet.Handle,
    Bookmark);
    FDataLink.DataSource.DataSet.FreeBookmark(Bookmark);
    Res := DbiGetRecord(FDataLink.DataSource.DataSet.Handle,
    Lock, RecBuf, nil);
    if Res = 0 then
    Result := RecBuf
    else
    Check(Res);
    end;
    end;

    Наверх

25. Как выяснить дату последнего изменения файла?

    Для выяснения даты последнего изменения файла можно воспользоваться следующей функцией:

    function GetFileDate(FileName: string): string;
    var
    FHandle: Integer;
    begin
    FHandle := FileOpen(FileName, 0);
    try
    Result := DateTimeToStr(FileDateToDateTime(FileGetDate(FHandle)));
    finally
    FileClose(FHandle);
    end;
    end;

    Наверх

26. Как проверять корректность доступа к базе данных?

    Следующая функция проверяет доступ к базе данных и выдает возможные причины, если доступ не удается осуществить. Функция возвращает значение True в случае успешной операции и False в противном случае.

    function TBDEDirect.CheckDatabase: Boolean;
    var
    DS: TDataSource;
    begin
    Result := False;
    DS := GetDataSource;
    if DS = nil then
    begin
    MessageDlg('Не установлена связь с элементом-источником данных.'+
    'Проверьте установку свойства DataSource.',
    mtError, [mbOK], 0);
    Exit;
    end;
    if DS.DataSet = nil then
    begin
    MessageDlg('Доступ к базе данных невозможен.', mtError,
    [mbOK], 0);
    Exit;
    end;
    if TDBDataSet(DS.DataSet).Database = nil then
    begin
    MessageDlg('Доступ к базе данных невозможен.', mtError,
    [mbOK], 0);
    Exit;
    end;
    if TDBDataSet(DS.DataSet).Database.Handle = nil then
    begin
    MessageDlg('Дескриптор (Handle) БД недоступен.', mtError,
    [mbOK], 0);
    Exit;
    end;
    if DS.DataSet.Handle = nil then
    begin
    MessageDlg('Дескриптор курсора (Cursor-Handle) недоступен.', mtError,
    [mbOK], 0);
    Exit;
    end;
    Result := True;
    end;

    Наверх

27. Как узнать, находится ли дискета в дисководе?

    type
    TDriveState(DS_NO_DISK, DS_UNFORMATTED_DISK,
    DS_EMPTY_DISK, DS_DISK_WITH_FILES);

    function DriveState(DrvLetter: Char): TDriveState;

    var
    Mask: String[6];
    SearchRec: TSearchRec;
    oldMode: Cardinal;
    ReturnCode: Integer;

    begin
    oldMode: = SetErrorMode(SEM_FAILCRITICALERRORS);
    Mask:= '?:\*.*';
    Mask[1] := DrvLetter;
    {$I-} { отключить обработку исключительных ситуаций }
    ReturnCode := FindFirst(Mask, faAnyfile, SearchRec);
    FindClose(SearchRec);

    {$I+} case ReturnCode of
    { как минимум один файл был найден }
    0: Result := DS_DISK_WITH_FILES;
    { файлов не найдено и дискета в порядке }
    -18: Result := DS_EMPTY_DISK;
    { DS_NO_DISK для DOS, ERROR_NOT_READY для WinNT, ERROR_PATH_NOT_FOUND для Win 3.1 }
    -21, -3: Result := DS_NO_DISK;
    else
    { дискета лежит в дисководе но она не форматировнная }
    Result := DS_UNFORMATTED_DISK;
    end;
    SetErrorMode(oldMode);
    end; { DriveState }

    Наверх

28. Как перейти к указанной записи в БД?

    Демонстрация перехода к указанной записи через задание номера записи.
    function TBDEDirect.GoToRecord(RecNo: LongInt): Boolean;
    var
    RecCount: LongInt;
    Bookmark: TBookmark;
    Res: DBIResult;
    begin
    Result := False;
    if CheckDatabase then
    begin
    if RecNo < 1 then
    RecNo := 1;
    RecCount := GetRecordCount;
    if RecNo > RecCount then
    RecNo := RecCount;
    Res := DbiSetToRecordNo(FDataLink.DataSource.DataSet.Handle,
    RecNo);
    if Res = 0 then
    begin
    Bookmark := StrAlloc(GetBookmarkSize);
    DbiGetBookmark(FDataLink.DataSource.DataSet.Handle,
    Bookmark);
    FDataLink.DataSource.DataSet.GoToBookmark(Bookmark);
    FDataLink.DataSource.DataSet.FreeBookmark(Bookmark);
    Result := True;
    end
    else
    Check(Res);
    end;
    end;

    Наверх

29. Создание db-файла во время работы приложения

    uses DB, DBTables, StdCtrls;

    procedure TForm1.Button1Click(Sender: TObject);
    var

    tSource, TDest: TTable;
    begin
    TSource := TTable.create(self);
    with TSource do begin
    DatabaseName := 'dbdemos';
    TableName := 'customer.db';
    open;
    end;
    TDest := TTable.create(self);
    with TDest do begin
    DatabaseName := 'dbdemos';
    TableName := 'MyNewTbl.db';
    FieldDefs.Assign(TSource.FieldDefs);
    IndexDefs.Assign(TSource.IndexDefs);
    CreateTable;
    end;
    TSource.close;
    end;

    Наверх

30. Как узнать имя компьютера?

    Function ReadComputerName:string;
    var
    i:DWORD;
    p:PChar;
    begin
    i:=255;
    GetMem(p, i);
    GetComputerName(p, i);
    Result:=String(p);
    FreeMem(p);
    end;

    Наверх

31. Как изменить имя компьютера?

    SetComputerName(PChar(Edit1.text));

    Наверх

32. Работа с корзиной в Windows

    32.01 Как получить количество файлов в корзине и их размер?
    32.02 Просмотр состояния корзины
    32.03 Очистка корзины
    32.04 Удаление файла в корзину

    32.01 Как получить количество файлов в корзине и их размер?
    ===============================================================
    type
    PSHQueryRBInfo = ^TSHQueryRBInfo;
    TSHQueryRBInfo = packed record
    cbSize: DWORD;
    // Size of the structure, in bytes.
    // This member must be filled in prior to calling the function.
    i64Size: Int64;
    // Total size of all the objects in the specified Recycle Bin, in bytes.
    i64NumItems: Int64;
    // Total number of items in the specified Recycle Bin.
    end;

    const
    shell32 = 'shell32.dll';

    function SHQueryRecycleBin(szRootPath: PChar; SHQueryRBInfo: PSHQueryRBInfo): HResult;

    stdcall; external shell32 Name 'SHQueryRecycleBinA';

    function GetDllVersion(FileName: string): Integer;
    var
    InfoSize, Wnd: DWORD;
    VerBuf: Pointer;
    FI: PVSFixedFileInfo;
    VerSize: DWORD;
    begin
    Result := 0;
    InfoSize := GetFileVersionInfoSize(PChar(FileName), Wnd);
    if InfoSize <> 0 then
    begin
    GetMem(VerBuf, InfoSize);
    try
    if GetFileVersionInfo(PChar(FileName), Wnd, InfoSize, VerBuf) then
    if VerQueryValue(VerBuf, '\', Pointer(FI), VerSize) then
    Result := FI.dwFileVersionMS;
    finally
    FreeMem(VerBuf);
    end;
    end;
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    var
    DllVersion: integer;
    SHQueryRBInfo: TSHQueryRBInfo;
    r: HResult;
    begin
    DllVersion := GetDllVersion(PChar(shell32));
    if DllVersion >= $00040048 then
    begin
    FillChar(SHQueryRBInfo, SizeOf(TSHQueryRBInfo), #0);
    SHQueryRBInfo.cbSize := SizeOf(TSHQueryRBInfo);
    R := SHQueryRecycleBin(nil, @SHQueryRBInfo);
    if r = s_OK then
    begin
    label1.Caption := Format('Size:%d Items:%d',
    [SHQueryRBInfo.i64Size, SHQueryRBInfo.i64NumItems]);
    end
    else
    label1.Caption := Format('Err:%x', [r]);
    end;
    end;
    {
    The SHQueryRecycleBin API used in this method is
    only available on systems with the latest shell32.dll installed with IE4 /
    Active Desktop.
    }

    32.02 Просмотр состояния корзины
    ==============================================
    unit Unit1;
    interface

    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls, ShellAPI;

    const
    SHERB_NOCONFIRMATION = $1;
    SHERB_NOPROGRESSUI = $2;
    SHERB_NOSOUND = $4;

    type
    TForm1 = class(TForm)
    btnGetRecicleBinFileCount: TButton;
    btnEmptyRecicleBin: TButton;
    btnDelToReciclebin: TButton;
    procedure btnGetRecicleBinFileCountClick(Sender: TObject);
    procedure btnEmptyRecicleBinClick(Sender: TObject);
    procedure btnDelToReciclebinClick(Sender: TObject);
    end;

    type
    TSHQueryRBInfo = packed record
    cbSize : DWORD;
    i64Size,
    i64NumItems : TLargeInteger;
    end;
    PSHQueryRBInfo = ^TSHQueryRBInfo;

    function SHEmptyRecycleBin(hwnd: HWND; pszRootPath: PChar;
    dwFlags: DWORD): HRESULT; stdcall;
    external 'shell32.dll' name 'SHEmptyRecycleBinA';

    function SHQueryRecycleBin (pszRootPath: PChar;
    var SHQueryRBInfo: TSHQueryRBInfo): HRESULT; stdcall;
    external 'Shell32.dll' name 'SHQueryRecycleBinA';

    var

    Form1: TForm1;

    implementation

    {$R *.dfm}

    // Просмотр состояния корзины (краткая информация)
    procedure TForm1.btnGetRecicleBinFileCountClick(Sender: TObject);
    var
    Info: TSHQueryRBInfo;
    Err: HRESULT;
    begin
    ZeroMemory(@Info, SizeOf(Info));
    Info.cbSize := SizeOf(Info);
    Err := SHQueryRecycleBin(nil, Info);
    if Err = S_OK then
    ShowMessage(Format('Всего в корзине %d эелементов, их общий размер: %d',
    [Info.i64NumItems, Info.i64Size]))
    else
    ShowMessage(SysErrorMessage(Err));
    end;
    end.

    32.03 Очистка корзины
    ==========================================================
    unit Unit1;

    interface

    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls, ShellAPI;

    const
    SHERB_NOCONFIRMATION = $1;
    SHERB_NOPROGRESSUI = $2;
    SHERB_NOSOUND = $4;

    type
    TForm1 = class(TForm)
    btnGetRecicleBinFileCount: TButton;
    btnEmptyRecicleBin: TButton;
    btnDelToReciclebin: TButton;
    procedure btnGetRecicleBinFileCountClick(Sender: TObject);
    procedure btnEmptyRecicleBinClick(Sender: TObject);
    procedure btnDelToReciclebinClick(Sender: TObject);
    end;

    type
    TSHQueryRBInfo = packed record
    cbSize : DWORD;
    i64Size,
    i64NumItems : TLargeInteger;
    end;
    PSHQueryRBInfo = ^TSHQueryRBInfo;

    function SHEmptyRecycleBin(hwnd: HWND; pszRootPath: PChar;
    dwFlags: DWORD): HRESULT; stdcall;

    external 'shell32.dll' name 'SHEmptyRecycleBinA';

    function SHQueryRecycleBin (pszRootPath: PChar;

    var SHQueryRBInfo: TSHQueryRBInfo): HRESULT; stdcall;
    external 'Shell32.dll' name 'SHQueryRecycleBinA';

    var
    Form1: TForm1;

    implementation

    {$R *.dfm}

    // Очистка корзины
    procedure TForm1.btnEmptyRecicleBinClick(Sender: TObject);
    var
    Err: HRESULT;
    begin
    Err := SHEmptyRecycleBin(Handle, 'c:\', SHERB_NOSOUND);
    if Err <> S_OK then ShowMessage(SysErrorMessage(Err));
    end;
    end.

    32.04 Удаление файла в корзину
    ==========================================================
    unit Unit1;

    interface

    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls, ShellAPI;

    const
    SHERB_NOCONFIRMATION = $1;
    SHERB_NOPROGRESSUI = $2;
    SHERB_NOSOUND = $4;

    type
    TForm1 = class(TForm)
    btnGetRecicleBinFileCount: TButton;
    btnEmptyRecicleBin: TButton;
    btnDelToReciclebin: TButton;
    procedure btnGetRecicleBinFileCountClick(Sender: TObject);
    procedure btnEmptyRecicleBinClick(Sender: TObject);
    procedure btnDelToReciclebinClick(Sender: TObject);
    end;

    type
    TSHQueryRBInfo = packed record
    cbSize : DWORD;
    i64Size,
    i64NumItems : TLargeInteger;
    end;
    PSHQueryRBInfo = ^TSHQueryRBInfo;

    function SHEmptyRecycleBin(hwnd: HWND; pszRootPath: PChar;
    dwFlags: DWORD): HRESULT; stdcall;
    external 'shell32.dll' name 'SHEmptyRecycleBinA';

    function SHQueryRecycleBin (pszRootPath: PChar; var SHQueryRBInfo: TSHQueryRBInfo): HRESULT; stdcall;
    external 'Shell32.dll' name 'SHQueryRecycleBinA';

    var
    Form1: TForm1;

    implementation

    {$R *.dfm}

    // Удаление файла в корзину...
    procedure TForm1.btnDelToReciclebinClick(Sender: TObject);
    var
    Struct: TSHFileOpStruct;
    Err: HRESULT;
    begin
    with Struct do
    begin
    Wnd := Handle;
    wFunc := FO_DELETE;
    pFrom := 'c:\1.txt';
    pTo := nil;
    fFlags := FOF_ALLOWUNDO;
    fAnyOperationsAborted := True;
    hNameMappings := nil;
    lpszProgressTitle := nil;
    end;
    Err := SHFileOperation(Struct);
    if Err <> S_OK then ShowMessage(SysErrorMessage(Err));
    end;
    end.

    Наверх

33. Как сменить обои на рабочем столе?

    program change;
    uses
    windows;
    var
    s: string;
    begin
    s := paramStr(1);
    SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, @S[1],
    SPIF_UPDATEINIFILE OR SPIF_SENDWININICHANGE);
    end.

    // Запускаешь:
    // change.exe "имя файла с картинкой"

    Наверх

34. Снимок рабочего стола

    public
    { Public declarations }
    procedure GrabScreen;
    ...

    implementation
    {$R *.DFM}

    procedure TForm1.GrabScreen;
    var
    DeskTopDC: HDc;
    DeskTopCanvas: TCanvas;
    DeskTopRect: TRect;
    begin
    DeskTopDC := GetWindowDC(GetDeskTopWindow);
    DeskTopCanvas := TCanvas.Create;
    DeskTopCanvas.Handle := DeskTopDC;
    DeskTopRect := Rect(0, 0, Screen.Width, Screen.Height);
    Form1.Canvas.CopyRect(DeskTopRect, DeskTopCanvas, DeskTopRect);
    ReleaseDC(GetDeskTopWindow, DeskTopDC);
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    begin
    GrabScreen;
    end;
    Наверх

35. Как выключить звук?

    uses
    MMSystem;

    function GetMasterMute(
    Mixer: hMixerObj;
    var Control: TMixerControl): MMResult;
    // Returns True on success
    var
    Line: TMixerLine;
    Controls: TMixerLineControls;
    begin
    ZeroMemory(@Line, SizeOf(Line));
    Line.cbStruct := SizeOf(Line);
    Line.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
    Result := mixerGetLineInfo(Mixer, @Line,
    MIXER_GETLINEINFOF_COMPONENTTYPE);
    if Result = MMSYSERR_NOERROR then
    begin
    ZeroMemory(@Controls, SizeOf(Controls));
    Controls.cbStruct := SizeOf(Controls);
    Controls.dwLineID := Line.dwLineID;
    Controls.cControls := 1;
    Controls.dwControlType := MIXERCONTROL_CONTROLTYPE_MUTE;
    Controls.cbmxctrl := SizeOf(Control);
    Controls.pamxctrl := @Control;
    Result := mixerGetLineControls(Mixer, @Controls,
    MIXER_GETLINECONTROLSF_ONEBYTYPE);
    end;
    end;

    procedure SetMasterMuteValue(
    Mixer: hMixerObj;
    Value: Boolean);
    var
    MasterMute: TMixerControl;
    Details: TMixerControlDetails;
    BoolDetails: TMixerControlDetailsBoolean;
    Code: MMResult;
    begin
    Code := GetMasterMute(0, MasterMute);
    if Code = MMSYSERR_NOERROR then
    begin
    with Details do
    begin
    cbStruct := SizeOf(Details);
    dwControlID := MasterMute.dwControlID;
    cChannels := 1;
    cMultipleItems := 0;
    cbDetails := SizeOf(BoolDetails);
    paDetails := @BoolDetails;
    end;
    LongBool(BoolDetails.fValue) := Value;
    Code := mixerSetControlDetails(0, @Details,
    MIXER_SETCONTROLDETAILSF_VALUE);
    end;
    if Code <> MMSYSERR_NOERROR then
    raise Exception.CreateFmt('SetMasterMuteValue failure, '+
    'multimedia system error #%d', [Code]);
    end;

    // Example:

    procedure TForm1.Button1Click(Sender: TObject);
    begin
    SetMasterMuteValue(0, CheckBox1.Checked); // Mixer device #0 mute on/off
    end;

    Наверх

36. Flash SWF --> EXE


    function Swf2Exe(S, D, F: string): string;
    //S = Source file (swf)
    //D = Destionation file (exe)
    //F = Flash Player
    var
    SourceStream, DestinyStream, LinkStream: TFileStream;
    flag: Cardinal;
    SwfFileSize: Integer;
    begin
    Result := 'something error';
    DestinyStream := TFileStream.Create(D, fmCreate);
    try
    LinkStream := TFileStream.Create(F, fmOpenRead or fmShareExclusive);
    try
    DestinyStream.CopyFrom(LinkStream, 0);
    finally
    LinkStream.Free;
    end;

    SourceStream := TFileStream.Create(S, fmOpenRead or fmShareExclusive);
    try
    DestinyStream.CopyFrom(SourceStream, 0);
    flag := $FA123456;
    DestinyStream.WriteBuffer(flag, SizeOf(Integer));
    SwfFileSize := SourceStream.Size;
    DestinyStream.WriteBuffer(SwfFileSize, SizeOf(Integer));
    Result := '';
    finally
    SourceStream.Free;
    end;
    finally
    DestinyStream.Free;
    end;
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    begin
    Swf2Exe('c:\somefile.swf', 'c:\somefile.exe',
    'c:\Program Files\Macromedia\Flash MX\Players\SAFlashPlayer.exe');
    end;

    Наверх

37. CopyFile для Linux

    Function CopyFile(Org, Dest:string):boolean;
    var Source, Target:TFileStream;
    begin
    Result:=false;
    try
    try
    Source:=TFileStream.Create(Org, fmShareDenyNone or fmOpenRead);
    try
    Target:=TFileStream.Create(Dest, fmOpenWrite or fmCreate);
    Target.CopyFrom(Source,Source.Size);
    Result:=true;
    finally
    Target.Free;
    end;
    finally
    Source.Free;
    end;
    except
    end;
    end;

    Наверх

38.Перетаскивание файла

    { На эту форму можно бросить файл (например из проводника) и он будет открыт }
    unit Unit1;
    interface
    uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls, ShellAPI {обязательно!};
    type
    TForm1 = class(TForm)
    Memo1: TMemo;
    FileNameLabel: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    protected
    {Это и есть самая главная процедура}
    procedure WMDropFiles(var Msg: TMessage); message wm_DropFiles;
    end;
    var
    Form1: TForm1;
    implementation
    {$R *.DFM}
    procedure TForm1.WMDropFiles(var Msg: TMessage);
    var
    Filename: array[0 .. 256] of Char;
    Count : integer;
    begin
    { Получаем количество файлов (просто пример) }
    nCount := DragQueryFile( msg.WParam, $FFFFFFFF, acFileName, cnMaxFileNameLen);
    { Получаем имя первого файла }
    DragQueryFile( THandle(Msg.WParam), 0, { это номер файла } Filename,SizeOf(Filename) ) ;
    { Открываем его }
    with FileNameLabel do begin
    Caption := LowerCase(StrPas(FileName));
    Memo1.Lines.LoadfromFile(Caption);
    end;
    { Отдаем сообщение о завершении процесса }
    DragFinish(THandle(Msg.WParam));
    end;
    procedure TForm1.FormCreate(Sender: TObject);
    begin
    { Говорим Windows, что на нас можно бросать файлы }
    DragAcceptFiles(Handle, True);
    end;
    procedure TForm1.FormDestroy(Sender: TObject);
    begin
    { Закрываем за собой дверь золотым ключиком}
    DragAcceptFiles(Handle, False);
    end;
    end.

    Наверх

39.Список всех запущенных приложений

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

    procedure TForm1.Button1Click(Sender: TObject);
    VAR
    Wnd : hWnd;
    buff: ARRAY [0..127] OF Char;
    begin
    ListBox1.Clear;
    Wnd := GetWindow(Handle, gw_HWndFirst);
    WHILE Wnd <> 0 DO BEGIN {Hе показываем:}
    IF (Wnd <> Application.Handle) AND {-Собственное окно}
    IsWindowVisible(Wnd) AND {-Hевидимые окна}
    (GetWindow(Wnd, gw_Owner) = 0) AND {-Дочернии окна}
    (GetWindowText(Wnd, buff, sizeof(buff)) <> 0)
    THEN BEGIN
    GetWindowText(Wnd, buff, sizeof(buff));
    ListBox1.Items.Add(StrPas(buff));
    END;
    Wnd := GetWindow(Wnd, gw_hWndNext);
    END;
    ListBox1.ItemIndex := 0;
    end;

    Наверх

40. Как закрыть приложение или как завершить указанный процесс?

    В данном примере мы закрываем нашу любимую Аську(ICQlite.exe)
    winexec('Cmd /x/c taskkill /f /im ICQlite.exe',SW_SHOWMINIMIZED);

    Наверх

41. Вставить какую-нибудь программу внутрь EXE файла

    1. Пишем в блокноте RC-файл, куда прописываем все нужные нам программы, например:
    ARJ EXEFILE C:\UTIL\ARJ.EXE
    2. Компилируем его в ресурс при помощи Brcc32.exe. Получаем RES-файл.
    3. Далее в тексте нашей программы:


    implementation
    {$R *.DFM}
    {$R test.res} //Это наш RES-файл

    procedure ExtractRes(ResType, ResName, ResNewName : String);
    var
    Res : TResourceStream;
    begin
    Res := TResourceStream.Create(Hinstance, Resname, Pchar(ResType));
    Res.SavetoFile(ResNewName);
    Res.Free;
    end;

    procedure TForm1.BitBtn1Click(Sender: TObject);
    begin
    // Записывает в текущую папку arj.exe
    ExtractRes('EXEFILE', 'ARJ', 'ARJ.EXE');
    end;

    Наверх

42. Копирование экрана


    unit ScrnCap;
    interface
    uses WinTypes, WinProcs, Forms, Classes, Graphics, Controls;

    { Копирует прямоугольную область экрана }
    function CaptureScreenRect(ARect : TRect) : TBitmap;
    { Копирование всего экрана }
    function CaptureScreen : TBitmap;
    { Копирование клиентской области формы или элемента }
    function CaptureClientImage(Control : TControl) : TBitmap;
    { Копирование всей формы элемента }
    function CaptureControlImage(Control : TControl) : TBitmap;

    {===============================================================}
    implementation
    function GetSystemPalette : HPalette;
    var
    PaletteSize : integer;
    LogSize : integer;
    LogPalette : PLogPalette;
    DC : HDC;
    Focus : HWND;
    begin
    result:=0;
    Focus:=GetFocus;
    DC:=GetDC(Focus);
    try
    PaletteSize:=GetDeviceCaps(DC, SIZEPALETTE);
    LogSize:=SizeOf(TLogPalette)+(PaletteSize-1)*SizeOf(TPaletteEntry);
    GetMem(LogPalette, LogSize);
    try
    with LogPalette^ do
    begin
    palVersion:=$0300;
    palNumEntries:=PaletteSize;
    GetSystemPaletteEntries(DC, 0, PaletteSize, palPalEntry);
    end;
    result:=CreatePalette(LogPalette^);
    finally
    FreeMem(LogPalette, LogSize);
    end;
    finally
    ReleaseDC(Focus, DC);
    end;
    end;

    function CaptureScreenRect(ARect : TRect) : TBitmap;
    var
    ScreenDC : HDC;
    begin
    Result:=TBitmap.Create;
    with result, ARect do begin
    Width:=Right-Left;
    Height:=Bottom-Top;
    ScreenDC:=GetDC(0);
    try
    BitBlt(Canvas.Handle, 0,0,Width,Height,ScreenDC, Left, Top, SRCCOPY );
    finally
    ReleaseDC(0, ScreenDC);
    end;
    Palette:=GetSystemPalette;
    end;
    end;

    function CaptureScreen : TBitmap;
    begin
    with Screen do
    Result:=CaptureScreenRect(Rect(0,0,Width,Height));
    end;

    function CaptureClientImage(Control : TControl) : TBitmap;
    begin
    with Control, Control.ClientOrigin do
    result:=CaptureScreenRect(Bounds(X,Y,ClientWidth,ClientHeight));
    end;

    function CaptureControlImage(Control : TControl) : TBitmap;
    begin
    with Control do
    if Parent=Nil then
    result:=CaptureScreenRect(Bounds(Left,Top,Width,Height))
    else
    with Parent.ClientToScreen(Point(Left, Top)) do
    result:=CaptureScreenRect(Bounds(X,Y,Width,Height));
    end;
    end.

    Наверх

43. Как менять разрешение экрана по ходу выполнения программы

    function SetFullscreenMode:Boolean;
    var DeviceMode : TDevMode;
    begin
    with DeviceMode do begin
    dmSize:=SizeOf(DeviceMode);
    dmBitsPerPel:=16;
    dmPelsWidth:=640;
    dmPelsHeight:=480;
    dmFields:=DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT;
    result:=False;
    if ChangeDisplaySettings(DeviceMode,CDS_TEST or CDS_FULLSCREEN) <> DISP_CHANGE_SUCCESSFUL
    then Exit;
    Result:=ChangeDisplaySettings(DeviceMode,CDS_FULLSCREEN) = DISP_CHANGE_SUCCESSFUL;
    end;
    end;

    procedure RestoreDefaultMode;
    var T : TDevMode absolute 0;
    begin
    ChangeDisplaySettings(T,CDS_FULLSCREEN);
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    begin
    if setFullScreenMode then begin
    sleep(7000);
    RestoreDefaultMode;
    end;
    end;

    Наверх

44. Как поместить картинку из базы данных, например MsSQL, в компонент TIMAGE ?

    1) Предполагается, что поле BLOB (например, Pict)
    2) в запросе Query.SQL пишется что-то вроде
    'select Pict from sometable where somefield=somevalue'
    3) запрос открывается
    4) делается "присваивание":
    Image1.Picture.Assing(TBlobField(Query.FieldByName('Pict'))
    или, если известно, что эта картинка - Bitmap, то можно
    Image1.Picture.Bitmap.Assing(TBlobField(Query.FieldByName('Pict'))

    А можно воспользоваться компонентом TDBImage.

    Наверх

45. Как получить горизонтальную прокрутку (scrollbar) в ListBox?

    Так же как в случае с TMemo, здесь можно использовать сообщения. Например, сообщение может быть отослано в момент создания формы:

    procedure TForm1.FormCreate(Sender: TObject);
    begin
    ListBox1.Perform(LB_SETHORIZONTALEXTENT, 1000, Longint(0));
    end;

    Второй параметр в вызове - ширина прокрутки в точках.

    Наверх

46. Как вставить еще несколько строк в середину StringGrid или после определенной строки?

    Имеется StringGrid с n-ым количеством строк. Как вставить еще несколько строк в середину StringGrid или после определенной строки?
    По-видимому, надо добавить строк в конец, изменив Grid.RowCount, а потом раздвинуть строки циклом снизу вверх:
    Grid.Rows.Strings[i] := Grid.Rows.Strings[i - 1];

    Или я бы сделал метод рисования этой таблицы, а данные хранил бы в отдельном stringList-е, там есть методы вставки, а вообще-то для этих целей предпочитаю DrawGrid: переопределяю метод onDrawCell, всё же объектная модель лучше и данные проще контролировать.

    Наверх

47. Пример получения позиции курсора из компоненты TMemo.

    procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    begin
    Memo1Click(Self);
    end;

    procedure TForm1.Memo1Click(Sender: TObject);
    VAR
    LineNum : LongInt;
    CharNum : LongInt;
    begin
    LineNum := Memo1.Perform(EM_LINEFROMCHAR, Memo1.SelStart, 0);
    CharNum := Memo1.Perform(EM_LINEINDEX, LineNum, 0);
    Label1.Caption := IntToStr(LineNum+1)+' : '+IntToStr((Memo1.SelStart-CharNum)+1);
    end;

    procedure TForm1.FormCreate(Sender: TObject);
    begin
    Memo1Click(Self);
    end;

    Наверх

48. Функция Undo в TMemo

    В компоненте TMemo предусмотрена функция отмены последней правки (Undo). Ее можно вызвать следующим образом:
    Memo1.Perform(EM_UNDO,0,0);
    Узнать о том, возможна ли отмена (т.е. есть ли что отменять) можно следующим образом:
    UndoEnabled:=(Memo1.Perform(EM_CAUNDO,0,0)<>0);

    Наверх

49. Как прокрутить текст в Tmemo или в TRichEdit

    Я добавляю програмно несколько строк в конец поля Memo, а их не видно. Как прокрутить Memo, чтобы было видно последние строки ?

    Примерно так:
    SendMessage(Memo1.Handle, EM_LINESCROLL, 0, Memo1.Lines.Count-1);

    Наверх

50. Как определить работает ли уже данное приложение или это первая его копия?

    Для Delphi 1. Каждый экземпляр программы имеет ссылку на свою предыдущую копию - hPrevInst: hWnd. Ее можно проверить перед созданием приложения и при необходимости отреагировать соответствующим образом. Если запущена только одна копия, то эта ссылка равна нулю.
    Пример:


    procedure TForm1.FormCreate(Sender: TObject);
    begin
    {Проверяем есть ли указатель на предыдущую копию приложения}
    IF hPrevInst <> 0 THEN BEGIN
    {Если есть, то выдаем сообщение и выходим}
    MessageDlg('Программа уже запущена!', mtError, [mbOk], 0);
    Halt;
    END;
    {Иначе - ничего не делаем (не мешаем созданию формы)}
    end;

    P.S. Для выхода необходимо использовать Halt, а не Close, как хотелось бы, так как форма еще не создана и закрывать нечего.
    Есть и другой способ - по списку загруженных приложений


    procedure TForm1.FormCreate(Sender: TObject);
    VAR
    Wnd : hWnd;
    buff : ARRAY[0.. 127] OF Char;
    Begin
    Wnd := GetWindow(Handle, gw_HWndFirst);
    WHILE Wnd <> 0 DO BEGIN
    IF (Wnd <> Application.Handle) AND (GetWindow(Wnd, gw_Owner) = 0)
    THEN BEGIN
    GetWindowText (Wnd, buff, sizeof (buff ));
    IF StrPas (buff) = Application.Title THEN
    BEGIN
    MessageDlg('Приложение уже загружено', mtWarning, [mbOk], 0);
    Halt;
    END;
    END;
    Wnd := GetWindow (Wnd, gw_hWndNext);
    END;
    End;

    Еще один интересный способ для Win32. Дело в том, что можно в памяти создавать временные файлы. При перезагрузке они теряются, а так существуют. Кстати, этот метод можно использовать и для обмена информацией между вашими приложениями.
    Пример:


    program Project1;
    uses
    Windows, // Обязательно
    Forms,
    Unit1 in 'Unit1.pas' {Form1};

    {$R *.RES}
    Const
    MemFileSize = 1024;
    MemFileName = 'one_inst_demo_memfile';
    Var
    MemHnd : HWND;
    begin
    { Попытаемся создать файл в памяти }
    MemHnd := CreateFileMapping(HWND($FFFFFFFF),
    nil,
    PAGE_READWRITE,
    0,
    MemFileSize,
    MemFileName);
    { Если файл не существовал запускаем приложение }
    if GetLastError<>ERROR_ALREADY_EXISTS then
    begin
    Application.Initialize;
    Application.CreateForm(TForm1, Form1);
    Application.Run;
    end;
    CloseHandle(MemHnd);
    end.
    Часто при работе у пользователя может быть открыто 5-20 окон и сообщение о том, что программа уже запущено приводит к тому, что он вынужден полчаса искать ранее запущенную копию. Выход из положения - найдя копию программы активировать ее, для чего в последнем примере перед HALT необходимо добавить строку :
    SetForegroundWindow(Wnd);
    Например так:


    program Project0;
    uses
    Windows, // !!!
    Forms,
    Unit0 in 'Unit0.pas' {Form1};

    var
    Handle1 : LongInt;
    Handle2 : LongInt;

    {$R *.RES}

    begin
    Application.Initialize;
    Handle1 := FindWindow('TForm1',nil);
    if handle1 = 0 then
    begin
    Application.CreateForm(TForm1, Form1);
    Application.Run;
    end
    else
    begin
    Handle2 := GetWindow(Handle1,GW_OWNER);
    //Чтоб заметили :)
    ShowWindow(Handle2,SW_HIDE); ShowWindow(Handle2,SW_RESTORE);
    SetForegroundWindow(Handle1); // Активизируем
    end;
    end.

    Наверх

51. Обработка событий от клавиатуры

    I. Эмуляция нажатия клавиши.

    Внутри приложения это выполняется достаточно просто с помощью вызова функции Windows API SendMessage() (можно воспользоваться и методом Perform того объекта (или формы), кому посылается сообщение о нажатой клавише). Код

    Memo1.Perform(WM_CHAR, Ord('A'), 0);

    или

    SendMessage(Memo1.Handle, WM_CHAR, Ord('A'), 0);

    приведет к печати символа "A" в объекте Memo1.

    II. Перехват нажатий клавиши внутри приложения.

    Задача решается очень просто. Можно у формы установить свойство KeyPreview в True и обрабатывать событие OnKeyPress. Второй способ - перехватывать событие OnMessage для объекта Application.

    III. Перехват нажатия клавиши в Windows.


    Существуют приложения, которым необходимо перехватывать все нажатия клавиш в Windows, даже если в данный момент активно другое приложение. Это может быть, например, программа, переключающая раскладку клавиатуры, резидентный словарь или программа, выполняющая иные действия по нажатию "горячей" комбинации клавиш. Перехват всех событий в Windows (в том числе и событий от клавиатуры) выполняется с помощью вызова функции SetWindowsHook(). Данная функция регистрирует в системе Windows ловушку (hook) для определенного типа событий/сообщений. Ловушка - это пользовательская процедура, которая будет обрабатывать указанное событие. Основное здесь то, что эта процедура должна всегда присутствовать в памяти Windows. Поэтому ловушку помещают в DLL и загружают эту DLL из программы. Пока хоть одна программа использует DLL, та не может быть выгружена из памяти. Приведем пример такой DLL и программы, ее использующей. В примере ловушка перехватывает нажатие клавиш на клавиатуре, проверяет их и, если это клавиши "+" или "-", посылает соответствующее сообщение в конкретное приложение (окно). Окно ищется по имени его класса ("TForm1") и заголовку (caption, "XXX").

    {текст библиотеки}
    library SendKey;
    uses
    WinTypes, WinProcs, Messages;
    const
    {пользовательские сообщения}
    wm_NextShow_Event = wm_User + 133;
    wm_PrevShow_Event = wm_User + 134;
    {handle для ловушки}
    HookHandle: hHook = 0;
    var
    SaveExitProc : Pointer;
    {собственно ловушка}
    function Key_Hook(Code: integer; wParam: word; lParam: Longint): Longint; export;
    var
    H: HWND;
    begin
    {если Code>=0, то ловушка может обработать событие}
    if Code >= 0 then
    begin
    {это те клавиши?}
    if ((wParam = VK_ADD)or(wParam = VK_SUBTRACT)) and (lParam and $40000000 = 0)
    then begin
    {ищем окно по имени класса и по заголовку}
    H := FindWindow('TForm1', 'XXX');
    {посылаем сообщение}
    if wParam = VK_ADD then
    SendMessage(H, wm_NextShow_Event, 0, 0)
    else
    SendMessage(H, wm_PrevShow_Event, 0, 0);
    end;
    {если 0, то система должна дальше обработать это событие}
    {если 1 - нет}
    Result:=0;
    end
    else
    {если Code<0, то нужно вызвать следующую ловушку}
    Result := CallNextHookEx(HookHandle,Code, wParam, lParam);
    end;
    {при выгрузке DLL надо снять ловушку}
    procedure LocalExitProc; far;
    begin
    if HookHandle<>0 then
    begin
    UnhookWindowsHookEx(HookHandle);
    ExitProc := SaveExitProc;
    end;
    end;
    {инициализация DLL при загрузке ее в память}
    begin
    {устанавливаем ловушку}
    HookHandle := SetWindowsHookEx(wh_Keyboard, Key_Hook,
    hInstance, 0);
    if HookHandle = 0 then
    MessageBox(0, 'Unable to set hook!', 'Error', mb_Ok)
    else begin
    SaveExitProc := ExitProc;
    ExitProc := @LocalExitProc;
    end;
    end.

    Размер такой DLL в скомпилированном виде будет около 3Кб, поскольку в ней не используются объекты из VCL.

    Далее приведен код модуля в Delphi, который загружает DLL и обрабатывает сообщения от ловушки, просто отображая их в Label1.

    unit Unit1;
    interface
    uses
    SysUtils,WinTypes,WinProcs,Messages,Classes,Graphics,Controls,Forms,Dialogs,StdCtrls;
    {пользовательские сообщения}
    const
    wm_NextShow_Event = wm_User + 133;
    wm_PrevShow_Event = wm_User + 134;
    type
    TForm1 = class(TForm)
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    private
    {обработчики сообщений}
    procedure WM_NextMSG (Var M : TMessage); message wm_NextShow_Event;
    procedure WM_PrevMSG (Var M : TMessage); message wm_PrevShow_Event;
    end;

    var
    Form1: TForm1;
    P : Pointer;
    implementation
    {$R *.DFM}
    {загрузка DLL}
    function Key_Hook : Longint; far; external 'SendKey';
    procedure TForm1.WM_NextMSG (Var M : TMessage);
    begin
    Label1.Caption:='Next message';
    end;

    procedure TForm1.WM_PrevMSG (Var M : TMessage);
    begin
    Label1.Caption:='Previous message';
    end;

    procedure TForm1.FormCreate(Sender: TObject);
    begin
    {если не использовать вызов процедуры из DLL в программе,
    то компилятор удалит загрузку DLL из программы}
    P:=@Key_Hook;
    end;
    end.

    Конечно, свойство Caption в этой форме должно быть установлено в "XXX".

    Наверх

52. Как сделать так, что при нажатии на Enter происходил переход к следующему элементу формы

    Ставите у формы KeyPreview = true и создаете событие KeyPress следующего вида:

    procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
    begin
    if (Key = #13) then begin
    Key:=#0;
    Perform(WM_NEXTDLGCTL,0,0);
    end;
    end;

    Наверх

53. Перетаскивание файла drag-drop

    { На эту форму можно бросить файл (например из проводника)
    и он будет открыт }
    unit Unit1;
    interface
    uses
    Windows, Messages, SysUtils, Classes, Graphics,
    Controls, Forms, Dialogs,StdCtrls,
    ShellAPI {обязательно!};

    type
    TForm1 = class(TForm)
    Memo1: TMemo;
    FileNameLabel: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    protected
    {Это и есть самая главная процедура}
    procedure WMDropFiles(var Msg: TMessage); message wm_DropFiles;
    end;

    var
    Form1: TForm1;
    implementation
    {$R *.DFM}

    procedure TForm1.WMDropFiles(var Msg: TMessage);
    var
    Filename: array[0 .. 256] of Char;
    Count : integer;
    begin
    { Получаем количество файлов (просто пример) }
    nCount := DragQueryFile( msg.WParam, $FFFFFFFF,
    acFileName, cnMaxFileNameLen);
    { Получаем имя первого файла }
    DragQueryFile( THandle(Msg.WParam),
    0, { это номер файла }
    Filename,SizeOf(Filename) ) ;
    { Открываем его }
    with FileNameLabel do begin
    Caption := LowerCase(StrPas(FileName));
    Memo1.Lines.LoadfromFile(Caption);
    end;
    { Отдаем сообщение о завершении процесса }
    DragFinish(THandle(Msg.WParam));
    end;

    procedure TForm1.FormCreate(Sender: TObject);
    begin
    { Говорим Windows, что на нас можно бросать файлы }
    DragAcceptFiles(Handle, True);
    end;

    procedure TForm1.FormDestroy(Sender: TObject);
    begin
    { Закрываем за собой дверь золотым ключиком}
    DragAcceptFiles(Handle, False);
    end;
    end.

    Наверх

54. Привлечение внимания к окну

    Часто возникает проблема - в многооконном приложении необходимо обратить внимание пользователя на то, что какое-то из окон требует внимания (например, к нему пришло сообщение по DDE, в нем завершился какой-либо процесс, произошла ошибка ...). Это легко сделать, используя команду API FlashWindow:

    procedure TForm1.Timer1Timer(Sender: TObject);
    begin
    FlashWindow(Handle,true);
    end;

    В данном примере FlashWindow вызывается по таймеру ежесекундно, что приводит к миганию заголовка окна.
    Наверх

55. Заставка для программы

    Сведения о программе, авторские права и т.д., лучше оформить в виде отдельной формы и показывать ее при запуске программы (как это сделано в Word).
    Сделать это не сложно:
    1. Создаете форму (например SplashForm).
    2. Объявляете ее свободной (availableForms).
    3. В Progect Source вставляете следующее (например):


    program Splashin;
    uses
    Forms,
    Main in 'MAIN.PAS',
    Splash in 'SPLASH.PAS'
    {$R *.RES}
    begin
    try
    SplashForm := TSplashForm.Create(Application);
    SplashForm.Show;
    SplashForm.Update;
    Application.CreateForm(TMainForm, MainForm);
    SplashForm.Hide;
    finally
    SplashForm.Free;
    end;
    Application.Run;
    end.


    И форма SplashForm держится на экране пока выполняется Create в главной форме. Но иногда она появляется и пропадает очень быстро, поэтому нужно сделать задержку:
    1. Добавляете на форму таймер с событием:


    procedure TSplashForm.Timer1Timer(Sender: TObject);
    begin
    Timer1.Enabled := False;
    end;


    2. Событие onCloseQuery для формы:


    procedure TSplashForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    begin
    CanClose := Not Timer1.Enabled;
    end;


    3. И перед SplashForm.Hide; ставите цикл:

    repeat
    Application.ProcessMessages;
    until SplashForm.CloseQuery;

    4. Все! Осталось установить на таймере период задержки 3-4 секунды.
    5. На последок, у такой формы желательно убрать Caption:
    SetWindowLong (Main.Handle,GWL_STYLE, GetWindowLong(Main.Handle, GWL_STYLE) AND NOT WS_CAPTION OR WS_SIZEBOX);

    Наверх

55. Как получить короткий путь файла если имеется длинный ("c:\Program Files" ==> "c:\progra~1")

    GetShortPathName()

    Наверх

56. Как создать свою кнопку в заголовке формы (на Caption Bar)

    Непосредственно такой функции вроде нет, но можно изловчиться. Нарисовать там кнопку вручную и обрабатывать команды нажатия мышки на Caption Bar.
    Пример.

    unit Main;
    interface
    uses
    Windows, Buttons, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
    type
    TForm1 = class(TForm)
    procedure FormResize(Sender: TObject);
    private
    CaptionBtn : TRect;
    procedure DrawCaptButton;
    procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPaint;
    procedure WMNCActivate(var Msg : TWMNCActivate); message WM_NCACTIVATE;
    procedure WMSetText(var Msg : TWMSetText); message WM_SETTEXT;
    procedure WMNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;
    procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
    public
    { Public declarations }
    end;

    var
    Form1: TForm1;

    implementation
    const
    htCaptionBtn = htSizeLast + 1;
    {$R *.DFM}

    procedure TForm1.DrawCaptButton;
    var
    xFrame, yFrame, xSize, ySize : Integer;
    R : TRect;
    begin
    //Dimensions of Sizeable Frame
    xFrame := GetSystemMetrics(SM_CXFRAME);
    yFrame := GetSystemMetrics(SM_CYFRAME);

    //Dimensions of Caption Buttons
    xSize := GetSystemMetrics(SM_CXSIZE);
    ySize := GetSystemMetrics(SM_CYSIZE);

    //Define the placement of the new caption button
    CaptionBtn := Bounds(Width - xFrame - 4*xSize + 2,
    yFrame + 2, xSize - 2, ySize - 4);

    //Get the handle to canvas using Form's device context
    Canvas.Handle := GetWindowDC(Self.Handle);

    Canvas.Font.Name := 'Symbol';
    Canvas.Font.Color := clBlue;
    Canvas.Font.Style := [fsBold];
    Canvas.Pen.Color := clYellow; Canvas.Brush.Color := clBtnFace;

    try
    DrawButtonFace(Canvas, CaptionBtn, 1, bsAutoDetect, False, False, False);
    //Define a smaller drawing rectangle within the button
    R := Bounds(Width - xFrame - 4 * xSize + 2,
    yFrame + 3, xSize - 6, ySize - 7);
    with CaptionBtn do
    Canvas.TextRect(R, R.Left + 2, R.Top - 1, 'W');
    finally
    ReleaseDC(Self.Handle, Canvas.Handle);
    Canvas.Handle := 0;
    end;
    end;

    procedure TForm1.WMNCPaint(var Msg : TWMNCPaint);
    begin
    inherited;
    DrawCaptButton;
    end;

    procedure TForm1.WMNCActivate(var Msg : TWMNCActivate);
    begin
    inherited;
    DrawCaptButton;
    end;

    procedure TForm1.WMSetText(var Msg : TWMSetText);
    begin
    inherited;
    DrawCaptButton;
    end;

    procedure TForm1.WMNCHitTest(var Msg : TWMNCHitTest);
    begin
    inherited;
    with Msg do
    if PtInRect(CaptionBtn, Point(XPos - Left, YPos - Top)) then
    Result := htCaptionBtn;
    end;

    procedure TForm1.WMNCLButtonDown(var Msg : TWMNCLButtonDown);
    begin
    inherited;
    if (Msg.HitTest = htCaptionBtn) then
    ShowMessage('You hit the button on the caption bar');
    end;

    procedure TForm1.FormResize(Sender: TObject);
    begin
    //Force a redraw of caption bar if form is resized
    Perform(WM_NCACTIVATE, Word(Active), 0);
    end;

    end.

    Наверх

57. Преобразование текста OEM у Ansi


    Эта версия работает под любым Delphi.
    (Начиная с Delphi 2, это можно записать короче с использованием AnsiToOem и OemToAnsi.)
    Здесь все просто.



    function ConvertAnsiToOem(const S : string) : string;
    { ConvertAnsiToOem translates a string into the OEM-defined character set }
    {$IFNDEF WIN32}
    var
    Source, Dest : array[0..255] of Char;
    {$ENDIF}
    begin
    {$IFDEF WIN32}
    SetLength(Result, Length(S));
    if Length(Result) > 0 then
    AnsiToOem(PChar(S), PChar(Result));
    {$ELSE}
    if Length(Result) > 0 then
    begin
    AnsiToOem(StrPCopy(Source, S), Dest);
    Result := StrPas(Dest);
    end;
    {$ENDIF}
    end; { ConvertAnsiToOem }

    function ConvertOemToAnsi(const S : string) : string;
    { ConvertOemToAnsi translates a string from the OEM-defined
    character set into either an ANSI or a wide-character string }
    {$IFNDEF WIN32}
    var
    Source, Dest : array[0..255] of Char;
    {$ENDIF}
    begin
    {$IFDEF WIN32}
    SetLength(Result, Length(S));
    if Length(Result) > 0 then
    OemToAnsi(PChar(S), PChar(Result));
    {$ELSE}
    if Length(Result) > 0 then
    begin
    OemToAnsi(StrPCopy(Source, S), Dest);
    Result := StrPas(Dest);
    end;
    {$ENDIF}
    end; { ConvertOemToAnsi }

    Наверх

58. Состояние кнопки insert (Insert/Overwrite)

    {------------------------------------------}
    { Returns the status of the Insert key. }
    {------------------------------------------}

    function InsertOn: Boolean;
    begin
    if LowOrderBitSet(GetKeyState(VK_INSERT))
    then InsertOn := true
    else InsertOn := false
    end;

    Наверх

59. IRC клиент на Delphi

    Автор статьи: Лозовский Александр

    Если помнишь, пару месяцев назад я предложил читателям придумать свою тему для кодинга. И, соответственно, удовлетворить самые популярные требования в своей статье. Настало время воплотить этот план в жизнь. Сегодня мне в руки попало письмо от "ViT" (noginsk@rambler.ru). Он предложил мне рассказать о создании своего IRC-клиента с использованием компонента ActiveIRC. Что ж, я просто не могу ему отказать :).

    На самом деле, есть много способов написания IRC-клиента. Во-первых, это прямая работа с IRC-протоколом. Дело весьма напряжное, и помочь в нем тебе сможет либо старый добрый Indy, либо библа WSocket из комплекта интернет-компонентов ICS (Internet Component Suite). Собственно, если посмотреть на www.torry.net/irc.htm - список наиболее популярных IRC-компонентов, можно обнаружить, что большая их часть именно так и поступает - использует Indy либо WSocket. Заметь, при этом они не стесняются требовать у тебя десятки долларов за использование их софта. Компонент ActiveIRC лишен этого недостатка, поэтому именно про него я сегодня и расскажу.

    ActiveIRC Component
    -----------------------------------------------
    Представляет он собой обычный бесплатный ActiveX компонент. В поставку компонента входит файл "ActiveIRC installer.exe" плюс документация. По большому счету, никакой документации к нему и не требуется - все предельно ясно, но для интереса можно и ознакомиться - там есть описание нескольких полезных функций.

    После запуска обозначенного exe-файла тут же появится сообщение... об удачной установке. Но радоваться еще рано, т.к. если ты запустишь Delphi и откроешь в компонентах вкладку "ActiveX", то, разумеется, ничего не найдешь. Почему? Да потому, что разбаловались Вы, батенька, и привыкли, что инсталлятор делает все за Вас. На самом же деле он только переносит свой OCX файл в WINDOWSSYSTEM, а регистрировать его придется уже ручками: component -> import ActiveX control -> ActiveIrc ActiveX -> выбрать файл Activeirc.ocx из системного каталога и инсталлировать его. Теперь он появится во вкладке ActiveX, и его можно смело класть на форму.

    Create form

    Наша форма будет довольно простой, состоящей из следующих элементов: 4 компонента Edit, 4 Кнопки, 3 Label, 1 Memo и собственно сам ActiveIRC. Результат формы смотри на рис.1.

    А теперь проставим названия:
    Label1 - свойство "caption" - "Сервер:"
    Label2 - свойство "caption" - "Порт:"
    Label3 - свойство "caption" - "Ник:"
    Button1 - свойство "caption" - "CONNECT"
    Button2 - свойство "сaption" - "JOIN"
    Button3 - свойство "caption" - "Leave"
    Button4 - свойство "caption" - "Сказать"

    Label'ы 1-3 будут сопровождать соответствующие Edit'ы. Также можешь создать Edit'ы для ввода других данных, которые могут тебе понадобиться. Для них существуют свойства Email, FullName и Ident (в последнем обычно прописано "localhost").

    У каждой кнопки есть свой caption. Он соответствует назначению каждой кнопки. Например, Button1 - CONNECT, отвечает за соединение с сервером. JOIN - зайти на канал.

    В общем-то, можно обойтись и без батонов - вместо них написать обработчик OnKeyDown для Edit4 (в нем мы будем писать наши сообщения). Например, обработка команды "/JOIN #LOVE" сведется к удалению из строки всех символов от "/" до "#" и запуску процедуры: ActiveIrc1.Join ('#LOVE');.

    Коннект и общение
    ------------------------------------------------

    Для коннекта к серверу и передачи данных о пользователе мы с тобой слепили кнопку "CONNECT". Давай посмотрим на ее событие OnClick:

    ActiveIrc1.server:= edit1.Text;
    ActiveIrc1.port:= strtoint (edit2.text);
    ActiveIrc1.nick:= edit3.Text;
    ActiveIrc1.Connect;

    Правда, здесь я прописываю не все свойства, а только те, без которых трудно обойтись. Далее вызовом метода Connect запускаем процесс соединения.

    Как ты, наверное, догадался, главным компонентом у нас будет Memo1. Именно в нем будут отображаться все сообщения. А поскольку каждое сообщение - это уже событие (я имею в виду Event), давай создадим необходимые обработчики:

    OnConsole - как только ты получаешь очередную порцию данных, например, служебная инфа от сервера, активизируется это событие. Единственное, что оно может дать - это переменную text, содержащую в себе само сообщение, поэтому пиши: memo1.lines.add (text);.

    OnIRCReady - когда IRC-сервак будет готов принимать твои команды и свойство IsConnected примет значение TRUE, вызывается этот Event. В его обработчик достаточно написать, допустим, уведомление об этом: Memo1.Lines.Add ('Готов к труду и обороне!');.

    OnMessage - сообщение, отправленное любым пользователем на канале, активирует этот Event. Естественно, что и возвращает он нам: channel - имя канала, user - ник юзера, text - собственно само сообщение. В его обработчик я написал: memo1.Lines.Add('('+channel+')'+user+'> '+text);. Заметь, что в этом случае к каждой мессаге будет приплюсовываться имя канала, с которого она отправлена. Это необходимо, если пользователь беседует на нескольких каналах, а при этом для чата используется всего одно окно. Вот пример такого сообщения:

    (#Xakep)Petrovis> Да, наш админ тоже этим страдает :). OnPrivateMessage - если какой-нибудь пользователь соизволил сделать на тебя /msg, т.е. отправить личное сообщение, придется обработать этот Event. Как это сделать - решать тебе (тут большой простор для фантазии, особенно для бывалого скриптера), но я сделал просто: memo1.Lines.Add('Приват от '+user+'--> '+text);. OnUserJoins - в его обработчик ты можешь записать реакцию на приджойнившегося к каналу юзера. Я сделал простое уведомление:

    memo1.Lines.Add('Пришел товарищ '+user+' на канал: '+channel+'!');

    Ничто не мешает тебе сделать автоматическое приветствие в духе:

    if User = 'Petya'
    then ActiveIRC.Say (Edit5.text, 'Привет, уважаемый! Давно ждал тебя :)');
    OnUserKick - когда скрипты только входили в моду, это событие было крайне необходимо для любителей сетевых разборок. После того как на канале кто-то кого-то кикнет, в твое распоряжение поступят константы: channel - канал, kickedby - имя обидчика, UserKicked - имя обиженного, Reason - основание. Как реагировать на это событие - решать тебе.
    OnUserQuits - твоя реакция на чей-то уход с канала. В этом событии содержится имя покинувшего IRC-сервер пользователя.

    События изучили, теперь перейдем к самому кодингу. Начнем с OnClick для кнопки "JOIN": ActiveIrc1.Join(edit5.Text), а в OnClick для "LEAVE", соответственно - ActiveIrc1.Leave;. Чтобы послать сообщение на канал или лично юзеру, нам понадобится кнопка "Сказать". Строчка ActiveIrc1.Say(edit5.Text,edit4.Text); позволит отправить на канал сообщение из Edit5 (Edit4 - это имя канала), но если первым аргументом будет прописан чей-то ник, то у этого пользователя откроется окно с приват-сообщением.

    Полезные функции
    -------------------------------------------------

    Помимо той основы, что я описал, у этого компонента присутствуют еще несколько интересных функций:
    boolean Raw(string: command) - напрямую отправляет команду IRC-серверу без обработки ActiveIRC. В случае успеха возвращает TRUE.
    boolean CTCPRequest(string nick, string ctcp, string info) - направляет пользователю CTCP-запрос. Очень поможет, если тебе захочется узнать:
    VERSION - версию его IRC-софта.
    PING - пинг к юзеру.
    TIME - локальное время юзера. Действительно, это бывает полезным, особенно если ты любишь разговаривать с иностранцами.
    boolean CTCPReply(string nick, string ctcp, string reply) - отвечает на CTCP-запрос.
    boolean GetChannelMode(string channel, string mode) - возвращает тебе режим, в котором работает канал. Например:
    i - invite only. Если ты не относишься к приглашенным - извини. Вход закрыт.
    M - Moderated.
    N - No external messages.
    T - только ОПы могут устанавливать темы.
    boolean GetUserMode(string channel, string user, string mode); - то же самое, но для пользователя. В данном случае он может быть либо о (ОП), либо v (войс).

    И вновь продолжается бой!
    -------------------------------------------------

    Что ж, теперь у тебя в руках есть все необходимое. Осталось только напрячь свою фантазию, сделать красивый интерфейс и выложить полученный результат в инет для общего скачивания. Не будь жадным - выкладывай все бесплатно, а по возможности давай и сорсы. Так у тебя больше шансов быть замеченным. Вдруг ты задвинешь mIRC своим супернавороченным клиентом :).

    Альтернативный вариант
    -------------------------------------------------

    Как я уже говорил, этот компонент далеко не единственный. Их довольно много, правда, практически все они плохие. Но один из них все-таки стоит выделить - компонент XiRC от простого мексиканского парня Martin Bleakley. Дело в том, что этот господин выбрал верный путь - он программил свой компонент с использованием Indy 8.0. Это его первый компонент и к тому же freeware.

    Качай его с http://www.torry.net/vcl/internet/irc/mbxirc.zip , т.к. собственный сайт и мейл этого господина накрылись еще года полтора назад, и все мои попытки сказать ему пару ласковых не увенчались успехом.

    К компоненту прилагаются 2 демы, причем вторая - практически готовый IRC-клиент. Но учти, что работать он у тебя не будет. Просто потому, что Мартин забыл сказать, что для его оформления он использовал компоненты FlatStyle (их я тоже положил на диск, а вообще их можно качать с www.torry.net/vcl/packs/interfacemiddle/flatstyl.zip). Эта коллекция - просто красивые аналоги дельфийских компонентов, но их отсутствие грозит тебе изрядными проблемами с запуском его демы.
    Наверх

60. Работа с Word'om в Делфи

    60.1 Запуск MS Word из Delphi
    60.2 Программирование закладок в Word с помощью Delphi
    60.3 MS Word и рисование

    60.1 Запуск MS Word из Delphi
    ===============================================================
    Инициализация и запуск
    ---------------------------------------------------------------
    Во-первых, в разделе uses нужно подключить модуль ComObj.

    Во-вторых объявляем переменную типа variant для обращения к MS Word.

    Инициализацию и запуск MS Word иллюстрирует следующий пример:

    uses ComObj;
    ...
    procedure RunWord;
    var Word: variant;
    begin
    try
    Word := CreateOleObject('Word.Application');
    except
    ShowMessage('Не могу запустить MS Word');
    end;
    end;

    // отображение на экране
    MsWord.Visible := True;

    // создание нового документа
    MsWord.Documents.Add;
    // открытие существующего документа
    MsWord.Documents.Open('c:\test.doc');

    Добавление (запись) текста в документ MS Word
    ---------------------------------------------------------------

    Все покажу на примере:

    Word.Selection.TypeText(Text:=MyText);
    // где MyText - переменная, хранящая текст для записи в документ.

    Word.Selection.TypeParagraph;
    // добавление нового абзаца

    Стоит заметить, что запись текста производится в место позиционирования курсора. По умолчанию это начало документа.

    Чтение текста из документа MS Word
    ---------------------------------------------------------------

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

    MyText:= Word.Selection;
    // где MyText - переменная для хранения считанных данных

    Для передвижения курсора по тексту документа можно использовать следующий набор команд:

    Word.Selection.MoveRight;
    // передвинуть курсор на символ вправо

    Word.Selection.MoveLeft;
    // передвинуть курсор на символ влево

    Word.Selection.MoveUp;
    // на строку вверх

    Word.Selection.MoveDown;
    // на строку вниз

    Выход (закрытие) MS Word
    ---------------------------------------------------------------

    Если есть открытый активный документ, то закрытие документа осуществляется следующим образом:

    // выход без сохранения
    MsWord.ActiveDocument.Close(SaveChanges:=0);

    А затем закрываем приложение

    MsWord.Quit;

    Удачной работы!


    Автор статьи: Нечаев Андрей
    Сайт автора: http://nech.tamb.ru

    60.2 Программирование закладок в Word с помощью Delphi
    ===============================================================
    Закладка - это элемент документа, которому присвоено уникальное имя.

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

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

    Естественно, перед применением описанных команд, нужно выполнить инициализацию переменной Word, а затем открыть или создать новый документ. Подробнее смотри выши

    1. Добавление закладки
    ---------------------------------------------------------------
    Word.ActiveDocument.Bookmarks.Add(BookMarkName);

    где BookMarkName - переменная типа string, содержащая имя закладки.

    2. Переход к закладке
    ---------------------------------------------------------------

    Переход к закладке можно осуществить по ее имени:

    Word.ActiveDocument.Bookmarks.Item(BookMarkName).Select;

    либо по порядковому номеру:

    Word.ActiveDocument.Bookmarks.Item(1).Select;

    3. Удаление закладки
    ---------------------------------------------------------------
    Удаление производится аналогично переходу к закладке, соответственно, можно использовать два варианта: через имя или индекс закладки.

    Word.ActiveDocument.Bookmarks.Item(BookMarkName).Delete;
    Word.ActiveDocument.Bookmarks.Item(1).Delete;

    4. Отображение закладок в документе
    ---------------------------------------------------------------

    Word.ActiveWindow.View.ShowBookmarks:=True; // отобразить закладки
    Word.ActiveWindow.View.ShowBookmarks:=False; // скрыть закладки

    5. Скрытые (зарезервированные) закладки
    ---------------------------------------------------------------

    MS Word автоматически устанавливает следующие закладки:
    \StartOfDoc - начало документа;
    \EndOfDoc - конец документа;
    \Sel - переход к текущей позиции ввода.

    Например, переход в начало документа.

    Word.ActiveDocument.Bookmarks.Item('\StartOfDoc').Select;

    Примечания:
    Название закладки должно начинаться с буквы.
    Чтобы отобразить закладки в документе, выберите в Word в меню Сервис команду Параметры, а затем на вкладке Вид установите флажок Закладки.


    Автор статьи: Нечаев Андрей
    Сайт автора: http://nech.tamb.ru

    60.2 MS Word и рисование
    ===============================================================

    В статье рассмотрены основные способы рисования из Delphi на листе MS Word.

    0. Запуск MS Word
    ---------------------------------------------------------------

    Подключаем необходимый для работы модуль и объявляем переменную:

    uses ComObj;
    ...
    var MsWord: variant;

    Запускаем MS Word и показываем на экране:

    MsWord:= CreateOleObject('Word.Application');
    MsWord.Visible := True;

    Создание нового документа:

    MsWord.Documents.Add;

    1. Линия
    ---------------------------------------------------------------
    Рисуем линию в документе MS Word на текущем листе:

    MsWord.ActiveDocument.Shapes.AddLine(x1, y1, x2, y2);

    где x1, y1 - координаты начала, а x2, y2 - координаты конца линии.

    Линия, выделенная для редактирования (форматирования):

    MsWord.ActiveDocument.Shapes.AddLine(x1, y1, x2, y2).Select;

    2. Прямоугольник
    ---------------------------------------------------------------
    MsWord.ActiveDocument.Shapes.AddShape(1, x1, y1, x2, y2);

    где x1,y1,x2,y2 - координаты прямоугольника.

    3. Произвольная фигура
    ---------------------------------------------------------------
    (или автофигура в терминологии MS Word)

    В общем случае, произвольная фигура рисуется так:

    MsWord.ActiveDocument.Shapes.AddShape(i, x1, y1, x2, y2);

    где i: номер фигуры (соответствует порядку следования фигур в MS Word на панели рисования), x1, y1, x2, y2 координаты прямоугольника в который будет вписан объект.

    4. Вставка картинки (произвольного изображения) в текущее положение курсора
    ---------------------------------------------------------------

    MsWord.Selection.InlineShapes.AddPicture(FileName:='C:\WINDOWS\Пузыри.bmp', LinkToFile:=False, SaveWithDocument:=True);

    При выполнении данной команды нужно определить следующие праметры:
    FileName - путь к графическому файлу;
    LinkToFile - булевский флаг, указывающий на необходимость связи с источником;
    SaveWithDocument - булевский флаг, указывающий на свойства рисунка при сохранении документа.

    5. Манипулцяции (форматирование) с фигурами
    ---------------------------------------------------------------

    Выбор фигуры можно осуществить следующим образом:

    MsWord.ActiveDocument.Shapes.item(n).Select;

    где n - порядковй номер фигуры.

    Заливка фона текущей фигуры

    MsWord.Selection.ShapeRange.Fill.ForeColor.RGB:=RGB(r, g, b);

    где r, g, b - соответственно красная, зеленая и синяя составляющая цвета.

    Толщина линий текущей фигуры

    MsWord.Selection.ShapeRange.Line.Weight:=5;

    Цвет линии текущей фигуры

    MsWord.Selection.ShapeRange.Line.ForeColor.RGB:=RGB(r, g, b);

    Группировка фигур

    MsWord.ActiveDocument.Shapes.Range(VarArrayOf(['3', '5', '8'])).group;

    где 3, 5, 8 - порядковый номер фигуры.

    6. Блокировка механизма вывода на экран отрисовки
    ---------------------------------------------------------------

    В случае, если вы не хотите наблюдать как на листе отрисовываются ваши манипуляции с графическими объектами, то можно воспользоваться ниже приведенными командами.

    // Выключение обновления экрана
    MsWord.ScreenUpdating := False;

    // Обновление экрана
    MsWord.Application.ScreenRefresh;

    // Включение обновления экрана
    MsWord.ScreenUpdating := True;

    Примечания:
    Рисование осуществляется на актвином листе.
    Координаты действуют только для текущего листа.

    Удачной работы!

    Автор статьи: Нечаев Андрей
    Сайт автора: http://nech.tamb.ru

    Наверх

61. Вывод диалога для выбора каталога - Делфи


    uses
    ShellAPI, ShlObj;
    ...

    procedure TForm1.Button1Click(Sender: TObject);
    var
    TitleName : string;
    lpItemID : PItemIDList;
    BrowseInfo : TBrowseInfo;
    DisplayName : array[0..MAX_PATH] of char;
    TempPath : array[0..MAX_PATH] of char;
    begin
    FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
    BrowseInfo.hwndOwner := Form1.Handle;
    BrowseInfo.pszDisplayName := @DisplayName;
    TitleName := 'Please specify a directory';
    BrowseInfo.lpszTitle := PChar(TitleName);
    BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
    lpItemID := SHBrowseForFolder(BrowseInfo);
    if lpItemId <> nil then
    begin
    SHGetPathFromIDList(lpItemID, TempPath);
    ShowMessage(TempPath);
    GlobalFreePtr(lpItemID);
    end;
    end;

    Наверх

62. Как спрятать кнопки в заголовке окна - Делфи

    procedure TForm1.FormCreate(Sender: TObject);
    var
    Style: Longint;
    begin
    Style := GetWindowLong(Handle, GWL_STYLE);
    SetWindowLong(Handle, GWL_STYLE, Style and not WS_SYSMENU);
    end;

    Наверх

63. Сколько файлов есть в определённой папке - Делфи

    function GetFileCount(Dir: string): integer;
    var
    fs: TSearchRec;
    begin
    Result := 0;
    if FindFirst(Dir + '\*.htm', faAnyFile - faDirectory - faVolumeID, fs) = 0
    then
    repeat
    inc(Result);
    until
    FindNext(fs) <> 0;
    FindClose(fs);
    end;

    Наверх

64. Выключение монитора - Делфи

    function MonitorOff(off:boolean;hWnd:HWND):boolean;
    begin
    if off = true then
    SendMessage(hWnd,wm_SysCommand,
    SC_MonitorPower,
    1) else
    SendMessage(hWnd,wm_SysCommand,
    SC_MonitorPower,
    0);
    end;

    Наверх

65. Как с помощью Проводника открыть конкретный каталог? - Делфи

    uses ShellApi;
    procedure TForm1.Button1Click(Sender: TObject);
    begin
    ShellExecute(0, 'explore', 'C:\WINDOWS', nil, nil, SW_SHOWNORMAL);
    end;
    Наверх

66. Запуск приложения - Делфи

    WinExec('C:\WINDOWS\CONTROL.EXE', sw_ShowNormal);

    Наверх
Hosted by uCoz