[Onic777]

Здравствуйте, Знатоки!

Я создал окно для захвата изображения с Web Camera следующим образом:

Код C++

Код:

hWndC = capCreateCaptureWindowA("My Own Capture Window",
                                   WS_CHILD | WS_VISIBLE,
                                   Form1->Panel1->Left,
                                   Form1->Panel1->Top,
                                   Form1->Panel1->Width,
                                   Form1->Panel1->Height,
                                   Form1->Panel1->Handle,
                                   0);
    if (hWndC!=0)
    {
        capDriverConnect    (hWndC,DeviceIndex);
        capPreviewScale     (hWndC, -1);
        capPreviewRate      (hWndC,0x42);
        capPreview          (hWndC,-1);
        SetWindowPos        (hWndC,
                            HWND_BOTTOM,
                            Form1->Panel1->Left,
                            Form1->Panel1->Top,
                            Form1->Panel1->Width,
                            Form1->Panel1->Height,
                            SWP_SHOWWINDOW);
    }

MAD: Пользуемся тегами.


Хотелось бы создать в этом окне перемещающийся с помощью мышки прямоугольный контур (рамку, frame или другим образом выделенную область, например, с помощью изменения прозрачности) для выделения интересующего фрагмента изображения с целью его дальнейшего сохранения.

Пытался решить проблему средствами BCPPB путем размещения на Panel1 Image, а затем на нем рисовал Frame, однако добиться его видимости мне не удалось.

Подскажите, как это можно сделать!

С Уважением,
Onic777

[lmikle]

Делал создание рамки.
Собственно, ее передвижение и изменение размеров - частный вариант обработки событий от мышы.

Sorry, код на Дельфи.

Код:

unit CutImageFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, BaseFrm, StdCtrls, ExtCtrls, Model, Math, System.UITypes;

type
  TOpMode = (omNone, omDraw, omMove);

  TCutImageFrame = class(TBaseFrame)
    pbImage: TPaintBox;
    procedure pbImagePaint(Sender: TObject);
    procedure pbImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pbImageMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure pbImageMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    FImage : TBitmap;
    FAspect : Extended;
    FImageRect : TRect;

    FAlphaBmp : TBitmap;
    FBlendFunc : _BLENDFUNCTION;

    FOpMode : TOpMode;
    FHasPoints : Boolean;
    FIsDrawing : Boolean;
    FStartPt, FEndPt : TPoint;

    procedure MoveRect(var Rect : TRect; ShiftX, ShiftY : Integer);
    procedure GetFaceRects(ClipRect : TRect; var TopRect, BottomRect : TRect);
    procedure BlendRectangle(CanvasHandle : THandle; R: TRect);
    procedure NomalizePoints;
  public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;

    function IsValid : Boolean; override;

    procedure LoadFromModel(Model : TModel); override;
    procedure SaveToModel(Model : TModel); override;
  end;

var
  CutImageFrame: TCutImageFrame;

implementation

{$R *.dfm}

constructor TCutImageFrame.Create(AOwner: TComponent);
const
  cTransColor : TColor = clBlue;
  cTransPercent : Byte = 25;
begin
  inherited;

  FImage := Nil;

  FAlphaBmp := TBitmap.Create;
  FAlphaBmp.Width := 1;
  FAlphaBmp.Height := 1;
  FAlphaBmp.Canvas.Pixels[0,0] := cTransColor;

  FBlendFunc.BlendOp := AC_SRC_OVER;
  FBlendFunc.BlendFlags := 0;
  FBlendFunc.SourceConstantAlpha := (50 + 255*cTransPercent) Div 100;
  FBlendFunc.AlphaFormat := 0;

  FOpMode := omNone;
end;

procedure TCutImageFrame.LoadFromModel(Model: TModel);
begin
  inherited;
  If Not Assigned(FImage) Then FImage := TBitmap.Create;
  FImage.Assign(Model.SourceBitmap);

  FAspect := Min(pbImage.Width/FImage.Width, pbImage.Height/FImage.Height);
  If FAspect > 1 Then FAspect := 1;
  FImageRect := Rect(0,0,Round(FImage.Width * FAspect),Round(FImage.Height * FAspect));
  MoveRect(FImageRect,Round((pbImage.Width-FImageRect.Right)/2),Round((pbImage.Height-FImageRect.Bottom)/2));

  FHasPoints := False;
  FIsDrawing := False;
end;

procedure TCutImageFrame.SaveToModel(Model: TModel);
var
  R : TRect;
  FBitmap : TBitmap;
begin
  inherited;

  FBitmap := TBitmap.Create;
  Try
    R := Rect(Min(FStartPt.X,FEndPt.X),Min(FStartPt.Y,FEndPt.Y),Max(FStartPt.X,FEndPt.X),Max(FStartPt.Y,FEndPt.Y));
    MoveRect(R,-FImageRect.Left,-FImageRect.Top);
    R.Left := Round(R.Left / FAspect);
    R.Top := Round(R.Top / FAspect);
    R.Right := Round(R.Right / FAspect);
    R.Bottom := Round(R.Bottom / FAspect);

    FBitmap.Width := R.Right - R.Left;
    FBitmap.Height := R.Bottom - R.Top;
    FBitmap.Canvas.CopyRect(Rect(0,0,FBitmap.Width,FBitmap.Height),FImage.Canvas,R);

    Model.CroppedBitmap := FBitmap;

    FreeAndNil(FImage);
  Finally
    FreeAndNil(FBitmap);
  End;
end;

procedure TCutImageFrame.pbImagePaint(Sender: TObject);
var
  R, FaceTop, FaceBottom : TRect;
begin
  inherited;
  pbImage.Canvas.StretchDraw(FImageRect,FImage);

  If FHasPoints Then
    Begin
      R := Rect(Min(FStartPt.X,FEndPt.X),Min(FStartPt.Y,FEndPt.Y),Max(FStartPt.X,FEndPt.X),Max(FStartPt.Y,FEndPt.Y));
      pbImage.Canvas.DrawFocusRect(R);

      GetFaceRects(R,FaceTop,FaceBottom);

      BlendRectangle(pbImage.Canvas.Handle,FaceTop);
      BlendRectangle(pbImage.Canvas.Handle,FaceBottom);
    End;
end;

procedure TCutImageFrame.GetFaceRects(ClipRect: TRect; var TopRect,
  BottomRect: TRect);
var
  RectWidth : Integer;
  TenPC : Integer;
begin
  {
  Height: 2 inch
  Head height: 1 - 1 3/8 inch (50%-69%)
  Head position: 10% from the top
  }

  RectWidth := ClipRect.Right - ClipRect.Left;
  TenPC := RectWidth div 10;

  TopRect.Top := ClipRect.Top + TenPC div 2;
  TopRect.Bottom := TopRect.Top + TenPC div 2;
  TopRect.Left := ClipRect.Left + RectWidth div 4;
  TopRect.Right := ClipRect.Right - RectWidth div 4;

  BottomRect.Bottom := ClipRect.Bottom - 3 * TenPC;
  BottomRect.Top := BottomRect.Bottom - TenPC div 2;
  BottomRect.Left := TopRect.Left;
  BottomRect.Right := TopRect.Right;
end;

procedure TCutImageFrame.MoveRect(var Rect: TRect; ShiftX,
  ShiftY: Integer);
begin
  Rect.Left := Rect.Left + ShiftX;
  Rect.Right := Rect.Right + ShiftX;
  Rect.Top := Rect.Top + ShiftY;
  Rect.Bottom := Rect.Bottom + ShiftY;
end;

function TCutImageFrame.IsValid: Boolean;
begin
  Result := False;
  If Not FHasPoints
    Then MessageDlg('Crop boundaries are not selected.',mtError,[mbOK],0)
    Else Result := True;
end;

procedure TCutImageFrame.BlendRectangle(CanvasHandle : THandle; R: TRect);
begin
  AlphaBlend(CanvasHandle,
             R.Left, R.Top, R.Right-R.Left, R.Bottom-R.Top,
             FAlphaBmp.Canvas.Handle, 0, 0, 1, 1, FBlendFunc);
end;

destructor TCutImageFrame.Destroy;
begin
  FreeAndNil(FAlphaBmp);
  inherited;
end;

procedure TCutImageFrame.NomalizePoints;
var
  P1, P2 : TPoint;
begin
  P1.X := Min(FStartPt.X,FEndPt.X);
  P1.Y := Min(FStartPt.Y,FEndPt.Y);

  P2.X := Max(FStartPt.X,FEndPt.X);
  P2.Y := Max(FStartPt.Y,FEndPt.Y);

  FStartPt := P1;
  FEndPt := P2;
end;

procedure TCutImageFrame.pbImageMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;

  If (X < FImageRect.Left) Or (X > FImageRect.Right) Or
     (Y < FImageRect.Top) Or (Y > FImageRect.Bottom)
    Then
      MessageDlg('Can''t start selection outside the photo.',mtError,[mbOK],0)
    Else
      Begin
        FStartPt.X := X;
        FStartPt.Y := Y;
        FEndPt.X := X;
        FEndPt.Y := Y;

        FHasPoints := True;
        FIsDrawing := True;

        Screen.Cursor := crCross;
        pbImagePaint(Sender);
      End;
end;

procedure TCutImageFrame.pbImageMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  FDelta : Integer;
  FSignX : Integer;
  FSignY : Integer;
begin
  inherited;

  If FIsDrawing
    Then
      Begin
        If X > FImageRect.Right Then X := FImageRect.Right;
        If Y > FImageRect.Bottom Then Y := FImageRect.Bottom;

        If X < FImageRect.Left Then X := FImageRect.Left;
        If Y < FImageRect.Top Then Y := FImageRect.Top;

        FDelta := Min(Abs(FStartPt.X - X),Abs(FStartPt.Y - Y));
        FSignX := Sign(FStartPt.X - X);
        FSignY := Sign(FStartPt.Y - Y);
        FEndPt.X := FStartPt.X - FSignX * FDelta;
        FEndPt.Y := FStartPt.Y - FSignY * FDelta;
        pbImagePaint(Sender);
      End
    Else
      Begin
        {
        If (X <= FEndPt.X) And (X >= FStartPt.X) And
           (Y <= FEndPt.Y) And (Y >= FStartPt.Y) And FHasPoints
          Then
            Begin
              Screen.Cursor := crSizeAll;
            End
          Else
            Begin
              Screen.Cursor := crDefault;
            End;
         }
      End;
end;

procedure TCutImageFrame.pbImageMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  FDelta : Integer;
  FSignX : Integer;
  FSignY : Integer;
begin
  inherited;
  
  If (X < FImageRect.Left) Or (X > FImageRect.Right) Or
     (Y < FImageRect.Top) Or (Y > FImageRect.Bottom) Then
    Begin
      If X > FImageRect.Right Then X := FImageRect.Right;
      If Y > FImageRect.Bottom Then Y := FImageRect.Bottom;
      If X < FImageRect.Left Then X := FImageRect.Left;
      If Y < FImageRect.Top Then Y := FImageRect.Top;
    End;
    
  FDelta := Min(Abs(FStartPt.X - X),Abs(FStartPt.Y - Y));
  FSignX := Sign(FStartPt.X - X);
  FSignY := Sign(FStartPt.Y - Y);
  FEndPt.X := FStartPt.X - FSignX * FDelta;
  FEndPt.Y := FStartPt.Y - FSignY * FDelta;
  NomalizePoints;
  FHasPoints := (FStartPt.X <> FEndPt.X) And (FstartPt.Y <> FEndPt.Y);
  FIsDrawing := False;
  Screen.Cursor := crDefault;
  pbImagePaint(Sender);
end;

end.