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?

Code

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
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

Alles anzeigen

Gruß Thomas

Frank A.

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?

Code

'
$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

Alles anzeigen

Gruß Thomas

Frank A.

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.

Code

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

Alles anzeigen

Gruß Thomas

Frank A.

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

Frank A.

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.

Jetzt mitmachen!