Images on top

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 :(

Yeh... basically I guess that I need a transparent TPanel component :)

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

Well rather use this one :)

http://prdownloads.sourceforge.net/jvcl/JVCL300CompleteJCL195-Build1848.zip?download

regards,
Kate

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

Oh yeh, that code also generates delphi 7 errors when I close delphi :(

Ok... I tried out the JvPanel. The problem is that once I embed the program, it covers up the image :(

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.

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.

Bump?

I'm trying to use the PKIMGBTN component. And its still under:(

Bump? :o

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

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 :(

????
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.

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

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?

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;

is it doing what you need?

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?

Like how would I get ImgBtn( http://delphi.icm.edu.pl/ftp/d20free/imgbtn.zip ) to have its own handle?

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.

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 :(

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?