WebSVN – plumbers – Diff – /trunk/SceneEditor/Unit1.pas

 unit Unit1;
-// TODO: create for "unused files" box a small thumbnail, too?
+// Idea: create a small thumbnail for "unused files", too?
-// TODO: sound interrupts when playing the dia show
-// TODO: aspect ratio
-// TODO: unused files: exclude *.db or *.pk
 interface
 uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls, Spin, Grids, GameBinStruct, ComCtrls, ExtCtrls, Vcl.MPlayer,
   Vcl.Menus;
 const
-  CUR_VER = '2017-08-09';
+  CUR_VER = '2017-10-02';
 type
   TForm1 = class(TForm)
     ListBox1: TListBox;
     Button1: TButton;
     N2: TMenuItem;
     Help1: TMenuItem;
     About1: TMenuItem;
     PopupMenu1: TPopupMenu;
     Addtoscene1: TMenuItem;
+    Panel1: TPanel;
+    Panel2: TPanel;
     procedure ListBox1Click(Sender: TObject);
     procedure Edit1Change(Sender: TObject);
     procedure Edit2Change(Sender: TObject);
     procedure SpinEdit1Change(Sender: TObject);
     procedure Button3Click(Sender: TObject);
     procedure RecalcUnusedFiles;
     procedure HandlePossibleEmptySceneList;
     procedure DisableEnableSceneControls(enable: boolean);
     procedure DisableEnablePictureControls(enable: boolean);
     procedure DisableEnableFileControls(enable: boolean);
+    class procedure AspectRatio(image: TImage; panel: TControl);
   end;
 var
   Form1: TForm1;
   Button3.Enabled := enable;
   Button10.Enabled := enable;
   Button14.Enabled := enable;
 end;
+var
+  AutomaticNextDia: boolean;
 procedure TForm1.Button15Click(Sender: TObject);
 var
   decisionBMP: string;
   PictureLastFrame: Cardinal;
   i: integer;
   DecisionPicSet: boolean;
 begin
   if PlayStart <> 0 then
   begin
-    if MediaplayerOpened then
+    if MediaplayerOpened and not AutomaticNextDia then
     begin
       if MediaPlayer1.Mode = mpPlaying then MediaPlayer1.Stop;
       Mediaplayer1.TimeFormat := tfMilliseconds;
       if CurPictureTimepos*100 < Cardinal(MediaPlayer1.Length) then
       begin
         MediaPlayer1.Position := CurPictureTimepos * 100;
         MediaPlayer1.Play;
       end;
     end;
+    AutomaticNextDia := false;
     FirstTickCount := GetTickCount;
     PlayStart := GetTickCount - CurPictureTimepos * 100;
   end
   else
   begin
           end;
           if not Application.Terminated and (ListBox2.ItemIndex < ListBox2.Count-1) and not StopPlayRequest then
           begin
             ListBox2.ItemIndex := ListBox2.ItemIndex + 1;
+            AutomaticNextDia := true;
             ListBox2Click(ListBox2);
           end;
         end
         else
         begin
           begin
             decisionBMP := IncludeTrailingPathDelimiter(CurScene^.szSceneFolder) + CurScene^.szDecisionBmp;
             if (CurScene^.szDecisionBmp <> '') and FileExists(decisionBMP) then
             begin
               Image2.Picture.LoadFromFile(decisionBMP);
+              AspectRatio(Image2, Panel2);
             end
             else
             begin
               Image2.Picture := nil;
             end;
   begin
     Inc(result, Game.pictures[i].duration);
   end;
 end;
+class procedure TForm1.AspectRatio(image: TImage; panel: TControl);
+var
+  wi, hi, ws, hs: integer;
+  ri, rs: double;
+begin
+  wi := image.Picture.Width;
+  hi := image.Picture.Height;
+  ri := wi / hi;
+  ws := panel.Width;
+  hs := panel.Height;
+  rs := ws / hs;
+  if rs > ri then
+  begin
+    image.Width  := Round(wi * hs/hi);
+    image.Height := hs;
+  end
+  else
+  begin
+    image.Width  := ws;
+    image.Height := Round(hi * ws/wi);
+  end;
+  image.Left := Round(panel.Width  / 2 - image.Width  / 2);
+  image.Top  := Round(panel.Height / 2 - image.Height / 2);
+end;
 procedure TForm1.ListBox2Click(Sender: TObject);
 var
   Filename: string;
 begin
   SpinEdit13.Value := CurPicture^.duration;
   Edit3.Text := string(CurPicture^.szBitmapFile);
   Filename := string(IncludeTrailingPathDelimiter(CurScene^.szSceneFolder) + CurPicture^.szBitmapFile);
   if FileExists(Filename) then
+  begin
-    Image2.Picture.LoadFromFile(Filename) // TODO: keep aspect ratio
+    Image2.Picture.LoadFromFile(Filename);
+    AspectRatio(Image2, Panel2);
+  end
   else
+  begin
     Image2.Picture := nil;
+  end;
   Label18.Caption := _DecisecondToTime(CurPictureTimepos);
   if PlayStart <> 0 then
   begin
 procedure TForm1.RecalcUnusedFiles;
 var
   i, idx: integer;
   SR: TSearchRec;
+  ext: string;
 begin
+  ListBox3.Items.BeginUpdate;
+  try
-  ListBox3.Clear;
+    ListBox3.Clear;
-  if FindFirst(IncludeTrailingPathDelimiter(CurScene^.szSceneFolder) + '*.*', faArchive, SR) = 0 then
+    if FindFirst(IncludeTrailingPathDelimiter(CurScene^.szSceneFolder) + '*.*', faArchive, SR) = 0 then
-  begin
+    begin
-    repeat
+      repeat
+        ext := UpperCase(ExtractFileExt(SR.Name));
+        if ((ext <> '.PK' {Adobe Audition}) and (ext <> '.DB' {Windows Thumbnail})) then
+        begin
-      ListBox3.Items.Add(SR.Name); //Fill the list
+          ListBox3.Items.Add(SR.Name); //Fill the list
+        end;
-    until FindNext(SR) <> 0;
+      until FindNext(SR) <> 0;
-    FindClose(SR);
+      FindClose(SR);
-  end;
+    end;
+    // Remove the entries which are present
-  for i := CurScene^.pictureIndex to CurScene^.pictureIndex+CurScene^.numPics-1 do
+    for i := CurScene^.pictureIndex to CurScene^.pictureIndex+CurScene^.numPics-1 do
-  begin
+    begin
-    idx := ListBox3.Items.IndexOf(Game.pictures[i].szBitmapFile);
+      idx := ListBox3.Items.IndexOf(Game.pictures[i].szBitmapFile);
-    if idx <> -1 then ListBox3.Items.Delete(idx);
+      if idx <> -1 then ListBox3.Items.Delete(idx);
-  end;
+    end;
-  idx := ListBox3.Items.IndexOf(Edit2.Text);
+    idx := ListBox3.Items.IndexOf(Edit2.Text);
-  if idx <> -1 then ListBox3.Items.Delete(idx);
+    if idx <> -1 then ListBox3.Items.Delete(idx);
-  idx := ListBox3.Items.IndexOf(Edit3.Text);
+    idx := ListBox3.Items.IndexOf(Edit3.Text);
-  if idx <> -1 then ListBox3.Items.Delete(idx);
+    if idx <> -1 then ListBox3.Items.Delete(idx);
+  finally
+    ListBox3.Items.EndUpdate;
+  end;
 end;
 procedure TForm1.RecalcSoundtrackLength;
 var
   FileName: string;
 procedure TForm1.RedrawDecisionBitmap;
 var
   Filename: string;
 begin
   FileName := string(IncludeTrailingPathDelimiter(CurScene^.szSceneFolder) + Edit2.Text);
-  if FileExists(FileName) then
+  if not FileExists(FileName) then exit;
-    Image1.Picture.Bitmap.LoadFromFile(FileName) // TODO: keep aspect ratio
+  Image1.Picture.Bitmap.LoadFromFile(FileName);
-  else
-    Image1.Picture := nil;
+  AspectRatio(Image1, Panel1);
   Image1.Picture.Bitmap.PixelFormat := pf24bit; // Extend the palette, so we have red, green and blue guaranteed.
   Image1.Canvas.Brush.Style := bsDiagCross;

Subversion Repositories plumbers

plumbers/trunk/SceneEditor/Unit1.pas – Rev 5 → 6