camerafrm.pas

delphi与JSP通过xml-rpc协议交换数据的例子

unit CameraFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, cxLookAndFeelPainters, StdCtrls, cxButtons;

  const WM_CAP_START = WM_USER;
  const WM_CAP_STOP = WM_CAP_START + 68;
  const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
  const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
  const WM_CAP_SAVEDIB = WM_CAP_START + 25;
  const WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
  const WM_CAP_SEQUENCE = WM_CAP_START + 62;
  const WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;
  const WM_CAP_SEQUENCE_NOFILE =WM_CAP_START+  63 ;
  const WM_CAP_SET_OVERLAY =WM_CAP_START+  51 ;
  const WM_CAP_SET_PREVIEW =WM_CAP_START+  50 ;
  const WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START +6;
  const WM_CAP_SET_CALLBACK_ERROR=WM_CAP_START +2;
  const WM_CAP_SET_CALLBACK_STATUSA= WM_CAP_START +3;
  const WM_CAP_SET_CALLBACK_FRAME= WM_CAP_START +5;
  const WM_CAP_SET_SCALE=WM_CAP_START+  53 ;
  const WM_CAP_SET_PREVIEWRATE=WM_CAP_START+  52 ;

  const TEMP_PATH = 'Temp\';
  const TEMP_PICTURE_FILE = 'TempPicFile.bmp';

type
  TCameraForm = class(TForm)
    pnlBase: TPanel;
    pnlPicture: TPanel;
    pnlArea: TPanel;
    imgPicture: TImage;
    btnOk: TcxButton;
    btnCancel: TcxButton;
    btnTake: TcxButton;
    btnReLoad: TcxButton;
    SaveDialog: TSaveDialog;
    procedure btnCancelClick(Sender: TObject);
    procedure btnOkClick(Sender: TObject);
    procedure imgPictureMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure imgPictureMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btnReLoadClick(Sender: TObject);
    procedure btnTakeClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    hWndC : THandle;
    CapturingAVI : bool;
    foldx,x1,y1,x2,y2,oldx,oldy,foldy : Integer;
    Trace : Boolean;
    procedure ScreenPhoto;
  public
    NewBitmap : TBitmap;
  end;

var
  CameraForm: TCameraForm;
  
implementation

{$R *.dfm}

function capCreateCaptureWindowA(lpszWindowName : PCHAR;
  dwStyle : longint;
  x : integer;
  y : integer;
  nWidth : integer;
  nHeight : integer;
  ParentWin : HWND;
  nId : integer): HWND;
  STDCALL EXTERNAL 'AVICAP32.DLL';

procedure TCameraForm.FormCreate(Sender: TObject);
begin
  inherited;
  ScreenPhoto;
  pnlBase.DoubleBuffered := true;
end;

procedure TCameraForm.imgPictureMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Width,Height : Integer;
  tempPicFile: string;
begin
  tempPicFile := ExtractFilePath(Application.ExeName) +
        TEMP_PATH + TEMP_PICTURE_FILE;

  if Button = mbRight then
  begin
    imgPicture.Picture.Bitmap.LoadFromFile(tempPicFile);
    Trace := False;
  end
  else begin
    if (Trace = False) then//TRACE表示是否在追踪鼠标
    begin//首次点击鼠标左键，开始追踪鼠标。

      imgPicture.Picture.Bitmap.LoadFromFile(tempPicFile);

      with imgPicture.canvas do
      begin
          MoveTo(foldx,0);
          LineTo(foldx,screen.height);
          MoveTo(0,foldy);
          LineTo(screen.width,foldy);
      end;
      x1 := x;
      y1 := y;
      oldx := x;
      oldy := y;
      Trace := True;
      imgPicture.Canvas.Pen.mode:=pmnot;//笔的模式为取反
      //这样再在原处画一遍矩形，相当于擦除矩形。
      imgPicture.canvas.pen.color := clblack;//笔为黑色
      imgPicture.canvas.brush.Style := bsclear;//空白刷子
      end
    else
    begin//第二次点击，表示已经得到矩形了，把它拷贝到FORM1中的IMAGE部件上。
      x2 := x;
      y2 := y;
      Trace := False;
      imgPicture.Canvas.Rectangle(x1,y1,oldx,oldy);
      Width := abs(x2-x1);
      Height := abs(y2-y1);

      NewBitmap:=Tbitmap.create;
      NewBitmap.Width := Width;
      NewBitmap.Height := Height;
      NewBitmap.Canvas.CopyRect
      (Rect(0,0,width,Height),imgPicture.Canvas,
      Rect(x1,y1,x2,y2));//拷贝
      imgPicture.Canvas.Rectangle(x1, y1, x2, y2);
    end;
  end;
end;

procedure TCameraForm.imgPictureMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if trace=true then//是否在追踪鼠标？
  begin//是，擦除旧的矩形并画上新的矩形
    with imgPicture.canvas do
    begin
      rectangle(x1,y1,oldx,oldy);
      Rectangle(x1,y1,x,y);
      oldx:=x;
      oldy:=y;
    end;
  end;
end;

procedure TCameraForm.btnOkClick(Sender: TObject);
begin
  if SaveDialog.Execute then
  begin
    if not Assigned(NewBitmap) then
      NewBitmap.Assign(imgPicture.Picture.Bitmap);

    NewBitmap.SaveToFile(SaveDialog.FileName);
  end;
end;

procedure TCameraForm.btnCancelClick(Sender: TObject);
begin
  Close;
end;

procedure TCameraForm.btnReLoadClick(Sender: TObject);
begin
  ScreenPhoto;
end;

procedure TCameraForm.btnTakeClick(Sender: TObject);
var
  tempPicFile: string;
begin
  tempPicFile := ExtractFilePath(Application.ExeName) +
        TEMP_PATH + TEMP_PICTURE_FILE;

  if hWndC <> 0 then
  begin
    SendMessage(hWndC,
    WM_CAP_SAVEDIB,
    0,
    longint(pchar(tempPicFile)));
  end;

  if hWndC <> 0 then
  begin
    SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
    hWndC := 0;
    btnTake.Enabled :=true;
  end;

  imgPicture.Picture.Bitmap.LoadFromFile(tempPicFile);
  
  btnReLoad.Enabled := true;
  pnlPicture.Visible := false;
  btnTake.Enabled := false;

  imgPicture.Canvas.Pen.mode := Pmnot; //笔的模式为取反
  imgPicture.Canvas.pen.color := clblack; //笔为黑色
  imgPicture.Canvas.brush.Style := bsclear;//空白刷子
end;

procedure TCameraForm.ScreenPhoto;
begin

  btnReLoad.Enabled := false;
  pnlPicture.Visible := true;
  btnTake.Enabled := true;

  CapturingAVI := false;
  hWndC := 0;
  hWndC := capCreateCaptureWindowA('My Own Capture Window',
  WS_CHILD or WS_VISIBLE ,
  pnlArea.Left,
  pnlArea.Top,
  pnlArea.Width,
  pnlArea.Height,
  pnlPicture.Handle,
  0);
  if hWndC <> 0 then
  SendMessage(hWndC, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, 0);
  SendMessage(hWndC, WM_CAP_SET_CALLBACK_ERROR, 0, 0);
  SendMessage(hWndC, WM_CAP_SET_CALLBACK_STATUSA, 0, 0);
  SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
  SendMessage(hWndC, WM_CAP_SET_SCALE, 1, 0);
  SendMessage(hWndC, WM_CAP_SET_PREVIEWRATE, 66, 0);
  SendMessage(hWndC, WM_CAP_SET_OVERLAY, 1, 0);
  SendMessage(hWndC, WM_CAP_SET_PREVIEW, 1, 0);
end;

initialization

  RegisterClass(TCameraForm);

finalization

  UnRegisterClass(TCameraForm);

end.