Einige Farbverläufe

[pluto]

Hallo,
diese Unit beinhaltet einige Farbverläufe wo her ich sie habe weiß ich leider nicht mehr.

Leider gehen diese Funktionen unter Lazarus nicht wegen scanline was es bei TBitmap nicht gibt.

Und ich kenne mich in diesem Bereich zu wenige aus.
Es währe toll wenn jemand es anpassen könnte für Lazarus.

Vielen Dank im voraus, im Anhang gibt es die Unit.

[monta]

Schau dir mal die Demo von OpBitmap an, das Scanline ist einfach und schnell und in der Demo wunderbar demonstriert

[theo]

Kuck mal Pluto, ich hab dir mal ein Beispiel gemacht wie du sowas umwandeln kannst:

Code: Alles auswählen

procedure verlauf(bm: TCanvasOPBitmap; farbe1, farbe2: TColor; art: shp);
var
  x, y, h, w, w3: integer;
  p: pBytearray;
  ri, gi, bi: byte;
  ra, ga, ba: word;
  rd, gd, bd, a, d: single;
begin
  bm.pixelformat := pf24bit;
  if art = Diamant then
    h := bm.height shr 1
  else h := bm.height - 1;
  if art <> Diagonal then
    w := bm.width shr 1 else
    w := bm.width;
  w3 := w * 3;
  farbe1 := colortorgb(farbe1);
  farbe2 := colortorgb(farbe2);
  ra := getrvalue(farbe1);
  ga := getgvalue(farbe1);
  ba := getbvalue(farbe1);
  ri := getrvalue(farbe2);
  gi := getgvalue(farbe2);
  bi := getbvalue(farbe2);
  rd := ri - ra;
  gd := gi - ga;
  bd := bi - ba;
  inc(ra, ra);
  inc(ga, ga);
  inc(ba, ba);
  for y := 0 to h do begin
    p := bm.scanline[y];
    a := y / h;
    if art = Linse then a := sin(pi * a);
    x := 0;
    while x < w3 do begin
      d := a + x / w3;
      p[x] := trunc((ba + bd * d) / 2);
      p[x + 1] := trunc((ga + gd * d) / 2);
      p[x + 2] := trunc((ra + rd * d) / 2);
      inc(x, 3);
    end;
  end;
 
  //stretchblt muss ersetzt werden:
 
  if art <> Diagonal then
   for y := 0 to h do
    for x := 0 to w do
      bm.Pixels[w+w-x-1,y]:=bm.Pixels[x,y];
 
  if art = Diamant then
    for y := 0 to h do
     for x := 0 to bm.width do
       bm.Pixels[x,h+h-y-1]:=bm.Pixels[x,y];
end;

Aufrufen mit:

Code: Alles auswählen

procedure TForm1.Button1Click(Sender: TObject);
var op:TCanvasOPBitmap;
begin
 op:=TCanvasOPBitmap.create;
 op.Width:=200;
 op.Height:=200;
 verlauf(op,clred,clyellow,Diamant);
 AssignOpBitmapToBitmap(op,Image1.Picture.Bitmap);
 op.free;
end;

Denn Rest machste aber selber....

[monta]

theo is halt nett

[theo]

theo is halt nett

Viel zu nett...

[Christian]

Der nette onkel der den kleinen jungs hilft Oo lol

[pluto]

Danke theo werde ich auf jeden Fall versuchen... es sind teilweise sehr schöne Farb Verläufe da

[Christian]

Die kannst auch einfacher haben halt einfach nen magneten neben den Monitor

[theo]

Die kannst auch einfacher haben halt einfach nen magneten neben den Monitor

Haha! Das geht aber nur für Röhren. Haste nen Flachen, einfach fest aufs Display drücken!

[Christian]

sieste daran hatt ich net gedach aber geht doch

[pluto]

naja ich weiß nicht so recht, op ich in die anleitung zum Programm schreiben kann: Bei einem Röhren Monitor bitte ein Magnet dran kleben und bei einem TFT bitte fester drauf drücken mit der Hand *G*

[theo]

Schreib noch hinzu, dass wenn man einen TFT hat, man mit der RECHTEN HAND drücken muss, damit man mit der linken CTRL S drücken kann, sonst geht der Verlauf natürlich verloren. Da haben's die mit dem Röhren Monitor einfacher.

[pluto]

lustig... mal sehen. ich werde mal in den nächsten tagen versuchen, die Funktionen anzupassen. evlt. schaffe ich das sogar mal abwarten.
vielen Dank für deine "Vorlage"

[theo]

Im der 0.9.22 gibt's übrigens GradientFill:

Image1.Picture.Bitmap.Width:=Image1.Width;
Image1.Picture.Bitmap.Height:=Image1.Height;
Image1.Picture.Bitmap.Canvas.GradientFill(Rect(0,0,Image1.Width,Image1.Height),clred,clyellow,gdvertical);

[pluto]

habe ich gesehen *G* mal sehen.... Danke.