14.09.2023 10:31

Chyba aplikace Notes: Soubor neexistuje. (profile)
10.05.2023 07:53

Co se děje ? Jak se pracuje v jazyce vzorců ? (2)
21.04.2023 14:15

Co se starou dokumentací k R3, R4, ...?
05.04.2023 14:41

Událost, při neexistenci přílohy. (2)
05.04.2023 11:51

Jak zjistit vložení přílohy. (4)
21.03.2023 11:14

Rámec nebo okno ? (10)
22.02.2023 10:14

Vylepseni designera 9.01 (3)
02.02.2023 20:27

Možná jste se také setkali s klasickým problémem: k dokumentu je přiložen (Attache) GIF nebo JPEG obrázek a vy ve formuláři na něj generujete odkaz. A nastává problém - je velmi vhodné do "IMG" tagu uvést rozměry obrázku, aby prohlížeč pro něj včas vyhradil příslušné místo. Kde je vzít?
Samozřejmě, přímo ze souboru - jsou uloženy přímo v hlaviččce GIF nebo JPEG dokumentu. Stačí si tedy v okamžiku načtení souboru tyto údaje poznamenat do dokumentu a ve vhodný okamžik je využít.
Dim header As String
Dim filename As String
Dim f As Integer
Dim wHi As Variant
Dim wLo As Variant
Dim hHi As Variant
Dim hLo As Variant
Dim w As Integer ' šířka obrázku
Dim h As Integer ' výška obrázku
filename="c:\picture.gif" ' jméno obrázku
f = Freefile()
Open filename For Input As #f
If Lcase(Right(filename, 3))="gif" Then
header = Input(10, f)
Close #f
wHi = Mid(header, 8, 1)
wLo = Mid(header, 7, 1)
hHi = Mid(header, 10, 1)
hLo = Mid(header, 9, 1)
w = Asc(wHi) * 256 + Asc(wLo)
h = Asc(hHi) * 256 + Asc(hLo)
Elseif Lcase(Right(filename, 3))="jpg" Then
header = Input(167, f)
Close #f
wHi = Asc(Midbp(header, 166, 1))
wLo = Asc(Midbp(header, 167, 1))
hHi = Asc(Midbp(header, 164, 1))
hLo = Asc(Midbp(header, 165, 1))
w = (wHi) * 256 + (wLo)
h = (hHi) * 256 + (hLo)
End If
Příklad byl převzat z diskuzního fóra, ještě by se samozřejmě dal hodně vylepšit (např. nespoléhat se ve zjištění typu obrázku na příponu a provést přímo analýzu hlavičky, doplnit podporu PNG formátu atd.) ale použít se dá velmi dobře.
Autor: Zdeněk Michálek
Datum: 26.03.2001
Sdílet článek Seznam komentářů
Zatím nebyl přidán žádný komentář. Buďte první!