Üye Girişi

Kullanıcı Adı:  Parola:   Kayıp Parola

Başlığı Görüntüle

 Başlığı Yazdır
Delphi İpuçları Ve Kodları - 3
MuhBim
#1 Mesajı Yazdır
Mesaj Tarihi 31-03-2010 18:38
Süper Yönetici

Mesaj Sayısı: 41
Katılım Tarihi: 19.04.07

Delphi -- Graphic İpuçları
1. 3D Yazı yazmak..
procedure imgPaintCanvas(TheCanvas : TCanvas; TheString : String; TheFontSize, UCorner, LCorner : Integer);
Begin
TheCanvas.Brush.Style := bsClear;
TheCanvas.Font.Style := [fsBold];
TheCanvas.Font.Name := 'MS Sans Serif';
TheCanvas.Font.Size := TheFontSize;
TheCanvas.Font.Color := clBlack;
TheCanvas.TextOut(UCorner, LCorner, TheString);
TheCanvas.Font.Color := clGray;
TheCanvas.TextOut(UCorner - 1, LCorner - 1, TheString);
TheCanvas.Font.Color := clSilver;
TheCanvas.TextOut(UCorner - 2, LCorner - 2, TheString);
TheCanvas.Font.Color := clBlack;
TheCanvas.TextOut(UCorner - 3, LCorner - 3, TheString);
End;
//Şöyle Çalışıyor
imgPaintCanvas(Image3.Canvas, '0', 10, 6, 4);

2. Form da MetaFile çizmek...
implementation
{$R *.DFM}
type
TMetafileCanvas = class(TCanvas)
private
FClipboardHandle: THandle;
FMetafileHandle: HMetafile;
FRect: TRect;
protected
procedure CreateHandle; override;
function GetMetafileHandle: HMetafile;
public
constructor Create;
destructor Destroy; override;
property Rect: TRect read FRect write FRect;
property MetafileHandle: HMetafile read GetMetafileHandle;
end;
constructor TMetafileCanvas.Create;
begin
inherited Create;
FClipboardHandle := GlobalAlloc(
GMEM_SHARE or GMEM_ZEROINIT, SizeOf(TMetafilePict));
end;
destructor TMetafileCanvas.Destroy;
begin
DeleteMetafile(CloseMetafile(Handle));
if Bool(FClipboardHandle) then GlobalFree(FClipboardHandle);
if Bool(FMetafileHandle) then DeleteMetafile(FMetafileHandle);
inherited Destroy;
end;
procedure TMetafileCanvas.CreateHandle;
var
MetafileDC: HDC;
begin
MetafileDC := CreateMetaFile(nil);
if Bool(MetafileDC) then
begin
with FRect do SetWindowOrg(MetafileDC, Left - 10, Top - 10);
with FRect do SetWindowExt(MetafileDC, Right - Left + 20, Bottom - Top + 20);
if Bool(FMetafileHandle) then
begin
PlayMetafile(MetafileDC, FMetafileHandle);
end;
end;
Handle := MetafileDC;
end;
function TMetafileCanvas.GetMetafileHandle: HMetafile;
var
MetafilePict: PMetafilePict;
IC: HDC;
ExtRect: TRect;
begin
if Bool(FMetafileHandle) then DeleteMetafile(FMetafileHandle);
FMetafileHandle := CloseMetafile(Handle);
Handle := 0;
MetafilePict := GlobalLock(FClipboardHandle);
MetafilePict^.mm := mm_AnIsoTropic;
IC := CreateIC('DISPLAY', nil, nil, nil);
SetMapMode(IC, mm_HiMetric);
ExtRect := FRect;
DPtoLP(IC, ExtRect, 2);
DeleteDC(IC);
MetafilePict^.xExt := ExtRect.Right - ExtRect.Left;
MetafilePict^.yExt := ExtRect.Top - ExtRect.Bottom;
MetafilePict^.HMF := FMetafileHandle;
GlobalUnlock(FClipboardHandle);
Result := FClipboardHandle;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
MetafileCanvas : TMetafileCanvas;
begin
MetafileCanvas := TMetafileCanvas.Create;
MetafileCanvas.Rect := Rect(0,0,500,500);
MetafileCanvas.Ellipse(10,10,400,400);
Image1.Picture.Metafile.LoadFromClipboardFormat(cf_MetafilePict, MetafileCanvas.MetafileHandle, 0);
MetafileCanvas.Free;
end;
end.

3. Forma Bitmap kaplanması...
var
Form1: TForm1;
Bitmap: TBitmap;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
Bitmap := TBitmap.Create;
Bitmap.LoadFromFile('C:\WINDOWS\hasir.bmp'Wink;
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;
end.

4.Transparan Bitmap nasıl yapılır...
procedure DrawTrans(DestCanvas: TCanvas; X,Y: smallint; SrcBitmap: TBitmap; AColor, BackColor: TColor);
var ANDBitmap, ORBitmap: TBitmap;
CM: TCopyMode;
Src: TRect;
begin
ANDBitmap:= NIL;
ORBitmap:= NIL;
try
ANDBitmap:= TBitmap.Create;
ORBitmap:= TBitmap.Create;
Src := Bounds(0,0, SrcBitmap.Width, SrcBitmap.Height);
with ORBitmap do begin
Width:= SrcBitmap.Width;
Height:= SrcBitmap.Height;
Canvas.Brush.Color := clBlack;
Canvas.CopyMode := cmSrcCopy;
Canvas.BrushCopy(Src, SrcBitmap, Src, AColor);
end;
with ANDBitmap do begin
Width:= SrcBitmap.Width;
Height:= SrcBitmap.Height;
Canvas.Brush.Color := BackColor;
Canvas.CopyMode := cmSrcInvert;
Canvas.BrushCopy(Src, SrcBitmap, Src, AColor);
end;
with DestCanvas do begin
CM := CopyMode;
CopyMode := cmSrcAnd;
Draw(X,Y, ANDBitmap);
CopyMode := cmSrcPaint;
Draw(X,Y, ORBitmap);
CopyMode := CM;
end;
finally
ANDBitmap.Free;
ORBitmap.Free;
end;
end;
Kullanımı :
DrawTrans(Image2.Canvas, 0,0, 'C:\Windows\deepblue.bmp', clBlack, clSilver);
 
http://www.programyukle.org
Atlanilacak Forum:

En Çok İndirilenlerYeni Eklenenler

image Outlook Express 6.0 [14860]  
image SPSS 15.0 [13022]  
image Msn Dondurucu ( Msn F... [12786]  
image GTA Mod Installer v2.2... [9526]  
image Cep Okey [9449]  
image Eşli Batak 2.0.0.8 [8460]  
image Cepte Televizyon v1.5 [7060]  
image Nokia N70 İçin Full Pr... [6143]  
image Championship Manager 0... [4238]  
image Ders dağıtım programı ... [3977]  
image CurrPortS 2.12 [18.12.2014]
image PHTML Encoder 6.4 [18.12.2014]
image DzSoft PHP Editor 4.2.7.7 [18.12.2014]
image KoolMoves 9.2.1 [18.12.2014]
image Chicken Invaders 2 2.0 [18.12.2014]
image Natalie Brooks: Kayıp Krallığın ... [18.12.2014]
image Zuma Deluxe 1.0 [18.12.2014]
image Bus Driver 1.5 [18.12.2014]
image Mario Forever 5.8 [18.12.2014]
image Icy Tower 1.5.1 [18.12.2014]
site statistics

Edit by MuhBim
Copyright © 2007 Programyukle.Org
Powered by PHP-Fusion copyright © 2002 - 2017 by Nick Jones.
Released as free software without warranties under GNU Affero GPL v3.
Sayfa oluşturulma süresi: 0.08 saniye | 44,767,431 Tekil Ziyaretçi | jQ Blog