unit1.pas

来自「精彩编程百例51～75 其中有 cpu速度测试 检测声卡 查询内存信息 图像处理」· PAS 代码 · 共 106 行

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    OrigImage: TImage;
    DestImage: TImage;
    RedTrackBar: TTrackBar;
    Label3: TLabel;
    GreenTrackBar: TTrackBar;
    Label5: TLabel;
    BlueTrackBar: TTrackBar;
    Label7: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure TrackBarChange(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.FormCreate(Sender: TObject);
begin
  OrigImage.Picture.LoadFromFile('1.BMP');
  DestImage.Picture.LoadFromFile('1.BMP');

  OrigImage.Picture.Bitmap.PixelFormat := pf24bit;
  DestImage.Picture.Bitmap.PixelFormat := pf24bit;
end;

procedure TForm1.TrackBarChange(Sender: TObject);
var i, j, RedValue, GreenValue, BlueValue: integer;
    OrigRow, DestRow: pRGBArray;
begin
    // 获取亮度增加量
  RedValue := RedTrackBar.Position;
  GreenValue := GreenTrackBar.Position;
  BlueValue := BlueTrackBar.Position;

    // 对像素的每一排做循环扫描
  for i := 0 to OrigImage.Picture.Height - 1 do
  begin
    OrigRow := OrigImage.Picture.Bitmap.ScanLine[i];
    DestRow := DestImage.Picture.Bitmap.ScanLine[i];

      // 对每一排中的像素做循环
    for j := 0 to OrigImage.Picture.Width - 1 do
    begin
        // 把像素的亮度值添加到像素的RBG值中
      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;

  DestImage.Repaint;       // 重画得到新效果的显示
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.