Autor |
Beitrag |
hRb
Beiträge: 269
Erhaltene Danke: 12
|
Verfasst: So 29.07.18 23:31
Hallo Freunde,
ich möchte auf eine früher gestellte Frage zurückkommen: "ImageList - schnelle Anzeige". Dort hat jaenicke eine Funktion vorgestellt um DateiIcons in einer Listview anzuzeigen. Das Icon erscheint in der vorgegebenen Größe von 160x120 Pixel (B x H), wird jedoch in der Listview mit einem weißen Rahmen umgeben. Die Höhe passt sich automatisch einem evtl. unterlegten Caption-Text an. In der Breite jedoch entsteht nach rechts wie links ein ca. 40 Pixel breiter Rand. Dieser Rand ist mir viel zu breit (10-15 Pixel wären ausreichend). Ich kann den Parameter zur Veränderung aber weder im Programm noch in den Objektdaten finden. Wo stellt man den Rand-Wert ein?
Danke für Eure Hilfe. hRb
Einloggen, um Attachments anzusehen!
|
|
hRb
Beiträge: 269
Erhaltene Danke: 12
|
Verfasst: Mo 01.10.18 14:27
Hallo,
keine einzige Antwort nach 2 Monaten? Ich gebe nochmals den Code von jaenicke der die Thumbnails liefert.
Nochmals die Frage: welcher Parameter entscheidet, dass nach links und rechts 40 Pixel als Rahmen entstehen? Am Format 120x160 (Differenz = 40) liegt es nicht. Bei quadratischen Zuschnitt z.B. Smallimiges.Height=120, SmallImiges.Weidth=120 bleibt der Abstand konstant bei 40 Picel. Der Explorer hat z.B. nur ca. 5 Pixel in der Ansicht "Große Symbole". Vielleicht hat der Entwickler jaenicke noch eine Idee?
Mfg hRb
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: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143:
| uses Winapi.ShlObj, Winapi.ActiveX;
const CLSID_LocalThumbnailCache: TGuid = '{50EF4544-AC9F-4A8E-B21B-8A26180DB13F}'; CLSID_SharedBitmap: TGuid = '{4db26476-6787-4046-b836-e8412a9e8a27}';
WTS_NONE = $00000000; WTS_EXTRACT = $00000000; WTS_INCACHEONLY = $00000001; WTS_FASTEXTRACT = $00000002; WTS_FORCEEXTRACTION = $00000004; WTS_SLOWRECLAIM = $00000008; WTS_EXTRACTDONOTCACHE = $00000020; WTS_SCALETOREQUESTEDSIZE = $00000040; WTS_SKIPFASTEXTRACT = $00000080; WTS_EXTRACTINPROC = $00000100; WTS_CROPTOSQUARE = $00000200; WTS_INSTANCESURROGATE = $00000400; WTS_REQUIRESURROGATE = $00000800; WTS_APPSTYLE = $00002000; WTS_WIDETHUMBNAILS = $00004000; WTS_IDEALCACHESIZEONLY = $00008000; WTS_SCALEUP = $00010000; WTS_DEFAULT = 0; WTS_LOWQUALITY = 1; WTS_CACHED = 2; WTSAT_UNKNOWN = 0; WTSAT_RGB = 1; WTSAT_ARGB = 2;
type WTS_FLAGS = LongInt; WTS_CACHEFLAGS = LongInt; WTS_ALPHATYPE = LongInt;
WTS_THUMBNAILID = record rgbKey: array [0 .. 15] of Byte; end;
ISharedBitmap = interface(IUnknown) ['{091162a4-bc96-411f-aae8-c5122cd03363}'] function GetSharedBitmap(out phbm: HBITMAP): HRESULT; stdcall; function GetSize(out pSize: TSize): HRESULT; stdcall; function GetFormat(out pat: WTS_ALPHATYPE): HRESULT; stdcall; function InitializeBitmap(hbm: HBITMAP; wtsAT: WTS_ALPHATYPE): HRESULT; stdcall; function Detach(out phbm: HBITMAP): HRESULT; stdcall; end;
IThumbnailCache = interface(IUnknown) ['{F676C15D-596A-4ce2-8234-33996F445DB1}'] function GetThumbnail(pShellItem: IShellItem; cxyRequestedThumbSize: UINT; flags: WTS_FLAGS; out ppvThumb: ISharedBitmap; out pOutFlags: WTS_CACHEFLAGS; out pThumbnailID: WTS_THUMBNAILID): HRESULT; stdcall; function GetThumbnailByID(thumbnailID: WTS_THUMBNAILID; cxyRequestedThumbSize: UINT; out ppvThumb: ISharedBitmap; out pOutFlags: WTS_CACHEFLAGS): HRESULT; stdcall; end;
function GetThumbnail(const AFilename: string; const ATarget: TBitmap; const ARequestedThumbSize: integer): HRESULT; type TRGBTripleArray = array[Word] of TRGBTriple; pRGBTripleArray = ^TRGBTripleArray; var ThumbnailCache: IThumbnailCache; ShellItem: IShellItem; Thumb: ISharedBitmap; OutFlags: WTS_CACHEFLAGS; ThumbnailID: WTS_THUMBNAILID; ThumbnailSize: TSize; hbm: HBITMAP; Col, Line: integer; SourceLine, TargetLine: pRGBTripleArray; Tmp: TRGBTriple; begin Result := CoInitialize(nil); if Succeeded(Result) then try Result := CoCreateInstance(CLSID_LocalThumbnailCache, nil, CLSCTX_INPROC, IThumbnailCache, ThumbnailCache); if Succeeded(Result) then begin Result := SHCreateItemFromParsingName(PChar(AFilename), nil, IShellItem, ShellItem); if Succeeded(Result) then begin Result := ThumbnailCache.GetThumbnail(ShellItem, ARequestedThumbSize, WTS_EXTRACT or WTS_SCALETOREQUESTEDSIZE, Thumb, OutFlags, ThumbnailID); if Succeeded(Result) then begin Thumb.GetSize(ThumbnailSize); Result := Thumb.GetSharedBitmap(hbm); if Succeeded(Result) then begin ATarget.SetSize(ThumbnailSize.cx, ThumbnailSize.cy); ATarget.Handle := hbm; ATarget.Dormant; ATarget.PixelFormat := pf24bit; for Line := 0 to (ATarget.Height div 2) - 1 do begin SourceLine := ATarget.ScanLine[Line]; TargetLine := ATarget.ScanLine[ATarget.Height - Line - 1]; for Col := 0 to ATarget.Width - 1 do begin Tmp := TargetLine[Col]; TargetLine[Col] := SourceLine[Col]; SourceLine[Col] := Tmp; end; end; end; end; end; end; finally CoUninitialize; end; end;
procedure TForm37.Button1Click(Sender: TObject); var Tmp: TBitmap; begin Tmp := TBitmap.Create; try if Succeeded(GetThumbnail(Edit1.Text, Tmp, Image1.Width)) then Image1.Picture.Assign(Tmp); finally Tmp.Free; end; end; |
|
|
Sinspin
Beiträge: 1328
Erhaltene Danke: 118
Win 10
RIO, CE, Lazarus
|
Verfasst: Di 02.10.18 07:50
Du suchst an der falschen Stelle. Das sieht mir nicht danach aus als wenn das was mit der Thumbnail Erzeugung zu tuen hat. Ich würde mich da eher mal mit dem Quelltext des Listview befassen.
Ist ja auch gut an deinem Screeshot zu erkennen. Das Bild ist der Schwarz umrandete Teil in der Mitte. Alles andere ist Listview.
_________________ Wir zerstören die Natur und Wälder der Erde. Wir töten wilde Tiere für Trophäen. Wir produzieren Lebewesen als Massenware um sie nach wenigen Monaten zu töten. Warum sollte unser aller Mutter, die Natur, nicht die gleichen Rechte haben?
|
|
hRb
Beiträge: 269
Erhaltene Danke: 12
|
Verfasst: Di 09.10.18 21:32
Hallo Sinspin,
das könnte durchaus sein. Zum Füllen der Listview nutze ich nachstehende Befehlsfolge. Dort verwende ich die Procedure GetFileIcon mit den Parametern:
- SizeOf(shInfo) = 692
- SHGFI_ICON = 256
- SHGFI_LARGEICON = 0
alle Werte sind jedoch (selbst im Debugger) nicht änderbar. Andere Parameter, die die Icon-Breite beeinflussen könnten, kann ich nicht mehr erkennen.
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:
| procedure GetFileIcon(AFileName: string; Output: TIcon); var shInfo: TSHFileInfo; begin SHGetFileInfo(PChar(AFileName), 0, shInfo, SizeOf(shInfo), SHGFI_ICON or SHGFI_LARGEICON); Output.Handle := shInfo.hIcon; end;
procedure FuelleListView; const cLgmax = 40; var anz, i: integer; item : TListItem; s : string; ico : TIcon; begin with Form1, StringGrid1 do begin Screen.Cursor := crHourGlass; ImageList1.Clear; Listview1.Clear; anz:= RowCount-1 ; ico := TIcon.Create; for i:=1 to anz do begin s := LabelPfad.Caption + Cells[2,i] + Cells[3,i]; if length(Cells[2,i])>0 then begin if not AddThumb(s, ImageList1) then begin try GetFileIcon(s, ico); ImageList1.AddIcon(ico); finally end; end; end; end; ico.Free; ListView1.LargeImages := ImageList1; for i := 0 to ImageList1.Count -1 do begin item := ListView1.Items.Add; s:= Cells[2,i+1] + Cells[3,i+1]; if length(s) > cLgmax then Insert(chr(ord(10)),s,cLgmax); if length(s) > 2*cLgmax+1 then Insert(chr(ord(10)),s,2*cLgmax+1); item.Caption := s; item.ImageIndex := i; end; Screen.Cursor := crDefault; end; end; |
Daneben sind noch folgende Funktionen mit im Spiel. Aber bei allen ist kein Parameter zur Icon-Breite erkennbar. Oder doch???
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: 103: 104: 105: 106: 107: 108:
| function GetThumbnail(const AFilename: string; const ATarget: TBitmap; const ARequestedThumbSize: integer): HRESULT; type TRGBTripleArray = array[Word] of TRGBTriple; pRGBTripleArray = ^TRGBTripleArray; var ThumbnailCache: IThumbnailCache; ShellItem: IShellItem; Thumb: ISharedBitmap; OutFlags: WTS_CACHEFLAGS; ThumbnailID: WTS_THUMBNAILID; ThumbnailSize: TSize; hbm: HBITMAP; Col, Line: integer; SourceLine, TargetLine: pRGBTripleArray; Tmp: TRGBTriple;
begin Result := CoInitialize(nil); if Succeeded(Result) then try Result := CoCreateInstance(CLSID_LocalThumbnailCache, nil, CLSCTX_INPROC, IThumbnailCache, ThumbnailCache); if Succeeded(Result) then begin Result := SHCreateItemFromParsingName(PChar(AFilename), nil, IShellItem, ShellItem); if Succeeded(Result) then begin Result := ThumbnailCache.GetThumbnail(ShellItem, ARequestedThumbSize, WTS_EXTRACT or WTS_SCALETOREQUESTEDSIZE, Thumb, OutFlags, ThumbnailID); if Succeeded(Result) then begin Thumb.GetSize(ThumbnailSize); Result := Thumb.GetSharedBitmap(hbm); if Succeeded(Result) then begin ATarget.SetSize(ThumbnailSize.cx, ThumbnailSize.cy); ATarget.Handle := hbm; ATarget.Dormant; ATarget.PixelFormat := pf24bit; for Line := 0 to (ATarget.Height div 2) - 1 do begin SourceLine := ATarget.ScanLine[Line]; TargetLine := ATarget.ScanLine[ATarget.Height - Line - 1]; for Col := 0 to ATarget.Width - 1 do begin Tmp := TargetLine[Col]; TargetLine[Col] := SourceLine[Col]; SourceLine[Col] := Tmp; end; end; end; end; end; end; finally CoUninitialize; end; end;
function AddThumb(AFileName : string; AImageList : TImageList):boolean; var tmpThumb : TBitmap; tmpImage : TBitmap; x,y : integer; f : integer; begin Result := false; tmpImage := TBitmap.Create; try tmpImage.Width := AImageList.Width; tmpImage.Height := AImageList.Height;
tmpImage.Canvas.Rectangle(tmpImage.Canvas.ClipRect);
tmpThumb := TBitmap.Create; try if Succeeded(GetThumbnail(AFileName, tmpThumb, AImageList.Width)) then begin
if tmpThumb.Height > tmpImage.Height then begin f := Trunc((tmpThumb.Width / tmpThumb.Height) * AImageList.Height); GetThumbnail(AFileName, tmpThumb, max(f,AImageList.Height)); end;
x := (tmpImage.Width - tmpThumb.Width) div 2; y := (tmpImage.Height - tmpThumb.Height) div 2; tmpImage.Canvas.Draw(x,y,tmpThumb);
try AImageList.Add(tmpImage,nil); Result := True; except end; end; finally tmpThumb.Free; end; finally tmpImage.Free; end; end; |
|
|
mandras
Beiträge: 430
Erhaltene Danke: 107
Win 10
Delphi 6 Prof, Delphi 10.4 Prof
|
Verfasst: Di 09.10.18 22:00
Deine Icons sind 160*120.
Die Euroflagge 1600*1200.
Nur diese wird korrekt angezeigt.
Das bringt mich in die Denkrichtung daß die vorliegenden Grafiken so skaliert werden daß ihre Breite 160 beträgt,
die Höhe wird proportional skaliert. Und wenn die Höhe zu gering ist entstehen weiße Ränder O+U.
Probiere einmal mit Bildern mit Breite < Höhe und ob dann rechts/links Ränder erscheinen.
Ich vermute bis hier daß die Ränder durchaus normales Verhalten darstellen.
|
|
hRb
Beiträge: 269
Erhaltene Danke: 12
|
Verfasst: Di 09.10.18 23:47
Nein, die Icongröße hat nichts mit der Originalgröße eines Bildes oder der Datei zu tun. Es geht hier um einen Dateibetrachter. D.h. es werden nicht nur Bilder, sondern alle Dateien eines Ordners angezeigt als Thumbnail, ähnlich dem Windows-Explorer. siehe beigefügtes Bild. Die Icon-Größe in der Imagelist ist von mir auf 160x120 eingestellt. Es geht darum, dass dem Thumbnail in der Listview-Darstellung noch ca 2x40 Pixel nach rechts und links zugefügt werden. Die 40 Pixel entstehen nicht aus der Differenz von 160-120. Wo also wird die "Rahmenbreite" festgelegt?
Wer die Vorgeschichte zur Frage verfolgen möchte kann die Vorstufe meines Programms herunter laden. Bereitgestellt hier im Forum als Datei "ChangeFileNameNew.zip" unter der Frage "ImageList - schnelle Anzeige" 2. Seite mein Beitrag vom Fr 15.06.18 22:52 Uhr vor ca 3 Monaten.
Gruß hRb
Einloggen, um Attachments anzusehen!
|
|
Sinspin
Beiträge: 1328
Erhaltene Danke: 118
Win 10
RIO, CE, Lazarus
|
Verfasst: Mi 10.10.18 18:11
mandras hat folgendes geschrieben : | Deine Icons sind 160*120.
Die Euroflagge 1600*1200.
Nur diese wird korrekt angezeigt. |
Wenn ich das richtig verstanden habe geht es nicht um das zentrale Ausrichten innerhalb des Items. Es geht um den irren Abstand zwischen den Items.
Allerdings wäre es dann total sinnfrei noch immer auf den Funktionen zur Thumbnailgenerierung rumzureiten, anstatt die Einstellungen der Listview mal unter die Lupe zu nehmen.
_________________ Wir zerstören die Natur und Wälder der Erde. Wir töten wilde Tiere für Trophäen. Wir produzieren Lebewesen als Massenware um sie nach wenigen Monaten zu töten. Warum sollte unser aller Mutter, die Natur, nicht die gleichen Rechte haben?
Zuletzt bearbeitet von Sinspin am Mi 10.10.18 18:35, insgesamt 1-mal bearbeitet
|
|
mandras
Beiträge: 430
Erhaltene Danke: 107
Win 10
Delphi 6 Prof, Delphi 10.4 Prof
|
Verfasst: Mi 10.10.18 18:26
Ja, jetzt habe ich es verstanden.
Es gibt in Unit Winapi.CommCtrl eine Funktion:
Listview_SetIconSpacing (Handle, cx, cy)
Die wirkt aber nur bis zur nächsten Änderung der LV-Größe.
|
|
hRb
Beiträge: 269
Erhaltene Danke: 12
|
Verfasst: Do 11.10.18 15:48
Hallo mandras,
genau das ist es! Parameter cx,cy sind offensichtlich im System voreingestellt. Ich habe jetzt mit den Parametern ein wenig gespielt. Wird cy zu klein, dann kann es zu unschönen Effekten kommen, z.B. bei langen Dateinamen (.Caption) bleibt das darunterliegende Feld leer. Bei noch kleineren cy korrigiert das System wohl automatisch. Bei zu kleinen cx überlagern sich die Bilder (weil Icon 160x120). Der Wert 0 verändert die Voreinstellungen nicht. So funktioniert z.B. cx=180, cy=0 bestens. Tatsächlich wirkt die Änderung nur bis zur nächsten ListView-Größenänderung. Muss nun prüfen in welche Routinen der Aufruf überall hinzugefügt werden muss.
Aber Frage/Problem damit gelöst.
Vielen Dank!!! hRb
|
|
hRb
Beiträge: 269
Erhaltene Danke: 12
|
Verfasst: So 14.10.18 16:33
Ich muss mich abschließend nochmals korrigieren. Der Wert 0 bedeutet nicht, dass die Voreinstellung des Systems erhalten bleibt (führt bei Form1-Änderung doch zu Überlappungen). Für alle die die Funktionen nutzen also der Hinweis:
cx muss größer sein als ImageList1.Width und cy > ImageList1.Height. Gute Werte, damit auch längere Dateinamen nicht abgeschnitten werden sind bei 160 x 120 (siehe unten). Sofern Bildunteltitel der Dateiname ist, empfiehlt sich automatischer Textumbruch wie folgt:
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15:
| const cLgmax = 40; ... Listview_SetIconSpacing (Listview1.Handle, cItemWidth , cItemHeight); ListView1.LargeImages := ImageList1; for i := 0 to ImageList1.Count -1 do begin item := ListView1.Items.Add; s:= StringGrid1.Cells[2,i+1] ; if length(s) > cLgmax then Insert(chr(ord(10)),s,cLgmax); if length(s) > 2*cLgmax+1 then Insert(chr(ord(10)),s,2*cLgmax+1); item.Caption := s; item.ImageIndex := i; end; |
Damit die Anzeige bei Form- oder Panel-Größenänderung korrekt funktioniert, muss das Resize-Ereignis gefüllt werden.
Delphi-Quelltext 1: 2: 3: 4:
| procedure TForm1.ListView1Resize(Sender: TObject); begin Listview_SetIconSpacing (Listview1.Handle, cItemWidth , cItemHeight); end; |
|
|
|