// Mittels
Setcoloradjustment
und
StretchBlt kann
man Bitmaps in
// Farbe, Helligkeit und Kontrast sehr einfach ändern. Für das
// Beispiel erzeugt man eine neue Anwendung, setzt zwei TButton
// und ein TImage auf die Form und erzeugt durch Doppelklick im
// Objektinspektor die Events
FormCreate,
FormDestroy,
Button1Click
//
und
Button2Click.
Dann ergänzt man das Ganze nach dem folgenden
// Code. Es werden neun von zwölf möglichen Einstellungen im
// Beispiel genutzt. Über Button1 kann man das Bild in sein Negativ
// wandeln, während acht Werte über Schieberegler eingestellt
// werden können. Die acht
Trackbars dafür werden dynamisch
// erzeugt.
// Hinweis: Bitmaps mit geringer Farbtiefe werden gedithert.
// Getestet mit D4 unter XP
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.
|