{*********************************************************} {* OVCEDCLC.PAS 4.06 *} {*********************************************************} {* ***** BEGIN LICENSE BLOCK ***** *} {* Version: MPL 1.1 *} {* *} {* The contents of this file are subject to the Mozilla Public License *} {* Version 1.1 (the "License"); you may not use this file except in *} {* compliance with the License. You may obtain a copy of the License at *} {* http://www.mozilla.org/MPL/ *} {* *} {* Software distributed under the License is distributed on an "AS IS" basis, *} {* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *} {* for the specific language governing rights and limitations under the *} {* License. *} {* *} {* The Original Code is TurboPower Orpheus *} {* *} {* The Initial Developer of the Original Code is TurboPower Software *} {* *} {* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *} {* TurboPower Software Inc. All Rights Reserved. *} {* *} {* Contributor(s): *} {* *} {* ***** END LICENSE BLOCK ***** *} {$I OVC.INC} {$B-} {Complete Boolean Evaluation} {$I+} {Input/Output-Checking} {$P+} {Open Parameters} {$T-} {Typed @ Operator} {.W-} {Windows Stack Frame} {$X+} {Extended Syntax} unit ovcedclc; {-numeric edit field with popup calculator} interface uses {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF} Buttons, Classes, Controls, Forms, Graphics, Menus, StdCtrls, SysUtils, {$IFDEF VERSION4}{$IFNDEF LCL} MultiMon, {$ENDIF}{$ENDIF} OvcBase, OvcCalc, OvcEdPop, OvcMisc; type TOvcCustomNumberEdit = class(TOvcEdPopup) {.Z+} protected {private} FAllowIncDec : Boolean; FCalculator : TOvcCalculator; {internal variables} PopupClosing : Boolean; HoldCursor : TCursor; WasAutoScroll : Boolean; {property methods} function GetAsFloat : Double; function GetAsInteger : LongInt; function GetAsString : string; function GetPopupColors : TOvcCalcColors; function GetPopupDecimals : Integer; function GetPopupFont : TFont; function GetPopupHeight : Integer; function GetPopupWidth : Integer; function GetReadOnly : Boolean; procedure SetAsFloat(Value : Double); procedure SetAsInteger(Value : LongInt); procedure SetAsString(const Value : string); procedure SetPopupColors(Value : TOvcCalcColors); procedure SetPopupDecimals(Value : Integer); procedure SetPopupFont(Value : TFont); procedure SetPopupHeight(Value : Integer); procedure SetPopupWidth(Value : Integer); procedure SetReadOnly(Value : Boolean); {internal methods} procedure PopupButtonPressed(Sender : TObject; Button : TOvcCalculatorButton); procedure PopupKeyDown(Sender : TObject; var Key : Word; Shift : TShiftState); procedure PopupKeyPress(Sender : TObject; var Key : Char); procedure PopupMouseDown(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer); protected procedure DoExit; override; procedure GlyphChanged; override; procedure KeyDown(var Key : Word; Shift : TShiftState); override; procedure KeyPress(var Key : Char); override; {.Z-} property AllowIncDec : Boolean read FAllowIncDec write FAllowIncDec; property PopupColors : TOvcCalcColors read GetPopupColors write SetPopupColors; property PopupDecimals : Integer read GetPopupDecimals write SetPopupDecimals; property PopupFont : TFont read GetPopupFont write SetPopupFont; property PopupHeight : Integer read GetPopupHeight write SetPopupHeight; property PopupWidth : Integer read GetPopupWidth write SetPopupWidth; property ReadOnly : Boolean read GetReadOnly write SetReadOnly; public {.Z+} constructor Create(AOwner : TComponent); override; {.Z-} procedure PopupClose(Sender : TObject); override; procedure PopupOpen; override; property AsInteger : LongInt read GetAsInteger write SetAsInteger; {public properties} property Calculator : TOvcCalculator read FCalculator; property AsFloat : Double read GetAsFloat write SetAsFloat; property AsString : string read GetAsString write SetAsString; end; TOvcNumberEdit = class(TOvcCustomNumberEdit) published {properties} {$IFDEF VERSION4} property Anchors; property Constraints; property DragKind; {$ENDIF} property About; property AllowIncDec; {$IFNDEF LCL} property AutoSelect; {$ENDIF} property AutoSize; property BorderStyle; property ButtonGlyph; property Color; property Ctl3D; property Cursor; property DragCursor; property DragMode; property Enabled; property Font; {$IFNDEF LCL} property HideSelection; {$ENDIF} property LabelInfo; property ParentColor; {$IFNDEF LCL} property ParentCtl3D; {$ENDIF} property ParentFont; property ParentShowHint; property PopupAnchor; property PopupColors; property PopupDecimals; property PopupFont; property PopupHeight; property PopupWidth; property PopupMenu; property ReadOnly; property ShowHint; property ShowButton; property TabOrder; property TabStop; property Visible; {events} property OnChange; property OnClick; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnPopupClose; property OnPopupOpen; property OnStartDrag; end; implementation {*** TOvcCustomNumberEdit ***} constructor TOvcCustomNumberEdit.Create(AOwner : TComponent); begin inherited Create(AOwner); ControlStyle := ControlStyle - [csSetCaption]; FAllowIncDec := False; {load button glyph} {$IFNDEF LCL} FButtonGlyph.Handle := LoadBaseBitmap('ORBTNCLC'); {$ELSE} FButtonGlyph.LoadFromLazarusResource('ORBTNCLC'); {$ENDIF} FButton.Glyph.Assign(FButtonGlyph); FCalculator := TOvcCalculator.CreateEx(Self, True); FCalculator.OnButtonPressed := PopupButtonPressed; FCalculator.OnExit := PopupClose; FCalculator.OnKeyDown := PopupKeyDown; FCalculator.OnKeyPress := PopupKeyPress; FCalculator.OnMouseDown := PopupMouseDown; FCalculator.Visible := False; {to avoid flash at 0,0} FCalculator.Options := [coShowItemCount]; FCalculator.BorderStyle := bsSingle; FCalculator.ParentFont := False; end; procedure TOvcCustomNumberEdit.DoExit; begin if not PopupActive then inherited DoExit; end; function TOvcCustomNumberEdit.GetAsFloat : Double; var I : Integer; S : string; begin S := Text; for I := Length(S) downto 1 do if not (S[I] in ['0'..'9', '+', '-', DecimalSeparator]) then Delete(S, I, 1); Result := StrToFloat(S); end; function TOvcCustomNumberEdit.GetAsInteger : LongInt; begin Result := Round(GetAsFloat); end; function TOvcCustomNumberEdit.GetAsString : string; begin Result := Text; end; function TOvcCustomNumberEdit.GetPopupColors : TOvcCalcColors; begin Result := FCalculator.Colors; end; function TOvcCustomNumberEdit.GetPopupDecimals : Integer; begin Result := FCalculator.Decimals; end; function TOvcCustomNumberEdit.GetPopupFont : TFont; begin Result := FCalculator.Font; end; function TOvcCustomNumberEdit.GetPopupHeight : Integer; begin Result := FCalculator.Height; end; function TOvcCustomNumberEdit.GetPopupWidth : Integer; begin Result := FCalculator.Width; end; function TOvcCustomNumberEdit.GetReadOnly : Boolean; begin Result := inherited ReadOnly; end; procedure TOvcCustomNumberEdit.GlyphChanged; begin inherited GlyphChanged; if FButtonGlyph.Empty then {$IFNDEF LCL} FButtonGlyph.Handle := LoadBaseBitmap('ORBTNCLC'); {$ELSE} FButtonGlyph.LoadFromLazarusResource('ORBTNCLC'); {$ENDIF} end; procedure TOvcCustomNumberEdit.KeyDown(var Key : Word; Shift : TShiftState); begin inherited KeyDown(Key, Shift); if (Key = VK_DOWN) and (ssAlt in Shift) then PopupOpen; end; procedure TOvcCustomNumberEdit.KeyPress(var Key : Char); var D : Double; X : Integer; L : Integer; begin inherited KeyPress(Key); if not ((Key = #22) or (Key = #3) or (Key = #24)) then begin if not (Key in [#27, '0'..'9', '.', DecimalSeparator, #8, '+', '-', '*', '/']) then begin Key := #0; {$IFNDEF LCL} MessageBeep(0); {$ENDIF} Exit; end; {Disallow more than one DecimalSeparator in the number} if (SelLength <> Length(Text)) and (Key = DecimalSeparator) and (Pos(DecimalSeparator, Text) > 0) then begin Key := #0; {$IFNDEF LCL} MessageBeep(0); {$ENDIF} Exit; end; if FAllowIncDec and (Key in ['+', '-']) then begin if Text = '' then Text := '0'; D := StrToFloat(Text); X := SelStart; L := SelLength; if Key = '+' then Text := FloatToStr(D+1) else {'-'} Text := FloatToStr(D-1); SelStart := X; SelLength := L; Key := #0; {clear key} end; if (Key in ['+', '*', '/']) then begin PopUpOpen; FCalculator.KeyPress(Key); Key := #0; {clear key} end; end; end; procedure TOvcCustomNumberEdit.PopupButtonPressed(Sender : TObject; Button : TOvcCalculatorButton); begin case Button of cbEqual : begin {get the current value} Text := FloatToStr(FCalculator.DisplayValue); Modified := True; {hide the calculator} PopupClose(Sender); SetFocus; SelStart := Length(Text); SelLength := 0; end; end; end; procedure TOvcCustomNumberEdit.PopupClose(Sender : TObject); begin if not FCalculator.Visible then Exit; {already closed, exit} if PopupClosing then Exit; PopupClosing := True; {avoid recursion} try inherited PopupClose(Sender); if GetCapture = FCalculator.Handle then ReleaseCapture; SetFocus; FCalculator.Hide; {hide the calculator} TForm(FCalculator.Parent).AutoScroll := WasAutoScroll; Cursor := HoldCursor; {change parentage so that we control the window handle destruction} FCalculator.Parent := Self; finally PopupClosing := False; end; end; procedure TOvcCustomNumberEdit.PopupKeyDown(Sender : TObject; var Key : Word; Shift : TShiftState); var X : Integer; begin case Key of VK_TAB : begin if Shift = [ssShift] then begin PopupClose(Sender); PostMessage(Handle, WM_KeyDown, VK_TAB, Integer(ssShift)); end else if Shift = [] then begin PopupClose(Sender); PostMessage(Handle, WM_KeyDown, VK_TAB, 0); end; end; VK_UP : if Shift = [ssAlt] then begin PopupClose(Sender); X := SelStart; SetFocus; SelStart := X; SelLength := 0; end; end; end; procedure TOvcCustomNumberEdit.PopupKeyPress(Sender : TObject; var Key : Char); var X : Integer; begin case Key of #27 : begin PopupClose(Sender); X := SelStart; SetFocus; SelStart := X; SelLength := 0; end; end; end; procedure TOvcCustomNumberEdit.PopupMouseDown(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer); var P : TPoint; I : Integer; begin P := Point(X,Y); if not PtInRect(FCalculator.ClientRect, P) then PopUpClose(Sender); {convert to our coordinate system} P := ScreenToClient(FCalculator.ClientToScreen(P)); if PtInRect(ClientRect, P) then begin I := SelStart; SetFocus; SelStart := I; SelLength := 0; end; end; procedure TOvcCustomNumberEdit.PopupOpen; var P : TPoint; R : TRect; {$IFDEF VERSION4} {$IFNDEF LCL} F : TCustomForm; MonInfo : TMonitorInfo; {$ENDIF} {$ENDIF} begin if FCalculator.Visible then Exit; {already popped up, exit} inherited PopupOpen; FCalculator.Parent := GetImmediateParentForm(Self); if FCalculator.Parent is TForm then begin WasAutoScroll := TForm(FCalculator.Parent).AutoScroll; TForm(FCalculator.Parent).AutoScroll := False; end; {set 3d to be the same as our own} {$IFNDEF LCL} FCalculator.ParentCtl3D := False; {$ENDIF} FCalculator.Ctl3D := False; {determine the proper position} SystemParametersInfo(SPI_GETWORKAREA, 0, @R, 0); {$IFDEF VERSION4} {$IFNDEF LCL} F := GetParentForm(Self); if Assigned(F) then begin FillChar(MonInfo, SizeOf(MonInfo), #0); MonInfo.cbSize := SizeOf(MonInfo); GetMonitorInfo(F.Monitor.Handle, @MonInfo); R := MonInfo.rcWork; end; {$ENDIF} {$ENDIF} if FPopupAnchor = paLeft then P := ClientToScreen(Point(-3, Height-4)) else {paRight} P := ClientToScreen(Point(Width-FCalculator.Width-1, Height-2)); if not Ctl3D then begin Inc(P.X, 3); Inc(P.Y, 3); end; if P.Y + FCalculator.Height >= R.Bottom then P.Y := P.Y - FCalculator.Height - Height; if P.X + FCalculator.Width >= R.Right then P.X := R.Right - FCalculator.Width - 1; if P.X <= R.Left then P.X := R.Left + 1; {$IFNDEF LCL} MoveWindow(FCalculator.Handle, P.X, P.Y, FCalculator.Width, FCalculator.Height, False); {$ENDIF} HoldCursor := Cursor; Cursor := crArrow; FCalculator.PressButton(cbClear); FCalculator.Show; FCalculator.Visible := True; if Text <> '' then FCalculator.PushOperand(AsFloat) else FCalculator.PushOperand(0); FCalculator.SetFocus; SetCapture(FCalculator.Handle); end; procedure TOvcCustomNumberEdit.SetAsFloat(Value : Double); begin Text := FloatToStr(Value); end; procedure TOvcCustomNumberEdit.SetAsInteger(Value : LongInt); begin Text := IntToStr(Value); end; procedure TOvcCustomNumberEdit.SetAsString(const Value : string); begin Text := Value; end; procedure TOvcCustomNumberEdit.SetPopupColors(Value : TOvcCalcColors); begin FCalculator.Colors := Value; end; procedure TOvcCustomNumberEdit.SetPopupDecimals(Value : Integer); begin FCalculator.Decimals := Value; end; procedure TOvcCustomNumberEdit.SetPopupFont(Value : TFont); begin if Assigned(Value) then FCalculator.Font.Assign(Value); end; procedure TOvcCustomNumberEdit.SetPopupHeight(Value : Integer); begin FCalculator.Height := Value; end; procedure TOvcCustomNumberEdit.SetPopupWidth(Value : Integer); begin FCalculator.Width := Value; end; procedure TOvcCustomNumberEdit.SetReadOnly(Value : Boolean); begin inherited ReadOnly := Value; FButton.Enabled := not ReadOnly; end; end.