mmoscope.pas

一套及时通讯的原码

   FEffectColor := clRed;
   FScaleTextColor := clBlack;
   FScaleLineColor:= clBlack;
   FGridColor := clGray;
   FScaleBackColor:= clBtnFace;
   FSelectColor := clRed;
   FSelectDotColor := clRed;
   FLocatorColor := clYellow;
   FBits := b8Bit;
   FChannel   := chBoth;
   FMode := mMono;
   FSampleRate := 11025;
   FSteps := 1;
   FZoom := 1;
   FGain := 8;                                    { no Gain = 8 div 8 = 1 }
   FEffect := efNone;
   FKind := okDots;
   FDrawMidLine := False;
   FDrawAmpScale := False;
   FDrawTimeScale := False;
   FDrawGrid := False;
   FBarWidth := 5;
   FBarColor := clGray;
   FBarTickColor := clWhite;
   Fx1 := -FBarWidth;
   Fx2 := 0;
   FNeedReset := False;
   FAccelerate := True;
   FShowInfoHint := False;
   FShowInfo := True;
   FScroll := False;
   FFTLen := 8;
   FLowPass := False;
   FDrawing := False;
   FLocked := False;
   FUseSelection := False;

   Height := 90;
   Width := 194;
   Cursor := crCross;
   FFTLength := 128;

   if not (csDesigning in ComponentState) then
   begin
      { update the oscope list }
      AddOscope(Self);
   end;
end;

{-- TMMOscope ------------------------------------------------------------}
Destructor TMMOscope.Destroy;
begin
   if not (csDesigning in ComponentState) then
   begin
      { update the oscope list }
      RemoveOscope(Self);
   end;

   FreeDataBuffers;

   inherited Destroy;
end;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.ChangeDesigning(aValue: Boolean);
begin
   inherited ChangeDesigning(aValue);

   if not (csDesigning in ComponentState) then
   begin
      { update the oscope list }
      AddOscope(Self);
      InitializeData;
   end;
end;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.CreateDataBuffers(Length: Cardinal);
begin
   if (Length > 0) then
   begin
      { allocate memory for sample buffer and lock }
      GlobalReAllocMem(Pointer(FData), (Length+4*10) * sizeOf(SmallInt));
   end;
end;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.FreeDataBuffers;
begin
   GlobalFreeMem(Pointer(FData));
end;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.GainOverflow;
begin
   if Assigned(FOnGainOverflow) then FOnGainOverflow(Self);
end;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.PcmOverflow;
begin
   if Assigned(FOnPcmOverflow) then FOnPcmOverflow(Self);
end;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.InitializeData;
Var
   i: integer;
   scale: real;

begin
   scale := 1.0;

   if (csDesigning in ComponentState) then
   for i := 0 to FWidth-1 do                           { create sine data }
   begin
      FData^[i] := Round(sin(i*2*PI/((FWidth-1)/8))*scale*$77FF);
      scale := scale - (1.0/FWidth);
   end
   else                                                { create zero data }
   for i := 0 to FWidth-1 do FData^[i] := 0;

   FMarkBegin   := 0;                     { reset the marker positions }
   FMarkEnd     := FWidth;
   FSelectStart := -1;
   FSelectEnd   := -1;
   FLocator     := -1;
end;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.ResetData;
var
   P: TPoint;
begin
   if FShowInfoHint then
   begin
      GetCursorPos(P);
      P := ScreenToClient(P);
      Perform(WM_LBUTTONUP, 0, Longint(PointToSmallPoint(P)));
   end;

   { TODO: f黵 Scroll display }
   InitializeData;
   Refresh;
end;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.SetEnabled(Value: Boolean);
begin
   if (Value <> FEnabled) then
   begin
      FEnabled := Value;
      {inherited Enabled := Value;}
      Invalidate;
   end;
end;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.SetBarWidth(aValue: integer);
begin
   if (aValue <> FBarWidth) then
   begin
      FBarWidth := Max(aValue,1);
      Invalidate;
   end;
end;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.SetFFTLen(aLength: integer);
var
   i: integer;

begin
   { FFTLen is here only a dummy to sync. the scrolling with other controls }
   aLength := MinMax(aLength,1,MAX_FFTLEN);
   { Convert FFTLen to a power of 2 }
   i := 0;
   while aLength > 1 do
   begin
      aLength := aLength shr 1;
      inc(i);
   end;
   if (i > 0) then aLength := aLength shl i;

   if (aLength <> FFTLen) then
   begin
      FFTLen := aLength;
      if FScroll then
      begin
         SetBytesPerScope;
         Invalidate;
      end;
   end;
end;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.SetKind(aValue: TMMOscopeKind);
begin
   if (aValue <> FKind) then
   begin
      FKind := aValue;
      if (FKind = okSpikes) then
      begin
         FRange := $7FFF;
         FCenter := 0;
      end
      else
      begin
         FRange := $FFFF;
         FCenter := $7FFF;
      end;
     Invalidate;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.SetEffectLimits;
begin
   case FEffect of
       efPeak : begin
                   FEffectTop := FHeight div EFFECTLIMIT;
                   FEffectBottom := FHeight - FEffectTop;
                end;
       efSplit: begin
                   FEffectTop := 0;
                   FEffectBottom := FMiddle;
                end;
   end;
end;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.SetEffect(aValue: TMMOscopeEffect);
begin
   FEffect := aValue;
   SetEffectLimits;
   Invalidate;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK2}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.AdjustSize(var W, H: Integer);
begin
   W := Max(W,2*BevelExtend+2);
   H := Max(H,2*BevelExtend+2) ;{and $FFFE;}

   if FDrawAmpScale then
      W := Max(W,2*SCALEWIDTH+2*BevelExtend+2);

   if FDrawTimeScale then
      H := Max(H,SCALEHEIGHT+2*BevelExtend+2); {and $FFFE};
end;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.AdjustBounds;
var
  W, H: Integer;

begin
   W := Width;
   H := Height;
   AdjustSize(W, H);
   if (W <> Width) or (H <> Height) then SetBounds(Left, Top, W, H)
   else Changed;
end;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.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;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.Changed;
begin
   FClientRect := Rect(0,0,Width,Height);

   { make place for amp the scale }
   if FDrawAmpScale then
      InflateRect(FClientRect, -SCALEWIDTH,0);

   { make place for amp the scale }
   if FDrawTimeScale then
      dec(FClientRect.Bottom, SCALEHEIGHT);

   { and now for the bevel }
   InflateRect(FClientRect, -Bevel.BevelExtend, -Bevel.BevelExtend);

   FWidth  := Max(FClientRect.Right - FClientRect.Left,4);
   FHeight := Max(FClientRect.Bottom - FClientRect.Top,4);
   FMiddle := FHeight div 2;
                                            { adjust the data buffer size }
   CreateDataBuffers(FWidth);
   InitializeData;                                 { init the data buffer }

   DIBCanvas.SetBounds(0,0,FWidth,FHeight);
   SetEffectLimits;
   SetBytesPerScope;                       { calc the new bytes per Scope }

   FMarkBegin   := 0;                      { reset the marker positions }
   FMarkEnd     := FWidth;

   FSelectStart := -1;
   FSelectEnd   := -1;
   FLocator     := -1;

   CalcScaleSteps;

   inherited Changed;
end;

{-- TMMOscope ------------------------------------------------------------}
Procedure TMMOscope.SetBytesPerScope;
begin
   FBytes := (Ord(FBits)+1) * (Ord(FMode)+1);

   if FScroll then FBytes := FBytes  * FFTLen
   else
   begin
      FBytes := FBytes * FWidth;
      if (FZoom > 0) then FBytes := FBytes * FZoom
      else if (FZoom < 0) then FBytes := ((FBytes div (abs(FZoom)+1)+5)div 4)*4;
   end;
end;

{-- TMMOscope ------------------------------------------------------------}
Procedure TMMOscope.SetPCMWaveFormat(wf: TPCMWaveFormat);
var
   pwfx: PWaveFormatEx;

begin
   pwfx := @wf;
   if not pcmIsValidFormat(pwfx) then
      raise EMMOscopeError.Create(LoadResStr(IDS_INVALIDFORMAT));

   SampleRate := pwfx^.nSamplesPerSec;
   BitLength := TMMBits(pwfx^.wBitsPerSample div 8 - 1);
   Mode := TMMMode(pwfx^.nChannels-1);
end;

{-- TMMOscope ------------------------------------------------------------}
function TMMOscope.GetPCMWaveFormat: TPCMWaveFormat;
var
   wfx: TWaveFormatEx;
begin
   pcmBuildWaveHeader(@wfx, (Ord(FBits)+1)*8, Ord(FMode)+1, SampleRate);
   Result := PPCMWaveFormat(@wfx)^;
end;

{-- TMMOscope ------------------------------------------------------------}
Procedure TMMOscope.SetBits(aValue: TMMBits);
begin
   if (aValue <> FBits) then
   begin
      FBits := aValue;
      SetBytesPerScope;
      Invalidate;
   end;
end;

{-- TMMOscope ------------------------------------------------------------}