unit bitmapprogress; interface uses windows,classes,controls,graphics,sysutils,messages,math; type TBitmapProgress = class(TCustomControl) private hrgn:HRgn; vcanv : tbitmap; fmax : integer; fposition : integer; lastposition : integer; fbitmap : tbitmap; fbwbitmap : tbitmap; fradius : integer; fstartradius : integer; fbrightness : real; procedure setangles; procedure _setposition(p : integer); procedure _setmax(m : integer); procedure setregion; procedure angledraw(startangle,endangle : integer;startrad : integer;endrad : integer); protected public constructor Create(AOwner : TComponent); override; destructor Destroy; override; procedure Resize; override; procedure CreateWnd; override; procedure ShowControl(AControl: TControl);override; published procedure assignbackground(_bitmap : tbitmap); procedure Paint; override; property radius : integer read fradius write fradius; property startradius : integer read fstartradius write fstartradius; property position : integer read fposition write _setposition; property max : integer read fmax write _setmax; property brightness : real read fbrightness write fbrightness; end; procedure Register; implementation constructor TBitmapProgress.Create(AOwner : TComponent); begin inherited; vcanv:= Tbitmap.create; fmax := 100; fposition := 0; width:=100; height:=100; Parent := (AOwner As TWinControl); fbrightness:=1; end; destructor TBitmapProgress.Destroy; begin vcanv.free; inherited Destroy; end; procedure TBitmapProgress.setregion; begin SetWindowRgn(Handle , 0, False); DeleteObject(hRgn); hrgn:=CreateEllipticRgn(0, 0,width, height); SetWindowRgn(Handle,hrgn, True); end; procedure TBitmapProgress.CreateWnd; begin inherited; setregion; end; procedure TbitmapProgress.Resize; begin vcanv.width:=width; vcanv.height:=height; setregion; inherited; end; procedure TbitmapProgress._setposition(p : integer); begin if p>fmax then p:=fmax; fposition:=p; setangles; end; procedure TbitmapProgress._setmax(m : integer); begin lastposition:=0; fmax:=m; setangles; end; procedure TBitmapProgress.angledraw(startangle,endangle : integer;startrad : integer;endrad : integer); var x,y,d,n : real; originx, originy : real; begin if fbitmap=nil then exit; originx:=width div 2; originy:=height div 2; d:=startrad; while (d<=endrad) do begin n:=startangle; while n<endangle do begin n:=n+0.25; x:=d*(cos(degtorad(n-90)))+originx; y:=d*(sin(degtorad(n-90)))+originy; vcanv.canvas.pixels[round(x),round(y)]:=fbitmap.canvas.pixels[round(x),round(y)]; end; d:=d+1; end; end; procedure TBitmapProgress.setangles; begin paint; end; procedure TBitmapProgress.Paint; var tr : trect; angle : integer; pos : integer; begin //inherited; canvas.draw(0,0,vcanv); tr.Top:=0; tr.Left:=0; tr.Right:=width; tr.Bottom:=height; if position>0 then angle:=round(((360 / fmax)*position)) else angle:=0; if angle<lastposition then begin; pos:=0; vcanv.canvas.stretchdraw(tr,fbwbitmap); end else pos:=lastposition; if angle=0 then vcanv.canvas.stretchdraw(tr,fbwbitmap); if angle=lastposition then exit; lastposition:=angle; angledraw(pos,angle,fstartradius,fradius); canvas.draw(0,0,vcanv); end; function ConvertBitmapToGrayscale(Bitmap: TBitmap; brightness : real): TBitmap; var i, j: Integer; Grayshade, Red, Green, Blue: Byte; PixelColor: Longint; begin with Bitmap do for i := 0 to Width - 1 do for j := 0 to Height - 1 do begin PixelColor := ColorToRGB(Canvas.Pixels[i, j]); Red := byte(PixelColor); Green := byte(PixelColor shr 8); Blue := byte(PixelColor shr 16); //.3 .6 .1 Grayshade := Round((0.1*brightness) * Red + (0.1*brightness) * Green + (0.1*brightness)* Blue); Canvas.Pixels[i, j] := RGB(Grayshade, Grayshade, Grayshade); end; Result := Bitmap; end; procedure TBitmapProgress.assignbackground(_bitmap : tbitmap); var tr : trect; begin if fbitmap=nil then fbitmap:=tbitmap.create; if fbwbitmap=nil then fbwbitmap:=tbitmap.create; //fbitmap.assign(_bitmap); tr.Top:=0; tr.Left:=0; tr.Right:=width; tr.Bottom:=height; fbitmap.width:=width; fbitmap.height:=height; fbitmap.canvas.stretchdraw(tr,_bitmap); fbwbitmap.assign(_bitmap); fbwbitmap.assign(ConvertBitmapToGrayscale(fbwbitmap,brightness)); visible:=true; paint; visible:=false; end; procedure TBitmapProgress.ShowControl(AControl: TControl); begin inherited; if not (csDesigning in ComponentState ) then setregion; end; procedure Register; begin RegisterComponents('LibrarySmith', [TBitmapProgress]); end; end.