Форум: "Основная";
Текущий архив: 2004.02.25;
Скачать: [xml.tar.bz2];
Внизкак узнать разрешение экрана Найти похожие ветки
← →
Aks (2004-02-11 12:21) [0]Люди, как узнать разрешение текущего экрана? и можно ли его поменять?
← →
RDen (2004-02-11 12:28) [1]ну например так:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
function GetNumColors: LongInt;
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure OnActivate(Sender: TObject);
private
procedure WM_NCHITTEST(var M: TWMNCHitTest); message wm_NCHitTest;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.OnActivate(Sender: TObject);
begin
ShowWindow(Application.Handle, SW_HIDE);
end;
function GetNumColors: LongInt;
var
BPP: Integer;
DC: HDC;
begin
DC := CreateDC("DISPLAY", nil, nil, nil);
if DC <> 0 then begin
try
BPP := GetDeviceCaps(DC, BITSPIXEL) * GetDeviceCaps(DC, PLANES);
finally
DeleteDC(DC);
end;
case BPP of
1: Result := 2;
4: Result := 16;
8: Result := 256;
15: Result := 32768;
16: Result := 65536;
24: Result := 16777216;
end;
end else
Result := 0;
end;
procedure TForm1. WM_NCHitTest(var M: TWMNCHitTest);
begin
inherited;
if M.Result = htClient then
M.Result := htCaption;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption := inttostr(GetNumColors) + " colors " + inttostr(Screen.Width) +
"x" + inttostr(Screen.height);
end;
end.
← →
Amoeba (2004-02-11 12:29) [2]Screen.Width и Screen.Height
F1
RTFM
← →
Aks (2004-02-11 12:40) [3]Спасибо
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2004.02.25;
Скачать: [xml.tar.bz2];
Память: 0.44 MB
Время: 0.03 c