Vẽ vời bằng Excel

[kuldokk]

Đã có ai thử vẽ/ tô màu trong Excel thế này chưa ạ ?

[video=youtube;Wh39kjDV81Y]https://www.youtube.com/watch?v=Wh39kjDV81Y[/video]

 

[vietapp]

Một khung hình có kích cỡ 320x480 mà render hết hơn một phút. Nếu mà dung để diễn hoạt hình thì sao nhỉ?

 

[ndu96081631]

Đã có ai thử vẽ/ tô màu trong Excel thế này chưa ạ ?

Bạn định chia sẻ điều gì đây? Hay muốn nói rằng chỉ bạn biết làm điều này và có ý muốn khoe?

 

[kuldokk]

Chào bác,
Em không nói là em biết làm

 

[kuldokk]

Một khung hình có kích cỡ 320x480 mà render hết hơn một phút. Nếu mà dung để diễn hoạt hình thì sao nhỉ?

Dùng để diễn hoạt hình 8-bit được đấy bạn )

 

[ndu96081631]

Chào bác,
Em không nói là em biết làm

Thật ra vấn đề này trên diễn đàn người ta đã làm từ lâu rồi. Bạn có thể search từ khóa SCAN PIC để biết
Nếu bạn đưa code bạn đã làm lên đây thì chúng ta còn có chuyện để bàn, nhưng với 1 file video thì bạn nghĩ xem có ai biết nó đã được làm như thế nào không?
Tôi cho đó không phải là "chia sẻ", gọi đó là gì thì chỉ có bạn tự biết thôi

 

[kuldokk]

Thật ra vấn đề này trên diễn đàn người ta đã làm từ lâu rồi. Bạn có thể search từ khóa SCAN PIC để biết
Nếu bạn đưa code bạn đã làm lên đây thì chúng ta còn có chuyện để bàn ...

Chào bác, chuyện quan trọng nói trước, cảm ơn bác đã nói đến từ khoá SCAN PIC.

1. Vì trong video, ý tưởng chỉ là vẽ lại 1 bức tranh tĩnh, không có chuyển dộng gì hết, nên có thể lấy được bức ảnh có độ phân giải tương đối lớn. Phần lấy code màu của 1 bức ảnh, em dùng JavaScript, và chương trình chạy trong trình duyệt Chrome. Trong phần này, bức ảnh có thể được làm nhoè đi ( hiệu ứng Pixelate). có thể điều chỉnh được độ nhoè từ 1 - 100 (Nhoè để tạo 8-bit artwork). Thông tin về màu dưới dạng RGB sẽ được ghi ra 1 Textbox. Copy, paste dữ liệu này vào 1 Sheet trong Excel và sử dụng VBA với 2 vòng lặp qua Sheets đó và tô màu tương tự ta sẽ có được hình ảnh như trên.

--> về ý tưởng thì gần như tương tự như các chủ đề liên quan đến SCAN PIC

Sub run()
    For i = 1 To 320
        For j = 1 To 480
            c = Split(ActiveWorkbook.Sheets(1).Cells(i, j), ",")
            ActiveWorkbook.Sheets(2).Cells(i, j).Interior.Color = RGB(c(0), c(1), c(2))
        Next j
    Next iEnd Sub
Sub resizeGrid()
    ActiveWorkbook.Sheets(2).Columns("A:RL").ColumnWidth = 1
    ActiveWorkbook.Sheets(2).Rows("1:320").RowHeight = 9
End Sub

function getImg() {
    img.onload = function () {
        demo.width = img.width;
        demo.height= img.height;
        init();
        pixelate();
    }
    img.src = document.getElementById('image-url').value;
}
 var ctx = demo.getContext('2d'),
    img = new Image,
    value = factor.value,
    color = [],
    text = '',
    count = 0,
    progress = 0;
 var fw, fh, w, h, x, y, p;
 img.crossOrigin = 'http://profile.ak.fbcdn.net/crossdomain.xml';
 var totalCell = 0;
 function init() {
    value = document.getElementById('factor').value
     w = img.width;    h = img.height;     /// calculate the factor
    fw = (img.width / value)|0,
    fh = (img.height / value)|0;
     x = w/(2*fw);
    y = h/(2*fh);
     totalCell = fw*fh;
     /// turn off image smoothing (prefixed in some browsers)
    ctx.imageSmoothingEnabled =
    ctx.mozImageSmoothingEnabled =
    ctx.msImageSmoothingEnabled =
    ctx.webkitImageSmoothingEnabled = false;
     document.getElementsByTagName('p')[0].innerHTML = "Dimension: " + fw + " by " + fh;
     }
 function pixelate() {
    var i = 0;
     var j = 0;
          ctx.drawImage(img, 0, 0, fw, fh);
    ctx.drawImage(demo, 0, 0, fw, fh, 0, 0, img.width, img.height);
         var loop = setInterval(function() {
        count ++;
         if(j == fw ) {
            j = 0;
            text += '\n';
            i++;
        }
         if(i == fh) {
            clearInterval(loop);
            document.getElementsByTagName('textarea')[0].innerHTML = text;
        }        p = ctx.getImageData(x + j * 2 * x, y + i * 2 * y, 1, 1).data;
        text += p[0] + ',' + p[1] + ',' + p[2] + '\t';
                 progress = Math.floor((count/totalCell) * 100);
        document.getElementsByTagName('h3')[0].innerHTML = progress + ' %';
        j++;    },1);}

2. Ngoài ra thì còn 1 phiên bản đi "scan ảnh" bằng Python rồi ghi dữ liệu ra file txt, sau đó dữ liệu này sẽ dùng làm dữ liệu màu cho animation.

Đầu tiên, dùng ffmpeg để trích ra key frames trong 1 đoạn video (9 trong trường hợp này):

ffmpeg -i video.mp4 -r 9 -f image2 images%05d.png

Code dùng để lấy thông tin về các điểm ảnh:

from PIL import Image
def chunks(l, n):
    if n < 1:
        n = 1
    return [l[i:i + n] for i in range(0, len(l), n)]
for i in range(1,10):
    pix_val = list(Image.open("images0000" + str(i) + ".png",'r').getdata())
    pix_val = chunks([",".join(str(x) for x in l) for l in pix_val],14)
    pix_val = "\n".join(["\t".join(c) for c in pix_val])
    text_file = open("images0000" + str(i) + ".txt","w")
    text_file.write(pix_val)
    text_file.close()
print "done"

Kết quả bác có thể xem qua trong file excel đính kèm.

Ngoài ra thì Subroutine sẽ giúp chúng ta đạt được kết quả tương tự nhưng không phải dùng thêm ngôn ngữ lập trình ngoài, chỉ dùng VBA.

Sub LoadImageIntoExcel()        Me.Activate        Dim strFileName     As String        Dim bmpFileHeader   As BITMAPFILEHEADER    Dim bmpInfoHeader   As BITMAPINFOHEADER    Dim ExcelPalette()  As PALETTE    Dim Palette24       As PALETTE24Bit        Dim i               As Integer    Dim r As Integer, c As Integer    Dim dAdjustedWidth  As Double    Dim Padding         As Byte
       AutoSize    On Error GoTo CloseFile    strFileName = Application.GetOpenFilename
    Open strFileName For Binary As #1            Get #1, , bmpFileHeader    Get #1, , bmpInfoHeader

    If bmpInfoHeader.lngWidth Mod 4 > 0 Then        dAdjustedWidth = (((Int((bmpInfoHeader.lngWidth * bmpInfoHeader.intBitCount) / 32) + 1) * 4#)) / _                            (bmpInfoHeader.intBitCount / 8#)
        If dAdjustedWidth Mod 4 <> 0 Then dAdjustedWidth = Application.RoundUp(dAdjustedWidth, 0)
    Else        dAdjustedWidth = bmpInfoHeader.lngWidth    End If        If bmpInfoHeader.intBitCount <= 8 Then        ReDim ExcelPalette(0 To 255)        
        For i = 0 To UBound(ExcelPalette)            Get #1, , ExcelPalette(i)        Next i                            Dim bytPixel As Byte                For r = 1 To bmpInfoHeader.lngHeight            For c = 1 To dAdjustedWidth                                If c <= bmpInfoHeader.lngWidth Then                    Get #1, , bytPixel                    Me.Cells(bmpInfoHeader.lngHeight + 1 - r, c).Interior.Color = _                    RGB(ExcelPalette(bytPixel).red, _                        ExcelPalette(bytPixel).green, _                        ExcelPalette(bytPixel).blue)                    DoEvents                Else                    Get #1, , Padding                    Me.Cells(bmpInfoHeader.lngHeight + 1 - r, c).Interior.Color = _                        RGB(255, 255, 255)                End If                

            Next c        Next r            Else                    For r = 1 To bmpInfoHeader.lngHeight            For c = 1 To dAdjustedWidth                                If c <= bmpInfoHeader.lngWidth Then                    Get #1, , Palette24                    Me.Cells(bmpInfoHeader.lngHeight + 1 - r, c).Interior.Color = _                        RGB(Palette24.red, _                            Palette24.green, _                            Palette24.blue)                Else                    Get #1, , Padding                    Me.Cells(bmpInfoHeader.lngHeight + 1 - r, c).Interior.Color = _                        RGB(255, 255, 255)                End If                DoEvents            Next c        Next r            End If    
    MsgBox "File loaded - program complete."
CloseFile:    If Len(Err.Description) > 0 Then MsgBox Err.Description    Close #1
End Sub

Type BITMAPFILEHEADER    strFileType     As String * 2    lngFileSize     As Long    bytReserved1    As Integer    bytResrved2     As Integer    lngBitmapOffset As LongEnd Type
Type BITMAPINFOHEADER    lngSize             As Long    lngWidth            As Long    lngHeight           As Long    lngPlanes           As Integer    intBitCount         As Integer    lngCompression      As Long    lngSizeImage        As Long    lngXPelsPerMeter    As Long    lngYPelsPerMeter    As Long    lngClrUsed          As Long    lngClrImportant     As LongEnd Type
Type PALETTE    blue        As Byte    green       As Byte    red         As Byte    reserve     As ByteEnd Type    Type PALETTE24Bit    blue        As Byte    green       As Byte    red         As ByteEnd Type

3.

... , nhưng với 1 file video thì bạn nghĩ xem có ai biết nó đã được làm như thế nào không?

Có, những người xem video và bật video Annotations biết.

Chúc bác 1 tuần mới vui vẻ

 

[yeucuocsong78]

Excel mà làm được thế này, quá khâm phục.