Buchempfehlung
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Umfassend, aber leicht verständlich führt dieses Buch in die Programmierung von ATMEL AVR Mikrocontrollern ein. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

GuiWindow.bi

Uploader:MitgliedOneCypher
Datum/Zeit:13.10.2009 11:05:53
Hinweis: Dieser Quelltext ist Bestandteil des Projekts GuiPtr, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.

#include once "GuiPtr.bi"
#include once "ScrollBar.bi"

type NullWindow
    Object as GuiObject ptr
    BackColor as uinteger = RGB(58,110,165)
    BorderColor as ubyte
    BorderStyle as ubyte
    VScrollbar as Scrollbar ptr
    HScrollbar as Scrollbar ptr
    dX as integer
    dY as integer
    declare sub StartThread()
    declare sub QuitThread()
    declare sub SleepThread(t as integer = 1)
    declare sub ThreadLock()
    declare sub ThreadUnlock()
    Declare function AddVScrollbar() as Scrollbar ptr
    Declare function AddHScrollbar() as Scrollbar ptr

    declare constructor(Title as string = "")
    declare constructor overload(l as integer, t as integer, w as integer, h as integer)
end type

Sub MoveElements(GO as any ptr, e as EventParameter)
    dim w as GuiObjectControl ptr = GO
    dim o as GuiObject ptr = w->GuiObjectPTR
    dim c as GuiObject ptr
    ForEach(c) in(o->ChildObjects)
        if c->FixedPosition = 0 then
            c->left += e.mdx
            c->top += e.mdy
        end if
    NextOne
end sub



Sub CalcInnerSizes(GO as any ptr, e as EventParameter)
    dim nw as NullWindow ptr = go
    Dim Child as GuiObject ptr

    'dim dX as integer
    'dim dY as integer

    dim dXMin as integer
    Dim dYMin as integer

    dim dXMax as integer
    Dim dYMax as integer


    for i as integer = 1 to nw->Object->ChildObjects.Count
        Child = nw->Object->ChildObjects.Item(i)
        if Child->Enabled = 1 then
            if nw->HScrollbar <> 0 then
                if Child->left < dXMin then dXMin = Child->left
                if Child->left + Child->width > nw->Object->Width then dXMax = Child->left + Child->width - nw->Object->Width
            end if
            if nw->VScrollbar <> 0 then
                if Child->top < dYMin then dYMin = Child->top
                if Child->top + Child->Height > nw->Object->Height then dYMax = Child->top + Child->Height - nw->Object->Height
            end if
        end if
    next

    if nw->HScrollBar <> 0 then
        nw->dX = dXMax - dXMin  'Entspricht 100
        nw->HScrollBar->MinValue = dXMin
        nw->HScrollBar->MaxValue = dXMax
        nw->HScrollBar->Value = 0
    end if

    if nw->VScrollBar <> 0 then
        nw->dY = dYMax - dYMin  'Entspricht 100
        nw->VScrollBar->MinValue = dYMin
        nw->VScrollBar->MaxValue = dYMax
        nw->VScrollBar->Value = 0
    end if

    'if nw->VScrollbar <> 0 then
    '    Dump "MinY= " &nw->VScrollBar->MinValue
    '    Dump "MaxY= " &nw->VScrollBar->MaxValue
    '    Dump "   Y= " &nw->VScrollBar->Value
    'else
    '    Dump "NoVScroll"
    'end if
end sub

Sub DragVScrollbar(GO as any ptr, e as EventParameter)
    dim vsb as Scrollbar ptr = go
    dim nw as NullWindow ptr = vsb->Object->Parent->MyObject
    Dim TmpE as EventParameter


    TmpE.mdy = -1* vsb->Value
    MoveElements nw, TmpE
    CalcInnerSizes nw, e
    nw->Object->root->Redraw
end sub


function nullWindow.AddVScrollbar() as Scrollbar ptr
    if VScrollbar = 0 then
        dim vsb as Scrollbar ptr = New Scrollbar(Object->width - 18,0,18,Object->Height - Object->ClientTop)
        vsb->Object->AlwaysOnTop = 1
        vsb->Object->FixedPosition = 1
        vsb->Object->PublicEvents->OnMouseDrag = @ DragVScrollbar
        vsb->Object->PublicEvents->SingleClick = @ DragVScrollbar
        VScrollbar = Object->Add(vsb)
    end if
    return VScrollbar
end function

Sub DragHScrollbar(GO as any ptr, e as EventParameter)
    dim hsb as Scrollbar ptr = go
    dim nw as NullWindow ptr = hsb->Object->Parent->MyObject
    Dim TmpE as EventParameter


    TmpE.mdx = -1* hsb->Value
    MoveElements nw, TmpE
    CalcInnerSizes nw, e
    nw->Object->root->Redraw
end sub

function nullWindow.AddHScrollbar() as Scrollbar ptr
    If HScrollBar = 0 then
        dim hsb as Scrollbar ptr = New Scrollbar(0,Object->Height -18, Object->Width,18)

        hsb->Object->Ignoreclient = 1
        hsb->Object->AlwaysOnTop = 1
        hsb->Object->FixedPosition = 1
        hsb->Object->PublicEvents->OnMouseDrag = @ DragHScrollbar
        hsb->Object->PublicEvents->SingleClick = @ DragHScrollbar
        HScrollbar = Object->Add(hsb)
    end if
    Return HScrollbar
end function


type GuiWindow
    Object as GuiObject ptr
    title as string
    Icon as any ptr
    SafeLeft as integer
    SafeTop as integer
    SafeWidth as integer
    SafeHeight as integer
    maximized as integer
    ForeColor as uinteger = RGB(217,229,242)
    BackColor as uinteger = RGB(212,208,200)
    BorderStyle as integer
    declare sub StartThread()
    declare sub QuitThread()
    declare sub SleepThread(t as integer=1)
    declare sub ThreadLock()
    declare sub ThreadUnlock()
    declare constructor(left as integer, top as integer, w as integer, h as integer, GWindowtitle as string)
    'testvariablen
    mx as integer
    my as integer
end type

Sub GuiWinResize(GO as any ptr, e as EventParameter)
    dim w as GuiObjectControl ptr = GO
    dim o as GuiObject ptr = w->GuiObjectPTR
    dim oldbuffer as any ptr
    o->width  += e.mdx
    o->height += e.mdy
    oldbuffer = o->Buffer
    Imagedestroy o->Buffer
    o->Buffer = imageCreate(o->width+1, o->height +1,RGB(0,0,0))
    o->root->ChangeBuffer oldbuffer, o->Buffer
    o->PrivateEvents->EmitDraw(Go)
end sub

Sub ObjectResize(GO as any ptr, e as EventParameter)
    dim w as GuiObjectControl ptr = GO
    dim o as GuiObject ptr = w->GuiObjectPTR
    dim oldbuffer as any ptr
    o->width  += e.mdx
    o->height += e.mdy
    oldbuffer = o->Buffer
    Imagedestroy o->Buffer
    o->Buffer = imageCreate(o->width+1, o->height +1,RGB(0,0,0))
    o->root->ChangeBuffer oldbuffer, o->Buffer
end sub

Sub GuiWinMove(GO as any ptr, e as EventParameter)
    dim w as GuiObjectControl ptr = GO
    dim o as GuiObject ptr = w->GuiObjectPTR
        o->left += e.mdx
        o->top += e.mdy
end sub

Sub MaximizeWindow(GO as any ptr, e as EventParameter)
    dim w as GuiWindow ptr = GO
    dim as integer sx, sy
    screencontrol 4, sx, sy
    dim oldbuffer as any ptr
    if e.my < 22 then
        if w->maximized then
            w->maximized = 1<>1
            w->object->left = w->SafeLeft
            w->object->Top = w->SafeTop
            w->object->Width = w->SafeWidth
            w->object->Height = w->SafeHeight
            oldbuffer = w->object->buffer
            imagedestroy w->object->buffer
            w->object->Buffer = imagecreate(w->object->Width+1,w->object->Height+1)
        else
            w->maximized = 1<>0
            w->SafeLeft = w->object->left
            w->SafeTop = w->object->Top
            w->SafeWidth = w->object->Width
            w->SafeHeight = w->object->Height
            w->object->left = 0
            if w->object->parent = 0 then
                w->object->Top = 0
                w->object->Width = sx
                w->object->Height = sy
            else
                w->object->Top = w->object->parent->ClientTop
                w->object->Width = w->object->parent->width
                w->object->height = w->object->parent->height - w->object->parent->ClientTop
            end if
            oldbuffer = w->object->buffer
            imagedestroy w->object->buffer
            w->object->Buffer = imagecreate(sx+1,sy+1)
        end if
        w->object->ChangeBuffer oldbuffer, w->object->buffer
        w->object->root->redraw
    end if
end sub

Sub NullWinBehavior(GO as any ptr, e as EventParameter)
    if e.mb = 3 then
        MoveElements GO, e
    end if
end sub

sub GuiWinBehavior(GO as any ptr, e as EventParameter)
    dim w as GuiWindow ptr = GO
    if w->Maximized = 0 then
        if e.mb = 1 then GuiWinMove GO, e
        if e.mb = 2 then GuiWinResize GO, e
        if e.mb = 3 then MoveElements GO, e
    end if
end sub

Sub ReDrawGuiWin(GWindowPTR as any ptr)
    dim w as GuiWindow ptr = GWindowPTR
    with *w
        with *w->Object
            line .buffer, (0,0)-(.width,.height), w->BackColor, BF
            'line .buffer, (0,0)-(.width, 22 ), RGB(166,202,240), BF
            line .buffer, (0,0)-(.width, 22 ), w->ForeColor, BF
            if w->BorderStyle = 0 then line .buffer, (0,0)-(.width,.height), RGB(0,0,0), B

            if w->BorderStyle = 1 then
                line .buffer, (0, 0)-(0 + .width, 0 + .height),RGB(64,64,64),B
                line .buffer, (0, 0)-(0, 0 + .height),RGB(255,255,255)
                line .buffer, (0, 0)-(0 + .width, 0),RGB(255,255,255)
            end if
            'line .buffer, (0,23)-(.width,23), RGB(255,255,255)
            'line .buffer, (0,23)-(0, .height), RGB(255,255,255)
            if w->Icon <> 0 then
                draw string .buffer, (23, 5), w->title,RGB(0,0,0)
                line .buffer, (4,4)-(18, 18),RGB(255,255,255),BF
            else
                draw string .buffer, (6, 5), w->title,RGB(0,0,0)
            end if
        end with
    end with
    'line w->Object->Buffer,(0,0)-(w->mx,w->my),RGB(255,0,0)
end sub


Sub RedrawNullWindow(GO as any ptr)
    dim nw as NullWindow ptr = GO
    with *nw->Object
        line .buffer,(0,0)-(.width,.height),nw->BackColor,BF
        'Dump "Ist:  " & str(nw->BackColor)
        'dump "Soll: " & str(RGB(255,255,255))
        select case nw->BorderStyle
        Case 0
        case 1
            line .buffer, (0, 0)-(0 + .width, 0 + .height),nw->BorderColor,B
        case 2
            line .buffer, (0, 0)-(0 + .width, 0 + .height),RGB(64,64,64),B
            line .buffer, (0, 0)-(0, 0 + .height),RGB(255,255,255)
            line .buffer, (0, 0)-(0 + .width, 0),RGB(255,255,255)
        end select
    end with
end sub


'Threadhandles:

Sub WindowThread(GO as any ptr)
    dim W as NullWindow ptr = GO
    w->Object->Exec
end sub


Sub GuiWindow.QuitThread()
    MutexLock Object->ThreadMutex
    Object->ThreadCancel = 1
    MutexUnLock Object->ThreadMutex
    ThreadWait Object->ThreadID
end sub

sub GuiWindow.ThreadLock()
    mutexlock Object->ThreadMutex
end sub

sub GuiWindow.ThreadUnlock()
    mutexunlock Object->ThreadMutex
end sub

sub GuiWindow.SleepThread(t as integer = 1)
    MutexLock Object->ThreadMutex
    Sleep t
    MutexUnLock Object->ThreadMutex
end sub

Sub GuiWindow.StartThread()
    Object->ThreadID = ThreadCreate(Cast(Any Ptr,@WindowThread), @This)
    Object->ThreadMutex = MutexCreate
end sub

Sub NullWindow.QuitThread()
    MutexLock Object->ThreadMutex
    Object->ThreadCancel = 1
    MutexUnLock Object->ThreadMutex
    ThreadWait Object->ThreadID
end sub

sub NullWindow.ThreadLock()
    mutexlock Object->ThreadMutex
end sub

sub NullWindow.ThreadUnlock()
    mutexunlock Object->ThreadMutex
end sub

sub NullWindow.SleepThread(t as integer = 1)
    MutexLock Object->ThreadMutex
    Sleep t
    MutexUnLock Object->ThreadMutex
end sub

Sub NullWindow.StartThread()
    Object->ThreadID = ThreadCreate(Cast(Any Ptr,@WindowThread), @This)
    Object->ThreadMutex = MutexCreate
end sub


constructor NullWindow(Title as string = "")
    dim as integer sx, sy
    screencontrol 4, sx, sy
    If Title < "" then WindowTitle Title
    Object = new GuiObject(@This)
    with *Object
        .Name = "NullWindow"
        .ClassName = "NullWindow"
        .left = 0
        .top = 0
        .width = sx
        .height = sy
        .PrivateEvents = new Events
        .PrivateEvents->OnDraw = @RedrawNullWindow
        .PrivateEvents->OnMouseDrag = @NullWinBehavior
        .buffer = imagecreate(sx+1,sy+1,RGB(0,0,128))
        .DrawPriority = 10
    end with
end constructor

constructor NullWindow(l as integer, t as integer, w as integer, h as integer)
    Object = new GuiObject(@This)
    with *Object
        .Name = "NullWindow"
        .ClassName = "NullWindow"
        .left = l
        .top = t
        .width = w
        .height = h
        .PrivateEvents = new Events
        .PrivateEvents->OnDraw = @RedrawNullWindow
        .PrivateEvents->OnMouseDrag = @NullWinBehavior
        .buffer = imagecreate(w+1,h+1,RGB(0,0,128))
    end with

    'Controlelements
end constructor

constructor GuiWindow(left as integer, top as integer, w as integer, h as integer, GWindowtitle as string)
    Object = new GuiObject(@This)
    with *Object
        .Name = "GuiWindow"
        .ClassName = "GuiWindow"
        .left = left
        .top = top
        .width = w
        .height = h
        .ClientTop = 23
        .buffer = imagecreate(w+1,h+1)
        .PrivateEvents = new Events
        .DrawPriority = 2
        with *.PrivateEvents
            .OnDraw = @ReDrawGuiWin
            .OnMouseDrag = @GuiWinBehavior
            .DoubleClick = @MaximizeWindow
        end with
    end with

    'Controlelements
    Title = GWindowTitle
end constructor