Hola,
>en fin la pregunta seria como puedo dibujar rectangulos dentro del chart del
>tamano deseado, y luego hacer zoom a esa seleccion en otro tchart
Es bastante facil hacer on aguel objeto.
Apariencia no es muy buena, pero se puede cambiar.
Sobre anterior pregunta, no he encontrado la respuesta :-(
Tengo que usar mi propia grafica.
Código Delphi
[-]
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, TeEngine, Series, ExtCtrls, TeeProcs, Chart, StdCtrls,
ChartObj,
Dpsn,
XYSel,
ZoomRect;
type
TForm1 = class(TForm)
Chart1: TChart;
ListBox1: TListBox;
BGetSelection: TButton;
BGetDiapasonSelection: TButton;
Chart2: TChart;
Series1: TFastLineSeries;
Series2: TFastLineSeries;
procedure FormCreate(Sender: TObject);
procedure Chart1AfterDraw(Sender: TObject);
procedure Chart1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Chart1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Chart1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
FZoomRect: TZoomRect;
FActiveObject: TChartObject;
FMouseHandled: Boolean;
FExclusiveZoomMode: Boolean;
procedure ZoomRectChanged(Sender: TObject);
public
procedure SetExclusiveZoomMode(ZoomOn: Boolean);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var i: Integer;
begin
for i := 0 to 300 do
begin
Series1.AddXY(i, Random(i));
Series2.AddXY(i, Series1.YValue[i]);
end;
SetExclusiveZoomMode(False);
Chart1.OnAfterDraw := Chart1AfterDraw;
Chart1.OnMouseDown := Chart1MouseDown;
Chart1.OnMouseMove := Chart1MouseMove;
Chart1.OnMouseUp := Chart1MouseUp;
Chart2.AllowZoom := False;
Chart2.AllowPanning := pmNone;
Chart2.LeftAxis.AutomaticMaximum := False;
Chart2.LeftAxis.AutomaticMinimum := False;
Chart2.BottomAxis.AutomaticMaximum := False;
Chart2.BottomAxis.AutomaticMinimum := False;
FZoomRect := TZoomRect.CreateEx(Self, Chart1);
FZoomRect.Rect := RectF(50, 50, 200, 200);
FZoomRect.OnChange := ZoomRectChanged;
FZoomRect.AllowRectBody := True;
FZoomRect.AllowStandardZoom := True;
Chart1.AllowPanning := pmBoth;
Chart1.AllowZoom := True;
FActiveObject := FZoomRect;
end;
procedure TForm1.SetExclusiveZoomMode(ZoomOn: Boolean);
begin
FExclusiveZoomMode := ZoomOn;
if ZoomOn then
begin
Chart1.AllowPanning := pmBoth;
Chart1.AllowZoom := True;
end
else
begin
Chart1.AllowPanning := pmNone;
Chart1.AllowZoom := False;
end;
end;
procedure TForm1.ZoomRectChanged(Sender: TObject);
begin
with (Sender as TZoomRect).Rect do
begin
if Chart2.BottomAxis.Maximum < XMin
then Chart2.BottomAxis.Maximum := XMin;
Chart2.BottomAxis.Minimum := XMin;
Chart2.BottomAxis.Maximum := XMax;
if Chart2.LeftAxis.Maximum < YMin
then Chart2.LeftAxis.Maximum := YMin;
Chart2.LeftAxis.Minimum := YMin;
Chart2.LeftAxis.Maximum := YMax;
end;
Chart2.Invalidate;
end;
procedure TForm1.Chart1AfterDraw(Sender: TObject);
begin
FActiveObject.Draw(Chart1);
end;
procedure TForm1.Chart1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FMouseHandled := FExclusiveZoomMode;
FActiveObject.HandleMouse(X, Y, evMouseDown, Shift, FMouseHandled);
end;
procedure TForm1.Chart1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
FMouseHandled := FExclusiveZoomMode;
FActiveObject.HandleMouse(X, Y, evMouseMove, Shift, FMouseHandled);
end;
procedure TForm1.Chart1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FMouseHandled := FExclusiveZoomMode;
FActiveObject.HandleMouse(X, Y, evMouseUp, Shift, FMouseHandled);
end;
end.
unit ChartObj;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, TeEngine, Series, ExtCtrls, TeeProcs, Chart;
type
PRectF = ^TRectF;
TRectF = packed record
XMin, XMax, YMin, YMax: Double;
end;
TEventID = (evNone, evDraw, evMouseDown, evMouseMove, evMouseUp, evKeyDown, evKeyUp);
TChartObject = class(TComponent)
private
FChart: TChart;
public
property Chart: TChart read FChart;
procedure Draw(Chart: TChart); virtual; abstract;
procedure HandleMouse(X, Y: Integer; Event: TEventID; Shift: TShiftState; var Handled: Boolean); virtual; abstract;
constructor Create(AOwner: TComponent); override;
constructor CreateEx(AOwner: TComponent; AChart: TChart);
end;
function RectF(XMin, YMin, XMax, YMax: Double): TRectF;
procedure OrientRect(var Rect: TRect);
procedure OrientRectF(var Rect: TRectF);
implementation
constructor TChartObject.Create(AOwner: TComponent);
begin
inherited;
FChart := nil;
end;
constructor TChartObject.CreateEx(AOwner: TComponent; AChart: TChart);
begin
Create(AOwner);
FChart := AChart;
end;
function RectF(XMin, YMin, XMax, YMax: Double): TRectF;
begin
Result.XMin := XMin;
Result.XMax := XMax;
Result.YMin := YMin;
Result.YMax := YMax;
end;
procedure OrientRectF(var Rect: TRectF);
procedure Swap(var A, B: Double);
var tmp: Double;
begin
tmp := A; A := B; B := tmp;
end;
begin
if Rect.XMin > Rect.XMax then Swap(Rect.XMin, Rect.XMax);
if Rect.YMin > Rect.YMax then Swap(Rect.YMin, Rect.YMax);
end;
procedure OrientRect(var Rect: TRect);
procedure Swap(var A, B: Integer);
var tmp: Integer;
begin
tmp := A; A := B; B := tmp;
end;
begin
if Rect.Left > Rect.Right then Swap(Rect.Left, Rect.Right);
if Rect.Top > Rect.Bottom then Swap(Rect.Top, Rect.Bottom);
end;
end.
unit ZoomRect;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, TeEngine, Series, ExtCtrls, TeeProcs, Chart,
ChartObj;
type
TZoomRectElement = (elNone, elRectBody,
elLeftBorder, elRightBorder, elTopBorder, elBottomBorder,
elLeftTopCorner, elRightTopCorner, elLeftBottomCorner, elRightBottomCorner);
TZoomRect = class(TChartObject)
private
FRect: TRectF;
FActiveElememt: TZoomRectElement;
FOnChange: TNotifyEvent;
FPrevPt: TPoint;
FAllowStandardZoom: Boolean;
FAllowRectBody: Boolean;
procedure SetRect(const Value: TRectF);
function GetRect: TRectF;
protected
function CalcScreenRect(const R: TRectF): TRect;
function CalcLogicRect(const R: TRect): TRectF;
procedure Changed;
public
property Rect: TRectF read GetRect write SetRect;
property AllowStandardZoom: Boolean read FAllowStandardZoom write FAllowStandardZoom;
property AllowRectBody: Boolean read FAllowRectBody write FAllowRectBody;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
procedure Draw(Chart: TChart); override;
procedure HandleMouse(X, Y: Integer; Event: TEventID; Shift: TShiftState; var Handled: Boolean); override;
end;
implementation
procedure TZoomRect.Draw(Chart: TChart);
var scrRect: TRect;
begin
scrRect := CalcScreenRect( Rect);
Chart.Canvas.Pen.Style := psSolid;
Chart.Canvas.Pen.Mode := pmCopy;
Chart.Canvas.Pen.Color := clBlack;
Chart.Canvas.Pen.Width := 2;
Chart.Canvas.Brush.Style := bsClear;
Chart.Canvas.Rectangle(scrRect.Left, scrRect.Top, scrRect.Right+1, scrRect.Bottom+1);
Chart.Canvas.Pen.Width := 1;
Chart.Canvas.Ellipse(scrRect.Left+3, scrRect.Top+3, scrRect.Left+16, scrRect.Top+16);
Chart.Canvas.MoveTo(scrRect.Left+9, scrRect.Top+6);
Chart.Canvas.LineTo(scrRect.Left+9, scrRect.Top+13);
Chart.Canvas.MoveTo(scrRect.Left+6, scrRect.Top+9);
Chart.Canvas.LineTo(scrRect.Left+13, scrRect.Top+9);
Chart.Canvas.MoveTo(scrRect.Left+14, scrRect.Top+13);
Chart.Canvas.LineTo(scrRect.Left+19, scrRect.Top+17);
end;
procedure TZoomRect.HandleMouse(X, Y: Integer; Event: TEventID; Shift: TShiftState; var Handled: Boolean);
const SENS = 3;
var scrRect, newScrRect: TRect;
function GetElementUnderMouse(const R: TRect): TZoomRectElement;
var orientedR: TRect;
begin
Result := elNone;
orientedR := R;
OrientRect(orientedR);
if (X < orientedR.Left - SENS)or(X > orientedR.Right + SENS) then Exit;
if (Y < orientedR.Top - SENS)or(Y > orientedR.Bottom + SENS) then Exit;
if (Abs(X - R.Left) < SENS)and(Abs(Y - R.Top) < SENS) then Result := elLeftTopCorner
else if (Abs(X - R.Left) < SENS)and(Abs(Y - R.Bottom) < SENS) then Result := elLeftBottomCorner
else if (Abs(X - R.Right) < SENS)and(Abs(Y - R.Top) < SENS) then Result := elRightTopCorner
else if (Abs(X - R.Right) < SENS)and(Abs(Y - R.Bottom) < SENS) then Result := elRightBottomCorner
else if Abs(X - R.Left) < SENS then Result := elLeftBorder
else if Abs(X - R.Right) < SENS then Result := elRightBorder
else if Abs(Y - R.Top) < SENS then Result := elTopBorder
else if Abs(Y - R.Bottom) < SENS then Result := elBottomBorder
else if PtInRect(orientedR, Point(X, Y)) then Result := elRectBody;
if (not FAllowRectBody) and (Result = elRectBody) then Result := elNone;
end;
function GetProperCursor(Element: TZoomRectElement): TCursor;
begin
case Element of
elNone: Result := crDefault;
elRectBody: Result := crHandPoint;
elLeftBorder, elRightBorder: Result := crSizeWE;
elTopBorder, elBottomBorder: Result := crSizeNS;
elLeftTopCorner, elRightBottomCorner: Result := crSizeNESW;
elRightTopCorner, elLeftBottomCorner: Result := crSizeNWSE;
else Result := crDefault;
end;
end;
begin
if Handled then Exit;
scrRect := CalcScreenRect(FRect);
Screen.Cursor := crDefault;
if Event = evMouseDown then
begin
FPrevPt := Point(X, Y);
FActiveElememt := GetElementUnderMouse(scrRect);
if FActiveElememt <> elNone then Chart.AllowZoom := False;
Screen.Cursor := GetProperCursor(FActiveElememt);
end
else
if Event = evMouseMove then
begin
if (ssLeft in Shift) then
begin
newScrRect := scrRect;
if FActiveElememt = elRectBody then OffsetRect(newScrRect, X - FPrevPt.X, Y - FPrevPt.Y);
if FActiveElememt in [elLeftBorder, elLeftTopCorner, elLeftBottomCorner] then newScrRect.Left := X;
if FActiveElememt in [elRightBorder, elRightTopCorner, elRightBottomCorner] then newScrRect.Right := X;
if FActiveElememt in [elTopBorder, elLeftTopCorner, elRightTopCorner] then newScrRect.Top := Y;
if FActiveElememt in [elBottomBorder, elLeftBottomCorner, elRightBottomCorner] then newScrRect.Bottom := Y;
Rect := CalcLogicRect(newScrRect);
Screen.Cursor := GetProperCursor(FActiveElememt);
Chart.Invalidate;
FPrevPt := Point(X, Y);
end
else
Screen.Cursor := GetProperCursor(GetElementUnderMouse(scrRect));
end
else
if Event = evMouseUp then
begin
FActiveElememt := elNone;
Chart.AllowZoom := AllowStandardZoom;
Chart.Invalidate;
end;
end;
function TZoomRect.GetRect: TRectF;
begin
Result := FRect;
OrientRectF(Result);
end;
procedure TZoomRect.SetRect(const Value: TRectF);
begin
FRect := Value;
Changed;
Chart.Invalidate;
end;
procedure TZoomRect.Changed;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
function TZoomRect.CalcScreenRect(const R: TRectF): TRect;
begin
Result.Left := Chart.BottomAxis.CalcPosValue(R.XMin);
Result.Right := Chart.BottomAxis.CalcPosValue(R.XMax);
Result.Top := Chart.LeftAxis.CalcPosValue(R.YMax);
Result.Bottom := Chart.LeftAxis.CalcPosValue(R.YMin);
end;
function TZoomRect.CalcLogicRect(const R: TRect): TRectF;
begin
Result.XMin := Chart.BottomAxis.CalcPosPoint(R.Left);
Result.XMax := Chart.BottomAxis.CalcPosPoint(R.Right);
Result.YMin := Chart.LeftAxis.CalcPosPoint(R.Bottom);
Result.YMax := Chart.LeftAxis.CalcPosPoint(R.Top);
end;
end.