نمایش نتایج 1 تا 28 از 28

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

  1. #1

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

    درود به همه برنامه نویس های گل

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

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

    موفق باشید.
    آخرین ویرایش به وسیله بهروز عباسی : جمعه 01 دی 1391 در 18:36 عصر
    Everything that has a beginning has an end. ... The End?



  2. #2

    اعمال فیلتر EDGE بر روی عکس

    توسط این توابع می تونید فیلتر 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;


    اینم پروژه.

    موفق باشید.
    آخرین ویرایش به وسیله بهروز عباسی : چهارشنبه 29 آبان 1392 در 22:37 عصر
    Everything that has a beginning has an end. ... The End?



  3. #3

    کامپوننت motiondetec برای تشخیص حرکت (به همراه مثال)


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


    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله بهروز عباسی : چهارشنبه 29 آبان 1392 در 22:40 عصر
    Everything that has a beginning has an end. ... The End?



  4. #4

    تنظیم مقدار روشنایی یک تصویر

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


    ...
    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;


    پروژه
    آخرین ویرایش به وسیله بهروز عباسی : چهارشنبه 29 آبان 1392 در 22:40 عصر
    Everything that has a beginning has an end. ... The End?



  5. #5

    کد و دیکد کردن یک عکس

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



    ...
    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;


    پروژه
    آخرین ویرایش به وسیله بهروز عباسی : چهارشنبه 29 آبان 1392 در 22:42 عصر
    Everything that has a beginning has an end. ... The End?



  6. #6
    کاربر دائمی آواتار MohsenB
    تاریخ عضویت
    اردیبهشت 1387
    محل زندگی
    ایرانم
    پست
    601

    نقل قول: آموزش ها و نمونه برنامه های پردازش تصویر در دلفی

    با سلام

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

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

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

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

  7. #7
    کاربر تازه وارد
    تاریخ عضویت
    تیر 1391
    محل زندگی
    Matrix
    پست
    37

    نقل قول: آموزش ها و نمونه برنامه های پردازش تصویر در دلفی

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

  8. #8

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

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

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

    موفق باشید.
    فایل های ضمیمه فایل های ضمیمه
    Everything that has a beginning has an end. ... The End?



  9. #9

    تشخیص رنگ پوست در فضای RGB

    درود به همه

    الان داشتم نگاهی به گذشته مینداختم (عکس زیر)، یهو زد به سرم یه برنامه بنویسم که رنگ پوست رو توی اون تصویر تشخیص بدم و ناگهان کد زیر پدید آمد.
    (با استفاده از رنگ پوست و کمی کار بیشتر میشه صورت رو توی تصاویر رنگی تشخیص داد امّا برای تشخیص صورت بهتره از فضای رنگ 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);


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


    موفق باشید.
    آخرین ویرایش به وسیله بهروز عباسی : چهارشنبه 29 آبان 1392 در 22:46 عصر
    Everything that has a beginning has an end. ... The End?



  10. #10

    تشخیص پلاک خودرو

    درود به همه

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

    ابتدا
    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

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

    موفق باشید.
    اینم عکس ماشینی که توی نمونه است.
    عکس های ضمیمه عکس های ضمیمه
    • نوع فایل: jpg Car.JPG‏ (20.3 کیلوبایت, 663 دیدار)
    Everything that has a beginning has an end. ... The End?



  11. #11

    تشخیص رنگ پوست در فضای RGB

    درود
    در پست های قبلی کدی برای تشخیص رنگ پوست در فضای 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
    موفق باشید.
    Everything that has a beginning has an end. ... The End?



  12. #12

    تشخیص پلاک خودرو در دلفی

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

    موفق باشید.
    فایل های ضمیمه فایل های ضمیمه
    Everything that has a beginning has an end. ... The End?



  13. #13

    OCR در دلفی

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

    موفق باشید.
    فایل های ضمیمه فایل های ضمیمه
    Everything that has a beginning has an end. ... The End?



  14. #14

    نقل قول: OCR در دلفی

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

    موفق باشید.
    مهندس جون/ مطمئنی این کد ocr هست؟
    من کد رو نیگا کردم. قضیه چیز دیگه ای هستا...
    آخرین ویرایش به وسیله بهروز عباسی : چهارشنبه 29 آبان 1392 در 22:42 عصر


  15. #15

    نقل قول: OCR در دلفی

    نقل قول نوشته شده توسط Gold مشاهده تاپیک
    مهندس جون/ مطمئنی این کد ocr هست؟
    من کد رو نیگا کردم. قضیه چیز دیگه ای هستا...
    والا من هنوز وقت نکردم موشکافیش کنم ببینم چه خبره فقط یکی دوتا تست کردم :

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

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

    اگه اشتباه کردم ببخشید.
    Everything that has a beginning has an end. ... The End?



  16. #16

    OCR در دلفی

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

    موفق باشید.

    فایل های ضمیمه فایل های ضمیمه
    Everything that has a beginning has an end. ... The End?



  17. #17

    نقل قول: آموزش ها و نمونه برنامه های پردازش تصویر در دلفی

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

    دوستای گلم حمایت کنید : https://cafebazaar.ir/app/com.nikanmehr.marmarxword/


    نرم افزار پخش مویرگی

  18. #18

    نقل قول: آموزش ها و نمونه برنامه های پردازش تصویر در دلفی

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

    منم نگفتم که اینا حرفه ای هستن

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

    (من این نمونه ها رو صرفاً برای نمونه گذاشتم و نه بیشتر ،متاسفانه وقت هم نکردم که ببینم چه خبره اگه ممکنه خودتون زحمت تحلیل یکیشون رو بکشید.)
    Everything that has a beginning has an end. ... The End?



  19. #19

    نقل قول: آموزش ها و نمونه برنامه های پردازش تصویر در دلفی

    آقا این پست رو زدم برای تشکر ویژه و اینکه مایوس نشی و ادامه بدی.
    خسته نباشی.(اشاره به اون آواتار خسته ام)
    آخرین ویرایش به وسیله بهروز عباسی : چهارشنبه 29 آبان 1392 در 22:48 عصر


  20. #20

    نقل قول: آموزش ها و نمونه برنامه های پردازش تصویر در دلفی

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

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

    دارم روی کامپوننتی کار می کنم که استفاده از شبکه عصبی رو آسون می کنه. به امید خدا تموم که شد یک نمونه می گذارم.
    خدا کنه زودتر تموم بشه
    تاحالا از FANN (Fast Artificial Neural Network Library) توی دلفی استفاده کردید؟؟
    یکی از دوستام که تو همین خطه گفت چیز خیلی جالبی اما برای ++C !
    کسی چنین چیزی برای Delphi سراغ نداره ؟
    آخرین ویرایش به وسیله بهروز عباسی : چهارشنبه 29 آبان 1392 در 22:48 عصر
    Everything that has a beginning has an end. ... The End?



  21. #21

    نقل قول: آموزش ها و نمونه برنامه های پردازش تصویر در دلفی

    نه ازش استفاده نکردم.
    فعلا دارم رو مفاهیم شبکه دوره می کنم تا خوب یادم بیاد و انواعش و محدودیت هاش رو بدونم.
    عناصرش و کارکرد هاش رو همین طور.
    البته اگر زورم برسه و علمم قد بده ..
    توابع تبدیل تاریخ با دقت 5000 سال
    پذیرش پروژه، کامپوننت، آموزش برنامه نویسی (دلفی، اس کیو ال، ..) -> 09123780840

    دوستای گلم حمایت کنید : https://cafebazaar.ir/app/com.nikanmehr.marmarxword/


    نرم افزار پخش مویرگی

  22. #22

    نقل قول: آموزش ها و نمونه برنامه های پردازش تصویر در دلفی

    نقل قول نوشته شده توسط You-See مشاهده تاپیک
    نه ازش استفاده نکردم.
    فعلا دارم رو مفاهیم شبکه دوره می کنم تا خوب یادم بیاد و انواعش و محدودیت هاش رو بدونم.
    عناصرش و کارکرد هاش رو همین طور.
    البته اگر زورم برسه و علمم قد بده ..
    اون نمونه ای که در پست 15 معرفی کردم شاید کمکت کنه :
    {*************************************************  ******************************

    Form TTrainingForm
    ------------------

    File Name : TrainingFrm.pas

    Language : Delphi 2005

    Author : Theo Zacharias (theo_yz@yahoo.com)

    Description : TTrainingForm is a class form that provide a user interface
    for training the backpropagation neural net.

    Last modified on June 14, 2005

    ************************************************** *****************************}

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

    متاسفانه من با شبکه ای عصبی آشنایی زیادی ندارم.
    برای OCR کدوم نوع بهتره ،اگه ممکنه در این باره کمی توضیح بدید.
    Everything that has a beginning has an end. ... The End?



  23. #23

    نقل قول: آموزش ها و نمونه برنامه های پردازش تصویر در دلفی

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

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

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

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

    ان شا ا... سر فرصت کامل تر می گم.
    عکس های ضمیمه عکس های ضمیمه
    توابع تبدیل تاریخ با دقت 5000 سال
    پذیرش پروژه، کامپوننت، آموزش برنامه نویسی (دلفی، اس کیو ال، ..) -> 09123780840

    دوستای گلم حمایت کنید : https://cafebazaar.ir/app/com.nikanmehr.marmarxword/


    نرم افزار پخش مویرگی

  24. #24

    نقل قول: آموزش ها و نمونه برنامه های پردازش تصویر در دلفی

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

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

    NeuralBase

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

    Neural Network Classifier

    Hopfield model of neural network for pattern recognition


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


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



    موفق باشید و روز خوش
    (خودم هم برم کمی در این باره مطالعه کنم)
    آخرین ویرایش به وسیله بهروز عباسی : پنج شنبه 24 اسفند 1391 در 14:52 عصر
    Everything that has a beginning has an end. ... The End?



  25. #25

    نقل قول: آموزش ها و نمونه برنامه های پردازش تصویر در دلفی

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

    گاهی پیش میاد که تصویری داریم که تو یک پرینت جا نمی شه.
    خب این برنامه رو قدیما نوشته بودم برای همین کار. در حقیقت یک تصویر رو به چند تصویر تکه تکه می کنه.
    با کمی کار روی سورسش چیز جالبی ازش در میاد.
    برنامه خیلی سریع نوشته شده، ممکنه اصول درش خیلی رعایت نشده باشه اما یک ایده می تونه باشه.
    عکس های ضمیمه عکس های ضمیمه
    فایل های ضمیمه فایل های ضمیمه
    توابع تبدیل تاریخ با دقت 5000 سال
    پذیرش پروژه، کامپوننت، آموزش برنامه نویسی (دلفی، اس کیو ال، ..) -> 09123780840

    دوستای گلم حمایت کنید : https://cafebazaar.ir/app/com.nikanmehr.marmarxword/


    نرم افزار پخش مویرگی

  26. #26

    نمونه ای ساده برای تشخیص متن

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

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

    Getimage Start.jpg

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

    موفق باشید
    فایل های ضمیمه فایل های ضمیمه
    Everything that has a beginning has an end. ... The End?



  27. #27

    نمونه برنامه تشخیص چهره

    قبلا یه نمونه گذاشته بودم که الان لینکش خرابه و اون نمونه رو فعلاً زوی این سیستم ندارم
    اما این هم خوبه
    فایل های ضمیمه فایل های ضمیمه
    Everything that has a beginning has an end. ... The End?



  28. #28

    نقل قول: کامپوننت motiondetec برای تشخیص حرکت (به همراه مثال)

    نقل قول نوشته شده توسط بهروز عباسی مشاهده تاپیک

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



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

تاپیک های مشابه

  1. نمونه برنامه های کوچک و مفيد در سي شارپ
    نوشته شده توسط razavi_university در بخش C#‎‎
    پاسخ: 1079
    آخرین پست: جمعه 07 شهریور 1399, 13:32 عصر
  2. نمونه برنامه های کاربردی
    نوشته شده توسط kia1349 در بخش Foxpro
    پاسخ: 298
    آخرین پست: پنج شنبه 07 بهمن 1395, 13:24 عصر

برچسب های این تاپیک

قوانین ایجاد تاپیک در تالار

  • شما نمی توانید تاپیک جدید ایجاد کنید
  • شما نمی توانید به تاپیک ها پاسخ دهید
  • شما نمی توانید ضمیمه ارسال کنید
  • شما نمی توانید پاسخ هایتان را ویرایش کنید
  •