fccalculator.pas

一套及时通讯的原码

begin
  inherited Destroy;
end;

procedure TfcCalcButton.WMRButtonDown(var Message: TWMRButtonDown);
begin
  inherited;
  if FCalc.StatusLabel <> nil then
     FCalc.statuslabel.Caption := Self.Hint;
end;

procedure TfcCalcButton.WMRButtonUp(var Message: TWMRButtonUp);
begin
  inherited;
  FCalc.RefreshSummary;
end;

constructor TfcCalcLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCalc := AOwner as TfcCalculator;
end;

procedure TfcCalcLabel.WMRButtonDown(var Message: TWMRButtonDown);
begin
  inherited;
  if FCalc.StatusLabel <> nil then
     FCalc.statuslabel.Caption := FloatToStr(FCalc.MemoryValue);
end;

procedure TfcCalcLabel.WMRButtonUp(var Message: TWMRButtonUp);
begin
  inherited;
  FCalc.RefreshSummary;
end;

procedure TfcCalcButton.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
  Message.result:= 1;
end;

procedure TfcCalcButton.Paint;
var
  IsDown: Boolean;
  R: TRect;
  P:TPoint;
  MouseinButton:BOolean;
  Btnlight,Btnshadow:TColor;
  SaveFontColor,SaveBrushColor,SavePenColor:TColor;
  StateFlags:integer;
begin
  SaveFontColor:=Canvas.Font.Color;
  SaveBrushColor:=Canvas.Brush.Color;
  SavePenColor:=Canvas.Pen.Color;

  try
     Canvas.Lock;
     if (csDesigning in COmponentState) and
        (csNoDesignVisible in ControlStyle) then exit;
     R := ClientRect;

     GetCursorPos(P);
     P:=(screenToClient(p));

     if PtInRect(r,p) then
        MouseInButton := True
     else MouseInButton := False;

     IsDown := FDrawKeyDown or ((csLButtonDown in ControlState) and MouseInButton);

     Canvas.Font := Self.Font;
     Canvas.Pen.Color := clBlack;
     Canvas.Font.Color := ButtonFontColor;
     Canvas.Brush.Color := ButtonColor;

     if FTransparent then begin
        Canvas.CopyRect(ClientRect,(Parent as TfcCalculator).PaintBitmap.Canvas,
          Rect(Left,Top,Left+WIdth,Top+Height));
     end
     else Canvas.FillRect(r);

     if MouseInButton and (cboHotTrackButtons in CalcOptions) and
        not (cboFlatButtons in CalcOptions) and not (cboFlatDrawStyle in CalcOptions) then
     begin
        Canvas.Pen.Color := clWindowFrame;
        Canvas.Pen.Width := 1;
        Canvas.Brush.Style := bsClear;
        if not (cboRoundedButtons in CalcOptions) then begin
           Canvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
  //       else Canvas.RoundRect(R.Left,R.Top,R.Right,R.Bottom,20,20);

      { DrawFrameControl must draw within this border }
       InflateRect(R, -1, -1);
       end;
     end;

     Canvas.Pen.Color := clBtnShadow;
     Canvas.Pen.Width := 1;
     Canvas.Brush.Color := ButtonColor;

     BTnShadow:= changeColor(ButtonColor,False);
     BtnLight := changeColor(ButtonColor,True);
  { DrawFrameControl does not draw a pressed button correctly }
  if IsDown then
  begin
    if (cboFlatDrawStyle in CalcOptions) then begin
      StateFlags:=DFCS_BUTTONPUSH or DFCS_PUSHED or DFCS_CHECKED;
      StateFlags:= StateFlags + DFCS_FLAT;
      DrawFrameControl(Canvas.Handle,R,DFC_BUTTON, StateFlags);
    end
    else begin
      if (cboRoundedButtons in CalcOptions) then begin
         if MouseInButton and (cboHotTrackButtons in CalcOptions) and not (cboFlatButtons in CalcOptions) then begin
            InflateRect(R, -1, -1);
            Canvas.Pen.Width := 2;
         end;
         Canvas.RoundRect(R.Left,R.Top,R.Right,R.Bottom,20,20);
         if MouseInButton and (cboHotTrackButtons in CalcOptions) and not (cboFlatButtons in CalcOptions) then begin
           Canvas.Pen.Color := clWindowFrame;
           Canvas.Pen.Width := 1;
           Canvas.RoundRect(R.Left,R.Top,R.Right,R.Bottom,20,20);
         end;
      end
      else begin
        Canvas.Brush.Style := bsClear;
        Canvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
        Canvas.Pen.Color := BtnShadow;
        Canvas.Polyline([Point(r.left,r.bottom),Point(r.left,r.top),Point(r.right,r.top)]);
        Canvas.Pen.Color := clBlack;
        Canvas.Polyline([Point(r.left+1,r.bottom-1),Point(r.left+1,r.top+1),Point(r.right-1,r.top+1)]);
        Canvas.Pen.Color := BtnLight;
        Canvas.Polyline([Point(r.left+2,r.bottom-2),Point(r.right-2,r.bottom-2),Point(r.right-2,r.top+2)]);
        Canvas.Pen.Color := clWhite;
        Canvas.Polyline([Point(r.left+1,r.bottom-1),Point(r.right-1,r.bottom-1),Point(r.right-1,r.top+1)]);
      end;
      InflateRect(R, -1, -1);
    end;
  end
  else
  begin
    if not (cboFlatButtons in CalcOptions) or
       (PtInRect(r,p) and ((cboHotTrackButtons in CalcOptions))) then begin
      if (cboFlatDrawStyle in CalcOptions) then begin
         StateFlags:=DFCS_BUTTONPUSH;
         StateFlags:= StateFlags + DFCS_FLAT;
         DrawFrameControl(Canvas.Handle,R,DFC_BUTTON, StateFlags);
      end
      else begin
         Canvas.Brush.Style := bsClear;
         if (cboRoundedButtons in CalcOptions) then begin
           if MouseInButton and (cboHotTrackButtons in CalcOptions) and not (cboFlatButtons in CalcOptions) then begin
              InflateRect(R, -1, -1);
              Canvas.Pen.Width := 2;
           end;
           Canvas.RoundRect(R.Left,R.Top,R.Right,R.Bottom,20,20);
           if MouseInButton and (cboHotTrackButtons in CalcOptions) and not (cboFlatButtons in CalcOptions) then begin
             Canvas.Pen.Color := clWindowFrame;
             Canvas.Pen.Width := 1;
             Canvas.RoundRect(R.Left,R.Top,R.Right,R.Bottom,20,20);
           end;
         end
         else begin
           Canvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
           Canvas.Pen.Color := BtnLight;
           Canvas.Polyline([Point(r.left,r.bottom),Point(r.left,r.top),Point(r.right,r.top)]);
           Canvas.Pen.Color := clWhite;
           Canvas.Polyline([Point(r.left+1,r.bottom-1),Point(r.left+1,r.top+1),Point(r.right-1,r.top+1)]);
           Canvas.Pen.Color := BtnShadow;
           Canvas.Polyline([Point(r.left+2,r.bottom-2),Point(r.right-2,r.bottom-2),Point(r.right-2,r.top+1)]);
           Canvas.Pen.Color := clBlack;
           Canvas.Polyline([Point(r.left+1,r.bottom-1),Point(r.right-1,r.bottom-1),Point(r.right-1,r.top)]);
         end;
       end;
    end;

//    InflateRect(R, -1, -1);
  end;

  if PtInRect(r,p) and False then
  begin
    R := ClientRect;
    InflateRect(R, -1, -1);
  end;

  if IsDown then
    OffsetRect(R, 1, 1);

  Canvas.Brush.Style := bsClear;
  DrawText(Canvas.Handle,PChar(Caption),length(caption),R,DT_CENTER or DT_VCENTER or DT_SINGLELINE);

{ if PtInRect(r,p) or False then
  begin
    R := ClientRect;
    InflateRect(R, -4, -4);
    Canvas.Pen.Color := clWindowFrame;
    Canvas.Brush.Color := clBtnFace;
//    DrawFocusRect(Canvas.Handle, R);
  end;}
  finally
     Canvas.Font.COlor := SaveFontColor;
     Canvas.Brush.Color := SaveBrushColor;
     Canvas.Pen.COlor := SavePenColor;
     Canvas.Unlock;
  end;
end;

procedure TfcCalcButton.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if (cboHotTrackButtons in CalcOptions) and not (cboFlatDrawStyle in CalcOptions) then
     Invalidate;
end;

procedure TfcCalcButton.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if (cboHotTrackButtons in CalcOptions) and not (cboFlatDrawStyle in CalcOptions) then
     Invalidate;

end;

procedure TfcCalcButton.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

{ TfcCalculator }
constructor TfcCalculator.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SetBounds(0,0,250,200);
  FCalcPrecision := 15;
  FMemoryValue := 0;
  FCurrentValue := 0;
  FLastValue := 0;
  Caption := '';
  FDecimalPlaces := -1;
  FMargin := 3;
  FOptions := [];
//  BorderStyle := bsRaisedPanel;
  FPanelColor := clBtnFace;
  FPaintBitmap:= TBitmap.create;
  FBackgroundBitmap:= TPicture.create;
  F3D := False;
  FCalcEdit :=nil;
  FLastButtonType := btNone;
end;

destructor TfcCalculator.Destroy;
begin
  inherited Destroy;
  FPaintBitmap.Free;
  FBackGroundBitmap.Free;
end;

procedure TfcCalculator.DoCreateButton(Calc: TfcCalculator;
    var AType:TfcCalcButtonType;
    var ACaption:String;
    var AFontColor:TColor;
    var AButtonColor:TColor;
    var AHint:String);
begin
   inherited;
   if Assigned(FOnSetButtonAttributes) then
      FOnSetButtonAttributes(Self, AType, ACaption, AFontColor, AButtonColor, AHint);
end;

procedure TfcCalculator.Loaded;
var i:integer;
begin
  inherited;
  CalcButtons;
  if BackGroundBitmap.Graphic.empty then begin
     for i:= 0 to ControlCount-1 do begin
       if COntrols[i] is TfcCalcButton then
         TfcCalcButton(controls[i]).FTransparent := False;
     end;
  end
  else begin
    for i:= 0 to ControlCount-1 do begin
       if COntrols[i] is TfcCalcButton then
         TfcCalcButton(controls[i]).FTransparent := True;
    end;
    InitBitmapsFlag := True;
  end;
end;

function TfcCalculator.CharToButton(c:Char;Ctrl:Boolean):TfcCalcButton;
var i:integer;
begin
  result := nil;
  for i:=0 to Controlcount-1 do begin
    if TfcCalcButton(Controls[i]).FBtnType = CharToOp(c,ctrl) then begin
       result := TfcCalcButton(Controls[i]);
       break;
    end;
  end;
end;

function TfcCalculator.OpToButton(op:TfcCalcButtonType):TfcCalcButton;
var i:integer;
begin
  result := nil;
  for i:=0 to Controlcount-1 do begin
    if TfcCalcButton(Controls[i]).FBtnType = op then begin
       result := TfcCalcButton(Controls[i]);
       break;
    end;
  end;
end;

function TfcCalculator.CharToOp(c:Char;Ctrl:Boolean):TfcCalcButtonType;
begin
  Result := btNone;
  case c of
      '0':Result :=bt0;
      '1':Result :=bt1;
      '2':Result :=bt2;
      '3':Result :=bt3;
      '4':Result :=bt4;
      '5':Result :=bt5;
      '6':Result :=bt6;
      '7':Result :=bt7;
      '8':Result :=bt8;
      '9':Result :=bt9;
      ',','.':Result:=btDecimal;
      '_':Result := btPlusMinus;
      '*':Result := btMultiply;
      '/':Result := btDivide;
      '+':Result := btAdd;
      '-':Result := btSubtract;
      '=':Result := btEquals;
      '@':Result := btSqrt;
      '%':Result := btPercent;
      'r','R': if not Ctrl then Result := btInverse
           else Result := btMRecall;
      'c','C': if not Ctrl then Result := btClear
           else Result := btMClear;
      'e','E': Result := btClearAll;
      'm','M': if Ctrl then Result := btMStore;
      'p','P': if Ctrl then Result := btMAdd;
      'b','B': Result := btBackSpace;
    end;
end;

procedure TfcCalculator.ResultKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
var c:Char;
    fb:TfcCalcButton;
begin
  if Key=vk_Return then c:='='
  else if Key=vk_Delete then c:='c'
  else if Key=vk_Back then c:='b'