?
Solved

Images on top

Posted on 2005-05-03
27
Medium Priority
?
628 Views
Last Modified: 2010-04-05
Hi. I've got this problem were I can't set an image to be on top of a groupbox. In the groupbox I am embedding a separate application, and I want to have the ability to have images on top of the groupbox. Right now I can only put buttons on top, but images, shapes, etc get put behind the groupbox.

Thanks :)
0
Comment
Question by:the_modder
  • 14
  • 8
  • 2
  • +3
27 Comments
 
LVL 4

Expert Comment

by:StevenB
ID: 13923649
Put the image on a TPanel and then put the panel on top of the groupbox.
0
 
LVL 1

Author Comment

by:the_modder
ID: 13923716
The TPanel works, but say that I'm going to be using a transparent image. The problem that I am going to have is that the transparency will only work with until it hits the TPanel :(
0
 
LVL 1

Author Comment

by:the_modder
ID: 13924002
Yeh... basically I guess that I need a transparent TPanel component :)
0
Industry Leaders: 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 10

Expert Comment

by:_Katka_
ID: 13924080
You can use JEDI VCL library it contains TJvPanel with transparency.
Also you can try to say to TImage.BringToFront but this works oddly.

JVCL library: http://mesh.dl.sourceforge.net/sourceforge/jvcl/JVCL300CompleteJCL195-Build1848.zip

regards,
Kate
0
 
LVL 10

Expert Comment

by:_Katka_
ID: 13924084
0
 
LVL 1

Author Comment

by:the_modder
ID: 13924085
http://forum.nifty.com/fdelphi/samples/01026.html
That's the code I'm using for the transparent TPanel. Now the problem is that it DOESN'T REFRESH! If I change it from day to night mode then it still shows the day mode :(

Illustration of the problem:
http://www.whipflash.com/vamr/problem.gif
0
 
LVL 1

Author Comment

by:the_modder
ID: 13924094
Oh yeh, that code also generates delphi 7 errors when I close delphi :(
0
 
LVL 1

Author Comment

by:the_modder
ID: 13924174
Ok... I tried out the JvPanel. The problem is that once I embed the program, it covers up the image :(
0
 
LVL 11

Expert Comment

by:pcsentinel
ID: 13924744
Heres a quick component knockup that adds a bitmap property

hope it helps

unit ImageGroupBox;

interface

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

type
  TImageGroupBox = class(TGroupBox)
  private
    FBitmap: TBitmap;
    procedure SetBitmap(const Value: TBitmap);
  protected
    procedure Paint; override;
  public
  published
        property Bitmap: TBitmap read FBitmap write SetBitmap;
  end;

procedure Register;

implementation

procedure TImageGroupBox.Paint;
var
  H: Integer;
  R: TRect;
  Flags: Longint;
begin
  with Canvas do
  begin
    Font := Self.Font;
    H := TextHeight('0');
    R := Rect(0, H div 2 - 1, Width, Height);
    if Ctl3D then
    begin
      Inc(R.Left);
      Inc(R.Top);
      Brush.Color := clBtnHighlight;
      FrameRect(R);
      OffsetRect(R, -1, -1);
      Brush.Color := clBtnShadow;
    end else
      Brush.Color := clWindowFrame;
    FrameRect(R);
    if Assigned(FBitmap) then
    begin
          StretchDraw(R,FBitmap);
    end;
    if Text <> '' then
    begin
      if not UseRightToLeftAlignment then
        R := Rect(8, 0, 0, H)
      else
        R := Rect(R.Right - Canvas.TextWidth(Text) - 8, 0, 0, H);
      Flags := DrawTextBiDiModeFlags(DT_SINGLELINE);
      DrawText(Handle, PChar(Text), Length(Text), R, Flags or DT_CALCRECT);
      Brush.Color := Color;
      DrawText(Handle, PChar(Text), Length(Text), R, Flags);
    end;
  end;
end;

procedure TImageGroupBox.SetBitmap(const Value: TBitmap);
begin
  FBitmap := Value;
  Repaint;
end;


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


end.
0
 
LVL 1

Author Comment

by:the_modder
ID: 13932008
pcsentinel: The code doesn't make a transparent image. I need parts of the image to be transparent. It would be great if I could place any component on it and have it be over the groupbox.
0
 
LVL 1

Author Comment

by:the_modder
ID: 13932807
Bump?
0
 
LVL 1

Author Comment

by:the_modder
ID: 13933282
I'm trying to use the PKIMGBTN component. And its still under:(
0
 
LVL 1

Author Comment

by:the_modder
ID: 13940991
Bump? :o
0
 
LVL 35

Expert Comment

by:Slick812
ID: 13952865
hello the_modder ,  here is some code for a "BitMap Shaped Window" in the  BmpShapeWnd unit, , I am not to sure from your description what you may want as far as transparent? However you give the TImage transparency as an example, so this  TBmpShapeWnd   will do that sort of thing. . There are not many properties to this component, The main useful property is the Bitmap Property, you load or set this bitmap to one you use for the transparent areas, as the default "Transparent Color" it will use the pixel color in the Lower Left corner for the transparent color, and create a region from the bitmap and then the window will be the shape of the bitmap. .  I did not test this for wierd bitmaps, like one only one pixel wide or a solid color, but it seems to work for me. . .
 the  procedure NewBmpNoShape(Bmp: TBitmap);  will place a new bitmap into the bitmap used, BUT it will NOT scan the new bitmap and make a new shape, so the shape does not change, just the bitmap, this can be used if your replace one bitmap with another that has the same shape.




unit BmpShapeWnd;

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

type
TBmpShapeWnd = class(TCustomControl)
  private
  { Private declarations }
    FColor: TColor;
    FRgn: Integer;
    FOnPaint: TNotifyEvent;
    procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;

  protected
  { Protected declarations }
    FBmp: TBitmap;
    PixStart, Adj, RgnX, RgnY: Integer;
    RgnStart: Boolean;
    procedure setBmp(Value : TBitMap);
    procedure SetColor(Value: TColor);
    function ReturnRgn(ThisRgn: Integer): Integer;
    procedure MakeBmpRegion;
    procedure Paint; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure AssignTo(Dest: TPersistent); override;

  public
  { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure NewBmpNoShape(Bmp: TBitmap);
    property Canvas;

  published
  { Published declarations }
    property Color: TColor read FColor write SetColor default clAqua;
    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
    property Bitmap: TBitMap read FBmp write setBmp;
    property Height default 100;
    property Width default 100;

end;

procedure Register;


implementation

uses
  SysUtils;

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


constructor TBmpShapeWnd.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := [csAcceptsControls, csFixedWidth, csFixedHeight];
FColor := clAqua;
Width := 100;
Height := 100;
FRgn := 0;
FBmp := TBitmap.Create;
end;

destructor TBmpShapeWnd.Destroy;
begin
FreeAndNil(FBmp);
inherited Destroy;
end;

procedure TBmpShapeWnd.CreateWnd;
begin
inherited;
if not FBmp.Empty then
MakeBmpRegion;
if FRgn > 0 then
  SetWindowRgn(Handle, FRgn, TRUE);
end;

procedure TBmpShapeWnd.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
  WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
end;

procedure TBmpShapeWnd.setBmp(Value: TBitMap);
begin
if (Value = nil) and HandleAllocated then
  begin
  SetWindowRgn(Handle, 0, TRUE);
  FRgn := 0;
  FBmp.ReleaseHandle
  end;

FBmp.Assign(Value);
if not FBmp.Empty then
  begin
  Height := FBmp.Height;
  Width := FBmp.Width;
  MakeBmpRegion;
  if FRgn > 0 then
    SetWindowRgn(Handle, FRgn, TRUE);
  end;
Paint;
end;

procedure TBmpShapeWnd.NewBmpNoShape(Bmp: TBitmap);
begin
if (Bmp = nil) or Bmp.Empty then Exit;
FBmp.Assign(Bmp);
Paint;
end;

procedure TBmpShapeWnd.SetColor(Value: TColor);
begin
if FColor = Value then Exit;
FColor := Value;
if FBmp.Empty then Paint;
end;

procedure TBmpShapeWnd.WMEraseBkgnd(var Message: TMessage);
begin
Message.Result := 1;
end;


function TBmpShapeWnd.ReturnRgn(ThisRgn: Integer): Integer;
var
TempRgn2 : Integer;
begin
{in Win 98 there is unusual problems when combining Regions,
if you Combine a region more than about 400 times, Win 98 does
strange things, this is my solution. This combines the region but
the pointer references to this function, ThisRgn, and TempRgn2 are
gone when the function is done}
TempRgn2 := 0;
if RgnStart then
     begin
     ThisRgn :=CreateRectRgn(PixStart,RgnY,RgnX+Adj,RgnY+1);
     RgnStart := False;
     Adj := 0;
     PixStart := 0;
     end
  else
     begin
     TempRgn2 := CreateRectRgn(PixStart,RgnY,RgnX+Adj,RgnY+1);
     CombineRgn(ThisRgn, ThisRgn, TempRgn2, RGN_OR);
     Adj := 0;
     PixStart := 0;
     end;

Result := ThisRgn;
if TempRgn2 <> 0 then
DeleteObject(TempRgn2);
end;

procedure TBmpShapeWnd.MakeBmpRegion;
Type
  PAryCard = ^TAryCard;
  TAryCard = Array[Word] of Cardinal;

var
ScanBmp: TBitmap;
pScanAry: PAryCard;
y, x, TempRgn, Error1: Integer;
PixRgn: Boolean;
aColor: Cardinal;
begin
FRgn := 0;
if FBmp.Empty then Exit;
RgnStart := True;
PixRgn := False;
PixStart := 0;
Adj := 0;
aColor := FBmp.Canvas.Pixels[0,FBmp.Height-1];
aColor := ((aColor and $FF) shl 16) or (aColor and $FF00) or ((aColor and $FF0000) shr 16);
TempRgn := CreateRectRgn(0,0,0,0);
if TempRgn = 0 then Exit;
ScanBmp := TBitmap.Create;
  try
  ScanBmp.Assign(Fbmp);
  ScanBmp.PixelFormat := pf32Bit;

  for y := 0 to ScanBmp.Height -1 do
    begin   // 1
    RgnY := y;
    pScanAry := ScanBmp.ScanLine[y];
    for x := 0 to ScanBmp.Width -1 do
      begin // 2
      RgnX := x;
      if pScanAry[x] and $FFFFFF = aColor then
        begin // 3
        if PixRgn then TempRgn := ReturnRgn(TempRgn);
        PixRgn := False;
        end else // 3
        begin // 4
        if not PixRgn then PixStart := x;
        if x = ScanBmp.Width -1 then
          begin // 5
          Adj := 1;
          TempRgn := ReturnRgn(TempRgn);
          end; // 5
        PixRgn := True;
        end; // 4
    end; // 2
  end;  // 1
  FRgn := CreateRectRgn(0,0,0,0);
  Error1 := CombineRgn(FRgn, TempRgn, FRgn, RGN_COPY);
  if (Error1 = NULLREGION) or (Error1 = ERROR) then
    FRgn := 0;
 
  finally
  DeleteObject(TempRgn);
  FreeAndNil(ScanBmp);
  end;
end;

procedure TBmpShapeWnd.Paint;
var
bColor: TColor;
begin
if not FBmp.Empty then
  Canvas.Draw(0,0,FBmp)
  else
  with Canvas do
    begin
    bColor := Brush.Color;
    Brush.Color := FColor;
    FillRect(GetClientRect);
    Brush.Color := bColor;
    end;
if Assigned(FOnPaint) then FOnPaint(Self);
end;


procedure TBmpShapeWnd.AssignTo(Dest: TPersistent);
begin
if Dest is TBmpShapeWnd then
  begin
  TBmpShapeWnd(Dest).FColor := FColor;
  TBmpShapeWnd(Dest).FBmp.Assign(FBmp);
  TBmpShapeWnd(Dest).FOnPaint := FOnPaint;
  if TBmpShapeWnd(Dest).HandleAllocated and (not TBmpShapeWnd(Dest).FBmp.Empty) then
    begin
    TBmpShapeWnd(Dest).MakeBmpRegion;
    SetWindowRgn(TBmpShapeWnd(Dest).Handle, TBmpShapeWnd(Dest).FRgn, TRUE);
    end;  
  end else inherited Assign(Dest);
end;

end.

= = = = = = = = = = = =  = = = = =

ask questions if you need more info
0
 
LVL 1

Author Comment

by:the_modder
ID: 13953120
Slick812: I installed the code, but I can't get it to work. i loaded up a button with transparency around it, and it shwos that it has a white border instead of the transparency. It also does not become transparent if I change the color to white :(
0
 
LVL 35

Expert Comment

by:Slick812
ID: 13955065
????
I think that maybe I used the wrong type for the FRgn, this worked on my XP system when testing, and today when I tried it, it became Inconsistant, sometimes working and sometimes not, so I changed the FRgn to a cardinal, and now it seems to do OK?

the Color does nothing if you have a bitmap loaded,
But since you mentioned it I added a TransColor property, which is like the TBitmap  TransparentColor, if you need a color, other than the lower left corner of bitmap, then set the TransColor to the color you want to be transparent. .
I hope this works,



unit BmpShapeWnd;

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


type
TBmpShapeWnd = class(TCustomControl)
  private
  { Private declarations }
    FColor, FTransColor: TColor;
    FRgn: Cardinal;
    FOnPaint: TNotifyEvent;
    procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;

  protected
  { Protected declarations }
    FBmp: TBitmap;
    PixStart, Adj, RgnX, RgnY: Integer;
    RgnStart: Boolean;
    procedure setBmp(Value : TBitMap);
    procedure SetColor(Value: TColor);
    function ReturnRgn(ThisRgn: Integer): Integer;
    procedure MakeBmpRegion;
    procedure Paint; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure AssignTo(Dest: TPersistent); override;

  public
  { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure NewBmpNoShape(Bmp: TBitmap);
    property Canvas;

  published
  { Published declarations }
    property Color: TColor read FColor write SetColor default clAqua;
    property TransColor: TColor read FTransColor write FTransColor default clDefault;
    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
    property Bitmap: TBitMap read FBmp write setBmp;
    property Height default 100;
    property Width default 100;

end;

procedure Register;


implementation

uses
  SysUtils;

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


constructor TBmpShapeWnd.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := [csAcceptsControls, csFixedWidth, csFixedHeight];
FColor := clAqua;
Width := 100;
Height := 100;
FRgn := 0;
FTransColor := clDefault;
FBmp := TBitmap.Create;
end;

destructor TBmpShapeWnd.Destroy;
begin
FreeAndNil(FBmp);
inherited Destroy;
end;

procedure TBmpShapeWnd.CreateWnd;
begin
inherited;
if not FBmp.Empty then
  begin
  MakeBmpRegion;
  if FRgn = 0 then
    MakeBmpRegion;
  if FRgn <> 0 then
    begin
    SetWindowRgn(Handle, FRgn, TRUE);
    end;
  end;
end;

procedure TBmpShapeWnd.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
  WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
end;

procedure TBmpShapeWnd.setBmp(Value: TBitMap);
begin
if (Value = nil) and HandleAllocated then
  begin
  SetWindowRgn(Handle, 0, TRUE);
  FRgn := 0;
  FBmp.ReleaseHandle;
  Paint;
  Exit;
  end;

FBmp.Assign(Value);
if not FBmp.Empty then
  begin
  Height := FBmp.Height;
  Width := FBmp.Width;

  MakeBmpRegion;
  if FRgn = 0 then
    MakeBmpRegion;
  if FRgn = 0 then
    MakeBmpRegion;
  if FRgn <> 0 then
    SetWindowRgn(Handle, FRgn, True);
  Paint;
  end;
end;

procedure TBmpShapeWnd.NewBmpNoShape(Bmp: TBitmap);
begin
if (Bmp = nil) or Bmp.Empty then Exit;
FBmp.Assign(Bmp);
Paint;
end;

procedure TBmpShapeWnd.SetColor(Value: TColor);
begin
if FColor = Value then Exit;
FColor := Value;
if FBmp.Empty then Paint;
end;

procedure TBmpShapeWnd.WMEraseBkgnd(var Message: TMessage);
begin
Message.Result := 1;
end;


function TBmpShapeWnd.ReturnRgn(ThisRgn: Integer): Integer;
var
TempRgn2 : Integer;
begin
TempRgn2 := 0;
if RgnStart then
     begin
     ThisRgn :=CreateRectRgn(PixStart,RgnY,RgnX+Adj,RgnY+1);
     RgnStart := False;
     Adj := 0;
     PixStart := 0;
     end
  else
     begin
     TempRgn2 := CreateRectRgn(PixStart,RgnY,RgnX+Adj,RgnY+1);
     CombineRgn(ThisRgn, ThisRgn, TempRgn2, RGN_OR);
     Adj := 0;
     PixStart := 0;
     end;

Result := ThisRgn;
if TempRgn2 <> 0 then
DeleteObject(TempRgn2);
end;

procedure TBmpShapeWnd.MakeBmpRegion;
Type
  PAryCard = ^TAryCard;
  TAryCard = Array[Word] of Cardinal;

var
ScanBmp: TBitmap;
pScanAry: PAryCard;
y, x, TempRgn, Error1: Integer;
PixRgn: Boolean;
aColor: Cardinal;
begin
FRgn := 0;
if FBmp.Empty then Exit;
RgnStart := True;
PixRgn := False;
PixStart := 0;
Adj := 0;
if FTransColor = clDefault then
  aColor := FBmp.Canvas.Pixels[0,FBmp.Height-1]
  else
  aColor := FTransColor;

aColor := ((aColor and $FF) shl 16) or (aColor and $FF00) or ((aColor and $FF0000) shr 16);
TempRgn := CreateRectRgn(0,0,0,0);
if TempRgn = 0 then Exit;
ScanBmp := TBitmap.Create;
  try
  ScanBmp.Assign(Fbmp);
  ScanBmp.PixelFormat := pf32Bit;

  for y := 0 to ScanBmp.Height -1 do
    begin   // 1
    RgnY := y;
    pScanAry := ScanBmp.ScanLine[y];
    for x := 0 to ScanBmp.Width -1 do
      begin // 2
      RgnX := x;
      if pScanAry[x] and $FFFFFF = aColor then
        begin // 3
        if PixRgn then TempRgn := ReturnRgn(TempRgn);
        PixRgn := False;
        end else // 3
        begin // 4
        if not PixRgn then PixStart := x;
        if x = ScanBmp.Width -1 then
          begin // 5
          Adj := 1;
          TempRgn := ReturnRgn(TempRgn);
          end; // 5
        PixRgn := True;
        end; // 4
    end; // 2
  end;  // 1
  FRgn := CreateRectRgn(0,0,0,0);
  Error1 := CombineRgn(FRgn, TempRgn, FRgn, RGN_COPY);
  if (Error1 = NULLREGION) or (Error1 = ERROR) then
    FRgn := 0;
 
  finally
  DeleteObject(TempRgn);
  FreeAndNil(ScanBmp);
  end;
end;

procedure TBmpShapeWnd.Paint;
var
bColor: TColor;
begin
if not FBmp.Empty then
  Canvas.Draw(0,0,FBmp)
  else
  with Canvas do
    begin
    bColor := Brush.Color;
    Brush.Color := FColor;
    FillRect(GetClientRect);
    Brush.Color := bColor;
    end;
if Assigned(FOnPaint) then FOnPaint(Self);
end;


procedure TBmpShapeWnd.AssignTo(Dest: TPersistent);
begin
if Dest is TBmpShapeWnd then
  begin
  TBmpShapeWnd(Dest).FColor := FColor;
  TBmpShapeWnd(Dest).FTransColor := FTransColor;
  TBmpShapeWnd(Dest).FBmp.Assign(FBmp);
  TBmpShapeWnd(Dest).FOnPaint := FOnPaint;
  if TBmpShapeWnd(Dest).HandleAllocated and (not TBmpShapeWnd(Dest).FBmp.Empty) then
    begin
    TBmpShapeWnd(Dest).MakeBmpRegion;
    SetWindowRgn(TBmpShapeWnd(Dest).Handle, TBmpShapeWnd(Dest).FRgn, TRUE);
    end;  
  end else inherited Assign(Dest);
end;

end.
0
 
LVL 1

Author Comment

by:the_modder
ID: 13957683
Slick812: The code you gave works great! But I'd need it to do everything that ImgBtn( http://delphi.icm.edu.pl/ftp/d20free/imgbtn.zip ) supports, like events, visibility, changeing image, etc..
Otherwise it works great! It stays on top of the panel. And the transparency works great :D
0
 
LVL 35

Expert Comment

by:Slick812
ID: 13961171
OK, I do not have time right now to re-do this thing, but I would guess that if you change one line

TBmpShapeWnd = class(TCustomControl)

to

TBmpShapeWnd = class(TPanel)

it just might do that, give you the events and such, however there may be left over properties that might not agree, but it's worth a try, , I may or may not have time tomorow or the next day to mess with it?, But I can not spend the time to develop a whole region based button control right now. . .

I really do not get your request for changeing image, I thought that was in there allready?
0
 
LVL 35

Expert Comment

by:Slick812
ID: 13961927
I looked at another  TCustomControl that I did and I can see that for any of the TControl stuff (events and sush) you just need to declare them in your published section, so you might keep the -
TBmpShapeWnd = class(TCustomControl)

and add some to the published section like this -



  published
  { Published declarations }
    property Color: TColor read FColor write SetColor default clAqua;
    property TransColor: TColor read FTransColor write FTransColor default clDefault;
    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
    property Bitmap: TBitMap read FBmp write setBmp;
    property Height default 100;
    property Width default 100;

    property Anchors;
    property Enabled;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    //property TabOrder; // not sure if you need tabs
    //property TabStop;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnEnter;
    property OnExit;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;

  end;


0
 
LVL 35

Expert Comment

by:Slick812
ID: 13981008
is it doing what you need?
0
 
LVL 1

Author Comment

by:the_modder
ID: 14004884
I had to comment out property TransColor: TColor read FTransColor write FTransColor default clDefault; because it said field or method identifier expected.

Slick: So, how do you make any control have its own handle?
0
 
LVL 1

Author Comment

by:the_modder
ID: 14004885
Like how would I get ImgBtn( http://delphi.icm.edu.pl/ftp/d20free/imgbtn.zip ) to have its own handle?
0
 
LVL 35

Expert Comment

by:Slick812
ID: 14006621
I do not think you can use a component based on a TImage, and just change it to a windowed control, it would require a whole different approach, as far as I know, the whole "Transpaency" thing is what you seem to need here, and a windowed control has  different factors to deal with using transparency.
0
 
LVL 1

Author Comment

by:the_modder
ID: 14006663
Arg... there's gotta be a way to get ImgBtn to stay ontop of an embedded application. I've got a navigation window embedded and I need to put some buttons on top of it, and have them change on mouse over, mouse down, etc.
For some reason the transparent panels always disappear, or don't update their borders when the map moves :(
0
 
LVL 35

Expert Comment

by:Slick812
ID: 14008039
No way, in my opinion,

 you seem to be looking for a "Button" type of component,

I gave you code to answer your original question -
" image to be on top of a groupbox". . . .

you said nothing about a "Button" in your original question?

have you looked at Torry's or other componet sites, I remember seeing 100's of Picture Button components, although many of them are like the imgbut thing you gave a link for, not so good, that thing  has NO code for  the assign method?
0
 
LVL 35

Accepted Solution

by:
Slick812 earned 404 total points
ID: 14020542
Since this question has been up for almost 2 weeks, , I did some code for a modder button, which is not really a button (based on a TButton) but something that is kind of a graphical image window with a region, that you can click for a button effect. It has 4 bitmaps to give it the Normal, mouse Over, mouse Down, and Disabled look.
I did very little testing for this, and just slapped code into it for the button states, but it seems to work for the button image I tried with it, it also assign to another TmodderBut and transfers all the bitmaps. . . . . . . . . . .


unit modderBut;

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

type
TmodderBut = class(TCustomControl)
  private
  { Private declarations }

  protected
  { Protected declarations }
    FColor, FTransColor: TColor;
    FRgn: Cardinal;
    FOnPaint: TNotifyEvent;
    FNorm, FOver, FDown, FDisA: TBitmap;
    fPixStart, fRgnX, fRgnY, fRgnY2: Integer;
    FRgnStart: Bool;
    procedure DoCaption(Shift: BOOL = False);
    procedure SetNorm(Value: TBitmap);
    procedure SetOver(Value: TBitmap);
    procedure SetDown(Value: TBitmap);
    procedure SetDisA(Value: TBitmap);
    procedure SetColor(Value: TColor);
    procedure NormChange(Sender: TObject);
    procedure ReturnRgn(ThisRgn: Cardinal);
    procedure MakeRegion;
    procedure Paint; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure AssignTo(Dest: TPersistent); override;
    function CanResize(var NewWidth, NewHeight: Integer): Boolean; override;
    procedure WMLButDown(var Message: TMessage); message WM_LBUTTONDOWN;
    procedure WMLButUp(var Message: TMessage); message WM_LBUTTONUP;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;

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

  published
  { Published declarations }
    property Color: TColor read FColor write SetColor default clAqua;
    property TransColor: TColor read FTransColor write FTransColor default clDefault;
    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
    property NormalBmp: TBitmap read FNorm write SetNorm;
    property OverBmp: TBitmap read FOver write SetOver;
    property DownBmp: TBitmap read FDown write SetDown;
    property DisableBmp: TBitmap read FDisA write SetDisA;
    property Height default 24;
    property Width default 80;

    property Action;
    property Anchors;
    property Caption;
    property Cursor;
    property Enabled;
    property Font;
    property Hint;
    property Left;
    property Name;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Tag;
    property Top;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;

  end;

procedure Register;


implementation

uses
  SysUtils;

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


constructor TmodderBut.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := [csClickEvents, csCaptureMouse, csFixedWidth, csFixedHeight];
FColor := clAqua;
Width := 80;
Height := 24;
FRgn := 0;
FTransColor := clDefault;
FNorm := TBitmap.Create;
FNorm.OnChange := NormChange;
FOver := TBitmap.Create;
FDown := TBitmap.Create;
FDisA := TBitmap.Create;
end;

destructor TmodderBut.Destroy;
begin
FreeAndNil(FNorm);
FreeAndNil(FOver);
FreeAndNil(FDown);
FreeAndNil(FDisA);
inherited Destroy;
end;

procedure TmodderBut.DoCaption(Shift: BOOL = False);
var
cRect: TRect;
begin
if Length(Caption) > 0 then
  begin
  cRect := ClientRect;
  Canvas.Font := Font;
  SetBkMode(Canvas.Handle, TRANSPARENT);
  if Shift then
    OffSetRect(cRect,1,1);
  if not Enabled then windows.SetTextColor(Canvas.Handle, $747070);
  DrawText(Canvas.Handle,PChar(Caption),-1,cRect,DT_SINGLELINE or DT_VCENTER or DT_CENTER);
  end;
end;

procedure TmodderBut.CreateWnd;
begin
inherited;
if not FNorm.Empty then
  begin
  MakeRegion;
  if FRgn = 0 then
    MakeRegion;
  if FRgn <> 0 then
    SetWindowRgn(Handle, FRgn, TRUE);
  end;
end;

procedure TmodderBut.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
  begin
  WindowClass.lpszClassName := 'TmodderBut';
  WindowClass.hbrBackground := 0;
  WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
  end;
end;

function TmodderBut.CanResize(var NewWidth, NewHeight: Integer): Boolean;
begin
Result := False;
if FNorm.Empty then Result := True else
  if (NewWidth = FNorm.Width) and (NewHeight = FNorm.Height) then Result := True;
end;

procedure TmodderBut.SetOver(Value : TBitmap);
begin
FOver.Assign(Value);
end;

procedure TmodderBut.SetDown(Value : TBitmap);
begin
FDown.Assign(Value);
end;

procedure TmodderBut.SetDisA(Value : TBitmap);
begin
FDisA.Assign(Value);
end;

procedure TmodderBut.setNorm(Value: TBitmap);
begin
FNorm.Assign(Value);
if not FNorm.Empty then
  begin
  SetBounds(Left,Top,FNorm.Width,FNorm.Height);
  if not HandleAllocated then Exit;
  MakeRegion;
  SetWindowRgn(Handle, FRgn, True);
  end;
Paint;
end;

procedure TmodderBut.NormChange(Sender: TObject);
begin
SetBounds(Left,Top,FNorm.Width,FNorm.Height);
if (not HandleAllocated) then Exit;
MakeRegion;
SetWindowRgn(Handle, FRgn, True);
Paint;
end;


procedure TmodderBut.SetColor(Value: TColor);
begin
if FColor = Value then Exit;
FColor := Value;
if  FNorm.Empty then Paint;
end;

procedure TmodderBut.WMLButDown(var Message: TMessage);
begin
if Enabled and (not FDown.Empty) then
  begin
  Canvas.Draw(0,0,FDown);
  DoCaption(True);
  end;
inherited;
end;

procedure TmodderBut.WMLButUp(var Message: TMessage);
begin
if Enabled then
  begin
  if not FOver.Empty then
    Canvas.Draw(0,0,FOver) else
    if not FNorm.Empty then
      Canvas.Draw(0,0,FNorm);
  DoCaption;
  end;
inherited;
end;

procedure TmodderBut.CMMouseLeave(var Message: TMessage);
begin
if Enabled and (not FNorm.Empty) then
  begin
  Canvas.Draw(0,0,FNorm);
  DoCaption;
  end;
end;

procedure TmodderBut.CMMouseEnter(var Message: TMessage);
begin
if Enabled and (not FOver.Empty) then
  begin
  Canvas.Draw(0,0,FOver);
  DoCaption;
  end;
end;

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

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

procedure TmodderBut.ReturnRgn(ThisRgn: Cardinal);
var
hRgn2 : Cardinal;
begin
hRgn2 := CreateRectRgn(fPixStart,fRgnY,fRgnX,fRgnY2);
CombineRgn(ThisRgn, ThisRgn, hRgn2, RGN_OR);
fPixStart := 0;
DeleteObject(hRgn2);
end;

procedure TmodderBut.MakeRegion;
var
ScanBmp: TBitmap;
pCard: PDWORD;
y, x, Error1, wid: Integer;
PixRgn: Bool;
TempRgn, aColor: Cardinal;
begin
FRgn := 0;
if FNorm.Empty then Exit;
FRgnStart := True;
PixRgn := False;
fPixStart := 0;
TempRgn := CreateRectRgn(0,0,0,0);
if TempRgn = 0 then Exit;
ScanBmp := TBitmap.Create;
  try
  ScanBmp.PixelFormat := pf32Bit;
  ScanBmp.Canvas.Brush.Color := $D207CE;
  ScanBmp.Height := FNorm.Height;
  ScanBmp.Width := FNorm.Width;
  ScanBmp.Canvas.Draw(0,0,FNorm);
  if FTransColor = clDefault then
    aColor := ScanBmp.Canvas.Pixels[0,ScanBmp.Height-1]
    else
    aColor := FTransColor;
  aColor := ((aColor and $FF) shl 16) or (aColor and $FF00) or ((aColor and $FF0000) shr 16);
  wid := ScanBmp.Width-1;
  pCard := ScanBmp.ScanLine[ScanBmp.Height -1];
  for y := ScanBmp.Height -1 downto 0 do
    begin   // 1
    fRgnY := y;
    fRgnY2 := y+1;

    for x := 0 to wid do
      begin // 2
      fRgnX := x;
      if pCard^ and $FFFFFF = aColor then
        begin // 3
        if PixRgn then
          begin
          ReturnRgn(TempRgn);
          PixRgn := False;
          end;
        end else // 3
        begin // 4
        if not PixRgn then
          begin
          fPixStart := x;
          PixRgn := True;
          end;
        if x = wid then
          begin // 5
          Inc(fRgnX);
          ReturnRgn(TempRgn);
          end; // 5

        end; // 4
      Inc(pCard);
      end; // 2

  end;  // 1
  FRgn := CreateRectRgn(0,0,0,0);
  Error1 := CombineRgn(FRgn, TempRgn, FRgn, RGN_COPY);
  if (Error1 = NULLREGION) or (Error1 = ERROR) then
    FRgn := 0;
 
  finally
  DeleteObject(TempRgn);
  FreeAndNil(ScanBmp);
  end;
end;



procedure TmodderBut.Paint;
var
bColor: TColor;
aPic: TBitmap;
begin
if FNorm.Empty then
  begin
  with Canvas do
    begin
    bColor := Brush.Color;
    Brush.Color := FColor;
    Rectangle(GetClientRect);
    Brush.Color := bColor;
    end;
  end else
  begin
  aPic := FNorm;
  if (not Enabled) and (not FDisA.Empty) then
    aPic := FDisA;
  Canvas.Draw(0,0,aPic);
  end;
DoCaption;
if Assigned(FOnPaint) then FOnPaint(Self);
end;


procedure TmodderBut.AssignTo(Dest: TPersistent);
begin
if Dest is TmodderBut then
  begin
  with TmodderBut(Dest) do
    begin
    FColor := Self.FColor;
    FTransColor := FTransColor;
    FNorm.Assign(Self.FNorm);
    FOver.Assign(Self.FOver);
    FDown.Assign(Self.FDown);
    FDisA.Assign(Self.FDisA);
    FOnPaint := Self.FOnPaint;
    Parent := Self.Parent;
    Caption := Self.Caption;
    Font.Assign(Self.Font);
    if Self.FNorm.Empty then
      begin
      Width := Self.Width;
      Height := Self.Height;
      end else
      if HandleAllocated then
      begin
      MakeRegion;
      SetWindowRgn(Handle, FRgn, TRUE);
      end;
    end;
  end else inherited Assign(Dest);
end;

end.


 = = = = = = = = = = =  = = = = = = = = =  = =

I hope you can have your button now with this code
0
 

Expert Comment

by:rpmccormi77
ID: 14894471
I am now working on thios same project.  Thank's for TmodderBut, it was cool, but my requirements have changed a bit now...

1) I needed to be able to detect clicks even on the transparent parts (so I can't use RGN stuff)
2) I needed to support PNG alpha-blended semi-transparancy (so I have to use WS_EX_TRANSPARENT).

I almost have it all working, except when the map window gets repainted, my compontent does not repaint itself so it just disapears.  You can still click its buttons which makes it re-draw though.  Plus if you minimize and restore the app, it always looks perfect.

How can I detect when the embedded map window repaints its self so I can repaint my buttons?

Thanks.
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

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…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Integration Management Part 2
Is your organization moving toward a cloud and mobile-first environment? In this transition, your IT department will encounter many challenges, such as navigating how to: Deploy new applications and services to a growing team Accommodate employee…
Suggested Courses
Course of the Month9 days, 7 hours left to enroll

621 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