Windows.GradientFill

[turboPASCAL]

Ich habe mir grad eine Funktion gebastelt:

Delphi-Quellcode:

var
  _GradientFill: function(DC: HDC; pTriVertex: Pointer; dwNumVertex: DWORD;
  pMesh: Pointer; dwNumMesh, dwMode: DWORD): DWORD; stdcall; { external in "msimg32.dll" }

type
  TFillMode = GRADIENT_FILL_RECT_H..GRADIENT_FILL_RECT_V;

function wGradientFill(DC: HDC; fillRect: TRect; startColor, endColor: COLORREF; FillMode: TFillMode): Boolean;
type
  _TTRIVERTEX = packed record
    X, Y: DWORD;
    Red, Green, Blue, Alpha: Word;
  end;
var
  tv: array [0..1] of _TTRIVERTEX;
  gr: GRADIENT_RECT;
  hLib: THandle;
begin
  // -------------------------------------------------------------------------
  // sollte global aufgerufen werden zB. in FormCreate
  // an sonsten wird das laden und freigeben unnötig oft aufgerufen
  hLib := LoadLibrary('MSIMG32.DLL');
  if hLib <> 0 then
    @_GradientFill := GetProcAddress(hLib, 'GradientFill');
  // -------------------------------------------------------------------------

  if @_GradientFill <> nil then
  begin
    // fillmode direction
    gr.UpperLeft  := 0;
    gr.LowerRight := 1;

    // eckpunkte festlegen
    tv[0].x     := fillRect.Left;
    tv[0].y     := fillRect.Top;
    tv[1].x     := fillRect.Right;
    tv[1].y     := fillRect.Bottom;

    // -------------------------------------------------------------------------
    // -> $0000 or BYTE(startColor shr 8) shl 8;
    // ein wenig trciki, GradientFill erwartet als farbwert ein word
    // wobei das farbbyte an erster stelle stehen muss.
    // ich verzichte hierbei gleich auf GetRValue() usw. von Windows. ;-)

    tv[0].Red   := $0000 or BYTE(startColor) shl 8;
    tv[0].Green := $0000 or BYTE(startColor shr 8) shl 8;
    tv[0].Blue  := $0000 or BYTE(startColor shr 16) shl 8;
    tv[0].Alpha := $0000 or BYTE(startColor shr 24) shl 8;

    tv[1].Red   := $0000 or BYTE(endColor) shl 8;
    tv[1].Green := $0000 or BYTE(endColor shr 8) shl 8;
    tv[1].Blue  := $0000 or BYTE(endColor shr 16) shl 8;
    tv[1].Alpha := $0000 or BYTE(endColor shr 24) shl 8;

    Result := _GradientFill(DC, @tv, 2, @gr, 1, FillMode) <> 0;
  end else
    Result := FALSE;

  // -------------------------------------------------------------------------
  // sollte global aufgerufen werden zB. in FormDestroy
  if hLib <> 0 then FreeLibrary(hLib);
  // -------------------------------------------------------------------------
end;

Aufruf zB.:

Delphi-Quellcode:

begin
  //...
 
  r := FormX.Clientrect;

  if @wGradientFill <> nil
    then wGradientFill(FormX.Canvas.Handle, r, clRed, clGreen, GRADIENT_FILL_RECT_H)
    else FormX.Canvas.FillRect(r);

Ich wusste doch das wir das in DP schon mal als Thema hatten.