Földgömb fokhálózattal

Top  Previous  Next

3D Földgömböt rajzol fokhálózattal:

 

föld

 

unit fgomb1;

 

interface

 

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ExtCtrls, StdCtrls, Spin, ExtDlgs, ComCtrls;

 

type

 

  Point3d = record

     x,y,z: Real;

  end;

 

TForm1 = class(TForm)

   Panel1: TPanel;

   Label1: TLabel;

   Label2: TLabel;

   SpinEdit1: TSpinEdit;

   SpinEdit2: TSpinEdit;

   PaintBox: TPaintBox;

   OpenPictureDialog1: TOpenPictureDialog;

   Button1: TButton;

   Label3: TLabel;

   SpinEdit3: TSpinEdit;

   TrackBar1: TTrackBar;

   procedure PaintBoxPaint(Sender: TObject);

   procedure SpinEdit1Change(Sender: TObject);

   procedure Button1Click(Sender: TObject);

   procedure FormCreate(Sender: TObject);

   procedure FormClose(Sender: TObject; var Action: TCloseAction);

   procedure FormResize(Sender: TObject);

   procedure PaintBoxMouseDown(Sender: TObject; Button: TMouseButton;

     Shift: TShiftState; X, Y: Integer);

   procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;

     WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);

   procedure TrackBar1Change(Sender: TObject);

   procedure PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X,

     Y: Integer);

private

   Bitmap : TBitMap;

   FGlobePen: TPen;

   FGridPen: TPen;

public

   Ux0,Uy0: Integer;

   Ux,Uy: Integer;

   r: Integer;

   property GlobePen : TPen read FGlobePen write FGlobePen;

   property GridPen : TPen read FGridPen write FGridPen;

end;

 

var

Form1: TForm1;

//  pA   : Array of TPoint3d;

 

implementation

 

{$R *.DFM}

 

function felulet( fi, lambda: Real ): Point3d;

begin

  Result.x := cos( fi ) * sin( lambda );

  Result.y := sin( fi );

  Result.z := cos( fi ) * cos( lambda );

end;

 

function forgatXZ( const p: Point3d; alfa: Real ): Point3d;

begin

  Result.x := cos( alfa )*p.x + sin( alfa )*p.z;

  Result.y := p.y;

  Result.z := -sin( alfa )*p.x + cos( alfa )*p.z;

end;

 

// Egy másik tengely mentén:

function forgatYZ( const p: Point3d; alfa: Real ): Point3d;

begin

  Result.x := p.x;

  Result.y := cos( alfa )*p.y + sin( alfa )*p.z;

  Result.z := -sin( alfa )*p.y + cos( alfa )*p.z;

end; // forgatXZ

 

 

procedure TForm1.PaintBoxPaint(Sender: TObject);

var

  alfa   : Real;

  beta   : Real;

  fi     : Integer;

  lambda : Integer;

  pont   : Point3d;

  OldpOn : boolean;

  pOn    : boolean;

begin

  // Drawing the sphere coordinate grid

  PaintBox.Canvas.Draw(0,0,BitMap);

  PaintBox.Canvas.Pen.Assign(GridPen);

  PaintBox.Canvas.Brush.Style := bsClear;

  alfa := SpinEdit1.Value *pi/180;

  beta := SpinEdit2.Value *pi/180;

 

  // Drawing the altitudes

  for fi := -8 to 8 do begin

      OldpOn  := False;

      pOn     := False;

     for lambda := 0 to 360 do begin

         pont := ForgatXZ( ForgatYZ(

            felulet( fi*10*pi/180, lambda*pi/180),

            alfa), beta );

         pOn := pont.z > 0;

         if pOn and OldpOn then begin

            PaintBox.Canvas.LineTo(Ux+Round(pont.x*r), Uy+Round(pont.y*r));

            pOn := True;

         end else begin

            PaintBox.Canvas.MoveTo(Ux+Round(pont.x*r), Uy+Round(pont.y*r));

            pOn := True;

         end;

         OldpOn := pOn;

     end;

  end;

 

  // Drawing the latidudes

  for lambda := 0 to 11 do begin

      OldpOn  := False;

      pOn     := False;

    for fi := 0 to 360 do begin

         pont := ForgatXZ( forgatYZ(

            felulet( fi*pi/180, lambda*15*pi/180),

            alfa), beta );

         pOn := pont.z > 0;

         if pOn and OldpOn then begin

            PaintBox.Canvas.LineTo(Ux+Round(pont.x*r), Uy+Round(pont.y*r));

            pOn := True;

         end else begin

            PaintBox.Canvas.MoveTo(Ux+Round(pont.x*r), Uy+Round(pont.y*r));

            pOn := True;

         end;

         OldpOn := pOn;

     end;

  end;

 

  PaintBox.Canvas.Pen.Assign(GlobePen);

  PaintBox.Canvas.Ellipse(Ux-r,Uy-r,Ux+r,Uy+r);

 

end;

 

procedure TForm1.FormCreate(Sender: TObject);

begin

  Bitmap := TBitmap.Create;

  r := PaintBox.ClientHeight * 3 div 7;

  SpinEdit3.Value := r;

  GlobePen := TPen.Create;

  GridPen  := TPen.Create;

  GlobePen.Color := clNavy;

  GlobePen.Width := 1;

  GridPen.Color  := clGray;

end;

 

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  Bitmap.Free;

  GlobePen.Free;

  GridPen.Free;

end;

 

procedure TForm1.FormResize(Sender: TObject);

begin

  Ux := PaintBox.ClientWidth div 2;

  Uy := PaintBox.ClientHeight div 2;

end;

procedure TForm1.SpinEdit1Change(Sender: TObject);

begin

r := SpinEdit3.Value;

PaintBox.Repaint;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

If OpenPictureDialog1.execute then

   with Bitmap do begin

     LoadFromFile(OpenPictureDialog1.Filename);

     PaintBox.Canvas.Draw(0,0,BitMap);

   end;

PaintBox.Repaint;

end;

 

procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;

WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);

begin

r := r + WheelDelta div 10;

PaintBox.Repaint;

end;

 

procedure TForm1.TrackBar1Change(Sender: TObject);

begin

r := TrackBar1.Position;

PaintBox.Repaint;

end;

 

procedure TForm1.PaintBoxMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

Ux0 := x; Uy0 := y;

end;

 

procedure TForm1.PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

if ssLeft in Shift then begin

    UX :=ux+x-UX0; UY:=UY+(y-UY0);

    PaintBox.Repaint;

    Ux0 := x; Uy0 := y;

end;

end;

 

end.