procedure Register;
begin
RegisterComponents(''''Liao'''', [TTitleBarButton]);
end;
{ TTitleBarButton }
constructor TTitleBarButton.Create(AOwner: TComponent);
var
ptr: Pointer;
begin
inherited;
FForm := GetParentForm(TControl(AOwner));
FGlyph := TBitmap.Create;
FColor := clBtnFace;
FVisible := False;
FRightMargin := 66;
FButtonDown := False;
FOldWndProc := Pointer(GetWindowLong(FForm.Handle,GWL_WNDPROC));
ptr := MakeObjectInstance(NewWndProc);
SetWindowLong(FForm.Handle, GWL_WNDPROC, Longint(ptr));
end;
destructor TTitleBarButton.Destroy;
begin
if not (csDestroying in FForm.ComponentState) then
begin
SetVisible(false);
SetWindowLong(FForm.Handle, GWL_WNDPROC, LongInt(FOldWndProc));
end;
FGlyph.Free;
inherited;
end;
procedure TTitleBarButton.NewWndProc(var message: TMessage);
function HitButton(APoint: TPoint): Boolean;
begin
APoint.x := APoint.x - FForm.Left;
APoint.y := APoint.y - FForm.Top;
Result := PtInRect(BoundsRect,APoint);
end;
var
p: TPoint;
begin
with message do
begin
if Visible then
begin
case Msg of
WM_NCPAINT , WM_NCACTIVATE :
begin
Result := CallWindowProc(FOldWndProc,FForm.Handle,Msg,WParam,LParam);
RePaint;
end;
WM_NCHITTEST :
begin
Result := CallWindowProc(FOldWndProc,FForm.Handle,Msg,WParam,LParam);
if Result = HTCAPTION then
begin
RePaint;
p.x := LoWord(LParam);
ScreenToClient(FForm.Handle,p);
with BoundsRect do //减去框架宽度
if (p.x >= Left-4) and (p.x <= Right-4) then Result := 888;
end;
end;
WM_NCLBUTTONDOWN,WM_NCLBUTTONDBLCLK:
begin
Result := CallWindowProc(FOldWndProc,FForm.Handle,Msg,WParam,LParam);
with TWMNCLButtonDown(message) do
if not HitButton(Point(XCursor, YCursor)) then Exit;
if WParam = 888 then
begin
FButtonDown := True;
Repaint;
上一页 [1] [2] [3] [4] [5] 下一页 | 
