dxribbonformcaptionhelper.pas

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

function TdxRibbonFormCaptionHelper.GetWindowCaptionBounds: TRect;
var
  R: TRect;
begin
  Result := Control.ClientRect;
  if FormData.Handle <> 0 then
  begin
    Result := FormData.Bounds;
    if FormData.State = wsMaximized then
    begin
      R := GetDefaultWindowBordersWidth(FormData.Handle);
      Inc(Result.Left, R.Left);
      Inc(Result.Top, R.Top);
      Dec(Result.Right, R.Right);
    end;
  end;
  Result.Bottom := Result.Top + GetWindowCaptionHeight;
end;

function TdxRibbonFormCaptionHelper.GetWindowCaptionHeight: Integer;
begin
  if (FormData.Handle <> 0) and (FormData.State = wsMinimized) then
    Result := FormData.Bounds.Bottom - FormData.Bounds.Top
  else
    Result := IRibbonFormNonClientDraw.GetRibbonFormCaptionHeight
end;

function TdxRibbonFormCaptionHelper.GetClientCaptionBounds: TRect;
var
  R: TRect;
begin
  if FormData.Handle <> 0 then
  begin
    Result := GetClientRect;
    R := GetWindowBordersWidth;
    Dec(Result.Left, R.Left);
    Dec(Result.Top, R.Top);
    Inc(Result.Right, R.Right);
  end
  else
    Result := Control.ClientRect;
  Result.Bottom := Result.Top + GetWindowCaptionHeight;
end;

function TdxRibbonFormCaptionHelper.GetClientCaptionRegion: HRGN;
var
  RW, B: TRect;
  R: HRGN;
begin
  if FFormCaptionRegions[rfrWindow] = 0 then
  begin
    Result := 0;
    Exit;
  end;
  Result := CreateRectRgnIndirect(cxEmptyRect);
  CombineRgn(Result, FFormCaptionRegions[rfrWindow], 0, RGN_COPY);
  if (FormData.Handle <> 0) and (FormData.State <> wsMaximized) and GetWindowRect(FormData.Handle, RW) then
  begin
    OffsetRect(RW, -RW.Left, -RW.Top);
    B := GetWindowBordersWidth;
    R := CreateRectRgn(0, 0, B.Left, GetWindowCaptionHeight);
    CombineRgn(Result, Result, R, RGN_DIFF); //exclude left border
    DeleteObject(R);
    R := CreateRectRgn(RW.Right - B.Right, 0, RW.Right, GetWindowCaptionHeight);
    CombineRgn(Result, Result, R, RGN_DIFF); //exclude right border
    DeleteObject(R);
    OffsetRgn(Result, -B.Left, -B.Top);
  end
end;

function TdxRibbonFormCaptionHelper.GetFormCaptionDrawBounds: TRect;
begin
  if (FormData.Handle <> 0) and (FormData.State = wsMinimized) then
  begin
    Result := GetClientRect;
    Inc(Result.Right, GetWindowBordersWidth.Left);
  end
  else
    Result := GetClientCaptionBounds;
end;

function TdxRibbonFormCaptionHelper.GetNCHitTestRegion: HRGN;
var
  R: HRGN;
begin
  if FFormCaptionRegions[rfrClient] = 0 then
  begin
    Result := 0;
    Exit;
  end;
  Result := CreateRectRgnIndirect(cxEmptyRect);
  CombineRgn(Result, FFormCaptionRegions[rfrClient], 0, RGN_COPY);
  R := GetApplicationButtonRegion;
  if R <> 0 then
  begin
    CombineRgn(Result, Result, R, RGN_DIFF);
    DeleteObject(R);
  end;
end;

function TdxRibbonFormCaptionHelper.GetWindowCaptionRegion: HRGN;
var
  RW: TRect;
begin
  if FormData.Handle = 0 then
  begin
    Result := 0;
    Exit;
  end;
  RW := FormData.Bounds;
  RW.Bottom := RW.Top + GetWindowCaptionHeight;
  Result := CreateRectRgnIndirect(RW);
end;

function TdxRibbonFormCaptionHelper.IsRoundedBottomCorners: Boolean;
begin
  Result := not IsRectangularFormBottom(FormData);
end;

procedure TdxRibbonFormCaptionHelper.RepaintBorderIcons;
var
  ACanvas: TcxCanvas;
  DC: HDC;
begin
  if not Valid or UseAeroNCPaint(FormData) then Exit;
  if FormData.State = wsMinimized then
  begin
    DC := GetDCEx(FormData.Handle, 0, DCX_CACHE or DCX_CLIPSIBLINGS or DCX_WINDOW or DCX_VALIDATE);
    BarCanvas.BeginPaint(DC);
    BarCanvas.Canvas.Lock;
    try
      BarCanvas.SetClipRegion(TcxRegion.Create(FBorderIconsArea), roSet);
      BufferedDrawCaption(BarCanvas, '');
    finally
      BarCanvas.Canvas.Unlock;
      BarCanvas.EndPaint;
      ReleaseDC(FormData.Handle, DC);
    end;
  end
  else
  begin
    ACanvas := Control.ActiveCanvas;
    ACanvas.Canvas.Lock;
    try
      ACanvas.SaveClipRegion;
      ACanvas.SetClipRegion(TcxRegion.Create(FBorderIconsArea), roSet);
      BufferedDrawCaption(ACanvas, '');
      ACanvas.RestoreClipRegion;
    finally
      ACanvas.Canvas.Unlock;
    end;
  end;
end;

procedure TdxRibbonFormCaptionHelper.StartMouseTimer;
begin
  if FMouseTimer <> nil then Exit;
  FMouseTimer := TTimer.Create(nil);
  FMouseTimer.Interval := 20;
  FMouseTimer.OnTimer := MouseTimerHandler;
end;

procedure TdxRibbonFormCaptionHelper.StopMouseTimer;
begin
  FreeAndNil(FMouseTimer);
end;

function TdxRibbonFormCaptionHelper.TestWinStyle(AStyle : DWORD) : Boolean;
begin
  Result := (FormData.Handle <> 0) and
    ((GetWindowLong(FormData.Handle, GWL_STYLE) and AStyle) <> 0);
end;

function TdxRibbonFormCaptionHelper.MouseDown(const P: TPoint;
  AButton: TMouseButton): Boolean;
var
  CP: TPoint;
begin
  Result := False;
  if not Valid then Exit;
  if (AButton = mbLeft) and IsBorderIconMouseEvent(P, CP) then
  begin
    Result := True;
    FPressedBorderIcon := BorderIconsMap[GetButtonFromPos(CP)];
    RepaintBorderIcons;
    SetCapture(FormData.Handle);
    FWasCapture := True;
  end;
end;

function TdxRibbonFormCaptionHelper.MouseUp(const P: TPoint;
  AButton: TMouseButton): Boolean;
const
  Commands: array[Boolean, Boolean] of Word = (
    (SC_MINIMIZE, SC_RESTORE),
    (SC_MAXIMIZE, SC_RESTORE));
var
  CP: TPoint;
  AIcon: TBorderIcon;
  ACommand: Word;
begin
  Result := False;
  if not Valid then Exit;
  if AButton = mbLeft then
  begin
    if IsBorderIconMouseEvent(P, CP) and (FPressedBorderIcon <> tbiNone) then
    begin
      Result := True;
      AIcon := GetButtonFromPos(CP);
      if BorderIconsMap[AIcon] = FPressedBorderIcon then
      begin
        case AIcon of
          biSystemMenu:
            ACommand := SC_CLOSE;
          biMinimize:
            ACommand := Commands[False, FormData.State = wsMinimized];
          biMaximize:
            ACommand := Commands[True, FormData.State = wsMaximized]
          else
            ACommand := SC_CONTEXTHELP;
        end;
        PostMessage(FormData.Handle, WM_SYSCOMMAND, ACommand, 0);
      end;
      FPressedBorderIcon := tbiNone;
      RepaintBorderIcons;
    end;
    if FWasCapture and (GetCapture = FormData.Handle) then
      ReleaseCapture;
  end
  else if (AButton = mbRight) and not IsBorderIconMouseEvent(P, CP, False) then
  begin
    Result := True;
    ShowSystemMenu(P);
  end;
end;

procedure TdxRibbonFormCaptionHelper.MouseTimerHandler(Sender: TObject);

  function NeedRepaint(const AMousePos: TPoint; H: HWND): Boolean;
  var
    AClientPos: TPoint;
  begin
    AClientPos := AMousePos;
    MapWindowPoint(0, H, AClientPos);
    Result := not cxRectPtIn(FBorderIconsArea, AClientPos);
    if not Result then
    begin
      if FormData.State = wsMinimized then
        Result := WindowFromPoint(AMousePos) <> H
      else
        Result := RealChildWindowFromPoint(H, AClientPos) <> Handle;
    end;
  end;

begin
  if (FormData.Handle <> 0) and Valid then
  begin
    if NeedRepaint(GetMouseCursorPos, FormData.Handle) then
    begin
      FHotBorderIcon := tbiNone;
      StopMouseTimer;
      RepaintBorderIcons;
    end;
  end
  else StopMouseTimer;
end;

procedure TdxRibbonFormCaptionHelper.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var
  ASaveIndex: Integer;
begin
  if Message.DC <> 0 then
  begin
    ASaveIndex := SaveDC(Message.DC);
    ExcludeCaptionRgn(Message.DC);
    inherited;
    RestoreDC(Message.DC, ASaveIndex);
  end
  else
    inherited;
end;

procedure TdxRibbonFormCaptionHelper.WMNCHitTest(var Message: TWMNCHitTest);
begin
  if CanProcessFormCaptionHitTest(Message.XPos, Message.YPos) then
    Message.Result := HTTRANSPARENT
  else
    OriginalWndProc(Message);
end;

procedure TdxRibbonFormCaptionHelper.WMPaint(var Message: TWMPaint);
begin
  FIsClientDrawing := True;
  OriginalWndProc(Message);
  FIsClientDrawing := False;
end;

procedure TdxRibbonFormCaptionHelper.WMSize(var Message: TWMSize);
begin
  Calculate;
  OriginalWndProc(Message);
end;

procedure TdxRibbonFormCaptionHelper.WMShowWindow(var Message: TMessage);
begin
  FHotBorderIcon := tbiNone;
  FPressedBorderIcon := tbiNone;
  if WordBool(Message.wParam) then
    Calculate;
  OriginalWndProc(Message);
end;

procedure TdxRibbonFormCaptionHelper.OriginalWndProc(var Message);
begin
  FOldWndProc(TMessage(Message));
end;

procedure TdxRibbonFormCaptionHelper.ShowSystemMenu(const P: TPoint);
var
  M: HMENU;
  ACommand: LongWord;
begin
  M := GetSystemMenu(FormData.Handle, False);
  ACommand := LongWord(TrackPopupMenu(M, TPM_RETURNCMD or TPM_TOPALIGN or TPM_LEFTALIGN, P.X, P.Y, 0, FormData.Handle, nil));
  PostMessage(FormData.Handle, WM_SYSCOMMAND, ACommand, 0);
end;

procedure TdxRibbonFormCaptionHelper.UpdateCaptionArea(ACanvas: TcxCanvas = nil);
begin
  if ACanvas = nil then
    DrawWindowCaption(nil, '')
  else
    BufferedDrawCaption(ACanvas, '');
end;

procedure TdxRibbonFormCaptionHelper.UpdateNonClientArea;
begin
  IRibbonFormNonClientDraw.UpdateNonClientArea;
end;

procedure TdxRibbonFormCaptionHelper.DestroyCaptionRegions;
var
  I: TdxRibbonFormRegion;
begin
  for I := Low(TdxRibbonFormRegion) to High(TdxRibbonFormRegion) do
    if FFormCaptionRegions[I] <> 0 then
    begin
      DeleteObject(FFormCaptionRegions[I]);
      FFormCaptionRegions[I] := 0;
    end;
end;

procedure TdxRibbonFormCaptionHelper.WndProc(var Message: TMessage);
begin
  if Control.IsDesigning then
    OriginalWndProc(Message)
  else
  begin
    case Message.Msg of
      WM_SIZE:
        WMSize(TWMSize(Message));
      WM_NCHITTEST:
        WMNCHitTest(TWMNCHitTest(Message));
      WM_ERASEBKGND:
        WMEraseBkgnd(TWMEraseBkgnd(Message));
      WM_PAINT:
        WMPaint(TWMPaint(Message));
      WM_SHOWWINDOW:
        WMShowWindow(Message);
      else
        OriginalWndProc(Message);
    end;
  end;
end;

end.