Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

How do I manipulate a dynamic array of variable sized Delphi TBitmaps?

Posted on 2007-10-08
9
Medium Priority
?
318 Views
Last Modified: 2013-11-22
I need to know if it is possible to manipulate a dynamic array of tbitmaps of variable sizes. ( Because ot the varrying size, I can't use to TimageList)

This is the code I propose to use to add and remove elements from the array.  Can anyone confirm that this will work - or correct any problems or definately tell me this can't be safely done at all.  I'd like some "Expert" opinions before I try using this code.  Because I'd like a good answer and if this or something like it will work I need to get this code out to my client today I'm spending 500 points to be shared among those who give me good information about this.

type
  TBitmapArray = array of TBitmap;

public
    BMParray : TBitmapArray;
    procedure newBMP(ba: TBitmapArray; x,y,w,h: integer);
    procedure killBMP(ba: TBitmapArray; index: integer);

implementation

procedure T_form.newBMP(ba: TBitmapArray; x,y,w,h: integer);
var
  n: integer;
  DC : HDC;
begin
  DC := GetDC (GetDesktopWindow) ;
  try
   n:= High(BMParray)+1;
   SetLength(BMParray,n);
   BMParray[n]:=TBitMap.Create;
   BMParray[n].Width:=w;
   BMParray[n].Height:=h;
   // The actual populating of the bitmaps is more complicate than the following
   // but they will be variable size and this will suffice as an example
   BitBlt(BMParray[n].Canvas.Handle, 0, 0, BMParray[n].Width, BMParray[n].Height, DC, x, y, SRCCOPY) ;
  finally
   ReleaseDC (GetDesktopWindow, DC) ;
  end;
end;

procedure T_form.killBMP(ba: TBitmapArray; index: Integer);
begin
  if (index<=High(ba)) and (index>=Low(ba)) then
  begin
    // is this the proper order?  to do this first before the SetLength?
    // it's the only way that makes sense to me
    ba[index].FreeImage;
    ba[index].Free;
    if index<>High(ba) then
    begin
      Finalize(ba[Index]);
      // this is the part I'm most concerned about...
      System.Move(ba[Index+1], ba[Index], (Length(ba)-Index-1)*SizeOf(TBitmap)+1);
    end;
    SetLength(ba, Length(ba) - 1) ;
  end;
end;

0
Comment
Question by:DMTrump
9 Comments
 
LVL 21

Assisted Solution

by:developmentguru
developmentguru earned 600 total points
ID: 20035593
I would simply create a TBitmap and add it to a TList as needed.  This gives you the flexibility to have N bitmaps in the list and their size is independant.

Let me know if you need more.
0
 
LVL 18

Expert Comment

by:Johnjces
ID: 20035908
Do you need this array of bitmaps to be in memory or can they be save/loaded to/from a file?

If you want to save/load a bitmap array consisting of bitmaps of all different sizes to/from a file I can provide code, but I am unsure if this is what you want/need/desire.

John
0
 

Author Comment

by:DMTrump
ID: 20035934
developmentguru:

That seems way to easy!  Could it be this simple?  The following code complies but I'm scared of leaking memory!  


var
bmplst: TList;

procedure T_form.newBMP(blst: Tlist; x,y,w,h: integer);
var
  DC : HDC;
  b: TBitmap;
  i: integer;
begin
  DC := GetDC (GetDesktopWindow) ;
  try
   b:=TBitMap.Create;
   b.Width:=w;
   b.Height:=h;
   // The actual populating of the bitmaps is more complicate than the following
   // but they will be variable size and this will suffice as an example
   BitBlt(b.Canvas.Handle, 0, 0, b.Width, b.Height, DC, x, y, SRCCOPY) ;
   blst.add(b);
  finally
   ReleaseDC (GetDesktopWindow, DC) ;
  end;
end;

procedure T_form.killBMP(blst: TList; index: Integer);
begin
    // is this going to free the memory?
    // that seems way to simple
    blst.Delete(index);
end;
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 

Author Comment

by:DMTrump
ID: 20035950
Johnjces:

No, I do save them each selectively but not as a group.
0
 

Author Comment

by:DMTrump
ID: 20036017
developmentguru:

On further investigation I see that I need to free the object (Tbitmap) memory myself  - and I'm also foggy on getting one of my Tlist bitmaps into a Timage by index -  If you can help with the the code for these two tasks I'd be very (500 points worth) grateful!
0
 
LVL 19

Assisted Solution

by:MerijnB
MerijnB earned 400 total points
ID: 20036333
even better is to use a TObjectList, the TObjectList will take care of the freeing of objects for you.

To retreive a TImage by index:

var Image: TImage;
begin
 Image := TImage(blst[i]);
end;
0
 
LVL 27

Accepted Solution

by:
kretzschmar earned 1000 total points
ID: 20036351

procedure T_form.killBMP(blst: TList; index: Integer);
begin
    // is this going to free the memory?
    // that seems way to simple
   TBitmap(blst[index]).free;  //<--add this
    blst.Delete(index);
end;

//displayByIndex
  Image1.picture.bitmap.assign(TBitmap(blst[index]));

just from head

meikl ;-)
0
 

Author Comment

by:DMTrump
ID: 20036852
Lots of good help - everyth8ing works fine now!
0
 
LVL 21

Expert Comment

by:developmentguru
ID: 20040621
It took me a while, but here is a full example.  The primary problem that you face is that a bitmap has no X or Y coordinates.  In this instance you need a class that handles a bitmap and a coordinate of where to place it.  In some programming I have seen this is called a sprite.  With that in mind, here is full source for a main form that will give an example.  Place two buttons btnAdd and btnDelete on the form in the lower left corner with the anchors set to left and bottom.  Add a paint box in the upper left corner, stretch it to fill the form to just above the buttons and set its anchor property to Left, Top, Right, Bottom.  Add the following code and set the events (create and destroy on the form, Paint on the Paint Box, click on the buttons).

--------------------------------------------------------------------------------------
unit Unit1;

interface

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

type
  {definition of these other classes would likely best be done in a separate
   unit.  They are defined here for simplicity.}

  {This class holds the definition of the individual "sprites".  You could add
   properties for speed, iniertia, whatever.  Keeping it simple, I started with
   X and Y which are not natural for a bitmap to have.}
  TSpriteDefinition = class
  private
    fBitmap : TBitmap;
    fX, fY : integer;
    fWidth, fHeight : integer;
    function GetHeight: integer;
    function GetWidth: integer;
    procedure SetBitmap(const Value: TBitmap);
    procedure SetHeight(const Value: integer);
    procedure SetWidth(const Value: integer);
  protected
  public
    constructor Create(x, y, Width, Height : integer);
    destructor Destroy; override;
    procedure PaintTo(Canvas : TCanvas);

    property X : integer read fX;
    property Y : integer read fY;
    property Width : integer read GetWidth write SetWidth;
    property Height : integer read GetHeight write SetHeight;
    property Bitmap : TBitmap read fBitmap write SetBitmap;
  end;

  {this class makes it easier to manipulate the list}
  TSpriteList = class(TObjectList)
  private
    function GetSprite(Index: integer): TSpriteDefinition;
  protected
  public
    function NewSprite(FileName : string; x, y, w, h : integer) :
      TSpriteDefinition; overload;
    function NewSprite(Bitmap : TBitmap; x, y, w, h : integer) :
      TSpriteDefinition; overload;
    procedure PaintTo(Canvas : TCanvas);

    property Sprites[Index : integer] : TSpriteDefinition read GetSprite;
  end;

  TForm1 = class(TForm)
    btnAdd: TButton;
    btnDelete: TButton;
    OpenDialog1: TOpenDialog;
    PaintBox1: TPaintBox;
    procedure btnAddClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
  private
    { Private declarations }
    Sprites : TSpriteList;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnAddClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
    begin
      Sprites.NewSprite(OpenDialog1.FileName, Random(200), Random(200), 20, 20);
      PaintBox1.Invalidate;
    end;
end;

procedure TForm1.btnDeleteClick(Sender: TObject);
begin
  with Sprites do
    if Count > 0 then
      Delete(Count - 1);
  PaintBox1.invalidate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Sprites := TSpriteList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Sprites.Free;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  Sprites.PaintTo(PaintBox1.Canvas);
end;

{ TMyBitmapDefinition }

constructor TSpriteDefinition.Create(x, y, Width, Height : integer);
begin
  fBitmap := TBitmap.Create;
  fBitmap.Width := Width;
  fBitmap.Height := Height;
  fX := x;
  fY := y;
end;

destructor TSpriteDefinition.Destroy;
begin
  fBitmap.Free;
  inherited;
end;

function TSpriteDefinition.GetHeight: integer;
begin
  Result := fBitmap.Height;
end;

function TSpriteDefinition.GetWidth: integer;
begin
  Result := fBitmap.Width;
end;

procedure TSpriteDefinition.PaintTo(Canvas: TCanvas);
begin
  Canvas.CopyRect(Rect(X, Y, X + Bitmap.Width, Y + Bitmap.Height),
    Bitmap.Canvas, Rect(0, 0, Bitmap.Width, Bitmap.Height));
end;

procedure TSpriteDefinition.SetBitmap(const Value: TBitmap);
var
  BMP : TBitmap;

begin
  BMP := TBitmap.Create;
  try
    BMP.Width := Width;
    BMP.Height := Height;
    BMP.Canvas.CopyRect(Rect(0, 0, Width, Height), Value.Canvas,
      Rect(0, 0, Width, Height));

    fBitmap.Assign(BMP);
  finally
    BMP.Free;
  end;
end;

procedure TSpriteDefinition.SetHeight(const Value: integer);
begin
  fHeight := Value;
  Bitmap.Height := Value;
end;

procedure TSpriteDefinition.SetWidth(const Value: integer);
begin
  fWidth := Value;
  Bitmap.Width := Value;
end;

{ TBitmapList }

function TSpriteList.GetSprite(Index: integer): TSpriteDefinition;
begin
  Result := TSpriteDefinition(Items[Index]);
end;

function TSpriteList.NewSprite(FileName: string; x, y, w, h: integer):
  TSpriteDefinition;
var
  Bitmap : TBitmap;

begin
  Bitmap := TBitmap.Create;
  try
    Bitmap.LoadFromFile(FileName);
    Result := NewSprite(Bitmap, x, y, w, h);
  finally
    Bitmap.Free;
  end;
end;

function TSpriteList.NewSprite(Bitmap: TBitmap; x, y, w, h: integer):
  TSpriteDefinition;
var
  Sprite : TSpriteDefinition;

begin
  Sprite := TSpriteDefinition.Create(x, y, w, h);
  Sprite.Bitmap := Bitmap;
  Add(Sprite);
  Result := Sprite;
end;

procedure TSpriteList.PaintTo(Canvas: TCanvas);
var
  I : integer;
  Sprite : TSpriteDefinition;

begin
  for I := 0 to Count - 1 do
    begin
      Sprite := Sprites[I];
      Sprite.PaintTo(Canvas);
    end;
end;

end.
--------------------------------------------------------------------------------------

Let me know if this helps.
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering 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

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…
This is an update to some code that someone else posted on Experts Exchange. It is an alternate approach, I think a little easier to use, & makes sure that things like the Task Bar will update.
This video shows how to quickly and easily deploy an email signature for all users in Office 365 and prevent it from being added to replies and forwards. (the resulting signature is applied on the server level in Exchange Online) The email signat…
Integration Management Part 2
Suggested Courses

571 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