
{$ALIGN ON, $BOOLEVAL OFF, $LONGSTRINGS ON, $IOCHECKS ON, $WRITEABLECONST OFF}
{$OVERFLOWCHECKS OFF, $RANGECHECKS OFF, $TYPEDADDRESS ON, $MINENUMSIZE 1}
unit Main;

interface

uses
	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
	ExtCtrls, StdCtrls, Buttons, ComCtrls, Menus, TBitmap_to_MJPEG_AVI;

type
	TMainForm = class(TForm)
	  MainMenu1: TMainMenu;
	  StatusBar1: TStatusBar;
	  Image1: TImage;
	  Label1: TLabel;
	  Timer1: TTimer;
	  procedure FormCreate(Sender: TObject);
	  procedure FormClose(Sender: TObject; var Action: TCloseAction);
	  procedure MPntExitClick(Sender: TObject);
	  procedure FormActivate(Sender: TObject);
	  procedure Timer1Timer(Sender: TObject);
	private
		Activated: boolean;
		BackGroundBitmap: TBitmap;
		OutputBitmap: TBitmap;
		v1, v2, v3, v4: word;
		TextX: integer;
		FrameCounter: dword;
		StartTick: dword;
		procedure WMWindowPosChanging(var MSG: Tmessage); message WM_WindowPosChanging;
		procedure UpdateImage(Sender: TObject);
	public
	end;

var
	MainForm: TMainForm;

implementation

{$R *.DFM}

//*************************

const	StickRange	=	13;

procedure TMainForm.WMWindowPosChanging(var MSG: Tmessage);
// Limit the forms position
var WorkArea: TRect;
Begin
	inherited;	// call parent proc first

	if (not SystemParametersInfo(SPI_GETWORKAREA, 0, @WorkArea, 0)) then exit;

	with PWindowPos(MSG.lparam)^ do
	begin
		if (x < (WorkArea.Left - round(Width * 0.9))) then x := WorkArea.Left - round(Width * 0.9)
		else
		if (x > (WorkArea.Right - round(Width * 0.1))) then x := WorkArea.Right - round(Width * 0.1);

		if (y < WorkArea.Top) then y := WorkArea.Top
		else
		if (y > (WorkArea.Bottom - round(Height * 0.1))) then y := WorkArea.Bottom - round(Height * 0.1);

		// stick to the screen edges
		if (Abs(x - WorkArea.Left) < StickRange) then x := WorkArea.Left;
		if (Abs((x + width) - WorkArea.Right) < StickRange) then x := WorkArea.Right - Width;
		if (Abs(y - WorkArea.Top) < StickRange) then y := WorkArea.Top;
		if (Abs((y + height) - WorkArea.Bottom) < StickRange) then y := WorkArea.Bottom - Height;
	end;
end;

//*************************

procedure GetBuildInfo(var v1, v2, v3, v4: word);
var	VerInfoSize	: DWord;
		VerInfo		: Pointer;
		VerValueSize: DWord;
		VerValue		: PVSFixedFileInfo;
		dw				: dword;
begin
	v1 := 0;
	v2 := 0;
	v3 := 0;
	v4 := 0;
	VerInfo := nil;

	VerInfoSize := GetFileVersionInfoSize(PChar(Application.ExeName), dw);
	if (VerInfoSize = 0) then exit;

	GetMem(VerInfo, VerInfoSize);
	if (VerInfo = nil) then exit;

	if (not GetFileVersionInfo(PChar( Application.ExeName), 0, VerInfoSize, VerInfo)) then
	begin
		FreeMem(VerInfo, VerInfoSize);
		exit;
	end;

	if (not VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize)) then
	begin
		FreeMem(VerInfo, VerInfoSize);
		exit;
	end;

	with VerValue^ do
	begin
		v1 := (dwFileVersionMS shr 16) and $FFFF;
		v2 := dwFileVersionMS and $FFFF;
		v3 := (dwFileVersionLS shr 16) and $FFFF;
		v4 := dwFileVersionLS and $FFFF;
	end;

	FreeMem(VerInfo, VerInfoSize);
end;

//*************************

procedure TMainForm.FormCreate(Sender: TObject);
begin
	Activated := false;

	GetBuildInfo(v1, v2, v3, v4);
	Caption := format('%s .. v%d.%d.%d.%d', [Application.Title, v1, v2, v3, v4]);

	Image1.Stretch := false;	// having stretch enabled slows things down somewhat	
	DoubleBuffered := true;		// stop display flicker

	BackgroundBitmap := nil;
	BackgroundBitmap := TBitmap.Create;

	if (FileExists('BackGround.bmp')) then
	begin
		BackGroundBitmap.LoadFromFile('BackGround.bmp');
		BackgroundBitmap.Width := BackgroundBitmap.Width and $fffffffe;		// ensure image is an even width
		BackgroundBitmap.Height := BackgroundBitmap.Height and $fffffffe;		// same with height
	end
	else
	begin
		BackgroundBitmap.Width := 640;
		BackgroundBitmap.Height := 480;
		BackgroundBitmap.PixelFormat := pf24bit;
		BackgroundBitmap.Canvas.Brush.Color := TColor($00906050);
		BackgroundBitmap.Canvas.FillRect(Rect(0, 0, Width, Height));
	end;

	OutputBitmap := nil;
	OutputBitmap := TBitmap.Create;
	OutputBitmap.Width := BackgroundBitmap.Width;
	OutputBitmap.Height := BackgroundBitmap.Height;
	OutputBitmap.PixelFormat := pf24bit;
	OutputBitmap.Canvas.Font := Label1.Font;
	OutputBitmap.Canvas.Brush.Style := bsClear;

	ClientWidth := OutputBitmap.Width;
	ClientHeight := OutputBitmap.Height;

	Image1.Picture.Bitmap.Width := Image1.Width;
	Image1.Picture.Bitmap.Height := Image1.Height;

	TextX := OutputBitmap.Width + 100;

	FrameCounter := 0;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
	Timer1.Enabled := false;

	// Close the AVI
	CloseMJPEGFile(false);

	if (OutputBitmap <> nil) then
	begin
		OutputBitmap.Free;
		OutputBitmap := nil;
	end;

	if (BackgroundBitmap <> nil) then
	begin
		BackgroundBitmap.Free;
		BackgroundBitmap := nil;
	end;
end;

procedure TMainForm.MPntExitClick(Sender: TObject);
begin
	PostMessage(Handle, WM_Close, 0, 0);			// close ourself
end;

procedure TMainForm.FormActivate(Sender: TObject);
begin
	if (Activated) then exit;
	Activated := true;

	// Create and initialize the AVI file
{	CreateMJPEGFile(	'mjpeg.avi',
							OutputBitmap.Width,
							OutputBitmap.Height,
							40000,
							FormatDateTime('ddd dd-mm-yyy hh:nn:ss', Now),
							20,
							paramstr(0) + ' ' + format('%s .. v%d.%d.%d.%d', [Application.Title, v1, v2, v3, v4]) + ' wrote by meh :)',
							'This is just an mjpeg test file',
							nil,
							nil,
							0);
}
	// Create and initialize the AVI file
	CreateMJPEGFile(	'mjpeg.avi',
							0,
							0,
							40000,
							FormatDateTime('ddd dd-mm-yyy hh:nn:ss', Now),
							20,
							paramstr(0) + ' ' + format('%s .. v%d.%d.%d.%d', [Application.Title, v1, v2, v3, v4]) + ' wrote by meh :)',
							'This is just an mjpeg test file',
							OutputBitmap,
							nil,
							0);

	StartTick := GetTickCount;


	Timer1.Enabled := true;
end;

procedure TMainForm.Timer1Timer(Sender: TObject);
begin
	UpdateImage(self);
end;

procedure TMainForm.UpdateImage(Sender: TObject);
var	s1, s2: string;
		x, y	: integer;
begin
	s1 := 'MJPEG TEST by C.Moss';
	s2 := 'Frame: ' + IntToStr(FrameCounter + 1);

	if (TextX < -(OutputBitmap.Canvas.TextWidth(s1) + 40)) then
	begin
		Timer1.Enabled := false;
		PostMessage(Handle, WM_Close, 0, 0);			// close ourself
		exit;
	end;

	TextX := TextX - 3;										// scroll the text

	if (BitBlt(	OutputBitmap.Canvas.Handle,
					0, 0, OutputBitmap.Width, OutputBitmap.Height,
					BackGroundBitmap.Canvas.Handle,
					0, 0,
					SRCCOPY)) then
	begin
		x := TextX;
		y := 30;
		OutputBitmap.Canvas.TextOut(x, y, s1);

		x := (OutputBitmap.Width - OutputBitmap.Canvas.TextWidth(s2)) div 2;
		y := y + OutputBitmap.Canvas.TextHeight(s1) + 10;
		OutputBitmap.Canvas.TextOut(x, y, s2);

		Image1.Picture.Assign(OutputBitmap);

		AddBitmap(OutputBitmap);									// this adds the image to the AVI file

		inc(FrameCounter);

		StatusBar1.Panels.Items[0].Text := format('%d', [FrameCounter]);
		StatusBar1.Panels.Items[1].Text := format('%0.1ffps', [FrameCounter / ((GetTickCount - StartTick) / 1000)]);

		Image1.Update;
	end;
end;

end.
