Resim yazıcıdan nasıl alınır

procedure TForm1.Print1Click(Sender: TObject);
var
AspectRatio: Single;
OutputWidth, OutputHeight: Single;
begin
if not PrintDialog1.Execute then Exit;
Printer.BeginDoc;
try
OutputWidth:=Image3.Picture.Width;
OutputHeight:=Image3.Picture.Height;
AspectRatio := OutputWidth / OutputHeight;
if (OutputWidth and(OutputHeightbegin
if OutputWidth < OutputHeight then
begin
OutputHeight := Printer.PageHeight;
OutputWidth := OutputHeight * AspectRatio;
end
else
begin OutputWidth := Printer.PageWidth;
OutputHeight := OutputWidth / AspectRatio;
end
end;
if OutputWidth > Printer.PageWidth then
begin
OutputWidth:=Printer.PageWidth;
OutputHeight:=OutputWidth/AspectRatio;
end;
if OutputHeight > Printer.PageHeight then
begin
OutputHeight := Printer.PageHeight;
OutputWidth := OutputHeight * AspectRatio;
end;
Printer.Canvas.StretchDraw(Rect(0,0,
trunc(OutputWidth), Trunc(OutputHeight)),
Image3.Picture.Graphic);
finally
Printer.EndDoc;
end;
end;


NOT:Uses printers;eklenecek.

Image Mail

Resimleri delphi içerisinden nasıl mail ile gönderebiliriz.

resourcestring
SSendError = 'Error sending mail';

uses mapi;

procedure TForm1.ImageSentToMail1Click(Sender: TObject);
var MapiMessage: TMapiMessage; MError: Cardinal;
begin
with MapiMessage do
begin ulReserved := 0;
lpszSubject := nil;
lpszNoteText := PChar(Image1.Picture);
lpszMessageType := nil;
lpszDateReceived := nil;
lpszConversationID := nil;
flFlags := 0;
lpOriginator := nil;
nRecipCount := 0;
lpRecips := nil;
nFileCount := 0;
lpFiles := nil;
end;
MError := MapiSendMail(0, 0, MapiMessage, MAPI_DIALOG or MAPI_LOGON_UI
or MAPI_NEW_SESSION, 0);
if MError <> 0 then MessageDlg(SSendError, mtError, [mbOK], 0);
end;

Flip Reverse

unit Unit1;
interface

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

type
TForm1 = class(TForm)
Button1: TButton;
CheckBoxFlip: TCheckBox;
Image1: TImage;
editFilename: TEdit;
EditFactor: TEdit;
CheckBoxReverse: TCheckBox;
LabelShrinkFactor: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;

implementation
{$R *.DFM}
// Flip/Reverse/Shrink bitmap
// Shrink by resampling by specified factor in both dimensions
FUNCTION FlipReverse(CONST FName: STRING;
CONST FlipIt: BOOLEAN;
CONST ReverseIt: BOOLEAN;
CONST Factor: INTEGER): TBitmap;
TYPE
TRGBTripleArray = ARRAY[WORD] OF TRGBTriple;
pRGBTripleArray = ^TRGBTripleArray;

VAR
Bitmap : TBitmap;
ColumnIn: INTEGER;
rowIn : pRGBTripleArray;
RowOut : pRGBTripleArray;
x : INTEGER;
y : INTEGER;
BEGIN
ASSERT (Factor > 0);
BitMap := TBitMap.Create;
Result := TBitMap.Create;
try
BitMap.LoadfromFile(FName);
// TRGBTripleArray Scanline is only good for pf24bit bitmap,
// so force this if necessary
IF Bitmap.PixelFormat <> pf24bit
THEN Bitmap.PixelFormat := pf24bit;
// "Output" bitmap is same size as "Input" only if Factor = 1
Result.Height := BitMap.Height DIV Factor;
Result.Width := BitMap.Width DIV Factor;
Result.PixelFormat := BitMap.PixelFormat; // pf24bit
// Only process "output" pixels and "fetch" pixels from input bitmap
// Define flip to be "top to bottom" and reverse to be "left to right"
for y := 0 TO (BitMap.Height DIV Factor)-1 do
begin
rowOut := Result.Scanline[y];
if FlipIt
then rowIn := Bitmap.Scanline[Bitmap.Height - 1 - Factor*y]
else rowIn := Bitmap.Scanline[Factor*y];
for x := 0 TO (BitMap.Width DIV Factor)-1 do
begin
if ReverseIt
then ColumnIn := Bitmap.Width - 1 - Factor*x
else ColumnIn := Factor*x;
with rowOut[x] do
begin
rgbtRed := rowIn[ColumnIn].rgbtRed;
rgbtGreen := rowIn[ColumnIn].rgbtGreen;
rgbtBlue := rowIn[ColumnIn].rgbtBlue;
end
end
end
finally
BitMap.free;
END

// Don't free result. Calling program will be responsible for that.
END;

procedure TForm1.Button1Click(Sender: TObject);
Var Bitmap: TBitmap;
begin
Bitmap := FlipReverse(EditFilename.Text, CheckBoxFlip.Checked, CheckBoxReverse.Checked,
StrToInt(EditFactor.Text));
TRY
// Display on screen
Image1.Picture.Graphic := Bitmap;
FINALLY
Bitmap.Free
END
end;end.

Horizontal Image

procedure TForm1.Horizontal1Click(Sender: TObject);
Var
DummyImage : TImage;
X,Y : Integer;
SrcRect,DstRect : TRect;
Begin
X := Image1.Picture.Width;
Y := Image1.Picture.Height;
SrcRect := Rect(0,0,X,Y); //0,0,X,Y
DstRect := Rect(X,0,0,Y); //X,0,0,Y
DummyImage := TImage.Create(Self);
DummyImage.Width := X;
DummyImage.Height := Y;
DummyImage.Canvas.CopyRect(DstRect,Image1.Canvas,SrcRect);
Image1.Picture := DummyImage.Picture;
DummyImage.Free;
end;

Image Filter

procedure Emboss(Bitmap : TBitmap; AMount : Integer);
var
x, y, i : integer;
p1, p2: PByteArray;
begin
for i := 0 to AMount do
begin
for y := 0 to Bitmap.Height-2 do
begin
p1 := Bitmap.ScanLine[y];
p2 := Bitmap.ScanLine[y+1];
for x := 0 to Bitmap.Width do
begin
p1[x*3] := (p1[x*3]+(p2[(x+3)*3] xor $FF)) shr 1;
p1[x*3+1] := (p1[x*3+1]+(p2[(x+3)*3+1] xor $FF)) shr 1;
p1[x*3+2] := (p1[x*3+1]+(p2[(x+3)*3+1] xor $FF)) shr 1;
end;end;end;end;

procedure TForm1.Emboss1Click(Sender: TObject);
begin
Emboss(Image1.Picture.Bitmap,10);
end;

Brightness Image

procedure TForm1.Brightness1Click(Sender: TObject);
begin
With form1 do
with filelistbox1 do
With form3 do
begin
if (FileExt = '.BMP') then
begin
OrigImage.Picture.LoadFromFile(Filelistbox1.FileName);
DestImage.Picture.LoadFromFile(Filelistbox1.FileName);
form3.show;
end;end;end;

Arka plana resim atma (BackGround)

procedure TForm1.FormCreate(Sender: TObject);
begin
Bitmap := TBitmap.Create;
Bitmap.LoadFromFile('C:\WINDOWS\cars.BMP');
end;

procedure TForm1.FormPaint(Sender: TObject);
var
X, Y, W, H: LongInt;
begin
with Bitmap do begin
W := Width;
H := Height;
end;
Y := 0;
while Y < Height do begin
X := 0;
while X < Width do begin
Canvas.Draw(X, Y, Bitmap);
Inc(X, W);
end;
Inc(Y, H);
end;
end;

Alias Image oluşturma

procedure AntiAlias(const i: TBitmap; var o: TBitmap);
var
Po: ^PixelA3;
P1, P2, P3, P4, P5: ^PixelA15;
x, y: Cardinal;
dekrement: Cardinal;
AntAussen, AntMitte, AntInnen: double;
begin
AntAussen := 12*4;;//12
AntMitte := 8*4; //8
AntInnen := 2; //2
dekrement := 2*(i.Width-2);
P1 := i.ScanLine[0];
P2 := i.ScanLine[1];
P3 := i.ScanLine[2];
P4 := i.ScanLine[3];
P5 := i.ScanLine[4];
for y := 2 to i.Height-4 do
begin
Po := o.ScanLine[y];
inc(Po, 1);
for x := 4 to i.Width-4 do
begin
Po^[1] := round(((P1^[4]+P1^[7]+P1^[10]+P2^[1]+ P2^[13]+ P3^[1]+ P3^[13]+P4^[1]+P4^[13]+
P5^[4]+P5^[7]+P5^[10])/ AntAussen)+((P2^[4]+P2^[7]+P2^[10]+P3^[4]+P3^[10]+P4^[4]+P4^[7]+P4^[10])/AntMitte)+
(P3^[7]/AntInnen));
Po^[2] := round(((P1^[5]+P1^[8]+P1^[11]+P2^[2]+P2^[14]+P3^[2]+P3^[14]+P4^[2]+P4^[14] +
P5^[5]+P5^[8]+P5^[11])/AntAussen)+((P2^[5]+P2^[8]+P2^[11]+P3^[5]+P3^[11]+P4^[5]+P4^[8]+P4^[11])/AntMitte) +
(P3^[8]/AntInnen));
Po^[3] := round(((P1^[6]+P1^[9]+P1^[12]+P2^[3]+P2^[15]+P3^[3]+P3^[15]+P4^[3]+P4^[15]+P5^[6]+P5^[9]+P5^[12])/AntAussen)+
((P2^[6]+P2^[9]+P2^[12]+P3^[6]+P3^[12]+P4^[6]+P4^[9]+P4^[12])/AntMitte)+(P3^[9]/AntInnen));
inc(PByte(P1), 3);inc(PByte(P2), 3);inc(PByte(P3), 3);inc(PByte(P4), 3);inc(PByte(P5), 3);
inc(Po, 1);end;
dec(PByte(P2), dekrement);
dec(PByte(P3), dekrement);
dec(PByte(P4), dekrement);
dec(PByte(P5), dekrement);
P1 := P2;P2 := P3;P3 := P4;P4 := P5;P5 := i.ScanLine[y+3];
end;end;

procedure TForm1.Antiallias1Click(Sender: TObject);
var Image1 : TBitmap;
begin
Image1 := TBitmap.Create;
Image1.Width := 141;
Image1.Height := 197;
Image1.PixelFormat := pf24Bit;
Image1 := TBitmap.Create;
Image1.Width := 141;
Image1.Height := 197;
Image1.PixelFormat := pf24Bit;
AntiAlias(Image1, Image1);
end;

Resim çevirme-03

procedure RotateBitmap(var hBitmapDC : Longint; var lWidth : Longint;
var lHeight : Longint; lRadians : real);
begin
hNewBitmapDC := CreateCompatibleDC(hBitmapDC);
lSine := Sin(lRadians);
lCosine := Cos(lRadians);
X1 := Round(-lHeight * lSine);
Y1 := Round(lHeight * lCosine);
X2 := Round(lWidth * lCosine - lHeight * lSine);
Y2 := Round(lHeight * lCosine + lWidth * lSine);
X3 := Round(lWidth * lCosine);
Y3 := Round(lWidth * lSine);
lMinX := Min(0, Min(X1, Min(X2, X3)));
lMinY := Min(0, Min(Y1, Min(Y2, Y3)));
lMaxX := Max(X1, Max(X2, X3));
lMaxY := Max(Y1, Max(Y2, Y3));
lNewWidth := lMaxX - lMinX;
lNewHeight := lMaxY - lMinY;
hNewBitmap := CreateCompatibleBitmap(hBitmapDC, lNewWidth, lNewHeight);
SelectObject(hNewBitmapDC, hNewBitmap);
For I := 0 To lNewHeight do begin
For J := 0 To lNewWidth do begin
lSourceX := Round((J +lMinX) * lCosine + (I + lMinY) * lSine);
lSourceY := Round((I + lMinY) * lCosine - (J + lMinX) * lSine);
If (lSourceX >= 0) And (lSourceX <= lWidth) And
(lSourceY >= 0) And (lSourceY <= lHeight) Then
BitBlt(hNewBitmapDC, J, I, 1, 1, hBitmapDC,
lSourceX, lSourceY, SRCCOPY);
end;
end;
lWidth := lNewWidth;
lHeight := lNewHeight;
hBitmapDC := hNewBitmapDC;
DeleteObject(hNewBitmap);
End;

procedure TForm1.Rotate1Click(Sender: TObject);
var lRadians : real;
DC : longint;
H, W : integer;
Degrees : integer;
begin
Degrees := 90;
lRadians := PI * Degrees / 180;
DC := Image1.Picture.Bitmap.Canvas.Handle;
H := Image1.Picture.Bitmap.Height;
W := Image1.Picture.Bitmap.Width;
RotateBitmap(DC, W, H, lRadians);
Image1.Width := W;
Image1.Height := H;
Image1.Picture.Bitmap.Width := W;
Image1.Picture.Bitmap.Height := H;
BitBlt(Image1.Picture.Bitmap.Canvas.Handle, 0, 0, W, H, DC, 0, 0, SRCCopy);
Image1.Refresh;
end;

Resim çevirme-02

Procedure cevir(Src, Dst: TImage);
var x,y: integer;
begin
Dst.Width:= Src.Height; Dst.Height:= Src.Width;
For x:= 0 to Src.Width-1 do begin
For y:= 0 to Src.Height-1 do begin
Dst.Canvas.Pixels[(Src.Height-1)-y,x]:= Src.Canvas.Pixels[x,y];
end;
end;
end;

Resim çevirme-01

Const PixelMax = 32768;
Type
pPixelArray = ^TPixelArray;
TPixelArray = Array[0..PixelMax-1] Of TRGBTriple;

Procedure RotateBitmap_ads(
SourceBitmap : TBitmap;
out DestBitmap : TBitmap;
Center : TPoint;
Angle : Double) ;
Var
cosRadians : Double;
inX : Integer;
inXOriginal : Integer;
inXPrime : Integer;
inXPrimeRotated : Integer;
inY : Integer;
inYOriginal : Integer;
inYPrime : Integer;
inYPrimeRotated : Integer;
OriginalRow : pPixelArray;
Radians : Double;
RotatedRow : pPixelArray;
sinRadians : Double;
begin
DestBitmap.Width := SourceBitmap.Width;
DestBitmap.Height := SourceBitmap.Height;
DestBitmap.PixelFormat := pf24bit;
Radians := -(Angle) * PI / 180;
sinRadians := Sin(Radians) ;
cosRadians := Cos(Radians) ;
For inX := DestBitmap.Height-1 Downto 0 Do
Begin
RotatedRow := DestBitmap.Scanline[inX];
inXPrime := 2*(inX - Center.y) + 1;
For inY := DestBitmap.Width-1 Downto 0 Do
Begin
inYPrime := 2*(inY - Center.x) + 1;
inYPrimeRotated := Round(inYPrime * CosRadians - inXPrime * sinRadians) ;
inXPrimeRotated := Round(inYPrime * sinRadians + inXPrime * cosRadians) ;
inYOriginal := (inYPrimeRotated - 1) Div 2 + Center.x;
inXOriginal := (inXPrimeRotated - 1) Div 2 + Center.y;
If
(inYOriginal >= 0) And
(inYOriginal <= SourceBitmap.Width-1) And
(inXOriginal >= 0) And
(inXOriginal <= SourceBitmap.Height-1)
Then
Begin
OriginalRow := SourceBitmap.Scanline[inXOriginal];
RotatedRow[inY] := OriginalRow[inYOriginal]
End
Else
Begin
RotatedRow[inY].rgbtBlue := 255;
RotatedRow[inY].rgbtGreen := 0;
RotatedRow[inY].rgbtRed := 0
End;
End;
End;
End;

{Usage:}
procedure TForm1.Button1Click(Sender: TObject) ;
Var
Center : TPoint;
Bitmap : TBitmap;
begin
Bitmap := TBitmap.Create;
Try
Center.y := (Image.Height div 2)+20;
Center.x := (Image.Width div 2)+0;
RotateBitmap_ads(
Image.Picture.Bitmap,
Bitmap,javascript:void(0)
Center,
Angle) ;
Angle := Angle + 15;
Image2.Picture.Bitmap.Assign(Bitmap) ;
Finally
Bitmap.Free;
End;end;

Resmin parlaklığını artırma-Constrat

Procedure Highlight(aSource, ATarget: TBitmap; AColor: TColor);

Var

i, j: Integer;
s, t: pRGBTriple;
r, g, b: Byte;
cl: TColor;

Begin
cl:= ColorToRGB(AColor);
r:= GetRValue(cl);
g:= GetGValue(cl);
b:= GetBValue(cl);
aSource.PixelFormat := pf24bit;
ATarget.PixelFormat := pf24bit;
ATarget.Width := aSource.Width;
ATarget.Height := aSource.Height;

For i:= 0 to aSource.Height - 1 Do
Begin
s:= ASource.Scanline[i];
t:= ATarget.Scanline[i];
For j := 0 to aSource.Width - 1 Do
Begin
t^.rgbtBlue := (b * s^.rgbtBlue) div 255;
t^.rgbtGreen := (g * s^.rgbtGreen) div 255;
t^.rgbtRed := (r * s^.rgbtRed) div 255;
Inc(s);
Inc(t);
End; End;End;

procedure Form1.Button1OnClick (Sender: TObject);
begin
Highlight(Image1.Picture.Bitmap, Image2.Picture.Bitmap,clWhite);
end;

Örneğin bir düğmenin tıklanma olayına yazararak kullanabilirsin.(Button on click)
Bunun için bir forma 2 resim bir düğme koyarsan yeterli olur.

Image1 içine bir resim yerleştir.Denemek için küçük bir resim olsun.
Image2 yide Image1 boturlarında yan yana koy.Image2 nin içine resim koyma yanlız.
Sonra aşağıdaki button1.onClik event ına yerleştir.