Buchempfehlung
MySQL kurz & gut
MySQL kurz & gut
Das preiswerte Taschen- buch stellt MySQL-rele- vante Inhalte systematisch und knapp dar, sodass es sich optimal zum Nach- schlagen beim Pro- grammieren eignet. [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

TextBox.bi

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

#include once "GuiPtr.bi"

Type TextBox
    Object as GuiObject ptr
    Text as string
    BackColor as uinteger = RGB(204,255,204)
    Columns as integer
    declare sub Clear()
    declare constructor(left as integer, top as integer, columns as integer)
    CursorXPos as integer
    TextXScroll as integer
    BlinkTimer as double
end type

Sub TextBox.Clear()
    TextXScroll = 0
    CursorXPos = 0
    Text = ""
end sub


Sub TextBoxTyping(GO as any ptr, e as EventParameter)
    dim t as TextBox ptr = GO
    if e.key <> "" and e.key <> CHR(13) then
        with *t
            .BlinkTimer = Timer
            if len(e.key) > 1 then
                if e.key = CHR(255,71) then .CursorXPos = 0: .TextXScroll = 0
                if e.key = CHR(255,79) then .CursorXPos = len(.text): if len(.text) > .Columns then .TextXScroll = len(.text) - .Columns
                if e.key = CHR(255,75) and .CursorXPos > 0 then .CursorXPos -= 1: if .CursorXPos < .TextXScroll then .TextXScroll -= 1
                if e.key = CHR(255,77) and .CursorXPos < len(.text) then .CursorXPos += 1: if .CursorXPos > .Columns + .TextXScroll then .TextXScroll += 1'.CursorXPos - .Columns
                if e.key = CHR(255,83) and Len(.text) - .CursorXPos > 0 then .Text = left(.Text, .CursorXPos) & right(.Text,len(.Text) - .CursorXPos -1)
            else
                if asc(e.key) = 8 then
                    .Text = left(.Text, .CursorXPos-1) & right(.Text,len(.Text) - .CursorXPos)
                    if .CursorXPos > 0 then .CursorXPos -=1
                    if len(.text) <= .Columns then .TextXScroll = 0
                    if .CursorXPos < .TextXScroll then .TextXScroll -= 1
                else
                    .Text = left(.Text, .CursorXPos) & e.key & right(.Text,len(.Text) - .CursorXPos)
                    .CursorXPos += 1
                    if .CursorXPos > .Columns + .TextXScroll then .TextXScroll += 1
                    'end if
                end if
            end if
        end with
    end if
end sub

Sub TextBoxDrawing(GO as any ptr)
    dim t as TextBox ptr = GO
    dim ShowString as string
    with *t->Object
        Line .buffer, (.left,.top)-(.left+.width,.top+.height),t->BackColor,BF
        Line .buffer, (.left,.top)-(.left+.width,.top+.height),RGB(0,0,0),B

        if len(t->text) > t->Columns then
            ShowString = mid(t->text,t->TextXScroll+1,t->Columns)
        else
            ShowString = t->text
        end if

        Draw string .buffer, (.left +4, .top +3),ShowString, RGB(0,0,0)
        if t->Object = .root->Selection then
            if t->BlinkTimer = 0 then t->BlinkTimer = Timer
            if timer < t->BlinkTimer + 0.5 then
                line .buffer, (.left+ 4 + ((t->CursorXPos - t->TextXScroll)* 8),.top +3)-(.left +4 + ((t->CursorXPos - t->TextXScroll)* 8),.top + 17),RGB(0,0,0)
            else
                if timer > t->BlinkTimer +1 then t->BlinkTimer = timer
            end if
        end if
    end with
end sub

Constructor TextBox(left as integer, top as integer, ColumnsCount as integer)
    Object = new GuiObject(@This)
    With *Object
        .ClassName = "TextBox"
        .left = left
        .top = top
        .width = ColumnsCount * 8 +7
        .height = 20
        .PrivateEvents = new Events
        .PrivateEvents->OnKeyPress  = @TextBoxTyping
        .PrivateEvents->OnDraw = @TextBoxDrawing
    end with
    Columns = ColumnsCount
end constructor