حفض محتويات ListView بملف نصي
#1
السلام عليكم
هل هناك طريقة غير معقدة لحفظ مكونات ListView في ملف نصي ؟
ListView به 4 Columns
و ساستعمل SaveDlg لحفض الملف ...
شكرا
الرد
#2
وعليكم السلام ورحمة الله
جرب:
PHP كود :
Author: By Fabio De Pasquale 

{
  
This Code allows you to Load/Save items & subitems of a
  TListView in a file
.

  
Mit diesem Code kann man Items & Subitems einer TListView
  speichern und wieder laden
.


  
The Code has been extracted & adapted from
  TSmartListView 1.01
, Freeware
  by Fabio De Pasquale
.
}

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; 
بالتوفيق.
الرد
#3
شكرا على الطريقة
لكن لا تضهر معضم الحروف في النص + ضهور حروف و فرغات غريبة ..
هل هناك بديل للـListView سيهل التعامل معه ؟
الرد
#4
إقتباس :لكن لا تضهر معضم الحروف في النص + ضهور حروف و فرغات غريبة ..
قم بالتنقيح وتقصي الخلل...
طرق أخرى:
http://www.delphi4arab.net/forum/showthr...p?tid=1186
http://www.delphi4arab.net/forum/showthread.php?tid=876
http://www.delphi4arab.net/forum/showthr...p?tid=2279
بالتوفيق.
الرد


التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم