Resize Image Intelli

Übersicht

BlitzBasic

Codearchiv

	AMY Betreff: Resize Image Intelli	Fr, Jan 13, 2006 23:15 Antworten mit Zitat
Hallo erstmal. Ich habe hier mal nen bischen mit resizeimage rumgespielt weil ich es immer schiesse fand das man bilder nicht dabei im format halten konnte. Vielleicht sucht ja jemand sotetwas. Viel Spass damit. Code: [AUSKLAPPEN] [EINKLAPPEN] screenx=1024 screeny=768 Graphics screenx,screeny,32,2 filename$=CommandLine() If Asc(Left$(filename$,1))=34 Then filename1$=Mid$(filename$,2,Len(filename)-2) Else filename1$=filename readimg=LoadImage(filename) x=ImageWidth(readimg) y=ImageHeight(readimg) If x>resolutionx Or y>resolutiony Or x>resolutionx And y>resolutiony Then resizecool(x,y,screenx,screeny,readimg) Function resizecool(pixelx,pixely,screenx,screeny,image) pixelx1#=pixelx pixely1#=pixely wert#=pixelx1/pixely1 wert2#=pixely1/pixelx1 Repeat If pixelx>screenx And pixely>screeny Then pixelx=pixelx-1 pixely=pixely-1 End If If pixelx>screenx And pixely<screeny Then pixelx=pixelx-1 pixely=pixely-1 End If If pixelx<screenx And pixely>screeny Then pixelx=pixelx-1 pixely=pixely-1 End If If pixelx<screenx And pixely<screeny Then pixelx=pixelx+1 pixely=pixely+1 End If If pixelx=screenx And pixely<screeny Then pixely=pixelx/wert:Exit If pixely=screeny And pixelx<screenx Then pixelx=pixely/wert2:Exit Forever If pixelx=screenx Then drawy=(screeny-pixely)/2 If pixely=screeny Then drawx=(screenx-pixelx)/2 ResizeImage image,pixelx,pixely DrawImage Image,drawx,drawy Stop End Function
Projekte: www.amyscbi.de I never comment my sourcecode. What's HARD to write must be HARD to read!

AMY

Betreff: Resize Image Intelli

Fr, Jan 13, 2006 23:15
Antworten mit Zitat

Hallo erstmal. Ich habe hier mal nen bischen mit resizeimage rumgespielt weil ich es immer schiesse fand das man bilder nicht dabei im format halten konnte. Vielleicht sucht ja jemand sotetwas. Viel Spass damit.
Code: [AUSKLAPPEN]

screenx=1024
screeny=768
Graphics screenx,screeny,32,2

filename$=CommandLine()
If Asc(Left$(filename$,1))=34 Then filename1$=Mid$(filename$,2,Len(filename)-2) Else filename1$=filename
readimg=LoadImage(filename)
x=ImageWidth(readimg)
y=ImageHeight(readimg)
If x>resolutionx Or y>resolutiony Or x>resolutionx And y>resolutiony Then resizecool(x,y,screenx,screeny,readimg)

Function resizecool(pixelx,pixely,screenx,screeny,image)
pixelx1#=pixelx
pixely1#=pixely
wert#=pixelx1/pixely1
wert2#=pixely1/pixelx1
Repeat
If pixelx>screenx And pixely>screeny Then
pixelx=pixelx-1
pixely=pixely-1
End If
If pixelx>screenx And pixely<screeny Then
pixelx=pixelx-1
pixely=pixely-1
End If
If pixelx<screenx And pixely>screeny Then
pixelx=pixelx-1
pixely=pixely-1
End If
If pixelx<screenx And pixely<screeny Then
pixelx=pixelx+1
pixely=pixely+1
End If
If pixelx=screenx And pixely<screeny Then pixely=pixelx/wert:Exit
If pixely=screeny And pixelx<screenx Then pixelx=pixely/wert2:Exit
Forever
If pixelx=screenx Then drawy=(screeny-pixely)/2
If pixely=screeny Then drawx=(screenx-pixelx)/2
ResizeImage image,pixelx,pixely
DrawImage Image,drawx,drawy
Stop
End Function

Projekte: www.amyscbi.de
I never comment my sourcecode. What's HARD to write must be HARD to read!

	AMY	Sa, Jan 14, 2006 14:54 Antworten mit Zitat
Ups Habe gemerkt das es bei einigen bilder nicht funktioniert da das Programm eine schleife hat aus der es bei bestimmten verhältnissen nicht wieder rauskommt. Deshalb die Berichtigte verion: Code: [AUSKLAPPEN] [EINKLAPPEN] screenx=1024 screeny=768 Graphics screenx,screeny,32,2 filename$=CommandLine() If Asc(Left$(filename$,1))=34 Then filename1$=Mid$(filename$,2,Len(filename)-2) Else filename1$=filename readimg=LoadImage(filename1) x=ImageWidth(readimg) y=ImageHeight(readimg) ;If x>screenx Or y>screeny Or x>screenx And y>screeny Then ;---- Millisecs for 1600x1200 to 1024x768 ;resizecool(x,y,screenx,screeny,readimg) If x>screenx Or y>screeny Or x>screenx And y>screeny Then ;6416 Millisecs for 1600x1200 to 1024x768 resizecool2(x,y,screenx,screeny,readimg) Else drawy=(screeny-y)/2 drawx=(screenx-x)/2 DrawImage readimg,drawx,drawy WaitKey End If End Function resizecool2(pixelx,pixely,screenx,screeny,image) start=MilliSecs() pixelx1#=pixelx pixely1#=pixely wert#=pixelx1/pixely1 wert2#=pixely1/pixelx1 If pixelx>screenx Then difx=pixelx-screenx If pixelx<screenx Then difx=screenx-pixelx If pixely>screeny Then dify=pixely-screeny If pixely<screeny Then dify=screeny-pixely If difx>dify Then pixelx1=pixelx-difx pixely1=pixelx/wert Else pixely=pixely-dify pixelx=pixely/wert2 End If drawy=(screeny-pixely)/2 drawx=(screenx-pixelx)/2 ResizeImage image,pixelx,pixely DrawImage Image,drawx,drawy Ende=MilliSecs() Zeit=Ende-Start WaitKey Cls Text screenx/2,screeny/2,Zeit+" Millisecs needed",1,1 WaitKey End Function
Projekte: www.amyscbi.de I never comment my sourcecode. What's HARD to write must be HARD to read!

AMY

Sa, Jan 14, 2006 14:54
Antworten mit Zitat

Ups Habe gemerkt das es bei einigen bilder nicht funktioniert da das Programm eine schleife hat aus der es bei bestimmten verhältnissen nicht wieder rauskommt. Deshalb die Berichtigte verion:

Code: [AUSKLAPPEN]

screenx=1024
screeny=768
Graphics screenx,screeny,32,2

filename$=CommandLine()
If Asc(Left$(filename$,1))=34 Then filename1$=Mid$(filename$,2,Len(filename)-2) Else filename1$=filename
readimg=LoadImage(filename1)
x=ImageWidth(readimg)
y=ImageHeight(readimg)
;If x>screenx Or y>screeny Or x>screenx And y>screeny Then ;---- Millisecs for 1600x1200 to 1024x768
;resizecool(x,y,screenx,screeny,readimg)
If x>screenx Or y>screeny Or x>screenx And y>screeny Then ;6416 Millisecs for 1600x1200 to 1024x768
resizecool2(x,y,screenx,screeny,readimg)
Else
drawy=(screeny-y)/2
drawx=(screenx-x)/2
DrawImage readimg,drawx,drawy
WaitKey
End If
End

Function resizecool2(pixelx,pixely,screenx,screeny,image)
start=MilliSecs()
pixelx1#=pixelx
pixely1#=pixely
wert#=pixelx1/pixely1
wert2#=pixely1/pixelx1
If pixelx>screenx Then difx=pixelx-screenx
If pixelx<screenx Then difx=screenx-pixelx
If pixely>screeny Then dify=pixely-screeny
If pixely<screeny Then dify=screeny-pixely
If difx>dify Then
pixelx1=pixelx-difx
pixely1=pixelx/wert
Else
pixely=pixely-dify
pixelx=pixely/wert2
End If
drawy=(screeny-pixely)/2
drawx=(screenx-pixelx)/2
ResizeImage image,pixelx,pixely
DrawImage Image,drawx,drawy
Ende=MilliSecs()
Zeit=Ende-Start
WaitKey
Cls
Text screenx/2,screeny/2,Zeit+" Millisecs needed",1,1
WaitKey
End Function

Projekte: www.amyscbi.de
I never comment my sourcecode. What's HARD to write must be HARD to read!

	Dreamora	Sa, Jan 14, 2006 15:00 Antworten mit Zitat
~ moved ~ Danke Suco - Habe gleich noch die Code Tags korrigiert, das nächste Mal bitte "bbcode" nicht deaktivieren. [Syntax] geht nicht mehr, [code] stattdessen verwenden. Dreamora
Ihr findet die aktuellen Projekte unter Gayasoft und könnt mich unter @gayasoft auf Twitter erreichen.

Dreamora

Sa, Jan 14, 2006 15:00
Antworten mit Zitat

~ moved ~

Danke Suco Smile

- Habe gleich noch die Code Tags korrigiert, das nächste Mal bitte "bbcode" nicht deaktivieren. [Syntax] geht nicht mehr, [code] stattdessen verwenden.
Dreamora

Ihr findet die aktuellen Projekte unter Gayasoft und könnt mich unter @gayasoft auf Twitter erreichen.

	AMY	Sa, Jan 14, 2006 19:54 Antworten mit Zitat
danke. benutze immer den button bb-code. sehe aber nicht so richtig durch wie das geht. sorry
Projekte: www.amyscbi.de I never comment my sourcecode. What's HARD to write must be HARD to read!