![Старый](images/statusicon/post_old.gif)
15.03.2006, 11:53
|
![Аватар для Admin](image.php?s=92e7b750e6d152221a0db9902bf7fc3b&u=1&dateline=1128338681) |
Администратор
|
|
Регистрация: 03.10.2005
Адрес: Россия, Москва
Сообщения: 1,531
Версия Delphi: Delphi 7
Репутация: выкл
|
|
Сам не пробовал....
Пример 1
Код:
unit MHint;
interface
uses
SysUtils, WinTypes, WinProcs, Messages,
Classes, Graphics, Controls, Forms, Dialogs;
type
TMHint = class(TComponent)
private
ScreenSize: Integer;
FActive: Boolean;
FSeparator: Char;
FOnShowHint: TShowHintEvent;
protected
procedure SetActive(Value: Boolean);
procedure SetSeparator(Value: char);
procedure NewHintInfo(var HintStr: string;
var CanShow: Boolean;
var HintInfo: THintInfo);
public
constructor Create(AOwner: TComponent); override;
published
property Active: Boolean
read FActive write SetActive;
property Separator: Char
read FSeparator write SetSeparator;
end;
procedure Register;
implementation
constructor TMHint.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FActive := True;
FSeparator := '@';
Application.OnShowHint := NewHintInfo;
ScreenSize := GetSystemMetrics(SM_CYSCREEN);
end;
procedure TMHint.SetActive(Value: Boolean);
begin
FActive := Value;
end;
procedure TMHint.SetSeparator(Value: Char);
begin
FSeparator := Value;
end;
procedure TMHint.NewHintInfo(var HintStr: string;
var CanShow: Boolean;
var HintInfo: THintInfo);
var
I: Byte;
begin
if FActive then
begin
I := Pos(FSeparator, HintStr);
while I > 0 do
begin
HintStr[i] := #13;
I := Pos(FSeparator, HintStr);
end;
if HintInfo.HintPos.Y+10 > ScreenSize then
HintInfo.HintPos.Y := ScreenSize-11;
end;
end;
procedure Register;
begin
RegisterComponents('MyComponents', [TMHint]);
end;
end.
Пример 2
Код:
unit Multhnt1;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure FormCreate(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
Var I: Integer;
S: String;
begin
for I := 0 to ComponentCount -1 do
if Components[i] is TControl then
With TControl(Components[i]) Do
Begin
S := Hint;
While Pos('@',S) <> 0 Do
S[Pos('@',S)] := #13;
Hint := S;
End;
end;
end.
|