A background painter class

Have you ever wanted to paint a bitmap tiled? centered? stretched? use this class

Here is a class I found long ago from one of those lost to memory sources, its sole purpose is to paint the background of a window using a given picture (you can extend its use by using tgraphic descendants such as tjpegpicture, add JPeg in the uses clause; TGifImage, add Anders Melanders gif; etc.)



unit bgpaint;



interface



uses

  Windows, Graphics, Classes;



type

  TTileBackStyle = (tbsNone, tbsPicCenter, tbsPicClip, tbsPicFit, tbsPicHeigth,

    tbsPicStretch, tbsPicTile, tbsPicWidth);



  TTileBack = class( TPersistent )

  private

    FPicture: TPicture;

    FStyle: TTileBackStyle;

    FOnChange: TNotifyEvent;



    procedure SetStyle(const Value: TTileBackStyle);

    procedure SetOnChange(const Value: TNotifyEvent);

    procedure SetPicture(const Value: TPicture);

  public

    constructor Create;

    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;



    function Empty: Boolean;

    procedure Draw(const Canvas: TCanvas; const ARect: TRect);

    property OnChange: TNotifyEvent read FOnChange write SetOnChange;

  published

    property Picture: TPicture read FPicture write SetPicture;

    property Style: TTileBackStyle read FStyle write SetStyle default tbsNone;

  end;



implementation



{ TTileBack }



procedure TTileBack.Assign(Source: TPersistent);

begin

  if Source is TTileBack then

    with TTileBack(Source) do

    begin

      Self.FStyle := Style;

      Self.Picture:= Picture;

    end

  else

    inherited

end;



constructor TTileBack.Create;

begin

  FPicture := TPicture.Create;

  FStyle := tbsNone;

end;



destructor TTileBack.Destroy;

begin

  FPicture.Free;

  inherited Destroy;

end;



procedure TTileBack.Draw(const Canvas: TCanvas; const ARect: TRect);

var

  Dest: TRect;

  XPos, YPos, RWidth, RHeight: Integer;

  PicRatio, ImageRatio: Double;

begin

  if Empty then Exit;



  RWidth := ARect.Right - ARect.Left;

  RHeight:= ARect.Bottom- ARect.Top;

  XPos := 0;

  YPos := 0;



  case Style of

    tbsNone: Exit;



    tbsPicClip:

      Canvas.Draw(ARect.Left, ARect.Top, Picture.Graphic);



    tbsPicCenter:

    begin

      XPos := ARect.Left + (RWidth - Picture.Width) div 2;

      YPos := ARect.Top + (RHeight- Picture.Height)div 2;

      Canvas.Draw(XPos, YPos, Picture.Graphic);

    end;



    tbsPicFit:

    begin

      if (FPicture.Width > 0) and (FPicture.Height > 0) then

      begin

        PicRatio := Picture.Height / Picture.Width;

        ImageRatio:=RHeight / RWidth;

        if PicRatio > ImageRatio then

        begin

          XPos := Trunc(RHeight / PicRatio);

          YPos := RHeight;

        end

        else

        begin

          XPos := RWidth;

          YPos := Trunc( RWidth * PicRatio );

        end;

      end;

      Dest := Rect( 0,0,XPos, YPos);

      OffsetRect(Dest, ARect.Left, ARect.Top);

      Canvas.StretchDraw(Dest, Picture.Graphic);

    end;



    tbsPicHeigth:

    begin

      XPos := Trunc(FPicture.Width * (RHeight / Picture.Height));


      YPos := RHeight;

      Dest := Rect(0, 0, XPos, YPos);

      OffsetRect(Dest, ARect.Left, ARect.Top);

      Canvas.StretchDraw(Dest, FPicture.Graphic);

    end;



    tbsPicStretch:

      Canvas.StretchDraw(ARect, Picture.Graphic);



    tbsPicTile:

    begin

      XPos := ARect.Left;

      while XPos < ARect.Right do

      begin

        YPos := ARect.Top;

        while YPos < ARect.Bottom do

        begin

          Canvas.Draw(XPos, Ypos, Picture.Graphic);

          YPos := YPos + FPicture.Height;

        end;

        XPos := XPos + Picture.Width;

      end;

    end;



    tbsPicWidth:

    begin

      XPos := RWidth;

      YPos := Trunc(RWidth * (Picture.Height / Picture.Width));

      Dest := Rect(0,0, XPos, YPos);

      OffsetRect(Dest, ARect.Left, ARect.Top);

      Canvas.StretchDraw(Dest, Picture.Graphic);

    end;

  end;

end;



function TTileBack.Empty: Boolean;

begin

  Result := (Style = tbsNone) or

    ((Style in [tbsPicClip, tbsPicFit, tbsPicHeigth, tbsPicStretch, tbsPicTile, tbsPicWidth]) and

    ((Picture = nil) or (Picture.Graphic = nil) or (Picture.Graphic.Empty)))

end;



procedure TTileBack.SetOnChange(const Value: TNotifyEvent);

begin

  FOnChange := Value;

  FPicture.OnChange := Value;

end;



procedure TTileBack.SetPicture(const Value: TPicture);

begin

  FPicture.Assign( Value );

end;



procedure TTileBack.SetStyle(const Value: TTileBackStyle);

begin

  if FStyle <> Value then

  begin

    FStyle := Value;

    if Assigned(FOnChange) then

      FOnChange(Self);

  end;

end;



end.



Here is a quick and dirty example of its usage and powers:





unit bgpaintex1;



interface



uses

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

  ExtCtrls, bgPaint, StdCtrls, JPeg;



type

  TForm1 = class(TForm)

    Image1: TImage;

    ComboBox1: TComboBox;

    Button1: TButton;

    OpenDialog1: TOpenDialog;

    procedure FormCreate(Sender: TObject);

    procedure FormPaint(Sender: TObject);

    procedure ComboBox1Change(Sender: TObject);

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

    aBG: TTileBack;

  end;



var

  Form1: TForm1;



implementation



uses TypInfo;



{$R *.DFM}



procedure TForm1.FormCreate(Sender: TObject);

var i: TTileBackStyle;

begin

  aBG := TTileBack.Create;

  aBG.Picture := Image1.Picture;

  aBG.Style := tbsPicFit;

  for i := tbsNone to tbsPicWidth do

  begin

    ComboBox1.Items.AddObject(GetEnumName(TypeInfo(TTileBackStyle), Integer(i)), TObject(i));

  end;

end;



procedure TForm1.FormPaint(Sender: TObject);

begin

  aBG.Draw(Canvas, ClientRect);

end;



procedure TForm1.ComboBox1Change(Sender: TObject);

begin

  aBG.Style := TTileBackStyle(ComboBox1.Items.Objects[ComboBox1.ItemIndex]);

  Invalidate;

end;



procedure TForm1.Button1Click(Sender: TObject);

begin

  if OpenDialog1.Execute then

  begin

    Image1.Picture.LoadFromFile(OpenDialog1.FileName);

    aBG.Picture := Image1.Picture;

    Invalidate;

  end;

end;



end.

 

Share this article!

Follow us!

Find more helpful articles: