dxribbonform.pas

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

    case Msg of
      WM_KEYDOWN:
        begin
          KeyDown(WParamLo, KeyDataToShiftState(LParam));
          if WParamLo = 0 then Exit;
          Default;
        end;
      WM_NCHITTEST:
        begin
          Default;
          if Result = HTCLIENT then Result := HTTRANSPARENT;
        end;
      WM_ERASEBKGND:
        begin
          AColor := RibbonNonClientHelper.GetWindowColor;
          FillRectByColor(TWMEraseBkGnd(Message).DC, ClientRect, AColor);
          // Erase the background at the location of an MDI client window
          if (FormStyle = fsMDIForm) and (ClientHandle <> 0) then
          begin
            Windows.GetClientRect(ClientHandle, R);
            FillRectByColor(TWMEraseBkGnd(Message).DC, R, AColor);
          end;
          Result := 1;
        end;
      WM_NCCALCSIZE:;
      WM_NCPAINT:;
      WM_MDIREFRESHMENU:
        Result := 0;
      WM_NCACTIVATE:
        Message.Result := 1;
      {
      $3F://!
        begin
          Default;
          F := ActiveMDIChild;
          if (F <> nil) and MaximizedChildren then
          begin
            //correct maximized bounds
            GetWindowRect(ClientHandle, R);
            R.Right := R.Right - R.Left + (F.Width - F.ClientWidth);
            R.Bottom := R.Bottom - R.Top + (F.Height - F.ClientHeight);
            if (F is TdxCustomRibbonForm) and TdxCustomRibbonForm(F).UseSkin then
              Inc(R.Bottom, TdxCustomRibbonForm(F).RibbonNonClientHelper.GetWindowCaptionHeight);
            SetWindowPos(F.Handle, 0, 0, 0, R.Right, R.Bottom,
              SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOZORDER);
          end;
        end;
      }
      WM_PAINT:
        begin
          DC := TWMPaint(Message).DC;
          if DC = 0 then
            TWMPaint(Message).DC := BeginPaint(ClientHandle, PS);
          try
            if DC = 0 then
            begin
              GetWindowRect(ClientHandle, R);
              R.TopLeft := ScreenToClient(R.TopLeft);
              MoveWindowOrg(TWMPaint(Message).DC, -R.Left, -R.Top);
            end;
            PaintHandler(TWMPaint(Message));
          finally
            if DC = 0 then
              EndPaint(ClientHandle, PS);
          end;
        end;
    else
      Default;
    end;
end;

procedure TdxCustomRibbonForm.DrawNonClientArea(ADrawCaption: Boolean; AUpdateRegion: HRGN = 1);
var
  DC: HDC;
  AFlags: Integer;
  ARgn: HRGN;
  AZoomed: Boolean;
begin
  if IsUseAeroNCPaint then Exit;
  UpdateWindowStates;
  AFlags := DCX_CACHE or DCX_CLIPSIBLINGS or DCX_WINDOW or DCX_VALIDATE;
  if AUpdateRegion <> 1 then
  begin
    ARgn := CreateRectRgnIndirect(cxEmptyRect);
    CombineRgn(ARgn, AUpdateRegion, 0, RGN_COPY);
    DC := GetDCEx(Handle, ARgn, AFlags or DCX_INTERSECTRGN);
  end
  else
    DC := GetDCEx(Handle, 0, AFlags);
  BarCanvas.BeginPaint(DC);
  BarCanvas.Canvas.Lock;
  try
    if IsIconic(Handle) then
      RibbonNonClientHelper.DrawWindowCaption(BarCanvas, Caption)
    else
    begin
      AZoomed := IsZoomed(Handle);
      if not AZoomed then
        RibbonNonClientHelper.DrawWindowBorders(BarCanvas);
      if ADrawCaption then
        RibbonNonClientHelper.DrawWindowCaption(nil, Caption);
    end;
  finally
    BarCanvas.Canvas.Unlock;
    BarCanvas.EndPaint;
    ReleaseDC(Handle, DC);
  end;
end;

function TdxCustomRibbonForm.HandleWithHelper(ADown: Boolean;
  AButton: TMouseButton): Boolean;
var
  P: TPoint;
begin
  Result := UseSkin;
  if Result then
  begin
    P := GetMouseCursorPos;
    if RibbonNonClientHelper.IsInCaptionArea(P.X, P.Y) then
    begin
      if ADown then
        Result := RibbonNonClientHelper.MouseDown(P, AButton)
      else
        Result := RibbonNonClientHelper.MouseUp(P, AButton);
    end
    else
      Result := False;
  end;
end;

procedure TdxCustomRibbonForm.KeyDown(var Key: Word; Shift: TShiftState);
var
  I: Integer;
  AIntf: IdxFormKeyPreviewListener;
  AForm: TForm;
begin
  inherited KeyDown(Key, Shift);
  if KeyPreview then
  begin
    if FormStyle = fsMDIChild then
      AForm := Application.MainForm
    else
      AForm := Self;
    for I := 0 to AForm.ControlCount - 1 do
      if Supports(TObject(AForm.Controls[I]), IdxFormKeyPreviewListener, AIntf) then
      begin
        AIntf.FormKeyDown(Key, Shift);
        AIntf := nil;
      end;
  end;
end;

procedure TdxCustomRibbonForm.ModifySystemMenu(ASysMenu: THandle);
begin
  if (BorderStyle <> bsNone) and (biSystemMenu in BorderIcons) and (FormStyle <> fsMDIChild) then
  begin
    if BorderStyle = bsDialog then
    begin
      DeleteMenu(ASysMenu, SC_TASKLIST, MF_BYCOMMAND);
      DeleteMenu(ASysMenu, 7, MF_BYPOSITION);
      DeleteMenu(ASysMenu, 5, MF_BYPOSITION);
      DeleteMenu(ASysMenu, SC_MAXIMIZE, MF_BYCOMMAND);
      DeleteMenu(ASysMenu, SC_MINIMIZE, MF_BYCOMMAND);
      DeleteMenu(ASysMenu, SC_SIZE, MF_BYCOMMAND);
      DeleteMenu(ASysMenu, SC_RESTORE, MF_BYCOMMAND);
    end
    else
    begin
      if not (biMinimize in BorderIcons) then
        EnableMenuItem(ASysMenu, SC_MINIMIZE, MF_BYCOMMAND or MF_GRAYED);
      if not (biMaximize in BorderIcons) then
        EnableMenuItem(ASysMenu, SC_MAXIMIZE, MF_BYCOMMAND or MF_GRAYED);
    end;
    SetMenuDefaultItem(ASysMenu, SC_CLOSE, MF_BYCOMMAND);
  end;
end;

procedure TdxCustomRibbonForm.ShiftControlsVertically(ADelta: Integer);
var
  I: Integer;
begin
  if ADelta = 0 then Exit;
  DisableAlign;
  try
    for I := 0 to ControlCount - 1 do
      with Controls[I] do
        if Align in [alNone, alCustom] then
          Top := Top + ADelta;
  finally
    EnableAlign;
  end;
end;

procedure TdxCustomRibbonForm.UpdateNonClientArea;
begin
  UpdateWindowStates;
  if UseSkin and IsWindowVisible(Handle) then
  begin
    DrawNonClientArea(False);
    RibbonNonClientHelper.UpdateNonClientArea;
  end;
end;

procedure TdxCustomRibbonForm.UpdateWindowStates;
var
  R: TRect;
begin
  if UseSkin and not (csDestroying in ComponentState) then
  begin
    FillChar(FData, SizeOf(TdxRibbonFormData), 0);
    if HandleAllocated then
    begin
      FData.Handle := Handle;
      if GetWindowRect(Handle, R) then
        OffsetRect(R, -R.Left, -R.Top)
      else
        R := cxEmptyRect;
      FData.Bounds := R;
      if IsIconic(Handle) then
        FData.State := wsMinimized
      else if IsZoomed(Handle) then
        FData.State := wsMaximized
      else
        FData.State := wsNormal;
    end;
    FData.Active := FIsActive;
    FData.Border := BorderStyle;
    FData.Style  := FormStyle;
    FData.DontUseAero := DisableAero or (ParentWindow <> 0);
    RibbonNonClientHelper.CheckWindowStates(FData);
  end;
end;

procedure TdxCustomRibbonForm.CalculateCornerRegions;

  procedure CalculateRegion(ACornerRgn: HRGN; DX, DY: Integer; const ACornerRect: TRect);
  var
    R1, R2: HRGN;
  begin
    R1 := CreateRectRgnIndirect(cxEmptyRect);
    GetWindowRgn(Handle, ACornerRgn);
    GetWindowRgn(Handle, R1);
    OffsetRgn(R1, DX, DY);
    CombineRgn(ACornerRgn, ACornerRgn, R1, RGN_DIFF);
    R2 := CreateRectRgnIndirect(ACornerRect);
    CombineRgn(ACornerRgn, ACornerRgn, R2, RGN_AND);
    DeleteObject(R1);
    DeleteObject(R2);
  end;

var
  H: Integer;
begin
  H := GetSystemMetrics(SM_CYCAPTION);
  CalculateRegion(FCornerRegions[0],  FSizingBorders.cx,  FSizingBorders.cy,
    cxRect(0, 0, H, H));
  CalculateRegion(FCornerRegions[1], -FSizingBorders.cx,  FSizingBorders.cy,
    cxRect(Width - H, 0, Width, H));
  CalculateRegion(FCornerRegions[2], -FSizingBorders.cx, -FSizingBorders.cy,
    cxRect(Width - H, Height - H, Width, Height));
  CalculateRegion(FCornerRegions[3],  FSizingBorders.cx, -FSizingBorders.cy,
    cxRect(0, Height - H, H, Height));
end;

procedure TdxCustomRibbonForm.CalculateZoomedOffsets;
var
  ABData: TAppBarData;
begin
  FZoomedBoundsOffsets := cxEmptyRect;
  if IsNeedCorrectForAutoHideTaskBar then
  begin
    FillChar(ABData, sizeof(ABData), 0);
    ABData.cbSize := sizeof(ABData);
    ABData.hWnd := Handle;
    SHAppBarMessage(ABM_GETTASKBARPOS, ABData);
    if ABData.uEdge = ABE_LEFT then
      FZoomedBoundsOffsets.Left := 1
    else if (ABData.uEdge = ABE_TOP) and not IsUseAeroNCPaint then
      FZoomedBoundsOffsets.Top := 1
    else if ABData.uEdge = ABE_RIGHT then
      FZoomedBoundsOffsets.Right := 1 + Ord(IsUseAeroNCPaint)
    else if ABData.uEdge = ABE_BOTTOM then
      FZoomedBoundsOffsets.Bottom := 1;
  end;
end;

procedure TdxCustomRibbonForm.CheckExtendFrame(AZoomed: Boolean);
var
  ANonClientHeight: Integer;
begin
  if UseSkin and HandleAllocated and IsUseAeroNCPaint then
  begin
    ANonClientHeight := RibbonNonClientHelper.GetWindowCaptionHeight;
    //prevent client area rendering beyond the screen if maximized
    if AZoomed and (ANonClientHeight > 0) then
      Inc(ANonClientHeight, dxGlassMaximizedNonClientHeight);
    ExtendFrameIntoClientAreaAtTop(ANonClientHeight);
  end;
end;


function TdxCustomRibbonForm.GetUseSkin: Boolean;
begin
  Result := FUseSkin //and (FormStyle <> fsMDIChild);
end;

procedure TdxCustomRibbonForm.InvalidateFrame(AWnd: HWND; AUpdate: Boolean = False);
begin
  SetWindowPos(AWnd, 0, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or
    SWP_NOZORDER or SWP_NOACTIVATE or SWP_DRAWFRAME);
  if AUpdate then
    UpdateWindow(AWnd);
end;

function TdxCustomRibbonForm.IsNeedCorrectForAutoHideTaskBar: Boolean;
var
  ABData : TAppBarData;
begin
  FillChar(ABData, sizeof(ABData), 0);
  ABData.cbSize := sizeof(ABData);
  Result := ((SHAppBarMessage(ABM_GETSTATE, ABData) and ABS_AUTOHIDE) > 0) and
    (MonitorFromWindow(FindWindow('Shell_TrayWnd', nil), MONITOR_DEFAULTTONEAREST) = Monitor.Handle);
end;

function TdxCustomRibbonForm.IsNormalWindowState: Boolean;
begin
  Result := not (IsIconic(Handle) or IsZoomed(Handle));
end;

procedure TdxCustomRibbonForm.SetAutoScroll(const Value: Boolean);
begin
  //don't change
  inherited AutoScroll := False;
end;

procedure TdxCustomRibbonForm.SetDisableAero(const Value: Boolean);
begin
  if FDisableAero <> Value then
  begin
    FDisableAero := Value;
    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{ or RDW_UPDATENOW or RDW_ERASENOW});
    end;
  end;
end;

procedure TdxCustomRibbonForm.SetRibbonNonClientHelper(const Value: TdxRibbonFormCaptionHelper);
var
  ASaveCaption: TCaption;
begin
  if FRibbonNonClientHelper <> Value then
  begin
    ASaveCaption := Caption;
    FRibbonNonClientHelper := Value;
    FUseSkin := (Value <> nil) and (FRibbonNonClientHelper <> nil);
    FExtendFrameAtTopHeight := -1;
    if csDestroying in ComponentState then
      FUseSkin := False
    else
    begin
      UpdateWindowStates;
      if HandleAllocated then
      begin
        if dxWMSetSkinnedMessage > 0 then
          SendMessage(Handle, dxWMSetSkinnedMessage, Integer(FUseSkin), 0);
        DisableAlign;
        SetWindowRgn(Handle, 0, False);
        if IsCompositionEnabled and not UseSkin then
          ExtendFrameIntoClientAreaAtTop(0);
        Caption := ASaveCaption;
        SetWindowPos(Handle, 0, 0, 0, Width, Height, SWP_NOMOVE or
          SWP_NOZORDER or SWP_NOACTIVATE or SWP_DRAWFRAME);
        if IsWindowVisible(Handle) then
          RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ERASE or RDW_FRAME or RDW_ALLCHILDREN);
        EnableAlign;