unit Unit3;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,JwaDwmapi, ExtCtrls,jwauxtheme, Buttons;
type
TForm3 =
class(TForm)
btn1: TSpeedButton;
procedure FormActivate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
dwmMargins : MARGINS;
_marginOk : Boolean;
_AeroEnabled: Boolean;
FRectText: TRect;
FDown:boolean;
procedure WndProc(
var Message : TMessage) ;
override ;
function HitTestNCA(hwnd:HWND;wparam:WPARAM;lparam:LPARAM):Integer;
public
{ Public declarations }
function AeroEnabled: Boolean;
procedure CheckGlassEnabled;
end;
var
Form3: TForm3;
implementation
{$R *.dfm}
function TForm3.AeroEnabled: Boolean;
begin
Result:=_AeroEnabled
end;
procedure TForm3.CheckGlassEnabled;
var
Response: Integer;
Enabled : bool;
begin
if (Win32MajorVersion >= 6)
then begin
Enabled:=False;
response :=DwmIsCompositionEnabled(Enabled);
_aeroEnabled:= enabled;
end;
end;
procedure TForm3.FormActivate(Sender: TObject);
begin
inherited;
if (dwmMargins.cyTopHeight < (btn1.Height+btn1.Top))
then
dwmMargins.cyTopHeight:= (btn1.Height+btn1.Top);
DwmExtendFrameIntoClientArea(
Handle,dwmMargins);
end;
procedure TForm3.FormCreate(Sender: TObject);
begin
// InitializeComponent();
// tsNonClientToolStrip.Renderer = new NonClientAreaRenderer();
DoubleBuffered:=true;
CheckGlassEnabled
end;
procedure TForm3.FormPaint(Sender: TObject);
var
r : TRect;
begin
inherited;
if _aeroEnabled
then begin
Canvas.Brush.Color:=TransparentColorValue;
Canvas.FillRect(Form3.ClientRect);
end
else begin
Canvas.Brush.Color:=
RGB($00C2, $00D9, $00F7);
Canvas.FillRect(Form3.ClientRect);
//
end;
r.Left:=dwmMargins.cxLeftWidth - 0;
r.Top:= dwmMargins.cyTopHeight - 0;
r.Right:= Width - dwmMargins.cxRightWidth - 0;
r.Bottom:= Height - dwmMargins.cyBottomHeight - 0;
Canvas.Brush.Color:=clBtnface;
Canvas.FillRect(r);
end;
function TForm3.HitTestNCA(hwnd:HWND; wparam:WParam; lparam:LPARAM):Integer;
var
P : TPoint;
begin
P.X:=LoWord(integer(lparam));
P.Y:=HiWord(integer(lparam));
end;
procedure TForm3.WndProc(
var Message : TMessage);
const
WM_NCCALCSIZE = $0083;
WM_NCHITTEST = $0084;
var
Result : LResult;
dwmHandled : bool;
nccsp: TNCCalcSizeParams;
begin
dwmHandled:=DwmDefWindowProc(Form3.Handle,
Message.Msg,
Message.WParam,
Message.LParam, result);
if (dwmHandled = true)
then begin
message.Result:=result;
//return
end;
if ( (
Message.Msg = WM_NCCALCSIZE)
and (
message.WParam = 1))
then begin
// Adjust (shrink) the client rectangle to accommodate the border:
nccsp.rgrc0.Top :=0;
nccsp.rgrc0.Bottom:= 0;
nccsp.rgrc0.Left :=0;
nccsp.rgrc0.Right:=0;
if (_marginOk=false)
then begin
//Set what client area would be for passing to DwmExtendIntoClientArea
dwmMargins.cyTopHeight:= nccsp.rgrc0.Top - nccsp.rgrc0.Top;
dwmMargins.cxLeftWidth:= nccsp.rgrc0.Left - nccsp.rgrc0.Left;
dwmMargins.cyBottomHeight:= nccsp.rgrc0.Bottom - nccsp.rgrc0.Bottom;
dwmMargins.cxRightWidth:= nccsp.rgrc0.Right - nccsp.rgrc0.Right;
_marginOk := true;
end;
//Marshal.StructureToPtr(nccsp, m.LParam, false);
Message.Result:=0;
end
else if (
message.Msg = WM_NCHITTEST)
and (Integer(
Message.Result)= 0)
then
Message.Result:= HitTestNCA(Form3.Handle,
Message.WParam,
message.LParam)
else
inherited;
end;
end.