{ uEncodeForm — окно настроек сборки с перекодированием. Зачем оно нужно. Обычная сборка копирует потоки и потому мгновенна, но отдаёт ролик ровно в том виде, в каком снят исходник. Когда ролик надо отдать под площадку — в 1080p с определённым потоком, — приходится перекодировать, и это уже осознанный выбор, а не поведение по умолчанию. Поэтому отдельный пункт меню и отдельное окно. Окно собирается кодом, без файла формы: элементов в нём меньше десятка, и описание заняло бы больше места, чем сам код. Так же сделано окно сообщения в uTheme. Перекодирование идёт на видеокарте. Процессорный кодировщик на 2688x1512 работает медленнее реального времени, и часовой ролик считал бы часами; выбор кодировщика делает uFfmpegCmd, предпочитая NVENC. Если аппаратного кодировщика нет, окно об этом честно предупреждает. } unit uEncodeForm; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Controls, Forms, Graphics, StdCtrls, Dialogs, uTheme, uExport; { Спрашивает настройки. Возвращает False, если человек передумал. ADefaultCodec — кодек проекта: с него разумно начинать, иначе первый же выбор менял бы формат без спроса. } function AskEncodeProfile(out AProfile: TEncodeProfile; const ADefaultCodec: string): Boolean; implementation uses uFfmpegCmd; type TPreset = record Caption: string; Width: Integer; Height: Integer; { Поток в килобитах в секунду. Значения взяты как обычная рабочая середина для съёмки с движением: меньше — заметны квадраты на траве и воде, больше — файл растёт без видимой пользы. } Bitrate: Integer; end; const Presets: array[0..3] of TPreset = ( (Caption: '1280x720 (720p)'; Width: 1280; Height: 720; Bitrate: 8000), (Caption: '1920x1080 (1080p)'; Width: 1920; Height: 1080; Bitrate: 16000), (Caption: '2560x1440 (1440p)'; Width: 2560; Height: 1440; Bitrate: 28000), (Caption: '3840x2160 (4K)'; Width: 3840; Height: 2160; Bitrate: 50000) ); type { Обработчики живут в объекте: событиям нужны методы. } TEncodeDialog = class(TComponent) public Form: TForm; cbPreset: TComboBox; cbCodec: TComboBox; edBitrate: TEdit; lblEncoder: TLabel; procedure PresetChange(Sender: TObject); procedure CodecChange(Sender: TObject); procedure UpdateEncoderNote; end; procedure TEncodeDialog.PresetChange(Sender: TObject); begin if (cbPreset.ItemIndex >= 0) and (cbPreset.ItemIndex <= High(Presets)) then edBitrate.Text := IntToStr(Presets[cbPreset.ItemIndex].Bitrate); end; procedure TEncodeDialog.CodecChange(Sender: TObject); begin UpdateEncoderNote; end; procedure TEncodeDialog.UpdateEncoderNote; var Codec, Enc: string; begin if cbCodec.ItemIndex = 0 then Codec := 'hevc' else Codec := 'h264'; Enc := PreferredEncoder(Codec); if Pos('nvenc', Enc) > 0 then begin lblEncoder.Font.Color := ThemeTextDim; lblEncoder.Caption := 'Кодировщик: ' + Enc + ' — на видеокарте.'; end else begin { Предупреждение, а не запрет: пусть человек сам решит, готов ли ждать. Молча уйти на процессор нельзя — разница в разы. } lblEncoder.Font.Color := ThemeAccent; lblEncoder.Caption := 'Кодировщик: ' + Enc + ' — аппаратного не нашлось, сборка будет очень долгой.'; end; end; function AskEncodeProfile(out AProfile: TEncodeProfile; const ADefaultCodec: string): Boolean; var Dlg: TEncodeDialog; Lbl: TLabel; BtnOk, BtnCancel: TThemedButton; I, Bitrate: Integer; begin Result := False; AProfile := Default(TEncodeProfile); Dlg := TEncodeDialog.Create(nil); try Dlg.Form := TForm.CreateNew(nil); Dlg.Form.Caption := 'Сборка с перекодированием'; Dlg.Form.BorderStyle := bsDialog; Dlg.Form.Position := poScreenCenter; Dlg.Form.ClientWidth := 460; Dlg.Form.ClientHeight := 220; Lbl := TLabel.Create(Dlg.Form); Lbl.Parent := Dlg.Form; Lbl.SetBounds(16, 16, 120, 20); Lbl.Caption := 'Размер кадра'; Dlg.cbPreset := TComboBox.Create(Dlg.Form); Dlg.cbPreset.Parent := Dlg.Form; Dlg.cbPreset.SetBounds(160, 12, 280, 26); Dlg.cbPreset.Style := csDropDownList; for I := 0 to High(Presets) do Dlg.cbPreset.Items.Add(Presets[I].Caption); Dlg.cbPreset.ItemIndex := 1; Dlg.cbPreset.OnChange := @Dlg.PresetChange; Lbl := TLabel.Create(Dlg.Form); Lbl.Parent := Dlg.Form; Lbl.SetBounds(16, 56, 140, 20); Lbl.Caption := 'Поток, кбит/с'; Dlg.edBitrate := TEdit.Create(Dlg.Form); Dlg.edBitrate.Parent := Dlg.Form; Dlg.edBitrate.SetBounds(160, 52, 120, 26); Dlg.edBitrate.Text := IntToStr(Presets[1].Bitrate); Lbl := TLabel.Create(Dlg.Form); Lbl.Parent := Dlg.Form; Lbl.SetBounds(16, 96, 140, 20); Lbl.Caption := 'Кодек'; Dlg.cbCodec := TComboBox.Create(Dlg.Form); Dlg.cbCodec.Parent := Dlg.Form; Dlg.cbCodec.SetBounds(160, 92, 280, 26); Dlg.cbCodec.Style := csDropDownList; Dlg.cbCodec.Items.Add('HEVC (H.265) — меньше файл'); Dlg.cbCodec.Items.Add('H.264 — совместимее'); if LowerCase(ADefaultCodec) = 'h264' then Dlg.cbCodec.ItemIndex := 1 else Dlg.cbCodec.ItemIndex := 0; Dlg.cbCodec.OnChange := @Dlg.CodecChange; Dlg.lblEncoder := TLabel.Create(Dlg.Form); Dlg.lblEncoder.Parent := Dlg.Form; Dlg.lblEncoder.SetBounds(16, 132, 424, 36); Dlg.lblEncoder.WordWrap := True; Dlg.lblEncoder.AutoSize := False; Dlg.lblEncoder.ParentColor := False; BtnOk := TThemedButton.Create(Dlg.Form); BtnOk.Parent := Dlg.Form; BtnOk.SetBounds(240, 180, 100, 28); BtnOk.Caption := 'Собрать'; BtnOk.ModalResult := mrOk; BtnOk.Default := True; BtnCancel := TThemedButton.Create(Dlg.Form); BtnCancel.Parent := Dlg.Form; BtnCancel.SetBounds(348, 180, 100, 28); BtnCancel.Caption := 'Отмена'; BtnCancel.ModalResult := mrCancel; BtnCancel.Cancel := True; { Цвета задаются до первого показа, как и во всех остальных окнах. } ApplyDarkTheme(Dlg.Form); Dlg.UpdateEncoderNote; if Dlg.Form.ShowModal <> mrOk then Exit; I := Dlg.cbPreset.ItemIndex; if (I < 0) or (I > High(Presets)) then I := 1; Bitrate := StrToIntDef(Trim(Dlg.edBitrate.Text), Presets[I].Bitrate); { Ноль и отрицательное — не поток, а описка. Верхняя граница выбрана с запасом: выше него кодировщики уже отказываются работать. } if (Bitrate < 100) or (Bitrate > 400000) then Bitrate := Presets[I].Bitrate; AProfile.Enabled := True; AProfile.Width := Presets[I].Width; AProfile.Height := Presets[I].Height; AProfile.BitrateKbps := Bitrate; if Dlg.cbCodec.ItemIndex = 1 then AProfile.Codec := 'h264' else AProfile.Codec := 'hevc'; Result := True; finally Dlg.Form.Free; Dlg.Free; end; end; end.