MACRO WINDOWS

Commentaire de f0xi le 15/01/2007 19:39:35 administrateur CS

un petit truc tout de suite :

if (Copy(IntToStr(GetKeyState(27)),1,1) = '-') then

mieux serait :

if GetAsyncKeyState(VK_ESCAPE) < 0 then

GetKeyState c'est plutot pour verifier les touches persistante comme Verr.Num, Caps.Lock, Scroll.Lock.

GetAsyncKeyState renvois une valeur inferieur a 0 si la touche est préssée.

on peu meme modifier le programme en faisant :

  repeat
    ImageBureau    := TPicture.Create;
    try
      HandleDCBureau := GetDC(GetDesktopWindow);
      ImageBureau.Bitmap.Width  := Screen.Width;
      ImageBureau.Bitmap.Height := Screen.Height;
      BitBlt(ImageBureau.Bitmap.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, HandleDCBureau, 0, 0, SrcCopy);
      ReleaseDC(GetDesktopWindow, HandleDCBureau);
      if CheckBox1.Checked then
         CaptureCurseurSouris(ImageBureau.Bitmap);
      Bmp := TbitMap.Create;
      try
        Bmp.Width  := 640;
        Bmp.Height := 480;
        ImgStretch(ImageBureau.Bitmap, Bmp, ResampleFilters[6].Filter, ResampleFilters[6].Width);
        AVIRecorder1.AddAVIFrame(Bmp);
      finally
        Bmp.Free;
      end;
    finally
      ImageBureau.Free;
    end;

    Fin := GetAsyncKeyState(VK_ESCAPE) < 0;

    if Fin then begin
       AVIRecorder1.CloseAVIFile;
       ShowWindow(Application.Handle, SW_SHOW);
       Application.Restore;
    end;

    Application.ProcessMessages;
until Fin;

un truc qui serait pas mal serait de mettre le process de capture dans un thread.

par contre pourquoi ImageBureau est de type TPicture plutot que TBitmap ??!
ce serait plus leger de le mettre en TBitmap ce qui pourrait, dans un soucis d'optimisation donner :

  Fin  := False;
  Pass := 0; { integer : compte le nombre de capture effectuées }

  AVIRecorder1.Compressor := acDivX;
  AVIRecorder1.FPS        := 3;
  { il faudrait garder le ratio de l'ecran original sur la taille de la video pour eviter l'ecrasement ou l'etirement de l'image :
    3/2   = 1.500 : 720x480, 1152x768, 1280x854, 1440x960
    4/3   = 1.333 : 320x240, 640x480, 768x576, 800x600, 1024x768, 1280x960, 1400x1050, 1600x1200, 2048x1536
    5/4   = 1.250 : 320x256, 640x512, 1280x1024, 2560x2048
    16/9  = 1.777 : 854x480, 1280x720, 1920x1080
    16/10 = 1.600 : 320x200, 1680x1050, 1920x1200, 2560x1600
  }
  AVIRecorder1.Width      := 640;
  AVIRecorder1.Height     := 480;

  if AVIRecorder1.CreateAVIFile(0) then begin
     ShowMessage('Appuyer sur [Echap] pour Arrêter la macro !');

     Application.Minimize;
     ShowWindow(Application.Handle, SW_HIDE);

     hbwait_ms(1000);

     FrameTemp      := TBitmap.Create;
     try
       FrameTemp.Width    := AVIRecorder1.Width;
       FrameTemp.Height   := AVIRecorder1.Height;
       repeat
         ImageBureau    := TBitmap.Create;
         try
           ImageBureau.Width  := Screen.Width;
           ImageBureau.Height := Screen.Height;
           HandleDCBureau := GetDC(GetDesktopWindow);
           BitBlt(ImageBureau.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, HandleDCBureau, 0, 0, SrcCopy);
           ReleaseDC(GetDesktopWindow, HandleDCBureau);

           if CheckBox1.Checked then
              CaptureCurseurSouris(ImageBureau);

           ImgStretch(ImageBureau, FrameTemp, ResampleFilters[6].Filter, ResampleFilters[6].Width);

           AVIRecorder1.AddAVIFrame(FrameTemp);
         finally
           ImageBureau.Free;
         end;

         Pass := Pass + 1;
         if (Pass mod 3) = 0 then
            Application.ProcessMessages;

         //----
         Fin := (GetAsyncKeyState(VK_ESCAPE) < 0) or (Pass >= $77359400);
         //----

       until Fin;

     finally
       AVIRecorder1.CloseAVIFile;
       FrameTemp.Free;

       ShowWindow(Application.Handle, SW_SHOW);
       Application.Restore;
     end;
  end;

Commentaire de f0xi le 16/01/2007 13:51:35 administrateur CS

Hi!

en fait le thread serait la pour eviter les appels a ProcessMessages qui ralentissent enormement le programme.
Aprés, c'est vrai, est-ce réellement utile ou non ... aprés tout on s'execute dans le thread principal qui n'a rien d'autre a faire...


sinon pour garder le ratio d'un image c'est simple :
R = W / H
H = W / R
W = H * R


ce qui nous donne comme fonctions :

function GetAspectRatio(const aOriginalWidth, aOriginalHeight : integer) : single;
begin
  result := aOriginalWidth / aOriginalHeight;
end;

function GetWidthByHeight(const aDesiredHeight : integer; const AspectRatio :  single) : integer;
begin
  result := round(aDesiredHeight * AspectRatio);
end;

function GetHeightByWidth(const aDesiredWidth : integer; const AspectRatio : single) : integer;
begin
  result := round(aDesiredWidth / AspectRatio);
end;


var
  AsRt : single  = 640/480;
  OlWd : integer = 640;
  OlHg : integer = 480;
  NwWd : integer = 320;
  NwHg : integer = 240;

{
Edit4 = Origine Width   [Tag = 1]
Edit5 = Origine Height  [Tag = 2]
Edit3 = Aspect Ratio    [Read only]
Edit1 = Desired Width   [Tag = 1]  
Edit2 = Desired Height  [Tag = 2]
}


{ comun a Edit1, Edit2, Edit4, Edit5 }
procedure TForm1.Edit4KeyPress(Sender: TObject; var Key: Char);
begin
  if not (Key in ['0'..'9',#08]) then Key := #0;
end;

{ comun a Edit4, Edit5 }
procedure TForm1.Edit4Change(Sender: TObject);
begin
  with (Sender as TEdit) do begin
    case Tag of
      1 : OlWd := StrToIntDef(Text,640);
      2 : OlHg := StrToIntDef(Text,480);
    end;
    AsRt := GetAspectRatio(OlWd,OlHg);
    Edit3.Text := Format('%.8f',[AsRt]);
    NwWd := StrToIntDef(Edit1.Text,320);
    NwHg := StrToIntDef(Edit2.Text,240);
    case Tag of
      1 : NwWd := GetWidthByHeight(NwHg,AsRt);
      2 : NwHg := GetHeightByWidth(NwWd,AsRt);
    end;
    Edit1.Text := IntToStr(NwWd);
    Edit2.Text := IntToStr(NwHg);
  end;
end;

{ comun a Edit1, Edit2 }
procedure TForm1.Edit1Change(Sender: TObject);
begin
  with (Sender as TEdit) do begin
    case Tag of
      1 : begin
            NwWd := StrToIntDef(Edit1.Text,320);
            NwHg := GetHeightByWidth(NwWd,AsRt);
            Edit2.Text := IntToStr(NwHg);
          end;
      2 : begin
            NwHg := StrToIntDef(Edit2.Text,240);
            NwWd := GetWidthByHeight(NwHg,AsRt);
            Edit1.Text := IntToStr(NwWd);
          end;
    end;
  end;
end;



ah, un truc au final qui serait pas mal du tout, serait de mettre l'appli dans la systray a coté de l'horloge...