Transfarent Ficture Form

unit Main;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls;

type

TfrmMain = class(TForm)

imgPicture: TImage;

procedure FormCreate(Sender: TObject);

procedure FormKeyPress(Sender: TObject; var Key: Char);

procedure FormPaint(Sender: TObject);

private

ImageMap: TBitmap;

WindowRgn: HRGN;

procedure WMNCHitTest (var M: TWMNCHitTest); message wm_NCHitTest;

function MaskColor(row: PByteArray; x: Word): TColor;

public

end;

var

frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);

procedure GetNextSpan(const row: PByteArray; const SpanLeft: Integer; var SpanRight: Integer; var SpanColor:TColor);

var

column : Integer;

TempColor : TColor;

begin

column := SpanLeft;

TempColor := MaskColor(row, SpanLeft);

repeat

column := column + 1;

until (TempColor <> MaskColor(row, column)) or (column >= ImageMap.Width);

SpanRight := column - 1;

SpanColor := TempColor;

end;

var

y : Integer;

row : PByteArray;

YRgn : HRGN;

SpanRgn : HRGN;

SpanLeft : Integer;

SpanRight : Integer;

SpanColor : TColor;

begin

frmMain.Canvas.Brush.Style := bsClear;

ImageMap := imgPicture.Picture.Bitmap;

WindowRgn := CreateRectRgn(0, 0, 0, 0);

for y := 0 to ImageMap.Height - 1 do

begin

YRgn := CreateRectRgn(0, y, 0, y);

row := ImageMap.scanline[y];

SpanLeft := 0;

SpanRight := 0;

repeat

GetNextSpan(row, SpanLeft, SpanRight, SpanColor);

if SpanColor <> clFuchsia then

begin

SpanRgn := CreateRectRgn(SpanLeft, y, SpanRight + 1, y + 1);

CombineRgn(YRgn, YRgn, SpanRgn, RGN_OR);

DeleteObject(SpanRgn);

end;

SpanLeft := SpanRight + 1;

until (SpanRight >= ImageMap.Width);

CombineRgn(WindowRgn, WindowRgn, YRgn, RGN_OR);

DeleteObject(YRgn);

end;

SetWindowRgn(Handle,WindowRgn,true);

end;

function TfrmMain.MaskColor(row: PByteArray; x: word):TColor;

var

r, g, b: byte;

begin

if ImageMap = nil then exit;

if x > ImageMap.Width then exit;

b := row[x * 3];

g := row[x * 3 + 1];

r := row[x * 3 + 2];

if (r = 255) and (g = 0) and (b = 255) then result := clFuchsia

end;

procedure TfrmMain.WMNCHitTest (var M: TWMNCHitTest);

begin

inherited;

if M.Result = htClient then

M.Result := htCaption;

end;

procedure TfrmMain.FormKeyPress(Sender: TObject; var Key: Char);

begin

if Key = CHR(27) then Application.Terminate

end;

procedure TfrmMain.FormPaint(Sender: TObject);

begin

Canvas.Draw(0, 0, ImageMap);

end;

end.