- نقل محتويات الـ 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[i] <> ' ') 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;
</FONT></FONT>
الخميس يوليو 03, 2008 12:12 am