Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2010.02.14;
Скачать: CL | DM;

Вниз

FREE TBITMAP   Найти похожие ветки 

 
serhiyiv ©   (2009-12-14 17:32) [0]

Здравствуйте. Подскажите пожалуйста, имееться функция (ее часть) результатом которой будет TBitmap. Каждый раз при ее вызове создаеться новый  TBitmap и получаеться утечка памяти. Если сделать TB2.Free; то нет результата.  Как получить результат (TBitmap)  и не терять память??

function GetBitmap (File:String):TBitmap;
var
TB2:TBitmap;
begin
    TB2:=TBitmap.Create;
    TB2.LoadFromFile(File);
    Result:=TB2;

  //TB2.Free;
end;


 
Юрий Зотов ©   (2009-12-14 17:35) [1]

Уничтожать битмап ВНЕ этой функции ПОСЛЕ его использования.


 
Германн ©   (2009-12-14 17:36) [2]

Заменить

> function GetBitmap (File:String):TBitmap;

на function GetBitmap (File:String; var TB : TBitmap): Boolean;


 
Jeer ©   (2009-12-14 18:22) [3]

proc GetBitmap(..): TBitmap;
begin
Result := TBitmap.Create;
..
end;

bmp := GetBitmap(..)
...
bmp.Free;


 
Leonid Troyanovsky ©   (2009-12-14 22:15) [4]


> Германн ©   (14.12.09 17:36) [2]

> на function GetBitmap (File:String; var TB : TBitmap): Boolean;

const File: String;

> Jeer ©   (14.12.09 18:22) [3]
> proc GetBitmap(..): TBitmap;

Для создания объектов в дельфи пользуют конструкторы, а не Get.

--
Regards, LVT.


 
Leonid Troyanovsky ©   (2009-12-14 22:24) [5]


> Германн ©   (14.12.09 17:36) [2]

> на function GetBitmap (File:String; var TB : TBitmap): Boolean;

А если еще заменить оную на метод TMyBitmap, то, во-ще, без замечаний.

--
Regards, LVT.


 
Германн ©   (2009-12-15 00:30) [6]


> Leonid Troyanovsky ©

Учтем"c. :)


 
Jeer ©   (2009-12-15 09:58) [7]


> > Jeer ©   (14.12.09 18:22) [3]
> > proc GetBitmap(..): TBitmap;
>
> Для создания объектов в дельфи пользуют конструкторы, а
> не Get.


Это не догма, да и то, если есть нужда в объекте.


 
serhiyiv ©   (2009-12-15 12:21) [8]

Спасибо, но всеровно не подходит. Я рисую на канве TListView-a, посылаю сообщение LVM_SETBKIMAGE. Вот так там надо указать хендл битмапа. Сначала я использую выше описаную (частично) функцию чтоб получить битмап. Но если  bmp.Free тогда картинка в любом случае в хендл никак не попадает.
var
 LVBK : TLVBKIMAGE;
...
LVBK.hbm := Моя Функция.handle;

Возможно както по другому достать битмап из файла и указать на него хендл. ?


 
clickmaker ©   (2009-12-15 12:33) [9]

> по другому достать битмап из файла и указать на него хендл.
> ?

LoadImage()


 
Юрий Зотов ©   (2009-12-15 12:38) [10]

> serhiyiv ©   (15.12.09 12:21) [8]
> Я рисую на канве TListView-a, посылаю сообщение LVM_SETBKIMAGE. Вот
> так там надо указать хендл битмапа.

А зачем же для этого каждый раз создавать НОВЫЙ TBitmap? Ведь можно использовать один и обновлять его.


 
serhiyiv ©   (2009-12-15 15:32) [11]


> А зачем же для этого каждый раз создавать НОВЫЙ TBitmap?
>  Ведь можно использовать один и обновлять его.


Ну а если у меня будет не один ListView а динамично будут создаваться несколько, то допустим на  TBitmap я нарисую один рисунок который  пойдет на 1-й ListView, потом если я на том же TBitmap нарисую другую картинку для 2-го ListView то картинка в 1-вом ListView поменяэться? Или останеться 1-вая которая была нарисована.
Ну а не будет утечки памяти если постоянно рисовать разные картинки на одном и том же TBitmap (его канве)?


 
clickmaker ©   (2009-12-15 16:07) [12]

> TBitmap я нарисую один рисунок который  пойдет на 1-й ListView,
> потом если я на том же TBitmap нарисую другую картинку
> для 2-го ListView то картинка в 1-вом ListView поменяэться?

нет

> не будет утечки памяти если постоянно рисовать разные картинки
> на одном и том же TBitmap (его канве)?

нет


 
DVM ©   (2009-12-15 18:56) [13]


> Ну а если у меня будет не один ListView а динамично будут
> создаваться несколько

Создай класс-потомок на основе TListView, добавь свое новое поле, скажем BackgroundBitmap, подгружай в него рисунок и отрисовывай фон.


 
serhiyiv ©   (2009-12-15 19:41) [14]

Большое всем спасибо за помошь!
> Создай класс-потомок на основе TListView, добавь свое новое
> поле, скажем BackgroundBitmap, подгружай в него рисунок
> и отрисовывай фон.


Не могли б вы пожалуйста немного подробней обьяснить или скинуть ссылку где можно почитать как что то похожее можна сделать или пример.


 
DVM ©   (2009-12-15 20:02) [15]


> serhiyiv ©   (15.12.09 19:41) [14]



unit Unit1;

interface

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

type

 TBitmapPos = (bpTopLeft, bpTopRight, bpBottomLeft,
               bpBottomRight, bpTile, bpCenter);

 TListView = class(ComCtrls.TListView)
 private
   FTag: Integer;
   FBitmap: TBitmap;
   FBitmapPos: TBitmapPos;
   procedure SetBitmap(const Value: TBitmap);
   procedure SetBitmapPos(const Value: TBitmapPos);
   procedure OnBitmapChange(Sender: TObject);
   procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
 protected
   procedure Paint; virtual;
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
 published
   property Bitmap: TBitmap read FBitmap write SetBitmap;
   property BitmapPos: TBitmapPos read FBitmapPos write SetBitmapPos;
 end;

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

var
 Form1: TForm1;

implementation

{$R *.dfm}

constructor TListView.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FTag := 0;
 FBitmap := TBitmap.Create;
 FBitmap.OnChange := OnBitmapChange;
 FBitmapPos := bpBottomRight;
end;

destructor TListView.Destroy;
begin
 FBitmap.Free; //Free the background image
 inherited Destroy;
end;

procedure TListView.OnBitmapChange(Sender: TObject);
begin
 Invalidate; //Call a refresh
end;

procedure TListView.Paint;
var
 X : LongInt;
 Y : LongInt;
 W : LongInt;
 H : LongInt;
 R : TRect;
 DC: HDC;
begin
 if not Assigned(FBitmap) then
   exit;

 R := GetClientRect;
 W := FBitmap.Width;
 H := FBitmap.Height;
 DC := GetDC(Self.Handle); //Get an handle to the TListView

 //Draw the bitmap at a specific position
 if FBitmapPos = bpTopLeft then
 begin
   BitBlt(DC,0,0,W,H,FBitmap.Canvas.Handle,0,0,SrcAnd);
 end
 else if FBitmapPos = bpTopRight then
 begin
   BitBlt(DC,R.Right - W,0,W,H,FBitmap.Canvas.Handle,0,0,SrcAnd);
 end
 else if FBitmapPos = bpBottomLeft then
 begin
   BitBlt(DC,0,R.Bottom - H,W,H,FBitmap.Canvas.Handle,0,0,SrcAnd);
 end
 else if FBitmapPos = bpBottomRight then
 begin
   BitBlt(DC,R.Right - W,R.Bottom - H,W,H,FBitmap.Canvas.Handle,0,0,SrcAnd);
 end
 else if FBitmapPos = bpTile then
 begin
   Y := R.Top;
   while Y < Height do
   begin
     X := R.Left;
     while X < Width do
     begin
       BitBlt(DC,X,Y,W,H,FBitmap.Canvas.Handle,0,0,SrcAnd);
       Inc(X,W);
     end;
     Inc(Y,H);
   end;
 end
 else if FBitmapPos = bpCenter then
 begin
   BitBlt(DC,(R.Right - R.Left - W) div 2,(R.Bottom - R.Top - H) div 2,
          W,H,FBitmap.Canvas.Handle,0,0,SrcAnd);
 end;

 ReleaseDC(Self.Handle,DC); //Release the handle

 //This condition is necessary to prevent flickering
 if FTag = 0 then
 begin
   Invalidate;
   FTag := 1;
 end
 else
   FTag := 0;
end;

procedure TListView.SetBitmap(const Value: TBitmap);
begin
 FBitmap.Assign(Value);
end;

procedure TListView.SetBitmapPos(const Value: TBitmapPos);
begin
 if FBitmapPos <> Value then
 begin
   FBitmapPos := Value;
   Invalidate;
 end;
end;

procedure TListView.WMPaint(var Message: TWMPaint);
begin
 inherited;
 Paint;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 ListView1.Bitmap.LoadFromFile("d:\1.bmp")
end;

end.



 
serhiyiv ©   (2009-12-16 16:41) [16]

Большое спасибо!



Страницы: 1 вся ветка

Текущий архив: 2010.02.14;
Скачать: CL | DM;

Наверх




Память: 0.51 MB
Время: 0.01 c
2-1260824299
andrewtitoff
2009-12-14 23:58
2010.02.14
MySQL


1-1237742925
Eazy
2009-03-22 20:28
2010.02.14
Сфера применения Delphi7


2-1260805424
JohnKorsh
2009-12-14 18:43
2010.02.14
Delphi 7 перестал останавливатться по Breakpoint.


15-1260142278
KilkennyCat
2009-12-07 02:31
2010.02.14
Стены и мармелад


1-1236676563
IGray
2009-03-10 12:16
2010.02.14
Очень странное срабатывание секции INITIALIZATION