{------------------------------------------------------------------------------}
{
   Unit Name: BackroundOmage
   Purpose  : Control to draw a backround image
   Author   : Vesa Lappalainen
   Date     : 14.10.2004
   Changed  :

   ToDo     :
}
{------------------------------------------------------------------------------}
unit BackroundImage;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, Graphics, Forms, jpeg;

type
  TBRIRelative = ( brrScreen,brrForm,brrParent,brrControl );
  TBackroundImage = class(tpaintBox)
  private
    FBitmap : TBitmap;
    FBmpLoaded : boolean;
    FBitmapName: string;
    FStrech: boolean;
    FRealtive: TBRIRelative;
    FTransparent: boolean;
    procedure SetBitmapName(const Value: string);
    procedure SetStrech(const Value: boolean);
    procedure DoBitmap;
    procedure SetRealtive(const Value: TBRIRelative);
    procedure bmpinvalidate;
    procedure SetTransparent(const Value: boolean);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
  published
    property BitmapName : string read FBitmapName write SetBitmapName;
    property Relative : TBRIRelative read FRealtive write SetRealtive default brrScreen;
    property Strech : boolean read FStrech write SetStrech default false;
    property Transparent : boolean read FTransparent write SetTransparent default false;
  end;

procedure Register;

implementation

var Bitmaps : TStrings;

procedure Register;
begin
  RegisterComponents('KaveOptions', [TBackroundImage]);
end;

{ TBackroundImage }

constructor TBackroundImage.Create(AOwner: TComponent);
begin
  inherited;

end;

destructor TBackroundImage.Destroy;
begin
  inherited;
end;

function FindForm(ctrl:TControl):TForm;
var c : TControl;
begin
  result := nil;
  c := ctrl;
  while ( c <> nil ) do begin
    if ( c is TForm ) then begin Result := TForm(c); exit; end;
    c := c.Parent;
  end;
end;

procedure TBackroundImage.Paint;
var ptc,pts:TPoint; rc,rs : TRect; f: TForm;
begin
  if ( not FBmpLOaded ) then DoBitmap;
  if ( FBitmap = nil ) then begin inherited; exit; end;
  ptc.X := 0;
  ptc.Y := 0;
  case Relative of
    brrScreen  : pts := ClientToScreen(ptc);
    brrForm    : begin
                   f   := FindForm(self);
                   if ( f = nil ) then exit;
                   pts := f.ScreenToClient(ClientToScreen(ptc));
                 end;
    brrParent  : begin
                   pts := Parent.ScreenToClient(ClientToScreen(ptc));
                 end;
    brrControl : pts := ptc;
  end;


  rc.TopLeft := ptc;
  rc.right := Width;
  rc.bottom := Height;

  rs.TopLeft := pts;
  if ( Strech ) then begin
    rs.right := rs.Left + FBitmap.Width;
    rs.bottom := rs.Top + FBitmap.Height;
  end else begin
    rs.right := rs.Left + Width;
    rs.bottom := rs.Top + Height;
  end;


//if ( FBitmap <> nil) then Canvas.Draw(0,0,FBitmap);

//  Canvas.CopyRect(rc,FBitmap.Canvas,rs);
  if ( Transparent ) then begin
    Canvas.Brush.Style := bsClear;
    Canvas.BrushCopy(rc,FBitmap,rs,clWhite);
  end else begin
    Canvas.CopyRect(rc,FBitmap.Canvas,rs);
  end;
  inherited;
end;

procedure TBackroundImage.DoBitmap();
var i:integer; b : TPicture; x,y,w,h:integer;
    s : string;
begin
  FBmpLoaded := true;
  s := '';
  if ( Strech ) then s := '.s';
  FBitmap := nil;
  if ( BitmapName = '' ) then exit;
  i := Bitmaps.IndexOf(BitmapName+s);
  if ( i >= 0 ) then begin
    FBitmap := TBitmap(Bitmaps.Objects[i]);
    exit;
  end;
  b := TPicture.Create;
  try
    b.LoadFromFile(BitmapName);
  except
    b.Free;
    Exit;
  end;

  if b.Graphic is TJPEGImage then
    with TJPEGImage(b.Graphic) do
    begin
      Performance := jpBestQuality;
    end;


  FBitmap := TBitmap.Create;
  w := b.Width;
  h := b.Height;
  if ( Strech ) then begin
    FBitmap.Width := w;
    FBitmap.Height := h;
  end else begin
    FBitmap.Width := Screen.Width;
    FBitmap.Height := Screen.Height;
  end;
  y := 0;
  while ( y <= FBitmap.Height ) do begin
    x := 0;
    while ( x <= FBitmap.Width ) do begin
      FBitmap.Canvas.Draw(x,y,b.Graphic);
      inc(x,w);
    end;
    inc(y,h);
  end;
  b.Free;
  Bitmaps.AddObject(BitmapName+s,FBitmap);
end;

procedure TBackroundImage.bmpinvalidate();
begin
  FBmpLoaded := false;
  Invalidate;
end;

procedure TBackroundImage.SetBitmapName(const Value: string);
begin
  if ( FBitmapName = Value ) then exit;
  FBitmapName := Value;
  bmpinvalidate;
end;

procedure DeleteBitmaps;
var i:integer; b:TObject;
begin
  if ( Bitmaps = nil ) then exit;
  for i:=0 to Bitmaps.Count-1 do begin
    b := Bitmaps.Objects[i];
    b.free;
  end;
  Bitmaps.Free;

end;

procedure TBackroundImage.SetStrech(const Value: boolean);
begin
  if ( FStrech = Value ) then exit;
  FStrech := Value;
  bmpinvalidate;
end;


procedure TBackroundImage.SetRealtive(const Value: TBRIRelative);
begin
  if ( FRealtive = Value ) then exit;
  FRealtive := Value;
  bmpinvalidate;
end;

procedure TBackroundImage.SetTransparent(const Value: boolean);
begin
  if ( FTransparent = Value ) then exit;
  FTransparent := Value;
  bmpinvalidate;
end;

initialization
  Bitmaps := TStringList.Create;

finalization
  DeleteBitmaps;
end.