xpwindow.pas

非常好的xp界面控件

begin
  if Assigned (FxpWindow.OnCustomBorderDraw) then
  begin
    AContinue := False;
    FxpWindow.OnCustomBorderDraw (FxpWindow, ACanvas, ABorderRect, FActiveWindow, AContinue);
    Exit;
  end;

  AInternalDraw := False;
  if Assigned (FInternalDrawBorder) then
  begin
    AContinue := False;
    FInternalDrawBorder (FxpWindow, ACanvas, ABorderRect, FActiveWindow, AContinue);
    AInternalDraw := true;
  end;

  if not AInternalDraw then
  begin
    ACanvas.Pen.Width := FBorderSize;

    if FActiveWindow then ACanvas.Pen.Color := FBorderColor
      else ACanvas.Pen.Color := FBorderInActiveColor;

    WinRgn := FxpWindow.GetWindowShape (FRoundedCorners);

    if FActiveWindow then
      ABorderColor := FBorderColor
    else
      ABorderColor := FBorderInActiveColor;

    if FShowBorder then ABorderSize := FBorderSize
      else ABorderSize := 0;

    if (rcBottomLeft in FRoundedCorners) or (rcBottomRight in FRoundedCorners) then
    begin
      ACanvas.Brush.Color := FxpWindow.FForm.Color;
      ACanvas.FillRect (
        Rect (ABorderRect.Left, ABorderRect.Bottom - (FRoundedCornerRadius div 2) - ABorderSize,
              ABorderRect.Right, ABorderRect.Bottom));
    end;

    ACanvas.Brush.Color := ACanvas.Pen.Color;
    ABorderBmp := TBitmap.Create;
    try
      ABorderBmp.Width := FBorderSize;
      ABorderBmp.Height := 1;
      GradientFillRect (ABorderBmp.Canvas, Rect (0,0,FBorderSize,1), ABorderColor, MakeDarkColor (ABorderColor, -20), fdHorizFromCenter, ABorderSize div 2);
      ACanvas.Brush.Bitmap := ABorderBmp;

      if FVisible then
      begin
        FrameRgn (ACanvas.Handle, WinRgn, ACanvas.Brush.Handle, Min (ABorderSize, 2), -1);
        ACanvas.FillRect (Rect (ABorderRect.Left, ABorderRect.Top + ABorderSize + FHeight, ABorderRect.Left + ABorderSize, ABorderRect.Bottom));
        ACanvas.FillRect (Rect (ABorderRect.Right - BorderSize, ABorderRect.Top + ABorderSize + FHeight, ABorderRect.Right, ABorderRect.Bottom));
      end
      else
      begin
        FrameRgn (ACanvas.Handle, WinRgn, ACanvas.Brush.Handle, ABorderSize, -1);
      end;


      ABorderBmp.Width := 1;
      ABorderBmp.Height := FBorderSize;
      GradientFillRect (ABorderBmp.Canvas, Rect (0,0,1,FBorderSize), MakeDarkColor (ABorderColor, -20), ABorderColor, fdTopToBottom, ABorderSize);
      ACanvas.Brush.Bitmap := nil;
      ACanvas.Brush.Bitmap := ABorderBmp;

      if FVisible then
      begin
        FrameRgn (ACanvas.Handle, WinRgn, ACanvas.Brush.Handle,  -1, Min (ABorderSize, 2));
        ACanvas.FillRect (Rect (ABorderRect.Left, ABorderRect.Bottom - ABorderSize, ABorderRect.Right, ABorderRect.Bottom));
      end
      else
      begin
        FrameRgn (ACanvas.Handle, WinRgn, ACanvas.Brush.Handle,  -1, ABorderSize);
      end;
    finally
      ABorderBmp.Free;
      ACanvas.Brush.Bitmap := nil;
    end;
    DeleteObject (WinRgn);


    //Draw Line under title
    if FVisible then
    begin
      ACanvas.Pen.Width := 2;
      ACanvas.MoveTo (ABorderRect.Left + FBorderSize, ABorderRect.Top + FHeight + FBorderSize-1);
      ACanvas.LineTo (ABorderRect.Right - FBorderSize, ABorderRect.Top + FHeight + FBorderSize-1);
    end;
  end;

end;

procedure TxpCaption.DrawTitle (ACanvas : TCanvas; ATitleRect : TRect);
var
  X, Y, Offs : Integer;
  IconBitmap : TBitmap;
  ABorderSize : Integer;
  AContinue : Boolean;
begin
  if Assigned (FInternalDrawTitle) then
  begin
    AContinue := False;
    FInternalDrawTitle (FxpWindow, ACanvas, ATitleRect, FActiveWindow, AContinue);
    if not AContinue then Exit;
  end;

  if FShowBorder then
    ABorderSize := FBorderSize
  else
    ABorderSize := 0;
  // Filling title
  if FGradientFill then
  begin
    if FActiveWindow then
    begin
      GradientFillRect (ACanvas, ATitleRect, FActiveStartColor, FActiveEndColor, FFillDirection, 60);
    end
    else
    begin
      GradientFillRect (ACanvas, ATitleRect, FInActiveStartColor, FInActiveEndColor, FFillDirection, 60);
    end;
  end
  else
  begin
    ACanvas.Brush.Color := FActiveStartColor;
    ACanvas.Brush.Style := bsSolid;
    ACanvas.FillRect (ATitleRect);
  end;

  ACanvas.Font.Assign (FFont);
  X := 5;
  Y := (ATitleRect.Top + ATitleRect.Bottom - ACanvas.TextHeight (FxpWindow.FForm.Caption)) div 2;

  //Calc application icon offset
  if FDisplayAppIcon then  Inc (X, FHeight - ABorderSize);

  //Draw title image
  if not FbgImage.Empty then
  begin
    FbgImage.TransparentMode := tmAuto;
    FbgImage.Transparent := False;
    case FImageAlign of
      iaLeft:
      begin
        if FImageTransparent then
          DrawBitmapTransparent (ACanvas, X, (ATitleRect.Bottom + ATitleRect.Top - FBGImage.Height) div 2, FbgImage, FbgImage.Canvas.Pixels [0,0])
        else
          ACanvas.Draw (X, (ATitleRect.Bottom + ATitleRect.Top - FBGImage.Height) div 2, FbgImage);
        Inc (X, FBGImage.Width + 10);
      end;
      iaRight:
      begin
        Offs := (GetSysButtonCount + FCustomButtonCount) * (FButtonSize + 2) + 10;
        if FImageTransparent then
          DrawBitmapTransparent (ACanvas, ATitleRect.Right - FBGImage.Width - 2 - Offs,
            (ATitleRect.Bottom + ATitleRect.Top - FBGImage.Height) div 2, FbgImage, FbgImage.Canvas.Pixels [0,0])
        else
          ACanvas.Draw (ATitleRect.Right - FBGImage.Width - 2 - Offs,
            (ATitleRect.Bottom + ATitleRect.Top - FBGImage.Height) div 2,
            FbgImage);
      end;
      iaCenter:
      begin
        if FImageTransparent then
          DrawBitmapTransparent (ACanvas, (ATitleRect.Right + ATitleRect.Left - FBGImage.Width) div 2,
            (ATitleRect.Bottom + ATitleRect.Top - FBGImage.Height) div 2, FbgImage, FbgImage.Canvas.Pixels [0,0])
        else
          ACanvas.Draw ((ATitleRect.Right + ATitleRect.Left - FBGImage.Width) div 2,
            (ATitleRect.Bottom + ATitleRect.Top - FBGImage.Height) div 2,
            FbgImage);
      end;
      iaStretch:
      begin
        if FImageTransparent then
          StretchBitmapRectTransparent (Acanvas, ATitleRect.Left, ATitleRect.Top, ATitleRect.Right- ATitleRect.Left, ATitleRect.Bottom - ATitleRect.Top,
            Rect (0, 0, FbgImage.Width, FbgImage.Height), FbgImage, FbgImage.Canvas.Pixels [0,0])
        else
          ACanvas.StretchDraw (ATitleRect, FbgImage);
      end;
      iaTile:
      begin
        FbgImage.TransparentMode := tmAuto;
        FbgImage.Transparent := FImageTransparent;

        TileImage (ACanvas, ATitleRect, FbgImage);
      end;
    end;
  end;

  AContinue := true;
  if Assigned (FxpWindow.FOnCustomDrawTitle) then
    FxpWindow.FOnCustomDrawTitle (self, ACanvas, ATitleRect, FActiveWindow, AContinue);


  //Draw application icons
  if FDisplayAppIcon and AContinue then
  begin
    IconBitmap := TBitmap.Create;
    try
      if not FxpWindow.FForm.Icon.Empty then
      begin
        DrawIconEx (ACanvas.Handle, ABorderSize + FIconMarginLeft, ABorderSize + FIconMarginTop,
          FxpWindow.FForm.Icon.Handle, FHeight - ABorderSize - 4, FHeight - ABorderSize - 4, 0, 0, DI_NORMAL);
      end
      else
        DrawIconEx (ACanvas.Handle, ABorderSize + FIconMarginLeft, ABorderSize + FIconMarginTop,
          Application.Icon.Handle, FHeight - ABorderSize - 4, FHeight - ABorderSize - 4, 0, 0, DI_NORMAL);
    finally
      IconBitmap.Free;
    end;
  end;


  //Draw text
  if (FxpWindow.FForm.Caption <> '') and AContinue then
  begin
    ACanvas.Brush.Style := bsClear;
    ACanvas.Font.Color := MakeDarkColor (ACanvas.Pixels [X, Y], -30);
    ACanvas.TextOut (X+1 + FIconMarginLeft, Y+1, FxpWindow.FForm.Caption);
    ACanvas.Font.Color := FFont.Color;
    ACanvas.TextOut (X + FIconMarginLeft, Y, FxpWindow.FForm.Caption);
  end;

  DrawButtons (ACanvas, ATitleRect);


end;


// Draw nonclient area
procedure TxpCaption.Draw (var AMessage : TMessage);
var
  UpdateRect : TRect;
  HeaderRect : TRect;
  DC : hDC;
  Image : TBitmap;
  NCCanvas : TCanvas;
begin
  //Get main window device context
  DC := GetWindowDC (FxpWindow.FForm.Handle);

  //Get window rectangle
  GetWindowRect (FxpWindow.FForm.Handle, UpdateRect);
  OffsetRect (UpdateRect, - UpdateRect.Left, - UpdateRect.Top);


  // if title visible ...
  if FVisible then
  begin
    //Calculate header rectangle
    HeaderRect := UpdateRect;
    HeaderRect.Bottom := FHeight;
    if FShowBorder then HeaderRect.Bottom := HeaderRect.Bottom  + FBorderSize;

    Image := TBitmap.Create;
    try
      Image.Width := HeaderRect.Right;
      Image.Height := HeaderRect.Bottom;
      DrawTitle (Image.Canvas, HeaderRect);
      BitBlt(DC, HeaderRect.Left, HeaderRect.Top, Image.Width, Image.Height,
           Image.Canvas.Handle, 0, 0, SRCCOPY);
    finally
      Image.Free;
    end;
  end;


  NCCanvas := TCanvas.Create;
  NCCanvas.Handle := DC;
  try
    if FShowBorder then
      DrawBorder (NCCanvas, UpdateRect)
    else
    begin
      if (rcBottomLeft in FRoundedCorners) or (rcBottomRight in FRoundedCorners) then
      begin
        NCCanvas.Brush.Color := FxpWindow.FForm.Color;
        NCCanvas.FillRect (Rect(UpdateRect.Left, UpdateRect.Bottom - FRoundedCornerRadius div 2, UpdateRect.Right, UpdateRect.Bottom));
      end;
    end;
  finally
    NCCanvas.Free;
  end;

  ReleaseDC(FxpWindow.FForm.Handle, DC);
end;


procedure TxpCaption.ProcessClientArea (var AMessage : TMessage);
var
  pClientArea : PNCCalcSizeParams;
begin
  pClientArea := PNCCalcSizeParams (AMessage.LParam);
  if FVisible then
  begin
    Inc (pClientArea^.rgrc[0].top, FHeight);

    //Main menu
    //if GetMenu (FxpWindow.FForm.Handle) <> 0 then
    //  Inc (pClientArea^.rgrc[0].top, GetSystemMetrics (SM_CYMENU));
  end;

  if (rcBottomLeft in FRoundedCorners) or
     (rcBottomRight in FRoundedCorners) then
  Dec (pClientArea^.rgrc[0].Bottom, FRoundedCornerRadius div 2);

  if FxpWindow.IsVScrollVisible then
    pClientArea^.rgrc[0].Right := pClientArea^.rgrc[0].Right - 18;

  if FxpWindow.IsHScrollVisible then
    pClientArea^.rgrc[0].Bottom := pClientArea^.rgrc[0].Bottom - 18;

  if FShowBorder then
  begin
    InflateRect (pClientArea^.rgrc[0], -FBorderSize, -FBorderSize);
  end;

end;

procedure TxpCaption.ProcessHitTest (var AMessage : TMessage);
var
  HitInfo : TWMNCHitTest;
  ClientPoint : TPoint;
  WinRect : TRect;
  BtnCheck : Integer;
  ABorderSize : Integer;
  ADragWidth : Integer;
begin
  HitInfo := TWMNCHitTest (AMessage);
  GetWindowRect (FxpWindow.FForm.Handle, WinRect);
  ClientPoint := Point (HitInfo.XPos, HitInfo.YPos);

  if FShowBorder then ABorderSize := FBorderSize else ABorderSize := 0;

  if FRoundedCorners <> [] then ADragWidth := FRoundedCornerRadius div 2 else
    ADragWidth := 5;


  //Check mouse on title
  if (PtInRect (Rect (WinRect.Left + ABorderSize, WinRect.Top + 5, WinRect.Right - ABorderSize,
               WinRect.Top + ABorderSize + FHeight), ClientPoint)) and (FVisible) then
  begin
    BtnCheck := PtInButton (Point (ClientPoint.X - WinRect.Left, ClientPoint.Y - WinRect.Top),
                     Rect (0, 0, WinRect.Right - WinRect.Left, FHeight + ABorderSize) );
    case BtnCheck of
     -10: AMessage.Result := HTCAPTION;
     -2: AMessage.Result := HTMENU;
     -1: AMessage.Result := HTSYSMENU;
      0: AMessage.Result := HTCLOSE;
      1: AMessage.Result := HTMAXBUTTON;
      2: AMessage.Result := HTMINBUTTON;
      else
        AMessage.Result := HTOBJECT;
    end;

    //ChangeButtonState
    if (BtnCheck > -1) then //if mouse on button
    begin
      if (FLastActiveButton <> BtnCheck) then //if mouse on button
      begin
        ChangeButtonState (FLastActiveButton, tbsNormal, Rect (0, 0, WinRect.Right - WinRect.Left, FHeight + ABorderSize));
        ChangeButtonState (BtnCheck, tbsActive, Rect (0, 0, WinRect.Right - WinRect.Left, FHeight + ABorderSize));
        FLastActiveButton := BtnCheck;
      end;
    end
    else
    begin
      if (FLastActiveButton <> -1) then
      begin
        ChangeButtonState (FLastActiveButton, tbsNormal, Rect (0, 0, WinRect.Right - WinRect.Left, FHeight + ABorderSize));
        FLastActiveButton := -1;
      end;
    end;

    if (FDownedButton <> -10) and (FDownedButton <> BtnCheck) then
    begin
      ChangeButtonState (FDownedButton, tbsNormal, Rect (0, 0, WinRect.Right - WinRect.Left, FHeight + ABorderSize));
      FDownedButton := -10;
    end;

    //If left mouse button pressed and cursor left button area
    if (FDownedButton <> -10) and (BtnCheck <> FDownedButton) then
    begin
      //ChangeButtonState (FDownedButton, tbsNormal, Rect (WinRect.Left + FBorderSize, WinRect.Top + 5, WinRect.Right - FBorderSize, WinRect.Top + FBorderSize + FHeight));
      SendMessage (FxpWindow.FForm.Handle, WM_NCPAINT, 0, 0);
      FDownedButton := -10;
    end;
    {else
      if (BtnCheck > -10) and (FDownedButton = -10) then
      begin
        ChangeButtonState (BtnCheck, tbsDowned, Rect (WinRect.Left + FBorderSize, WinRect.Top + 5, WinRect.Right - FBorderSize, WinRect.Top + FBorderSize + FHeight));
        SendMessage (FxpWindow.FForm.Handle, WM_NCPAINT, 0, 0);
      end;}
  end
  else
  //Check mouse in menu
  //if PtInRect (Rect (WinRect.Left + FBorderSize, WinRect.Top + FBorderSize + FHeight,
  //                   WinRect.Right - FBorderSize, WinRect.Top + FBorderSize + FHeight + GetSystemMetrics (SM_CYMENU)),
  //                   ClientPoint) then