home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / AddOns / Components / Essentials / SETUP.EXE / %MAINDIR% / esedcalc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-11-28  |  12.6 KB  |  500 lines
  1. {*********************************************************}
  2. {*                  ESEDCALC.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 EsEdCalc;
  23.   {-numeric edit field with popup calculator}
  24.  
  25. interface
  26.  
  27. uses
  28.   {$IFDEF Win32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  29.   Buttons, Classes, Controls, Forms, Graphics, Menus, Messages,
  30.   StdCtrls, SysUtils,
  31.   EsBase, EsCalc, EsConst, EsEdPop;
  32.  
  33. type
  34.   TEsCustomNumberEdit = class(TEsEdPopup)
  35.   protected {private}
  36.     {.Z+}
  37.     FAllowIncDec     : Boolean;
  38.     FPopupCalcColors : TEsCalcColors;
  39.     FPopupCalcFont   : TFont;
  40.     FPopupCalcHeight : Integer;
  41.     FPopupCalcWidth  : Integer;
  42.  
  43.     {internal variables}
  44.     Calculator       : TEsCalculator;
  45.     HoldCursor       : TCursor;                                        {!!.04}
  46.     WasAutoScroll    : Boolean;
  47.  
  48.     {property methods}
  49.     function GetAsFloat : Double;
  50.     function GetAsInteger : LongInt;
  51.     function GetAsString : string;
  52.     procedure SetAsFloat(Value : Double);
  53.     procedure SetAsInteger(Value : LongInt);
  54.     procedure SetAsString(const Value : string);
  55.  
  56.     {property methods}
  57.     function GetReadOnly : Boolean;
  58.     procedure SetPopupCalcFont(Value : TFont);
  59.     procedure SetReadOnly(Value : Boolean);
  60.  
  61.     {internal methods}
  62.     procedure PopupButtonPressed(Sender : TObject; Button : TEsCalculatorButton);
  63.     procedure PopupKeyDown(Sender : TObject; var Key : Word; Shift : TShiftState);
  64.     procedure PopupKeyPress(Sender : TObject; var Key : Char);
  65.     procedure PopupMouseDown(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
  66.     {.Z-}
  67.  
  68.   protected
  69.     {.Z+}
  70.     procedure DoExit;
  71.       override;
  72.     procedure KeyDown(var Key : Word; Shift : TShiftState);
  73.       override;
  74.     procedure KeyPress(var Key : Char);
  75.       override;
  76.     procedure PopupClose(Sender : TObject);
  77.       override;
  78.     {.Z-}
  79.  
  80.     property AllowIncDec : Boolean
  81.       read FAllowIncDec
  82.       write FAllowIncDec
  83.       default False;
  84.  
  85.     property PopupCalcColors : TEsCalcColors
  86.       read FPopupCalcColors
  87.       write FPopupCalcColors;
  88.  
  89.     property PopupCalcFont : TFont
  90.       read FPopupCalcFont
  91.       write SetPopupCalcFont;
  92.  
  93.     property PopupCalcHeight : Integer
  94.       read FPopupCalcHeight
  95.       write FPopupCalcHeight
  96.       default calcDefHeight;
  97.  
  98.     property PopupCalcWidth : Integer
  99.       read FPopupCalcWidth
  100.       write FPopupCalcWidth
  101.       default calcDefWidth;
  102.  
  103.     property ReadOnly : Boolean
  104.       read GetReadOnly
  105.       write SetReadOnly;
  106.  
  107.   public
  108.     {.Z+}
  109.     constructor Create(AOwner : TComponent);
  110.       override;
  111.     destructor Destroy;
  112.       override;
  113.     procedure PopupOpen;                                               {!!.05}
  114.       override;
  115.     {.Z-}
  116.  
  117.     property AsInteger : LongInt
  118.       read GetAsInteger
  119.       write SetAsInteger;
  120.  
  121.     property AsFloat : Double
  122.       read GetAsFloat
  123.       write SetAsFloat;
  124.  
  125.     property AsString : string
  126.       read GetAsString
  127.       write SetAsString;
  128.   end;
  129.  
  130.   TEsNumberEdit = class(TEsCustomNumberEdit)
  131.   published
  132.     {properties}
  133.     property AllowIncDec;
  134.     property AutoSelect;
  135.     property AutoSize;
  136.     property BorderStyle;
  137.     property Color;
  138.     property Ctl3D;
  139.     property Cursor;
  140.     property DragCursor;
  141.     property DragMode;
  142.     property Enabled;
  143.     property EsLabelInfo;
  144.     property Font;
  145.     property HideSelection;
  146.     property ParentColor;
  147.     property ParentCtl3D;
  148.     property ParentFont;
  149.     property ParentShowHint;
  150.     property PopupCalcColors;
  151.     property PopupCalcFont;
  152.     property PopupCalcHeight;
  153.     property PopupCalcWidth;
  154.     property PopupMenu;
  155.     property ReadOnly;
  156.     property ShowHint;
  157.     property ShowButton;
  158.     property TabOrder;
  159.     property TabStop;
  160.     property Version;
  161.     property Visible;
  162.  
  163.     {events}
  164.     property OnChange;
  165.     property OnClick;
  166.     property OnDblClick;
  167.     property OnDragDrop;
  168.     property OnDragOver;
  169.     property OnEndDrag;
  170.     property OnEnter;
  171.     property OnExit;
  172.     property OnKeyDown;
  173.     property OnKeyPress;
  174.     property OnKeyUp;
  175.     property OnMouseDown;
  176.     property OnMouseMove;
  177.     property OnMouseUp;
  178.     {$IFDEF Win32}
  179.     property OnStartDrag;
  180.     {$ENDIF Win32}
  181.   end;
  182.  
  183.  
  184. implementation
  185.  
  186.  
  187. {$IFDEF TRIALRUN}
  188. uses
  189.   EsTrial;
  190. {$I ESTRIALF.INC}
  191. {$ENDIF}
  192.  
  193.  
  194. {*** TEsCustomNumberEdit ***}
  195.  
  196. constructor TEsCustomNumberEdit.Create(AOwner : TComponent);
  197. {$IFDEF TRIALRUN}
  198. var
  199.   X : Integer;
  200. {$ENDIF}
  201. begin
  202.   inherited Create(AOwner);
  203.  
  204.   ControlStyle := ControlStyle - [csSetCaption];
  205.  
  206.   FAllowIncDec := False;
  207.   FPopupCalcHeight := calcDefHeight;
  208.   FPopupCalcWidth := calcDefWidth;
  209.   FPopupCalcFont := TFont.Create;
  210.   FPopupCalcFont.Assign(Font);
  211.  
  212.   {load button glyph}
  213.   FButton.Glyph.Handle := LoadBitmap(HInstance, 'ESSMALLDOWNARROW');
  214.  
  215.   {create color class}
  216.   FPopupCalcColors := TEsCalcColors.Create;
  217.   {assign default color scheme}
  218.   FPopupCalcColors.FCalcColors := CalcScheme[csWindows];
  219.   FPopupCalcColors.FColorScheme := csWindows;
  220.  
  221. {$IFDEF TRIALRUN}
  222.   X := _CC_;
  223.   if (X < ccRangeLow) or (X > ccRangeHigh) then Halt;
  224.   X := _VC_;
  225.   if (X < ccRangeLow) or (X > ccRangeHigh) then Halt;
  226. {$ENDIF}
  227. end;
  228.  
  229. destructor TEsCustomNumberEdit.Destroy;
  230. begin
  231.   FPopupCalcColors.Free;
  232.   FPopupCalcColors := nil;
  233.  
  234.   FPopupCalcFont.Free;
  235.   FPopupCalcFont := nil;
  236.  
  237.   inherited Destroy;
  238. end;
  239.  
  240. procedure TEsCustomNumberEdit.DoExit;
  241. begin
  242.   if not PopupActive then
  243.     inherited DoExit;
  244. end;
  245.  
  246. {!!.04} {revised}
  247. function TEsCustomNumberEdit.GetAsFloat : Double;
  248. var
  249.   I : Integer;
  250.   S : string;
  251. begin
  252.   S := Text;
  253.   for I := Length(S) downto 1 do
  254.     if not (S[I] in ['0'..'9', '+', '-', DecimalSeparator]) then
  255.       Delete(S, I, 1);
  256.   Result := StrToFloat(S);
  257. end;
  258.  
  259. function TEsCustomNumberEdit.GetAsInteger : LongInt;
  260. begin
  261.   Result := Trunc(GetAsFloat);
  262. end;
  263.  
  264. function TEsCustomNumberEdit.GetAsString : string;
  265. begin
  266.   Result := Text;
  267. end;
  268.  
  269. function TEsCustomNumberEdit.GetReadOnly : Boolean;
  270. begin
  271.   Result := inherited ReadOnly;
  272. end;
  273.  
  274. procedure TEsCustomNumberEdit.KeyDown(var Key : Word; Shift : TShiftState);
  275. begin
  276.   inherited KeyDown(Key, Shift);
  277.  
  278.   if (Key = VK_DOWN) and (ssAlt in Shift) then
  279.     PopupOpen;
  280. end;
  281.  
  282. procedure TEsCustomNumberEdit.KeyPress(var Key : Char);
  283. var
  284.   D : Double;
  285.   X : Integer;
  286.   L : Integer;
  287. begin
  288.   inherited KeyPress(Key);
  289.  
  290.   if not (Key in [#27, '0'..'9', '.', DecimalSeparator, #8, '+', '-']) then begin
  291.     Key := #0;
  292.     MessageBeep(0);
  293.   end;
  294.  
  295.   if FAllowIncDec  and (Key in ['+', '-']) then begin
  296.     if Text = '' then
  297.       Text := '0';
  298.     D := StrToFloat(Text);
  299.     X := SelStart;
  300.     L := SelLength;
  301.  
  302.     if Key = '+' then
  303.       Text := FloatToStr(D+1)
  304.     else {'-'}
  305.       Text := FloatToStr(D-1);
  306.  
  307.     SelStart := X;
  308.     SelLength := L;
  309.  
  310.     Key := #0; {clear key}
  311.   end;
  312.  
  313. end;
  314.  
  315. procedure TEsCustomNumberEdit.PopupButtonPressed(Sender : TObject;
  316.           Button : TEsCalculatorButton);
  317. begin
  318.   case Button of
  319.     ccEqual :     
  320.       begin
  321.         {get the current value}
  322.         Text := FloatToStr(Calculator.Value);
  323.         Modified := True;                                              {!!.04}
  324.  
  325.         {hide the calculator}
  326.         PopupClose(Sender);
  327.         SetFocus;
  328.         SelStart := Length(Text);
  329.         SelLength := 0;
  330.       end;
  331.   end;
  332. end;
  333.  
  334. procedure TEsCustomNumberEdit.PopupClose(Sender : TObject);
  335. begin
  336.   inherited PopupClose(Sender);
  337.  
  338.   if GetCapture = Calculator.Handle then
  339.     ReleaseCapture;
  340.  
  341.   SetFocus;                                                            {!!.05}
  342.   Calculator.Hide;  {hide the calculator}
  343.   if (Calculator.Parent <> nil) and (Calculator.Parent is TForm) then  {!!.05}
  344.     TForm(Calculator.Parent).AutoScroll := WasAutoScroll;
  345.   Cursor := HoldCursor;                                                {!!.04}
  346.  
  347.   {change parentage so that we control the window handle destruction}  {!!.04}
  348.   Calculator.Parent := Self;                                           {!!.04}
  349. end;
  350.  
  351. procedure TEsCustomNumberEdit.PopupKeyDown(Sender : TObject; var Key : Word; Shift : TShiftState);
  352. var
  353.   X : Integer;
  354. begin
  355.   case Key of
  356.     VK_UP : if Shift = [ssAlt] then begin
  357.               PopupClose(Sender);
  358.               X := SelStart;
  359.               SetFocus;
  360.               SelStart := X;
  361.               SelLength := 0;
  362.             end;
  363.   end;
  364. end;
  365.  
  366. procedure TEsCustomNumberEdit.PopupKeyPress(Sender : TObject; var Key : Char);
  367. var
  368.   X : Integer;
  369. begin
  370.   case Key of
  371.     #27 :
  372.       begin
  373.         PopupClose(Sender);
  374.         X := SelStart;
  375.         SetFocus;
  376.         SelStart := X;
  377.         SelLength := 0;
  378.       end;
  379.   end;
  380. end;
  381.  
  382. procedure TEsCustomNumberEdit.PopupMouseDown(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
  383. var
  384.   P : TPoint;
  385.   I : Integer;
  386. begin
  387.   P := Point(X,Y);
  388.   if not PtInRect(Calculator.ClientRect, P) then
  389.     PopUpClose(Sender);
  390.  
  391.   {convert to our coordinate system}
  392.   P := ScreenToClient(Calculator.ClientToScreen(P));
  393.  
  394.   if PtInRect(ClientRect, P) then begin
  395.     I := SelStart;
  396.     SetFocus;
  397.     SelStart := I;
  398.     SelLength := 0;
  399.   end;
  400. end;
  401.  
  402. procedure TEsCustomNumberEdit.PopupOpen;
  403. var
  404.   P : TPoint;
  405.   {$IFDEF Win32}
  406.   R : TRect;                                                           {!!.04}
  407.   {$ENDIF}
  408. begin
  409.   inherited PopupOpen;
  410.  
  411.   if not Assigned(Calculator) then begin
  412.     Calculator := TEsCalculator.CreateEx(Self, True);
  413.     Calculator.OnButtonPressed := PopupButtonPressed;
  414.     Calculator.OnExit := PopupClose;
  415.     Calculator.OnKeyDown := PopupKeyDown;
  416.     Calculator.OnKeyPress := PopupKeyPress;
  417.     Calculator.OnMouseDown := PopupMouseDown;
  418.     Calculator.Visible := False; {to avoid flash at 0,0}
  419.     Calculator.ShowMemoryButtons := False;
  420.     Calculator.BorderStyle := bsSingle;
  421.     Calculator.Height := FPopupCalcHeight;
  422.     Calculator.Width := FPopupCalcWidth;
  423.     Calculator.ParentCtl3D := False;                                   {!!.02}
  424.     Calculator.Ctl3D := Ctl3D;                                         {!!.02}
  425.     Calculator.Font.Assign(FPopupCalcFont);
  426.   end;
  427.   {!!.05}
  428.   if Parent <> nil then
  429.     Calculator.Parent := Parent
  430.   else
  431.     Calculator.Parent := GetParentForm(Self);
  432.  
  433.   if (Calculator.Parent <> nil) and (Calculator.Parent is TForm) then begin{!!.05}
  434.     WasAutoScroll := TForm(Calculator.Parent).AutoScroll;
  435.     TForm(Calculator.Parent).AutoScroll := False;
  436.   end;                                                                 {!!.05}
  437.   
  438.   {set colors}
  439.   Calculator.Colors.Assign(FPopupCalcColors);
  440.  
  441.   {determine the proper position}
  442.   {$IFDEF Win32}
  443.   P := ClientToScreen(Point(-2, Height-2));
  444.   {$ELSE}
  445.   P := ClientToScreen(Point(0, Height));
  446.   {$ENDIF}
  447.  
  448.   {!!.04}
  449.   {$IFDEF Win32}
  450.   SystemParametersInfo(SPI_GETWORKAREA, 0, @R, 0);
  451.   if P.Y + Calculator.Height >= R.Bottom then
  452.     P.Y := P.Y - Calculator.Height - Height - 2;
  453.   if P.X + Calculator.Width >= R.Right then
  454.     P.X := R.Right - Calculator.Width - 1;
  455.   {$ELSE}
  456.   if P.Y + Calculator.Height >= Screen.Height then
  457.     P.Y := P.Y - Calculator.Height - Height - 2;
  458.   if P.X + Calculator.Width >= Screen.Width then
  459.     P.X := Screen.Width - Calculator.Width - 1;
  460.   {$ENDIF}
  461.  
  462.   MoveWindow(Calculator.Handle, P.X, P.Y, Calculator.Width, Calculator.Height, False);
  463.  
  464.   HoldCursor := Cursor;                                                {!!.04}
  465.   Cursor := crArrow;                                                   {!!.04}
  466.   Calculator.Show;
  467.   Calculator.SetFocus;
  468.  
  469.   SetCapture(Calculator.Handle);
  470. end;
  471.  
  472. procedure TEsCustomNumberEdit.SetAsFloat(Value : Double);
  473. begin
  474.   Text := FloatToStr(Value);
  475. end;
  476.  
  477. procedure TEsCustomNumberEdit.SetAsInteger(Value : LongInt);
  478. begin
  479.   Text := IntToStr(Value);
  480. end;
  481.  
  482. procedure TEsCustomNumberEdit.SetAsString(const Value : string);
  483. begin
  484.   Text := Value;
  485. end;
  486.  
  487. procedure TEsCustomNumberEdit.SetPopupCalcFont(Value : TFont);
  488. begin
  489.   if Assigned(Value) then
  490.     FPopupCalcFont.Assign(Value);
  491. end;
  492.  
  493. procedure TEsCustomNumberEdit.SetReadOnly(Value : Boolean);
  494. begin
  495.   inherited ReadOnly := Value;
  496.   FButton.Enabled := not ReadOnly;
  497. end;
  498.  
  499. end.
  500.