fccalcedit.pas

一套及时通讯的原码

     (Message.Sender <> Button) and (Message.Sender.Parent <> fDropDownCalc) then
    CloseUp(True);
end;

procedure TfcCustomCalcEdit.DropDown;
var
  P: TPoint;
  X, Y: Integer;
  WinAttribute: HWnd;
  f:extended;

  function GetDeskTopHeight:Integer;
     var Rect1:TRect;
  begin
      if SystemParametersInfo(SPI_GETWORKAREA,0,@Rect1,0) Then
         GetDeskTopHeight:=Rect1.Bottom-Rect1.Top
      else
         GetDeskTopHeight:=Screen.Height;
  end;
begin
  DoBeforeDropdown;
  if (fDropDownCalc <> nil) then exit;

{  if wwCalcHook=0 then
      wwCalcHook := SetWindowsHookEx(WH_MOUSE, @wwCalcHookProc, HINSTANCE, GetCurrentThreadID);
 }
  CalcOptions.Options:= CalcOptions.Options + [cboHideEditor{,cboShowDecimal,cboDigitGrouping}];
  fDropDownCalc := TfcCalcPanel.Create(self);
  fDropDownCalc.Visible := False;
  fDropDownCalc.Height := 175;
  fDropDownCalc.OnSetButtonAttributes := DoCalcButtonAttributes;
  if cboSimpleCalc in CalcOptions.Options then
     fDropDownCalc.Width := 148
  else fDropDownCalc.Width := 250;
  fDropDownCalc.Parent := Self;
  FDropDownCalc.CalcEdit := self;

  try
    if Text='' then abort;
    f:= fcStrToFloat(Text);
  except
    f:=0.0;
  end;


  if (f=0.0) or (fdropdowncalc.Text = '') then begin
    if cboShowDecimal in CalcOptions.Options then fDropDownCalc.Text := '0'+decimalseparator
    else fDropDownCalc.Text := '0';
  end;

  if CalcOptions.background <> nil then begin
     fDropDownCalc.BackgroundBitmapDrawStyle := CalcOptions.BackgroundStyle;
     fDropDownCalc.BackgroundBitmap.Assign(CalcOptions.Background);
  end;

  fDropDownCalc.PanelColor := CalcOptions.PanelColor;
  fDropDownCalc.Options := CalcOptions.Options;
  fDropDownCalc.ButtonMargin := CalcOptions.ButtonMargin;

  P := Parent.ClientToScreen(Point(Left, Top));
  Y := P.Y + Height - 1;
  if BorderStyle = bsNone then y:= y + 1;

  { 11/28/2000 - PYW - Check based on actual work area. }
   if Y + fDropDownCalc.Height > GetDeskTopHeight then Y := P.Y - fDropDownCalc.Height;

   { 4/1/97 - Expand list to left since it goes past edge of screen }
   P.X := P.X+Width-1-FDropDownCalc.width;
   X := P.X;
   if P.X < 0 then X := 0;
   if P.X + fDropDownCalc.Width >= Screen.Width then X := Screen.Width-FDropDownCalc.Width;

   try  //10/15/01 - Uncommented to allow dropdown event to be called.
      Update;
      FDecimalEntered := False;

      DoDropDown;
   except
      exit;
   end;

   { 3/13/97 - Always Top so that drop-down is not hidden under taskbar}
   WinAttribute:= HWND_TOPMOST;
   SetWindowPos(fDropDownCalc.Handle, WinAttribute, X, Y, 0, 0,
     SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);

   fDropDownCalc.visible:= true;
   if FDropdownCalc.StatusLabel <> nil then
      FDropDownCalc.StatusLabel.Caption := Text;
   Windows.SetFocus(Handle);
   Windows.HideCaret(Handle); // Don't show care thwne calculator dropped down

{   if not inAutoDropDown then DoSelectAll;
   if Editable then ShowCaret(Handle);

   LastShowHint:= ShowHint;
   ShowHint:= False;
   Invalidate;      }

end;

{procedure TfcCustomCalcEdit.SetCalcOptions(Value: TfcPopupCalcOptions);
begin
  if FCalcOptions <> Value then
    FCalcOptions := Value;
end;}

procedure TfcCustomCalcEdit.CloseUp(Accept: Boolean);
var IsDroppedDown: Boolean;
    key:word;
begin
  if Accept then begin
     if (FDropDownCalc <> nil) and (Text <> '') then begin
        if ((not FDropDownCalc.LastOperatorEquals) {and (FDropDownCalc.LastOp <> btPercent)})
           and (FDropDownCalc.LastOp <> btNone) then begin
          key := vk_return;
          FDropDownCalc.ResultKeyDown(FDropDownCalc,key,[]);
        end;
     end;
  end;
  IsDroppedDown := self.IsDroppedDown;
  inherited;
  if IsDroppedDown then
    try
      if fDropDownCalc = nil then exit
      else begin
        fDropDownCalc.Free;
        fDropDownCalc := nil;
      end;

      DoCloseUp(Accept);
    finally
       SetFocus;
       if Editable then begin
         SelectAll;
         Windows.ShowCaret(Handle);
       end;
    end;
end;

//10/1/2001-PYW-Added handling for WMCut and WMPaste.
procedure TfcCustomCalcEdit.WMCut(var Message: TMessage);
begin
  if not EditCanModify then exit;
  inherited;
  SetModified(True);
  if (AllowNull = False) and (Text = '') then begin
     if cboShowDecimal in CalcOptions.Options then Text := '0'+decimalseparator
     else Text := '0';
     SelectAll;
  end;
end;

procedure TfcCustomCalcEdit.WMPaste(var Message: TMessage);
var prevText: string;
    prevSelStart: integer;
    f:extended;
begin
  PrevText:= Text;
  PrevSelStart:= selStart;
  if not EditCanModify then exit;
  inherited;
  SetModified(True);
  if (selStart=0) then selStart:= prevSelStart + length(Text) - length(PrevText);

  try
    if Text='' then abort;
    f:= fcStrToRealDef(Text,0.0)
  except
    f:=0.0;
  end;

  if (AllowNull = False) and ((Text = '') or (f=0.0)) then begin
     if cboShowDecimal in CalcOptions.Options then Text := '0'+decimalseparator
     else Text := '0';
     SelectAll;
  end;
end;

procedure TfcCustomCalcEdit.DoCalcButtonAttributes(Calc: TfcCalculator;var AType:TfcCalcButtonType;
  var ACaption:String; var AFontColor:TColor; var AButtonColor:TColor; var AHint:String);
begin
  if DropDownControl <> nil then
     if Assigned(FOnCalcButtonAttributes) then
        FOnCalcButtonAttributes(self,AType,ACaption,AFontColor,AButtonColor,AHint);
end;

function TfcCustomCalcEdit.GetAlignment:TAlignment;
begin
  result := FAlignment;
  if (DataLink<> nil) and (DataLink.Field <> nil) then
     result := DataLink.Field.Alignment;
end;

procedure TfcCustomCalcEdit.UpdateData(Sender: TObject);
begin
  if DataLink.Field.Value <> Value then
     DataLink.Field.Value := Value;
end;

function TfcCustomCalcEdit.GetDropDownControl: TWinControl;
begin
   result:= fDropDownCalc
end;

function TfcCustomCalcEdit.GetDropDownContainer: TWinControl;
begin
   result:= fDropDownCalc
end;

function TfcCustomCalcEdit.GetItemCount: Integer;
begin
  result := 0;
end;

function TfcCustomCalcEdit.GetItemSize: TSize;
begin
  result := fcSize(0, 0);
end;

// Added function to compute what text should be displayed based on DisplayFormat.
function TfcCustomCalcEdit.GetDisplayText(AText:String):string;
begin
  if (DataLink<>nil) and (Datalink.Field<>nil) then begin
     if DisplayFormat <> '' then
        result := FormatFloat(DisplayFormat,Datalink.Field.AsFloat)
     else result := Datalink.Field.DisplayText;
  end
  else if (DisplayFormat <> '') then
//     result := FormatFloat(DisplayFormat,fcStrToRealDef(AText,0.0))
     result := FormatFloat(DisplayFormat,fcStrToFloat(AText,DisplayFormat))
  else result := AText;
end;

function TfcCustomCalcEdit.SkipInheritedPaint : boolean;
begin
   result := (not FFocused) or (csPaintCopy in ControlState) or
             (FFocused and (DataLink <>nil) and (Datalink.Field<>nil));
end;


procedure TfcCustomCalcEdit.Paint;
begin
  PaintToCanvas(Canvas, GetClientEditRect, True, False, Text);
end;

//procedure PaintToCanvas(ACanvas: TCanvas; Rect: TRect; Highlight, GridPaint: Boolean;
//      Text: string); override;
procedure TfcCustomCalcEdit.PaintToCanvas(Canvas: TCanvas; Rect: TRect;
  Highlight, GridPaint: Boolean; aText: string);
var OldBkMode: Integer;
    Flags: UINT;
    TempRect:TRect;
    OldBkColor:TColor;

    function GetTextRect:TRect;
    begin
       result := Classes.Rect(Rect.Left + GetLeftIndent + 2,
                              Rect.Top + 2,
                              Rect.Right,Rect.Bottom);
       {$ifdef fcDelphi4Up}
       if fcIsInwwObjectView(self) then begin
          result.Top:= result.Top -1;
          result.Left:= result.Left -1; // 1/29/01
       end;
       {$endif}

      if (not fcIsInwwObjectView(self)) and
         Frame.IsFrameEffective then
      begin
         Frame.GetFrameTextPosition(result.Left, result.top, FFocused);
         result.left:= result.Left + GetLeftIndent + 1;
         if AlignmentVertical = fcavCENTER then result.top:= result.Top -1;
      end
    end;

  function DrawHighlight:boolean;
  begin
     result := ((not Editable and Focused) or fcParentGridFocused(Self));
     if csPaintCopy in ControlState then result:= False;
  end;

  procedure PaintText;
  begin
    flags := DT_TOP or DT_SINGLELINE;
    case Alignment of
      taLeftJustify: Flags := Flags or DT_LEFT;
      taRightJustify:  Flags := Flags or DT_RIGHT;
      taCenter:  Flags := Flags or DT_CENTER;
    end;

    TempRect := GetTextRect;

    temprect.right := Temprect.right-3;  //10/04/2001-????

    if not fcIsInwwGrid(self) then begin
       TempRect.left:= TempRect.left - 1;
       TempRect.Top:= TempRect.Top - 1;
    end
    else if fcIsClass(parent.classtype, 'TwwDBGrid') then
    begin
       if not (dgRowLines in fcGetGridOptions(self)) then TempRect.Top:= TempRect.Top -1;
    end;

    if Frame.IsFrameEffective then begin  //10/04/2001-????
//       temprect.right := Temprect.right+1;
       temprect.top := Temprect.top+1;
    end;

    if fcIsInwwObjectViewPaint(self) or
       (IsTransparentEffective and not FFocused) or fcIsInwwGridPaint(self) then
       SetBkMode(Canvas.Handle, TRANSPARENT)
    else
       SetBkMode(Canvas.Handle, OPAQUE);
    if (not FFocused) and IsTransparentEffective and (Frame.NonFocusTransparentFontColor<>clNone) then
        Canvas.Font.Color:= Frame.NonFocusTransparentFontColor;

    // 8/1/02
    if (not IsTransparentEffective) and (not fcIsInwwGridPaint(self)) then
      if (not FFocused) and (Frame.Enabled) and (Frame.NonFocusColor<>clNone) then
         Canvas.Brush.Color:= Frame.NonFocusColor;

    // 3/1/2002 - Enabled Inplace Edit so that end-user can modify an existing number.  Modified behavior to
    //            paint focused text without special formatting characters for ease of calculation and natural
    //            use by end-user.

    if FFocused and (DataLink<>nil) and (Datalink.Field<>nil) then
        aText := FloatToStr(Value)
    else aText := GetDisplayText(aText);  //10/5/2001-DisplayText based on displayformat

    DrawText(Canvas.Handle,PChar(aText),Length(aText),TempRect,Flags);
  end;

  function PaintCopyOutsideGrid: boolean;
  begin
     result:= not
       ((not fcIsInwwGrid(self)) and (not (csPaintcopy in ControlState)))
  end;

begin
  OldBkColor := GetBkColor(Canvas.Handle);
  OldBkMode := GetBkMode(Canvas.Handle);
  Canvas.Font := Font; { 7/8/99 - Fixes problem where font not set for csPaintCopy }

  if (not enabled) and (color<>clGrayText) then { 3/7/00 - Use disablec color }
     Canvas.font.color:= clGrayText;
  try
     // Draw Highlight rect with focus rect
     if (csPaintCopy in ControlState) or // 1/31/01
        (fcIsInwwGrid(self) and (not Focused or not Highlight)) then
     begin
        if not fcIsInwwGrid(self) then Rect.Right := BtnParent.Left-1;

        // Draw Background in the Highlight color and surround it with a focus rect
        if (not fcIsInwwGrid(self)) or (not GridPaint) then
           Canvas.Brush.Color := fcThisThat(Highlight and (DrawHighlight or Not PaintCopyOutsideGrid), clHighlight, self.Color);

        if (not IsTransparentEffective) and not fcIsInwwObjectViewPaint(self) and
           not (fcIsInwwGridPaint(self)) then Canvas.FillRect(Rect);

        if (not GridPaint) and Highlight and (DrawHighlight or Not PaintCopyOutsideGrid) then
        begin
           SetBkColor(Canvas.Handle, ColorToRGB(clHighlightText));
           SetTextColor(Canvas.Handle, ColorToRGB(clHighlight));
           Canvas.DrawFocusRect(Rect);
        end;

        // Draw the text
        if not fcIsInwwGrid(self) or (not GridPaint) then begin
           SetBkMode(Canvas.Handle, TRANSPARENT);
           SetBkColor(Canvas.Handle, ColorToRGB(fcThisThat(Highlight and (DrawHighlight or Not PaintCopyOutsideGrid), clHighlight, clWindow)));
           SetTextColor(Canvas.Handle, ColorToRGB(fcThisThat(Highlight and (DrawHighlight or Not PaintCopyOutsideGrid), clWindow, Font.Color)));
        end;

        PaintText;
     end
     else if not fcisinwwGrid(Self) and (not FFocused) and
       ((csPaintCopy in ControlState) or True{Frame.IsFrameEffective}) then begin
        Canvas.Brush.Color := Color;  //1/21/2002 - Color not set when control loses focus.
        PaintText;
     end;

     if Frame.IsFrameEffective then
     begin
       DrawFrame(Canvas);
     end;

  finally
     SetBkMode(Canvas.Handle,OldBkMode);
     SetBkColor(Canvas.Handle, OldBkColor);
  end;
end;

function TfcCustomCalcEdit.GetEditRect: TRect;
begin
  result:= inherited GetEditRect;
  if Frame.IsFrameEffective then
     inc(result.right, +1);
end;

// Select all when gettin focus
procedure TfcCustomCalcEdit.CMEnter(var Message: TCMEnter);
begin
  inherited;
{  FSkipTextChangedFlag := True;
  Text := FloatToStr(Value);
  FSkipTextChangedFlag := False;}

  if autoselect then SelectAll;
end;

procedure TfcCustomCalcEdit.DataChange(Sender: TObject);
begin
  if DataLink.Field <> nil then
  begin
    if not (csDesigning in ComponentState) then
    begin
      if (DataLink.Field.DataType = ftString) and (MaxLength = 0) then
        MaxLength := DataLink.Field.Size;
    end;
// 3/1/2002 - Enabled Inplace Edit so that end-user can modify an existing number.  Modified behavior to
//            paint focused text without special formatting characters for ease of calculation and natural
//            use by end-user.
    if Focused and DataLink.CanModify then begin
      if DataLink.Field.Text <> '' then //3/11/2002 - PYW - Handle Null Case in new DataChange procedure.
         Text:=  floatToStr(fcStrToFloat(DataLink.Field.Text ))
      else Text := '';
    end
    else begin
      Text := DataLink.Field.DisplayText;
    end;
  end else
  begin
    if csDesigning in ComponentState then
      Text := Name else
      Text := '';
  end;
end;

{

procedure Register;
begin
  RegisterComponents('Samples', [TfcCustomCalcEdit]);
end;
}
end.