Есть ли такой контрол в Дельфи?

[mutabor]

Можно ли в Дельфи создать такие стандартные контролы? Не руками рисовать, а именно стандартный, как на картинке, чтобы выглядел соответсвующе смотря какая XP тема у пользователя.
Как я трекбар не крутил ничего такого не получилось.

[B_N]

Обычный трэкбар с манифестом....

[mutabor]

В таком случае как сузить его внутреннюю часть до полоски? При этом чтобы ползунок остался видимым.
Как менять вид ползунка на квадратный?

[B_N]

А это зависит от того, с одной ли стороны метки. Стили TBS_TOP, TBS_BOTTOM, TBS_LEFT, TBS_RIGHT, в зависимости от TBS_VERT или TBS_HORZ для ползунка с указателем и TBS_BOTH для ползунка без указателя.

[mutabor]

С видом ползунка разобрался, спасибо, проглядел.
А вот свойства меняющего ширину полосы в упор не вижу. Его что забыли добавить? В Дельфи у трекбара получается полоса широкая на всю ширину ползунка.

[B_N]

А-а.., сразу не понял, что речь про канал, как его называет, MS. Если память не подводит, его ширина привязана к размеру ползунка, который ставится через TBM_SETTHUMBLENGTH. (стиль TBS_FIXEDLENGTH должен быть установлен).

[mutabor]

Кажется начинает проясняться, TBM_SETTHUMBLENGTH к этому в Дельфи свойство есть, и оно действительно привязано к ширине канала, а вот TBS_FIXEDLENGTH сейчас поищу, но вроде не припомню такого.

Нет такого, вот все свойства:
In TTrackBar
Frequency
LineSize
Max
Min
Orientation
PageSize
Position
SelEnd
SelStart
SliderVisible
ThumbLength
TickMarks
TickStyle

[B_N]

mutabor, вру Подводит память. Широкий канал включает стиль
TBS_ENABLESELRANGE (стиль), в канале можно при этом добавить "активный диапазон", а TBM_SETTHUMBLENGTH (сообщение) меняет только размер кубика. Если Дельфи про него не знает, то просто через SetWindowLong, TBS_ENABLESELRANGE - это обычный оконный стиль.

-------------------------

Да, ещё выше опечатался. "(стиль TBS_FIXEDLENGTH должен быть снят)." следует читать как (стиль TBS_FIXEDLENGTH должен быть установлен), исправляю.

[mutabor]

Значит так, попробовал я в процедуре TTrackBar.CreateParams, это в модуле ComCtrls.pas, убрать стиль TBS_ENABLESELRANGE. Результата никакого. На всякий случай привожу три процедуры
TTrackBar.Create
TTrackBar.CreateParams //в ней я менял
TTrackBar.CreateWnd

Может еще чего подскажите?
На всякий случай уточню, мне нужно сделать "канал" узким, а "квадратик" побольше.

constructor TTrackBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 150;
  Height := 45;
  TabStop := True;
  FMin := 0;
  FMax := 10;
  FPosition := 0;
  FLineSize := 1;
  FPageSize := 2;
  FFrequency := 1;
  FSelStart := 0;
  FSelEnd := 0;
  FThumbLength := 20; //вот это свойство
  FTickMarks := tmBottomRight;
  FTickStyle := tsAuto;
  FOrientation := trHorizontal;
  ControlStyle := ControlStyle - [csDoubleClicks];
  FSliderVisible := True;
end;

procedure TTrackBar.CreateParams(var Params: TCreateParams);
const
  OrientationStyle: array[TTrackbarOrientation] of DWORD = (TBS_HORZ, TBS_VERT);
  TickStyles: array[Boolean, TTickStyle] of DWORD =
    ((TBS_NOTICKS, TBS_AUTOTICKS, 0), (TBS_NOTICKS, 0, 0));
  ATickMarks: array[TTickMark] of DWORD = (TBS_BOTTOM, TBS_TOP, TBS_BOTH);
begin
  InitCommonControl(ICC_BAR_CLASSES);
  inherited CreateParams(Params);
  CreateSubClass(Params, TRACKBAR_CLASS);
  with Params do
  begin
    Style := Style or OrientationStyle[FOrientation] or
      // Ignore tsAuto if more than MaxAutoTicks in the track bar range.
      // tsAuto is is ignored because the TRACKBAR_CLASS will paint,
      // as many tick marks as you ask for. Too many an it appears
      // the track bar has hung but it just painting very slowly. Since large
      // ranges can be accidentally entered in the object inpsector we just
      // have the control ignore them instead of hanging.
      TickStyles[FMax - FMin > MaxAutoTicks, FTickStyle] or
      // тут я строку закомментировал
      //ATickMarks[FTickMarks] or TBS_FIXEDLENGTH or TBS_ENABLESELRANGE;
      ATickMarks[FTickMarks] or TBS_FIXEDLENGTH;
    WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW) or
      CS_DBLCLKS;
    if not FSliderVisible then
      Style := Style or TBS_NOTHUMB;
  end;
end;

procedure TTrackBar.CreateWnd;
begin
  inherited CreateWnd;
  if HandleAllocated then
  begin
    SendMessage(Handle, TBM_SETTHUMBLENGTH, FThumbLength, 0);
    SendMessage(Handle, TBM_SETLINESIZE, 0, FLineSize);
    SendMessage(Handle, TBM_SETPAGESIZE, 0, FPageSize);
    SendMessage(Handle, TBM_SETRANGEMIN, 0, FMin);
    SendMessage(Handle, TBM_SETRANGEMAX, 0, FMax);
    UpdateSelection;
    SendMessage(Handle, TBM_SETPOS, 1, FPosition);
    SendMessage(Handle, TBM_SETTICFREQ, FFrequency, 1);
  end;
end;

[B_N]

Сообщение от mutabor

Может еще чего подскажите?
На всякий случай уточню, мне нужно сделать "канал" узким, а "квадратик" побольше.

Ширина канала (если он есть, как таковой) привязана к размеру кубика. Что-то около 3/4.

Ну а чтобы его не было:

procedure TForm1.FormCreate(Sender: TObject);
const TBS_ENABLESELRANGE = $0020;
begin
    SetWindowLong(
            self.TrackBar1.Handle,
            GWL_STYLE,
            GetWindowLong(self.TrackBar1.Handle, GWL_STYLE) AND (NOT TBS_ENABLESELRANGE));

end;

Понятия не имею, есть ли в дельфи такое свойство, я тоже не нашёл. Так же, как и TBS_ENABLESELRANGE, не знаю, в каком он юните, поэтому здесь определил вручную.