Hallo,
ich habe mal eine Funktion für Sliders gebaut, damit man die nicht immer von hand abfragen muss. Hoffe, sowas gab es noch nicht.
BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN] SeedRnd MilliSecs()
Type ScrollBox_data Field box, panel, ppanel Field x, y, visible_width, visible_height, total_width, total_height, group, style Field slider_h, slider_v Field wheelx, wheely End Type
Function CreateScrollBox(x, y, visible_width, visible_height, total_width, total_height, group, style = 0) ScrollBox.ScrollBox_data = New ScrollBox_data ScrollBox\x = x ScrollBox\y = y ScrollBox\visible_width = visible_width ScrollBox\visible_height = visible_height ScrollBox\total_width = total_width + 15 ScrollBox\total_height = total_height + 15 ScrollBox\group = group ScrollBox\style = style ScrollBox\box = CreatePanel(ScrollBox\x, ScrollBox\y, ScrollBox\visible_width, ScrollBox\visible_height, ScrollBox\group, ScrollBox\style) ScrollBox\ppanel = CreatePanel(0, 0, ClientWidth(ScrollBox\box) - 15, ClientHeight(ScrollBox\box) - 15, ScrollBox\box) ScrollBox\panel = CreatePanel(0, 0, ScrollBox\total_width, ScrollBox\total_height, ScrollBox\ppanel) ScrollBox\slider_h = CreateSlider(0, ClientHeight(ScrollBox\box) - 15, ClientWidth(ScrollBox\box) - 15, 15, ScrollBox\box, 1) ScrollBox\slider_v = CreateSlider(ClientWidth(ScrollBox\box) - 15, 0, 15, ClientHeight(ScrollBox\box) - 15, ScrollBox\box, 2) SetSliderRange ScrollBox\slider_h, ScrollBox\visible_width, ScrollBox\total_width SetSliderRange ScrollBox\slider_v, ScrollBox\visible_height, ScrollBox\total_height If ScrollBox\total_width <= ScrollBox\visible_width HideGadget ScrollBox\slider_h EndIf If ScrollBox\total_height <= ScrollBox\visible_height HideGadget ScrollBox\slider_v EndIf Return ScrollBox\panel End Function
Function UpdateScrollBox(box) For ScrollBox.ScrollBox_data = Each ScrollBox_data If ScrollBox\panel = box ScrollBox = ScrollBox.ScrollBox_data Exit EndIf Next If EventID() = $204 wx = EventData() * ScrollBox\wheelx wy = EventData() * ScrollBox\wheely EndIf SetSliderValue ScrollBox\slider_v, SliderValue(ScrollBox\slider_v) - wy SetSliderValue ScrollBox\slider_h, SliderValue(ScrollBox\slider_h) - wx SetGadgetShape ScrollBox\panel, 0 - SliderValue(ScrollBox\slider_h), 0 - SliderValue(ScrollBox\slider_v), GadgetWidth(ScrollBox\panel), GadgetHeight(ScrollBox\panel) End Function
Function SetScrollBoxWheel(box, direction = 0, value = 0) For ScrollBox.ScrollBox_data = Each ScrollBox_data If ScrollBox\panel = box ScrollBox = ScrollBox.ScrollBox_data Exit EndIf Next If value = 0 Then value = ScrollBox\wheely
ScrollBox\wheelx = GetBit(direction, 0) * value ScrollBox\wheely = GetBit(direction, 1) * value End Function
Function GetScrollBoxWheel(box) For ScrollBox.ScrollBox_data = Each ScrollBox_data If ScrollBox\panel = box ScrollBox = ScrollBox.ScrollBox_data Exit EndIf Next If ScrollBox\wheely Return ScrollBox\wheely ElseIf ScrollBox\wheelx Return ScrollBox\wheelx EndIf End Function
Function SetScrollBoxRange(box, total_width, total_height, visible_width = 0, visible_height = 0) For ScrollBox.ScrollBox_data = Each ScrollBox_data If ScrollBox\panel = box ScrollBox = ScrollBox.ScrollBox_data Exit EndIf Next If visible_width <> 0 Then ScrollBox\visible_width = visible_width If visible_height <> 0 Then ScrollBox\visible_height = visible_width If group <> 0 Then ScrollBox\group = group ScrollBox\total_width = total_width + 15 ScrollBox\total_height = total_height + 15 SetGadgetShape ScrollBox\box, ScrollBox\x, ScrollBox\y, ScrollBox\visible_width, ScrollBox\visible_height SetGadgetShape ScrollBox\ppanel, 0, 0, ClientWidth(ScrollBox\box) - 15, ClientHeight(ScrollBox\box) - 15 SetGadgetShape ScrollBox\panel, 0, 0, ScrollBox\total_width, ScrollBox\total_height SetSliderRange ScrollBox\slider_h, ClientWidth(ScrollBox\box), ScrollBox\total_width SetSliderRange ScrollBox\slider_v, ClientHeight(ScrollBox\box), ScrollBox\total_height If ScrollBox\total_width <= ScrollBox\visible_width HideGadget ScrollBox\slider_h Else ShowGadget ScrollBox\slider_h EndIf If ScrollBox\total_height <= ScrollBox\visible_height HideGadget ScrollBox\slider_v Else ShowGadget ScrollBox\slider_v EndIf End Function
Function GetScrollBoxRange(box, coordinate) For ScrollBox.ScrollBox_data = Each ScrollBox_data If ScrollBox\panel = box ScrollBox = ScrollBox.ScrollBox_data Exit EndIf Next If coordinate = 0 Then Return ScrollBox\total_width If coordinate = 1 Then Return ScrollBox\total_height End Function
Function ScrollBoxGadget(box) For ScrollBox.ScrollBox_data = Each ScrollBox_data If ScrollBox\panel = box ScrollBox = ScrollBox.ScrollBox_data Exit EndIf Next Return ScrollBox\box End Function
Function SetScrollBoxScrolled(box, x, y, style = 0) For ScrollBox.ScrollBox_data = Each ScrollBox_data If ScrollBox\panel = box ScrollBox = ScrollBox.ScrollBox_data Exit EndIf Next If style x = SliderValue(ScrollBox\slider_h) + x y = SliderValue(ScrollBox\slider_v) + y EndIf SetSliderValue ScrollBox\slider_h, x SetSliderValue ScrollBox\slider_v, y SetGadgetShape ScrollBox\panel, 0 - SliderValue(ScrollBox\slider_h), 0 - SliderValue(ScrollBox\slider_v), GadgetWidth(ScrollBox\panel), GadgetHeight(ScrollBox\panel) End Function
Function GetScrollBoxScrolled(box, coordinate = 0) For ScrollBox.ScrollBox_data = Each ScrollBox_data If ScrollBox\panel = box ScrollBox = ScrollBox.ScrollBox_data Exit EndIf Next If coordinate = 0 Then Return SliderValue(ScrollBox\slider_v) If coordinate = 1 Then Return SliderValue(ScrollBox\slider_h) End Function
win = CreateWindow("ScrollBox", 200, 200, 400, 400, Desktop(), 13)
m1 = CreateMenu("Linke ScrollBox", 1, WindowMenu(win)) m2 = CreateMenu("Rechte ScrollBox", 1, WindowMenu(win)) m11 = CreateMenu("Scrollgeschwindigkeit abrufen", 11, m1) m12 = CreateMenu("Scrollgeschwindigkeit ändern", 12, m1) m13 = CreateMenu("Scrollen auf...", 13, m1) CreateMenu("", 0, m1) m14 = CreateMenu("ScrollBox verstecken", 14, m1) m21 = CreateMenu("Scrollgeschwindigkeit abrufen", 21, m2) m22 = CreateMenu("Scrollgeschwindigkeit ändern", 22, m2) m23 = CreateMenu("Scrollen auf...", 23, m2) CreateMenu("", 0, m2) m24 = CreateMenu("ScrollBox verstecken", 24, m2)
UpdateWindowMenu win
Repeat p$ = RequestFile$("Wähle ein Foto!", "jpg,bmp,png") If p$ = "" If Not Confirm("Das Bild ist kein Bild!", 1) End EndIf EndIf Until FileType(p$) = 1
sb1 = CreateScrollBox(5, 5, ClientWidth(win) / 2 - 10, ClientHeight(win) - 10, ImageWidth(LoadImage(p$)), ImageHeight(LoadImage(p$)), win, 1)
picture1 = CreatePanel(0, 0, ImageWidth(LoadImage(p$)), ImageHeight(LoadImage(p$)), sb1) SetPanelImage picture1, p$
repl = CreateButton("Bild neu aussuchen", 5, 5, 100, 25, picture1)
sb2 = CreateScrollBox(ClientWidth(win) / 2, 5, ClientWidth(win) / 2 - 10, ClientHeight(win) - 10, 1060, 310, win) Dim buttons(9, 9)
picture2 = CreatePanel(0, 0, 1060, 310, sb2) For a = 0 To 9 For b = 0 To 9 buttons(a, b) = CreateButton(Chr$(Rand(0, 255)) + Chr$(Rand(0, 255)) + Chr$(Rand(0, 255)), a * 105 + 5, b * 30 + 5, 100, 25, picture2) Next Next
Repeat Select WaitEvent(0) Case $204 UpdateScrollBox sb1 UpdateScrollBox sb2 Case $401 Select EventSource() Case enterb d = Proceed("Welche Richtung?" + Chr$(10) + "Ja = Beide, Vertikal = Nein, Horizontal = Abbrechen") + 2 SetScrollBoxWheel(edited, d, Int(TextFieldText$(enterf))) edited = 0 FreeGadget subwin EnableGadget win ActivateGadget win Case enterb0 SetScrollBoxScrolled(edited, Int(TextFieldText$(enterf1)), Int(TextFieldText$(enterf2))) edited = 0 FreeGadget subwin EnableGadget win ActivateGadget win Case repl Repeat p$ = RequestFile$("Wähle ein Foto!", "jpg,bmp,png") If p$ = "" If Not Confirm("Das Bild ist kein Bild!", 1) End EndIf EndIf Until FileType(p$) = 1 SetScrollBoxRange(sb1, ImageWidth(LoadImage(p$)), ImageHeight(LoadImage(p$))) SetGadgetShape picture1, 0, 0, ImageWidth(LoadImage(p$)), ImageHeight(LoadImage(p$)) SetPanelImage picture1, p$ SetGadgetShape repl, 5, 5, 100, 25 Default For a = 0 To 9 For b = 0 To 9 If buttons(a, b) = EventSource() Notify GadgetText$(buttons(a, b)) + " sagt:" + Chr$(10) + "Autsch! Das tut weh!" EndIf Next Next End Select UpdateScrollBox sb1 UpdateScrollBox sb2 Case $803 End Case $1001 Select EventData() Case 11, 21 If Left$(EventData(), 1) = 1 Then edited = sb1 Else edited = sb2 Notify GetScrollBoxWheel(edited) edited = 0 Case 12, 22 If Left$(EventData(), 1) = 1 Then edited = sb1 Else edited = sb2 DisableGadget win subwin = CreateWindow("Scrollgeschwindigkeit von ScrollBox " + Left$(EventData(), 1) + " ändern", GadgetX(win) + 13, GadgetY(win) + 36, 106, 54, win, 1) enterf = CreateTextField(0, 0, 75, 25, subwin) SetGadgetText enterf, GetScrollBoxWheel(edited) enterb = CreateButton("OK", 75, 0, 25, 25, subwin, 4) ActivateGadget enterf Case 13, 23 If Left$(EventData(), 1) = 1 Then edited = sb1 Else edited = sb2 DisableGadget win subwin = CreateWindow("ScrollBox " + Left$(EventData(), 1) + " scrollen auf...", GadgetX(win) + 13, GadgetY(win) + 36, 106, 54, win, 1) enterf1 = CreateTextField(0, 0, 75 / 2, 25, subwin) enterf2 = CreateTextField(75 / 2, 0, 75 / 2, 25, subwin) SetGadgetText enterf1, GetScrollBoxScrolled(edited, 1) SetGadgetText enterf2, GetScrollBoxScrolled(edited, 0) enterb0 = CreateButton("OK", 75, 0, 25, 25, subwin, 4) ActivateGadget enterf1 Case 14 If Not MenuChecked(m14) CheckMenu m14 HideGadget ScrollBoxGadget(sb1) Else UncheckMenu m14 ShowGadget ScrollBoxGadget(sb1) EndIf UpdateWindowMenu win Case 24 If Not MenuChecked(m24) CheckMenu m24 HideGadget ScrollBoxGadget(sb2) Else UncheckMenu m24 ShowGadget ScrollBoxGadget(sb2) EndIf UpdateWindowMenu win End Select End Select Forever
Function GetBit(byte, bitnumber) ret = byte And 2 ^ bitnumber If ret <> 0 Then ret = 1 Return ret End Function
EDIT: Code aktualisiert.
Download Syntaxhighlighting
Die Strukturierung wird zwar schlecht sein, aber das ist meine erste Veröffentlichung...
Kritik erwünscht (gerne auch per PM, wenn die Postgenehmigung hier abgelaufen ist...)
EDIT: Jetzt werden Scrollbalken ausgeblendet, wenn unnötig, daher also mein Tipp: Sachen, die vlt. gescrollt werden müssen, im Zweifelsfall gleich in eine ScrollBox schreiben. Sieht dann aus wie ein Panel normal.
(PS:) Ach ja, und ohne Pics saug ich nix:
(Verzeiht mir die schlechte Bildqualität )
Mit freundlichen Grüßen,
KnorxThieus
|