Canvas - degrade via codigo

Top Previous Next

-------------------------------------------------------------------------------------------------------

-------- EXISTEM 3 MANEIRAS DE FAZER DEGRADE, ESTA É A ***MAIS RAPIDA*** ------------------------------

-------------------------------------------------------------------------------------------------------

{

Question/Problem/Abstract:

I am trying to use GradientFill API, but I get some weird results. Why?

Answer:

Because the declaration of the _TRIVERTEX structure is wrong!

This is how the structure is declared:

...

COLOR16 = Shortint;

...

_TRIVERTEX = packed record

x: Longint;

y: Longint;

Red: COLOR16;

Green: COLOR16;

Blue: COLOR16;

Alpha: COLOR16;

end;

Although the structure declaration itself is correct, the COLOR16 type should be of type Smallint.

This makes the size of structure 4 bytes shorter than expected by the API and gives the weird behaviour.

You can follow two ways to solve the problem:

Hard way: correct the error in Windows.pas and recompile the VCL library.

Easy way: declare in your programs the correct _TRIVERTEX structure and

redeclare the GradientFill API to match the new structure declaration.

Here follows a sample unit that show how to do it.

}

------------------------------------------------------------------------------

function GradientFill(Handle: HDC; pVertex: Pointer; dwNumVertex: DWORD; pMesh: Pointer; dwNumMesh: DWORD;

dwMode: DWORD): DWORD; stdcall; external 'msimg32.dll';

procedure Degrade(ACanvas: TCanvas; const X1, Y1, X2, Y2: Integer; CorInicial: TColor = clBlack; CorFinal: TColor = clBlue);

type

_TRIVERTEX = packed record

X, Y : DWord;

Red, Green, Blue, Alpha: Word;

end;

var

udtVertex : array [0..1] of _TRIVERTEX;

RectGradient: TGradientRect;

begin

with udtVertex[0] do

begin

X := X1;

Y := Y1;

Red := GetRValue( CorInicial ) * $100;

Green := GetGValue( CorInicial ) * $100;

Blue := GetBValue( CorInicial ) * $100;

Alpha := 0;

end;

with udtVertex[1] do

begin

X := X2;

Y := Y2;

Red := GetRValue( CorFinal ) * $100;

Green := GetGValue( CorFinal ) * $100;

Blue := GetBValue( CorFinal ) * $100;

Alpha := $0000;

end;

RectGradient.UpperLeft := 0;

RectGradient.LowerRight := 1;

// Para degrade vertical coloque um "V" no final da ultima palavra da linha abaixo

GradientFill(ACanvas.Handle, @udtVertex, 2, @RectGradient, 1, GRADIENT_FILL_RECT_H);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Degrade(Self.Canvas, 50, 50, 100, 100, clRed, clYellow) ;

end;

--------------------------------------------------------------------------

// Este abaixo estava na rotina original e não precisei usar ....

uses Graphics;

procedure SetTriVertexColor(var vertex: _TRIVERTEX; color:TColor);

begin

with vertex do

begin

Red := GetRValue(color) shl 8;

Green := GetGValue(color) shl 8;

Blue := GetBValue(color) shl 8;

end;

-------------------------------------------------------------------------------------------------------

------------------------------- 2 MODELO, É MAIS SIMPLES ----------------------------------------------

-------------------------------------------------------------------------------------------------------

// Esta função é simple, feita por Flavio Jr. Se quiser selecionar cor origem e destino use a outra funcao.

// Cor: B = Blue, G = Green, R = Red, Y = Yellow, P = Pink, S = Silver

procedure DesenhaDegrade(ACanvas: TCanvas; const X1, Y1, X2, Y2: Integer; Cor: Char = 'B');

var

I : Integer;

BC, RC, GC: Double;

begin

ACanvas.Brush.Style := bsSolid;

RC := 0; GC := 0; BC := 0;

for I := Y1 to Y2 do

begin

case Cor of

'B': BC := BC + (255 / (Y2-Y1));

'G': GC := GC + (255 / (Y2-Y1));

'R': RC := RC + (255 / (Y2-Y1));

'Y': begin

GC := GC + (255 / (Y2-Y1));

RC := RC + (255 / (Y2-Y1));

end;

'P': begin

BC := BC + (255 / (Y2-Y1));

RC := RC + (255 / (Y2-Y1));

end;

'S': begin

BC := BC + (255 / (Y2-Y1));

GC := GC + (255 / (Y2-Y1));

RC := RC + (255 / (Y2-Y1));

end;

if RC > 255 then RC := 255; // As vezes pode passar de 255... daí da bug!

if GC > 255 then GC := 255;

if BC > 255 then BC := 255;

ACanvas.Brush.Color := RGB( Trunc(RC), Trunc(GC), Trunc(BC));

ACanvas.FillRect(Rect( X1, Y1 + I, X2, Y1 + I + 1 ));

end;

----------------------------------------------------------------------------------------------------

---------------------------------- OUTRA SUPER-HIPER-POWER-DEGRADE-FUNCTIO -------------------------

----------------------------------------------------------------------------------------------------

type

TDegradeStyle = (dsVert, dsHoriz, dsVertDuplo, dsHorizDuplo);

procedure DesenhaDegrade(ACanvas: TCanvas; const X1, Y1, X2, Y2: Integer; CorInicial: TColor = clBlack; CorFinal: TColor = clBlue; Style: TDegradeStyle = dsVert);

var

FromR, FromG, FromB: Integer; // Usado para separar as cores em RGB

DiffR, DiffG, DiffB: Integer; // Usado para separar as cores em RGB

procedure DoVertical(fr, fg, fb, dr, dg, db : Integer);

var

ColorRect: TRect;

I : Integer;

R, G, B : Byte;

begin

ColorRect.Left := X1;

ColorRect.Right := X2;

for I := 0 to 255 do // Make lines (rectangles) of color

begin

ColorRect.Top := MulDiv (I, Y2-Y1, 256) + Y1; // Find top for this color

ColorRect.Bottom:= MulDiv (I + 1, Y2-Y1, 256) + Y1; // Find Bottom

R := fr + MulDiv(I, dr, 255); // Find the RGB values

G := fg + MulDiv(I, dg, 255);

B := fb + MulDiv(I, db, 255);

ACanvas.Brush.Color := RGB(R, G, B); // Plug colors into brush

ACanvas.FillRect(ColorRect); // Draw on Bitmap

end;

procedure DoHorizontal(fr, fg, fb, dr, dg, db : Integer);

var

ColorRect: TRect;

I : Integer;

R, G, B : Byte;

begin

ColorRect.Top := Y1; // Set rectangle top

ColorRect.Bottom := Y2;

for I := 0 to 255 do // Make lines (rectangles) of color

begin

ColorRect.Left := MulDiv (I, X2-X1, 256) + X1; // Find left for this color

ColorRect.Right := MulDiv (I + 1, X2-X1, 256) + X1; // Find Right

R := fr + MulDiv(I, dr, 255); // Find the RGB values

G := fg + MulDiv(I, dg, 255);

B := fb + MulDiv(I, db, 255);

ACanvas.Brush.Color := RGB(R, G, B); // Plug colors into brush

ACanvas.FillRect(ColorRect); // Draw on Bitmap

end;

procedure DoHorizCenter(fr, fg, fb, dr, dg, db : Integer);

var

ColorRect: TRect;

I : Integer;

R, G, B : Byte;

Haf : Integer;

begin

Haf := (X2-X1) div 2;

ColorRect.Top := Y1;

ColorRect.Bottom := Y2;

for I := 0 to Haf do

begin

ColorRect.Left := MulDiv (I, Haf, Haf) + X1;

ColorRect.Right := MulDiv (I + 1, Haf, Haf) + X1;

R := fr + MulDiv(I, dr, Haf);

G := fg + MulDiv(I, dg, Haf);

B := fb + MulDiv(I, db, Haf);

ACanvas.Brush.Color := RGB(R, G, B);

ACanvas.FillRect(ColorRect);

ColorRect.Left := (X2-X1) - (MulDiv (I, Haf, Haf)) + X1;

ColorRect.Right := (X2-X1) - (MulDiv (I + 1, Haf, Haf)) + X1;

ACanvas.FillRect(ColorRect);

end;

procedure DoVertCenter(fr, fg, fb, dr, dg, db : Integer);

var

ColorRect: TRect;

I : Integer;

R, G, B : Byte;

Haf : Integer;

begin

Haf := (Y2-Y1) div 2;

ColorRect.Left := X1;

ColorRect.Right := X2;

for I := 0 to Haf do

begin

ColorRect.Top := MulDiv (I, Haf, Haf) + Y1;

ColorRect.Bottom := MulDiv (I + 1, Haf, Haf) + Y1;

R := fr + MulDiv(I, dr, Haf);

G := fg + MulDiv(I, dg, Haf);

B := fb + MulDiv(I, db, Haf);

ACanvas.Brush.Color := RGB(R, G, B);

ACanvas.FillRect(ColorRect);

ColorRect.Top := (Y2-Y1) - (MulDiv (I, Haf, Haf)) + Y1;

ColorRect.Bottom := (Y2-Y1) - (MulDiv (I + 1, Haf, Haf)) + Y1;

ACanvas.FillRect(ColorRect);

end;

begin

ACanvas.Brush.Style := bsSolid;

// abaixo estes calculos separam o azul, verde e vermelho para "for"...

FromR := CorInicial and $000000ff;

FromG := (CorInicial shr 8) and $000000ff;

FromB := (CorInicial shr 16) and $000000ff;

DiffR := (CorFinal and $000000ff) - FromR; // Encontra a diferença

DiffG := ((CorFinal shr 8) and $000000ff) - FromG;

DiffB := ((CorFinal shr 16) and $000000ff) - FromB;

case Style of

dsVert : DoVertical(FromR, FromG, FromB, DiffR, DiffG, DiffB);

dsHoriz : DoHorizontal(FromR, FromG, FromB, DiffR, DiffG, DiffB);

dsVertDuplo : DoVertCenter(FromR, FromG, FromB, DiffR, DiffG, DiffB);

dsHorizDuplo: DoHorizCenter(FromR, FromG, FromB, DiffR, DiffG, DiffB);

end;

// Exemplo de uso:

procedure TForm1.BotaoClick;

begin

DesenhaDegrade(Self.Canvas, 10, 10, 60, 100, clBlack, clBlue, dsHoriz);

DesenhaDegrade(Self.Canvas, 70, 10, 120, 100, clBlack, clBlue, dsVert);

DesenhaDegrade(Self.Canvas, 130, 10, 180, 100, clRed, clYellow, dsHorizDuplo);

DesenhaDegrade(Self.Canvas, 190, 10, 240, 100, clGreen, clYellow, dsVertDuplo);

end;