Darstellung eines verschiebbaren Bereichs

[THFR]

Den ich im Moment mit einem transparenten Dialog erstelle. Nur ein Rahmen, den ich aber nicht transparent hin bekomme (soll ohne OFrame.dll sein), wäre mein Wunsch. Kennt von euch einer eine Möglichkeit?

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Def @Clienttoscreen(2) !"USER32","ClientToScreen"
Def @G2lx(0) @Long(C2sstrc#,0)
Def @G2ly(0) @Long(C2sstrc#,4)

Proc G2l
   Parameters Hdl&
   Clear C2sstrc#
   @Clienttoscreen(%Hwnd,C2sstrc#)
   x%=@G2lx()
   y%=@G2ly()
   Clear C2sstrc#
   @Clienttoscreen(Hdl&,C2sstrc#)
   x%=@G2lx()-x%
   y%=@G2ly()-y%
Endproc

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

def %LWA_ALPHA $2
def %GWL_EXSTYLE -20
def %WS_EX_LAYERED $80000
def %WS_EX_TRANSPARENT $20
def SetWindowLong(3) !"USER32","SetWindowLongA"
def GetWindowLong(2) !"USER32","GetWindowLongA"
def SetLayeredWindowAttributes(4) !"USER32","SetLayeredWindowAttributes"

Proc SetTransparent
 Declare Old&
 Parameters Hwnd&, Perc%
 Old& = GetWindowLong(Hwnd&,%GWL_EXSTYLE)
 SetWindowLong(Hwnd&, %GWL_EXSTYLE, (Old& | %WS_EX_LAYERED));
 SetLayeredWindowAttributes(Hwnd&, 0, (255 * Perc%) / 100, %LWA_ALPHA);
EndProc

SetTrueColor 1
window 0,0 - 600,600

UsePen 0,0,rgb(0,0,0)
WhileLoop 10,600,20
Line 10,&Loop - 600,&loop
wend
Line 0,0 - 600,550
Line 0,550 - 600,0

declare x%,y%,bmp1&
Declare C2sstrc#
Dim C2sstrc#,8

CHILD

Dispose C2sstrc#
DeleteObject bmp1&
end

proc CHILD
Windowstyle 82
var hwnd&=Create("DIALOG",%hwnd,"",100,100,220,320)
setstyle hwnd&,Getstyle(hwnd&) - $C00000
SetTransparent hwnd&, 45
@Create("Tooltip",%hwnd,hwnd&,"Verschieben mit gehaltener Maustaste links "+\
"in der unteren rechten Fläche.\nBild erstellen mit Mausklick rechts.")

userMessages 16,513,514,516//wm_close,wm_lButtonDown,wm_rButtonDown

while 1

    WaitInput
    case %key=27:break
    case %uMessage=16: break
    case %uMessage=513 : hWnd.movebyMouse()//wm_lButtonDown
    If %uMessage=516
      MCls 220, 320
      CopyBmpToMem x%,y% - 220,320 > 0,0
      bmp1&=@Create("hPic",0,"&MEMBMP")
      SavePic "C:\\Test.jpg", bmp1&,100              ' anpassen !!!
      @MessageBox ("Bild gespeichert.","Hinweis",64)
    EndIf
wend
userMessages 0
DestroyWindow(hwnd&)
SetFocus(%hwnd)
endProc

proc hWnd.moveByMouse
    declare mpos#
    dim mpos#,8
    external("user32","GetCursorPos",mpos#)
    while iskey(1)
        external("user32","GetCursorPos",mpos#)
        setWindowPos hWnd&=(long(mpos#,0)-220),(long(mpos#,4)-320) - 220,320,0
    wend
    dispose mpos#
   G2l hWnd&
endProc

Gruß Thomas

[Frabbing]

Du willst einen Teil deines Bildschirms verschieben mit einer transparenten Farbe als Hintergrund?

Ein Dialog ist ungeignet, ebenso die Layered-Technik, denke ich. Höchstens zum Kombinieren des Verschiebeeffekts.
Die OFrame erstellt Controls mit eigener Class (RegisterClassEx()). Nur so bist du vor ungewünschten Effekten geschützt, die ein Systemcontrol vielleicht auslöst. Dann musst du tatsächlich bei jedem WM_PAINT, dass dein Control auslöst, neuzeichnen. Mit der API AlphaBlend() geht das am einfachsten. Wenn es vor WindowsXP funktionieren soll oder nicht-transparent, geht es auch mit BitBlt(). Bei nicht-Transparenz könntest du aber auch auch ein Static mit Bild verwenden.

[THFR]

Hallo Frank,
so recht bin mit deinen Anregungen nicht weiter gekomen. Auch mit der OFrame.dll hakt es bei mir mit dem Einblenden des Hintergrundbildes im Oframe. Siehst du das Problem?

'
$H windows.ph
$H messages.ph

var owndll&=UseDll("OFrame.dll")

Declare test4&
Declare x&,y&,z&,text$,rect#,edit&
Dim rect#,16

Def GetSysColor(1) !"USER32","GetSysColor"
Def GetCurrentObject(2) !"GDI32","GetCurrentObject"
Def GetClientRect(2) !"USER32","GetClientRect"
Def ExtractIconEx(5) !"SHELL32","ExtractIconExA"
Def OF_SetMoveRect(5) !"oframe","OF_SetMoveRect"
Def OF_SetSizeRect(5) !"oframe","OF_SetSizeRect"
Def OF_SetBitmap(4) !"oframe","OF_SetBitmap"
Def OF_SetText(4) !"oframe","OF_SetText"
Def OF_SetIcon(5) !"oframe","OF_SetIcon"
Def OF_SetStyle(6) !"oframe","OF_SetStyle"
Def OF_SetGdi(6) !"oframe","OF_SetGdi"

Cls ~GetSysColor(15)
'
Usefont "MS Sans Serif",10,0,0,0,0
SetDialogFont 1
declare bmp1&,bmp2&


BILD_AUSSCNITT 'Bild laden und anzeigen

WaitInput
FreeDLL owndll&
DeleteObject bmp1&
DeleteObject bmp2&
END

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

SubClassProc

  x_plus&=~GetKeyState(1) & $8000
  If x_plus&

    If ( SubClassMessage(area_plus&, ~WM_VSCROLL) and (&sLParam=0) )
    
      ShowWindow(test4&,0)'####################
      
      ~GetWindowRect(area_plus&,rect_plus#)
      maxy_plus&=Long(rect_plus#,12)-Long(rect_plus#,4)+1
      x_plus&=&sWParam & $0000ffff
      a_plus&=1

      If x_plus&=~SB_LINEDOWN
        isy_plus&=8
      ElseIf x_plus&=~SB_PAGEDOWN
        isy_plus&=maxy_plus&

      ElseIf x_plus&=~SB_LINEUP
        isy_plus&=-8
      ElseIf x_plus&=~SB_PAGEUP
        isy_plus&=-maxy_plus&

      ElseIf x_plus&=~SB_THUMBTRACK
        so_plus!=yy_plus!
        yy_plus!=&sWParam >> 16
        isy_plus&=-(so_plus!-yy_plus!)
        a_plus&=0
      EndIf

      If a_plus&

        yy_plus!=yy_plus!+isy_plus&
        If yy_plus!<0
          isy_plus&=(isy_plus&+(0-yy_plus!))
          yy_plus!=0
        EndIf
        If yy_plus!>(virty_plus&-maxy_plus&)
          isy_plus&=isy_plus&-(yy_plus!-(virty_plus&-maxy_plus&))
          yy_plus!=virty_plus&-maxy_plus&

        EndIf
      Endif

      Long vs_plus#,0=28
      Long vs_plus#,4=~SIF_ALL
      Long vs_plus#,12=virty_plus&

      Long vs_plus#,16=maxy_plus&

      Long vs_plus#,20=yy_plus!
      ~SetScrollInfo(area_plus&,~SB_VERT,vs_plus#,1)
      ~ScrollWindow(area_plus&,0,-isy_plus&,0,0)
      ~UpdateWindow(area_plus&)

      ShowWindow(test4&,1)'####################
      
    ElseIf (SubClassMessage(area_plus&, ~WM_HSCROLL) and (&sLParam=0))
    
      ShowWindow(test4&,0)'####################
      
      ~GetWindowRect(area_plus&,rect_plus#)
      maxx_plus&=Long(rect_plus#,8)-Long(rect_plus#,0)+1
      x_plus&=&sWParam & $0000ffff
      a_plus&=1

      If x_plus&=~SB_LINERIGHT
        isx_plus&=8
      ElseIf x_plus&=~SB_PAGERIGHT
        isx_plus&=maxx_plus&

      ElseIf x_plus&=~SB_LINELEFT
        isx_plus&=-8
      ElseIf x_plus&=~SB_PAGELEFT
        isx_plus&=-maxx_plus&

      ElseIf x_plus&=~SB_THUMBTRACK
        so_plus!=xx_plus!
        xx_plus!=&sWParam >> 16
        isx_plus&=-(so_plus!-xx_plus!)
        a_plus&=0
      EndIf

      If a_plus&

        xx_plus!=xx_plus!+isx_plus&

        If xx_plus!<0
          isx_plus&=(isx_plus&+(0-xx_plus!))
          xx_plus!=0
        EndIf
        If xx_plus!>(virtx_plus&-maxx_plus&)
          isx_plus&=isx_plus&-(xx_plus!-(virtx_plus&-maxx_plus&))
          xx_plus!=virtx_plus&-maxx_plus&

        EndIf
      Endif

      Long vs_plus#,0=28
      Long vs_plus#,4=~SIF_ALL
      Long vs_plus#,12=virtx_plus&

      Long vs_plus#,16=maxx_plus&

      Long vs_plus#,20=xx_plus!
      ~SetScrollInfo(area_plus&,~SB_HORZ,vs_plus#,1)
      ~ScrollWindow(area_plus&,-isx_plus&,0,0,0)
      ~UpdateWindow(area_plus&)
      ShowWindow(test4&,1)'####################
    EndIf

  EndIf
  Case %sMessage=~WM_COMMAND: SendMessage(%hwnd,%sMessage,&sWParam,&sLParam)

  Case (SubClassMessage(area_plus&, ~WM_HSCROLL) and (&sLParam<>0)): SendMessage(%hwnd,%sMessage,&sWParam,&sLParam)
  Case (SubClassMessage(area_plus&, ~WM_VSCROLL) and (&sLParam<>0)): SendMessage(%hwnd,%sMessage,&sWParam,&sLParam)

EndProc

Proc Blatt_Basis
  ~GetWindowRect(area_plus&,rect_plus#)
  maxy_plus&=Long(rect_plus#,12)-Long(rect_plus#,4)+1
  Long vs_plus#,0=28
  Long vs_plus#,4=~SIF_ALL
  Long vs_plus#,12=virty_plus&
  Long vs_plus#,16=maxy_plus&
  Long vs_plus#,20=yy_plus!
  ~SetScrollInfo(area_plus&,~SB_VERT,vs_plus#,1)
  maxx_plus&=Long(rect_plus#,8)-Long(rect_plus#,0)+1
  Long vs_plus#,0=28
  Long vs_plus#,4=~SIF_ALL
  Long vs_plus#,12=virtx_plus&
  Long vs_plus#,16=maxx_plus&
  Long vs_plus#,20=xx_plus!
  ~SetScrollInfo(area_plus&,~SB_HORZ,vs_plus#,1)
EndProc

Proc BILD_AUSSCNITT

 Declare a_plus&,x_plus&,y_plus&,text$,area_plus&, klasse$,last_plus&

 Declare isx_plus&,isy_plus&,xx_plus!,yy_plus!,maxx_plus&,maxy_plus&,rect_plus#,vs_plus#
 Declare virtx_plus&,virty_plus&,so_plus!,but1_plus&,but2_plus&,but3_plus&,but4_plus&,but5_plus&
 Declare tb.x%

 Dim rect_plus#,16
 Dim vs_plus#,512

 virtx_plus&=400
 virty_plus&=500

 var bild.dlg&=Createdialog(%hwnd,"Bild",300,100,430,600)

 but1_plus&=CreateButton(bild.dlg&,"O",8,4,26,26)
 @Create("Tooltip",%hWnd,but1_plus&,"Bild öffnen")
 but2_plus&=CreateButton(bild.dlg&,"S",40,4,26,26)
 @Create("Tooltip",%hWnd,but2_plus&,"Bild speicher")
 but3_plus&=Control("MSCTLS_TRACKBAR32", "Trackbar01", $54000000, 72, 8, 200, 20, bild.dlg&, 2011, %hInstance, $00010004)
 sendmessage(but3_plus&,$405,100,100)
 but4_plus&=CreateButton(bild.dlg&,"Ende",340,4,62,26)
 

 klasse$="#32770"
 text$=""
 area_plus&=~CreateWindowEx($20000,addr(klasse$),addr(text$),$50300000,8 ,48 ,400 ,500 ,bild.dlg&,0,%hinstance,0)

 var Hdlg&=control("Dialog","Hauptdialog",$58000000,0,0,2110,2150,area_plus&,5000,0) 'zur Bildaufnahme

 Blatt_Basis

 GetClientRect(area_plus&,rect#)

 test4&=Control("OFRAME", "", $40000001, 0, 0, 0, 0, area_plus&, 1, %hInstance, $0)

 SubClass area_plus&, 1
 Declare bild.file$,back&
 Declare h&, v&,Hmdc&,Hbitmap&,bild&,Fenster2&

 While 1

  WaitInput
  Case (%key=2) OR GetFocus(but4_plus&):Break


  If GetFocus(but1_plus&)
   bild.file$ = @LoadFile$("ÖFFNE","Bilder|*.bmp;*.jpg;*.png")
    if len(bild.file$)>0
      x_plus&=SendMessage(but3_plus&,$400,0,0)
      bmp1&=@Create("hPic",-1,bild.file$)

      virtx_plus&=%BmpX
      virty_plus&=%BmpY
      Blatt_Basis
      bmp1&=@Create("hSizedPic",-1,bild.file$,(%BmpX*x_plus&/100),(%BmpY*x_plus&/100),1)
      SetWindowPos bmp2&=0,0-0,0
      bmp2&=@Create("Bitmap", Hdlg&, bmp1&, 0, 0)

      OF_SetBitmap(test4&,-1,bmp1&,2)
      OF_SetSizeRect(test4&,120,220,144,264)
      OF_SetMoveRect(test4&,0,0,Long(rect#,8),Long(rect#,12))
      ShowWindow(test4&,1)
      SetWindowPos test4&=40,80-120,220;0

    endif

  ElseIf GetFocus(but2_plus&) AND (len(bild.file$)>0)

  ElseIf GetFocus(but3_plus&)
    x_plus&=SendMessage(but3_plus&,$400,0,0)

    If (x_plus&<>last_plus&) AND (x_plus&>2)
      last_plus&=x_plus&

      If len(bild.file$)>0
        SetWindowPos bmp2&=0,0-0,0
        ShowWindow(test4&,0)
        bmp1&=@Create("hPic",-1,bild.file$)
        bmp1&=@Create("hSizedPic",-1,bild.file$,(%BmpX*x_plus&/100),(%BmpY*x_plus&/100),1)
        virtx_plus&=%BmpX
        virty_plus&=%BmpY
        Blatt_Basis
        bmp2&=@Create("Bitmap", Hdlg&, bmp1&, 0, 0)

        OF_SetBitmap(test4&,-1,bmp1&,2)
        OF_SetSizeRect(test4&,120,220,120,220)
        OF_SetMoveRect(test4&,0,0,Long(rect#,8),Long(rect#,12))
        OF_SetStyle(test4&,2,0,0,0,0)
        ShowWindow(test4&,1)

      EndIf
    EndIf
  EndIf

Endwhile

SubClass area_plus&, 0
Dispose rect_plus#
Dispose vs_plus#
DestroyWindow(Hdlg&)
DestroyWindow(Bild.dlg&)
EndProc

Gruß Thomas

[Frabbing]

Ich seh nur das geladene Hintergundbild und ein leeres OFrame darauf. Was hast du vor?

[THFR]

Ich würde gerne das Bild scrollen und eben auch im OFrame als Hintergrund haben. Ohne Scroll-Area geht's.

Declare owndll&,pic1&,pic2&,back&
Declare test1&,test2&,test3&,test4&,test5&,test6&
Declare x&,y&,z&,text$,rect#,edit&
Declare LargeIcon&,SmallIcon&
Dim rect#,16
Def GetSysColor(1) !"USER32","GetSysColor"
Def GetCurrentObject(2) !"GDI32","GetCurrentObject"
Def GetClientRect(2) !"USER32","GetClientRect"
Def ExtractIconEx(5) !"SHELL32","ExtractIconExA"
Def OF_SetMoveRect(5) !"oframe","OF_SetMoveRect"
Def OF_SetSizeRect(5) !"oframe","OF_SetSizeRect"
Def OF_SetBitmap(4) !"oframe","OF_SetBitmap"
Def OF_SetText(4) !"oframe","OF_SetText"
Def OF_SetIcon(5) !"oframe","OF_SetIcon"
Def OF_SetStyle(6) !"oframe","OF_SetStyle"
Def OF_SetGdi(6) !"oframe","OF_SetGdi"

owndll&=UseDll("OFrame.dll")

Window 0,0-600,600
Cls GetSysColor(15)
GetClientRect(%hwnd,rect#)

pic1&=Create("hPic",-1,"hem.png",1) ' Bild und Pfad anpassen!!

DrawPic pic1&,0,0;0

back&=pic1&

test4&=Control("OFRAME", "", $40000001, 8, 220, 240, 120, %hWnd, 1, %hInstance, $0)
OF_SetBitmap(test4&,-1,back&,2)
OF_SetSizeRect(test4&,246,330,246,330)
OF_SetMoveRect(test4&,0,0,Long(rect#,8),Long(rect#,12))
OF_SetStyle(test4&,2,0,0,0,0)
ShowWindow(test4&,1)

x&=0
While 1
  WaitInput
  Case %key=2:Break
Endwhile

FreeDll owndll&
Dispose rect#
End

Gruß Thomas

[Frabbing]

Ja, die OFrames können nicht auf Fenstern funktionieren, die selber Childs sind. Das siehst du auch daran, dass der Bereich von Childs immer ausstraffiert ist. Und dein Bild auf der Area ist ein Childfenster...
Ich sagte im anderen Thread gestern ja schon, dass ich die Restaurierungstechnik, die MS gewählt hat, für ungelungen halte.

[THFR]

Danke für die Erklärung. Ich werde, wenn ich es noch einsetzen muß, mir etwas anderes einfallen lassen.

Gruß Thomas

[Frabbing]

Du könntest das Area als eigene Class definieren und deine Bitmap unter lpwcx.hbrBackground (RegisterClassEx) eintragen. Dann brauchst du kein Bitmap-Static mehr zu verwenden.