açıya göre Bitmap çevirme pixelformat sorunu

Delphi'de kod yazma ile ilgili sorularınızı bu foruma yazabilirsiniz.
Cevapla
Kullanıcı avatarı
nosedive
Üye
Mesajlar: 238
Kayıt: 16 May 2004 07:48

açıya göre Bitmap çevirme pixelformat sorunu

Mesaj gönderen nosedive »

Kod: Tümünü seç

function RotateBmp(xSource: TBitmap; Aci: double): TBitmap;
var
  cosTheta: DOUBLE;
  Delta: DWORD; // D3/D4 compatibility
  i: INTEGER;
  iRotationAxis: INTEGER;
  iOriginal: INTEGER;
  iPrime: INTEGER;
  iPrimeRotated: INTEGER;
  j: INTEGER;
  jRotationAxis: INTEGER;
  jOriginal: INTEGER;
  jPrime: INTEGER;
  jPrimeRotated: INTEGER;
  RowOriginal: pRGBArray;
  RowRotated: pRGBArray;
  sinTheta: DOUBLE;
  StartTime: DWORD;
  Theta: DOUBLE; // radians
  dest: TBitmap;
  source: Tbitmap;
begin
  Dest := TBitmap.Create;
  source := Xsource;
  Source.PixelFormat := pf24bit;
  Dest.PixelFormat := pf24bit;
  dest.Width := Source.Width;
  dest.Height := Source.Height;
  iRotationAxis := Source.Width div 2;
  JRotationAxis := Source.Height div 2;
  Theta := -(aci) * PI / 180;
  sinTheta := SIN(Theta);
  cosTheta := COS(Theta);
  for j := Dest.Height - 1 downto 0 do
  begin
    RowRotated := Dest.Scanline[j];
    jPrime := 2 * (j - jRotationAxis) + 1;
    for i := Dest.Width - 1 downto 0 do
    begin
      iPrime := 2 * (i - iRotationAxis) + 1;
      iPrimeRotated := ROUND(iPrime * CosTheta - jPrime * sinTheta);
      jPrimeRotated := ROUND(iPrime * sinTheta + jPrime * cosTheta);
      iOriginal := (iPrimeRotated - 1) div 2 + iRotationAxis;
      jOriginal := (jPrimeRotated - 1) div 2 + jRotationAxis;
      if (iOriginal >= 0) and (iOriginal <= Source.Width - 1) and
        (jOriginal >= 0) and (jOriginal <= Source.Height - 1)
       then begin
        RowOriginal := Source.Scanline[jOriginal];
        RowRotated[i] := RowOriginal[iOriginal]
      end
      else begin
        RowRotated[i].rgbtBlue := 255; // assign "corner" color
        RowRotated[i].rgbtGreen := 255;
        RowRotated[i].rgbtRed := 255;
      end;
    end;
  end;
  source.PixelFormat := pf1bit;
  Dest.PixelFormat := pf1bit;
  dest.SaveToFile('c:\cevrili.bmp');
  REsult := Dest;
burada 1 bitlik lineart bmp dönme işlemi sonucunda değişik renk tonu alabiliyor..ama her zaman değil...kırmızının tonları oluşuyor. ancak resim windowstan baktığımızda kırmızı görünmesine ragmen..photoshop ile baktığımızda norma görünümde...yani lineart beyaz...pixelformat ları yukarda 1 bite çekince de kitleniyor program...

bu konuda daha önce bi çalışma yapan varmı acaba?

Teşk.
Kullanıcı avatarı
nosedive
Üye
Mesajlar: 238
Kayıt: 16 May 2004 07:48

detay

Mesaj gönderen nosedive »

en son

Kod: Tümünü seç


  source.PixelFormat := pf1bit; 
  Dest.PixelFormat := pf1bit; 
  dest.SaveToFile('c:\cevrili.bmp'); 


kısmında pixelformat 1 bit değilde 24 bit olarak bırakırsam sorun yok..ama o zaman dogal olarak 450 k lık bir resim RGB olup 11 mb a çıkıyor...yukarda

24bit olarak tanımlanan yerde 1 bit yaparsam bu sefer kilitlenme oluyor...

sanırım bu olay 24 bitten 1 bite dönüşürken oluyor...

Ama nasıl engel olunacak
Kullanıcı avatarı
bluekid
Kıdemli Üye
Mesajlar: 541
Kayıt: 11 Haz 2004 10:45
İletişim:

Mesaj gönderen bluekid »

bir de burdaki kodu kullanıp deneyiver ...
http://www.efg2.com/Lab/ImageProcessing ... anline.htm
Cevapla