Trim کردن تصویر

[MozenAbasi]

سلام دوستان خداقوت
من تو دلفی تازه کار هستم برای همین وقتی تو تاپیک های دیگه جستجو کردم یا کلی کد مواجه شدم که نفهمیدم که هر کدومش چی کار میکنه .
من میخوام مشخصات هر پیکسل از تصویر رو در بیارم منظورم RGB هر پیکسل هستش . می خواستم یکی لطف کنه و دستورات مربوط به این کار رو معرفی کنه و اگه لازم هست برای این کار تنظیمات خاصی روی عنصر Image مورد نظر اعمال بشه (مثل VB) بفرمایید .

کاری که من میخوام بکنم اینه که میخوام یک ایمیج رو اصطلاحا Trim کنم فرض کنید طرف یه عکس آپلود میکنه فرضا یه گوشش حاوی اطلاعات مورد نظر ماست مثلا طرف یه عکس 10*10 آپلود میکنه که فقط یک بخش 2*2 اون حاوی اطلاعات هست و بقیه همینطور سفیده . برای همین این روش به ذهنم اومد که کل عکس رو پیمایش کنم و بیشترین سطر و ستونی که پیکسلش سیاهه رو به عنوان سطر و ستون آخر عکس در نظر گرفته و اون رو به طریقی (که البته بلد نیستم !) Resize کنم .

ممنون میشم راهنماییم کنیم

[Mask]

این نمونه رو قبلا برای تشخیص رنگ عکس نوشتم. میتونی ازش ایده بگیری. کلیه دستورات کار با عکس هم درش هست.

[MozenAbasi]

ممنون بابت نمونه برنامه .
می خواستم نظرتون رو برای ایده ای که در مورد اصل Trim کردن تصویر دارم هم بگید .
آیا راهی که پیشنهاد دادم مناسبه یا راه بهتری هم وجود داره ؟
برای Resize کردنش چی کار کنم ؟

[MozenAbasi]

اگر کسی راه بهتری سراغ داره لطفا معرفی کنه

[MohsenB]

سلام

از این کد میتونید استفاده کنید :


procedure TForm1.btn1Click(Sender: TObject);
const c_dark = 50;
var bmp:TBitmap;
reg :TRect;
i,t :Word;
begin
with img1.Picture.Bitmap do begin
reg:= Rect(Width, Height, 0, 0);
for i := 0 to Height-1 do
for t := 0 to Width do
if ((Canvas.Pixels[t,i] and $FF)+((Canvas.Pixels[t,i] shr 8) and $FF)+((Canvas.Pixels[t,i] shr 16) and $FF)) <(768-c_dark) then begin
if(i<reg.Top) then reg.Top:= i;
if(t<reg.Left) then reg.Left:= t;
if((i+1)>reg.Bottom) then reg.Bottom:= i+1;
if((t+1)>reg.Right) then reg.Right:= t+1;
end;
end;
bmp:= TBitmap.Create;
bmp.SetSize(reg.Width, reg.Height);
BitBlt(bmp.Canvas.Handle,0, 0, reg.Width, reg.Height, img1.Canvas.Handle, reg.Left, reg.Top, SRCCOPY);
img2.Picture.Bitmap.Assign(bmp);
end;


موفق باشید

[MozenAbasi]

سلام

از این کد میتونید استفاده کنید :


procedure TForm1.btn1Click(Sender: TObject);
const c_dark = 50;
var bmp:TBitmap;
reg :TRect;
i,t :Word;
begin
with img1.Picture.Bitmap do begin
reg:= Rect(Width, Height, 0, 0);
for i := 0 to Height-1 do
for t := 0 to Width do
if ((Canvas.Pixels[t,i] and $FF)+((Canvas.Pixels[t,i] shr 8) and $FF)+((Canvas.Pixels[t,i] shr 16) and $FF)) <(768-c_dark) then begin
if(i<reg.Top) then reg.Top:= i;
if(t<reg.Left) then reg.Left:= t;
if((i+1)>reg.Bottom) then reg.Bottom:= i+1;
if((t+1)>reg.Right) then reg.Right:= t+1;
end;
end;
bmp:= TBitmap.Create;
bmp.SetSize(reg.Width, reg.Height);
BitBlt(bmp.Canvas.Handle,0, 0, reg.Width, reg.Height, img1.Canvas.Handle, reg.Left, reg.Top, SRCCOPY);
img2.Picture.Bitmap.Assign(bmp);
end;


ممنون بابت کدی که زحمت کشیدین و نوشتین ولی روی خط 19 و 20 خطا میده مثلا دستور SetSize رو نمیشناسه و یا Width, Height رو برای reg نمیشناسه و همچنین Not enough actual parameters برای BitBlt تو خط 20 میده .
ممنون میشم راهنماییم کنید .

[MohsenB]

سلام

امیدوارم این کد کمکتون کنه و همچنین امیدوارم دست از سر این دلفیای قدیمی بردارین :


procedure TForm1.btn1Click(Sender: TObject);
const c_dark = 50;
var bmp:TBitmap;
reg :TRect;
i,t :Word;
begin
with img1.Picture.Bitmap do begin
reg:= Rect(Width, Height, 0, 0);
for i := 0 to Height-1 do
for t := 0 to Width-1 do
if ((Canvas.Pixels[t,i] and $FF)+((Canvas.Pixels[t,i] shr 8) and $FF)+((Canvas.Pixels[t,i] shr 16) and $FF)) <(768-c_dark) then begin
if(i<reg.Top) then reg.Top:= i;
if(t<reg.Left) then reg.Left:= t;
if((i+1)>reg.Bottom) then reg.Bottom:= i+1;
if((t+1)>reg.Right) then reg.Right:= t+1;
end;
end;
bmp:= TBitmap.Create;
bmp.Width:=reg.Right-reg.Left;
bmp.Height:= reg.Bottom-reg.Top;
BitBlt(bmp.Canvas.Handle,0, 0, reg.Right-reg.Left, reg.Bottom-reg.Top, img1.Canvas.Handle, reg.Left, reg.Top, SRCCOPY);
img1.Picture.Bitmap.Assign(bmp);
end;


موفق باشید

[MozenAbasi]

جناب MohsenB خیلی ازتون ممنونم .نمیدونید چه کمک بزرگی بهم کردین.
من همیشه بچه های سایت برنامه نویس رو به عنوان بچه های بسیار قوی و بی ریا در عرصه برنامه نویسی به همه دوستانم معرفی کردم .
امیدوارم همیشه موفق باشید .