Wrap objects to an arbitrary width

Share your advanced PureBasic knowledge/code with the community.
Seymour Clufley
Addict
Addict
Posts: 1233
Joined: Wed Feb 28, 2007 9:13 am
Location: London

Wrap objects to an arbitrary width

Post by Seymour Clufley »

Just some code that might be useful to someone. The key procedure is WrapObjectsWithinWidth() - everything else is for demo purposes. The demo reduces the arbitrary width until the objects use 4 rows.

Code: Select all

Procedure RI(img.i,title.s="",fit_on_screen.b=#True,bgclr.i=#Gray,timelimit.i=0,free.b=#False)
	
	If Not IsImage(img)
		Debug "PROC RI (ReportImage):"+c13+"img is not an image!"
		ProcedureReturn
	EndIf
	
	iw.d = ImageWidth(img)
	ih.d = ImageHeight(img)
	
	simg = CreateImage(#PB_Any,iw,ih,32,bgclr)
	StartDrawing(ImageOutput(simg))
	DrawAlphaImage(ImageID(img),0,0)
	StopDrawing()
	
	If fit_on_screen
	  d = ExamineDesktops()
	  kw.d = DesktopWidth(0)
	  kh.d = DesktopHeight(0)
	  While iw>kw Or ih>kh
	    iw * 0.999
	    ih * 0.999
	  Wend
	  ResizeImage(simg,iw,ih)
	EndIf
	
	If title=""
		title = "Report Image"
	EndIf
	
	win = OpenWindow(#PB_Any,0,0,iw,ih,title,#PB_Window_BorderLess|#PB_Window_ScreenCentered)
	
	imgad = ImageGadget(#PB_Any,0,0,iw,ih,ImageID(simg))
	
	escapekey = 1
	spacekey = 2
	returnkey = 3
	AddKeyboardShortcut(win,#PB_Shortcut_Escape,escapekey)
	AddKeyboardShortcut(win,#PB_Shortcut_Space,spacekey)
	AddKeyboardShortcut(win,#PB_Shortcut_Return,returnkey)
	
	If Not WindowID(win) : Debug "CAN'T FIND WINDOW ID" : ProcedureReturn #False : EndIf
  SetWindowPos_(WindowID(win),#HWND_TOPMOST,0,0,0,0,#SWP_NOMOVE|#SWP_NOSIZE)    ; gets it on top to stay 
	
	killtime = ElapsedMilliseconds()+timelimit
	Repeat
		we = WindowEvent()
		If we
			If we=#PB_Event_Menu
				Break
			EndIf
		Else
			Delay(10)
		EndIf
		If timelimit>0 And ElapsedMilliseconds()>killtime : Break : EndIf
	ForEver
	
	CloseWindow(win)
	
	
	FreeImage(simg)
	If free
	  FreeImage(img)
	EndIf
	
EndProcedure

Macro BeatThis(a,b)
  If b>a
    a=b
  EndIf
EndMacro


Structure WrapObjectsRow
  total_w.d
  objects.i
  Array object.i(10)
EndStructure

Procedure.i WrapObjectsWithinWidth(objects.i,Array objWidth.i(1),Array row.WrapObjectsRow(1),max_w.d,margin.d)
  ;Debug "MAX W: "+Str(max_w)
  Dim row(10)
  rows.i = 1
  accum_w.d = 0
  For i = 1 To objects
    If (accum_w+objWidth(i)+margin) > max_w ;Or i=objects
      If i=objects
        ;R("accum_w: "+Str(accum_w)+c13+"max w: "+Str(max_w)+c13+"current image width: "+Str(objWidth(i)))
      EndIf
      row(rows)\total_w = accum_w
      accum_w = 0
      
      rows+1
      If ArraySize(row())<rows : ReDim row(rows+5) : EndIf
      Dim row(rows)\object(10)
    EndIf
    
    row(rows)\objects+1
    If ArraySize(row(rows)\object())<row(rows)\objects : ReDim row(rows)\object(row(rows)\objects+5) : EndIf
    row(rows)\object(row(rows)\objects) = i
    
    accum_w + objWidth(i)+margin
  Next i
  
  If row(rows)\total_w=0
    row(rows)\total_w = accum_w
  EndIf
  For r = 1 To rows
    row(r)\total_w - margin
  Next r
  
  ReDim row(rows)
  
  ProcedureReturn rows
EndProcedure

Procedure.i WrapImagesWithinWidth(images.i,Array img.i(1),Array row.WrapObjectsRow(1),max_w.d,margin.d)
  
  Dim obj.i(images)
  For i = 1 To images
    obj(i) = ImageWidth(img(i))
  Next i
  ProcedureReturn WrapObjectsWithinWidth(images,obj(),row(),max_w,margin)
  
EndProcedure


min_w.d = 0
oh.d = 100
images = Random(30,10)
Dim eimg.i(images)
For a = 1 To images
  eimg(a) = CreateImage(#PB_Any,Random(200,10),oh,32,RGBA(Random(255,40),Random(255,40),Random(255,40),255))
  BeatThis(min_w,ImageWidth(eimg(a)))
Next a
max_w.d = 1800
Dim row.WrapObjectsRow(0)
margin = 10
Repeat
  rows.i = WrapImagesWithinWidth(images,eimg(),row(),max_w,margin)
  If rows=>4
    Break
  EndIf
  max_w * 0.99
  If max_w<=min_w : Break : EndIf
ForEver

iw.d = max_w
ih.d = (rows * (oh+margin))+margin

img.i = CreateImage(#PB_Any,iw,ih,32,#Black)

; left-aligned
StartDrawing(ImageOutput(img))
dy.d = margin
For r = 1 To rows
  dx.d = margin
  For a = 1 To row(r)\objects
    i = row(r)\object(a)
    DrawAlphaImage(ImageID(eimg(i)),dx,dy)
    dx + ImageWidth(eimg(i))+margin
  Next a
  dy + oh+margin
Next r
StopDrawing()
RI(img,"left-aligned")

; centre-aligned
; StartDrawing(ImageOutput(img))
; Box(0,0,OutputWidth(),OutputHeight(),RGBA(0,0,0,255))
; dy.d = margin
; For r = 1 To rows
;   dx.d = (iw/2)-(row(r)\total_w/2)
;   For a = 1 To row(r)\objects
;     i = row(r)\object(a)
;     DrawAlphaImage(ImageID(eimg(i)),dx,dy)
;     dx + ImageWidth(eimg(i))+margin
;   Next a
;   dy + oh+margin
; Next r
; StopDrawing()
; RI(img,"centre-aligned")

; ; right-aligned
; StartDrawing(ImageOutput(img))
; Box(0,0,OutputWidth(),OutputHeight(),RGBA(0,0,0,255))
; dy.d = margin
; For r = 1 To rows
;   dx.d = iw - (row(r)\total_w+margin)
;   For a = 1 To row(r)\objects
;     i = row(r)\object(a)
;     DrawAlphaImage(ImageID(eimg(i)),dx,dy)
;     dx + ImageWidth(eimg(i))+margin
;   Next a
;   dy + oh+margin
; Next r
; StopDrawing()
; RI(img,"right-aligned")

FreeImage(img)
JACK WEBB: "Coding in C is like sculpting a statue using only sandpaper. You can do it, but the result wouldn't be any better. So why bother? Just use the right tools and get the job done."