xppanel.pas

非常好的xp界面控件

      end;
      //Image
      if FTitleImageTransparent then
        DrawBitmapTransparent (ACanvas, X - Integer (FMouseOnHeader), Y - Integer (FMouseOnHeader),
          FTitleImage, FTitleImage.Canvas.Pixels [0,0])
      else
        ACanvas.Draw (X - Integer (FMouseOnHeader),  Y - Integer (FMouseOnHeader), FTitleImage);
    end
    else
    begin
      FTitleImage.TransparentMode := tmAuto;
      FTitleImage.Transparent := FTitleImageTransparent;
      case FTitleImageAlign of
        tiaStretch:
          ACanvas.StretchDraw (ATitleRect, FTitleImage);
        tiaTile:
          TileImage (ACanvas, ATitleRect, FTitleImage);
      end;
    end;

  end;

  if FTitle <> '' then
  begin
    ATextRect.Right := ABtnOffset;

    ATextFormat := DT_VCENTER or DT_END_ELLIPSIS or DT_SINGLELINE;
    ACanvas.Font.Assign (FTitleFont);
    case FTitleAlignment of
      taLeftJustify: ATextFormat := ATextFormat or DT_LEFT;
      taRightJustify: ATextFormat := ATextFormat or DT_RIGHT;
      taCenter: ATextFormat := ATextFormat or DT_CENTER;
    end;
    ACanvas.Brush.Style := bsClear;

    //Shadow
    ACanvas.Font.Color := clLtGray;
    DrawText (ACanvas.Handle, PChar (FTitle), Length(FTitle), ATextRect, ATextFormat);

    //Text
    ACanvas.Font.Assign (FTitleFont);
    OffsetRect (ATextRect, -1, -1);
    if FMouseOnHeader then OffsetRect (ATextRect, -1, -1);
    DrawText (ACanvas.Handle, PChar (FTitle), Length(FTitle), ATextRect, ATextFormat);
  end;
end;


procedure TxpPanel.DrawAllTitleButtons (ACanvas : TCanvas; ATitleRect : TRect);
const
  XOffset : Integer = 22;
var
  AButtonRect : TRect;
begin
  if FTitleButtons = [] then Exit;

  AButtonRect.Left := ATitleRect.Right - cTitleButtonSize - 5 + XOffset;
  AButtonRect.Right := ATitleRect.Right - 5 + XOffset;
  AButtonRect.Top := (ATitleRect.Bottom + ATitleRect.Top) div 2 - (cTitleButtonSize div 2)+1;
  AButtonRect.Bottom := (ATitleRect.Bottom + ATitleRect.Top) div 2 + (cTitleButtonSize div 2);

  if tbClose in FTitleButtons then
  begin
    AButtonRect.Left := AButtonRect.Left - XOffset;
    AButtonRect.Right := AButtonRect.Right- XOffset;
    FCloseBtnRect := AButtonRect;
    DrawTitleButton (ACanvas, AButtonRect, tbClose);
  end;

  if tbMaximize in FTitleButtons then
  begin
    AButtonRect.Left := AButtonRect.Left - XOffset;
    AButtonRect.Right := AButtonRect.Right- XOffset;
    FMaxBtnRect := AButtonRect;
    DrawTitleButton (ACanvas, AButtonRect, tbMaximize);
  end;

  if tbMinimize in FTitleButtons then
  begin
    AButtonRect.Left := AButtonRect.Left - XOffset;
    AButtonRect.Right := AButtonRect.Right- XOffset;
    FMinBtnRect := AButtonRect;
    DrawTitleButton (ACanvas, AButtonRect, tbMinimize);
  end;
end;

procedure TxpPanel.DrawTitleButton (ACanvas : TCanvas; AButtonRect : TRect; ABtnType : TTitleButton);
var
  XCenter, YCenter, Radius : Integer;
begin
  //ACanvas.Pen.Color := $D9B6AD;

  ACanvas.Pen.Color := MakeDarkColor (ACanvas.Pixels [AButtonRect.Right, AButtonRect.Bottom], 10);
  ACanvas.Pen.Width := 1;
  ACanvas.Brush.Color := MakeDarkColor (ACanvas.Pixels [AButtonRect.Right, AButtonRect.Bottom], 10);
  ACanvas.Ellipse (AButtonRect.Left-1, AButtonRect.Top-1, AButtonRect.Right+2, AButtonRect.Bottom+2);

  if FTitleGradient then
    ACanvas.Pen.Color := MakeDarkColor (FTitleEndColor, 30)
  else
    ACanvas.Pen.Color := MakeDarkColor (FTitleColor, 30);
  ACanvas.Pen.Width := 1;
  ACanvas.Brush.Color := clWhite;
  ACanvas.Ellipse (AButtonRect.Left, AButtonRect.Top, AButtonRect.Right, AButtonRect.Bottom);

  ACanvas.Pen.Color := MakeDarkColor (clWhite, 20);
  ACanvas.Pen.Width := 1;


  ACanvas.Brush.Color := clWhite;

  ACanvas.Ellipse (AButtonRect.Left+1, AButtonRect.Top+1, AButtonRect.Right-1, AButtonRect.Bottom-1);

  XCenter := (AButtonRect.Right + AButtonRect.Left) div 2;
  YCenter := (AButtonRect.Bottom + AButtonRect.Top) div 2;

  if XCenter < YCenter then
    Radius := (XCenter - AButtonRect.Left)-4
  else
    Radius := (YCenter - AButtonRect.Top)-4;

  ACanvas.Pen.Width := 2;
  if FMouseOnHeader and FShowHeader then
    ACanvas.Pen.Color := $FF5C33
  else
    ACanvas.Pen.Color := $A53C00;

  case ABtnType of
    tbClose:
      begin
          ACanvas.Polyline ([Point (XCenter - Radius + 2, YCenter - Radius + 2),
                       Point (XCenter + Radius - 2, YCenter + Radius - 2)    ]);

          ACanvas.Polyline ([Point (XCenter + Radius - 2, YCenter - Radius + 2),
                       Point (XCenter - Radius + 2, YCenter + Radius - 2)    ]);
      end;
    tbMaximize:
      begin
        ACanvas.Pen.Width := 1;
        if FMaximized then
        begin
          ACanvas.Rectangle (XCenter - Radius + 1, YCenter - Radius + 1,
                             XCenter + Radius-1, YCenter + Radius-2);
          ACanvas.Rectangle (XCenter - Radius + 3, YCenter - Radius + 3,
                             XCenter + Radius+1, YCenter + Radius);
        end
        else
        begin
          ACanvas.Rectangle (XCenter - Radius + 1, YCenter - Radius + 1,
                             XCenter + Radius, YCenter + Radius);
          ACanvas.Rectangle (XCenter - Radius + 1, YCenter - Radius + 2,
                             XCenter + Radius, YCenter + Radius);
        end;
      end;
    tbMinimize:
      begin
        if FMinimized then
        begin
          //Drawing down arrows
          ACanvas.Polyline ([Point (XCenter - Radius + 2, YCenter - Radius + 1),
                       Point (XCenter, YCenter-1),
                       Point (XCenter + Radius - 2, YCenter - Radius + 1)    ]);

          ACanvas.Polyline ([Point (XCenter - Radius + 2, YCenter+1),
                       Point (XCenter, YCenter + Radius - 1),
                       Point (XCenter + Radius - 2, YCenter+1)    ]);
        end
        else
        begin
          //Drawing up arrows
          ACanvas.Polyline ([Point (XCenter - Radius + 2, YCenter - 1),
                       Point (XCenter, YCenter - Radius + 1),
                       Point (XCenter + Radius - 2, YCenter - 1)    ]);

          ACanvas.Polyline ([Point (XCenter - Radius + 2, YCenter + Radius - 1),
                       Point (XCenter, YCenter+1),
                       Point (XCenter + Radius - 2, YCenter + Radius - 1)    ]);
        end;
    end;     
  end;
end;




procedure TxpPanel.DrawBorder (ACanvas : TCanvas; ARect : TRect; AClient : Boolean);
var
  ARoundedCorner : TRoundedCorners;
begin
  ACanvas.Brush.Style := BSCLEAR;
  ACanvas.Pen.Color := FBorderColor;
  ACanvas.Pen.Width := FBorderSize;

  ACanvas.Rectangle (ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);

  if FRoundedCorner = [] then Exit;

  ARoundedCorner := FRoundedCorner;

  if AClient then
    ARoundedCorner := ARoundedCorner - [rcTopLeft, rcTopRight];

  if (rcTopLeft in ARoundedCorner) and (rcTopRight in ARoundedCorner) and
      (rcBottomLeft in ARoundedCorner) and (rcBottomRight in ARoundedCorner) then
  begin
    ACanvas.RoundRect (ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, cCornerRadius, cCornerRadius);
    ARoundedCorner := [];
  end
  else
  if (rcTopLeft in ARoundedCorner) and (rcTopRight in ARoundedCorner) then
  begin
    ACanvas.RoundRect (ARect.Left, ARect.Top, ARect.Right, ARect.Bottom + cCornerRadius*2, cCornerRadius, cCornerRadius);
    ARoundedCorner := ARoundedCorner - [rcTopLeft, rcTopRight];
  end
  else
  if (rcBottomLeft in ARoundedCorner) and (rcBottomRight in ARoundedCorner) then
  begin
    ACanvas.RoundRect (ARect.Left, ARect.Top - cCornerRadius*2, ARect.Right, ARect.Bottom, cCornerRadius, cCornerRadius);
    ARoundedCorner := ARoundedCorner - [rcBottomLeft, rcBottomRight];
  end
  else
  if (rcTopLeft in ARoundedCorner) and (rcBottomLeft in ARoundedCorner) then
  begin
    ACanvas.RoundRect (ARect.Left, ARect.Top, ARect.Right + cCornerRadius*2, ARect.Bottom, cCornerRadius, cCornerRadius);
    ARoundedCorner := ARoundedCorner - [rcTopLeft, rcBottomLeft];
  end
  else
  if (rcTopRight in ARoundedCorner) and (rcBottomRight in ARoundedCorner) then
  begin
    ACanvas.RoundRect (ARect.Left - cCornerRadius*2, ARect.Top, ARect.Right, ARect.Bottom, cCornerRadius, cCornerRadius);
    ARoundedCorner := ARoundedCorner - [rcTopRight, rcBottomRight];
  end;

  if ARoundedCorner = [] then Exit;

  if (rcTopLeft in ARoundedCorner) then
    ACanvas.RoundRect (ARect.Left, ARect.Top, ARect.Right + cCornerRadius*2, ARect.Bottom + cCornerRadius*2, cCornerRadius, cCornerRadius);
  if (rcTopRight in ARoundedCorner) then
    ACanvas.RoundRect (ARect.Left - cCornerRadius*2, ARect.Top, ARect.Right, ARect.Bottom + cCornerRadius*2, cCornerRadius, cCornerRadius);
  if (rcBottomLeft in ARoundedCorner) then
    ACanvas.RoundRect (ARect.Left, ARect.Top - cCornerRadius*2, ARect.Right + cCornerRadius*2, ARect.Bottom, cCornerRadius, cCornerRadius);
  if (rcBottomRight in ARoundedCorner) then
    ACanvas.RoundRect (ARect.Left - cCornerRadius*2, ARect.Top - cCornerRadius*2, ARect.Right, ARect.Bottom, cCornerRadius, cCornerRadius);



end;

procedure TxpPanel.DrawBGImage (ACanvas : TCanvas);
begin
  FBGImage.TransparentMode := tmAuto;
  FBGImage.Transparent := FBGImageTransparent;
  case FBGImageAlign of
    iaStretch:
      begin
        ACanvas.StretchDraw (ClientRect, FBGImage);
      end;
    iaCenter:
      begin
        ACanvas.Draw (
          (ClientWidth - FBGImage.Width) div 2,
          (ClientHeight - FBGImage.Height) div 2,
          FBGImage);
      end;
    iaTile:
      begin
        TileImage (ACanvas, ClientRect, FBGImage);
      end;
  end;
end;


//Draw client area

procedure TxpPanel.Paint;
var
  TempCanvas : TBitmap;
  WinRect : TRect;
begin
  TempCanvas := TBitmap.Create;
  try
    TempCanvas.Width := ClientWidth;
    TempCanvas.Height := ClientHeight;
    if FGradientFill then
    begin
      GradientFillRect (TempCanvas.Canvas, ClientRect, FStartColor, FEndColor, FFillDirection, 60);
    end
    else
    Begin
      TempCanvas.Canvas.Brush.Style := bsSolid;
      TempCanvas.Canvas.Brush.Color := Color;
      TempCanvas.Canvas.FillRect (ClientRect);
    end;

    if not FBGImage.Empty then DrawBGImage (TempCanvas.Canvas);

    BitBlt(Canvas.Handle, 0, 0, TempCanvas.Width, TempCanvas.Height,
      TempCanvas.Canvas.Handle, 0, 0, SRCCOPY);

    if FShowBorder then
    begin
      SendMessage (Handle, WM_NCPAINT, wmNCPaintOnlyBorder, 0);
      //SendMessage (Handle, WM_NCPAINT, 0, 0);
    end;

  finally
    TempCanvas.Free;
  end;
end;

//Calculate nonclient area
procedure TxpPanel.WMNCCalcSize (var Message : TWMNCCalcSize);
begin
  if FShowBorder then
  begin
    InflateRect (Message.CalcSize_Params^.rgrc[0], -FBorderSize, -FBorderSize);
    if FShowHeader then
      Inc (Message.CalcSize_Params^.rgrc[0].Top, FTitleHeight);
  end
  else
  begin
    if FShowHeader then
      Inc (Message.CalcSize_Params^.rgrc[0].Top, FTitleHeight+1);
  end;

  inherited;
end;

procedure TxpPanel.WMNCACTIVATE (var Message : TWMNCActivate);
begin
  inherited;
end;


procedure TxpPanel.NCHitTest (var Message : TWMNCHitTest);
var
  WinRect : TRect;
  ClientPoint : TPoint;
  PanelPoint : TPoint;
  ABottom : Integer;
  ATitleHeight : Integer;
  ABorderSize : Integer;
begin
  inherited;
  Message.Result := HTCLIENT;

  GetWindowRect (Handle, WinRect);
  ABottom := WinRect.Bottom;

  if FShowHeader then ATitleHeight := FTitleHeight else ATitleHeight := 0;

  if FShowBorder then
  begin
    ABorderSize := FBorderSize;
    if ABorderSize < 5 then ABorderSize := 5;
  end
  else
    ABorderSize := 0;


  WinRect.Bottom := WinRect.Top + ATitleHeight;

  ClientPoint := Point (Message.XPos, Message.YPos);

  PanelPoint := ScreenToClient (ClientPoint);

  if PtInRect (WinRect, Point (Message.XPos, Message.YPos)) then
    Message.Result := HTOBJECT;

  if FTitleShadowOnMouseEnter then
  begin
    if (not FMouseOnHeader) and ((PtInRect (WinRect, Point (Message.XPos, Message.YPos)))) then
    begin
      FMouseOnHeader := true;
      SendMessage (Handle, WM_NCPAINT, 0, 0);

      if Assigned (FOnTitleMouseEnter) then FOnTitleMouseEnter (self);
    end
    else
    if (not ((PtInRect (WinRect, Point (Message.XPos, Message.YPos))))) and (FMouseOnHeader) then
    begin
      FMouseOnHeader := False;
      SendMessage (Handle, WM_NCPAINT, 0, 0);
      if Assigned (FOnTitleMouseExit) then FOnTitleMouseExit (self);
    end;
  end;

  Inc (PanelPoint.y, FTitleHeight);

  if tbClose in FTitleButtons then
  begin
    if PtInRect (FCloseBtnRect, PanelPoint) then
      Message.Result := HTCLOSE;
  end;

  if tbMaximize in FTitleButtons then
  begin
    if PtInRect (FMaxBtnRect, PanelPoint) then
      Message.Result := HTMAXBUTTON;
  end;

  if tbMinimize in FTitleButtons then
  begin
    if PtInRect (FMinBtnRect, PanelPoint) then
      Message.Result := HTMINBUTTON;
  end;

  if (csDesigning in ComponentState) then Exit;

  WinRect.Bottom := ABottom;
  if FSizable and not FMinimized and not Maximized then
  begin
    if PtInRect (Rect (WinRect.Left, WinRect.Top, WinRect.Left + ABorderSize+5, WinRect.Top + ABorderSize + 5), ClientPoint) then
      Message.Result := HTTOPLEFT
    else
    //Check mouse on TopRight border