unit numericinput;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, stdctrls,extctrls;


const TIMERSTARTINTERVAL=200;

type
  TNumericInput= class(TGraphicControl)
  private
  fcolor : Tcolor;
  fldown,frdown : boolean;
  minusup,minusdown,plusup,plusdown : tbitmap;
  fvalue : integer;
  fmax,fmin : integer;
  ftimer : TTimer;
  procedure setcolor(_color : tcolor);
  procedure setmin(min : integer);
  procedure setmax(max : integer);
  procedure setvalue(n : integer);
  { Private declarations }
  protected
    { Protected declarations }
  public
  constructor Create(AOwner : TComponent); override;
  procedure Paint; override;
  procedure Resize; override;
  procedure MouseUp(Button: TMouseButton; Shift: TShiftState;X, Y: Integer);override;
  procedure MouseDown(Button: TMouseButton; Shift: TShiftState;X, Y: Integer);override;
  procedure dotimer(sender : tobject);
    { Public declarations }
  published
  property color : Tcolor read Fcolor write setcolor default clred;
  property font;
  property parentfont;
  property OnClick;
  property OnMouseDown;
  property OnMouseUp;
  property visible;
  property value : integer read fvalue write setvalue;
  property max : integer read fmax write setmax;
  property min : integer read fmin write setmin;

        { Published declarations }
  end;

const ICONWIDTH = 32;

procedure Register;

implementation
{$R ICONS.RES}


procedure Tnumericinput.setvalue(n : integer);
begin
if n<=fmax then fvalue:=n;
if n>=fmin then fvalue:=n;
paint;
end;

procedure Tnumericinput.dotimer(sender : tobject);
begin
if frdown=true then if fvalue+1<=fmax then value:=value+1;
if fldown=true then if fvalue-1>=fmin then value:=value-1;
if ftimer.Interval>20 then ftimer.Interval:=ftimer.Interval-10;
end;

procedure Tnumericinput.setmax(max : integer);
begin
  fmax:=max;
  if value>fmax then value:=fmax;
end;

procedure Tnumericinput.setmin(min : integer);
begin
  fmin:=min;
  if value<fmin then value:=fmin;
end;


procedure alphablendbitmapwithcolor(blend : tbitmap;blendcolor : tcolor;source : tbitmap;alpha : real);
var
x,y : integer;
rin,rout : pbytearray;
outval : integer;
br,bg,bb : integer;

function rangecheck(inp : integer) : byte;
begin
     if inp>255 then outval:=255;
     if inp<0 then outval:=0;
     result:=byte(inp);
end;

begin
source.width:=blend.width;
source.height:=blend.height;
source.pixelformat:=pf24bit;
br:=getrvalue(ColorToRGB(blendcolor));
bg:=getgvalue(ColorToRGB(blendcolor));
bb:=getbvalue(ColorToRGB(blendcolor));


with source do begin
       for y:=0 to source.height -1 do begin
         rin:=scanline[y];
         rout:=source.scanline[y];
         x:=0;
      // application.processmessages;
         while x< 3*width-1 do begin
      // application.processmessages;

         outval:=round((alpha*(rin[x]-bb))+bb);
         rout[x]:=rangecheck(outval);
      // application.processmessages;
         outval:=round((alpha*(rin[x+1]-bg))+bg);
         rout[x+1]:=rangecheck(outval);
      // application.processmessages;

         outval:=round((alpha*(rin[x+2]-br))+br);
         rout[x+2]:=rangecheck(outval);
         x:=x+3;
         end;
     end;
end;
end;








procedure TNumericInput.setcolor(_color : tcolor);
begin
Fcolor:=_color;
resize;

invalidate;
end;

constructor TNumericInput.Create(AOwner : TComponent);
begin
     inherited Create(AOwner);
     controlstyle:=controlstyle-[csOpaque];
     Parent := (AOwner AS TWinControl);
     fcolor:=clWindow;
     canvas.pen.style:=psSolid;


     plusup:=tbitmap.Create;
     plusdown:=tbitmap.Create;
     minusup:=tbitmap.Create;
     minusdown:=tbitmap.Create;
     ftimer:=ttimer.create(self);
     ftimer.Enabled:=false;
     ftimer.Interval:=TIMERSTARTINTERVAL;
     ftimer.OnTimer:=dotimer;
     fmax:=100;
     fmin:=0;
     width:=200;
end;


procedure TNumericInput.Paint;
var
dr : trect;
begin

inherited paint;
//vcanv:=tbitmap.create;
//vcanv.SetSize(width,height);
dr.left:=0;
dr.right:=height;
dr.Top:=0;
dr.bottom:=dr.right;
canvas.Brush.Style:=bsClear;

if fldown=false then Canvas.BrushCopy(dr,minusup,minusup.Canvas.ClipRect,minusup.Canvas.Pixels[0,0]) else Canvas.BrushCopy(dr,minusdown,minusdown.Canvas.ClipRect,minusdown.Canvas.Pixels[0,0]);
canvas.Font.Assign(font);
canvas.Font.Size:=width div 7;
canvas.Brush.Style:=bsSolid;
canvas.Pen.color:=clWhite;
canvas.Brush.color:=clBlack;
canvas.Rectangle(dr.right+4,0,width-dr.Right-4,height);
canvas.Brush.Style:=bsClear;
canvas.TextOut((width div 2)-(canvas.textwidth(inttostr(fvalue)) div 2),height div 2 - canvas.TextHeight('A') div 2,inttostr(fvalue));

dr.left:=width - (dr.right);
dr.Right:=width;
if frdown=false then Canvas.BrushCopy(dr,plusup,plusup.Canvas.ClipRect,plusup.Canvas.Pixels[0,0]) else Canvas.BrushCopy(dr,plusdown,plusdown.Canvas.ClipRect,plusdown.Canvas.Pixels[0,0]);
end;

procedure Register;
begin
  RegisterComponents('LibrarySmith', [TNumericInput]);
end;


procedure TNumericInput.Resize;
begin
height:=round(width / 4);
inherited resize;
canvas.Font:=font;
plusup.LoadFromResourceName(hinstance,'PLUSUP');
plusdown.LoadFromResourceName(hinstance,'PLUSDOWN');
minusup.LoadFromResourceName(hinstance,'MINUSUP');
minusdown.LoadFromResourceName(hinstance,'MINUSDOWN');

alphablendbitmapwithcolor(plusup,fcolor,plusup,0.7);
alphablendbitmapwithcolor(plusdown,fcolor,plusdown,0.7);
alphablendbitmapwithcolor(minusup,fcolor,minusup,0.7);
alphablendbitmapwithcolor(minusdown,fcolor,minusdown,0.7);


end;

procedure TNumericInput.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
invalidate;
fldown:=false;
frdown:=false;
ftimer.enabled:=false;
ftimer.Interval:=TIMERSTARTINTERVAL;
inherited;
end;

procedure TNumericInput.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
if (x<width div 3) then begin
  fldown:=true;
  if fvalue-1>=fmin then value:=value-1;
end;
if (x>width - (width div 3)) then begin
  frdown:=true;
  if fvalue+1<=fmax then value:=value+1;
end;
ftimer.enabled:=true;
invalidate;
inherited;
end;




end.