تقسيم النص
#1
السلام عليكم

كيف اقسم ملف مثلا
عندي ملف تكست به اكثر من 255 حرف
افتحه عن طريق dlgOpen
ثم يقسم الاحرف ليقبلها دلفي
مثلاا
;'11111'
;'22222'
;'33333'

وثم عن طريق dlgSave
يحفظ الملف

اكملت كلشيء تقريبا
وبقى تقسيم النص

ارفقت مشروع


الملفات المرفقة
.rar   مشروع تقسيم.rar (الحجم : 2.99 ك ب / التحميلات : 25)
الرد
#2
وعليكم السلام
السؤال غير واضح :confused:
سبحان الله وبحمده سبحان الله العظيم
الرد
#3
عندي ملف بامتداد .txt
ومكتوب فيه كلمات واسطر كثيره مثلااا
كود :
hello this is delphi for arab enjoy your day here delphi for arab is the best website

الان بدي اقسمهم
كل سطر يحتوي على 20 حرف فقط
واذا يوجد اكثر من 20 يحول باقي الاحرف
الى السطر الثاني
الى ان تنتهي كل احرف التيكست

وثم يحفظ العمل بصيغه تيكست



يعني يصير هكذا
كود :
;'hello this is delphi' ;' for arab enjoy yo' ;'ur day here delph' ;'i for arab is the b' ;'est website'
الرد
#4
و عليكم السلام
حل على السريع :

PHP كود :
procedure Split20(AMemo: TMemo);
var
  
i: integer;
  
tStr, Str, TmpStr: String;
begin
  
if AMemo.Lines.Count = 0 then
    
Exit;

  
TmpStr := '';
  
tStr := '';

  for 
i := 0 to AMemo.Lines.Count do
    
begin
      Str 
:= TmpStr + AMemo.Lines[i];
      
TmpStr := Copy(Str, 21, Length(Str)) + ' ';
      
Str := (Copy(Str, 0, 20));
      if 
i = 0 then
        tStr 
:= tStr + Str
      
else
        
tStr := tStr + #13#10 + Str;
    
end;
  
tStr := tStr + #13#10 + TmpStr;
  
AMemo.Text := tStr;
end; 
PHP كود :
Split20(mmo1); 
Open Your Source .. Open Your Mind
الرد
#5
Smp3

شكرااا لك
يعمل لاكن يوجد مشكله
يعمل جيدا حتى يصل الى السطر رقم 12 اعتقد
وثم ينسخ باقي النص فقط اي يبقى كما هوه
راح احاول احلها
شكراا لك
الرد
#6
السلام عليكم يمكنك استخدام TStringList مع خاصية Delimiter حيث تضع فيها المحدد الذي يفصل بين النصوص و تضع في خاصية DelimitedText النص المراد اجراء العملية عليه ثم تقوم بتحميل النص الى stringlist يتم التقسيم بطريقة الية ابحث في المنتدى هناك الكثير مما اثير حول الموضوع
مثال :

PHP كود :
procedure TForm1.Button1Click(Sender: TObject);
begin
  SplitText
(Memo1, ';');
end; 
PHP كود :
procedure TForm1.SplitText(AMemo: TMemo; Delimiter: Char);
var
  
StringList: TStringList;
  
I: Integer;
begin
  StringList 
:= TStringList.Create;
  try
    
StringList.Delimiter := Delimiter;
    
StringList.DelimitedText := AMemo.Text;
    
AMemo.Clear;
    for 
I := 0 to StringList.Count - 1 do
      
AMemo.Lines.Add(StringList[I]);
  finally
    
StringList.Free;
  
end;
end; 
و لرب نازلة يضيق لها الفتى ذرعا و عند الله منها المخرج
ضاقت فلما استحكمت حلقاتها فرجت و كنت اضنها لا تفرج
الرد
#7
هذه طريقة أخرى :
PHP كود :
// By SMP3
function SplitStr(const AStr: String; n: integer): string;
var
  
s, PropStr: PChar;
  
Len, MemLen, i, D: integer;
  
c: char;
  
MemTxt, FTxt, TmpStr: string;
begin
  D 
:= 0;
  
MemTxt := AStr;
  
Len := Length(MemTxt);
  
GetMem(PropStr, Len * 2);
  
MemLen := Len {$IFDEF UNICODE} * 2{$ENDIF};
  
s := PChar(MemTxt);
  for 
i := 0 to Len {$IFDEF UNICODE} * 2{$ENDIF} do
    
begin
      
if s^ <> #$D then
        
begin
          inc
(s);
          if 
s^ <> #$A then
            
begin
              dec
(s);
              
PropStr^ := s^;
              
inc(s);
              
inc(D);
              
inc(PropStr);
            
end
          
else
            
begin
              inc
(D);
              
inc(s, 2);
              
PropStr^ := ' ';
              
inc(PropStr);
            
end;
        
end
      
else
        
begin
          inc
(D);
          
inc(s, 2);
          
PropStr^ := ' ';
          
inc(PropStr);
        
end;
    
end;

  
dec(PropStr, D);
  
MemTxt := PropStr;
  
Len := 0;
  
FTxt := '';
  
TmpStr := '';

  while 
0 <= Length(MemTxt) - Len do
    
begin
      TmpStr 
:= Copy(PropStr, 0, n);
      
FTxt := FTxt + TmpStr + #13#10;
      
inc(PropStr, n);
      
inc(Len, n);
      if 
PropStr^ = ' ' then
        begin
          inc
(PropStr, +1);
          
inc(Len, +1);
        
end;
    
end;
  
dec(PropStr, Len);
  
Len := Length(FTxt);
  
FTxt[Len - 1] := #0;
  
FTxt[Len - 2] := #0;

  
Result := FTxt;
  
FreeMem(PropStr, MemLen);

end; 
PHP كود :
Memo2.Text := SplitStr(self.Memo1.Text, 20); 
Open Your Source .. Open Your Mind
الرد
#8
أه لقد نسيت ..
ضع شرط للتحقق if Len < n then


كود :
function SplitStr(const AStr: String; n: integer): string; var s, PropStr: PChar; Len, MemLen, i, D: integer; c: char; MemTxt, FTxt, TmpStr: string; begin D := 0; MemTxt := AStr; Len := Length(MemTxt); [COLOR="Red"] if Len < n then Result := AStr;[/COLOR] ..... ..... .....
Open Your Source .. Open Your Mind
الرد
#9
تحديث للدالة لتفادي Memory Leaks :
PHP كود :
// By SMP3
function SplitStr(const AStr: String; n: integer): string;
var
  
s, PropStr: PChar;
  
Len, MemLen, i, D: integer;
  
c: char;
  
MemTxt, FTxt, TmpStr: string;
begin
  D 
:= 0;
  
MemTxt := AStr;
  
Len := Length(MemTxt);
  if 
Len < n then
    Result 
:= AStr;

  
GetMem(PropStr, Len {$IFDEF UNICODE} * 2{$ENDIF});
  
MemLen := Len {$IFDEF UNICODE} * 2{$ENDIF};
  
s := PChar(MemTxt);
  for 
i := 0 to Len {$IFDEF UNICODE} * 2{$ENDIF} do
    
begin
      
if s^ <> #$D then
        
begin
          inc
(s);
          if 
s^ <> #$A then
            
begin
              dec
(s);
              
PropStr^ := s^;
              
inc(s);
              
inc(D);
              
inc(PropStr);
            
end
          
else
            
begin
              inc
(D);
              
inc(s, 2);
              
PropStr^ := ' ';
              
inc(PropStr);
            
end;
        
end
      
else
        
begin
          inc
(D);
          
inc(s, 2);
          
PropStr^ := ' ';
          
inc(PropStr);
        
end;
    
end;

  
dec(PropStr, D);
  
MemTxt := PropStr;
  
Len := 0;
  
FTxt := '';
  
TmpStr := '';

  while 
0 <= Length(MemTxt) - Len do
    
begin
      TmpStr 
:= Copy(PropStr, 0, n);

      
FTxt := FTxt + TmpStr + #13#10;
      
inc(PropStr, n);
      
inc(Len, n);
      if 
PropStr^ = ' ' then
        begin
          inc
(PropStr, +1);
          
inc(Len, +1);
        
end;
    
end;
  
dec(PropStr, Len);
  
Len := Length(FTxt);
  
FTxt[Len - 1] := #0;
  
FTxt[Len - 2] := #0;

  
Result := FTxt;
  
FreeMem(PropStr, MemLen{$IFDEF UNICODE} * 2{$ENDIF});

end; 
Open Your Source .. Open Your Mind
الرد
#10
شكرااا
تم الحل
الرد


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


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