Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Потрепаться";
Текущий архив: 2002.08.15;
Скачать: [xml.tar.bz2];

Вниз

Народ, как изменить вид hint a?   Найти похожие ветки 

 
Igor_thief   (2002-07-19 13:19) [0]

Сделать его другой формы?


 
blackman   (2002-07-19 15:37) [1]

"Borland Delphi 4, Руководство разработчика", К. Пачеко и С.
Тейксер
unit CoolHint
interface
uses Windows, Classes, Controls, Forms, Messages, Graphics
type
TddgHintWindow = 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
destructor TddgHintWindow.Destroy
begin
FreeCurrentRegion
inherited Destroy
end
procedure TddgHintWindow.CreateParams(var Params: TCreateParams)
{ We need to remove the border created on the Windows API-level }
{ when the window is created. }
begin
inherited CreateParams(Params)
Params.Style := Params.Style and not ws_Border // remove border
end
procedure TddgHintWindow.FreeCurrentRegion
{ Regions, like other API objects, should be freed when you are }
{ through using them. Note, however, that you cannot delete a }
{ region which is currently set in a window, so this method sets }
{ the window region to 0 before deleting the region object. }
begin
if FRegion <>0 then begin // if Region is alive...
SetWindowRgn(Handle, 0, True) // set win region to 0
DeleteObject(FRegion) // kill the region
FRegion := 0 // zero out field
end
end
procedure TddgHintWindow.ActivateHint(Rect: TRect const AHint:
string)
{ Called when the hint is activated by putting the mouse pointer }
{ above a control. }
begin
with Rect do
Right := Right + Canvas.TextWidth("WWWW") // add some slop
BoundsRect := Rect
FreeCurrentRegion
with BoundsRect do
{ Create a round rectangular region to display the hint window }
FRegion := CreateRoundRectRgn(0, 0, Width, Height, Width, Height)
if FRegion <>0 then
SetWindowRgn(Handle, FRegion, True) // set win region
inherited ActivateHint(Rect, AHint) // call inherited
end
procedure TddgHintWindow.Paint
{ This method gets called by the WM_PAINT handler. It is }
{ responsible for painting the hint window. }
var
R: TRect
begin
R := ClientRect // get bounding rectangle
Inc(R.Left, 1) // move left side slightly
Canvas.Font.Color := clInfoText // set to proper color
{ paint string in the center of the round rect }
DrawText(Canvas.Handle, PChar(Caption), Length(Caption), R,
DT_NOPREFIX or DT_WORDBREAK or DT_CENTER or DT_VCENTER)
end
var
OldHintClass: THintWindowClass
function SetNewHintClass(AClass: THintWindowClass): THintWindowClass
var
DoShowHint: Boolean
begin
Result := HintWindowClass // return value is old hint
window
DoShowHint := Application.ShowHint
if DoShowHint then
Application.ShowHint := False // destroy old hint window
HintWindowClass := AClass // assign new hint window
if DoShowHint then
Application.ShowHint := True // create new hint window
end
initialization
OldHintClass := SetNewHintClass(TddgHintWindow)
finalization
SetNewHintClass(OldHintClass)
end.



Страницы: 1 вся ветка

Форум: "Потрепаться";
Текущий архив: 2002.08.15;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.45 MB
Время: 0.007 c
1-48158
DeMoN-777
2002-08-01 12:36
2002.08.15
Как обработать событие OnKeyPress у TWebBrowser ?


1-48034
V.Turecky
2002-08-03 20:09
2002.08.15
Меню.Enabled:=false???


1-48118
Jusic
2002-08-05 16:20
2002.08.15
Как можно узнать, открыто ли мое приложение уже или это первая ег


6-48243
bob1906
2002-05-31 00:11
2002.08.15
Помогите написать прогу типа BackOrifice для Windows


14-48245
Igor_thief
2002-07-16 12:28
2002.08.15
Компонент





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский