source: branches/highdpi/Back.pas

{$INCLUDE Switches.inc}
unit Back;

interface

uses
  Dpi.Forms, Dpi.Graphics,
  LCLIntf, LCLType, SysUtils, Classes, Graphics, Forms, Controls;

type

  { TBackground }

  TBackground = class(TDpiForm)
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    Img: TDpiBitmap;
  public
    procedure UpdateInterface;
  end;

var
  Background: TBackground;

implementation

uses
  Directories, ScreenTools, Start;

{$R *.lfm}

procedure TBackground.FormCreate(Sender: TObject);
begin
  Img := nil;
end;

procedure TBackground.FormShow(Sender: TObject);
begin
  UpdateInterface;
end;

procedure TBackground.FormDestroy(Sender: TObject);
begin
  if Assigned(Img) then FreeAndNil(Img);
end;

procedure TBackground.FormPaint(Sender: TObject);
begin
  if Assigned(Img) then
    DpiBitBltCanvas(Canvas, DpiScreen.Width - Img.Width - (DpiScreen.Width - 800) *
      3 div 8, (DpiScreen.Height - 600) div 3, Img.Width, Img.Height,
      Img.Canvas, 0, 0);
end;

procedure TBackground.FormClose(Sender: TObject; var Action: TCloseAction);
begin
end;

procedure TBackground.UpdateInterface;
var
  FileName: string;
begin
  if FullScreen then begin
    WindowState := wsFullScreen;
    if not Assigned(Img) then begin
      FileName := GetGraphicsDir + DirectorySeparator + 'Background.png';
      if FileExists(FileName) then begin
        Img := TDpiBitmap.Create;
        LoadGraphicFile(Img, FileName);
        Repaint;
      end;
    end;
  end else begin
    if WindowState <> wsMaximized then begin
      WindowState := wsNormal;
      WindowState := wsFullScreen;
    end;
    WindowState := wsNormal;
    BoundsRect := Bounds(StartDlg.Left - 8, StartDlg.Top - 8,
      StartDlg.Width + 16, StartDlg.Height + 16);
  end;
end;

end.