Ножницы своими руками

Исходный вид (ножницы) этого действа выглядит примерно вот так:
 
Итак, на главной форме нам особо ничего не надо. Кнопка запуска вырезания, и компонент TImage. По большому счету TImage нам и не нужен(если мы не собираемся потом показать вырезанный кусок). Алгоритм действий: При нажатии на кнопку мы запускаем вторую форму для вырезания. Эта вторая форма имеет отключенные границы. Форму мы показываем во весь экран (fullscreen), для этого задействуем интерфейс ITaskBarList3, а также уберем значок формы с панели задач. Создадим скриншот рабочего стола, и передадим его в форму для вырезания. Т.е вырезать мы будем со скриншота (: После того, как мы вырезали то, что было нужно, показываем форму обратно, и возвращаем кнопку на панели задач. Т.е при создании формы получаем ITaskBarList3 в self.FTaskBar:

procedure TMainForm.FormCreate(Sender: TObject);
begin
    FTaskBar := CreateComObject(CLSID_TaskbarList) as ITaskBarList3;
    FTaskBar.HrInit();
end;

При клике на кнопку запускаем вышеописанный алгоритм. Дочерняя формы имеет класс TSnippingForm. Для передачи изображения там создано свойство Img.

procedure TMainForm.SnipButtonClick(Sender: TObject);
begin
    FTaskBar.DeleteTab(handle);
    visible := false;
    FSnipForm := TSnippingForm.Create(nil);
    try
        sleep(200);
        CaptureScreen();

        FTaskBar.MarkFullscreenWindow(FSnipFOrm.Handle, true);


        TSnippingForm(FSnipForm).Img := Image;

        FSnipForm.ShowModal();
        FTaskBar.MarkFullscreenWindow(FSnipFOrm.Handle, false);
    finally
        FreeAndNil(FSnipForm);
        FTaskBar.AddTab(handle);
        visible := true;
    end;
end;

Для того чтобы сделать дочернее окно полноэкранным используем метод MarkFullScreenWindow(), а чтобы убрать кнопку панели задач DeleteTab(). Форма и кнопка к сожалению не исчезают мгновенно, так что перед созданием скриншота делаем небольшую паузу. Для создания скриншота нам понадобится дескриптор окна рабочего стола, после чего дескриптор его контекста, после чего мы копируем битовое изображение, используя GDI функцию BitBlt. В общем то такого кода полно в инете. Пусть будет и у меня (:

procedure TMainForm.CaptureScreen();
var dth : HWND;
    dtdc : HDC;
    bm : TBitmap;
begin
    dth  := GetDesktopWindow();
    dtdc := getDC(dth);

    bm := TBitmap.Create();
    bm.Height := screen.Height;
    bm.Width  := screen.Width;
    try
        BitBlt(bm.canvas.Handle, 0, 0, screen.width, screen.height, dtdc,0,0, SRCCOPY);
        Image.Picture.Bitmap.Handle := bm.Handle;
    finally
        ReleaseDC(dth, dtdc);
    end;
end;

Теперь переходим в дочернее окно TSnippingForm. Его состояние установлено в wsMaximized, чтобы распахивалось на весь экран. При создании формы создаем Direct2D канву, устанавливаем цвет кисти в красный, для обводки прямоугольника, и создаем сплошную кисть FFillBrush с полупрозрачным белым цветом.

procedure TSnippingForm.FormCreate(Sender: TObject);
begin
    FCanvas := TDirect2DCanvas.Create(handle);
    ID2D1HwndRenderTarget(FCAnvas.RenderTarget).SetDpi(96,96);

    canvas.RenderTarget.CreateSolidColorBrush(D2D1ColorF(1,1,1,0.5), nil, FFillBrush);

    canvas.brush.Color := clRed;
end;

У нас будет несколько обработчиков мыши. При нажатии мы будем запоминать точку нажатия - вершина прямоугольника - FStart : TPoint. При движении мыши будем перерисовывать окно:

procedure TSnippingForm.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    FStart := point(x,y);
end;

procedure TSnippingForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
    if (FStart.X + FStart.Y) > 0 then Repaint();
end;

Как будет происходить само рисование: Сначала мы отрисуем фоновую картинку рабочего стола. Затем создадим два прямоугольника ID2D1RectangeGeometry - один в полный экран, второй по размеру текущего выделения, после чего объединим их в группу геометрий. И зарисуем ее белой кистью. Такой же эффект можно было получить без использования группы геометрий, а использую метод CombineWithGeometry с операцией пересечения. В заключение добавляем красный прямоугольник кистью канвы, она красная.

procedure TSnippingForm.FormPaint(Sender: TObject);
var rects : array[0..1] of ID2D1RectangleGeometry;
    snipRect : TD2D1RectF;
    gg : ID2D1GeometryGroup;
    rt : ID2D1RenderTarget;
    factory : ID2D1Factory;
begin
    canvas.BeginDraw();
    rt := canvas.RenderTarget;
    rt.GetFactory(factory);
    try
        rt.DrawBitmap(FBgnd);
        if (FStart.X + FStart.Y) = 0 then exit;

        factory.CreateRectangleGeometry(D2D1RectF(0,0,width, height) , rects[0]);
        snipRect := D2D1RectF(FStart.X, FStart.Y, mouse.CursorPos.X, mouse.CursorPos.Y);
        factory.CreateRectangleGeometry(snipRect, rects[1]);
        factory.CreateGeometryGroup(D2D1_FILL_MODE_ALTERNATE, @rects, 2, gg);

        rt.FillGeometry(gg, FFillBrush);
        rt.DrawGeometry(rects[1], canvas.Brush.Handle);
    finally
        canvas.EndDraw();
    end;
end;

Вот собственно и все. При отпускании кнопки мыши форму можно закрыть, скопировав выделенное изображение. Вот тут то у меня возникли проблемы. Как скопировать изображение в TBitmap я так и не разобрался. По идее можно попробовать это сделать через WIC. Я попробовал это сделать создав WICImage, из него создав новый IWICBitmap с нужными размерами. Затем на его основе создал ID2D1BitmapRenderTarget. Теперь было необходимо отрисовать на поверхности нужный выделенный рисунок. После чего передать TWICImage в главную форму, установив его вмето Image.picture.graphic. Но что то тут не работает. В итоге выходит черный квадрат (: В кратце исходный код для сего был следующий:

        wic := TWicImage.Create();
        pf := GUID_WICPixelFormat32bppBGR;
        TWICImage.ImagingFactory.CreateBitmap(w,h, @pf, WICBitmapCacheOnLoad, iwbm);
        wic.Handle := iwbm;

        rtp.pixelFormat := D2D1PixelFormat(DXGI_FORMAT_UNKNOWN, D2D1_ALPHA_MODE_UNKNOWN);
        factory.CreateWicBitmapRenderTarget(wic.Handle, rtp, wrt);
        DrawBitmap(wrt);
        FImg.Picture.Graphic := wic;

Вторая мысль была через ID2D1DCRenderTarget, которая привязана к канве TImage. Тут может вообще нельзя такое творить, не знаком с GDI. Если кто то может мне разъяснить как же отобразить разрисованную канву в TImage, то буду благодарен. Исходник того что получилось в конце статьи приложу. А вот скришотик отрисованного выделения:

Для тех кто может разъяснить с сохранением изображения или тем кому просто может показать интересным, то вот исходный код зы: раз уж Delphi попал на скришот, то какую цветовую схему редактора кода вы используете, стандартную или настраиваете самостоятельно?