Bildgröße anpassen (Aspect Ratio)

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
diceman
Beiträge: 347
Registriert: 06.07.2017 12:24
Kontaktdaten:

Bildgröße anpassen (Aspect Ratio)

Beitrag von diceman »

Ich komme dieser Tage einfach zu nix ... :cry:
Zu nix Großem, um genau zu sein. So kleine Codeschnipsel bastel ich aber gelegentlich ganz gerne, einfach um in Form zu bleiben.
Die folgende Prozedur behält die korrekten Seitenverhältnisse, auch wenn der resize-Funktion nur ein Wert (x oder y) mitgeteilt wird.
Die entsprechende Funktion ist autonom und lässt sich leicht in eigene Projekte einpflegen.

Anleitung zum Testen:
- Einfach ein beliebiges Bild im .jpg -Format ins selbe Verzeichnis wie das Code-File ablegen und in "myPic.jpg" umbenennen
- der aspectResize(myPic,newX,newY)-Prozedur neue Parameter mitteilen. Wenn einer der beiden Werte 0 ist, wird die Größe fürs korrekte Seitenverhältnis automatisch berechnet.

Code: Alles auswählen

EnableExplicit
UseJPEGImageDecoder()

Declare aspectResize(picID,newX,newY,isRaw)
Declare showImage()

#xRes = 1024
#yRes = 768
Global screen
Global myPic = LoadImage(#PB_Any,"myPic.jpg")

If InitSprite()
	screen = OpenWindow(#PB_Any,0,0,#xRes,#yRes,"Base",#PB_Window_ScreenCentered)
	If OpenWindowedScreen(WindowID(screen),0,0,#xRes,#yRes)
		InitKeyboard()
	EndIf
EndIf


aspectResize(myPic,1024,768,#True)
showImage()




Procedure showImage()
	Repeat
		ClearScreen(RGB(0,0,0))
		If StartDrawing(ScreenOutput())
			DrawImage(ImageID(myPic),0,0)
			StopDrawing()
		EndIf
		FlipBuffers()	
		
		ExamineKeyboard()
		
		WaitWindowEvent(1)
	Until KeyboardPushed(#PB_Key_Escape)
EndProcedure


Procedure aspectResize(picID,newX,newY,isRaw)
	Define x = ImageWidth(picID)
	Define y = ImageHeight(picID)
	Define factor.f

	If newX And newY = 0
		factor = y/x
		newY = newX*factor
	EndIf
	If newX = 0 And newY
		factor = x/y
		newX = newY*factor
	EndIf
	If newX And newY
		If isRaw
			isRaw = #PB_Image_Raw
		EndIf
		ResizeImage(picID,newX,newY,isRaw)
		ProcedureReturn #True ;Optionales Feedback, ob Bildgroesse veraendert wurde
	EndIf
EndProcedure
Zuletzt geändert von diceman am 13.07.2019 13:25, insgesamt 4-mal geändert.
Now these points of data make a beautiful line,
And we're out of Beta, we're releasing on time.
Benutzeravatar
Mijikai
Beiträge: 754
Registriert: 25.09.2016 01:42

Re: Bildgröße anpassen (Aspect Ratio)

Beitrag von Mijikai »

Nette Funktion,
ich hoffe das die Zeit bald wider gutmütiger ist :)
Das Problem kenne ich.
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: Bildgröße anpassen (Aspect Ratio)

Beitrag von RSBasic »

:allright:
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Antworten