// 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;
|