Hello Yeray
Nearly there. I have annotations working but they do not appear until I either mouse over a chart or press Refresh. How do I get these to draw automatically. Also, can I remove the box around the text and just show the name, with no background.
The annotations are also lined up to the left of the bar chart, not the centre. Is there any easy way to automatically centre these?
I have introduced a ToolCount parameter, as I will have other tools on the chart.
Looking forward to your comments
Errol
Code: Select all
unit StackChart;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, TeeGDIPlus, ExtCtrls, TeeProcs, TeEngine, Chart, StdCtrls, DB,
Series, DBChart, kbmMemTable, teetools,contnrs;
type
TForm1 = class;
TForm1 = class(TForm)
Button1: TButton;
DBChart1: TDBChart;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Form1Create(Sender: TObject);
procedure RegenerateChart(Sender: TObject);
procedure DBChart1AfterDraw(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TMyBarSeries = class(TBarSeries)
private
fYPosition: double;
procedure SetYPosition(const Value: Double);
public
property YPosition: Double read fYPosition write SetYPosition;
function MinXValue:Double; override;
function PointOrigin(ValueIndex: Integer; SumAll: Boolean): Double; override;
function MaxYValue:Double; override;
end;
var
Form1: TForm1;
SeriesListB: TStringList;
WellElev,ProfDist: double;
WellName: string;
MyTable: TkbmMemTable;
implementation
{$R *.dfm}
procedure TForm1.DBChart1AfterDraw(Sender: TObject);
var
j: integer;
begin
for j := 0 to 2 do
with (DBChart1.Tools[j] as TAnnotationTool) do
begin
case j of
0: WellName := 'AT-103';
1: WellName := 'AT-201';
2: WellName := 'AT-604';
end;
Shape.CustomPosition := True;
Text := WellName;
Left := TMyBarSeries(SeriesListB.Objects[j]).CalcXPos(0);
end;
end;
procedure TForm1.Form1Create(Sender: TObject);
var
i,j,iRTC: Integer;
RTC, LTitle: string;
R,G,B,iIndex: integer;
DragTool: TDragMarksTool;
LTemp1,LTemp2: integer;
procedure AddRockSeries;
begin
LTitle := IntToStr(j);
if (SeriesListB.IndexOf(LTitle) = -1) then
SeriesListB.AddObject(LTitle,TMyBarSeries.Create(Owner));
iIndex := SeriesListB.IndexOf(LTitle);
// with DBChart1.AddSeries(TMyBarSeries) as TBarSeries do
with TMyBarSeries(SeriesListB.Objects[iIndex]) do
begin
Marks.Visible := true;
MultiBar := mbSelfStack;
CustomBarWidth := 60;
MarksLocation := mlCenter;
MarksOnBar := True;
Marks.Clip := True;
ShowInLegend := False;
ParentChart := DBChart1;
DataSource := myTable;
YPosition := WellElev;
XValues.ValueSource := 'ProfileDistance';
YValues.ValueSource := 'Depth';
XLabelsSource := 'Rock Type Code'; // marks!!!
ColorSource := 'Foreground';
VertAxis := aLeftAxis;
HorizAxis := aBottomAxis;
end;
end;
begin
DBChart1.ClearChart;
DBChart1.Tools.Clear;
DBChart1.View3D:=false;
DBChart1.LeftAxis.Inverted := False;
DBChart1.BottomAxis.Title.Caption := 'Profile Distance';
DBChart1.LeftAxis.Title.Caption := 'Elevation';
DBChart1.Axes.Bottom.LabelStyle:=talPointValue;
SeriesListB := TStringList.Create;
for j := 0 to 2 do
begin
case j of
0: WellName := 'AT-103';
1: WellName := 'AT-201';
2: WellName := 'AT-604';
end;
myTable := TkbmMemTable.Create(Owner);
with myTable do
begin
FieldDefs.Add('ProfileDistance', ftInteger,0,false);
FieldDefs.Add('Depth', ftFloat,0,false);
FieldDefs.Add('Rock Type Code', ftString,10,false);
FieldDefs.Add('Foreground', ftInteger,0,false);
CreateTable;
EmptyTable;
Open;
ProfDist := random*5000;
WellElev := (random*500);
for i:=0 to 5 do
begin
Append;
FieldByName('ProfileDistance').AsFloat:=ProfDist;
FieldByName('Depth').AsFloat:= -(150+random*150); // negative
case i of
0: RTC := IntToStr(j)+'-'+'BAS';
1: RTC := IntToStr(j)+'-'+'PYR';
2: RTC := IntToStr(j)+'-'+'NO';
3: RTC := IntToStr(j)+'-'+'TUF';
4: RTC := IntToStr(j)+'-'+'PYR';
5: RTC := IntToStr(j)+'-'+'MD';
end;
FieldByName('Rock Type Code').AsString := RTC;
R := Round(random*255);
G := Round(random*255);
B := Round(random*255);
FieldByName('Foreground').AsInteger:=RGB(R,G,B);
Post;
end;
AddRockSeries;
end;
DBChart1.Tools.Add(TAnnotationTool.Create(self));
with (DBChart1.Tools[j] as TAnnotationTool) do
begin
Shape.CustomPosition := True;
PositionUnits := muPixels;
Left := TMyBarSeries(SeriesListB.Objects[j]).CalcXPos(0);
end;
end;
DragTool := DBChart1.Tools.Add(TDragMarksTool) as TDragMarksTool;
DragTool.Active := true;
end;
procedure TForm1.RegenerateChart(Sender: TObject);
begin
Form1Create(owner);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DBChart1.RefreshData;
end;
Function TMyBarSeries.MinXValue:Double;
Begin
result:=XValues[0];
end;
procedure TMyBarSeries.SetYPosition(const Value: Double);
begin
if FYPosition <> Value then
begin
FYPosition := Value;
Repaint;
end;
end;
function TMyBarSeries.PointOrigin(ValueIndex: Integer;
SumAll: Boolean): Double;
begin
Result := inherited PointOrigin(ValueIndex, SumAll);
if not SumAll then
Result := Result + YPosition;
end;
function TMyBarSeries.MaxYValue:Double;
var
LMaxY: double;
Begin
result:=YPosition + 20;
end;
end.
