xpwindow.pas

非常好的xp界面控件

  HitInfo := TWMNCHitTest (Message);
  GetWindowRect (FxpWindow.FForm.Handle, WinRect);
  BtnCheck := PtInButton (Point (HitInfo.XPos - WinRect.Left, HitInfo.YPos - WinRect.Top),
                          Rect (0, 0, WinRect.Right - WinRect.Left, FHeight + FBorderSize));

  FDownedButton := BtnCheck;

  ABorderSize := 0;

  if FShowBorder then ABorderSize := FBorderSize;

  case Message.WParam of
    HTSYSMENU:
    begin
      SetCursorPos(WinRect.Left + 2 + ABorderSize, WinRect.Top + ABorderSize+ FHeight);
      Message.LParam := MakeLong (WinRect.Left + 2 + ABorderSize, WinRect.Top + 2 + ABorderSize);
    end;
    HTCLOSE:
    begin
      ChangeButtonState (0, tbsDowned, Rect (0, 0, WinRect.Right - WinRect.Left, FHeight + ABorderSize));
      Result := true;
    end;
    HTMAXBUTTON:
    begin
      ChangeButtonState (1, tbsDowned, Rect (0, 0, WinRect.Right - WinRect.Left, FHeight + ABorderSize));
      Result := true;
    end;
    HTMINBUTTON:
    begin
      ChangeButtonState (2, tbsDowned, Rect (0, 0, WinRect.Right - WinRect.Left, FHeight + ABorderSize));
      Result := true;
    end;
    HTOBJECT:
    begin
      ChangeButtonState (BtnCheck, tbsDowned, Rect (0, 0, WinRect.Right - WinRect.Left, FHeight + ABorderSize));
      Result := true;
    end;
  end;
end;

procedure TxpCaption.SetActive (AActive : Boolean);
var
  dwStyle : longint;
begin
  FActive := AActive;

  dwStyle := GetWindowLong(FxpWindow.FForm.Handle, GWL_STYLE);
  if AActive then
  begin
    FOrignDLGFRAME := (dwStyle and WS_DLGFRAME) <> 0;
    dwStyle := dwStyle and not WS_DLGFRAME;

    //Temporary
    //FxpWindow.FForm.VertScrollBar.Visible := False;
    //FxpWindow.FForm.HorzScrollBar.Visible := False;
    //
  end
  else
    //if FOrignDLGFRAME then dwStyle := dwStyle or WS_DLGFRAME;
    if FxpWindow.FForm.BorderStyle <> bsNone then dwStyle := dwStyle or WS_DLGFRAME;

  if (FxpWindow.Active) and not (csDesigning in FxpWindow.ComponentState) then
  begin
    SetWindowLong(FxpWindow.FForm.Handle, GWL_STYLE, dwStyle);
    FxpWindow.SetFormShape (FxpWindow.xpCaption.FRoundedCorners);
  end;

  if (not FActive) and (FRoundedCorners <> []) then
    FxpWindow.RestoreFormShape;

  FxpWindow.Style := xwsCustom;
end;

procedure TxpCaption.SetFont (AValue : TFont);
begin
  FFont.Assign (AValue);
  //SendMessage (FxpWindow.FForm.Handle, WM_NCPAINT, 0, 0);
  SendMessage (FxpWindow.FForm.Handle, WM_FONTCHANGE, 0, 0);
end;

procedure TxpCaption.ChangeButtonState (AIndex : Integer; AState : TTitleButtonState; ATitleRect : TRect);
var
  ButtonRect : TRect;
  ACanvas : TCanvas;
begin
  ButtonRect := Rect (ATitleRect.Right - FButtonSize - 10, (ATitleRect.Bottom + ATitleRect.Top - FButtonSize) div 2,
    ATitleRect.Right - 10, (ATitleRect.Bottom + ATitleRect.Top - FButtonSize) div 2 + FButtonSize);

  if AIndex < 3 then
  begin
    //System button offset
    case AIndex of
      0: begin end;
      1: OffsetRect (ButtonRect, - (FButtonSize + 2) * (Integer (biSystemMenu in FxpWindow.FForm.BorderIcons) ), 0);
      2: OffsetRect (ButtonRect, - (FButtonSize + 2) * (Integer (biSystemMenu in FxpWindow.FForm.BorderIcons) + Integer (biMaximize in FxpWindow.FForm.BorderIcons) ), 0);
    end;
  end
  else
    //Custom Button offset
    OffsetRect (ButtonRect, - (FButtonSize + 2) * ((AIndex - 3) + GetSysButtonCount), 0);

  InflateRect (ButtonRect, -1, -1);

  ACanvas := TCanvas.Create;
  try
    ACanvas.Handle := GetWindowDC (FxpWindow.FForm.Handle);

    InflateRect (ButtonRect, 1, 1);

    if (AIndex in [3..3+FCustomButtonCount]) then
    begin
      // Custom draw for custom buttons
      if (Assigned (FxpWindow.FOnCustomButtonDraw)) then
        FxpWindow.FOnCustomButtonDraw (Self, ACanvas, ButtonRect, AIndex - 2, AState);
    end
    else
    begin
      case AIndex of
        0: begin
             //Close button
             if Assigned (FxpWindow.OnCustomSysBtnDraw) then
             begin
               FxpWindow.OnCustomSysBtnDraw (FxpWindow, ACanvas, ButtonRect, csbCloseButton, AState);
             end
             else
             begin
               if Assigned (FInternalSysBtnDraw) then
               begin
                 FInternalSysBtnDraw (FxpWindow.FForm, ACanvas, ButtonRect, csbCloseButton, AState);
               end
               else
               begin
                 DrawButtonRect (ACanvas, ButtonRect, AState, true);
                 DrawCloseButtonImage (ACanvas, ButtonRect, AState);
               end;
             end;
           end;
        1: begin
             //Max button
             if Assigned (FxpWindow.OnCustomSysBtnDraw) then
             begin
               FxpWindow.OnCustomSysBtnDraw (FxpWindow, ACanvas, ButtonRect, csbMaxButton, AState);
             end
             else
             begin
               if Assigned (FInternalSysBtnDraw) then
               begin
                 FInternalSysBtnDraw (FxpWindow.FForm, ACanvas, ButtonRect, csbMaxButton, AState);
               end
               else
               begin
                 DrawButtonRect (ACanvas, ButtonRect, AState, False);
                 DrawMaxButtonImage (ACanvas, ButtonRect, AState);
               end;
             end;
           end;
        2: begin
             ////Min button
             if Assigned (FxpWindow.OnCustomSysBtnDraw) then
             begin
               FxpWindow.OnCustomSysBtnDraw (FxpWindow, ACanvas, ButtonRect, csbMinButton, AState);
             end
             else
             begin
               if Assigned (FInternalSysBtnDraw) then
               begin
                 FInternalSysBtnDraw (FxpWindow.FForm, ACanvas, ButtonRect, csbMinButton, AState);
               end
               else
               begin
                 DrawButtonRect (ACanvas, ButtonRect, AState, False);
                 DrawMinButtonImage (ACanvas, ButtonRect, AState);
               end;
             end;
           end;
      end;
    end;

  finally
    ReleaseDC (FxpWindow.FForm.Handle, ACanvas.Handle);
    ACanvas.Free;
  end;

end;

procedure TxpCaption.DrawButtonRect (ACanvas : TCanvas; AButtonRect : TRect; AState : TTitleButtonState; CloseBtn : Boolean);
var
  FillDir : TFillDirection;
  AStartColor, AEndColor : TColor;
begin
  ACanvas.Brush.Style := bsClear;
  ACanvas.Pen.Color := clWhite;
  ACanvas.Pen.Width := 1;
  InflateRect (AButtonRect, -1, -1);

  if AState = tbsDowned then
    FillDir := fdBottomToTop
  else
    FillDir := fdTopToBottom;

  if CloseBtn then
  begin
    AStartColor := clRed;
    AEndColor := clPurple;
  end
  else
  begin
    AStartColor := FActiveStartColor;
    AEndColor := FActiveEndColor;
  end;

  if AState = tbsActive then
  begin
    AStartColor := MakeDarkColor (AStartColor, -30);
    AEndColor := MakeDarkColor (AEndColor, -30);
  end;

  GradientFillRect (ACanvas, AButtonRect, AStartColor, AEndColor, FillDir, 30);

  InflateRect (AButtonRect, 1, 1);
  ACanvas.Pen.Color := FBtnBorderColor;
  ACanvas.RoundRect (AButtonRect.Left, AButtonRect.Top,
    AButtonRect.Right, AButtonRect.Bottom, 3, 3);
end;

procedure TxpCaption.DrawButtons (ACanvas : TCanvas; ATitleRect : TRect);
var
  ButtonRect : TRect;
  AState : TTitleButtonState;
  I : Integer;
  ACustomDraw : Boolean;
begin
  ButtonRect := Rect (ATitleRect.Right - FButtonSize - 10, (ATitleRect.Bottom + ATitleRect.Top - FButtonSize) div 2,
    ATitleRect.Right - 10, (ATitleRect.Bottom + ATitleRect.Top - FButtonSize) div 2 + FButtonSize);

  ACustomDraw := False;
  //Close button
  if biSystemMenu in FxpWindow.FForm.BorderIcons then
  begin
    if FDownedButton = 0 then AState := tbsDowned else AState := tbsNormal;

    if Assigned (FxpWindow.OnCustomSysBtnDraw) then
    begin
      FxpWindow.OnCustomSysBtnDraw (FxpWindow, ACanvas, ButtonRect, csbCloseButton, AState);
      ACustomDraw := true;
    end;

    if not ACustomDraw then
    begin
      if Assigned (FInternalSysBtnDraw) then
        FInternalSysBtnDraw (FxpWindow.FForm, ACanvas, ButtonRect, csbCloseButton, AState)
      else
      begin
        DrawButtonRect (ACanvas, ButtonRect, AState, true);
        DrawCloseButtonImage (ACanvas, ButtonRect, tbsNormal);
      end;
    end;

    OffsetRect (ButtonRect, - FButtonSize - 2, 0);
  end;

  //Maximize button
  if (biSystemMenu in FxpWindow.FForm.BorderIcons) and (biMaximize in FxpWindow.FForm.BorderIcons) then
  begin
    if FDownedButton = 1 then AState := tbsDowned else AState := tbsNormal;

    if Assigned (FxpWindow.OnCustomSysBtnDraw) then
    begin
      FxpWindow.OnCustomSysBtnDraw (FxpWindow, ACanvas, ButtonRect, csbMaxButton, AState);
      ACustomDraw := true;
    end;

    if not ACustomDraw then
    begin
      if Assigned (FInternalSysBtnDraw) then
        FInternalSysBtnDraw (FxpWindow.FForm, ACanvas, ButtonRect, csbMaxButton, AState)
      else
      begin
        DrawButtonRect (ACanvas, ButtonRect, AState, false);
        DrawMaxButtonImage (ACanvas, ButtonRect, tbsNormal);
      end;
    end;  
    OffsetRect (ButtonRect, - FButtonSize-2, 0);
  end;

  //Minimize button
  if (biSystemMenu in FxpWindow.FForm.BorderIcons) and (biMinimize in FxpWindow.FForm.BorderIcons) then
  begin
    if FDownedButton = 2 then AState := tbsDowned else AState := tbsNormal;

    if Assigned (FxpWindow.OnCustomSysBtnDraw) then
    begin
      FxpWindow.OnCustomSysBtnDraw (FxpWindow, ACanvas, ButtonRect, csbMinButton, AState);
      ACustomDraw := true;
    end;

    if not ACustomDraw then
    begin
      if Assigned (FInternalSysBtnDraw) then
        FInternalSysBtnDraw (FxpWindow.FForm, ACanvas, ButtonRect, csbMinButton, AState)
      else
      begin
        DrawButtonRect (ACanvas, ButtonRect, AState, false);
        DrawMinButtonImage (ACanvas, ButtonRect, tbsNormal);
      end;
    end;
    OffsetRect (ButtonRect, - FButtonSize-2, 0);
  end;

  For I := 1 to FCustomButtonCount do
  begin
    if Assigned (FxpWindow.FOnCustomButtonDraw) then
      FxpWindow.FOnCustomButtonDraw (Self, ACanvas, ButtonRect, I, tbsNormal);
    OffsetRect (ButtonRect, - FButtonSize-2, 0);
  end;
end;

function TxpCaption.PtInButton (APoint : TPoint; ATitleRect : TRect) : Integer;
var
  ButtonRect : TRect;
  I  : Integer;
  ABorderSize : Integer;
begin
  Result := -10; //HTCAPTION
{
     -10  HTCAPTION;
     -2   HTMENU;
     -1   HTSYSMENU;
      0   HTCLOSE;
      1   TMAXBUTTON;
      2   TMINBUTTON;
      else CustomButton
}
  if FShowBorder then ABorderSize := FBorderSize else ABorderSize := 0;

  if FDisplayAppIcon and PtInRect (Rect (ABorderSize+FIconMarginLeft, ABorderSize+FIconMarginTop,
     FHeight - 2+FIconMarginLeft, FHeight-2+FIconMarginTop), APoint) then
  begin
    Result := -1;
    Exit;
  end;

  {if (GetMenu (FxpWindow.FForm.Handle) <> 0) and
     (PtInRect (Rect (ATitleRect.Left + ABorderSize, ATitleRect.Top + ABorderSize + FHeight+1,
                ATitleRect.Right - ABorderSize, ATitleRect.Top + ABorderSize + FHeight+1+GetSystemMetrics (SM_CYMENU)),
                APoint)) then
  begin
    Result := -2;
    Exit;
  end;}

  ButtonRect := Rect (ATitleRect.Right - FButtonSize - 10, (ATitleRect.Bottom + ATitleRect.Top - FButtonSize) div 2,
    ATitleRect.Right - 10, (ATitleRect.Bottom + ATitleRect.Top - FButtonSize) div 2 + FButtonSize);

  if biSystemMenu in FxpWindow.FForm.BorderIcons then
    if PtInRect (ButtonRect, APoint) then
    begin
      Result := 0;
      Exit;
    end
    else
      OffsetRect (ButtonRect, - FButtonSize - 2, 0);

  if (biSystemMenu in FxpWindow.FForm.BorderIcons) and (biMaximize in FxpWindow.FForm.BorderIcons) then
    if PtInRect (ButtonRect, APoint) then
    begin
      Result := 1;
      Exit;
    end
    else
      OffsetRect (ButtonRect, - FButtonSize - 2, 0);

  if (biSystemMenu in FxpWindow.FForm.BorderIcons) and (biMinimize in FxpWindow.FForm.BorderIcons) then
    if PtInRect (ButtonRect, APoint) then
    begin
      Result := 2;
      Exit;
    end
    else
      OffsetRect (ButtonRect, - FButtonSize - 2, 0);

  For I := 0 to FCustomButtonCount-1 do
  begin
    if PtInRect (ButtonRect, APoint) then
    begin
      Result := I + 3;
      Exit;
    end;
    OffsetRect (ButtonRect, - FButtonSize - 2, 0);
  end;

end;

procedure TxpCaption.DrawBorder (ACanvas : TCanvas; ABorderRect : TRect);
var
  WinRgn : hRgn;
  ABorderBmp : TBitmap;
  ABorderColor : TColor;
  ABorderSize : Integer;
  AContinue : Boolean;
  AInternalDraw : Boolean;