Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Introduce video as stimulus. #54

Open
wants to merge 30 commits into
base: master
Choose a base branch
from
Open
Changes from 1 commit
Commits
Show all changes
30 commits
Select commit Hold shift + click to select a range
4e2206b
video interface draft
cpicanco Oct 20, 2017
ede8a30
Video.SetBounds draft
cpicanco Oct 21, 2017
fedd3a7
play stop button in video
cpicanco Oct 21, 2017
b720eae
move video units to src
cpicanco Oct 22, 2017
6eeb3a6
refactoring
cpicanco Oct 22, 2017
f641513
update project file
cpicanco Oct 22, 2017
84deeeb
update language files
cpicanco Oct 22, 2017
359074b
lets test on windows
cpicanco Oct 27, 2017
afeef95
works on linux with no hack
cpicanco Oct 27, 2017
5ba334e
add exemple of config file with videos
cpicanco Oct 28, 2017
f7fd40f
Merge branch 'vlc-video' of github.com:cpicanco/stimulus_control into…
cpicanco Oct 28, 2017
15d3c1d
add video extensions in open dialogs
cpicanco Oct 28, 2017
9ca97b1
fix missing comparisons in delayed mts when delay = 0
cpicanco Oct 29, 2017
8be4808
allow load/save matrix coordenates
cpicanco Oct 29, 2017
48f6e76
refactoring for better behavior analytic ontology
cpicanco Oct 29, 2017
a28ce93
update language files
cpicanco Oct 29, 2017
de74e9b
update .compiled files
cpicanco Oct 29, 2017
80f6446
update libzmq
cpicanco Oct 29, 2017
1959936
implements onclick event on video player
cpicanco Oct 29, 2017
7fa8c97
refactoring and add video onclick event for tkey with video
cpicanco Oct 29, 2017
181fe8c
use original size of iti media
cpicanco Feb 13, 2018
47a1684
update dependencies
cpicanco Mar 19, 2018
54157c9
do not use -Xs
cpicanco Mar 19, 2018
9402a2a
remove -Xs, again
cpicanco Mar 21, 2018
9cbee4e
Merge branch 'master' into vlc-video
cpicanco Mar 21, 2018
09e7d78
wip vlc test
cpicanco Mar 21, 2018
117248d
fix time schedules on start
cpicanco Apr 13, 2018
869e525
fix schedules example
cpicanco Apr 24, 2018
4d7990f
fix exceptions on create/destroy video cycles
cpicanco Apr 24, 2018
13ac858
setup debug project file
cpicanco Apr 24, 2018
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Next Next commit
video interface draft
  • Loading branch information
cpicanco committed Oct 20, 2017
commit 4e2206b8fbbc20107d64186935e2ca0a6d66865e
243 changes: 85 additions & 158 deletions src/units/controls.stimuli.key.pas
Original file line number Diff line number Diff line change
@@ -18,6 +18,7 @@ interface

, Dialogs
, Audio.Bass_nonfree
, Video
, Schedules
, Session.Configuration.GlobalContainer
;
@@ -38,15 +39,16 @@ TKey = class(TGraphicControl)
FSchedule: TSchedule;
FStimulus: TBitmap;
//FGifImage: TJvGIFAnimator;
//FMedia : TWindowsMediaPlayer;

FVideoPlayer : IVideoPlayer;
FEdge: TColor;
FFileName: string;
FKind: TKind;
FEditMode: Boolean;
FResponseCount: Integer;
FLoopNumber: Integer;
FLastResponseLog : string;
procedure SetFileName(Path: string);
procedure SetFileName(AFilename: string);
private
FOnConsequence: TNotifyEvent;
FOnResponse: TNotifyEvent;
@@ -112,11 +114,9 @@ constructor TKey.Create(AOwner: TComponent);

destructor TKey.Destroy;
begin
{if Assigned(FMedia) then
begin
Stop;
FreeAndNil(FMedia);
end;}
if FVideoPlayer.Assigned then
FVideoPlayer.Stop;

if Assigned(FAudioPlayer) then FAudioPlayer.Free;
if Assigned(FStimulus) then FStimulus.Free;
//if Assigned(FGifImage) then FreeAndNil (FGifImage);
@@ -132,12 +132,9 @@ procedure TKey.FullScreen;
Height := ClientHeight;
FStimulus.SetSize(Width,Height)
end;
{if (FKind.stmImage = stmVideo) then
begin
repeat Application.ProcessMessages until FMedia.playState = 3;
if (FMedia.playState = 3) then
FMedia.fullScreen := True;
end; }

if FKind.stmImage = stmVideo then
FVideoPlayer.FullScreen(True);
Invalidate;
end;

@@ -194,7 +191,7 @@ procedure TKey.Paint;
stmPicture:Canvas.StretchDraw(ClientRect, FStimulus);
//stmAnimation:PaintGIF;
stmNone:PaintKey(Color);
stmVideo:;
stmVideo:{ do nothing };
end;
end;

@@ -211,7 +208,7 @@ procedure TKey.Stop;
FAudioPlayer.Stop;
end;

procedure TKey.SetFileName(Path: string); //Review required
procedure TKey.SetFileName(AFilename: string); //Review required
var
s1 : String;

@@ -227,8 +224,13 @@ procedure TKey.SetFileName(Path: string); //Review required
if Assigned(FStimulus) then
FStimulus.Free;
FStimulus := TBitmap.Create;
FStimulus.Width:=Width;
FStimulus.Height:=Height;
with FStimulus do
begin
Width := Self.Width;
Height := Self.Height;
Canvas.Brush.Color := Self.Color;
Canvas.Rectangle(ClientRect);
end;
end;

procedure SetKind(Audio : boolean; Image : TImage);
@@ -253,177 +255,102 @@ procedure TKey.SetFileName(Path: string); //Review required
FGifImage.Cursor := Self.Cursor;
FGifImage.Animate := True; }



// Create_VID;
{
FMedia := TWindowsMediaPlayer.Create(self);
if OnlyAudio then FMedia.ParentWindow := Application.Handle
else FMedia.Parent := Self;
FMedia.Align:= alClient;
FMedia.stretchToFit := True;
//FMedia.enableContextMenu := False;
//FMedia.windowlessVideo := True;
//FMedia.ControlInterface.stretchToFit := True;
//FMedia.DefaultInterface.stretchToFit := True;
//FMedia.Top := 0;
//FMedia.Left := 0;
//FMedia.Width := Width;
//FMedia.Height := Height;
FMedia.settings.autoStart := False;
FMedia.settings.setMode('loop', false);
FMedia.settings.setMode('autoRewind', false);
FMedia.settings.invokeURLs := False;
FMedia.ControlInterface.enableContextMenu := False;
FMedia.ControlInterface.windowlessVideo := True;
FMedia.Cursor := Self.Cursor;
FMedia.OnMouseDown := MouseDown; //3
FMedia.uiMode := 'none';
}

function Load_PNG(AFilename:string; Audio: Boolean=False) : boolean;
procedure Load_PNG(AF:string=AFilename; Audio: Boolean=False);
var LPNG : TPortableNetworkGraphic;
begin
Result := False;
try
CreateBitmap;
LPNG := TPortableNetworkGraphic.Create;
LPNG.LoadFromFile(AFilename);
FStimulus.Assign(LPNG);
FStimulus.Transparent:=True;
FStimulus.TransparentColor:=clFuchsia;
LPNG.Free;
SetKind(Audio, stmPicture);
except
on Exception do
Exit;

end;
Result := True;
CreateBitmap;
LPNG := TPortableNetworkGraphic.Create;
LPNG.LoadFromFile(AF);
FStimulus.Assign(LPNG);
FStimulus.Transparent:=True;
FStimulus.TransparentColor:=clFuchsia;
LPNG.Free;
SetKind(Audio, stmPicture);
end;

function Load_BMP(AFilename:string; Audio: Boolean=False) : boolean;
procedure Load_BMP(AF:string=AFilename; Audio: Boolean=False);
begin
Result := False;
try
CreateBitmap;
FStimulus.LoadFromFile(AFilename);
SetKind(Audio, stmPicture);
except
on Exception do
Exit;
end;
Result := True;
CreateBitmap;
FStimulus.LoadFromFile(AF);
SetKind(Audio, stmPicture);
end;

function Load_JPG(AFilename:string; Audio: Boolean=False) : boolean;
procedure Load_JPG(AF:string=AFilename; Audio: Boolean=False);
var LJPG : TJPEGImage;
begin
Result := False;
try
CreateBitmap;
LJPG := TJPEGImage.Create;
LJPG.LoadFromFile(AFilename);
FStimulus.Assign(LJPG);
LJPG.Free;
SetKind(Audio, stmPicture);
except
on Exception do
Exit;
end;
Result := True;
CreateBitmap;
LJPG := TJPEGImage.Create;
LJPG.LoadFromFile(AF);
FStimulus.Assign(LJPG);
LJPG.Free;
SetKind(Audio, stmPicture);
end;

//function Load_GIF(Audio: boolean) : boolean;
//begin
// Result := False;
//
//
// try
// FGifImage.Image.LoadFromFile (s2);
// except
// on Exception do Exit;
// end;
//
// SetKind (Audio, stmAnimation);
// Result := True;
//
//
//end;

function Load_AUD(AFilename : string): boolean;
procedure Load_AUD;
begin
Result := False;
if Loops > 0 then
FAudioPlayer := TBassStream.Create(AFilename,Loops)
else
FAudioPlayer := TBassStream.Create(AFilename);
SetKind(True, TImage.stmNone);
Result := True;
end;

//function Load_VID (Audio : boolean) : boolean;
//begin
// Result := False;
//
// try
// if EditMode then FMedia.settings.playCount := 1
// else if FLoopNumber = 0 then FMedia.settings.playCount := MaxInt
// else if FLoopNumber > 0 then FMedia.settings.playCount := FLoopNumber
// else if FLoopNumber < 0 then FMedia.settings.playCount := Abs(FLoopNumber);
// FMedia.URL := s2;
// except
// on Exception do Exit;
//
// end;
// FMPlayer.OnNotify:= MPlayerLoopNotify;
// SetKind (Audio, Image);
// Result := True;
//end;
procedure Load_VID;
begin
FVideoPlayer := GetVideoInterface;
FVideoPlayer.Load(AFilename);
SetKind(False, TImage.stmVideo);
end;

begin
if FFileName = Path then Exit;
if FFileName = AFilename then Exit;
FFileName := '';
if FileExists(Path) then
if FileExists(AFilename) then
begin
s1:= UpperCase(ExtractFileExt(Path));
s1:= UpperCase(ExtractFileExt(AFilename));
case s1 of
// images
'.BMP' : Load_BMP(Path);
'.JPG' : Load_JPG(Path);
'.PNG' : Load_PNG(Path);
'.BMP' : Load_BMP;
'.JPG' : Load_JPG;
'.PNG' : Load_PNG;

// animation
// '.GIF': Load_GIF(Path);
//'.GIF' :
// begin
// FGifImage.Image.LoadFromFile (AFilename);
// SetKind(Audio, stmAnimation);
// end;

// video
//'.MPG', '.AVI',
//'.MOV', '.FLV',
//'.WMV', '.MP4': Load_VID;
'.MPG', '.AVI',
'.MOV', '.FLV',
'.WMV', '.MP4': Load_VID;
// audio
'.WAV','.AIFF','.MP3','.OGG':
if Load_AUD(Path) then
begin
// note that at this point we already loaded the audio file
// the user can associate an image with each audio file sound
// the user can place an image file with the same name as the audio file inside rootmedia
// we load the image here
s1:= Path;
Delete(s1, pos(Copy(Path,Length(Path)- 3,4),s1), 4);

for LExtension in LGuessedExtensions do
if FileExists(s1 + LExtension) then
begin
case UpperCase(LExtension) of
// images
'.BMP' : Load_BMP(s1 + LExtension, True);
'.JPG' : Load_JPG(s1 + LExtension, True);
'.PNG' : Load_PNG(s1 + LExtension, True);
end;
Break;
begin
Load_AUD;
// note that at this point we already loaded the audio file
// the user can associate an image with each audio file sound
// the user can place an image file with the same name as the audio file inside rootmedia
// we load the image here
s1:= AFilename;
Delete(s1, pos(Copy(AFilename,Length(AFilename)- 3,4),s1), 4);

for LExtension in LGuessedExtensions do
if FileExists(s1 + LExtension) then
begin
case UpperCase(LExtension) of
// images
'.BMP' : Load_BMP(s1 + LExtension, True);
'.JPG' : Load_JPG(s1 + LExtension, True);
'.PNG' : Load_PNG(s1 + LExtension, True);
end;
end;
Break;
end;
end;
end;

FFileName := Path;
FFileName := AFilename;
Invalidate;
end;
end;
@@ -450,7 +377,7 @@ procedure TKey.KeyMouseDown(Sender: TObject; Button: TMouseButton;
//******
procedure TKey.Consequence(Sender: TObject);
begin
if Assigned(OnConsequence) then FOnConsequence(Self); //Necessariamente Self
if Assigned(OnConsequence) then FOnConsequence(Self); //must be Self
end;

function TKey.GetShortName: string;
@@ -463,7 +390,7 @@ function TKey.GetShortName: string;

procedure TKey.Response(Sender: TObject);
begin
if Assigned(OnResponse) then FOnResponse(Self); //Necessariamente SELF
if Assigned(OnResponse) then FOnResponse(Self); //must be Self
end;


1 change: 1 addition & 0 deletions tests/vlc/.gitignore
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
backup/*
10 changes: 1 addition & 9 deletions tests/vlc/main_form.lfm
Original file line number Diff line number Diff line change
@@ -6,10 +6,8 @@ object Form1: TForm1
Caption = 'Form1'
ClientHeight = 459
ClientWidth = 824
OnActivate = FormActivate
OnCreate = FormCreate
OnDestroy = FormDestroy
LCLVersion = '1.8.0.3'
LCLVersion = '1.8.0.4'
object Panel1: TPanel
Left = 0
Height = 59
@@ -30,10 +28,4 @@ object Form1: TForm1
TabOrder = 0
end
end
object Timer1: TTimer
Enabled = False
OnTimer = Timer1Timer
left = 31
top = 40
end
end
Loading