// 작성자: 전철호 (jeonchulho@hanmail.net)
// Date: 98.1.15
// 저작권 (c)1998-2000
// By 전철호 JeonHint95 for Delphi 3.0 (OS win95)
//
// 준수사항.(Reserved Right)
// 이 콤포넌트는 주인의 허락 없이 배포를 금하고,
// 상업목적이나 개인의 환경에 맞게 변경하는 것을 금한다.
unit Jeonhint;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms,Dialogs;
const
cAbout = 'TJeonHint95 1998 by 전철호';
type
THintDirection=(hdUpRight,hdUpLeft,hdDownRight,hdDownLeft);
TOnSelectHintDirection=procedure(HintControl:TControl;
var HintDirection:THintDirection)of object;
TJeonHint95 = class(TComponent)
private
FHintDirection :THintDirection;
FHintColor :TColor;
FHintShadowColor :TColor;
FHintFont :TFont;
FHintPauseTime :Integer;
FRound :Integer;
FAbout :String;
FActive :Boolean;
FDepth :Integer;
FOnSelectHintDirection:TOnSelectHintDirection;
procedure SetShowHint(Value:Boolean);
procedure SetHintDirection(Value:THintDirection);
procedure SetHRound(Value:Integer);
procedure SetHActive(Value:Boolean);
procedure SetHDepth(Value:Integer);
procedure SetHintColor(Value:TColor);
procedure SetHintShadowColor(Value:TColor);
procedure SetHintFont(Value:TFont);
procedure CMFontChanged(var Message:TMessage); message CM_FONTCHANGED;
procedure SetHintPauseTime(Value:Integer);
protected
procedure FuAbout(value :String);
public
constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
procedure Loaded;override;
procedure SetNewHintFont;
published
Property About : String read FAbout write FuAbout;
property HintDirection:THintDirection read FHintDirection write SetHintDirection default hdUpRight;
property HintColor:TColor read FHintColor write SetHintColor default clYellow;
property HintShadowColor:TColor read FHintShadowColor write SetHintShadowColor default clPurple;
property HintRadius:Integer read FRound write SetHRound default 9;
property HintWidth:Integer read FDepth write SetHDepth default 100;
property HintActive:Boolean read FActive write SetHActive default False;
property HintFont:TFont read FHintFont write SetHintFont;
property HintPauseTime:Integer read FHintPauseTime write SetHintPauseTime default 1200;
property OnSelectHintDirection:TOnSelectHintDirection read FOnSelectHintDirection write FOnSelectHintDirection;
end;
TNewHint = class(THintWindow)
private
FDanHint :TJeonHint95;
FHintDirection:THintDirection;
procedure SelectProperHintDirection(ARect:TRect);
procedure CheckUpRight(Spot:TPoint);
procedure CheckUpLeft(Spot:TPoint);
procedure CheckDownRight(Spot:TPoint);
procedure CheckDownLeft(Spot:TPoint);
function FindDanHint:TJeonHint95;
protected
function BetweenToken(var S: String; Sep: Char):String;
function FindToken(var S: String; Sep: Char): String;
function TokenCount(S: String; Sep: Char):Integer;
procedure Paint;override;
procedure CreateParams(var Params: TCreateParams);override;
public
constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
procedure ActivateHint(Rect: TRect; const AHint: string);override;
property HintDirection:THintDirection read FHintDirection write FHintDirection default hdUpRight;
published
end;
procedure Register;
implementation
const
SHADOW_WIDTH=6;
N_PIXELS =2; // 화살표 커서 위치
var
MemBmp :TBitmap;
UpRect,DownRect :TRect;
SelectHintDirection:THintDirection;
ShowPos :TPoint;
HRound :Integer;
HActive :Boolean;
HDepth :Integer;
procedure Register;
begin
RegisterComponents('인력개발',[TJeonHint95]);
RegisterClasses([TJeonHint95]);
end;
procedure TJeonHint95.SetNewHintFont;
var
I:Integer;
begin
for I:=0 to Application.ComponentCount-1 do
if Application.Components[I] is TNewHint then begin
TNewHint(Application.Components[I]).Canvas.Font.Assign(FHintFont);
Exit;
end;
end;
constructor TJeonHint95.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
FHintDirection :=hdUpRight;
FHintColor :=clYellow;
FHintShadowColor :=clPurple;
Application.HintPause:=FHintPauseTime;
FHintFont :=TFont.Create;
FHintFont.Name :='바탕체';
FHintPauseTime :=1000;
FDepth :=250;
HDepth :=FDepth;
FRound :=18;
HRound :=FRound;
HActive :=FActive;
FHintFont.Size :=8;
FHintFont.Color :=clBlack;
FHintFont.Pitch :=fpDefault;
FHintFont.Style :=FHintFont.Style+[fsItalic];
fAbout :=cAbout;
SetShowHint(HActive);
end;
destructor TJeonHint95.Destroy;
begin
FHintFont.Free;
inherited Destroy;
end;
procedure TJeonHint95.Loaded;
begin
inherited Loaded;
SetShowHint(FActive);
end;
procedure TJeonHint95.SetHintDirection(Value:THintDirection);
begin
if Value <> FHintDirection then
FHintDirection:=Value;
end;
procedure TJeonHint95.SetHRound(Value:Integer);
begin
if Value <> HRound then begin
FRound:=Value;
HRound:=FRound;
end;
end;
procedure TJeonHint95.SetHActive(Value:Boolean);
begin
if (csDesigning in ComponentState) then
MessageDlg('폼 디자인시는 !!'+ #10#13+'사용을 못합니다 !!.', mtInformation,[mbOk], 0)
else if Value <> FActive then begin
FActive:=Value;
hActive:=FActive;
SetShowHint(FActive);
end;
end;
procedure TJeonHint95.SetShowHint(Value:Boolean);
begin
if (csDesigning in ComponentState) then
Value:=False
else begin
if Value then HintWindowClass :=TNewHint
else HintWindowClass :=THintWindow;
Application.ShowHint:=not Application.ShowHint;
Application.ShowHint:=not Application.ShowHint;
SetNewHintFont;
end;
end;
procedure TJeonHint95.SetHintColor(Value:TColor);
begin
if Value <> FHintColor then
FHintColor:=Value;
end;
procedure TJeonHint95.SetHintShadowColor(Value:TColor);
begin
if Value <> FHintShadowColor then
FHintShadowColor:=Value;
end;
procedure TJeonHint95.SetHintFont(Value:TFont);
begin
FHintFont.Assign(Value);
SetShowHint(FActive);
end;
procedure TJeonHint95.FuAbout(value:String);
begin
if value <> fAbout then begin
fAbout := cAbout;
MessageDlg('Component : TJeonHint95 (Version 1.0) '+ #10#13+ #10#13+
'`1998 by 전철호 '+ #10#13+
'Mail Addr : jeonchulho@hanmail.net ',
mtInformation, [mbOk],0);
end;
end;
procedure TJeonHint95.CMFontChanged(var Message:TMessage);
begin
inherited;
SetShowHint(FActive);
end;
procedure TJeonHint95.SetHDepth(Value:Integer);
begin
if Value<>FDepth then begin
if Value > 300 then Value:=300;
FDepth:=Value;
hDepth:=FDepth;
end;
end;
procedure TJeonHint95.SetHintPauseTime(Value:Integer);
begin
if Value<>FHintPauseTime then begin
FHintPauseTime :=Value;
Application.HintPause:=Value;
end;
end;
function TNewHint.FindDanHint:TJeonHint95;
var
I:Integer;
begin
Result:=nil;
for I:=0 to Application.MainForm.ComponentCount-1 do
if Application.MainForm.Components[I] is TJeonHint95 then begin
Result:=TJeonHint95(Application.MainForm.Components[I]);
Exit;
end;
end;
constructor TNewHint.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
ControlStyle:=ControlStyle-[csOpaque];
with Canvas do begin
Brush.Style :=bsClear;
Brush.Color :=clBackground;
end;
FHintDirection:=hdUpRight;
end;
destructor TNewHint.Destroy;
begin
inherited Destroy;
end;
procedure TNewHint.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do begin
Style := WS_POPUP OR WS_DISABLED {윈도우 스타일-WS_BORDER};
// Hint Window밑에 음영을 추가한다.
WindowClass.Style := WindowClass.Style OR CS_SAVEBITS;
end;
end;
procedure TNewHint.Paint;
var
R :TRect;
CCaption :array[0..255] of Char;
FillRegion,
ShadowRgn:HRgn;
AP :array[0..2] of TPoint; {커서위치}
SP :array[0..2] of TPoint; {음영위치}
X,Y :Integer;
AddNum :Integer;
begin
R:=ClientRect; {R -> 텍스트 출력을 위한 영역}
inc(R.Left,8);
inc(R.Top,3);
AddNum:=0;
if FHintDirection >= hdDownRight then
AddNum:=15;
Inc(R.Top,AddNum);
case HintDirection of
hdUpRight:begin
AP[0]:=Point(10,Height-15);
AP[1]:=Point(20,Height-15);
AP[2]:=Point(0,Height);
SP[0]:=Point(12,Height-15);
SP[1]:=Point(25,Height-15);
SP[2]:=Point(12,Height);
end;
hdUpLeft: begin
AP[0]:=Point(Width-SHADOW_WIDTH-20,Height-15);
AP[1]:=Point(Width-SHADOW_WIDTH-10,Height-15);
AP[2]:=Point(Width-SHADOW_WIDTH,Height);
SP[0]:=Point(Width-SHADOW_WIDTH-27,Height-15);
SP[1]:=Point(Width-SHADOW_WIDTH-5,Height-15);
SP[2]:=Point(Width-SHADOW_WIDTH,Height);
end;
hdDownRight:begin
AP[0]:=Point(10,15);
AP[1]:=Point(20,15);
AP[2]:=Point(0,0);
SP[0]:=Point(12,Height-15);
SP[1]:=Point(25,Height-15);
SP[2]:=Point(12,Height);
end;
hdDownLeft: begin
AP[0]:=Point(Width-SHADOW_WIDTH-20,15);
AP[1]:=Point(Width-SHADOW_WIDTH-10,15);
AP[2]:=Point(Width-SHADOW_WIDTH,0);
SP[0]:=Point(12,Height-15);
SP[1]:=Point(25,Height-15);
SP[2]:=Point(12,Height);
end;
end;
{힌트 사각형의 음영을 그린다.}
if (FHintDirection <= hdUpLeft) then begin
ShadowRgn := CreateRoundRectRgn(10,8,Width,Height-8,HRound-1,HRound-1);
for X:=Width-SHADOW_WIDTH-8 to Width do
for Y:=8 to Height-14 do begin
if (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) then
MemBmp.Canvas.Pixels[X,Y]:=FDanHint.HintShadowColor;
end;
for X:=10 to Width do
for Y:=Height-14 to Height-9 do begin
if (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) then
MemBmp.Canvas.Pixels[X,Y]:=FDanHint.HintShadowColor;
end;
end else begin
ShadowRgn := CreateRoundRectRgn(10,8+15,Width,Height-2,HRound-1,HRound-1);
for X:=Width-SHADOW_WIDTH-8 to Width do
for Y:=8+15 to Height-8 do begin
if (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) then
MemBmp.Canvas.Pixels[X,Y]:=FDanHint.HintShadowColor;
end;
for X:=10 to Width do
for Y:=Height-8 to Height-2 do begin
if (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) then
MemBmp.Canvas.Pixels[X,Y]:=FDanHint.HintShadowColor;
end;
end;
DeleteObject(ShadowRgn);
{ 화살표 음영을 그린다.}
if (HintDirection <= hdUpLeft) then begin
ShadowRgn := CreatePolygonRgn(SP,3,WINDING);
for X:=SP[0].X to SP[1].X do
for Y:=SP[0].Y to SP[2].Y do begin
if (Odd(X)=Odd(Y)) and PtInRegion(ShadowRgn,X,Y) then
MemBmp.Canvas.Pixels[X,Y]:=FDanHint.HintShadowColor;
end;
DeleteObject(ShadowRgn);
end;
{ 힌트 사각형을 그린다}
MemBmp.Canvas.Pen.Color:=clBlack;
MemBmp.Canvas.Pen.Style:=psSolid;
MemBmp.Canvas.Brush.Color:=FDanHint.HintColor;
MemBmp.Canvas.Brush.Style:=bsSolid;
if (FHintDirection<=hdUpLeft) then
MemBmp.Canvas.RoundRect(0,0,Width-SHADOW_WIDTH,Height-14,HRound,HRound)
else MemBmp.Canvas.RoundRect(0,0+AddNum,Width-SHADOW_WIDTH,Height-14+6,HRound,HRound);
{ 화살표를 그린다.}
MemBmp.Canvas.Pen.Color:=FDanHint.HintColor;
MemBmp.Canvas.MoveTo(AP[0].X,AP[0].Y);
MemBmp.Canvas.LineTo(AP[1].X,AP[1].Y);
MemBmp.Canvas.Pen.Color:=clBlack;
FillRegion:=CreatePolygonRgn(AP,3,WINDING);
FillRgn(MemBmp.Canvas.Handle,FillRegion,MemBmp.Canvas.Brush.Handle);
DeleteObject(FillRegion);
MemBmp.Canvas.LineTo(AP[2].X,AP[2].Y);
MemBmp.Canvas.LineTo(AP[0].X,AP[0].Y);
{SetBkMode 함수로 DrawText의 Text를 transparent하게 만든다.}
SetBkMode(MemBmp.Canvas.Handle,TRANSPARENT);
MemBmp.Canvas.Font.Assign(FDanHint.HintFont);
DrawText(MemBmp.Canvas.Handle, StrPCopy(CCaption, Caption), -1, R,
DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
Canvas.CopyMode:=cmSrcCopy;
Canvas.CopyRect(ClientRect,MemBmp.Canvas,ClientRect);
MemBmp.Free;
end;
procedure TNewHint.CheckUpLeft(Spot:TPoint);
var
Width,Height:Integer;
begin
Dec(Spot.Y,N_PIXELS);
Width := UpRect.Right-UpRect.Left;
Height := UpRect.Bottom-UpRect.Top;
SelectHintDirection:= hdUpLeft;
if (Spot.X+SHADOW_WIDTH-Width) < 0 then begin
Inc(Spot.Y,N_PIXELS);
CheckUpRight(Spot);
Exit;
end;
if (Spot.Y-Height) < 0 then begin
Inc(Spot.Y,N_PIXELS);
CheckDownLeft(Spot);
Exit;
end;
ShowPos.X:=Spot.X+SHADOW_WIDTH-Width;
ShowPos.Y:=Spot.Y-Height;
end;
procedure TNewHint.CheckUpRight(Spot:TPoint);
var
Width,Height:Integer;
begin
Dec(Spot.Y,N_PIXELS);
Width :=UpRect.Right-UpRect.Left;
Height := UpRect.Bottom-UpRect.Top;
SelectHintDirection:= hdUpRight;
if (Spot.X+Width) > Screen.Width then begin
Inc(Spot.Y,N_PIXELS);
CheckUpLeft(Spot);
Exit;
end;
if (Spot.Y-Height) < 0 then begin
Inc(Spot.Y,N_PIXELS);
CheckDownRight(Spot);
Exit;
end;
ShowPos.X:=Spot.X;
ShowPos.Y:=Spot.Y-Height;
end;
procedure TNewHint.CheckDownRight(Spot:TPoint);
var
Width,Height:Integer;
begin
Inc(Spot.Y,N_PIXELS*3);
Width := DownRect.Right-DownRect.Left;
Height := DownRect.Bottom-DownRect.Top;
SelectHintDirection := hdDownRight;
if (Spot.X+Width) > Screen.Width then begin
Dec(Spot.Y,N_PIXELS*3);
CheckDownLeft(Spot);
Exit;
end;
if (Spot.Y+Height) > Screen.Height then begin
Dec(Spot.Y,N_PIXELS*3);
CheckUpRight(Spot);
Exit;
end;
ShowPos.X:=Spot.X;
ShowPos.Y:=Spot.Y;
end;
procedure TNewHint.CheckDownLeft(Spot:TPoint);
var
Width,Height:Integer;
begin
Inc(Spot.Y,N_PIXELS*3);
Width := DownRect.Right-DownRect.Left;
Height := DownRect.Bottom-DownRect.Top;
SelectHintDirection:= hdDownLeft;
if (Spot.X+SHADOW_WIDTH-Width) < 0 then begin
Dec(Spot.Y,N_PIXELS*3);
CheckDownRight(Spot);
Exit;
end;
if (Spot.Y+Height) > Screen.Height then begin
Dec(Spot.Y,N_PIXELS*3);
CheckUpLeft(Spot);
Exit;
end;
ShowPos.X:=Spot.X+SHADOW_WIDTH-Width;
ShowPos.Y:=Spot.Y;
end;
procedure TNewHint.SelectProperHintDirection(ARect:TRect);
var
Spot :TPoint;
OldHintDirection,
SendHintDirection:THintDirection;
HintControl :TControl;
begin
GetCursorPos(Spot);
HintCOntrol:=FindDragTarget(Spot,True);
Inc(ARect.Right,10+SHADOW_WIDTH);
Inc(ARect.Bottom,20);
UpRect:=ARect;
Inc(ARect.Bottom,9);
DownRect:=ARect;
OldHintDirection :=FDanHint.HintDirection;
SendHintDirection:=FDanHint.HintDirection;
if Assigned(FDanHint.FOnSelectHintDirection) then begin
FDanHint.FOnSelectHintDirection(HintControl,SendHintDirection);
FDanHint.HintDirection:=SendHintDirection;
end;
case FDanHint.HintDirection of
hdUpRight:CheckUpRight(Spot);
hdUpLeft:CheckUpLeft(Spot);
hdDownRight:CheckDownRight(Spot);
hdDownLeft:CheckDownLeft(Spot);
end;
FDanHint.HintDirection:=OldHintDirection;
end;
function TNewHint.FindToken(var S: String; Sep: Char): String;
var
I : Word;
begin
I:=Pos(Sep,S);
if I<>0 then begin
Result:=Copy(S,1,I-1);
Delete(S,1,I);
end else begin
Result:=S;
S:='';
end;
end;
function TNewHint.BetweenToken(var S: String; Sep: Char):String;
var
Token: String;
begin
Token := FindToken(S,Sep);
Result:= FindToken(S,Sep);
end;
function TNewHint.TokenCount(S: String; Sep: Char):Integer;
begin
Result:=0;
while S<>''do begin
FindToken(S,Sep);
inc(Result);
end;
dec(Result);
end;
procedure TNewHint.ActivateHint(Rect: TRect; const AHint: string);
var
ScreenDC : HDC;
LeftTop : TPoint;
tmpWidth,i,temp,old,z,t,new,korr,tmpHeight : Integer;
s2 : String;
s : TStringList;
begin
if not HActive then
exit;
if hDepth > 300 then
hDepth:=300;
MemBmp :=TBitmap.Create;
Caption :=AHint;
s :=TStringList.Create;
s2 :=' '+ AHint;
with Rect do begin
tmpWidth :=Right -Left;
tmpHeight:=Bottom-Top;
i := Canvas.TextHeight(AHint);
korr:= round(tmpHeight/i)-1;
dec(korr,TokenCount(AHint,#13));
if(tmpWidth)>hDepth then begin
caption := '**';
i := 0;
while (caption <> '') do begin
caption := BetweenToken(s2,' ');
if s2 <> ' ' then
s2 := ' ' + s2;
if caption <> '' then begin
s.add(caption);
inc(i);
end;
end;
old := 0;
temp := 0;
for z := 0 to i-1 do begin
temp := Canvas.TextWidth(s.strings[z])+6;
if temp > old then
old := temp;
end;
if temp > hDepth then
temp:=old
else
temp:=hDepth;
old:=-1;new:=0;z:=0;
while z s2:=s.strings[z];
t :=z+1;
while (Canvas.TextWidth(s2) <= (temp-6)) and (t < i) do begin
s2 := s2+' '+s[t];
inc(t);
end;
if (t > z+1) and (t <= i) and (Canvas.TextWidth(s2) > (temp-6)) then begin
Delete(s2,Pos(s[t-1],s2)-1,length(s[t-1])+1);
z := t-2;
dec(t);
end;
caption := caption+s2;
if ((z < i-1) and (t < i)) then
caption := caption+#13;
if Canvas.TextWidth(s2)+6 > new then
new := Canvas.TextWidth(s2)+6;
inc(old);
if (z >= i-1) or (t >= i) then
break;
inc(z);
end;
s.Free;
Right := Left+new+6;
inc(Bottom,(old-korr)*Canvas.TextHeight(AHint));
end;
end; {with rect}
FDanHint := FindDanHint;
SelectProperHintDirection(Rect);
HintDirection := SelectHintDirection;
Inc(Rect.Right,10+SHADOW_WIDTH);
Inc(Rect.Bottom,20);
if (FHintDirection>=hdDownRight) then Inc(Rect.Bottom,9);
tmpWidth :=Rect.Right-Rect.Left;
tmpHeight :=Rect.Bottom-Rect.Top;
Rect.Left :=ShowPos.X;
Rect.Top :=ShowPos.Y;
Rect.Right :=Rect.Left+tmpWidth;
Rect.Bottom:=Rect.Top+tmpHeight;
BoundsRect :=Rect;
MemBmp.Width :=Width;
MemBmp.Height:=Height;
ScreenDC:=CreateDC('DISPLAY',nil,nil,nil);
LeftTop.X:=0;
LeftTop.Y:=0;
LeftTop:=ClientToScreen(LeftTop);
{Screen상의 본래의 Bitmap을 저장학기위하여 MemBmp를 사용한다}
BitBlt(MemBmp.Canvas.Handle,0,0,Width,Height,ScreenDC,LeftTop.X,LeftTop.Y,SRCCOPY);
{SetBkMode(Canvas.Handle,TRANSPARENT);}
SetWindowPos(Handle, HWND_TOPMOST, ShowPos.X, ShowPos.Y, 0,0, SWP_SHOWWINDOW or
SWP_NOACTIVATE or SWP_NOSIZE);
BitBlt(Canvas.Handle,0,0,Width,Height,MemBmp.Canvas.Handle,0,0,SRCCOPY);
DeleteDC(ScreenDC);
end;
end.
|
|
