کم نور شدن (شیشه ای شدن) عکس روی فرم

[Site Admin]

با عرض سلام و ادب خدمت دوستان من یک عکس روی فرم قرار دادم و میخوام این عکس به صورت شیشه ای باشه یا کم نور بشه که روی عکس لیبلها خودشو نشون بده من جهت نمایش عکس از کامپوننت pic show استفاده کردم

[BORHAN TEC]

ببینید این لینک به دردتون می خوره:
http://melander.dk/articles/alphasplash/

[MohsenB]

سلام

سوالتون واضح نیست ، شما میخواید لیبیل های پشت تصویر معلوم باشن یا میخواید عکس طوری باشه که لیبلهای روی تصویر معلوم باشن ؟ لطفا بیشتر توضیح بدین .

[mnakhaei67]

با سلام.من هم همین مشکلو دارم.کسی میتونه راهنمایی کنه.اما من از کامپوننت خاصی استفاده نکردم.در واقع یه جزئ timage که خاصیت picture آن رو یه عکس انتخاب کردم در فرمم استفاده کردم روی این عکس لیبل و button و غیره میخوام پیدا باشه.در واقع میخوام عکس به عنوان پس زمینه شیشه ای یا کم نور به قول دوستمون باشه.اگه میشه زود راهنماییم کنین.ممنون

[Site Admin]

سلام

سوالتون واضح نیست ، شما میخواید لیبیل های پشت تصویر معلوم باشن یا میخواید عکس طوری باشه که لیبلهای روی تصویر معلوم باشن ؟ لطفا بیشتر توضیح بدین .

با سلام و ادب
من لیبیلها رو روی عکس گذاشتم و میخوام عکس کم نور تر باشه برای توضیح بیشتر پروژه رو واستون شرح میدم
من برنامه چاپ چکی را دارم طراحی میکنم که میخوام عکس چک به صورت کم رنگ پشت زمینه صفحه ولیبیلهای من که دروجه و قیمت و تاریخ چک است پر رنگ تر روی چک نمایش داده بشه
با تشکر

[MohsenB]

سلام


فکر کنم با تنظیم نور تصویر چک و افزایش اون مشکلتون حل بشه . برا همین میتونید از کدهای زیر استفاده کنید :


procedure PicBright(var clip: TBitmap; Level: Integer);
var
p0:pbytearray;
r,g,b,x,y: Integer;
function IntToByte(i:Integer):Byte;
begin
if i>255 then Result:=255
else if i<0 then Result:=0
else Result:=i;
end;
begin
for y:=0 to clip.Height-1 do begin
p0:=clip.scanline[y];
for x:=0 to clip.Width-1 do begin
r:=p0[x*3]; g:=p0[x*3+1]; b:=p0[x*3+2];
p0[x*3]:=IntToByte(r+((255-r)*Level)div 255);
p0[x*3+1]:=IntToByte(g+((255-g)*Level)div 255);
p0[x*3+2]:=IntToByte(b+((255-b)*Level)div 255);
end;
end;
end;

procedure TForm1.btn1Click(Sender: TObject);
var bmp :TBitmap;
begin
bmp:= TBitmap.Create;
bmp.Assign(img1.Picture.Bitmap);
PicBright(bmp,150);
img1.Canvas.Draw(0,0,bmp);
bmp.Free;
end;


توضیح اینکه img1 همون کنترل ایمیجی هست که عکس چک تو اونه و ترجیها باید با فرمت بیتوار Bitmap (.bmp) باشه .
مقدار نمونه 150 مقدار افزایش نور هست که از 0 تا 255 متغییره .
شما کدهای رویداد کلیک Btn1 رو هر جایی که لازم دارین مثل بعد از لود شدن عکس و یا نمایش فرم قرار بدین .


موفق باشید

[MohsenB]

سلام دوباره


در تکمیل کدهای بالا ، اگر سرعت براتون ملاک نباشه و یا نیاز دارید کد راهتتری داشته باشید میتونید از کد زیر استفاده کنید :


procedure PicBright(var img :TImage; Level: Integer);
var
x,y: Integer;
function Addc(c :Byte):Byte;
begin
if (c+((255-c)*Level)div 255)>255 then Result:= 255 else Result:= (c+((255-c)*Level)div 255);
end;
begin
with img.Canvas do
for y:=0 to img.Picture.Height-1 do
for x:=0 to img.Picture.Width-1 do
Pixels[x,y]:= RGB(Addc(Pixels[x,y] and $FF),Addc((Pixels[x,y] shr 8)and $FF),Addc((Pixels[x,y] shr 16)and $FF));
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
PicBright(img1,200);
end;



و یا از ترکیب این دوتا :


procedure PicBright(var img :TImage; Level: Integer);
var
p0:pbytearray;
r,g,b,x,y: Integer;
bmp :TBitmap;
function IntToByte(i:Integer):Byte;
begin
if i>255 then Result:=255
else if i<0 then Result:=0
else Result:=i;
end;
begin
bmp:= TBitmap.Create;
bmp.Assign(img.Picture.Bitmap);
for y:=0 to img.Picture.Height-1 do begin
p0:= bmp.scanline[y];
for x:=0 to img.Picture.Width-1 do begin
r:=p0[x*3]; g:=p0[x*3+1]; b:=p0[x*3+2];
p0[x*3]:=IntToByte(r+((255-r)*Level)div 255);
p0[x*3+1]:=IntToByte(g+((255-g)*Level)div 255);
p0[x*3+2]:=IntToByte(b+((255-b)*Level)div 255);
end;
end;
img.Canvas.Draw(0,0,bmp);
bmp.Free;
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
PicBright(img1,200);
end;


موفق باشید