Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 21.04.2013, 16:05
darkduelist darkduelist вне форума
Прохожий
 
Регистрация: 29.11.2010
Сообщения: 3
Репутация: 10
По умолчанию Изменение контрастности изображения

Всем привет, помогите решить проблему...
Необходимо изменить контрастность у изображения и распечатать. На счет контрастности я нашел 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.
Вложения
Тип файла: 7z Работа с изображением.7z (198.2 Кбайт, 6 просмотров)

Последний раз редактировалось Admin, 21.04.2013 в 16:19.
Ответить с цитированием
  #2  
Старый 21.04.2013, 18:02
Snake22 Snake22 вне форума
Активный
 
Регистрация: 20.02.2011
Сообщения: 374
Репутация: 744
По умолчанию

могу предложить такой вариант.
в процедуре изменить "битмап" на "График"
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  
Старый 21.04.2013, 18:06
darkduelist darkduelist вне форума
Прохожий
 
Регистрация: 29.11.2010
Сообщения: 3
Репутация: 10
По умолчанию

БОЛЬШОЕ СПАСИБО!
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 08:17.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter