سلام به سایت خودتون خوش آمدید
برنامه ای براتون نوشتم که اینکارو براتون انجام بده تصویر Background و لایه رو انتخاب کنید و سپس کلید ResultBitmap رو کلیک کنید.
این فایل pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,jpeg, StdCtrls, ExtDlgs, ExtCtrls;
type
PTriple =^ TTriple;
TTriple=Array[0..65535] of TRGBTriple;
TForm1 = class(TForm)
Button1: TButton;
OpenPictureDialog1: TOpenPictureDialog;
Button2: TButton;
ScrollBox1: TScrollBox;
BackImage: TImage;
ScrollBox2: TScrollBox;
FrontImage: TImage;
ScrollBox3: TScrollBox;
ResultImage: TImage;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
public
FrontBit, BackBit ,ResBit : TBitmap;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function ConverColor(Color1, Color2: TRGBTriple;Opacity: Real): TRGBTriple;
var DisR, DisG, DisB : integer;
begin
DisR:=Color2.rgbtRed-Color1.rgbtRed;
DisG:=Color2.rgbtGreen-Color1.rgbtGreen;
DisB:=Color2.rgbtBlue-Color1.rgbtBlue;
if DisR<>0 then Result.rgbtRed:=Color1.rgbtRed+round(Disr/100*Opacity)
else Result.rgbtRed:=Color1.rgbtRed;
if DisG<>0 then Result.rgbtGreen:=Color1.rgbtGreen+round(DisG/100*Opacity)
else Result.rgbtGreen:=Color1.rgbtGreen;
if DisB<>0 then Result.rgbtBlue:=Color1.rgbtBlue+round(DisB/100*Opacity)
else Result.rgbtBlue:=Color1.rgbtBlue;
end;
function SetOpacity(FrontBitmap ,BackBitmap : TBitmap;Opacity : byte):TBitmap;
var i , j : integer;
FrontRow ,BackRow ,ResRow : PTriple;
begin
if Opacity>100 then Opacity := Opacity mod 100;
Result := TBitmap.Create;
with Result do
begin
PixelFormat := pf24bit;
Width := BackBitmap.Width;
Height := BackBitmap.Height;
end;
FrontBitmap.PixelFormat := pf24bit;
BackBitmap.PixelFormat := pf24bit;
for i := 0 to BackBitmap.Height-1 do
begin
if i>= FrontBitmap.Height-1 then Break;
FrontRow := FrontBitmap.ScanLine[i];
BackRow := BackBitmap.ScanLine[i];
ResRow := Result.ScanLine[i];
for j := 0 to BackBitmap.Width-1 do
if j< FrontBitmap.Width-1 then
ResRow[j] := ConverColor(BackRow[j],FrontRow[j],Opacity);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var JPGImage : TJPEGImage;
begin
if OpenPictureDialog1.Execute then
begin
JPGImage := TJPEGImage.Create;
try
JPGImage.LoadFromFile(OpenPictureDialog1.FileName) ;
BackBit.Assign(JPGImage);
with BackImage do
begin
Width := BackBit.Width;
Height := BackBit.Height;
Picture.Bitmap. Assign(BackBit);
end;
finally
JPGImage.Free;
end;
end;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
FrontBit := TBitmap.Create;
BackBit := TBitmap.Create;
ResBit := TBitmap.Create;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FrontBit.Free;
BackBit.Free;
ResBit.Free;
end;
procedure TForm1.Button2Click(Sender: TObject);
var JPGImage : TJPEGImage;
begin
if OpenPictureDialog1.Execute then
begin
JPGImage := TJPEGImage.Create;
try
JPGImage.LoadFromFile(OpenPictureDialog1.FileName) ;
FrontBit.Assign(JPGImage);
with FrontImage do
begin
Width := FrontBit.Width;
Height := FrontBit.Height;
Picture.Bitmap. Assign(FrontBit);
end;
finally
JPGImage.Free;
end;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
ResBit.Assign(SetOpacity(FrontBit,BackBit,30));
with ResultImage do
begin
Width := ResBit.Width;
Height := ResBit.Height;
Picture.Bitmap.Assign(ResBit);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
end;
end.
این هم فایل dfm
object Form1: TForm1
Left = 192
Top = 114
Width = 696
Height = 480
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 32
Top = 16
Width = 121
Height = 25
Caption = 'BackGroundBitmap'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 32
Top = 48
Width = 121
Height = 25
Caption = 'LayerBitmap'
TabOrder = 1
OnClick = Button2Click
end
object ScrollBox1: TScrollBox
Left = 168
Top = 8
Width = 233
Height = 209
TabOrder = 2
object BackImage: TImage
Left = 0
Top = 0
Width = 209
Height = 201
end
end
object ScrollBox2: TScrollBox
Left = 416
Top = 8
Width = 233
Height = 209
TabOrder = 3
object FrontImage: TImage
Left = 0
Top = 0
Width = 209
Height = 201
end
end
object ScrollBox3: TScrollBox
Left = 168
Top = 232
Width = 233
Height = 209
TabOrder = 4
object ResultImage: TImage
Left = 0
Top = 0
Width = 209
Height = 201
end
end
object Button3: TButton
Left = 24
Top = 304
Width = 121
Height = 25
Caption = 'ResultBitmap'
TabOrder = 5
OnClick = Button3Click
end
object OpenPictureDialog1: TOpenPictureDialog
Left = 56
Top = 8
end
end
سوال در مورد کمرنگ کردن یک تصویر ؟؟؟
پاسخ با نقل قول
