Hallo, ich Lade in meinem Programm jpegs und bmps und zeige dann vorschaubilder und informationen an, das funktioniert aber nur, wenn ich entweder jpegs oder bmps geladen habe, lade ich eins vom beiden, und dann das andere, dann funktioniert das zu letzt geladene nicht.
Gespeichert werden die Dateinamen in einem Array:
Delphi-Quelltext
1: 2: 3: 4: 5: 6: 7:
| type TWallpaper = record Filename, InfoName: string; end;
var Wallpapers: array of TWallpaper; |
Dort landen die Dateinamen aber nicht beim oben genannten Beispiel, hier mal der Rest-Code:
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102:
| function GetFileSizeEx(const FileName: String): Int64; var F: TSearchRec; begin Result := - 1; if FindFirst(FileName, faAnyFile, F) = 0 then begin try Result := F.FindData.nFileSizeLow or (F.FindData.nFileSizeHigh shl 32); finally SysUtils.FindClose(F); end; end; end;
procedure TMainForm.ShowPreview(Filename: string); var BitmapInfo: TBitmapInfo; begin BitmapInfo := TBitmapInfo.Create; try BitmapInfo.Filename := Filename; BitmapInfo.GetFromFile; LB_Info.Clear; LB_Info.Items.add('Größe: ' + inttostr(getfilesizeex(Filename) div 1024) + ' Kb'); LB_Info.Items.add('Breite: ' + inttostr(BitmapInfo.width) + ' Pixel'); LB_Info.Items.add('Höhe: ' + inttostr(BitmapInfo.height) + ' Pixel'); LB_Info.Items.add('Farbtiefe: ' + inttostr(BitmapInfo.depth) + ' Bit'); if (lowercase(extractfileext(Filename)) = '.jpg') or (lowercase(extractfileext(Filename)) = '.jpeg') or (lowercase(extractfileext(Filename)) = '.bmp') then IMG_Thumb.Picture.LoadFromFile(Filename); finally BitmapInfo.Free; end; end;
procedure TMainForm.LB_ListMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var mpos, lbpos: TPoint; bsitem: integer; begin if ssright in shift then begin getcursorpos(mpos); PM_Wallpaper.Popup(mpos.x, mpos.y); end; if ssleft in shift then begin if LB_List.count < 1 then exit; lbpos.X := x; lbpos.Y := y; bsitem := LB_List.ItemAtPos(lbpos, true); if bsitem < 0 then exit; ShowPreview(Wallpapers[bsitem].Filename); end; end;
procedure TMainForm.FormCreate(Sender: TObject); begin SetLength(Wallpapers, 1); with IMG_Thumb.Canvas do begin Brush.Color := clwhite; FillRect(IMG_Thumb.ClientRect); end; end;
procedure TMainForm.Wallpaperhinzufgen1Click(Sender: TObject); var i: integer; begin if openpictureDialog1.Execute then for i := 0 to openpicturedialog1.Files.count - 1 do begin Wallpapers[i].Filename := openpicturedialog1.Files[i]; Wallpapers[i].InfoName := ExtractFileName(openpicturedialog1.Files[i]); LB_List.Items.Add(Wallpapers[i].InfoName); SetLength(Wallpapers, length(Wallpapers) + 1); end; end;
procedure TMainForm.LB_ListKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); var bsitem: integer; i: integer; begin if (key = vk_left) or (key = vk_right) or (key = vk_up) or (key = vk_down) then begin if LB_List.count < 1 then exit; for i := 0 to LB_List.Items.Count - 1 do if LB_List.Selected[i] = true then begin bsitem := i; break; end; ShowPreview(Wallpapers[bsitem].Filename); end; end; |
Danke schonmal
