Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Gráficos (https://www.clubdelphi.com/foros/forumdisplay.php?f=8)
-   -   como hacer graficos de meteorologia. (https://www.clubdelphi.com/foros/showthread.php?t=70602)

crespopg 29-10-2010 23:59:00

como hacer graficos de meteorologia.
 
Solicito de la ayuda del foro, para poder hacer graficos de meteorologia, como los que acontinuacion se indican:

duilioisola 30-10-2010 10:58:20

Para esos gráficos te basta con este código: :D
Código Delphi [-]
begin
end;
Es que no veo nada después de los dos puntos.

crespopg 01-11-2010 01:23:37

Entiendo la respuesta, y se agradece la ayuda. pero mi configuracion no me permite enviar archivos anexos ni enlaces, por lo que no pude explicarme como debiera.
Requiero de hacer una grafica del tipo velocimetro, con parametros y procedimientos necesarios para ajustar colores, maximo, minimo, fonts, etc.
espero de su ayuda.

www cm colpos mx/meteoro/WindDirection.gif

duilioisola 01-11-2010 17:09:18

Para hacer ese tipo de gráficos suele bastar con un poco de trigonometría (seno y coseno) y las funciones básicas de gráficlos (Line, Circle, TextOut).

De todos modos, si lo que quieres es un componente ya hecho, puedes buscar en Torrys Delphi pages

Este es un ejepmplo de lo que puedes econtrar.

duilioisola 01-11-2010 19:18:46

Te dejo un pequeño ejemplo por si te interesa hacerlo tu mismo...

rounin 02-11-2010 14:05:43

Otro ejemplo...

Código Delphi [-]
procedure TForm1.FormCreate(Sender: TObject);
begin
  FWMeter := TWindMeter.Create(Self);
  FWMeter.Parent := Self;
  FWMeter.Width := 200;
  FWMeter.Height := 200;
  FWMeter.Color := clBtnFace;
  FWMeter.Font.Size := 16;
  FWMeter.Colors[wmeArrow] := clGreen;
  FWMeter.Colors[wmeCircle] := clWhite;
  FWMeter.Colors[wmeRing] := clBlue;
  FWMeter.Colors[wmeCaptionBg] := clBlue;
  FWMeter.TickLength := 10;
  FWMeter.CaptionFont.Size := 15;
  FWMeter.FooterFont.Size := 8;
  FWMeter.Angle := 100;
end;
 
{-------------------------------}
unit wmeter;
interface
uses
  Windows, Messages, Classes, Graphics, Controls;
type
  TWindMeterElements = (wmeArrow, wmePin, wmeRing, wmeCaptionBg, wmeCircle);
  TWindMeter = class(TGraphicControl)
  private
    FFooterText: string;
    FCaptionFont: TFont;
    FFooterFont: TFont;
    FAngle: Integer;
    FMinAngle: Integer;
    FMaxAngle: Integer;
    FTickLength: Integer;
    FColors: array[TWindMeterElements] of TColor;
    procedure SetCaptionFont(const Value: TFont);
    procedure SetFooterFont(const Value: TFont);
    procedure SetAngle(const Value: Integer);
    procedure SetTickLength(const Value: Integer);
    function GetColors(Element: TWindMeterElements): TColor;
    procedure SetColors(Element: TWindMeterElements; const Value: TColor);
    procedure SetMaxAngle(const Value: Integer);
    procedure SetMinAngle(const Value: Integer);
  protected
    function Center: TPoint; virtual;
    function Radius: Integer; virtual;
    procedure DrawArrow(Angle: Double); virtual;
    procedure DrawRing; virtual;
    procedure DrawLabel(Angle: Double; const LabelText: string); virtual;
    procedure DrawTick(Angle: Double; Length: Integer); virtual;
    procedure DrawCaption; virtual;
    procedure DrawFooter; virtual;
    procedure ChangeHandler(Sender: TObject);
  public
    procedure Paint; override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Colors[Element: TWindMeterElements]: TColor read GetColors write SetColors;
  published
    property Caption;
    property Font;
    property Color;
    property CaptionFont: TFont read FCaptionFont write SetCaptionFont;
    property FooterFont: TFont read FFooterFont write SetFooterFont;
    property Angle: Integer read FAngle write SetAngle;
    property MinAngle: Integer read FMinAngle write SetMinAngle;
    property MaxAngle: Integer read FMaxAngle write SetMaxAngle;
    property TickLength: Integer read FTickLength write SetTickLength;
  end;
//  procedure Register;
implementation
uses
  Math;
{----------------------------- TWindMeter -------------------------------------}
constructor TWindMeter.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle + [csOpaque];
  Width := 200;
  Height := 200;
  FTickLength := 10;
  Font.Size := 10;
  Color := clWhite;
  Caption := 'Wind Direction';
  FFooterText := 'Footer';
  FMinAngle := 0;
  FMaxAngle := 360;
  FCaptionFont := TFont.Create;
  FCaptionFont.Assign(Font);
  FCaptionFont.Style := [fsBold];
  FCaptionFont.Color := clWhite;
  FCaptionFont.OnChange := ChangeHandler;
  FFooterFont := TFont.Create;
  FFooterFont.Assign(Font);
  FFooterFont.OnChange := ChangeHandler;
  Colors[wmeArrow] := clRed;
  Colors[wmePin] := clBlack;
  Colors[wmeRing] := clBlack;
  Colors[wmeCaptionBg] := clBlack;
  Colors[wmeCircle] := Color; 
end;
destructor TWindMeter.Destroy;
begin
  FCaptionFont.Free;
  FFooterFont.Free;
  inherited;
end;
function TWindMeter.Center: TPoint;
begin
  Result := Point(Width div 2, Height div 2);
end;
function TWindMeter.Radius: Integer;
var capH, footH, labH: Integer;
begin
  //Result := Round( Min(Height, Width)*0.3 );
  Canvas.Font := FCaptionFont;
  capH := Canvas.TextHeight('1');
  Canvas.Font := Font;
  labH := Canvas.TextHeight('1');
  Canvas.Font := FFooterFont;
  footH := Canvas.TextHeight('1');
  Result := (Height - labH*2 - capH - footH - 16) div 2;
  if Result > (Width - labH) div 2 - 16 then
    Result := (Width - labH) div 2 - 16;
end;
procedure TWindMeter.DrawArrow(Angle: Double);
var cntr: TPoint;
    majorR, R0, R1, R2: Integer;
    XX, YY, Xa, Ya, Xb, Yb: Integer;
    a, aa, ab: Double;
begin
  a := Angle*PI/180;
  cntr := Center;
  majorR := Radius;
  R0 := majorR div 12;
  R1 := majorR div 6;
  R2 := majorR - FTickLength{ - 10};
  XX :=   Round( Sin(a)*R2 ) + cntr.X;
  YY := - Round( Cos(a)*R2 ) + cntr.Y;
  Canvas.Pen.Color := Colors[wmeArrow];
  Canvas.Brush.Color := Colors[wmeArrow];
  Canvas.Ellipse(cntr.X - R1, cntr.Y - R1, cntr.X + R1+1, cntr.Y + R1+1);
  { Triangle }
  aa := a - PI/2;
  Xa :=   Round( Sin(aa)*R1 ) + cntr.X;
  Ya := - Round( Cos(aa)*R1 ) + cntr.Y;
  ab := a + PI/2;
  Xb :=   Round( Sin(ab)*R1 ) + cntr.X;
  Yb := - Round( Cos(ab)*R1 ) + cntr.Y;
  Canvas.Polygon([Point(XX, YY), Point(Xa, Ya), Point(Xb, Yb)]);

  Canvas.Pen.Color := Colors[wmePin];
  Canvas.Brush.Color := Colors[wmePin];
  Canvas.Ellipse(cntr.X - R0, cntr.Y - R0, cntr.X + R0+1, cntr.Y + R0+1);
end;
procedure TWindMeter.DrawLabel(Angle: Double; const LabelText: string);
var XX, YY, X0, Y0: Integer;
    labelR, txtH, txtW: Integer;
    cntr: TPoint;
    a: Double;
begin
  a := Angle*PI/180;
  cntr := Center;
  txtH := Canvas.TextHeight(LabelText);
  txtW := Canvas.TextWidth(LabelText);
  labelR := Radius + Round( txtH*0.4*Sqr(cos(a)) + txtW*0.6*Sqr(sin(a)) ) + 4;
  XX :=   Round( Sin(a)*labelR ) + cntr.X;
  YY := - Round( Cos(a)*labelR ) + cntr.Y;
  X0 := XX - txtW div 2;
  Y0 := YY - txtH div 2;
  Canvas.Font := Font;
  Canvas.Brush.Style := bsClear;
  Canvas.TextOut(X0, Y0, LabelText);
  Canvas.Brush.Style := bsSolid; 
end;
procedure TWindMeter.DrawRing;
var cntr: TPoint;
    majorR: Integer;
begin
  cntr := Center;
  majorR := Radius;
  Canvas.Pen.Color := Colors[wmeRing];
  Canvas.Brush.Color := Colors[wmeCircle];
  Canvas.Ellipse(cntr.X - majorR, cntr.Y - majorR,
                 cntr.X + majorR, cntr.Y + majorR);
end;
procedure TWindMeter.DrawTick(Angle: Double; Length: Integer);
var X0, Y0, X1, Y1: Integer;
    majorR, minorR: Integer;
    cntr: TPoint;
    a: Double;
begin
  a := Angle*PI/180;
  cntr := Center;
  majorR := Radius;
  minorR := Radius - Length;
  X0 :=   Round( Sin(a)*minorR ) + cntr.X;
  Y0 := - Round( Cos(a)*minorR ) + cntr.Y;
  X1 :=   Round( Sin(a)*majorR ) + cntr.X;
  Y1 := - Round( Cos(a)*majorR ) + cntr.Y;
  Canvas.MoveTo(X0, Y0);
  Canvas.LineTo(X1, Y1);
end;
procedure TWindMeter.Paint;
var angle: Integer;
    nticks: Integer;
begin
  inherited;
  Canvas.Brush.Color := Color;
  Canvas.FillRect(ClientRect);
  DrawRing;
  nticks := 16;
  for angle := 0 to nticks-1 do
    DrawTick(angle*360/nticks, FTickLength);
  Canvas.Font.Assign(Font);
 
  DrawLabel(0, 'N');
  DrawLabel(45, 'NE');
  DrawLabel(90, 'E');
  DrawLabel(90+45, 'SE');
  DrawLabel(180, 'S');
  DrawLabel(180+45, 'SW');
  DrawLabel(270, 'W');
  DrawLabel(270+45, 'NW');
  DrawArrow(FAngle);
  DrawCaption;
  DrawFooter;
end;
procedure TWindMeter.DrawCaption;
var txtH, txtW: Integer;
    R: TRect;
begin
  Canvas.Font.Assign(FCaptionFont);
  txtH := Canvas.TextHeight(Caption);
  txtW := Canvas.TextWidth(Caption);
  R := ClientRect;
  R.Bottom := R.Top + txtH + 2;
  Canvas.Brush.Color := Colors[wmeCaptionBg];
  Canvas.TextRect(R, (Width - txtW) div 2, 1, Caption);
end;
procedure TWindMeter.DrawFooter;
var txtH, txtW: Integer;
    R: TRect;
begin
  Canvas.Font.Assign(FFooterFont);
  txtH := Canvas.TextHeight(FFooterText);
  txtW := Canvas.TextWidth(FFooterText);
  R := ClientRect;
  R.Top := R.Bottom - txtH - 2;
  Canvas.Brush.Color := Color;
  Canvas.TextRect(R, (Width - txtW) div 2, R.Top + 1, FFooterText);
end;
procedure TWindMeter.ChangeHandler(Sender: TObject);
begin
  Refresh;
end;
procedure TWindMeter.SetCaptionFont(const Value: TFont);
begin
  FCaptionFont.Assign(Value);
end;
procedure TWindMeter.SetFooterFont(const Value: TFont);
begin
  FFooterFont.Assign(Value);
end;
procedure TWindMeter.SetAngle(const Value: Integer);
begin
  if FAngle <> Value then
  begin
    if (Value >= FMinAngle)and(Value <= FMaxAngle) then
    begin
      FAngle := Value;
      Refresh;
    end;   
  end;
end;
procedure TWindMeter.SetTickLength(const Value: Integer);
begin
  if FTickLength <> Value then
  begin
    FTickLength := Value;
    Refresh;
  end;
end;
function TWindMeter.GetColors(Element: TWindMeterElements): TColor;
begin
  Result := FColors[Element];
end;
procedure TWindMeter.SetColors(Element: TWindMeterElements; const Value: TColor);
begin
  if FColors[Element] <> Value then
  begin
    FColors[Element] := Value;
    Refresh;
  end;
end;
procedure TWindMeter.SetMaxAngle(const Value: Integer);
begin
  if FMaxAngle <> Value then
  begin
    FMaxAngle := Value;
    if FAngle > FMaxAngle then
      FAngle := FMaxAngle;
    Refresh;
  end;
end;
procedure TWindMeter.SetMinAngle(const Value: Integer);
begin
  if FMinAngle <> Value then
  begin
    FMinAngle := Value;
    if FAngle < FMinAngle then
      FAngle := FMinAngle;
    Refresh;
  end;
end;
end.


La franja horaria es GMT +2. Ahora son las 13:04:58.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi