XProfan

Matthias
Arlt

by me sufficient one ' sleep 100 ' to the ' with OlePic# '. evident need The previous action a couple ms Time. with whom ms is yet breeze down. Möglicherweise is the systemabhängig. The Bildgröße game there well no role.

WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia

06/03/20 ▲

Jörg
Sellmeyer

really amazing, that it then functions, I there crept a Error made have.
it must hot:
Case Anzeige&: DestroyWindow(Anzeige&)
thanks for testing. is now korrigiert.

Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

06/04/20 ▲

Michael
W.

2,54 is the Umrechnungswert inch to cm

PictureObject is a StreamObjekt the there created becomes. and integrally evident erbt this StreamObjekt one Objekt, which modes then to inquire the Size and Another items uses go can.

there we with our Objects no Zeiger and no THIS having, can we these Objects unfortunately in XProfan not How simple Objects manage.

Create("HPIC":
have You time geschaut, which File Types since the zero produce? evident is the function not so vielseitig How OLE.

The function Create("Bitmap",... becomes 2x one after another called.

---
Nachtrag:
I had hoped, the .Ole_GetType something sinnvolles supply. but I sustained with everything a 1 supplied.
.ico/.cur lead to that crash, though it with whom ladbaren Types aufgeführt is.

here the Test-Source:

Compile Mark Separation


$H windows.ph

'Konstanten
DEF &Picture_Release     8
DEF &Picture_GetHandle  12
DEF &Picture_GetType    20
DEF &Picture_Get_Width  24
DEF &Picture_Get_Height 28
DEF &Picture_Render     32
DEF &Picture_Select     44

'Globale variables
'DECLARE OLE32&,OLEPRO32&
DECLARE IID_IPicture#
DECLARE PData#
DECLARE HMEM&
Declare OlePic#

Class OleImage = OleImage@,\
  Ole_Init@,\
  Ole_Free@,\
  Ole_LoadImage@,\
  Ole_GetType@,\
  Ole_GetHandle@,\
  Ole_FreeImage@,\
  OLE32&,\
  OLEPro32&,\
  PictureObject&,\
  hPic&,\
  PicFormat&,\
  Width&,\
  Height&,\
  GetSize@,\
  Destroy@

Proc OleImage.OleImage
  Parameters File$
  .Ole_Init()
  .PictureObject& = .Ole_LoadImage(File$)
  .PicFormat& = .Ole_GetType(.PictureObject&)
  .hPic& = .Ole_GetHandle()
ENDPROC

Proc OleImage.Ole_Init
  .OLE32& = UseDll("OLE32")
  .OLEPRO32& = UseDll("OLEPRO32")
  
  External("OLE32","OleInitialize",0)
  
  Dim IID_IPicture#,16
  Long IID_IPicture#,0 = $7BF80980
  Word IID_IPicture#,4 = $BF32
  Word IID_IPicture#,6 = $101A
  byte IID_IPicture#,8 = $8B
  byte IID_IPicture#,9 = $BB
  byte IID_IPicture#,10 = $00
  byte IID_IPicture#,11 = $AA
  byte IID_IPicture#,12 = $00
  byte IID_IPicture#,13 = $30
  byte IID_IPicture#,14 = $0C
  byte IID_IPicture#,15 = $AB
ENDPROC

Proc OleImage.Ole_Free
  ~GlobalFree(Hmem&)
  
  External("OLE32","OleUninitialize")
  
  FreeDll .OLE32&
  FreeDll .OLEPRO32&
  DISPOSE IID_IPicture#
ENDPROC

Proc OleImage.Ole_LoadImage
  Declare MemPointer&,PStream&,PictureObject&,PSize&
  Parameters Picture$
  '------------------------
  Set("Filemode", 0)
  PSIZE& = Filesize(Picture$)
  Dim PData#,PSIZE&
  BlockRead(Picture$,PData#,0,PSIZE&)'data in Memory-Variable reading
  '------------------------
  ~GlobalFree(Hmem&)
  HMem& = ~GlobalAlloc($022,PSize&)'memory reservieren
  Mempointer& = ~GlobalLock(Hmem&)'Pointer on memory
  ~RtlMoveMemory(MemPointer&,PData#,PSize&)'Memory-Variable in memory schieben
  DISPOSE PData#'Memory-Variable enable
  ~GlobalUnlock(HMem&)'memory to that use enable
  
  External("Ole32","CreateStreamOnHGlobal",Hmem&,1,addr(PStream&))'Stream-Pointer create
  External("OlePro32","OleLoadPicture",PStream&,PSIZE&,0,IID_IPicture#,ADDR(PictureObject&))'Pointer fuer Pictureobject
  
  '------------------------
  Case PictureObject& > 0 : Return PictureObject&
  Case PictureObject& = 0 : Return 0
ENDPROC

Proc OleImage.Ole_GetType
  Declare Command&,PicFormat&
  Command& = Long(.PictureObject&,0)
  Call(@Long(Command&,&Picture_GetType),.PictureObject&,addr(PicFormat&))
  Return PicFormat&
ENDPROC

Proc OleImage.GetSize
  'here dive for me a couple unloosed ask on.
  Parameters DC&
  Declare Command&,w&,h&,xpixels&,ypixels&
  Command& = Long(.PictureObject&,0)
  'here becomes The Bildschirmauflösung per inch quizzed - by me 96x96.
  'though white I do not, which function in which dll there addressed becomes.
  Call(@Long(Command&,&Picture_Get_Width),.PictureObject&,addr(w&))
  Call(@Long(Command&,&Picture_Get_Height),.PictureObject&,addr(h&))
  'The Size the Fensters becomes determined
  xpixels& = ~GetDeviceCaps(DC&, 88)
  ypixels& = ~GetDeviceCaps(DC&, 90)
  'Umrechnung the Bildschirmauflösung on The Fenstergröße.
  'I Have though no idea, How the worth 2540 zustande comes.
  .Width&  = Round((w&*xpixels&)/2540,0)
  .Height& = Round((h&*ypixels&)/2540,0)
ENDPROC

Proc OleImage.Ole_GetHandle
  Declare Command&,PicHandle&
  Command& = Long(.PictureObject&,0)
  Call(@Long(Command&,&Picture_GetHandle),.PictureObject&,addr(PicHandle&))
  Return PicHandle&
ENDPROC

Proc OleImage.Ole_FreeImage
  Parameters PictureObject&
  Declare Command&
  Command& = Long(PictureObject&,0)
  Call(@Long(Command&,&Picture_Release),PictureObject&)
ENDPROC

Proc OleImage.Destroy
  DeleteObject .hPic&,.PictureObject&
  .Ole_Free()
ENDPROC

Declare hbtn&,Image$,hFont&,Anzeige&,TestHandle&
User Messages $10
Cls
ShowMax
hFont& = Create("Font","Western ",14,0,0,0,0)
SetDialogFont hFont&
hbtn& = Create("Button",%hwnd,"Load image",%maxx-70,40,60,24)

'### zugefuegt ###
Declare szTXT&, type1TXT&, type2TXT&, type2$
szTXT& = Create("Text",%hwnd,"1000x1000",%maxx-70,40+30,60,24)
type1TXT& = Create("Text",%hwnd,"&bildtyp",%maxx-70,40+30+30,60,24)
type2TXT& = Create("Text",%hwnd,"$bildtyp",%maxx-70,40+30+30+30,60,24)
'###

WhileNot %key = 27  'ESC exits the program
  WaitInput
  Case %uMessage = $10 : Break

  If Clicked(hbtn&)
    Image$ = LoadFile$("ÖFFNE","any supported Formate|*.dib;*.bmp;*.rle;*.jpe;*.jpeg;*.jpg;*.gif;*.ico;*.cur;*.emf;*.wmf|\
    Bitmap (bmp,rle,dib)|*.bmp;*.rle;*.dib|Jpeg (jpg,jpe,jpeg)|*.jpg;*.jpe;*.jpeg|Gif (gif)|*.gif|\
    Enhanced Metafile (emf)|*.emf|Metafile (wmf)|*.wmf|Icons (Ico)|*.ico|Cursor (cur)|*.cur")

    If Image$ > ""
      '### zugefuegt ###
      type2$ = Right$(Image$,6) '6 because of .tiff, .jpeg
      type2$ = SubStr$(type2$, 2, ".")
      '###
      
      TestHandle& = Create("hPic",-1,Image$)
      'with very large Images is here the Result 0
      Window Title Str$(TestHandle&) + " lever. with very large Images is the Result here 0"
      DeleteObject TestHandle&

      If SizeOf(OlePic#)
        OlePic#.Destroy()
        Dispose OlePic#
      EndIf

      OlePic# = New(OleImage,Image$)
      Case Anzeige&: DestroyWindow(Anzeige&)
            
      With OlePic#
        '### here was 2. Create("Bitmap" 
        'The Handleermittlung via Ole yielding verwertbares lever:
        Anzeige& = Create("Bitmap",%hwnd,.hPic&,0,0)
        OlePic#.GetSize(%hdc2)
        '### zugefuegt ###
        'Print .Width&,.Height&
        SetText szTXT&, Trim$(Str$(.Width&) + "x" + Str$(.Height&))
        SetText type1TXT&, Trim$(Str$(.PicFormat&))
        SetText type2TXT&, Trim$(type2$)
        '###
      EndWith
    EndIf
  EndIf
Wend

If SizeOf(OlePic#)
    OlePic#.Destroy()
    Dispose OlePic#
EndIf
DeleteObject hFont&

End

System: Windows 8/10, XProfan X4
Programmieren, das spannendste Detektivspiel der Welt.

Jörg
Sellmeyer

circa Ico and others Formate goes it me here none. I try, a Ansatz To supplying, How one large Images (The nowadys with each Handy in the Megapixelbereich made go) with Profan Show can. The small Formate functions Yes well with (Create(...)). the a too much is me at last Kontrollgang durchgerutscht. - is too beside the point.

definitive is a Test with pictures (jpg) with at least 3000 x 2000 Pixeln or so. in the area get one with Create(...) even no gültiges lever More, separate only yet zero and can accordingly too weder Show, yet any values read. where Profan already with plenty smaller Images pinch. The boundary lying with about 1 Mio Pixeln total. what even nowadys one joke is.

with Ole does it but. the korrekte lever can itself on one profaneigenen Create("Bitmap",...) Show and the Maße can then even too (if too umständlich) detect.
I Have supra time a korrigierten code reingesetzt.
On The Inch-Umrechnung had so did i come can, as ehemaliger joiner

- thanks for Info.

Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

Michael
W.

2592x1944
2448x3264 (from the white I yet, The has 9 MB)
becomes by me everything with negativem lever displayed.

the Scrolling can with a scrollbaren background achieve.
there Gibts somehow "scrollable Gadget" or so.

The Testteil can out, because Ole the Yes in the handle has.

System: Windows 8/10, XProfan X4
Programmieren, das spannendste Detektivspiel der Welt.

Matthias
Arlt

can I only confirm... Mehrfachtest with pictures larger as ca. 4000x3000 free from problems and durchgängig with negativem Hdl.

WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia

Jörg
Sellmeyer

the negatives hdl isn't unusual. gives it too with smaller Images with profaneigenen Mitteln always time again. but beautiful, that it apparently free from problems works.

i'll the still as Objekt ready make. rather would me but, if Roland The next Profanversion so aufbohrt, that then too large Images so ladbar are.

an such function as externe Possibility lead go ahead double activities, if one feststellt, that Profan no deal produce can or power in the principle The Create("HPIC",...) function superfluously, what indeed not sense the thing is.

XProfan X4
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

Matthias
Arlt

Hm...by me does it with even this large Images too in reinem Profan.
strain time quick under 11.2 tested (again larger 4000x3000)

Compile Mark Separation

declare btn&,pic$,hPic&,hBmp&
window 0,0-%maxx,(%maxy-30)
btn&=create("BUTTON",%hwnd,"Bild...",20,20,60,22)

while 1

    waitinput

    if clicked(btn&)

        pic$=LoadFile $("Bild loading...","*.*")

        if FileExists(pic$)

            case hPic& : deleteobject hPic&
            case hBmp& : destroywindow(hBmp&)
            hPic&=Create("HPIC",-1,pic$)
            hBmp&=Create("Bitmap",%hwnd,hPic&,0,0)

        endif

    endif

wend

case hPic& : deleteobject hPic&

or I Have evtl. the trouble mißverstanden !?

WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia

Jörg
Sellmeyer

Probier time that here: [...]

XProfan X4
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

Matthias
Arlt

Have I now probiert. interestingly is here Yes only The most dissolution. objectively soar Profan thereby from. Verkleinere I now this Image with IrfanView on ca. 90 percent its Size, then works the again with Profan. Therefore is the verarbeitbare boundary for Profan with round 8000x8000.

Nachtrag:
i'm once more whom ungekehrten lane gone and Have one of my own Images on over 8000 vergrößert. too there soar Profan then from. means lying there well the maximum Machbare.

Nachtrag 2:
and because I the now very know wished, Have I time by MCLS ans Limit the Memory bitmap herangetastet. maximum was then with 7905x7905.

WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia

06/06/20 ▲

Michael
W.

means a 64k-boundary?

I have the image time loaded and tested. one sees The Kapverdischen Inseln and Gibraltar. The remainder of gigantischen Image isn't To see. but crash wants to Program not.
can it his, the your just To little memory in the computer have?

8460x8900
I can really not present that here The Bildschirmgröße a strain game. my Samsung screen creates 1920x1080 in the jetzigen attitude.

System: Windows 8/10, XProfan X4
Programmieren, das spannendste Detektivspiel der Welt.

06/10/20 ▲