مجموعة أكواد جميلة

1 - نقل محتويات الـ StringGrid إلى الـ ListView

procedure StringGrid2ListView(StringGrid: TStringGrid; Listview: TListView);
var
  i, j, k: Integer;
  ListItem: TListItem;
begin
  ListView.Items.BeginUpdate;
  try
    with StringGrid, ListView do
    begin
      for j := 1 to ColCount - 1 do
        Columns.Add;
      for j := 1 to RowCount - 1 do
      begin
        ListItem         := Listview.Items.Add;
        ListItem.Caption := Cells[1, j];
        for k := 1 to ColCount - 1 do
          ListItem.Subitems.Add(Cells[k + 1, j]);
      end;
    end;
  finally
    ListView.Items.EndUpdate;
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
begin
  with ListView1 do
  begin
    Items.BeginUpdate;
    try
      ViewStyle := vsReport;
      Items.Clear;
      for i := Columns.Count - 1 downto 0 do
        listView_DeleteColumn(Handle, i);
    finally
      Items.EndUpdate;
    end;
  end;
  // اختبر الان
  StringGrid2ListView(StringGrid1, ListView1);
end;

---------------------------------------

2- هل ترغب بالحصول على الكلمة التي تحت مؤش الماوس ضمن الـ RichEdit

هذا الكود مفيد مثلاً لبرنامج ترجمة حيث يشير المستخدم إلى الكلمة فتعرض الترجمة في

hint مثلاً

تم استخدام الحدث MouseMove لهذا الغرض

uses
 RichEdit;

procedure TForm1.RichEdit1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  iCharIndex, iLineIndex, iCharOffset, i, j: Integer;
  Pt: TPoint;
  s: string;
begin
  with TRichEdit(Sender) do
  begin
    Pt := Point(X, Y);

    iCharIndex := Perform(Messages.EM_CHARFROMPOS, 0, Integer(@Pt));
    if iCharIndex < 0 then Exit;
    iLineIndex  := Perform(EM_EXLINEFROMCHAR, 0, iCharIndex);
    iCharOffset := iCharIndex - Perform(EM_LINEINDEX, iLineIndex, 0);
    if Lines.Count - 1 < iLineIndex then Exit;
    s := Lines[iLineIndex];
    i := iCharOffset + 1;
    while (i > 0) and (s <> ' ') do Dec(i);
    j := iCharOffset + 1;

    while (j <= Length(s)) and (s[j] <> ' ') do Inc(j);
    Caption := Copy(s, i, j - i);
  end;
end;

-----------------------------

3- هل تريد جعل الأداة RichEdit قادرة على استيعاب نص حجمه أكثر

من 64 كيلو بايت .

هذا الكود القليل حجماً الكبير مفعولاً يجعل الـRichEdit قادرة على استيعاب 2غيغابايت

procedure TForm1.Button1Click(Sender: TObject);
begin
  RichEdit11.MaxLength := $7FFFFFF0;
end; 

// أو :

procedure TForm1.Button1Click(Sender: TObject);
begin
  SendMessage(RichEdit1.Handle, EM_EXLIMITTEXT, 0, $7FFFFFF0);
end;

-----------------------------

4- أشكال متعددة للـ UnderLine ضمن الأداة RichEdit

uses
  RichEdit;

// أشكال Underline 
const
  CFU_UNDERLINETHICK = 9;
  CFU_UNDERLINEWAVE = 8;
  CFU_UNDERLINEDASHDOTDOT = 7;
  CFU_UNDERLINEDASHDOT = 6;
  CFU_UNDERLINEDASH = 5;
  CFU_UNDERLINEDOTTED = 4;
  CFU_UNDERLINE = 1;
  CFU_UNDERLINENONE = 0;

procedure RE_SetCharFormat(ARichEdit: TRichEdit; AUnderlineType: Byte; AColor: Word);
var
  Format: CHARFORMAT2;
begin
  FillChar(Format, SizeOf(Format), 0);
  with Format do
  begin
    cbSize := SizeOf(Format);
    dwMask := CFM_UNDERLINETYPE;
    bUnderlineType := AUnderlineType or AColor;
    ARichEdit.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format));
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  RE_SetCharFormat(RichEdit1, CFU_UNDERLINEWAVE, $50);
end;

المبرمج عماد .... B) B)