// Mit der Function MinimizeName kann man die Breite eines Datei-Pfades
// (in Pixeln) kürzen. Beispielsweise ergibt

// pfad:='C:\Eigene Dateien\Eigene Webs\_themes\expeditn\color1.css';
// label1.caption:=minimizename(pfad,label1.canvas,200);

// die gekürzte Ausschrift 'C:\...\_themes\expeditn\color1.css'.

// Das funktioniert aber nicht mehr, wenn der Dateiname selbst (ohne Pfadangabe)
// schon eine größere Breite (in Pixeln) hat als die vorgegebene Breite.
// Dann wird trotzdem der Dateiname mit voller Buchstabenanzahl ausgegeben.
// Deshalb die folgende Prozedur:

// Getestet mit D4 unter Win98

// Variante 1: Für TLabel. "AutoSize" des Labels muß "True" sein

uses FileCtrl; 
 
procedure mininame(pfad: string; breite: word; lbl: Tlabel); 
const punkte = '...'; 
var lg: integer; 
begin 
  lbl.caption := minimizename(pfad, lbl.canvas, breite); 
  if lbl.width > breite then begin 
    lg := breite - lbl.canvas.textwidth(punkte); 
    while lbl.width > lg do 
      lbl.caption := copy(lbl.caption, 1, length(lbl.caption) - 1); 
    lbl.caption := lbl.caption + punkte; 
  end; 
  application.processmessages; 
end; 
 
// Aufruf: 
procedure TForm1.Button4Click(Sender: TObject); 
begin 
  mininame('C:\Eigene Dateien\TEST_TEST_TEST_TEST_TEST_TEST_TEST_TEST_TEST_TEST', 
    200, Label7); 
end;

 

//--------------------------------------------------------------------

// Variante 2: Etwas langsamer, aber allgemein gültig.
             
 (Also nicht nur für TLabel)

uses FileCtrl; 
 
function mininame(pfad: string; cnv: TCanvas; breite: word): string; 
const punkte = '...'; 
var lg: integer; 
begin 
  result := minimizename(pfad, cnv, breite); 
  if cnv.textwidth(result) > breite then begin 
    lg := breite - cnv.textwidth(punkte); 
    while cnv.textwidth(result) > lg do 
      delete(result, length(result), 1); 
    result := result + punkte; 
  end; 
end; 
 
// Beispielaufruf: 
procedure TForm1.Button4Click(Sender: TObject); 
var datei: string; 
begin 
  canvas.brush.style := bsclear; 
  datei := 
    'C:\Eigene Dateien\TEST_TEST_TEST_TEST_TEST_TEST_TEST_TEST_TEST_TEST'; 
  canvas.textout(150, 250, mininame(datei, canvas, clientwidth - 300)); 
end; 


Zugriffe seit 6.9.2001 auf Delphi-Ecke