Solved

Change bitmap when button is disabled

Posted on 1998-09-12
5
285 Views
Last Modified: 2013-12-03
I am using a component called TColorButton. It's great except for one thing: when the button is disabled, the image does not change. Iwould like the icon on the button to show that it is disabled by removing the colors (usual behaviour for disabled button).

The code for the component is listed below. Any suggestions ?
unit ColorButton;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, Buttons;

type
  TColorButtonAlignment = (alTopLeft, alTopCenter, alTopRight, alMiddleLeft, alMiddleCenter,
                alMiddleRight, alBottomLeft, alBottomCenter, alBottomRight);

  TButtonBevel = (bbLowered, bbNone, bbRaised);

  TButtonStyles = (bsAutoSize, bsCenter, bsStretch, bsShowFocus, bsShowKey);
  TButtonStyle = set of TButtonStyles;

  TButtonState = (bsUp, bsDown, bsDisabled);

  TColorButton = class(TCustomControl)
  private
    FAlignment: TColorButtonAlignment;
    FBevelStyle: TButtonBevel;
    FBevelSize: Integer;
    FColor: TColor;
    FPicture: TPicture;
    FSpacing: Integer;
    FStyle: TButtonStyle;

    FFocused: Boolean;
    FState: TButtonState;

    procedure SetAlignment(Value: TColorButtonAlignment);
    procedure SetBevelStyle(Value: TButtonBevel);
    procedure SetBevelSize(Value: Integer);
    procedure SetCaption(var Message: TMessage); message CM_TEXTCHANGED;
    procedure SetColor(Value: TColor);
    procedure SetEnabled(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure SetFocusOff(var Message: TMessage); message CM_LOSTFOCUS;
    procedure SetFocusOn(var Message: TMessage); message CM_GOTFOCUS;
    procedure SetFont(var Message: TMessage); message CM_FONTCHANGED;
    procedure SetPicture(Value: TPicture);
    procedure SetSpacing(Value: Integer);
    procedure SetStyle(Value: TButtonStyle);

    procedure DoEnter; override;
    procedure DoExit; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure KeyAccel(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  protected
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure Paint; override;
  published
    property Action;
    property Anchors;
    property Alignment: TColorButtonAlignment read FAlignment write SetAlignment default alMiddleCenter;
    property BevelStyle: TButtonBevel read FBevelStyle write SetBevelStyle default bbRaised;
    property BevelSize: Integer read FBevelSize write SetBevelSize default 2;
    property Caption;
    property Color: TColor read FColor write SetColor default clBtnFace;
    property Cursor;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property Height;
    property Left;
    property Name;
    property Picture: TPicture read FPicture write SetPicture;
    property Spacing: Integer read FSpacing write SetSpacing default 2;
    property Style: TButtonStyle read FStyle write SetStyle default [bsCenter, bsShowFocus];
    property Tag;
    property TabOrder;
    property TabStop;
    property Top;
    property Width;
    property Visible;

    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

procedure Register;

function Smallest(X, Y: Integer): Integer;
function Largest(X, Y: Integer): Integer;
function GetHighlightColor(BaseColor: TColor): TColor;
function GetShadowColor(BaseColor: TColor): TColor;
function GetSpeedKey(var Caption: String): Integer;

implementation

procedure Register;
begin
  RegisterComponents('From Internet', [TColorButton]);
end;

//
// Global procedures and functions
///////////////////////////////////////////////////////////////////////////////

function Smallest(X, Y: Integer): Integer;
begin
  if X < Y then Result := X else Result := Y;
end;

function Largest(X, Y: Integer): Integer;
begin
  if X > Y then Result := X else Result := Y;
end;

function GetHighlightColor(BaseColor: TColor): TColor;
begin
  Result := RGB(Smallest(GetRValue(ColorToRGB(BaseColor)) + 64, 255),
                Smallest(GetGValue(ColorToRGB(BaseColor)) + 64, 255),
                Smallest(GetBValue(ColorToRGB(BaseColor)) + 64, 255));
end;

function GetShadowColor(BaseColor: TColor): TColor;
begin
  Result := RGB(Largest(GetRValue(ColorToRGB(BaseColor)) - 64, 0),
                Largest(GetGValue(ColorToRGB(BaseColor)) - 64, 0),
                Largest(GetBValue(ColorToRGB(BaseColor)) - 64, 0));
end;

function GetSpeedKey(var Caption: String): Integer;
var
  keyPos: Integer;
begin
  // Find the speed key location
  keyPos := Pos('&', Caption);
  // Delete the '&' symbol
  Delete(Caption, keyPos, 1);
  // Return the location of the speed key
  Result := keyPos;
end;

//
// ColorButton procedures and functions
///////////////////////////////////////////////////////////////////////////////

constructor TColorButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csOpaque];
  FAlignment := alMiddleCenter;
  FBevelStyle := bbRaised;
  FBevelSize := 2;
  FColor := clBtnFace;
  FPicture := TPicture.Create;
  FSpacing := 2;
  FStyle := [bsCenter, bsShowFocus, bsShowKey];
  FFocused := False;
  FState := bsUp;
  Width := 75; Height := 25;
  Enabled := True;
  TabStop := False;
end;

destructor TColorButton.Destroy;
begin
  FPicture.Free;
  inherited Destroy;
end;

procedure TColorButton.Loaded;
begin
  inherited Loaded;
  if Enabled then
    FState := bsUp
  else
    FState := bsDisabled;
end;

procedure TColorButton.Paint;
  procedure DrawCaption(Offset: Integer);
  var
    xLoc, yLoc, edgeSize, keyPos: Integer;
    newCaption: String;
  begin
    edgeSize := (FBevelSize + FSpacing);
    newCaption := Caption;
    keyPos := GetSpeedKey(newCaption);

    with inherited Canvas do
    begin
      // Work out text location
      case FAlignment of
      alTopLeft:
      begin
        xLoc := edgeSize + Offset; yLoc := edgeSize + Offset;
      end;
      alTopCenter:
      begin
        xLoc := edgeSize + Offset + ((Width - (edgeSize * 2)) - TextWidth(newCaption)) div 2; yLoc := edgeSize + Offset;
      end;
      alTopRight:
      begin
        xLoc := Width - edgeSize - TextWidth(newCaption) + Offset; yLoc := edgeSize + Offset;
      end;
      alMiddleLeft:
      begin
        xLoc := edgeSize + Offset; yLoc := edgeSize + Offset + ((Height - (edgeSize * 2)) - TextHeight(newCaption)) div 2;
      end;
      alMiddleCenter:
      begin
        xLoc := edgeSize + Offset + ((Width - (edgeSize * 2)) - TextWidth(newCaption)) div 2;
            yLoc := edgeSize + Offset + ((Height - (edgeSize * 2)) - TextHeight(newCaption)) div 2;
      end;
      alMiddleRight:
      begin
        xLoc := Width - edgeSize - TextWidth(newCaption) + Offset;
            yLoc := edgeSize + Offset + ((Height - (edgeSize * 2)) - TextHeight(newCaption)) div 2;
      end;
      alBottomLeft:
      begin
        xLoc := edgeSize + Offset; yLoc := Height - edgeSize - TextHeight(newCaption) + Offset;
      end;
      alBottomCenter:
      begin
        xLoc := edgeSize + Offset + ((Width - (edgeSize * 2)) - TextWidth(newCaption)) div 2;
        yLoc := Height - edgeSize - TextHeight(newCaption) + Offset;
      end;
      alBottomRight:
      begin
        xLoc := Width - edgeSize - TextWidth(newCaption) + Offset;
        yLoc := Height - edgeSize - TextHeight(newCaption) + Offset;
      end;
      else
      // Just in-case...
            xLoc := edgeSize + Offset + ((Width - (edgeSize * 2)) - TextWidth(newCaption)) div 2;
        yLoc := edgeSize + Offset + ((Height - (edgeSize * 2)) - TextHeight(newCaption)) div 2;
      end;

      // Draw the text
      TextOut(xLoc, yLoc, newCaption);
      // Draw the speed key
      if ((keyPos > 0) and (bsShowKey in FStyle)) then
      begin
            // Can't use underscore character - unlikely to be correct width
        Pen.Color := Font.Color;
            MoveTo(xLoc + (TextWidth(Copy(newCaption, 1, keyPos - 1))), yLoc + (TextHeight('ABC')));
            LineTo(xLoc + (TextWidth(Copy(newCaption, 1, keyPos))), yLoc + (TextHeight('ABC')));
      end;
    end;
  end;

var
  Client, Picture: TRect;
  clHigh, clLow: TColor;
begin
  if not Enabled and not (csDesigning in ComponentState) then
    FState := bsDisabled
  else
    if FState = bsDisabled then
      FState := bsUp;

  if ((not (FPicture.Graphic = nil)) and (bsAutoSize in FStyle)) then
  begin
    Width := FPicture.Width + (FBevelSize * 2);
    Height := FPicture.Height + (FBevelSize * 2);
  end;

  Client := Bounds(0, 0, Width, Height);
  Canvas.Font.Assign(Font);

  with inherited Canvas do
  begin
    // Clear the background
    Brush.Color := FColor;
    FillRect(Client);
    // Draw the button bevel
    if not (FBevelStyle = bbNone) then
    begin
      // Get the bevel colors
      if ((FState = bsDown) xor (FBevelStyle = bbLowered)) then
      begin
        clHigh := GetShadowColor(FColor);
        clLow := GetHighlightColor(FColor);
      end
      else
      begin
        clHigh := GetHighlightColor(FColor);
        clLow := GetShadowColor(FColor);
      end;
        Frame3D(Canvas, Client, clHigh, clLow, FBevelSize);
    end;

    // Draw the focus
    if (FFocused and (bsShowFocus in FStyle)) and Enabled then
      DrawFocusRect(Rect(
      Client.Left + FSpacing - 1, Client.Top + FSpacing - 1,
      Client.Right - FSpacing + 1, Client.Bottom - FSpacing + 1));

    // Draw the picture
    if (FPicture <> nil) then
    begin
      if (bsStretch in FStyle) then
                 Picture := Rect(
              FBevelSize + FSpacing, FBevelSize + FSpacing, Width - (FBevelSize + FSpacing), Height - (FBevelSize + FSpacing))
      else if (bsCenter in FStyle) then
                 Picture := Bounds(
                   (Width - FPicture.Width) div 2, (Height - FPicture.Height) div 2,
               FPicture.Width, FPicture.Height
               )
      else
            case FAlignment of
             alTopLeft, alTopCenter, alTopRight:
             Picture := Bounds(
               (Width - FPicture.Width) div 2,
                   ((Height - (FBevelSize + FSpacing)) - FPicture.Height),
                       FPicture.Width, FPicture.Height
                   );
        alMiddleLeft:
                     Picture := Bounds(
                       ((Width - (FBevelSize + FSpacing)) - FPicture.Width),
                  (Height - FPicture.Height) div 2,
                       FPicture.Width, FPicture.Height
                   );
        alMiddleCenter:
                     Picture := Bounds(
                       (Width - FPicture.Width) div 2,
                           (Height - FPicture.Height) div 2,
                           FPicture.Width, FPicture.Height
                           );
        alMiddleRight:
                     Picture := Bounds(
                       (FBevelSize + FSpacing),
                   (Height - FPicture.Height) div 2,
                       FPicture.Width, FPicture.Height
                               );
        alBottomLeft, alBottomCenter, alBottomRight:
                     Picture := Bounds(
                       (Width - FPicture.Width) div 2,
                  (FBevelSize + FSpacing),
                       FPicture.Width, FPicture.Height);
      end;
      StretchDraw(Picture, FPicture.Graphic);
    end
    else
    begin
      Brush.Color := FColor;
      FillRect(Rect(FBevelSize, FBevelSize, Width - FBevelSize, Height - FBevelSize));
    end;

    // Draw the caption
    if (Caption <> '') then
    begin
          Brush.Style := bsClear;
      if ((not Enabled) and (not (csDesigning in ComponentState))) then
      begin
            Font.Color := GetHighlightColor(FColor); DrawCaption(1);
        Font.Color := GetShadowColor(FColor); DrawCaption(0);
      end else DrawCaption(0);
    end;
  end;
end;

procedure TColorButton.DoEnter;
begin
  FFocused := True; Repaint;
  inherited DoEnter;
end;

procedure TColorButton.DoExit;
begin
  FFocused := False;
  Repaint;
  inherited DoExit;
end;

procedure TColorButton.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if Key = VK_SPACE then
    if Enabled then
    begin
      FState := bsDown;
      Repaint;
    end;
end;

procedure TColorButton.KeyUp(var Key: Word; Shift: TShiftState);
begin
  inherited KeyUp(Key, Shift);
  if Key = VK_SPACE then
    if Enabled then
    begin
      FState := bsUp;
      Click; Repaint;
    end;
  if Key = VK_RETURN then if not (FState = bsDisabled) then Click;
end;

procedure TColorButton.KeyAccel(var Message: TCMDialogChar);
begin
  with Message do
  begin
    if IsAccel(CharCode, Caption) and Enabled then
    begin
      Click;
      Result := 1;
    end
    else inherited;
  end;
end;

procedure TColorButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if Enabled then
  begin
    FState := bsDown;
    Repaint;
  end;
end;

procedure TColorButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if Enabled then
  begin
    FState := bsUp;
    Repaint;
  end;
end;

procedure TColorButton.SetAlignment(Value: TColorButtonAlignment);
begin
  FAlignment := Value;
  Repaint;
end;

procedure TColorButton.SetBevelStyle(Value: TButtonBevel);
begin
  FBevelStyle := Value;
  Repaint;
end;

procedure TColorButton.SetBevelSize(Value: Integer);
begin
  if Value < 1 then
    Value := 1;
  FBevelSize := Value;
  Repaint;
end;

procedure TColorButton.SetCaption(var Message: TMessage);
begin
  Repaint;
end;

procedure TColorButton.SetColor(Value: TColor);
begin
  FColor := Value;
  Repaint;
end;

procedure TColorButton.SetEnabled(var Message: TMessage);
begin
  inherited;
  if Enabled then
    FState := bsUp else FState := bsDisabled;
  Repaint;
end;

procedure TColorButton.SetFocusOff(var Message: TMessage);
begin
  inherited;
  FFocused := False;
  Repaint;
end;

procedure TColorButton.SetFocusOn(var Message: TMessage);
begin
  inherited;
  FFocused := True;
  Repaint;
end;

procedure TColorButton.SetFont(var Message: TMessage);
begin
  inherited;
  Repaint;
end;

procedure TColorButton.SetPicture(Value: TPicture);
begin
  if FPicture <> Value then
  begin
    FPicture.Assign(Value);
    Repaint;
  end;
end;

procedure TColorButton.SetSpacing(Value: Integer);
begin
  if Value < 0 then
    Value := 0;
  if FSpacing <> Value then
  begin
    FSpacing := Value;
    Repaint;
  end;
end;

procedure TColorButton.SetStyle(Value: TButtonStyle);
begin
  if FStyle <> Value then
  begin
    FStyle := Value;
    Repaint;
  end;
end;

procedure TColorButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
  inherited ActionChange(Sender, CheckDefaults);
end;


end.
0
Comment
Question by:yvesmail
  • 3
  • 2
5 Comments
 
LVL 10

Accepted Solution

by:
viktornet earned 200 total points
ID: 1339569
How about this....???
-----------
procedure TForm1.SBClick(Sender: TObject);
var
  X, Y : Integer;
begin
  for y := 0 to SB.Glyph.Height do
    for x := 0 to SB.Glyph.Width do
      SB.Glyph.Canvas.Pixels[x,y] :=
        SB.Glyph.Canvas.Pixels[x,y] xor $00ffffff;//try playing with this xor
end;
---------------
Regards,
Viktor Ivanov
0
 

Author Comment

by:yvesmail
ID: 1339570
Thank you Viktor. I looked at the speedbutton source code, used it in combination with what you gave me and I got a very good solution.


0
 
LVL 10

Expert Comment

by:viktornet
ID: 1339571
Would you please tell me what you got as a final procedure for making it look like diabled???

ThanQ
0
 

Author Comment

by:yvesmail
ID: 1339572
Here it is:

      if ((not Enabled) and (not (csDesigning in ComponentState))) then
      begin
        IWidth := FPicture.Bitmap.Width;
        IHeight := FPicture.Bitmap.Height;
        TmpImage := TBitmap.Create;
        try
          TmpImage.Width := IWidth;
          TmpImage.Height := IHeight;
          IRect := Rect(0, 0, IWidth, IHeight);
          MonoBmp := nil;
          try
            MonoBmp := TBitmap.Create;
            begin
              with MonoBmp do
              begin
                Assign(FPicture.Bitmap);
                for x := 0 to IWidth do
                  for y := 0 to IHeight do
                    if MonoBmp.Canvas.Pixels[x, y] = FColor then
                      MonoBmp.Canvas.Pixels[x, y] := clBlack
                    else
                      MonoBmp.Canvas.Pixels[x, y] := clWhite;

                Monochrome := True;
              end;

              with TmpImage.Canvas do
              begin
                Brush.Color := FColor;
                FillRect(IRect);
                Brush.Color := GetHighlightColor(FColor);
                SetBkColor(Handle, clWhite);
                BitBlt(Handle, 1, 1, IWidth, IHeight, MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
                Brush.Color := GetDisabledColor(FColor);
                SetBkColor(Handle, clWhite);
                BitBlt(Handle, 0, 0, IWidth, IHeight, MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
              end;
            end;
          finally
            MonoBmp.Free;
          end;
          StretchDraw(Picture, TmpImage);
        finally
          TmpImage.Free;
        end;
      end
      else
        StretchDraw(Picture, FPicture.Graphic);
    end

0
 
LVL 10

Expert Comment

by:viktornet
ID: 1339573
ThanQ

Regards,
Viktor Ivanov
0

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
This video gives you a great overview about bandwidth monitoring with SNMP and WMI with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're looking for how to monitor bandwidth using netflow or packet s…

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now