Переписал все и добавил объяснения:
Код:
unit foto;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Mask, ExtCtrls, ComCtrls, ExtDlgs,
jpeg, ImgList, DBCtrls, Math, Clipbrd, Spin, Buttons, OrImage, OrImageEditor;
type
TForm1 = class(TForm)
btnFileLoad: TButton;
btnBumGlyan: TButton;
btnBumMatt: TButton;
btnSize10x15: TButton;
btnSize15x21: TButton;
btnSize20x30: TButton;
btnStartAll: TButton;
btnStopAll: TButton;
btnPageDown: TButton;
btnPageUp: TButton;
btnSaveAll: TButton;
btnExit: TButton;
lblVarSize: TLabel;
SavePictureDialog1: TSavePictureDialog;
OpenPictureDialog1: TOpenPictureDialog;
PutFile1: TEdit;
GroupBox1: TGroupBox;
CheckBox1: TCheckBox;
lblNameBrightnessShort1: TLabel;
lblVarBrightness: TLabel;
lblNameBrightnessShort2: TLabel;
GroupBox2: TGroupBox;
lblNameContrastShort1: TLabel;
lblVarContrast: TLabel;
lblNameContrastShort2: TLabel;
CheckBox2: TCheckBox;
GroupBox3: TGroupBox;
lblNameRedShort1: TLabel;
lblVarRed: TLabel;
lblNameRedShort2: TLabel;
CheckBox3: TCheckBox;
trbRedValue: TTrackBar;
trbGreenValue: TTrackBar;
trbBlueValue: TTrackBar;
lblNameGreenShort2: TLabel;
lblNameBlueShort2: TLabel;
lblNameGreenShort1: TLabel;
lblNameBlueShort1: TLabel;
lblVarGreen: TLabel;
lblVarBlue: TLabel;
Bevel1: TBevel;
Bevel2: TBevel;
Bevel3: TBevel;
Bevel4: TBevel;
Bevel6: TBevel;
SheetFile1: TSpinEdit;
SheetFile2: TSpinEdit;
SheetFile3: TSpinEdit;
SheetFile4: TSpinEdit;
SheetFile5: TSpinEdit;
SheetFile6: TSpinEdit;
PutFile2: TEdit;
PutFile3: TEdit;
PutFile4: TEdit;
PutFile5: TEdit;
PutFile6: TEdit;
OrImage1: TOrImage;
Bevel5: TBevel;
OrImage2: TOrImage;
OrImage3: TOrImage;
OrImage4: TOrImage;
OrImage5: TOrImage;
OrImage6: TOrImage;
trbBrightness: TTrackBar;
trbContrast: TTrackBar;
lblVarBum: TLabel;
procedure btnFileLoadClick(Sender: TObject);
procedure btnSaveAllClick(Sender: TObject);
procedure btnExitClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure OrImageDblClick(Sender: TObject);
procedure TrackBarBrightnessChange(Sender: TObject);
procedure TrackBarContrastChange(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure OrImage1DblClick(Sender: TObject);
procedure OrImage2DblClick(Sender: TObject);
procedure OrImage3DblClick(Sender: TObject);
procedure OrImage4DblClick(Sender: TObject);
procedure OrImage5DblClick(Sender: TObject);
procedure TrackBarChange(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
OrImage: TOrImage;
procedure UpdateEffects;
end;
var
Form1: TForm1;
const
MaxPixelCount = 32768;
type
pRGBArray = ^TRGBArray;
TRGBArray = ARRAY[0..MaxPixelCount-1] OF TRGBTriple;
function Min(a, b: integer): integer;
function Max(a, b: integer): integer;
implementation
uses Unit2;
{$R *.dfm}
const strTrueORFalse: array[Boolean]of string = ('false','true');
procedure TForm1.btnFileLoadClick(Sender: TObject); //Загрузка файлов в каждый Image
var
q : integer;
begin
if (openpicturedialog1.Execute) and (openpicturedialog1.FileName <> '') then
try
for q := 0 to openpicturedialog1.Files.Count - 1 do
case q of
0:begin
OrImage1.Picture.LoadFromFile(openpicturedialog1.Files.Strings[q]);
OrImage1.PictureOriginal := OrImage1.Picture;
end;
1:begin
OrImage2.Picture.LoadFromFile(openpicturedialog1.Files.Strings[q]);
OrImage2.PictureOriginal := OrImage2.Picture;
end;
2:begin
OrImage3.Picture.LoadFromFile(openpicturedialog1.Files.Strings[q]);
OrImage3.PictureOriginal := OrImage3.Picture;
end;
3:begin
OrImage4.Picture.LoadFromFile(openpicturedialog1.Files.Strings[q]);
OrImage4.PictureOriginal := OrImage4.Picture;
end;
4:begin
OrImage5.Picture.LoadFromFile(openpicturedialog1.Files.Strings[q]);
OrImage5.PictureOriginal := OrImage5.Picture;
end;
5:begin
OrImage6.Picture.LoadFromFile(openpicturedialog1.Files.Strings[q]);
OrImage6.PictureOriginal := OrImage6.Picture;
end;
end;
except
ShowMessage('Ошибка!');
end;
end;
procedure TForm1.formCreate(Sender: TObject); //Определение нулевых позиций при старте
begin
lblVarBrightness.Caption := '0';
lblVarContrast.Caption := '0';
trbRedValue.Position := 0;
lblVarRed.Caption := '0';
trbGreenValue.Position := 0;
lblVarGreen.Caption := '0';
trbBlueValue.Position := 0;
lblVarBlue.Caption := '0';
end;
procedure TForm1.TrackBarChange(Sender: TObject); //Регулировка по цветам
var i, j, k, l, m, n, o, p, e, f, r, t, g, h, RedValue, GreenValue, BlueValue : integer;
OrigRow, DestRow: pRGBArray; //Назначение переменных
begin
RedValue := trbRedValue.Position; //Присвоение переменным начальных значений TrackBar-ов
GreenValue := trbGreenValue.Position;
BlueValue := trbBlueValue.Position;
if RedValue <= 0 then lblVarRed.Caption := IntToStr(RedValue)
else lblVarRed.Caption := Format('+%d', [RedValue]);
if GreenValue <= 0 then lblVarGreen.Caption := IntToStr(GreenValue)
else lblVarGreen.Caption := Format('+%d', [GreenValue]);
if BlueValue <= 0 then lblVarBlue.Caption := IntToStr(BlueValue)
else lblVarBlue.Caption := Format('+%d', [BlueValue]);
for i := 0 to OrImage1.Picture.Height - 1 do
begin
OrigRow := OrImage1.PictureOriginal.Bitmap.ScanLine[i]; //считывание изображения
DestRow := OrImage1.Picture.Bitmap.ScanLine[i];
for j := 0 to OrImage1.Picture.Width - 1 do
begin //алгоритм изменения цветов
if RedValue > 0 then
DestRow[j].rgbtRed := Min(255, OrigRow[j].rgbtRed + RedValue)
else
DestRow[j].rgbtRed := Max(0, OrigRow[j].rgbtRed + RedValue);
if GreenValue > 0 then
DestRow[j].rgbtGreen := Min(255, OrigRow[j].rgbtGreen + GreenValue)
else
DestRow[j].rgbtGreen := Max(0, OrigRow[j].rgbtGreen + GreenValue);
if BlueValue > 0 then
DestRow[j].rgbtBlue := Min(255, OrigRow[j].rgbtBlue + BlueValue)
else
DestRow[j].rgbtBlue := Max(0, OrigRow[j].rgbtBlue + BlueValue);
end;
end;
OrImage1.Repaint; //перерисовка изображения
end;
procedure TForm1.UpdateEffects; //Изменение яркости и контрастности
begin
if OrImage1<> nil then with OrImage1 do //Задание начальных значений
begin
trbBrightness.Position:=PicBrightness;
trbContrast.Position:=PicContrast;
end;
end;
procedure TForm1.FormActivate(Sender: TObject); //принудительное обновление эффекта яркости и контрастности
begin
if OrImage1<>nil then
UpdateEffects;
end;
procedure TForm1.TrackBarBrightnessChange(Sender: TObject); //Регулировка яркости
begin
if OrImage1=nil then Exit;
OrImage1.PicBrightness:=trbBrightness.Position;
lblVarBrightness.Caption:=' '+IntToStr(OrImage1.PicBrightness)+' ';
end;
procedure TForm1.TrackBarContrastChange(Sender: TObject); //Регулировка контраста
begin
if OrImage1=nil then Exit;
OrImage1.PicContrast:=trbContrast.Position;
lblVarContrast.Caption:=' '+IntToStr(OrImage1.PicContrast)+' ';
end;
procedure TForm1.btnSaveAllClick(Sender: TObject); //Сохранение файлов
begin
SavePictureDialog1.Execute
end;
procedure TForm1.btnExitClick(Sender: TObject); //Выход из программы
begin
Close
end;
procedure TForm1.OrImageDblClick(Sender: TObject); //Присвоение двойного нажатия на Image для открытия Form2 (коррекция красных глаз)
begin
ClipBoard.Clear;
ClipBoard.Open;
ClipBoard.Assign(OrImage1.Picture);
ClipBoard.Close;
Form2.Showmodal;
end;
procedure TForm1.OrImage1DblClick(Sender: TObject);
begin
ClipBoard.Clear;
ClipBoard.Open;
ClipBoard.Assign(OrImage2.Picture);
ClipBoard.Close;
Form2.Showmodal;
end;
procedure TForm1.OrImage2DblClick(Sender: TObject);
begin
ClipBoard.Clear;
ClipBoard.Open;
ClipBoard.Assign(OrImage3.Picture);
ClipBoard.Close;
Form2.Showmodal;
end;
procedure TForm1.OrImage3DblClick(Sender: TObject);
begin
ClipBoard.Clear;
ClipBoard.Open;
ClipBoard.Assign(OrImage4.Picture);
ClipBoard.Close;
Form2.Showmodal;
end;
procedure TForm1.OrImage4DblClick(Sender: TObject);
begin
ClipBoard.Clear;
ClipBoard.Open;
ClipBoard.Assign(OrImage5.Picture);
ClipBoard.Close;
Form2.Showmodal;
end;
procedure TForm1.OrImage5DblClick(Sender: TObject);
begin
ClipBoard.Clear;
ClipBoard.Open;
ClipBoard.Assign(OrImage6.Picture);
ClipBoard.Close;
Form2.Showmodal;
end;
function Min(a, b: integer): integer;
begin
if a < b then result := a
else result := b;
end;
function Max(a, b: integer): integer;
begin
if a > b then result := a
else result := b;
end;
end.
Проблема остается - так как яркость и контрастность в одной "связке" (компонент OrImage), а регулировка RGB сама по себе - то они друг друга взаимоисключают. Нужно их подружить. Извините, если с терминологией проблемы - всего полтора месяца учусь. Исходники вышлю если надо. |
