On some forms I have dbEdits that sometimes aren't wide enough to show all the text their fields may contain. For them I have the following code:
procedure Tgm12edLots.dbeLotNameMouseEnter(Sender: TObject);
begin
with dbeLotName do begin
ShowHint := True;
Hint := Text;
end;
end;
I'd like to avoid the hint showing if all the text is visible, but I don't how to test for that condition.
Thanks for any tips/suggestions!
I think this should work...
function CanShowAllText(Edit: TDBEdit):Boolean;
var
TextWidth:Integer;
VisibleWidth: Integer;
Bitmap: TBitmap;
const
//This could be worked out but without delphi I can't remember all that goes into it.
BordersAndMarginsWidthEtc = 4;
begin
Bitmap := TBitmap.Create;
try
Bitmap.Canvas.Font.Assign(Edit.Font);
TextWidth := Bitmap.Canvas.TextWidth(Edit.Text);
VisibleWidth := Edit.Width - BordersAndMarginsWidthEtc;
Result := TextWidth < VisibleWidth;
finally
Bitmap.Free;
end;
end;
Here is a fast version (without a TBitmap
overhead) that takes into account the Edit
control's Margins (i.e. EM_SETMARGINS
).
Use IsEditTextOverflow
below to determine if the Text overflows the visible area.
type
TCustomEditAccess = class(TCustomEdit);
function EditTextWidth(Edit: TCustomEdit): Integer;
var
DC: HDC;
Size: TSize;
SaveFont: HFont;
begin
DC := GetDC(0);
SaveFont := SelectObject(DC, TCustomEditAccess(Edit).Font.Handle);
GetTextExtentPoint32(DC, PChar(Edit.Text), Length(Edit.Text), Size);
SelectObject(DC, SaveFont);
ReleaseDC(0, DC);
Result := Size.cx;
end;
function EditVisibleWidth(Edit: TCustomEdit): Integer;
var
R: TRect;
begin
SendMessage(Edit.Handle, EM_GETRECT, 0, LPARAM(@R));
Result := R.Right - R.Left;
end;
function IsEditTextOverflow(Edit: TCustomEdit): Boolean;
begin
Result := EditTextWidth(Edit) > EditVisibleWidth(Edit);
end;
来源:https://stackoverflow.com/questions/9941787/is-it-possible-to-determine-if-the-text-in-a-dbedit-is-longer-than-what-is-visib