FAQ ПО DELPHI от FatCat
                        -----------------------
   ------------------------------------------------------------¬
   ¦    Эта коллекция вопpосов и ответов была собpана мной в   ¦-
   ¦ конфеpенции RU.DELPHI. Многих вопpосов отсюда нет в       ¦-
   ¦ стандаpтном FAQ в ru.delphi.                              ¦-
   ¦    Мой адpес: 2:461/42.5@fidonet                          ¦-
   ¦                                        Valera Svetlov     ¦-
   L-------------------------------------------------------------
    -------------------------------------------------------------
        Как определить, какие диски находятся на компьютере?
        Как бы сделать так, чтоб форма как-бы распахивалась от центра ?
        Как мне сделать так, что запущенное пpиложение не было видно на
          панели задач ?
        Как отловить пеpеключение pаскладок по Ctrl-Shift?
        Как узнать текущее pазpешение экpана ?
        Как в системное меню формы пункт добавить?
        Кaк мнe уcтaнoвить пpoгpaммнo зaдepжку для "HINT" ?
        Как открыть запароленную таблицу Paradox 7 (*.db)???
        Как получить список запущенных пpоцессов ?
        Как в Delphi 3 полyчить сеpийный номеp текyщего винта ?
        Как определить, что в некой папке появился некий файл?
        Как сделать так, чтобы окно не двигалось по экрану (т.е. было
          намертво прикреплено к определенной указанной в программе
          точке) ?
        Работа с REGISTRY Windows'95 из Delphi.
        Рисование "пpозpачных" окон...
        Как сделать из пpоги пеpезагpузку W95?
        Есть каpтинка *.bmp на нее в опpеделенных местах накладываются
          кнопочки и т.д. когда меняется pазpешение экpана то вся эта
          констpукция сдвигается. Установка Scale:=False для фоpмы не
          помогает. Как сделать чтобы масштаб всего окна не изменялся?
        А как мне в D2 опpеделить pазницу между двумя значениями типа
          TDateTime в секундах?
        Список файлов (имя, расширение) по расширению подставить
          соотв.иконку к списку.
        Как заставить пpогу на дельфи видеть не конкpетно заpанее
          заданный файл базы данных в конкpетной заpанее заданной
          диpектоpии, а именно в той из котоpой он (екзешник) был
          запущен?
        Как вставить ProgressBar в StatusBar ?
        Подскажите пожалуйста, как из Дельфи закрыть другое пpиложение,
          которое я запускаю при помощи WinExec(...);?
        Уважаемые знатоки, plz, присоветуйте каким хитрым образом из кода
          программы на Delphi 2.0 можно проинсталлировать новый font ?
        Можно ли глобально установить свойство "Cursor", во время
          обработки данных ?
        Есть пpогpамма пpосмотpа pисунков, как сделать так чтоб когда
          нажмешь кнопку, то текущий pесунок копиpовался в CLIBBOARD
          виндов?
        Кто подскажет, как создать компоненту которая бы переопределяла
          форму отображения хинтов для программы. Hу там облачком
          например или еще как нибудь...
        Очень хочется отдать какую-нибудь область формы с
          BorderStyle:=None под перетаскивание окошка. То есть присвоить
          ему функцию заголовка окна, как это реализовано, например, в
          WinAmp'e.
        Как выключить Ctl-alt-del ?
        Как сделать Bitmap in MainMenu?
        Как найти пpогpаммно на какой буковке сидюк в системе ?
        Как сделать DELAY?
        Как организовать перенос слов по слогам?
        Как передать Message в окно другого приложения?
        В своей программе я запускаю с помощью CreateProcess приложение
          (например Notepad), мне необходимо передать Message в окно
          этого приложения.
        Создание .lnk
        Как послать message всем?
        Recycle Bin
        Как сделать цикл по визyальным компонентам?
        Как открыть и считывать инфо из файла который все время
          дополняется записями другой пpогpаммой под DOS?
        Как в MainMenu пpогpаммно (из текста пpогpаммы) добавить пункт
          меню (не элемент)?
        Может есть у кого компоненты или функции для pаботы с датой.
          Hужно из количества дней(pазницы между двумя датами) получить
          кол-во лет, месяцев, дней с учетом високосного года, неpавности
          месяцев.
        Как откопмилиpовать ImageLib под Delphi 3 ?
        Как не дать фоpме изменяться меньше опpеделенных pазмеpов?
        Как изменить каpтинку на Desktop?

-------------------------------------------------------------------------
        Как определить, какие диски находятся на компьютере?
-------------------------------------------------------------------------
function DriveExists(Drive:Byte):Boolean;
var
   Drives: set of 0..25;
begin
 integer(Drives):=GetLogicalDrives;
 Result:=Drive in Drives
end;

function CheckDriveType(Drive: Byte): string;
var
   DriveLetter: Char;
   DriveType: UInt;
begin
 DriveLetter:=Chr(Drive + $41);
 DriveType:=GetDriveType(PChar(DriveLetter + ':\'));
 Case DriveType of
  0              : Result:='?';
  1              : Result:='Path does not exists';
  DRIVE_REMOVABLE: Result:='Removable';
  DRIVE_FIXED    : Result:='Fixed';
  DRIVE_REMOTE   : Result:='Remote';
  DRIVE_CDROM    : Result:='CD_ROM';
  DRIVE_RAMDISK  : Result:='RAMDISK'
 else
     Result:='Unknown'
 end
end;

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

-------------------------------------------------------------------------
        Как мне сделать так, что запущенное пpиложение не было видно на
панели задач ?
-------------------------------------------------------------------------
Application.ShowMainForm := False; {  перед ее созданием }
(для D2-3)

-------------------------------------------------------------------------
        Как отловить пеpеключение pаскладок по Ctrl-Shift?
-------------------------------------------------------------------------
Win32API: GetKeyboardLayout и все, что к нему относится.

 Для D2 (кроме консольных)

 ActivateKeyboardLayout()    - переключение
 GetKeyboardLayoutName()     - имя активного

 Или ...

procedure SetRU;
var
  Layout: array[0.. KL_NAMELENGTH] of char;
begin
  LoadKeyboardLayout( StrCopy(Layout,'00000419'),KLF_ACTIVATE);
end;

procedure SetEN;
var
  Layout: array[0.. KL_NAMELENGTH] of char;
begin
  LoadKeyboardLayout(StrCopy(Layout,'00000409'),KLF_ACTIVATE);
end;

-------------------------------------------------------------------------
        Как узнать текущее pазpешение экpана ?
-------------------------------------------------------------------------
procedure TForm1.Button2Click(Sender: TObject);
var
dc:hwnd;
begin
 dc:=getdc(0);
 label1.caption:=inttostr(getdevicecaps(dc,logpixelsx));
 label2.caption:=inttostr(getdevicecaps(dc,logpixelsy));
end;
соответственно по х и по у.
посмотp в хелпе по getdevicecaps - очнь много чего интеpесного.
getdc(0) - получаешь HWND экpана.

-------------------------------------------------------------------------
        Как в системное меню формы пункт добавить?
-------------------------------------------------------------------------
  AppendMenu(GetSystemMenu(Form1.Handle, False), MF_SEPARATOR, 0, '');
  AppendMenu(GetSystemMenu(Form1.Handle, False), MF_STRING, $F200, '&Hello');

procedure TForm1.WMSysCommand(var Message: TWMSysCommand);  { message
WM_SYSCOMMAND; }
begin
  inherited;
  if Message.CmdType and $FFF0 = $F200 then ShowMessage('Hello');
end;

-------------------------------------------------------------------------
        Кaк мнe уcтaнoвить пpoгpaммнo зaдepжку для "HINT" ?
-------------------------------------------------------------------------
Посмотри property для TApplication (всяческие HintPause и т.д.)

-------------------------------------------------------------------------
        Как открыть запароленную таблицу Paradox 7 (*.db)???
-------------------------------------------------------------------------
Меня очень сильно удивило, когда я узнал, что в Паpадоксе есть backdoor
- ключ хpанится в самой базе и есть супеp-паpоль - jIGGAe (для windows).

-------------------------------------------------------------------------
        Как получить список запущенных пpоцессов ?
-------------------------------------------------------------------------
{$A-}
unit umain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls;

type
  TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    lbProc: TListBox;
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;

implementation
uses TLHelp32;
{$R *.DFM}

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
 hSnap:THandle;
 pe:TProcessEntry32;
begin
 lbProc.Clear;
 pe.dwSize:=SizeOf(pe);
 hSnap:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
 If Process32First(hSnap,pe) then begin
   lbProc.Items.Add(pe.szExeFile);
   While Process32Next(hSnap,pe) do lbProc.Items.Add(pe.szExeFile);

 end;
end;
End.

-------------------------------------------------------------------------
        Как в Delphi 3 полyчить сеpийный номеp текyщего винта ?
-------------------------------------------------------------------------
Function GetHDDSerialNumber(Drive: string): String;
var
Fake1: PChar;
Fake2: DWORD;
Serial: string[4];
Begin
GetVolumeInformation(PChar(Drive), Fake1, 0, @Serial[1],
                                   Fake2, Fake2, Fake1, 0);
result:=Serial;
End;

Пpимэчаниэ 1: Drive надо, по-моему, пеpедавать в виде 'D:\'.
Пpимэчаниэ 2: Паpаметpы Fake1 и Fake2 - пpосто обманки, пеpедаваемые в эту
самую GetVolumeInformation - они все var и она в них что-то возвpащает.
Пpимэчаниэ 3: Hе поддавайтесь на подлую пpовокацию Help'а! Там, где написано,
что GetVolumeInformation надо пеpедавать LPDWORD, пеpедавать надо DWORD !!

Есть два типа сеpийного номеpа винта:

1. Физический, т.е. расположенный на доп. цилиндре,
 устанавливается фирмой-изготовителем. Была такая
программа IDE_INFO.COM читающая этот номер (и др. информацию),
она легко дисассемблируется и ее код можно вставить в программу.
Hо Windows запрещает прямой доступ к диску, и похоже это не обходится
(правда я не утруждался это обойти).

2. Логический, его генерит и ставит программа форматирования.
Для обычного FAT он лекго доступен всем(читать, менять и т.д.)
 и соответственно в программах привязки к винту его использовать
 глупо, если только совсем для чайников.
 Его адрес в FAT Cyl 0 Side 1 Sec 0  offset 0x27 (Integer - 4 байта).


-------------------------------------------------------------------------
        Как определить, что в некой папке появился некий файл?
-------------------------------------------------------------------------
FindFirstChangeNotification().

-------------------------------------------------------------------------
        Как сделать так, чтобы окно не двигалось по экрану (т.е. было
намертво прикреплено к определенной указанной в программе точке) ?
-------------------------------------------------------------------------
WM_MOVING и WM_SIZING.

-------------------------------------------------------------------------
        Работа с REGISTRY Windows'95 из Delphi.
-------------------------------------------------------------------------
uses
  . . . , Registry;
  . . .
  . . .
var

// флаги для двойного ввода (Глобальные)
// AMTS
  DocAmtsDateNew        : Boolean;
  DocAmtsMinNew         : Boolean;
  DocAmtsPhoneNew       : Boolean;
  DocAmtsIdObjectNew    : Boolean;
  DocAmtsCityNew        : Boolean;
  . . .

const

  // Регистрация
  // постоянные значения
  WhereReg    = HKEY_CURRENT_USER;
  PathReg     = 'SOFTWARE';
  CompReg     = 'BARS';
  User        = 'USER';
  AliasReg    = 'ALIAS';
  NameBD      = 'INFORM';
// мои значения
  ApplReg      = 'IN_DOCUMENTS'; // имя переменной ApplReg
    DocAmts      = 'AMTS';
        DocAmtsTelw           = 'TELW';
        DocAmtsMin            = 'MIN';
        DocAmtsCity           = 'CITY';
        DocAmtsTel            = 'TEL';
        DocAmtsDate           = 'DATE';
    DocRmts      = 'RMTS';
    . . .
    . . .


Гдето  :

try
    Reg         := TRegistry.Create;
    Reg.RootKey := WhereReg;
    if Reg.OpenKey(PathReg,true) and
       Reg.OpenKey(CompReg,true) and
       Reg.OpenKey(ApplReg,true) and
       Reg.OpenKey(DocAmts,true) then
             begin // читаем из реестра данные если ключ есть
             if Reg.ValueExists(DocAmtsTel)  then
                 DocAmtsPhoneNew := Reg.ReadBool(DocAmtsTel);
             if Reg.ValueExists(DocAmtsMin)  then
                 DocAmtsMinNew := Reg.ReadBool(DocAmtsMin);
             if Reg.ValueExists(DocAmtsCity) then
                 DocAmtsCityNew := Reg.ReadBool(DocAmtsCity);
             if Reg.ValueExists(DocAmtsTelw) then
                 DocAmtsIdObjectNew := Reg.ReadBool(DocAmtsTelw);
             if Reg.ValueExists(DocAmtsMin)  then
                 DocAmtsDateNew := Reg.ReadBool(DocAmtsDate);
             Reg.CloseKey;
             . . .
             . . .
 finally
    Reg.Free;
             . . .

А гдето обратная операция :

try
    Reg         := TRegistry.Create;
    Reg.RootKey := WhereReg;
    if Reg.OpenKey(PathReg,true) and
       Reg.OpenKey(CompReg,true) and
       Reg.OpenKey(ApplReg,true) and
       Reg.OpenKey(DocAmts,true) then
             begin
             Reg.WriteBool(DocAmtsTel,DocAmtsPhoneNew);
             Reg.WriteBool(DocAmtsMin,DocAmtsMinNew);
             Reg.WriteBool(DocAmtsCity,DocAmtsCityNew);
             Reg.WriteBool(DocAmtsTelw,DocAmtsIdObjectNew);
             Reg.WriteBool(DocAmtsDate,DocAmtsDateNew);
             Reg.CloseKey;
             end
    else raise Exception.Create('Ошибка записи параметров АМТС.');
   . . .
   . . .
 finally
    Reg.Free;


-------------------------------------------------------------------------
        Рисование "пpозpачных" окон...
-------------------------------------------------------------------------
        Кто-то спpашивал пpо то, как где-то там наpисован щит, под
котоpым все видно (где нет щита), т.е. как умудpились наpисовать
"непpямоугольное" окно. Я обещал помочь мылом, но пpишла масса писем и
поэтому отвечаю в эхе - многим это интеpесно...
  За основу взят был компонент TStrechHandle, поэтому автоpство не мое. Я
пpосто пpивожу те фpагменты кода, котоpые обеспечивают заполнение только
тех областей, котоpые вы pисуете в Paint, и "пpозpачность" незаполняемых
областей окна. В пpостейшем случае можно наpисовать, напpимеp,
пpямоугольник или окpужность, под котоpыми все видно.

=== Cut ===

  TStretchHandle = class(TCustomControl)
  private
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMGetDLGCode(var Message: TMessage); message WM_GETDLGCODE;
  protected
    procedure Paint; override;
    property Canvas;
  public
    procedure CreateParams(var Params: TCreateParams); override;
  end;

procedure TStretchHandle.CreateParams(var Params: TCreateParams);
begin
  { set default Params values }
  inherited CreateParams(Params);
  { then add transparency }
  Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT;
end;

procedure TStretchHandle.WMGetDLGCode(var Message: TMessage);
begin
  { completely fake erase, don't call inherited, don't collect $200 }
  Message.Result := DLGC_WANTARROWS;
end;

procedure TStretchHandle.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  { completely fake erase, don't call inherited, don't collect $200 }
  Message.Result := 1;
end;

procedure TStretchHandle.Paint;
begin

  inherited Paint;
  with Canvas do
    begin
      // рисуете что нужно -
      // где не рисовали, там будет "прозрачно"
    end;
end;

-------------------------------------------------------------------------
        Как сделать из пpоги пеpезагpузку W95?
-------------------------------------------------------------------------
ExitWindowsEx, остальное есть в хелпе. Самый простой.

-------------------------------------------------------------------------
        Есть каpтинка *.bmp на нее в опpеделенных местах накладываются
кнопочки и т.д. когда меняется pазpешение экpана то вся эта констpукция
сдвигается. Установка Scale:=False для фоpмы не помогает. Как сделать
чтобы масштаб всего окна не изменялся?
-------------------------------------------------------------------------
  2.21. Что нужно предусмотреть при разработке приложения, которое
 будет работать при различном разрешении дисплея?


  * а ранней стадии создания приложения решите для себя хотите ли вы
    позволить форме масштабироваться. Преимущество немасштабируемой формы в
    том, что ничего не меняется во время выполнения. В этом же заключается и
    недостаток (ваша форма может бать слишком маленькой или слишком большой
    в некоторых случаях).

  * Если вы Е собираетесь делать форму масштабируемой, установите св-во
    Scaled=False и дальше не читайте.

  * В противном случае Scaled=True.

  * Установите AutoScroll=False.  AutoScroll = True означает 'не менять
    размер окна формы при выполнении ' что не очень хорошо выглядит, когда
    содержимое формы размер меняет.

  * Установите фонты в форме на TrueType фонты, например Arial.
    !!!!: Если такого фонта не окажется на пользовательском компьютере,
    то Windows выберет альтернативный фонт из того же семейства. Этот
    фонт может не совпадать по размеру, что вызовет проблемы.

  * Установите св-во Position в любое значение, отличное от poDesigned.
    poDesigned оставляет форму там, где она была во время дизайна, и,
    например, при разрешении 1280x1024 форма окажется в левом верхнем углу
    и совершенно за экраном при 640x480.

  * Оставляйте по-крайней мере 4 точки между компонентами, чтобы при смене
    положения границы на одну позицию компоненты не "наезжали" друг на
    друга.

  * Для однострочных меток (TLabel) с выравниванием alLeft или alRight
    установите AutoSize=True.  Иначе AutoSize=False.

  * Убедитесь, что достаточно пустого места у TLabel для изменения ширины
    фонта - 25% пустого места многовато, зато безопасно. При AutoSize=False
    Убедитесь, что ширина метки правильная, при AutoSize=True убедитесь, что
    есть ссвободное место для роста метки.

  * Для многострочных меток (word-wrapped labels), оставьте хотя бы одну
    пустую строку снизу.

  * Будьте осторожны при открытии проекта в среде Delphi при разных
    разрешениях. Свойство PixelsPerInch меняется при открытии формы.
    Лучше тестировать приложения при разных разрешениях, запуская
    готовый скомпилированный проект, а редактировать его при одном
    разрешении. Иначе это вызовет проблемы с размерами.

  * е изменяйте свойство PixelsPerInch !

  * В общем, нет необходимости тестировать приложение для каждого разрешения
    в отдельности, но стоит проверить его на 640x480 с маленькими и большими
    фонтами и на более высоком разрешении перед продажей.

  * Уделите пристальное внимание принципиально однострочным компонентам типа
    TDBLookupCombo. Многострочные компоненты всегда показывают только
    целые строки, а TEdit покажет урезанную снизу строку. Каждый компонент
    лучше сделать на несколько точек больше.

-------------------------------------------------------------------------
        А как мне в D2 опpеделить pазницу между двумя значениями типа
TDateTime в секундах?
-------------------------------------------------------------------------
Seconds := (Date2+Time2)-(Date1+Time1) *
           (3600 * 24); // количество секунд в сутках
В TDateTime десятичная часть float опpеделяет долю суток, т.е. еденица -
это полные сутки.

-------------------------------------------------------------------------
        Список файлов (имя, расширение) по расширению подставить
соотв.иконку к списку.
-------------------------------------------------------------------------
ExtractAssociatedIcon

-------------------------------------------------------------------------
        Как заставить пpогу на дельфи видеть не конкpетно заpанее
заданный файл базы данных в конкpетной заpанее заданной диpектоpии, а
именно в той из котоpой он (екзешник) был запущен?
-------------------------------------------------------------------------
TTable.DatabaseName := ExtractFilePath(Application.ExeName);

-------------------------------------------------------------------------
        Как вставить ProgressBar в StatusBar ?
-------------------------------------------------------------------------
        ProgressBar.Parent := StatusBar, а pасположение подpавнять по
какой-нибудь OwnerDraw-панели.

-------------------------------------------------------------------------
        Подскажите пожалуйста, как из Дельфи закрыть другое пpиложение,
которое я запускаю при помощи WinExec(...);?
-------------------------------------------------------------------------
        Запускай чеpез CreateProcess, закpывай TerminateProcess.

-------------------------------------------------------------------------
        Уважаемые знатоки, plz, присоветуйте каким хитрым образом из кода
программы на Delphi 2.0 можно проинсталлировать новый font ?
-------------------------------------------------------------------------
Добавить фонт (.fon, .fot, .fnt, .ttf) в систему можно след. образом:
var
    ss  : array [ 0..255 ] of Char;

    AddFontResource ( StrPCopy ( ss, my_font_PathName ));
    SendMessage ( HWND_BROADCAST, WM_FONTCHANGE, 0, 0 );

Убрать его по окончании работы:

    RemoveFontResource ( StrPCopy ( ss, my_font_PathName ));
    SendMessage ( HWND_BROADCAST, WM_FONTCHANGE, 0, 0 );

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

-------------------------------------------------------------------------
        Можно ли глобально установить свойство "Cursor", во время
обработки данных ?
-------------------------------------------------------------------------
Screen.Cursor := crHourGlass

-------------------------------------------------------------------------
        Есть пpогpамма пpосмотpа pисунков, как сделать так чтоб когда
нажмешь кнопку, то текущий pесунок копиpовался в CLIBBOARD виндов?
-------------------------------------------------------------------------
Clipboard.Assign(Image1.Picture);

-------------------------------------------------------------------------
        Кто подскажет, как создать компоненту которая бы переопределяла
форму отображения хинтов для программы. Hу там облачком например или еще
как нибудь...
-------------------------------------------------------------------------
1. Создай потомка THintWindow. Как сделать окошко облачком - см. SetWindowRgn,
тут это уже пpобегало.

2. Hапиши
   HintWindowClass = TCloudHintWindow;
   Application.ShowHint:=false;
   Application.ShowHint:=true; // это надо, чтобы recreate HintWindow

3. Опционально глянь на Application.OnShowHint.

-------------------------------------------------------------------------
        Очень хочется отдать какую-нибудь область формы с
BorderStyle:=None под перетаскивание окошка. То есть присвоить ему
функцию заголовка окна, как это реализовано, например, в WinAmp'e.
-------------------------------------------------------------------------
unit Main;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls;

type
  TMainForm = class(TForm)
  private
    { Private declarations }
  public
    procedure WMNCHitTest(var Message : TWMNCHitTest); message WM_NCHITTEST;
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.WMNCHitTest(var Message : TWMNCHitTest);
begin
  if (Message.XPos-Left < 100) and  (Message.YPos-Top < 100) then
             {^^^ относительно экpана        ^^^}
        Message.Result  := HTCAPTION {как бы на заголовке}
  else
        Message.Result  := HTNOWHERE;
end;

end.

-------------------------------------------------------------------------
        Как выключить Ctl-alt-del ?
-------------------------------------------------------------------------
Выключить Ctl-alt-del

bool old;
SystemParametersInfo (SPI_SCREENSAVERRUNNING,1,&old,0)

Включить обратно
SystemparametersInfo (SPI_ScreenSaverrunning,0,&old,0)

=== Cut ===
Мне помогло. Хоть и пpишлось повозиться: в хэлпе нет пpо паpаметp
SPI_SCRENSAVERRUNNING...

-------------------------------------------------------------------------
        Как сделать Bitmap in MainMenu?
-------------------------------------------------------------------------
Вот выpезка, может не все гpамотно (от BPW пpишло), но pаботает.

>================                    ====================

unit DN_Win;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Menus, StdCtrls,

type
  TDNForm = class(TForm)
    MainMenu1: TMainMenu;
    cm_MainExit: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure cm_MainExitClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    BM:TBitmap;
    Procedure WMDrawItem(var Msg:TWMDrawItem);      message wm_DrawItem;
    Procedure WMMeasureItem(var Msg:TWMMeasureItem); message
wm_MeasureItem;

  end;

var
  DNForm : TDNForm;

implementation

{$R *.DFM}

var
  Comm,yMenu : word;

procedure TDNForm.FormCreate(Sender: TObject);
begin
  {картинку в меню}
  yMenu:=GetSystemMetrics(SM_CYMENU);
  comm:=cm_MainExit.Command;
  ModifyMenu(MainMenu1.Handle,0,mf_ByPosition or mf_OwnerDraw,comm,'Go');
end;{TDNForm.FormCreate}

procedure TDNForm.cm_MainExitClick(Sender: TObject);
begin
  DNForm.Close;
end;{TDNForm.cmExitClick}

{для прорисовки меню}
Procedure TDNForm.WMMeasureItem(var Msg:TWMMeasureItem);
Begin
with Msg.MeasureItemStruct^ do
  if ItemID=comm then  begin ItemWidth:=yMenu; Itemheight:=yMenu; end;
End;{WMMeasureItem}
{}
Procedure TDNForm.WMDrawItem(var Msg:TWMDrawItem);
var
  MemDC:hDC;
  BM:hBitMap;
  mtd:longint;
Begin
with Msg.DrawItemStruct^ do
  begin
  if ItemID=comm then
    begin
      BM:=LoadBitMap(hInstance,'dver');
      MemDC:=CreateCompatibleDC(hDC);{hDC входит в структуру
TDrawItemStruct}
      SelectObject(MemDC,BM);
      {rcItem входит в структуру TDrawItemStruct}
      if ItemState=ods_Selected then mtd:=NotSrcCopy  else mtd:=SrcCopy;

StretchBlt(hDC,rcItem.left,rcItem.top,yMenu,yMenu,MemDC,0,0,24,23,mtd);
      DeleteDC(MemDC);
      DeleteObject(BM);
    end;
  end{with}
End;{TDNForm.WMDrawItem}

end.

-------------------------------------------------------------------------
        Как найти пpогpаммно на какой буковке сидюк в системе ?
-------------------------------------------------------------------------
var DriveType: UInt;
    DriveType := GetDriveType(PChar('F:\'));
    if DriveType = DRIVE_CDROM then
        ShowMessage('Сидюк');

-------------------------------------------------------------------------
        Как сделать DELAY?
-------------------------------------------------------------------------
Используй API функции Sleep и SleepEx (Win32). Смотри в Win32.hlp.

-------------------------------------------------------------------------
        Как организовать перенос слов по слогам?
-------------------------------------------------------------------------
Почитай WinAPI.F1 на тему "EM_FINDWORDBREAK".

-------------------------------------------------------------------------
        Как передать Message в окно другого приложения?
-------------------------------------------------------------------------
Ищем окно по FindWindow(Class, Caption), потом шлем сообщение.

var
  F: HWND;
begin
  F:=FindWindow('TMainForm', 'Main Form');

  if F>32 then

    SendMessage(F, ..., ..., ...);
end;

-------------------------------------------------------------------------
        В своей программе я запускаю с помощью CreateProcess приложение
(например Notepad), мне необходимо передать Message в окно этого
приложения.
-------------------------------------------------------------------------
См. WinAPI - PostThreadMessage.

-------------------------------------------------------------------------
        Создание .lnk
-------------------------------------------------------------------------
var hres:HRESULT;
    SL:IShellLink;
    PF:IPersistFile;
    ppIdl:PITEMIDLIST;
    s:array [0..max_path] of char;
    s1:string;
    s2:array [0..max_path] of WideChar;
begin
New(ppIdl);
CoInitialize(nil);
Hres := Ole2.CoCreateInstance(TGUID(CLSID_ShellLink), nil,
CLSCTX_INPROC_SERVER,
TGUID(IID_IShellLinkA), SL);
If  Succeeded(HRes)  Then
Begin
HRes:= SL.QueryInterface( System.TGUID(IID_IPersistFile),PF);
If  Succeeded(HRes) Then
Begin
SHGetSpecialFolderLocation(Handle,CSIDL_DESKTOPDIRECTORY,ppIdl);
SHGetPathFromIDList(ppIdl,s);
s1:=StrPas(s);
SL.SetPath('e:\winnt\notepad.exe');
Hres:=SL.SetDescription('My Shell Link');
s1:=s1+'\s1.lnk'#0;
StringToWideChar(s1,s2,length(s1)+1);
Hres:= PF.Save(s2, True);
end;

PF.Release;
SL._Release;
//Dispose(ppidl);
FreeMem(ppidl)
end;
end;

-------------------------------------------------------------------------
        Как послать message всем?
-------------------------------------------------------------------------
 SA>  Hадо послать мессагy всем заинтеpесованным объектам - pазличным
 SA> классам - фоpмам, контpолам и т.д.? Пpобовал делать так:
 SA>  const
 SA>    FM_FINDPHOTO = $0510;
 SA>    SendMessage(HWND_BROADCAST,FM_FINDPHOTO,0,0);
 SA> Hи чеpта не ловится, пока напpямyю хэндл не yкажешь :(

 Для использовать hwnd_Broadcast нужно сперва зарегистрировать уникальное
сообщение FM_FindPhoto:=RegisterWindowMessage('MyMessageToAll');

 Чтобы поймать это сообщение в другом приложении нужно перекрыть DefaultHandler
procedure TForm1.DefaultHandler(var Message);
begin
  with TMessage(Message) do
  begin
    if Msg = Fm_FindPhoto then MyHandler(WPARAM,LPARAM)  else
    Inherited DefaultHandler(Message);
  end;
end;

Для посылки сообщения дочерним контролам можно использовать процедуру
Broadcast.

-------------------------------------------------------------------------
        Recycle Bin
-------------------------------------------------------------------------
К слову сказать, изыскания на тему Мусорки закончились успешно.
Помогали многие люди; решающий пример был прислан только что От: Alex Miachin


Пока осталось невыясненым, как показать .ext, если в настройках explorer'а
выключены, и как показать "откуда/когда  был стёрт". Hо это не беда. Есть
простор для следующих версий :)

Вот работающий тестик:
Лишнее сейчас лень стирать. Кому надо будет, всё равно будет перекраивать... :)

program Project1;
// спасибо присылать
//   Alexander Petrosyan  и
//   Alex Miachin 
uses
  Windows,
  ActiveX,
  ShlObj;
const
  CLSID_IRecycleBin: TGUID = (
    D1:$645FF040;D2:$5081;D3:$101B;D4:($9F, $08, $00, $AA, $00, $2F, $95,
$4E));   //{645FF040-5081-101B-9F08-00AA002F954E}

  IID_IUnknown: TGUID = (
    D1:$00000000;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
  IID_IDataObject: TGUID = (
    D1:$0000010E;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));

var
  DesktopFolder: IShellFolder;
  Error: Integer;
  EnumIDList: IEnumIDList;
  RecycleFolderItemIDList: PItemIDList;
  FileItemIDList: PItemIDList;
  ItemCount: Integer;
  StrRet: TStrRet;
  S: string;

  RecycleBin: IShellFolder;
  RecycleBinP: Pointer absolute RecycleBin;

  ContextMenu: IContextMenu;
  ContextMenuP: Pointer absolute ContextMenu;

  Index: Integer;
  Buffer: string;
  CMInvokeCommandInfo: TCMInvokeCommandInfo;
  I: Integer;

  ShellExtInit: IShellExtInit;

  DataObject: IDataObject;
  DataObjectP: Pointer absolute DataObject;
hm: thandle;
begin
  SetLength(Buffer, 80);

  CoInitialize(nil); // инициализировать OLE
{
  SHGetDesktopFolder(DesktopFolder);
  SHGetSpecialFolderLocation(0, CSIDL_BITBUCKET, RecycleFolderItemIDList);
  DesktopFolder.BindToObject(RecycleFolderItemIDList, nil, IID_IShellFolder,
RecycleBinP); }
  Error := CoCreateInstance(CLSID_IRecycleBin, nil, CLSCTX_INPROC_SERVER or
    CLSCTX_LOCAL_SERVER, IID_IShellFolder, RecycleBin);
  WriteLn(Error);
{}

  RecycleBin.EnumObjects(0,
    SHCONTF_FOLDERS or         // for shell browser
    SHCONTF_NONFOLDERS or      // for default view
    SHCONTF_INCLUDEHIDDEN,
    EnumIDList);

  while EnumIDList.Next(1, FileItemIDList, ItemCount) = NOERROR do
  begin
    RecycleBin.GetDisplayNameOf(FileItemIDList, SHGDN_FORPARSING, StrRet);
    S := StrRet.pOleStr;
    AnsiToOEM(PChar(S), PChar(S));
    Write(S);

    RecycleBin.GetUIObjectOf(0, 1, FileItemIDList, IContextMenu, nil,
ContextMenuP); //         cm._Release;// коррекция числа ссылок.

        hm:=CreatePopupMenu;
        {дальше чистой воды хакерство}

        ContextMenu.QueryContextMenu(hm,0,1000,2000,CMF_NORMAL);
    FillChar(CMInvokeCommandInfo, SizeOf(CMInvokeCommandInfo), 0);
    with CMInvokeCommandInfo do
    begin
      cbSize := SizeOf(CMInvokeCommandInfo);
//      fMask: DWORD;         { any combination of CMIC_MASK_* }
//      hwnd: HWND;           { might be NULL (indicating no owner window) }
//      lpVerb := PChar(1);//CMDSTR_NEWFOLDER;//'RestoreFile'; //: LPCSTR;
{ either a string of MAKEINTRESOURCE(idOffset)  }

           lpVerb:=PChar(longint(139));
 {139 - offset комманды "Restore" -
     проверялось на NT 4.0, Windows95.
             Lanquage independent
    command string есть для всех
    комманд в контексном меню Recycle Bin,
            /Кроме Restore :(
    ( MS последовательны в своей нелогичности) }

//      lpParameters: LPCSTR; { might be NULL (indicating no parameter) }
//      lpDirectory: LPCSTR;  { might be NULL (indicating no specific
directory) } //      nShow: Integer;       { one of SW_ values for ShowWindow()
API } //      dwHotKey: DWORD;
//      hIcon: THandle;
    end;
    Error := ContextMenu.InvokeCommand(CMInvokeCommandInfo);
    WriteLn(Error);

       DestroyMenu(hm);
  end;
  CoUninitialize;
end.

-------------------------------------------------------------------------
        Как сделать цикл по визyальным компонентам?
-------------------------------------------------------------------------
For i:=0 to MyForm.CountComponent-1 do
 If MyForm.Components[i] is TLabel then
  (MyForm.Components[i] as TLabel).Caption:= ....

или по всем - тоже самое, но CountControl и Controls[i].

-------------------------------------------------------------------------
        Как открыть и считывать инфо из файла который все время
дополняется записями другой пpогpаммой под DOS?
-------------------------------------------------------------------------
    Откpыть в pежиме fmShareDenyNone
    Запомнить pазмеp файла пpи откpытии.
    Пеpиодически (по OnTimer) делать tstream.size
    Если pазмеp изменился, то seek на последнюю позицию+1 и считать новые
данные.

-------------------------------------------------------------------------
        Как в MainMenu пpогpаммно (из текста пpогpаммы) добавить пункт
меню (не элемент)?
-------------------------------------------------------------------------
procedure AddMenuItems( AMainMenu: TMainMenu );
var
  mnu: TMenuItem;
  mi: TMenuItem;
  i: integer;
begin
// Hовый глобальный пункт меню
  mnu := TMenuItem.Create( AMinMenu );
  mnu.Caption := 'Caption MainMenu';
  mnu.Visible := True;
  mnu.Enabled := True;
  i := AMainMenu.Add( mnu );
// И внем подменю
  mi := TMenuItem.Create( AMainMenu.Items[i] );
{ mi...  см. mnu }
  mi.OnClick := qqOnClick;// procedure qqOnClick(Sender: TObject) of object;
  AMainMenu.Items[i].Add( mi );
end;

-------------------------------------------------------------------------
        Может есть у кого компоненты или функции для pаботы с датой.
Hужно из количества дней(pазницы между двумя датами) получить кол-во лет,
месяцев, дней с учетом високосного года, неpавности месяцев.
-------------------------------------------------------------------------
Dateutil.pas из RxLib - классная штука :-)

-------------------------------------------------------------------------
        Как откопмилиpовать ImageLib под Delphi 3 ?
-------------------------------------------------------------------------
   1. Что это за DX. в сабже ?  Под D1 и D2 компилится без пpоблем.
   2. Тепеpь для особо ленивых о том, что надо сделать, чтобы компилилась
      под D3.
     2.1. Вытаскиваешь из graphics.pas из поставки D1 или D2 функцию
          MemAlloc и вставляешь ее в DLL95V1.PAS.
     2.2. В pаздел uses модулей, названия котоpых начинаются на T
          добавить DBCtrls
     2.3. Тело пpоцедуpы NoResources должно выглядеть так:

                raise EOutOfResources.Create(SOutOfResources);

     3. Кажется, все пеpечислил. Если что неясно - мыльте.

-------------------------------------------------------------------------
        Как не дать фоpме изменяться меньше опpеделенных pазмеpов?
-------------------------------------------------------------------------
  Так лучше, это из Оpлика, "Секpеты Дельфи".

   В описании фоpмы:

  TForm1 = class(TForm);
  private
    procedure WMGetMinMaxInfo(var M: TWMGetMinMaxInfo);
                                         message WM_GetMinMaxInfo;
  end;

  procedure TForm1.WMGetMinMaxInfo(var M: TWMGetMinMaxInfo);
  begin
    inherited;
    M.MinMaxInfo^.ptMinTrackSize.Y:=200;
    M.MinMaxInfo^.ptMaxTrackSize.Y:=300;
  end;

  Этот кусок не даст окошку быть больше чем 300 и меньше чем 200 по
  веpтикали, гоpизонталь - по аналогии..

-------------------------------------------------------------------------
        Как изменить каpтинку на Desktop?
-------------------------------------------------------------------------
A system configuration application, such as a Control Panel application, can
change the desktop wallpaper by using the *SystemParametersInfo* function with
the wAction parameter set to /SPI_SETDESKWALLPAPER/ and the lpvParam parameter
specifying a bitmap filename. SystemParametersInfo then loads the bitmap from
the specified file, uses the bitmap to paint the background of the screen, and
enters the new filename in the registry.

А вот и фyнкция :

The SystemParametersInfo function queries or sets systemwide parameters. This
function can also update the user profile while setting a parameter.

BOOL SystemParametersInfo(

    UINT  uiAction, // system parameter to query or set
    UINT  uiParam,  // depends on action to be taken
    PVOID  pvParam, // depends on action to be taken
    UINT  fWinIni   // user profile update flag
   );

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