standardpalette.via

用VB6写的真正的32位高级语言可视程序编译器

// StandardPalette.lnl

application PE GUI entry main; 

include "win32a.inc";

const xSteps = 5; const ySteps = 4; 

MSG msg;
RECT rect; 
WNDCLASS wc;
PAINTSTRUCT ps;

string strName[7]; 
string strTitle[24];

dword hWindow;
dword hdc;
dword hPen; 
dword hPenPrevious;
dword hBrush; 
dword hBrushPrevious;
dword i,j; 
dword xSize,ySize;
dword PalIndex; 

frame LoWord(dword dwValue); 
    return(dwValue & $0000FFFF); 
end; 

frame HiWord(dword dwValue); 
    return(dwValue >> 16); 
end;

frame OnSize(dword hwnd, dword message, dword wparam, dword lparam); 
    xSize = LoWord(lparam) / xSteps; 
    ySize = HiWord(lparam) / ySteps; 
    InvalidateRect(hwnd, 0, 1); 
    return(0); 
end; 

frame OnPaint(dword hwnd,dword message,dword wparam,dword lparam); 
    hdc = BeginPaint(hwnd, @ps); 

    j = 0; 
    while (j < ySteps) { 
        i = 0; 
        while (i < xSteps) { 
            PalIndex = j * xSteps + $01000000 + i; 
            hPen = CreatePen(PS_SOLID, 1, PalIndex); 
            hPenPrevious = SelectObject(hdc, hPen); 
            hBrush = CreateSolidBrush(PalIndex); 
            hBrushPrevious = SelectObject(hdc, hBrush); 
            rect.left = i * xSize; 
            rect.top = j * ySize; 
            rect.right = (i + 1) * xSize - 1; 
            rect.bottom = (j + 1) * ySize - 1;
            Rectangle(hdc, rect.left, rect.top, rect.right,rect.bottom); 
            DeleteObject(hPenPrevious); 
            DeleteObject(hBrushPrevious); 
            i++; 
        } 
    j++; 
    }

    EndPaint(hwnd, @ps); 

    return(0); 
end; 

frame OnClose(dword hwnd, dword message, dword wparam, dword lparam); 

    if (MessageBox(hwnd, "Exit application?",
                   strTitle,MB_YESNO|MB_ICONQUESTION) = IDYES) { 
        DestroyWindow(hwnd); 
        return(0); 
    } 
    else { 
        return(1); 
    } 
end; 
    
frame WndProc(dword hwnd, dword message, dword wparam, dword lparam); 
    if (message=WM_SIZE) { 
        return(OnSize(hwnd, message, wparam, lparam)); 
    } 
    
    if (message=WM_PAINT) { 
        return(OnPaint(hwnd, message, wparam, lparam)); 
    } 
    
    if (message = WM_CLOSE) { 
        return(OnClose(hwnd, message, wparam, lparam)); 
    } 
    
    if (message = WM_DESTROY) { 
        PostQuitMessage(0); 
    } 
    
    return(DefWindowProc(hwnd, message, wparam, lparam)); 
end; 

frame main();  
    strTitle = "Standard Palette Colors"; 
    strName = "Color1"; 

    wc.style = CS_HREDRAW + CS_VREDRAW; 
    wc.lpfnWndProc = @WndProc; 
    wc.cbClsExtra = 0; 
    wc.cbWndExtra = 0; 
    wc.hInstance = Instance; 
    wc.hIcon = LoadIcon(0, IDI_APPLICATION); 
    wc.hCursor = LoadCursor(0, IDC_ARROW); 
    wc.hbrBackground = GetStockObject(WHITE_BRUSH); 
    wc.lpszMenuName = ""; 
    wc.lpszClassName = "Color1"; 

    if (RegisterClass(wc) = 0) { 
        MessageBox(0, "RegisterClass failed.", strName, MB_OK); 
        ExitProcess(0); 
    } 

    hWindow = CreateWindowEx($40000 + $100, strName, 
                             strTitle, 
                             $CF0000 + $10000000, _
                             CW_USEDEFAULT, CW_USEDEFAULT, 
                             CW_USEDEFAULT, CW_USEDEFAULT, 
                             0, 0, Instance, 0);

    if (hWindow = 0) { 
        MessageBox(0, "CreateWindowEx failed.", strName,MB_OK); 
        UnregisterClass(strName, Instance); 
        ExitProcess(0); 
    } 

    ShowWindow(hWindow, SW_SHOWNORMAL); 
    UpdateWindow(hWindow); 

    while (GetMessage(@msg, 0, 0, 0) > 0) { 
        TranslateMessage(@msg); 
 
        DispatchMessage(@msg); 
    } 

    UnregisterClass(strName, Instance);
end;