| Autor |
Beitrag |
Popov
Gast
Erhaltene Danke: 1
|
Verfasst: Mo 23.12.02 11:34
Ich brauche einen Code der mir den Nicht-Transparent-Teil einer Bitmap einen 3D-Effekt verpaßt. Um zu zeigen was ich meine, hier ein Beispiel:
Der linke Teil ist das Original. Die Farbe clFuchsia ist die Transparentfarbe. Die graue Form des Objekts ist nur beim Beispiel so. Später wird mit der richtigen Grafik gearbeitet. Der rechte Teil ist die das Ergebnis. Später soll ein Programm mit Sonderform daraus werden.
Ich hoffe jetzt ist klar was ich mit dem 3D-Effekt meine. Natürlich hab ich mich darangesetzt und etwas bereits selbst geschrieben (der rechte Teil ist das Ergebnis der Prozedur). Allerdings bin ich damit nicht zufrieden, weil es zu lange dauert. Es sind zwar nur einige hundert Millisekunden, aber für das was ich will ist es zu lange. Später soll sich die Form innerhalb einer Sekunde mehrmals in der Form ändern können (quasi eine "lebende" Form). Die Bitmap wird dann erst zu Laufzeit erstellt und soll dann sofort die dreidimensionale Form erhalten. Deshalb sind 300 Millisekunden pro Berechnung zuviel.
Nun kenne ich mich nicht so mit der Grafikprogrammierung aus, daß ich alle Tricks kennen würde. Ich gebe zu, daß ich wahrscheinlich auch nicht die beste Methode gewählt habe. Ich hab zufällig die Region des Nicht-Transparent-Teils und hab deshalb mit PtInRegion gearbeitet. Vielleicht ist aber diese Funktion zu langsam. Vielleicht hätte ich direkt die transparente Farbe abfragen sollen. Vielleicht mit ScaneLine arbeiten? Wer kann mit da einige Tips geben wie ich meine Prozedur schneller machen könnte.
Vielleicht hat einer bereits einen Code der sowas perfekt berechnet. Ich bin bereit meinen Code zu opfern wenn es was besseres gibt.
Hier ist die Prozedur die ich geschrieben habe. Wie gesagt arbeitet sie mit PtInRegion. Der wichtige Teil der Berechnung ist eigentlich erst nach dem dritten Kommentar. Alles was davor ist, sind Ausnahmen.
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
| procedure Rahmen3(B: TBitmap; R: hRGN);
var
X, Y, S: Integer;
const
cH = $00E2E2E2;
cD = clGray;
begin
for Y := B.Height - 1 downto 0 do begin
S := -1;
for X := 0 to B.Width - 1 do begin
//Ausnahmeabfragen bei den vier Bitmap-Rändern
if (X = 0) and (PtInRegion(R, X, Y)) then begin
B.Canvas.Pixels[X, Y] := clWhite;
B.Canvas.Pixels[X + 1, Y] := cH;
end else
if (Y = 0) and (PtInRegion(R, X, Y)) then begin
B.Canvas.Pixels[X, Y] := clWhite;
B.Canvas.Pixels[X, Y + 1] := cH;
end else
if (X = B.Width - 1) and (PtInRegion(R, X, Y)) then begin
B.Canvas.Pixels[X, Y] := clBlack;
B.Canvas.Pixels[X - 1, Y] := cD;
end else
if (Y = B.Height - 1) and (PtInRegion(R, X, Y)) then begin
B.Canvas.Pixels[X, Y] := clBlack;
B.Canvas.Pixels[X, Y - 1] := cD;
end else {}
//Ausnahmeabfragen bei Region-Rändern - Vertikal
if (PtInRegion(R, X, Y)) and (not PtInRegion(R, X, Y - 1)) then begin
B.Canvas.Pixels[X, Y] := clWhite;
//B.Canvas.Pixels[X, Y + 1] := cH;
end else
if (PtInRegion(R, X, Y)) and (not PtInRegion(R, X, Y + 1)) then begin
B.Canvas.Pixels[X, Y] := clBlack;
B.Canvas.Pixels[X, Y - 1] := cD;
end;
//Normalabfragen bei Region-Rändern - Horizontal
if not PtInRegion(R, X, Y) then begin
S := 1;
if PtInRegion(R, X - 1, Y) then begin
B.Canvas.Pixels[X - 1, Y] := clBlack;
B.Canvas.Pixels[X - 2, Y] := cD;
end;
end else if (PtInRegion(R, X, Y)) and (S <> -1){} then begin
B.Canvas.Pixels[X, Y] := clWhite;
B.Canvas.Pixels[X + 1, Y] := cH;
S := -1;
end;
end;
end;
end; |
Grafik, Optimierung, 300 Millisekunden. Das kommt mir alles bekannt vor. Hoffentlich gibts deswegen nicht wieder einen Megastreit 
|
|
AndyB
 
Beiträge: 1173
Erhaltene Danke: 14
RAD Studio XE2
|
Verfasst: Mo 23.12.02 14:01
Wie wäre es mit 9-10 Millisekunden (bei 650MHz):
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
| procedure Rahmen3D(B: TBitmap; TransparentColor: TColor);
// nur mit 24Bit Farbtiefe
type
PRGBEntry = ^TRGBEntry;
TRGBEntry = packed record
r, g, b: Byte;
end;
var
TransColor: TColorRef;
FlippedBitmap: Boolean;
Width, Height: Integer;
Memory: PByte;
function GetPix(X, Y: Integer): TColorRef;
var pB: PRGBEntry;
begin
if (Cardinal(X) >= Cardinal(Width)) or (Cardinal(Y) >= Cardinal(Height)) then
begin
Result := TransColor;
Exit;
end;
pB := PRGBEntry(Memory);
// Verkehrtherumliegende Bitmaps beachten
if FlippedBitmap then Dec(pB, Y * Width) else Inc(pB, Y * Width);
Inc(pB, X);
with pB^ do
Result := RGB(r, g, b);
end;
procedure SetPix(X, Y: Integer; Color: TColorRef);
var pB: PRGBEntry;
begin
if (Cardinal(X) >= Cardinal(Width)) or (Cardinal(Y) >= Cardinal(Height)) then
Exit;
pB := PRGBEntry(Memory);
// Verkehrtherumliegende Bitmaps beachten
if FlippedBitmap then Dec(pB, Y * Width) else Inc(pB, Y * Width);
Inc(pB, X);
with pB^ do
begin
r := (Color shr 16) and $ff;
g := (Color shr 8) and $ff;
b := Color and $ff;
end;
end;
const
cH = $00E2E2E2;
cD = clGray;
var
X, Y, S: Integer;
DIB: TDIBSection;
begin
if B.PixelFormat <> pf24bit then
raise Exception.Create('Nur für 24Bit Farbtiefe.');
Width := B.Width;
Height := B.Height;
TransColor := ColorToRGB(TransparentColor);
if (Height = 0) or (Width = 0) then Exit;
Memory := B.ScanLine[0];
// liegen die Bitmapzeilen verkehrt herum im Speicher?
GetObject(B.Handle, SizeOf(DIB), @DIB);
FlippedBitmap := DIB.dsBmih.biHeight > 0;
for Y := Height - 1 downto 0 do
begin
S := -1;
for X := 0 to Width - 1 do
begin
//Ausnahmeabfragen bei den vier Bitmap-Rändern
if GetPix(X, Y) <> TransColor then {if not IsTransparent(X, Y) then}
begin
if (X = 0) then
begin
SetPix(X, Y, clWhite);
SetPix(X + 1, Y, cH);
end else
if (Y = 0) then
begin
SetPix(X, Y, clWhite);
SetPix(X, Y + 1, cH);
end else
if (X = Width - 1) then
begin
SetPix(X, Y, clBlack);
SetPix(X - 1, Y, cD);
end else
if (Y = Height - 1) then
begin
SetPix(X, Y, clBlack);
SetPix(X, Y - 1, cD);
end;
//Ausnahmeabfragen bei Region-Rändern - Vertikal
if GetPix(X, Y - 1) = TransColor then {if (IsTransparent(X, Y - 1)) then}
begin
SetPix(X, Y, clWhite);
// SetPix(X, Y + 1, cH);
end else
if GetPix(X, Y + 1) = TransColor then {if (IsTransparent(X, Y + 1)) then}
begin
SetPix(X, Y, clBlack);
SetPix(X, Y - 1, cD);
end;
//Normalabfragen bei Region-Rändern - Horizontal (1)
if (S <> -1) then
begin
SetPix(X, Y, clWhite);
SetPix(X + 1, Y, cH);
S := -1;
end;
end // if not IsTransparent(X, Y)
else
begin
//Normalabfragen bei Region-Rändern - Horizontal (2)
S := 1;
if GetPix(X - 1, Y) <> TransColor then {if not IsTransparent(X - 1, Y) then}
begin
SetPix(X - 1, Y, clBlack);
SetPix(X - 2, Y, cD);
end;
end; // if not IsTransparent(X, Y) else
end; // for Width
end; // for Height
B.Modified := True;
end; | _________________ Ist Zeit wirklich Geld?
|
|
Popov
Gast
Erhaltene Danke: 1
|
Verfasst: Mo 23.12.02 14:51
Jaaaaaa, dein Code ist gut. Besser als meins. Ich hab den zwar inzwischen auf unter 100ms runter, aber mehr geht nach der Methode nicht. PtInRegion ist der Übeltäter und kostet fast die ganze Zeit. Ich wollte inzwischen den Code in die Tonne kloppen und etwas neues mit ScanLine machen. Leider hab ich aber noch nie mit ScanLine gearbeitet und das hätte mich dann paar Tage gekostet. Zwar kenne ich ScanLine und weiß wozu es gut ist, aber eher nur vom Hörensagen.
Also Danke noch einmal. Dein Code ist super.
|
|
Popov
Gast
Erhaltene Danke: 1
|
Verfasst: Di 24.12.02 14:11
Ich hab gestern beim Testen bemerkt, daß dein Code bei kleinen Grafiken Probleme hat und sie ein wenig falsch darstellt. Ich werde den Fehler wahrscheinlich finden und korriegieren (aber erst nach Weihnachten). Wollte dir nur bescheidsagen, nicht daß du den Code irgendwann benutzt und es dann erst rausfindest. Wie gesagt kommt der Fehler nur bei kleinen Grafiken (bzw. hab ich nur eine bis jetzt getestet).
Hier die Grafik die ich meine (allerdings in gif und 256 Farben).
|
|
AndyB
Beiträge: 1173
Erhaltene Danke: 14
RAD Studio XE2
|
Verfasst: Mi 25.12.02 00:33
| Popov hat folgendes geschrieben: | | daß dein Code bei kleinen Grafiken Probleme hat und sie ein wenig falsch darstellt. |
Und wieso soll das nur mein Code haben? Ich habe deinen Code nur beschleunigt. Der Algorithmus ist immer noch von dir.
Hier sind noch ein paar Verbesserungen (die nicht den Algorithmus betreffen)
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
| ...
var
TransColor: TColorRef;
FlippedBitmap: Boolean;
Width, Height: Integer;
ScanLines: array of PByte;
function GetPix(X, Y: Integer): TColorRef;
var pB: PByte;
begin
if (Cardinal(X) >= Cardinal(Width)) or (Cardinal(Y) >= Cardinal(Height)) then
begin
Result := TransColor;
Exit;
end;
pB := ScanLines[Y];
// Verkehrtherumliegende Bitmaps beachten
Inc(pB, X * 3);
with PRGBEntry(pB)^ do
Result := RGB(r, g, b);
end;
procedure SetPix(X, Y: Integer; Color: TColorRef);
var pB: PByte;
begin
if (Cardinal(X) >= Cardinal(Width)) or (Cardinal(Y) >= Cardinal(Height)) then
Exit;
pB := ScanLines[Y];
// Verkehrtherumliegende Bitmaps beachten
Inc(pB, X * 3);
pB^ := Byte(Color shr 16); Inc(pB);
pB^ := Byte(Color shr 8); Inc(pB);
pB^ := Byte(Color);
end;
const
cH = $00E2E2E2;
cD = clGray;
var
X, Y, S: Integer;
DIB: TDIBSection;
Memory: PByte;
BytesPerSL: Integer;
begin
if B.PixelFormat <> pf24bit then
raise Exception.Create('Nur für 24Bit Farbtiefe.');
Width := B.Width;
Height := B.Height;
TransColor := ColorToRGB(TransparentColor);
if (Height = 0) or (Width = 0) then Exit;
Memory := B.ScanLine[0];
// liegen die Bitmapzeilen verkehrt herum im Speicher?
GetObject(B.Handle, SizeOf(DIB), @DIB);
FlippedBitmap := DIB.dsBmih.biHeight > 0;
BytesPerSL := BytesPerScanline(Width, DIB.dsBm.bmBitsPixel, 32);
if FlippedBitmap then BytesPerSL := -BytesPerSL;
SetLength(ScanLines, Height); // dynamisches Array wird autom. freigegeben
for Y := 0 to Height - 1 do
ScanLines[Y] := Pointer(Integer(Memory) + Y * BytesPerSL);
for Y := Height - 1 downto 0 do
... | _________________ Ist Zeit wirklich Geld?
|
|
Popov
Gast
Erhaltene Danke: 1
|
Verfasst: Do 26.12.02 06:25
Keine Angst. Ich gehöre nicht zu denen die hinter einem herlaufen und Freude drann haben einen auf die Fehler aufmerksam zu machen. Ich habs nur deswegen gemacht, weil ich annehme, daß du den Code irgendwann vielleicht selbst mal nutzen wirst, ihn auskrammst und plötzlich, gerade wenn du keine Zeit hast, es dann selbst bemerkst.
Ich hab den neuen Code noch nicht studiert, werde es aber noch machen. Vielleicht liegt es nur an den Farben, ich weiß es nicht. Du brauchst den Fehler nicht suchen, das hab ich mit dem Hinweis nicht beabsichtigt. Bevor ich den Code entgültig einsetzetzen werde, werde ich sowieso jede einzelne Zeile gegenchecken (mach ich immer so). Vielleicht fällt mir was auf.
|
|
|
