Change brightness on monitor through code

Hi. I'd like to change brightness on my monitor through code. I managed to find some code that will let me make it brighter, but I also need to make the image darker.

Thanks in adavance,
David Burban

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, math;

type
  TGammaRamp = packed record
    R : array[0..255] of word;
    G : array[0..255] of word;
    B : array[0..255] of word;
  end;


type
  TForm1 = class(TForm)
    TrackBar1: TTrackBar;
    procedure TrackBar1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
    SYS_OldGamma : TGammaRamp;


implementation

{$R *.dfm}

procedure StoreOldGamma;
var
  DC : HDC;

begin
  DC := GetDC(0);
  GetDeviceGammaRamp(DC, SYS_OldGamma);
  ReleaseDC(0, DC);
end;

procedure RestoreOldGamma;
var
  DC : HDC;

begin
  DC := GetDC(0);
  SetDeviceGammaRamp(DC, SYS_OldGamma);
  ReleaseDC(0, DC);
end;

function SetGamma(Value : byte) : TGammaRamp;
var
  I  : integer;
  DC : HDC;
  V  : integer;

begin
  for I := 0 to 255 do begin
    V := Round(255 * Power(I / 255, Abs(Value) / 255));
    if V > 255 then
      V := 255;
      Result.R[I] := V shl 8;
      Result.G[I] := V shl 8;
      Result.B[I] := V shl 8;
  end;
  DC := GetDC(0);
  SetDeviceGammaRamp(DC, Result);
  ReleaseDC(0, DC);
end;


procedure TForm1.TrackBar1Change(Sender: TObject);
begin
SetGamma(trackbar1.Position);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

end;

end.
LVL 1
the_modderAsked:
Who is Participating?
 
GhostModConnect With a Mentor Commented:
PAQd, 225 points refunded.

GhostMod
Community Support Moderator
0
 
calinutzCommented:
Listening...
0
 
the_modderAuthor Commented:
Ok??? I basically want to make my monitor dimmer at night, and a bit brigther by day. Right now I only have code to make it brighter. I need code to make it dimmer and brigther, and hopefully without quality loss through gamma (maybe brightness, contrast settings).
0
Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
the_modderAuthor Commented:
BUMP?
0
 
ginsonicCommented:
brightness, just add an equal value to each channel.
contrast, multiply with a value, either > 1 (for increased contrast)
or < 1 for less contrast)

or read:

http://www.freeweb.hu/delphicikk/listaz.php?id=1452&oldal=20
0
 
the_modderAuthor Commented:
ginsonic: the link you gave me seems to be about images. I need this to be system wide. And can you just give me the code :D

Thanks again,
David

P.S: Points increased to 125!
0
 
Wim ten BrinkSelf-employed developerCommented:
I would think this kind of code is hardware-dependant, thus what you're trying to do might not work on other systems. You're trying to make a hardware modification, btw, and the security mechaniism of Windows might prevent this too.

From MSDN: Direct color display modes do not use color lookup tables and are usually 16, 24, or 32 bit. Not all direct color video boards support loadable gamma ramps. SetDeviceGammaRamp succeeds only for devices with drivers that support downloadable gamma ramps in hardware.
In other words, your screen might not even support changing the device gamma.

From MSDN: Windows 98/Me, Windows 2000/XP: To get the DC for a specific display monitor, use the EnumDisplayMonitors and CreateDC functions.
Thus, GetDC(0) might return the wrong device handle.

Also, SetDeviceGammaRamp is a function that returns False if it fails, in which case you should use SysErrorMessage(GetLastError) to get the last error as string, so you know why it fails.

0
 
Ferruccio AccalaiSenior developer, analyst and customer assistance Commented:
0
 
the_modderAuthor Commented:
Nope, doesn't work. It just made everything like textboxes dark. It did not touch the start menu.
0
 
the_modderAuthor Commented:
BUMP! I don't really care if some video cards don't support it, the main thing is that the majority of the cards support gamma profiles (even my crappy ATI Radeon 9200 SE 64).
0
 
the_modderAuthor Commented:
BUMP! ^^^^^^^
0
 
the_modderAuthor Commented:
POINTS INCREASED TO 200!
0
 
the_modderAuthor Commented:
Maybe someone could use this? http://www.rpro.ru/dl-fx2/directdraw.pas
0
 
the_modderAuthor Commented:
BUMP!
0
 
the_modderAuthor Commented:
Can someone maybe translate this ( http://www.rookscape.com/vbgaming/tutT.php ) from VB to delphi?

Thanks,
David Burban

P.S: Poins increased to 225!
0
 
the_modderAuthor Commented:
I need something like this: http://www.whipflash.com/vamr/gamma_controls.png

Will award extra points :)
0
 
the_modderAuthor Commented:
Can someone convert this code from VB to delphi? Maybe its easier to use the code in the first post?

Option Explicit
Private Ramp1(0 To 255, 0 To 2) As Integer
Private Ramp2(0 To 255, 0 To 2) As Integer
Private Declare Function GetDeviceGammaRamp Lib "gdi32" (ByVal hdc As Long, lpv As Any) As Long
Private Declare Function SetDeviceGammaRamp Lib "gdi32" (ByVal hdc As Long, lpv As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Sub Form_Load()
   '----------------------------------------------------------------
   Dim iCtr       As Integer
   Dim lVal       As Long
   '----------------------------------------------------------------
   GetDeviceGammaRamp Me.hdc, Ramp1(0, 0)
      For iCtr = 0 To 255
         lVal = Int2Lng(Ramp1(iCtr, 0))
         Ramp2(iCtr, 0) = Lng2Int(Int2Lng(Ramp1(iCtr, 0)) / 2)
         'Die folgenden Zeilen für ROT auskommentieren:
         Ramp2(iCtr, 1) = Lng2Int(Int2Lng(Ramp1(iCtr, 1)) / 2)
         Ramp2(iCtr, 2) = Lng2Int(Int2Lng(Ramp1(iCtr, 2)) / 2)
      Next iCtr
   SetDeviceGammaRamp Me.hdc, Ramp2(0, 0)
   '----------------------------------------------------------------
End Sub
Private Sub Form_Unload(Cancel As Integer)
   '----------------------------------------------------------------
   SetDeviceGammaRamp Me.hdc, Ramp1(0, 0)
   '----------------------------------------------------------------
End Sub
Public Function Int2Lng(IntVal As Integer) As Long
   '----------------------------------------------------------------
   CopyMemory Int2Lng, IntVal, 2
   '----------------------------------------------------------------
End Function
Public Function Lng2Int(Value As Long) As Integer
   '----------------------------------------------------------------
   CopyMemory Lng2Int, Value, 2
   '----------------------------------------------------------------
End Function
0
 
the_modderAuthor Commented:
Closing with a refund will be ok.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.