dxoffice11.pas

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

    ToR := GetRValue(ARGBColor2);
    ToG := GetGValue(ARGBColor2);
    ToB := GetBValue(ARGBColor2);
    SR := ARect;
    if AHorizontal then
      W := SR.Right - SR.Left
    else
      W := SR.Bottom - SR.Top;
    N := 256;
    if W < N then
      N := W;
    for I := 0 to N - 1 do
    begin
      if AHorizontal then
        SR.Right := ARect.Left + MulDiv(I + 1, W, N)
      else
        SR.Bottom := ARect.Top + MulDiv(I + 1, W, N);
      R := FromR + MulDiv(I, ToR - FromR, N - 1);
      G := FromG + MulDiv(I, ToG - FromG, N - 1);
      B := FromB + MulDiv(I, ToB - FromB, N - 1);
      if not IsRectEmpty(SR) then
        FillRectByColor(DC, SR, RGB(R, G, B));
      if AHorizontal then
      begin
        SR.Left := SR.Right;
        if SR.Left >= ARect.Right then
          Break;
      end
      else
      begin
        SR.Top := SR.Bottom;
        if SR.Top >= ARect.Bottom then
          Break;
      end;
    end;
  end;

  procedure SystemGradientFill(ARGBColor1, ARGBColor2: DWORD);

    procedure SetVertex(var AVertex: TTriVertex; const APoint: TPoint; ARGBColor: DWORD);
    begin
      AVertex.X := APoint.X;
      AVertex.Y := APoint.Y;
      AVertex.Red := MakeWord(0, GetRValue(ARGBColor));
      AVertex.Green := MakeWord(0, GetGValue(ARGBColor));
      AVertex.Blue := MakeWord(0, GetBValue(ARGBColor));
      AVertex.Alpha := 0;
    end;

  const
    AModesMap: array[Boolean] of DWORD = (GRADIENT_FILL_RECT_V, GRADIENT_FILL_RECT_H);
  var
    AVertices: array[0..1] of TTriVertex;
    AGradientRect: TGradientRect;
  begin
    SetVertex(AVertices[0], ARect.TopLeft, ARGBColor1);
    SetVertex(AVertices[1], ARect.BottomRight, ARGBColor2);
    AGradientRect.UpperLeft := 0;
    AGradientRect.LowerRight := 1;
    GradientFill(DC, AVertices[0], 2, AGradientRect, 1, AModesMap[AHorizontal]);
  end;

var
  ARGBColor1, ARGBColor2: DWORD;
begin
  ARGBColor1 := ColorToRGB(AColor1);
  ARGBColor2 := ColorToRGB(AColor2);
  if ARGBColor1 = ARGBColor2 then
    FillRectByColor(DC, ARect, AColor1)
  else
    if Assigned(GradientFill) then
      SystemGradientFill(ARGBColor1, ARGBColor2)
    else
      SoftwareGradientFill(ARGBColor1, ARGBColor2);
end;

procedure FillTubeGradientRect(DC: HDC; const ARect: TRect; AColor1, AColor2: TColor;
  AHorizontal: Boolean);
var
  FromR, FromG, FromB, ToR, ToG, ToB: Integer;
  ToR1, ToG1, ToB1, ToR2, ToG2, ToB2: Integer;
  SR: TRect;
  W, I, N, M: Integer;
  R, G, B: Byte;
  ABrush: HBRUSH;
begin
  AColor1 := ColorToRGB(AColor1);
  AColor2 := ColorToRGB(AColor2);
  if AColor1 = AColor2 then
  begin
    ABrush := CreateSolidBrush(AColor1);
    FillRect(DC, ARect, ABrush);
    DeleteObject(ABrush);
    Exit;
  end;

  FromR := GetRValue(AColor1);
  FromG := GetGValue(AColor1);
  FromB := GetBValue(AColor1);
  ToR := GetRValue(AColor2);
  ToG := GetGValue(AColor2);
  ToB := GetBValue(AColor2);
  SR := ARect;
  if AHorizontal then
    W := SR.Right - SR.Left
  else
    W := SR.Bottom - SR.Top;
  M := W div 2;
  ToR1 := FromR - MulDiv(FromR - ToR, GradientPercent, 200);
  ToG1 := FromG - MulDiv(FromG - ToG, GradientPercent, 200);
  ToB1 := FromB - MulDiv(FromB - ToB, GradientPercent, 200);

  ToR2 := FromR - MulDiv(FromR - ToR1, W, M);
  ToG2 := FromG - MulDiv(FromG - ToG1, W, M);
  ToB2 := FromB - MulDiv(FromB - ToB1, W, M);

//  N := 256;
//  if W < N then
//    N := W;
  N := W;

  for I := 0 to N - 1 do
  begin
    if AHorizontal then
      SR.Right := ARect.Left + MulDiv(I + 1, W, N)
    else
      SR.Bottom := ARect.Top + MulDiv(I + 1, W, N);
    if I < M then
    begin
      R := FromR + MulDiv(I, ToR2 - FromR, N - 1);
      G := FromG + MulDiv(I, ToG2 - FromG, N - 1);
      B := FromB + MulDiv(I, ToB2 - FromB, N - 1);
    end
    else            
      if I = M then
      begin
        R := ToR1;
        G := ToG1;
        B := ToB1;
        FromR := ToR + MulDiv(ToR1 - ToR, W, M);
        FromG := ToG + MulDiv(ToG1 - ToG, W, M);
        FromB := ToB + MulDiv(ToB1 - ToB, W, M);
      end
      else
      begin
        R := FromR + MulDiv(I, ToR - FromR, N - 1);
        G := FromG + MulDiv(I, ToG - FromG, N - 1);
        B := FromB + MulDiv(I, ToB - FromB, N - 1);
      end;

    if not IsRectEmpty(SR) then
    begin
      ABrush := CreateSolidBrush(RGB(R, G, B));
      FillRect(DC, SR, ABrush);
      DeleteObject(ABrush);
    end;
    if AHorizontal then
    begin
      SR.Left := SR.Right;
      if SR.Left >= ARect.Right then
        Break;
    end
    else
    begin
      SR.Top := SR.Bottom;
      if SR.Top >= ARect.Bottom then
        Break;
    end;
  end;
end;

procedure FillRectByColor(DC: HDC; const R: TRect; AColor: TColor);
var
  ABrush: HBRUSH;
begin
  ABrush := CreateSolidBrush(ColorToRGB(AColor));
  FillRect(DC, R, ABrush);
  DeleteObject(ABrush);
end;

procedure FrameRectByColor(DC: HDC; const R: TRect; AColor: TColor);
var
  ABrush: HBRUSH;
begin
  ABrush := CreateSolidBrush(ColorToRGB(AColor));
  FrameRect(DC, R, ABrush);
  DeleteObject(ABrush);
end;

function GetGradientColorRect(const ARect: TRect; X: Integer; AColor1, AColor2: TColor;
  AHorizontal: Boolean): TColorRef;
var
  FromR, ToR, FromG, ToG, FromB, ToB: Byte;
  ARectLeft, W, I, N: Integer;
  R, G, B: Byte;
begin
  AColor1 := ColorToRGB(AColor1);
  AColor2 := ColorToRGB(AColor2);
  FromR := GetRValue(AColor1);
  FromG := GetGValue(AColor1);
  FromB := GetBValue(AColor1);
  ToR := GetRValue(AColor2);
  ToG := GetGValue(AColor2);
  ToB := GetBValue(AColor2);
  if AHorizontal then
  begin
    ARectLeft := ARect.Left;
    W := ARect.Right - ARect.Left;
  end
  else
  begin
    ARectLeft := ARect.Top;
    W := ARect.Bottom - ARect.Top;
  end;
  N := 256;
  if W < N then
    N := W;
  I := MulDiv(X - ARectLeft + 1, N, W) - 1;
  if I < 0 then I := 0;
  R := FromR + MulDiv(I, ToR - FromR, N - 1);
  G := FromG + MulDiv(I, ToG - FromG, N - 1);
  B := FromB + MulDiv(I, ToB - FromB, N - 1);
  Result := RGB(R, G, B);
end;

procedure Office11FrameSelectedRect(DC: HDC; const R: TRect);
begin
  if IsHighContrastBlack or IsHighContrast2 then
    FrameRectByColor(DC, R, clHighlightText)
  else
    FrameRect(DC, R, dxOffice11SelectedBorderBrush);
end;

procedure Office11DrawFingerElements(DC: HDC; ARect: TRect; AHorizontal: Boolean;
  ABrush1: HBRUSH = 0; ABrush2: HBRUSH = 0);
var
  R1, R2: TRect;
  W: Integer;
begin
  with ARect do
    R1 := Rect(Left, Top, Left + 4, Top + 4);
  if AHorizontal then
  begin
    W := ARect.Bottom - ARect.Top;
    W := W - (W div 4) * 4;
    if W > 1 then W := W div 2;
    OffsetRect(R1, 0, W);
  end
  else
  begin
    W := ARect.Right - ARect.Left;
    W := W - (W div 4) * 4;
    if W > 1 then W := W div 2;
    OffsetRect(R1, W, 0);
  end;
  if ABrush1 = 0 then
     ABrush1 := dxOffice11BarFingerBrush1;
  if ABrush2 = 0 then
     ABrush2 := dxOffice11BarFingerBrush2;
  repeat
    R2 := R1;
    InflateRect(R2, -1, -1);
    FillRect(DC, R2, ABrush2);
    OffsetRect(R2, -1, -1);
    FillRect(DC, R2, ABrush1);
    if AHorizontal then
    begin
      OffsetRect(R1, 0, 4);
      if R1.Bottom > ARect.Bottom then Break;
    end
    else
    begin
      OffsetRect(R1, 4, 0);
      if R1.Right > ARect.Right then Break;
    end;
  until False;
end;

procedure Office11DrawItemArrow(DC: HDC; R: TRect; ADownArrow: Boolean;
  Enabled, Selected, Flat: Boolean);
var
  Size: Integer;
begin
  if not ADownArrow then
    Size := R.Bottom - R.Top - 6
  else  // atDown
    Size := R.Right - R.Left - 8;
  Size := (Size - 1) div 2 + Byte(Size mod 2 <> 0);
  if Size < 3 then Size := 3;
  Office11DrawLargeItemArrow(DC, R, ADownArrow, Size, Selected, Enabled, Flat);
end;

procedure Office11DrawLargeItemArrow(DC: HDC; R: TRect; ADownArrow: Boolean;
  Size: Integer; Selected, Enabled, Flat: Boolean);
var
  Color: COLORREF;
  X, Y: Integer;
  P: array[1..3] of TPoint;
  Pen: HPEN;
  Brush: HBRUSH;

  procedure DrawEnabled;
  begin
    with R do
      if not ADownArrow then
      begin
        X := (Left + Right - Size) div 2;
        Y := (Top + Bottom - (2 * Size - 1)) div 2;
        P[1] := Point(X, Y);
        P[2] := Point(X, Y + 2 * Size - 2);
      end
      else  // atDown
      begin
        X := (Left + Right - (2 * Size - 1)) div 2;
        Y := (Top + Bottom - Size) div 2;
        P[1] := Point(X, Y);
        P[2] := Point(X + 2 * Size - 2, Y);
      end;
    P[3] := Point(X + Size - 1, Y + Size - 1);

    Pen := SelectObject(DC, CreatePen(PS_SOLID, 1, Color));
    Brush := SelectObject(DC, CreateSolidBrush(Color));
    Polygon(DC, P, 3);
    DeleteObject(SelectObject(DC, Brush));
    DeleteObject(SelectObject(DC, Pen));
  end;

begin
  if Enabled then
  begin
    if Selected and IsHighContrastWhite then
      Color := clWhite
    else
      Color := dxOffice11TextEnabledColor;
  end
  else
    Color := dxOffice11TextDisabledColor;
  DrawEnabled;
end;

procedure Office11DrawSizeGrip(DC: HDC; ARect: TRect;
  AColor1: TColor = clDefault; AColor2: TColor = clDefault);
var
  ABrush1, ABrush2: HBRUSH;
begin
  ABrush1 := 0;
  ABrush2 := 0;
  if AColor1 <> clDefault then
    ABrush1 := CreateSolidBrush(ColorToRGB(AColor1));
  if AColor2 <> clDefault then
    ABrush2 := CreateSolidBrush(ColorToRGB(AColor2));
  ARect := Rect(ARect.Right - 12, ARect.Bottom - 3, ARect.Right, ARect.Bottom);
  Office11DrawFingerElements(DC, ARect, False, ABrush1, ABrush2); // 3
  Inc(ARect.Left, 4);
  OffsetRect(ARect, 0, -4);
  Office11DrawFingerElements(DC, ARect, False, ABrush1, ABrush2); // 2
  Inc(ARect.Left, 4);
  OffsetRect(ARect, 0, -4);
  Office11DrawFingerElements(DC, ARect, False, ABrush1, ABrush2); // 1
  if ABrush1 <> 0 then DeleteObject(ABrush1);
  if ABrush2 <> 0 then DeleteObject(ABrush2);
end;

initialization
  FMsimg32Library := LoadLibrary(msimg32);
  if FMsimg32Library <> 0 then
    GradientFill := GetProcAddress(FMsimg32Library, 'GradientFill')

finalization
  if FMsimg32Library <> 0 then
    FreeLibrary(FMsimg32Library);

end.