Hint (вопрос к мастерам)

← →
Igor_thief (2003-02-25 20:54) [0]

Просмотрите пожалуйста этот код и если можно, подскажите где в нем ошибка. Дело в том, что при первом показе хинта, на переделаднный мною хинт быстро налаживается стандартный. А при дальнейшей работе, все работает нормально. Ну Вы проверте и увидите.
Вот код:
unit RndHint;

interface

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

type
TRndHintWindow=class(THintWindow)
private
FRegion:THandle;
procedure FreeCurrentRegion;
public
destructor Destroy;override;
procedure ActivateHint(Rect:TRect;const AHint:string);override;
procedure Paint;override;
procedure CreateParams(var Params:TCreateParams);override;
end;

implementation

{ TRndHintWindow }

procedure TRndHintWindow.ActivateHint(Rect: TRect; const AHint: string);
(*Вызывается при активизации подсказки.*)
begin
with Rect do//добавить немного пространства
Right:=Right+Canvas.TextWidth("WWWW");
BoundsRect:=Rect;
FreeCurrentRegion;
(*Создание прямоугольной области со скругленными углами для
отображения окна подсказки.*)
FRegion:=CreateRoundRectRgn(0,0,Width,Height,15,15);
if FRegion<>0 then SetWindowRgn(Handle,FRegion,true);
inherited ActivateHint(Rect,AHint);
end;

procedure TRndHintWindow.CreateParams(var Params: TCreateParams);
(*Необходимо удалить стандартную границу, созданную на уровне API
Windows при создании окна.*)
begin
inherited CreateParams(Params);
Params.Style:=Params.Style and not WS_BORDER;
end;

destructor TRndHintWindow.Destroy;
begin
FreeCurrentRegion;
inherited Destroy;
end;

procedure TRndHintWindow.FreeCurrentRegion;
(*Области окна подобно другим объектам API, одлжни быть освобождены по
завершении их использования. Запомните, что нельзя удалить в окне
область, являющуюся текущей, поэтому в данном методе перед удалением
объекта области текущей области назначают нулевую.*)
begin
if FRegion<>0 then//Если область существует, то
begin
SetWindowRgn(Handle,0,true);//сделать текущей нулевую,
DeleteObject(FRegion);//удалить заданную область
FRegion:=0;//и обнулить поле FRegion;
end;
end;

procedure TRndHintWindow.Paint;
var
R:TRect;
begin
R:=ClientRect;//Получить размер прямоугольника
Inc(R.Left,1);//немного сдвинуть левую сторону
Canvas.Brush.Color:=clInfoBk;//установка цвета фона
FillRgn(Canvas.Handle,FRegion,Canvas.Brush.Handle);
Canvas.Font.Color:=clInfoText;//установка цвета текста
//Вывести строку вцентре скругленого прямоугольника
DrawText(Canvas.Handle,PChar(Caption),Length(Caption),R,
DT_NOPREFIX or DT_WORDBREAK or DT_CENTER or DT_VCENTER);
end;

var
OldHintClass:THintWindowClass;

function SetNewHintWindowClass(AClass:THintWindowClass):THintWindowClass;
var
DoShowHint:Boolean;
begin
//Возвращаемое значение - старое окно подсказки
Result:=HintWindowClass;
DoShowHint:=Application.ShowHint;
//удалить старое окно подсказки
if DoShowHint then Application.ShowHint:=false;
//назначить новое окно посказки
HintWindowClass:=AClass;
//создать новое окно подсказки
if DoShowHint then Application.ShowHint:=true;
end;

initialization
OldHintClass:=SetNewHintWindowClass(TRndHintWindow);

finalization
SetNewHintWindowClass(OldHintClass);

end.

← →
Igor_thief (2003-02-26 10:21) [1]

Неужели очень сложная задача?

← →
Igor_thief (2003-02-26 11:11) [2]

Мастера, это очень важно для меня. Help!

← →
han_malign (2003-02-26 11:39) [3]

Включи Project Options->Compiler->Use Debug DCUs и пройдись по VCL на хинте - нам твою задачу отлаживать некогда...

← →
Igor_thief (2003-02-26 12:55) [4]

Спасибо хоть за это. Но все равно, если будет свободное время, то посмотрите. Очень важный вопрос. Я дебагил свой компонент, чего-то заметил, но все что не пробую, не работает.

← →
Palladin (2003-02-26 13:37) [5]

мне если чесно просто даже не хочется читать такое нагромождение...

← →
han_malign (2003-02-26 14:21) [6]

BoundsRect:=Rect; - абсолютно лишнее

← →
Igor_thief (2003-02-26 17:11) [7]

Palladin © (26.02.03 13:37)
А ты бы посмотрел и тогда бы понял, что это не нагромождение.
han_malign © (26.02.03 14:21)
Да, но это мне абсолютно не помогло!

← →
Романов Р.В. (2003-02-26 17:15) [8]

Почти как в книжке, с небольшими вариациями. Должно работать.

← →
Igor_thief (2003-02-26 17:22) [9]

Романов Р.В. © (26.02.03 17:15)
Вот и я говорю, что должно работать. А не работает!

← →
han_malign (2003-02-26 17:25) [10]

В D5 должно, судя по исходникам, а у тебя - неизвестно...

← →
Igor_thief (2003-02-26 17:39) [11]

Я пишу на D7. Использую WinXp+sp1.

← →
Игорь Шевченко (2003-02-26 17:47) [12]

Найди отличия:
unit HSRoundHint; interface uses Windows, Classes, Controls, Forms, Messages, Graphics; type THSHintWindow = class (THintWindow) private FRegion : THandle; procedure FreeCurrentRegion; public destructor Destroy; override; procedure ActivateHint (Rect : TRect; const AHint : String); override; procedure Paint; override; procedure CreateParams (var Params : TCreateParams); override; end; implementation { THSHintWindow } procedure THSHintWindow.ActivateHint(Rect: TRect; const AHint: String); begin with Rect do Inc(Right, Canvas.TextWidth ("W")); BoundsRect := Rect; FreeCurrentRegion(); with BoundsRect do FRegion := CreateRoundRectRgn (0, 0, Width, Height, 6, 6); if FRegion <> 0 then SetWindowRgn (Handle, FRegion, true); inherited; end; procedure THSHintWindow.CreateParams(var Params: TCreateParams); begin inherited; with Params do Style := Style AND NOT WS_BORDER; end; destructor THSHintWindow.Destroy; begin FreeCurrentRegion; inherited; end; procedure THSHintWindow.FreeCurrentRegion; begin if FRegion <> 0 then begin SetWindowRgn (Handle, 0, true); DeleteObject (FRegion); FRegion := 0; end; end; procedure THSHintWindow.Paint; var R : TRect; begin R := ClientRect; Canvas.Pen.Color := clBtnFace; Canvas.Brush.Style := bsClear; Canvas.Brush.Color := clBlack; Canvas.RoundRect(R.Left, R.Top, R.Right-1, R.Bottom-5, 6, 6); Canvas.Font.Color := clWhite; DrawText (Canvas.Handle, PChar(Caption), Length (Caption), R, DT_NOPREFIX OR DT_WORDBREAK OR DT_CENTER OR DT_VCENTER); end; initialization Application.ShowHint := false; HintWindowClass := THSHintWindow; Application.ShowHint := true; end.

← →
Igor_thief (2003-02-27 09:59) [13]

Я попробую!

← →
Igor_thief (2003-02-28 18:30) [14]

← →
Igor_thief (2003-03-02 14:16) [15]

Все! Я здаюсь. Я не смог найти ошибку. Мастера, помогите. Please!

← →
VAleksey (2003-03-02 14:18) [16]

А вот как раз самому - то сдаваться и не к чему.
Это мастерам может надоесть отвечать, а тебе с этим кодом работать. Так что вперед.

Hint (вопрос к мастерам) Найти похожие ветки