toolctrlseh.pas

考勤管理是企业内部管理的重要环节和基础

  if Flat then Dec(PWid);
  if PWid mod 2 <> MinWH mod 2 then Inc(PWid);
  if Plus and (PWid mod 2 <> PHet mod 2) then
    if (MinWH < 12) then Inc(PWid) else Dec(PWid);
  PlusInd := PWid div 2 - PHet div 2;

  W := ElRect.Left + (ElRect.Right - ElRect.Left - PWid) div 2;//- Ord(not Active and Flat);
  //if W * 2 + PWid > (ElRect.Right - ElRect.Left) then Dec(W);
  Inc(W,Ord(Pressed));
  H := ElRect.Top + (ElRect.Bottom - ElRect.Top - PHet) div 2 + Ord(Pressed);

  if not Enabled then
  begin
    Inc(W);Inc(H);
    Brush := GetSysColorBrush(COLOR_BTNHILIGHT);
    SaveBrush := SelectObject(DC, Brush);
    PatBlt(DC, W, H, PWid, PHet, PATCOPY);
    if Plus then  PatBlt(DC, W + PlusInd, H - PlusInd, PHet, PWid, PATCOPY);
    Dec(W);Dec(H);
    SelectObject(DC, SaveBrush);
    Brush := GetSysColorBrush(COLOR_BTNSHADOW);
  end else
    Brush := GetSysColorBrush(COLOR_BTNTEXT);

  SaveBrush := SelectObject(DC, Brush);
  PatBlt(DC, W, H, PWid, PHet, PATCOPY);
  if Plus then  PatBlt(DC, W + PlusInd, H - PlusInd, PHet, PWid, PATCOPY);
  SelectObject(DC, SaveBrush);
end;

procedure DrawOneButton(DC: HDC; Style: TDrawButtonControlStyleEh;
  ARect: TRect; Enabled, Flat, Active, Down, DownDirection: Boolean);
var Rgn, SaveRgn: HRgn;
    r:Integer;
    Flags:Integer;
    IsClipRgn:Boolean;
    DRect:TRect;
//    Brush: HBRUSH;
begin
  DRect := ARect;
  LPtoDP(DC,DRect,2);

  IsClipRgn := Flat and Active;
  r := 0; SaveRgn := 0;
  if IsClipRgn 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;

  if Flat then
    if not Active {and not (Style=bcsUpDownEh)}
      then InflateRect(ARect,2,2)
      else InflateRect(ARect,1,1);
  Flags := DownFlags[Down] or FlatFlags[Flat] or EnabledFlags[Enabled];
  case Style of
    bcsDropDownEh: DrawFrameControl(DC, ARect, DFC_SCROLL, Flags or DFCS_SCROLLCOMBOBOX);
    bcsEllipsisEh: DrawEllipsisButton(DC, ARect, Enabled, Active, Flat, Down);
    bcsUpDownEh: DrawFrameControl(DC, ARect, DFC_SCROLL, Flags or IsDownFlags[DownDirection]);
    bcsMinusEh, bcsPlusEh: DrawPlusMinusButton(DC, ARect, Enabled, Active, Flat, Down, bcsPlusEh = Style);
  end;
  if Flat then
    if not Active {and not (Style=bcsUpDownEh)}
      then InflateRect(ARect,-2,-2)
      else InflateRect(ARect,-1,-1);

  if IsClipRgn then
  begin
    if r = 0
      then SelectClipRgn(DC, 0)
      else SelectClipRgn(DC, SaveRgn);
    DeleteObject(SaveRgn);
    if Down
      then DrawEdge(DC, ARect, BDR_SUNKENOUTER, BF_RECT)
      else DrawEdge(DC, ARect, BDR_RAISEDINNER, BF_RECT)
  end;
end;

type
  PPoints = ^TPoints;
  TPoints = array[0..0] of TPoint;

  TButtonBitmapInfoEh = record
    Size:TPoint;
    BitmapType: TDrawButtonControlStyleEh;
    Flat:Boolean;
    case TDrawButtonControlStyleEh of
      bcsDropDownEh, bcsEllipsisEh, bcsUpDownEh,
      bcsPlusEh, bcsMinusEh: (Pressed, Active, Enabled, DownDirect:Boolean);
      bcsCheckboxEh: (State: TCheckBoxState);
  end;

  { TButtonsBitmapCache }

  TButtonBitmapInfoBitmapEh = record
    BitmapInfo: TButtonBitmapInfoEh;
    Bitmap: TBitmap;
  end;

  PButtonBitmapInfoBitmapEh = ^TButtonBitmapInfoBitmapEh;

  TButtonsBitmapCache = class(TList)
  private
    function Get(Index: Integer): PButtonBitmapInfoBitmapEh;
//    procedure Put(Index: Integer; const Value: PButtonBitmapInfoBitmapEh);
  public
    procedure Clear; override;
    function GetButtonBitmap(ButtonBitmapInfo: TButtonBitmapInfoEh):TBitmap;
    property Items[Index: Integer]: PButtonBitmapInfoBitmapEh read Get {write Put}; default;
  end;

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.State := State;
      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);

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

    IsClipRgn := Flat and not Active;
    if IsClipRgn then
    begin
      DRect := ARect;
      LPtoDP(DC,DRect,2);
      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 Dec(Result);
  if Result > GetSystemMetrics(SM_CXVSCROLL)
    then Result := GetSystemMetrics(SM_CXVSCROLL);
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
      Result := V1 = V2;
  except
  end;
end;
//{$DEBUGINFO ON}

function TButtonsBitmapCache.GetButtonBitmap(ButtonBitmapInfo: TButtonBitmapInfoEh):TBitmap;
var i: Integer;
    BitmapInfoBitmap: PButtonBitmapInfoBitmapEh;
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 CompareMem(@ButtonBitmapInfo,Items[i],SizeOf(TButtonBitmapInfoEh)) then
    begin
      Result := Items[i].Bitmap;
      Exit;
    end;
  New(BitmapInfoBitmap);
  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.State,
                True,
                ButtonBitmapInfo.Flat
                );
     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): PButtonBitmapInfoBitmapEh;
begin
  Result := 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;
    Dispose(Items[i]);
  end;
  inherited Clear;
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;
  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),
      TWinControlCracker(Parent).Color,StyleFlags[Style],AButtonNum,
      Flat, FActive, Enabled, cbUnchecked)
  else
  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);