Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2007.03.18;
Скачать: [xml.tar.bz2];

Вниз

ScreenShot в двухмониторных системах   Найти похожие ветки 

 
TCrash   (2007-01-20 10:27) [0]

Непонятное что-то происходит. Сделал свой модуль для снятия скриншота, в него включил класс TMonitor из Forms (чтобы полностью не присоединять его).
Делаю оконное приложение - все работает нормально., делаю приложение без окон - ошибка.
Само приложение :
program test;
uses
 cScreenShot;
begin
 ScreenShot:=TScreenShot.Create;
 ScreenShot.GetMonitors;
 ScreenShot.GetScreenShot(0);
 ScreenShot.SaveToFile("a.bmp");
 ScreenShot.Free;
end.


cScreenShot:

unit cScreenShot;
interface
uses Windows, MultiMon, Classes, Graphics;

type
 TMonitor = class(TObject)
// полностью скопировано из Forms
 end;

type
 TMonitors=class(TObject)
   Count: integer;
   Items: array of TMonitor;
   constructor Create;
   destructor Destroy; override;
   procedure Add(m: TMonitor);
   procedure Clear;
 end;

type
 TScreenShot=class
   Monitors: TMonitors;
   BitMap: TBitMap;
   PixelFormat: TPixelFormat;
   constructor Create;
   destructor Destroy; override;
   procedure GetMonitors;
   procedure GetScreenShot(Index: integer);
   procedure SaveToFile(const fName: string);
   procedure SaveToStream(Dest: TStream);
 private
   DC: HDC;
 end;

var
 ScreenShot: TScreenShot;

implementation
{ TMonitor полностью скопировано из Forms}

{TMonitors}

procedure TMonitors.Add(m: TMonitor);
begin
 Inc(Count);
 SetLength(Items,Count);
 Items[Count-1]:=m;
end;

{TScreenShot по образу и подобию :}
function EnumMonitorsProc(hm: HMONITOR; dc: HDC; r: PRect;
                         Data: Pointer): Boolean; stdcall;
var
 l: TMonitors;
 m: TMonitor;
begin
 l:=TMonitors(Data);
 M := TMonitor.Create;
 M.FHandle := hm;
 M.FMonitorNum := L.Count;
 L.Add(M);
 Result := True;
end;

procedure TScreenShot.GetMonitors;
begin
 Monitors.Clear;
 EnumDisplayMonitors(0, nil, @EnumMonitorsProc, LongInt(Monitors));
end;

procedure TScreenShot.GetScreenShot(Index: integer);
var
 m: TMonitor;
 Left,Top,Width,Height: DWORD;
 r: TRect;
begin
 m:=Monitors.Items[Index];
 r:=m.GetBoundsRect; //в r попадают несусветные значения. Дома и на работе разные
 Left:=r.Left;
 Top:=r.Top;
 Width:=r.Right-r.Left;
 Height:=r.Bottom-r.Top;
 BitMap.Width:=Width; // Width~=800000 и здесь вываливается, естесственно ошибка
                             // EOutOfResources Параметр задан неправильно :(
 BitMap.Height:=Height;
 BitBlt(BitMap.Canvas.Handle,0,0,Width,Height,DC,Left,Top,SrcCopy);
 BitMap.PixelFormat:=PixelFormat;
end;

Почему при использовании того же модуля из формы все работает корретно?


 
Дмитрий Белькевич ©   (2007-01-24 07:07) [1]

А чем так принципиально окно не нравиться?


 
TCrash   (2007-01-24 10:07) [2]

Дмитрий Белькевич ©   (24.01.07 7:07) [1]
Хочется оформить это сервисом.
Суть задачи такая - нечто похожее на RAdmin, но свое и с некоторыми доп. функциями. Для чего - Начальство настаивает чтобы весь софт был лицензионный, а RAdmin мне пакупать не хочет. Как впрочем и другие аналогичные утилиты :(


 
Котик Б   (2007-01-24 10:49) [3]


> RAdmin мне пакупать не хочет

VNC



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2007.03.18;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.46 MB
Время: 0.046 c
2-1172121094
Novichok_New
2007-02-22 08:11
2007.03.18
ListView + CheckBox


4-1162818043
Виктор1985
2006-11-06 16:00
2007.03.18
Функция обратная GetDC


2-1172237689
Аликъ
2007-02-23 16:34
2007.03.18
Адрес


2-1172498747
Danila_master
2007-02-26 17:05
2007.03.18
Несколько модулей в одном проекте.


15-1171727368
hhjjkk
2007-02-17 18:49
2007.03.18
Как ПОЛНОСТЬЮ удалить 1С с компа?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский