Blend: Delphi Version

{*****************************************************************************
*                                                                            *
*  Blend.dpr                                                                 *
*  BlendU.pas                                                                *
*                                                                            *
*  This program illustrates some of the Fastgraph for Windows alpha blending *
*  functions.                                                                *
*                                                                            *
*  Press F1 to view the foreground image.                                    *
*  Press F2 to view the background image.                                    *
*  Press F3 to create and view a 50% blended image.                          *
*  Press F4 to create and view a variable blended image.                     *
*                                                                            *
*****************************************************************************}
unit BlendU;
interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, FGWin;
type
  TForm1 = class(TForm)
    procedure AppOnActivate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  end;
var
  Form1: TForm1;
implementation
{$R *.DFM}
const
  { virtual buffer dimensions }
  vbWidth = 640;
  vbHeight = 480;
  vbDepth = 16;
var
  { direct color bitmap containing the foreground image }
  Foreground : Array [1..vbWidth*vbHeight*(vbDepth div 8)] of byte;
  { direct color bitmap containing the background image }
  Background : Array [1..vbWidth*vbHeight*(vbDepth div 8)] of byte;
  { direct color bitmap containing the resulting blended image }
  Blended : Array [1..vbWidth*vbHeight*(vbDepth div 8)] of byte;
  { 256-color bitmap containing variable opacity values }
  Opacity : Array [1..vbWidth*vbHeight] of byte;
  dc : hDC;
  hPal : hPalette;
  hVB : integer;
  cxClient, cyClient : integer;
{*****************************************************************************
*                                                                            *
*  MakeOpacityBitmap()                                                       *
*                                                                            *
*  Define a 256-color bitmap with varying opacity values. The foregound      *
*  opacities will be zero at the image center and will gradually increase    *
*  as we move farther from the center.                                       *
*                                                                            *
*****************************************************************************}
procedure MakeOpacityBitmap;
var
  i, x, y : integer;
  OpacityValue : integer;
  yTerm : integer;
begin
  i := 1;
  for y := 0 to vbHeight-1 do
  begin
    yTerm := abs(y - vbHeight div 2);
    for x := 0 to vbWidth-1 do
    begin
      OpacityValue := abs(x - vbWidth div 2) + yTerm;
      if OpacityValue > 255 then
        Opacity[i] := 255
      else
        Opacity[i] := OpacityValue;
      inc(i);
    end;
  end;
end;
{****************************************************************************}
procedure TForm1.AppOnActivate(Sender: TObject);
begin
  fg_realize(hPal);
  Invalidate;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
  fg_realize(hPal);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  dc := GetDC(Form1.Handle);
  fg_setdc(dc);
  hPal := fg_defpal;
  fg_realize(hPal);
  fg_vbinit;
  fg_vbdepth(vbDepth);
  hVB := fg_vballoc(vbWidth,vbHeight);
  fg_vbopen(hVB);
  fg_vbcolors;
  { get background image from the CAT.BMP file }
  fg_showbmp('CAT.BMP'+chr(0),0);
  fg_move(0,vbHeight-1);
  fg_getdcb(Background,vbWidth,vbHeight);
  { get foreground image from the PORCH.BMP file }
  fg_showbmp('PORCH.BMP'+chr(0),0);
  fg_move(0,vbHeight-1);
  fg_getdcb(Foreground,vbWidth,vbHeight);
  { calcluate variable opacity bitmap }
  MakeOpacityBitmap;
  Application.OnActivate := AppOnActivate;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    { display foreground image }
    VK_F1:
    begin
      fg_move(0,vbHeight-1);
      fg_putdcb(Foreground,vbWidth,vbHeight);
      fg_vbscale(0,vbWidth-1,0,vbHeight-1,0,cxClient-1,0,cyClient-1);
      Caption := 'Alpha Blending: Foreground Image';
    end;
    { display background image }
    VK_F2:
    begin
      fg_move(0,vbHeight-1);
      fg_putdcb(Background,vbWidth,vbHeight);
      fg_vbscale(0,vbWidth-1,0,vbHeight-1,0,cxClient-1,0,cyClient-1);
      Caption := 'Alpha Blending: Background Image';
    end;
    { display blended image with constant 50% foreground opacity }
    VK_F3:
    begin
      Cursor := crHourGlass;
      fg_opacity(128);
      fg_blenddcb(Foreground,Background,Blended,vbWidth*vbHeight);
      fg_move(0,vbHeight-1);
      fg_putdcb(Blended,vbWidth,vbHeight);
      fg_vbscale(0,vbWidth-1,0,vbHeight-1,0,cxClient-1,0,cyClient-1);
      Caption := 'Alpha Blending: 50% Blended Image';
      Cursor := crDefault;
    end;
    { display blended image with variable foreground opacity }
    VK_F4:
    begin
      Cursor := crHourGlass;
      fg_blendvar(Foreground,Background,Opacity,Blended,vbWidth*vbHeight);
      fg_move(0,vbHeight-1);
      fg_putdcb(Blended,vbWidth,vbHeight);
      fg_vbscale(0,vbWidth-1,0,vbHeight-1,0,cxClient-1,0,cyClient-1);
      Caption := 'Alpha Blending: Variable Blended Image';
      Cursor := crDefault;
    end;
  end;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
  fg_vbscale(0,vbWidth-1,0,vbHeight-1,0,cxClient-1,0,cyClient-1);
end;
procedure TForm1.FormResize(Sender: TObject);
begin
  cxClient := ClientWidth;
  cyClient := ClientHeight;
  Invalidate;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
  fg_vbclose;
  fg_vbfree(hVB);
  fg_vbfin;
  DeleteObject(hPal);
  ReleaseDC(Form1.Handle,dc);
end;
end.