thehomectrls.pas

67个控件,回车代替TAB,非空检查,记录数据库中记录的ID,也可自己定义关键字段,关联LABEL以便提示,

        begin
          THSelectNext(Self, Self, True, True);
          Key := 0;
        end;
    else
      inherited;
    end
  else inherited;
end;

procedure TCustomTHEdit.Change;
begin
  inherited;
  FChanged := True;
end;

procedure TCustomTHEdit.DoEnter;
begin
  if THControlEnter(Self) then inherited;
end;

function TCustomTHEdit.Validate: Boolean;
begin
  Result := True;
  if FChanged then
  begin
    if Length(Text) = 0 then
    begin
      if not FNullable then
      begin
        MessageDlg(GetCaption(FCaption, FLeadLabel) + NotNull, mtWarning, [mbOK], 0);
        Result := False;
      end
    end
    else
      case FStyle of
        esNumeric:
          Result := ValidateNumeric;
        esInteger:

          Result := ValidateInteger;
        esDate:
          Result := ValidateDate;
        esTime:
          Result := ValidateTime;
      end;
    if Result and Assigned(FOnValidate) then FOnValidate(Self, Result);
  end;
  if Result then FChanged := False
  else SetFocus;
end;

procedure TCustomTHEdit.Clear;
begin
  inherited;
  FChanged := True;
end;

procedure TCustomTHEdit.Reset;
begin
  FChanged := True;
end;

procedure TCustomTHEdit.Unchange;
begin
  FChanged := False;
end;

function TCustomTHEdit.GetAsFloat: Extended;
begin
  case FStyle of
    esInteger, esDate, esTime:
      Result := StrToIntDef(Text, 0);
  else
    Result := StrToFloatDef(Text, 0);
  end;
end;

function TCustomTHEdit.GetAsString: string;
begin
  case FStyle of
    esNumeric:
      Result := Format('%.' + IntToStr(FScale) + 'f', [StrToFloatDef(Text, 0)]);
    esInteger, esDate, esTime:
      Result := IntToStr(StrToIntDef(Text, 0));
  else
    Result := Text;
  end;
end;

function TCustomTHEdit.GetAsInteger: Longint;
begin
  case FStyle of
    esNumeric:
      Result := Round(StrToFloatDef(Text, 0));
  else
    Result := StrToIntDef(Text, 0);
  end;
end;

function TCustomTHEdit.GetAsDate: Longint;
begin
  Result := StrToIntDate(Text);
end;

function TCustomTHEdit.GetAsTime: Longint;
begin
  Result := StrToIntTime(Text);
end;

function TCustomTHEdit.ValidateInteger: Boolean;
var
  lValue: Longint;
begin
  Result := False;
  try
    lValue := StrToInt(Text);
    if (lValue > Round(FMax)) or (not FMaxable and (lValue >= Round(FMax))) then
      MessageDlg(GetCaption(FCaption, FLeadLabel) + GetRangeMsg(True) + IntToStr(Round(FMax)), mtWarning, [mbOK], 0)
    else if (lValue < Round(FMin)) or (not FMinable and (lValue <= Round(FMin))) then
      MessageDlg(GetCaption(FCaption, FLeadLabel) + GetRangeMsg(False) + IntToStr(Round(FMin)), mtWarning, [mbOK], 0)
    else Result := True;
  except
    MessageDlg(GetCaption(FCaption, FLeadLabel) + '应为整数。', mtWarning, [mbOK], 0);
  end;
end;

function TCustomTHEdit.ValidateNumeric: Boolean;
var
  lfValue: Extended;
  iPos: Integer;
begin
  Result := False;
  try
    lfValue := StrToFloat(Text);
    iPos := Pos('.', Text);
    if (iPos > 0) and (Length(Text) - iPos > FScale) then
      MessageDlg(GetCaption(FCaption, FLeadLabel) + '只能精确到小数点后' + IntToStr(FScale) + '位。', mtWarning, [mbOK], 0)
    else if (lfValue > FMax) or (not FMaxable and (lfValue >= FMax)) then
      MessageDlg(GetCaption(FCaption, FLeadLabel) + GetRangeMsg(True) + Format('%.*f。', [FScale, FMax]), mtWarning, [mbOK], 0)
    else if (lfValue < FMin) or (not FMinable and (lfValue <= FMin)) then
      MessageDlg(GetCaption(FCaption, FLeadLabel) + GetRangeMsg(False) + Format('%.*f。', [FScale, FMin]), mtWarning, [mbOK], 0)
    else
    begin
      Result := True;
      Text := Format('%.*f', [FScale, lfValue]);
    end;
  except
    MessageDlg(GetCaption(FCaption, FLeadLabel) + '应为实数。', mtWarning, [mbOK], 0);
  end;
end;

function TCustomTHEdit.ValidateDate: Boolean;
var
  lValue: Longint;
begin
  Result := False;
  lValue := StrToIntDate(Text);
  if lValue = 0 then MessageDlg(GetCaption(FCaption, FLeadLabel) + '格式应为YYYYMMDD。', mtWarning, [mbOK], 0)
  else if (lValue > FMax) or (not FMaxable and (lValue >= FMax)) then
    MessageDlg(GetCaption(FCaption, FLeadLabel) + GetRangeMsg(True) + IntToStr(Round(FMax)), mtWarning, [mbOK], 0)
  else if (lValue < FMin) or (not FMinable and (lValue <= FMin)) then
    MessageDlg(GetCaption(FCaption, FLeadLabel) + GetRangeMsg(False) + IntToStr(Round(FMin)), mtWarning, [mbOK], 0)
  else Result := True;
end;

function TCustomTHEdit.ValidateTime: Boolean;
var
  lValue: Longint;
begin
  Result := False;
  lValue := StrToIntTime(Text);
  if lValue = -1 then MessageDlg(GetCaption(FCaption, FLeadLabel) + '格式应为HHMMSS。', mtWarning, [mbOK], 0)
  else if (lValue > FMax) or (not FMaxable and (lValue >= FMax)) then
    MessageDlg(GetCaption(FCaption, FLeadLabel) + GetRangeMsg(True) + IntToStr(Round(FMax)), mtWarning, [mbOK], 0)
  else if (lValue < FMin) or (not FMinable and (lValue <= FMin)) then
    MessageDlg(GetCaption(FCaption, FLeadLabel) + GetRangeMsg(False) + IntToStr(Round(FMin)), mtWarning, [mbOK], 0)
  else Result := True;
end;

function TCustomTHEdit.GetRangeMsg(bLess: Boolean): string;
begin
  Result := '必须';
  if bLess then Result := Result + '小于'
  else Result := Result + '大于';
  if FMinable or FMaxable then Result := Result + '等于';
end;

function TCustomTHEdit.GetIsNull: Boolean;
begin
  Result := Length(Text) = 0;
end;

procedure TCustomTHEdit.SetStyle(Value: TTHEditStyle);
begin
  if FStyle <> Value then
  begin
    if (csDesigning in ComponentState) and (not (csReading in ComponentState)) then
      case Value of
        esNumeric:
          begin
            FMin := 0;
            FMax := 10E8;
            FMinable := False;
            FMaxable := False;
            FScale := 2;
            MaxLength := 20;
          end;
        esInteger:
          begin
            FMin := 0;
            FMax := MaxLongint;
            FMinable := False;
            FMaxable := True;
            MaxLength := 10;
          end;
        esDate:
          begin
            FMin := 0;
            FMax := MaxLongint;
            MaxLength := 8;
          end;
        esTime:
          begin
            FMin := 0;
            FMinable := True;
            FMax := MaxLongint;
            MaxLength := 6;
          end;
      end;
    FStyle := Value;
    FChanged := True;
  end;
end;

procedure TCustomTHEdit.SetMin(Value: Extended);
begin
  if FMin <> Value then
  begin
    FMin := Value;
    FChanged := True;
  end;
end;

procedure TCustomTHEdit.SetMax(Value: Extended);
begin
  if FMax <> Value then
  begin
    FMax := Value;
    FChanged := True;
  end;
end;

procedure TCustomTHEdit.SetMinable(Value: Boolean);
begin
  if FMinable <> Value then
  begin
    FMinable := Value;
    FChanged := True;
  end;
end;

procedure TCustomTHEdit.SetMaxable(Value: Boolean);
begin
  if FMaxable <> Value then
  begin
    FMaxable := Value;
    FChanged := True;
  end;
end;

procedure TCustomTHEdit.SetScale(Value: Byte);
begin
  if FScale <> Value then
  begin
    FScale := Value;
    FChanged := True;
  end;
end;

{ TArrowExit }

constructor TArrowExit.Create;
begin
  inherited;
  FArrowExitStyle[0] := asAlways;
  FArrowExitStyle[1] := asTopBottomOnly;
end;

function TArrowExit.GetArrowExit(Index: Integer): TArrowExitStyle;
begin
  Result := FArrowExitStyle[Index];
end;

procedure TArrowExit.SetArrowExit(Index: Integer; Value: TArrowExitStyle);
begin
  FArrowExitStyle[Index] := Value;
end;

{ TCutomTHCheckBox }

procedure TCutomTHCheckBox.KeyPress(var Key: Char);
begin
  inherited;
  if Key = Char(VK_RETURN) then
  begin
    THSelectNext(Self, Self, True, True);
    Key := #0;
  end;
end;

procedure TCutomTHCheckBox.DoEnter;
begin
  if THControlEnter(Self) then inherited;
end;

function TCutomTHCheckBox.Validate: Boolean;
begin
  Result := True;
  if FSavedState <> Ord(State) then
  begin
    if Assigned(FOnValidate) then FOnValidate(Self, Result);
  end;
  if Result then FSavedState := Ord(State)
  else SetFocus;
end;

constructor TCutomTHCheckBox.Create(AOwner: TComponent);
begin
  inherited;
  Reset;
end;

procedure TCutomTHCheckBox.Reset;
begin
  FSavedState := -1;
end;

procedure TCutomTHCheckBox.Clear;
begin
  Reset;
  if AllowGrayed then
    State := cbGrayed else
    State := cbUnchecked;
end;

{ TTHBitBtn }

constructor TTHBitBtn.Create(AOwner: TComponent);
begin
  inherited;
  Height := 21; //29;
  Width := 75; //85
end;

procedure TTHBitBtn.DoEnter;
begin
  if Cancel or THControlEnter(Self) then inherited;
end;

{ TCustomTHComboBox }

constructor TCustomTHComboBox.Create(AOwner: TComponent);
begin
  inherited;
  Style := csOwnerDrawVariable; // 使可以修改ItemHeight, 使之与TComboBox, TEdit等高度相等
  Width := 121;
  ItemHeight := 16;
  FValueWidth := 12;
  FMarkChar := '|';
  FNullable := False;
  FSavedItemHeight := 0;
  Reset;
end;

function TCustomTHComboBox.GetChecked: string;
begin
  Result := GetFront(Text, FMarkChar);
end;

function TCustomTHComboBox.GetPrompt: string;
begin
  Result := GetBack(Text, FMarkChar);
end;

procedure TCustomTHComboBox.SetChecked(const Value: string);
var
  Index: Integer;
begin
  for Index := 0 to Items.Count - 1 do
  begin
    if GetFront(Items[Index], FMarkChar) = Value then
    begin
      ItemIndex := Index;
      Break;
    end;
  end;
end;

procedure TCustomTHComboBox.KeyPress(var Key: Char);
begin
  inherited;
  if Key = Char(VK_RETURN) then
  begin
    THSelectNext(Self, Self, True, True);
    Key := #0;
  end;
end;

procedure TCustomTHComboBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if (Shift = []) and not DroppedDown then
    case Key of
      VK_UP:
        begin
          THSelectNext(Self, Self, False, True);
          Key := 0;
        end;
      VK_DOWN:
        begin
          THSelectNext(Self, Self, True, True);
          Key := 0;
        end;
    else
      inherited;
    end
  else inherited;
end;

procedure TCustomTHComboBox.DoEnter;
begin
  if THControlEnter(Self) then inherited;
end;

procedure TCustomTHComboBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
  if (Index >= 0) and (Index < Items.Count) then
  begin
    if Assigned(FOnSetItemProperty) then FOnSetItemProperty(Canvas, Index, State);
    Canvas.FillRect(Rect);
    if FValueWidth > 0 then
      Canvas.TextOut(Rect.Left, Rect.Top, GetFront(Items[Index], FMarkChar));
    Canvas.TextOut(Rect.Left + Max(FValueWidth, 0), Rect.Top, GetBack(Items[Index], FMarkChar));
  end;
end;

procedure TCustomTHComboBox.DropDown;
begin
  if Items.Count = 0 then
  begin
    if FSavedItemHeight = 0 then
    begin
      FSavedItemHeight := ItemHeight;
      if ItemHeight < 16 then ItemHeight := 16; // Items为空时能显示正确
    end;
  end
  else
  begin
    ItemHeight := FSavedItemHeight;
    FSavedItemHeight := 0;
  end;
  inherited;
end;

function TCustomTHComboBox.Validate: Boolean;
begin
  Result := True;
  if FChanged or (FSavedText <> Text) then
  begin
    if not FNullable and (ItemIndex = -1) then
    begin
      MessageDlg(GetCaption(FCaption, FLeadLabel) + NotNull, mtWarning, [mbOK], 0);