|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Изменение контрастности изображения
Всем привет, помогите решить проблему...
Необходимо изменить контрастность у изображения и распечатать. На счет контрастности я нашел http://www.delphisources.ru/pages/faq/base/bmp_contrast.html Но при его работе у меня почему просто исчезает картинка... Код:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, JPEG, ComCtrls; type TForm1 = class(TForm) btn1: TButton; img1: TImage; dlgOpen1: TOpenDialog; lbl1: TLabel; btn2: TButton; TrackBar1: TTrackBar; chk1: TCheckBox; procedure btn1Click(Sender: TObject); procedure TrackBar1Change(Sender: TObject); procedure btn2Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure Contrast(Bitmap: TBitmap; Value: Integer; Local: Boolean); function BLimit(B: Integer): Byte; begin if B < 0 then Result := 0 else if B > 255 then Result := 255 else Result := B; end; var Dest: pRGBTriple; x, y, mr, mg, mb, W, H, tr, tg, tb: Integer; vd: Double; begin if Value = 0 then Exit; W := Bitmap.Width - 1; H := Bitmap.Height - 1; if Local then begin mR := 128; mG := 128; mB := 128; end else begin tr := 0; tg := 0; tb := 0; for y := 0 to H do begin Dest := Bitmap.ScanLine[y]; for x := 0 to W do begin with Dest^ do begin Inc(tb, rgbtBlue); Inc(tg, rgbtGreen); Inc(tr, rgbtRed); end; Inc(Dest); end; end; mB := Trunc(tb / (W * H)); mG := Trunc(tg / (W * H)); mR := Trunc(tr / (W * H)); end; if Value > 0 then vd := 1 + (Value / 10) else vd := 1 - (Sqrt(-Value) / 10); for y := 0 to H do begin Dest := Bitmap.ScanLine[y]; for x := 0 to W do begin with Dest^ do begin rgbtBlue := BLimit(mB + Trunc((rgbtBlue - mB) * vd)); rgbtGreen := BLimit(mG + Trunc((rgbtGreen - mG) * vd)); rgbtRed := BLimit(mR + Trunc((rgbtRed - mR) * vd)); end; Inc(Dest); end; end; end; procedure TForm1.btn1Click(Sender: TObject); begin if dlgOpen1.Execute then img1.Picture.LoadFromFile(dlgOpen1.FileName); end; procedure TForm1.TrackBar1Change(Sender: TObject); begin lbl1.Caption := IntToStr(TrackBar1.Position); end; procedure TForm1.btn2Click(Sender: TObject); begin Contrast(Img1.Picture.Bitmap,TrackBar1.Position, chk1.Checked); Img1.Repaint; end; end. Последний раз редактировалось Admin, 21.04.2013 в 16:19. |
#2
|
|||
|
|||
могу предложить такой вариант.
в процедуре изменить "битмап" на "График" procedure Contrast(Bitmap: TBitmap; Value: Integer; Local: Boolean); procedure Contrast(ImageGraphic: TGraphic; Value: Integer; Local: Boolean); в процедуре добавить переменную var Bitmap:TBitmap; после begin сделать это begin Bitmap:=TBitmap.Create; Bitmap.Assign(ImageGraphic); и в конце процедуры Form1.img1.Picture.Graphic.Assign(Bitmap); - или чтоб этого избежать,сделать её в виде функции http://rghost.ru/45452140 |
#3
|
|||
|
|||
БОЛЬШОЕ СПАСИБО!
|