mmlevel.pas

一套及时通讯的原码

{-- TMMLevelScale -------------------------------------------------------}
procedure TMMLevelScale.SetKind(aValue: TMMLevelKind);
var
   Temp: integer;
begin
   if (aValue <> FKind) then
   begin
      FKind := aValue;
      if ((FKind = lkHorizontal) and (Height > Width)) or
         ((FKind = lkVertical) and (Height < Width)) then
      begin
         Temp := Width;
         Width := Height;                        { swap Width and Height }
         Height := Temp;
      end;
      Invalidate;
   end;
end;

{-- TMMLevelScale -------------------------------------------------------}
Procedure TMMLevelScale.SetDirection(aValue: TMMLevelDirection);
Begin
   if (aValue <> FDirection) then
   begin
      FDirection := aValue;
      Invalidate;
   end;
end;

(*
{-- TMMLevelScale -------------------------------------------------------}
procedure TMMLevelScale.Paint;
const
     FRange = $7FFF;
var
   i, Count,CurValue,Volume: Longint;
   dbValue: Float;
   R        : TRect;
   Rev      : Boolean;
   P1, P2   : Integer;

begin
   with Canvas do
   begin
      Brush.Color := Color;
      FillRect(ClientRect);
      Font := Self.Font;

      R := ClientRect;
      if Scale.Visible then
      begin
        InflateRect(R,-1,-2);
        Scale.Canvas := Canvas ;
        Rev := (Kind = lkVertical) xor (Direction = dirReversed);
        if Rev then
        begin
            Scale.Color  := Scale3Color;
            Scale.Color2 := Scale2Color;
            Scale.Color3 := Scale1Color;
            P1           := 100 - Point2;
            P2           := 100 - Point1;
        end
        else
        begin
            Scale.Color  := Scale1Color;
            Scale.Color2 := Scale2Color;
            Scale.Color3 := Scale3Color;
            P1           := Point1;
            P2           := Point2;
        end;

        Scale.Point1 := MulDiv(P1-1,Scale.TickCount,100);
        Scale.Point2 := MulDiv(P2-1,Scale.TickCount,100);
        if (ScalePos = spAboveOrLeft) or (ScalePos = spBoth) then
        begin
           if Kind = lkHorizontal then
           begin
              Scale.DrawRect(Canvas,Rect(R.Left,R.Top,R.Right-1,R.Top+Scale.ScaleHeight),True);
              Inc(R.Top,Scale.ScaleHeight);
           end
           else
           begin
              Scale.DrawRect(Canvas,Rect(R.Left,R.Top,R.Left+Scale.ScaleHeight,R.Bottom-1),True);
              Inc(R.Left,Scale.ScaleHeight);
           end;
        end;

        if (ScalePos = spBelowOrRight) or (ScalePos = spBoth) then
        begin
           if Kind = lkHorizontal then
           begin
              Scale.DrawRect(Canvas,Rect(R.Left,R.Bottom-Scale.ScaleHeight,R.Right-1,R.Bottom),False);
              Dec(R.Bottom,Scale.ScaleHeight)
           end
           else
           begin
              Scale.DrawRect(Canvas,Rect(R.Right-Scale.ScaleHeight,R.Top,R.Right,R.Bottom-1),False);
              Dec(R.Right,Scale.ScaleHeight);
           end;
        end;
      end;
      if (R.Top > R.Bottom) or (R.Left > R.Right) then Exit;

      { Draw the scale }
      if FScaleTicks > 1 then
      for i := 0 to FScaleTicks-1 do
      begin
         CurValue := MulDiv(FRange,i,FScaleTicks-1);
         if ((FKind = lkHorizontal) and (FDirection = dirReversed)) or
            ((FKind = lkVertical) and (FDirection = dirNormal)) then
            CurValue := FRange - CurValue;

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

         if FLogAmp then
         begin
            Count := i;
            if ((FKind = lkHorizontal) and (FDirection = dirNormal)) or
               ((FKind = lkVertical) and (FDirection = dirReversed)) then
                 Count := FScaleTicks-1-Count;

            Volume := Muldiv(Count,FSensitivy,FScaleTicks-1)
         end
         else
         begin
            Count := i;
            if ((FKind = lkHorizontal) and (FDirection = dirReversed)) or
               ((FKind = lkVertical) and (FDirection = dirNormal)) then
                 Count := FScaleTicks-1-Count;

            dbValue := FRange/pow(10,-FSensitivy/20);
            Volume := Round(Log10(((Long(Count)*(FRange-dbValue)/(FScaleTicks-1))+dbValue)/FRange)*20)
         end;

         if (FDirection = dirNormal) then
            Count := 0
         else
            Count := FSensitivy;

         if (FKind = lkHorizontal) then
            TextOut(MulDiv32(i,R.Right-R.Left-TextWidth(IntToStr(Count))-1,FScaleTicks-1),
                    R.Top + (R.Bottom-R.Top-TextHeight(IntToStr(Volume))) div 2,IntToStr(Volume))
         else
            TextOut(R.Left + (R.Right-R.Left-TextWidth(IntToStr(Volume))) div 2,
                    MulDiv32(i,R.Bottom-R.Top-TextHeight(IntToStr(Count))-1,FScaleTicks-1),
                    IntToStr(Volume));
      end;
   end;
end;
*)

{ TODO: Not perfect yet ! }
{-- TMMLevelScale -------------------------------------------------------}
procedure TMMLevelScale.Paint;
Label NextLoop;
const
   FRange = $7FFF;

var
   i, j, Pos, H2, W2, th, tw, tw2, Count, CurValue, Volume: Longint;
   dbValue  : Float;
   R        : TRect;
   Rev      : Boolean;
   P1, P2   : Integer;
   Skip     : Integer;
   incValue : Integer;
   Offset   : Integer;
   s        : string;

begin
   with Canvas do
   begin
      Brush.Color := Color;
      FillRect(ClientRect);
      Font := Self.Font;

      R := ClientRect;
      if (Kind = lkHorizontal) then
         Offset := TextWidth('0') div 2
      else
         Offset := TextHeight('0') div 2;

      if Scale.Visible then
      begin
        Scale.Canvas := Canvas;
        Rev := (Kind = lkVertical) xor (Direction = dirReversed);
        if Rev then
        begin
            Scale.Color  := Scale3Color;
            Scale.Color2 := Scale2Color;
            Scale.Color3 := Scale1Color;
            P1           := 100 - Point2;
            P2           := 100 - Point1;
        end
        else
        begin
            Scale.Color  := Scale1Color;
            Scale.Color2 := Scale2Color;
            Scale.Color3 := Scale3Color;
            P1           := Point1;
            P2           := Point2;
        end;

        Scale.Point1 := MulDiv(P1-1,Scale.TickCount,100);
        Scale.Point2 := MulDiv(P2-1,Scale.TickCount,100);
        if (ScalePos = spAboveOrLeft) or (ScalePos = spBoth) then
        begin
           if Kind = lkHorizontal then
           begin
              if Direction <> dirReversed then
                 Scale.DrawRect(Canvas,Rect(R.Left-Offset-1,R.Top,R.Right-Offset-1,R.Top+Scale.ScaleHeight),True)
              else
                 Scale.DrawRect(Canvas,Rect(R.Left+Offset,R.Top,R.Right+Offset-1,R.Top+Scale.ScaleHeight),True);
              Inc(R.Top,Scale.ScaleHeight);
           end
           else
           begin
              if Direction <> dirReversed then
                 Scale.DrawRect(Canvas,Rect(R.Left,R.Top+Offset,R.Left+Scale.ScaleHeight,R.Bottom+Offset-1),True)
              else
                 Scale.DrawRect(Canvas,Rect(R.Left,R.Top-Offset,R.Left+Scale.ScaleHeight,R.Bottom-Offset-1),True);
              Inc(R.Left,Scale.ScaleHeight);
           end;
        end;

        if (ScalePos = spBelowOrRight) or (ScalePos = spBoth) then
        begin
           if Kind = lkHorizontal then
           begin
              if Direction <> dirReversed then
                 Scale.DrawRect(Canvas,Rect(R.Left-Offset-1,R.Bottom-Scale.ScaleHeight,R.Right-Offset-1,R.Bottom),False)
              else
                 Scale.DrawRect(Canvas,Rect(R.Left+Offset,R.Bottom-Scale.ScaleHeight,R.Right+Offset-1,R.Bottom),False);

              Dec(R.Bottom,Scale.ScaleHeight)
           end
           else
           begin
              if Direction <> dirReversed then
                 Scale.DrawRect(Canvas,Rect(R.Right-Scale.ScaleHeight,R.Top+Offset,R.Right,R.Bottom+Offset-1),False)
              else
                 Scale.DrawRect(Canvas,Rect(R.Right-Scale.ScaleHeight,R.Top-Offset,R.Right,R.Bottom-Offset-1),False);
              Dec(R.Right,Scale.ScaleHeight);
           end;
        end;
      end;

      if (R.Top > R.Bottom) or (R.Left > R.Right) then Exit;

      th := TextHeight('W');
      tw := TextWidth(IntToStr(FSensitivy));
      tw2:= tw;

      { maybe we must skip some ticks ? }
      Skip := 1;
      if (FKind = lkHorizontal) then
      begin
         if (Direction = dirSymetric) then
            while (Width div 2) div (((FScaleTicks-1) div skip)*tw) < 1 do inc(Skip)
         else
            while Width div (((FScaleTicks-1) div skip)*tw) < 1 do inc(Skip);

         if (Direction <> dirReversed) then
            incValue := -1
         else
            incValue := 1;
      end
      else
      begin
         if (Direction = dirSymetric) then
             while (Height div 2) div (((FScaleTicks-1) div skip)*th) < 1 do inc(Skip)
         else
             while Height div (((FScaleTicks-1) div skip)*th) < 1 do inc(Skip);

         if (Direction <> dirReversed) then
            incValue := 1
         else
            incValue := -1;
      end;

      if (incValue = 1) then
         i := 0
      else
         i := FScaleTicks-1;

      H2 := (R.Bottom-R.Top) div 2;
      W2 := (R.Right-R.Left) div 2;

      { draw the scale }
      for j := 0 to FScaleTicks-1 do
      begin
         if ((j) mod Skip <> 0) then goto NextLoop;

         CurValue := MulDiv(FRange,i,FScaleTicks-1);
         if ((FKind = lkHorizontal) and (FDirection = dirReversed)) or
            ((FKind = lkVertical) and (FDirection <> dirReversed)) then
            CurValue := FRange - CurValue;

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

         if FLogAmp then
         begin
            Count := i;
            if ((FKind = lkHorizontal) and (FDirection <> dirReversed)) or
               ((FKind = lkVertical) and (FDirection = dirReversed)) then
                 Count := FScaleTicks-1-Count;

            Volume := Muldiv(Count,FSensitivy,FScaleTicks-1)
         end
         else
         begin
            Count := i;
            if ((FKind = lkHorizontal) and (FDirection = dirReversed)) or
               ((FKind = lkVertical) and (FDirection <> dirReversed)) then
                 Count := FScaleTicks-1-Count;

            dbValue := FRange/pow(10,-FSensitivy/20);
            Volume := Round(Log10(((Long(Count)*(FRange-dbValue)/(FScaleTicks-1))+dbValue)/FRange)*20)
         end;

         if (FKind = lkHorizontal) then
         begin
            s := IntToStr(Volume);
            tw := TextWidth(s);
            if (FDirection = dirSymetric) then
            begin
               Pos := MulDivRN(i,(R.Right-R.Left-1)div 2,FScaleTicks-1);
               if (Pos >= 0) and (W2-Pos+tw <= W2) then
               begin
                  TextOut(R.Left+Pos-(tw div 2),R.Top+(R.Bottom-R.Top-th)div 2,s);
                  if (i < FScaleTicks-1) then
                  begin
                     s := '+'+IntToStr(abs(Volume));
                     TextOut(R.Left+2*W2-Pos-1-(tw div 2),R.Top+(R.Bottom-R.Top-th)div 2,s);
                  end; 
               end;
            end
            else
            begin
               Pos := MulDivRN(i,R.Right-R.Left-1,FScaleTicks-1);
               if incValue = -1 then dec(Pos,tw);
               if (Pos >= 0) and (Pos+tw <= Width) then
                  TextOut(R.Left+Pos,R.Top+(R.Bottom-R.Top-th)div 2,s);
            end;
         end
         else
         begin
            s := IntToStr(Volume);
            tw := TextWidth(s);
            if (FDirection = dirSymetric) then
            begin
               Pos := MulDivRN(i,(R.Bottom-R.Top-1)div 2,FScaleTicks-1);
               if (Pos >= 0) and (Pos+th <= H2) then
               begin
                  TextOut(R.Right-(R.Right-R.Left)div 2 -(tw2 div 2)+(tw2-tw)-1,R.Top+H2+1+Pos-(th div 2),s);
                  if (i > 0) then
                  begin
                     s := '+'+IntToStr(abs(Volume));
                     TextOut(R.Right-(R.Right-R.Left)div 2 -(tw2 div 2)+(tw2-tw)-1,R.Top+H2+1-Pos-(th div 2),s);
                  end;
               end;
            end
            else
            begin
               Pos := MulDivRN(i,R.Bottom-R.Top-1,FScaleTicks-1);

               if incValue = -1 then dec(Pos,th);
               if (Pos >= 0) and (Pos+th <= Height) then
                   TextOut(R.Right-(R.Right-R.Left)div 2 -(tw2 div 2)+(tw2-tw)-1,R.Top+Pos,s);
            end;
         end;

NextLoop:
         i := i + incValue;
      end;
   end;
end;

end.