mmoscope.pas

一套及时通讯的原码

Procedure TMMOscope.SetChannel(aValue: TMMChannel);
begin
   if (aValue <> FChannel) then
   begin
      FChannel := aValue;
      SetBytesPerScope;
      Invalidate;
   end;
end;

{-- TMMOscope ------------------------------------------------------------}
Procedure TMMOscope.SetMode(aValue: TMMMode);
begin
   if (aValue <> FMode) then
   begin
      FMode := aValue;
      SetBytesPerScope;
      Invalidate;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK3}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.SetSampleRate(aValue: Longint);
begin
   if (aValue <> FSampleRate) then
   begin
      FSampleRate := MinMax(aValue, 8000, 88200);
      { Re-initialize the display }
      Invalidate;
   end;
end;

{-- TMMOscope ------------------------------------------------------------}
Procedure TMMOscope.SetGain(aValue: Integer);
begin
   if (aValue <> FGain-8) and (aValue >= -8) and (aValue <= 32) then
   begin
      FGain := aValue + 8;
      Invalidate;
   end;
end;

{-- TMMOscope ------------------------------------------------------------}
Function TMMOscope.GetGain: Integer;
begin
   Result := FGain - 8;
end;

{-- TMMOscope ------------------------------------------------------------}
Procedure TMMOscope.SetSteps(aValue: Integer);
begin
   aValue := MinMax(1, aValue, 9);
   if (aValue <> FSteps) then
   begin
      FSteps := aValue;
      Invalidate;
   end;
end;

{-- TMMOscope ------------------------------------------------------------}
Procedure TMMOscope.SetZoom(aValue: Integer);
begin
   if (aValue <> FZoom) and (aValue <> 0) then
   begin
      FZoom := MinMax(aValue,-9,9);
      SetBytesPerScope;
      Invalidate;
   end;
end;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.SetDrawAmpScale(aValue: Boolean);
begin
   if (aValue <> FDrawAmpScale) then
   begin
      FDrawAmpScale := aValue;
      AdjustBounds;
      Invalidate;
   end;
end;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.SetDrawTimeScale(aValue: Boolean);
begin
   if (aValue <> FDrawTimeScale) then
   begin
      FDrawTimeScale := aValue;
      AdjustBounds;
      Invalidate;
   end;
end;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.SetDrawGrid(aValue: Boolean);
begin
   if (aValue <> FDrawGrid) then
   begin
      FDrawGrid := aValue;
      Invalidate;
   end;
end;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.SetAccelerate(aValue: Boolean);
begin
   if (aValue <> FAccelerate) then
   begin
      FAccelerate := aValue;
      if not FAccelerate and FScroll then Invalidate;
   end;
end;

{-- TMMOscope ------------------------------------------------------------}
Procedure TMMOscope.SetScroll(aValue: Boolean);
begin
   if (aValue <> FScroll) then
   begin
      FScroll := aValue;
      Changed;
   end;
end;

{-- TMMOscope ------------------------------------------------------------}
Procedure TMMOscope.SetColors(Index: Integer; aValue: TColor);
begin
   case Index of
        0: if FForeColor = aValue then exit else FForeColor := aValue;
        1: if FInactColor = aValue then exit else FInactColor := aValue;
        2: if FEffectColor = aValue then exit else FEffectColor := aValue;
        3: if FOffColor = aValue then exit else FOffColor := aValue;
        4: if FScaleTextColor = aValue then exit else FScaleTextColor := aValue;
        5: if FScaleLineColor = aValue then exit else FScaleLineColor := aValue;
        6: if FGridColor = aValue then exit else FGridColor := aValue;
        7: if FBarColor = aValue then exit else FBarColor := aValue;
        8: if FBarTickColor = aValue then exit else FBarTickColor := aValue;
        9: if FScaleBackColor = aValue then exit else FScaleBackColor := aValue;
       10: if FSelectColor = aValue then exit else FSelectColor := aValue;
       11: if FSelectDotColor = aValue then exit else FSelectDotColor := aValue;
       12: if FLocatorColor = aValue then exit else FLocatorColor := aValue;
   end;
   Invalidate;
end;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.Marked(mkBegin, mkEnd: Integer; Redraw: Boolean);
begin
   if (mkBegin <> FMarkBegin) then
   begin
      if (mkBegin < 0) then mkBegin := -1;
      if (mkBegin > FWidth) then mkBegin := FWidth;
      FMarkBegin := mkBegin;
   end;

   if (mkEnd <> FMarkEnd) then
   begin
      if (mkEnd < 0) then mkEnd := -1;
      if (mkEnd > FWidth) then mkEnd := FWidth;
      FMarkEnd := mkEnd;
   end;

   if Redraw then Refresh;
end;

{-- TMMOscope -----------------------------------------------------------------}
procedure TMMOscope.Select(sStart, sEnd: Longint; Redraw: Boolean);
var
   oldStart,oldEnd: Longint;
begin
   oldStart:= FSelectStart;
   oldEnd := FSElectEnd;

   if (sStart <> FSelectStart) then
   begin
      if (sStart < 0) then sStart := -1;
      if (sStart > FWidth) then sStart := FWidth;
      FSelectStart := sStart;
   end;

   if (sEnd <> FSelectEnd) then
   begin
      if (sEnd < 0) then sEnd := -1;
      if (sEnd > FWidth) then sEnd := FWidth;
      FSelectEnd := sEnd;
   end;

   if (FSelectStart > FSelectEnd) then
   begin
      SwapLong(FSelectStart,FSelectEnd);
   end;

   if (FSelectEnd - FSelectStart <= 0) then
   begin
      FSelectStart := -1;
      FSelectEnd := -1;
   end;

   if Redraw and ((oldStart <> FSelectStart) or (oldEnd <> FSelectEnd)) then
      Refresh;
end;

{-- TMMOscope -----------------------------------------------------------------}
procedure TMMOscope.SetLocator(aValue: Longint);
var
   oldLoc: Longint;
begin
   oldLoc := FLocator;

   if (aValue <> FLocator) then
   begin
      if (aValue < 0) then aValue := -1;
      if (aValue > FWidth) then aValue := FWidth;
      FLocator := aValue;
   end;

   if (oldLoc <> FLocator) then
      Refresh;
end;

{-- TMMOscope ------------------------------------------------------------}
procedure TMMOscope.SetDrawMidLine(aValue: Boolean);
begin
   if (aValue <> FDrawMidLine) then
   begin
      FDrawMidLine := aValue;
      Invalidate;
   end;
end;

{-- TMMOscope ------------------------------------------------------------}
Procedure TMMOscope.RefreshPCMData(PCMData: Pointer);
Var
   i,j: integer;
   ReIndex: integer;
   rZoom: integer;
   wf: TPCMWaveFormat;
   MinL,MaxL,MinR,MaxR: SmallInt;

begin
   if FEnabled and Visible and not FShowInfoHint then
   begin
      if FScroll then
      begin
         i := 0;
         wf := GetPCMWaveFormat;
         pcmFindMinMax(@wf, PCMData, FBytes,
                       MinL,MaxL,MinR,MaxR);

         if (FBits = b8bit) then
         begin
            if (FMode = mMono) or (FChannel = chLeft) then
            begin
               FData^[i] := (MinL-128) shl 8;
               FData^[i+1] := (MaxL-128) shl 8;
            end
            else if (FChannel = chRight) then
            begin
               FData^[i] := (MinR-128) shl 8;
               FData^[i+1] := (MaxR-128) shl 8;
            end
            else
            begin
               FData^[i] := ((MinL + MinR) div 2 - 128) shl 8;
               FData^[i+1] := ((MaxL + MaxR) div 2 - 128) shl 8;
            end;
         end
         else
         begin
            if (FMode = mMono) or (FChannel = chLeft) then
            begin
               FData^[i] := MinL;
               FData^[i+1] := MaxL;
            end
            else if (FChannel = chRight) then
            begin
               FData^[i] := MinR;
               FData^[i+1] := MaxR;
            end
            else
            begin
               FData^[i] := (Longint(MinL)+MinR) div 2;
               FData^[i+1] := (Longint(MaxL)+MaxR) div 2;
            end;
         end;
      end
      else
      begin
         ReIndex := Ord(FChannel)-1;
         j := 0;
         rZoom := abs(FZoom);
         if FZoom > 0 then
         begin
            { copy the sample Data from PCMData to FData }
            if (FBits = b8bit) then
            begin
               if (FMode = mMono) then
               for i := 0 to FWidth-1 do
               begin
                  FData^[i] := (PByteArray(PCMData)^[j]-128) shl 8;
                  inc(j,rZoom);
               end
               else if (FChannel = chBoth) then
               for i := 0 to FWidth-1 do
               begin
                  FData^[i] := ((Word(PByteArray(PCMData)^[j+j])+PByteArray(PCMData)^[j+j+1])div 2 -128) shl 8;
                  inc(j,rZoom);
               end
               else
               for i := 0 to FWidth-1 do
               begin
                  FData^[i] := (PByteArray(PCMData)^[j+j+ReIndex]-128) shl 8;
                  inc(j,rZoom);
               end;
            end
            else
            begin
               if (FMode = mMono) then
               for i := 0 to FWidth-1 do
               begin
                  FData^[i] := PSmallArray(PCMData)^[j];
                  inc(j,rZoom);
               end
               else if (FChannel = chBoth) then
               for i := 0 to FWidth-1 do
               begin
                  FData^[i] := (Long(PSmallArray(PCMData)^[j+j])+PSmallArray(PCMData)^[j+j+1])div 2;
                  inc(j,rZoom);
               end
               else
               for i := 0 to FWidth-1 do
               begin
                  FData^[i] := PSmallArray(PCMData)^[j+j+ReIndex];
                  inc(j,rZoom);
               end;
            end;
         end
         else
         begin
            inc(rZoom);
            { copy the sample Data from PCMData to FData }
            if (FBits = b8bit) then
            begin
               if (FMode = mMono) then
               for i := 0 to FWidth-1 do
               begin
                  FData^[i] := (PByteArray(PCMData)^[j]-128) shl 8;
                  if ((i+1) mod rZoom = 0) then inc(j);
               end
               else if (FChannel = chBoth) then
               for i := 0 to FWidth-1 do
               begin
                  FData^[i] := ((Word(PByteArray(PCMData)^[j+j])+PByteArray(PCMData)^[j+j+1])div 2 -128) shl 8;
                  if ((i+1) mod rZoom = 0) then inc(j);
               end
               else
               for i := 0 to FWidth-1 do
               begin
                  FData^[i] := (PByteArray(PCMData)^[j+j+ReIndex]-128) shl 8;
                  if ((i+1) mod rZoom = 0) then inc(j);
               end;
            end
            else
            begin
               if (FMode = mMono) then
               for i := 0 to FWidth-1 do
               begin
                  FData^[i] := PSmallArray(PCMData)^[j];
                  if ((i+1) mod rZoom = 0) then inc(j);
               end
               else if (FChannel = chBoth) then
               for i := 0 to FWidth-1 do
               begin
                  FData^[i] := (Long(PSmallArray(PCMData)^[j+j])+PSmallArray(PCMData)^[j+j+1])div 2;