VPF::Поменять цвет картики в Image - Форум программистов

Ru_

Дата 28.12.2006, 03:47 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 10
Регистрация: 16.12.2006

Репутация: нет
Всего: нет

С наступающим всех! smile

Как поменять цвет картики в Image.
Есть картинка, как сделать ее более красной, синей или другим цветом.
Цвет регулируется SrollBar-ом. smile

Alexeis

Дата 28.12.2006, 10:16 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

При помощи Image1.picture.bitmap.ScanLine - получить доступ к битовой карте и увеличить красную составляющую цвета каждого пиксела на указанное число процентов, если полученное число больше 255, то записать 255.

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

Ru_

Дата 28.12.2006, 17:10 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 10
Регистрация: 16.12.2006

Репутация: нет
Всего: нет

alexeis1, спасибо.
Я дико извиняюсь, а можно пример. smile

Alexeis

Дата 28.12.2006, 19:57 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls, ComCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    TrackBar1: TTrackBar;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure TrackBar1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  bmp  : TBitmap;

implementation

{$R *.dfm}
type
  TRGB = packed record
          b, g , r : Byte;
  end;

  TRGBArr = array[0..MAXLONG div 3 - 1] of TRGB;
  PRGBArr = ^TRGBArr;

procedure TForm1.FormCreate(Sender: TObject);
begin
  bmp := TBitmap.Create;
  bmp.Assign(Image1.Picture.Graphic);
  bmp.PixelFormat := pf24bit;

//  Image1.Picture.Bitmap.PixelFormat := pf24bit;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  bmp.Free;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
var
  i, j : Integer;
  l    : PRGBArr;
  c, t : Extended;

begin
  Image1.Picture.Assign(bmp);
  c := 1 + (TrackBar1.Position - 50) / 100;
  with Image1.Picture
  do
    begin
      for i := 0 to bmp.Height - 1
      do
        begin
          l := Bitmap.ScanLine[i];
          for j := 0 to Bitmap.Width - 1
          do
            begin
              t := (l[j].r * c);
              if (t > 255)
              then
                 t := 255
              else
                if (t < 0)
                then
                  t := 0
                else
                  l[j].r := Round(t);
            end;

        end;

    end;
    Image1.Invalidate;

end;

end.

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »