bscalc.pas

漂亮的皮肤控件 for delphi 567

begin
  inherited;
  ButtonMode := True;
  FValue := 0;
  FIncrement := 1;
  FDecimal := 2;
  StopCheck := True;
  Text := '0';
  StopCheck := False;
  FromEdit := False;
  Width := 120;
  Height := 20;
  FSkinDataName := 'buttonedit';
  OnButtonClick := ButtonClick;
  FCalc := TbsPopupCalculatorForm.Create(Self);
  FCalc.Visible := False;
  FCalc.CalcEdit := Self;
  FCalc.Parent := Self;
  FMemory := 0.0;
  FPrecision := DefCalcPrecision;
  FCalcButtonSkinDataName := 'toolbutton';
  FCalcDisplayLabelSkinDataName := 'label';
  FAlphaBlend := False;
  FAlphaBlendValue := 0;
end;

destructor TbsSkinCalcEdit.Destroy;
begin
  FCalc.Free;
  inherited;
end;

procedure TbsSkinCalcEdit.CMCancelMode(var Message: TCMCancelMode);
begin
  if (Message.Sender <> FCalc) and
     not FCalc.ContainsControl(Message.Sender)
  then
    CloseUp;
end;

procedure TbsSkinCalcEdit.CloseUp;
begin
  if FCalc.Visible then FCalc.Hide;
  if CheckW2KWXP and FAlphaBlend
  then
    SetWindowLong(FCalc.Handle, GWL_EXSTYLE,
                  GetWindowLong(Handle, GWL_EXSTYLE) and not WS_EX_LAYERED);
end;

procedure TbsSkinCalcEdit.DropDown;
var
  i, Y: Integer;
  P: TPoint;
begin
 with FCalc do
  begin
    SkinData := Self.SkinData;
    FCalcPanel.SkinData := Self.SkinData;
    FDisplayLabel.DefaultFont := FDefaultFont;
    FDisplayLabel.SkinDataName := FCalcDisplayLabelSkinDataName;
    FDisplayLabel.SkinData := Self.SkinData;
    for i := 0 to FCalcPanel.ControlCount - 1 do
    if FCalcPanel.Controls[i] is TbsSkinSpeedButton then
    with TbsSkinSpeedButton(FCalcPanel.Controls[i]) do
    begin
      DefaultFont := Self.DefaultFont;
      DefaultHeight := 25;
      SkinDataName := FCalcButtonSkinDataName;
      SkinData := Self.SkinData;
    end
    else
    if FCalcPanel.Controls[i] is TbsSkinStdLabel then
    with TbsSkinStdLabel(FCalcPanel.Controls[i]) do
    begin
      DefaultFont := Self.DefaultFont;
      SkinData := Self.SkinData;
    end;
    TCalculatorPanel(FCalcPanel).FMemory := Self.FMemory;
    TCalculatorPanel(FCalcPanel).UpdateMemoryLabel;
    TCalculatorPanel(FCalcPanel).FPrecision := Max(2, Self.Precision);
    TCalculatorPanel(FCalcPanel).FBeepOnError := False;
    if Self.FValue <> 0 then begin
      TCalculatorPanel(FCalcPanel).DisplayValue := Self.FValue;
      TCalculatorPanel(FCalcPanel).FStatus := csFirst;
      TCalculatorPanel(FCalcPanel).FOperator := '=';
    end;
    Width := 209;
    //
    if FIndex = -1
    then
      Height := FCalcPanel.Height + FDisplayLabel.Height + 2
    else
      Height := FCalcPanel.Height + FDisplayLabel.Height +
      (RectHeight(SkinRect) - RectHeight(ClRect));
    //
    P := Self.Parent.ClientToScreen(Point(Self.Left, Self.Top));
    Y := P.Y + Self.Height;
    if Y + FCalc.Height > Screen.Height then Y := P.Y - FCalc.Height;
    if P.X + FCalc.Width > Screen.Width
    then P.X := Screen.Width - FCalc.Width;
    if P.X < 0 then P.X := 0;
    FCalc.Left := P.X;
    FCalc.Top := Y;
    //
    if CheckW2KWXP and FAlphaBlend
    then
      begin
        SetWindowLong(FCalc.Handle, GWL_EXSTYLE,
                      GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
        SetAlphaBlendTransparent(FCalc.Handle, 0)
      end;
    FCalc.Show(P.X, Y);
    //
    if FAlphaBlend and not FAlphaBlendAnimation and CheckW2KWXP
    then
      begin
        Application.ProcessMessages;
        SetAlphaBlendTransparent(FCalc.Handle, FAlphaBlendValue)
      end
    else
    if CheckW2KWXP and FAlphaBlend and FAlphaBlendAnimation
    then
      begin
        Application.ProcessMessages;
        I := 0;
        repeat
          Inc(i, 2);
          if i > FAlphaBlendValue then i := FAlphaBlendValue;
          SetAlphaBlendTransparent(FCalc.Handle, i);
        until i >= FAlphaBlendValue;
      end;
  end;
end;

procedure TbsSkinCalcEdit.ButtonClick(Sender: TObject);
begin
  if FCalc.Visible then CloseUp else DropDown;
end;

procedure TbsSkinCalcEdit.SetValueType(NewType: TbsValueType);
begin
  if FValueType <> NewType
  then
    begin
      FValueType := NewType;
      if FValueType = vtInteger
      then
        begin
          FIncrement := Round(FIncrement);
          if FIncrement = 0 then FIncrement := 1;
        end;
  end;
end;

procedure TbsSkinCalcEdit.SetDecimal(NewValue: Byte);
begin
  if FDecimal <> NewValue then begin
    FDecimal := NewValue;
  end;
end;

function TbsSkinCalcEdit.CheckValue;
begin
  Result := NewValue;
  if (FMaxValue <> FMinValue)
  then
    begin
      if NewValue < FMinValue then
      Result := FMinValue
      else if NewValue > FMaxValue then
      Result := FMaxValue;
    end;
end;

procedure TbsSkinCalcEdit.SetMinValue;
begin
  FMinValue := AValue;
end;

procedure TbsSkinCalcEdit.SetMaxValue;
begin
  FMaxValue := AValue;
end;

function TbsSkinCalcEdit.IsNumText;

function GetMinus: Boolean;
var
  i: Integer;
  S: String;
begin
  S := AText;
  i := Pos('-', S);
  if i > 1
  then
    Result := False
  else
    begin
      Delete(S, i, 1);
      Result := Pos('-', S) = 0;
    end;
end;

function GetP: Boolean;
var
  i: Integer;
  S: String;
begin
  S := AText;
  i := Pos(DecimalSeparator, S);
  if i = 1
  then
    Result := False
  else
    begin
      Delete(S, i, 1);
      Result := Pos(DecimalSeparator, S) = 0;
    end;
end;

const
  EditChars = '01234567890-';
var
  i: Integer;
  S: String;
begin
  S := EditChars;
  Result := True;
  if ValueType = vtFloat
  then
    S := S + DecimalSeparator;
  if (Text = '') or (Text = '-')
  then
    begin
      Result := False;
      Exit;
    end;

  for i := 1 to Length(Text) do
  begin
    if Pos(Text[i], S) = 0
    then
      begin
        Result := False;
        Break;
      end;
  end;

  Result := Result and GetMinus;

  if ValueType = vtFloat
  then
    Result := Result and GetP;

end;

procedure TbsSkinCalcEdit.Change;
var
  NewValue, TmpValue: Double;
begin
  if FromEdit then Exit;
  if not StopCheck and IsNumText(Text)
  then
    begin
      if ValueType = vtFloat
      then TmpValue := StrToFloat(Text)
      else TmpValue := StrToInt(Text);
      NewValue := CheckValue(TmpValue);
      if NewValue <> FValue
      then
        begin
          FValue := NewValue;
        end;
      if NewValue <> TmpValue
      then
        begin
          FromEdit := True;
          if ValueType = vtFloat
          then Text := FloatToStrF(NewValue, ffFixed, 15, FDecimal)
          else Text := IntToStr(Round(FValue));
          FromEdit := False;
        end;
    end;
  inherited;  
end;

procedure TbsSkinCalcEdit.CMTextChanged;
begin
  inherited;
end;

procedure TbsSkinCalcEdit.SetValue;
begin
  FValue := CheckValue(AValue);
  StopCheck := True;
  if ValueType = vtFloat
  then
    Text := FloatToStrF(CheckValue(AValue), ffFixed, 15, FDecimal)
  else
    Text := IntToStr(Round(CheckValue(AValue)));
  StopCheck := False;
end;

procedure TbsSkinCalcEdit.KeyPress(var Key: Char);
begin
  if not IsValidChar(Key) then
  begin
    Key := #0;
    MessageBeep(0)
  end;
  if Key <> #0 then
  if FCalc.Visible
  then
    CloseUp
  else
    inherited KeyPress(Key);
end;

function TbsSkinCalcEdit.IsValidChar(Key: Char): Boolean;
begin
  if ValueType = vtInteger
  then
    Result := (Key in ['-', '0'..'9']) or
     ((Key < #32) and (Key <> Chr(VK_RETURN)))
  else
  Result := (Key in [DecimalSeparator, '-', '0'..'9']) or
    ((Key < #32) and (Key <> Chr(VK_RETURN)));
  if ReadOnly and Result and ((Key >= #32) or
     (Key = Char(VK_BACK)) or (Key = Char(VK_DELETE)))
  then
    Result := False;

  if (Key = DecimalSeparator) and (Pos(DecimalSeparator, Text) <> 0)
  then
    Result := False
  else
  if (Key = '-') and (Pos('-', Text) <> 0)
  then
    Result := False;
end;

procedure TbsSkinCalcEdit.WMKillFocus(var Message: TWMKillFocus);
begin
  inherited;
  CloseUp;
end;

constructor TbsPopupCalculatorForm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  BorderStyle := bvFrame;
  ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable];
  CalcEdit := nil;
  { DisplayPanel }
  FDisplayLabel := TbsSkinLabel.Create(Self);
  with FDisplayLabel do begin
    Align := alTop;
    Parent := Self;
    AutoSize := False;
    Alignment := taRightJustify;
    Caption := '0';
    BorderStyle := bvNone;
    DefaultHeight := 20;
    Visible := True;
  end;
  { CalcPanel }
  FCalcPanel := TCalculatorPanel.CreateLayout(Self);
  with TCalculatorPanel(FCalcPanel) do begin
    Align := alTop;
    Parent := Self;
    FControl := FDisplayLabel;
    BorderStyle := bvNone;
    OnOkClick := OkClick;
    OnCancelClick := CancelClick;
    Visible := True;
  end;
end;

destructor TbsPopupCalculatorForm.Destroy;
begin
  FDisplayLabel.Free;
  FCalcPanel.Free;
  inherited;
end;


procedure TbsPopupCalculatorForm.Show(X, Y: Integer);
begin
  SetWindowPos(Handle, HWND_TOP, X, Y, 0, 0,
      SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
  Visible := True;
end;

procedure TbsPopupCalculatorForm.Hide;
begin
  SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
      SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
  Visible := False;
end;

procedure TbsPopupCalculatorForm.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := WS_POPUP;
    ExStyle := WS_EX_TOOLWINDOW;
    AddBiDiModeExStyle(ExStyle);
    WindowClass.Style := CS_SAVEBITS;
  end;
end;

procedure TbsPopupCalculatorForm.WMMouseActivate(var Message: TMessage);
begin
  Message.Result := MA_NOACTIVATE;
end;

procedure TbsPopupCalculatorForm.OkClick(Sender: TObject);
begin
  if CalcEdit <> nil
  then
    begin
      CalcEdit.Value := TCalculatorPanel(FCalcPanel).DisplayValue;
      CalcEdit.CloseUp;
    end;
end;

procedure TbsPopupCalculatorForm.CancelClick(Sender: TObject);
begin
  if CalcEdit <> nil then CalcEdit.CloseUp;
end;

end.