?
Solved

Change brightness on monitor through code

Posted on 2004-09-19
20
Medium Priority
?
1,115 Views
Last Modified: 2012-06-27
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.
0
Comment
Question by:the_modder
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
20 Comments
 
LVL 11

Expert Comment

by:calinutz
ID: 12097809
Listening...
0
 
LVL 1

Author Comment

by:the_modder
ID: 12097831
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
 
LVL 1

Author Comment

by:the_modder
ID: 12099053
BUMP?
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 9

Expert Comment

by:ginsonic
ID: 12099236
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
 
LVL 1

Author Comment

by:the_modder
ID: 12099270
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
 
LVL 17

Expert Comment

by:Wim ten Brink
ID: 12102228
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
 
LVL 23

Expert Comment

by:Ferruccio Accalai
ID: 12102308
0
 
LVL 1

Author Comment

by:the_modder
ID: 12107542
Nope, doesn't work. It just made everything like textboxes dark. It did not touch the start menu.
0
 
LVL 1

Author Comment

by:the_modder
ID: 12118522
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
 
LVL 1

Author Comment

by:the_modder
ID: 12131197
BUMP! ^^^^^^^
0
 
LVL 1

Author Comment

by:the_modder
ID: 12155433
POINTS INCREASED TO 200!
0
 
LVL 1

Author Comment

by:the_modder
ID: 12155496
Maybe someone could use this? http://www.rpro.ru/dl-fx2/directdraw.pas
0
 
LVL 1

Author Comment

by:the_modder
ID: 12326208
BUMP!
0
 
LVL 1

Author Comment

by:the_modder
ID: 12331505
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
 
LVL 1

Author Comment

by:the_modder
ID: 12334149
I need something like this: http://www.whipflash.com/vamr/gamma_controls.png

Will award extra points :)
0
 
LVL 1

Author Comment

by:the_modder
ID: 12390037
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
 
LVL 1

Author Comment

by:the_modder
ID: 13341172
Closing with a refund will be ok.
0
 
LVL 1

Accepted Solution

by:
GhostMod earned 0 total points
ID: 13850885
PAQd, 225 points refunded.

GhostMod
Community Support Moderator
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
If you’ve ever visited a web page and noticed a cool font that you really liked the look of, but couldn’t figure out which font it was so that you could use it for your own work, then this video is for you! In this Micro Tutorial, you'll learn yo…
Visualize your data even better in Access queries. Given a date and a value, this lesson shows how to compare that value with the previous value, calculate the difference, and display a circle if the value is the same, an up triangle if it increased…
Suggested Courses

764 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question