| | |
| Stránka: 1 z 1
| [ Príspevkov: 4 ] | |
Autor | Správa |
---|
Registrovaný: 21.12.08 Prihlásený: 14.07.16 Príspevky: 114 Témy: 21 | Napísal ha2: 25.02.2010 23:37 | |
|
potrebujem ukladat data z listview do suboru a naopak. Nasiel som si nato hotovu funkciu. Az nato ze haluzi ak nacitam ulozeny listview zo suboru, nieco pridam a znova ulozin (v mieste pridania to nahadze stvorceky). Alebo ak ukladam aj enter (mam v bunke viac riadkov, napr text z richedit vlozeny do bunky). Vtedy to tiez pridava stvorceky. Jak to vyriesit?
Vyzera to ze ak ulozim, ukoncim program, spustim program a nacitam subor do listview tak vtedy to robi chyby, a akoby odreze prve 2 znaky...
Kód: uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, comctrls, StdCtrls;
type TForm1 = class(TForm) ListView1: TListView; Button1: TButton; Button2: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private procedure SaveListViewToFile(AListView: TListView; sFileName: string); procedure LoadListViewToFile(AListView: TListView; sFileName: string); public end;
const Msg1 = 'File "%s" does not exist!'; Msg2 = '"%s" is not a ListView file!';
var Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.SaveListViewToFile(AListView: TListView; sFileName: string); var idxItem, idxSub, IdxImage: Integer; F: TFileStream; pText: PChar; sText: string; W, ItemCount, SubCount: Word; MySignature: array [0..2] of Char; begin //Initialization with AListView do begin ItemCount := 0; SubCount := 0; //**** MySignature := 'LVF'; // ListViewFile F := TFileStream.Create(sFileName, fmCreate or fmOpenWrite); F.Write(MySignature, SizeOf(MySignature));
if Items.Count = 0 then // List is empty ItemCount := 0 else ItemCount := Items.Count; F.Write(ItemCount, SizeOf(ItemCount));
if Items.Count > 0 then begin for idxItem := 1 to ItemCount do begin with Items[idxItem - 1] do begin //Save subitems count if SubItems.Count = 0 then SubCount := 0 else SubCount := Subitems.Count; F.Write(SubCount, SizeOf(SubCount)); //Save ImageIndex IdxImage := ImageIndex; F.Write(IdxImage, SizeOf(IdxImage)); //Save Caption sText := Caption; w := Length(sText); pText := StrAlloc(Length(sText) + 1); StrPLCopy(pText, sText, Length(sText)); F.Write(w, SizeOf(w)); F.Write(pText^, w); StrDispose(pText); if SubCount > 0 then begin for idxSub := 0 to SubItems.Count - 1 do begin //Save Item's subitems sText := SubItems[idxSub]; w := Length(sText); pText := StrAlloc(Length(sText) + 1); StrPLCopy(pText, sText, Length(sText)); F.Write(w, SizeOf(w)); F.Write(pText^, w); StrDispose(pText); end; end; end; end; end; F.Free; end; end;
procedure TForm1.LoadListViewToFile(AListView: TListView; sFileName: string); var F: TFileStream; IdxItem, IdxSubItem, IdxImage: Integer; W, ItemCount, SubCount: Word; pText: PChar; PTemp: PChar; MySignature: array [0..2] of Char; sExeName: string; begin with AListView do begin ItemCount := 0; SubCount := 0;
sExeName := ExtractFileName(sFileName);
if not FileExists(sFileName) then begin MessageBox(Handle, PChar(Format(Msg1, [sExeName])), 'I/O Error', MB_ICONERROR); Exit; end;
F := TFileStream.Create(sFileName, fmOpenRead); F.Read(MySignature, SizeOf(MySignature));
if MySignature <> 'LVF' then begin MessageBox(Handle, PChar(Format(Msg2, [sExeName])), 'I/O Error', MB_ICONERROR); Exit; end;
F.Read(ItemCount, SizeOf(ItemCount)); Items.Clear;
for idxItem := 1 to ItemCount do begin with Items.Add do begin //Read imageindex F.Read(SubCount, SizeOf(SubCount)); //Read imageindex F.Read(IdxImage, SizeOf(IdxImage)); ImageIndex := IdxImage; //Read the Caption F.Read(w, SizeOf(w)); pText := StrAlloc(w + 1); pTemp := StrAlloc(w + 1); F.Read(pTemp^, W); StrLCopy(pText, pTemp, W); Caption := StrPas(pText); StrDispose(pTemp); StrDispose(pText); if SubCount > 0 then begin for idxSubItem := 1 to SubCount do begin F.Read(w, SizeOf(w)); pText := StrAlloc(w + 1); pTemp := StrAlloc(w + 1); F.Read(pTemp^, W); StrLCopy(pText, pTemp, W); Items[idxItem - 1].SubItems.Add(StrPas(pText)); StrDispose(pTemp); StrDispose(pText); end; end; end; end;
F.Free; end; end;
// Example:
procedure TForm1.Button1Click(Sender: TObject); begin // Save Items and Clear the ListView SaveListViewToFile(ListView1, 'MyListView.sav'); ListView1.Items.Clear; end;
procedure TForm1.Button2Click(Sender: TObject); begin // Load Items LoadListViewToFile(ListView1, 'MyListView.sav'); end;
|
|
Registrovaný: 21.12.08 Prihlásený: 14.07.16 Príspevky: 114 Témy: 21 | Napísal autor témy ha2: 28.02.2010 22:28 | |
|
tak tyka sa to asi len D2010 ta chyba
|
|
Registrovaný: 29.10.08 Prihlásený: 30.07.12 Príspevky: 933 Témy: 2 | Napísal coldak: 15.04.2010 13:09 | |
|
ak si dobre pamatam tak componenta TListView ma prvok Items ktory je typu TStringList a ten ma metodu SaveToFile. alebo sa mylim ? ak sa mylim tak prepac, davno som s delphi nerobil.
|
|
Registrovaný: 21.12.08 Prihlásený: 14.07.16 Príspevky: 114 Témy: 21 | Napísal autor témy ha2: 18.04.2010 23:13 | |
|
nie, items nema savetofile. Ale uz som si nato napisal vlastnu funkciu.
|
|
| Stránka: 1 z 1
| [ Príspevkov: 4 ] | |
Podobné témy | Témy | Odpovede | Zobrazenia | Posledný príspevok |
---|
| [Delphi] Progressbar do Listview v Delphi, Visual Basic | 2 | 627 | 10.09.2010 21:24 coldak | | Java - save to txt file v Assembler, C, C++, Pascal, Java | 2 | 223 | 07.12.2012 9:58 Mike7400 | | Prehratie zvuku pri vyskoceni okna open/save file v IE v Sieťové a internetové programy | 2 | 341 | 01.06.2010 19:11 don jebot | | Delphi 2009 *.dcu file v Delphi, Visual Basic | 2 | 462 | 23.03.2010 14:09 myxall | | delphi zapis cisla do editu v delphi v Delphi, Visual Basic | 3 | 1100 | 11.05.2008 12:02 p360t | | Vkladanie údajov do ListView v Delphi, Visual Basic | 2 | 520 | 10.01.2011 13:09 coldak | | android ListView a jeho dynamicke nacitavanie v Android, iOS, Windows Phone (Mobile) | 10 | 642 | 05.05.2014 21:54 XOLOO | | ListView a WebBrowser (Visual Basic 2010) v Delphi, Visual Basic | 0 | 450 | 10.04.2012 11:30 lukas15 | | jQuery & load v JavaScript, VBScript, Ajax | 7 | 383 | 18.07.2014 10:42 hatto13 | | pomaly load netu v Antivíry a antispywary | 9 | 712 | 16.09.2008 17:44 don jebot | | Problém s LOAD v JavaScript, VBScript, Ajax | 4 | 464 | 14.04.2016 20:48 Padnex | | Failed to load resource v JavaScript, VBScript, Ajax | 6 | 483 | 03.07.2016 16:15 walther | | Windows XP - Load DLL v Operačné systémy Microsoft | 1 | 372 | 01.01.2010 22:43 FERDA23 | | cmos checksum error - default load v AMD čipové sady | 9 | 2849 | 12.10.2008 8:14 cassyopea | | return confirm() pred jQuery.load() v JavaScript, VBScript, Ajax | 2 | 450 | 13.10.2010 15:42 emer | | Gtx 760 , GPU load 70% v nVidia grafické karty | 11 | 458 | 24.09.2013 22:54 roman10 |
| Nemôžete zakladať nové témy v tomto fóre Nemôžete odpovedať na témy v tomto fóre Nemôžete upravovať svoje príspevky v tomto fóre Nemôžete mazať svoje príspevky v tomto fóre
|
|