Steema Central

Code: Select all

// ---------- InsertGeologicalComment ------------------------------------------
procedure TQSCollection.InsertGeologicalComment
                    (AFldCode,AFld:string; AIndex: integer; ADataset: TDataset);
var
  i,iIndex: integer;
  Ltitle : string;

// assumes IntervalQuery has been filled. EBA 20160302
begin
  IntervalQuery.Open;
  IntervalQuery.First;

  LTitle := IntToStr(owner.Chart.SeriesList.Count);
  SeriesListB.AddObject(LTitle,TUnitBarSeries.Create(Owner)) 

  iIndex := SeriesListB.IndexOf(LTitle);

  with TUnitBarSeries(SeriesListB.Objects[iIndex]) do
  begin
    ParentChart := self.Owner.Chart;
    DataSource := IntervalQuery;  // after parent chart

    MultiBar := mbSelfStack;
    CustomBarWidth := 60;
    BarPen.Visible := False;
    MarksLocation := mlCenter;
    MarksOnBar := True;
    Marks.Clip := True;
    Marks.Shadow.Visible := False;
    ShowInLegend := False;

    Marks.Visible := True;
    Marks.Pen.Color := clWhite;
    Marks.Transparent := True;
    Marks.Font.Size := 8;

    ColorSource := 'Foreground';
    XLabelsSource := 'Strata Comment';
    XValues.ValueSource := 'ProfileDistance';
    YValues.ValueSource := 'Depth';
		VertAxis := aLeftAxis;

    active := true;
  end;

  self.owner.chart.refreshdata;
  self.owner.PlaceComments;

end;

// ---------- PlaceComments ----------------------------------------------------
procedure TPBQuickGraph.PlaceComments;
var
  s, i, tmpSize: Integer;

begin
  Chart.Draw;
  for s:=0 to IntervalQueryCollection.SeriesListB.Count-1 do
    if (s div 2 <> s/2) then // every second series in SeriesListB
      with TUnitBarSeries(IntervalQueryCollection.SeriesListB.Objects[s]) do
      begin
        for i := 0 to TUnitBarSeries(IntervalQueryCollection.SeriesListB.Objects[s]).Count - 1 do
          with Marks.Positions[i] do
          begin
            Custom := true;
            LeftTop.X := CalcXPos(0) + 80;
            tmpSize:=CalcYSizeValue(YValue[i]);
            LeftTop.Y:=CalcYPos(i)+(tmpSize div 2)-(Marks.Height div 2);
          end;
      end;
end;

procedure TPBQuickGraph.BarUndoZoom(Sender: TObject);
begin
  PlaceComments;
end;

Code: Select all

uses Series;

procedure TForm1.FormCreate(Sender: TObject);
var i: Integer;
begin
  Chart1.Legend.Visible:=false;
  Chart1.View3D:=false;

  with Chart1.AddSeries(TBarSeries) as TBarSeries do
  begin
    for i:=0 to 4 do
      if i=4 then
        Add(25+random*75)
      else
        Add(25+random*75, 'S0, I' + IntToStr(i));

    MultiBar:=mbSelfStack;
    MarksLocation:=mlCenter;
    MarksOnBar:=true;
    CustomBarWidth:=60;
  end;

  PlaceMarks;
end;

procedure TForm1.PlaceMarks;
var s, i, tmpSize: Integer;
begin
  Chart1.Draw;

  for s:=0 to Chart1.SeriesCount-1 do
    if Chart1[s] is TBarSeries then
      with Chart1[s] as TBarSeries do
      begin
        for i:=0 to Count-1 do
          with Marks.Positions[i] do
          begin
            if (Labels[i] <> '') then
            begin
              Custom:=true;
              LeftTop.X:=CalcXPos(i);

              if MarksLocation=mlEnd then
                LeftTop.Y:=CalcYPos(i)
              else
              begin
                tmpSize:=CalcYSizeValue(YValue[i]);
                if MarksLocation=mlStart then
                  LeftTop.Y:=CalcYPos(i)+tmpSize-Marks.Height
                else
                  LeftTop.Y:=CalcYPos(i)+(tmpSize div 2)-(Marks.Height div 2);
              end;
            end
            else
              Marks.Item[i].Text.Text:='';
          end;
      end;
end;

procedure TForm1.Chart1Scroll(Sender: TObject);
begin
  PlaceMarks;
end;

procedure TForm1.Chart1Zoom(Sender: TObject);
begin
  PlaceMarks;
end;

procedure TForm1.Chart1UndoZoom(Sender: TObject);
begin
  PlaceMarks;
end;

Code: Select all

  DBChart1.Axes.Bottom.LabelStyle:=talValue;

Code: Select all

Brush.Clear;

Code: Select all

  with (Chart.Tools[H] as TAnnotationTool) do
    Top := Chart.Axes.Bottom.PosAxis;

Code: Select all

  with (Chart.Tools[H] as TAnnotationTool) do
    Top :=  Chart.Axes.Top.PosAxis;

Code: Select all

Top := DBChart1.ChartRect.Top - 20;

Code: Select all

      Top := DBChart1.Axes.Left.CalcYPosValue(TMyBarSeries(SeriesListB.Objects[j]).YPosition) - Height;

Code: Select all

procedure TForm1.DBChart1UndoZoom(Sender: TObject);
begin
  DBChart1.Draw;
end;