[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