Solved

qom #1: Speedbutton Component

Posted on 2002-06-02
69
641 Views
Last Modified: 2010-04-04
hi,

as ex-ex has changed the minimum point assignment to 50 points, it is nevermore comfortable for me to post 25 points qows (even i would more like it to do qows than qom.

qom -> question of the month

qom is a more difficult quest with following rules
- the first working solution gets this 100 pts
- each different working solution gets 50 pts in a seperate q
- top 15 experts are not allowed to participate in this quest, but they may post suggestions/hints
- top 15 experts may post a solution after the q is graded
- sponsoring, each one can sponsor this quest, by supplying the seperate q's for differnet solutions rather than me
- sponsors cannot participate on this quest
- a qom is one week open (on demand also longer)
- a qom starts on the first monday of a new month

well, the question now (is based on a paq from mine)

i need a speedbutton-component,
where i can link a same instance on it

a sample

let say i have 4 such buttons dropped on a form
if i press the third
-button1 going down and fires its onclick event
-button2 going down and fires its onclick event
-button3 going down and fires its onclick event

if i press the second
-button1 going down and fires its onclick event
-button2 going down and fires its onclick event

if i press the fourth
-button1 going down and fires its onclick event
-button2 going down and fires its onclick event
-button3 going down and fires its onclick event
-button4 going down and fires its onclick event


the logic should be implemented in the speedbutton-
component by properties

hope thats clear enough,
just ask if not

have fun

meikl ;-)
0
Comment
Question by:kretzschmar
  • 27
  • 27
  • 5
  • +3
69 Comments
 
LVL 17

Expert Comment

by:geobul
Comment Utility
Hi meikl,
Something like (tested with run-time creation only):
-----
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure lbClick1(Sender: TObject);
    procedure lbClick2(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TMySpeedButton = class(TSpeedButton)
  private
    FLinkedButton: TMySpeedButton;
    procedure SetLinkedButton(Value: TMySpeedButton);
    function GetLinkedButton: TMySpeedButton;
  public
    procedure Click; override;
  published
    property LinkedButton: TMySpeedButton read GetLinkedButton write SetLinkedButton default nil;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

// TMySpeedButton

procedure TMySpeedButton.Click;
var
  LinkedButton: TMySpeedButton;
begin
  LinkedButton := GetLinkedButton;
  if LinkedButton <> nil then LinkedButton.Click;
  inherited Click;
end;

procedure TMySpeedButton.SetLinkedButton(Value: TMySpeedButton);
begin
  FLinkedButton := Value;
end;

function TMySpeedButton.GetLinkedButton: TMySpeedButton;
begin
  result := FLinkedButton;
end;

// end of TMySpeedButton

procedure TForm1.lbClick1(Sender: TObject);
begin
  ShowMessage('Button 1');
end;

procedure TForm1.lbClick2(Sender: TObject);
begin
  ShowMessage('Button 2');
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  lb1,lb2: TMySpeedButton;
begin
  // create two buttons
  lb1 := TMySpeedButton.Create(Form1);
  with lb1 do begin
    Parent := Form1;
    Left := 50;
    Top := 20;
    OnClick := lbClick1;
  end;
  lb2 := TMySpeedButton.Create(Form1);
  with lb2 do begin
    Parent := Form1;
    Left := 100;
    Top := 20;
    OnClick := lbClick2;
    LinkedButton := lb1; // First button lb1 is linked to the second one
  end;
end;

end.
-----
Regards, Geo
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
geo, mostly the first ;-)
looks good, testing this evening :-))

well others, come on

meikl ;-)
0
 
LVL 11

Expert Comment

by:robert_marquardt
Comment Utility
That was about my implementation already.
I would use the new property here:

procedure TMySpeedButton.Click;
begin
 if Assigned(LinkedButton) then
   LinkedButton.Click;
 inherited Click;
end;

Always use the properties as much as possible
in the implementation. It makes changes much easier.
0
 
LVL 17

Expert Comment

by:geobul
Comment Utility
Good point, Robert. It should be done that way, of course. GetLinkedButton function becomes obsolete then.

Regards, Geo
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
no one more?

maybe an additional feature?
like
a speedbutton (if it is in flatstyle)
raises a bevel if the mouse enters

now, what about, if i want this for all linked buttons?
(well thats no content of this q)

meikl ;-)
0
 
LVL 11

Expert Comment

by:robert_marquardt
Comment Utility
I have explored CM_MOUSEENTER/CM_MOUSELEAVE already.
The qom is too simple even with that.
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
at least you should show a sample, robert ;-)

too simple->every start should be simple
(i'm open for suggestions)

meikl ;-)
0
 
LVL 11

Expert Comment

by:robert_marquardt
Comment Utility
Here is a complete small component. It is not perfect (Picture, PicUp, PicDown are not really clean yet).
The CMHitTest ist the main trick.

unit MouseImage;

interface

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

type
  TOnMouseEvent = procedure(Msg: TWMMouse) of object;

  TMouseImage = class(TImage)
  private
    FOnMouseEnter: TOnMouseEvent;
    FOnMouseLeave: TOnMouseEvent;
    FPicDown: TPicture;
    FPicUp: TPicture;
    FDown: Boolean;
    FEntered: Boolean;
    procedure SetPicDown(Value: TPicture);
    procedure SetPicUp(Value: TPicture);
    procedure SetDown(Value: Boolean);
    procedure SetEntered(Value: Boolean);
  protected
    procedure Loaded; override;
    procedure WMMouseEnter(var Msg: TWMMouse); message CM_MOUSEENTER;
    procedure WMMouseLeave(var Msg: TWMMouse); message CM_MOUSELEAVE;
    procedure CMHitTest(var Msg: TWMMouse); message CM_HITTEST;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Down: Boolean read FDown write SetDown;
    property Entered: Boolean read FEntered write SetEntered;
    property PicDown: TPicture read FPicDown write SetPicDown;
    property PicUp: TPicture read FPicUp write SetPicUp;
    property OnMouseEnter: TOnMouseEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TOnMouseEvent read FOnMouseLeave write FOnMouseLeave;
  end;

procedure Register;

implementation

{$R *.RES}

(*******************************************************************************)

procedure Register;
begin
  RegisterComponents('3rdParty', [TMouseImage]);
end;

(*******************************************************************************)

constructor TMouseImage.Create;
begin
  inherited;
  FPicDown := TPicture.Create;
  FPicUp   := TPicture.Create;
  FDown    := False;
  FEntered := False;
end;

(*******************************************************************************)

destructor TMouseImage.Destroy;
begin
  FreeAndNil(FPicDown);
  FreeAndNil(FPicUp);
  inherited;
end;

(*******************************************************************************)

procedure TMouseImage.Loaded;
begin
  Picture.Assign(PicUp);
end;

(*******************************************************************************)

procedure TMouseImage.WMMouseEnter(var Msg: TWMMouse);
var
 P: TControl;
begin
  inherited;
  P := Self;
  repeat
    P := P.Parent;
  until (P = nil) or (P is TForm);
  if (P = nil) or TForm(P).Active then
  begin
    Entered := True;
    if Assigned(FOnMouseEnter) then
      FOnMouseEnter(Msg);
  end;
end;

(*******************************************************************************)

procedure TMouseImage.WMMouseLeave(var Msg: TWMMouse);
var
 P: TControl;
begin
  inherited;
  P := Self;
  repeat
    P := P.Parent;
  until (P = nil) or (P is TForm);
  if (P = nil) or TForm(P).Active then
  begin
    Entered := False;
    if Assigned(FOnMouseLeave) then
      FOnMouseLeave(Msg);
  end;
end;

(*******************************************************************************)

procedure TMouseImage.CMHitTest(var Msg: TWMMouse);
begin
  inherited;
  if Assigned(PicUp) and Assigned(PicUp.Bitmap) and Transparent and
    (Msg.XPos < PicUp.Bitmap.Width) and (Msg.YPos < PicUp.Bitmap.Height) and
    (PicUp.Bitmap.Canvas.Pixels[Msg.XPos, Msg.YPos] = (Picture.Bitmap.TransparentColor and $FFFFFF)) then
    Msg.Result := 0;
end;

(*******************************************************************************)

procedure TMouseImage.SetPicUp(Value: TPicture);
begin
  FPicUp.Assign(Value);
end;

(*******************************************************************************)

procedure TMouseImage.SetPicDown(Value: TPicture);
begin
  FPicDown.Assign(Value);
end;

(*******************************************************************************)

procedure TMouseImage.SetDown(Value: Boolean);
begin
  FDown   := Value;
  Entered := Value;
end;

(*******************************************************************************)

procedure TMouseImage.SetEntered(Value: Boolean);
begin
  FEntered := Value;
  if Down or Entered then
    Picture.Assign(PicDown)
  else
    Picture.Assign(PicUp);
end;

end.
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
well ok, robert, now going back to the question

we've like four linked speedbuttons (flatstyle)

if i move the mouse over the third button a bevel is raised
now i want simultan that button1 and button2 also raises a bevel, like as the mousecursor are over there and of course if i move away the mouse from button3, the bevel disappears, also for button1 and button2

is it clear enough?
(i spend additional 100 pts,
if you or any other are providing a sample about this)

meikl ;-)
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
too hard, robert (or veryone else)?

:-))
0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
Hello

This is all easy ,its just that I use Borland c++builder(its the closest language to delphi) and would take me  alot of time to convert c++builder code to delphi


0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
well freshman, you are out
->no delphi source sample, no points
:-))

but as all stated it is easy,
it would be nice to see
how it would be implemented
(even with the beveling)

meikl ;-)



0
 
LVL 17

Expert Comment

by:geobul
Comment Utility
Hi,
An additional property LinkedBevel is added. The task could be done without such property simply removing 'and LinkedBevel' from the two mouse message procedures.

Regards, Geo
---
unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   procedure lbClick1(Sender: TObject);
   procedure lbClick2(Sender: TObject);
   procedure lbClick3(Sender: TObject);
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

 TMySpeedButton = class(TSpeedButton)
 private
   FLinkedButton: TMySpeedButton;
   FLinkedBevel: Boolean;
   procedure SetLinkedButton(Value: TMySpeedButton);
 protected
   procedure WMMouseEnter(var Msg: TWMMouse); message CM_MOUSEENTER;
   procedure WMMouseLeave(var Msg: TWMMouse); message CM_MOUSELEAVE;
 public
   procedure Click; override;
 published
   property LinkedButton: TMySpeedButton read FLinkedButton write SetLinkedButton default nil;
   property LinkedBevel: Boolean read FLinkedBevel write FLinkedBevel;
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

// TMySpeedButton

procedure TMySpeedButton.Click;
begin
 if Assigned(LinkedButton) then LinkedButton.Click;
 inherited Click;
end;

procedure TMySpeedButton.SetLinkedButton(Value: TMySpeedButton);
begin
 FLinkedButton := Value;
end;

procedure TMySpeedButton.WMMouseEnter(var Msg: TWMMouse);
begin
  if Assigned(LinkedButton) and LinkedBevel then LinkedButton.WMMouseEnter(Msg);
  inherited;
end;

procedure TMySpeedButton.WMMouseLeave(var Msg: TWMMouse);
begin
  if Assigned(LinkedButton) and LinkedBevel then LinkedButton.WMMouseLeave(Msg);
  inherited;
end;

// end of TMySpeedButton

procedure TForm1.lbClick1(Sender: TObject);
begin
 ShowMessage('Button 1');
end;

procedure TForm1.lbClick2(Sender: TObject);
begin
 ShowMessage('Button 2');
end;

procedure TForm1.lbClick3(Sender: TObject);
begin
 ShowMessage('Button 3');
end;

procedure TForm1.FormCreate(Sender: TObject);
var
 lb1,lb2,lb3: TMySpeedButton;
begin
 // create three buttons
 lb1 := TMySpeedButton.Create(Form1);
 with lb1 do begin
   Parent := Form1;
   Left := 50;
   Top := 20;
   Flat := true;
   Caption := '1';
   OnClick := lbClick1;
   LinkedBevel := true;
 end;
 lb2 := TMySpeedButton.Create(Form1);
 with lb2 do begin
   Parent := Form1;
   Left := 100;
   Top := 20;
   Flat := true;
   Caption := '2';
   OnClick := lbClick2;
   LinkedBevel := true;
   LinkedButton := lb1; // First button lb1 is linked to the second one
 end;
 lb3 := TMySpeedButton.Create(Form1);
 with lb3 do begin
   Parent := Form1;
   Left := 150;
   Top := 20;
   Flat := true;
   Caption := '3';
   OnClick := lbClick3;
   LinkedBevel := true;
   LinkedButton := lb2; // First button lb1 is linked to the second one
 end;
end;

end.
0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
Hello!

the Tspeedbutton component has a Flat property,so if put this property to true and go over with the mouse the bevel will raise



0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
geo, looks good

freshman, reread the question

let say i have for buttons
if i click on the third button, i will have
button1-onclick-event fired
button2-onclick-event fired
button3-onclick-event fired

(initial question)

if i move with the mouse on the third button i will have
button1-bevel raised
button2-bevel raised
button3-bevel raised
(addon question)

well, this should also work,
if i leave the third-button->all bevels should disappear

and this all handled in one component,
derived from tspeedbutton

easy enough?

meikl ;-)
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
let say i have for buttons
should be
let say i have four buttons
0
 
LVL 11

Expert Comment

by:robert_marquardt
Comment Utility
Sometimes i have to work ;-)
0
 
LVL 9

Expert Comment

by:ITugay
Comment Utility
hi all,
hi meikl ;-)

following this QOM....

Good question, good idea about control's behaviour. I have an idea how this component can be used in real application. Something like selector of cumulative parameters settings.

>> - sponsoring, each one can sponsor this quest,
>> by supplying the seperate q's for differnet solutions rather than me

meikl, let me know if you are going to grade additional points for somebody.

-------
Igor

PS: it seems too easy, or you keep underwater rock? :-)


0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
hi igor,
i let you know about sponsoring next week.

about my eMail-account you asked in another q,
its the same as provided in my profile.

to robert,
of course your work is more important
than this q.

meikl ;-)

0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
Hello all!

Here is what I done so far:
bevel raises when you go over with mouse and more..

Here is how its going to work,there will be a property where you type all the speed buttons you want this button to control  

I already making it as a component :-)
0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
oh and I frogot to say the code is in delphi,But I develop with c++builder becuase it can compile c++ and delphi code ,but my main(the one I know best) language is c++ but I know delphi to ;-)
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
thats ok freshman,
don't hurry, you've time until next monday,
or on demand longer

yes, it should be a component,
but written with delphi source,
how you implement the component doesn't matter,
if u use a container or a collection or just
a derivement from tspeedbutton or any other

you are free with this, but at least there should be buttons with the bahaviour on a click-event as described
above (intial q)

and the beveling feature
(addon q, not a must, but gets additional 100 pts, for the first and 50 pts for each different solution)

don't forget to post the source, freshman

to all, good news,
after kpro did not properly work and my question points are not rounded up to 500, the moderator comTech pushed my question-points up to 5000, so that i'm able to grade each solution.

about sponsoring,
during finishing this thread next week,
i will post a list, who becomes how much pts in additional for ... q's. sponsors may pick up one or more from the list
and leave a comment which one was taken.
sponsors will then grade the taken expert(s)
with sponsors own q-points.

so far about sponsoring oragnisation

just a last word,
the component should be stable and recognize
run/designtime freed objects, which may linked to it

hint: notification-method

happy coding

meikl ;-)
0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
Hello!

I'am still working on it :-)
0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
I think I will finish in about 30mins, so ill send you the exe sample to your email when I finish ,so you see how it works
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
well, freshman,
you can send it to me
at my mailadress shown in my profile
(just click on my name)

but you have to post the source
in this thread for getting points,
just because its a knowledge-sharing community
and others than me may also interested on your solution

meikl ;-)
0
 
LVL 4

Expert Comment

by:nestorua
Comment Utility
HI, Meikl,
Here is my code:

unit PSISpeedButton;

{--------------------------------------------------------------------------}
{--------------------------------------------------------------------------}
INTERFACE
{--------------------------------------------------------------------------}
{--------------------------------------------------------------------------}

uses
  Windows, Messages, SysUtils, Classes, Controls, Buttons, Dialogs;

type
  TPSISpeedButton = class(TSpeedButton)
  private
   FSB: TSpeedButton;
    procedure SetSB(const Value: TSpeedButton);
    { Private declarations }
  protected
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    { Protected declarations }
  public
    procedure Click; override;
    function CheckOutTheChain(const Value: TSpeedButton): boolean;
    { Public declarations }
  published
   property SB : TSpeedButton read  FSB
                              write SetSB;
    { Published declarations }
  end;

procedure Register;

{--------------------------------------------------------------------------}
{--------------------------------------------------------------------------}
IMPLEMENTATION
{--------------------------------------------------------------------------}
{--------------------------------------------------------------------------}

{--------------------------------------------------------------------------}
procedure Register;
begin
  RegisterComponents('Samples', [TPSISpeedButton]);
end;
{--------------------------------------------------------------------------}
{ TPSISpeedButton }
{--------------------------------------------------------------------------}
function TPSISpeedButton.CheckOutTheChain(const Value: TSpeedButton): boolean;
var psisb: TSpeedButton;
begin
 Result:=True;
//
 if ((Value=NIL) or not (Value is TPSISpeedButton))
  then EXIT;
//
 psisb:=Value;
//
  while ((psisb<>NIL) and (psisb is TPSISpeedButton)) do
   begin
     if psisb=Self
      then
       begin
         Result:=False;
         BREAK;
       end;
//
    psisb:=TPSISpeedButton(psisb).SB;
   end;
end;
{--------------------------------------------------------------------------}
procedure TPSISpeedButton.Click;
begin
 if FSB<>NIL
  then FSB.Click;
//
  INHERITED Click;
end;
{--------------------------------------------------------------------------}
procedure TPSISpeedButton.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  INHERITED Notification(AComponent, Operation);
//
  if Operation=opRemove then
    if AComponent=FSB then FSB:=NIL;
end;
{--------------------------------------------------------------------------}
procedure TPSISpeedButton.SetSB(const Value: TSpeedButton);
begin
  if CheckOutTheChain(Value)
   then FSB:=Value
   else ShowMessage('You are not allowed to !');
end;
{--------------------------------------------------------------------------}
{--------------------------------------------------------------------------}
END.
0
 
LVL 4

Expert Comment

by:nestorua
Comment Utility
Sincerely,
Nestorua.
0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
I think I will finish in about 30mins, so ill send you the exe sample to your email when I finish ,so you see how it works
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
a long half hour, freshman :-))

well nestorua, checking this weekend

meikl ;-)
0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
Hello!

I have little problems ,maybe i'll finish today
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
no problem, freshman, take your time
0
 
LVL 9

Expert Comment

by:ITugay
Comment Utility
hi meikl,

you'v got  a lot of points :-) Seems now it is possible to continue QOW (Quest Of Week)?

----
Igor.
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
yep,

thought also about of this,
with the same conditions as in this qom (100+50).
(sponsoring may required in this case in some months)

meikl ;-)
0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
Hello!

meikl ,I'am almost finished, i'll finish today or tommorow for sure ;-)
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
Hello!

It's complete and  
Here are things that are done:

1)you can link unlimited number of SpeedButtons together
2)Bevel raises on all buttons when go over with mouse
2)Bevel disappears on all buttons when leave button with mouse
3)OnClick event triggered on all buttons when click on button

meikl, I will send sample exe so you can see :-)
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
well, freshman,
exact what is wanted :-))

now you have only to post your source here
(even if it is written in c, exeptionally)

meikl ;-)
0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
Hello meikl ,did you try the sample?
0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
Hello!

meikl ,as I said before I wrote it in delphi as a component :-)

Ok,I'll post the full source(2 pas files) here so can you paste the code into pas file and install it instantly
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
freshman, missung already your source here ;-)
0
 
LVL 2

Accepted Solution

by:
freshman3k earned 150 total points
Comment Utility
Hello!

unit1.pas is the main(the component) file and the unit2.pas is what unit1.pas uses.

just copy and paste the code into pas files.

Here is the source:

*********************************************************
---------------------------------------------------------
-----------------------unit1.pas-------------------------
---------------------------------------------------------
*********************************************************

unit unit1;


{$STACKCHECKS OFF}
{$STACKFRAMES OFF}
{$RANGECHECKS OFF}

interface

uses Windows, Messages, Classes, Controls, Graphics, StdCtrls,
  ExtCtrls, unit2,Forms,Menus, CommCtrl, Dialogs;

type
  TSuperSpeedBtn = class(TGraphicControl)
  private
    df: TShiftState;
    sw: integer;
    sw2: integer;
    SendDataYN: Integer;
    FItems: TStrings;
    FGroupIndex: Integer;
    FGlyph: Pointer;
    FDown: Boolean;
    FDragging: Boolean;
    FAllowAllUp: Boolean;
    FLayout: TButtonLayout;
    FSpacing: Integer;
    FTransparent: Boolean;
    FMargin: Integer;
    FFlat: Boolean;
    FMouseInControl: Boolean;
    FMouseInControl2: Boolean;
    procedure GlyphChanged(Sender: TObject);
    procedure UpdateExclusive;
    function GetGlyph: TBitmap;
    procedure SetGlyph(Value: TBitmap);
    function GetNumGlyphs: TNumGlyphs;
    procedure SetNumGlyphs(Value: TNumGlyphs);
    procedure SetDown(Value: Boolean);
    procedure SetFlat(Value: Boolean);
    procedure SetAllowAllUp(Value: Boolean);
    procedure SetGroupIndex(Value: Integer);
    procedure SetLayout(Value: TButtonLayout);
    procedure SetSpacing(Value: Integer);
    procedure SetTransparent(Value: Boolean);
    procedure SetMargin(Value: Integer);
    procedure UpdateTracking;
    procedure WMLButtonDblClk(var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMButtonPressed(var Message: TMessage); message CM_BUTTONPRESSED;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    Procedure WMCopyData( Var msg: TCopyDataStruct); message WM_COPYDATA;
    Procedure SendData(msg: Integer; comp: TControl);
    procedure SetLinkList (aValue : TStrings);
    procedure SendProc(msg : Integer);
    procedure MouseDownProc;
    procedure MouseUpProc(X, Y: Integer);
    procedure MouseMoveProc(X, Y: Integer);
    procedure UpdateTrack;
    procedure MouseUpProc2;
  protected
    FState: TButtonState;

    function GetPalette: HPALETTE; override;
    procedure Loaded; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure Paint; override;
    property MouseInControl: Boolean read FMouseInControl;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Click; override;
  published
    property Action;
    property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
    property Down: Boolean read FDown write SetDown default False;
    property Caption;
    property LinkWith: TStrings read FItems write SetLinkList;
    property Enabled;
    property Flat: Boolean read FFlat write SetFlat default True;
    property Font;
    property Glyph: TBitmap read GetGlyph write SetGlyph;
    property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft;
    property Margin: Integer read FMargin write SetMargin default -1;
    property NumGlyphs: TNumGlyphs read GetNumGlyphs write SetNumGlyphs default 1;
    property ParentFont;
    property ParentShowHint;
    property ParentBiDiMode;
    property PopupMenu;
    property ShowHint;
    property Spacing: Integer read FSpacing write SetSpacing default 4;
    property Transparent: Boolean read FTransparent write SetTransparent default True;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

procedure Register;

implementation
{{$R FlatButtonRes.dcr}

uses Consts, SysUtils;

constructor TSuperSpeedBtn.Create(AOwner: TComponent);
begin

  FGlyph := TButtonGlyph.Create;
  TButtonGlyph(FGlyph).OnChange := GlyphChanged;
  inherited Create(AOwner);
  SetBounds(0, 0, 23, 22);
  ControlStyle := [csCaptureMouse, csDoubleClicks];
  ParentFont := True;
  Color := clBtnFace;
  FSpacing := 4;
  FMargin := -1;
  FLayout := blGlyphLeft;
  FTransparent := True;
  FItems:=TStringList.Create;
  FFlat:=True;
  SendDataYN:=1;
  Inc(ButtonCount);
end;
{----------}
destructor TSuperSpeedBtn.Destroy;
begin
  Dec(ButtonCount);
  inherited Destroy;
  FItems.Free;
  TButtonGlyph(FGlyph).Free;
end;
{----------}
procedure TSuperSpeedBtn.Paint;
const
  DownStyles: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER);
  FillStyles: array[Boolean] of Integer = (BF_MIDDLE, 0);
var
  PaintRect: TRect;
  DrawFlags: Integer;
  Offset: TPoint;
begin
  if not Enabled then
  begin
    FState := bsDisabled;
    FDragging := False;
  end
  else if FState = bsDisabled then
    if FDown and (GroupIndex <> 0) then
      FState := bsExclusive
    else
      FState := bsUp;
  Canvas.Font := Self.Font;
  PaintRect := Rect(0, 0, Width, Height);
  if not FFlat then
  begin
    DrawFlags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
    if FState in [bsDown, bsExclusive] then
      DrawFlags := DrawFlags or DFCS_PUSHED;
    DrawFrameControl(Canvas.Handle, PaintRect, DFC_BUTTON, DrawFlags);
  end
  else
  begin
    if (FState in [bsDown, bsExclusive]) or
      (FMouseInControl and (FState <> bsDisabled)) or
      (csDesigning in ComponentState) then
      DrawEdge(Canvas.Handle, PaintRect, DownStyles[FState in [bsDown, bsExclusive]],
        FillStyles[Transparent] or BF_RECT)
    else if not Transparent then
    begin
      Canvas.Brush.Color := Color;
      Canvas.FillRect(PaintRect);
    end;
    InflateRect(PaintRect, -1, -1);
  end;
  if FState in [bsDown, bsExclusive] then
  begin
    if (FState = bsExclusive) and (not FFlat or not FMouseInControl) then
    begin
      Canvas.Brush.Bitmap := AllocPatternBitmap(clBtnFace, clBtnHighlight);
      Canvas.FillRect(PaintRect);
    end;
    Offset.X := 1;
    Offset.Y := 1;
  end
  else
  begin
    Offset.X := 0;
    Offset.Y := 0;
  end;
  TButtonGlyph(FGlyph).Draw(Canvas, PaintRect, Offset, Caption, FLayout, FMargin,FSpacing, FState, Transparent);
end;
{----------}
procedure TSuperSpeedBtn.UpdateTracking;
var
  P: TPoint;
begin
  if FFlat then
  begin
    if Enabled then
    begin
      GetCursorPos(P);
      FMouseInControl := not (FindDragTarget(P, True) = Self);
      if FMouseInControl then begin
      Perform(CM_MOUSELEAVE, 0, 0);
        end
      else
       Perform(CM_MOUSEENTER, 0, 0);

    end;
  end;
end;
{----------}
procedure TSuperSpeedBtn.UpdateTrack;
var
  P: TPoint;
begin
      GetCursorPos(P);
      FMouseInControl2 := not (FindDragTarget(P, True) = Self);

end;
{----------}
procedure TSuperSpeedBtn.Loaded;
var
  State: TButtonState;
begin
  inherited Loaded;
  if Enabled then
    State := bsUp
  else
    State := bsDisabled;
  TButtonGlyph(FGlyph).CreateButtonGlyph(State);
end;
{----------}
procedure TSuperSpeedBtn.SendProc(msg : Integer);
var
 I: Integer;
 Compon: TControl;
begin
 
    if (SendDataYN = 1) and (FItems.Count <> 0) then begin
       for I := 0 to FItems.Count-1 do begin
         Compon:=TControl(GetParentForm(self).FindComponent(Trim(FItems.Strings[I])));

         if (Compon <> Self) and (Compon is TSuperSpeedBtn) then begin
           SendData(msg,Compon);
           end;
          end;
         end;
       SendDataYN:=1;
end;
{----------}
procedure TSuperSpeedBtn.MouseDownProc;
begin
     if not FDown then begin
      FState := bsDown;
      Invalidate;
      FDragging := True;
      SendProc(1);
      end;
end;
{-----------}
procedure TSuperSpeedBtn.MouseDown(Button: TMouseButton; Shift: TShiftState;X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
 if (Button = mbLeft) and Enabled then begin
    MouseDownProc;
  end;
end;
{----------}
procedure TSuperSpeedBtn.MouseMoveProc(X, Y: Integer);
var
  NewState: TButtonState;
begin
  inherited MouseMove(df, X, Y);

  if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then begin
   SendProc(3);
   end;
 
  if FDragging then begin
    if not FDown then
     NewState := bsUp
    else
     NewState := bsExclusive;
   if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then
      if FDown then
      NewState := bsExclusive
      else
      NewState := bsDown;
    if NewState <> FState then
    begin
      FState := NewState;

     if SendDataYN = 0 then begin
       if sw=1 then begin
         NewState:=bsDown;
         end;
       if sw=2 then begin
         NewState:=bsUp;
         end;
      end;

     Invalidate;

      if NewState=bsDown then begin
        SendProc(6);
        end;
      if NewState=bsUp then begin
        SendProc(7);
        end;
    end;
  end
  else if not FMouseInControl then
    UpdateTracking;
end;
{----------}
procedure TSuperSpeedBtn.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  MouseMoveProc(X,Y);
end;
{----------}
procedure TSuperSpeedBtn.MouseUpProc2;
begin
     UpdateTrack;
   if (SendDataYN=1) then begin
     if not FMouseInControl2 then begin
             SendProc(2);
           end
           else begin
             SendProc(5);
           end;
            end;
end;
{----------}
procedure TSuperSpeedBtn.MouseUpProc( X, Y: Integer);
var
  DoClick: Boolean;
begin
  inherited MouseUp(mbLeft,df, X, Y);
  if FDragging then
  begin
    FDragging := False;

    DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight);


    if FGroupIndex = 0 then
    begin
      FState := bsUp;
      FMouseInControl := False;
      if DoClick and not (FState in [bsExclusive, bsDown]) then
        Invalidate;
        MouseUpProc2;
    end
    else
      if DoClick then
      begin
        SetDown(not FDown);
        if FDown then Repaint;
          MouseUpProc2;
      end
      else
      begin
        if FDown then FState := bsExclusive;
        Repaint;
          MouseUpProc2;
      end;
    if DoClick then
     if (SendDataYN = 0) and (sw2=3) then begin
       Click;
       end;
     if (SendDataYN = 1) and not FMouseInControl2 then begin
      Click;
       end;
    UpdateTracking;
  end;
end;
{----------}
procedure TSuperSpeedBtn.MouseUp(Button: TMouseButton; Shift: TShiftState;X, Y: Integer);
begin
    MouseUpProc(X,Y);
end;
{----------}
procedure TSuperSpeedBtn.Click;
begin
  inherited Click;
end;
{----------}
function TSuperSpeedBtn.GetPalette: HPALETTE;
begin
  Result := Glyph.Palette;
end;
{----------}
function TSuperSpeedBtn.GetGlyph: TBitmap;
begin
  Result := TButtonGlyph(FGlyph).Glyph;
end;
{----------}
procedure TSuperSpeedBtn.SetGlyph(Value: TBitmap);
begin
  TButtonGlyph(FGlyph).Glyph := Value;
  Invalidate;
end;
{----------}
function TSuperSpeedBtn.GetNumGlyphs: TNumGlyphs;
begin
  Result := TButtonGlyph(FGlyph).NumGlyphs;
end;
{----------}
procedure TSuperSpeedBtn.SetNumGlyphs(Value: TNumGlyphs);
begin
  if Value < 0 then Value := 1
  else if Value > 4 then Value := 4;
  if Value <> TButtonGlyph(FGlyph).NumGlyphs then
  begin
    TButtonGlyph(FGlyph).NumGlyphs := Value;
    Invalidate;
  end;
end;
{----------}
procedure TSuperSpeedBtn.GlyphChanged(Sender: TObject);
begin
  Invalidate;
end;
{----------}
procedure TSuperSpeedBtn.UpdateExclusive;
var
  Msg: TMessage;
begin
  if (FGroupIndex <> 0) and (Parent <> nil) then
  begin
    Msg.Msg := CM_BUTTONPRESSED;
    Msg.WParam := FGroupIndex;
    Msg.LParam := Longint(Self);
    Msg.Result := 0;
    Parent.Broadcast(Msg);
  end;
end;
{----------}
procedure TSuperSpeedBtn.SetDown(Value: Boolean);
begin
  if FGroupIndex = 0 then Value := False;
  if Value <> FDown then
  begin
    if FDown and (not FAllowAllUp) then Exit;
    FDown := Value;
    if Value then
    begin
      if FState = bsUp then Invalidate;
      FState := bsExclusive
    end
    else
    begin
      FState := bsUp;
      Repaint;
    end;
    if Value then UpdateExclusive;
  end;
end;
{----------}
procedure TSuperSpeedBtn.SetFlat(Value: Boolean);
begin
  if Value <> FFlat then
  begin
    FFlat := Value;
    Invalidate;
  end;
end;
{----------}
procedure TSuperSpeedBtn.SetGroupIndex(Value: Integer);
begin
  if FGroupIndex <> Value then
  begin
    FGroupIndex := Value;
    UpdateExclusive;
  end;
end;
{----------}
procedure TSuperSpeedBtn.SetLayout(Value: TButtonLayout);
begin
  if FLayout <> Value then
  begin
    FLayout := Value;
    Invalidate;
  end;
end;
{----------}
procedure TSuperSpeedBtn.SetMargin(Value: Integer);
begin
  if (Value <> FMargin) and (Value >= -1) then
  begin
    FMargin := Value;
    Invalidate;
  end;
end;
{----------}
procedure TSuperSpeedBtn.SetSpacing(Value: Integer);
begin
  if Value <> FSpacing then
  begin
    FSpacing := Value;
    Invalidate;
  end;
end;
{----------}
procedure TSuperSpeedBtn.SetTransparent(Value: Boolean);
begin
  if Value <> FTransparent then
  begin
    FTransparent := Value;
    if Value then
      ControlStyle := ControlStyle - [csOpaque] else
      ControlStyle := ControlStyle + [csOpaque];
    Invalidate;
  end;
end;
{----------}
procedure TSuperSpeedBtn.SetAllowAllUp(Value: Boolean);
begin
  if FAllowAllUp <> Value then
  begin
    FAllowAllUp := Value;
    UpdateExclusive;
  end;
end;
{----------}
procedure TSuperSpeedBtn.WMLButtonDblClk(var Message: TWMLButtonDown);
begin
  inherited;
  if FDown then DblClick;
end;
{----------}
procedure TSuperSpeedBtn.CMEnabledChanged(var Message: TMessage);
const
  NewState: array[Boolean] of TButtonState = (bsDisabled, bsUp);
begin
  TButtonGlyph(FGlyph).CreateButtonGlyph(NewState[Enabled]);
  UpdateTracking;
  Repaint;
end;
{----------}
procedure TSuperSpeedBtn.CMButtonPressed(var Message: TMessage);
var
  Sender: TSuperSpeedBtn;
begin
  if Message.WParam = FGroupIndex then
  begin
    Sender := TSuperSpeedBtn(Message.LParam);
    if Sender <> Self then
    begin
      if Sender.Down and FDown then
      begin
        FDown := False;
        FState := bsUp;
        Invalidate;
      end;
      FAllowAllUp := Sender.AllowAllUp;
    end;
  end;
end;
{----------}
procedure TSuperSpeedBtn.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
    if IsAccel(CharCode, Caption) and Enabled and Visible and
      (Parent <> nil) and Parent.Showing then
    begin
      Click;
      Result := 1;
    end else
      inherited;
end;
{----------}
procedure TSuperSpeedBtn.CMFontChanged(var Message: TMessage);
begin
  Invalidate;
end;
   
procedure TSuperSpeedBtn.CMTextChanged(var Message: TMessage);
begin
  Invalidate;
end;
{----------}
procedure TSuperSpeedBtn.CMSysColorChange(var Message: TMessage);
begin
  with TButtonGlyph(FGlyph) do
  begin
    Invalidate;
    CreateButtonGlyph(FState);
  end;
end;
{----------}
procedure TSuperSpeedBtn.CMMouseEnter(var Message: TMessage);
begin
  inherited;
    if FFlat and not FMouseInControl and Enabled and (DragMode <> dmAutomatic) and (GetCapture = 0) then
  begin
    FMouseInControl := True;
    Repaint;
    SendProc(3);
  end;
end;
{----------}
procedure TSuperSpeedBtn.CMMouseLeave(var Message: TMessage);
begin
  inherited;
    if FFlat and FMouseInControl and Enabled and not FDragging then
  begin
    FMouseInControl := False;
    Invalidate;
    SendProc(4);
  end;
end;
{----------}
procedure TSuperSpeedBtn.SetLinkList(aValue : TStrings);
begin
  FItems.Assign(aValue);
end;
{----------}
Procedure TSuperSpeedBtn.WMCopyData( Var msg: TCopyDataStruct);
Var
   st: String;
Begin
   st:=PChar(msg.lpData);
   SendDataYN:=0;

   if st=IntToStr(1) then begin
    if ((GetAsyncKeyState(VK_LBUTTON) < 0) = TRUE) and Enabled then begin
      MouseDownProc;
      end;
    end;
   if st=IntToStr(2) then begin
     sw2:=3;
     MouseUpProc(0,0);
    end;
   if st=IntToStr(3) then begin
     Perform(CM_MOUSEENTER,0,0);
    end;
   if st=IntToStr(4) then begin
     Perform(CM_MOUSELEAVE,0,0);
    end;
   if st=IntToStr(5) then begin
     sw2:=4;
     MouseUpProc(0,0);
    end;
   if st=IntToStr(6) then begin
     sw:=1;
     MouseMoveProc(0,0);
    end;
   if st=IntToStr(7) then begin
     sw:=2;
     MouseMoveProc(-1,-1);
    end;

End;
{----------}
Procedure TSuperSpeedBtn.SendData(msg: Integer; comp: TControl);
var
 S: String;
 data: TCopyDataStruct;
begin
    S:= IntToStr(msg);
    data.dwData := DWORD(S[1]);
    data.cbData := 2;
    comp.Perform(WM_COPYDATA,0,integer(@data));
end;
{-----------}
procedure Register;
begin
  RegisterComponents ('SuperBtn',[TSuperSpeedBtn]);
end;

end.

**********************************************************
************************END*******************************
----------------------------------------------------------


*********************************************************
---------------------------------------------------------
-----------------------unit2.pas-------------------------
---------------------------------------------------------
*********************************************************

unit unit2;

interface
uses Windows, Classes, Controls, Forms, Graphics, StdCtrls,
  ExtCtrls, CommCtrl, Consts,Buttons, Messages;

{$S-,W-,R-}
{{$R BUTTONS.RES}

type
  TButtonLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom);
  TButtonState = (bsUp, bsDisabled, bsDown, bsExclusive,bsTranspDisabled); {Pxidano (pryhledn} a zedl})}
  TButtonStyle = (bsAutoDetect, bsWin31, bsNew);
  TNumGlyphs = 1..4;

  TBitBtnKind = (bkCustom, bkOK, bkCancel, bkHelp, bkYes, bkNo, bkClose,
    bkAbort, bkRetry, bkIgnore, bkAll);

const
  BitBtnResNames: array[TBitBtnKind] of PChar = (
    nil, 'BBOK', 'BBCANCEL', 'BBHELP', 'BBYES', 'BBNO', 'BBCLOSE',
    'BBABORT', 'BBRETRY', 'BBIGNORE', 'BBALL');
{ BitBtnCaptions: array[TBitBtnKind] of Pointer = (
    nil, @SOKButton, @SCancelButton, @SHelpButton, @SYesButton, @SNoButton,
    @SCloseButton, @SAbortButton, @SRetryButton, @SIgnoreButton,
    @SAllButton);}
  BitBtnModalResults: array[TBitBtnKind] of TModalResult = (
    0, mrOk, mrCancel, 0, mrYes, mrNo, 0, mrAbort, mrRetry, mrIgnore,
    mrAll);

type
  TGlyphList = class(TImageList)
  private
    Used: TBits;
    FCount: Integer;
    function AllocateIndex: Integer;
  public
    constructor Create(AWidth, AHeight: Integer);
    destructor Destroy; override;
    function Add(Image, Mask: TBitmap): Integer;
    function AddMasked(Image: TBitmap; MaskColor: TColor): Integer;
    procedure Delete(Index: Integer);
    property Count: Integer read FCount;
  end;

  TGlyphCache = class
  private
    GlyphLists: TList;
  public
    constructor Create;
    destructor Destroy; override;
    function GetList(AWidth, AHeight: Integer): TGlyphList;
    procedure ReturnList(List: TGlyphList);
    function Empty: Boolean;
  end;

  TButtonGlyph = class
  private
    FOriginal: TBitmap;
    FGlyphList: TGlyphList;
    FIndexs: array[TButtonState] of Integer;
    FTransparentColor: TColor;
    FNumGlyphs: TNumGlyphs;
    FOnChange: TNotifyEvent;
    procedure GlyphChanged(Sender: TObject);
    procedure SetGlyph(Value: TBitmap);
    procedure SetNumGlyphs(Value: TNumGlyphs);
    procedure Invalidate;
{    function CreateButtonGlyph(State: TButtonState): Integer;}
    procedure DrawButtonGlyph(Canvas: TCanvas; const GlyphPos: TPoint;
      State: TButtonState; Transparent: Boolean);
    procedure DrawButtonText(Canvas: TCanvas; const Caption: string;
      TextBounds: TRect; State: TButtonState);
    procedure CalcButtonLayout(Canvas: TCanvas; const Client: TRect;
      const Offset: TPoint; const Caption: string; Layout: TButtonLayout;
      Margin, Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect);
  public
    constructor Create;
    destructor Destroy; override;
    { return the text rectangle }
    function Draw(Canvas: TCanvas; const Client: TRect; const Offset: TPoint;
      const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
      State: TButtonState; Transparent: Boolean): TRect;
    function CreateButtonGlyph(State: TButtonState): Integer;      
    property Glyph: TBitmap read FOriginal write SetGlyph;
    property NumGlyphs: TNumGlyphs read FNumGlyphs write SetNumGlyphs;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;



function DrawButtonFace(Canvas: TCanvas; const Client: TRect;
  BevelWidth: Integer; Style: TButtonStyle; IsRounded, IsDown,
  IsFocused: Boolean): TRect;
function GetBitBtnGlyph(Kind: TBitBtnKind): TBitmap;
procedure CreateBrushPattern;

var
  BitBtnGlyphs: array[TBitBtnKind] of TBitmap;
  MouseInBtn:TButton;
  LeaveMsgSending:Boolean;
  Pattern: TBitmap = nil;
  ButtonCount: Integer = 0;
  GlyphCache: TGlyphCache = nil;



implementation

{ DrawButtonFace - returns the remaining usable area inside the Client rect.}
function DrawButtonFace(Canvas: TCanvas; const Client: TRect;
  BevelWidth: Integer; Style: TButtonStyle; IsRounded, IsDown,
  IsFocused: Boolean): TRect;
var
  NewStyle: Boolean;
  R: TRect;
  DC: THandle;
begin
  NewStyle := ((Style = bsAutoDetect) and NewStyleControls) or (Style = bsNew);

  R := Client;
  with Canvas do
  begin
    if NewStyle then
    begin
      Brush.Color := clBtnFace;
      Brush.Style := bsSolid;
      DC := Canvas.Handle;    { Reduce calls to GetHandle }

      if IsDown then
      begin    { DrawEdge is faster than Polyline }
        DrawEdge(DC, R, BDR_SUNKENINNER, BF_TOPLEFT);              { black     }
        DrawEdge(DC, R, BDR_SUNKENOUTER, BF_BOTTOMRIGHT);          { btnhilite }
        Dec(R.Bottom);
        Dec(R.Right);
        Inc(R.Top);
        Inc(R.Left);
        DrawEdge(DC, R, BDR_SUNKENOUTER, BF_TOPLEFT or BF_MIDDLE); { btnshadow }
      end
      else
      begin
        DrawEdge(DC, R, BDR_RAISEDOUTER, BF_BOTTOMRIGHT);          { black }
        Dec(R.Bottom);
        Dec(R.Right);
        DrawEdge(DC, R, BDR_RAISEDINNER, BF_TOPLEFT);              { btnhilite }
        Inc(R.Top);
        Inc(R.Left);
        DrawEdge(DC, R, BDR_RAISEDINNER, BF_BOTTOMRIGHT or BF_MIDDLE); { btnshadow }
      end;
    end
    else
    begin
      Pen.Color := clWindowFrame;
      Brush.Color := clBtnFace;
      Brush.Style := bsSolid;
      Rectangle(R.Left, R.Top, R.Right, R.Bottom);

      { round the corners - only applies to Win 3.1 style buttons }
      if IsRounded then
      begin
        Pixels[R.Left, R.Top] := clBtnFace;
        Pixels[R.Left, R.Bottom - 1] := clBtnFace;
        Pixels[R.Right - 1, R.Top] := clBtnFace;
        Pixels[R.Right - 1, R.Bottom - 1] := clBtnFace;
      end;

      if IsFocused then
      begin
        InflateRect(R, -1, -1);
        Brush.Style := bsClear;
        Rectangle(R.Left, R.Top, R.Right, R.Bottom);
      end;

      InflateRect(R, -1, -1);
      if not IsDown then
        Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, BevelWidth)
      else
      begin
        Pen.Color := clBtnShadow;
        PolyLine([Point(R.Left, R.Bottom - 1), Point(R.Left, R.Top),
          Point(R.Right, R.Top)]);
      end;
    end;
  end;

  Result := Rect(Client.Left + 1, Client.Top + 1,
    Client.Right - 2, Client.Bottom - 2);
  if IsDown then OffsetRect(Result, 1, 1);
end;

function GetBitBtnGlyph(Kind: TBitBtnKind): TBitmap;
begin
  if BitBtnGlyphs[Kind] = nil then
  begin
    BitBtnGlyphs[Kind] := TBitmap.Create;
    BitBtnGlyphs[Kind].Handle := LoadBitmap(HInstance, BitBtnResNames[Kind]);
  end;
  Result := BitBtnGlyphs[Kind];
end;

{ TGlyphList }

constructor TGlyphList.Create(AWidth, AHeight: Integer);
begin
  inherited CreateSize(AWidth, AHeight);
  Used := TBits.Create;
end;

destructor TGlyphList.Destroy;
begin
  Used.Free;
  inherited Destroy;
end;

function TGlyphList.AllocateIndex: Integer;
begin
  Result := Used.OpenBit;
  if Result >= Used.Size then
  begin
    Result := inherited Add(nil, nil);
    Used.Size := Result + 1;
  end;
  Used[Result] := True;
end;

function TGlyphList.Add(Image, Mask: TBitmap): Integer;
begin
  Result := AllocateIndex;
  Replace(Result, Image, Mask);
  Inc(FCount);
end;

function TGlyphList.AddMasked(Image: TBitmap; MaskColor: TColor): Integer;
begin
  Result := AllocateIndex;
  ReplaceMasked(Result, Image, MaskColor);
  Inc(FCount);
end;

procedure TGlyphList.Delete(Index: Integer);
begin
  if Used[Index] then
  begin
    Dec(FCount);
    Used[Index] := False;
  end;
end;

{ TGlyphCache }

constructor TGlyphCache.Create;
begin
  inherited Create;
  GlyphLists := TList.Create;
end;

destructor TGlyphCache.Destroy;
begin
  GlyphLists.Free;
  inherited Destroy;
end;

function TGlyphCache.GetList(AWidth, AHeight: Integer): TGlyphList;
var
  I: Integer;
begin
  for I := GlyphLists.Count - 1 downto 0 do
  begin
    Result := GlyphLists[I];
    with Result do
      if (AWidth = Width) and (AHeight = Height) then Exit;
  end;
  Result := TGlyphList.Create(AWidth, AHeight);
  GlyphLists.Add(Result);
end;

procedure TGlyphCache.ReturnList(List: TGlyphList);
begin
  if List = nil then Exit;
  if List.Count = 0 then
  begin
    GlyphLists.Remove(List);
    List.Free;
  end;
end;

function TGlyphCache.Empty: Boolean;
begin
  Result := GlyphLists.Count = 0;
end;

procedure CreateBrushPattern;
var
  X, Y: Integer;
begin
  Pattern := TBitmap.Create;
  Pattern.Width := 8;
  Pattern.Height := 8;
  with Pattern.Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := clBtnFace;
    FillRect(Rect(0, 0, Pattern.Width, Pattern.Height));
    for Y := 0 to 7 do
      for X := 0 to 7 do
        if (Y mod 2) = (X mod 2) then  { toggles between even/odd pixles }
          Pixels[X, Y] := clWhite;     { on even/odd rows }
  end;
end;


{ TButtonGlyph }
constructor TButtonGlyph.Create;
var
  I: TButtonState;
begin
  inherited Create;
  FOriginal := TBitmap.Create;
  FOriginal.OnChange := GlyphChanged;
  FTransparentColor := clOlive;
  FNumGlyphs := 1;
  for I := Low(I) to High(I) do
    FIndexs[I] := -1;
  if GlyphCache = nil then GlyphCache := TGlyphCache.Create;
end;

destructor TButtonGlyph.Destroy;
begin
  FOriginal.Free;
  Invalidate;
  if Assigned(GlyphCache) and GlyphCache.Empty then
  begin
    GlyphCache.Free;
    GlyphCache := nil;
  end;
  inherited Destroy;
end;

procedure TButtonGlyph.Invalidate;
var
  I: TButtonState;
begin
  for I := Low(I) to High(I) do
  begin
    if FIndexs[I] <> -1 then FGlyphList.Delete(FIndexs[I]);
    FIndexs[I] := -1;
  end;
  GlyphCache.ReturnList(FGlyphList);
  FGlyphList := nil;
end;

procedure TButtonGlyph.GlyphChanged(Sender: TObject);
begin
  if Sender = FOriginal then
  begin
    FTransparentColor := FOriginal.TransparentColor;
    Invalidate;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TButtonGlyph.SetGlyph(Value: TBitmap);
var
  Glyphs: Integer;
begin
  Invalidate;
  FOriginal.Assign(Value);
  if (Value <> nil) and (Value.Height > 0) then
  begin
    FTransparentColor := Value.TransparentColor;
    if Value.Width mod Value.Height = 0 then
    begin
      Glyphs := Value.Width div Value.Height;
      if Glyphs > 4 then Glyphs := 1;
      SetNumGlyphs(Glyphs);
    end;
  end;
end;

procedure TButtonGlyph.SetNumGlyphs(Value: TNumGlyphs);
begin
  if (Value <> FNumGlyphs) and (Value > 0) then
  begin
    Invalidate;
    FNumGlyphs := Value;
    GlyphChanged(Glyph);
  end;
end;

function TButtonGlyph.CreateButtonGlyph(State: TButtonState): Integer;
const
  ROP_DSPDxax = $00E20746;
var
  TmpImage, DDB, MonoBmp: TBitmap;
  IWidth, IHeight: Integer;
  IRect, ORect: TRect;
  I: TButtonState;
  DestDC: HDC;
begin
  if (State = bsDown) and (NumGlyphs < 3) then State := bsUp;
  Result := FIndexs[State];
  if Result <> -1 then Exit;
  if (FOriginal.Width or FOriginal.Height) = 0 then Exit;
  IWidth := FOriginal.Width div FNumGlyphs;
  IHeight := FOriginal.Height;
  if FGlyphList = nil then
  begin
    if GlyphCache = nil then GlyphCache := TGlyphCache.Create;
    FGlyphList := GlyphCache.GetList(IWidth, IHeight);
  end;
  TmpImage := TBitmap.Create;
  try
    TmpImage.Width := IWidth;
    TmpImage.Height := IHeight;
    IRect := Rect(0, 0, IWidth, IHeight);
    TmpImage.Canvas.Brush.Color := clBtnFace;
    TmpImage.Palette := CopyPalette(FOriginal.Palette);
    I := State;
    if Ord(I) >= NumGlyphs then I := bsUp;
    ORect := Rect(Ord(I) * IWidth, 0, (Ord(I) + 1) * IWidth, IHeight);
    case State of
      bsUp, bsDown,
      bsExclusive:
        begin
          TmpImage.Canvas.CopyRect(IRect, FOriginal.Canvas, ORect);
          if FOriginal.TransparentMode = tmFixed then
            FIndexs[State] := FGlyphList.AddMasked(TmpImage, FTransparentColor)
          else
            FIndexs[State] := FGlyphList.AddMasked(TmpImage, clDefault);
        end;
      bsDisabled:
        begin
          MonoBmp := nil;
          DDB := nil;
          try
            MonoBmp := TBitmap.Create;
            DDB := TBitmap.Create;
            DDB.Assign(FOriginal);
            DDB.HandleType := bmDDB;
            if NumGlyphs > 1 then
            with TmpImage.Canvas do
            begin    { Change white & gray to clBtnHighlight and clBtnShadow }
              CopyRect(IRect, DDB.Canvas, ORect);
              MonoBmp.Monochrome := True;
              MonoBmp.Width := IWidth;
              MonoBmp.Height := IHeight;

              { Convert white to clBtnHighlight }
              DDB.Canvas.Brush.Color := clWhite;
              MonoBmp.Canvas.CopyRect(IRect, DDB.Canvas, ORect);
              Brush.Color := clBtnHighlight;
              DestDC := Handle;
              SetTextColor(DestDC, clBlack);
              SetBkColor(DestDC, clWhite);
              BitBlt(DestDC, 0, 0, IWidth, IHeight,
                     MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);

              { Convert gray to clBtnShadow }
              DDB.Canvas.Brush.Color := clGray;
              MonoBmp.Canvas.CopyRect(IRect, DDB.Canvas, ORect);
              Brush.Color := clBtnShadow;
              DestDC := Handle;
              SetTextColor(DestDC, clBlack);
              SetBkColor(DestDC, clWhite);
              BitBlt(DestDC, 0, 0, IWidth, IHeight,
                     MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);

              { Convert transparent color to clBtnFace }
              DDB.Canvas.Brush.Color := ColorToRGB(FTransparentColor);
              MonoBmp.Canvas.CopyRect(IRect, DDB.Canvas, ORect);
              Brush.Color := clBtnFace;
              DestDC := Handle;
              SetTextColor(DestDC, clBlack);
              SetBkColor(DestDC, clWhite);
              BitBlt(DestDC, 0, 0, IWidth, IHeight,
                     MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
            end
            else
            begin
              { Create a disabled version }
              with MonoBmp do
              begin
                Assign(FOriginal);
                HandleType := bmDDB;
                Canvas.Brush.Color := clBlack;
                Width := IWidth;
                if Monochrome then
                begin
                  Canvas.Font.Color := clWhite;
                  Monochrome := False;
                  Canvas.Brush.Color := clWhite;
                end;
                Monochrome := True;
              end;
              with TmpImage.Canvas do
              begin
                Brush.Color := clBtnFace;
                FillRect(IRect);
                Brush.Color := clBtnHighlight;
                SetTextColor(Handle, clBlack);
                SetBkColor(Handle, clWhite);
                BitBlt(Handle, 1, 1, IWidth, IHeight,
                  MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
                Brush.Color := clBtnShadow;
                SetTextColor(Handle, clBlack);
                SetBkColor(Handle, clWhite);
                BitBlt(Handle, 0, 0, IWidth, IHeight,
                  MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
              end;
            end;
          finally
            DDB.Free;
            MonoBmp.Free;
          end;
          FIndexs[State] := FGlyphList.AddMasked(TmpImage, clDefault);
        end;
    end;
  finally
    TmpImage.Free;
  end;
  Result := FIndexs[State];
  FOriginal.Dormant;
end;

procedure TButtonGlyph.DrawButtonGlyph(Canvas: TCanvas; const GlyphPos: TPoint;
  State: TButtonState; Transparent: Boolean);
var
  Index: Integer;
begin
  if FOriginal = nil then Exit;
  if (FOriginal.Width = 0) or (FOriginal.Height = 0) then Exit;
  Index := CreateButtonGlyph(State);
  with GlyphPos do
    if Transparent or (State = bsExclusive) then
      ImageList_DrawEx(FGlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0,
        clNone, clNone, ILD_Transparent)
    else
      ImageList_DrawEx(FGlyphList.Handle, Index, Canvas.Handle, X, Y, 0, 0,
        ColorToRGB(clBtnFace), clNone, ILD_Normal);
end;

procedure TButtonGlyph.DrawButtonText(Canvas: TCanvas; const Caption: string;
  TextBounds: TRect; State: TButtonState);
begin
  with Canvas do
  begin
    Brush.Style := bsClear;
    if State = bsDisabled then
    begin
      OffsetRect(TextBounds, 1, 1);
      Font.Color := clBtnHighlight;
      DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, 0);
      OffsetRect(TextBounds, -1, -1);
      Font.Color := clBtnShadow;
      DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, 0);
    end else
      DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,
        DT_CENTER or DT_VCENTER or DT_SINGLELINE);
  end;
end;

procedure TButtonGlyph.CalcButtonLayout(Canvas: TCanvas; const Client: TRect;
  const Offset: TPoint; const Caption: string; Layout: TButtonLayout; Margin,
  Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect);
var
  TextPos: TPoint;
  ClientSize, GlyphSize, TextSize: TPoint;
  TotalSize: TPoint;
begin
  { calculate the item sizes }
  ClientSize := Point(Client.Right - Client.Left, Client.Bottom -
    Client.Top);

  if FOriginal <> nil then
    GlyphSize := Point(FOriginal.Width div FNumGlyphs, FOriginal.Height) else
    GlyphSize := Point(0, 0);

  if Length(Caption) > 0 then
  begin
    TextBounds := Rect(0, 0, Client.Right - Client.Left, 0);
    DrawText(Canvas.Handle, PChar(Caption), Length(Caption), TextBounds, DT_CALCRECT);
    TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom -
      TextBounds.Top);
  end
  else
  begin
    TextBounds := Rect(0, 0, 0, 0);
    TextSize := Point(0,0);
  end;

  { If the layout has the glyph on the right or the left, then both the
    text and the glyph are centered vertically.  If the glyph is on the top
    or the bottom, then both the text and the glyph are centered horizontally.}
  if Layout in [blGlyphLeft, blGlyphRight] then
  begin
    GlyphPos.Y := (ClientSize.Y - GlyphSize.Y + 1) div 2;
    TextPos.Y := (ClientSize.Y - TextSize.Y + 1) div 2;
  end
  else
  begin
    GlyphPos.X := (ClientSize.X - GlyphSize.X + 1) div 2;
    TextPos.X := (ClientSize.X - TextSize.X + 1) div 2;
  end;

  { if there is no text or no bitmap, then Spacing is irrelevant }
  if (TextSize.X = 0) or (GlyphSize.X = 0) then
    Spacing := 0;

  { adjust Margin and Spacing }
  if Margin = -1 then
  begin
    if Spacing = -1 then
    begin
      TotalSize := Point(GlyphSize.X + TextSize.X, GlyphSize.Y + TextSize.Y);
      if Layout in [blGlyphLeft, blGlyphRight] then
        Margin := (ClientSize.X - TotalSize.X) div 3
      else
        Margin := (ClientSize.Y - TotalSize.Y) div 3;
      Spacing := Margin;
    end
    else
    begin
      TotalSize := Point(GlyphSize.X + Spacing + TextSize.X, GlyphSize.Y +
        Spacing + TextSize.Y);
      if Layout in [blGlyphLeft, blGlyphRight] then
        Margin := (ClientSize.X - TotalSize.X + 1) div 2
      else
        Margin := (ClientSize.Y - TotalSize.Y + 1) div 2;
    end;
  end
  else
  begin
    if Spacing = -1 then
    begin
      TotalSize := Point(ClientSize.X - (Margin + GlyphSize.X), ClientSize.Y -
        (Margin + GlyphSize.Y));
      if Layout in [blGlyphLeft, blGlyphRight] then
        Spacing := (TotalSize.X - TextSize.X) div 2
      else
        Spacing := (TotalSize.Y - TextSize.Y) div 2;
    end;
  end;

  case Layout of
    blGlyphLeft:
      begin
        GlyphPos.X := Margin;
        TextPos.X := GlyphPos.X + GlyphSize.X + Spacing;
      end;
    blGlyphRight:
      begin
        GlyphPos.X := ClientSize.X - Margin - GlyphSize.X;
        TextPos.X := GlyphPos.X - Spacing - TextSize.X;
      end;
    blGlyphTop:
      begin
        GlyphPos.Y := Margin;
        TextPos.Y := GlyphPos.Y + GlyphSize.Y + Spacing;
      end;
    blGlyphBottom:
      begin
        GlyphPos.Y := ClientSize.Y - Margin - GlyphSize.Y;
        TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y;
      end;
  end;

  { fixup the result variables }
  with GlyphPos do
  begin
    Inc(X, Client.Left + Offset.X);
    Inc(Y, Client.Top + Offset.Y);
  end;
  OffsetRect(TextBounds, TextPos.X + Client.Left + Offset.X,
    TextPos.Y + Client.Top + Offset.X);
end;

function TButtonGlyph.Draw(Canvas: TCanvas; const Client: TRect;
  const Offset: TPoint; const Caption: string; Layout: TButtonLayout;
  Margin, Spacing: Integer; State: TButtonState; Transparent: Boolean): TRect;
var
  GlyphPos: TPoint;
begin
  CalcButtonLayout(Canvas, Client, Offset, Caption, Layout, Margin, Spacing,
    GlyphPos, Result);
  DrawButtonGlyph(Canvas, GlyphPos, State, Transparent);
  DrawButtonText(Canvas, Caption, Result, State);
end;


procedure DestroyLocals; far;
var
  I: TBitBtnKind;
begin
  for I := Low(TBitBtnKind) to High(TBitBtnKind) do
    BitBtnGlyphs[I].Free;
end;

initialization
  FillChar(BitBtnGlyphs, SizeOf(BitBtnGlyphs), 0);
  MouseInBtn:=nil;
  LeaveMsgSending:=True;
finalization
  DestroyLocals;
end.

**********************************************************
************************END*******************************
----------------------------------------------------------

took me about 4 days with just 6 hours a day to make this component ;-)

0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
Please do not claim this as your own source and do not post it anywhere!
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
>Please do not claim this as your own source and do not
>post it anywhere!

is ok, freshman

starting now evaluting,
results and gradinglist comes tomorrow

meikl ;-)
0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
meikl , Should I tell how to use the component? :-)
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
would be nice, freshman,
then it would be not to hard for me
to evaluate,
but in your case i have the exe and
i trust you that your exe is based on your source,
so that it is not a must for you to explain it for me
but others may know this

in some hours,
the results are posted
(first i must be a little bit for my family,
because i'm a short time at home todays evening)

meikl ;-)
0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
>i trust you that your exe is based on your source
yes, exe I gave you is already using the component

>first i must be a little bit for my family,because i'm a
>short time at home todays evening
of course,after all your family is far more important then this q

0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
>i trust you that your exe is based on your source
yes, exe I gave you is already using the component

>first i must be a little bit for my family,because i'm a
>short time at home todays evening
of course,after all your family is far more important then this q

0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
Here is how to use the component.

for example I have four of these buttons placed on the form and I want that all of these buttons to control each other, I would set there linkwith property as follows:

SuperSpeedBtn1's linkwith property would be:
SuperSpeedBtn2
SuperSpeedBtn3
SuperSpeedBtn4


SuperSpeedBtn2's linkwith property would be:
SuperSpeedBtn1
SuperSpeedBtn3
SuperSpeedBtn4


SuperSpeedBtn3's linkwith property would be:
SuperSpeedBtn1
SuperSpeedBtn2
SuperSpeedBtn4


SuperSpeedBtn4's linkwith property would be:
SuperSpeedBtn1
SuperSpeedBtn2
SuperSpeedBtn3

Hope thats clear enought

P.S: if you want ,I can change the component so you dont have to type into each button separately but instead type everything into just one button
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
the results

geobul:
100 pts for first on basic question
100 pts for first addon question
(i will raise this q up to 200 and grade you, geo)

robert:
failed the goal of this question,
but for providing an interest component,
which shows how to handle messages for the addon q
50 pts in a separat question

nestorua:
50 pts for solving basic question (but not first)
25 pts for qow17, which i have not gave you yet

freshmen:
50 pts for solving basic question (but not first)
50 pts for solving addon question (but not first)
50 pts for best implementation (bonus)

summary:
geobul : 200 pts with this q
robert : 50 pts in a separate q
nestorua : 75 pts in a separate q
freshmen : 150 pts in a separate q

if all agree, then i will close this thread in two days
from now, otherwise just tell me

sponsors may pick within this two days one or more
experts, which are get its points in a separate q

freshmen,
>meikl , Should I tell how to use the component? :-)
yes

meikl ;-)
0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
meikl,

No offense but all of Geobul's solutions are hard coded so you cannot link multiple buttons together and that dosent answer the basic question and addon question


>freshmen,
>>meikl , Should I tell how to use the component? :-)
>yes

I already posted how to use the component in my last post


0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
meikl,

No offense but all of Geobul's solutions are hard coded so you cannot link multiple buttons together and that dosent answer the basic question and addon question


>freshmen,
>>meikl , Should I tell how to use the component? :-)
>yes

I already posted how to use the component in my last post


0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
:-))
sorry, freshman, as i wrote my last comment,
i didn't saw your last comment ;-)

about geobuls solution,
i guessed it would be not too hard
to extract the TMySpeedButton-Class parts
into a unit and add a register-procedure,
but well, your criticism is correct

to all,
suggestions welcome

meikl ;-)
0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
meikl,

Here is what I think about Geobul's solutions:

1)hard coded so you cannot link multiple buttons together.
and this by itself automatically dosent answer the basic question and the addon question

2)
>if i press the third
>-button1 going down and fires its onclick event
>-button2 going down and fires its onclick event
>-button3 going down and fires its onclick event....

As you asked as an addon question the button to go down ,Geobul's solution doesnt make the button go down,
and this itself dosent answer the addon question either

and Here is what I think about nestorua's solutions:
1)same as Geobul's

and Here is what I think about robert's solutions:
1)robert failed the goal of this question

P.S: to everyone: No hard fellings,I'am just being fair
:-)
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
waiting for comments from the others participants

the grading discussion is opened

to 1.
as stated

i guessed it would be not too hard
to extract the TMySpeedButton-Class parts
into a unit and add a register-procedure

like

unit MySpeedButton;
uses someunits;

type
TMySpeedButton = class(TSpeedButton)
private
  FLinkedButton: TMySpeedButton;
  FLinkedBevel: Boolean;
  procedure SetLinkedButton(Value: TMySpeedButton);
protected
  procedure WMMouseEnter(var Msg: TWMMouse); message CM_MOUSEENTER;
  procedure WMMouseLeave(var Msg: TWMMouse); message CM_MOUSELEAVE;
public
  procedure Click; override;
published
  property LinkedButton: TMySpeedButton read FLinkedButton write SetLinkedButton default nil;
  property LinkedBevel: Boolean read FLinkedBevel write FLinkedBevel;
end;

procedure register;

implementation

{$R *.DFM}

// TMySpeedButton

RegisterComponents ('Samples',[TMySpeedButton]);



procedure TMySpeedButton.Click;
begin
if Assigned(LinkedButton) then LinkedButton.Click;
inherited Click;
end;

procedure TMySpeedButton.SetLinkedButton(Value: TMySpeedButton);
begin
FLinkedButton := Value;
end;

procedure TMySpeedButton.WMMouseEnter(var Msg: TWMMouse);
begin
 if Assigned(LinkedButton) and LinkedBevel then LinkedButton.WMMouseEnter(Msg);
 inherited;
end;

procedure TMySpeedButton.WMMouseLeave(var Msg: TWMMouse);
begin
 if Assigned(LinkedButton) and LinkedBevel then LinkedButton.WMMouseLeave(Msg);
 inherited;
end;

end.

now you've a component, where you can link at designtime
buttons with the same class

to 2.
good point, missed this myself
(sometimes i should reread my own questions) :-))

to 3(1). nestoruas is near exact to geobuls, but provides the notification-procedure and implements a check for avoiding circular links

to 4(1). as stated robert failed the goal

well,
what is the meaning of the others,
as freshman is correct about his objectives as it is

geo solves the question not in all cases
robert failed
nestorua just "expands" geos solution
freshman matches the question exact and a bit more

freshman,
how should the gradings shown,
from your point of view?

meikl ;-)
0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
hello meikl,

>freshman,
>how should the gradings shown,
>from your point of view?

Here is what I think,

geobul:
almost solved the basic question(but not all the way) : 85
almost solved the addon question(but not all the way) : 65

nestorua:
almost solved the basic question(but not all the way) : 85

robert : failed the goal of this question and.... = 30

Conclusion,

geobul: 150
nestorua: 85
robert: 30
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
well,
your suggestion seems to be ok for me,
except for geobul 2x 75 pts (was both first, but results is the same)
except for nestorua (was not first) i would give 45 pts,
what about yourself,
atleast you solved all,
i would keep the 150 pts grade for you, freshman

after discussion following gradings

geobul 150
nestorua 45 +(25 from qow17) = 70
robert 30
freshman 150 (or 200 for complete genius solution?)

others, what's your meaning

meikl ;-)
0
 
LVL 17

Expert Comment

by:geobul
Comment Utility
Hi,
>1)hard coded so you cannot link multiple buttons together.

Yes, you can. You build a chain of linked buttons. Btn2 controls Btn1. Btn3 controls Btn2 and that way controls Btn1 indirectly.

>and this by itself automatically dosent answer the basic question and the addon question

I don't understand.

>2)

I agree. Linked buttons don't go down.

>almost solved the addon question(but not all the way) : 65

I can't agree. The addon question was about bevels (mouse over/leave) not about pressing the buttons.

And finally: freshman's component is not derived from TSpeedButton.

Regards, Geo
0
 
LVL 17

Expert Comment

by:geobul
Comment Utility
Meikl,
>geobul 150
is correct (and sounds well :-)

Regards, Geo
0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
Hello geobul,

>Yes, you can. You build a chain of linked buttons. Btn2 >controls Btn1. Btn3 controls Btn2 and that way
>controls Btn1 indirectly.

How about, if you have 4 of these buttons on the form and want them to function as follows:

if i press Button1,
button1 fires its onclick event
button2 fires its onclick event
button3 fires its onclick event
button4 fires its onclick event

if i press Button2,
button1 fires its onclick event
button2 fires its onclick event
button3 fires its onclick event
button4 fires its onclick event

if i press Button3,
button1 fires its onclick event
button2 fires its onclick event
button3 fires its onclick event
button4 fires its onclick event

if i press Button4,
button1 fires its onclick event
button2 fires its onclick event
button3 fires its onclick event
button4 fires its onclick event

Can your button do that ? :)
0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
Sorry geobul, I made a mistake in my previous post

Here is the corrected one:

How about, if you have 4 of these buttons on the form and want them to function as follows:

if i press Button1,
button1 fires its onclick event
button2 fires its onclick event
button3 fires its onclick event

if i press Button2,
button1 fires its onclick event
button2 fires its onclick event

if i press Button3,
button1 fires its onclick event
button2 fires its onclick event
button3 fires its onclick event

if i press Button4,
button1 fires its onclick event
button2 fires its onclick event
button4 fires its onclick event

geobul,Can your button do that ? :)

0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
freshman,
that was not part of this q,
only the "previous" linked button(s)
and the clicked should fire

i know, that your component
can assign different
combinations for each button
(thats why the bonus)

nestorua, robert,
your agreements or objectives are needed

meikl ;-)
0
 
LVL 4

Expert Comment

by:nestorua
Comment Utility
HI, Meikl,
I agree. Thanks.
Sincerely,
Nestorua.
0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
Meikl, Whatever you say, I will agree ;-)
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
well, if robert will not comment anything, then
the gradings would be

geobul 150 pts
robert 30 pts
nestorua 70 pts
freshman 150 pts

i will geobul grade with this q,
others get the points in separate for... qs

sponsors may have 24 hours from now for picking
one or more experts for grading from the sponsor's
points-account.

after 24 for hours i will grade the rest or all, if no sponsor found

meikl ;-)
0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
Thanks alot, meikl :-)
0
 
LVL 9

Expert Comment

by:ITugay
Comment Utility
hi meikl,
oww, long thread....

I will grade geobul

-----
Igor
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
well, ok,
igor and thanks for sponsoring,

then i will grade freshman
with this q this evening,
and the rest with separat questions

meikl ;-)
0
 
LVL 2

Expert Comment

by:freshman3k
Comment Utility
meikl, whats next?
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
the grading of course, freshman
(sorry that i'm late for this) ;-)

nestorua go
http://www.experts-exchange.com/delphi/Q_20312100.html
to collect your points

robert go
http://www.experts-exchange.com/delphi/Q_20312101.html
to collect your points

thanks to all for participating on this quest,
specially to sponsor igor :-)

meikl ;-)
0
 
LVL 27

Author Comment

by:kretzschmar
Comment Utility
geo, your (sponsored) points are there
http://www.experts-exchange.com/delphi/Q_20311673.html

meikl ;-)
0

Featured Post

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

Suggested Solutions

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…
This tutorial demonstrates a quick way of adding group price to multiple Magento products.

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

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

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now