cxgraphics.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,593 行 · 第 1/5 页

  Result := ImageBitmap;
end;

function GetMaskBitmap(AWidth, AHeight: Integer): TcxBitmap;
begin
  cxBitmapInit(MaskBitmap, AWidth, AHeight);
  Result := MaskBitmap;
end;

function cxFlagsToDTFlags(Flags: Integer): Integer;
begin
  Result := DT_NOPREFIX;
  if cxAlignLeft and Flags <> 0 then
    Result := Result or DT_LEFT;
  if cxAlignRight and Flags <> 0 then
    Result := Result or DT_RIGHT;
  if cxAlignHCenter and Flags <> 0 then
    Result := Result or DT_CENTER;
  if cxAlignTop and Flags <> 0 then
    Result := Result or DT_TOP;
  if cxAlignBottom and Flags <> 0 then
    Result := Result or DT_BOTTOM;
  if cxAlignVCenter and Flags <> 0 then
    Result := Result or DT_VCENTER;
  if cxSingleLine and Flags <> 0 then
    Result := Result or DT_SINGLELINE;
  if cxDontClip and Flags <> 0 then
    Result := Result or DT_NOCLIP;
  if cxExpandTabs and Flags <> 0 then
    Result := Result or DT_EXPANDTABS;
  if cxShowPrefix and Flags <> 0 then
    Result := Result and not DT_NOPREFIX;
  if cxWordBreak and Flags <> 0 then
  begin
    Result := Result or DT_WORDBREAK;
    if cxDontBreakChars and Flags = 0 then
      Result := Result or DT_EDITCONTROL;
  end;
  if cxShowEndEllipsis and Flags <> 0 then
    Result := Result or DT_END_ELLIPSIS;
  if cxDontPrint and Flags <> 0 then
    Result := Result or DT_CALCRECT;
  if cxShowPathEllipsis and Flags <> 0 then
    Result := Result or DT_PATH_ELLIPSIS;
end;

procedure cxSetImageList(const AValue: TCustomImageList; var AFieldValue: TCustomImageList; const AChangeLink: TChangeLink; ANotifyComponent: TComponent);
begin
  if AValue <> AFieldValue then
  begin
    if AFieldValue <> nil then
    begin
      AFieldValue.RemoveFreeNotification(ANotifyComponent);
      if AChangeLink <> nil then
        AFieldValue.UnRegisterChanges(AChangeLink);
    end;
    AFieldValue := AValue;
    if AValue <> nil then
    begin
      if AChangeLink <> nil then
        AValue.RegisterChanges(AChangeLink);
      AValue.FreeNotification(ANotifyComponent);
    end;
    if AChangeLink <> nil then
      AChangeLink.Change;
  end;
end;

procedure ExtendRect(var Rect: TRect; const AExtension: TRect);
begin
  with AExtension do
  begin
    Inc(Rect.Left, Left);
    Inc(Rect.Top, Top);
    Dec(Rect.Right, Right);
    Dec(Rect.Bottom, Bottom);
  end;
end;

function IsGlyphAssigned(AGlyph: TBitmap): Boolean;
begin
  Result := (AGlyph <> nil) and not AGlyph.Empty;
end;

function IsImageAssigned(AImageList: TCustomImageList; AImageIndex: Integer): Boolean;
begin
  Result := (AImageList <> nil) and (0 <= AImageIndex) and (AImageIndex < AImageList.Count);
end;

function IsXPManifestEnabled: Boolean;
{$IFNDEF DELPHI7}
const
  ComCtlVersionIE6 = $00060000;
{$ENDIF}
begin
  Result := GetComCtlVersion >= ComCtlVersionIE6
end;

function GetRealColor(AColor: TColor): TColor;
var
  DC: HDC;
begin
  DC := GetDC(0);
  Result := GetNearestColor(DC, AColor);
  ReleaseDC(0, DC);
end;

function GetChannelValue(AValue: Integer): Byte;
begin
  if AValue < 0 then
    Result := 0
  else
    if AValue > 255 then
      Result := 255
    else
      Result := AValue;
end;

function GetLightColor(ABtnFaceColorPart, AHighlightColorPart, AWindowColorPart: TcxColorPart): TColor;
var
  ABtnFaceColor, AHighlightColor, AWindowColor: TColor;

  function GetLightIndex(ABtnFaceValue, AHighlightValue, AWindowValue: Byte): Integer;
  begin
    Result := GetChannelValue(
      MulDiv(ABtnFaceValue, ABtnFaceColorPart, 100) +
      MulDiv(AHighlightValue, AHighlightColorPart, 100) +
      MulDiv(AWindowValue, AWindowColorPart, 100));
  end;

begin
  ABtnFaceColor := ColorToRGB(clBtnFace);
  AHighlightColor := ColorToRGB(clHighlight);
  AWindowColor := ColorToRGB(clWindow);
  if (ABtnFaceColor = 0) or (ABtnFaceColor = $FFFFFF) then
    Result := AHighlightColor
  else
    Result := RGB(
      GetLightIndex(GetRValue(ABtnFaceColor), GetRValue(AHighlightColor), GetRValue(AWindowColor)),
      GetLightIndex(GetGValue(ABtnFaceColor), GetGValue(AHighlightColor), GetGValue(AWindowColor)),
      GetLightIndex(GetBValue(ABtnFaceColor), GetBValue(AHighlightColor), GetBValue(AWindowColor)));
end;

function GetLightBtnFaceColor: TColor;

  function GetLightValue(Value: Byte): Byte;
  begin
    Result := GetChannelValue(Value + MulDiv(255 - Value, 16, 100));
  end;

begin
  Result := ColorToRGB(clBtnFace);
  Result := RGB(
    GetLightValue(GetRValue(Result)),
    GetLightValue(GetGValue(Result)),
    GetLightValue(GetBValue(Result)));
  Result := GetRealColor(Result);
end;

function GetLightDownedColor: TColor;
begin
  Result := GetRealColor(GetLightColor(11, 9, 73));
end;

function GetLightDownedSelColor: TColor;
begin
  Result := GetRealColor(GetLightColor(14, 44, 40));
end;

function GetLightSelColor: TColor;
begin
  Result := GetRealColor(GetLightColor(-2, 30, 72));
end;

procedure FillBitmapInfoHeader(out AHeader: TBitmapInfoHeader; AWidth, AHeight: Integer;
  ATopDownDIB: Boolean); overload;
begin
  AHeader.biSize := SizeOf(TBitmapInfoHeader);
  AHeader.biWidth := AWidth;
  if ATopDownDIB then
    AHeader.biHeight := -AHeight
  else
    AHeader.biHeight := AHeight;
  AHeader.biPlanes := 1;
  AHeader.biBitCount := 32;
  AHeader.biCompression := BI_RGB;
end;

procedure FillBitmapInfoHeader(out AHeader: TBitmapInfoHeader; ABitmap: TBitmap;
  ATopDownDIB: Boolean); overload;
begin
  FillBitmapInfoHeader(AHeader, ABitmap.Width, ABitmap.Height, ATopDownDIB);
end;

function GetBitmapBits(ABitmap: TBitmap; ATopDownDIB: Boolean): TRGBColors;
var
  AInfo: TBitmapInfo;
begin
  SetLength(Result, ABitmap.Width * ABitmap.Height);
  FillBitmapInfoHeader(AInfo.bmiHeader, ABitmap, ATopDownDIB);
//  GetDIBits(ABitmap.Canvas.Handle, ABitmap.Handle, 0, ABitmap.Height, nil, AInfo,
//    DIB_RGB_COLORS);
  GetDIBits(cxScreenCanvas.Handle, ABitmap.Handle, 0, ABitmap.Height, Result,
    AInfo, DIB_RGB_COLORS);
end;

procedure SetBitmapBits(ABitmap: TBitmap; var AColors: TRGBColors;
  ATopDownDIB: Boolean);
var
  AInfo: TBitmapInfo;
begin
  FillBitmapInfoHeader(AInfo.bmiHeader, ABitmap, ATopDownDIB);
{$IFDEF CXTEST}
  Assert(SetDIBits(cxScreenCanvas.Handle, ABitmap.Handle, 0, ABitmap.Height, AColors, AInfo, DIB_RGB_COLORS) <> 0, 'SetBitmapBits fails');
{$ELSE}
  SetDIBits(cxScreenCanvas.Handle, ABitmap.Handle, 0, ABitmap.Height, AColors, AInfo, DIB_RGB_COLORS);
{$ENDIF}
  AColors := nil;
end;

function SystemAlphaBlend(ADestDC, ASrcDC: HDC; const ADestRect, ASrcRect: TRect; AConstantAlpha: Byte = $FF): Boolean;
{$IFNDEF DELPHI6}
const
  AC_SRC_ALPHA = 1;
{$ENDIF}
var
  ABlendFunction: TBlendFunction;
begin
  ABlendFunction.BlendOp := AC_SRC_OVER;
  ABlendFunction.BlendFlags := 0;
  ABlendFunction.SourceConstantAlpha := AConstantAlpha;
  ABlendFunction.AlphaFormat := AC_SRC_ALPHA;
  Result := Assigned(VCLAlphaBlend) and VCLAlphaBlend(
    ADestDC, ADestRect.Left, ADestRect.Top, cxRectWidth(ADestRect), cxRectHeight(ADestRect),
    ASrcDC, ASrcRect.Left, ASrcRect.Top, cxRectWidth(ASrcRect), cxRectHeight(ASrcRect), ABlendFunction);
end;

function cxColorByName(const AText: string; var AColor: TColor): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := Low(cxColorsByName) to High(cxColorsByName) do
    if SameText(AText, cxColorsByName[I].Name) then
    begin
      AColor := cxColorsByName[I].Color;
      Result := True;
      Break;
    end;
end;

function cxNameByColor(AColor: TColor; var AText: string): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := Low(cxColorsByName) to High(cxColorsByName) do
    if AColor = cxColorsByName[I].Color then
    begin
      AText := cxColorsByName[I].Name;
      Result := True;
      Break;
    end;
end;

function cxColorToRGBQuad(AColor: TColor; AReserved: Byte = 0): TRGBQuad;
begin
  DWORD(Result) := ColorToRGB(AColor);

  //#DG exchange values
  Result.rgbBlue := Result.rgbBlue xor Result.rgbRed;
  Result.rgbRed := Result.rgbBlue xor Result.rgbRed;
  Result.rgbBlue := Result.rgbBlue xor Result.rgbRed;
  Result.rgbReserved := AReserved;
end;

procedure CommonAlphaBlend(ADestDC, ASrcDC: HDC; const ADestRect, ASrcRect: TRect; ASmoothImage: Boolean; AConstantAlpha: Byte = $FF);

  function CreateDirectBitmap(ASrcDC: HDC; const ASrcRect: TRect): TBitmap;
  var
    ARect: TRect;
  begin
    ARect := Rect(0, 0, cxRectWidth(ASrcRect), cxRectHeight(ASrcRect));
    Result := cxCreateBitmap(ARect, pf32bit);
    Result.Canvas.Brush.Color := 0;
    Result.Canvas.FillRect(ARect);
    cxBitBlt(Result.Canvas.Handle, ASrcDC, ARect, ASrcRect.TopLeft, SRCCOPY);
  end;

  function cxRectIdentical(const ARect1, ARect2: TRect): Boolean;
  begin
    Result := (cxRectWidth(ARect1) = cxRectWidth(ARect2)) and (cxRectHeight(ARect1) = cxRectHeight(ARect2));
  end;

  procedure ResizeBitmap(ADestBitmap, ASrcBitmap: TBitmap);
  begin
    StretchBlt(ADestBitmap.Canvas.Handle, 0, 0, ADestBitmap.Width, ADestBitmap.Height,
      ASrcBitmap.Canvas.Handle, 0, 0, ASrcBitmap.Width, ASrcBitmap.Height, SRCCOPY);
  end;

  procedure InternalAlphaBlend(ADestBitmap, ASrcBitmap: TBitmap);

    procedure SoftwareAlphaBlend(AWidth, AHeight: Integer);
    var
      ASourceColors, ADestColors: TRGBColors;
      I: Integer;
    begin
      ASourceColors := GetBitmapBits(ASrcBitmap, False);
      ADestColors := GetBitmapBits(ADestBitmap, False);
      for I := 0 to AWidth * AHeight - 1 do
        cxBlendFunction(ASourceColors[I], ADestColors[I], AConstantAlpha);
      SetBitmapBits(ADestBitmap, ADestColors, False);
    end;

  var
    AClientRect: TRect;
  begin
    AClientRect := Rect(0, 0, ADestBitmap.Width, ADestBitmap.Height);
    if not SystemAlphaBlend(ADestBitmap.Canvas.Handle, ASrcBitmap.Canvas.Handle, AClientRect, AClientRect, AConstantAlpha) then