타이틀바에 버튼을 올려서 사용중입니다.
xp이하에서는 잘 작동이 되는데 비스타와 윈7의 투명타이틀바(aero)에서는 보이지 않는 현상이 발생합니다.
어떻게 해결할 방법이 없나요?
참고 :
http://delphicikk.atw.hu/listaz.php?id=1668&oldal=28
unit TitleBtn;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Forms, Dialogs,
Buttons, Controls, StdCtrls, ExtCtrls;
type
TTitleBtnForm = class(TForm)
procedure FormResize(Sender: TObject);
procedure FormCreate(Sender: TObject);
function GetSystemTitleBtnCount: integer;
procedure KillHint;
private
TitleButton: TRect;
FActive: boolean;
FHint: THintWindow;
Timer2: TTimer;
procedure DrawTitleButton(i: integer);
{Paint-related messages}
procedure WMSetText(var Msg: TWMSetText); message WM_SETTEXT;
procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
procedure WMNCActivate(var Msg: TWMNCActivate); message WM_NCACTIVATE;
{Mouse-related messages}
procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHitTest;
procedure WMNCLButtonDown(var Msg: TWMNCLButtonDown);
message WM_NCLBUTTONDOWN;
procedure WMNCLButtonUp(var Msg: TWMNCLButtonUp); message WM_NCLBUTTONUP;
procedure WMNCMouseMove(var Msg: TWMNCMouseMove); message WM_NCMouseMove;
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
{-}
function GetVerInfo: DWORD;
{-}
procedure ShowHint;
procedure Timer2Timer(Sender: TObject);
public
end;
const
htTitleBtn = htSizeLast + 1;
implementation
uses
PauLitaData, About, SpoolMessages;
procedure TTitleBtnForm.FormResize(Sender: TObject);
begin
Perform(WM_NCACTIVATE, Word(Active), 0);
end;
procedure TTitleBtnForm.DrawTitleButton(i: integer);
var
bmap: TBitmap; {Bitmap to be drawn - 16x16: 16 Colors}
XFrame, {X and Y size of Sizeable area of Frame}
YFrame,
XTtlBit, {X and Y size of Bitmaps in caption}
YTtlBit: integer;
n: integer;
begin
{Get size of form frame and bitmaps in title bar}
XFrame := GetSystemMetrics(SM_CXFRAME);
YFrame := GetSystemMetrics(SM_CYFRAME);
XTtlBit := GetSystemMetrics(SM_CXSIZE);
YTtlBit := GetSystemMetrics(SM_CYSIZE);
n := GetSystemTitleBtnCount;
if GetVerInfo = VER_PLATFORM_WIN32_NT then
TitleButton := Bounds(Width - XFrame - (n + 1) * XTtlBit + 1 - 3, YFrame + 1 - 3,
XTtlBit - 2, YTtlBit - 4)
else
TitleButton := Bounds(Width - XFrame - (n + 1) * XTtlBit + 1, YFrame + 1, XTtlBit
- 2, YTtlBit - 4);
Canvas.Handle := GetWindowDC(Self.Handle);
try
{Draw a button face on the TRect}
DrawButtonFace(Canvas, TitleButton, 1, bsAutoDetect, FALSE, FALSE, FALSE);
bmap := TBitmap.Create;
DataModule1.ImageList1.GetBitmap(i, bmap);
with TitleButton do
if GetVerInfo = VER_PLATFORM_WIN32_NT then
Canvas.Draw(Left + 2, Top + 2, bmap)
else
Canvas.StretchDraw(TitleButton, bmap);
finally
ReleaseDC(Self.Handle, Canvas.Handle);
bmap.Free;
Canvas.Handle := 0;
end;
end;
procedure TTitleBtnForm.WMSetText(var Msg: TWMSetText);
begin
inherited;
DrawTitleButton(0);
end;
procedure TTitleBtnForm.WMNCPaint(var Msg: TWMNCPaint);
begin
inherited;
DrawTitleButton(0);
end;
procedure TTitleBtnForm.WMNCActivate(var Msg: TWMNCActivate);
begin
inherited;
DrawTitleButton(0);
end;
procedure TTitleBtnForm.WMNCLButtonDown(var Msg: TWMNCLButtonDown);
begin
inherited;
if (Msg.HitTest = htTitleBtn) then
DrawTitleButton(1);
end;
procedure TTitleBtnForm.WMNCLButtonUp(var Msg: TWMNCLButtonUp);
begin
inherited;
if (Msg.HitTest = htTitleBtn) then
begin
KillHint;
ShowAboutBox;
end;
end;
procedure TTitleBtnForm.WMNCMouseMove(var Msg: TWMNCMouseMove);
begin
inherited;
if (Msg.HitTest = htTitleBtn) and PtinRect(TitleButton, Point(Msg.XCursor - Left,
Msg.YCursor - Top)) then
ShowHint
else
KillHint;
end;
function TTitleBtnForm.GetVerInfo: DWORD;
var
verinfo: TOSVERSIONINFO;
begin
verinfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
if GetVersionEx(verinfo) then
Result := verinfo.dwPlatformID;
end;
procedure TTitleBtnForm.WMNCHitTest(var Msg: TWMNCHitTest);
begin
inherited;
with Msg do
begin
if PtinRect(TitleButton, Point(XPos - Left, YPos - Top)) then
Result := htTitleBtn;
end;
end;
function TTitleBtnForm.GetSystemTitleBtnCount: integer;
var
Menu: HMenu;
i, n, m, l: integer;
begin
l := 0;
Menu := GetSystemMenu(Handle, FALSE);
n := GetMenuItemCount(Menu);
for i := 0 to n - 1 do
begin
m := GetMenuItemID(Menu, i);
if (m = SC_RESTORE) or (m = SC_MAXIMIZE) or (m = SC_CLOSE) then
Inc(l)
else if (m = SC_MINIMIZE) then
Inc(l, 2);
end;
Result := l;
end;
procedure TTitleBtnForm.KillHint;
begin
if Assigned(Timer2) then
begin
Timer2.Enabled := FALSE;
Timer2.Free;
Timer2 := nil;
end;
if Assigned(FHint) then
begin
FHint.ReleaseHandle;
FHint.Free;
FHint := nil;
end;
FActive := FALSE;
end;
procedure TTitleBtnForm.Timer2Timer(Sender: TObject);
var
thePoint: TPoint;
theRect: TRect;
Count: DWORD;
i: integer;
begin
Timer2.Enabled := FALSE;
Timer2.Free;
Timer2 := nil;
thePoint.X := TitleButton.Left;
thePoint.Y := TitleButton.Bottom - 25;
with theRect do
begin
topLeft := ClientToScreen(thePoint);
Right := Left + Canvas.TextWidth(MsgAbout) + 10;
Bottom := Top + 14;
end;
FHint := THintWindow.Create(Self);
FHint.Color := clInfoBk;
FHint.ActivateHint(theRect, MsgAbout);
for i := 1 to 7 do
begin
Count := GetTickCount;
repeat
{Application.ProcessMessages;}
until
(GetTickCount - Count >= 18);
with theRect do
begin
Inc(Top);
Inc(Bottom);
FHint.SetBounds(Left, Top, FHint.Width, FHint.Height);
FHint.Update;
end;
end; { i }
FActive := TRUE;
end;
procedure TTitleBtnForm.ShowHint;
begin
if FActive then
Exit;
if Assigned(Timer2) then
Exit;
Timer2 := TTimer.Create(Self);
Timer2.Interval := 500;
Timer2.OnTimer := Timer2Timer;
Timer2.Enabled := TRUE;
end;
procedure TTitleBtnForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y:
Integer);
begin
inherited;
KillHint;
end;
procedure TTitleBtnForm.FormCreate(Sender: TObject);
begin
OnMouseMove := FormMouseMove;
end;
end.
