Abfrage des Mausklicks

Anfängerfragen zum Programmieren mit PureBasic.
Benutzeravatar
Falko
Admin
Beiträge: 3535
Registriert: 29.08.2004 11:27
Computerausstattung: PC: MSI-Z590-GC; 32GB-DDR4, ICore9; 2TB M2 + 2x3TB-SATA2 HDD; Intel ICore9 @ 3600MHZ (Win11 Pro. 64-Bit),
Acer Aspire E15 (Win11 Home X64). Purebasic LTS 6.11b1
HP255G8 Notebook @AMD Ryzen 5 5500U with Radeon Graphics 2.10 GHz 3.4GHz, 32GB_RAM, 3TB_SSD (Win11 Pro 64-Bit)
Kontaktdaten:

Beitrag von Falko »

Brügge hat geschrieben:> das problem mit der Maus habe ich schon behoben

nur für screen, nicht für fenster.


ich kann nur screen programmieren (habe mich noch nicht mit den fenstern beschäftigt (finde screens in ordnung).


ich würde eher ne liste nehmen.
ja ne liste ist gut ich kann allerdings mit PB nur array machen KA wie listen gehen.
man kann ja auch einen großen arrey nehmen

dim line(1000,2)

ist auch wie ne liste ^^


naja also Dieter ich kann dir nur bei screens helfen :allright: musst du wissen wie dein programm werden soll. :wink:

MFG
>> ich kann nur screen programmieren (habe mich noch nicht mit den fenstern beschäftigt (finde screens in ordnung).

Stimmt, wegen der Demoversion. Um die WindowsAPI-Funktionen im
obigen Beispiel zu nutzen, müßtest du die gdi32.dll und die user32.dll
mit folgenden funktionen erst einmal laden:

OpenLibrary(0,"user32.dll")
OpenLibrary(1,"gdi32.dll")

dann die betreffende Funktion mit z.B CallFunction(0,"GetDC",hwnd.l) aufrufen. Noch besser, wäre es all die API_ -Befehle in Proceduren
zu schreiben, so das man direkt den Namen wie z.B. GetDC nutzen kann.
Der APIViewer ist dazu eine gute Hilfe.

Damit könntest du dann auch Windowsapplikationen mit API's erstellen und testen.

Sieht dann nicht so aus wie ein screen aus DOS, was nur Grafik kann :mrgreen:

Das gleiche (fast) könnte ich auch mit GFA-Basic für DOS progen und
habe zudem auch Menüs, Dialoge in DOS zur Verfügung.

Könnte man 16Bit-DLL's vom GFA für Windows in PB nutzen, hätte ich schon lange angefangen aus GFA die vielen fertigen und komfortablen Windowsgrafikfunktionen für PB zu wrappen :lol: .
Aber leider ist auch das nicht möglich.

Grüße Falko
Bild
Win11 Pro 64-Bit, PB_6.11b1
Benutzeravatar
GreyEnt
Beiträge: 376
Registriert: 20.07.2006 19:41

Vielen Dank für all die Beiträge

Beitrag von GreyEnt »

Hab nun mal den Code reingestellt.
Ursprünglich kommt es aus der 2DDrawing Examples.

Die Funtionen bislang.

Linien Kreise Bögen erstellen dur eingabe der Koordinaten.
Laden von dateien *.CAD *.DXF (Version ACAD10)
Speichern in *.CAD
Ansicht schieben mit Pfeiltasten.
Highliten wenn sich Maus über Linie befindet. Muss Pixelgenau treffen.

Über komentare würde ich mich freuen.

MfG
Dieter

Code: Alles auswählen

;
; ------------------------------------------------------------
;
;   VARICAD
;   xy-CAD
;   Geometrie Editor
;   The Incredible CAD
;
;   geschrieben in PureBasic 3.92
;   Juni 2006
;   von Dieter Platzke
;   platzke@muenster.de
;
; ------------------------------------------------------------
;
Global pi.f, winkelgrad.f, quit.b,anzeigex1.l, anzeigey1.l, anzeigex2.l, anzeigey2.l, ladedatei$, aktivelement.l
pi=3.14159265 : winkelgrad=pi/180 :quit=0
anzeigex1.l=400: anzeigey1=300: anzeigex2.l=800: anzeigey2=600
gz.l=160    ;Zeile für freie gadgets
aobjekt.l=0 ;Aktuelles Objekt für Eigenschaftsfenster
farbe.l=0
cursorblau.l=0
cursorgruen.l=0
cursorrot.l=0

Structure bogen
  zentrumx.f
  zentrumy.f
  radius.f
  startwinkel.f
  endwinkel.f
EndStructure
Structure kreis
  zentrumx.f
  zentrumy.f
  radius.f
EndStructure
Structure linie
  startx.f
  starty.f
  endx.f
  endy.f
EndStructure
Structure punkt
  x.f
  y.f  
EndStructure
Structure dreieck
  startx.f
  starty.f
  liniec.f
  liniea.f
  linieb.f
EndStructure
Structure vieleck
  zentrumx.f
  zentrumy.f
  kantenzahl.w
  kantenlaenge.f
EndStructure
Structure elipse
  zentrumx.f
  zentrumy.f
  radius1.f
  radius2.f
EndStructure
Structure limiten ;ohne Nutzen
limxmin.f
limxmax.f
limymin.f
limymax.f
EndStructure


NewList bo.bogen()
NewList kr.kreis()
NewList li.linie()
NewList pu.punkt()
NewList dr.dreieck()
NewList vi.vieleck()
NewList el.elipse()
NewList lim.limiten()

Procedure limiten()
;FirstElement(lim())
FirstElement(kr())
If CountList(kr())>0
xmin.f=kr()\zentrumx-kr()\radius
xmax.f=kr()\zentrumx+kr()\radius
ymin.f=kr()\zentrumy-kr()\radius
ymax.f=kr()\zentrumy+kr()\radius
For b.l = 1 To CountList(kr())
If kr()\zentrumx-kr()\radius<xmin
xmin=kr()\zentrumx-kr()\radius
EndIf
If kr()\zentrumx+kr()\radius>xmax
xmax=kr()\zentrumx+kr()\radius
EndIf
If kr()\zentrumy-kr()\radius<ymin
ymin=kr()\zentrumy-kr()\radius
EndIf
If kr()\zentrumy+kr()\radius>ymax
ymax=kr()\zentrumx+kr()\radius
EndIf
NextElement(kr())
Next
EndIf

If CountList(bo())>0
FirstElement(bo())
For b.l = 1 To CountList(bo())
If bo()\zentrumx-bo()\radius<xmin
xmin=bo()\zentrumx-bo()\radius
EndIf
If bo()\zentrumx+bo()\radius>xmax
xmax=bo()\zentrumx+bo()\radius
EndIf
If bo()\zentrumy-bo()\radius<ymin
ymin=bo()\zentrumy-bo()\radius
EndIf
If bo()\zentrumy+bo()\radius>ymax
ymax=bo()\zentrumx+bo()\radius
EndIf
NextElement(bo())
Next
EndIf

If CountList(li())>0
FirstElement(li())
For b.l = 1 To CountList(li())
If li()\startx<xmin
xmin=li()\startx
EndIf
If li()\endx>xmax
xmax=li()\endx
EndIf
If li()\starty<ymin
ymin=li()\starty
EndIf
If li()\endy>ymax
ymax=li()\endy
EndIf
NextElement(li())
Next
EndIf

Debug("xmin"+StrF(xmin))
Debug("xmax"+StrF(xmax))
Debug("ymin"+StrF(ymin))
Debug("ymax"+StrF(ymax))
Debug("Linien "+Str(CountList(li())))
Debug("Bogen "+Str(CountList(bo())))
Debug("Kreise "+Str(CountList(kr())))

EndProcedure

;<--------------------
Procedure bogenzeichnen()
winkel1.f=bo()\endwinkel-bo()\startwinkel
If bo()\startwinkel<bo()\endwinkel
bogenwinkel.f=winkel1       ; Der Bogenwinkel ist der Winkel zwischen Startwinkel und Endwinkel
Else
bogenwinkel.f=360+winkel1
EndIf
koordx1.f = bo()\zentrumx + anzeigex1 +Cos(winkelgrad*bo()\startwinkel)*bo()\radius
koordx2.f = koordx1
koordy1.f = -bo()\zentrumy + anzeigey1 -Sin(winkelgrad*bo()\startwinkel)*bo()\radius
koordy2.f = koordy1
a.f=bo()\startwinkel
While a<bo()\startwinkel+bogenwinkel
koordx1 = bo()\zentrumx + anzeigex1 +Cos(winkelgrad*a)*bo()\radius
koordy1 = -bo()\zentrumy + anzeigey1 -Sin(winkelgrad*a)*bo()\radius
LineXY(koordx1,koordy1,koordx2,koordy2)
koordx2 = koordx1
koordy2 = koordy1
a=a+1
Wend
EndProcedure
;<------------------
Procedure kreiszeichnen()
a.f = 0
  koordx1.l = kr()\zentrumx + anzeigex1 + Cos(winkelgrad*a)*kr()\radius
  koordx2.l = koordx1.l
  koordy1.l = -kr()\zentrumy + anzeigey1 + Sin(winkelgrad*a)*kr()\radius
  koordy2.l = koordy1.l
  Repeat
  koordx1 = kr()\zentrumx + anzeigex1 + Cos(winkelgrad*a)*kr()\radius
  koordy1 = -kr()\zentrumy + anzeigey1 + Sin(winkelgrad*a)*kr()\radius
  LineXY(koordx1,koordy1,koordx2,koordy2)
  koordx2.l = koordx1.l
  koordy2.l = koordy1.l
  a=a+1
  Until a>360
EndProcedure
;<------------------
Procedure liniezeichnen()
startx.f=li()\startx + anzeigex1
starty.f=anzeigey1 - li()\starty
endx.f=li()\endx + anzeigex1
endy.f=anzeigey1 - li()\endy
LineXY(startx,starty,endx,endy)
EndProcedure

Procedure dxflesen()
ReadFile(1,ladedatei$)
Repeat
  a$=ReadString()
  Select a$
      Case "ARC"
      bozaehler=bozaehler+1
      AddElement(bo())
       box:
       b$ = ReadString()
       If FindString(b$,".",1)=0
        Goto box
       EndIf
       bo()\zentrumx = ValF(b$)
       boy:
       b$ = ReadString()
       If FindString(b$,".",1)=0
        Goto boy
       EndIf
       bo()\zentrumy = ValF(b$)
       boz:
       b$ = ReadString()
       If FindString(b$,".",1)=0
        Goto boz
       EndIf
       bor:
       b$ = ReadString()
       If FindString(b$,".",1)=0
        Goto bor
       EndIf
       bo()\radius = ValF(b$)
       bosw:
       b$ = ReadString()
       If FindString(b$,".",1)=0
        Goto bosw
       EndIf
       bo()\startwinkel = ValF(b$)
       boew:
       b$ = ReadString()
       If FindString(b$,".",1)=0
        Goto boew
       EndIf
       bo()\endwinkel = ValF(b$)
       
      Case "LINE"
      lizaehler=lizaehler+1
       AddElement(li())
       lisx:
       b$ = ReadString()
       If FindString(b$,".",1)=0
        Goto lisx
       EndIf
       li()\startx = ValF(b$)
       lisy:
       b$ = ReadString()
       If FindString(b$,".",1)=0
        Goto lisy
       EndIf
       li()\starty = ValF(b$)
       liz:
       b$ = ReadString()
       If FindString(b$,".",1)=0
        Goto liz
       EndIf
       liex:
       b$ = ReadString()
       If FindString(b$,".",1)=0
        Goto liex
       EndIf
       li()\endx = ValF(b$)
       liey:
       b$ = ReadString()
       If FindString(b$,".",1)=0
        Goto liey
       EndIf
       li()\endy = ValF(b$)
       
      Case "CIRCLE"
      krzaehler=krzaehler+1
       AddElement(kr())
       krxlesen:
       b$ = ReadString()
       If FindString(b$,".",1)=0
        Goto krxlesen
       EndIf
       kr()\zentrumx = ValF(b$)
       krylesen:
       b$ = ReadString()
       If FindString(b$,".",1)=0
        Goto krylesen
       EndIf
       kr()\zentrumy = ValF(b$)
       krzlesen:
       b$ = ReadString()
       If FindString(b$,".",1)=0
        Goto krzlesen
       EndIf
       krradiuslesen:
       b$ = ReadString()
       If FindString(b$,".",1)=0
        Goto krradiuslesen
       EndIf
       kr()\radius = ValF(b$)
  EndSelect
 Until a$="EOF"
CloseFile(1)
limiten()
EndProcedure


OpenWindow(0, 20, 20, 800, 600, #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_SizeGadget, "VARICAD")


  ;
  ; This is the 'event loop'. All the user actions are processed here.
  ; It's very easy to understand: when an action occurs, the EventID
  ; isn't 0 and we just have to see what have happened...
  ;
  ;AddKeyboardShortcut(0,#PB_ShortCut_B, 1)
  CreateStatusBar(0, WindowID())
    AddStatusBarField(200)
    AddStatusBarField(200)
    AddStatusBarField(50)
  
  StatusBarText(0, 0, "Area 1")
  StatusBarText(0, 1, "Area 2", #PB_StatusBar_BorderLess)
  StatusBarText(0, 2, "Area 3", #PB_StatusBar_Right | #PB_StatusBar_Raised) 

  CreateToolBar(0, WindowID()) 
    ToolBarStandardButton(0,#PB_ToolBarIcon_New) 
    ToolBarStandardButton(1,#PB_ToolBarIcon_Open) 
    ToolBarStandardButton(2,#PB_ToolBarIcon_Save)
    ToolBarStandardButton(3,#PB_ToolBarIcon_Print)
    ToolBarStandardButton(4,#PB_ToolBarIcon_Find)
    ToolBarStandardButton(5,#PB_ToolBarIcon_Replace)
    ToolBarStandardButton(6,#PB_ToolBarIcon_Cut)
    ToolBarStandardButton(7,#PB_ToolBarIcon_Copy) 
    ToolBarStandardButton(8,#PB_ToolBarIcon_Paste) 
    ToolBarStandardButton(9,#PB_ToolBarIcon_Undo)
    ToolBarStandardButton(10,#PB_ToolBarIcon_Redo) 
    ToolBarStandardButton(11,#PB_ToolBarIcon_Delete)
    ToolBarStandardButton(12,#PB_ToolBarIcon_Properties)
    ToolBarStandardButton(13,#PB_ToolBarIcon_Help)
    
  CreateMenu(0, WindowID())
    MenuTitle("Datei")
    MenuItem(0,"Neu")
    MenuItem(1,"Öffnen")
    MenuItem(2,"Sichern")
    MenuBar()
    MenuItem(14,"Schließen")
    MenuTitle("Skizzieren")
    MenuItem(15,"Linie")
    MenuItem(16,"Kreis")  
    MenuTitle("?")
    MenuItem(17,"Info")
  
  CreateGadgetList(WindowID())
    ButtonGadget(1, 1, 25,106,25, "Neuzeichnen")
    ButtonGadget(2, 1, 50,106,25, "Programm beenden")
    ButtonGadget(3, 1, 75,106,25, "Neuer Bogen")
    ButtonGadget(16,1,100,106,25, "Neuer Kreis")
    ButtonGadget(17,1,125,106,25, "Neue Linie")
    ListViewGadget(18,WindowWidth()-140 ,10,140,200)
    AddGadgetItem (18,-1,"Willkomen zu XY")
  
  AddKeyboardShortcut(0,#PB_Shortcut_Up, 20)    ;Tasten für PAN
  AddKeyboardShortcut(0,#PB_Shortcut_down, 21)  ;     -||-
  AddKeyboardShortcut(0,#PB_Shortcut_left, 22)  ;     -||-
  AddKeyboardShortcut(0,#PB_Shortcut_right, 23) ;     -||-
  
  Gosub SomeGraphics
    
  Repeat
  
  EventID = WaitWindowEvent()
  
    Select eventID
    
    Case #PB_Event_CloseWindow
      quit = 1
      
    ;Case #pb_event_shortcut
    ;End
    

    
    Case #pb_event_gadget
      Select EventGadgetID()
    
    Case 1
       Gosub SomeGraphics

    Case 2
        quit = 1
      
    Case 3 ;Eingabe neuer Bogen
      CreateGadgetList(WindowID())
      StringGadget(5, 1, gz, 50, 19, "200")
      StringGadget(6, 1, gz+20, 50, 19, "200")
      StringGadget(7, 1, gz+40, 50, 19, "150")
      StringGadget(8, 1, gz+60, 50, 19, "0")
      StringGadget(9, 1, gz+80, 50, 19, "60")
      TextGadget(10, 55, gz, 50 , 19,"Zentr.X")
      TextGadget(11, 55, gz+20, 50 , 19,"Zentr.Y")
      TextGadget(12, 55, gz+40, 50 , 19,"Radius")
      TextGadget(13, 55, gz+60, 50 , 19,"S.Winkel")
      TextGadget(14, 55, gz+80, 50 , 19,"E.Winkel")
      ButtonGadget(15, 1, gz+100, 106, 25, " OK ")
      
    Case 15 ;ok neuer Bogen
      AddElement(bo())
      bo()\zentrumx = ValF(GetGadgetText(5))
      bo()\zentrumy = ValF(GetGadgetText(6))
      bo()\radius = ValF(GetGadgetText(7))
      bo()\startwinkel = ValF(GetGadgetText(8))
      bo()\endwinkel = ValF(GetGadgetText(9))
      For a.b=5 To 15
      FreeGadget(a)
      Next a
      Gosub SomeGraphics
      
    Case 16 ;Eingabe neuer Kreis
      CreateGadgetList(WindowID())
      StringGadget(5, 1, gz, 50, 19, "200")
      StringGadget(6, 1, gz+20, 50, 19, "200")
      StringGadget(7, 1, gz+40, 50, 19, "150")
      TextGadget(8, 55, gz, 50 , 19,"Zentr.X")
      TextGadget(9, 55, gz+20, 50 , 19,"Zentr.Y")
      TextGadget(10, 55, gz+40, 50 , 19,"Radius")
      ButtonGadget(11, 1, gz+60, 106, 25, " OK ")
      
    Case 11 ;ok neuer Kreis
      AddElement(kr())
      kr()\zentrumx = ValF(GetGadgetText(5))
      kr()\zentrumy = ValF(GetGadgetText(6))
      kr()\radius = ValF(GetGadgetText(7))
      For a.b=5 To 11
      FreeGadget(a)
      Next a
      Gosub SomeGraphics
      
    Case 17 ;Eingabe neuer Linie
      CreateGadgetList(WindowID())
      StringGadget(5, 1, gz, 50, 19, "200")
      StringGadget(6, 1, gz+20, 50, 19, "200")
      StringGadget(7, 1, gz+40, 50, 19, "150")
      StringGadget(8, 1, gz+60, 50, 19, "0")
      TextGadget(9, 55, gz, 50 , 19,"Start X")
      TextGadget(10, 55, gz+20, 50 , 19,"Start Y")
      TextGadget(11, 55, gz+40, 50 , 19,"Ende X")
      TextGadget(12, 55, gz+60, 50 , 19,"Ende Y")
      ButtonGadget(13, 1, gz+80, 106, 25, " OK ")
      
    Case 13 ;ok neue Linie
      AddElement(li())
      li()\startx = ValF(GetGadgetText(5))
      li()\starty = ValF(GetGadgetText(6))
      li()\endx = ValF(GetGadgetText(7))
      li()\endy = ValF(GetGadgetText(8))
      For a.b=5 To 13
      FreeGadget(a)
      Next a
      Gosub SomeGraphics
      
                      
    EndSelect ;Ende Case #pb_event_gadget
    
    Case #pb_event_menu
    
     Select EventMenuID()
    Case 0                  ; Elemente Löschen
    ClearList(bo())
    ClearList(kr())
    ClearList(li())
    StartDrawing(WindowOutput())
    FrontColor(255,208,200) 
    Box(108,28,WindowWidth(),WindowHeight())
    FrontColor(0,0,0) 
    StopDrawing()
    Gosub SomeGraphics:
    SetWindowTitle(0,"VARICAD-"+"Neu")
    
    Case 1                  ; Fenster für Laden
    LastElement(bo())
    LastElement(kr())
    LastElement(li())
    ladedatei$ = OpenFileRequester("Laden","c:\test.cad","CAD-Dateien|*.cad;*.dxf",0)
    If Right(ladedatei$,3)="dxf"
    dxflesen()
    EndIf
    If Right(ladedatei$,3)="cad"
     ReadFile(1,ladedatei$)
     Repeat
     a$=ReadString()
     Select a$
      Case "Bogen"
      AddElement(bo())
      bo()\zentrumx = ValF(ReadString())
      bo()\zentrumy = ValF(ReadString())
      bo()\radius = ValF(ReadString())
      bo()\startwinkel = ValF(ReadString())
      bo()\endwinkel = ValF(ReadString())
      Case "Kreis"
      AddElement(kr())
      kr()\zentrumx = ValF(ReadString())
      kr()\zentrumy = ValF(ReadString())
      kr()\radius = ValF(ReadString())
      Case "Linie"
      AddElement(li())
      li()\startx = ValF(ReadString())
      li()\starty = ValF(ReadString())
      li()\endx = ValF(ReadString())
      li()\endy = ValF(ReadString())
     EndSelect
     Until a$=""
     CloseFile(1)
    EndIf
    Gosub SomeGraphics:
    SetWindowTitle(0,"VARICAD-"+ ladedatei$)
    limiten()
 
    Case 2; Fenster für Sichern
     savedatei$ = SaveFileRequester("Sichern","c:\test.cad","CAD-Dateien|*.cad",0)
     namedatei$=GetFilePart(savedatei$)
     OpenFile(1,savedatei$)
      FirstElement(bo())
      For b.l = 1 To CountList(bo())
      WriteStringN("Bogen");hier bogen in Datei schreiben
      WriteStringN(StrF(bo()\zentrumx))
      WriteStringN(StrF(bo()\zentrumy))
      WriteStringN(StrF(bo()\radius))
      WriteStringN(StrF(bo()\startwinkel))
      WriteStringN(StrF(bo()\endwinkel))
      NextElement(bo())
      Next
      FirstElement(kr())
      For b.l = 1 To CountList(kr())
      WriteStringN("Kreis");hier kreis in Datei schreiben
      WriteStringN(StrF(kr()\zentrumx))
      WriteStringN(StrF(kr()\zentrumy))
      WriteStringN(StrF(kr()\radius))
      NextElement(kr())
      Next
      FirstElement(li())
      For b.l = 1 To CountList(li())
      WriteStringN("Linie");hier linie in Datei schreiben
      WriteStringN(StrF(li()\startx))
      WriteStringN(StrF(li()\starty))
      WriteStringN(StrF(li()\endx))
      WriteStringN(StrF(li()\endy))
      NextElement(li())
      Next
      CloseFile(1)
      SetWindowTitle(0,"VARICAD-"+ savedatei$)
      
    Case 20
    anzeigey1=anzeigey1-10
    StartDrawing(WindowOutput())
    FrontColor(255,208,200) 
    Box(108,28,WindowWidth(),WindowHeight())
    FrontColor(0,0,0) 
    StopDrawing()
    Gosub somegraphics
    Case 21
    anzeigey1=anzeigey1+10
    StartDrawing(WindowOutput())
    FrontColor(212,208,200) 
    Box(108,28,WindowWidth(),WindowHeight())
    FrontColor(0,0,0) 
    StopDrawing()
    Gosub somegraphics
    Case 22
    anzeigex1=anzeigex1-10
    StartDrawing(WindowOutput())
    FrontColor(212,208,200) 
    Box(108,28,WindowWidth(),WindowHeight())
    FrontColor(0,0,0) 
    StopDrawing()
    Gosub somegraphics
    Case 23
    anzeigex1=anzeigex1+10
    StartDrawing(WindowOutput())
    FrontColor(212,208,200) 
    Box(108,28,WindowWidth(),WindowHeight())
    FrontColor(0,0,0) 
    StopDrawing()
    Gosub somegraphics
       
    EndSelect ;Ende Case #PB_ToolBarIcon
      
    EndSelect ;Ende Case Select
    
    koordx.l=WindowMouseX()-anzeigex1 : koordy.l=anzeigey1-WindowMouseY()
    StatusBarText(0,0,"X: "+Str(koordx)+"/ Y: "+Str(koordy))
    StartDrawing(WindowOutput())
    cursorblau.l= Blue(Point(WindowMouseX(),WindowMouseY()))
    cursorgruen.l=Green(Point(WindowMouseX(),WindowMouseY()))
    cursorrot.l=Red(Point(WindowMouseX(),WindowMouseY()))
    StatusBarText(0,1,Str(cursorrot)+" "+Str(cursorgruen)+" "+Str(cursorblau))
    
    FirstElement(li())                ;Block zum finden des ausgewählten Objektes
    For b.l = 1 To CountList(li())
    FrontColor(253, 0, 0)
    liniezeichnen()
    cursorblau.l= Blue(Point(WindowMouseX(),WindowMouseY()))
    cursorgruen.l=Green(Point(WindowMouseX(),WindowMouseY()))
    cursorrot.l=Red(Point(WindowMouseX(),WindowMouseY()))
    If cursorrot = 253
      StatusBarText(0,2,"Kontakt")
      aktivelement=b
      Break 1
     Else
      FrontColor(0, 0, 0)
      liniezeichnen()
      StatusBarText(0,2,"Zero")
      aktivelement=0
    EndIf
    NextElement(li())
    Next b
    StopDrawing()
    
    If aktivelement=0
    ClearGadgetItemList(18)
    Else
    If CountGadgetItems(18)=0
    AddGadgetItem (18,-1,"Linie "+Str(b))
    AddGadgetItem (18,-1,"SX "+StrF(li()\startx))
    AddGadgetItem (18,-1,"SY "+StrF(li()\starty))
    AddGadgetItem (18,-1,"EX "+StrF(li()\endx))
    AddGadgetItem (18,-1,"EY "+StrF(li()\endy))
    AddGadgetItem (18,-1,"L "+ StrF(Sqr( Pow(li()\startx-li()\endx,2)+Pow(li()\starty-li()\endy,2) )))
    deltax.f=li()\startx-li()\endx
    AddGadgetItem (18,-1,"deltaX "+ StrF(deltax))
    deltay.f=li()\starty-li()\endy
    AddGadgetItem (18,-1,"deltaY "+ StrF(deltay))
    steigung.f=deltay/deltax
    AddGadgetItem (18,-1,"Steigung "+StrF(steigung))
    winkel.f=ATan(steigung)/winkelgrad
    AddGadgetItem (18,-1,"Winkel "+StrF(winkel))
    EndIf
    EndIf
    
    If GetAsyncKeyState_(#vk_lbutton)
    If aktivelement>0
    a$ = InputRequester("startx "," Start x eingeben"," gut gemacht ")
    EndIf
    EndIf



Until EventID = #PB_EventCloseWindow Or quit=1  ; If the user has pressed on the close button

  
End   ; All the opened windows are closed automatically by PureBasic
;
; Some 2D graphics functions...
;

SomeGraphics:
  StartDrawing(WindowOutput())
  FirstElement(bo())
  For b.l = 1 To CountList(bo())
  bogenzeichnen()
  NextElement(bo())
  Next b
  FirstElement(kr())
  For b.l = 1 To CountList(kr())
  kreiszeichnen()
  NextElement(kr())
  Next b
  FirstElement(li())
  For b.l = 1 To CountList(li())
  liniezeichnen()
  NextElement(li())
  Next b
  StopDrawing() ; This is absolutely needed when the drawing operations are finished !!! Never forget it !
Return ;Somegraphics
CodeTags editiert von Falko
Benutzeravatar
Falko
Admin
Beiträge: 3535
Registriert: 29.08.2004 11:27
Computerausstattung: PC: MSI-Z590-GC; 32GB-DDR4, ICore9; 2TB M2 + 2x3TB-SATA2 HDD; Intel ICore9 @ 3600MHZ (Win11 Pro. 64-Bit),
Acer Aspire E15 (Win11 Home X64). Purebasic LTS 6.11b1
HP255G8 Notebook @AMD Ryzen 5 5500U with Radeon Graphics 2.10 GHz 3.4GHz, 32GB_RAM, 3TB_SSD (Win11 Pro 64-Bit)
Kontaktdaten:

Beitrag von Falko »

@Brügge
Teste mal, ich hoffe, du siehst dann die Vorzüge von Windowsapplikationen gegenüber DOS-Bildschirmgrafiken. (Scherz beiseite) :mrgreen:

Auf jeden Fall sind dort Windows-Menüs usw. einfacher hinzuzufügen.
Aber das möchte ich jetzt nicht progen. Ist zu warm :lol:

Auf jeden Fall ist der Schreibaufwand gegenüber der Demoversion in PB
nicht so gross, wenn man sich entschließt die Vollversion zu kaufen. Aber um es zeigen zu können, habe ich es mal versucht umzusetzen.

Code: Alles auswählen

;PB3.94 DEMO-TESTVERSION

OpenLibrary(0,"user32.dll")
OpenLibrary(1,"gdi32.dll")

Structure POINTAPI
	x.l
	y.l
EndStructure

#PS_SOLID = $0
#SM_CXSCREEN = $0
#SM_CYSCREEN = $1

WS_OVERLAPPED = $0
WS_CAPTION = $C00000
WS_SYSMENU = $80000
WS_THICKFRAME = $40000
WS_MINIMIZEBOX = $20000
WS_MAXIMIZEBOX = $10000

WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)

#WM_LBUTTONDOWN = $201
#WM_LBUTTONUP = $202

Procedure.l GetDC(hwnd.l)
   ProcedureReturn CallFunction(0,"GetDC",hwnd)
EndProcedure
;
Procedure.l CreatePen(nPenStyle.l, nWidth.l, crColor.l)
   ProcedureReturn CallFunction(1,"CreatePen",nPenStyle, nWidth, crColor)
EndProcedure
;
Procedure.l SelectObject(hdc.l, hObject.l)
   ProcedureReturn CallFunction(1,"SelectObject",hdc, hObject)
EndProcedure
;
Procedure.l MoveToEx(hdc.l, x.l, y.l,Point)
   ProcedureReturn CallFunction(1,"MoveToEx",hdc, x, y, lpPoint.POINTAPI)
EndProcedure
;
Procedure.l LineTo(hdc.l, x.l, y.l,Point)
   ProcedureReturn CallFunction(1,"LineTo",hdc, x, y)
EndProcedure
;
Procedure.l DeleteObject(hObject.l)
   ProcedureReturn CallFunction(1,"DeleteObject",hObject)
EndProcedure
;
Procedure.l GetSystemMetrics(nIndex.l)
   ProcedureReturn CallFunction(0,"GetSystemMetrics",nIndex)
EndProcedure
;
Procedure Lin(x,y,x1,y1,Width,Color) 
   hDC=GetDC(WindowID(0)) 
   pen=CreatePen(#PS_SOLID,Width,color)  
   hPenOld=SelectObject(hDC,pen) 
   MoveToEx(hDC,x,y,0):LineTo(hDC,x1,y1,0) 
   DeleteObject(pen) 
   DeleteObject(hPenOld) 
EndProcedure 

_X=GetSystemMetrics(#SM_CXSCREEN)-8 : _Y=GetSystemMetrics(#SM_CYSCREEN)-68 
OpenWindow(0,0,0,_X,_Y,#PB_Window_SystemMenu,"") 
Set=0

Repeat 

event = WaitWindowEvent()
Select event
   Case  #WM_LBUTTONDOWN 
               x1 = WindowMouseX() 
               y1 = WindowMouseY()
               Set=1
   Case #WM_LBUTTONUP
              x2 = WindowMouseX() 
              y2 = WindowMouseY()
              lin(x1,y1,x2,y2,2,RGB(255,0,0))
              Set=0
EndSelect 
Until event = #PB_Event_CloseWindow 
CloseLibrary(0): CloseLibrary(1)
Bild
Win11 Pro 64-Bit, PB_6.11b1
Brügge
Beiträge: 359
Registriert: 28.05.2006 16:40
Wohnort: Rheine

Beitrag von Brügge »

so ein müll!!

das läuft bei mir nicht und ich kann das nicht so umschreiben, dass es funzt!! wie gesagt PB 3.90 demo! :cry:
und ich kenn mich mit den befehlen nicht so aus
Brügge
Beiträge: 359
Registriert: 28.05.2006 16:40
Wohnort: Rheine

Beitrag von Brügge »

hey falko bei denen code gibt es noch einen fehler:

wenn man eine linie zeichnet und dann das fenster verschiebt geht die linie weg
Benutzeravatar
GreyEnt
Beiträge: 376
Registriert: 20.07.2006 19:41

Stimmt nicht. :(

Beitrag von GreyEnt »

also bei mir ist die linie da wenn ich die Anzeige verschiebe.
Hallo Brügge warum kauft du Dir nicht eine Version PB?
Ich finde das Geld ist nicht rausgeschmissen.
Brügge
Beiträge: 359
Registriert: 28.05.2006 16:40
Wohnort: Rheine

Beitrag von Brügge »

hi


also bei mir ist die linie da wenn ich die Anzeige verschiebe.

auch wenn du das fenster ausserhalb des bildschirmes verschiebst ?


Hallo Brügge warum kauft du Dir nicht eine Version PB?
Ich finde das Geld ist nicht rausgeschmissen.

wie viel kostet das denn?
Benutzeravatar
GreyEnt
Beiträge: 376
Registriert: 20.07.2006 19:41

Beitrag von GreyEnt »

>also bei mir ist die linie da wenn ich die Anzeige verschiebe.

>auch wenn du das fenster ausserhalb des bildschirmes verschiebst ?
Wenn ich das fenster aus dem Bildschirm ziehe sehe ich den Desktop von Windows. Das ist ein Feature kein Bug. :)


>Hallo Brügge warum kauft du Dir nicht eine Version PB?
>Ich finde das Geld ist nicht rausgeschmissen.

>wie viel kostet das denn?
ich meine 50€ gezahlt zu haben. Incl. Buch was natürlich schon zu alt war. :)
Kaeru Gaman
Beiträge: 17389
Registriert: 10.11.2004 03:22

Beitrag von Kaeru Gaman »

das is aber schon ne weile her...

aktuell zahlt man 79,- für die vollversion
bzw. 59,- für den Update-key, falls man die alte 3.30 erworben hat.
Der Narr denkt er sei ein weiser Mann.
Der Weise weiß, dass er ein Narr ist.
Brügge
Beiträge: 359
Registriert: 28.05.2006 16:40
Wohnort: Rheine

Beitrag von Brügge »

naja egal die demo ist auch recht nett ^^

ich habe mir die mühe gemacht und ein kleines beispiel programm geschrieben...

Code: Alles auswählen

InitSprite()
InitKeyboard()
InitMouse()
InitSound()

OpenScreen(1280,1024,32, "CAD")
StartSpecialFX() 


Dim Linie(1000,5)

;line(x,1) = xachse1
;line(x,2) = yachse1
;line(x,3) = xachse2
;line(x,4) = yachse2
;line(x,5) = art (ob ein kreis gezeichnet werden soll oder eine linie)

Global art.w
Global x.f
Global y.f
Global radius.f
Global bogen.f


bogen = 3.1415926 / 180
art = 1

;wenn art = 1 ist dann wird eine linie gezeichnet bei 2 ein kreis 
;bogen ist die konstance, womit wir uns den obtimalen bogenmaß ausrechnen kannst

Repeat
ExamineKeyboard() 
ExamineMouse() 
  

If art > 2 
  art = 1
EndIf 
 
  
If KeyboardPushed(#PB_Key_Escape)
  esc = 1
EndIf
  

If MouseButton(1)
  If druck2 = 0
    If MouseX() > 1000
      If MouseY() < 20
        esc = 1
      EndIf
      If MouseY() < 40
        If MouseY() > 20 
          art = art +1
        EndIf
      EndIf
      If MouseY() > 40
        If MouseY() < 60 
          anzahl = anzahl -1
          If anzahl <0 
            anzahl = 0
          EndIf
          linie(anzahl,1) = 0
          linie(anzahl,2) = 0
          linie(anzahl,3) = 0
          linie(anzahl,4) = 0
          linie(anzahl,5) = 0        
        EndIf
      EndIf
    EndIf
  EndIf
  druck2 = 1
Else
  druck2 = 0
EndIf


If MouseButton(1)
  If druck1 = 0
    x1 = MouseX()
    y1 = MouseY()
  EndIf
  druck1 = 1
Else
  If druck1 = 1
    x2 = MouseX()
    y2 = MouseY()
    
    If x1 < 1000
      If x2 < 1000
        linie(anzahl,1) = x1
        linie(anzahl,2) = y1
        linie(anzahl,3) = x2
        linie(anzahl,4) = y2
        linie(anzahl,5) = art
        anzahl = anzahl +1
      EndIf
    EndIf
    
  EndIf
  druck1 = 0
EndIf

ClearScreen(0,0,0)

StartDrawing(ScreenOutput())
FrontColor (150,150,150)

LineXY(1000,0,1000,1024)
LineXY(0,0,0,1024)
LineXY(0,0,1000,0)
LineXY(0,1024,1000,1024)

Locate(1010,0)
DrawText("Programm Beenden") 
Locate(1010,20)
If art = 1
  DrawText("Zu Kreis Wechseln") 
EndIf
If art = 2
  DrawText("Zu Linie Wechseln") 
EndIf
Locate(1010,40)
DrawText("Letzten Teil Löschen") 

FrontColor (255,0,0)
For i = 0 To 1000
  If linie(i,5) > 0
    If linie(i,5) = 1
      LineXY(linie(i,1),linie(i,2),linie(i,3),linie(i,4))
    EndIf
    If linie(i,5) = 2
      x = (linie(i,1) - linie(i,3))*(linie(i,1) - linie(i,3)) 
      y = (linie(i,2) - linie(i,4))*(linie(i,2) - linie(i,4))
      radius = Sqr(x+y)
      
      For j = 1 To 361
        sinx = Sin(j*bogen)*radius+linie(i,1)
        cosy = Cos(j*bogen)*radius+linie(i,2)
        If j > 1
          LineXY(sinx,cosy,sinxalt,cosyalt)
        EndIf
        sinxalt = sinx
        cosyalt = cosy
        
      Next j
      
    EndIf
  EndIf
Next i


Box(MouseX(),MouseY(),10,10)

StopDrawing()

FlipBuffers()

Until esc = 1
also ich fand es sehr einfach das soweit zu schreiben. Ich wusste nicht was alles ins menü muss aber ich hoffe es ist bis jetzt recht gut ^^
Antworten