Сегодня мы научимся закрашивать фон окна плавным переходом из одного цвета в другой. Такая заливка очень часто используется в инсталяторах программ. Помимо этого мы на примере рассмотрим запуск внешней проги и ожидание её оканчания выполнения. Я уже описывал этот приём в разделе "каком к верху", а теперь ты увидешь реальный пример.

Рис 1. Форма

На рисунке 1 показана форма уже запущенного примера. Посмотри на неё, а теперь создай новый проект и брось на него кнопку. По событию OnClick по этой кнопке мы пишем:

procedure TForm1.Button1Click(Sender: TObject);
var
 zCurDir:array[0..255] of char;
 WorkDir:String;
 StartupInfo:TStartupInfo;
 ProcessInfo:TProcessInformation;
begin
 GetDir(0,WorkDir);
 StrPCopy(zCurDir,WorkDir);
 FillChar(StartupInfo,Sizeof(StartupInfo),#0);
 StartupInfo.cb := Sizeof(StartupInfo);


 StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
 StartupInfo.wShowWindow := SW_SHOW;
 if not CreateProcess(nil,
  'calc.exe',              { указатель командной строки, путь к
                              проге + аргументы }
  nil,                     { указатель на процесс атрибутов безопасности }
  nil,                     { указатель на поток атрибутов безопасности }
  false,                   { флаг родительского обработчика }
  CREATE_NEW_CONSOLE or    { флаг создания }
  NORMAL_PRIORITY_CLASS,
  nil,                     { указатель на новую среду процесса }
  nil,                     { указатель на имя текущей директории }
  StartupInfo,             { указатель на STARTUPINFO }
  ProcessInfo)             { указатель на PROCESS_INF }
  then exit;
 WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
 Application.MessageBox(PChar('Калькулятор закончил работу!'), 'Ошибка', 
            MB_OK+MB_ICONEXCLAMATION);
end;

Здесь есть очень интересная функция WaitforSingleObject. Эта функция ждёт, пока не произойдёт какое-то событие. В качестве первого параметра передаётся указатель на событие, а второй - время ожидание. INFINITE - означает, что надо ожидать события бесконечно.

Есть ещё один очень удобный способ использования WaitforSingleObject. Ещё в DOS существовала функция Delay, которая производила задержку, но сейчас её использование не актуально. Вот тут нам помогает WaitforSingleObject:

var
 h:THandle;
begin
 h:=CreateEvent(nil, true,false, 'et');//Создаю событие
 WaitForSingleObject(h,1000);//Запускаю ожидание события
 CloseHandle(h);//Закрываю событие
end;

В этом примере я создал пустое событие и запустил WaitForSingleObject для ожидания события ровно 1 секунду. Так как моё событие пустое и никогда не произойдёт, функция WaitForSingleObject подождёт 1 секунду и продолжит выполнение программы. Таким образом мы сделали задёржку в программе, которая универсальна и не загружает проц.

Ещё одна интересная функция FillChar, она заполняет область памяти указанной в качестве первого параметра значением указанным в качестве третьего параметра. Второй параметр - размер области памяти. В примере выше, я заполняю нулями структуру StartupInfo, так я становлюсь уверен, что все члены структуры являются нулями.

Остальное тебе должно быть уже всё знакомо, поэтому я сделаю минутную паузу и покурю, пока ты рассмотришь этот код и поймёшь всё происходящее.

Всё, я покурил. Теперь можно двигатся дальше :). Теперь алгоритм создания заливки. По собитию формы OnPaint пишем:

procedure TForm1.FormPaint(Sender: TObject);
var
 difr,difb,difg,sr,sg,sb:integer;
 x1,x2,h,y1,y2,w,l:integer;
 u:longint;
 c:real;
begin
 ec := clblue;  //Начальный цвет для заливки
 sc := clblack; //Конечный 
 n := 80;       //Количество блоков
 h := height;
 w := width;
 c := h/n;
 //Дальше идёт расчёт сдвигов
 sr := sc and $FF;
 difr := (ec and $FF) - sr;
 sg := (sc shr 8) and $FF;
 difg := ((ec shr 8) and $FF) - sg;
 sb := (sc shr 16) and $FF;
 difb := ((ec shr 16) and $FF) - sb;

 //Устанавливаю прозрачный стиль ручки
 canvas.pen.style := psclear;
 canvas.pen.width := 0;

 //Устанавливаю сплошной стиль заливки
 canvas.brush.style := bssolid;

 //Рисую поблочно градиент
 for l := 0 to n-1 do
  begin
   x1 := 0;
   x2 := w;
   y1 := round(l*c);
   y2 := y1+round(c)+2;
   u := rgb((l * difr) div (n-1)+sr,(l * difg) div (n-1)+sg,
                 (l * difb) div (n-1)+sb);
   canvas.brush.color := u;
   canvas.rectangle(x1,y1,x2,y2); 
  end;
end;

Чтобы всё это заработало, нужно в самом начале (в разделе var) объявить пару переменных:

var
  Form1: TForm1;
  sc,ec,n:longint;

По событию OnResize я заставляю форму перерисоватся.

Вот и всё, что я хотел тебе сказать.

 Исходники примера забирай здесь