رتبه موضوع:
  • 11 رای - 2.27 میانگین
  • 1
  • 2
  • 3
  • 4
  • 5
رنگی کردن رکوردهای استرینگ گرید در دلفی
#1
درود من می خواهم بنا بر شرطهایی که دارم ردیفهای استرینگ گرید را رنگی کنم ، کد زیر را نوشتم ولی جواب نمی ده .میخواهم که اگر مقدار موجود در ستون های اول یکی باشند آن ردیف ها یک رنگ باشند و برای مقدار بعدی از آرایه ای که تعریف کردم رنگ بعدی را بخونه
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;
اما اصلا جواب نمی ده  ، میشه لطفا کمک کنید. کد نمونه ای که تو اینترنت هم هست کمکم نمی کنه.
پاسخ
#2
درود
خوبید ؟
من چند تا نمونه سورس میزارم :

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;

کدها تو دلفی کپی کنی درست میشه (بخاطر ادیتور فرومه)
در صورتی که سوال دارید و سوالتون مختصر هست با شماره 09120642214 میتونید تماس بگیرید.
کسانی که دوست دارن در کانال فروشگاه ما و یا کانال انجمن عضو بشن یک پیامک در تلگرام برای من بفرستید که عضوشون میکنم.

ادرس فروشگاه :

http://www.amshop.ir



ای ام شاپ را در اینستگرام دنبال کنید

ای ام شاپ رو در کانال تلگرام دنبال کنید



This forum uses Lukasz Tkacz MyBB addons.
پاسخ
#3
من همه این کدها را امتحان کردم اما همونطور که نوشتم جواب نمیده . لطفا یکبار کدی رو که فرستادم چک کنید .من می خوام در صورت برقراری شرط اون سطر فقط رنگی بشه
پاسخ
#4
 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 انتخاب کن که به رنگ سبز تبدیل شه
در صورتی که سوال دارید و سوالتون مختصر هست با شماره 09120642214 میتونید تماس بگیرید.
کسانی که دوست دارن در کانال فروشگاه ما و یا کانال انجمن عضو بشن یک پیامک در تلگرام برای من بفرستید که عضوشون میکنم.

ادرس فروشگاه :

http://www.amshop.ir



ای ام شاپ را در اینستگرام دنبال کنید

ای ام شاپ رو در کانال تلگرام دنبال کنید



This forum uses Lukasz Tkacz MyBB addons.
پاسخ
#5
من این کد را قبول دارم اما مشکل کد خودم را نمی دونم  و نمی فهمم ، اگه میشه شما کد خود من را چک کنید . سپاسگزار میشم.
پاسخ
#6
ایراد شما چیه ؟
چه مشکلی از کد گرفته میشه؟
کجای دستور ایراد گرفته میشه؟
در صورتی که سوال دارید و سوالتون مختصر هست با شماره 09120642214 میتونید تماس بگیرید.
کسانی که دوست دارن در کانال فروشگاه ما و یا کانال انجمن عضو بشن یک پیامک در تلگرام برای من بفرستید که عضوشون میکنم.

ادرس فروشگاه :

http://www.amshop.ir



ای ام شاپ را در اینستگرام دنبال کنید

ای ام شاپ رو در کانال تلگرام دنبال کنید



This forum uses Lukasz Tkacz MyBB addons.
پاسخ
#7
بعد از اجرای برنامه تمام خانه های من یک رنگ میشه و این اشتباه . من می خوام وقتی که خانه های ستون 0 و ردیف I
با هم یکسان بودند آن سطرها یکرنگ باشند .و اگر مقدار متفاوتی داشتند رنگشان عوض شود . همانطور که در کدد بالا نوشتم ، رنگها را از آرایه می خونم . مقادیر در گرید هم به ترتیب می باشد یعنی از دیتابیس که می خونم مرتب هستند.
پاسخ
#8
درود
خوبی نسرین جان؟
من یه سورس برات تهیه کردم این یکی + پروژه میزارم که دیگه اصلا مشکلی نباشه(حالا دیگه سطر و جدول های که میخوای رنگی کنی میتونی پیدا کنی)
دوستانی که میخوان توی دلفی 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; هم میشه سطر که ۴ و ۴ انتخاب کردم.
اینم نمونه سورس کد :

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

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

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

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

ادرس فروشگاه :

http://www.amshop.ir



ای ام شاپ را در اینستگرام دنبال کنید

ای ام شاپ رو در کانال تلگرام دنبال کنید



This forum uses Lukasz Tkacz MyBB addons.
پاسخ
#9
فایل تغییر رنگ رو ناقص ا\لود کردم.
سورس کد :
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.
 
در صورتی که سوال دارید و سوالتون مختصر هست با شماره 09120642214 میتونید تماس بگیرید.
کسانی که دوست دارن در کانال فروشگاه ما و یا کانال انجمن عضو بشن یک پیامک در تلگرام برای من بفرستید که عضوشون میکنم.

ادرس فروشگاه :

http://www.amshop.ir



ای ام شاپ را در اینستگرام دنبال کنید

ای ام شاپ رو در کانال تلگرام دنبال کنید



This forum uses Lukasz Tkacz MyBB addons.
پاسخ


موضوعات مشابه ...
موضوع نویسنده پاسخ بازدید آخرین ارسال
  اکسترکت کردن برنامه به RAM stack 4 544 09-09-2016، 07:56 AM
آخرین ارسال: Amin_Mansouri
  استفاده از اسکن اثر انگشت در دلفی amir_rezaee 0 527 06-06-2016، 09:20 AM
آخرین ارسال: amir_rezaee
  اجرای برنامه روی سیستمی که دلفی نصب نباشد nasrinPoornejaty 8 3,757 06-19-2013، 06:59 PM
آخرین ارسال: Saeed7007
  XML در دلفی nasrinPoornejaty 15 13,656 09-03-2011، 01:03 PM
آخرین ارسال: Amin_Mansouri

پرش به انجمن:


کاربران در حال بازدید این موضوع: 1 مهمان
<------> <____> <<<<----------------->>>> <<<<--->>>>>
This forum uses Lukasz Tkacz MyBB addons.