toolctrlseh.pas

我对ehlib的修改,优化了计算效率,修正了其本身存在的BUG

var ButtonsBitmapCache: TButtonsBitmapCache;

procedure ClearButtonsBitmapCache;
begin
  ButtonsBitmapCache.Clear;
end;

function RectSize(ARect: TRect): TSize;
begin
  Result.cx := ARect.Right - ARect.Left;
  Result.cy := ARect.Bottom - ARect.Top;
end;

procedure PaintButtonControlEh(DC: HDC; ARect: TRect; ParentColor: TColor;
  Style: TDrawButtonControlStyleEh; DownButton: Integer;
  Flat, Active, Enabled: Boolean; State: TCheckBoxState);
var
  Rgn, SaveRgn: HRgn;
  HalfRect, DRect: TRect;
  ASize: TSize;
  r: Integer;
  Brush: HBRUSH;
  IsClipRgn: Boolean;
  BitmapInfo: TButtonBitmapInfoEh;
  Bitmap: TBitmap;
begin
  SaveRgn := 0; r := 0;
//  FillChar(BitmapInfo, Sizeof(BitmapInfo), #0);
  BitmapInfo.BitmapType := Style;
  BitmapInfo.Flat := Flat;

  if Style = bcsCheckboxEh then
  begin
    ASize := RectSize(ARect);
    if ASize.cx < ASize.cy then
    begin
      ARect.Top := ARect.Top + (ASize.cy - ASize.cx) div 2;
      ARect.Bottom := ARect.Bottom - (ASize.cy - ASize.cx) div 2 - (ASize.cy - ASize.cx) mod 2;
    end else if ASize.cx > ASize.cy then
    begin
      ARect.Left := ARect.Left + (ASize.cx - ASize.cy) div 2;
      ARect.Right := ARect.Right - (ASize.cx - ASize.cy) div 2 - (ASize.cx - ASize.cy) mod 2;
    end;

    if Flat then InflateRect(ARect, -1, -1);
    if UseButtonsBitmapCache then
    begin
      BitmapInfo.Size := Point(ARect.Right - ARect.Left, ARect.Bottom - ARect.Top);
      BitmapInfo.CheckState := State;
      BitmapInfo.Pressed := DownButton <> 0;
      BitmapInfo.Active := Active;
      BitmapInfo.Enabled := Enabled;
      Bitmap := ButtonsBitmapCache.GetButtonBitmap(BitmapInfo);

      StretchBlt(DC, ARect.Left, ARect.Top, ARect.Right - ARect.Left,
        ARect.Bottom - ARect.Top, Bitmap.Canvas.Handle, 0, 0,
        Bitmap.Width, Bitmap.Height, cmSrcCopy);
    end else
      DrawCheck(DC, ARect, State, Enabled, Flat, DownButton <> 0, Active);

    if Flat then
    begin
      InflateRect(ARect, 1, 1);
      if Active then
        DrawEdge(DC, ARect, BDR_SUNKENOUTER, BF_RECT)
      else
      begin
//        FrameRect(DC, ARect, GetCurrentObject(DC, OBJ_BRUSH));
        Brush := CreateSolidBrush(ColorToRGB(ParentColor));
        FrameRect(DC, ARect, Brush);
        DeleteObject(Brush);
      end;
    end;
  end else
  begin
    BitmapInfo.Active := Active;
    BitmapInfo.Enabled := Enabled;

{$IFDEF EH_LIB_7}
    IsClipRgn := Flat and not Active and not ThemeServices.ThemesEnabled;
{$ELSE}
    IsClipRgn := Flat and not Active;
{$ENDIF}
    if IsClipRgn then
    begin
      DRect := ARect;
      WindowsLPtoDP(DC, DRect);
      InflateRect(ARect, -1, -1);
      if not UseButtonsBitmapCache then
      begin
        SaveRgn := CreateRectRgn(0, 0, 0, 0);
        r := GetClipRgn(DC, SaveRgn);
        with DRect do
          Rgn := CreateRectRgn(Left + 1, Top + 1, Right - 1, Bottom - 1);
        SelectClipRgn(DC, Rgn);
        DeleteObject(Rgn);
      end;
    end;

    if Style = bcsUpDownEh then
    begin
      if IsClipRgn then InflateRect(ARect, 1, 1);
      HalfRect := ARect;
      with HalfRect do
        Bottom := Top + (Bottom - Top) div 2;
      if IsClipRgn then InflateRect(HalfRect, -1, -1);
      if UseButtonsBitmapCache then
      begin
        BitmapInfo.Size := Point(HalfRect.Right - HalfRect.Left, HalfRect.Bottom - HalfRect.Top);
        BitmapInfo.Pressed := DownButton = 1;
        BitmapInfo.DownDirect := False;
        Bitmap := ButtonsBitmapCache.GetButtonBitmap(BitmapInfo);
        StretchBlt(DC, HalfRect.Left, HalfRect.Top, HalfRect.Right - HalfRect.Left,
          HalfRect.Bottom - HalfRect.Top, Bitmap.Canvas.Handle, 0, 0,
          Bitmap.Width, Bitmap.Height, cmSrcCopy);
      end else
        DrawOneButton(DC, Style, HalfRect, Enabled, Flat, Active, DownButton = 1, False);
      if IsClipRgn then InflateRect(HalfRect, 1, 1);
      HalfRect.Bottom := ARect.Bottom;
      with HalfRect do
        Top := Bottom - (Bottom - Top) div 2;
      if IsClipRgn then InflateRect(HalfRect, -1, -1);
      if UseButtonsBitmapCache then
      begin
        BitmapInfo.Size := Point(HalfRect.Right - HalfRect.Left, HalfRect.Bottom - HalfRect.Top);
        BitmapInfo.Pressed := DownButton = 2;
        BitmapInfo.DownDirect := True;
        Bitmap := ButtonsBitmapCache.GetButtonBitmap(BitmapInfo);
        StretchBlt(DC, HalfRect.Left, HalfRect.Top, HalfRect.Right - HalfRect.Left,
          HalfRect.Bottom - HalfRect.Top, Bitmap.Canvas.Handle, 0, 0,
          Bitmap.Width, Bitmap.Height, cmSrcCopy);
      end else
        DrawOneButton(DC, Style, HalfRect, Enabled, Flat, Active, DownButton = 2, True);
      if IsClipRgn
        then InflateRect(ARect, -1, -1);
      if ((ARect.Bottom - ARect.Top) mod 2 = 1) or (IsClipRgn) then
      begin
        HalfRect := ARect;
        HalfRect.Top := (HalfRect.Bottom + HalfRect.Top) div 2;
        HalfRect.Bottom := HalfRect.Top;
        if (ARect.Bottom - ARect.Top) mod 2 = 1 then Inc(HalfRect.Bottom);
        if IsClipRgn then InflateRect(HalfRect, 0, 1);
        Brush := CreateSolidBrush(ColorToRGB(ParentColor));
        FillRect(DC, HalfRect, Brush);
        DeleteObject(Brush);
      end;
    end else if UseButtonsBitmapCache then
    begin
      BitmapInfo.Size := Point(ARect.Right - ARect.Left, ARect.Bottom - ARect.Top);
      BitmapInfo.Pressed := DownButton <> 0;
      Bitmap := ButtonsBitmapCache.GetButtonBitmap(BitmapInfo);
      StretchBlt(DC, ARect.Left, ARect.Top, ARect.Right - ARect.Left,
        ARect.Bottom - ARect.Top, Bitmap.Canvas.Handle, 0, 0,
        Bitmap.Width, Bitmap.Height, cmSrcCopy);
    end else
      DrawOneButton(DC, Style, ARect, Enabled, Flat, Active, DownButton <> 0, True);

    if IsClipRgn then
    begin
      InflateRect(ARect, 1, 1);
      if not UseButtonsBitmapCache then
      begin
        if r = 0
          then SelectClipRgn(DC, 0)
          else SelectClipRgn(DC, SaveRgn);
        DeleteObject(SaveRgn);
      end;
      Brush := CreateSolidBrush(ColorToRGB(ParentColor));
      FrameRect(DC, ARect, Brush);
      DeleteObject(Brush);
    end;
  end;
end;

function GetDefaultFlatButtonWidth: Integer;
var
  DC: HDC;
  SysMetrics: TTextMetric;
begin
  DC := GetDC(0);
  GetTextMetrics(DC, SysMetrics);
  ReleaseDC(0, DC);
  Result := Round(SysMetrics.tmHeight / 3 * 2);
  if Result mod 2 = 0 then Inc(Result);
  if Result > GetSystemMetrics(SM_CXVSCROLL)
    then Result := GetSystemMetrics(SM_CXVSCROLL);
end;

function DefaultEditButtonHeight(EditButtonWidth: Integer; Flat: Boolean): Integer;
begin
  if Flat
    then Result := Round(EditButtonWidth * 3 / 2)
    else Result := EditButtonWidth;
end;

//{$DEBUGINFO OFF}
function VarEquals(const V1, V2: Variant): Boolean;
var i: Integer;
begin
  Result := not (VarIsArray(V1) xor VarIsArray(V2));
  if not Result then Exit;
  Result := False;
  try
    if VarIsArray(V1) and VarIsArray(V2) and
      (VarArrayDimCount(V1) = VarArrayDimCount(V2)) and
      (VarArrayLowBound(V1, 1) = VarArrayLowBound(V2, 1)) and
      (VarArrayHighBound(V1, 1) = VarArrayHighBound(V2, 1))
      then
      for i := VarArrayLowBound(V1, 1) to VarArrayHighBound(V1, 1) do
      begin
        Result := V1[i] = V2[i];
        if not Result then Exit;
      end
    else
      begin
        Result := not (VarIsEmpty(V1) xor VarIsEmpty(V2));
        if not Result
          then Exit
          else Result := (V1 = V2);
      end;
  except
  end;
end;
//{$DEBUGINFO ON}

function GetRGBColor(Value: TColor): DWORD;
begin
  Result := ColorToRGB(Value);
  case Result of
    clNone: Result := CLR_NONE;
    clDefault: Result := CLR_DEFAULT;
  end;
end;

procedure DrawImage(DC: HDC; ARect: TRect; Images: TCustomImageList;
  ImageIndex: Integer; Selected: Boolean);
const
  ImageTypes: array[TImageType] of Longint = (0, ILD_MASK);
  ImageSelTypes: array[Boolean] of Longint = (0, ILD_SELECTED);
var CheckedRect, AUnionRect: TRect;
  OldRectRgn, RectRgn: HRGN;
  r, x, y: Integer;
  procedure DrawIm;
  var ABlendColor: TColor;
  begin
    with Images do
      if HandleAllocated then
      begin
        if Selected then ABlendColor := clHighlight
        else ABlendColor := BlendColor;
        ImageList_DrawEx(Handle, ImageIndex, DC, x, y, 0, 0,
          GetRGBColor(BkColor), GetRGBColor(ABlendColor),
          ImageTypes[ImageType] or ImageSelTypes[Selected]);
      end;
  end;
begin
  with Images do
  begin
    x := (ARect.Right + ARect.Left - Images.Width) div 2;
    y := (ARect.Bottom + ARect.Top - Images.Height) div 2;
    CheckedRect := Rect(X, Y, X + Images.Width, Y + Images.Height);
    UnionRect(AUnionRect, CheckedRect, ARect);
    if EqualRect(AUnionRect, ARect) then // ARect containt image
      DrawIm
    else
    begin // Need clip
      OldRectRgn := CreateRectRgn(0, 0, 0, 0);
      r := GetClipRgn(DC, OldRectRgn);
      RectRgn := CreateRectRgn(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
      SelectClipRgn(DC, RectRgn);
      DeleteObject(RectRgn);

      DrawIm;

      if r = 0
        then SelectClipRgn(DC, 0)
        else SelectClipRgn(DC, OldRectRgn);
      DeleteObject(OldRectRgn);
    end;
  end;
end;

function AlignDropDownWindowRect(MasterAbsRect: TRect; DropDownWin: TWinControl; Align: TDropDownAlign): TPoint;
var
  P: TPoint;
  Y: Integer;
  WorkArea: TRect;
  MonInfo: TMonitorInfo;
begin
  P := MasterAbsRect.TopLeft;
  Y := P.Y + (MasterAbsRect.Bottom - MasterAbsRect.Top);

  MonInfo.cbSize := SizeOf(MonInfo);
{$IFDEF CIL}
  GetMonitorInfo(MonitorFromRect(MasterAbsRect, MONITOR_DEFAULTTONEAREST), MonInfo);
{$ELSE}
  GetMonitorInfo(MonitorFromRect(@MasterAbsRect, MONITOR_DEFAULTTONEAREST), @MonInfo);
{$ENDIF}
  WorkArea := MonInfo.rcWork;
//  SystemParametersInfo(SPI_GETWORKAREA, 0, Pointer(@WorkArea), 0);

  if ((Y + DropDownWin.Height > WorkArea.Bottom) and (P.Y - DropDownWin.Height >= WorkArea.Top)) or
    ((P.Y - DropDownWin.Height < WorkArea.Top) and (WorkArea.Bottom - Y < P.Y - WorkArea.Top))
    then
  begin
    if P.Y - DropDownWin.Height < WorkArea.Top then
      DropDownWin.Height := P.Y - WorkArea.Top;
    Y := P.Y - DropDownWin.Height;
    DropDownWin.Perform(cm_SetSizeGripChangePosition, Ord(sgcpToTop), 0);
  end else
  begin
    if Y + DropDownWin.Height > WorkArea.Bottom then
      DropDownWin.Height := WorkArea.Bottom - Y;
    DropDownWin.Perform(cm_SetSizeGripChangePosition, Ord(sgcpToBottom), 0);
  end;

  case Align of
    daRight: Dec(P.X, DropDownWin.Width - (MasterAbsRect.Right - MasterAbsRect.Left));
    daCenter: Dec(P.X, (DropDownWin.Width - (MasterAbsRect.Right - MasterAbsRect.Left)) div 2);
  end;

  if (DropDownWin.Width > WorkArea.Right - WorkArea.Left) then
    DropDownWin.Width := WorkArea.Right - WorkArea.Left;
  if (P.X + DropDownWin.Width > WorkArea.Right) then
  begin
    P.X := WorkArea.Right - DropDownWin.Width;
    DropDownWin.Perform(cm_SetSizeGripChangePosition, Ord(sgcpToLeft), 0);
  end
  else if P.X < WorkArea.Left then
  begin
    P.X := WorkArea.Left;
    DropDownWin.Perform(cm_SetSizeGripChangePosition, Ord(sgcpToRight), 0);
  end else if Align = daRight then
    DropDownWin.Perform(cm_SetSizeGripChangePosition, Ord(sgcpToLeft), 0)
  else
    DropDownWin.Perform(cm_SetSizeGripChangePosition, Ord(sgcpToRight), 0);

  Result := Point(P.X, Y);
end;

function AlignDropDownWindow(MasterWin, DropDownWin: TWinControl; Align: TDropDownAlign): TPoint;
var
  MasterAbsRect: TRect;
begin
  MasterAbsRect.TopLeft := MasterWin.Parent.ClientToScreen(Point(MasterWin.Left, MasterWin.Top));
  MasterAbsRect.Bottom := MasterAbsRect.Top + MasterWin.Height;
  MasterAbsRect.Right := MasterAbsRect.Left + MasterWin.Width;
  Result := AlignDropDownWindowRect(MasterAbsRect, DropDownWin, Align);
end;

type
  TIntArray = array[0..16384] of Integer;
  PIntArray = ^TIntArray;

procedure DrawDotLine(Canvas: TCanvas; FromPoint: TPoint; ALength: Integer;
  Along: Boolean; BackDot: Boolean);
var
  Points: array of TPoint;
  StrokeList: array of DWORD;
  DotCount, I: Integer;
begin
  if Along then
  begin
    if ((FromPoint.X mod 2) <> (FromPoint.Y mod 2)) xor BackDot then
    begin
      Inc(FromPoint.X);
      Dec(ALength);
    end;
  end else
  begin
    if ((FromPoint.X mod 2) <> (FromPoint.Y mod 2)) xor BackDot then
    begin
      Inc(FromPoint.Y);
      Dec(ALength);
    end;
  end;

  DotCount := ALength div 2;
  if ALength mod 2 <> 0 then
    Inc(DotCount);
  SetLength(Points, DotCount * 2); // two points per stroke
  SetLength(StrokeList, DotCount);
  for I := 0 to DotCount - 1 do
    StrokeList[I] := 2;