Einzelnen Beitrag anzeigen

FarAndBeyond
(Gast)

n/a Beiträge
 
#4

AW: TLabel Breite eingrenzen z.B. für SongTitel [ASM]

  Alt 17. Mär 2016, 19:43
@Neutral General:
Danke für die Info, stimmt TLabel hat ja auch ein Canvas ... Manchmal sieht man den Baum nicht weil man direkt vor ihm steht...
Ja die Geschwindigkeit auf meinem Core i7 Notebook ist sehr gut, aber falls das Programm mal auf Kleinstrechnern oder UraltRechnern läuft (MP3-OGG-WAV-Player), dann wäre es vielleicht 'ne gute Idee an jeder Stelle den Code zu optimieren um in der Summe vielleicht einen Unterschied zu erlangen.
Außerdem kann man so schöne neue Ansätze und Wege kennenlernen... und das ist gut... Danke für die Beispiele.

Ich weiß ja nicht ob man das so messen darf/sollte, aber der Unterschied ist echt enorm...
1: 2964
2: 31
3: 0 (manchmal 15 oder 16)
Delphi-Quellcode:
unit uTimeCheckChangeLabelWidth;

interface

uses
  Windows, SysUtils, Classes, Controls, Forms,
  StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)

   Button1: TButton;
   Label1 : TLabel;
   Label2 : TLabel;
   Label3 : TLabel;

    procedure Button1Click (Sender: TObject);
    procedure FormCreate (Sender: TObject);
  end;

var
  Form1 : TForm1;
  myText: String;
implementation
 {$R *.dfm}

Function ChangeLabelWidth1(Lab: TLabel; MaxWidth: Integer): Boolean;
  Var
   LabCap: String;
 Begin
  If Lab.Width <= MaxWidth
   Then
    Begin
     Result:= False;
     Exit;
    End
   Else
    Begin
     LabCap:= Lab.Caption;
     LabCap:= LabCap +'...';
      Repeat
       Delete(LabCap, (Length(LabCap)-3), 1);
       Lab.Caption:= LabCap;
      Until Lab.Width <= MaxWidth;
     Result:= True;
    End;
 End;


function ChangeLabelWidth2(Lab: TLabel; MaxWidth: Integer): Boolean;
var LabCap: String;
begin
  if Lab.Width > MaxWidth then
  begin
    LabCap:= Lab.Caption;
    MaxWidth := MaxWidth - Lab.Canvas.TextWidth('...');
    repeat
      SetLength(LabCap, Length(LabCap)-1);
    until Lab.Canvas.TextWidth(LabCap) <= MaxWidth;
    Lab.Caption := LabCap + '...';

    Result:= True;
  end
  else
    Result := false;
end;


function ChangeLabelWidth3(Lab: TLabel; MaxWidth: Integer): Boolean;
var LabCap: String;
    CurrWidth, n: Integer;
begin
  if Lab.Width > MaxWidth then
  begin
    LabCap:= Lab.Caption;
    MaxWidth := MaxWidth - Lab.Canvas.TextWidth('...');
    CurrWidth := Lab.Canvas.TextWidth(LabCap);

    n := Length(LabCap);
    repeat
      CurrWidth := CurrWidth - Lab.Canvas.TextWidth(LabCap[n]);
      dec(n);
    until (CurrWidth <= MaxWidth) or (n <= 0);
    Lab.Caption := copy(LabCap, 1, n) + '...';

    Result:= True;
  end
  else
    Result := false;
end;


Procedure TForm1.Button1Click(Sender: TObject);
 Var
  I : Integer;
  timeStart: Cardinal;
  timeSum : Cardinal;
 Begin
  Label1.Caption:= myText;

   timeStart:= GetTickcount;
  ChangeLabelWidth1(label1, 300);
   timeSum := GetTickCount-timeStart;

  Label1.Caption:= IntToStr(timeSum);


  Label2.Caption:= myText;

   timeStart:= GetTickcount;
  ChangeLabelWidth2(label2, 300);
   timeSum := GetTickCount-timeStart;

  Label2.Caption:= IntToStr(timeSum);


  Label3.Caption:= myText;

   timeStart:= GetTickcount;
  ChangeLabelWidth3(label3, 300);
   timeSum := GetTickCount-timeStart;

  Label3.Caption:= IntToStr(timeSum);
 End;


Procedure TForm1.FormCreate(Sender: TObject);
  Var
   I: Integer;
 Begin
  myText:= 'Hallo';

   For I:= 1 To 1000
   Do myText:= myText+'Hallo';
 End;


end.
@Sir Rufo:
Danke für die Info, ich glaub' da hast du die Nase vorn.... Ich kann "TLabel.EllipsisPosition" in D7 und Lazarus nicht finden, das gibt's wohl erst in höheren Versionen oder ich hab' noch nicht genau genug geschaut... ich halte das mal im "Hinterkopf".
  Mit Zitat antworten Zitat