Mega Code Archive
Bir resmi şeffaf olarak başka bir resim üzerine yapıştırmak
<![CDATA[
Bir remin şeffaf olarak başka bir resim üzerine yapıştırılması
Unit1.pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
ColorDialog1: TColorDialog;
Panel1: TPanel;
Button2: TButton;
Image2: TImage;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure DrawTransparent(t: TCanvas; x,y: Integer; s: TBitmap; TrCol: TColor);
end;
var
Form1: TForm1;
bmp:tbitmap;
clr:tcolor;
implementation
{$R *.DFM}
procedure tform1.DrawTransparent(t: TCanvas; x,y: Integer; s: TBitmap; TrCol: TColor);
var
bmpXOR, bmpAND, bmpINVAND, bmpTarget: TBitmap;
oldcol: Longint;
begin
try
bmpAND := TBitmap.Create;
bmpAND.Width := s.Width;
bmpAND.Height := s.Height;
bmpAND.Monochrome := True;
oldcol := SetBkColor(s.Canvas.Handle, ColorToRGB(TrCol));
BitBlt(bmpAND.Canvas.Handle, 0,0,s.Width,s.Height, s.Canvas.Handle, 0,0, SRCCOPY);
SetBkColor(s.Canvas.Handle, oldcol);
bmpINVAND := TBitmap.Create;
bmpINVAND.Width := s.Width;
bmpINVAND.Height := s.Height;
bmpINVAND.Monochrome := True;
BitBlt(bmpINVAND.Canvas.Handle, 0,0,s.Width,s.Height, bmpAND.Canvas.Handle, 0,0, NOTSRCCOPY);
bmpXOR := TBitmap.Create;
bmpXOR.Width := s.Width;
bmpXOR.Height := s.Height;
BitBlt(bmpXOR.Canvas.Handle, 0,0,s.Width,s.Height, s.Canvas.Handle, 0,0, SRCCOPY);
BitBlt(bmpXOR.Canvas.Handle, 0,0,s.Width,s.Height, bmpINVAND.Canvas.Handle, 0,0, SRCAND);
bmpTarget := TBitmap.Create;
bmpTarget.Width := s.Width;
bmpTarget.Height := s.Height;
BitBlt(bmpTarget.Canvas.Handle, 0,0,s.Width,s.Height, t.Handle, x,y, SRCCOPY);
BitBlt(bmpTarget.Canvas.Handle, 0,0,s.Width,s.Height, bmpAND.Canvas.Handle, 0,0, SRCAND);
BitBlt(bmpTarget.Canvas.Handle, 0,0,s.Width,s.Height, bmpXOR.Canvas.Handle, 0,0, SRCINVERT);
BitBlt(t.Handle, x,y,s.Width,s.Height, bmpTarget.Canvas.Handle, 0,0, SRCCOPY);
finally
bmpXOR.Free;
bmpAND.Free;
bmpINVAND.Free;
bmpTarget.Free;
end;{End of TRY section}
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DrawTransparent(image1.Canvas, 1,1, bmp, clr);
image1.Invalidate;
image1.repaint;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
bmp:=tbitmap.create;
bmp.width:=image1.width;
bmp.height:=image1.height;
bmp.assign(image2.picture);
// clr:=tcolor.create;;
clr:=clgreen;
panel1.color:=clr;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
bmp.free;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if colordialog1.execute then
clr:=colordialog1.Color;
panel1.color:=clr;
end;
end.
Unit1.dfm
object Form1: TForm1
Left = 200
Top = 108
Width = 617
Height = 302
Caption = 'Form1'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Image1: TImage
Left = 264
Top = 8
Width = 329
Height = 201
Stretch = True
end
object Image2: TImage
Left = 8
Top = 8
Width = 249
Height = 201
Stretch = True
end
object Button1: TButton
Left = 144
Top = 224
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
object Panel1: TPanel
Left = 304
Top = 216
Width = 113
Height = 41
Caption = 'Panel1'
TabOrder = 1
object Button2: TButton
Left = 22
Top = 8
Width = 75
Height = 25
Caption = 'Button2'
TabOrder = 0
OnClick = Button2Click
end
end
object ColorDialog1: TColorDialog
Ctl3D = True
Left = 112
Top = 352
end
end
//Alıntıdır...
]]>