Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  3 794

•  TDictionary Custom Sort  5 903

•  Fast Watermark Sources  5 706

•  3D Designer  8 481

•  Sik Screen Capture  6 041

•  Patch Maker  6 485

•  Айболит (remote control)  6 475

•  ListBox Drag & Drop  5 340

•  Доска для игры Реверси  94 962

•  Графические эффекты  6 679

•  Рисование по маске  5 807

•  Перетаскивание изображений  4 864

•  Canvas Drawing  5 241

•  Рисование Луны  4 959

•  Поворот изображения  4 507

•  Рисование стержней  3 189

•  Paint on Shape  2 436

•  Генератор кроссвордов  3 309

•  Головоломка Paletto  2 620

•  Теорема Монжа об окружностях  3 405

•  Пазл Numbrix  2 251

•  Заборы и коммивояжеры  2 911

•  Игра HIP  1 880

•  Игра Go (Го)  1 797

•  Симулятор лифта  2 136

•  Программа укладки плитки  1 861

•  Генератор лабиринта  2 298

•  Проверка числового ввода  1 986

•  HEX View  2 295

•  Физический маятник  1 958

 
скрыть

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Копирование экрана




Новая марка монохромных мониторов ViewSonic имеет в качестве символа трех пингвинов.


unit ScrnCap;

interface

uses
  WinTypes, WinProcs, Forms, Classes, Graphics, Controls;

{ Копирует прямоугольную область экрана }
function CaptureScreenRect(ARect : TRect) : TBitmap;
{ Копирование всего экрана }
function CaptureScreen : TBitmap;
{ Копирование клиентской области формы или элемента }
function CaptureClientImage(Control : TControl) : TBitmap;
{ Копирование всей формы элемента }
function CaptureControlImage(Control : TControl) : TBitmap;

implementation

function GetSystemPalette : HPalette;
var
  PaletteSize : integer;
  LogSize : integer;
  LogPalette : PLogPalette;
  DC : HDC;
  Focus : HWND;
begin
  result:=0;
  Focus:=GetFocus;
  DC:=GetDC(Focus);
  try
    PaletteSize:=GetDeviceCaps(DC, SIZEPALETTE);
    LogSize:=SizeOf(TLogPalette)+(PaletteSize-1)*SizeOf(TPaletteEntry);
    GetMem(LogPalette, LogSize);
    try
      with LogPalette^ do
      begin
        palVersion:=$0300;
        palNumEntries:=PaletteSize;
        GetSystemPaletteEntries(DC, 0, PaletteSize, palPalEntry);
      end;
      result:=CreatePalette(LogPalette^);
    finally
      FreeMem(LogPalette, LogSize);
    end;
  finally
    ReleaseDC(Focus, DC);
  end;
end;


function CaptureScreenRect(ARect : TRect) : TBitmap;
var
  ScreenDC : HDC;
begin
  Result:=TBitmap.Create;
  with result, ARect do
  begin
    Width:=Right-Left;
    Height:=Bottom-Top;
    ScreenDC:=GetDC(0);
    try
      BitBlt(Canvas.Handle, 0,0,Width,Height,ScreenDC, Left, Top, SRCCOPY );
    finally
      ReleaseDC(0, ScreenDC);
    end;
    Palette:=GetSystemPalette;
  end;
end;

function CaptureScreen : TBitmap;
begin
  with Screen do
    Result:=CaptureScreenRect(Rect(0,0,Width,Height));
end;

function CaptureClientImage(Control : TControl) : TBitmap;
begin
  with Control, Control.ClientOrigin do
    result:=CaptureScreenRect(Bounds(X,Y,ClientWidth,ClientHeight));
end;

function CaptureControlImage(Control : TControl) : TBitmap;
begin
  with Control do
    if Parent=nil then
      result:=CaptureScreenRect(Bounds(Left,Top,Width,Height))
    else
      with Parent.ClientToScreen(Point(Left, Top)) do
        result:=CaptureScreenRect(Bounds(X,Y,Width,Height));
end;

end.





Похожие по теме исходники

Хранитель экрана Папины Дочки

Передача удаленного экрана по сети (Remote Screen)




Copyright © 2004-2025 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте