# Native Code > برنامه نویسی در Delphi > مباحث عمومی دلفی و پاسکال > آموزش: آموزش ها و نمونه برنامه های پردازش تصویر در دلفی

## بهروز عباسی

درود به همه برنامه نویس های گل :لبخند گشاده!: 

من به خاطر یک پروژه مجبور به یادگیری پردازش تصویر شدم ،چون خودم دلفی کار می کنم و دیدم توی سایت 
مخصوصاً در بخش دلفی چنین چیزی کمه تصمیم گرفتم هر تابع و مثالی که می بینم برای این جور کارا به درت می خوره رو در این تاپیک قرار بدم.

امید وارم مفید باشه .

موفق باشید.

----------


## بهروز عباسی

توسط این توابع می تونید فیلتر EDGE  رو بر روی عکس مورد نظرتون اعمال کنید.


اینم کد

...

type
  TRGBTripleArray = array [0 .. 10000] of TRGBTriple;
  PRGBTripleArray = ^TRGBTripleArray;

  T3x3FloatArray = array [0 .. 2] of array [0 .. 2] of Extended;

function Convolve(ABitmap: TBitmap; AMask: T3x3FloatArray;
  ABias: Integer): TBitmap;
var
  LRow1, LRow2, LRow3, LRowOut: PRGBTripleArray;
  LRow, LCol: Integer;
  LNewBlue, LNewGreen, LNewRed: Extended;
  LCoef: Extended;
begin
  LCoef := 0;
  for LRow := 0 to 2 do
    for LCol := 0 to 2 do
      LCoef := LCoef + AMask[LCol, LRow];
  if LCoef = 0 then
    LCoef := 1;

  Result := TBitmap.Create;

  Result.Width := ABitmap.Width - 2;
  Result.Height := ABitmap.Height - 2;
  Result.PixelFormat := pf24bit;

  LRow2 := ABitmap.ScanLine[0];
  LRow3 := ABitmap.ScanLine[1];

  for LRow := 1 to ABitmap.Height - 2 do
  begin
    LRow1 := LRow2;
    LRow2 := LRow3;
    LRow3 := ABitmap.ScanLine[LRow + 1];

    LRowOut := Result.ScanLine[LRow - 1];

    for LCol := 1 to ABitmap.Width - 2 do
    begin
      LNewBlue := (LRow1[LCol - 1].rgbtBlue * AMask[0, 0]) +
        (LRow1[LCol].rgbtBlue * AMask[1, 0]) +
        (LRow1[LCol + 1].rgbtBlue * AMask[2, 0]) +
        (LRow2[LCol - 1].rgbtBlue * AMask[0, 1]) +
        (LRow2[LCol].rgbtBlue * AMask[1, 1]) +
        (LRow2[LCol + 1].rgbtBlue * AMask[2, 1]) +
        (LRow3[LCol - 1].rgbtBlue * AMask[0, 2]) +
        (LRow3[LCol].rgbtBlue * AMask[1, 2]) +
        (LRow3[LCol + 1].rgbtBlue * AMask[2, 2]);
      LNewBlue := (LNewBlue / LCoef) + ABias;
      if LNewBlue > 255 then
        LNewBlue := 255;
      if LNewBlue < 0 then
        LNewBlue := 0;

      LNewGreen := (LRow1[LCol - 1].rgbtGreen * AMask[0, 0]) +
        (LRow1[LCol].rgbtGreen * AMask[1, 0]) +
        (LRow1[LCol + 1].rgbtGreen * AMask[2, 0]) +
        (LRow2[LCol - 1].rgbtGreen * AMask[0, 1]) +
        (LRow2[LCol].rgbtGreen * AMask[1, 1]) +
        (LRow2[LCol + 1].rgbtGreen * AMask[2, 1]) +
        (LRow3[LCol - 1].rgbtGreen * AMask[0, 2]) +
        (LRow3[LCol].rgbtGreen * AMask[1, 2]) +
        (LRow3[LCol + 1].rgbtGreen * AMask[2, 2]);
      LNewGreen := (LNewGreen / LCoef) + ABias;
      if LNewGreen > 255 then
        LNewGreen := 255;
      if LNewGreen < 0 then
        LNewGreen := 0;

      LNewRed := (LRow1[LCol - 1].rgbtRed * AMask[0, 0]) +
        (LRow1[LCol].rgbtRed * AMask[1, 0]) +
        (LRow1[LCol + 1].rgbtRed * AMask[2, 0]) +
        (LRow2[LCol - 1].rgbtRed * AMask[0, 1]) +
        (LRow2[LCol].rgbtRed * AMask[1, 1]) +
        (LRow2[LCol + 1].rgbtRed * AMask[2, 1]) +
        (LRow3[LCol - 1].rgbtRed * AMask[0, 2]) +
        (LRow3[LCol].rgbtRed * AMask[1, 2]) +
        (LRow3[LCol + 1].rgbtRed * AMask[2, 2]);
      LNewRed := (LNewRed / LCoef) + ABias;
      if LNewRed > 255 then
        LNewRed := 255;
      if LNewRed < 0 then
        LNewRed := 0;

      LRowOut[LCol - 1].rgbtBlue := trunc(LNewBlue);
      LRowOut[LCol - 1].rgbtGreen := trunc(LNewGreen);
      LRowOut[LCol - 1].rgbtRed := trunc(LNewRed);
    end;
  end;
end;

function Get_EDGE(imgSource: TImage): TBitmap;
var
  LMask: T3x3FloatArray;
begin
  LMask[0, 0] := -1;
  LMask[1, 0] := -1;
  LMask[2, 0] := -1;
  LMask[0, 1] := -1;
  LMask[1, 1] := 8;
  LMask[2, 1] := -1;
  LMask[0, 2] := -1;
  LMask[1, 2] := -1;
  LMask[2, 2] := -1;
  Result := Convolve(imgSource.Picture.Bitmap, LMask, 0);
end;
 //Example
procedure Tfrm_Main.btn_RunClick(Sender: TObject);
begin
  img_2.Picture.Bitmap := Get_edge(img_1);
end;


اینم پروژه.

موفق باشید.

----------


## بهروز عباسی

توسط این کامپوننت و نمونه جالبی که داره
 شما می تونید با استفاده از وب کم یک شئ متحرک را شناسایی کنید .

----------


## بهروز عباسی

با تابع زیر می تونید میزان روشنایی یک تصویر رو تغییر بدید.


...
const
  MaxPixelCount = 32768;

type
  pRGBArray = ^TRGBArray;
  TRGBArray = ARRAY [0 .. MaxPixelCount - 1] OF TRGBTriple;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  img_Original.Picture.Bitmap.PixelFormat := pf24bit;
  img_Dest.Picture.Bitmap.PixelFormat := pf24bit;

  trckbr_Br.Position := 0;
  lbl_Value.Caption := '0';
end;

procedure Brightness(imgSource, imgDest: TImage; BrValue: integer;
  lblValu: TLabel);
  function Min(a, b: integer): integer;
  begin
    if a < b then
      result := a
    else
      result := b;
  end;

  function Max(a, b: integer): integer;
  begin
    if a > b then
      result := a
    else
      result := b;
  end;

var
  i, j: integer;
  OrigRow, DestRow: pRGBArray;
begin
  // get brightness increment value
  // value := TTrackBar(Sender).Position;

  if BrValue <= 0 then
    lblValu.Caption := IntToStr(BrValue)
  else
    lblValu.Caption := Format('+%d', [BrValue]);

  // for each row of pixels
  for i := 0 to imgSource.Picture.Height - 1 do
  begin
    OrigRow := imgSource.Picture.Bitmap.ScanLine[i];
    DestRow := imgDest.Picture.Bitmap.ScanLine[i];

    // for each pixel in row
    for j := 0 to imgSource.Picture.Width - 1 do
    begin
      // add brightness value to pixel's RGB values
      if BrValue > 0 then
      begin
        // RGB values must be less than 256
        DestRow[j].rgbtRed := Min(255, OrigRow[j].rgbtRed + BrValue);
        DestRow[j].rgbtGreen := Min(255, OrigRow[j].rgbtGreen + BrValue);
        DestRow[j].rgbtBlue := Min(255, OrigRow[j].rgbtBlue + BrValue);
      end
      else
      begin
        // RGB values must be greater or equal than 0
        DestRow[j].rgbtRed := Max(0, OrigRow[j].rgbtRed + BrValue);
        DestRow[j].rgbtGreen := Max(0, OrigRow[j].rgbtGreen + BrValue);
        DestRow[j].rgbtBlue := Max(0, OrigRow[j].rgbtBlue + BrValue);
      end;
    end;
  end;

  imgDest.Repaint;

end;
 //Example
procedure TForm1.trckbr_BrChange(Sender: TObject);
var
 value: integer;
begin
  value := TTrackBar(Sender).Position;
  Brightness(img_Original,img_Dest,value,lbl_Value)
end;

پروژه

----------


## بهروز عباسی

توسط توابع زیر می توانید یک عکس را کلید عددی خاص خود کد و دیکد کنید.



...
var
  BitmapOriginal: TBitmap;
  BitmapEncrypted: TBitmap;

  // Don't bother trying to understand structure of pixels within scanline.
  // Just find length of scanline in bytes and process all bytes.
PROCEDURE EncryptImage(imgDest: TImage; SeedEncrypt: Integer);
VAR
  i: Integer;
  j: Integer;
  RandomValue: BYTE;
  rowIn: pByteArray;
  rowOut: pByteArray;
  ScanlineByteCount: Integer;
BEGIN
  IF Assigned(BitmapEncrypted) THEN
    BitmapEncrypted.Free;

  BitmapEncrypted := TBitmap.Create;
  BitmapEncrypted.Width := BitmapOriginal.Width;
  BitmapEncrypted.Height := BitmapOriginal.Height;
  BitmapEncrypted.PixelFormat := BitmapOriginal.PixelFormat;

  // Copy palette if palettized image
  IF BitmapOriginal.PixelFormat IN [pf1bit, pf4bit, pf8bit] THEN
    BitmapEncrypted.Palette := CopyPalette(BitmapOriginal.Palette);

  // This finds the number of bytes per scanline regardless of PixelFormat
  ScanlineByteCount := ABS(Integer(BitmapOriginal.Scanline[1]) -
    Integer(BitmapOriginal.Scanline[0]));

  TRY
    RandSeed := SeedEncrypt
  EXCEPT
    RandSeed := 79997 // use this prime number if entry is invalid
  END;

  FOR j := 0 TO BitmapOriginal.Height - 1 DO
  BEGIN
    rowIn := BitmapOriginal.Scanline[j];
    rowOut := BitmapEncrypted.Scanline[j];

    FOR i := 0 TO ScanlineByteCount - 1 DO
    BEGIN
      RandomValue := Random(256);
      rowOut[i] := rowIn[i] XOR RandomValue
    END
  END;

  imgDest.Picture.Graphic := BitmapEncrypted;

END { EncryptImage };

PROCEDURE DecryptImage(imgDest: TImage; SeedDecrypt: Integer);
VAR
  BitmapDecrypted: TBitmap;
  i: Integer;
  j: Integer;
  RandomValue: BYTE;
  rowIn: pByteArray;
  rowOut: pByteArray;
  ScanlineByteCount: Integer;
begin
  BitmapDecrypted := TBitmap.Create;
  BitmapDecrypted.Width := BitmapEncrypted.Width;
  BitmapDecrypted.Height := BitmapEncrypted.Height;
  BitmapDecrypted.PixelFormat := BitmapEncrypted.PixelFormat;

  // Copy palette if palettized image
  IF BitmapEncrypted.PixelFormat IN [pf1bit, pf4bit, pf8bit] THEN
    BitmapDecrypted.Palette := CopyPalette(BitmapEncrypted.Palette);

  // This finds the number of bytes per scanline regardless of PixelFormat
  ScanlineByteCount := ABS(Integer(BitmapEncrypted.Scanline[1]) -
    Integer(BitmapEncrypted.Scanline[0]));

  TRY
    RandSeed := SeedDecrypt
  EXCEPT
    RandSeed := 79997 // use this prime number if entry is invalid
  END;

  FOR j := 0 TO BitmapEncrypted.Height - 1 DO
  BEGIN
    rowIn := BitmapEncrypted.Scanline[j];
    rowOut := BitmapDecrypted.Scanline[j];

    FOR i := 0 TO ScanlineByteCount - 1 DO
    BEGIN
      RandomValue := Random(256);
      rowOut[i] := rowIn[i] XOR RandomValue
    END
  END;

  imgDest.Picture.Graphic := BitmapDecrypted;
END { DecryptImage };


نحوه استفاده
procedure TForm1.FormCreate(Sender: TObject);
begin
  IF Assigned(BitmapOriginal) THEN
    BitmapOriginal.Free;
  BitmapOriginal := TBitmap.Create;
  BitmapOriginal := img_Original.Picture.Bitmap;
end;
procedure TForm1.btn_DecryptClick(Sender: TObject);
begin
  DecryptImage(img_Decrypted, 12);
end;

procedure TForm1.btn_EncryptClick(Sender: TObject);
begin
  EncryptImage(img_Encrypted, 12);
end;

پروژه

----------


## MohsenB

با سلام

یه سورس داشتم که از خودش یا تیکه های اون میتونید استفاده کنید .
با این کدها میتونید کارهای زیر رو انجام دهید :

Invert
AddColorNoise
AddMonoNoise
AntiAlias
Contrast
FishEye
GrayScale
Lightness
Darkness
Saturation
SplitBlur
GaussianBlur
Mosaic
Twist
Splitlight
Tile
SpotLight
Trace
Emboss
Solorize
Posterize
Rotate

رمز : نام کاربری

موفق و پیروز باشید

----------


## N30TheM4TRIX

سلام
بابا بی خواب "شنبه 09 دی 1391 04:14 صبح" کمی به خودت استراحت بده
 چرا از ImageEn یا OpenCV استفاده نمی کنی؟

----------


## بهروز عباسی

اینم یک کتاب درمورد پردازش تصویر در دلفی

زبان : انگلیسی
تعداد صفحه : 42
منبع : imageprocessingindelphi (البته باید از راه های غیر معمول برای ورود استفاده کنید)

موفق باشید.

----------


## بهروز عباسی

درود به همه

الان داشتم نگاهی به گذشته مینداختم (عکس زیر)، یهو زد به سرم یه برنامه بنویسم که رنگ پوست رو توی اون تصویر تشخیص بدم و ناگهان کد زیر پدید آمد.
(با استفاده از رنگ پوست و کمی کار بیشتر میشه صورت رو توی تصاویر رنگی تشخیص داد امّا برای تشخیص صورت بهتره از فضای رنگ HSV استفاده بشه)

مواد لازم :
یک عدد Button به نامbtn_Run تا کدهای زیر رو توی رویداد کلیکش بنویسید.
دو عدد Image به نام های img_1وimg_2 که هردو باید حاوی یک تصویر از نوع BMP باشند ، همین

اینم عکس برنامه :




*کد برنامه رو کمی تغییر دادم ،کیفیتش بهتر شد.*
{...}
 uses
  System.Math;
  procedure TForm1.btn_RunClick(Sender: TObject);

  var
    x, Y: INTEGER;
    R, G, B: BYTE;
    Ptr: PByteArray;

    function isSkinRGB(R, G, B: BYTE): boolean;
    // R > 95 and G > 40 and B > 20 and
    // max{R,G,B}-min{R,G,B} > 15 and
    // |R-G| > 15 and R > G and R > B
    begin

      if (R > 95) and (G > 40) and (B > 20) and
        (MAX(MAX(R, G), B) - MIN(MIN(R, G), B) > 15) and (Abs(R - G) > 15) and
        (R > G) and (R > B) then
        RESULT := true
      else
        RESULT := false;
    end;

    begin
      For Y := 0 To img_1.Height - 1 do
      begin
        Ptr := img_1.Picture.Bitmap.Scanline[Y];

        For x := 0 To img_1.Width - 1 do
        begin
          B := Round(Ptr[(x * 3) - 3]);
          R := Round(Ptr[(x * 3) - 4]);
          G := Round(Ptr[(x * 3) - 2]);
          if isSkinRGB(R, G, B) then
            img_2.Picture.Bitmap.Canvas.Pixels[x, Y] := RGB(R, 0, 0);

        end;
      end;
    end;


اگر هم خواستید فقط قسمت های تعیین شده رو نشون بدید به img_2 یک عکس کاملاً سفید با اندازه تصویر اول قرار بدید (برای اینکه می خوایم اون قسمت ها روش چاپ کنیم)
و خط زیر رو توی برنامه بالا پیدا کنید :

    img_2.Picture.Bitmap.Canvas.Pixels[x, y] := RGB(R, 0, 0);
و با کد زیر جایگزین کنید :
        img_2.Picture.Bitmap.Canvas.Pixels[x, y] := RGB(R,G, B);

اینم تصویر از برنامه با حالت جدید :


موفق باشید.

----------


## بهروز عباسی

درود به همه :لبخند گشاده!: 

امروز می خوام یه نمونه با حال برای تشخیص پلاک خودرو(فعلاً تعیین ناحیه شماره پلاک) براتون بذارم.

ابتدا
uses math;
بعد
procedure RGBtoHSL(R, G, B: Integer; var H, S, L: Integer);
var
  Delta: Double;
  CMax, CMin: Double;
  Red, Green, Blue, Hue, Sat, Lum: Double;
begin
  Red := R / 255;
  Green := G / 255;
  Blue := B / 255;
  CMax := Max(Red, Max(Green, Blue));
  CMin := Min(Red, Min(Green, Blue));
  Lum := (CMax + CMin) / 2;
  if CMax = CMin then
  begin
    Sat := 0;
    Hue := 0;
  end
  else
  begin
    if Lum < 0.5 then
      Sat := (CMax - CMin) / (CMax + CMin)
    else if (CMax < 1) then
      Sat := (CMax - CMin) / (2 - CMax - CMin);
    Delta := CMax - CMin;
    if Red = CMax then
      Hue := (Green - Blue) / Delta
    else if Green = CMax then
      Hue := 2 + (Blue - Red) / Delta
    else
      Hue := 4.0 + (Red - Green) / Delta;
    Hue := Hue / 6;
    if Hue < 0 then
      Hue := Hue + 1;
  end;
  H := Round(Hue * 360);
  S := Round(Sat * 100);
  L := Round(Lum * 100);
end;
{------------------------}
FUNCTION RGBTripleToY(CONST RGB: TRGBTriple): Integer;
BEGIN
  WITH RGB DO
    RESULT := Integer(77 * rgbtRed + 150 * rgbtGreen + 29 * rgbtBlue) SHR 8
END { RGBtoY };

بعد کد زیر رو توی یک button بنویسید.
var
  bmp, bmp1: TBitmap;
  x, y, ScanlineBytes: Integer;
  p1, p2: pbytearray;
  RVALUE, bvalue, gvalue, num: Integer;
  hVALUE, sVALUE, lVALUE: Integer;
  tm1, tm2: Integer;
begin

  self.DoubleBuffered := true;

  num := 0;
  bmp := TBitmap.Create;
  bmp1 := TBitmap.Create;
  bmp.Assign(OroginalColorImage.Picture.Bitmap);
  bmp1.Assign(OroginalColorImage.Picture.Bitmap);

  bmp.PixelFormat := pf24bit;
  bmp1.PixelFormat := pf24bit;

  for y := 0 to bmp.Height - 3 do
  begin
    p1 := bmp.ScanLine[y];
    p2 := bmp1.ScanLine[y];
    begin
      for x := 0 to bmp.Width - 3 do
      begin
        RVALUE := p2[3 * x + 1];
        gvalue := p2[3 * x] + 2;
        bvalue := p2[3 * x];
        RGBtoHSL(RVALUE, gvalue, bvalue, hVALUE, sVALUE, lVALUE);
        lVALUE := lVALUE;
        lVALUE := Min(100, lVALUE);
        if (hVALUE > 170) and (hVALUE <= 230) then
        begin
          num := num + 1;
          p1[3 * x] := 255;
          p1[3 * x + 1] := 255;
          p1[3 * x + 2] := 255;
        end
        else if (hVALUE > 40) and (hVALUE < 80) then
        begin
          p1[3 * x] := 200;
          p1[3 * x + 1] := 200;
          p1[3 * x + 2] := 200;
        end
        else if hVALUE > 340 then
        begin
          p1[3 * x] := 150;
          p1[3 * x + 1] := 150;
          p1[3 * x + 2] := 150;
        end
        else if lVALUE > 80 then
        begin
          p1[3 * x] := 100;
          p1[3 * x + 1] := 100;
          p1[3 * x + 2] := 100;
        end
        else
        begin
          p1[3 * x] := 0;
          p1[3 * x + 1] := 0;
          p1[3 * x + 2] := 0;
        end;

      end;
    end;
  end;
  ImageHistoStretched.Picture.Bitmap.Assign(bmp);
  bmp.free;
  bmp1.free;
گفتن نداره ولی :
 OroginalColorImage یک کنترل TImage است و باید عکس رو درونش قرار بدید.

در انتها

LPR.JPG

*نکته : این فقط یک نمونه ساده بیشتر نیست و حساسیتش هم به رنگه پلاکه و با پلاک ایران کار نمی کنه !
کمی هم باید تلاش کنید.

موفق باشید.
اینم عکس ماشینی که توی نمونه است.
*

----------


## بهروز عباسی

درود
در پست های قبلی کدی برای تشخیص رنگ پوست در فضای RGB قرار دادم ،اما کمی مشکل داشت این یکی خیلی بهتره.


function Is_Skin(const R, G, B: Byte): Boolean; inline;
  function Max(const A, B: Integer): Integer; inline;
  begin
    if A > B then
      Result := A
    else
      Result := B;
  end;
  function Min(const A, B: Integer): Integer; inline;
  begin
    if A < B then
      Result := A
    else
      Result := B;
  end;

begin
  if ((R > 95) and (G > 40) and (B > 20) and (Max(R, Max(G, B)) - Min(R,
    Min(G, B)) > 15) and (abs(R - G) > 15) and (R > G) and (R > B)) then
    Result := True
  else
    Result := False;
end;

procedure Get_SkinColor(const AInput: TBitmap; AOut: TBitmap;
  AspecifyByColor: BOOL = False; AspecifyColor: TColor = clRed);
var
  iHeight, iWidth: Longint;
  pScanLine: Pointer;
  RGBBitmap: TRGBTriple;
begin

  with AOut do
  begin
    Height := AInput.Height;
    Width := AInput.Width;

    // PixelFormat := pf32bit;

    for iHeight := Height - 1 downto 0 do
    begin
      pScanLine := AInput.ScanLine[iHeight];
      for iWidth := 0 to Width - 1 do
      begin
        // Read RGB from scan line
        RGBBitmap :=
          TRGBTriple(Pointer(Longint(pScanLine) +
          (iWidth * SizeOf(TRGBTriple)))^);

        if Is_Skin(RGBBitmap.rgbtRed, RGBBitmap.rgbtGreen, RGBBitmap.rgbtBlue)
        then
        begin
          if AspecifyByColor then
          begin
            AOut.Canvas.Pixels[iWidth, iHeight] := AspecifyColor;
          end
          else
          begin
            AOut.Canvas.Pixels[iWidth, iHeight] :=
              RGB(RGBBitmap.rgbtRed, RGBBitmap.rgbtGreen, RGBBitmap.rgbtBlue);
          end;
        end;

      end;
    end;
  end;

end;

اینم طرز استفاده :
procedure TForm1.btn_RunClick(Sender: TObject);
begin
  Get_SkinColor(img_1.Picture.Bitmap, img_4.Picture.Bitmap { ,true,clWhite { } )
end;

Skin color RGB.JPG
موفق باشید.

----------


## بهروز عباسی

درود به همه
اینم یه نمونه خیلی خوب برای تشخیص پلاک خودرو
حتماً امتحانش کنید

موفق باشید.

----------


## بهروز عباسی

درود 
اینم یک نمونه خوب برای OCR با استفاده از شبکه عصبی.

موفق باشید.

----------


## Mask

> درود 
> اینم یک نمونه خوب برای OCR با استفاده از شبکه عصبی.
> 
> موفق باشید.


 مهندس جون/ مطمئنی این کد ocr هست؟
من کد رو نیگا کردم. قضیه چیز دیگه ای هستا...

----------


## بهروز عباسی

> مهندس جون/ مطمئنی این کد ocr هست؟
> من کد رو نیگا کردم. قضیه چیز دیگه ای هستا...


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

یک یا چند حرفو به شبکه دادم و منتظر شدم تا یاد بگیره بعد همون حروفو توی یک عکس به برنامه دادم اونم تشخیص داد و متن حاوی اون حروفو به من داد.

بازم میگم کدشو مطالعه نکردم.

اگه اشتباه کردم ببخشید. :متفکر:

----------


## بهروز عباسی

درود
بازم یه نمونه از OCR در دلفی 100%.

ocru.JPG
موفق باشید.

----------


## یوسف زالی

دوست من OCR این ها نیست ها!
در OCR مهم ترین فن استفاده از شیکه عصبی هست.
مطمئنی درست کد گذاشتی؟
دارم روی کامپوننتی کار می کنم که استفاده از شبکه عصبی رو آسون می کنه. به امید خدا تموم که شد یک نمونه می گذارم.
در این روش شما، که البته جواب هم می ده، روش مقایسه و امتیاز استفاده شده.
این روش در مقیاس های بزرگ یا نزدیک خیلی کارایی نداره. مثل تشخیص دستخط یا تشخیص چهره یا صدا..

----------


## بهروز عباسی

> دوست من OCR این ها نیست ها!
> در OCR مهم ترین فن استفاده از شیکه عصبی هست.
> مطمئنی درست کد گذاشتی؟
> دارم روی کامپوننتی کار می کنم که استفاده از شبکه عصبی رو آسون می کنه. به امید خدا تموم که شد یک نمونه می گذارم.
> در این روش شما، که البته جواب هم می ده، روش مقایسه و امتیاز استفاده شده.
> این روش در مقیاس های بزرگ یا نزدیک خیلی کارایی نداره. مثل تشخیص دستخط یا تشخیص چهره یا صدا..


درود
ممنون از توجهت

منم نگفتم که اینا حرفه ای هستن :لبخند گشاده!: 

فکر کنم اولی از شبکه استفاده کنه ها !!!

(من این نمونه ها رو صرفاً برای نمونه گذاشتم و نه بیشتر ،متاسفانه وقت هم نکردم که ببینم چه خبره اگه ممکنه خودتون زحمت تحلیل یکیشون رو بکشید.)

----------


## Mask

آقا این پست رو زدم برای تشکر ویژه و اینکه مایوس نشی و ادامه بدی.
خسته نباشی.(اشاره به اون آواتار خسته ام)

----------


## بهروز عباسی

> آقا  این پست رو زدم برای تشکر ویژه و اینکه مایوس نشی و ادامه بدی.
> خسته نباشی.(اشاره به اون آواتار خسته ام)


 خیلی ممنون :لبخند گشاده!: 

گفتی آواتار : باورکن اون موقع تقریباً یک هفته خواب نداشتم هر روز 3 یا 4 ساعت می خوابیدم پوستم کنده شد
اما حالا نه  :لبخند گشاده!: 




> دارم روی کامپوننتی کار می کنم که استفاده از شبکه عصبی رو آسون می کنه. به امید خدا تموم که شد یک نمونه می گذارم.


خدا کنه زودتر تموم بشه  :لبخند گشاده!: 
تاحالا از FANN (Fast Artificial Neural Network Library) توی دلفی استفاده کردید؟؟
یکی از دوستام که تو همین خطه گفت چیز خیلی جالبی اما برای ++C !
کسی چنین چیزی برای Delphi سراغ نداره ؟

----------


## یوسف زالی

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

----------


## بهروز عباسی

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


اون نمونه ای که در پست 15 معرفی کردم شاید کمکت کنه :



> {*************************************************  ******************************
> 
>   Form TTrainingForm
>   ------------------
> 
>   File Name     : TrainingFrm.pas
> 
>   Language      : Delphi 2005
> 
> ...


اونطور که از توضیحاتش معلومه ،بدک نیست

متاسفانه من با شبکه ای عصبی آشنایی زیادی ندارم.
برای OCR کدوم نوع بهتره ،اگه ممکنه در این باره کمی توضیح بدید.

----------


## یوسف زالی

سر فرصت نگاه می ندازم حتما.
اجالتا:
استفاده از شبکه های عصبی "می تونه" در تشخیص الگو بهتر باشه.
ممکنه راههای ساده تر و سریعتری هم باشه، اما شبکه عصبی از نظر یادگیری بهتره.

توضیح اجمالی شبکه عصبی:
همون طور که مغز از نرون ها تشکیل شده، و ارتباط هر نرون با نرون های مجاور تعیین کننده ی تصمیم هست، از طرفی مفهوم حافظه این وسط وجود داره، و در نهایت تشدید کننده و تقلیل دهنده هم موثره، مدلی از برنامه نویسی بوجود اومد که اساس اون رو نرون تشکیل می داد.

هر نرون واحدی هست که یک ورودی به شکل ماتریس می گیره، با توجه به مقدار آستانه ی تحریک (بایاس) بر اساس تابعی که درش تعبیه شده (توابع برای کارهای مختلف فرق داره) اون ماتریس رو نگاشت می کنه به ماتریسی که به خروجی می ره.

یادگیری در این سیستم در حقیقت تغییر اون ماتریس به یک ماتریس جدید هست.
جالبه بدونید که هر داده ای در تمام درایه های ماتریس ذخیره می شه نه فقط یک درایه! چیزی مثل هولوگرام،
مثل عدسی، اگر یک ذره بین بتونه انعکاس شمع رو رو کاغذ درست کنه، نصف عدسی هم می تونه تمام تصویر قبلی رو درست کنه فقط محو تر،
به زبان شبکه های عصبی یعنی اگر ماتریس کوچکتر باشه دقت تشخیص کمتر می شه!!!

ان شا ا... سر فرصت کامل تر می گم.

----------


## بهروز عباسی

بابت توضیحات بالا خیلی ممنون

الان کمی سرچ بازی کردم اینا گیرم امد فکر کنم کمکت کنه (واسه من زوده :کف کرده!: )0
روسی بلیدی ؟؟ منم بلد نیستم ولی خدا یش دم همشون گرم.

*NeuralBase*

*کامپوننت برای کار با شبکه های عصبی درDelphi  نمونه هم داره* ،ولی باید روش کار کنید.
مثلاً یک نمونه از شبکه Hopfield که معمولاً برای تشخیص حروف استفاده میشه همراشه که یه مشکل کوچولو داره .
چند مقاله خوب در مورد Hopfield *

Neural Network Classifier*
*Hopfield model of neural network for pattern recognition*


ا
اینم لینک دانلود FANN برای دلفی
پسوردش : *www.aiportal.ru*


اینم یه مثال ازش (تست نکردم)



موفق باشید و روز خوش
(خودم هم برم کمی در این باره مطالعه کنم :لبخند گشاده!: )

----------


## یوسف زالی

- تکه تکه کردن یک عکس که پرینت آن در یک صفحه جا نمی شود..

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

----------


## بهروز عباسی

درود
اینم یه نمونه ساده برای تشخیص متن (از یک عکس)
خیلی ساده و در بعضی مواقع هم کاربردی

تصویر برنامه قبل از عمل :

Getimage Start.jpg

تصویر برنامه بعد از عمل  :لبخند گشاده!: :
Getimage End.jpg

موفق باشید

----------


## بهروز عباسی

قبلا یه نمونه گذاشته بودم که الان لینکش خرابه و اون نمونه رو فعلاً زوی این سیستم ندارم
اما این هم خوبه :چشمک:

----------


## خاطره گلی

> توسط این کامپوننت و نمونه جالبی که داره
>  شما می تونید با استفاده از وب کم یک شئ متحرک را شناسایی کنید .



سلام چرا نام کاربری من فایلو اکسترکت نمیکنه

----------

