Parsi Coders

نسخه‌ی کامل: رنگی کردن رکوردهای استرینگ گرید در دلفی
شما در حال مشاهده نسخه آرشیو هستید. برای مشاهده نسخه کامل کلیک کنید.
سلام من می خواهم بنا بر شرطهایی که دارم ردیفهای استرینگ گرید را رنگی کنم ، کد زیر را نوشتم ولی جواب نمی ده .میخواهم که اگر مقدار موجود در ستون های اول یکی باشند آن ردیف ها یک رنگ باشند و برای مقدار بعدی از آرایه ای که تعریف کردم رنگ بعدی را بخونه
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;
اما اصلا جواب نمی ده  ، میشه لطفا کمک کنید. کد نمونه ای که تو اینترنت هم هست کمکم نمی کنه.
درود
خوبید ؟
من چند تا نمونه سورس میزارم :[عکس: Tip273.png]

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;



سورس کد ۲tonguerocedure 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;

کدها تو دلفی کپی کنی درست میشه (بخاطر ادیتور فرومه)
من همه این کدها را امتحان کردم اما همونطور که نوشتم جواب نمیده . لطفا یکبار کدی رو که فرستادم چک کنید .من می خوام در صورت برقراری شرط اون سطر فقط رنگی بشه
 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 انتخاب کن که به رنگ سبز تبدیل شه
من این کد را قبول دارم اما مشکل کد خودم را نمی دونم  و نمی فهمم ، اگه میشه شما کد خود من را چک کنید . ممنون میشم.
ایراد شما چیه ؟
چه مشکلی از کد گرفته میشه؟
کجای دستور ایراد گرفته میشه؟
بعد از اجرای برنامه تمام خانه های من یک رنگ میشه و این اشتباه . من می خوام وقتی که خانه های ستون 0 و ردیف I
با هم یکسان بودند آن سطرها یکرنگ باشند .و اگر مقدار متفاوتی داشتند رنگشان عوض شود . همانطور که در کدد بالا نوشتم ، رنگها را از آرایه می خونم . مقادیر در گرید هم به ترتیب می باشد یعنی از دیتابیس که می خونم مرتب هستند.
درود
خوبی نسرین جان؟
من یه سورس برات تهیه کردم این یکی + پروژه میزارم که دیگه اصلا مشکلی نباشه(حالا دیگه سطر و جدول های که میخوای رنگی کنی میتونی پیدا کنی)
دوستانی که میخوان توی دلفی 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; هم میشه سطر که ۴ و ۴ انتخاب کردم.
اینم نمونه سورس کد :
[attachment=421]

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

در سورس دستر زیر رو میبینید
      if ARow mod 2 = 0 then
        Canvas.Brush.Color := $00E1FFF9
      else
یه دستور شرطی هست که سطر 2 رو میبنید رنگش رو عوض کردیم.
حالا میتونید شرط های دیکه هم بزایرید.
سورس کاملا گویا هست یه کم روش کار کنید به نتیجه میرسید.
سورس ها + پروژه گذاشتم که یقین داشته باشید سورس ها کار میکنند.
فایل تغییر رنگ رو ناقص ا\لود کردم.
سورس کد :
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.