unit TestMain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls;
type
{ TCardTestForm }
TCardTestForm = class(TForm)
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Image1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
CardBitmap:TBitmap;
procedure DrawBitmap;
end;
var
CardTestForm: TCardTestForm;
implementation
{$R *.lfm}
{ TCardTestForm }
type
TABGR = packed record
R, G, B, A: Byte;
end;
TABGRColor = record
case Boolean of
False:(Color:TColor);
True:(ABGR:TABGR);
end;
const
Delta = 100;
MaxColor = 255 - Delta;
procedure TCardTestForm.FormCreate(Sender: TObject);
var MaskBitmap:TBitmap;
I, J:Integer;C:TABGRColor;
begin
Randomize;
with Image1.Picture do begin
Bitmap.Assign(TBitmap.Create);
Bitmap.Width := 640;
Bitmap.Height := 640;
Bitmap.Canvas.FillRect(0, 0, Bitmap.Width, Bitmap.Height);
end;
CardBitmap := TBitmap.Create;
CardBitmap.LoadFromFile('Card.bmp');
{Can be loaded from file too}
MaskBitmap := TBitmap.Create;
MaskBitmap.Width := CardBitmap.Width;
MaskBitmap.Height := CardBitmap.Height;
for I := 0 to CardBitmap.Width - 1 do begin
for J := 0 to CardBitmap.Height - 1 do begin
C.Color := CardBitmap.Canvas.Pixels[I, J];
if (C.ABGR.R > MaxColor) and (C.ABGR.G > MaxColor) and (C.ABGR.B > MaxColor) then begin
MaskBitmap.Canvas.Pixels[I, J] := clWhite;
end
else begin
MaskBitmap.Canvas.Pixels[I, J] := clBlack;
end;
end;
end;
CardBitmap.MaskHandle := MaskBitmap.ReleaseHandle;
MaskBitmap.Free;
DrawBitmap;
end;
procedure TCardTestForm.FormDestroy(Sender: TObject);
begin
CardBitmap.Free;
end;
procedure TCardTestForm.Image1Click(Sender: TObject);
begin
DrawBitmap;
end;
procedure TCardTestForm.DrawBitmap;
begin
with Image1.Picture do begin
{Random background color}
Bitmap.Canvas.Brush.Color := Random(clWhite);
Bitmap.Canvas.FillRect(0, 0, CardBitmap.Width, CardBitmap.Height);
Bitmap.Canvas.Draw(0, 0, CardBitmap);
end;
end;
end.
Recent
