unit HSGradient;

interface
uses
 Windows, Graphics;

type
 THSGradientStyle = (gsNone, gsHorizontal, gsVertical);

 THSGradientFill = class
 private
   FStartColor: TColor;
   FEndColor: TColor;
   FStyle: THSGradientStyle;
 public
   procedure FillRect (ACanvas: TCanvas; ARect: TRect);
   property StartColor: TColor read FStartColor write FStartColor;
   property EndColor: TColor read FEndColor write FEndColor;
   property Style: THSGradientStyle read FStyle write FStyle;
 end;

implementation
uses
 HSMsImg;

{ THSGradientFill }

procedure THSGradientFill.FillRect(ACanvas: TCanvas; ARect: TRect);
const
 StdGradientRect: GRADIENT_RECT = (UpperLeft: 0; LowerRight: 1);
 GradientDirections: array[Boolean] of Integer = (GRADIENT_FILL_RECT_H,
   GRADIENT_FILL_RECT_V);
var
 Vert: array[0..1] of THSTriVertex;
begin
 Vert[0].Red := Word(GetRValue(FStartColor)) shl 8;
 Vert[0].Green := Word(GetGValue(FStartColor)) shl 8;
 Vert[0].Blue := Word(GetBValue(FStartColor)) shl 8;
 Vert[1].Red := Word(GetRValue(FEndColor)) shl 8;
 Vert[1].Green := Word(GetGValue(FEndColor)) shl 8;
 Vert[1].Blue := Word(GetBValue(FEndColor)) shl 8;
 Vert[0].x := ARect.Left;
 Vert[0].y := ARect.Top;
 Vert[1].y := ARect.Bottom;
 Vert[1].x := ARect.Right;
 HSGradientFill(ACanvas.Handle, PHSTriVertex(@Vert), 2, @StdGradientRect, 1,
   GradientDirections[FStyle = gsVertical]);
end;

end.

{
  Модуль: HsMsImg

  Описание: Интерфейс к функциям MSIMG32

  Автор: Игорь Шевченко

  Дата создания: 18.10.2002

  История изменений:
}
unit HSMsImg;

interface
uses
 Windows;

type
 THSTriVertex = packed record
   x: LongInt;
   y: LongInt;
   Red: Word;
   Green: Word;
   Blue: Word;
   Alpha: Word;
 end;
 PHSTriVertex = ^THSTriVertex;

function HSGradientFill(DC: HDC; Vertex: PHSTriVertex; NumVertex: ULONG;
 Mesh: Pointer; NumMesh, Mode: ULONG): BOOL; stdcall;
const
 { gradient drawing modes }
 GRADIENT_FILL_RECT_H = $00000000;
 GRADIENT_FILL_RECT_V = $00000001;
 GRADIENT_FILL_TRIANGLE = $00000002;
 GRADIENT_FILL_OP_FLAG = $000000ff;

implementation

type
 THSGradientFill = function (DC: HDC; Vertex: PHSTriVertex; NumVertex: ULONG;
   Mesh: Pointer; NumMesh, Mode: ULONG): BOOL; stdcall;
var
 _HSGradientFill: THSGradientFill;
 DllHandle: THandle;

const
 Dllname = 'msimg32.dll';

function InitLib: Boolean;
begin
 if DllHandle = 0 then begin
   DllHandle := LoadLibrary(Dllname);
   if DllHandle <> 0 then begin
     @_HSGradientFill := GetProcAddress(DllHandle, 'GradientFill');
   end;
 end;
 Result := DllHandle <> 0;
end;

function HSGradientFill(DC: HDC; Vertex: PHSTriVertex; NumVertex: ULONG;
 Mesh: Pointer; NumMesh, Mode: ULONG): BOOL; stdcall;
begin
 if InitLib and Assigned(_HSGradientFill) then
   Result := _HSGradientFill(DC, Vertex, NumVertex, Mesh, NumMesh, Mode)
 else begin
   Result := false;
   SetLastError(ERROR_CALL_NOT_IMPLEMENTED);
 end;
end;

initialization
finalization
 if DllHandle <> 0 then
   FreeLibrary(DllHandle);
end.