toolctrlseh.pas

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

  if Along then
    for I := 0 to DotCount - 1 do
    begin
      Points[I * 2] := Point(FromPoint.X, FromPoint.Y);
      Points[I * 2 + 1] := Point(FromPoint.X + 1, FromPoint.Y);
      Inc(FromPoint.X, 2);
    end
  else
    for I := 0 to DotCount - 1 do
    begin
      Points[I * 2] := Point(FromPoint.X, FromPoint.Y);
      Points[I * 2 + 1] := Point(FromPoint.X, FromPoint.Y + 1);
      Inc(FromPoint.Y, 2);
    end;

{$IFDEF CIL}
  PolyPolyLine(Canvas.Handle, Points, StrokeList, DotCount);
{$ELSE}
  PolyPolyLine(Canvas.Handle, PIntArray(Points)^, PIntArray(StrokeList)^, DotCount);
{$ENDIF}
end;

procedure DrawTreeElement(Canvas: TCanvas; ARect: TRect;
  TreeElement: TTreeElementEh; BackDot: Boolean);
var
  ABoxRect: TRect;
//  ABoxRectWidth: Integer;
  ACenter: TPoint;
begin
  ACenter.X := (ARect.Right + ARect.Left) div 2;
  ACenter.Y := (ARect.Bottom + ARect.Top) div 2;
  with Canvas do
  begin
    ABoxRect := Rect(ACenter.X-4, ACenter.Y-4, ACenter.X+5, ACenter.Y+5);
//    ABoxRectWidth := ABoxRect.Right - ABoxRect.Left;
    if TreeElement in [tehMinusUpDown .. tehPlusDown] then
    begin
      Brush.Color := clWindow;
      Pen.Color := clBtnShadow;
      Pen.Style := psSolid;
      Rectangle(ABoxRect.Left, ABoxRect.Top, ABoxRect.Right, ABoxRect.Bottom);
      Pen.Color := clWindowText;
      MoveTo(ABoxRect.Left + 2, ACenter.Y);
      LineTo(ABoxRect.Right - 2, ACenter.Y);
      if TreeElement in [tehPlusUpDown, tehPlusUp, tehPlusDown] then
      begin
        MoveTo(ACenter.X, ABoxRect.Top + 2);
        LineTo(ACenter.X, ABoxRect.Bottom - 2);
      end;

      Pen.Color := clBtnShadow;
      DrawDotLine(Canvas, Point(ABoxRect.Right + 1, ACenter.Y),
       (ARect.Right - ABoxRect.Right), True, False);

      if TreeElement in [tehMinusUpDown, tehMinusUp, tehPlusUpDown, tehPlusUp] then
        DrawDotLine(Canvas, Point(ACenter.X, ARect.Top), (ABoxRect.Top - ARect.Top), False, BackDot);

      if TreeElement in [tehMinusUpDown, tehMinusDown, tehPlusUpDown, tehPlusDown] then
        DrawDotLine(Canvas, Point(ACenter.X, ABoxRect.Bottom + 1),
          (ARect.Bottom - ABoxRect.Bottom), False, BackDot);

    end else
    begin
      Pen.Style := psSolid;
      Pen.Color := clBtnShadow;
      if TreeElement in [tehCrossUpDown, tehVLine] then
        DrawDotLine(Canvas, Point(ACenter.X, ARect.Top),
          (ARect.Bottom - ARect.Top), False, BackDot);
      if TreeElement in [tehCrossUpDown, tehCrossUp, tehCrossDown] then
        DrawDotLine(Canvas, Point(ACenter.X, ACenter.Y), (ARect.Right - ACenter.X), True, False);
      if TreeElement in [tehCrossDown] then
        DrawDotLine(Canvas, Point(ACenter.X, ACenter.Y), (ARect.Bottom - ACenter.Y), False, BackDot);
      if TreeElement in [tehCrossUp] then
        DrawDotLine(Canvas, Point(ACenter.X, ARect.Top), (ACenter.Y - ARect.Top), False, BackDot);
    end;
  end;
end;

{ TButtonsBitmapCache }

function TButtonsBitmapCache.GetButtonBitmap(ButtonBitmapInfo: TButtonBitmapInfoEh): TBitmap;
var
  i: Integer;
  BitmapInfoBitmap: TButtonBitmapInfoBitmapEh;
begin
  if ButtonBitmapInfo.Size.X < 0 then ButtonBitmapInfo.Size.X := 0;
  if ButtonBitmapInfo.Size.Y < 0 then ButtonBitmapInfo.Size.Y := 0;
  for i := 0 to Count - 1 do
    if CompareButtonBitmapInfo(ButtonBitmapInfo, Items[i].BitmapInfo) then
    begin
      Result := Items[i].Bitmap;
      Exit;
    end;
  BitmapInfoBitmap := TButtonBitmapInfoBitmapEh.Create;
  Add(BitmapInfoBitmap);
  BitmapInfoBitmap.BitmapInfo := ButtonBitmapInfo;
  BitmapInfoBitmap.Bitmap := TBitmap.Create;
  BitmapInfoBitmap.Bitmap.Width := ButtonBitmapInfo.Size.X;
  BitmapInfoBitmap.Bitmap.Height := ButtonBitmapInfo.Size.Y;

  case ButtonBitmapInfo.BitmapType of
    bcsCheckboxEh:
      DrawCheck(BitmapInfoBitmap.Bitmap.Canvas.Handle,
        Rect(0, 0, ButtonBitmapInfo.Size.X, ButtonBitmapInfo.Size.Y),
        ButtonBitmapInfo.CheckState,
        ButtonBitmapInfo.Enabled,
        ButtonBitmapInfo.Flat,
        ButtonBitmapInfo.Pressed,
        ButtonBitmapInfo.Active
        );
    bcsEllipsisEh, bcsUpDownEh, bcsDropDownEh, bcsPlusEh, bcsMinusEh:
      DrawOneButton(BitmapInfoBitmap.Bitmap.Canvas.Handle, ButtonBitmapInfo.BitmapType,
        Rect(0, 0, ButtonBitmapInfo.Size.X, ButtonBitmapInfo.Size.Y),
        ButtonBitmapInfo.Enabled, ButtonBitmapInfo.Flat,
        ButtonBitmapInfo.Active, ButtonBitmapInfo.Pressed,
        ButtonBitmapInfo.DownDirect);
  end;
  Result := BitmapInfoBitmap.Bitmap;
end;

function TButtonsBitmapCache.Get(Index: Integer): TButtonBitmapInfoBitmapEh;
begin
  Result := TButtonBitmapInfoBitmapEh(inherited Items[Index]);
end;

{procedure TButtonsBitmapCache.Put(Index: Integer; const Value: PButtonBitmapInfoBitmapEh);
begin
  inherited Items[Index] := Value;
end;}

procedure TButtonsBitmapCache.Clear;
var i: Integer;
begin
  for i := 0 to Count - 1 do
  begin
    Items[i].Bitmap.Free;
    Items[i].Free;
    //Dispose(Items[i]);
  end;
  inherited Clear;
end;

constructor TButtonsBitmapCache.Create;
begin
  inherited Create;
  OwnsObjects := False;
end;

{ TEditButtonControlEh }

procedure TEditButtonControlEh.EditButtonDown(TopButton: Boolean; var AutoRepeat: Boolean);
var Handled: Boolean;
begin
  if Assigned(FOnDown) then
    FOnDown(Self, TopButton, AutoRepeat, Handled);
end;

procedure TEditButtonControlEh.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var AutoRepeat: Boolean;
//    OldState: TButtonState;
begin
  if Style = ebsUpDownEh
    then AutoRepeat := True
    else AutoRepeat := False;
//  OldState := FState;
  inherited MouseDown(Button, Shift, X, Y);
  if (Button = mbLeft) then
  begin
    UpdateDownButtonNum(X, Y);
    if FButtonNum > 0 then
    begin
      EditButtonDown(FButtonNum = 1, AutoRepeat);
      if AutoRepeat then ResetTimer(InitRepeatPause);
    end;
  end;
end;

procedure TEditButtonControlEh.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift, X, Y);
  if MouseCapture and (FStyle = ebsUpDownEh) and (FState = bsDown) then
  begin
    if ((FButtonNum = 2) and (Y < (Height div 2))) or
      ((FButtonNum = 1) and (Y > (Height - Height div 2))) then
    begin
      FState := bsUp;
      Invalidate;
    end;
  end;
end;

procedure TEditButtonControlEh.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (FStyle = ebsUpDownEh) and (FState <> bsDown) then
    FNoDoClick := True;
  try
    inherited MouseUp(Button, Shift, X, Y);
  finally
    FNoDoClick := False;
  end;
  UpdateDownButtonNum(X, Y);
  if (FTimer <> nil) and FTimer.Enabled then
    FTimer.Enabled := False;
end;

procedure TEditButtonControlEh.UpdateDownButtonNum(X, Y: Integer);
var OldButtonNum: Integer;
begin
  OldButtonNum := FButtonNum;
  if FState in [bsDown, bsExclusive] then
    if FStyle = ebsUpDownEh then
    begin
      if Y < (Height div 2) then
        FButtonNum := 1
      else if Y > (Height - Height div 2) then
        FButtonNum := 2
      else
        FButtonNum := 0;
    end
    else FButtonNum := 1
  else
    FButtonNum := 0;
  if FButtonNum <> OldButtonNum then
    Invalidate;
end;

procedure TEditButtonControlEh.Paint;
const
  StyleFlags: array[TEditButtonStyleEh] of TDrawButtonControlStyleEh =
  (bcsDropDownEh, bcsEllipsisEh, bcsUpDownEh, bcsUpDownEh, bcsPlusEh, bcsMinusEh);
  DownStyles: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER);
var Rgn, SaveRgn: HRgn;
  r: Integer;
  BRect: TRect;
  IsClipRgn: Boolean;
  AButtonNum: Integer;
begin
  AButtonNum := FButtonNum;
{$IFDEF EH_LIB_7}
  IsClipRgn := False;
  SaveRgn := 0;
  r := 0;
{$ENDIF}
  if not (FState in [bsDown, bsExclusive]) then
    AButtonNum := 0;
  //else if AButtonNum = 0 then
  //  AButtonNum := 1;
  if not (Style = ebsGlyphEh) then
    PaintButtonControlEh(Canvas.Handle, Rect(0, 0, Width, Height),
{$IFDEF CIL}
      Color,
{$ELSE}
      TWinControlCracker(Parent).Color,
{$ENDIF}
      StyleFlags[Style], AButtonNum,
      Flat, FActive, Enabled, cbUnchecked)
  else
  begin
{$IFDEF EH_LIB_7}
    if not ThemeServices.ThemesEnabled then
{$ENDIF}
    begin
      IsClipRgn := Flat {and not FActive};
      BRect := BoundsRect;
      r := 0;
      SaveRgn := 0;
      if IsClipRgn then
      begin
        SaveRgn := CreateRectRgn(0, 0, 0, 0);
        r := GetClipRgn(Canvas.Handle, SaveRgn);
        with BRect do
          Rgn := CreateRectRgn(Left + 1, Top + 1, Right - 1, Bottom - 1);
        SelectClipRgn(Canvas.Handle, Rgn);
        DeleteObject(Rgn);
      end;
    end;

    inherited Paint;

{$IFDEF EH_LIB_7}
    if not ThemeServices.ThemesEnabled then
{$ENDIF}
    begin
      if IsClipRgn then
      begin
        if r = 0 then
          SelectClipRgn(Canvas.Handle, 0)
        else
          SelectClipRgn(Canvas.Handle, SaveRgn);
        DeleteObject(SaveRgn);
        OffsetRect(BRect, -Left, -Top);
        if FActive then
          DrawEdge(Canvas.Handle, BRect, DownStyles[FState in [bsDown, bsExclusive]], BF_RECT)
        else
        begin
{$IFDEF CIL}
          Canvas.Brush.Color := Color;
{$ELSE}
          Canvas.Brush.Color := TWinControlCracker(Parent).Color;
{$ENDIF}
          Canvas.FrameRect(BRect);
        end;
      end;
    end;

  end;
end;

procedure TEditButtonControlEh.SetState(NewState: TButtonState; IsActive: Boolean; ButtonNum: Integer);
begin
  if (FState <> NewState) or (IsActive <> FActive) or (ButtonNum <> FButtonNum) then
  begin
    FActive := IsActive;
    FState := NewState;
    FButtonNum := ButtonNum;
    //Invalidate;
    Repaint;
  end;
end;

procedure TEditButtonControlEh.SetStyle(const Value: TEditButtonStyleEh);
begin
  if FStyle <> Value then
  begin
    FStyle := Value;
    Invalidate;
  end;
end;

procedure TEditButtonControlEh.SetWidthNoNotify(AWidth: Integer);
begin
  inherited Width := AWidth;
end;

procedure TEditButtonControlEh.SetActive(const Value: Boolean);
begin
  if Active <> Value then
  begin
    FActive := Value;
    Invalidate;
  end;
end;

procedure TEditButtonControlEh.Click;
begin
  if not FNoDoClick then
  begin
    inherited Click;
  end;
end;

function TEditButtonControlEh.GetTimer: TTimer;
begin
  if FTimer = nil then
  begin
    FTimer := TTimer.Create(Self);
    FTimer.Enabled := False;
    FTimer.OnTimer := TimerEvent;
  end;
  Result := FTimer;
end;

procedure TEditButtonControlEh.ResetTimer(Interval: Cardinal);
begin
  if Timer.Enabled = False then
  begin
    Timer.Interval := Interval;
    Timer.Enabled := True;
  end
  else if Interval <> Timer.Interval then
  begin
    Timer.Enabled := False;
    Timer.Interval := Interval;
    Timer.Enabled := True;
  end;
end;

procedure TEditButtonControlEh.TimerEvent(Sender: TObject);
var AutoRepeat: Boolean;
begin
  if Style = ebsUpDownEh
    then AutoRepeat := True
    else AutoRepeat := False;
  if not (FState = bsDown) then Exit;
  if Timer.Interval = Cardinal(InitRepeatPause)