Главная страница
    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.042 c
2-1172154352
Lonix
2007-02-22 17:25
2007.03.18
Button


15-1172171494
mdw
2007-02-22 22:11
2007.03.18
23 февраля


2-1172487297
Bogdan1024
2007-02-26 13:54
2007.03.18
АКФ


3-1166496638
NigthSkif
2006-12-19 05:50
2007.03.18
Выполнение процедуры


15-1172344484
lookin
2007-02-24 22:14
2007.03.18
Немножко размышлений насчет восстановления формата данных





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский