//drony@mynet.com
// icq:266148308
//Delphi 7 ile sorunsuz çalışmaktadır.
--------------------------------------------------------------------------------
bmp formatlı image'ları negativ yapamak için güzel bir örnek ve bunun için kullanılan bi kaç metod ile
ilgili güzel bir örnek
--------------------------------------------------------------------------------
unit NegImg;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
OrigImg: TImage;
Button1: TButton;
RadioGroup1: TRadioGroup;
Label5: TLabel;
Label6: TLabel;
OpenBtn: TButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure OpenBtnClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
procedure NegativeBitmap(OrigBmp, DestBmp: TBitmap);
procedure FastNegativeBitmap(OrigBmp, DestBmp: TBitmap);
procedure InvertBitmap(OrigBmp, DestBmp: TBitmap);
const
MaxPixelCount = 32768;
type
PRGBArray = ^TRGBArray;
TRGBArray = array[0..MaxPixelCount - 1] of TRGBTriple;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
IniTime, ElapsedTime: DWord;
begin
Label6.Caption := '';
IniTime := GetTickCount;
case RadioGroup1.ItemIndex of
0: NegativeBitmap(OrigImg.Picture.Bitmap, OrigImg.Picture.Bitmap);
1: FastNegativeBitmap(OrigImg.Picture.Bitmap, OrigImg.Picture.Bitmap);
2: InvertBitmap(OrigImg.Picture.Bitmap, OrigImg.Picture.Bitmap);
end;
ElapsedTime := GetTickCount - IniTime;
Label6.Caption := Format('%d ms', [ElapsedTime]);
end;
procedure NegativeBitmap(OrigBmp, DestBmp: TBitmap);
var
i, j, R, G, B: Integer;
TmpBmp: TBitmap;
begin
// Create a temporal bitmap. This allows to use the same bitmap
// as input or output
TmpBmp := TBitmap.Create;
try
// Assign the temporal bitmap the same characteristics as the original
TmpBmp.Width := OrigBmp.Width;
TmpBmp.Height := OrigBmp.Height;
TmpBmp.PixelFormat := OrigBmp.PixelFormat;
// For each row
for i := 0 to TmpBmp.Height - 1 do
begin
// For each column
for j := 0 to TmpBmp.Width - 1 do
begin
// r := 255 - GetRValue(OrigBmp.Canvas.Pixels[j, i]);
// g := 255 - GetGValue(OrigBmp.Canvas.Pixels[j, i]);
// b := 255 - GetBValue(OrigBmp.Canvas.Pixels[j, i]);
R := not GetRValue(OrigBmp.Canvas.Pixels[j, i]);
G := not GetGValue(OrigBmp.Canvas.Pixels[j, i]);
B := not GetBValue(OrigBmp.Canvas.Pixels[j, i]);
TmpBmp.Canvas.Pixels[j, i] := RGB(R, G, B);
end; // Column
end; // Row
// Assign the negative bitmap to the destination bitmap
DestBmp.Assign(TmpBmp);
finally
// Destroy temp bitmap
TmpBmp.Free;
end;
end;
procedure FastNegativeBitmap(OrigBmp, DestBmp: TBitmap);
var
i, j: Integer;
TmpBmp: TBitmap;
OrigRow, DestRow: PRGBArray;
begin
// Create a temporal bitmap. This allows to use the same bitmap
// as input or output
TmpBmp := TBitmap.Create;
try
// Assign the temporal bitmap the same characteristics as the original
TmpBmp.Width := OrigBmp.Width;
TmpBmp.Height := OrigBmp.Height;
OrigBmp.PixelFormat := pf24bit;
TmpBmp.PixelFormat := OrigBmp.PixelFormat;
// For each row
for i := 0 to TmpBmp.Height - 1 do
begin
// Sssign current ScanLines
OrigRow := OrigBmp.ScanLine[i];
DestRow := TmpBmp.ScanLine[i];
// For each column
for j := 0 to TmpBmp.Width - 1 do
begin
// Invert red, green, blue values
// DestRow[j].rgbtRed := 255 - OrigRow[j].rgbtRed;
// DestRow[j].rgbtGreen := 255 - OrigRow[j].rgbtGreen;
// DestRow[j].rgbtBlue := 255 - OrigRow[j].rgbtBlue;
DestRow[j].rgbtRed := not OrigRow[j].rgbtRed;
DestRow[j].rgbtGreen := not OrigRow[j].rgbtGreen;
DestRow[j].rgbtBlue := not OrigRow[j].rgbtBlue;
end;
end;
// Assign the negative bitmap to the destination bitmap
DestBmp.Assign(TmpBmp);
finally
// Destroy temp bitmap
TmpBmp.Free;
end;
end;
procedure InvertBitmap(OrigBmp, DestBmp: TBitmap);
begin
// use of the GDI InvertRect() A>PI is even faster...
InvertRect(OrigBmp.Canvas.Handle, OrigBmp.Canvas.ClipRect);
DestBmp.Assign(OrigBmp);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
try
OrigImg.Picture.LoadFromFile('Delphi.bmp'); //burada derlerken hataverebilir hatta verir bunu bir butona atasanız iyi olur
except
end;
end;
procedure TForm1.OpenBtnClick(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
OrigImg.Picture.LoadFromFile(OpenDialog1.FileName);
OrigImg.Refresh;
end;
end;
end.
________________________________________________________________________________
object Form1: TForm1
Left = 215
Top = 164
Width = 242
Height = 495
Caption = 'Negative image'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object OrigImg: TImage
Left = 8
Top = 184
Width = 217
Height = 273
AutoSize = True
end
object Label5: TLabel
Left = 8
Top = 166
Width = 77
Height = 13
Caption = 'Calculation time:'
end
object Label6: TLabel
Left = 104
Top = 166
Width = 5
Height = 13
Font.Charset = DEFAULT_CHARSET
Font.Color = clRed
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Button1: TButton
Left = 8
Top = 40
Width = 217
Height = 33
Caption = 'Process'
TabOrder = 0
OnClick = Button1Click
end
object RadioGroup1: TRadioGroup
Left = 8
Top = 80
Width = 217
Height = 81
Caption = 'Pixel access method'
ItemIndex = 0
Items.Strings = (
'TBitmap.Canvas.Pixels[x,y]'
'TBitmap.ScanLine[y]'
'InvertRect')
TabOrder = 1
end
object OpenBtn: TButton
Left = 8
Top = 8
Width = 105
Height = 25
Caption = 'Choose file...'
TabOrder = 2
OnClick = OpenBtnClick
end
object Button2: TButton
Left = 152
Top = 8
Width = 73
Height = 25
Caption = 'About...'
TabOrder = 3
OnClick = Button2Click
end
object OpenDialog1: TOpenDialog
DefaultExt = '.bmp'
Filter = 'Windows BMP|*.bmp'
FilterIndex = 0
Left = 120
Top = 8
end
end.