1

Тема: Прямокутник виділення(фокусу) у TTrackBar

Доброго і святкового дня, шановна спільнота :)
У мене до Вас питання: як очистити/зняти/перемалювати прямокутник виділення, як це зображено в додатку?
В інтернеті бачив рішення, але вони або не працювали, або працювали не так як треба.
Шукав й інші компоненти слайдерів, але потрібен слайдер з підтримкою скінів(від Embarcadero).
P.S. В AlphaControls є компонент TsTrackBar. Так от, при увімкненому стилі цього прямокутника немає, але переходити на "важчий" двигун скінів я не хочу.

Post's attachments

Записати.PNG 746 b, 173 downloads since 2015-08-24 

2

Re: Прямокутник виділення(фокусу) у TTrackBar

DOP написав:

Доброго і святкового дня, шановна спільнота :)
У мене до Вас питання: як очистити/зняти/перемалювати прямокутник виділення, як це зображено в додатку?
В інтернеті бачив рішення, але вони або не працювали, або працювали не так як треба.
Шукав й інші компоненти слайдерів, але потрібен слайдер з підтримкою скінів(від Embarcadero).
P.S. В AlphaControls є компонент TsTrackBar. Так от, при увімкненому стилі цього прямокутника немає, але переходити на "важчий" двигун скінів я не хочу.

Я використовув компоненти TImage

Post's attachments

Записtarckати.PNG 20.65 kb, 155 downloads since 2015-08-24 

3

Re: Прямокутник виділення(фокусу) у TTrackBar

О, можете поділитись реалізацією?  *SCRATCH*

4 Востаннє редагувалося shabaranskij (24.08.2015 15:53:23)

Re: Прямокутник виділення(фокусу) у TTrackBar

DOP написав:

О, можете поділитись реалізацією?  *SCRATCH*

Так, мені не шкода. Зараз на яндекс диск закину всі файли.

5 Востаннє редагувалося shabaranskij (24.08.2015 16:03:41)

Re: Прямокутник виділення(фокусу) у TTrackBar

Готово. https://yadi.sk/d/X1ONOEz1idSBA. Якщо будуть питання що до коду тоді питай. https://vk.com/shabaranskijtaras

Подякували: DOP1

6

Re: Прямокутник виділення(фокусу) у TTrackBar

... стандартний трекбар буде ще й від маніфесту залежати. Краще реалізувати свій движок (ви правильно відзначили за скіни ... є набір TMS, наприклад).

Але найпростіше двома TImage.
1- робимо 3 картинки bitmap (або в одну всі, потiм copyrect-ом порiзати): висотою 1 пкс підкладка движка, сам Траск-движок в початковому стані і стані взяття
2- картинки заганяємо в ресурси, читаємо з ресурсу за допомогою TResourceStream
3- transparent Імейджа в true

Події на фоновому:

 var dv_move: tpoint;

procedure tvid.set_pos (_x: longint);
begin
 ...
end;

procedure Tvid.SldPosbackMouseDown (Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 if (Button = mbLeft) then set_pos (x)
end;

procedure Tvid.SldPosbackMouseMove (Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 if Shift = [ssLeft] then set_pos (x)
end; 

Події движка:

procedure tvid.dv_nmov;
begin
 if dv.Left <16- (dv.Width div 2) then
  dv.Left: = 16- (dv.Width div 2);
 if dv.Left> SldPosBack.Width + 16- (dv.Width div 2) then
  dv.Left: = SldPosBack.Width + 16- (dv.Width div 2)
end;

procedure Tvid.dvMouseDown (Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 // Підвантажуємий першу
 img.Picture.Bitmap.assign (src1);
 dv_move: = Point (x, y)
end;

procedure Tvid.dvMouseMove (Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 if (ssLeft in Shift) and (Player.Initialized) then begin
  dv.Left: = dv.Left + x - dv_move.X;
  dv_nmov;
  set_pos (dv.Left-16)
 end
end;

procedure Tvid.dvMouseUp (Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 // другу
 img.Picture.Bitmap.assign (src2);
end; 

Як це виглядає в моєму DS-плеєрі/системi керування https://www.youtube.com/watch?v=HvIPmnjWW0s

Подякували: DOP1

7 Востаннє редагувалося DOP (24.08.2015 17:16:32)

Re: Прямокутник виділення(фокусу) у TTrackBar

Знайшов оптимальне рішення(при умові, що трекбару не потрібен неявний фокус):

Form1.ActiveControl := nil;

або

Form1.DefocusControl(TrackBar1, true);

8

Re: Прямокутник виділення(фокусу) у TTrackBar

DOP
В JVCL можете глянути, та й AlphaControls не такий уже тяжкий. Якщо пишете свій медіаплеєр то раджу саме AlphaControls.
Прибирати фокус не варто, бо тоді прогою буде незручно керувати з клавіатури і пульта.

9

Re: Прямокутник виділення(фокусу) у TTrackBar

Але при використані AlphaControls збільшується жирність програми.) Не великий мінус.

10

Re: Прямокутник виділення(фокусу) у TTrackBar

Знайшов оптимальне рішення

э такий хак перемалювання:

function TrackBarProc(myWnd: HWND;
                        Msg: UINT;
                        myWParam: WPARAM;
                        myLParam:LPARAM): LRESULT; stdcall;
var
   DC, hPen, hOldPen, hOldBrush : DWORD;
   cxBorder : integer;
   rc : TRect;
   cr : integer;
begin
   result := CallWindowProc(Pointer(GetWindowLong(myWnd,GWL_USERDATA)),
                            myWnd, Msg, myWParam, myLParam);
   if Msg = WM_PAINT then
   begin
      cxBorder := GetSystemMetrics(SM_CXBORDER);
      GetWindowRect(myWnd,rc);
      DC := GetWindowDC(myWnd);
      cr :=GetSysColor(COLOR_BTNFACE);
      hPen := CreatePen(PS_INSIDEFRAME, cxBorder, cr);
      hOldPen := SelectObject(DC, hPen);
      hOldBrush := SelectObject(DC,  GetStockObject(NULL_BRUSH));
      Rectangle(DC, 0, 0,rc.Right - rc.Left, rc.Bottom - rc.Top);
      SelectObject(DC, hOldBrush);
      SelectObject(DC, hOldPen);
      ReleaseDC(myWnd,DC);
      DeleteObject(hPen)
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
SetWindowLong(TrackBar1.Handle,
              GWL_USERDATA,
              SetWindowLong(TrackBar1.Handle, GWL_WNDPROC, LPARAM(@TrackBarProc)));
end;

11 Востаннє редагувалося DOP (25.08.2015 01:35:51)

Re: Прямокутник виділення(фокусу) у TTrackBar

raxp, працює шикарно при вимкнених стилях. Зараз спробую адаптувати під стилі...

Update
Дещо модифікував функцію перемалювання трекбару. Тепер замальовує ту рамку фокусу згідно обраного стилю, ПРОТЕ я так і не зміг вирішити проблему мерехтіння рамки ми наведенні мишки на контрол(без стилю Ваш код працює так як треба).

Відредагований код
function TrackBarProc(myWnd: HWND; Msg: UINT; myWParam: WPARAM;
  myLParam: LPARAM): LRESULT; stdcall;
var
  DC, hPen, hOldPen, hOldBrush: DWORD;
  cxBorder: integer;
  rc: TRect;
  cr: integer;
  LStyles: TCustomStyleServices;
begin
  LStyles:=StyleServices;
  result := CallWindowProc(Pointer(GetWindowLong(myWnd, GWL_USERDATA)), myWnd,
    Msg, myWParam, myLParam);
  if Msg = WM_PAINT then
  begin
    cxBorder := GetSystemMetrics(SM_CXBORDER);
    GetWindowRect(myWnd, rc);
    DC := GetWindowDC(myWnd);
    cr := LStyles.GetStyleColor(scWindow);
    hPen := CreatePen(PS_SOLID, cxBorder, cr);
    hOldPen := SelectObject(DC, hPen);
    hOldBrush := SelectObject(DC, GetStockObject(NULL_BRUSH));
    Rectangle(DC, 0, 0, rc.Right - rc.Left, rc.Bottom - rc.Top);
    SelectObject(DC, hOldBrush);
    SelectObject(DC, hOldPen);
    ReleaseDC(myWnd, DC);
    DeleteObject(hPen)
  end;
end;

Інфу брав звідси