home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / AddOns / Components / Essentials / SETUP.EXE / %MAINDIR% / EsDir.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-11-28  |  7.6 KB  |  315 lines
  1. {*********************************************************}
  2. {*                    ESDIR.PAS 1.05                     *}
  3. {*      Copyright (c) 1997-98 TurboPower Software Co     *}
  4. {*                 All rights reserved.                  *}
  5. {*********************************************************}
  6.  
  7. {$I ES.INC}
  8.  
  9. {$B-} {Complete Boolean Evaluation}
  10. {$I+} {Input/Output-Checking}
  11. {$P+} {Open Parameters}
  12. {$T-} {Typed @ Operator}
  13. {$W-} {Windows Stack Frame}
  14. {$X+} {Extended Syntax}
  15.  
  16. {$IFNDEF Win32}
  17.   {$G+} {286 Instructions}
  18.   {$N+} {Numeric Coprocessor}
  19.   {$C MOVEABLE,DEMANDLOAD,DISCARDABLE}
  20. {$ENDIF}
  21.  
  22. unit EsDir;
  23.   {-direction picker component}
  24.  
  25. interface
  26.  
  27. {$IFDEF Win32}
  28.   {$R ESDIR.R32}
  29. {$ELSE}
  30.   {$R ESDIR.R16}
  31. {$ENDIF Win32}
  32.  
  33. uses
  34.   {$IFDEF Win32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  35.   Classes, Controls, Graphics, Messages,
  36.   EsData, EsUtil;
  37.  
  38. type
  39.   TEsCustomDirectionPicker = class(TGraphicControl)
  40.   protected {private}
  41.     {property variables}
  42.     FDirection       : Integer;
  43.     FNumDirections   : Integer;
  44.     FSelectedBitmap  : TBitmap;
  45.     FShowCenter      : Boolean;
  46.     FDirectionBitmap : TBitmap;
  47.  
  48.     {event variables}
  49.     FOnChange        : TNotifyEvent;
  50.  
  51.     {property methods}
  52.     procedure SetDirection(Value : Integer);
  53.     procedure SetSelectedBitmap(Value : TBitmap);
  54.     procedure SetNumDirections(Value : Integer);
  55.     procedure SetShowCenter(Value : Boolean);
  56.     procedure SetDirectionBitmap(Value : TBitmap);
  57.  
  58.   protected
  59.     procedure MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
  60.       override;
  61.     procedure Paint;
  62.       override;
  63.  
  64.     property Direction : Integer
  65.       read FDirection
  66.       write SetDirection
  67.       default 0;
  68.  
  69.     property NumDirections : Integer
  70.       read FNumDirections
  71.       write SetNumDirections
  72.       default 8;
  73.  
  74.     property SelectedBitmap : TBitmap
  75.       read FSelectedBitmap
  76.       write SetSelectedBitmap;
  77.  
  78.     property ShowCenter : Boolean
  79.       read FShowCenter
  80.       write SetShowCenter
  81.       default True;
  82.  
  83.     property DirectionBitmap : TBitmap
  84.       read FDirectionBitmap
  85.       write SetDirectionBitmap;
  86.  
  87.     property OnChange : TNotifyEvent
  88.       read FOnChange
  89.       write FOnChange;
  90.  
  91.   public
  92.     constructor Create(AComponent : TComponent);
  93.       override;
  94.     destructor Destroy;
  95.       override;
  96.   end;
  97.  
  98.   TEsDirectionPicker = class(TEsCustomDirectionPicker)
  99.   published
  100.     property Direction;
  101.     property Enabled;
  102.     property SelectedBitmap;
  103.     property NumDirections;
  104.     property ShowCenter;
  105.     property DirectionBitmap;
  106.  
  107.     property OnChange;
  108.     property OnClick;
  109.     property OnDblClick;
  110.     property OnMouseDown;
  111.     property OnMouseMove;
  112.     property OnMouseUp;
  113.   end;
  114.  
  115. (*
  116. procedure Register;
  117. *)
  118.  
  119. implementation
  120.  
  121.  
  122. {$IFDEF TRIALRUN}
  123. uses
  124.   EsTrial;
  125. {$I ESTRIALF.INC}
  126. {$ENDIF}
  127.  
  128.  
  129. const
  130.   DToR = Pi / 180;
  131.  
  132. constructor TEsCustomDirectionPicker.Create(AComponent : TComponent);
  133. {$IFDEF TRIALRUN}
  134. var
  135.   X : Integer;
  136. {$ENDIF}
  137. begin
  138.   inherited Create(AComponent);
  139.  
  140.   ControlStyle := [csClickEvents, csDoubleClicks];
  141.  
  142.   Width  := 50;
  143.   Height := 50;
  144.  
  145.   FDirection := -1;
  146.   FNumDirections := 8;
  147.   FShowCenter := True;
  148.  
  149.   {create and load the bitmap images}
  150.   FDirectionBitmap := TBitmap.Create;
  151.   FDirectionBitmap.Handle := LoadBitmap(HInstance, 'ESBLUEDOT');
  152.   FSelectedBitmap := TBitmap.Create;
  153.   FSelectedBitmap.Handle := LoadBitmap(HInstance, 'ESREDDOT');
  154.  
  155. {$IFDEF TRIALRUN}
  156.   X := _CC_;
  157.   if (X < ccRangeLow) or (X > ccRangeHigh) then Halt;
  158.   X := _VC_;
  159.   if (X < ccRangeLow) or (X > ccRangeHigh) then Halt;
  160. {$ENDIF}
  161. end;
  162.  
  163. destructor TEsCustomDirectionPicker.Destroy;
  164. begin
  165.   {destroy bitmaps}
  166.   FDirectionBitmap.Free;
  167.   FDirectionBitmap := nil;
  168.   FSelectedBitmap.Free;
  169.   FSelectedBitmap := nil;
  170.  
  171.   inherited Destroy;
  172. end;
  173.  
  174. procedure TEsCustomDirectionPicker.MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
  175. var
  176.   I             : Integer;
  177.   BW            : Integer;
  178.   Angle         : Extended;
  179.   Diameter      : Integer;
  180.   Radius        : Integer;
  181.   X1, Y1        : Integer;
  182.   Distance      : Integer;
  183.   BestDirection : Integer;
  184.   BestDistance  : Integer;
  185. begin
  186.   inherited MouseDown(Button, Shift, X, Y);
  187.  
  188.   if (Button = mbLeft) and Enabled then begin
  189.     BW := Max(FDirectionBitmap.Width, FDirectionBitmap.Height);
  190.     Diameter := Min(Height, Width)-2*BW;
  191.     Radius := Diameter div 2;
  192.  
  193.     if FShowCenter then begin
  194.       {initialize at center (-1)}
  195.       BestDistance := Round(Sqrt(Sqr(Radius+BW-X) + Sqr(Radius+BW-Y)));
  196.       BestDirection := -1;
  197.     end else begin
  198.       BestDistance := Width*2;
  199.       BestDirection := FDirection;
  200.     end;
  201.  
  202.     for I := 0 to Pred(FNumDirections) do begin
  203.       Angle := (I * (360/FNumDirections) + 90) * DToR;
  204.       X1 := Round(Radius * (1-Cos(Angle))) + BW;
  205.       Y1 := Round(Radius * (1-Sin(Angle))) + BW;
  206.       Distance := Round(Sqrt(Sqr(X1-X) + Sqr(Y1-Y)));
  207.       if Distance < BestDistance then begin
  208.         BestDistance := Distance;
  209.         BestDirection := I;
  210.       end;
  211.     end;
  212.  
  213.     Direction := BestDirection;
  214.   end;
  215. end;
  216.  
  217. procedure TEsCustomDirectionPicker.Paint;
  218. var
  219.   I        : Integer;
  220.   BW       : Integer;
  221.   BW2      : Integer;
  222.   Angle    : Extended;
  223.   Diameter : Integer;
  224.   Radius   : Integer;
  225.   X, Y     : Integer;
  226. begin
  227.   BW := Max(FDirectionBitmap.Width, FDirectionBitmap.Height);
  228.   Diameter := Min(Height, Width)-2*BW;
  229.   Radius := Diameter div 2;
  230.  
  231.   if FShowCenter then
  232.     Canvas.Draw(Radius+BW, Radius+BW, FDirectionBitmap);
  233.   for I := 0 to Pred(FNumDirections) do begin
  234.     Angle := (I * (360/FNumDirections) + 90) * DToR;
  235.     X := Round(Radius * (1-Cos(Angle)));
  236.     Y := Round(Radius * (1-Sin(Angle)));
  237.     Canvas.Draw(X+BW, Y+BW, FDirectionBitmap);
  238.   end;
  239.  
  240.   {draw the dot for the selected direction}
  241.   BW2 := (Max(FSelectedBitmap.Width, FSelectedBitmap.Height)-BW) div 2;  {adjustment for larger bitmap}
  242.   if FDirection = -1 then begin
  243.     if FShowCenter then
  244.       Canvas.Draw(Radius+BW-BW2, Radius+BW-BW2, FSelectedBitmap)
  245.   end else begin
  246.     Angle := (FDirection * (360/FNumDirections) + 90) * DToR;
  247.     X := Round(Radius * (1-Cos(Angle)));
  248.     Y := Round(Radius * (1-Sin(Angle)));
  249.     Canvas.Draw(X+BW-BW2, Y+BW-BW2, FSelectedBitmap);
  250.   end;
  251. end;
  252.  
  253. procedure TEsCustomDirectionPicker.SetDirection(Value : Integer);
  254. begin
  255.   if csLoading in ComponentState then begin
  256.     FDirection := Value;
  257.     Exit;
  258.   end;
  259.  
  260.   if (Value <> FDirection) and (Value >= -1) and (Value < FNumDirections) then begin
  261.     FDirection := Value;
  262.     Invalidate;
  263.     if Assigned(FOnChange) then
  264.       FOnChange(Self);
  265.   end;
  266. end;
  267.  
  268. procedure TEsCustomDirectionPicker.SetSelectedBitmap(Value : TBitmap);
  269. begin
  270.   if Assigned(Value) then
  271.     FSelectedBitmap.Assign(Value)
  272.   else
  273.     FSelectedBitmap.ReleaseHandle;
  274.   Invalidate;
  275. end;
  276.  
  277. procedure TEsCustomDirectionPicker.SetNumDirections(Value : Integer);
  278. begin
  279.   if (Value <> FNumDirections) and (Value >= 2) then begin
  280.     FNumDirections := Value;
  281.     Invalidate;
  282.   end;
  283. end;
  284.  
  285. procedure TEsCustomDirectionPicker.SetShowCenter(Value : Boolean);
  286. begin
  287.   if Value <> FShowCenter then begin
  288.     FShowCenter := Value;
  289.     Invalidate;
  290.   end;
  291. end;
  292.  
  293. procedure TEsCustomDirectionPicker.SetDirectionBitmap(Value : TBitmap);
  294. begin
  295.   if Assigned(Value) then
  296.     FDirectionBitmap.Assign(Value)
  297.   else
  298.     FDirectionBitmap.ReleaseHandle;
  299.   Invalidate;
  300. end;
  301.  
  302. (*
  303. procedure Register;
  304. begin
  305.   RegisterComponents('Essentials+', [TEsDirectionPicker]);
  306. end;
  307. *)
  308.  
  309. initialization
  310.  
  311.   if Classes.GetClass(TEsDirectionPicker.ClassName) = nil then
  312.     Classes.RegisterClass(TEsDirectionPicker);
  313.  
  314. end.
  315.