[nasrinPoornejaty]

سلام من می خواهم بنا بر شرطهایی که دارم ردیفهای استرینگ گرید را رنگی کنم ، کد زیر را نوشتم ولی جواب نمی ده .میخواهم که اگر مقدار موجود در ستون های اول یکی باشند آن ردیف ها یک رنگ باشند و برای مقدار بعدی از آرایه ای که تعریف کردم رنگ بعدی را بخونه

procedure TComparing_Objects_Frm.StringGrid10DrawCell(Sender: TObject;
  ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var I ,J: Integer;
     Fval:String;
     fcolor : array[0..5] of TColor;
begin
fcolor[0]:=clGreen;
fcolor[1]:=clGray;
fcolor[2]:=clPurple;
fcolor[3]:=clYellow;
fcolor[4]:=clMaroon;
fcolor[5]:=clOlive;
J:=0;
Fval:=StringGrid10.Cells[0,1] ;

for I :=2 to StringGrid10.RowCount do
begin
     if StringGrid10.Cells[0,I]=Fval then
           StringGrid10.Canvas.Brush.Color := fcolor[J]
     else
     begin
          J:=J+1;
          StringGrid10.Canvas.Brush.Color := fcolor[J]  ;
          Fval:=StringGrid34.Cells[0,I];
     end;
     StringGrid10.canvas.fillrect(rect);
     StringGrid10.canvas.textrect(rect, I, 0, StringGrid10.cells[0,I])
end;

end;

اما اصلا جواب نمی ده  ، میشه لطفا کمک کنید. کد نمونه ای که تو اینترنت هم هست کمکم نمی کنه.

[Amin_Mansouri]

درود
خوبید ؟
من چند تا نمونه سورس میزارم :

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  dx: Integer;
begin
  with (Sender as TStringGrid) do
  begin
    // Don't change color for first Column, first row
    if (ACol = 0) or (ARow = 0) then
      Canvas.Brush.Color := clBtnFace
    else
    begin
      case ACol of
        1: Canvas.Font.Color := clBlack;
        2: Canvas.Font.Color := clBlue;
      end;
      // Draw the Band
      if ARow mod 2 = 0 then
        Canvas.Brush.Color := $00E1FFF9
      else
        Canvas.Brush.Color := $00FFEBDF;
      Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2, cells[acol, arow]);
      Canvas.FrameRect(Rect);
    end;
  end;
end;



سورس کد ۲rocedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);

  procedure WriteText(StringGrid: TStringGrid; ACanvas: TCanvas; const ARect: TRect;
    const Text: string; Format: Word);
  const
    DX = 2;
    DY = 2;
  var
    S: array[0..255] of Char;
    B, R: TRect;
  begin
    with Stringgrid, ACanvas, ARect do
    begin
      case Format of
        DT_LEFT: ExtTextOut(Handle, Left + DX, Top + DY,
            ETO_OPAQUE or ETO_CLIPPED, @ARect, StrPCopy(S, Text), Length(Text), nil);

        DT_RIGHT: ExtTextOut(Handle, Right - TextWidth(Text) - 3, Top + DY,
            ETO_OPAQUE or ETO_CLIPPED, @ARect, StrPCopy(S, Text),
            Length(Text), nil);

        DT_CENTER: ExtTextOut(Handle, Left + (Right - Left - TextWidth(Text)) div 2,
            Top + DY, ETO_OPAQUE or ETO_CLIPPED, @ARect,
            StrPCopy(S, Text), Length(Text), nil);
      end;
    end;
  end;

  procedure Display(StringGrid: TStringGrid; const S: string; Alignment: TAlignment);
  const
    Formats: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  begin
    WriteText(StringGrid, StringGrid.Canvas, Rect, S, Formats[Alignment]);
  end;
begin
  // Right-justify columns 0-2
  // Spalten 0-2 rechts ausrichten.
  if ACol in [0..2] then
    Display(StringGrid1, StringGrid1.Cells[ACol, ARow], taRightJustify)

    // Center the first row
    // Erste zeile zentrieren
    if ARow = 0 then
      Display(StringGrid1, StringGrid1.Cells[ACol, ARow], taCenter)
  end;
سورس ۳:
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
const
  SelectedColor = Clblue;
begin
  if (state = [gdSelected]) then
    with TStringGrid(Sender), Canvas do
    begin
      Brush.Color := SelectedColor;
      FillRect(Rect);
      TextRect(Rect, Rect.Left + 2, Rect.Top + 2, Cells[aCol, aRow]);
    end;
end;

کدها تو دلفی کپی کنی درست میشه (بخاطر ادیتور فرومه)

[nasrinPoornejaty]

من همه این کدها را امتحان کردم اما همونطور که نوشتم جواب نمیده . لطفا یکبار کدی رو که فرستادم چک کنید .من می خوام در صورت برقراری شرط اون سطر فقط رنگی بشه

[Amin_Mansouri]

 procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if ARow in [2,5,8,12] then
StringGrid1.Canvas.Brush.Color := clGreen;
StringGrid1.Canvas.FillRect(Rect);
StringGrid1.Canvas.TextRect(Rect,Rect.Left,Rect.to p,StringGrid1.Cells[ACol,ARow]);

end;

2 5 8 12 میشه لیست row انتخاب کن که به رنگ سبز تبدیل شه

[nasrinPoornejaty]

من این کد را قبول دارم اما مشکل کد خودم را نمی دونم  و نمی فهمم ، اگه میشه شما کد خود من را چک کنید . ممنون میشم.

[Amin_Mansouri]

ایراد شما چیه ؟
چه مشکلی از کد گرفته میشه؟
کجای دستور ایراد گرفته میشه؟

[nasrinPoornejaty]

بعد از اجرای برنامه تمام خانه های من یک رنگ میشه و این اشتباه . من می خوام وقتی که خانه های ستون 0 و ردیف I
با هم یکسان بودند آن سطرها یکرنگ باشند .و اگر مقدار متفاوتی داشتند رنگشان عوض شود . همانطور که در کدد بالا نوشتم ، رنگها را از آرایه می خونم . مقادیر در گرید هم به ترتیب می باشد یعنی از دیتابیس که می خونم مرتب هستند.

[Amin_Mansouri]

درود
خوبی نسرین جان؟
من یه سورس برات تهیه کردم این یکی + پروژه میزارم که دیگه اصلا مشکلی نباشه(حالا دیگه سطر و جدول های که میخوای رنگی کنی میتونی پیدا کنی)
دوستانی که میخوان توی دلفی stringgrid سلول و سطر رو رنگی کنند باید به صورت زیر عمل کنند.
در سورس زیر دستور زیر رو پیدا کنید.
strngrd1.Canvas.Brush.Color:=RGB(255,0,0); //red brush
در اینجا میتونید انتخاب کنید سلول های که میخوان تغییر رنگ بدن چه رنگی انتخاب باشند که قرمر انتخاب شده ,رنگ ها بصورت کد rgb هستند.
procedure TForm1.btnColorClick(Sender: TObject);
begin
  selectedCol:=4;
  selectedRow:=4;
 
  colorCell:=True;
 
  strngrd1.Repaint;
end;
 
selectedCol:=4; میشه همان سلول  و   selectedRow:=4; هم میشه سطر که ۴ و ۴ انتخاب کردم.
اینم نمونه سورس کد :

  taghir rang string grid.zip (اندازه 2.69 KB / تعداد دانلود: 7)

سورس بعدی که گفتید جواب نمیده
میتونید یه سطر مشخص شده رنگی کنید.
نمونه سورس:

  StringGrid1DrawCell.zip (اندازه 230.42 KB / تعداد دانلود: 9)

در سورس دستر زیر رو میبینید
      if ARow mod 2 = 0 then
        Canvas.Brush.Color := $00E1FFF9
      else
یه دستور شرطی هست که سطر 2 رو میبنید رنگش رو عوض کردیم.
حالا میتونید شرط های دیکه هم بزایرید.
سورس کاملا گویا هست یه کم روش کار کنید به نتیجه میرسید.
سورس ها + پروژه گذاشتم که یقین داشته باشید سورس ها کار میکنند.

[Amin_Mansouri]

فایل تغییر رنگ رو ناقص ا\لود کردم.
سورس کد :
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids;
 
type
  TForm1 = class(TForm)
    strngrd1: TStringGrid;
    btnColor: TButton;
    procedure strngrd1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure btnColorClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    selectedCol, selectedRow: Integer;
    colorCell: Boolean;
  end;
 
var
  Form1: TForm1;

implementation
 
{$R *.dfm}
 
procedure TForm1.btnColorClick(Sender: TObject);
begin
  selectedCol:=4;
  selectedRow:=4;
 
  colorCell:=True;
 
  strngrd1.Repaint;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  colorCell:=true;
end;
 
procedure TForm1.strngrd1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  if colorCell then
  begin
    if ((ACol=selectedCol) and (ARow=selectedRow)) then
    begin
      strngrd1.Canvas.Brush.Color:=RGB(255,0,0); //red brush
      strngrd1.Canvas.FillRect(Rect);  //paint the backgorund red
 
      //draw the original text
      strngrd1.Canvas.TextRect(Rect, Rect.Left, Rect.Top, strngrd1.Cells[ACol, ARow]);
 
      //draw focused rectangle if the current cell is selected by user
      if gdFocused in State then
         strngrd1.Canvas.DrawFocusRect(Rect);
    end;
  end;
 
end;
 
end.