1{
2    This file is part of the PTCPas framebuffer library
3    Copyright (C) 2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
4
5    This library is free software; you can redistribute it and/or
6    modify it under the terms of the GNU Lesser General Public
7    License as published by the Free Software Foundation; either
8    version 2.1 of the License, or (at your option) any later version
9    with the following modification:
10
11    As a special exception, the copyright holders of this library give you
12    permission to link this library with independent modules to produce an
13    executable, regardless of the license terms of these independent modules,and
14    to copy and distribute the resulting executable under terms of your choice,
15    provided that you also meet, for each linked independent module, the terms
16    and conditions of the license of that module. An independent module is a
17    module which is not derived from or based on this library. If you modify
18    this library, you may extend this exception to your version of the library,
19    but you are not obligated to do so. If you do not wish to do so, delete this
20    exception statement from your version.
21
22    This library is distributed in the hope that it will be useful,
23    but WITHOUT ANY WARRANTY; without even the implied warranty of
24    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
25    Lesser General Public License for more details.
26
27    You should have received a copy of the GNU Lesser General Public
28    License along with this library; if not, write to the Free Software
29    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
30}
31
32{$ifdef VER2_6}
33{ constants moved to the windows unit in fpc trunk }
34const
35  DISP_CHANGE_BADPARAM = -5;
36  DISP_CHANGE_BADDUALVIEW = -6;
37  DM_POSITION = $00000020;
38  DM_NUP = $00000040;
39  DM_PANNINGWIDTH = $08000000;
40  DM_PANNINGHEIGHT = $10000000;
41  DMDFO_DEFAULT = 0;
42  DMDFO_STRETCH = 1;
43  DMDFO_CENTER  = 2;
44{$endif VER2_6}
45
46constructor TWin32ModeSetter.Create;
47begin
48  SetupModeList;
49end;
50
51procedure TWin32ModeSetter.Open(AWidth, AHeight: Integer; AFormat: IPTCFormat);
52var
53  dm: TDEVMODE;
54begin
55  FillChar(dm, SizeOf(dm), 0);
56  dm.dmSize := SizeOf(dm);
57  dm.dmPelsWidth := AWidth;
58  dm.dmPelsHeight := AHeight;
59  dm.dmBitsPerPel := AFormat.Bits;
60  dm.dmFields := DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT;
61
62  DispChangeCheck(ChangeDisplaySettings(@dm, CDS_FULLSCREEN));
63
64  FillChar(FChosenMode, SizeOf(FChosenMode), 0);
65  FChosenMode.dmSize := SizeOf(FChosenMode);
66  FChosenMode.dmDriverExtra := 0;
67  if not EnumDisplaySettings(nil, ENUM_CURRENT_SETTINGS, @FChosenMode) then
68    raise TPTCError.Create('EnumDisplaySettings(ENUM_CURRENT_SETTINGS) failed after mode set');
69
70  FInMode := True;
71  FOpen := True;
72end;
73
74procedure TWin32ModeSetter.Close;
75begin
76  FOpen := False;
77  if not FInMode then
78    exit;
79
80  DispChangeCheck(ChangeDisplaySettings(nil, 0));
81  FInMode := False;
82end;
83
84procedure TWin32ModeSetter.Save;
85begin
86  LOG('saving desktop');
87end;
88
89procedure TWin32ModeSetter.Restore;
90begin
91  LOG('restoring desktop');
92end;
93
94procedure TWin32ModeSetter.Enter;
95begin
96  LOG('entering mode');
97  if not FInMode then
98  begin
99    DispChangeCheck(ChangeDisplaySettings(@FChosenMode, CDS_FULLSCREEN));
100    FInMode := True;
101  end;
102end;
103
104procedure TWin32ModeSetter.Leave;
105begin
106  LOG('leaving mode');
107  if FInMode then
108  begin
109    DispChangeCheck(ChangeDisplaySettings(nil, 0));
110    FInMode := False;
111  end;
112end;
113
114procedure TWin32ModeSetter.SetupModeList;
115var
116  dm: TDEVMODE;
117  I: Integer;
118  ModeExists: Boolean;
119begin
120  LOG('getting list of display modes');
121  SetLength(FModes, 0);
122  I := 0;
123  repeat
124    FillChar(dm, SizeOf(dm), 0);
125    dm.dmSize := SizeOf(dm);
126    dm.dmDriverExtra := 0;
127    ModeExists := EnumDisplaySettings(nil, I, @dm);
128    if ModeExists then
129    begin
130      LogDevMode(dm);
131      LOG(IntToStr(dm.dmPelsWidth) + 'x' + IntToStr(dm.dmPelsHeight) + 'x' + IntToStr(dm.dmBitsPerPel) + ' ' + IntToStr(dm.dmDisplayFrequency) + ' Hz');
132      {todo: add to FModes list...}
133      Inc(I);
134    end;
135  until not ModeExists;
136  LOG('done getting the list of modes');
137end;
138
139procedure TWin32ModeSetter.DispChangeCheck(ADispChangeResult: LONG);
140
141  function DispChangeResult2String(ADispChangeResult: LONG): string;
142  begin
143    case ADispChangeResult of
144      DISP_CHANGE_SUCCESSFUL:  Result := 'DISP_CHANGE_SUCCESSFUL';
145      DISP_CHANGE_BADDUALVIEW: Result := 'DISP_CHANGE_BADDUALVIEW';
146      DISP_CHANGE_BADFLAGS:    Result := 'DISP_CHANGE_BADFLAGS';
147      DISP_CHANGE_BADMODE:     Result := 'DISP_CHANGE_BADMODE';
148      DISP_CHANGE_BADPARAM:    Result := 'DISP_CHANGE_BADPARAM';
149      DISP_CHANGE_FAILED:      Result := 'DISP_CHANGE_FAILED';
150      DISP_CHANGE_NOTUPDATED:  Result := 'DISP_CHANGE_NOTUPDATED';
151      DISP_CHANGE_RESTART:     Result := 'DISP_CHANGE_RESTART';
152      else
153        Result := 'Unknown';
154    end;
155    Result := IntToStr(ADispChangeResult) + ' (' + Result + ')';
156  end;
157
158begin
159  if ADispChangeResult <> DISP_CHANGE_SUCCESSFUL then
160    raise TPTCError.Create('Error setting display mode; ChangeDisplaySettings returned ' + DispChangeResult2String(ADispChangeResult));
161end;
162
163procedure TWin32ModeSetter.LogDevMode(const ADevMode: TDEVMODE);
164
165  function Fields2String(dmFields: DWORD): string;
166  begin
167    Result := '';
168    if (dmFields and DM_ORIENTATION) <> 0 then
169      Result := Result + 'DM_ORIENTATION + ';
170    if (dmFields and DM_PAPERSIZE) <> 0 then
171      Result := Result + 'DM_PAPERSIZE + ';
172    if (dmFields and DM_PAPERLENGTH) <> 0 then
173      Result := Result + 'DM_PAPERLENGTH + ';
174    if (dmFields and DM_PAPERWIDTH) <> 0 then
175      Result := Result + 'DM_PAPERWIDTH + ';
176    if (dmFields and DM_SCALE) <> 0 then
177      Result := Result + 'DM_SCALE + ';
178    if (dmFields and DM_COPIES) <> 0 then
179      Result := Result + 'DM_COPIES + ';
180    if (dmFields and DM_DEFAULTSOURCE) <> 0 then
181      Result := Result + 'DM_DEFAULTSOURCE + ';
182    if (dmFields and DM_PRINTQUALITY) <> 0 then
183      Result := Result + 'DM_PRINTQUALITY + ';
184    if (dmFields and DM_POSITION) <> 0 then
185      Result := Result + 'DM_POSITION + ';
186    if (dmFields and DM_DISPLAYORIENTATION) <> 0 then
187      Result := Result + 'DM_DISPLAYORIENTATION + ';
188    if (dmFields and DM_DISPLAYFIXEDOUTPUT) <> 0 then
189      Result := Result + 'DM_DISPLAYFIXEDOUTPUT + ';
190    if (dmFields and DM_COLOR) <> 0 then
191      Result := Result + 'DM_COLOR + ';
192    if (dmFields and DM_DUPLEX) <> 0 then
193      Result := Result + 'DM_DUPLEX + ';
194    if (dmFields and DM_YRESOLUTION) <> 0 then
195      Result := Result + 'DM_YRESOLUTION + ';
196    if (dmFields and DM_TTOPTION) <> 0 then
197      Result := Result + 'DM_TTOPTION + ';
198    if (dmFields and DM_COLLATE) <> 0 then
199      Result := Result + 'DM_COLLATE + ';
200    if (dmFields and DM_FORMNAME) <> 0 then
201      Result := Result + 'DM_FORMNAME + ';
202    if (dmFields and DM_LOGPIXELS) <> 0 then
203      Result := Result + 'DM_LOGPIXELS + ';
204    if (dmFields and DM_BITSPERPEL) <> 0 then
205      Result := Result + 'DM_BITSPERPEL + ';
206    if (dmFields and DM_PELSWIDTH) <> 0 then
207      Result := Result + 'DM_PELSWIDTH + ';
208    if (dmFields and DM_PELSHEIGHT) <> 0 then
209      Result := Result + 'DM_PELSHEIGHT + ';
210    if (dmFields and DM_DISPLAYFLAGS) <> 0 then
211      Result := Result + 'DM_DISPLAYFLAGS + ';
212    if (dmFields and DM_NUP) <> 0 then
213      Result := Result + 'DM_NUP + ';
214    if (dmFields and DM_DISPLAYFREQUENCY) <> 0 then
215      Result := Result + 'DM_DISPLAYFREQUENCY + ';
216    if (dmFields and DM_ICMMETHOD) <> 0 then
217      Result := Result + 'DM_ICMMETHOD + ';
218    if (dmFields and DM_ICMINTENT) <> 0 then
219      Result := Result + 'DM_ICMINTENT + ';
220    if (dmFields and DM_MEDIATYPE) <> 0 then
221      Result := Result + 'DM_MEDIATYPE + ';
222    if (dmFields and DM_DITHERTYPE) <> 0 then
223      Result := Result + 'DM_DITHERTYPE + ';
224    if (dmFields and DM_PANNINGWIDTH) <> 0 then
225      Result := Result + 'DM_PANNINGWIDTH + ';
226    if (dmFields and DM_PANNINGHEIGHT) <> 0 then
227      Result := Result + 'DM_PANNINGHEIGHT + ';
228
229    if Length(Result) > 0 then
230      Result := Copy(Result, 1, Length(Result) - 3);
231
232    Result := IntToStr(dmFields) + ' (' + Result + ')';
233  end;
234
235  function DisplayOrientation2String(dmDisplayOrientation: DWORD): string;
236  begin
237    case dmDisplayOrientation of
238      DMDO_DEFAULT: Result := 'DMDO_DEFAULT';
239      DMDO_90:      Result := 'DMDO_90';
240      DMDO_180:     Result := 'DMDO_180';
241      DMDO_270:     Result := 'DMDO_270';
242      else
243        Result := 'Unknown';
244    end;
245    Result := IntToStr(dmDisplayOrientation) + ' (' + Result + ')';
246  end;
247
248  function DisplayFixedOutput2String(dmDisplayFixedOutput: DWORD): string;
249  begin
250    case dmDisplayFixedOutput of
251      DMDFO_DEFAULT: Result := 'DMDFO_DEFAULT';
252      DMDFO_CENTER:  Result := 'DMDFO_CENTER';
253      DMDFO_STRETCH: Result := 'DMDFO_STRETCH';
254      else
255        Result := 'Unknown';
256    end;
257    Result := IntToStr(dmDisplayFixedOutput) + ' (' + Result + ')';
258  end;
259
260  function DisplayFlags2String(dmDisplayFlags: DWORD): string;
261  begin
262    Result := '';
263    if (dmDisplayFlags and DM_GRAYSCALE) <> 0 then
264      Result := Result + 'DM_GRAYSCALE + ';
265    if (dmDisplayFlags and DM_INTERLACED) <> 0 then
266      Result := Result + 'DM_INTERLACED + ';
267
268    if Length(Result) > 0 then
269      Result := Copy(Result, 1, Length(Result) - 3);
270
271    Result := IntToStr(dmDisplayFlags) + ' (' + Result + ')';
272  end;
273
274begin
275  LOG('dmFields', Fields2String(ADevMode.dmFields));
276  if (ADevMode.dmFields and DM_DISPLAYORIENTATION) <> 0 then
277    LOG('dmDisplayOrientation', DisplayOrientation2String(ADevMode.dmDisplayOrientation));
278  if (ADevMode.dmFields and DM_DISPLAYFIXEDOUTPUT) <> 0 then
279    LOG('dmDisplayFixedOutput', DisplayFixedOutput2String(ADevMode.dmDisplayFixedOutput));
280  if (ADevMode.dmFields and DM_BITSPERPEL) <> 0 then
281    LOG('dmBitsPerPel        ', ADevMode.dmBitsPerPel);
282  if (ADevMode.dmFields and DM_PELSWIDTH) <> 0 then
283    LOG('dmPelsWidth         ', ADevMode.dmPelsWidth);
284  if (ADevMode.dmFields and DM_PELSHEIGHT) <> 0 then
285    LOG('dmPelsHeight        ', ADevMode.dmPelsHeight);
286  if (ADevMode.dmFields and DM_DISPLAYFLAGS) <> 0 then
287    LOG('dmDisplayFlags      ', DisplayFlags2String(ADevMode.dmDisplayFlags));
288  if (ADevMode.dmFields and DM_DISPLAYFREQUENCY) <> 0 then
289    LOG('dmDisplayFrequency  ', IntToStr(ADevMode.dmDisplayFrequency) + ' Hz');
290end;
291