unit ControlImprovers;
interface
uses StdCtrls, Grids, Typinfo, Types,
Db;
type
TEdit =
class(StdCtrls.TEdit)
private
FLastValidText :
string;
FEditType : TFieldType;
FPrecision : integer;
FDigits : integer;
function GetValue : variant;
procedure SetValue (AValue : Variant);
procedure SetEditType(AType : TFieldType);
protected
procedure Change;
override;
public
property Value : variant
read GetValue
write SetValue;
property EditType : TFieldType
read FEditType
write SetEditType;
property Precision : integer
read FPrecision
write FPrecision;
property Digits : integer
read FDigits
write FDigits;
end;
type TStringGrid =
class(Grids.TStringGrid)
private
FCellType :
array of array of TFieldType;
FCustomInplaceEdit: TEdit;
FCustomInplaceEditOnCol,
FCustomInplaceEditOnRow : integer;
function GetCellType(ix, iy : integer) : TFieldType;
procedure SetCellType(ix, iy : integer; ACellType : TFieldType);
procedure OnCustomInplaceEditExit(Sender : TObject);
protected
function GetEditText(ACol, ARow: Integer) :
string;
override;
public
property CellType[ix, iy : integer] : TFieldType
read GetCellType
write SetCellType;
end;
implementation
uses Windows, SysUtils, Classes, ComCtrls, Forms, Controls, Math;
procedure TStringGrid.OnCustomInplaceEditExit(Sender : TObject);
begin
if assigned(FCustomInplaceEdit)
then begin
if FCustomInplaceEdit.Visible
then begin
Cells[FCustomInplaceEditOnCol, FCustomInplaceEditOnRow] := FCustomInplaceEdit.Value;
if assigned(OnSetEditText)
then begin
OnSetEditText(Sender, FCustomInplaceEditOnCol, FCustomInplaceEditOnRow, FCustomInplaceEdit.Value);
end;
FCustomInplaceEdit.Hide;
end;
end;
end;
function TStringGrid.GetEditText(ACol, ARow: Integer):
string;
var Inp : TInput;
ARect : TRect;
begin
if Assigned(OnGetEditText)
then OnGetEditText(self, ACol, ARow, Result);
if CellType[ACol, ARow] = ftUnknown
then begin
//no cell type specified - treat like normal stringgrid:
//do nothing, and text for default inplace editor is current cell text
result := Cells[ACol, ARow];
end
else begin
InplaceEditor.EditText := Cells[ACol, ARow];
InplaceEditor.Hide;
if not assigned(FCustomInplaceEdit)
then begin
FCustomInplaceEdit := TEdit.Create(self);
FCustomInplaceEdit.Parent := Self;
end;
FCustomInplaceEditOnCol := ACol;
FCustomInplaceEditOnRow := ARow;
//EditType of the TEdit gets assigned from the CellType:
FCustomInplaceEdit.EditType := CellType[ACol, ARow];
//Assign value of the cell to the TEdit
FCustomInplaceEdit.Value := Cells[ACol, ARow];
//positioning the TEdit directly onto the cell:
ARect := CellRect(ACol, ARow);
FCustomInplaceEdit.Left := ARect.Left;
FCustomInplaceEdit.Top := ARect.Top;
FCustomInplaceEdit.Width:= ARect.Width;
FCustomInplaceEdit.Height:=ARect.Height;
FCustomInplaceEdit.Font := Font;
//use font of grid
FCustomInplaceEdit.Color := Color;
FCustomInplaceEdit.Show;
FCustomInplaceEdit.BringToFront;
FCustomInplaceEdit.SetFocus;
FCustomInplaceEdit.OnExit := OnCustomInplaceEditExit;
result := FCustomInplaceEdit.Value;
end;
end;
function TEdit.GetValue : variant;
begin
if (FEditType
in FieldTypesString)
or (FEditType = ftUnknown)
then begin
result := Text;
end
else if FEditType
in FieldTypesInteger
then begin
result := Round(StrToFloatDef(Text, 0.0));
//trunc(StrToFloat) instead of just StrToInt; allows converting from float to integer
//without loss of value (StrToIntDef('1.234', 0) --> 0!)
end
else if FEditType
in FieldTypesFloat
then begin
result := StrToFloatDef(Text, 0.0);
end
else assert(false, '
Unsupported EditType!');
end;
procedure TEdit.SetValue(AValue: variant);
begin
if (FEditType
in FieldTypesString)
or (FEditType = ftUnknown)
then begin
Text := AValue;
end
else if FEditType
in FieldTypesInteger
then begin
Text := IntToStr(AValue);
end
else if FEditType
in FieldTypesFloat
then begin
Text := FloatToStrF(AValue, ffFixed, FPrecision, FDigits);
end
else assert(false, '
Unsuppported EditType!');
end;
procedure TEdit.SetEditType(AType: TFieldType);
begin
FEditType := AType;
Value := Value;
//converts "Text" to be of given type with given precision / digits if possible,
//otherwise sets value to 0 (or 0.0)
end;
procedure TEdit.Change;
var iDummy : integer;
dDummy : double;
iSelStart,
iSelLength : integer;
begin
iSelStart := SelStart;
iSelLength := SelLength;
if (FEditType
in FieldTypesString)
or (FEditType = ftUnknown)
then begin
//nothing to do
end
else if FEditType
in FieldTypesInteger
then begin
if TryStrToInt(Text, iDummy)
then begin //is Text a valid integer?
Value := Value;
//"014" --> "14"
FLastValidText := Text;
//store "14" as "last known good" to be able to revert to it
end
else if FLastValidText <> '
'
then begin
Text := FLastValidText;
//Text is not a valid integer, so revert to last valid text
SelStart := iSelStart;
//restore cursor pos to where it was before (gets misplaced by setting Text)
SelLength := iSelLength;
//restore selection to where it was before (gets misplaced by setting Text)
end
else begin
Value := 0;
//sets Text to "0"
SelStart := iSelStart;
//restore cursor pos to where it was before (gets misplaced by setting Text)
SelLength := iSelLength;
//restore selection to where it was before (gets misplaced by setting Text)
end;
end
else if FEditType
in FieldTypesFloat
then begin
if TryStrToFloat(Text, dDummy)
then begin //is Text a valid float?
Value := Value;
//"014.3" --> "14.3"
FLastValidText := Text;
//store "14.3" as "last known good" to be able to revert to it
end
else if FLastValidText <> '
'
then begin
Text := FLastValidText;
//Text is not a valid float, so revert to last valid text
SelStart := iSelStart;
//restore cursor pos to where it was before (gets misplaced by setting Text)
SelLength := iSelLength;
//restore selection to where it was before (gets misplaced by setting Text)
end
else begin
Value := 0.0;
//sets Text to "0.000" (or whatever "Digits" says)
SelStart := iSelStart;
//restore cursor pos to where it was before (gets misplaced by setting Text)
SelLength := iSelLength;
//restore selection to where it was before (gets misplaced by setting Text)
end;
end
else assert(false, '
Unsuppported EditType!');
inherited;
if Assigned(OnChange)
then OnChange(Self);
end;
end.