Einzelnen Beitrag anzeigen

DelphiUser1

Registriert seit: 15. Sep 2012
56 Beiträge
 
#19

AW: Idee für Auswahlfunktion

  Alt 24. Okt 2012, 22:59
So also mithilfe dieses Quellcodes ist es mir gelungen, meine Daten zu laden:
Delphi-Quellcode:
  type
  TInfo=class
  Name:String;
  Ort:String;
  ImageIndex:Integer;
  end;

var
  Form1: TForm1;
  Info: TInfo;
  Path:String;

implementation

{$R *.dfm}

 {Gibt den X-ten Teilstring eines mit Kommas getrennten Daten-Strings}
function ExtractSubStr(Str: String; Index: Integer): String;
var
  i: Integer;
begin
  Result := '';
  if Index < 1 then Exit;
  Str := Str + ',';
  for i := 1 to Index - 1 do Delete(Str, 1, Pos(',', Str));
  Result := Trim(Copy(Str, 1, Pos(',', Str) - 1));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Doublebuffered:=True;
Path:= ExtractFilepath(ParamStr(0));
Info := TInfo.Create;
ListBox1.Style := lbOwnerDrawFixed;
end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  th, tl: Integer;
  i: Integer;
  bmp: TBitmap;
  Info:TInfo;
begin
  with (Control as TListBox) do
  begin
    //Einstellungen für selektierten Item (A)
    if odSelected in State then
      Canvas.Brush.Color := $00EFD3C6; //Helles Blau für selektierte Items

    //Löscht den Item-Canvas
    Canvas.FillRect(Rect);

    //Einstellungen für selektierten Item (B)
    if odSelected in State then
    begin
      Canvas.Pen.Color := $00C66931; //Dunkleres Blau für Fokus-Rand
      Canvas.Brush.Style := bsClear;
      Canvas.Rectangle(Rect);
    end;
    Info:=TInfo(Items.Objects[Index]);
    //-Bild 48x48 px aus ImageList zeichnen----------------------------------

    bmp := TBitmap.Create;
    try
      i := Info.ImageIndex;
      if (i > -1) and (i <= Form1.ImageList1.Count - 1) then
      begin
        Form1.ImageList1.GetBitmap(i, bmp);
        Canvas.Draw(Rect.Left + 2, Rect.Top + 2, bmp);
      end;
    finally
      bmp.Free;
    end;

    //-Text-Zeile 1 ausgeben-------------------------------------------------

    //Seitenabstand für Text (rechts vom Bild)
    tl := ItemHeight + 4;
    //Oberkante für Textzeilen. Jeder neue Zeile addiert ihre Höhe dazu
    th := 2;

    Canvas.Font.Style := [fsBold]; //Font-Eigenschaften für aktuelle Zeile
    Canvas.Font.Color := $00C66931; //Blau und fett

    Canvas.TextOut(Rect.Left + tl, Rect.Top + th, Info.Name);
    th := Canvas.TextHeight(#32); //Unterkante alter Text = Oberkante neuer Text

    //-Text-Zeile 2 ausgeben-------------------------------------------------

    Canvas.Font.Style := Canvas.Font.Style - [fsBold]; //-
    Canvas.Font.Color := clWindowText; //Normal

    Canvas.TextOut(Rect.Left + tl, Rect.Top + th, Info.Ort);
    th := th + Canvas.TextHeight(#32); //s. o.

    //-Text-Zeile 3 ausgeben-------------------------------------------------

    Canvas.Font.Size := Canvas.Font.Size - 2; //-
    Canvas.Font.Color := clGray; //Grau und etwas kleiner

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

    //Überzeichnet alten Fokus
    if odFocused in State then
      Canvas.DrawFocusRect(Rect);
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  i: Integer;
begin
  with ListBox1 do //Objekte müssen separat freigegeben werden
    for i := 0 to Items.Count - 1 do
      TInfo(Items.Objects[i]).Free; //Freigeben
end;



procedure TForm1.Timer1Timer(Sender: TObject);
var hallo:TStrings;
begin
if FileExists(path+ Edit1.Text+'.txt') then
begin
hallo:=TStringlist.Create;
hallo.LoadFromFile(path+'Info'+Edit1.Text+'.txt');
Info.Name := hallo.Strings[0]+' '+hallo.Strings[1];
Info.Ort := hallo.Strings[3];
  ListBox1.Items.AddObject('', Info);
  ListBox1.Font.Name := 'Segoe UI';
  ListBox1.Font.Size := 10;

  ListBox1.ItemHeight := 2 + ImageList1.Height + 2;
  Edit1.Text:='';
  hallo.free;
end;
das einzige Problem ist, ich weiß nicht wie ich das Bild lade (es ist eine jpg datei) und wenn man jetzt öfter nacheinander sucht, dann werden auf einmal immer wieder neue Items für die Listbox created, man hat also nach dem zweiten suchen zwei mal die selbe Person angezeigt.
Mögliche Lösung:
Delphi-Quellcode:
if Listbox1.Items.Count>1 then
ListBox1.Items.Delete(1)
else
if FileExists(path+ Edit1.Text+'.txt') then
begin
....
Jetzt sieht es aber nicht nur verbugt aus, sondern es können nicht mal zwei leute in der liste angezeigt werden, da ja direkt der zweite wieder gelöscht wird
Hilfe bitte
  Mit Zitat antworten Zitat