Link to home
Start Free TrialLog in
Avatar of jellison
jellison

asked on

Shaped buttons (again)

I have asked similar questions before - now I have a bit more info.

I have a number of shaped button components, some freeware, some I have paid for. I have a project which has around 50 buttons and growing and I want to be able to "skin" the buttons a la Winamp or Media Player. For each button I want to define three states with three bitmaps - normal, down, and disabled. I would also like to have a caption.

Now, if I create a test project, add a shaped button and set all the button bitmaps at design time, then replicate the button 49 times, my Windows GDI resources drop from 60% to 50%. If I then run the program (no code, just buttons) the GDI drops to 30%. With some code and other graphic components I start running dangerously low on GDI.

So the question is:  Does anyone know of or use a shaped button which doesn't eat GDI? Can such a beast exist or is this type of component bound to do this?

The component does not have to have a "hot" region (ie only respond in the non transparent region) it just has to allow a transparent region to give the button a shape. I think this is the way Media players buttons work.

Thanks,

John
Avatar of excalibur256
excalibur256
Flag of United Kingdom of Great Britain and Northern Ireland image

Well, media player skins are done through XML. They have separate images as well has 'hotspot' definition images.

Download the Media Player SDK if you want to know more about them.

If you don't care about 'hot' regions you could use a simple SpeedButton with the flat property set to true.

Button components which take their shapes from images will always be bigger than others as they have to store the associated image in them. This is where replicating could would your problem worse.

See if you can store a single copy of you image in an image list or Timage and then point all you buttons at it.

There are also methods of getting you application to draw normal buttons as shapes, if you do a bit of research online you should be able to find out how as I can't remember. I had a set of buttons at my last company which incorporated this method into their properties, although only for set shapes like ellipses, stars etc. The also allowed bitmaps.

I think these buttons may have been part of TurboPower's Orpheus 3 package. Although there is a more remote possiblity they may also have been from the LMD Tools on the Delphi 5 Companion CD.

Good luck and happy button hunting.
Avatar of edey
edey

"So the question is:  Does anyone know of or use a shaped button which doesn't eat GDI? Can such a beast
exist or is this type of component bound to do this?"

Hmmm, the trouble, I think, is that each an every one of those buttons is a window with a handle & all the goodies.  I'd sugest looking for, or writing, a button that descends from TGraphic instead.

GL
Mike
hello jellison, did you try the image button component I made "LookButton" ? It is a decendent of TGraphicControl , , , Anytime to have more than 50 Image buttons you will use GDI resources. . . you may try using smaller buttons (smaller bitmaps), or 256 color bitmaps if you are using 24bit bitmaps (or even 16 color bitmaps) . . . you can't expect the resource use to be like non-image buttons, . Maybe for many buttons that will not be used very much you could create a Hidden Panel with those buttons as normal buttons and only show the Panel when those buttons are needed. Creating a Menu might eliminate many of those buttons, more than 50 buttons seems like it would be visually hard to use anyway.
You can draw 10000 buttons with almost no resources by using a descendent of TGraphicControl in combination with storing the images in an one imageList instead of in single bitmaps. It doesn't matter, which color depth the bitmaps have, for win9x resources only the mere number of used handles counts. So use a TGraphicControl, this consumes no handle at all, and one imagelist for all the images (of the same size), that costs 2 handles, which is 0,001% or something like that.

Regards, Madshi.
I wondered about your resource sucking lota image buttons app and what might be done about it, , , , so I took Madshi's advice and took some code from my LookButton component and made a TImgListButton component. It does not create any intenal bitmaps, regions or windows, it only uses an Image List created in your app which can be shared by as many buttons as you want. So it should not use alot more GDI resources at all. Let me know if you want to see the code.
Sounds like the perfect solution for John.  :-)  Does it support transparent buttons?

Regards, Madshi.
Avatar of jellison

ASKER

Slick812,

I does sound like a perfect solution. I did download and install your LookButton and tested it. It's a very nice component but it is a GDI eater if you use a lot of them.

Yes I would be interested in the code for ImgListbutton. I suspect it might be a popular one on Torry or whatever as well. There doesn't seem to be anything like this - it goes from plain button to very powerful yet complex button. Like Madshi I wonder whether it can have a transparent region to simulate a true shaped region, even if it responds to the entire rectangle.

The more I think about it the better it sounds in that I have groups of buttons which all have identical bitmaps for disabled, up, down etc. Can lots of buttons share an image list? I would guess they can.

I don't have the knowledge (nore the desire at the moment) to write components so I really appreciate your help on this :0)

Regards,    John
Madshi, yes, it will draw the button with the mask in the ImageList (if the ImageList is set to Masked and dsTransparent) so the button may be a shape other than a rectangle. I was surprized how well it seems to work, if you don't mind the transparent areas being mouse sensitive, but he said he didn't need that. Thanks for your suggestion., I'll post the code for it, if you want a look.
I do have my own TSpeedButton like button component, which does all the stuff that is needed without consuming any resources (apart from the one ImageList), but it's quite complicated, burried in a big unit with lots of other stuff, depending on some of my other packages. In other words: Not ready for publishing. So if you Slick's new component would fit your need, it would be very fine for me. A quasi transparent button can be realized by copying the background image of the parent.

Yes, you can use one imagelist for all your buttons (in case all the images have the same size, of course).

Regards, Madshi.
Hi Slick812, yes, you're right. Simply painting the ImageList picture in transparent mode should work. But what if you e.g. change the imageList index? You need to repaint your button. How do you do that with transparency? If you again only paint your image, you would overlap the old and the new image. So the background needs to be repainted, too.
Probably you can do that by invalidating the parent TWinControl, but I'm not sure, if I remember right that produces flickering. That's quite bad, my own buttons change their picture if the mouse goes in and out and I hate flickering. So I'm copying the background image, preparing everything in memory and just painting the new picture. This way I have no flickering at all...
Madshi, yes, it will draw the button with the mask in the ImageList (if the ImageList is set to Masked and dsTransparent) so the button may be a shape other than a rectangle. I was surprized how well it seems to work, if you don't mind the transparent areas being mouse sensitive, but he said he didn't need that. Thanks for your suggestion., I'll post the code for it, if you want a look.
This ilPicButton Component uses an ImageList that is in your app, I haven't had time to see what the GDI resources use for this button might be, so let me know if you test that.  This is not a "final" version, I did NOT try and set this for run time Image List changes like Madshi has mentioned, but you could Hide and then show this if you do make a run time ImageList change.  Here's the code for the component. . . .



unit ilPicButton;

interface

uses
  Windows, Messages, Classes, Graphics, Controls, Imglist;

type
  TOnMouseOver = procedure(Sender:TObject)of Object;
  TOnMouseOut = procedure(Sender:TObject) of Object;

TilPicButton = class(TGraphicControl)
  private
    { Private declarations }
    FOver, FShowDown: Boolean;
    FActiveRect: Trect;
    FImageList: TImageList;
    FOnMouseOver: TOnMouseOver;
    FOnMouseOut: TOnMouseOut;
    procedure SetImageList(Value: TImageList);
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;

  protected
    { Protected declarations }
    procedure Paint; override;
    procedure Click; override;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;

  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    { Published declarations }
    property Caption;
    property Cursor;
    property Font;
    property Height default 28;
    property Width default 54;
    property Enabled;
    property Visible;
    property Left;
    property Top;
    property Name;
    property Tag;
    property Hint;
    property ParentShowHint;
    property ShowHint;
    property ImageList: TImageList read FImageList write setImageList;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnClick;
    property OnMouseOver: TOnMouseOver read FOnMouseOver write FOnMouseOver;
    property OnMouseOut: TOnMouseOut read FOnMouseOut write FOnMouseOut;

  end; // TilPicButton

procedure Register;

implementation

uses SysUtils, Forms;

procedure Register;
  begin
    RegisterComponents('Samples', [TilPicButton]);
  end;

constructor TilPicButton.Create(AOwner: TComponent);
  begin
    inherited Create(AOwner);
    Width := 54;
    Height := 28;
    FOver := False;
    FShowDown := False;
    FImageList := Nil;
    ControlStyle:= ControlStyle - [csSetCaption] - [csOpaque] + [csClickEvents];
  end;

destructor TilPicButton.Destroy;
  begin

  inherited Destroy;
  end;

procedure TilPicButton.SetImageList(Value: TImageList);
begin
if FImageList = Value then Exit;
FImageList := Value;
Invalidate;
end;

procedure TilPicButton.Click;
  begin
  FShowDown := False;
  inherited Click;
  end;

procedure TilPicButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
  begin
  inherited MouseUp(Button, Shift, X, Y);
  FShowDown := False;
  if (Button = mbLeft) then
  Invalidate;
  end;

procedure TilPicButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
  begin
  inherited MouseDown(Button, Shift, X, Y);
  if (Button = mbLeft) then
    begin
    FShowDown := True;
    Invalidate;
    end;
  end;

procedure TilPicButton.MouseMove(Shift: TShiftState; X,Y:Integer);
begin
inherited MouseMove(Shift, X, Y);
end;

procedure TilPicButton.CMMouseLeave(var Message: TMessage);
  begin
  FOver := False;
  if Enabled then
    begin
    if FImageList <> Nil then
    if FImageList.Count > 3 then Invalidate;
    if Assigned(FOnMouseOut) then FOnMouseOut(Self);
    end;
  end;

procedure TilPicButton.CMMouseEnter(var Message: TMessage);
  begin
  FOver := True;
  if Enabled then
  begin
  if FImageList <> Nil then
  if FImageList.Count > 3 then Invalidate;
  if Assigned(FOnMouseOver) then FOnMouseOver(Self);
  end;
  end;

procedure TilPicButton.CMFontChanged(var Message: TMessage);
begin
  Invalidate;
end;
   
procedure TilPicButton.CMTextChanged(var Message: TMessage);
begin
  Invalidate;
end;

procedure TilPicButton.Paint;
  begin
  Canvas.Brush.Style := bsClear;
  FActiveRect := ClientRect;
  if (csDesigning in ComponentState) then
    begin
    with Canvas.Pen do
      begin
      Style := psSolid;
      Color := clGray;
      Mode :=  pmXor;
      end;

    if ((FImageList = nil) or (FImageList.Count = 0)) then
    Canvas.Rectangle(0, 0, Width, Height) else
    FImageList.Draw(Canvas,0,0,0,True);
    if Length(Caption) > 0 then
        begin
        Canvas.Font := Self.Font;
        DrawText(Canvas.Handle,PChar(Caption),-1,FActiveRect,DT_SINGLELINE or DT_VCENTER or DT_CENTER);
        end;
    end else // csDesigning
   
    begin
    if not ((FImageList = nil) or (FImageList.Count = 0)) then
    begin
    if FImageList.Count < 3 then
    FImageList.Draw(Canvas,0,0,0,True) else
    if FImageList.Count = 3 then
      begin
      if not Enabled then
        begin
        FImageList.Draw(Canvas,0,0,2,True);
        end else
        if FOver then
          begin
          if FShowDown then
            FImageList.Draw(Canvas,0,0,1,True) else
            FImageList.Draw(Canvas,0,0,0,True);
          end else
          FImageList.Draw(Canvas,0,0,0,True);
      end else
      if not Enabled then {1}
        begin
        FImageList.Draw(Canvas,0,0,3,True);
        end else
        if FOver then
          begin
          if FShowDown then
            FImageList.Draw(Canvas,0,0,2,True) else
            FImageList.Draw(Canvas,0,0,1,True);
          end else
          FImageList.Draw(Canvas,0,0,0,True);
    end; // not ImageList = nil


  if Length(Caption) > 0 then
    begin
    Canvas.Font := Self.Font;
    if not Enabled then Canvas.Font.Color := clSilver;
    if FShowDown and FOver then FActiveRect := Rect(2,2,Width+2,Height+2);
    DrawText(Canvas.Handle,PChar(Caption),-1,FActiveRect,DT_SINGLELINE or DT_VCENTER or DT_CENTER);
    end;
  end;
  end;

end.


 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

this takes 2 kinds of ImageLists, one with 3 images and one with 4 images, if there are No images (or no ImageList) then nothing is drawn at run time except the caption. If the ImageList has 1 or 2 images, then only the 0 index image is drawn. If the ImageList has 3 images in it, then the 0 index is the "Normal Picture" and the 1 index is the "Down" and the 2 index is the "Disabled Picture". . . . If the ImageList has 4 or more images then the 0 index is the "Normal", 1 index is the "HighLight", 2 index is the "Down" and the 3 index is the "Disabled". You will need to make settings in the ImageList Object Insector if you want the buttons to be drawn transparent - leave the BackColor and Blend color as clNone set the Drawing Style to dsTransparent and the width and height to the size of your Images and Button (set the ilPicButton width and height to the image size also). After you set the width and Height, Double click the ImageList1 to get the ImageList Image Editor and load your bitmaps in the 0, 1, 2 ect. indexes, you can set the transparent color here also. This automaticly generates the "MasK" bitmaps. If you want to use custom Masks then the code I used to load them is in the Form1.FormCreate like this


  MaskBmp := TBitmap.Create;
  MaskBmp.LoadFromFile('E:\Borland\butA mask.bmp');
  TempBmp := TBitmap.Create;
  TempBmp.LoadFromFile('E:\Borland\butA.bmp');
  ImageList1.Add(TempBmp,MaskBmp);
  TempBmp.LoadFromFile('E:\Borland\butA hi.bmp');
  ImageList1.Add(TempBmp,MaskBmp);
  TempBmp.LoadFromFile('E:\Borland\butA down.bmp');
  ImageList1.Add(TempBmp,MaskBmp);
  TempBmp.LoadFromFile('E:\Borland\butA grey.bmp');
  ImageList1.Add(TempBmp,MaskBmp);
  FreeAndNil(TempBmp);
  FreeAndNil(MaskBmp);
  ilPicButtton1.ImageList := ImageList1;


this button will work even if the width and height are not the same as the ImageList it uses. I haven't had time to really test it out but it works even if you place the button on a TImage. You may want to experiment with the ImageList settings for certain effects, hope you can use it
Hmmmmm... But this way you can't really save many handles! I mean, let's say you have 10 buttons. With your component (as it is now) you can either connect all 10 buttons with the same imageList - in that case all buttons have the same bitmaps, that's not what we want. Or we can set up one imageList for each button - that consumes lots of resources again...
You should allow the indexes of the imageList to be set manually. E.g. let one button begin with index 0, the other with index 4 and so on. Or even better, publish some new properties like "NormalIndex", "DownIndex", "HighlightIndex" and "DisabledIndex". Then your component is as flexible as it can be. In that case you can connect all buttons with only one imageList and at the same time all buttons can have totally different images.
Another option might be to have each button just store it's pixel data then call stretchDIBits to draw them to the parent's canvas without needing to create/store a bitmap for the button.

GL
Mike
This is the latest version of ImgListBut, an ImageList Picture Button. This one is more Resource friendly (thanks for the hint Madshi, but I was already headed in that direction) and uses various Images in a TImageList which you set by assigning Index numbers to the Normal, Hilight, Down and Disabled Images. This allows a single TImageList to contain Images for many different buttons. I have added an Auto Generated HighLight Image. This allows you to draw all 4 button states (normal, hilight, down, and disabled) from only ONE normal image in the ImageList. And for those who are not graphicly challenged, you can create buttons using 1, 2, 3, or 4 images to show your button image masterpieces.
You need to have a TImageList in your app which you set in the ImageList property of this button. . . I tried to get some form of pallete recogition for the old time 256 color display, but all the TImageList pixelFormat are pfDevice and are the color depth of your display when you add your images . So if you want any RealizePalette you will have to do it yourself or use a TImage. (256 color may no longer be a concern anyway) . . . This ImgListBut seemed to work well if you set your Form's DoubleBuffered := True to elimiate a slight flicker the first time a new image Index is displayed.
See "Using ImgListBut" below the code for more instructions.



unit ImgListBut;

interface

uses
  Windows, Messages, Classes, Controls, Imglist;

type
TBrighten = (ba15, ba20, ba25, ba30, ba35, ba40);
  {TBrighten is the amount added to the Red, Green and Blue during the
  Scanline to create a Lighter than normal HightLight Bitmap which is
  added to the ImageList, ba25 or ba30 is good for most and ba40 is for
  darker nornal images and ba15 for lighter ones. This is ignored except
  for CreateHi}
TImgListBut = class(TGraphicControl)
  private
    { Private declarations }
    FOver, FDown, FAuto, FCreate: Boolean;
    FNormIndex, FHiIndex, FDownIndex, FDisIndex: Integer;
    FImageList: TImageList;
    FBrightAmt: TBrighten;
    FChangeLink: TChangeLink;
    FOnMouseOver: TNotifyEvent;
    FOnMouseOut: TNotifyEvent;
    procedure SetImageList(Value: TImageList);
    procedure SetNorm(Value: Integer);
    procedure ImgListChange(Sender: TObject);
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;

  protected
    { Protected declarations }
    procedure Paint; override;
    procedure Click; override;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure Loaded; override;

  public
    { Public declarations }
    ShowDown: Boolean;
    procedure CreateHi;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    { Published declarations }
    property BrightAmount: TBrighten read FBrightAmt write FBrightAmt default ba20;
 {BrightAmount sets the Auto Generated HiLight Pic's increase in Brightness,
  it is ONLY used if CreateHi := True}
    property ImageList: TImageList read FImageList write setImageList;
 {All the images used for this button come from the images in the
   ImageList that is created outside of this component}
    property Caption;
    property Cursor;
    property Font;
    property Height default 28;
    property Width default 54;
    property Enabled;
    property Visible;
    property Left;
    property Top;
    property Name;
    property Tag;
    property Hint;
    property ParentShowHint;
    property ShowHint;
 {the 4 Index values set which ImageList Image is used for a Button State, the IndexHilite
   is also used in the AutoImage Draw}
    property IndexNorm: Integer read FNormIndex write SetNorm default -1;
    property IndexHilite: Integer read FHiIndex write FHiIndex default -1;
    property IndexDown: Integer read FDownIndex write FDownIndex default -1;
    property IndexDisable: Integer read FDisIndex write FDisIndex default -1;
    property AutoImage: Boolean read FAuto write FAuto default False;
 {AutoImage := True tells this to draw all 4 button states from 2 Images, Normal and Hilite}
    property CreateHi: Boolean read FCreate write FCreate default False;
 {CreateHi := True will generate a Hilite Image from the Normal Image with scanline using
  the BrightAmount to increase Red, Green and Blue. Then adds Hilite Image to the FImageList
  and sets the IndexHilight to the new image index}
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnClick;
    property OnMouseOver: TNotifyEvent read FOnMouseOver write FOnMouseOver;
    property OnMouseOut: TNotifyEvent read FOnMouseOut write FOnMouseOut;

  end; // TImgListBut

procedure Register;

implementation

uses SysUtils, Graphics;

procedure Register;
  begin
    RegisterComponents('Samples', [TImgListBut]);
  end;

constructor TImgListBut.Create(AOwner: TComponent);
  begin
    inherited Create(AOwner);
    Width := 54;
    Height := 28;
    FBrightAmt := ba20;
    FOver := False;
    FDown := False;
    FImageList := nil;
    FNormIndex := -1;
    FHiIndex := -1;
    FDownIndex := -1;
    FDisIndex := -1;
    FAuto := False;
    FCreate := False;
    ShowDown := False;
    if (csDesigning in ComponentState) then
    FChangeLink := TChangeLink.Create else
    FChangeLink := nil;
    ControlStyle:= ControlStyle - [csSetCaption] - [csOpaque] + [csClickEvents];
  end;

destructor TImgListBut.Destroy;
  begin
  if (FChangeLink <> nil) and (FImageList <> nil) then
  FImageList.UnRegisterChanges(FChangeLink);
  FreeAndNil(FChangeLink);
  inherited Destroy;
  end;

procedure TImgListBut.Loaded;
begin
inherited Loaded;
if (not (csDesigning in ComponentState)) and FCreate then
CreateHi;
    {a Hilight Bitmap is created and added to the
     ImageList by the CreateHi prcedure, ONLY during
     runtime. If another ImgListBut wants to use this
     new Image then set the 2 IndexHilite to this in Form1Create}
end;

procedure TImgListBut.SetImageList(Value: TImageList);
begin
if FImageList = Value then Exit;
if (FChangeLink <> nil) and (FImageList <> nil) then
  FImageList.UnRegisterChanges(FChangeLink);
FImageList := Value;
if (FImageList <> nil) and (csDesigning in ComponentState) then
    begin
    FImageList.RegisterChanges(FChangeLink);
    FChangeLink.OnChange := ImgListChange;
    end;
Invalidate;
end;

procedure TImgListBut.ImgListChange(Sender: TObject);
begin
Invalidate;
end;

procedure TImgListBut.SetNorm(Value: Integer);
begin
if FNormIndex = Value then Exit;
FNormIndex := Value;
Invalidate;
end;

procedure TImgListBut.CreateHi;
{creates the Auto Generated HiLight Bitmap
and adds it to the ImageList}
TYPE
  pRGBArray = ^TRGBArray;
  TRGBArray = ARRAY[0..16383] OF TRGBTriple;
 {I use TRGBArray because I can more easly understand
   and use the rgbtRed, rgbtGreen and rgbtBlue}

var
y, x, R, G, B, BrtAmt: Integer;
TempBmp1, TempBmp2: TBitmap;
P, P2 : pRGBArray;
begin
if (FImageList = nil) or (FImageList.Count = 0) or (FNormIndex < 0)
  or (FNormIndex >= FImageList.Count) then Exit;
BrtAmt := 20;
case FBrightAmt of
ba15: BrtAmt := 15;
ba20: BrtAmt := 20;
ba25: BrtAmt := 25;
ba30: BrtAmt := 30;
ba35: BrtAmt := 35;
ba40: BrtAmt := 40;
end;
TempBmp1 := TBitmap.Create;
TempBmp2 := TBitmap.Create;
{2 bitmaps are created and freeded, one bitmap
gets the ImageList 0 index Image, and the other
gets Lightened for Hilight effect}
FImageList.GetBitmap(FNormIndex,TempBmp1);
if TempBmp1.Width > 16384 then Exit;
TempBmp1.PixelFormat := pf24bit;
TempBmp2.Assign(TempBmp1);
for y := 0 to TempBmp1.Height -1 do
      begin {scan height}
      P := TempBmp1.ScanLine[y];
      P2 := TempBmp2.ScanLine[y];
      for x := 0 to TempBmp1.Width -1 do
        begin {scan Width}
        with P[x] do
        begin
        R := rgbtRed;
        G := rgbtGreen;
        B := rgbtBlue;
        end;
{increase all the color values by the
BrightAmount}
          Inc(R,BrtAmt);
          if R > 255 then R := 255;
          Inc(G,BrtAmt);
          if G > 255 then G := 255;
          Inc(B,BrtAmt);
          if B > 255 then B := 255;
        with P2[x] do
        begin
        rgbtRed := R;
        rgbtGreen := G;
        rgbtBlue := B;
        end;
        end; {scan width}
      end; {scan height}
FHiIndex := FImageList.Add(TempBmp2,TempBmp1);
FreeAndNil(TempBmp1);
FreeAndNil(TempBmp2);
end;

procedure TImgListBut.Click;
  begin
  FDown := False;
  inherited Click;
  end;

procedure TImgListBut.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
  begin
  inherited MouseDown(Button, Shift, X, Y);
  if (Button = mbLeft) then
    begin
    FDown := True;
{sets the FDown to true to draw the Down Image in Paint}
    Invalidate;
    end;
  end;

procedure TImgListBut.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
  begin
  inherited MouseUp(Button, Shift, X, Y);
  FDown := False;
{sets the FDown to False to not draw the Down Image in Paint}
  if (Button = mbLeft) then
  Invalidate;
  end;

procedure TImgListBut.CMMouseLeave(var Message: TMessage);
  begin
  FOver := False;
  if Enabled then
    begin
    if (FImageList <> Nil) then Invalidate;
    if Assigned(FOnMouseOut) then FOnMouseOut(Self);
    end;
  end;

procedure TImgListBut.CMMouseEnter(var Message: TMessage);
  begin
  FOver := True;
  if Enabled then
  begin
  if (FImageList <> Nil) then Invalidate;
  if Assigned(FOnMouseOver) then FOnMouseOver(Self);
  end;
  end;

procedure TImgListBut.CMFontChanged(var Message: TMessage);
begin
  Invalidate;
end;
   
procedure TImgListBut.CMTextChanged(var Message: TMessage);
begin
  Invalidate;
end;

procedure TImgListBut.Paint;
var
OldBlendCl: TColor;
OldDrawStyle: TDrawingStyle;
Drawn: Boolean;
FActiveRect: Trect;

  begin
  Drawn := False;
  Canvas.Brush.Style := bsClear;
  FActiveRect := ClientRect;
  if (csDesigning in ComponentState) then
    begin // csDesigning
    if (FImageList = nil) or (FImageList.Count = 0) or (FNormIndex < 0)
      or (FNormIndex >= FImageList.Count) then
      begin
{some visible indication is needed at design time for this
if there are no images, so a Xor rectangle is drawn}
      with Canvas.Pen do
        begin
        Style := psSolid;
        Color := clGray;
        Mode :=  pmXor;
        end;
      Canvas.Rectangle(0, 0, Width, Height)
      end else
      FImageList.Draw(Canvas,0,0,FNormIndex);
    if Length(Caption) > 0 then
        begin
        Canvas.Font := Self.Font;
        DrawText(Canvas.Handle,PChar(Caption),-1,FActiveRect,DT_SINGLELINE or DT_VCENTER or DT_CENTER);
        end;
    end else // csDesigning
    begin
    if not ((FImageList = nil) or (FImageList.Count = 0))  then
    begin // not ImageList = nil
    if FAuto then
    begin // FAuto
{AutoImage uses a different paint because the Down and Disabled Images are Fake}
    if (FHiIndex > -1)  and (FHiIndex < FImageList.Count) then
      begin // FHiIndex
      if not Enabled then
        begin
        OldBlendCl := FImageList.BlendColor;
        FImageList.BlendColor := clGray;
        OldDrawStyle := FImageList.DrawingStyle;
        FImageList.DrawingStyle := dsSelected;
        FImageList.Draw(Canvas,0,0,FNormIndex);
        FImageList.BlendColor := OldBlendCl;
        FImageList.DrawingStyle := OldDrawStyle;
        end else
        if FOver then
          begin
          if FDown then
            begin
            FImageList.Draw(Canvas,2,2,FHiIndex);
            end else
            begin
            FImageList.Draw(Canvas,0,0,FHiIndex);
            end;
          end else
          FImageList.Draw(Canvas,0,0,FNormIndex);
      end else // FHiIndex
      FImageList.Draw(Canvas,0,0,FNormIndex);
    end else // FAuto
    begin
{it does not matter if the Indexs are set or not, each paint will look for the
button state and see if an Image is availible for that state}
      if (FDisIndex > -1) and (FDisIndex < FImageList.Count) then
        if not Enabled then
          begin
          FImageList.Draw(Canvas,0,0,FDisIndex);
          Drawn := True;
          end;

       if (not Drawn) and (FDownIndex > -1) and (FDownIndex < FImageList.Count) then
         if FDown or ShowDown then
           begin
           FImageList.Draw(Canvas,0,0,FDownIndex);
           Drawn := True;
           end;

       if (not Drawn) and (FHiIndex > -1) and (FHiIndex < FImageList.Count) then
         if FOver then
           begin
           FImageList.Draw(Canvas,0,0,FHiIndex);
           Drawn := True;;
           end;

       if not Drawn then
       FImageList.Draw(Canvas,0,0,FNormIndex);

  end; // else FAuto

    end; // not ImageList = nil


  if Length(Caption) > 0 then
    begin
    Canvas.Font := Self.Font;
    if not Enabled then Canvas.Font.Color := clSilver;
    if FDown and FOver then FActiveRect := Rect(2,2,Width+2,Height+2);
    DrawText(Canvas.Handle,PChar(Caption),-1,FActiveRect,DT_SINGLELINE or DT_VCENTER or DT_CENTER);
    end;
  end;
  end;

end.



 - -  -  -  -  -  -  -  -  -  -  -  -  -  -  -- - - -  -

Using ImgListBut
You should probaly should start with a TImageList (on the Win32 tab). Set the DrawingStyle to dsTransparent and Masked to true. Set the Width and Height of the TImageList to the largest dimentions of the images you plan to add. When adding your images, the Options will default to "Center" for smaller images, but you HAVE to change it to "Crop" so the image will be drawn at 0, 0 . Also your added images should have the bottom left pixel in the color you want transparent (I could NOT get the TImageList clickOn transparent color to work AT ALL, except to eliminate ALL transparency). . . Now add a TImgListBut to your form and add this line to the form's OnCreate event - DoubleBuffered := True; - . Now set the ImgListBut1 ImageList property
to ImageList1 (imagelist with your buttons images in it). Set the IndexNorm to the ImageList Index of your button Image,  0  in this case. A partial Image should now bee seen in your button now set the Width and Height to your Image width and height. Now set the other IndexXXX properties to the ImageList index of that button state image. You can have No IndexXXX settings (any negative number means no Image drawn for that button state) or any of them or all of the IndexXXX values (range values outside of your ImageList index values will draw nothing and NOT create an exception, so IndexHilight := 100000000  with a 4 image ImageList will not draw anything and continue to function). Your button Images should be drawn in a NON rectangular "transparent" shape if you
have the proper TImageList settings. . . Now the CreateHi and AutoImage properties, the AutoImage := True will draw all 4 button states from 2 Images IndexNorm and IndexHilite. Bitmaps ARE NOT created for this, just adjustments to the ImageList Draw procedure for thw Down Image and the Disabled Image. The CreateHi property is set to True if you want this component to add an Image to the ImageList that is a copy of the IndexNorm image that has been made Lighter by the BrightAmount setting. Bitmaps are created and Freed for this process but it shouldn't add to GDI resource comsumtion. Once the Hilite Image is added to the ImageList the IndexHilite is changed to the new index number. If you want other ImgListBut to use the created Hilight add line to your Form1Create event, like this
-  ImgListBut4.IndexHilite := ImgListBut3.IndexHilite;  - ImgListBut4 should have IndexNorm the same as ImgListBut3, with AutoImage set to True, but unlike ImgListBut3 which has the CreateHi := True , ImgListBut4 has CreateHi := False . . . If AutoImage is true then the IndexDown and IndexDisabled are Ignored.

tired of typing - - - - You should ask questions, let me know,  Wes
Wes,

I'm not surprised you are tired of typing!  Thanks for all your time on this. Something screwy is happening to EE again - I wasn't able to see it for a lot of last week and I didn't get an email to tell me of your last posting so I am a bit late replying.

I will install this latest code and do some experimenting - I will get back to you.

Regards,  John.
Ok,

Well...  One thing I should have said from the start was that I still haven't had the b?!??s to upgrade my Delphi from V3.  I know I should but so far V3 has done me well and I have a lot of apps which I suspect may take some time to upgrade. I have ordered V6 though and I am awaiting delivery.
In the meantime - I got your original code to compile by tweaking a few things and removing the reference to the Imglist unit - I am 99% sure that's a V3 issue. That component looks ok as far as I have tested it and doesn't eat resource. With 50 odd buttons the resouces don't change at all.
Your Imglistbut component seems a bit more complex (you have obviously spent a lot of time on it) and that has various issues that V3 just can't deal with - overloading,  unknown functions (FreeandNil?) etc.
I will bite the bullet when V6 arrives and let you know how it goes.

Regards,  John
yea, I had to wait for almost a week before I could get to EE, and I didn't get an email about your post either  . . . .. you can change FreeAndNil(TempBmp) to TempBmp.Free
I'm not sure which fuctions are overloaded, but they could probaly be changed to work, I had to have the ImgList in D5 , , , That last version seems to work well, except for some ImageList issues (setting the transparent color) which were not in the component , I have wondered why you might need so many buttons?  good luck with D6
Still no email but I will just keep checking. If it's the same as last time they will all come in a bunch in a few days.
I will see if I can mod the Imglistbut to compile in D3.  D6 has just arrived but I suspect it's going to take a while to convert my apps and other components.
Why do I need so many buttons?  The app talks to a video capture device with up to 64 cameras on it and displays images. There are 16 camera select buttons, and others for image resolution, camera movement (pan tilt etc) and a few more.
I am going to keep the question open for a little while longer while I experiment. I will give you the points soon!
I have told you about the FreeAndNil, you may can change the lines with
FImageList.Draw(Canvas,0,0,FNormIndex);

to

FImageList.Draw(Canvas,0,0,WhateverIndex,True);

Yea, changeing to another Delphi version is a job, but it gives you a chance to "Clean House"

Let me know of any failures in the ImgListBut
Got it to compile. Changed the overloaded function names and FreeandNil() to Object.Free.
Works well when the buttons are on the form canvas and the forms FDoubleBuffered property is True (as you suggested). On top of panels containing images though (eg on a keyboard panel with a nice background texture) the buttons are flickering. I will have a go at changing the paint method to create a temp image and then just copy that (which I think is how you stop flickering?). If you have any ideas in the meantime....

I think we are very nearly there. I would suggest this component is probably worth posting on Torry etc when it's finished. I have never found anything else like it.

Regards,  John
ASKER CERTIFIED SOLUTION
Avatar of Member_2_248744
Member_2_248744
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Wes,

I have tweaked things a bit in the component to reduce the flicker and I am now using it for real in my app. The main thing I did was remove the "onmouseover" repaint - I don't use that and it made it much smoother.

I may play about with it a bit more to increase my component writing knowledge.

I still think it's worth doing a small document file to go with it and submitting it to Torry etc.

Thanks for all your time.

Regards,  John.