Hint

← →
ORMADA (2004-01-29 13:28) [0]

Кто нить писал свои хинты ? Есть проблема хочу в окно хинта выводить рисунок ещё вроде всё объявил как нада рисую на канве хинта но блин потом фсё перкрывается текстом хинта (fuck!) т.е. текст с хинтом зарисовывает фсё что я делал привожу код может кто поможет

Unit AloisHint2;

Interface

Uses
SysUtils, WinTypes, WinProcs, Messages,
Classes, Graphics, Controls, Forms, Dialogs;

Type
TAloisHint = Class(TComponent)
private
FSeparate_str: Char;
ScreenSize: Integer;
FActive: Boolean;
FOnShowHint: TShowHintEvent;
FColor: TColor; //---Цвета хинта---
PColor: TColor; //---Цвет для удаления---
FFont: TFont;
FOnFontChange: TNotifyEvent;
FPicture: TPicture;
Procedure SetPicture(Value: TPicture); virtual;
Procedure SetFont(Value: TFont); virtual;
Function GetFont: TFont; virtual;

protected
Procedure SetActive(Value: Boolean);
Procedure SetSeparate_str(Value: char);

Procedure NewHintInfo(Var HintStr: String;
Var CanShow: Boolean;
Var HintInfo: THintInfo);
public

published
Constructor Create(aowner: Tcomponent); override;
Destructor destroy; override;
Property Font: TFont read GetFont write SetFont;
Property Active: Boolean
read FActive write SetActive;
Property Separate_str: Char
read FSeparate_str write SetSeparate_str;
Property HintColor: TColor read FColor write FColor;//---Цвета хинта---
Property PicTransparentColor: TColor read PColor write PColor; //---Цвет для удаления---

Property OnFontChange: TNotifyEvent read FOnFontChange write FOnFontChange;
Property Picture: TPicture read FPicture write SetPicture;
End;

Procedure Register;

Implementation

Constructor TAloisHint.Create(AOwner: TComponent);
Begin
Inherited Create(AOwner);
FActive := False;
FSeparate_str := "*";
FColor := clWindow;
PColor := clNone;

Application.OnShowHint := NewHintInfo;
ScreenSize := GetSystemMetrics(SM_CYSCREEN);
FFont := TFont.Create;
FFont.Style := [ ];
FFont.Name := "Arial";
FFont.Size := 8;
FPicture := TPicture.Create;
End;

Procedure TAloisHint.SetPicture(Value: TPicture);
Begin
FPicture.Assign(Value);
End;

Destructor TAloisHint.destroy;
Begin
FFont.Destroy;
FPicture.Free;
Inherited destroy;
End;

Procedure TAloisHint.SetActive(Value: Boolean);
Begin
FActive := Value;
End;

Procedure TAloisHint.SetSeparate_str(Value: Char);
Begin
FSeparate_str := Value;
End;

Procedure TAloisHint.NewHintInfo(Var HintStr: String;
Var CanShow: Boolean;
Var HintInfo: THintInfo);
Var
I : Byte;
a : integer;
Begin
If FActive Then
Begin
I := Pos(FSeparate_str, HintStr);
While I > 0 Do
Begin
HintStr[ I ] := #13;
I := Pos(FSeparate_str, HintStr);
End;
If HintInfo.HintPos.Y + 10 > ScreenSize Then
HintInfo.HintPos.Y := ScreenSize - 11;
hintinfo.CursorRect.Top := 999;
hintinfo.HintColor := FColor;
For a := 0 To Application.ComponentCount - 1 Do
If Application.Components[ a ] Is THintWindow Then
With THintWindow(Application.Components[ a ]).Canvas Do
Begin
Font.Name := FFont.Name;
Font.Color := FFont.Color;
Font.Style := FFont.Style;
Font.Size := FFont.Size;
Font.Charset := FFont.Charset;
Font.PixelsPerInch := FFont.PixelsPerInch;
Font.Height := FFont.Height;

If FPicture.Graphic <> Nil Then
BrushCopy(Rect(0, 0, FPicture.Width, FPicture.Height),
FPicture.Bitmap,
Rect(0, 0, FPicture.Width, FPicture.Height), PColor);- здеся рисую картинку
TextOut(0,10,HintStr);-вывожу текст
// HintStr:=""; здесь пытался текстхинта нулить чтоб он зараза ничё рисовал сверху но если HintStr="" то хинт ваще не вылетает
End;
End;
End;

Procedure TAloisHint.SetFont(Value: TFont);
Begin
If Assigned(Value) Then
FFont.Assign(Value);
If Assigned(FOnFontChange) Then
OnFontChange(self);
End;

Function TAloisHint.GetFont: TFont;
Begin
Result := FFont;
End;

Procedure Register;
Begin
RegisterComponents("AloisPack2", [ TAloisHint ]);
End;

End.

← →
Serge (2004-01-29 13:31) [1]

Ругаться - отшень нехорошо!

unit HintX; interface uses Windows, Messages, Controls; type TIconHintX = class(THintWindow) protected procedure Paint; override; public function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; override; end; implementation uses Forms; { TIconHintX } {-Вычисляем новый размер окошка подсказки для помещения в него иконки:-} function TIconHintX.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; begin Result := inherited CalcHintRect(MaxWidth, AHint, AData); Result.Right := (Length(AHint) * 5) + Application.Icon.Width; Result.Bottom := (Application.Icon.Height) * 2; end; procedure TIconHintX.Paint; const MARGIN = 5; begin inherited; Canvas.Draw(MARGIN, MARGIN * 5, Application.Icon); SendMessage(Handle, WM_NCPAINT, 0, 0); //рисуем рамку окошка подсказки end; initialization //связываем наш новый класс с классом окошка подсказки установленным поумолчанию: HintWindowClass := TIconHintX; end.

← →
Rouse_ (2004-01-29 13:33) [2]

Canvas.Brush.Style := bsClear;
TextOut(0,10,HintStr);-вывожу текст
Canvas.Brush.Style := bsSolid;

← →
ORMADA (2004-01-29 13:42) [3]

2 Rouse_ к сожалению не помогло

Hint Найти похожие ветки