unit Compass;

interface

uses
  Windows, SysUtils, Classes, Controls, messages, Forms;
const
Dir:array[0..3] of char=('N','E','S','W');//стороны света

VK_E=69;
VK_N=78;
VK_S=83;
VK_W=87;

type
  TAzimuth=integer;

  TCompass = class(TCustomControl)
  private
    s,c: integer;
    a,offSet: extended;
    LogFont: TLogFont;
    l: string;
    FAzimuth: TAzimuth;
    r: integer;
    AngleLabel: string;
    fAngle, fStartAngle: extended;
    fRotating: boolean;
    procedure Draw;
    procedure SetAzimuth(const Value: TAzimuth);
  protected
    procedure Paint; override;

    function CanResize(var NewWidth: Integer;
      var NewHeight: Integer): Boolean; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    Procedure CMDialogCODE(Var Msg:TWMKey); message WM_GETDLGCODE;
    procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X: Integer; Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Azimuth:TAzimuth read FAzimuth write SetAzimuth; // Азимут
  end;

procedure Register;
{$R cursors.res}

implementation

uses Graphics, Math, dialogs;

procedure Register;
begin
  RegisterComponents('ООП', [TCompass]);
end;

{ TCompass }

constructor TCompass.Create(AOwner: TComponent);
begin
  inherited;
  Width:=100;
  Height:=100;
  Screen.Cursors[1]:=LoadCursor(HInstance,'OPENHAND');
  Screen.Cursors[2]:=LoadCursor(HInstance,'DRAGHAND');
  ControlStyle:=ControlStyle+[csOpaque];
end;

function TCompass.CanResize(var NewWidth, NewHeight: Integer): Boolean;
begin
  NewHeight:=NewWidth;
  Result:=inherited CanResize(NewWidth, NewHeight);
end;

procedure TCompass.CMDialogCODE(var Msg: TWMKey);
begin
  inherited;
  Msg.Result:=DLGC_WANTARROWS;  // Компонент реагирует на нажатие курсорных клавиш
end;

procedure TCompass.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited;
  case Key of
    VK_PRIOR: Azimuth:=Azimuth+10;
    VK_NEXT:  Azimuth:=Azimuth-10;
    VK_RIGHT: Azimuth:=Azimuth+1;
    VK_LEFT:  Azimuth:=Azimuth-1;
    VK_N:  Azimuth:=0;
    VK_E:  Azimuth:=90;
    VK_S:  Azimuth:=180;
    VK_W:  Azimuth:=270;
   else;
  end;
end;


procedure TCompass.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  fRotating:=True;
  Screen.Cursor:=2;
  fStartAngle:=ArcTan2(x-r,y-r)-fAngle;
end;

procedure TCompass.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if fRotating then
  Azimuth:=Round(RadToDeg(ArcTan2(x-r,y-r)-fStartAngle));
end;

procedure TCompass.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  Screen.Cursor:=1;
  fRotating:=False;
end;

procedure TCompass.Paint;
begin
  Inherited;
  r:=ClientWidth div 2;
  Draw;
end;

procedure TCompass.Draw;
var i: integer;
begin
with Canvas do
begin
  Brush.Style:=bsSolid;
  Ellipse(ClientRect);
  Font.Color:=clRed;
  Brush.Style:=bsClear;
  FillChar(LogFont, SizeOf(LogFont), 0);
  LogFont.lfWidth:=10;
  LogFont.lfHeight:=20;
    for i :=0  to 11 do
      begin
      a:=i*pi/6-fAngle;
      if a<0 then a:=2*pi+a;
      s:=Round(r*sin(a));
      c:=Round(r*cos(a));
      Pen.Width:=2;
      Pen.Color:=RGB(220,220,220);
      Polyline([Point(r,r),Point(r+s,r-c)]);
      Pen.Width:=1;
      Pen.Color:=clBlack;
      Polyline([Point(r,r),Point(r+s,r-c)]);
      If (i mod 3)=0 then
        begin
        l:=Dir[i div 3];
        Font.Color:=clNavy;
        end
        else
        begin
        l:=IntToStr(i*30);
        Font.Color:=clRed;
        end;
        offSet:=ArcTan2(TextWidth(l) div 2,R);
        LogFont.lfEscapement := -Round(RadToDeg(a)*10);     // Угол наклона в десятых долях градуса
        Font.Handle := CreateFontIndirect(LogFont);
        TextOut(r+Round(r*sin(a-offSet)), r-Round(r*cos(a-offSet)), l);
      end;

  LogFont.lfEscapement :=0;
  Font.Handle := CreateFontIndirect(LogFont);
  Font.Color:=clGreen;
  Brush.Style:=bsSolid;
  TextOut(r-TextWidth(AngleLabel) div 2,r div 2,AngleLabel);

        Brush.Style:=bsClear;
      Ellipse(ClientRect);
      Pen.Width:=2;
      Polyline([Point(r,r),Point(r,0),Point(r-5,10),Point(r,0),Point(r+5,10)]);
      Pen.Width:=1;
      Brush.Style:=bsSolid;

  end;
end;


procedure TCompass.SetAzimuth(const Value: TAzimuth);
begin
  FAzimuth := Value;
  if Value<0 then  FAzimuth:=360+Value;
  fAngle:=DegToRad(FAzimuth);
  AngleLabel:=IntToStr(FAzimuth)+'°';
  Repaint;
end;

end.

unit AdressEdit;
interface
uses
  SysUtils, Classes, Controls, ExtCtrls;

type
   TAdressEdit = class(TCustomControl)
  private
    FZipCodeEdit, FCityEdit, FStreetEdit: TLabeledEdit;
    FEditsLeft: Integer;
    procedure SetEditsLeft(const Value: Integer);
    function CreateLabeledEdit(LabelCaption:string; aTop: integer):TLabeledEdit;
    function GetStreet: string;
    procedure SetStreet(const Value: string);
    function GetZipCode: string;
    procedure SetZipCode(const Value: string);
    function GetCity: string;
    procedure SetCity(const Value: string);
    { Private declarations }
  protected
    procedure Paint; override;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
   property EditsLeft:Integer read FEditsLeft write SetEditsLeft;
   property Street: string read GetStreet write SetStreet;
   property ZipCode: string read GetZipCode write SetZipCode;
   property City: string read GetCity write SetCity;
  end;

procedure Register;

implementation
 uses Types, Dialogs;
procedure Register;
begin
  RegisterComponents('ООП', [TAdressEdit]);
end;

{ TAdressEdit }

constructor TAdressEdit.Create(AOwner: TComponent);
begin
  inherited;
  EditsLeft:=50;
  Width:=200;
  Height:=95;
  FZipCodeEdit:=CreateLabeledEdit('&Индекс',5);
  FCityEdit:=CreateLabeledEdit('&Город',35);
  FStreetEdit:=CreateLabeledEdit('&Улица',65);
end;

destructor TAdressEdit.Destroy;
begin
  inherited;
end;

function TAdressEdit.CreateLabeledEdit(LabelCaption: string; aTop: integer): TLabeledEdit;
begin
  Result:=TLabeledEdit.Create(Self);
  Result.Parent:=Self;
  Result.Top:=aTop;
  Result.EditLabel.Caption:=LabelCaption+':';
  Result.Left:=EditsLeft;
  Result.LabelPosition:=lpLeft;
end;

procedure TAdressEdit.Paint;
begin
  inherited;
  Canvas.FrameRect(ClientRect);
end;

procedure TAdressEdit.Resize;
var i, t: integer;
begin
  inherited;
  t:=ClientHeight div ComponentCount;
  for i :=0 to ComponentCount-1 do
    if Components[i] is TLabeledEdit then
      begin
      (Components[i] as TLabeledEdit).Top:=t div 4+t*i;
      (Components[i] as TLabeledEdit).Width:=ClientWidth-EditsLeft-5;
      end;

end;

procedure TAdressEdit.SetEditsLeft(const Value: Integer);
begin
  FEditsLeft := Value;
end;

function TAdressEdit.GetStreet: string;
begin
  Result:=FStreetEdit.Text;
end;

procedure TAdressEdit.SetStreet(const Value: string);
begin
  FStreetEdit.Text:=Value;
end;

function TAdressEdit.GetZipCode: string;
begin
  Result:=FZipCodeEdit.Text;
end;

procedure TAdressEdit.SetZipCode(const Value: string);
begin
  FZipCodeEdit.Text:=Value;
end;

function TAdressEdit.GetCity: string;
begin
   Result:=FCityEdit.Text;
end;

procedure TAdressEdit.SetCity(const Value: string);
begin
  FCityEdit.Text:=Value;
end;

end.