Форум: "Потрепаться";
Текущий архив: 2003.03.17;
Скачать: [xml.tar.bz2];
Вниз
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]Игорь Шевченко © (26.02.03 17:47)
Тот же эфект!
← →
Igor_thief (2003-03-02 14:16) [15]Все! Я здаюсь. Я не смог найти ошибку. Мастера, помогите. Please!
← →
VAleksey (2003-03-02 14:18) [16]А вот как раз самому - то сдаваться и не к чему.
Это мастерам может надоесть отвечать, а тебе с этим кодом работать. Так что вперед.
Страницы: 1 вся ветка
Форум: "Потрепаться";
Текущий архив: 2003.03.17;
Скачать: [xml.tar.bz2];
Память: 0.49 MB
Время: 0.009 c