旧事重提:有关控件HINT的使用。(100分)

  • 主题发起人 主题发起人 zcm1975117
  • 开始时间 开始时间
Z

zcm1975117

Unregistered / Unconfirmed
GUEST, unregistred user!
1.编辑框的HINT怎么自动换行,不要用#13方法,因为我事前前不知道在那里加入#13.
2.DBGRID的单元格HINT的问题:超过单元格就HINT,并可以自动换行,我知道InfoPower3000
可以实现此功能,但好象不支持自动换行功能,并且我也不象用这个控件,我看了半天源代码,
太长了,请那位高手指点。
 
我看了以前有位menxin回答过这个问题,但我试了一下,效率很差,待别是鼠标移动频繁时,
还会闪动,不能修改记录。他的答案如下:
var
Form1: TForm1;
i,j:integer;

implementation

{$R *.DFM}

type TMyGrid=Class(TCustomDBGrid);

procedure TForm1.DBGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
B:TBookmark;
begin
DBGrid1.DataSource.DataSet.DisableControls;
b:=DBGrid1.DataSource.DataSet.GetBookmark;
i:=DBGrid1.MouseCoord(x,y).x;
j:=DBGrid1.MouseCoord(x,y).y;
TMyGrid(DBGrid1).DataSource.DataSet.MoveBy(j-TMyGrid(DBGrid1).DataLink.ActiveRecord-1);
DBGrid1.Hint:=TMyGrid(DBGrid1).getfieldvalue(i-1);
DBGrid1.DataSource.DataSet.GotoBookmark(b);
DBGrid1.DataSource.DataSet.FreeBookmark(b);
DBGrid1.DataSource.DataSet.EnableControls;
end;

procedure TForm1.ApplicationEvents1ShowHint(var HintStr: String;
var CanShow: Boolean; var HintInfo: THintInfo);
var RectWidth:integer;
begin
if HintInfo.HintControl.Name='DBGrid1' then begin
with HintInfo do begin
HintPos:=DBGrid1.ClientToScreen(TMyGrid(DBGrid1).CellRect(I,J).TopLeft);
HideTimeout:=100;
ReshowTimeout:=100;
end;
RectWidth:=TMyGrid(DBGrid1).CellRect(I,J).Right-TMyGrid(DBGrid1).CellRect(I,J).Left;
Application.HideHint;
CanShow:=DBGrid1.Canvas.TextWidth(DBGrid1.Hint)>RectWidth;
end;
end;

end.
 
kao, 你怎么知道我昨晚刚刚写了一个? 算了,大家共享一下吧!

unit wxGrid;

interface

uses Windows, Messages, Classes, Forms, Controls, Graphics, SysUtils, Grids;

const
MaxHintWidth = 300;

type
TGridObject = (goCol, goRow);

TwxGrid = class(TStringGrid)
private
FHintWnd: THintWindow;
FCellHint: boolean;
FModified: boolean;
FWordWrap: boolean;
protected
function CalcHintRect(const AHint: string; HintWnd: THintWindow): TRect;
procedure DoHint(X, Y: Integer);
procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
procedure RowMoved(FromIndex, ToIndex: Longint); override;
procedure ColWidthsChanged; override;
procedure RowHeightsChanged; override;
procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
AState: TGridDrawState); override;
procedure SetWordWrap(Value: boolean);
public
procedure CMMouseEnter(var Msg: TMessage); message cm_MouseEnter;
procedure CMMouseLeave(var Msg: TMessage); message cm_MouseLeave;
procedure WMMouseMove(var Msg: TWMMouseMove); message wm_MouseMove;
property Modified: boolean read FModified write FModified;
published
constructor Create(AOwner: TComponent); override;
procedure MoveRow(FromIndex, ToIndex: Longint);
procedure MoveColumn(FromIndex, ToIndex: Longint);
procedure Insert(InsertObject: TGridObject; NewIndex: longint);
procedure Delete(DeleteObject: TGridObject; OldIndex: longint);
procedure AutoSizeWidth;
property CellHint: boolean read FCellHint write FCellHint;
property WordWrap: boolean read FWordWrap write SetWordWrap;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Xiang',[TwxGrid]);
end;

constructor TwxGrid.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCellHint := True;
FModified := False;
FWordWrap := False;
end;

procedure TwxGrid.SetEditText(ACol, ARow: Longint; const Value: string);
begin
inherited SetEditText(ACol, ARow, Value);
FModified := True;
end;

procedure TwxGrid.ColumnMoved(FromIndex, ToIndex: Longint);
begin
FModified := True;
inherited ColumnMoved(FromIndex, ToIndex);
end;

procedure TwxGrid.RowMoved(FromIndex, ToIndex: Longint);
begin
FModified := True;
inherited RowMoved(FromIndex, ToIndex);
end;

procedure TwxGrid.ColWidthsChanged;
begin
FModified := True;
inherited ColWidthsChanged;
end;

procedure TwxGrid.RowHeightsChanged;
begin
FModified := True;
inherited RowHeightsChanged;
end;

procedure TwxGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
const
CharOffset = 2;
var
Sentence: string;
begin
if FWordWrap then begin
ARect := Rect(ARect.Left + CharOffset, ARect.Top + CharOffset, ARect.Right, ARect.Bottom);
with Canvas do begin
if gdFixed in AState then begin
Pen.Color := FixedColor;
Brush.Color := FixedColor;
end
else if gdSelected in AState then begin
Brush.Color := clHighlight;
Pen.Color := clHighlight;
Font.Color := clHighlightText;
end
else begin
Pen.Color := Color;
Brush.Color := Color;
end;
Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
end;

Sentence := Cells[ACol, ARow];
DrawText(Canvas.Handle, PChar(Sentence), Length(Sentence), ARect, DT_WORDBREAK);

if Assigned(OnDrawCell) then OnDrawCell(Self, ACol, ARow, ARect, AState);
end
else
inherited DrawCell(ACol, ARow, ARect, AState);
end;

procedure TwxGrid.SetWordWrap(Value: boolean);
begin
FWordWrap := Value;
Invalidate;
end;

function TwxGrid.CalcHintRect(const AHint: string; HintWnd: THintWindow): TRect;
begin
Result := HintWnd.CalcHintRect(MaxHintWidth, AHint, nil)
end;

procedure TwxGrid.CMMouseEnter(var Msg: TMessage);
var
Pt: TPoint;
begin
if FCellHint then begin
GetCursorPos(Pt);
Pt := ScreenToClient(Pt);
DoHint(Pt.X, Pt.Y)
end;
end;

procedure TwxGrid.CMMouseLeave(var Msg: TMessage);
begin
inherited;
if Assigned(FHintWnd) then FHintWnd.ReleaseHandle;
end;

procedure TwxGrid.DoHint(X, Y: Integer);
const
TextOffset = 2;
var
Col, Row: Longint;
R, OldR: TRect;
Pt: TPoint;
begin
MouseToCell(X, Y, Col, Row);
Canvas.Font := Font;
if (Col <> -1) and (Row <> -1) and
(Canvas.TextWidth(Cells[Col, Row]) + TextOffset > ColWidths[Col]) and
not EditorMode and ForegroundTask and not (csDesigning in ComponentState) then begin
if not Assigned(FHintWnd) then begin
FHintWnd := HintWindowClass.Create(Self);
FHintWnd.Color := Application.HintColor;
end;
Hint := Cells[Col, Row];
R := CalcHintRect(Hint, FHintWnd);
Pt := ClientToScreen(CellRect(Col, Row).TopLeft);
Dec(Pt.X);
Dec(Pt.Y);
OffsetRect(R, Pt.X, Pt.Y);
GetWindowRect(FHintWnd.Handle, OldR);
if not IsWindowVisible(FHintWnd.Handle) or
not ((R.Left = OldR.Left) and (R.Top = OldR.Top)) then
FHintWnd.ActivateHint(R, Hint)
end
else
if Assigned(FHintWnd) then FHintWnd.ReleaseHandle;
end;

procedure TwxGrid.WMMouseMove(var Msg: TWMMouseMove);
begin
inherited;
if FCellHint then DoHint(Msg.XPos, Msg.YPos)
end;

procedure TwxGrid.MoveRow(FromIndex, ToIndex: Longint);
begin
Inherited MoveRow(FromIndex, ToIndex);
FModified := True;
end;

procedure TwxGrid.MoveColumn(FromIndex, ToIndex: Longint);
begin
Inherited MoveColumn(FromIndex, ToIndex);
FModified := True;
end;

procedure TwxGrid.Insert(InsertObject: TGridObject; NewIndex: longint);
var
i, j: longint;
begin
if InsertObject = goRow then begin
j := RowCount;
RowCount := RowCount + 1;
for i := J downto NewIndex + 1 do Rows := Rows[i - 1];
Rows[NewIndex].Clear;
end
else begin
j := ColCount;
ColCount := ColCount + 1;
for i := J downto NewIndex + 1 do Cols := Cols[i - 1];
Cols[NewIndex].Clear;
end;
FModified := True;
end;

procedure TwxGrid.Delete(DeleteObject: TGridObject; OldIndex: longint);
var
i, j: longint;
begin
if DeleteObject = goRow then begin
j := RowCount - 2;
for i := OldIndex to j do Rows := Rows[i + 1];
RowCount := RowCount - 1;
end
else begin
j := ColCount - 2;
for i := OldIndex to j do Cols := Cols[i + 1];
ColCount := ColCount - 1;
end;
FModified := True;
end;

procedure TwxGrid.AutoSizeWidth;
var
i, j : integer;
temp : integer;
Max : integer;
begin
for j := FixedCols to ColCount - 1 do begin
Max := 0;
for i := 0 to (RowCount - 1) do begin
temp := Canvas.TextWidth(Cells[j, i]);
if temp > Max then Max := temp;
end;
ColWidths[j] := Max + GridLineWidth + 4;
end;
end;

end.


 
Kao!这么长![:(!]
好东西!收藏![8D]
 
to kthy:
非常感谢你的代码,不过我准许把它改成DBGRIDj时,却没有办法改过来,可以再指教
一下吗?谢谢
 
我现在正在修改,改好之后传上来!!
 
后退
顶部