mmmeter.pas

一套及时通讯的原码

function TMMCustomMeter.GetDCOffset(Index: Integer): integer;
begin
   case Index of
      0: Result := -FDCOffsetL;
      1: Result := -FDCOffsetR;
    else Result := 0; 
   end;
end;

{-- TMMCustomMeter ------------------------------------------------------}
Procedure TMMCustomMeter.RefreshPCMData(PCMData: Pointer);
Var
   i: integer;
   ReIndex: integer;
   BestValue, Value, DCOffs: integer;

Begin
   if FEnabled AND Visible then
   begin
      BestValue := 0;
      ReIndex := Ord(FChannel)-1;
      if (FBits = b8bit) then
         if (FMode = mMono) then
         for i := 0 to FSamples-1 do
         begin
            Value := ABS((PByteArray(PCMData)^[i]+FDCOffsetL-128) shl 8);
            if (Value > BestValue) then BestValue := Value;
         end
         else if (FChannel = chBoth) then
         for i := 0 to FSamples-1 do
         begin
            Value := ABS(((Word(PByteArray(PCMData)^[i+i]+FDCOffsetL)+PByteArray(PCMData)^[i+i+1]+FDCOffsetR)div 2-128) shl 8);
            if (Value > BestValue) then BestValue := Value;
         end
         else
         begin
            if (FChannel = chLeft) then
                DCOffs := FDCOffsetL
            else
                DCOffs := FDCOffsetR;

            for i := 0 to FSamples-1 do
            begin
               Value := ABS((PByteArray(PCMData)^[i+i+ReIndex]+DCOffs-128) shl 8);
               if (Value > BestValue) then BestValue := Value;
            end;
         end
      else
         if (FMode = mMono) then
         for i := 0 to FSamples-1 do
         begin
            Value := ABS(PSmallArray(PCMData)^[i]+FDCOffsetL);
            if (Value > BestValue) then BestValue := Value;
         end
         else if (FChannel = chBoth) then
         for i := 0 to FSamples-1 do
         begin
            Value := ABS((Long(PSmallArray(PCMData)^[i+i]+FDCOffsetL)+PSmallArray(PCMData)^[i+i+1]+FDCOffsetR)div 2);
            if (Value > BestValue) then BestValue := Value;
         end
         else
         begin
            if (FChannel = chLeft) then
                DCOffs := FDCOffsetL
            else
                DCOffs := FDCOffsetR;

            for i := 0 to FSamples-1 do
            begin
               Value := ABS(PSmallArray(PCMData)^[i+i+ReIndex]+DCOffs);
               if (Value > BestValue) then BestValue := Value;
            end;
         end;

      if (BestValue >= FRange) then PcmOverflow;

      SetData(BestValue);
   end;
end;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.SetData(SampleValue: integer);
var
   dbValue: Float;

begin
   SampleValue := abs(SampleValue);

   FPeakValue := SampleValue;

   if (SampleValue = 0) and (FData = 0) and not FRefresh then exit;

   if (FDecayMode <> dmNone) then
   begin
      inc(FDecayPtr);
      inc(FDecayCntAct);
      if (FDecayPtr >= FDecayCount) then FDecayPtr := 0;
      if (FDecayCntAct > FDecayCount) then FDecayCntAct := FDecayCount;

      { In decay mode, need to average the value }
      case Ord(FDecayMode) of
        1: begin
              FLastVal_F := FLastVal_F * FDecayFactor;
              if (SampleValue >= FLastVal_F) then FLastVal_F := SampleValue
              else SampleValue := Trunc(FLastVal_F);
           end;
        2: begin
	      FLastVal_F := FLastVal_F*FDecayFactor+(1-FDecayFactor)*SampleValue;
	      SampleValue := Floor(FLastVal_F);
           end;
        3: begin
              FLastVal := FLastVal + (SampleValue-FDataBuf[FDecayPtr]);
              FDataBuf[FDecayPtr] := SampleValue;
              SampleValue := FLastVal div FDecayCntAct;
           end;
      end;
   end;

   if FLogAmp then
   begin
      { add the gain and calc the actual db value }
      dbValue := Log10(MaxR(MulDiv32(SampleValue,FGain,8)/FRange,0.00001))*20;
      { now the scaling }
      SampleValue := Max(Round((dbValue-FSensitivy)*FRange/-FSensitivy),0);
   end
   else
   begin
      { calc the low limit (Sensivity(db) to sample value }
      dbValue := FRange/pow(10,-FSensitivy/20);
      { now the scaling }
      SampleValue := Max(Round((MulDiv32(SampleValue,FGain,8)-dbValue)*FRange/(FRange-dbValue)),0);
   end;

   if (SampleValue >= FRange) then
   begin
      GainOverflow;
      SampleValue := FRange;
   end;

   if (SampleValue > FPeak) AND FShowPeak then
   begin
      FRefresh := True;
      FPeak := SampleValue;                         {start a new peak timer }
      FPeakCounter := 2*FPeakDelay+1;
   end;

   if (SampleValue <> FData) or FRefresh then
   begin
      FRefresh := False;
      FData := SampleValue;
      if FEnabled and Visible then
         FastDraw;
   end;
end;

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

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

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.CMTextChanged(var Message: TMessage);
begin
   Invalidate;
end;

{-- TMMCustomMeter ------------------------------------------------------}
function TMMCustomMeter.GetPalette: HPALETTE;
begin
   if not FBackBitmap.Empty then Result := FBackBitmap.Palette
   else Result := 0;
end;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.DrawText;
var
   aRect: TRect;
   FontHeight: Integer;
   Text: PChar;

begin
   with FOffBitmap.Canvas do
   begin
      if (Caption <> '') then
      begin
         Text := StrAlloc(Length(Caption)+1);
         try
            StrPCopy(Text, Caption);
            Brush.Style := bsClear;
            Font := Self.Font;
            FontHeight := TextHeight('W');
            with aRect do
            begin
               Left := 0;
               Right := FWidth;
               Bottom := FHeight - FHeight div 16;
               Top := Bottom - FontHeight;
            end;
{$IFDEF WIN32}
            Windows.DrawText(Handle, Text, StrLen(Text), aRect, (DT_EXPANDTABS or
                             DT_VCENTER or DT_CENTER));
{$ELSE}
            WinProcs.DrawText(Handle, Text, StrLen(Text), aRect, (DT_EXPANDTABS or
                              DT_VCENTER or DT_CENTER));
{$ENDIF}
         finally
            StrDispose(Text);
         end;
      end;
   end;
end;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.ComputeNeedleEnd(var pt: TPoint; Value, Radius: integer);
var
   Angle, StartAngle, EndAngle: Float;

begin
   StartAngle := M_Pi * (180 - FScaleAngle) / 360;
   EndAngle := M_Pi - StartAngle;
   Angle := StartAngle + (EndAngle-StartAngle) * Value / FRange;
   pt.X := FWidth div 2 - Round(Radius*Cos(Angle));
   pt.Y := FHeight + FNeedleOffSet - Round(Radius*Sin(Angle));
end;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.DrawBackGround;
var
   Radius, i: integer;
   ptStart,ptEnd: TPoint;
   CurValue: integer;
   Volume: integer;
   dbValue: Float;

begin
   with FOffBitmap.Canvas do
   begin
      if not FBackBitmap.Empty then
      begin
         StretchDraw(Rect(0,0,FWidth,FHeight), FBackBitmap);
      end
      else
      begin
         { clear background }
         Brush.Color := Color;
         FillRect(Rect(0,0,FWidth,FHeight));
      end;

      if FDrawScale then
      begin
         { Draw the scale }
         Radius := FHeight + FNeedleOffset - FTopSpace;
         Pen.Width := 1;
         Brush.Style := bsClear;
         Font.Name := 'Small Fonts';
         Font.Size := 6;
         Font.Color := Self.Font.Color;
         Font.Style := [];
         if FScaleTicks > 1 then
         for i := 0 to FScaleTicks-1 do
         begin
            CurValue := MulDiv32(FRange,i,FScaleTicks-1);

            if FScaleOrigin = soInner then
            begin
               if (FLargeTicks=0)or(i=FScaleTicks-1)or(i mod FLargeTicks=0) then
                   ComputeNeedleEnd(ptStart, CurValue, Radius-2)
               else
                   ComputeNeedleEnd(ptStart, CurValue, (Radius-2)-FScaleHeight2+FScaleHeight1);

               ComputeNeedleEnd(ptEnd, CurValue, (Radius-2)-FScaleHeight2);
            end
            else
            begin
               ComputeNeedleEnd(ptStart, CurValue, (Radius-2));

               if (FLargeTicks=0)or(i=FScaleTicks-1)or(i mod FLargeTicks=0) then
                   ComputeNeedleEnd(ptEnd, CurValue, (Radius-2)-FScaleHeight2)
               else
                   ComputeNeedleEnd(ptEnd, CurValue, (Radius-2)-FScaleHeight2+FScaleHeight1);
            end;

            if (CurValue > FPoint2*FRange/100) then Pen.Color := FScale3Color
            else if (CurValue > FPoint1*FRange/100) then Pen.Color := FScale2Color
            else Pen.Color := FScale1Color;

            MoveTo(ptStart.X, ptStart.Y);
            LineTo(ptEnd.X, ptEnd.Y);

            if (FTextTicks > 0) and (i mod FTextTicks=0) then
            begin
               ComputeNeedleEnd(ptEnd, CurValue, Radius-2);

               if FLogAmp then
               begin
                  Volume := Muldiv32(FScaleTicks-1-i,FSensitivy,FScaleTicks-1)
               end
               else
               begin
                  dbValue := FRange/pow(10,-FSensitivy/20);
                  Volume := Round(Log10(((i*(FRange-dbValue)/(FScaleTicks-1))+dbValue)/FRange)*20)
               end;

               TextOut(ptEnd.X-(TextWidth(IntToStr(Volume))-TextWidth(IntToStr(abs(Volume)))div 2)+1,
                       ptEnd.Y-TextHeight('0')-3,IntToStr(Volume));
            end;
         end;
      end;
   end;
end;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.DrawNeedle;
var
   ptEnd: TPoint;
   Radius : integer;

begin
   with FOffBitmap.Canvas do
   begin
      Radius := FHeight + FNeedleOffset - FTopSpace;
      if FShowPeak then
      begin
         { Compute the new peak needle position }
         ComputeNeedleEnd(ptEnd, FPeak, Radius);

         { Draw the peak needle }
         Pen.Color := FPeakColor;
         Pen.Width := FNeedleWidth;
         MoveTo(FWidth div 2, FHeight + FNeedleOffset);
         LineTo(ptEnd.X, ptEnd.Y);
      end;

      { Compute the new needle position }
      ComputeNeedleEnd(ptEnd, FData, Radius);

      { Draw the scale needle }
      Pen.Color := FNeedleColor;
      Pen.Width := FNeedleWidth;
      MoveTo(FWidth div 2, FHeight + FNeedleOffset);
      LineTo(ptEnd.X, ptEnd.Y);
   end;
end;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.DrawMeter(FastDraw: Boolean);
begin
   if not FastDraw then
   begin                           { Clear DIB background or draw bitmap }
      DrawBackGround;
                                                      { draw the caption }
      DrawText;
      FSaveBitmap.Canvas.Draw(0,0,FOffBitmap);         { save background }
   end
   else
   begin
      FOffBitmap.Canvas.Draw(0,0,FSaveBitmap);      { restore background }
   end;

   DrawNeedle;                                        { draw the needles }
                                                        { copy to screen }
   Canvas.CopyRect(BeveledRect,FOffBitmap.Canvas, Rect(0,0,FWidth,FHeight));

   if assigned(FOnPostPaint) then FOnPostPaint(Self);
end;

{-- TMMCustomMeter ------------------------------------------------------}
Procedure TMMCustomMeter.Paint;
begin
   { draw the bevel }
   Bevel.PaintBevel(Canvas,ClientRect,True);
   { and now the meter }
   DrawMeter(False);

   {$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;

{-- TMMCustomMeter ------------------------------------------------------}
procedure TMMCustomMeter.FastDraw;
var
  DC: HDC;
  Control: TWinControl;

begin
   {$IFDEF BUILD_ACTIVEX}
   Control := Self;
   {$ELSE}
   Control := Parent;
   {$ENDIF}

   if Visible and (Control <> nil) and Control.HandleAllocated then
   begin
      DC := GetDC(Control.Handle);
      try
        {$IFNDEF BUILD_ACTIVEX}
        if RectVisible(DC, Rect(Left, Top, Left + Width, Top + Height)) then
        begin
           MoveWindowOrg(DC, Left, Top);
           IntersectClipRect(DC, 0, 0, Width, Height);
        {$ELSE}
        if RectVisible(DC, Rect(0, 0, Width, Height)) then
        begin
        {$ENDIF}
           Canvas.Handle := DC;
           DrawMeter(True);
        end;

      finally
        Canvas.Handle := 0;
        ReleaseDC(Control.Handle, DC);
      end;
  end;
end;

end.