home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kompon / d23456 / WAVICAP.ZIP / avicap / Unit1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-01-31  |  3.5 KB  |  147 lines
  1. unit Unit1;
  2. interface
  3. uses
  4.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  5.   StdCtrls, ExtCtrls, AviCap, AviCapH, Clipbrd, Menus;
  6.  
  7. type
  8.   TForm1 = class(TForm)
  9.     Button1: TButton;
  10.     Panel1: TPanel;
  11.     Image1: TImage;
  12.     Button2: TButton;
  13.     Button3: TButton;
  14.     Button4: TButton;
  15.     Button5: TButton;
  16.     Button6: TButton;
  17.     Button7: TButton;
  18.     Button8: TButton;
  19.     Button9: TButton;
  20.     Edit1: TEdit;
  21.     Bevel1: TBevel;
  22.     AviCap1: TAviCap;
  23.     Button10: TButton;
  24.     PopupMenu1: TPopupMenu;
  25.     Item11: TMenuItem;
  26.     Item21: TMenuItem;
  27.     Item31: TMenuItem;
  28.     procedure Button1Click(Sender: TObject);
  29.     procedure Button2Click(Sender: TObject);
  30.     procedure Button3Click(Sender: TObject);
  31.     procedure Button5Click(Sender: TObject);
  32.     procedure Button6Click(Sender: TObject);
  33.     procedure Button4Click(Sender: TObject);
  34.     procedure Button7Click(Sender: TObject);
  35.     procedure Button8Click(Sender: TObject);
  36.     procedure Button9Click(Sender: TObject);
  37.     procedure AviCap1MouseMove(Sender: TObject; Shift: TShiftState; X,
  38.       Y: Integer);
  39.     procedure AviCap1MouseDown(Sender: TObject; Shift: TShiftState; X,
  40.       Y: Integer);
  41.     procedure Button10Click(Sender: TObject);
  42.   private
  43.      { Private-Deklarationen }
  44.   public
  45.    {Public-Deklarationen }
  46.   end;
  47. var
  48.   Form1: TForm1;
  49.  
  50. implementation
  51. {$R *.DFM}
  52.  
  53. procedure TForm1.Button1Click(Sender: TObject);
  54. begin
  55.   with AviCap1 do
  56.   begin
  57.     if cap_Connected then
  58.     begin
  59.       cap_Connected := False;
  60.       Button1.Caption := 'Connect';
  61.     end
  62.     else
  63.     begin cap_Connected := True;
  64.       Button1.Caption := 'Disconnect';
  65.     end;
  66.     Panel1.Visible := cap_Connected;
  67.   end;
  68. end;
  69.  
  70. procedure TForm1.Button2Click(Sender: TObject);
  71. begin
  72.   AviCap1.cap_DlgVideoCompression := true;
  73. end;
  74.  
  75. procedure TForm1.Button3Click(Sender: TObject);
  76. begin
  77.   AviCap1.cap_DlgVideoDisplay := true;
  78. end;
  79.  
  80. procedure TForm1.Button5Click(Sender: TObject);
  81. begin
  82.   AviCap1.cap_DlgVideoSourece := true;
  83. end;
  84.  
  85. procedure TForm1.Button4Click(Sender: TObject);
  86. begin
  87.   AviCap1.cap_DlgVideoFormat := true;
  88.  
  89. end;
  90.  
  91. procedure TForm1.Button6Click(Sender: TObject);
  92. begin
  93.   if messagedlg('Hit <OK> to start capture', mtConfirmation, [mbOK, mbAbort], 0) = mrOk then
  94.   begin
  95.     capPreview(avicap1.cap_WndHandle, 1);
  96.     AviCap1.StartCapture;
  97.   end
  98. end;
  99.  
  100. procedure TForm1.Button7Click(Sender: TObject);
  101. begin
  102.   capGrabFrameNoStop(AviCap1.cap_WndHandle);
  103.   capFileSaveDIB(AviCap1.cap_WndHandle, lparam(PChar(Edit1.Text)));
  104. end;
  105.  
  106. procedure TForm1.Button8Click(Sender: TObject);
  107. begin
  108.   capGrabFrameNoStop(AviCap1.cap_WndHandle);
  109.   capEditCopy(AviCap1.cap_WndHandle);
  110. end;
  111.  
  112. procedure TForm1.Button9Click(Sender: TObject);
  113. begin
  114.   Button8Click(Sender);
  115.   image1.Picture.Bitmap.LoadFromClipBoardFormat(cf_BitMap, ClipBoard.GetAsHandle(cf_Bitmap), 0);
  116.   ClipBoard.Clear;
  117. end;
  118.  
  119. procedure TForm1.AviCap1MouseMove(Sender: TObject; Shift: TShiftState; X,
  120.   Y: Integer);
  121. begin
  122.   caption := 'Position X: ' + IntToSTr(x) + ';  Position Y: ' + INtToSTr(y);
  123. end;
  124.  
  125. procedure TForm1.AviCap1MouseDown(Sender: TObject; Shift: TShiftState; X,
  126.   Y: Integer);
  127. var
  128.   r: Trect;
  129. begin
  130.   if ssLeft in Shift then
  131.     beep;
  132.   if ssRight in Shift then
  133.   begin
  134.     r := ClientRect;
  135.     PopupMenu1.Popup(left + width - r.Right + x, top + height - r.Bottom + y);
  136.   end;
  137. end;
  138.  
  139. procedure TForm1.Button10Click(Sender: TObject);
  140. begin
  141. With AViCAp1 do
  142. showblackscreen:= not showblackscreen
  143. end;
  144.  
  145. end.
  146.  
  147.