mmegauge.pas

一套及时通讯的原码

   DrawInactiveSpots;
end;

{-- TMMLEDGauge ------------------------------------------------------}
procedure TMMLEDGauge.AdjustSize(var W, H: Integer);
begin
   if not (csLoading in ComponentState) then
   begin
      W := Max(W,2*BevelExtend+2);
      H := Max(H,2*BevelExtend);
   end;
end;

{-- TMMLEDGauge ------------------------------------------------------}
procedure TMMLEDGauge.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
var
  W, H: Integer;
begin
   W := aWidth;
   H := aHeight;
   AdjustSize (W, H);
   inherited SetBounds(aLeft, aTop, W, H);
   Changed;
end;

{-- TMMLEDGauge ------------------------------------------------------}
procedure TMMLEDGauge.Loaded;
var
  W, H: Integer;
begin
   inherited Loaded;

   W := Width;
   H := Height;
   AdjustSize(W, H);
   Width := W;
   Height:= H;

   DrawInactiveSpots;
   Invalidate;
end;

{-- TMMLEDGauge ------------------------------------------------------}
procedure TMMLEDGauge.Changed;
begin
   FClientRect := BeveledRect;
   FWidth  := Max(FClientRect.Right - FClientRect.Left,1);
   FHeight := Max(FClientRect.Bottom - FClientRect.Top,1);

   DIBCanvas.SetBounds(0,0,FWidth,FHeight);
   FBarDIB.SetBounds(0,0,FWidth,FHeight);

   { recalculate the number of spots }
   CalcNumSpots;

   inherited Changed;
end;

{-- TMMLEDGauge ------------------------------------------------------}
procedure TMMLEDGauge.SetPoints(Index, aValue: integer);
begin
   aValue := MinMax(aValue, 1, 100);
   case Index of
     0: if FPoint1 = aValue then exit else FPoint1 := aValue;
     1: if FPoint2 = aValue then exit else FPoint2 := aValue;
   end;
   CalcNumSpots;
   Invalidate;
end;

{-- TMMLEDGauge ------------------------------------------------------}
procedure TMMLEDGauge.SetColors(Index:Integer; aValue: TColor);
begin
   case Index of
      0: if FBar1Color = aValue then exit else FBar1Color := aValue;
      1: if FBar2Color = aValue then exit else FBar2Color := aValue;
      2: if FBar3Color = aValue then exit else FBar3Color := aValue;
      3: if FInact1Color = aValue then exit else FInact1Color := aValue;
      4: if FInact2Color = aValue then exit else FInact2Color := aValue;
      5: if FInact3Color = aValue then exit else FInact3Color := aValue;
   end;
   DrawInactiveSpots;
   Invalidate;
end;

{-- TMMLEDGauge ------------------------------------------------------}
procedure TMMLEDGauge.SetInactiveDoted(aValue: Boolean);
begin
   if (aValue <> FInactiveDoted) then
   begin
      FInactiveDoted := aValue;
      DrawInactiveSpots;
      Invalidate;
   end;
end;

{-- TMMLEDGauge ------------------------------------------------------}
procedure TMMLEDGauge.SetActiveDoted(aValue: Boolean);
begin
   if (aValue <> FActiveDoted) then
   begin
      FActiveDoted := aValue;
      DrawInactiveSpots;
      Invalidate;
   end;
end;

{-- TMMLEDGauge ------------------------------------------------------}
procedure TMMLEDGauge.CMColorChanged(var Message: TMessage);
begin
   DrawInactiveSpots;
   inherited;
end;

{-- TMMLEDGauge ------------------------------------------------------}
procedure TMMLEDGauge.SetProgress(aValue: integer);
begin
   if (aValue <> FProgress) then
   begin
      FProgress := MinMax(aValue,0,VALUERANGE);
      FData     := Min(MulDiv32(FProgress,FNumSpots,VALUERANGE),FNumSpots);
      if (csDesigning in ComponentState) then
          Refresh
      else
          FastDraw(DrawBar,False);
   end;
end;

{-- TMMLEDGauge ------------------------------------------------------}
procedure TMMLEDGauge.DrawBarHorizontal(DIB: TMMDIBCanvas; nSpots: integer);
Var
   i: integer;
   SpotRect: TRect;                                 { Spot draw rectangle }
   SpotInc: integer;                       { increase value for next spot }

begin
   SpotInc := FSpotWidth + FSpotSpace;
   SpotRect.Top := 0;
   SpotRect.Bottom := FHeight;

   if (FDirection = dirNormal) then
   begin
      SpotRect.Left := FFirstSpace;
      SpotRect.Right := SpotRect.Left + FSpotWidth;             {Leerraum }
   end
   else
   begin
      SpotRect.Right := FWidth - FFirstSpace;
      SpotRect.Left := SpotRect.Right - FSpotWidth;
      SpotInc := -SpotInc;
   end;

   with DIB do
   begin
      DIB_SetTColor(FBar1Color);
      for i := 1 to nSpots do                  { draw the highlited spots }
      begin
         if i > FPoint2Spot then DIB_SetTColor(FBar3Color)
         else if i > FPoint1Spot then DIB_SetTColor(FBar2Color);
         DIB_FillRectDoted(SpotRect,FActiveDoted);
         OffsetRect(SpotRect, SpotInc, 0);
      end;
   end;
end;

{-- TMMLEDGauge ------------------------------------------------------}
procedure TMMLEDGauge.DrawBarVertical(DIB: TMMDIBCanvas; nSpots: integer);
Var
   i: integer;
   SpotRect: TRect;                                 { Spot draw rectangle }
   SpotInc: integer;                       { increase value for next spot }

begin
   SpotInc := FSpotWidth + FSpotSpace;
   SpotRect.Left := 0;
   SpotRect.Right := FWidth;

   with DIB do
   begin
      if (FDirection = dirNormal) then
      begin
         SpotRect.Bottom := FHeight - FFirstSpace;
         SpotRect.Top := SpotRect.Bottom - FSpotWidth;
         SpotInc := -SpotInc;
      end
      else
      begin
         SpotRect.Top := FFirstSpace;
         SpotRect.Bottom := SpotRect.Top + FSpotWidth;
      end;

      DIB_SetTColor(FBar1Color);
      for i := 1 to nSpots do                 { draw the highlited spots }
      begin
         if i > FPoint2Spot then DIB_SetTColor(FBar3Color)
         else if i > FPoint1Spot then DIB_SetTColor(FBar2Color);

         DIB_FillRectDoted(SpotRect,FActiveDoted);
         OffsetRect(SpotRect, 0, SpotInc);
      end;
   end;
end;

{-- TMMLEDGauge ------------------------------------------------------}
procedure TMMLEDGauge.SetBPP(aValue: integer);
begin
   if (aValue <> BitsPerPixel) then
   begin
      if (aValue <> 8) and (aValue <> 24) then
         raise EMMDIBError.Create('Bitlength not supported yet');

      FBarDIB.BitsPerPixel := aValue;
      DIBCanvas.BitsPerPixel := aValue;
      DrawInactiveSpots;
      Invalidate;
   end;
end;

{-- TMMLEDGauge ------------------------------------------------------}
procedure TMMLEDGauge.DrawInactiveSpots;
var
   _Bar1,_Bar2,_Bar3: TColor;
   _Active: Boolean;

begin
   if not (csLoading in ComponentState) and (FBarDIB <> nil) and not assigned(FOnDrawBar) then
   with FBarDIB do
   begin
      DIB_InitDrawing;

      DIB_SetTColor(Color);
      DIB_Clear;

      _Bar1 := FBar1Color;
      _Bar2 := FBar2Color;
      _Bar3 := FBar3Color;
      _Active := FActiveDoted;
      FBar1Color := FInact1Color;
      FBar2Color := FInact2Color;
      FBar3Color := FInact3Color;
      FActiveDoted := FInactiveDoted;
      case FKind of
         gkHorizontal: DrawBarHorizontal(FBarDIB,FNumSpots);
         gkVertical  : DrawBarVertical(FBarDIB,FNumSpots);
      end;
      FBar1Color := _Bar1;
      FBar2Color := _Bar2;
      FBar3Color := _Bar3;
      FActiveDoted := _Active;

      DIB_DoneDrawing;
   end;
end;

{-- TMMLEDGauge ------------------------------------------------------}
procedure TMMLEDGauge.SetOnDrawBar(aValue: TMMLEDDrawBar);
begin
   FOnDrawBar := aValue;
   if not assigned(FOnDrawBar) then DrawInactiveSpots;
   Invalidate;
end;

{-- TMMLEDGauge ------------------------------------------------------}
procedure TMMLEDGauge.DrawBar(Dummy: Boolean);
begin
   DIBCanvas.DIB_InitDrawing;

   if assigned(FOnDrawBar) then
   begin
      FOnDrawBar(Self,DIBCanvas,Rect(0,0,FWidth,FHeight),FData);
   end
   else
   begin                                         { draw the background }
      DIBCanvas.DIB_SetTColor(Color);
      DIBCanvas.DIB_Clear;

      DIBCanvas.DIB_CopyDIBBits(FBarDIB.Surface,0,0,FWidth,FHeight,0,0);

      case FKind of                           { draw the bar to bitmap }
          gkHorizontal: DrawBarHorizontal(DIBCanvas,FData);
          gkVertical  : DrawBarVertical(DIBCanvas,FData);
      end;
   end;

   DIBCanvas.DIB_BitBlt(Canvas.Handle,FClientRect,0,0); { copy to screen }

   DIBCanvas.DIB_DoneDrawing;
end;

{-- TMMLEDGauge ------------------------------------------------------}
Procedure TMMLEDGauge.Paint;
begin
   { draw the bevel }
   inherited Paint;
   DrawBar(True);
end;

end.