Problem z funkcją

0

Napisałem sobie takie funkcje do alphablendingu:

function getalphacolor(Background, Foreground: TColor;
Alpha: byte): TColor;
begin
Result:=rgb(round((Alpha/100)*GetRValue(Foreground)+(1-(Alpha/100))*GetRValue(Background)), round((Alpha/100)*GetGValue(Foreground)+(1-(Alpha/100))*GetGValue(Background)), round((Alpha/100)*GetBValue(Foreground)+(1-(Alpha/100))*GetBValue(Background)));
end;

function getalphabitmap(Background, Foreground:TBitmap; X, Y:Integer; Alpha:Byte; Offset:Integer):TBitmap;
var
a, b, tmp:integer;
begin
result:=tbitmap.Create;
result.Width:=foreground.Width;
result.Height:=foreground.Height;

for a:=0 to foreground.Width do
for b:=0 to foreground.Height do
if (a+x&lt=background.Width) and (b+y&lt=background.Height) then
begin
if a&lt=offset then
tmp:=round(a/offsetalpha);
if a&gt=foreground.Width-offset then
tmp:=round((foreground.Width-a)/offset
alpha);
if (a&gtoffset) and (a&ltforeground.Width-offset) then
tmp:=alpha;

result.Canvas.Pixels[a, b]:=getalphacolor(background.Canvas.Pixels[a+x, b+y], foreground.Canvas.Pixels[a, b], tmp);
end;

I wszystko działa ładnie, tylko że bardzo wolno (przy ciągłym odświeżaniu). Czy nie ma jakiegoś szybszego sposobu? I jeszcze jeden, poważniejszy problem. Po kilku minutach wywooływania tego co 50 ms zaczyna wyskakiwać błąd 'Out of system resources'. Podejrzewam, że przyczyną jest niezwalnianie bitmapy będącej rezultatem funkcji, nie wiem niestety, jak to naprawić.---------------------------
Delphi 6

Pozdrówka

0

Pierwszego problemu nie rozwiąże, ale drugi:

&gtporcedure getalphabitmap(Background, Foreground:TBitmap; X, Y:Integer; Alpha:Byte; Offset:Integer; Result: TBitmap);

Po prostu jako Result podawaj juz utworzoną bitmapę, jedną dla całego programu. Nie będzie wtedy problemów z tworzeniem ciągle nowych bitmap (of koz bez Result:=TBitmap.Create w kodzie procedury).--Vogel [Delphi 6 PE]

I TY możesz nauczyć się grać w bierki!

0

function getalphacolor(Background, Foreground: TColor;
Alpha: byte): TColor;
begin
Result:=rgb(round((Alpha/100)*GetRValue(Foreground)+(1-(Alpha/100))*GetRValue(Background)), round((Alpha/100)*GetGValue(Foreground)+(1-(Alpha/100))*GetGValue(Background)), round((Alpha/100)*GetBValue(Foreground)+(1-(Alpha/100))*GetBValue(Background)));
end;

function getalphabitmap(Background, Foreground:TBitmap; X, Y:Integer; Alpha:Byte; Offset:Integer):TBitmap;
var
a, b, tmp:integer;
begin
result:=tbitmap.Create;
result.Width:=foreground.Width;
result.Height:=foreground.Height;

for a:=0 to foreground.Width do
for b:=0 to foreground.Height do
if (a+x&lt=background.Width) and (b+y&lt=background.Height) then
begin
if a&lt=offset then
tmp:=round(a/offsetalpha);
if a&gt=foreground.Width-offset then
tmp:=round((foreground.Width-a)/offset
alpha);
if (a&gtoffset) and (a&ltforeground.Width-offset) then
tmp:=alpha;

result.Canvas.Pixels[a, b]:=getalphacolor(background.Canvas.Pixels[a+x, b+y], foreground.Canvas.Pixels[a, b], tmp);
end;

W celu przyspieszenia proponuję:

  1. skopiować do zmiennych lokalnych wartości szerokości i wysokości żeby nie wołać metod obiektu TBitmap za każdym przejściem pętli.
  2. zauważ, że zmienna tmp tak naprawdę zależy od zmiennej a oraz ofsetu i szerokości i wysokości bitmapy, nie zależy natomiast od zmiennej b. Proponuję zatem
    stworzenie tablicy o liczbie elementów odpowiadającej jednemu wierszowi bitmapy i przechowującej wartości zmiennej tmp dla kolejnych wartości a. Wystarczy zatem wykonać obliczenia zmiennoprzecinkowe tylko dla jednego wiersza a potem korzystać z tablicy. To powinno wydatnie przyspieszyć algorytm.

pozdr

--Michał
TJS group
delphi 5,6
" Praktyka - to jest wtedy gdy wszystko działa lecz nikt nie wie dlaczego
Teoria - jest wtedy gdy nic nie działa ale wszyscy wiedzą dlaczego,
My łączymy teorię z praktyką
NIC NIE DZIAŁA I NIKT NIE WIE DLACZEGO "

0

Nie zrozumiałem za bardzo, o co chodzi z tą tablicą. Czy mógłbyś opisać to troszeczkę dokładniej?---------------------------
Delphi 6

Pozdrówka

0

Ok proponuje zrobić tak:

function getalphacolor(Background, Foreground: TColor;
Alpha: byte): TColor;
begin
Result:=rgb(round((Alpha/100)*GetRValue(Foreground)+(1-(Alpha/100))*GetRValue(Background)), round((Alpha/100)*GetGValue(Foreground)+(1-(Alpha/100))*GetGValue(Background)), round((Alpha/100)*GetBValue(Foreground)+(1-(Alpha/100))*GetBValue(Background)));
end;

function getalphabitmap(Background, Foreground:TBitmap; X, Y:Integer; Alpha:Byte; Offset:Integer):TBitmap;
var
a, b, tmp:integer;
tab: Array of integer;
begin
result:=tbitmap.Create;
result.Width:=foreground.Width;
result.Height:=foreground.Height;

SetLength(tab, foregroud.Width);

for a:=0 to foreground.Width do
for b:=0 to foreground.Height do
if (a+x&lt=background.Width) and (b+y&lt=background.Height) then
begin
if b=0 then
begin
if a&lt=offset then
tmp:=round(a/offsetalpha);
if a&gt=foreground.Width-offset then
tmp:=round((foreground.Width-a)/offset
alpha);
if (a&gtoffset) and (a&ltforeground.Width-offset) then
tmp:=alpha;
tab[a]:=tmp;
end
else
tmp:=tab[a];

       result.Canvas.Pixels[a, b]:=getalphacolor(background.Canvas.Pixels[a+x,b+y], foreground.Canvas.Pixels[a, b], tmp); 

end;

--Michał
TJS group
delphi 5,6
" Praktyka - to jest wtedy gdy wszystko działa lecz nikt nie wie dlaczego
Teoria - jest wtedy gdy nic nie działa ale wszyscy wiedzą dlaczego,
My łączymy teorię z praktyką
NIC NIE DZIAŁA I NIKT NIE WIE DLACZEGO "

0

Aha zapomniałem jeszcze, że na końcu procedury musi być
Finalize(tab);

powodzenia--Michał
TJS group
delphi 5,6
" Praktyka - to jest wtedy gdy wszystko działa lecz nikt nie wie dlaczego
Teoria - jest wtedy gdy nic nie działa ale wszyscy wiedzą dlaczego,
My łączymy teorię z praktyką
NIC NIE DZIAŁA I NIKT NIE WIE DLACZEGO "

0

ec_mike napisał:
&gtAha zapomniałem jeszcze, że na końcu procedury musi być
&gt Finalize(tab);
&gt

chyba nie musi byc, bo tab jest tablica deklarowana lokalnie i i tak bedzie zwolniona--Pawel {Delphi 6 Personal}

Po pierwsze: naciśnij F1

0

Pierwsza i najważniejsza rzecz: Jeżeli to jest bitmapa, to nie zmieniaj pojedynczo pikseli tylko cały wiersz. Zobacza w artykule o rozjaśnianiu, w jaki sposób można przyspieszyć zmianę koloru wykorzystując ScanLine.
Drugie: Zmień fukcję obliczającą kolor Alpha. Zamień / na div i Round na Trunc
Mnożenie i dzielenie są przemienne.
np:

function GetAlphaColor(Background, Foreground: TColor;
Alpha: Byte): TColor;
var
RF, GF, BF, RB, GB, BB: Byte;
begin
RF := GetRValue(Foreground);
GF := GetGValue(Foreground);
BF := GetBValue(Foreground);
RB := GetRValue(Background);
GB := GetGValue(Background);
BB := GetBValue(Background);
Result := RGB(
Trunc(RFAlpha div 100 + RB - RBAlpha div 100),
Trunc(GFAlpha div 100 + GB - GBAlpha div 100),
Trunc(BFAlpha div 100 + BB - BBAlpha div 100)
);
end;

--Jest jeszcze jeden błąd ... :)

Apel: Piszcie w tematach o jaki język programowania chodzi np. : [Delphi], [C++], itp.

0

Najlepiej to tak:

type TTriple = record
R, G, B: Byte;
end;

implementation

function GetAlphaColor(Background, Foreground: TTriple;
Alpha: Byte): TTriple;
var
RF, GF, BF, RB, GB, BB: Byte;
begin
RF := Foreground.R;
GF := Foreground.G;
BF := Foreground.B;
RB := Background.R;
GB := Background.G;
BB := Background.B;
Result.R := Trunc(RFAlpha div 100 + RB - RBAlpha div 100);
Result.G := Trunc(GFAlpha div 100 + GB - GBAlpha div 100);
Result.B := Trunc(BFAlpha div 100 + BB - BBAlpha div 100);
end;

procedure GetAlphaBitmap(Background, Foreground, Wynik:TBitmap; X, Y:Integer; Alpha:Byte; Offset:Integer);
type TTablica = array of TTriple;
PTablica = TTablica;
var
a, b, tmp, SzerF, WysF, SzerB, WysB:integer;
tab: array of Integer;
LiniaF, LiniaB, LiniaW: PTablica;
begin
SzerF := Foreground.Width;
WysF := Foreground.Height;
SzerB := Foreground.Width;
WysB := Foreground.Height;
SetLength(LiniaF
, SzerF);
SetLength(LiniaB, SzerB);
SetLength(LiniaW
, SzerF);
SetLength(tab, SzerF);
for b := 0 to WysF do begin
LiniaF := Foreground.ScanLine[b];
LiniaB := Background.ScanLine[b+y];
LiniaW := Wynik.ScanLine[b];
for a := 0 to SzerF do
if (a+x&lt=SzerB) and (b+y&lt=WysB) then
begin
if b=0 then
begin
if a&lt=offset then
tmp := alphaa div offset
else
if a&gt=SzerF-offset then
tmp := alpha
(SzerF-a) div offset
else
if (a&gtoffset) and (a&ltSzerF-offset) then
tmp := alpha;
tab[a]:=tmp;
end
else
tmp:=tab[a];
LiniaW[a] := GetAlphaColor(LiniaB[a+x], LiniaF^[a], tmp);
end;
end;
end;

--Jest jeszcze jeden błąd ... :)

Apel: Piszcie w tematach o jaki język programowania chodzi np. : [Delphi], [C++], itp.

0

A ja się i tak upieram aby na koncu procedury było finalize(tab), bo mimo iż jest to
zmienna lokalna to:

jest ona typu wskaźnikowego i wskazuje blok pamięci, którego wielkość określa się
wywołując SetLength(tab, ileśtam);
a zatem po wyjściu z procedury zwalniamy zmienną wskaźnikową ale pamięć zarezerwowana na tablicę zostaje dalej zajęta i dopiero wywołanie finalize(tab) ją zwalnia.
Jest to jeden z błędów powodujących zużywanie zasobów systemu (Memory Leak).
Nie ujawnia się przez jakiś czas, dopiero po wielokrotnym wywołaniu procedury otrzymamy komunikat "Out of System Resources".

0

ec-mike napisał:

&gta zatem po wyjściu z procedury pamięć zarezerwowana na tablicę zostaje dalej zajęta

Nie wiedzialem!!!! Myslalem, ze Delphi zwalnia pamiec. Jestes tego pewien?--Pawel {Delphi 6 Personal}

Po pierwsze: naciśnij F1

0

ec-mike napisał:
A ja się i tak upieram aby na koncu procedury było finalize(tab), bo mimo iż jest to
zmienna lokalna to:

jest ona typu wskaźnikowego i wskazuje blok pamięci, którego wielkość określa się
wywołując SetLength(tab, ileśtam);
a zatem po wyjściu z procedury zwalniamy zmienną wskaźnikową ale pamięć zarezerwowana na tablicę zostaje dalej zajęta i dopiero wywołanie finalize(tab) ją zwalnia.
Jest to jeden z błędów powodujących zużywanie zasobów systemu (Memory Leak).
Nie ujawnia się przez jakiś czas, dopiero po wielokrotnym wywołaniu procedury otrzymamy komunikat "Out of System Resources".

Obawiam się, że jednak nie masz racji. Testowałem takie rozwiązanie:

procedure TForm1.Button1Click(Sender: TObject);
procedure Test;
var
q: array of Byte;
begin
SetLength(q, 5010241024);
Finalize(q);
end;
var
x: Integer;
begin
for x:=0 to 100 do
Test;
end;

Zarówno w jednym jak i w drugim przypadku chwilowa zajętość pamięci osiągała ok. 46 MB, żeby po zakończeniu wykonywania procedury wrócić do ok. 1,5 MB. Liczba wywoływań funkcji nie miała wpływu na zużycie pamięci, a jedynie na czas wykonywania.

Dodam, że testy wykonywałem na Duronie 800 i 128 MB RAM w systemie WinXP. Byćmoże trzebaby wykonać jeszcze testy na systemach Win9x i WinNT, ponieważ tam zarządzanie pamięcią jest znacznie mniej wydajne (ale to chyba nie zależy od systemu).--Jest jeszcze jeden błąd ... :)

Apel: Piszcie w tematach o jaki język programowania chodzi np. : [Delphi], [C++], itp.

0

Dryobates napisał:

&gtObawiam się, że jednak nie masz racji. Testowałem takie rozwiązanie:
&gt
Dzieki Dryobates, uspokoiles mnie co do mojego programu, ktory obficie uzywa duzych tablic, w tym lokalnych. A nie mialem czasu sam puszczac testow. Wydawalo mi sie, ze gdzies czytalem (tylko gdzie?), ze Delphi porzadnie zwalnia lokalne zmienne - razem z ich pamiecia. Chyba ze sam ja jawnie przydzielisz przez New lub AllocMem. Ale niejawne allokacje (jak przy SetLength) sa automatycznie zwalniane.--Pawel {Delphi 6 Personal}

Po pierwsze: naciśnij F1

0

Ok, ja to napisałem na podstawie tego co pisali w helpie, skoro mówicie, że tak jest ok to super. {brawo}

1 użytkowników online, w tym zalogowanych: 0, gości: 1