src/video.pas

   1 unit video;
   2
   3 interface
   4  procedure initVideo(scrW, scrH:integer; canScale:boolean;);
   5  procedure drawVideo;
   6
   7 implementation
   8  uses scri, keyboard;
   9  var
  10   useRes:boolean;
  11
  12  procedure initVideo(scrW, scrH:integer; canScale:boolean;);
  13   var
  14    tmp:integer;
  15   begin
  16    keyboard.scrMulX:=1;
  17    keyboard.scrMulY:=1;
  18    useRes:=false;
  19    if (getWidth>getHeight) and (scrW<scrH) then
  20     begin
  21      tmp:=scrW;
  22      scrW:=scrH;
  23      scrH:=tmp;
  24     end;
  25
  26    if ((getWidth>scrW) and (getHeight>scrH)) or ((getHeight>scrW) and (getWidth>scrH)) then
  27     begin
  28      debug('Scaling: '+getWidth+'x'+getHeight+' -> '+scrW+'x'+scrH);
  29      if getWidth<getHeight then
  30       scrH:=getHeight/(getWidth/scrW);
  31      else
  32       scrW:=getWidth/(getHeight/scrH);
  33
  34      scrH:=getHeight/(getWidth/scrW);
  35      scrW:=getWidth/(getHeight/scrH);
  36
  37      debug('Scaling result: '+getWidth+'x'+getHeight+' -> '+scrW+'x'+scrH);
  38
  39      ScriCreate(scrW, scrH);
  40      if canScale then
  41       begin
  42        keyboard.scrMulX:=getWidth/scrW;
  43        keyboard.scrMulY:=getHeight/scrH;
  44        ScriScale(getWidth/scrW, getHeight/scrH);
  45        ScriPosition(0, 0);
  46        ScriSwap;
  47        useRes:=true;
  48       end;
  49    end;
  50   end;
  51
  52  procedure drawVideo;
  53   begin
  54    draw_virtual_keys;
  55    if useRes then
  56     begin
  57      ScriSwap;
  58      ScriDraw;
  59      Repaint;
  60      ScriSwap;
  61     end;
  62    else
  63     Repaint;
  64   end;
  65
  66 end.