{"id":134,"date":"2007-05-12T14:58:39","date_gmt":"2007-05-12T12:58:39","guid":{"rendered":" http:\/\/www.nsonic.de\/blog\/2007\/05\/rainbow-gradient-hintergrund\/"},"modified":"2007-05-12T14:58:41","modified_gmt":"2007-05-12T12:58:41","slug":"rainbow-gradient-hintergrund","status":"publish","type":"post","link":"https:\/\/www.nsonic.de\/blog\/2007\/05\/rainbow-gradient-hintergrund\/","title":{"rendered":"Rainbow Gradient Hintergrund"},"content":{"rendered":"

Wilhelm Steinbu\u00df wrote in message
\n37724E4C.5A37E97C@fh-trier.de… <\/p>\n

> Hi,
\n>
\n> I will made a rainborrow with two or more colors.
\n>
\n> A little procedure like:
\n>
\n> procedure (color1, color2:TColor; canvas: TCanvas);
\n> begin
\n> ….
\n> end;
\n>
\n> And this procedure should made the rainborrow in Canvas.
\n> In the top the color color1 and in the bottom the color color2 !
\n>
\n<\/em>
\nHere’s some source I found a while back about pallete shifting that makes
\na cool rainbow background on the form. It won’t work on some NT systems.<\/p>\n

[code lang=”delphi”]unit rainbow;<\/p>\n

interface<\/p>\n

uses
\n SysUtils, WinTypes, Forms, ExtCtrls, Classes, Messages, Graphics;<\/p>\n

type
\n TForm1 = class(TForm)
\n Timer1: TTimer;
\n procedure FormCreate(Sender: TObject);
\n procedure FormDestroy(Sender: TObject);
\n procedure FormPaint(Sender: TObject);
\n procedure FormResize(Sender: TObject);
\n procedure Timer1Timer(Sender: TObject);
\n procedure FormClick(Sender: TObject);
\n procedure Timer2Timer(Sender: TObject; var Done : Boolean);
\n procedure FormKeyPress(Sender: TObject; var Key: Char);
\n procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
\n Y: Integer);
\n private
\n { Private declarations }
\n BluePalette : HPALETTE;
\n UsingOurPalette : Boolean;
\n SaverKind : Word;
\n protected
\n procedure WMQueryNewPalette(var Message : TMessage); message
\n WM_QUERYNEWPALETTE;
\n procedure WMPaletteChanged(var Message : TMessage); message
\n WM_PALETTECHANGED;
\n procedure PaletteChanged(var Message : TMessage);
\n public
\n { Public declarations }
\n function GetPalette : HPALETTE; override;
\nend;<\/p>\n

var
\n Form1: TForm1;<\/p>\n

implementation<\/p>\n

{$R *.DFM}<\/p>\n

Var
\n Pal : PLogPalette;
\n PalSize : Word;<\/p>\n

type
\n TFadeDirection = (fdIn, fdOut);<\/p>\n

Procedure CursorOff;
\nVar
\n Cstate : Integer;
\nBegin
\n Cstate := ShowCursor(True);
\n While Cstate >= 0 do
\n Cstate := ShowCursor(False);
\nEnd;<\/p>\n

Procedure CursorOn;
\nVar
\n Cstate : Integer;
\nBegin
\n Cstate := ShowCursor(True);
\n While Cstate < 0 do\n Cstate := ShowCursor(True);\nEnd;\n\nprocedure TForm1.PaletteChanged(var Message : TMessage);\nvar\n hOldPal : THandle;\n wTemp : Word;\nbegin\n hOldPal := SelectPalette(Canvas.Handle, BluePalette, False);\n wTemp := RealizePalette(Canvas.Handle);\n SelectPalette(Canvas.Handle, hOldPal, True);\n RealizePalette(Canvas.Handle);\n if wTemp <> 0
\n Then
\n Invalidate;
\n Message.Result := wTemp;
\nend;<\/p>\n

procedure TForm1.WMQueryNewPalette(var Message : TMessage);
\nbegin
\n PaletteChanged(Message);
\n inherited;
\nend;<\/p>\n

procedure TForm1.WMPaletteChanged(var Message : TMessage);
\nbegin
\n if Message.wparam <> handle
\n then
\n Begin
\n PaletteChanged(Message);
\n UsingOurPalette := False;
\n End
\n else
\n UsingOurPalette := True;
\n inherited;
\nend;<\/p>\n

procedure MakeGradient(R1, G1, B1, R2, G2, B2, Steps : Integer;
\n var palPalEntry : array of TPaletteEntry);
\n var
\n RStep, GStep, BStep : Real;
\n RNow, GNow, BNow : Real;
\n i : Integer;
\nbegin
\n RStep := (R2-R1)\/Steps;
\n GStep := (G2-G1)\/Steps;
\n BStep := (B2-B1)\/Steps;
\n RNow := R1;
\n GNow := G1;
\n BNow := B1;
\n for i := 0 to Steps – 2 do
\n begin
\n with palPalEntry[i] do
\n begin
\n peRed := Round(RNow);
\n peGreen := Round(GNow);
\n peBlue := Round(BNow);
\n end;
\n RNow := RNow + RStep;
\n GNow := GNow + GStep;
\n BNow := BNow + BStep;
\n end;
\n with palPalEntry[Steps – 1] do
\n begin
\n peRed := R2;
\n peGreen := G2;
\n peBlue := B2;
\n end;
\nend;<\/p>\n

procedure TForm1.FormCreate(Sender: TObject);
\nvar
\n xHDC : HDC;
\n nStaticColors : Word;
\n I : Word;
\n BlackPal : PLogPalette;
\nbegin
\n Randomize;
\n SaverKind := Random(2);
\n If SaverKind = 1
\n Then
\n Color := clBlack;
\n Application.OnIdle := Timer2Timer;
\n PalSize := SizeOf(TLogPalette) + 255 * SizeOf(TPaletteEntry);
\n GetMem(Pal, PalSize);
\n With Pal^ do
\n Begin
\n palVersion := $0300;
\n palNumEntries := 256;
\n xHDC := Canvas.Handle;
\n { This assumes SYSPAL_STATIC, but will work under SYSPAL_NOSTATIC; if
\n you need more colors, check out GetSystemPaletteUse and
\nSetSystemPaletteUse
\n Get the twenty static colors into the array, then fill in the empty
\n spaces with the given color table }<\/p>\n

{ Get the static colors from the system palette }
\n nStaticColors := GetDeviceCaps(xHDC, NUMRESERVED);
\n if nStaticColors = 0
\n Then
\n nStaticColors := 20; { “Fake” static colors }
\n GetSystemPaletteEntries(xHDC, 0, 256, palPalEntry);
\n { Set the peFlags of the lower static colors to zero }
\n nStaticColors := nStaticColors shr 1; { half at bottom, half at top}
\n for i:= 0 to (nStaticColors-1) do
\n palPalEntry[i].peFlags := 0;<\/p>\n

I := 0;
\n MakeGradient(255, 0, 0, 255, 127, 0, 40, palPalEntry[ i+10]);
\n MakeGradient(255, 127, 0, 255, 255, 0, 40, palPalEntry[ i+49]);
\n MakeGradient(255, 255, 0, 0, 255, 0, 40, palPalEntry[ i+88]);
\n MakeGradient( 0, 255, 0, 0, 0, 255, 41, palPalEntry[i+128]);
\n MakeGradient( 0, 0, 255, 255, 0, 255, 41, palPalEntry[i+168]);
\n MakeGradient(255, 0, 255, 255, 0, 0, 40, palPalEntry[i+206]);<\/p>\n

For I := 0 to 235 do
\n With palPalEntry[nStaticColors + I] do
\n peFlags :=PC_RESERVED; { Prepare for palette animation }<\/p>\n

{ Mark empty entries as PC_NOCOLLAPSE }
\n for i := (nStaticColors + 236) to (255-nStaticColors) do
\n palPalEntry[i].peFlags := PC_NOCOLLAPSE;<\/p>\n

{ Set the peFlags of the upper static colors to zero }
\n for i := (256 – nStaticColors) to 255 do
\n palPalEntry[i].peFlags := 0;<\/p>\n

GetMem(BlackPal, PalSize);
\n Move(Pal^, BlackPal^, PalSize);
\n I := 10;
\n FillChar(BlackPal^.palPalEntry[I], SizeOf(TPALETTEENTRY) * 236, 0);
\n For I := 10 to 245 do
\n BlackPal^.palPalEntry[I].peFlags := PC_RESERVED;
\n BluePalette := CreatePalette(BlackPal^);
\n FreeMem(BlackPal, PalSize);
\n end;
\nend;<\/p>\n

procedure TForm1.FormDestroy(Sender: TObject);
\nbegin
\n { Delete the palette we created earlier }
\n DeleteObject(BluePalette);
\n FreeMem(Pal, PalSize);
\nend;<\/p>\n

function TForm1.GetPalette : HPALETTE;
\nbegin
\n Result := BluePalette;
\nend;<\/p>\n

procedure TForm1.FormPaint(Sender: TObject);
\nvar
\n OldPal : HPALETTE;
\n YPos, BarWidth : Real;
\n i : Word;
\nbegin
\n OldPal := SelectPalette(Canvas.Handle, BluePalette, True);
\n RealizePalette(Canvas.Handle);
\n BarWidth := clientheight \/ 236;
\n Case SaverKind of
\n 0 : Begin
\n YPos := 0;
\n For i := 10 to 245 do
\n begin
\n If UsingOurPalette
\n Then
\n canvas.brush.color := PaletteIndex(i)
\n Else
\n with Pal^.palPalEntry[i] do
\n canvas.brush.color := RGB(peRed, peGreen, peBlue);
\n canvas.fillrect(rect(0, Round(YPos),
\n ClientWidth – 1, Round(YPos + BarWidth)));
\n YPos := YPos + BarWidth;
\n end;
\n End;
\n End;
\n SelectPalette(Canvas.Handle, OldPal, True);
\n RealizePalette(Canvas.Handle);
\nend;<\/p>\n

procedure TForm1.FormResize(Sender: TObject);
\nbegin
\n Invalidate;
\nend;<\/p>\n

procedure Fade(Steps : Word; MyPal : PLogPalette;
\n BluePalette : HPALETTE; Dir : TFadeDirection);
\ntype
\n TRealPalEntry = Record
\n reRed : Real;
\n reGreen : Real;
\n reBlue : Real;
\n End;
\n TRealPal = Array[0..255] of TRealPalEntry;<\/p>\n

var
\n OldPal : HPalette;
\n FadeRealPal : ^TRealPal;
\n FadeStepsPal : ^TRealPal;
\n FinalPal : PLogPalette;
\n I, J : Word;
\n Ten : Word;
\n TempPalette : HPalette;<\/p>\n

PalSize : Word;
\n Pal : PLogPalette;<\/p>\n

begin
\n Ten := 10;
\n GetMem(FadeRealPal, SizeOf(TRealPalEntry) * 236);
\n GetMem(FadeStepsPal, SizeOf(TRealPalEntry) * 236);
\n PalSize := SizeOf(TLogPalette) + 255 * SizeOf(TPaletteEntry);
\n GetMem(Pal, PalSize);
\n GetMem(FinalPal, PalSize);
\n Move(MyPal^, Pal^, PalSize);
\n Move(Pal^, FinalPal^, PalSize);
\n {$R-}
\n If Dir = fdOut
\n Then
\n For I := 0 to 235 do
\n With FadeStepsPal^[I], Pal^.palPalEntry[I+10] do
\n begin
\n reRed := -peRed \/ Steps;
\n reBlue := -peBlue \/ Steps;
\n reGreen := -peGreen \/ Steps;
\n end
\n Else
\n For I := 0 to 235 do
\n With FadeStepsPal^[I], Pal^.palPalEntry[I+10] do
\n begin
\n reRed := peRed \/ Steps;
\n reBlue := peBlue \/ Steps;
\n reGreen := peGreen \/ Steps;
\n end;
\n if Dir = fdIn
\n Then
\n Begin
\n FillChar(Pal^.palPalEntry[Ten], SizeOf(TPALETTEENTRY) * 236, 0);
\n FillChar(FadeRealPal^, SizeOf(TRealPalEntry) * 236, 0);
\n End
\n Else
\n Begin
\n FillChar(FinalPal^.palPalEntry[Ten], SizeOf(TPALETTEENTRY) * 236,
\n0);
\n For I := 0 to 235 do
\n With FadeRealPal^[I], Pal^.palPalEntry[I+10] do
\n begin
\n reRed := peRed;
\n reBlue := peBlue;
\n reGreen := peGreen;
\n end
\n End;<\/p>\n

For I := 0 to 235 do
\n begin
\n Pal^.palPalEntry[I+10].peFlags := PC_RESERVED;
\n FinalPal^.palPalEntry[I + 10].peFlags := PC_RESERVED;
\n end;<\/p>\n

For I := 1 to Steps – 1 do
\n Begin
\n AnimatePalette(BluePalette, 10, 236, Addr(Pal^.palPalEntry[Ten]));<\/p>\n

For J := 0 to 235 do
\n Begin
\n With FadeRealPal^[J] do
\n Begin
\n reRed := reRed + FadeStepsPal^[J].reRed;
\n reGreen := reGreen + FadeStepsPal^[J].reGreen;
\n reBlue := reBlue + FadeStepsPal^[J].reBlue;
\n End;
\n With Pal^.palpalEntry[J+10] do
\n Begin
\n peRed := Round(FadeRealPal^[J].reRed);
\n peGreen := Round(FadeRealPal^[J].reGreen);
\n peBlue := Round(FadeRealPal^[J].reBlue);
\n End;
\n End;
\n End;
\n AnimatePalette(BluePalette, 10, 236, Addr(FinalPal^.palPalEntry[Ten]));
\n FreeMem(FinalPal, PalSize);
\n FreeMem(Pal, PalSize);
\n FreeMem(FadeRealPal, SizeOf(TRealPalEntry) * 236);
\n FreeMem(FadeStepsPal, SizeOf(TRealPalEntry) * 236);
\nend;<\/p>\n

const
\n Started : Boolean = False;
\n BallColor : Word = 245;
\n YDir : Integer = -2;
\n XDir : Integer = 1;
\n RX : Integer = 100;
\n RY : Integer = 200;<\/p>\n

procedure TForm1.Timer1Timer(Sender: TObject);
\nvar
\n Temp : TPALETTEENTRY;
\n F, G : Word;
\n OldPal : HPalette;
\nconst
\n PalStart : word = 10;
\n PalEnd : word = 245;
\nbegin
\n If not Started
\n Then
\n Started := True;
\n With pal^ do
\n Begin
\n Temp := palPalEntry[palStart];
\n For F := palStart to (palEnd – 1) do
\n palPalEntry[F] := palPalEntry[F+1];
\n palPalEntry[palEnd] := Temp;
\n AnimatePalette(BluePalette, PalStart, (PalEnd + 1 –
\nPalStart),Addr(palPalEntry[palStart]))
\n End;
\n OldPal := SelectPalette(Canvas.Handle, BluePalette, True);
\n RealizePalette(Canvas.Handle);
\n Case SaverKind of
\n 1 :
\n Begin
\n canvas.brush.color := PaletteIndex(BallColor);
\n canvas.fillrect(Rect(RX, RY, RX+20, RY+20));
\n Inc(RX, XDir);
\n If (RX + 20 >= clientwidth) or (RX < 0)\n Then\n XDir := -XDir;\n Inc(RY, YDir);\n If (RY+20 >= clientheight) or (RY < 0)\n Then\n YDir := -YDir;\n Dec(BallColor);\n If BallColor = 9\n Then\n BallColor := 245;\n End;\n End;\n SelectPalette(Canvas.Handle, OldPal, True);\n RealizePalette(Canvas.Handle);\nend;\n\n\nprocedure TForm1.FormClick(Sender: TObject);\nbegin\n If Started\n Then\n Begin\n Fade(128, Pal, BluePalette, fdOut);\n Close;\n End;\nend;\n\nconst\n FirstTime : Boolean = True;\n\nprocedure TForm1.Timer2Timer(Sender: TObject; var Done: Boolean);\nbegin\n If FirstTime\n Then\n Begin\n FirstTime := False;\n Fade(128, Pal, BluePalette, fdIn);\n Timer1.Enabled := True;\n Done := False;\n End;\nend;\n\nprocedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);\nbegin\n FormClick(Sender);\nend;\n\nprocedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,\n Y: Integer);\nbegin\n FormClick(Sender);\nend;\n\nend.\n[\/code]\n\n[tags]Delphi, Graphic[\/tags]\n<\/p>\n","protected":false},"excerpt":{"rendered":"

Wilhelm Steinbu\u00df wrote in message 37724E4C.5A37E97C@fh-trier.de… > Hi, > > I will made a rainborrow with two or more colors. > > A…<\/p>\n","protected":false},"author":2,"featured_media":0,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"spay_email":""},"categories":[11],"tags":[75,101],"jetpack_featured_media_url":"","jetpack_shortlink":"https:\/\/wp.me\/p71Tml-2a","_links":{"self":[{"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/posts\/134"}],"collection":[{"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/users\/2"}],"replies":[{"embeddable":true,"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/comments?post=134"}],"version-history":[{"count":0,"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/posts\/134\/revisions"}],"wp:attachment":[{"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/media?parent=134"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/categories?post=134"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.nsonic.de\/blog\/wp-json\/wp\/v2\/tags?post=134"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}