ScreenCapture yapma-Mouse sağ tuşu ile

procedure DrawCursor(ScreenShotBitmap : TBitmap);
var
r: TRect;
CI: TCursorInfo;
Icon: TIcon;
II: TIconInfo;
begin
r := ScreenShotBitmap.Canvas.ClipRect;
Icon := TIcon.Create;
try
CI.cbSize := SizeOf(CI);
if GetCursorInfo(CI) then
if CI.Flags = CURSOR_SHOWING then
begin
Icon.Handle := CopyIcon(CI.hCursor);
if GetIconInfo(Icon.Handle, II) then
begin
ScreenShotBitmap.Canvas.Draw(
ci.ptScreenPos.x - Integer(II.xHotspot) - r.Left,
ci.ptScreenPos.y - Integer(II.yHotspot) - r.Top,
Icon
);
end;
end;
finally
Icon.Free;
end;
end;

Bu kısım OnClick Olayına eklenecek....
var
pic : TBitmap;
begin
pic := TBitmap.Create;
try
ScreenShot(0,0,Screen.Width,Screen.Height,pic);
DrawCursor(pic);
//Image1.Picture.Assign(pic);
finally
pic.FreeImage;
FreeAndNil(pic);
end;

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;