unit dav7RotationBtn;
{ rotation button component }

interface

uses Classes,Controls,Graphics,Messages;

type Torientation = (orHorizontal,orVertical);
     TRotationChange = procedure(sender : TObject; position : byte) of object;
     TonButtonPaint = procedure(sender : TObject) of object;
     TDav7RotationBtn = class(TgraphicControl)
      private
       FMap : Tbitmap;
       Fmoving : boolean;
       FoldX   : smallInt;
       FoldY   : smallInt;
       Forientation : TOrientation;
       FonEnter : TNotifyEvent;
       FonLeave : TNotifyEvent;
       FonChange : TRotationChange;
       FonButtonPaint : TonButtonPaint;
       FBorderwidth : byte;
       FBordercolor1 : cardinal;
       FBordercolor2 : cardinal;
       FBGcolor : cardinal;
       FNotchColor : cardinal;
       FNotchWidth : byte;
       FNotchSpacing : byte;
       FPixelRatio : byte;
       Fpixelcount : smallInt;
       Fmaxpixelcount : smallInt;
       FPosition : byte;
       FMaximum : byte;
       FDCC : byte;
       procedure setOrientation(ortn : TOrientation);
       procedure setbordercolor1(col : cardinal);
       procedure setbordercolor2(col : cardinal);
       procedure setBGcolor(col : cardinal);
       procedure setborderwidth(bw : byte);
       procedure setNotchWidth(nw : byte);
       procedure setNotchSpacing(ns : byte);
       procedure setNotchColor(col : cardinal);
       procedure setPosition(pos : byte);
       procedure setmaximum(m : byte);
       procedure setpixelratio(pr : byte);
       procedure draw;
      protected
       procedure paint;override;
       procedure mousemove(Shift : Tshiftstate; x,y : integer); override;
       procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
                           X, Y: Integer); override;
       procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
                         X, Y: Integer); override;
       procedure CMmouseEnter(var message : Tmessage); message CM_MOUSEENTER;
       procedure CMmouseLeave(var message : Tmessage); message CM_MOUSELEAVE;
      public
        constructor create(AOwner : TComponent); override;
        destructor destroy; override;
        property map : Tbitmap read Fmap;
      published
       property orientation : TOrientation read FOrientation write setOrientation;
       property OnEnter : TNotifyEvent read FOnEnter write FOnEnter;
       property OnLeave : TNotifyEvent read FonLeave write FOnLeave;
       property onChange : TRotationChange read FonChange write FonChange;
       property onButtonPaint : TonButtonPaint read FonButtonPaint write FonButtonPaint;
       property visible;
       property enabled;
       property bordercolor1 : cardinal read FBordercolor1 write setBordercolor1;
       property bordercolor2 : cardinal read FBordercolor2 write setbordercolor2;
       property BGcolor : cardinal read FBGcolor write setBGcolor;
       property borderwidth : byte read FBorderwidth write setBorderwidth;
       property notchwidth : byte read FNotchwidth write setNotchWidth;
       property notchSpacing : byte read FNotchSpacing write setNotchSpacing;
       property notchColor : cardinal read Fnotchcolor  write setNotchColor;
       property position : byte read Fposition write setPosition;
       property maximum : byte read Fmaximum write setmaximum;
       property pixelratio : byte read FPixelRatio write setpixelratio;
     end;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents('system',[Tdav7RotationBtn]);
end;

constructor TDav7RotationBtn.create(Aowner : TComponent);
begin
 inherited create(AOwner);
 width := 30;
 height := 120;
 Forientation := orVertical;
 Fborderwidth := 2;
 FBordercolor1 := $404040;
 FBordercolor2 := $808080;
 FbgColor := $c0c0c0;
 FNotchColor := $000000;
 FnotchWidth := 5;
 FNotchSpacing := 5;
 Fpixelratio := 10;
 Fmaximum := 10;
 Fmaxpixelcount := 105;
end;

destructor TDav7RotationBtn.destroy;
begin
 map.free;
 inherited destroy;
end;

procedure TDav7RotationBtn.setOrientation(ortn : TOrientation);
var h : integer;
begin
 if ((ortn = orHorizontal) and (width < height)) or
    ((ortn = orVertical) and (width > height)) then
  begin
   h := height;
   height := width;
   width := h;
  end;
 FOrientation := ortn;
 draw;
end;

procedure Tdav7RotationBtn.CMmouseLeave(var message : Tmessage);
begin
 if not (csDesigning in componentstate) and assigned(FOnLeave) then
  onLeave(self);
end;

procedure Tdav7RotationBtn.CMmouseEnter(var message : Tmessage);
begin
 FDCC := 0;
 if not (csDesigning in componentstate) and assigned(FOnEnter) then
    onEnter(self);
end;

procedure TDav7RotationBtn.setbordercolor1(col : cardinal);
begin
 Fbordercolor1 := col;
 draw;
end;

procedure TDav7RotationBtn.setbordercolor2(col : cardinal);
begin
 Fbordercolor2 := col;
 draw;
end;

procedure TDav7RotationBtn.setBGcolor(col : cardinal);
begin
 FBgcolor := col;
 draw;
end;

procedure TDav7RotationBtn.setborderwidth(bw : byte);
begin
 if bw >= width shr 1 then bw := 0;
 FBorderwidth := bw;
 draw;
end;

procedure TDav7RotationBtn.setNotchWidth(nw : byte);
begin
 FNotchWidth := nw;
 draw;
end;

procedure TDav7RotationBtn.setNotchSpacing(ns : byte);
begin
 FNotchSpacing := ns;
 draw;
end;

procedure TDav7RotationBtn.setNotchColor(col : cardinal);
begin
 FNotchColor := col;
 draw;
end;

procedure TDav7RotationBtn.setPosition(pos : byte);
begin
 FPosition := pos;
 Fpixelcount := pos * pixelratio;
 draw;
end;

procedure TDav7RotationBtn.setmaximum(m : byte);
begin
 Fmaximum := m;
 if m < Fposition then
  begin
   Fposition := m;
   FPixelcount := m * Fpixelratio;
  end;
 Fmaxpixelcount := Fpixelratio * (m+1) - 1;
 draw;
end;

procedure TDav7RotationBtn.setpixelratio(pr : byte);
begin
 FPixelRatio := pr;
 Fpixelcount := Fposition * pr;
 Fmaxpixelcount := pr * (Fmaximum+1) - 1;
 draw;
end;

procedure TDav7RotationBtn.paint;
begin
 draw;
end;

procedure TDav7RotationBtn.mousemove(Shift : Tshiftstate; x,y : integer);
var dy,dx : smallInt;
    newPosition : byte;
begin
 if Fmoving then
  begin
   dx := x - FoldX;
   dy := y - FoldY;
   FoldX := x;
   FoldY := y;
   case Forientation of
    orVertical   : Fpixelcount := Fpixelcount - dy;
    orHorizontal : Fpixelcount := Fpixelcount + dx;
   end;//case
   if Fpixelcount < 0 then Fpixelcount := 0
    else if Fpixelcount > Fmaxpixelcount then Fpixelcount := Fmaxpixelcount;
   newposition := Fpixelcount div Fpixelratio;
   if newposition <> Fposition then
    begin
     Fposition := newposition;
     if assigned(FonChange) then Fonchange(self,Fposition);
    end;
   draw;
  end;
end;

procedure TDav7RotationBtn.MouseDown(Button: TMouseButton; Shift: TShiftState;
                           X, Y: Integer);
begin
 Fmoving:= true;
 FoldX := x;
 FoldY := y;
end;

procedure TDav7RotationBtn.MouseUp(Button: TMouseButton; Shift: TShiftState;
                         X, Y: Integer);
begin
 Fmoving := false;
end;

procedure TDav7RotationBtn.draw;
var i,radius,notchInterval,tape : smallInt;
    x1,y1,x2,y2,pixbase : smallInt;
    RI,rad2 : longInt;
    a,h : double;
begin
 if assigned(Fmap) = false then
  begin
   Fmap := Tbitmap.create;
   Fmap.pixelformat := pf32bit;
  end;
 if Fmap.Width <> width then Fmap.Width := width;
 if Fmap.Height <> height then Fmap.Height := height;
 with Fmap do with canvas do
  begin
   brush.Color := FbgColor;
   brush.Style := bsSolid;
   fillrect(rect(0,0,width,height));
   pen.Width := 1;
   for i := 0 to FBorderwidth-1 do
    begin
     pen.Color := FBordercolor1;
     moveto(width-i-1,i);
     lineto(i,i);
     lineto(i,height-1-i);
     pen.color := FBordercolor2;
     lineto(width-1-i,height-1-i);
     lineto(width-i-1,i);
    end;
//
   notchInterval := FNotchSpacing + FNotchWidth;
   pen.Color := FNotchColor;
   x1 := FBorderwidth;
   y1 := FBorderwidth;
   x2 := width - FBorderwidth;
   y2 := height - FBorderwidth;
   if Forientation = orVertical then
    begin
     radius := height shr 1;
     rad2 := radius*radius;
     for i := y1 to y2 - 1 do
      begin
       if i = radius then a := 0.5*pi
        else begin
              RI := radius-i;
              h := sqrt(rad2 - sqr(RI));
              a := arctan(h/RI);
              if RI < 0 then a := pi + a;
             end;
       tape := round(a*radius);
       if ((tape + Fpixelcount) mod notchInterval) < FnotchWidth then
        begin
         moveto(x1,i);
         lineto(x2,i);
        end;
      end;
    end;
   if Forientation = orHorizontal then
    begin
     radius := width shr 1;
     rad2 := radius*radius;
     pixbase := FMaxpixelcount - Fpixelcount;
     for i := x1 to x2-1 do
      begin
       if i = radius then a := 0.5*pi
        else begin
              RI := radius-i;
              h := sqrt(rad2 - sqr(RI));
              a := arctan(h/RI);
              if RI < 0 then a := pi + a;
             end;
       tape := round(a*radius);
       if ((pixbase + tape) mod notchInterval) < FnotchWidth then
        begin
         moveto(i,y1);
         lineto(i,y2);
        end;
      end;
    end;
  end;//with
 if assigned(FonButtonPaint) then FonButtonPaint(self);
 self.Canvas.Draw(0,0,Fmap);
end;

end.