jvqspin.pas

East make Tray Icon in delphi

    else {vtInteger}
      Result := StrToIntDef(RemoveThousands(Text), Round(FMinValue));
    end;
  except
    if ValueType = vtFloat then
      Result := FMinValue
    else
      Result := Round(FMinValue);
  end;
end;

procedure TJvSpinEdit.SetValue(NewValue: Extended);
var
  FloatFormat: TFloatFormat;
  WasModified: Boolean;
begin
  if Thousands then
    FloatFormat := ffNumber
  else
    FloatFormat := ffFixed;

  { Changing EditText sets Modified to false }
  WasModified := Modified;
  try
    case ValueType of
      vtFloat:
        if FDisplayFormat <> '' then
          Text := FormatFloat(FDisplayFormat, CheckValue(NewValue))
        else
          Text := FloatToStrF(CheckValue(NewValue), FloatFormat, 15, FDecimal);
      vtHex:
        if ValueType = vtHex then
          Text := IntToHex(Round(CheckValue(NewValue)), 1);
    else {vtInteger}
      //Text := IntToStr(Round(CheckValue(NewValue)));
      Text := FloatToStrF(CheckValue(NewValue), FloatFormat, 15, 0);
    end;
    DataChanged;
  finally
    Modified := WasModified;
  end;
end;

//=== { TJvUpDown } ==========================================================

constructor TJvUpDown.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Orientation := udVertical;
  Min := -1;
  Max := 1;
  Position := 0;
end;

destructor TJvUpDown.Destroy;
begin
  OnClick := nil;
  inherited Destroy;
end;

procedure TJvUpDown.Resize;
begin
  if Width <> DefBtnWidth then
    Width := DefBtnWidth
  else
    inherited Resize;
end;




procedure TJvUpDown.Click(Button: TUDBtnType);
var
  Pos: Integer;
begin
  if not FChanging then
  begin
    FChanging := True;
    try
      Pos := Position;
      UpdatePosition(0);
    finally
      FChanging := False;
    end;
    if Pos < 0 then
      inherited Click(btPrev)
    else
      inherited Click(btPrev)
  end;
end;


//=== { TSpinButtonBitmaps } =================================================

procedure TSpinButtonBitmaps.AddClient;
begin
  Inc(FClientCount);
end;

function TSpinButtonBitmaps.CompareWith(const AWidth, AHeight: Integer;
  const AStyle: TJvSpinButtonStyle; const ACustomGlyphs: Boolean): Integer;
begin
  // used by the binary search
  Result := Self.Width - AWidth;
  if Result = 0 then
  begin
    Result := Self.Height - AHeight;
    if Result = 0 then
    begin
      Result := Ord(Self.Style) - Ord(AStyle);
      if Result = 0 then
        Result := Ord(Self.CustomGlyphs) - Ord(ACustomGlyphs);
    end;
  end;
end;

constructor TSpinButtonBitmaps.Create(AManager: TSpinButtonBitmapsManager;
  const AWidth, AHeight: Integer; const AStyle: TJvSpinButtonStyle; const ACustomGlyphs: Boolean);
begin
  inherited Create;
  FManager := AManager;
  FWidth := AWidth;
  FHeight := AHeight;
  FStyle := AStyle;
  FCustomGlyphs := ACustomGlyphs;

  FTopDownBtn := TBitmap.Create;
  FBottomDownBtn := TBitmap.Create;
  FNotDownBtn := TBitmap.Create;
  FDisabledBtn := TBitmap.Create; 

  DrawAllBitmap;
end;

destructor TSpinButtonBitmaps.Destroy;
begin
  FManager.Remove(Self);

  FTopDownBtn.Free;
  FBottomDownBtn.Free;
  FNotDownBtn.Free;
  FDisabledBtn.Free; 

  inherited Destroy;
end;

procedure TSpinButtonBitmaps.Draw(ACanvas: TCanvas;
  const ADown: TSpinButtonState; const AEnabled, AMouseInTopBtn, AMouseInBottomBtn: Boolean);
begin
  if FResetOnDraw then
  begin
    DrawAllBitmap;
    FResetOnDraw := False;
  end;

  with ACanvas do
    if not AEnabled then
      Draw(0, 0, FDisabledBtn)
    else
      case ADown of
        sbNotDown: 
            Draw(0, 0, FNotDownBtn);
        sbTopDown:
          Draw(0, 0, FTopDownBtn);
        sbBottomDown:
          Draw(0, 0, FBottomDownBtn);
      end;
end;

procedure TSpinButtonBitmaps.DrawAllBitmap;
begin 

  DrawBitmap(FTopDownBtn, sbTopDown, True);
  DrawBitmap(FBottomDownBtn, sbBottomDown, True);
  DrawBitmap(FNotDownBtn, sbNotDown, True);
  DrawBitmap(FDisabledBtn, sbNotDown, False);
end;



procedure TSpinButtonBitmaps.DrawBitmap(ABitmap: TBitmap;
  ADownState: TSpinButtonState; const Enabled: Boolean);
const
  CColors: TColorArray = (clBtnShadow, clBtnHighlight, cl3DDkShadow);
var
  ButtonRect: TRect;
  LColors: TColorArray;
  UpArrow, DownArrow: TBitmap;

  procedure JvDraw;
  var
    TopFlags, BottomFlags: DWORD;
    R: TRect;
  begin
    TopFlags := EDGE_RAISED;
    BottomFlags := EDGE_RAISED;
    R := ButtonRect;

    with ABitmap.Canvas do
    begin 
      Start; 
      LColors := CColors;
      if ADownState = sbTopDown then
      begin
        LColors[0] := clBtnFace;
        LColors[2] := clBtnHighlight;
        TopFlags := EDGE_SUNKEN;
      end;
      if ADownState = sbBottomDown then
      begin
        LColors[1] := clWindowFrame;
        LColors[2] := clBtnShadow;
        BottomFlags := EDGE_SUNKEN;
      end;
      DrawEdge(Handle, R, TopFlags, BF_TOPLEFT or BF_SOFT);
      DrawEdge(Handle, R, BottomFlags, BF_BOTTOMRIGHT or BF_SOFT);
      InflateRect(R, -1, -1);

      Pen.Color := LColors[0];
      MoveTo(R.Left, R.Bottom - 2);
      LineTo(R.Right - 1, R.Top - 1);

      Pen.Color := LColors[2];
      MoveTo(R.Right - 1, R.Top);
      LineTo(R.Right - 1, R.Top);
      LineTo(R.Left, R.Bottom - 1);

      Pen.Color := LColors[1];
      MoveTo(R.Left + 1, R.Bottom - 1);
      LineTo(R.Right, R.Top);

      if not CustomGlyphs then
      begin
        UpArrow.LoadFromResourceName(HInstance, sSpinUpBtn);
        UpArrow.TransparentColor := clWhite;
        UpArrow.Transparent := True;
        DownArrow.LoadFromResourceName(HInstance, sSpinDownBtn);
        DownArrow.TransparentColor := clWhite;
        DownArrow.Transparent := True;
        JvDrawArrows(ABitmap.Canvas, ADownState, Enabled, UpArrow, DownArrow);
      end; 
      Stop; 
    end;
  end;

  procedure PoleDraw;
  var
    H: Integer;
    TopFlags, BottomFlags: DWORD;
    R, R1: TRect;
    RSrc: TRect;
  begin
    TopFlags := EDGE_RAISED;
    BottomFlags := EDGE_RAISED;

    with ABitmap.Canvas do
    begin 
      Start; 
      { top glyph }
      H := Height div 2;
      R := Bounds(0, 0, Width, H);
      if ADownState = sbTopDown then
        TopFlags := EDGE_SUNKEN
      else
        R.Bottom := R.Bottom + 1;
      if ADownState = sbBottomDown then
        BottomFlags := EDGE_SUNKEN;
      RSrc := R;
      DrawEdge(Handle, R, TopFlags, BF_RECT or BF_SOFT or BF_ADJUST);
      R1 := Bounds(0, H, Width, Height);
      R1.Bottom := Height;
      DrawEdge(Handle, R1, BottomFlags, BF_RECT or BF_SOFT or BF_ADJUST);
      if not CustomGlyphs then
      begin
        UpArrow.LoadFromResourceName(HInstance, sSpinUpBtnPole);
        UpArrow.TransparentColor := clWhite;
        UpArrow.Transparent := True;
        DownArrow.LoadFromResourceName(HInstance, sSpinDownBtnPole);
        DownArrow.TransparentColor := clWhite;
        DownArrow.Transparent := True;
        PoleDrawArrows(ABitmap.Canvas, ADownState, Enabled, UpArrow, DownArrow);
      end; 
      Stop; 
    end;
  end;

begin
  UpArrow := nil;
  DownArrow := nil;
  try
    if not CustomGlyphs then
    begin
      UpArrow := TBitmap.Create;
      DownArrow := TBitmap.Create;
    end;

    ABitmap.Height := Height;
    ABitmap.Width := Width;

    with ABitmap.Canvas do
    begin
      ButtonRect := Bounds(0, 0, Width, Height);
      Pen.Width := 1;
      Brush.Color := clBtnFace;
      Brush.Style := bsSolid;
      FillRect(ButtonRect);
    end;
    if FStyle = sbsClassic then
      PoleDraw
    else
      JvDraw;
  finally
    UpArrow.Free;
    DownArrow.Free;
  end;
end;



procedure TSpinButtonBitmaps.DrawGlyphs(ACanvas: TCanvas; const AState: TSpinButtonState; const Enabled: Boolean;
  AUpArrow, ADownArrow: TBitmap);
begin 
  if FStyle = sbsClassic then
    PoleDrawArrows(ACanvas, AState, Enabled, AUpArrow, ADownArrow)
  else
    JvDrawArrows(ACanvas, AState, Enabled, AUpArrow, ADownArrow)
end;

procedure TSpinButtonBitmaps.JvDrawArrows(ACanvas: TCanvas; const AState: TSpinButtonState;
  const Enabled: Boolean; AUpArrow, ADownArrow: TBitmap);
var
  Dest, Source: TRect;
  DeltaRect: Integer;
  DisabledBitmap: TBitmap;
begin
  { buttons }
  with ACanvas do
  begin
    { top glyph }
    DeltaRect := 1;
    if AState = sbTopDown then
      Inc(DeltaRect);

    Dest := Bounds(Round((Width / 4) - (AUpArrow.Width / 2)) + DeltaRect,
      Round((Height / 4) - (AUpArrow.Height / 2)) + DeltaRect, AUpArrow.Width,
      AUpArrow.Height);
    Source := Bounds(0, 0, AUpArrow.Width, AUpArrow.Height);

    if Enabled then
      BrushCopy( ACanvas,  Dest, AUpArrow, Source, AUpArrow.TransparentColor)
    else
    begin
      DisabledBitmap := CreateDisabledBitmap(AUpArrow, clBlack);
//        DisabledBitmap := CreateMonoBitmap(AUpArrow, clWhite);//, clBlack);
      try
        BrushCopy( ACanvas,  Dest, DisabledBitmap, Source, DisabledBitmap.TransparentColor);
      finally
        DisabledBitmap.Free;
      end;
    end;

    { bottom glyph }
    Dest := Bounds(Round((3 * Width / 4) - (ADownArrow.Width / 2)) - 1,
      Round((3 * Height / 4) - (ADownArrow.Height / 2)) - 1,
      ADownArrow.Width, ADownArrow.Height);
    Source := Bounds(0, 0, ADownArrow.Width, ADownArrow.Height);

    if Enabled then
      BrushCopy( ACanvas,  Dest, ADownArrow, Source, ADownArrow.TransparentColor)
    else
    begin
      DisabledBitmap := CreateDisabledBitmap(ADownArrow, clBlack);
//      DisabledBitmap := CreateMonoBitmap(ADownArrow, clWhite);
      try
        BrushCopy( ACanvas,  Dest, DisabledBitmap, Source, DisabledBitmap.TransparentColor);
      finally
        DisabledBitmap.Free;
      end;
    end;
  end;
end;

procedure TSpinButtonBitmaps.PoleDrawArrows(ACanvas: TCanvas;
  const AState: TSpinButtonState; const Enabled: Boolean; AUpArrow, ADownArrow: TBitmap);
var
  X, Y, I, J, H: Integer;
  R1: TRect;
  R: TRect;
  DisabledBitmap: TBitmap;
begin
  with ACanvas do
  begin
    H := Height div 2;
    R := Bounds(0, 0, Width, H);
    if AState = sbTopDown then
    else
      R.Bottom := R.Bottom + 1;
    R1 := Bounds(0, H, Width, Height);
    R1.Bottom := Height;
    I := R.Bottom - R.Top - 1;
    J := R1.Bottom - R1.Top - 1;
    Y := R.Top + (H - AUpArrow.Height) div 2;
    if AState = sbTopDown then
      OffsetRect(R1, 0, 1);

    R1.Bottom := R1.Top + I;
    if J - AUpArrow.Height < 0 then
      Y := R.Top;
    X := (Width - AUpArrow.Width) div 2;

    IntersectClipRect(Handle, R.Left, R.Top, R.Right, R.Bottom);
    if Enabled then
      Draw(X, Y, AUpArrow)
    else
    begin
//      DisabledBitmap := CreateDisabledBitmap(AUpArrow, clBlack);
      DisabledBitmap := CreateMonoBitmap(AUpArrow, clWhite);
      try
        Draw(X, Y, DisabledBitmap);
      finally
        DisabledBitmap.Free;
      end;
    end;
    SelectClipRgn(Handle, 0);
    X := (Width - ADownArrow.Width) div 2;
    Y := R1.Top + (I - ADownArrow.Height) div 2;
    if I - ADownArrow.Height < 0 then
    begin
      Dec(R1.Top);
      Y := R1.Bottom - ADownArrow.Height
    end;

    IntersectClipRect(Handle, R1.Left, R1.Top, R1.Right, R1.Bottom);
    if Enabled then
      Draw(X, Y, ADownArrow)
    else
    begin
      DisabledBitmap := CreateMonoBitmap(ADownArrow, clWhite);
      try
        Draw(X, Y, DisabledBitmap);
      finally
        DisabledBitmap.Free;
      end;
    end;
    SelectClipRgn(Handle, 0);
  end;
end;

procedure TSpinButtonBitmaps.RemoveClient;
begin
  Dec(FClientCount);
  if FClientCount = 0 then
    Self.Free;
end;

procedure TSpinButtonBitmaps.Reset;
begin
  FResetOnDraw := True;
end;

//=== { TSpinButtonBitmapsManager } ==========================================

procedure TSpinButtonBitmapsManager.AddClient;
begin
  Inc(FClientCount);
end;

constructor TSpinButtonBitmapsManager.Create;
begin
  inherited Create;
  FList := TList.Create;
end;

destructor TSpinButtonBitmapsManager.Destroy;
begin
  while FList.Count > 0 do
    // this will implicitly remove the object from the list
    TObject(FList[0]).Free;

  FList.Free;
  inherited Destroy;
end;

function TSpinButtonBitmapsManager.Find(const Width, Height: Integer;
  const AButtonStyle: TJvSpinButtonStyle; const ACustomGlyphs: Boolean;
  var Index: Integer): Boolean;
var
  L, H, I, C: Integer;
begin
  // same binary search as Classes.TStringList.Find
  Result := False;
  L := 0;
  H := FList.Count - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    C := TSpinButtonBitmaps(FList[I]).CompareWith(Width, Height, AButtonStyle, ACustomGlyphs);
    if C < 0 then
      L := I + 1
    else
    begin
      H := I - 1;
      if C = 0 then
      begin
        Result := True;
        L := I;
      end;
    end;
  end;
  Index := L;
end;

procedure TSpinButtonBitmapsManager.Remove(Obj: TObject);
begin
  FList.Remove(Obj);
end;

procedure TSpinButtonBitmapsManager.RemoveClient;
begin
  Dec(FClientCount);
  if FClientCount = 0 then
  begin
    if Self = GSpinButtonBitmapsManager then
      GSpinButtonBitmapsManager := nil;
    Self.Free;
  end;
end;

function TSpinButtonBitmapsManager.WantButtons(const Width, Height: Integer;
  const AButtonStyle: TJvSpinButtonStyle; const ACustomGlyphs: Boolean): TSpinButtonBitmaps;
var
  Index: Integer;
begin
  if not Find(Width, Height, AButtonStyle, ACustomGlyphs, Index) then
    FList.Insert(Index, TSpinButtonBitmaps.Create(Self, Width, Height, AButtonStyle, ACustomGlyphs));
  Result := TSpinButtonBitmaps(FList[Index]);
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQSpin.pas,v $';
    Revision: '$Revision: 1.15 $';
    Date: '$Date: 2005/02/06 23:40:52 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.