Değerli arkadaşlar.
Bitmap ile ilgili bir sorunum var. Bana yardımcı olacak arkadaşlara şimdiden teşekkür ederim. Forumda "kopyalama hatası" adı ile başlık açmıştım. Sağolsun "ertank" arkadaşımız yardımcı oldu. kodlar şu şekilde:
procedure TForm1.Button1Click(Sender: TObject);
var
LBmp1 : TBitmap;
LBmp2: TBitmap;
begin
LBmp1 := nil;
LBmp2 := nil;
try
LBmp1 := TBitmap.Create;
LBmp1.LoadFromFile('C:\Users\User\Downloads\R1.bmp');
LBmp1.Transparent := True;
LBmp1.TransparentMode := tmAuto;
LBmp2 := TBitmap.Create;
LBmp2.LoadFromFile('C:\Users\User\Downloads\R2.bmp');
LBmp2.Transparent := True;
LBmp2.TransparentMode := tmAuto;
LBmp2.Canvas.Draw(0, 0, LBmp1);
LBmp2.SaveToFile('C:\Users\User\Downloads\r_transparan.bmp');
Image1.Picture.Bitmap.LoadFromFile('C:\Users\User\Downloads\r_transparan.bmp');
finally
LBmp1.Free();
LBmp2.Free();
end;
end;
Bu kodda 1.ci resim 2.ci resim üzerine boyutlar aynı kalmak kaydıyla saydam olarak kopyalanıyor. Sorunum ise 1.ci resimin boyutlarını küçültüp 2.ci resime kopyaladığımda saydamlık kayboluyor. Küçültmek için şu kodları kullanıyorum.
procedure TForm2.ResmiKucultButtonClick(Sender: TObject);
{### ReSampleBitmap Kodları başlangıç ###---------------------------------}
type
PBitmap = ^TBitmap;
TLine = array[0..MaxInt div SizeOf(TRGBQUAD) - 1] of TRGBQUAD;
PLine = ^TLine;
function ResampleSubBitmap(Bitmap: TBitmap; XPos, YPos, Width, Height: Integer): TRGBQuad;
var
r, g, b: Cardinal;
Line: PLine;
x, y, z: Integer;
begin
z := (Width * Height);
r := 0;
g := 0;
b := 0;
if (YPos + Height) >= Bitmap.Height then Height := (Bitmap.Height - YPos) - 1;
if (XPos + Width) >= Bitmap.Width then Width := (Bitmap.Width - XPos) - 1;
for y := YPos to YPos + Height do
begin
Line := Bitmap.ScanLine[y];
Bitmap.Transparent := true;
Bitmap.TransparentMode := tmAuto;
for x := XPos to XPos + Width do
begin
r := r + Line[x].rgbRed;
g := g + Line[x].rgbGreen;
b := b + Line[x].rgbBlue;
Inc(z);
end;
end;
if (z = 0) then z := 1;
r := Round((r / z) * 1.4);
if (r > 255) then r := 255;
g := Round((g / z) * 1.4);
if (g > 255) then g := 255;
b := Round((b / z) * 1.4);
if (b > 255) then b := 255;
Result.rgbRed := r;
Result.rgbGreen := g;
Result.rgbBlue := b;
end;
function ResampleBitmap(Bitmap: TBitmap; NewWidth, NewHeight: Integer): Boolean;
var
Temp: TBitmap;
Line: PLine;
x, y: Integer;
Blockheight, Blockwidth: Cardinal;
BlockPosX, BlockPosY: Single;
BlockDiffX, BlockDiffY: Single;
XPos, YPos: Single;
DiffX, Diffy: Single;
begin
Result := True;
Temp := TBitmap.Create;
Bitmap.PixelFormat := pf32Bit;
Bitmap.Transparent := true;
Bitmap.TransparentMode := tmAuto;
Bitmap.Canvas.Brush.Style := bsClear;
Temp.Transparent := true;
Temp.TransparentMode := tmAuto;
Temp.PixelFormat := pf32Bit;
Temp.Canvas.Brush.Style := bsClear;
Temp.Height := NewHeight;
Temp.Width := NewWidth;
BlockDiffY := (Bitmap.Height / NewHeight);
BlockDiffX := (Bitmap.Width / NewWidth);
BlockHeight := Trunc(BlockDiffY);
BlockWidth := Trunc(BlockDiffY);
DiffX := 1;
DiffY := 1;
BlockPosY := 0;
YPos := 0;
for y := 0 to NewHeight - 1 do
begin
BlockPosX := 0;
XPos := 0;
Line := Temp.ScanLine[Trunc(YPos)];
for x := 0 to NewWidth - 1 do
begin
Line[Trunc(XPos)] := ResampleSubBitmap(Bitmap,
Round(BlockPosX), Round(BlockPosY), Blockwidth, BlockHeight);
BlockPosX := BlockPosX + BlockDiffX;
XPos := XPos + DiffX;
end;
BlockPosY := BlockPosY + BlockDiffY;
YPos := YPos + DiffY;
end;
Bitmap.Assign(Temp);
Temp.Transparent := true;
Temp.TransparentMode := tmAuto;
Temp.Canvas.Brush.Style := bsClear;
Temp.Free;
Bitmap.Transparent := true;
Bitmap.TransparentMode := tmAuto;
Bitmap.Canvas.Brush.Style := bsClear;
end; {### ReSampleBitmap Kodları bitiş ###---------------------------------}
begin
Image1.Canvas.Brush.Style := bsClear;
ResampleBitmap(Image1.Picture.bitmap,30,30)); //1.ci resim boyutları 30x30 yapılıyor.
Image1.Canvas.Brush.Style := bsClear;
Image1.Transparent := true;
end;
Burada elde ettiğim resim1, resim2 üzerine (yukarıdaki 1.ci kodu kullanarak) ama saydam olamadan kopyalanıyor. Küçültülen resmi saydam olarak nasıl kopyalayabilirim..?
Kullandığım sürüm : Delphi 7
Bitmap'ı saydam olarak küçültme ve kopyalama
Forum kuralları
Forum kurallarını okuyup, uyunuz!
Forum kurallarını okuyup, uyunuz!