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
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
"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
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.
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.
Regards, Madshi.
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
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.
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...
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)o f 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('Sample s', [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(Butto n: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
FShowDown := False;
if (Button = mbLeft) then
Invalidate;
end;
procedure TilPicButton.MouseDown(But ton: 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(Shi ft: 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,PCh ar(Caption ),-1,FActi veRect,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,PCh ar(Caption ),-1,FActi veRect,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:\B orland\but A mask.bmp');
TempBmp := TBitmap.Create;
TempBmp.LoadFromFile('E:\B orland\but A.bmp');
ImageList1.Add(TempBmp,Mas kBmp);
TempBmp.LoadFromFile('E:\B orland\but A hi.bmp');
ImageList1.Add(TempBmp,Mas kBmp);
TempBmp.LoadFromFile('E:\B orland\but A down.bmp');
ImageList1.Add(TempBmp,Mas kBmp);
TempBmp.LoadFromFile('E:\B orland\but A grey.bmp');
ImageList1.Add(TempBmp,Mas kBmp);
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
unit ilPicButton;
interface
uses
Windows, Messages, Classes, Graphics, Controls, Imglist;
type
TOnMouseOver = procedure(Sender:TObject)o
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('Sample
end;
constructor TilPicButton.Create(AOwner
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(
begin
if FImageList = Value then Exit;
FImageList := Value;
Invalidate;
end;
procedure TilPicButton.Click;
begin
FShowDown := False;
inherited Click;
end;
procedure TilPicButton.MouseUp(Butto
X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
FShowDown := False;
if (Button = mbLeft) then
Invalidate;
end;
procedure TilPicButton.MouseDown(But
X, Y: Integer);
begin
inherited MouseDown(Button, Shift, X, Y);
if (Button = mbLeft) then
begin
FShowDown := True;
Invalidate;
end;
end;
procedure TilPicButton.MouseMove(Shi
begin
inherited MouseMove(Shift, X, Y);
end;
procedure TilPicButton.CMMouseLeave(
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(
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
begin
Invalidate;
end;
procedure TilPicButton.CMTextChanged
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
if Length(Caption) > 0 then
begin
Canvas.Font := Self.Font;
DrawText(Canvas.Handle,PCh
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
if FImageList.Count = 3 then
begin
if not Enabled then
begin
FImageList.Draw(Canvas,0,0
end else
if FOver then
begin
if FShowDown then
FImageList.Draw(Canvas,0,0
FImageList.Draw(Canvas,0,0
end else
FImageList.Draw(Canvas,0,0
end else
if not Enabled then {1}
begin
FImageList.Draw(Canvas,0,0
end else
if FOver then
begin
if FShowDown then
FImageList.Draw(Canvas,0,0
FImageList.Draw(Canvas,0,0
end else
FImageList.Draw(Canvas,0,0
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,PCh
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:\B
TempBmp := TBitmap.Create;
TempBmp.LoadFromFile('E:\B
ImageList1.Add(TempBmp,Mas
TempBmp.LoadFromFile('E:\B
ImageList1.Add(TempBmp,Mas
TempBmp.LoadFromFile('E:\B
ImageList1.Add(TempBmp,Mas
TempBmp.LoadFromFile('E:\B
ImageList1.Add(TempBmp,Mas
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.
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
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('Sample s', [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.UnRegisterChang es(FChange Link);
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(V alue: TImageList);
begin
if FImageList = Value then Exit;
if (FChangeLink <> nil) and (FImageList <> nil) then
FImageList.UnRegisterChang es(FChange Link);
FImageList := Value;
if (FImageList <> nil) and (csDesigning in ComponentState) then
begin
FImageList.RegisterChanges (FChangeLi nk);
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(FNorm Index,Temp Bmp1);
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,Te mpBmp1);
FreeAndNil(TempBmp1);
FreeAndNil(TempBmp2);
end;
procedure TImgListBut.Click;
begin
FDown := False;
inherited Click;
end;
procedure TImgListBut.MouseDown(Butt on: 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(v ar 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(v ar 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 ,FNormInde x);
if Length(Caption) > 0 then
begin
Canvas.Font := Self.Font;
DrawText(Canvas.Handle,PCh ar(Caption ),-1,FActi veRect,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 ,FNormInde x);
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 ,FNormInde x);
end else // FHiIndex
FImageList.Draw(Canvas,0,0 ,FNormInde x);
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 ,FDownInde x);
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 ,FNormInde x);
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,PCh ar(Caption ),-1,FActi veRect,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
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('Sample
end;
constructor TImgListBut.Create(AOwner:
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.UnRegisterChang
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(V
begin
if FImageList = Value then Exit;
if (FChangeLink <> nil) and (FImageList <> nil) then
FImageList.UnRegisterChang
FImageList := Value;
if (FImageList <> nil) and (csDesigning in ComponentState) then
begin
FImageList.RegisterChanges
FChangeLink.OnChange := ImgListChange;
end;
Invalidate;
end;
procedure TImgListBut.ImgListChange(
begin
Invalidate;
end;
procedure TImgListBut.SetNorm(Value:
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(FNorm
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,Te
FreeAndNil(TempBmp1);
FreeAndNil(TempBmp2);
end;
procedure TImgListBut.Click;
begin
FDown := False;
inherited Click;
end;
procedure TImgListBut.MouseDown(Butt
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
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(v
begin
FOver := False;
if Enabled then
begin
if (FImageList <> Nil) then Invalidate;
if Assigned(FOnMouseOut) then FOnMouseOut(Self);
end;
end;
procedure TImgListBut.CMMouseEnter(v
begin
FOver := True;
if Enabled then
begin
if (FImageList <> Nil) then Invalidate;
if Assigned(FOnMouseOver) then FOnMouseOver(Self);
end;
end;
procedure TImgListBut.CMFontChanged(
begin
Invalidate;
end;
procedure TImgListBut.CMTextChanged(
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
if Length(Caption) > 0 then
begin
Canvas.Font := Self.Font;
DrawText(Canvas.Handle,PCh
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
FImageList.BlendColor := OldBlendCl;
FImageList.DrawingStyle := OldDrawStyle;
end else
if FOver then
begin
if FDown then
begin
FImageList.Draw(Canvas,2,2
end else
begin
FImageList.Draw(Canvas,0,0
end;
end else
FImageList.Draw(Canvas,0,0
end else // FHiIndex
FImageList.Draw(Canvas,0,0
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
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
Drawn := True;
end;
if (not Drawn) and (FHiIndex > -1) and (FHiIndex < FImageList.Count) then
if FOver then
begin
FImageList.Draw(Canvas,0,0
Drawn := True;;
end;
if not Drawn then
FImageList.Draw(Canvas,0,0
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,PCh
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
ASKER
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.
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.
ASKER
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
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
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
ASKER
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 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 ,FNormInde x);
to
FImageList.Draw(Canvas,0,0 ,WhateverI ndex,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
FImageList.Draw(Canvas,0,0
to
FImageList.Draw(Canvas,0,0
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
ASKER
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
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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.
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.
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.