home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d456 / DCSLIB25.ZIP / DCCalculator.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-06-06  |  22.5 KB  |  770 lines
  1. {
  2.  BUSINESS CONSULTING
  3.  s a i n t - p e t e r s b u r g
  4.  
  5.          Components Library for Borland Delphi 4.x, 5.x
  6.          Copyright (c) 1998-2000 Alex'EM
  7.  
  8. }
  9. unit DCCalculator;
  10.  
  11. interface
  12. uses
  13.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  14.   DCEditButton, DCEditTools, DCPopupWindow, DCConst;
  15.  
  16. type
  17.   TStoredValues  = (svMemoryValue, svVisibleParam, svStoredParam);
  18.   TCalcValues    = array[TStoredValues] of Double;
  19.   TCalcButtons   = (cbDig0, cbDig1, cbDig2, cbDig3, cbDig4, cbDig5, cbDig6,
  20.                     cbDig7, cbDig8, cbDig9, cbDiv , cbSqrt, cbMul , cbPrec,
  21.                     cbSub,  cbInv , cbNeg , cbSep , cbAdd , cbRes , cbBks ,
  22.                     cbDel,  cbC   , cbMemC, cbMemR, cbMemS, cbMemP, cbOk  ,
  23.                     cbCancel);
  24.  
  25.   TDCCalcButton = class(TDCEditButton)
  26.   public
  27.     constructor Create(AOwner: TComponent); override;
  28.     procedure DoPaint(ACanvas: TCanvas; ARect: TRect); override;
  29.     procedure DrawBorder(ACanvas: TCanvas; ARect: TRect); override;
  30.     function GetImageOffset: TPoint; override;
  31.     function GetTextOffset: TPoint; override;
  32.   end;
  33.  
  34.   TDCCustomCalculator = class(TDCClipPopup)
  35.   private
  36.     FGridOffset : TPoint;
  37.     FElementSize: TPoint;
  38.     FDisplayHeight: integer;
  39.     FButtonsHeight: integer;
  40.     FValues: TCalcValues;
  41.     FVisibleParam: string;
  42.     FErrorCode: integer;
  43.     FOperation: TCalcButtons;
  44.     FClearParam: boolean;
  45.     FCloseUp: TCloseUpEvent;
  46.     procedure CreateGridButtons;
  47.     procedure CreateSpecButtons;
  48.     procedure SetElementSize;
  49.     function AddGridButton(ACol, ARow: integer; AName, ACaption: string;
  50.       ATag: integer): TDCEditButton;
  51.     procedure SetButtonProperty(Button: TDCEditButton; ATag: integer);
  52.     procedure DrawDisplay;
  53.     procedure DrawMemoryStatus;
  54.     procedure DoButtonClick(Sender: TObject);
  55.     procedure ClearValues;
  56.     procedure ClearVisibleParam;
  57.     procedure SetVisibleParam(const Value: string);
  58.     procedure AddToVisibleParam(Value: Char);
  59.     procedure SetOperation(Value: TCalcButtons);
  60.     procedure DoOperation(Value: TCalcButtons);
  61.     procedure AddToMemory;
  62.     procedure DoBackspace;
  63.     function GetMemoryValue: Double;
  64.     procedure SetMemoryValue(const Value: Double);
  65.     procedure FloatToVisibleParam;
  66.   protected
  67.     procedure CloseUp(State: Byte); virtual;
  68.     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  69.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  70.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  71.     procedure WMPaint (var Message: TMessage); message WM_PAINT;
  72.     property MemoryValue: Double read GetMemoryValue write SetMemoryValue;
  73.   public
  74.     constructor Create(AOwner: TComponent); override;
  75.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  76.     procedure VisibleParamToFloat;
  77.     property VisibleParam: string read FVisibleParam write SetVisibleParam;
  78.     property OnCloseUp: TCloseUpEvent read FCloseUp write FCloseUp;
  79.     property ErrorCode: integer read FErrorCode;
  80.   end;
  81.  
  82. implementation
  83.  
  84. { TDCCustomCalculator }
  85.  
  86. function TDCCustomCalculator.AddGridButton(ACol, ARow: integer; AName,
  87.   ACaption: string; ATag: integer): TDCEditButton;
  88.  var
  89.   BoundsRect: TRect;
  90. begin
  91.   BoundsRect := Rect(FGridOffset.X + ARow * FElementSize.X,
  92.                      FGridOffset.Y + ACol * FElementSize.Y,
  93.                      FElementSize.X, FElementSize.Y);
  94.   Result := Buttons.AddButtonEx(TDCCalcButton);
  95.   with Result do
  96.   begin
  97.     Name         := AName;
  98.     Caption      := ACaption;
  99.     SetBounds(BoundsRect);
  100.   end;
  101.   SetButtonProperty(Result, ATag);
  102. end;
  103.  
  104. procedure TDCCustomCalculator.AddToVisibleParam(Value: Char);
  105. begin
  106.   if (FErrorCode = 0) then
  107.   begin
  108.     if FClearParam then
  109.     begin
  110.       VisibleParam := Value;
  111.       FClearParam  := False;
  112.     end
  113.     else
  114.       VisibleParam := VisibleParam + Value;
  115.   end;
  116. end;
  117.  
  118. procedure TDCCustomCalculator.ClearValues;
  119.  var
  120.   i: TStoredValues;
  121. begin
  122.   for i := Low(FValues) to High(FValues) do FValues[i] := 0;
  123. end;
  124.  
  125. procedure TDCCustomCalculator.CMMouseEnter(var Message: TMessage);
  126.  var
  127.   Pos: TPoint;
  128. begin
  129.   inherited;
  130.   GetCursorPos(Pos);
  131.   if Buttons.MouseDown then
  132.   begin
  133.     Buttons.MouseDown := GetAsyncKeyState(VK_LBUTTON)<0;
  134.     if not Buttons.MouseDown then
  135.       Buttons.UpdateButtons(Pos.X, Pos.Y, False, True);
  136.   end;
  137. end;
  138.  
  139. procedure TDCCustomCalculator.CMMouseLeave(var Message: TMessage);
  140. begin
  141.   inherited;
  142.   Buttons.UpdateButtons(-1, -1, False, True);
  143. end;
  144.  
  145. constructor TDCCustomCalculator.Create(AOwner: TComponent);
  146. begin
  147.   inherited;
  148.  
  149.   Options := [coHeader];
  150.   PopupBorderStyle := brRaised;
  151.   Parent   := TWinControl(AOwner);
  152.   PopupAlignment := wpBottomRight;
  153.  
  154.   Buttons.PaintOnSizing := False;
  155.  
  156.   Color       := clMessageWindow;
  157.   Canvas.Font := Font;
  158.  
  159.   SetElementSize;
  160.   FDisplayHeight := FElementSize.Y + 4;
  161.   FButtonsHeight := FElementSize.Y + 1;
  162.   FGridOffset    := Point(Margins.Left + BorderSize + 2,
  163.                           Margins.Top  + BorderSize + 2 + FDisplayHeight + 4);
  164.   CreateSpecButtons;
  165.  
  166.   FGridOffset.X  := FGridOffset.X + FElementSize.X + 4;
  167.   FGridOffset.Y  := FGridOffset.Y + FElementSize.Y + 4;
  168.  
  169.   CreateGridButtons;
  170.   ClearValues;
  171.  
  172.   Width  := Margins.Left + Margins.Right  + FElementSize.X * 6 + 2 * BorderSize + 8;
  173.   Height := Margins.Top  + Margins.Bottom + FElementSize.Y * 5 + 2 * BorderSize +
  174.     FDisplayHeight + 12 + FButtonsHeight + 3;
  175.  
  176.   FErrorCode   := 0;
  177.   FClearParam  := True;
  178.   Foperation   := cbDig0;
  179.   VisibleParam := FloatToStr(FValues[svVisibleParam]);
  180. end;
  181.  
  182. procedure TDCCustomCalculator.CreateGridButtons;
  183. begin
  184.   AddGridButton(0, 0, '$BT_7'   , '7'   , Ord(cbDig7));
  185.   AddGridButton(0, 1, '$BT_8'   , '8'   , Ord(cbDig8));
  186.   AddGridButton(0, 2, '$BT_9'   , '9'   , Ord(cbDig9));
  187.   AddGridButton(0, 3, '$BT_DIV' , '/'   , Ord(cbDiv ));
  188.   AddGridButton(0, 4, '$BT_SQRT', 'sqrt', Ord(cbSqrt));
  189.   AddGridButton(1, 0, '$BT_4'   , '4'   , Ord(cbDig4));
  190.   AddGridButton(1, 1, '$BT_5'   , '5'   , Ord(cbDig5));
  191.   AddGridButton(1, 2, '$BT_6'   , '6'   , Ord(cbDig6));
  192.   AddGridButton(1, 3, '$BT_MUL' , '*'   , Ord(cbMul ));
  193.   AddGridButton(1, 4, '$BT_PERC', '%'   , Ord(cbPrec));
  194.   AddGridButton(2, 0, '$BT_1'   , '1'   , Ord(cbDig1));
  195.   AddGridButton(2, 1, '$BT_2'   , '2'   , Ord(cbDig2));
  196.   AddGridButton(2, 2, '$BT_3'   , '3'   , Ord(cbDig3));
  197.   AddGridButton(2, 3, '$BT_SUB' , '-'   , Ord(cbSub ));
  198.   AddGridButton(2, 4, '$BT_INV' , '1|x' , Ord(cbInv ));
  199.   AddGridButton(3, 0, '$BT_0'   , '0'   , Ord(cbDig0));
  200.   AddGridButton(3, 1, '$BT_NEG' , '+|-' , Ord(cbNeg ));
  201.   AddGridButton(3, 2, '$BT_SEP' , DecimalSeparator,  Ord(cbSep));
  202.   AddGridButton(3, 3, '$BT_ADD' , '+'   ,  Ord(cbAdd));
  203.   AddGridButton(3, 4, '$BT_RES' , '='   ,  Ord(cbRes));
  204. end;
  205.  
  206. procedure TDCCustomCalculator.CreateSpecButtons;
  207.  var
  208.   BoundsRect: TRect;
  209.   Button: TDCEditButton;
  210. begin
  211.   with Buttons do
  212.   begin
  213.     BoundsRect := Rect(FGridOffset.X + FElementSize.X + 4, FGridOffset.Y,
  214.                        FElementSize.X * 3, FElementSize.Y);
  215.     Button := AddButtonEx(TDCCalcButton);
  216.     with Button do
  217.     begin
  218.       Name    := '$BT_BKS';
  219.       Caption := 'Backspase';
  220.       SetBounds(BoundsRect);
  221.       SetButtonProperty(Button, Ord(cbBks));
  222.     end;
  223.  
  224.     BoundsRect := Rect(BoundsRect.Left + BoundsRect.Right, BoundsRect.Top,
  225.                        FElementSize.X, FElementSize.Y);
  226.     Button := AddButtonEx(TDCCalcButton);
  227.     with Button do
  228.     begin
  229.       Name    := '$BT_DEL';
  230.       Caption := 'CE';
  231.       SetBounds(BoundsRect);
  232.       SetButtonProperty(Button, Ord(cbDel));
  233.     end;
  234.  
  235.     BoundsRect := Rect(BoundsRect.Left + BoundsRect.Right, BoundsRect.Top,
  236.                        FElementSize.X, FElementSize.Y);
  237.     Button := AddButtonEx(TDCCalcButton);
  238.     with Button do
  239.     begin
  240.       Name    := '$BT_C';
  241.       Caption := 'C';
  242.       SetBounds(BoundsRect);
  243.       SetButtonProperty(Button, Ord(cbC));
  244.     end;
  245.  
  246.     BoundsRect := Rect(FGridOffset.X, FGridOffset.Y +FElementSize.Y+4,
  247.                        FElementSize.X, FElementSize.Y);
  248.     Button := AddButtonEx(TDCCalcButton);
  249.     with Button do
  250.     begin
  251.       Name    := '$BT_MC';
  252.       Caption := 'MC';
  253.       SetBounds(BoundsRect);
  254.       SetButtonProperty(Button, Ord(cbMemC));
  255.     end;
  256.  
  257.     BoundsRect := Rect(BoundsRect.Left, BoundsRect.Top+BoundsRect.Bottom,
  258.                        FElementSize.X, FElementSize.Y);
  259.     Button := AddButtonEx(TDCCalcButton);
  260.     with Button do
  261.     begin
  262.       Name    := '$BT_MR';
  263.       Caption := 'MR';
  264.       SetBounds(BoundsRect);
  265.       SetButtonProperty(Button, Ord(cbMemR));
  266.     end;
  267.  
  268.     BoundsRect := Rect(BoundsRect.Left, BoundsRect.Top+BoundsRect.Bottom,
  269.                        FElementSize.X, FElementSize.Y);
  270.     Button := AddButtonEx(TDCCalcButton);
  271.     with Button do
  272.     begin
  273.       Name    := '$BT_MS';
  274.       Caption := 'MS';
  275.       SetBounds(BoundsRect);
  276.       SetButtonProperty(Button, Ord(cbMemS));
  277.     end;
  278.  
  279.     BoundsRect := Rect(BoundsRect.Left, BoundsRect.Top+BoundsRect.Bottom,
  280.                        FElementSize.X, FElementSize.Y);
  281.     Button := AddButtonEx(TDCCalcButton);
  282.     with Button do
  283.     begin
  284.       Name    := '$BT_M+';
  285.       Caption := 'M+';
  286.       SetBounds(BoundsRect);
  287.       SetButtonProperty(Button, Ord(cbMemP));
  288.     end;
  289.  
  290.     BoundsRect := Rect(FGridOffset.X, BoundsRect.Top+BoundsRect.Bottom+4,
  291.                        5*FElementSize.X+4, FButtonsHeight);
  292.     Button := AddButtonEx(TDCCalcButton);
  293.     with Button do
  294.     begin
  295.       Name    := '$BT_OK';
  296.       Caption := '&OK';
  297.       SetBounds(BoundsRect);
  298.       SetButtonProperty(Button, Ord(cbOk));
  299.     end;
  300.  
  301.     BoundsRect := Rect(BoundsRect.Left + BoundsRect.Right, BoundsRect.Top,
  302.                        FElementSize.X, FButtonsHeight);
  303.     Button := AddButtonEx(TDCCalcButton);
  304.     with Button do
  305.     begin
  306.       Name    := '$BT_Cancel';
  307.       SetBounds(BoundsRect);
  308.       SetButtonProperty(Button, Ord(cbCancel));
  309.       Glyph.LoadFromResourceName(HInstance, 'DC_BTNCANCEL');
  310.     end;
  311.   end;
  312. end;
  313.  
  314. procedure TDCCustomCalculator.DoButtonClick(Sender: TObject);
  315.  var
  316.   ButtonCode: TCalcButtons;
  317. begin
  318.   if Sender is TDCEditButton then
  319.   begin
  320.     ButtonCode := TCalcButtons(TDCEditButton(Sender).Tag);
  321.     case ButtonCode of
  322.       cbDig0:
  323.         if VisibleParam <> '0' then AddToVisibleParam('0');
  324.       cbDig1..cbDig9:
  325.         AddToVisibleParam(Chr(Ord('0')+Ord(ButtonCode)));
  326.       cbDiv, cbMul, cbSub, cbAdd:
  327.         SetOperation(ButtonCode);
  328.       cbSqrt, cbPrec, cbInv, cbNeg, cbRes:
  329.         DoOperation(ButtonCode);
  330.       cbSep:
  331.         if Pos(DecimalSeparator, VisibleParam) = 0 then
  332.         begin
  333.           FClearParam := False;
  334.           AddToVisibleParam(DecimalSeparator);
  335.         end;
  336.       cbBks:
  337.         DoBackspace;
  338.       cbDel:
  339.         ClearVisibleParam;
  340.       cbC:
  341.         begin
  342.           FErrorCode := 0;
  343.           ClearVisibleParam;
  344.           FValues[svStoredParam] := 0;
  345.         end;
  346.       cbMemC:
  347.         MemoryValue  := 0;
  348.       cbMemR:
  349.         VisibleParam := FloatToStr(MemoryValue);
  350.       cbMemS:
  351.         begin
  352.           VisibleParamToFloat;
  353.           MemoryValue  := FValues[svVisibleParam];
  354.         end;
  355.       cbMemP:
  356.         AddToMemory;
  357.       cbOk:
  358.         CloseUp(1);
  359.       cbCancel:
  360.         CloseUp(0);
  361.     end;
  362.   end;
  363. end;
  364.  
  365. procedure TDCCustomCalculator.DrawDisplay;
  366.  var
  367.   DisplayRect: TRect;
  368.   ABrush: HBRUSH;
  369. begin
  370.   DisplayRect := Rect(2, 2, ClientWidth - 4, FDisplayHeight);
  371.   Canvas.Brush.Bitmap := AllocPatternBitmap(clWhite, clBtnFace);
  372.   Canvas.FillRect(DisplayRect);
  373.  
  374.   ABrush := CreateSolidBrush(ColorToRGB(clBtnFace));
  375.   FrameRect(Canvas.Handle, DisplayRect, ABrush);
  376.   DeleteObject(ABrush);
  377.  
  378.   InflateRect(DisplayRect, -4, -2);
  379.   DrawHighLightText(Canvas, PChar(FVisibleParam), DisplayRect, 1,
  380.     DT_RIGHT or DT_VCENTER or DT_SINGLELINE);
  381.  
  382.   Canvas.Brush.Color := Color;
  383. end;
  384.  
  385. procedure TDCCustomCalculator.DrawMemoryStatus;
  386.  var
  387.   DisplayRect: TRect;
  388.   MemoryStatus: string;
  389.   ABrush: HBRUSH;
  390. begin
  391.   DisplayRect := Rect(2, 6 + FDisplayHeight,
  392.                       2 + FElementSize.X, 6 + FDisplayHeight + FElementSize.Y);
  393.   Canvas.Brush.Bitmap := AllocPatternBitmap(clHintBackground, clLite);
  394.   Canvas.FillRect(DisplayRect);
  395.  
  396.   ABrush := CreateSolidBrush(ColorToRGB(clBtnShadow));
  397.   FrameRect(Canvas.Handle, DisplayRect, ABrush);
  398.   DeleteObject(ABrush);
  399.  
  400.   InflateRect(DisplayRect, -4, -2);
  401.  
  402.   if FValues[svMemoryValue] <> 0 then
  403.     MemoryStatus := 'M'
  404.   else
  405.     MemoryStatus := ' ';
  406.  
  407.   DrawHighLightText(Canvas, PChar(MemoryStatus), DisplayRect, 1,
  408.     DT_CENTER or DT_VCENTER or DT_SINGLELINE);
  409.  
  410.   Canvas.Brush.Color := Color;
  411. end;
  412.  
  413. procedure TDCCustomCalculator.DoOperation(Value: TCalcButtons);
  414. begin
  415.   VisibleParamToFloat;
  416.   if FErrorCode = 0 then
  417.   begin
  418.     try
  419.       case Value of
  420.         cbSqrt:
  421.           FValues[svVisibleParam] := Sqrt(FValues[svVisibleParam]);
  422.         cbInv:
  423.           FValues[svVisibleParam] := 1 / FValues[svVisibleParam];
  424.         cbNeg:
  425.           FValues[svVisibleParam] := - FValues[svVisibleParam];
  426.         cbRes:
  427.           if FOperation <> cbDig0 then
  428.           begin
  429.             case FOperation of
  430.               cbDiv:
  431.                 FValues[svVisibleParam] := FValues[svStoredParam] / FValues[svVisibleParam];
  432.               cbMul:
  433.                 FValues[svVisibleParam] := FValues[svStoredParam] * FValues[svVisibleParam];
  434.               cbSub:
  435.                 FValues[svVisibleParam] := FValues[svStoredParam] - FValues[svVisibleParam];
  436.               cbAdd:
  437.                 FValues[svVisibleParam] := FValues[svStoredParam] + FValues[svVisibleParam];
  438.             end;
  439.             FOperation := cbDig0;
  440.           end;
  441.         cbPrec:
  442.           FValues[svVisibleParam] := FValues[svStoredParam] * FValues[svVisibleParam] / 100;
  443.       end;
  444.     except
  445.       on E: Exception do
  446.       begin
  447.         FErrorCode   := -1;
  448.         VisibleParam := E.Message;
  449.       end;
  450.     end;
  451.   end;
  452.   FloatToVisibleParam;
  453.   FClearParam := True;
  454. end;
  455.  
  456. procedure TDCCustomCalculator.SetButtonProperty(Button: TDCEditButton;
  457.   ATag: integer);
  458. begin
  459.   with Button do
  460.   begin
  461.     Visible      := False;
  462.     Tag          := ATag;
  463.     Allignment   := abCenter;
  464.     Glyph        := nil;
  465.     Font         := Self.Font;
  466.     DisableStyle := deNormal;
  467.     BrushColor   := Color;
  468.     AnchorStyle  := asNone;
  469.     OnClick      := DoButtonClick;
  470.     Visible      := True;
  471.     Transparent  := True;
  472.     DoubleBuffered := False;
  473.   end;
  474. end;
  475.  
  476. procedure TDCCustomCalculator.SetElementSize;
  477. begin
  478.   FElementSize := Point(Canvas.TextWidth('sqrt')+8, Canvas.TextHeight('sqrt')+2);
  479. end;
  480.  
  481. procedure TDCCustomCalculator.SetOperation(Value: TCalcButtons);
  482. begin
  483.   if Value = FOperation then DoOperation(cbRes);
  484.   FOperation  := Value;
  485.   FClearParam := True;
  486.   VisibleParamToFloat;
  487.   FValues[svStoredParam] := FValues[svVisibleParam];
  488. end;
  489.  
  490. procedure TDCCustomCalculator.SetVisibleParam(const Value: string);
  491. begin
  492.   if FVisibleParam <> Value then
  493.   begin
  494.     FVisibleParam :=  Value;
  495.     DrawDisplay;
  496.   end;
  497. end;
  498.  
  499. procedure TDCCustomCalculator.WMPaint(var Message: TMessage);
  500. begin
  501.   inherited;
  502.   DrawDisplay;
  503.   DrawMemoryStatus;
  504. end;
  505.  
  506. procedure TDCCustomCalculator.DoBackspace;
  507. begin
  508.   if (FErrorCode = 0) and not(FClearParam) then
  509.   begin
  510.     if Length(VisibleParam) > 1 then
  511.       VisibleParam := Copy(VisibleParam, 1, Length(VisibleParam)-1)
  512.     else
  513.       ClearVisibleParam;
  514.   end;
  515. end;
  516.  
  517. procedure TDCCustomCalculator.ClearVisibleParam;
  518. begin
  519.   if FErrorCode = 0 then
  520.   begin
  521.     VisibleParam := '0';
  522.     FClearParam  := True;
  523.   end;
  524. end;
  525.  
  526. function TDCCustomCalculator.GetMemoryValue: Double;
  527. begin
  528.   Result := FValues[svMemoryValue];
  529. end;
  530.  
  531. procedure TDCCustomCalculator.SetMemoryValue(const Value: Double);
  532.  var
  533.   RefreshStatus: boolean;
  534. begin
  535.   if FErrorCode = 0 then
  536.   begin
  537.     FClearParam := True;
  538.     RefreshStatus := (FValues[svMemoryValue] <> 0) and (Value =  0) or
  539.                      (FValues[svMemoryValue] =  0) and (Value <> 0);
  540.     FValues[svMemoryValue] := Value;
  541.     if RefreshStatus then DrawMemoryStatus;
  542.   end;
  543. end;
  544.  
  545. procedure TDCCustomCalculator.AddToMemory;
  546. begin
  547.   VisibleParamToFloat;
  548.   if FErrorCode = 0 then
  549.   begin
  550.     try
  551.       MemoryValue := MemoryValue + FValues[svVisibleParam];
  552.     except
  553.     end;
  554.   end;
  555. end;
  556.  
  557. procedure TDCCustomCalculator.VisibleParamToFloat;
  558. begin
  559.   if (FErrorCode = 0) and IsValidFloat(VisibleParam) then
  560.   begin
  561.     try
  562.       FValues[svVisibleParam] := StrToFloat(VisibleParam);
  563.     except
  564.       {}
  565.     end;
  566.   end;
  567. end;
  568.  
  569. procedure TDCCustomCalculator.FloatToVisibleParam;
  570. begin
  571.   if FErrorCode = 0 then
  572.   begin
  573.     VisibleParam := FloatToStr(FValues[svVisibleParam]);
  574.   end;
  575. end;
  576.  
  577. procedure TDCCustomCalculator.KeyDown(var Key: Word; Shift: TShiftState);
  578. begin
  579.   inherited;
  580.   with Buttons do
  581.   begin
  582.     case Key of
  583.       $30{VK_0}: DoButtonClick(FindButton('$BT_0'));
  584.       $31{VK_1}: DoButtonClick(FindButton('$BT_1'));
  585.       $32{VK_2}:
  586.         if ssShift in Shift then
  587.           DoButtonClick(FindButton('$BT_SQRT'))
  588.         else
  589.           DoButtonClick(FindButton('$BT_2'));
  590.       $33{VK_3}: DoButtonClick(FindButton('$BT_3'));
  591.       $34{VK_4}: DoButtonClick(FindButton('$BT_4'));
  592.       $35{VK_5}:
  593.         if ssShift in Shift then
  594.           DoButtonClick(FindButton('$BT_PERC'))
  595.         else
  596.           DoButtonClick(FindButton('$BT_5'));
  597.       $36{VK_6}: DoButtonClick(FindButton('$BT_6'));
  598.       $37{VK_7}: DoButtonClick(FindButton('$BT_7'));
  599.       $38{VK_8}:
  600.         if ssShift in Shift then
  601.           DoButtonClick(FindButton('$BT_MUL'))
  602.         else
  603.           DoButtonClick(FindButton('$BT_8'));
  604.       $39{VK_9}: DoButtonClick(FindButton('$BT_9'));
  605.       $4C{L}:
  606.         if ssCtrl in Shift then
  607.           DoButtonClick(FindButton('$BT_MC'));
  608.       $4D{M}:
  609.         if ssCtrl in Shift then
  610.           DoButtonClick(FindButton('$BT_MS'));
  611.       $51{P}:
  612.         if ssCtrl in Shift then
  613.           DoButtonClick(FindButton('$BT_M+'));
  614.       $52{R}:
  615.         if ssCtrl in Shift then
  616.           DoButtonClick(FindButton('$BT_MR'))
  617.         else
  618.           DoButtonClick(FindButton('$BT_INV'));
  619.       $BB:
  620.         if ssShift in Shift then
  621.           DoButtonClick(FindButton('$BT_ADD'))
  622.         else
  623.           DoButtonClick(FindButton('$BT_RES'));
  624.       $BD: DoButtonClick(FindButton('$BT_SUB'));
  625.       $BC, $BE: {DecimalSeparator}
  626.         if Shift = [] then
  627.            DoButtonClick(FindButton('$BT_SEP'));
  628.       $BF: DoButtonClick(FindButton('$BT_DIV'));
  629.       VK_DECIMAL:
  630.         if ssShift in Shift then
  631.           DoButtonClick(FindButton('$BT_CE'))
  632.         else
  633.           DoButtonClick(FindButton('$BT_SEP'));
  634.       VK_DIVIDE  : DoButtonClick(FindButton('$BT_DIV'));
  635.       VK_MULTIPLY: DoButtonClick(FindButton('$BT_MUL'));
  636.       VK_SUBTRACT: DoButtonClick(FindButton('$BT_SUB'));
  637.       VK_ADD     : DoButtonClick(FindButton('$BT_ADD'));
  638.       VK_NUMPAD0 : DoButtonClick(FindButton('$BT_0'));
  639.       VK_NUMPAD1 : DoButtonClick(FindButton('$BT_1'));
  640.       VK_NUMPAD2 : DoButtonClick(FindButton('$BT_2'));
  641.       VK_NUMPAD3 : DoButtonClick(FindButton('$BT_3'));
  642.       VK_NUMPAD4 : DoButtonClick(FindButton('$BT_4'));
  643.       VK_NUMPAD5 : DoButtonClick(FindButton('$BT_5'));
  644.       VK_NUMPAD6 : DoButtonClick(FindButton('$BT_6'));
  645.       VK_NUMPAD7 : DoButtonClick(FindButton('$BT_7'));
  646.       VK_NUMPAD8 : DoButtonClick(FindButton('$BT_8'));
  647.       VK_NUMPAD9 : DoButtonClick(FindButton('$BT_9'));
  648.       VK_BACK    : DoButtonClick(FindButton('$BT_BKS'));
  649.       VK_DELETE  : DoButtonClick(FindButton('$BT_DEL'));
  650.       VK_F9      : DoButtonClick(FindButton('$BT_INV'));
  651.       VK_RETURN  : DoButtonClick(FindButton('$BT_OK'));
  652.       VK_ESCAPE  : DoButtonClick(FindButton('$BT_Cancel'))
  653.     end;
  654.   end;
  655. end;
  656.  
  657. procedure TDCCustomCalculator.CloseUp(State: Byte);
  658. begin
  659.   if Assigned(FCloseUp) then FCloseUp(State);
  660. end;
  661.  
  662. procedure TDCCustomCalculator.CMDialogChar(var Message: TCMDialogChar);
  663.  var
  664.   Button: TDCEditButton;
  665. begin
  666.   Button := Buttons.FindButton('$BT_OK');
  667.   if IsAccel(Message.CharCode, '&Ok' ) then
  668.   begin
  669.     Button.Click;
  670.   end;
  671.  
  672.   Button := Buttons.FindButton('$BT_Cancel');
  673.   if IsAccel(Message.CharCode, '&Cancel') then
  674.   begin
  675.     Button.Click;
  676.   end;
  677.   inherited;
  678. end;
  679.  
  680. { TDCCalcButton }
  681.  
  682. constructor TDCCalcButton.Create(AOwner: TComponent);
  683. begin
  684.   inherited;
  685.   Style := stFlat;
  686. end;
  687.  
  688. procedure TDCCalcButton.DoPaint(ACanvas: TCanvas; ARect: TRect);
  689.  var
  690.   ImageRect, TextRect: TRect;
  691. begin
  692.   ImageRect := GetImageRect;
  693.   TextRect  := GetTextRect(ImageRect);
  694.   OffsetRect(ImageRect, ARect.Left, ARect.Top);
  695.   OffsetRect(TextRect, ARect.Left, ARect.Top);
  696.  
  697.   if not Enabled then
  698.      case DisableStyle of
  699.        deLite  :
  700.          ACanvas.Brush.Bitmap := AllocPatternBitmap(clLite, clBtnFace);
  701.        deNormal:
  702.          ACanvas.Brush.Color  := BrushColor;
  703.        deNone  :
  704.          ACanvas.Brush.Color  := BrushColor;
  705.      end
  706.   else
  707.     case ButtonState of
  708.       btRest, btRestMouseInRect:
  709.         ACanvas.Brush.Color := BrushColor;
  710.       btDownMouseInRect:
  711.         if (ColorToRGB(BrushColor) = clSilver) or (BrushColor = clBtnFace) then
  712.           ACanvas.Brush.Bitmap := AllocPatternBitmap(clWhite, clBtnFace)
  713.         else
  714.           ACanvas.Brush.Color := clBtnFace;
  715.     end;
  716.  
  717. {
  718.   if Transparent and Assigned(OwnerButtons) then
  719.     OwnerButtons.PaintBackground(ARect, Self, ACanvas)
  720.   else
  721. }
  722.   FillRect(ACanvas.Handle, ARect, ACanvas.Brush.Handle);
  723.  
  724.   DrawBorder(ACanvas, ARect);
  725.   DrawBitmap(ACanvas, ImageRect);
  726.   if (Text <> '') and DrawText then DrawEditText(ACanvas, TextRect);
  727. end;
  728.  
  729. procedure TDCCalcButton.DrawBorder(ACanvas: TCanvas; ARect: TRect);
  730.  var
  731.   AButtonState: TButtonState;
  732.   ABrush: HBRUSH;
  733. begin
  734.   AButtonState := ButtonState;
  735.   if not Enabled then AButtonState := btRest;
  736.  
  737.   case AButtonState of
  738.     btRest:
  739.       begin
  740.         if (csDesigning in (Owner as TComponent).ComponentState) then
  741.         begin
  742.           ABrush := CreateSolidBrush(ColorToRGB(clBlack));
  743.           FrameRect(ACanvas.Handle, ARect, ABrush);
  744.           DeleteObject(ABrush);
  745.         end;
  746.       end;
  747.     btDownMouseInRect:
  748.       begin
  749.       end;
  750.     btRestMouseInRect:
  751.       begin
  752.         ABrush := CreateSolidBrush(ColorToRGB(clBlack));
  753.         FrameRect(ACanvas.Handle, ARect, ABrush);
  754.         DeleteObject(ABrush);
  755.       end;
  756.   end;
  757. end;
  758.  
  759. function TDCCalcButton.GetImageOffset: TPoint;
  760. begin
  761.   Result := Point(0, 0);
  762. end;
  763.  
  764. function TDCCalcButton.GetTextOffset: TPoint;
  765. begin
  766.   Result := Point(0, 0);
  767. end;
  768.  
  769. end.
  770.