unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  ExtCtrls, StdCtrls; 
 
type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    Button2: TButton; 
    Image1: TImage; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
  private 
    procedure go(Sender: TObject); 
  public 
    procedure ColorAdj(Target: HDC; x, y: integer); 
    function Laden(Bild: string): boolean; 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
uses comctrls; 
 
var 
  Original: TBitmap; 
  Negativ, Geladen: boolean; 
  TB: array[0..7] of TTrackBar; 
  // TB[0] --> Kontrast 
  // TB[1] --> Helligkeit 
  // TB[2] --> Sättigung 
  // TB[3] --> Schwarz-Grenze 
  // TB[4] --> Weiß-Grenze 
  // TB[5] --> Farbhelligkeit ROT 
  // TB[6] --> Farbhelligkeit GRÜN 
  // TB[7] --> Farbhelligkeit BLAU 
 
function TForm1.Laden(Bild: string): boolean; 
begin 
  try 
    Original.LoadFromFile(Bild); 
    result := (Original.width > 0) and (Original.height > 0); 
  except 
    result := false; 
  end; 
end; 
 
procedure TForm1.ColorAdj(Target: HDC; x, y: integer); 
var 
  ca: COLORADJUSTMENT; 
begin 
  if not Geladen then 
    raise exception.create('Kein Bild vorhanden'); 
  with ca do begin 
    caSize := sizeof(ca); 
    caFlags := CA_NEGATIVE * ord(Negativ); 
    caIlluminantIndex := 0; 
    caContrast := TB[0].Position; 
    caBrightness := TB[1].Position; 
    caColorfulness := TB[2].Position; 
    caReferenceBlack := TB[3].Position; 
    caReferenceWhite := TB[4].Position + REFERENCE_WHITE_MIN; 
    caRedGamma := TB[5].Position + RGB_GAMMA_MIN; 
    caGreenGamma := TB[6].Position + RGB_GAMMA_MIN; 
    caBlueGamma := TB[7].Position + RGB_GAMMA_MIN; 
    caRedGreenTint := 0; 
  end; 
  SetStretchBltMode(Target, HALFTONE); 
  Setcoloradjustment(Target, ca); 
  StretchBlt(Target, x, y, Original.width, Original.height, 
    Original.canvas.handle, 0, 0, Original.width, Original.height, srcCopy); 
end; 
 
procedure TForm1.go(Sender: TObject); 
begin 
  ColorAdj(Image1.Canvas.handle, 0, 0); 
  Image1.refresh; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
var 
  x, u: integer; 
begin 
  Original := TBitmap.create; 
  Geladen := Laden('d:\bilder\corel003.bmp'); 
  Image1.autosize := true; 
  Image1.left := 10; 
  Image1.top := 10; 
  if Geladen then Image1.picture.assign(Original); 
  // ------------------ Trackbars erzeugen -------------------
  for x := 0 to 2 do begin 
    TB[x] := TTrackbar.create(self); 
    with TB[x] do begin 
      parent := self; 
      left := Image1.left + Image1.width + 20; 
      top := Image1.top + height * x + 10; 
      Frequency := 10; 
      min := COLOR_ADJ_MIN; 
      max := COLOR_ADJ_MAX; 
      position := 0; 
      OnChange := go; 
    end; 
  end; 
  TB[3] := TTrackbar.create(self); 
  with TB[3] do begin 
    parent := self; 
    left := Image1.left + Image1.width + 20; 
    top := Image1.top + height * 3 + 10; 
    Frequency := 200; 
    min := 0; 
    max := REFERENCE_BLACK_MAX; 
    position := 0; 
    OnChange := go; 
  end; 
  TB[4] := TTrackbar.create(self); 
  with TB[4] do begin 
    parent := self; 
    left := Image1.left + Image1.width + 20; 
    top := Image1.top + height * 4 + 10; 
    Frequency := 200; 
    min := 0; 
    max := REFERENCE_WHITE_MAX - REFERENCE_WHITE_MIN; 
    position := max; 
    OnChange := go; 
  end; 
  for x := 5 to 7 do begin 
    TB[x] := TTrackbar.create(self); 
    with TB[x] do begin 
      parent := self; 
      left := Image1.left + Image1.width + TB[x].width + 20; 
      top := Image1.top + height * (x - 5) + 10; 
      Frequency := 750; 
      min := 0; 
      max := 10000 + RGB_GAMMA_MIN * 2; 
      position := 10000 - RGB_GAMMA_MIN; 
      OnChange := go; 
    end; 
  end; 
  // ---------------------------------------------------------------
  Button1.left := Image1.left + Image1.width + 20; 
  Button2.left := Button1.left + Button1.width + 20; 
  Button1.top := TB[4].top + TB[4].height + 10; 
  Button2.top := Button1.top; 
  u := Button2.top + Button2.height + 10; 
  clientheight := Original.height + 20; 
  if clientheight < u then clientheight := u; 
  clientwidth := TB[5].left + TB[5].width + 10; 
  position := poScreenCenter; 
  go(self); 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
var 
  x: integer; 
begin 
  Original.free; 
  for x := 0 to high(TB) do TB[x].free; 
end; 
 
// Negativ-Positiv umschalten 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  Negativ := not Negativ; 
  go(self); 
end; 
 
// Alles zurücksetzen 
procedure TForm1.Button2Click(Sender: TObject); 
var 
  x: integer; 
begin 
  Negativ := false; 
  for x := 0 to 3 do TB[x].position := 0; 
  TB[4].position := TB[4].max; 
  for x := 5 to 7 do TB[x].position := 10000 - RGB_GAMMA_MIN; 
  go(self); 
end; 
 
end.