dxribbonform.pas

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

      if Message.SizeType = SIZE_MAXIMIZED then
        SetWindowRgn(Handle, 0, False);
      CheckExtendFrame(Message.SizeType = SIZE_MAXIMIZED);
    end
    else
    begin
      if Message.SizeType = SIZE_MAXIMIZED then
      begin
        //clip borders
        GetWindowRect(Handle, R);
        OffsetRect(R, -R.Left, -R.Top);
        with GetDefaultWindowBordersWidth(Handle) do
          R := cxRectInflate(R, -Left, -Top, -Right, -Bottom);
        SetWindowRgn(Handle, CreateRectRgnIndirect(R), True);
      end
      else
      begin
        SetWindowRgn(Handle, RibbonNonClientHelper.GetWindowRegion, True);
        CalculateCornerRegions;
      end;
    end;
  end;
end;

procedure TdxCustomRibbonForm.WMSysCommand(var Message: TWMSysCommand);
begin
  inherited;
  if UseSkin then
  begin
    case (Message.CmdType and $FFF0) of
      SC_MAXIMIZE, SC_RESTORE:
        UpdateNonClientArea;
      else
        UpdateWindowStates;
    end;
  end;
end;

procedure TdxCustomRibbonForm.WMWindowPosChanged(var Message: TWMWindowPosChanged);
begin
  UpdateWindowStates;
  inherited;
end;

procedure TdxCustomRibbonForm.WMDWMCompositionChanged(var Message: TMessage);
begin
  inherited;
  if UseSkin then
  begin
    UpdateWindowStates;
    if UseSkin and HandleAllocated and IsCompositionEnabled and IsWindowVisible(Handle) then
    begin
      SetWindowRgn(Handle, 0, False);
      FExtendFrameAtTopHeight := -1;
      ForceUpdateWindowSizeForVista;
      FExtendFrameAtTopHeight := -1;
      RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_ERASE or
        RDW_FRAME or RDW_ALLCHILDREN);
    end;
    Message.Result := 0;
  end;
end;

procedure TdxCustomRibbonForm.WndProc(var Message: TMessage);
begin
  if not UseSkin then
    inherited WndProc(Message)
  else
    with Message do
    begin
      case Msg of
        WM_ENTERSIZEMOVE:
          begin
            FSizingLoop := True;
            inherited WndProc(Message);
          end;
        WM_EXITSIZEMOVE:
          begin
            FSizingLoop := False;
            inherited WndProc(Message);
            UpdateNonClientArea;
          end;
        WM_NCUAHDRAWCAPTION,
        WM_NCUAHDRAWFRAME:
          begin
            if IsUseAeroNCPaint then
              CallDWMWindowProc(Message);
            DrawNonClientArea(True);
            Message.Result := 0;
          end;
        WM_MOUSEACTIVATE, WM_SYNCPAINT:
          begin
            inherited WndProc(Message);
            DrawNonClientArea(True);
          end;
        WM_NCLBUTTONDOWN:
          begin
            if not IsUseAeroNCPaint then
              UpdateWindow(Handle);
            inherited WndProc(Message);
            if IsIconic(Handle) then
            begin
              DrawNonClientArea(True);
              Result := 0;
              Exit;
            end;
          end;
        WM_NCMOUSELEAVE:
          begin
            if IsUseAeroNCPaint then
              CallDWMWindowProc(Message)
            else
              inherited;
          end;
        WM_LBUTTONDOWN:
          begin
            //dmAutomatic suppress a dispatching
            if (DragMode = dmAutomatic) and not IsUseAeroNCPaint then
              if HandleWithHelper(True, mbLeft) then
                Exit;
            inherited;
          end;
      else
        if (dxWMGetSkinnedMessage <> 0) and (Msg = dxWMGetSkinnedMessage) then
        begin
          Result := Ord(UseSkin);
          Exit;
        end;
        inherited;
      end;
    end;
end;

function TdxCustomRibbonForm.IsUseAeroNCPaint: Boolean;
begin
  Result := UseAeroNCPaint(FData);
end;

procedure TdxCustomRibbonForm.CheckResizingNCHitTest(var AHitTest: Integer; const P: TPoint);
const
  CornerHitTests: array[0..3] of DWORD = (HTTOPLEFT, HTTOPRIGHT, HTBOTTOMRIGHT, HTBOTTOMLEFT);
var
  I: Integer;
  R, RW: TRect;
begin
  if not IsNormalWindowState then Exit;
  for I := 0 to 3 do
    if PtInRegion(FCornerRegions[I], P.X, P.Y) then
    begin
      AHitTest := CornerHitTests[I];
      Break;
    end;
  if AHitTest = HTNOWHERE then
  begin
    GetWindowRect(Handle, RW);
    OffsetRect(RW, -RW.Left, -RW.Top);
    R := RW;
    R.Bottom := R.Top + FSizingBorders.cy;
    if cxRectPtIn(R, P) then
      AHitTest := HTTOP
    else
      if not IsUseAeroNCPaint then
      begin
        R := RW;
        R.Left := R.Right - FSizingBorders.cx;
        if cxRectPtIn(R, P) then
          AHitTest := HTRIGHT
        else
        begin
          R := RW;
          R.Top := R.Bottom - FSizingBorders.cy;
          if cxRectPtIn(R, P) then
            AHitTest := HTBOTTOM
          else
          begin
            R := RW;
            R.Right := R.Left + FSizingBorders.cx;
            if cxRectPtIn(R, P) then
              AHitTest := HTLEFT;
          end;
        end;
      end;
  end;
end;

procedure TdxCustomRibbonForm.CreateCornerRegions;
var
  I: Integer;
begin
  for I := 0 to 3 do
    FCornerRegions[I] := CreateRectRgnIndirect(cxEmptyRect);
end;

procedure TdxCustomRibbonForm.DestroyCornerRegions;
var
  I: Integer;
begin
  for I := 0 to 3 do
    DeleteObject(FCornerRegions[I]);
end;

procedure TdxCustomRibbonForm.ExcludeRibbonPaintArea(DC: HDC);
var
  R, CR: HRGN;
  ARibbonRect: TRect;
begin
  if FExtendFrameAtTopHeight = 0 then Exit;
  R := GetClipRegion(DC);
  ARibbonRect := cxRect(0, 0, ClientWidth, FExtendFrameAtTopHeight);
  CR := CreateRectRgnIndirect(ARibbonRect);
  SelectClipRgn(DC, CR);
  FillRect(DC, ARibbonRect, GetStockObject(BLACK_BRUSH));
  CombineRgn(R, R, CR, RGN_DIFF);
  SelectClipRgn(DC, R);
  DeleteObject(R);
  DeleteObject(CR);
end;

procedure TdxCustomRibbonForm.ForceUpdateWindowSizeForVista;
const
  Flags = {SWP_FRAMECHANGED or SWP_NOCOPYBITS or SWP_NOREDRAW or}
    SWP_NOMOVE or SWP_NOZORDER or SWP_NOOWNERZORDER;
var
  WP: Cardinal;
begin
  if UseSkin and IsUseAeroNCPaint then
  begin
    WP := BeginDeferWindowPos(2);
    try
      DeferWindowPos(WP, Handle, 0, 0, 0, Width - 1, Height - 1, Flags);
      DeferWindowPos(WP, Handle, 0, 0, 0, Width + 1, Height + 1, Flags);
    finally
      EndDeferWindowPos(WP);
    end;
  end;
end;

procedure TdxCustomRibbonForm.ExtendFrameIntoClientAreaAtTop(AHeight: Integer);
var
  M: TdxMargins;
  DC: HDC;
  R: TRect;
begin
  if FExtendFrameAtTopHeight <> AHeight then
  begin
    if AHeight > FExtendFrameAtTopHeight then
    begin
      R := cxRect(0, FExtendFrameAtTopHeight, Width, AHeight);
      if not FVisibleChanging then
        Inc(R.Left, 100);
      if not cxRectIsEmpty(R) then
      begin
        DC := GetWindowDC(Handle);
        FillRect(DC, R, GetStockObject(BLACK_BRUSH));
        ReleaseDC(Handle, DC);
      end;
    end;
    FExtendFrameAtTopHeight := AHeight;
    M.cxLeftWidth := 0;
    M.cxRightWidth := 0;
    M.cyBottomHeight := 0;
    M.cyTopHeight := AHeight;
    DwmExtendFrameIntoClientArea(Handle, @M);
  end;
end;

function TdxCustomRibbonForm.GetFormBorderIcons: TBorderIcons;
var
  ABorderStyle: TFormBorderStyle;
begin
  ABorderStyle := BorderStyle;
  if (FormStyle = fsMDIChild) and (ABorderStyle in [bsNone, bsDialog]) then
    ABorderStyle := bsSizeable;
  Result := BorderIcons;
  case ABorderStyle of
    bsNone: Result := [];
    bsDialog: Result := (Result * [biSystemMenu, biHelp]) - [biMaximize];
    bsToolWindow,
    bsSizeToolWin: Result := Result * [biSystemMenu];
  end;
end;

procedure TdxCustomRibbonForm.CorrectZoomedBounds(var R: TRect);
begin
  Inc(R.Left, FZoomedBoundsOffsets.Left);
  Inc(R.Top, FZoomedBoundsOffsets.Top);
  Dec(R.Right, FZoomedBoundsOffsets.Right);
  Dec(R.Bottom, FZoomedBoundsOffsets.Bottom);
end;

function TdxCustomRibbonForm.GetCurrentBordersWidth: TRect;
begin
  if IsZoomed(Handle) then
  begin
    Result := GetDefaultWindowBordersWidth(Handle);
    if FormStyle = fsMDIChild then
      Result.Top := 0;
  end
  else
    Result := RibbonNonClientHelper.GetWindowBordersWidth;
end;

procedure TdxCustomRibbonForm.WMGetText(var Message: TWMGetText);
var
  L: Integer;
begin
  if (csLoading in ComponentState) or UseSkin then
  begin
    L := Length(FCaption);
    FillChar(Pointer(Message.Text)^, Message.TextMax, #0);
    if Message.TextMax - 1 < L then
      L := Message.TextMax - 1;
    if L > 0 then
      Move(FCaption[1], Pointer(Message.Text)^, L);
    Message.Result := L;
  end
  else
    inherited;
end;

procedure TdxCustomRibbonForm.WMGetTextLength(var Message: TWMGetTextLength);
begin
  if (csLoading in ComponentState) or UseSkin then
    Message.Result := Length(FCaption)
  else
    inherited;
end;

procedure TdxCustomRibbonForm.WMSetText(var Message: TWMSetText);

  procedure UpdateMDIForm;
  var
    AForm: TdxCustomRibbonForm;
  begin
    if (FormStyle = fsMDIChild) and IsZoomed(Handle) and
      (Application.MainForm is TdxCustomRibbonForm) then
    begin
      AForm := TdxCustomRibbonForm(Application.MainForm);
      if AForm.UseSkin then
        AForm.CaptionChanged;
    end;
  end;

begin
  if (csLoading in ComponentState) or UseSkin then
  begin
    FCaption := Message.Text;
    if UseSkin then
    begin
      CaptionChanged;
      UpdateMDIForm;
      Perform(CM_TEXTCHANGED, 0, 0);
      if GetWindowLong(Handle, GWL_EXSTYLE) and WS_EX_APPWINDOW = WS_EX_APPWINDOW then
        SetWindowTextWithoutRedraw(Handle, RibbonNonClientHelper.GetTaskBarCaption);
    end
    else
    begin
      inherited;
      UpdateMDIForm;
    end;
  end
  else
  begin
    inherited;
    UpdateMDIForm;
  end;
end;

initialization
  if Win32MajorVersion >= 6 then
    BufferedPaintInit;

finalization
  if Win32MajorVersion >= 6 then
    BufferedPaintUnInit;

end.