-
Forum: Multimedia
by himitsu,
1. Okt 2009
die LinienFettiererMix läßt sich sogar auf Fotos loslassen :lol:
die anderen Versionen brauchen aber die Hintergrundfarbe, in welche sie sich hinein ausbreiten, sonst kommen da keine guten Ergebnisse raus, falls sich überhaupt viel ändert
ach ja, für dat Foto hab ich natürlich die nötigen Rechte
dachte halt, wenn schon Foto, dann kann ich euch auch 'ne Freude machen :angel:
-
Forum: Multimedia
by himitsu,
1. Okt 2009
So, hier nun die Resultate gemixt in einem Programm
#org ErstelleBild
#4 LinienFettiererKopieren
#14 LinienFettiererMix
#20 LinienFettiererDirekt
#20 LinienFettiererDirekt
#18 LinienFettiererDirekt
-
Forum: Multimedia
by himitsu,
30. Sep 2009
Was davon?
Der Record war zur einfachen Umrechnung/Zerlegung der Farbanteile
Und Array ist ein Sonderfall
hier wird von Delphi keine Index-Prüfung gemacht, also es entspricht sozusagen einem Array und man muß so keinen Maximalwert angeben ... es kann also nicht passieren, daß hier mal eine ERangeError (Exception) geworfen wird.
Ich weiß ja nicht wie groß die Bilder sind und eh ich...
-
Forum: Multimedia
by himitsu,
30. Sep 2009
ungetestet ... hier werden theoretisch zuerst je die Farben aus Colors genommen und dann das erste gefundene Pixel
procedure LinienFettierer(Image: TBitmap; Background: TColor; Colors: Array of TColor; Size: Integer);
type
TRGBA = packed Record R, G, B, A: Byte; End;
TScanArray = packed Array of TRGBA;
PScanArray = ^TScanArray;
var
x, y, x2, y2, x3, y3, i: Integer;
C: TRGBA;
...
-
Forum: Multimedia
by himitsu,
30. Sep 2009
Was auch noch recht leicht ginge ...
- man lege ein Gitter über das Bild
- nehme sich jedes Raster vor und wähle eine Farbe ... Mittelwert oder auch die häufigste Farbe
* (jeweils auch die hintergrundfarbenen Pixel ignoriert)
- und fülle dann das Rasterfeld mit dieser Farbe
(warum hier alle immer so ... äähhhhhh ... kompliziert denken müssen :lol: )
-
Forum: Multimedia
by himitsu,
30. Sep 2009
ach deswegen hab ich fast nie welche drin :nerd:
Gut, wenn es dir zu unscharf ist, dann eben erstmal die billige Version ohne Mittelwert, und dafür jeweils mit dem Farbwert des ersten gefundenen Pixels.
procedure LinienFettierer(Image: TBitmap; Background: TColor; Size: Integer);
type
TRGBA = packed Record R, G, B, A: Byte; End;
TScanArray = packed Array of TRGBA;
PScanArray =...
-
Forum: Multimedia
by himitsu,
30. Sep 2009
du solltest mal meine Quellcodes hier sehn :oops:
im Grunde sind das hier nur die Änderungen/Erweiterungen zu ersten "Version"
(hab mir halt wichtige Dinge markiert, welche eventuell noch geändert/überprüft werden müssen oder schon geändert wurden ... je nach Kontext, bzw. je nach Lust und Laune)
hey, ich brauchte mal 'ne Ablenkung, bevor ich von anderen Dingen zuviel abbekomm (seh nur...
-
Forum: Multimedia
by himitsu,
30. Sep 2009
ich übe einfach zuwenig :cry:
nja, aber schön flott isses nun ... vorher mit Pixels rund ~45 Sekunden und nun nichtmal eine :shock:
// benötigt: ein TButton (Button1) und ein TImage (Image1)
procedure LinienFettierer(Image: TBitmap; Background: TColor; Size: Integer);
type
TRGBA = packed Record R, G, B, A: Byte; End;
TScanArray = packed Array of TRGBA;
PScanArray =...
-
Forum: Multimedia
by himitsu,
30. Sep 2009
so, jetzt ist es rund :nerd:
x3 und y3 (also die Pixelposition im Originalbild) wurde falsch berechnet ... hatte mich schon gewundert, warum es so verschoben aussah
// benötigt: ein TButton (Button1) und ein TImage (Image1)
procedure LinienFettierer(Image: TBitmap; Background: TColor; Size: Integer);
var
x, y, x2, y2, x3, y3, R, G, B, P, A: Integer;
C: TColor;
-
Forum: Multimedia
by himitsu,
29. Sep 2009
joar, ScannLines könnte es schon etwas beschleunigen :roll:
aber ich wollt's jetzt nicht übertreiben
das Mask sollte eigentlich einen ausgemalten Kreis enthalten
und weil ich grad irgendwie mit Sinus und Cosinus 'ne Denkblokade hab, ist da nur ein "sinnloses" Quadrat drinnen :oops:
ähhhhh ... ok, ich glaub Potenz und Wurzeln waren da eh besser, als Sinus :wall:
-
Forum: Multimedia
by himitsu,
29. Sep 2009
procedure LinienFettierer(Image: TBitmap; Background: TColor; Size: Integer);
var
x, y, x2, y2, x3, y3, R, G, B, P: Integer;
C: TColor;
Temp: TBitmap;
Mask: Array of Array of Boolean;
begin
SetLength(Mask, Size, Size);
for x := 0 to Size - 1 do
for y := 0 to Size - 1 do
-
Forum: Multimedia
by himitsu,
29. Sep 2009
Gibt es eine Einheitliche Hintergrundfarbe?
Wenn ja, dann entweder jedes Pixel, welches nicht dem Hintergrund entspricht, in ein neues Bild übertragen und dort als etwas größeren Kreis zeichen.
Wenn es dabei auch rchteckig sein darf, ginge auch einfach
BildNew.Width := Bild.Width + B;
BildNew.Height := Bild.Height + B;
For x := 0 to B - 1 do
For y := 0 to B - 1 do
...
