Solved

i need two special components

Posted on 2001-09-13
26
252 Views
Last Modified: 2010-04-06
The first one should be a TBitBtn descendant because it needs Focus, Glyph and Caption.
The trick is that a left click should only set focus to the control, but should not generate an OnClick event.

The second component should be a TImage where the OnClick is only fired when a non-transparent part of the image is clicked.

Best source code or links to free source code.
0
Comment
Question by:robert_marquardt
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 9
  • 8
  • 8
  • +1
26 Comments
 
LVL 27

Expert Comment

by:kretzschmar
ID: 6478984
well not free

www.cooldev.com
0
 
LVL 9

Accepted Solution

by:
ITugay earned 200 total points
ID: 6479093
Hi robert_marquard.

meikl:-)

I think it should be something like this:

  TMyBitBtn = class(TBitBtn)
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  end;

  TMyImage = class(TImage)
  protected
    procedure WM_LBUTTONDOWN(var M: TMessage); message WM_LBUTTONDOWN;
  end;
.........
procedure TMyBitBtn.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if CanFocus then
    SetFocus;
  Inherited;
end;


procedure TMyImage.WM_LBUTTONDOWN(var M: TMessage);
var
  B: TBitmap;
begin
  B := Picture.Bitmap;
  if B.Canvas.Pixels[LoWord(M.LParam), HiWord(M.LParam)] = (B.TransparentColor and $FFFFFF) then
    M.Result := 0
  else
    Inherited;
end;

-----
Igor
0
 
LVL 8

Expert Comment

by:TOndrej
ID: 6479175
Hi,
here is a little test:

type
  TSpecialBitBtn = class(TBitBtn)
  protected
    procedure Click; override;
  end;

procedure TSpecialBitBtn.Click;
begin

end;

type
  TSpecialImage = class(TImage)
  private
    FOldPictureChanged: TNotifyEvent;
    FTransparentColor: TColor;
    procedure PictureChanged(Sender: TObject);
  protected
    procedure Click; override;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

procedure TSpecialImage.PictureChanged(Sender: TObject);
var
  B: TBitmap;
begin
  if Assigned(FOldPictureChanged) then
    FOldPictureChanged(Sender);

  if Assigned(Picture.Graphic) and Picture.Graphic.Transparent then
  begin
    B := TBitmap.Create;
    try
      B.Height := Picture.Graphic.Height;
      B.Width := Picture.Graphic.Width;
      B.Assign(Picture.Graphic);
      FTransparentColor := B.TransparentColor and not $02000000;
    finally
      B.Free;
    end;
  end
  else
    FTransparentColor := clDefault;
end;

procedure TSpecialImage.Click;
begin

end;

procedure TSpecialImage.WMLButtonUp(var Message: TWMLButtonUp);
var
  P: TPoint;
begin
  inherited;
  if Assigned(Picture.Graphic) then
  begin
    P := SmallPointToPoint(Message.Pos);
    with P do
    begin
      OutputDebugString(PChar(Format('Pixels: %d %s Trans: %d %s',
        [Canvas.Pixels[x, y], ColorToString(Canvas.Pixels[x, y]), FTransparentColor, ColorToString(FTransparentColor)])));

      if PtInRect(ClientRect, P) and (Canvas.Pixels[x, y] <> FTransparentColor) then
        inherited Click;
    end;
  end
  else
    inherited Click;
end;

constructor TSpecialImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FOldPictureChanged := Picture.OnChange;
  Picture.OnChange := PictureChanged;
  FTransparentColor := clDefault;
end;

destructor TSpecialImage.Destroy;
begin
  Picture.OnChange := FOldPictureChanged;
  FOldPictureChanged := nil;
  inherited Destroy;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FBtn := TSpecialBitBtn.Create(Self);
  try
    FBtn.Parent := Self;
    FBtn.Kind := bkOK;
    FBtn.Left := 8;
    FBtn.Top := 8;
    FBtn.OnClick := BtnClick;
  except
    FBtn.Free;
    raise;
  end;

  FImage := TSpecialImage.Create(Self);
  try
    FImage.Parent := Self;
    FImage.Left := 8;
    FImage.Top := 40;
    FImage.AutoSize := True;
    FImage.Transparent := True;
    FImage.Picture.LoadFromFile('C:\Program Files\Common Files\Borland Shared\Images\Splash\16Color\Athena.bmp');
    FImage.OnClick := ImageClick;
  except
    FImage.Free;
    raise;
  end;
end;

procedure TForm1.BtnClick(Sender: TObject);
begin
  ShowMessage('click');
end;

procedure TForm1.ImageClick(Sender: TObject);
begin
  ShowMessage('click');
end;

Igor: looking at help for TPicture.Bitmap, I'm not sure if your suggestion will work for other pictures than .bmp...?
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 9

Expert Comment

by:ITugay
ID: 6479240
Ondrej,
seems you are right. Line of code:

    B := Picture.Bitmap;

should be replaced to

    B := TBitmap.Create;
    try
      B.Height := Picture.Graphic.Height;
      B.Width := Picture.Graphic.Width;
      B.Assign(Picture.Graphic);
      if B.Canvas.Pixels[LoWord(M.LParam), HiWord(M.LParam)] =
        (B.TransparentColor and $FFFFFF) then
        M.Result := 0
      else
        Inherited;
    finally
      B.Free;
    end;

----
Igor

0
 
LVL 8

Expert Comment

by:TOndrej
ID: 6479253
yep but in that case you're creating/destroying the bitmap on every left button down...
I thought about this too, and decided to only read the value of transparent color when the Picture is changed.
Cheers
0
 
LVL 9

Expert Comment

by:ITugay
ID: 6479270
Ondrej,

yes, I have put myself in the trap :-)

0
 
LVL 11

Author Comment

by:robert_marquardt
ID: 6479323
Sorry, both solutions for TBitBtn are wrong.
The control already has the focus when MouseDown is called and Click is called after MouseDown.

The TImage has to be tested this evening.
0
 
LVL 8

Expert Comment

by:TOndrej
ID: 6479349
My solution has nothing to do with MouseDown...
0
 
LVL 11

Author Comment

by:robert_marquardt
ID: 6479417
Yep. You use Click which is called AFTER MouseDown so the control has the focus already.
So i cannot decide if the click gave the focus or not.
0
 
LVL 9

Expert Comment

by:ITugay
ID: 6479432
Hi robert_marquard,

  TMyBitBtn = class(TBitBtn)
  protected
    procedure WndProc(var M: TMessage); override;
  end;

....
procedure TMyBitBtn.WndProc(var M: TMessage);
begin
  case M.Msg of
    WM_LBUTTONDOWN:
      if not Focused then
        SetFocus
      else
        Inherited;
  else
    Inherited
  end;
end;

-------
Igor.
0
 
LVL 8

Expert Comment

by:TOndrej
ID: 6479443
A click will always give the focus, there's nothing to decide. Except if the control is already focused then click will not change focus. Am I missing something?

You said:

"The trick is that a left click should only set focus to the control, but should not generate an OnClick
event."

That requirement is met perfectly. No OnClick is generated because inherited Click is never called.

I'm sure I've missed or I don't understand something important here; please try to explain in detail.
0
 
LVL 11

Author Comment

by:robert_marquardt
ID: 6479514
Yes. Just discovered that i worded it badly.
If not focused then the control should focus without OnClick. Clicking the focused control should give an OnClick.
0
 
LVL 8

Expert Comment

by:TOndrej
ID: 6479635
I see now :-)

type
  TSpecialBitBtn = class(TBitBtn)
  private
    FAllowClick: Boolean;
  protected
    procedure Click; override;
    procedure WndProc(var Message: TMessage); override;
  end;

procedure TSpecialBitBtn.Click;
begin
  if FAllowClick then
    inherited Click;
end;

procedure TSpecialBitBtn.WndProc(var Message: TMessage);
begin
  if Message.Msg = WM_LBUTTONDOWN then
    FAllowClick := Focused;
  inherited;
end;

Similar to Igor's suggestion but clicks are always shown visually (you see the button depressed and released).

HTH
TOndrej
0
 
LVL 9

Expert Comment

by:ITugay
ID: 6479649
Ondrej,

would it be problem if user focused button by [Tab] key?

Cheers,
Igor.

0
 
LVL 8

Expert Comment

by:TOndrej
ID: 6479662
Hi Igor :-)
I don't think so, why?
0
 
LVL 9

Expert Comment

by:ITugay
ID: 6479683
In this cases FAllowClick will be false, right?
Try to click it by [Space].
:-)
0
 
LVL 11

Author Comment

by:robert_marquardt
ID: 6479787
No problem with Tab or Space or whatever.
This will be a special button which can show all keys so Tab is disabled anyway. They also focus, but do not click.
Only left mouse button focuses and clicks. The other mouse buttons work already.

I think i will split the points.
0
 
LVL 8

Expert Comment

by:TOndrej
ID: 6479788
you're right, Igor :-)

next try:

type
  TSpecialBitBtn = class(TBitBtn)
  private
    FAllowClick: Boolean;
    FMouseFocus: Boolean;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  protected
    procedure Click; override;
    procedure WndProc(var Message: TMessage); override;
  end;

procedure TSpecialBitBtn.CMEnter(var Message: TCMEnter);
begin
  FAllowClick := not FMouseFocus;
  FMouseFocus := False;
  inherited;
end;

procedure TSpecialBitBtn.Click;
begin
  if FAllowClick then
    inherited Click;
  FAllowClick := True;
end;

procedure TSpecialBitBtn.WndProc(var Message: TMessage);
begin
  if Message.Msg = WM_LBUTTONDOWN then
  begin
    FMouseFocus := not Focused;
    FAllowClick := Focused;
  end;
  inherited;
end;
0
 
LVL 9

Expert Comment

by:ITugay
ID: 6479797
Ondrej,
yes, it is:-)

Robert,
glad to help you.



0
 
LVL 11

Author Comment

by:robert_marquardt
ID: 6481631
Here is the result of my tests for the special TImage.
The points go to ITugay because his first answer near.
For the special TbitBtn i will do more tests and set up a "points for" question if my solution is inspired by one of the comments here.

type
  TMyImage = class(TImage)
  private
    procedure WMLButtonDown(var Msg: TWMMouse); message WM_LBUTTONDOWN;
  end;

procedure Register;

implementation

procedure TMyImage.WMLButtonDown(var Msg: TWMMouse);
begin
  if Assigned(Picture) and Assigned(Picture.Bitmap) and Picture.Bitmap.Transparent and
    (Msg.XPos < Picture.Bitmap.Width) and (Msg.YPos < Picture.Bitmap.Height) and
    (Picture.Bitmap.Canvas.Pixels[Msg.XPos, Msg.YPos] <> (Picture.Bitmap.TransparentColor and $FFFFFF)) then
    inherited;
end;
0
 
LVL 11

Author Comment

by:robert_marquardt
ID: 6481649
I just discovered the it is even better to use CM_HITTEST instead of WM_LBUTTONDOWN. Same code as above.
That handles overlapping TMyImages which is important for me.
0
 
LVL 8

Expert Comment

by:TOndrej
ID: 6481728
I'm not sure but not calling inherited WMLButtonDown could possibly have undesired side effects; I had the impression that it's recommended to never suppress mouse button messages; IIRC csClicked is set and cleared somewhere down the ancestry chain; and my suggestion also seems cleaner to me.
CM_HITTEST is IMHO an excellent idea; it seems indeed ideal for this purpose.
Cheers
TOndrej
0
 
LVL 9

Expert Comment

by:ITugay
ID: 6481941
I agree that CM_HITTEST is better then WN_LBUTTONDOWN.
Ondrej is right about calling Inherited for mouse buttons events. They occurs in pair "down & up", and some flags may be set inside control. But usually nothing happen if inherit call skipped. Anyway, Message.Result should be assigned.

----
Igor
0
 
LVL 11

Author Comment

by:robert_marquardt
ID: 6482055
I finetuned again. Now inherited is called always (which sets Msg.Result) and then Msg.Result is changed with the test. This should be the safest way possible.

inherited;
if Assigned(Picture) and Assigned(Picture.Bitmap) and Picture.Bitmap.Transparent and
   (Msg.XPos < Picture.Bitmap.Width) and (Msg.YPos < Picture.Bitmap.Height) and
   (Picture.Bitmap.Canvas.Pixels[Msg.XPos, Msg.YPos] = (Picture.Bitmap.TransparentColor and $FFFFFF))
then
   Msg.Result := 0;
0
 
LVL 9

Expert Comment

by:ITugay
ID: 6482081
something like this.
Just a note. In some cases Inherited can change value of WParam and LParam, be carefull :-)

-----
Igor.
0
 
LVL 11

Author Comment

by:robert_marquardt
ID: 6484635
I got a hint for mouse activate which was not mentioned here. So no split points if that way will work.
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

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…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Monitoring a network: why having a policy is the best policy? Michael Kulchisky, MCSE, MCSA, MCP, VTSP, VSP, CCSP outlines the enormous benefits of having a policy-based approach when monitoring medium and large networks. Software utilized in this v…
If you’ve ever visited a web page and noticed a cool font that you really liked the look of, but couldn’t figure out which font it was so that you could use it for your own work, then this video is for you! In this Micro Tutorial, you'll learn yo…

726 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