unit1.~pas

delphi制作简单调整图片RGB对比度.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Image1: TImage;
    Image2: TImage;
    TrackBar1: TTrackBar;
    TrackBar2: TTrackBar;
    TrackBar3: TTrackBar;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure TrackBar1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  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

{$R *.dfm}

procedure TForm1.TrackBar1Change(Sender: TObject);
var
  i, j, RValue, GValue, BValue: integer;
  Row1, Row2: pRGBArray;
begin
  //设置图片RGB的值
  RValue := TrackBar1.Position;
  GValue := TrackBar2.Position;
  BValue := TrackBar3.Position;
  //设置图片每行的象素
  for i := 0 to Image1.Picture.Height - 1 do
  begin
    Row1 := Image1.Picture.Bitmap.ScanLine[i];
    Row2 := Image2.Picture.Bitmap.ScanLine[i];
    //对行中的象素进行设置
    for j := 0 to Image1.Picture.Width - 1 do
    begin
      //增加RGB的象素值
      if RValue > 0 then  //R
        Row2[j].rgbtRed := Min(255, Row1[j].rgbtRed + RValue)
      else
        Row2[j].rgbtRed := Max(0, Row1[j].rgbtRed + RValue);
      if GValue > 0 then  //G
        Row2[j].rgbtGreen := Min(255, Row1[j].rgbtGreen + GValue)
      else
        Row2[j].rgbtGreen := Max(0, Row1[j].rgbtGreen + GValue);
      if BValue > 0 then  //B
        Row2[j].rgbtBlue := Min(255, Row1[j].rgbtBlue + BValue)
      else
        Row2[j].rgbtBlue := Max(0, Row1[j].rgbtBlue + BValue);
    end;
  end;
  Image2.Repaint;
end;

function Max(a, b: integer): integer;
begin
  if a > b then result := a
  else result := b;
end;

function Min(a, b: integer): integer;
begin
  if a < b then result := a
  else result := b;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1.Picture.LoadFromFile('1.BMP');
  Image2.Picture.LoadFromFile('1.BMP');
  Image1.Picture.Bitmap.PixelFormat := pf24bit;
  Image2.Picture.Bitmap.PixelFormat := pf24bit;
end;

end.