xppanel.pas

非常好的xp界面控件

    if PtInRect (Rect (WinRect.Right - 5, WinRect.Top, WinRect.Right+1, WinRect.Top + 5), ClientPoint) then
      Message.Result := HTTOPRIGHT
    //Check mouse on BottomLeft border
    else
    if PtInRect (Rect (WinRect.Left, WinRect.Bottom - ABorderSize-5, WinRect.Left+5, WinRect.Bottom), ClientPoint) then
      Message.Result := HTBOTTOMLEFT
    //Check mouse on BottomRight border
    else
    if PtInRect (Rect (WinRect.Right-5, WinRect.Bottom - ABorderSize-5, WinRect.Right, WinRect.Bottom), ClientPoint) then
      Message.Result := HTBOTTOMRIGHT
    else
    //Check mouse on Left border
    if PtInRect (Rect (WinRect.Left, WinRect.Top + 5, WinRect.Left + ABorderSize, WinRect.Right - ABorderSize), ClientPoint) then
      Message.Result := HTLEFT
    else
    //Check mouse on Right border
    if PtInRect (Rect (WinRect.Right - ABorderSize, WinRect.Top + 5, WinRect.Right+1, WinRect.Bottom - 5), ClientPoint) then
      Message.Result := HTRIGHT
    else
    //Check mouse on Top border
    if PtInRect (Rect (WinRect.Left+5, WinRect.Top, WinRect.Right-5, WinRect.Top + ABorderSize), ClientPoint) then
      Message.Result := HTTOP
    //Check mouse on Bottom border
    else
    if PtInRect (Rect (WinRect.Left+5, WinRect.Bottom - ABorderSize, WinRect.Right-5, WinRect.Bottom), ClientPoint) then
      Message.Result := HTBOTTOM;
  end;


  if FMovable and PtInRect (WinRect, ClientPoint) and
     not (Message.Result in [HTCLOSE, HTMINBUTTON, HTMAXBUTTON]) then
  begin
    WinRect.Bottom := WinRect.Top + ATitleHeight;
    InflateRect (WinRect, -ABorderSize, -ABorderSize);
    if PtInRect (WinRect, ClientPoint) then Message.Result := HTCAPTION;
  end;

end;


//Draw nonclient area
procedure TxpPanel.WMNCPaint(var Message : TWMNCPaint);
var
  UpdateRect : TRect;
  HeaderRect : TRect;
  DC : hDC;
  NCCanvas : TCanvas;
  TempCanvas : TBitmap;
begin
  DC := GetWindowDC (Handle);
  NCCanvas := TCanvas.Create;
  try
    NCCanvas.Handle := DC;
    GetWindowRect (Handle, UpdateRect);

    OffsetRect (UpdateRect, - UpdateRect.Left, - UpdateRect.Top);

    HeaderRect := UpdateRect;
    HeaderRect.Bottom := FTitleHeight + FBorderSize;

    if FShowBorder then
    begin
      HeaderRect.Bottom := FTitleHeight + FBorderSize;
      InflateRect (HeaderRect, -FBorderSize, 0);
    end;

    if (FShowHeader) and (Message.Unused{$IFNDEF DELPHI6UP}[0]{$ENDIF} <> wmNCPaintOnlyBorder) then
    begin
      TempCanvas := TBitmap.Create;
      try
        //Title Drawing
        TempCanvas.Width := HeaderRect.Right - HeaderRect.Left;
        TempCanvas.Height := HeaderRect.Bottom - HeaderRect.Top;
        DrawTitle (TempCanvas.Canvas, HeaderRect);

        //Title Butons Drawing
        DrawAllTitleButtons (TempCanvas.Canvas, HeaderRect);

        BitBlt(DC, HeaderRect.Left, HeaderRect.Top, TempCanvas.Width, TempCanvas.Height,
          TempCanvas.Canvas.Handle, 0, 0, SRCCOPY);
      finally
        TempCanvas.Free;
      end;
    end;

    if FShowBorder then
    begin
      //DrawBorder (NCCanvas, UpdateRect, (Message.Unused[0] = wmNCPaintOnlyBorder));
      DrawBorder (NCCanvas, UpdateRect, False);
    end;


  finally
    NCCanvas.Free;
    ReleaseDC (Handle, DC);
  end;
  Message.Result := 0;

  inherited;
end;

procedure TxpPanel.WMSize (var Message : TMessage);
begin
  FullRepaint := (FGradientFill and FBGImage.Empty) or
    ((not FBGImage.Empty) and (FBGImageAlign <> iaTile )) or
    (FGradientFill and (not FBGImage.Empty) and (FBGImageAlign <> iaTile)) ;
  SetShape (FRoundedCorner);
  inherited;
end;


procedure TxpPanel.SetShape (ARounded : TRoundedCorners);
var
  WinRgn : hRgn;
  WinRgn1 : hRgn;
  WinRgn2 : hRgn;
  ShadowRgn : hRgn;
  Rectn : TRect;
  RTop, RBottom : Integer;
  AWidth, AHeight : Integer;
begin
  WinRgn := 0;
  GetWindowRect (Handle, Rectn);
  OffsetRect (Rectn, -Rectn.Left, -Rectn.Top);

  //Delete old window region
  GetWindowRgn (Handle, WinRgn);
  DeleteObject(WinRgn);

  AWidth := Width;
  AHeight := Height;

  {if FShadow then
  begin
    Dec (AWidth, FShadowDist);
    Dec (AHeight, FShadowDist);
  end;}

  if ARounded <> [] then
  begin
    RTop := 0;
    RBottom := AHeight;
    if (rcTopLeft in ARounded) or (rcTopRight in ARounded) then RTop := cCornerRadius div 2;
    if (rcBottomLeft in ARounded) or (rcBottomRight in ARounded) then RBottom := AHeight - cCornerRadius div 2;

    WinRgn := CreateRectRgn (0, RTop, AWidth, RBottom);

    //Create topleft rounded corner
    if  rcTopLeft in ARounded then
    begin
      WinRgn1 := CreateRectRgn (cCornerRadius div 2, cCornerRadius div 2, cCornerRadius, cCornerRadius);
      WinRgn2 := CreateEllipticRgn (0,0,cCornerRadius+1,cCornerRadius+1);
      CombineRgn (WinRgn1, WinRgn1, WinRgn2, RGN_OR);
      CombineRgn (WinRgn, WinRgn, WinRgn1, RGN_OR);
      DeleteObject(WinRgn1);
      DeleteObject(WinRgn2);

      //Create result region
      if rcTopRight in ARounded then
      begin
        WinRgn1 := CreateRectRgn (cCornerRadius div 2, 0, AWidth - cCornerRadius div 2, cCornerRadius);
        CombineRgn (WinRgn, WinRgn, WinRgn1, RGN_OR);
      end
      else
      begin
        WinRgn1 := CreateRectRgn (cCornerRadius div 2, 0, AWidth, cCornerRadius);
        CombineRgn (WinRgn, WinRgn, WinRgn1, RGN_OR);
      end;
      DeleteObject(WinRgn1);
    end;

    //Create topright rounded corner
    if  rcTopRight in ARounded then
    begin
      WinRgn1 := CreateRectRgn (AWidth - cCornerRadius, 0, AWidth - cCornerRadius div 2, cCornerRadius);
      WinRgn2 := CreateEllipticRgn (AWidth - cCornerRadius + 1, 0, AWidth+1, cCornerRadius);
      CombineRgn (WinRgn1, WinRgn1, WinRgn2, RGN_OR);
      CombineRgn (WinRgn, WinRgn, WinRgn1, RGN_OR);
      DeleteObject(WinRgn1);
      DeleteObject(WinRgn2);

      //Create result region
      if rcTopLeft in ARounded then
      begin
        WinRgn1 := CreateRectRgn (cCornerRadius div 2, 0, AWidth - cCornerRadius div 2, cCornerRadius);
        CombineRgn (WinRgn, WinRgn, WinRgn1, RGN_OR);
      end
      else
      begin
        WinRgn1 := CreateRectRgn (0, 0, AWidth - cCornerRadius, cCornerRadius);
        CombineRgn (WinRgn, WinRgn, WinRgn1, RGN_OR);
      end;
      DeleteObject (WinRgn1);
    end;

    //Create bottomleft rounded corner
    if  rcBottomLeft in ARounded then
    begin
      WinRgn1 := CreateRectRgn (cCornerRadius div 2, AHeight - cCornerRadius, cCornerRadius, AHeight - cCornerRadius div 2);
      WinRgn2 := CreateEllipticRgn (0, AHeight - cCornerRadius, cCornerRadius,AHeight+1);
      CombineRgn (WinRgn1, WinRgn1, WinRgn2, RGN_OR);
      CombineRgn (WinRgn, WinRgn, WinRgn1, RGN_OR);
      DeleteObject(WinRgn1);
      DeleteObject(WinRgn2);

      //Create result region
      if rcBottomRight in ARounded then
      begin
        WinRgn1 := CreateRectRgn (cCornerRadius div 2, AHeight - cCornerRadius div 2, AWidth - cCornerRadius div 2, AHeight);
        CombineRgn (WinRgn, WinRgn, WinRgn1, RGN_OR);
      end
      else
      begin
        WinRgn1 := CreateRectRgn (cCornerRadius div 2, AHeight - cCornerRadius div 2, AWidth, AHeight);
        CombineRgn (WinRgn, WinRgn, WinRgn1, RGN_OR);
      end;
      DeleteObject (WinRgn1);
    end;

    //Create bottomright rounded corner
    if  rcBottomRight in ARounded then
    begin
      WinRgn1 := CreateRectRgn (AWidth - cCornerRadius, AHeight - cCornerRadius,
        AWidth - cCornerRadius div 2, AHeight);
      WinRgn2 := CreateEllipticRgn (AWidth - cCornerRadius + 1, AHeight-cCornerRadius+1, AWidth+1, AHeight+1);
      CombineRgn (WinRgn1, WinRgn1, WinRgn2, RGN_OR);
      CombineRgn (WinRgn, WinRgn, WinRgn1, RGN_OR);
      DeleteObject(WinRgn1);
      DeleteObject(WinRgn2);

      //Create result region
      if rcBottomLeft in ARounded then
      begin
        WinRgn1 := CreateRectRgn (cCornerRadius div 2, AHeight - cCornerRadius div 2, AWidth - cCornerRadius div 2+1, AHeight);
        CombineRgn (WinRgn, WinRgn, WinRgn1, RGN_OR)
      end
      else
      begin
        WinRgn1 := CreateRectRgn (0, AHeight - cCornerRadius div 2, AWidth - cCornerRadius div 2+1, AHeight);
        CombineRgn (WinRgn, WinRgn, WinRgn1, RGN_OR);
      end;
      DeleteObject (WinRgn1);
    end;

  end
  else
    WinRgn := CreateRectRgn (0, 0, AWidth, AHeight);


  //////////////////////////////////////////////////////////////////////////////
  ////////////////  Creating  top region for title bitmap //////////////////////
  //////////////////////////////////////////////////////////////////////////////
  {
  if (not FTitleImage.Empty) and (FTitleImageAlign in [tiaLeft, tiaCenter, tiaRight]) and
     (FTitleImage.Height > FTitleHeight) then
  begin
    if FTitleImageTransparent then
      WinRgn1 := CreateRegionFromBitmap (FTitleImage,
                 FTitleImage.Canvas.Pixels [FTitleImage.Canvas.ClipRect.Left, FTitleImage.Canvas.ClipRect.Top],
                 0)
    else
      WinRgn1 := CreateRegionFromBitmap (FTitleImage, clNone,  30);

    //OffsetRgn (WinRgn1, 5, FTitleImage.Height - FTitleHeight + 5);
    OffsetRgn (WinRgn, 0, FTitleImage.Height - FTitleHeight + 5);
    CombineRgn (WinRgn, WinRgn, WinRgn1, RGN_OR);

    DeleteObject (WinRgn1);
  end;        }
  //////////////////////////////////////////////////////////////////////////////
  
  SetWindowRgn (Handle, WinRgn, true);
end;

procedure TxpPanel.ForceReDraw;
begin
  SendMessage (Handle, WM_NCPAINT, 0, 0);
  Invalidate;
end;

procedure TxpPanel.Loaded;
begin
  inherited;
  if FRoundedCorner <> [] then SetShape (FRoundedCorner);
  SendMessage (Handle, WM_NCPAINT, 0, 0);

  if Minimized then
    FHeight := DefaultHeight
  else
    FHeight := Height;
  FOldBounds := BoundsRect;
  if Align = alClient then
  begin
    FOldAlign := alNone;
    FMaximized := true;
  end
  else
    FMaximized := false;
end;

procedure TxpPanel.MouseEnter (var Message : TMessage);
begin
  inherited;
  if Assigned (FOnMouseEnter) then FOnMouseEnter (self);
end;

procedure TxpPanel.MouseLeave (var Message : TMessage);
begin
  inherited;
  if FMouseOnHeader then
  begin
    FMouseOnHeader := False;
    FullRepaint := False;
    SendMessage (Handle, WM_NCPAINT, 0, 0);

    if Assigned (FOnTitleMouseExit) then FOnTitleMouseExit (self);
  end;

  if Assigned (FOnMouseExit) then FOnMouseExit (self);
end;

procedure TxpPanel.NCMouseDown (var Message : TWMNCLBUTTONDOWN);
var
  ATitleHeight : Integer;
begin
  if not (Message.HitTest in [HTCLOSE, HTMINBUTTON, HTMAXBUTTON]) then
  begin
    if Message.HitTest = HTCAPTION then
    begin
      if Assigned (FBeforeMoving) then FBeforeMoving (self);
    end;

    inherited;

    Invalidate;
    if Message.HitTest in [HTTOP, HTLEFT, HTRIGHT, HTBOTTOM,
          HTTOPLEFT, HTTOPRIGHT, HTBOTTOMLEFT, HTBOTTOMRIGHT] then
    begin
      Invalidate;
    end;

    if Message.HitTest = HTCAPTION then
    begin
      if Assigned (FAfterMoving) then FAfterMoving (self);
    end;

    try Parent.Realign; except end;
  end;

  ATitleHeight := 0;
  if FShowHeader then ATitleHeight := FTitleHeight;
  if FShowBorder then ATitleHeight := ATitleHeight + 1;

  if Assigned (FOnTitleMouseDown) then
    FOnTitleMouseDown (Self, mbLeft, [],
      ScreenToClient (Point (Message.XCursor, Message.YCursor)).x,
      ScreenToClient (Point (Message.XCursor, Message.YCursor)).y + ATitleHeight);

end;

procedure TxpPanel.NCMouseUp (var Message : TWMNCLBUTTONUP);
var
  ATitleHeight : Integer;
begin
  inherited;
  Parent.Realign;
  if Assigned (FOnTitleClick) and
     not (Message.HitTest in [HTCLOSE, HTMINBUTTON, HTMAXBUTTON]) then FOnTitleClick (Self);

  ATitleHeight := 0;
  if FShowHeader then ATitleHeight := FTitleHeight;
  if FShowBorder then ATitleHeight := ATitleHeight + 1;

  if Assigned (FOnTitleMouseUp) then
    FOnTitleMouseUp (Self, mbLeft, [],
      ScreenToClient (Point (Message.XCursor, Message.YCursor)).x,
      ScreenToClient (Point (Message.XCursor, Message.YCursor)).y + ATitleHeight);

  case Message.HitTest of
    HTCLOSE:
    begin
      Visible := False;
      if Assigned (FAfterClose) then FAfterClose (Self);
    end;
    HTMAXBUTTON:
    begin
      Maximized := not Maximized;
    end;
    HTMINBUTTON:
    begin
      Minimized := not Minimized;
    end;
  end;
end;

procedure TxpPanel.NCMouseDblClick (var Message : TWMNCLButtonDblClk);
begin
  if Assigned (FOnTitleDblClick) then FOnTitleDblClick (self);
  if tbMinimize in FTitleButtons then Minimized := not Minimized else
    if tbMaximize in FTitleButtons then Maximized := not Maximized;
end;


procedure TxpPanel.SetGradientFill (AValue : Boolean);
begin
  if FGradientFill <> AValue then
  begin
    FGradientFill := AValue;
    ForceReDraw;
  end;
end;

procedure TxpPanel.SetStartColor (AColor : TColor);
begin
  if FStartColor <> AColor then
  begin