timage uzerinde secili alani invert etme

frost majere · Mesaj gönderen **frost majere** » 20 Mar 2007 05:54

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, jpeg, StdCtrls;

type
  TFormMarchingAnts = class(TForm)
    Timer1: TTimer;
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);

  private
     X1,Y1,X2,Y2 : Integer;

   procedure RemoveTheRect;
   procedure DrawTheRect;
   procedure InvertImage(const AnImage:TImage);
    { Private declarations }
  public
    { Public declarations }
  end;
function InvertBitmapF(MyBitmap: TBitmap): TBitmap;external 'mkGraph.dll';
var
  FormMarchingAnts: TFormMarchingAnts;
  Counter : Byte;
CounterStart : Byte;
Looper : LongInt;

implementation

{$R *.dfm}

PROCEDURE RestrictCursorToDrawingArea (CONST Image: TImage);
VAR
   CursorClipArea: TRect;
BEGIN
CursorClipArea := Bounds(Image.ClientOrigin.X, Image.ClientOrigin.Y,
                                         Image.Width, Image.Height);
Windows.ClipCursor(@CursorClipArea)
END {RestrictCursorToDrawingArea};

PROCEDURE RemoveCursorRestrictions;
BEGIN
Windows.ClipCursor(NIL)
END {RemoveCursorRestrictions};

procedure MovingDots(X,Y: Integer; TheCanvas: TCanvas); stdcall;
begin
Inc(Looper);
{$R-}
Counter := Counter shl 1;              // Shift the bit left one
{$R+}
if   Counter = 0
then Counter := 1;          // If it shifts off left, reset it
if   (Counter and 224) > 0  // Are any of the left 3 bits set?
then TheCanvas.Pixels[X,Y] := clWhite   // Erase the pixel
else TheCanvas.Pixels[X,Y] := clBlack;  // Draw the pixel
end;

function NormalizeRect(R: TRect): TRect;
begin
// This routine normalizes a rectangle. It makes sure that the Left,Top
// coords are always above and to the left of the Bottom,Right coords.
with R do
BEGIN
   if   Left > Right
   then
     if   Top > Bottom
     then Result := Rect(Right,Bottom,Left,Top)
     else Result := Rect(Right,Top,Left,Bottom)
   else
     if   Top > Bottom
     then Result := Rect(Left,Bottom,Right,Top)
     else Result := Rect(Left,Top,Right,Bottom);
END
end;

procedure TFormMarchingAnts.FormCreate(Sender: TObject);
begin
X1 := 0;
Y1 := 0;
X2 := 0;
Y2 := 0;
Canvas.Pen.Color := Color;
Canvas.Brush.Color := Color;
CounterStart := 128;
Timer1.Interval := 100;
Timer1.Enabled := True;
Looper := 0;

FormMarchingAnts.ControlStyle := FormMarchingAnts.ControlStyle  + [csOpaque];
end;

procedure TFormMarchingAnts.RemoveTheRect;
var
R : TRect;
begin
R := NormalizeRect(Rect(X1,Y1,X2,Y2));  // Rectangle might be flipped
InflateRect(R,1,1);                     // Make the rectangle 1 pixel larger
InvalidateRect(Handle,@R,True);         // Mark the area as invalid
InflateRect(R,-2,-2);                   // Now shrink the rectangle 2 pixels
ValidateRect(Handle,@R);                // And validate this new rectangle.
// This leaves a 2 pixel band all the way around
// the rectangle that will be erased & redrawn
UpdateWindow(Handle);
end;

procedure TFormMarchingAnts.DrawTheRect;
begin
// Determines starting pixel color of Rect
Counter := CounterStart;
// Use LineDDA to draw each of the 4 edges of the rectangle
LineDDA(X1,Y1,X2,Y1,@MovingDots,LongInt(Canvas));
LineDDA(X2,Y1,X2,Y2,@MovingDots,LongInt(Canvas));
LineDDA(X2,Y2,X1,Y2,@MovingDots,LongInt(Canvas));
LineDDA(X1,Y2,X1,Y1,@MovingDots,LongInt(Canvas));
end;

procedure TFormMarchingAnts.Timer1Timer(Sender: TObject);
begin
CounterStart := CounterStart shr 2;    // Shl 1 will move rect slower
if   CounterStart = 0                  // If bit is lost, reset it
then CounterStart := 128;
DrawTheRect                           // Draw the rectangle

end;

procedure TFormMarchingAnts.Image1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
if ssLeft in Shift
then  begin
   X := X + (Sender AS TImage).Left;
   Y := Y + (Sender AS TImage).top;

   RemoveTheRect;         // Erase any existing rectangle
   X2 := X; Y2 := Y;      // Save the new corner where the mouse is
   DrawTheRect;           // Draw the Rect now... don't wait for the timer!
end;
end;

procedure TFormMarchingAnts.Image1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
X := X + (Sender AS TImage).Left;
Y := Y + (Sender AS TImage).Top;

RemoveTheRect;                               // Erase any existing rectangle
X1 := X;
Y1 := Y;

X2 := X;
Y2 := Y;

// Force mouse movement to stay within TImage
RestrictCursorToDrawingArea( (Sender AS TImage) )

end;

procedure TFormMarchingAnts.Image1MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
RemoveCursorRestrictions
end;




procedure TFormMarchingAnts.InvertImage(const AnImage:TImage);
var
  BytesPorScan: integer;
  vi_width, vi_height: integer;
  p: pByteArray;
begin
  //This only works with images of 24 or 32 bits per pixel
  If not (AnImage.Picture.Bitmap.PixelFormat in[pf24Bit, pf32Bit])then
    raise exception.create('Error, Format File not soported!');


  //Invert the RGB for each pixel
  for vi_height := x1 to x2 do
  begin
    P := AnImage.Picture.Bitmap.ScanLine[vi_height];
    for vi_width := y1 to y2 do
        P^[vi_width] := 255-P^[vi_width];
  end;
  AnImage.Refresh;
end;


procedure TFormMarchingAnts.Button1Click(Sender: TObject);
begin
InvertImage(Image1)
end;

procedure TFormMarchingAnts.Button2Click(Sender: TObject);
begin
showmessage(inttostr(x1) + #13 + inttostr(x2) + #13 + inttostr(y1) + #13 + inttostr(y2))
end;

yukarida ki kod ile timage uzerinde belirli bir alani secebiliyorum fakat,
invert ederken secili alandan gelen koordinatlar ile invert olunan alan uyu$muyor.

te$ekkurler.

mrmarman · Mesaj gönderen **mrmarman** » 20 Mar 2007 10:49

Kodu inceledim. Bir kaç hata var...

1. Yüklediğin image 24 bit mi 32 bit mi olduğu çok ama çok önemli. Neden ? Çünkü Scanline kullanıyoruz.

Birazdan detay vericem.

2. Form bazında X ve Y belirlenmiş fakat Image için işlem yapılmaya çalışışmış. Yani Formun 100x ve 100y 'si Image'in Left ve Top değerinin düşüldüğü halidir. Referansınız karıştırılmış.

3. Scanline için kullanılan döngü takdim tehir'e uğramış yani yatay değerleri almak için dikey koordinatlar, dikey değerleri okumak için yatay koordinatlara ait ölçüler kullanılmış X'ler ile Y'ler karışmış.

4. resim 24 bit ise X değeri 3 ile, 32 bit ise 4 ile çarpılarak nokta değer okunmalıydı. Halbuki bu fonksiyon scanline'a göre değil Pixel fonksiyonuna göre yazılmış.

- Ben ne yaptım. ( Yüklenen resmin tBitmap olduğunu varsayıyorum, JPEG hata verir, bitmap canvas kullanılıyor çünkü )

1. Resim ne olursa olsun pf24bit olarak fiksledim. sen bunu kaldırıp gelen resmin türüne 24 veya 32 bit olmasına göre özgür olmak isteyebilirsin diye ÇARPAN diye bir değişken ekledim. 24Bit ise bu carpan 3, 32Bit ise bu carpan 4 oluyor. ( bkz. CASE ile )

2. X değerlerinden TImage nesnesinin Left değerini, Y değerlerinden ise Top değerini düşerek gerçek koordinatları elde ettik.

3. Height (dikey) için döngüye yanlışlıkla X denmiş bunu Y ile değiştirdim. Width (yatay) için de aynı hata yapılmış. Y'leri X ile değiştirdim.

4. Carpan isimli değişkeni oluşturdum demiştim. Yatay genişliğin değerlerini okumak için 24bit için 3, 32bit için 4 ile çarpılması gerekir.
( 3 ve 4 nereden geliyor diye soracak olanlar için, 24 bitlik pixelformatı renk özellikleri 3 byte ile 32 bitlik pixel formatlı renk özellikleri 4 byte ile ifade edilir.

Kod: Tümünü seç

TRGB24bit = 
PACKED RECORD
  rgbBlue : BYTE;
  rgbGreen: BYTE;
  rgbRed  : BYTE;
END;

Kod: Tümünü seç

TRGB32bit = 
PACKED RECORD
  rgbBlue : BYTE;
  rgbGreen: BYTE;
  rgbRed  : BYTE;
  rgbReserved:  BYTE
END;

5. En sonunda da seçilmiş alanı Image için yeniden belirleyince kaydırmıştık eski haline döndürüyoruz ki tekrar negatifi pozitif yapabilesin.

- Aşağıdaki kodunu düzelttiğim hali. Eskisinin üzerine yazabilirsin.. Afiyet olsun.

Kod: Tümünü seç

procedure TFormMarchingAnts.InvertImage(const AnImage:TImage);
var
  //BytesPorScan: integer;
  vi_width, vi_height: integer;
  p: pByteArray;
  Carpan : Integer;
begin
  Carpan := 1;
  //This only works with images of 24 or 32 bits per pixel
  AnImage.Picture.Bitmap.PixelFormat := pf24Bit;
  If not (AnImage.Picture.Bitmap.PixelFormat in[pf24Bit, pf32Bit])then
    raise exception.create('Error, Format File not soported!');
  //Invert the RGB for each pixel
  X1 := X1 - Image1.Left;
  X2 := X2 - Image1.Left;
  Y1 := Y1 - Image1.Top;
  Y2 := Y2 - Image1.Top;
  Case AnImage.Picture.Bitmap.PixelFormat of
  pf24Bit : Carpan := 3;
  pf32Bit : Carpan := 4;
  End;

  for vi_height := y1 to y2 do
  begin
    P := AnImage.Picture.Bitmap.ScanLine[vi_height];
    for vi_width := x1*Carpan to x2*Carpan do
        P^[vi_width] := 255-P^[vi_width];
  end;
  AnImage.Refresh;
  X1 := X1 + Image1.Left;
  X2 := X2 + Image1.Left;
  Y1 := Y1 + Image1.Top;
  Y2 := Y2 + Image1.Top;
end;

frost majere · Mesaj gönderen **frost majere** » 21 Mar 2007 12:44

cok te$ekkurler