unit Imageunit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, LCLIntf, LCLType;
type
TCard = class(TCustomControl)
private
FCardBMP: TBitmap;
protected
procedure Paint; override;
public
StandardCardList: timagelist;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetupStandardCards;
end;
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
public { public declarations }
Card1: TCard;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
constructor TCard.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
parent := TWinControl(Aowner);
FCardBMP := tbitmap.Create;
StandardCardList := timagelist.createSize(71, 95);
SetupStandardCards;
left := 0;
top := 0;
Height := 95;
Width := 71;
Show;
end;
destructor TCard.Destroy;
begin
FCardBMP.Free;
StandardCardList.Free;
inherited Destroy;
end;
procedure TCard.SetupStandardCards;
var
i: integer;
ACard: TBitmap;
begin
ACard := tbitmap.Create;
ACard.Height := 95;
ACard.Width := 72;
for i := 0 to 74 do
StandardCardList.Add(ACard, nil);
acard.Free;
end;
procedure TCard.Paint;
var
TS: TTextStyle;
R: TRect;
begin
StandardCardList.GetBitmap(1, FCardBMP);
FCardBMP.Canvas.Brush.color := clYellow;
FCardBMP.Canvas.FillRect(Bounds(1, 30, 14, 16));
FCardBMP.Canvas.Font.Style := [fsBold];
TS := FCardBMP.Canvas.TextStyle;
TS.Alignment := taCenter;
R := Rect(1, 30, 15, 46);
FCardBMP.Canvas.Font.Color := clblack;
FCardBMP.Canvas.TextRect(R, 1, 29, '-2', TS);
FCardbmp.SavetoFile('C:\Users\Bob\Documents\Attach\testcardbef.bmp');
Self.Canvas.Draw(0, 0, FCardBMP);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Card1 := TCard.Create(Form1);
self.color := clTeal;
Card1.left := 50;
Card1.top := 50;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Card1.Free;
end;
end.