mmlevel.pas

一套及时通讯的原码

      FRefresh := False;

      FData := SampleValue;

      if FEnabled and Visible then
         FastDraw(DrawLevel,False);
   end;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.SetValue(aValue: integer);
begin
   SetData(Round(MinMax(aValue,0,VALUERANGE)*FRange/VALUERANGE));
end;

{-- TMMCustomLevel ------------------------------------------------------}
function TMMCustomLevel.GetValue: integer;
begin
   if FData = 0 then
      Result := 0
   else if not FLogAmp then
      Result := Round(FData * VALUERANGE / FNumSpots)
   else
      Result := Round(pow(10,(FSensitivy-FSensitivy*FData/FNumspots)/20)
                          * 8 / FGain * VALUERANGE);
end;

{-- TMMCustomLevel ------------------------------------------------------}
function TMMCustomLevel.GetPeak: integer;
begin
   if FPeak = 0 then
      Result := 0
   else if not FLogAmp then
      Result := Round(FPeak * VALUERANGE / FNumSpots)
   else
      Result := Round(pow(10,(FSensitivy-FSensitivy*FPeak/FNumspots)/20)
                          * 8 / FGain * VALUERANGE);
end;

{-- TMMCustomLevel ------------------------------------------------------}
function TMMCustomLevel.GetPeakValue: integer;
begin
  Result := (GetPeak * FRange) div VALUERANGE;
end;

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

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.DrawLevelHorizontal(DIB: TMMDIBCanvas; nSpots, Peak: integer; DrawAll: Boolean);
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
      if not DrawAll and (Direction = dirSymetric) then
      begin
         if (nSpots > FNumSpots) then nSpots := FNumSpots
         else if (nSpots < 1) then nSpots := 1;

         OffsetRect(SpotRect, (nSpots-1-SYNCBARS)*SpotInc, 0);

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

            DIB_FillRectDoted(SpotRect,FActiveDoted);
            OffsetRect(SpotRect, SpotInc, 0);
         end;
      end
      else
      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;

      if (FNumPeaks > 0) and (Peak > nSpots) then
      begin
         OffsetRect(SpotRect, ((Peak-1)-nSpots)*SpotInc, 0);

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

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.DrawLevelVertical(DIB: TMMDIBCanvas; nSpots, Peak: integer; DrawAll: Boolean);
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;

      if not DrawAll and (Direction = dirSymetric) then
      begin
         if (nSpots > FNumSpots) then nSpots := FNumSpots
         else if (nSpots < 1) then nSpots := 1;

         OffsetRect(SpotRect, 0, (nSpots-1-SYNCBARS)*SpotInc);

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

            DIB_FillRectDoted(SpotRect,FActiveDoted);
            OffsetRect(SpotRect, 0, SpotInc);
         end;
      end
      else
      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, 0, SpotInc);
         end;
      end;

      if (FNumPeaks > 0) and (Peak > nSpots) then
      begin
         OffsetRect(SpotRect, 0, ((Peak-1)-nSpots) * SpotInc);

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

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.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
         lkHorizontal: DrawLevelHorizontal(FBarDIB,FNumSpots,0,True);
         lkVertical  : DrawLevelVertical(FBarDIB,FNumSpots,0,True);
      end;
      FBar1Color := _Bar1;
      FBar2Color := _Bar2;
      FBar3Color := _Bar3;
      FActiveDoted := _Active;

      DIB_DoneDrawing;
   end;
end;

{-- TMMCustomLevel ------------------------------------------------------}
procedure TMMCustomLevel.DrawLevel(Dummy: Boolean);
begin
   if assigned(FOnPaint) then FOnPaint(Self);

   DIBCanvas.DIB_InitDrawing;
                                                   { draw the background }
   if assigned(FOnDrawBar) then
   begin
      FOnDrawBar(Self,DIBCanvas,Rect(0,0,FWidth,FHeight),FData,FPeak);
   end
   else
   begin
      DIBCanvas.DIB_CopyDIBBits(FBarDIB.Surface,0,0,FWidth,FHeight,0,0);

      if FEnabled then
      begin
         case FKind of                           { draw the level to bitmap }
           lkHorizontal: DrawLevelHorizontal(DIBCanvas,FData,FPeak,False);
           lkVertical  : DrawLevelVertical(DIBCanvas,FData,FPeak,False);
         end;
      end;
   end;

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

   DIBCanvas.DIB_DoneDrawing;
end;

{-- TMMCustomLevel ------------------------------------------------------}
Procedure TMMCustomLevel.Paint;
begin
   { draw the bevel }
   inherited Paint;
   DrawLevel(True);

   {$IFDEF BUILD_ACTIVEX}
   if Selected then
   begin
      Canvas.Brush.Style := bsClear;
      Canvas.Pen.Color   := clRed;
      Canvas.Rectangle(0,0,Width,Height);
      Canvas.Brush.Style := bsSolid;
   end;
   {$ENDIF}
end;

{== TMMLevelScale =======================================================}
constructor TMMLevelScale.Create(aOwner: TComponent);
begin
   inherited create(aOwner);

   FSensitivy := -35;
   FLogAmp := True;
   FScaleTicks := 8;
   FPoint1 := 50;
   FPoint2 := 85;
   FScale1Color := clWhite;
   FScale2Color := clWhite;
   FScale3Color := clRed;
   ParentFont := False;
   Font.Name := 'Small Fonts';
   Font.Size := 6;
   Color := clBlack;
   Width := 200;
   Height := 7;
   FScalePos := spBoth;
   FScale := TMMLevScale.Create;
   FScale.Visible := False;
   FScale.OnChange := ScaleChanged;
end;

{-- TMMLevelScale -------------------------------------------------------}
destructor TMMLevelScale.Destroy;
begin
   FScale.Free;

   inherited Destroy;
end;

{-- TMMLevelScale -------------------------------------------------------}
procedure TMMLevelScale.SetScalePos(Value: TMMScalePos);
begin
    if Value <> FScalePos then
    begin
       FScalePos := Value;
       Invalidate;
    end;
end;

{-- TMMLevelScale -------------------------------------------------------}
procedure TMMLevelScale.SetScale(Value: TMMLevScale);
begin
   FScale.Assign(Value);
end;

{-- TMMLevelScale -------------------------------------------------------}
procedure TMMLevelScale.ScaleChanged(Sender: TObject);
begin
   Invalidate;
end;

{-- TMMLevelScale -------------------------------------------------------}
procedure TMMLevelScale.SetSensitivy(aValue: integer);
begin
   aValue := MinMax(aValue, -90, -9);
   if (aValue <> FSensitivy) then
   begin
      FSensitivy := aValue;
      Invalidate;
   end;
end;

{-- TMMLevelScale -------------------------------------------------------}
procedure TMMLevelScale.SetLogAmp(aValue: Boolean);
begin
   if (aValue <> FLogAmp) then
   begin
      FLogAmp := aValue;
      Invalidate;
   end;
end;

{-- TMMLevelScale -------------------------------------------------------}
procedure TMMLevelScale.SetScaleTicks(aValue: integer);
begin
   if (aValue <> FScaleTicks) then
   begin
      FScaleTicks := Max(aValue,2);
      Invalidate;
   end;
end;

{-- TMMLevelScale -------------------------------------------------------}
procedure TMMLevelScale.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;
   Invalidate;
end;

{-- TMMLevelScale -------------------------------------------------------}
procedure TMMLevelScale.SetColors(Index:Integer; aValue: TColor);
begin
   case Index of
      0: if FScale1Color = aValue then exit else FScale1Color := aValue;
      1: if FScale2Color = aValue then exit else FScale2Color := aValue;
      2: if FScale3Color = aValue then exit else FScale3Color := aValue;
   end;
   Invalidate;
end;