在某些表单上,我有dbEdits,有时不够宽,无法显示其字段可能包含的所有文本。对他们来说,我有以下代码:
procedure Tgm12edLots.dbeLotNameMouseEnter(Sender: TObject);
begin
with dbeLotName do begin
ShowHint := True;
Hint := Text;
end;
end;
我想避免提示显示所有文本是否可见,但我不知道如何测试该条件。
感谢您的任何提示/建议!
答案 0 :(得分:6)
这是一个快速版本(没有TBitmap
开销),它考虑了Edit
控件的边距(即EM_SETMARGINS
)。
使用下面的IsEditTextOverflow
确定文本是否溢出可见区域。
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;
答案 1 :(得分:5)
我认为这应该有用......
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;