[nbstudio]

В общем нужно сделать свой трекбар для плеера, обычный TrackBar не подходит, единственный компонент который подходит, так это AdvTrackBar, но он триальный. Вот встала проблема создания трекбара из 2 Image (один - это полоска, а другой это за что тягать). Только вот реализовать это не получается. Может кто подскажет?

[Страдалецъ]

Подсказать как реализовать?
Ничего особо сложного, делаете класс наследник TGraphicControl
в нем преписываете конструктор Create и метод Paint. Если есть необходимость, то регистрируете его.

[nbstudio]

Сообщение от Страдалецъ

Подсказать как реализовать?
Ничего особо сложного, делаете класс наследник TGraphicControl
в нем преписываете конструктор Create и метод Paint. Если есть необходимость, то регистрируете его.

А можно примерчик как это реализовать, если не сложно?

[Страдалецъ]

Примерчик такой у вас уже есть, посмотрите в исходниках как реализован класс TShape он живет в ExtCtrls.pas

[nbstudio]

Глянул этот файл, но чесно говоря почти ничего там не понял, там сильно много лишнего, а мне просто надо наглядно используя 2 компонента Image сделать трекбар. Просто узнать длину файла, определить процент, и позицию движка, и чтобы этот движок передвигался если за него потянуть. Вот это собственно и непонятно.

[AleD]

совпадение? на днях начинал делать такой компонент! правда только начал, но не успел доделать, выложу сырой исходник, основное в нём уже есть, осталось потвикать и доделать, думаю сможете.

[mak-karpov]

Вот код перетаскивания, проценты сам посчитай(если умеешь)

Код:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Shape1: TShape;
    Shape2: TShape;
    Label1: TLabel;
    Label2: TLabel;
    Shape3: TShape;
    procedure Shape3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Shape3MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Shape3MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  mv   : boolean;
  coord : TPoint;
  l,il    : integer;
  procent : integer;
implementation

{$R *.dfm}

procedure TForm1.Shape3MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if ((Shape2.Left - Shape3.Left) < X) and (X < (Shape2.Left - Shape3.Left)+17) then
    mv := true;
  Coord := Point(x,y);
  l := Shape2.Left;
end;

procedure TForm1.Shape3MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var sm : integer;
begin
  sm := X-Coord.X;
  if (Shape2.Left >= Shape3.Left+(Shape3.Width - Shape2.Width - 4)) and (sm > 0)  then exit;
  if (Shape2.Left <= (Shape3.Left+4)) and (sm < 0) then exit;
  if mv then begin
    Shape2.Left := l + sm;
  end;

end;

procedure TForm1.Shape3MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  mv := false;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  il := Shape2.Left;
end;

end.

dfm

Код:

object Form1: TForm1
  Left = 192
  Top = 114
  Width = 485
  Height = 135
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Shape1: TShape
    Left = 20
    Top = 26
    Width = 361
    Height = 11
  end
  object Shape2: TShape
    Left = 22
    Top = 14
    Width = 17
    Height = 33
    Brush.Color = clGray
  end
  object Label1: TLabel
    Left = 14
    Top = 60
    Width = 457
    Height = 13
    Caption = 
      'Замени компонеты TShape (кроме Shape3) компонентами TImage (если' +
      ' хочешь, конечно)'
  end
  object Label2: TLabel
    Left = 12
    Top = 78
    Width = 66
    Height = 13
    Caption = 'Проценты - 0'
  end
  object Shape3: TShape
    Left = 18
    Top = 14
    Width = 367
    Height = 33
    Brush.Style = bsClear
    Pen.Style = psClear
    OnMouseDown = Shape3MouseDown
    OnMouseMove = Shape3MouseMove
    OnMouseUp = Shape3MouseUp
  end
end