sgr_scale.pas

图形控件,画实时曲线,等操作方便

  begin
   if (fFlags and sdfVertical)=0 then
    for j:=0 to rTksCount-1 do fTksPos[j]:=fOPos+round(fLen*fTksDbl[j])
   else
    for j:=0 to rTksCount-1 do fTksPos[j]:=fOPos-round(fLen*fTksDbl[j])
  end;
begin               
 if fTicksCount<1 then begin rTksCount:=fTicksCount; Exit end;
 if (fFlags and (sdfNoTicksLabel or sdfNotAjustedTicks))=0 then LbldTicks
 else NoLbldTicks;
end;                
procedure Tsp_Scale.ShiftScaleBy(pixel:boolean; idelta:double; fdelta:double);
  procedure ShiftMinMax(delta:double);
  begin
   fMin:=fMin+delta;
   fMax:=fMin+fInterval;
   if (fFlags and sdfInversed)=0 then fOVal:=fMin else fOVal:=fMax;
   IMin:=Ceil(fMin*IntFactor);
   IMax:=Floor(fMax*IntFactor);
  end;
  procedure SLbldTicksVal(delta:double);                     
  var id:extended; j:integer;
  begin
    id:=Frac((fTksDbl[0]*IntFactor-fOVal*IntFactor)/IStep);
    if ((fFlags and sdfInversed)=0) then
    begin
      if id<0 then id:=id+1;
      id:=fOVal*IntFactor+id*IStep;
      rTksCount:=Trunc((fMax*IntFactor-id)/IStep)+1;
      if rTksCount>MaxTicksCount then rTksCount:=MaxTicksCount;
      for j:=0 to rTksCount do fTksDbl[j]:=(id+IStep*j)/IntFactor;
    end else begin
      if id>0 then id:=id-1;
      id:=fOVal*IntFactor+id*IStep;
      rTksCount:=Trunc((id-fMin*IntFactor)/IStep)+1;
      if rTksCount>MaxTicksCount then rTksCount:=MaxTicksCount;
      for j:=0 to rTksCount do fTksDbl[j]:=(id-IStep*j)/IntFactor;
    end
  end;
  procedure STicksVal(delta:double);                         
  var id,step:double; j:integer;
  begin
    if fTicksCount>1 then step:=1/(fTicksCount-1) else step:=1;
    if (fFlags and sdfVertical)<>0 then delta:=-delta;
    id:=Frac((fTksDbl[0]*fLen-delta)/(fLen*step));
    if id<0 then id:=id+1;
    rTksCount:=Trunc(1/step-id)+1;
    id:=id*step;
    if rTksCount>MaxTicksCount then rTksCount:=MaxTicksCount;
    for j:=0 to rTksCount-1 do fTksDbl[j]:=id+step*j;
  end;
begin               
 if pixel then fdelta:=idelta/fM else idelta:=fdelta*fM;
 if fdelta=0 then Exit;
 ShiftMinMax(fdelta);
 if abs(fdelta)>fInterval then  CalcTicksVal
 else begin
    if (fFlags and (sdfNoTicksLabel or sdfNotAjustedTicks))=0 then SLbldTicksVal(fdelta)
    else STicksVal(idelta);
 end;
 CalcTicksPos;
end;               
function Tsp_Scale.TickLabel(tickNum: integer): string;
begin
 if ((fFlags and sdfLabelAsDate)<>0) then
  Result:=FormatDateTime(fLabelFormat, TksDbl(tickNum))
 else
  Result:=FormatFloat(fLabelFormat, TksDbl(tickNum));
end;
function Tsp_Scale.GetTicksCount:byte;
begin
 Result:=rTksCount;
end;
procedure Tsp_Scale.SetFlagBit(const BN:integer; const On:boolean);
var Mask:integer;
begin
 Mask:=1 shl BN;
 if On then
 begin
  if ((fFlags and Mask)=0) then begin
    fFlags:=fFlags or Mask;
    FlagsChanged(BN, On);
  end;
 end else
 if ((fFlags and Mask)<>0) then begin
   fFlags:=fFlags and Not Mask;
   FlagsChanged(BN, On);
 end
end;
procedure Tsp_Scale.ReSetFlagBit(const BN:integer; const Off:boolean);
begin
 SetFlagBit(BN,Not(Off));
end;
function  Tsp_Scale.NotFlagBit(const BN:integer):boolean;
begin
 Result:=(fFlags and (1 shl BN))=0;
end;
function Tsp_Scale.GetFlagBit(const BN:integer):boolean;
begin
 Result:=(fFlags and (1 shl BN))<>0;
end;
procedure Tsp_Scale.FlagsChanged(const BN:integer; const On:boolean);
begin
end;
constructor Tsp_Scale.Create(Flags:integer);
begin
 inherited Create;
 fLineAttr:=Tsp_LineAttr.Create;
 fTicksCount:=5;
 fFlags:=Flags;
 fLabelFormat:='###0.##';
 fO.x:=10; fO.y:=30; fLen:=25;
 ChangeMinMax(dblDfltAxisMin, dblDfltAxisMax);
end;
destructor Tsp_Scale.Destroy;
begin
 if Assigned(fLineAttr) then fLineAttr.Free;
 inherited Destroy;
end;
procedure Tsp_Scale.SetLine(oX, oY, lLen:integer);
begin
 if (fO.x<>oX) or (fO.y<>oY) or (lLen<>fLen) then
 begin
  fO.x:=oX; fO.y:=oY;
  if lLen=0 then inc(lLen) else if lLen<0 then lLen:=-lLen;
  fLen:=lLen;
  CalcMetr;
  CalcTicksPos;
 end;
end;
procedure Tsp_Scale.ChangeMinMax(aMin,aMax:double);
begin
  FixMinMax(aMin, aMax);
  CalcMetr;
  CalcTicksVal;
  CalcTicksPos;
end;
procedure Tsp_Scale.ScrollBy(delta:integer);
begin
 ShiftScaleBy(True, delta, 0);
end;
function Tsp_Scale.V2P(const V:double):integer;                                     
var rr:double;
begin
 rr:=fOPos+(fM*(V-fOVal));
 if rr>16383 then Result:=16383
 else if rr<-16383 then Result:=-16383
      else Result:=round(rr);
end;
function Tsp_Scale.P2V(const V:integer):double;                                     
begin
 Result:=fOVal+(V-fOPos)/fM;
end;
Const
 TickOfs=0;                                    
 MnTick=1;                                    
 MjTick=4;                                     
 LblOfs=1;
function Tsp_Scale.BandWidth(FntWidth, FntHeight:integer):integer;
var j, tw:integer;
begin
 Result:=fLineAttr.Width;
 if (FFlags and sdfVertical)=0 then
 begin                                          
   if (rTksCount>0) then begin
     if ((FFlags and sdfNoTicksLabel)=0) then
       inc(Result, TickOfs+MjTick+LblOfs+FntHeight)
     else if (FFlags and sdfNoTicks)=0 then inc(Result, TickOfs+MjTick);
   end;              
 end else
 begin                                        
   Result:=fLineAttr.Width;
   if (rTksCount>0) then begin
     if ((FFlags and sdfNoTicksLabel)=0) then
     begin
      tw:=Length(TickLabel(0));
      for j:=1 to rTksCount-1 do                                     
         if tw < Length(TickLabel(j)) then
            tw:=Length(TickLabel(j));
      inc(Result, TickOfs+MjTick+LblOfs+tw*FntWidth);
     end
     else if (FFlags and sdfNoTicks)=0 then inc(Result, TickOfs+MjTick);
   end;              
 end;
end;            
function Tsp_Scale.OrgIndent(FntWidth, FntHeight:integer):integer;
var tp:integer;
begin
 if (rTksCount>0) and ((FFlags and sdfNoTicksLabel)=0) then
 begin
   tp:=abs(round((fOVal-TksDbl(0))*fM));                     
   if (FFlags and sdfVertical)=0 then
     Result:=FntWidth*Length(TickLabel(0)) div 2-tp
   else Result:=FntHeight div 2-tp;
   if Result<0 then Result:=0;
 end else Result:=0;
end;
function Tsp_Scale.EndIndent(FntWidth, FntHeight:integer):integer;
var tp:integer;
begin
 if (rTksCount>0) and ((FFlags and sdfNoTicksLabel)=0) then
 begin
   if (fFlags and sdfInversed)=0
   then tp:=abs(round((fMax-TksDbl(rTksCount-1))*fM))                      
   else tp:=abs(round((fMin-TksDbl(rTksCount-1))*fM));
   if (FFlags and sdfVertical)=0 then
     Result:=FntWidth*Length(TickLabel(rTksCount-1)) div 2 - tp
   else
     Result:=FntHeight div 2-tp;
   if Result<0 then Result:=0;
 end else Result:=0;
end;
function Tsp_Scale.CalcDrawBounds(fCanvas:TCanvas):TRect;
var j, ti:integer;
begin
 with Result do with fCanvas do
 begin
  if (FFlags and sdfVertical)=0 then
  begin                                          
    ti:=fLineAttr.Width;
    if (rTksCount>0) and ((FFlags and sdfNoTicksLabel)=0) then
    begin
      inc(ti, TickOfs+MjTick+LblOfs+TextHeight('8'));
      Left:=fTksPos[0]-TextWidth(TickLabel(0)) div 2;
      Right:=fTksPos[rTksCount-1]+TextWidth(TickLabel(rTksCount-1)) div 2;
    end
    else if (FFlags and sdfNoTicks)=0 then inc(ti, TickOfs+MjTick);
    if (FFlags and sdfLabelAtTop)=0 then Top:=fO.y else Top:=fO.y-ti+1;
    Bottom:=Top+ti;
    if Left>fO.x then Left:=fO.x;
    if Right<fO.x+fLen then Right:=fO.x+fLen+1;
  end else
  begin                                               
    ti:=fLineAttr.Width;
    if (rTksCount>0) and ((FFlags and sdfNoTicksLabel)=0) then
    begin
      ti:=TextWidth(TickLabel(0));
      for j:=1 to rTksCount-1 do                                     
         if ti< TextWidth(TickLabel(j)) then
            ti:=TextWidth(TickLabel(j));
      inc(ti, TickOfs+MjTick+LblOfs);
      Top:=fTksPos[rTksCount-1]-TextHeight('8')div 2;
      Bottom:=fTksPos[0]+TextHeight('8')div 2;
    end
    else if (FFlags and sdfNoTicks)=0 then inc(ti, TickOfs+MjTick);
    if (FFlags and sdfLabelOnRight)=0 then Left:=fO.x-ti+1 else Left:=fO.x;
    Right:=Left+ti;
    if Top>(fO.y-fLen) then Top:=fO.y-fLen;
    if Bottom<fO.y then Bottom:=fO.y+1;
  end;
 end;
end;                 
procedure Tsp_Scale.DrawLine;                  
var j,st, w,b,e: integer;
begin
 with fLineAttr do if Visible then with fCanvas do
 begin
  Pen.Color:=fLineAttr.Color;
  Pen.Style:=Style;
  Pen.Width:=1;
  Pen.Mode:=pmCopy;
  if (fFlags and sdfRevertTicks)=0 then st:=1 else st:=-1;
  if (FFlags and sdfVertical)=0 then
   begin
     w:=fO.y;
     b:=fO.x-odec; e:=fO.x+fLen+1+einc;
     for j:=1 to Width do begin
      MoveTo(b, w);
      LineTo(e, w);
      inc(w, st);
     end;
   end
  else
   begin
     w:=fO.x;
     e:=fO.y+1+odec; b:=fO.y-fLen-einc;
     for j:=1 to Width do begin
      MoveTo(w, b);
      LineTo(w, e);
      dec(w, st);
     end;
   end;
 end;
end;
procedure Tsp_Scale.DrawTicks;                   
 procedure DrawVert;
 var j:word;
     x,l:integer;
     LS:String; LW:integer;
 begin
  with fCanvas do
  begin
    if ((FFlags and sdfNoTicks)=0) and (rTksCount>0)then
    begin
      if (FFlags and sdfLabelOnRight)=0 then begin
        x:=fO.x-TickOfs-fLineAttr.Width; l:=x-MjTick;
      end else begin
        x:=fO.x+TickOfs+fLineAttr.Width; l:=x+MjTick;
      end;
      for j:=0 to rTksCount-1 do begin             
        MoveTo(x, fTksPos[j]);
        LineTo(l, fTksPos[j]);
      end;
    end;
    if ((FFlags and sdfNoTicksLabel)=0) and (rTksCount>0) then
    begin
      l:=TextHeight('8') div 2;
      if (FFlags and sdfLabelOnRight)=0 then
      begin
        x:=fO.x-TickOfs-fLineAttr.Width-MjTick-LblOfs;
        for j:=0 to rTksCount-1 do begin
          LS:=TickLabel(j);
          LW:=TextWidth(LS);
          TextOut(x-LW, fTksPos[j]-l, LS);
        end;
      end
      else
      begin
        x:=fO.x+TickOfs+fLineAttr.Width+MjTick+LblOfs;
        for j:=0 to rTksCount-1 do begin
          TextOut(x, fTksPos[j]-l, TickLabel(j));
        end;
      end;
    end;                                  
  end;       
 end;             
 procedure DrawHoriz;
 var j:word;
     y,l:integer;
     LS:String;   LW:integer;
 begin
  with fCanvas do
  begin
    if ((FFlags and sdfNoTicks)=0) and (rTksCount>0)then
    begin
      if (FFlags and sdfLabelAtTop)=0 then begin
        y:=fO.y+TickOfs+fLineAttr.Width; l:=y+MjTick;
      end else begin
        y:=fO.y-TickOfs-fLineAttr.Width; l:=y-MjTick;
      end;
      for j:=0 to rTksCount-1 do begin             
        MoveTo(fTksPos[j], y);
        LineTo(fTksPos[j], l);
      end;
    end;
    if ((FFlags and sdfNoTicksLabel)=0) and (rTksCount>0)then
    begin
      if (FFlags and sdfLabelAtTop)=0 then
           y:=fO.y+TickOfs+fLineAttr.Width+MjTick+LblOfs
      else y:=fO.y-TickOfs-fLineAttr.Width-MjTick-LblOfs-TextHeight('8');
      for j:=0 to rTksCount-1 do begin
        LS:=TickLabel(j);
        LW:=TextWidth(LS);
        TextOut(fTksPos[j]-LW div 2, y, LS);
      end;
    end;                                  
  end;       
 end;             
begin            
 if (fFlags and sdfLineOnly)=sdfLineOnly then Exit;
 if (FFlags and sdfVertical)=0 then DrawHoriz
 else DrawVert;
end;             
END.