vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
NEU! sevCoolbar 3.0 - Professionelle Toolbars im modernen Design!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2025
 
zurück

 Sie sind aktuell nicht angemeldet.Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Allgemeine Diskussionen
Re: Kool 
Autor: unbekannt
Datum: 31.03.03 18:52

Hi E7,

jepp. User32 und GDI32.

hier ist der Quellcode für "Kool"

'==============================================================================
'
'  KOOL.BAS SDK graphics example for PowerBASIC for Windows PB/WIN 7.0
'  Copyright (c) 1999-2002 PowerBASIC, Inc.
'  All Right Reserved.
'
'  Uses a 30mSec Timer to do the drawing updates, and uses less than 1% of the
'  processor time (as measured on an AMD K6-266/64Mb/1Mb S3 Trio video card)
'
'==============================================================================
 
 
#DIM ALL
#COMPILE EXE
#INCLUDE "WIN32API.INC"
 
 
'------------------------------------------------------------------------------
' GUI Window class name (must be unique).  We'll use it for the title too.
'
$ClassName = "PB/WIN Simple Graphics Demo #2"
 
 
'------------------------------------------------------------------------------
' Main program entry point...
'
FUNCTION WINMAIN (BYVAL hInstance     AS LONG, _
                  BYVAL hPrevInstance AS LONG, _
                  BYVAL lpCmdLine     AS ASCIIZ PTR, _
                  BYVAL iCmdShow      AS LONG) AS LONG
 
    LOCAL Msg         AS tagMsg
    LOCAL wce         AS WndClassEx
    LOCAL szClassName AS ASCIIZ * 80
    LOCAL hWnd        AS DWORD
    LOCAL hTimer      AS DWORD
 
    szClassName       = $ClassName
 
    wce.cbSize        = SIZEOF(wce)
    wce.style         = %CS_HREDRAW OR %CS_VREDRAW
    wce.lpfnWndProc   = CODEPTR( WndProc )
    wce.cbClsExtra    = 0
    wce.cbWndExtra    = 0
    wce.hInstance     = hInstance
    wce.hIcon         = LoadIcon( hInstance, "PROGRAM" )
    wce.hCursor       = LoadCursor( %NULL, BYVAL %IDC_ARROW )
    wce.hbrBackground = GetStockObject( %BLACK_BRUSH )
    wce.lpszMenuName  = %NULL
    wce.lpszClassName = VARPTR(szClassName)
    wce.hIconSm       = LoadIcon( hInstance, BYVAL %IDI_APPLICATION )
 
    RegisterClassEx wce
 
    ' Create a window using the registered class
    hWnd = CreateWindowEx(0, _                      ' extended Window style
                          $ClassName, _             ' window class name
                          $ClassName, _             ' window caption
                          %WS_OVERLAPPEDWINDOW, _   ' window style
                          %CW_USEDEFAULT, _         ' initial x position
                          %CW_USEDEFAULT, _         ' initial y position
                          %CW_USEDEFAULT, _         ' initial x size
                          %CW_USEDEFAULT, _         ' initial y size
                          %HWND_DESKTOP, _          ' parent window handle
                          BYVAL %NULL, _            ' window menu handle
                          hInstance, _              ' program instance handle
                          BYVAL %NULL)              ' creation parameters
 
    ShowWindow hWnd, iCmdShow
    UpdateWindow hWnd
 
    ' Create a timer event every 30 mSec
    hTimer = SetTimer(hWnd, 0, 30, BYVAL %NULL)
 
    DO WHILE GetMessage(Msg, %NULL, 0, 0)
        TranslateMessage Msg
        DispatchMessage Msg
    LOOP
 
    ' Destroy the timer
    KillTimer hWnd, 0
 
    FUNCTION = msg.wParam
 
END FUNCTION
 
 
 
FUNCTION WndProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
                  BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG
 
    LOCAL Rct      AS RECT
    LOCAL PS       AS PAINTSTRUCT
    LOCAL hDC      AS DWORD
 
    STATIC hOldPen AS DWORD
    STATIC x1      AS LONG
    STATIC x2      AS LONG
    STATIC y1      AS LONG
    STATIC y2      AS LONG
    STATIC z1      AS LONG
    STATIC z2      AS LONG
    STATIC c1      AS LONG
    STATIC c2      AS LONG
 
    STATIC co1     AS LONG
 
    STATIC xd1     AS LONG
    STATIC xd2     AS LONG
    STATIC yd1     AS LONG
    STATIC yd2     AS LONG
    STATIC zd1     AS LONG
    STATIC zd2     AS LONG
    STATIC cd1     AS LONG
    STATIC cd2     AS LONG
 
    STATIC iOk     AS LONG
    STATIC count   AS LONG
 
    SELECT CASE wMsg
 
    CASE %WM_CREATE
        DIM pt(13)  AS STATIC POINTAPI
 
        DIM x1(40) AS STATIC LONG
        DIM y1(40) AS STATIC LONG
 
        DIM x2(40) AS STATIC LONG
        DIM y2(40) AS STATIC LONG
 
        DIM z1(40) AS STATIC LONG
        DIM z2(40) AS STATIC LONG
 
        DIM c1(40) AS STATIC LONG
        DIM c2(40) AS STATIC LONG
 
        RANDOMIZE
 
        GetClientRect hWnd, Rct
        x1 = RND(10, Rct.nRight - 10)
        x2 = RND(10, Rct.nRight - 10)
        y1 = RND(10, Rct.nBottom - 10)
        y2 = RND(10, Rct.nBottom - 10)
 
        z1 = RND(10, Rct.nRight - 10)
        c1 = RND(10, Rct.nRight - 10)
        z2 = RND(10, Rct.nBottom - 10)
        c2 = RND(10, Rct.nBottom - 10)
 
        xd1 = 9
        xd2 = 7
        yd1 = 6
        yd2 = 10
        zd1 = 2
        zd2 = 2
        cd1 = -2
        cd2 = -2
 
        iOk = -1
        EXIT FUNCTION
 
    CASE %WM_SIZE
        iOk = 0
        InvalidateRect hWnd, BYVAL %NULL, %TRUE
        SendMessage hWnd, %WM_CREATE, 0, 0
        EXIT FUNCTION
 
    CASE %WM_SYSCOMMAND
        IF wParam = %SC_CLOSE THEN
            DestroyWindow hWnd
            EXIT FUNCTION
        END IF
 
    CASE %WM_PAINT
        IF ISFALSE iOk THEN
            EXIT SELECT
        END IF
 
        hDC = BeginPaint(hWnd, PS)
 
        ARRAY DELETE x1(1)
        ARRAY DELETE x2(1)
        ARRAY DELETE y1(1)
        ARRAY DELETE y2(1)
        ARRAY DELETE z1(1)
        ARRAY DELETE z2(1)
        ARRAY DELETE c1(1)
        ARRAY DELETE c2(1)
 
        hOldPen = SelectObject(hDC, CreatePen(%PS_SOLID, 1, co1))
 
        pt(1).x = z1 : pt(1).y = z2
        pt(2).x = z1 : pt(2).y = z2
        pt(3).x = x2 : pt(3).y = y2
 
        pt(4).x = c1 : pt(4).y = c2
        pt(5).x = c1 : pt(5).y = c2
        pt(6).x = x1 : pt(6).y = y1
 
        MoveToEx hDC, x1, y1, BYVAL %NULL
        PolyBezierTo hDC, pt(1), 6
 
        DeleteObject SelectObject(hDC, GetStockObject(%BLACK_PEN))
        pt(1).x = z1(1) : pt(1).y = z2(1)
        pt(2).x = z1(1) : pt(2).y = z2(1)
        pt(3).x = x2(1) : pt(3).y = y2(1)
 
        pt(4).x = c1(1) : pt(4).y = c2(1)
        pt(5).x = c1(1) : pt(5).y = c2(1)
        pt(6).x = x1(1) : pt(6).y = y1(1)
        MoveToEx hDC, x1(1), y1(1), BYVAL %NULL
        PolyBezierTo hDC, pt(1), 6
 
        DeleteObject SelectObject(hDC, hOldPen)
 
        EndPaint hWnd, PS
        EXIT FUNCTION
 
    CASE %WM_TIMER
        IF ISFALSE iOk THEN
            EXIT SELECT
        END IF
 
        IF count < 1 THEN
            co1 = RGB(29 + RND(1, 225), 29 + RND(1, 225), 29 + RND(1, 225))
            count = 200
        END IF
 
        DECR count
 
        GetClientRect hWnd, Rct
        InvalidateRect hWnd, BYVAL %NULL, %FALSE
        UpdateWindow hWnd
 
        x1(40) = x1
        x2(40) = x2
        y1(40) = y1
        y2(40) = y2
        z1(40) = z1
        z2(40) = z2
        c1(40) = c1
        c2(40) = c2
 
        x1 = x1 + xd1
        x2 = x2 + xd2
        y1 = y1 + yd1
        y2 = y2 + yd2
        z1 = z1 + zd1
        z2 = z2 + zd2
        c1 = c1 + cd1
        c2 = c2 + cd2
 
        IF (x1 < 1) OR (x1 >= Rct.nRight - 1) OR (RND(1, 100) = 5) THEN
            xd1 = -xd1
        END IF
 
        IF (x2 < 1) OR (x2 >= Rct.nRight - 1) OR (RND(1, 100) = 5) THEN
            xd2 = -xd2
        END IF
 
        IF (z1 < 1) OR (z1 >= Rct.nRight - 1) OR (RND(1, 100) = 5) THEN
            zd1 = -zd1
        END IF
 
        IF (c1 < 1) OR (c1 >= Rct.nRight - 1) OR (RND(1, 100) = 5) THEN
            cd1 = -cd1
        END IF
 
        IF (y1 < 1) OR (y1 >= Rct.nBottom - 1) OR (RND(1, 100) = 5) THEN
            yd1 = -yd1
        END IF
 
        IF (y2 < 1) OR (y2 >= Rct.nBottom - 1) OR (RND(1, 100) = 5) THEN
            yd2 = -yd2
        END IF
 
        IF (z2 < 1) OR (z2 >= Rct.nBottom - 1) OR (RND(1, 100) = 5) THEN
            zd2 = -zd2
        END IF
 
        IF (c2 < 1) OR (c2 >= Rct.nBottom - 1) OR (RND(1, 100) = 5) THEN
            cd2 = -cd2
        END IF
 
        EXIT FUNCTION
 
    CASE %WM_DESTROY
        PostQuitMessage 0
        EXIT FUNCTION
 
    END SELECT
 
    FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
 
END FUNCTION
0
alle Nachrichten anzeigenGesamtübersicht  |  Zum Thema  |  Suchen

 ThemaViews  AutorDatum
Programme ohne dll's294MalermeisterBernd28.03.03 17:21
Re: Programme ohne dll's521Elwood28.03.03 17:39
Jepp, das EINZIGE was keine Runtimes benötigt. (oT)539unbekannt28.03.03 18:52
Kleine Demo ... (oT)512unbekannt28.03.03 18:58
Echt cool, Lordchen (oT)466ModeratorMoni28.03.03 19:29
muss ich auch sagen 443palooka28.03.03 20:35
Wenn Interesse daran besteht, wie so was gemacht wird,537unbekannt29.03.03 20:26
Re: Programme ohne dll's125Lars28.03.03 18:42
Re: Programme ohne dll's449unbekannt28.03.03 18:47
Re: Programme ohne dll's101Lars28.03.03 23:43
Re: Programme ohne dll's96MalermeisterBernd29.03.03 07:19
Re: Programme ohne dll's460Hubkabel29.03.03 11:35
Re: Programme ohne dll's520Kinman29.03.03 23:48
Kool600E729.03.03 12:44
Re: Kool465unbekannt29.03.03 13:16
Re: Kool464Elwood29.03.03 18:11
Re: Kool455E730.03.03 00:53
Re: Kool419unbekannt30.03.03 01:23
Re: Kool479E731.03.03 13:57
Re: Kool518unbekannt31.03.03 18:52
Re: Kool674E701.04.03 20:17
Re: Kool491unbekannt01.04.03 20:32
Re: Kool441E703.04.03 20:01
Re: Kool418unbekannt03.04.03 20:06
Re: Kool460E706.04.03 12:33
Re: Programme ohne dll's97Heinz_29.03.03 19:37
Re: Programme ohne dll's80MalermeisterBernd31.03.03 10:41
Re: Programme ohne dll's444kane189631.03.03 14:05

Sie sind nicht angemeldet!
Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.

Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  GesamtübersichtSuchen 

nach obenzurück
 
   

Copyright ©2000-2025 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel