dxribbonform.pas

胜天进销存源码,国产优秀的进销存

        UpdateSystemMenu;
      end;
    end;
  end;
end;

procedure TdxCustomRibbonForm.SetUseSkinColor(const Value: Boolean);
begin
  if FUseSkinColor <> Value then
  begin
    FUseSkinColor := Value;
    if HandleAllocated then
      InvalidateRect(Handle, nil, True);
  end;
end;

procedure TdxCustomRibbonForm.UpdateSystemMenu;
begin
  if UseSkin then
  begin
    RibbonNonClientHelper.InitWindowBorderIcons(GetFormBorderIcons);
    GetSystemMenu(Handle, True); //W2k painting bug workaround
  end;
end;

procedure TdxCustomRibbonForm.CMActivate(var Message: TCMActivate);
begin
  FNeedCallActivate := True;
  if not FDelayedActivate then
    inherited;
end;

procedure TdxCustomRibbonForm.CMColorChanged(var Message: TMessage);
begin
  if UseSkin then
  begin
    if (FormStyle = fsMDIForm) and (ClientHandle <> 0) then
      Windows.InvalidateRect(ClientHandle, nil, True);
  end;
  inherited;
end;

procedure TdxCustomRibbonForm.CMShowingChanged(var Message: TMessage);

  procedure UpdateRibbonControls(var ARibbon, AStatusBar: TWinControl);
  var
    I: Integer;
  begin
    for I := 0 to ControlCount - 1 do
    begin
      if Controls[I] is TdxCustomRibbon then
        ARibbon := TWinControl(Controls[I])
      else if Controls[I] is TdxCustomStatusBar then
        AStatusBar := TWinControl(Controls[I]);
      if (ARibbon <> nil) and (AStatusBar <> nil) then Break;
    end;
  end;

  procedure CheckHideRibbonControl(var AControl: TWinControl);
  begin
    if (AControl <> nil) and AControl.HandleAllocated and AControl.Visible then
      ShowWindow(AControl.Handle, SW_HIDE)
    else
      AControl := nil;
  end;

  procedure ShowRibbonControl(AControl: TWinControl);
  begin
    if AControl <> nil then
    begin
      ShowWindow(AControl.Handle, SW_SHOWNA);
      UpdateWindow(AControl.Handle);
    end;
  end;

var
  ANeedHideRibbonControls: Boolean;
  ARibbon, AStatusBar: TWinControl;
begin
  ARibbon := nil; //remove warnings
  AStatusBar := nil;
  ANeedHideRibbonControls := Visible and FVisibleChanging;
  FDelayedActivate := ANeedHideRibbonControls;
  FNeedCallActivate := False;
  try
    if ANeedHideRibbonControls then
    begin
      UpdateRibbonControls(ARibbon, AStatusBar);
      CheckHideRibbonControl(ARibbon);
      CheckHideRibbonControl(AStatusBar);
    end;
    inherited;
  finally
    if ANeedHideRibbonControls then
    begin
      ShowRibbonControl(ARibbon);
      ShowRibbonControl(AStatusBar);
    end;
    FDelayedActivate := False;
    if FNeedCallActivate then
      Perform(CM_ACTIVATE, 0, 0);
  end;
end;

procedure TdxCustomRibbonForm.CMVisibleChanged(var Message: TMessage);
begin
  FVisibleChanging := True;
  try
    inherited;
  finally
    FVisibleChanging := False;
  end;
end;

procedure TdxCustomRibbonForm.WMCancelMode(var Message: TWMCancelMode);
begin
  if UseSkin then
    RibbonNonClientHelper.CancelMode;
  inherited;
end;

procedure TdxCustomRibbonForm.WMCaptureChanged(var Message: TMessage);
begin
  if UseSkin and (THandle(Message.LParam) <> Handle) then
  begin
    FSizingLoop := False;
    RibbonNonClientHelper.CancelMode;
  end;
  inherited;
end;

procedure TdxCustomRibbonForm.WMEraseBkgnd(var Message: TWMEraseBkgnd);

  function GetBkgColor: TColor;
  begin
    if FUseSkinColor then
      Result := RibbonNonClientHelper.GetWindowColor
    else
      Result := Color;
  end;

var
  R: TRect;
begin
  if UseSkin and (IsUseAeroNCPaint or not DoubleBuffered or (TMessage(Message).wParam = TMessage(Message).lParam)) then
  begin
    R := ClientRect;
    //reduce flickering
    if IsUseAeroNCPaint then
      Inc(R.Top, FExtendFrameAtTopHeight);
    if not cxRectIsEmpty(R) then
      FillRectByColor(Message.DC, R, GetBkgColor);
  end
  else
    inherited;
end;

procedure TdxCustomRibbonForm.WMInitMenu(var Message: TWMInitMenu);
begin
  Message.Menu := GetSystemMenu(Handle, False);
  inherited;
  ModifySystemMenu(Message.Menu);
end;

procedure TdxCustomRibbonForm.WMLButtonDown(var Message: TWMLButtonDown);
begin
  if HandleWithHelper(True, mbLeft) then
    UpdateNonClientArea
  else
    inherited;
end;

procedure TdxCustomRibbonForm.WMLButtonUp(var Message: TWMLButtonUp);
begin
  if UseSkin then
  begin
    if HandleWithHelper(False, mbLeft) then
      Message.Result := 0
    else
    begin
      RibbonNonClientHelper.CancelMode;
      inherited;
    end;
  end
  else inherited
end;

procedure TdxCustomRibbonForm.WMRButtonDown(var Message: TWMRButtonDown);
begin
  if HandleWithHelper(True, mbRight) then
    Message.Result := 0
  else
    inherited;
end;

procedure TdxCustomRibbonForm.WMRButtonUp(var Message: TWMRButtonUp);
begin
  if HandleWithHelper(False, mbRight) then
    Message.Result := 0
  else
    inherited;
end;

procedure TdxCustomRibbonForm.WMNCRButtonUp(var Message: TWMNCRButtonUp);
begin
  if HandleWithHelper(False, mbRight) then
    Message.Result := 0
  else
    inherited;
end;

procedure TdxCustomRibbonForm.WMNCActivate(var Message: TWMNCActivate);
var
  AFlags: Cardinal;
begin
  FIsActive := Message.Active;
  if UseSkin then
  begin
    UpdateWindowStates;
    if (FormStyle = fsMDIChild) or IsUseAeroNCPaint then // AB15017 only on XP
    begin                                                // Aero required to call a default method
      AFlags := GetWindowLong(Handle, GWL_STYLE);
      SetWindowLong(Handle, GWL_STYLE, AFlags and not WS_VISIBLE);
      Message.Result := DefWindowProc(Handle, WM_NCACTIVATE, TMessage(Message).WParam, 0);
      SetWindowLong(Handle, GWL_STYLE, AFlags);
    end
    else
      Message.Result := 1; //B20794
    if not (csDestroying in ComponentState) then
    begin
      if not FIsActive then
        RibbonNonClientHelper.CancelMode;
      UpdateNonClientArea
    end;
    if (FormStyle = fsMDIForm) and (ActiveMDIChild <> nil) then
      ActiveMDIChild.Perform(WM_NCACTIVATE, Ord(IsActive), 0);
  end
  else
    inherited;
end;

procedure TdxCustomRibbonForm.WMNCCalcSize(var Message: TWMNCCalcSize);
var
  R, SaveR0: TRect;
  T: Integer;
  AIsZoomed: Boolean;
begin
  if not (UseSkin and Visible and not IsIconic(Handle) and not (csReading in ComponentState)) then
    inherited
  else
  begin
    if Message.CalcValidRects then
    begin
      AIsZoomed := IsZoomed(Handle);
      if IsUseAeroNCPaint then
      begin
        T := Message.CalcSize_Params^.rgrc[0].Top;
        if AIsZoomed and GetWindowRect(Handle, R) and not cxRectIsEqual(R, Message.CalcSize_Params^.rgrc[0]) then
          Realign;
        inherited;
        SaveR0 := Message.CalcSize_Params^.rgrc[0];
        SaveR0.Top := T;
      end
      else
      begin
        R := GetCurrentBordersWidth;
        SaveR0 := Message.CalcSize_Params^.rgrc[0];
        with Message.CalcSize_Params^.rgrc[0] do
        begin
          Inc(SaveR0.Top, R.Top);
          Dec(SaveR0.Bottom, R.Bottom);
          Inc(SaveR0.Left, R.Left);
          Dec(SaveR0.Right, R.Right);
        end;
      end;
      if AIsZoomed then
      begin
        if FormStyle = fsMDIChild then 
        begin
          if IsCompositionEnabled then
            Inc(SaveR0.Top, 2)
          else
            Dec(SaveR0.Top, 2);
        end
        else
        begin
          CalculateZoomedOffsets; //check for Taskbar autohide
          CorrectZoomedBounds(SaveR0);
        end;
      end;
      Message.CalcSize_Params^.rgrc[0] := SaveR0;
    end
    else
      inherited;
    Message.Result := 0;
  end;
end;

procedure TdxCustomRibbonForm.WMNCHitTest(var Message: TWMNCHitTest);
var
  R: TRect;
  P: TPoint;
begin
  if UseSkin then
  begin
    Message.Result := HTNOWHERE;
    if IsUseAeroNCPaint then
    begin
      CallDWMWindowProc(Message);
      if Message.Result = HTNOWHERE then
        inherited;
      if not ((Message.Result = HTCAPTION) or (Message.Result = HTCLIENT)) then
        Exit;
      Message.Result := HTNOWHERE;
    end;
    GetWindowRect(Handle, R);
    P := cxPoint(Message.XPos - R.Left, Message.YPos - R.Top);
    if (BorderStyle in [bsSizeable, bsSizeToolWin]) then
      CheckResizingNCHitTest(Message.Result, P);
    if (Message.Result = HTNOWHERE) and RibbonNonClientHelper.IsInCaptionArea(Message.XPos, Message.YPos) then
      RibbonNonClientHelper.GetWindowCaptionHitTest(Message);
    if Message.Result = HTNOWHERE then
      Message.Result := HTCLIENT;
  end
  else
    inherited;
end;

procedure TdxCustomRibbonForm.WMShowWindow(var Message: TMessage);
begin
  inherited;
  if WordBool(Message.WParam) and UseSkin and IsNormalWindowState then
  begin
    //for a showing MDIChild on vista without DWM
    //make sure for WM_SIZE & WM_NCCALCSIZE
    SetWindowPos(Handle, 0, 0, 0, Width, Height, SWP_NOZORDER or SWP_NOACTIVATE or
      SWP_NOMOVE or SWP_FRAMECHANGED);

    RibbonNonClientHelper.InitWindowBorderIcons(GetFormBorderIcons);
    CaptionChanged;
  end;
end;

procedure TdxCustomRibbonForm.WMNCPaint(var Message: TMessage);
begin
  if UseSkin then
  begin
    if IsUseAeroNCPaint then
      inherited;
    DrawNonClientArea(False, Message.WParam);
    Message.Result := 0;
  end
  else
    inherited;
end;

procedure TdxCustomRibbonForm.WMPaint(var Message: TWMPaint);
begin
  if UseSkin then
  begin
    UpdateWindowStates;
    if IsUseAeroNCPaint then
      ExcludeRibbonPaintArea(Message.DC);
    inherited;
  end
  else
    inherited;
end;

procedure TdxCustomRibbonForm.WMSize(var Message: TWMSize);
var
  R: TRect;
begin
  inherited;
  if UseSkin and not (csReading in ComponentState) then
  begin
    UpdateWindowStates;
    RibbonNonClientHelper.Resize;
    FSizingBorders.cx := GetSystemMetrics(SM_CXSIZEFRAME);
    FSizingBorders.cy := GetSystemMetrics(SM_CYSIZEFRAME);
    if IsUseAeroNCPaint then
    begin