全國最多中醫師線上諮詢網站-台灣中醫網
發文 回覆 瀏覽次數:1572
推到 Plurk!
推到 Facebook!

[急問]如何替TStringGrid中的格子填色

尚未結案
pasphi
一般會員


發表:16
回覆:12
積分:5
註冊:2002-11-29

發送簡訊給我
#1 引用回覆 回覆 發表時間:2003-11-23 22:40:09 IP:202.175.xxx.xxx 未訂閱
若要在程式碼中替TStringGrid中的格子寫上文字, 可以:(假設StringGrid1為TStringGrid) StringGrid1.Cells[1,2] := '文字'; 但如何在程式碼中替這格子填上底色呢? 希望大家可以幫忙! :) DELphi==
------
DELphi==
azurecloud
中階會員


發表:52
回覆:108
積分:92
註冊:2003-09-04

發送簡訊給我
#2 引用回覆 回覆 發表時間:2003-11-24 06:14:24 IP:163.13.xxx.xxx 未訂閱
Hi,pasphi 您好: 請先參考下面這篇:http://delphi.ktop.com.tw/topic.php?topic_id=19200 我根據這篇寫了個程序,你可以直接呼叫,代碼如下    procedure stringcell_draw(AStringgrid : TStringgrid; col,row : integer; text : String); var Rect : TRect; begin    AStringgrid.Canvas.Brush.Color := clred;    AStringgrid.Canvas.Font.Color := clblue;    rect := AStringgrid.CellRect(col,row);    AStringgrid.Canvas.FillRect(rect);    AStringgrid.Canvas.TextOut(Rect.left+2, Rect.top+2, text); //前兩個參數是座標,你可以加加減減調整位置 end;    procedure TForm1.Button1Click(Sender: TObject); begin    stringcell_draw(stringgrid1,2,2,'test'); // 這裡是呼叫的示範 end;    請注意此時的文字是"畫"出來的,我測試的結果是當此 Cells OnFocus 時 顏色和字會消失,如果您不想讓它消失的話,在 Cells 的 OnFocus 事件再 呼叫一次程序即可,希望幫得上忙。 ps.做出來的效果如下:
P.D.
版主


發表:603
回覆:4038
積分:3874
註冊:2006-10-31

發送簡訊給我
#3 引用回覆 回覆 發表時間:2003-11-25 02:35:14 IP:61.71.xxx.xxx 未訂閱
引言: 若要在程式碼中替TStringGrid中的格子寫上文字, 可以:(假設StringGrid1為TStringGrid) StringGrid1.Cells[1,2] := '文字'; 但如何在程式碼中替這格子填上底色呢? 希望大家可以幫忙! :) DELphi==
我剛好做到這段, 給你參考, 在 stringgrid 的 ondrawcell中寫
procedure TForm_Part.stgSpecDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
        var xCol, xWidth: integer;
            xRow, xHeight: integer;
begin
     with Sender as TStringGrid do begin
       // 拖曳時
       if State=[gdSelected] then begin
         Canvas.Brush.Color:= $0080FFFF; //底色
         Canvas.Font.Color:= clBlack;  //字體顏色
       end
       // 如果 cell 為 √
       else if (Cells[ACol, ARow]='√') then begin
         Canvas.Brush.Color:= clGreen; //底色
         Canvas.Font.Color:= clWhite;  //字體顏色
       end
       // 其他狀況  
       else begin
         if (ACol<>0) and (ARow<>0) then begin
            Canvas.Brush.Color:= clGray;
            Canvas.Font.Color:= clBlack;
         end;
       end;
       // nRow, nCol 在 onSelect 中指定, 並以 private 存在
       // 當focus在某一cell時
       if (ARow=nRow) and (ACol=nCol) then begin
          Canvas.Brush.Color:= $00C08080;
          Canvas.Font.Color:= clBlack;
       end;
       // 以下是將文字置中的計算(以 font=9為基礎) 
       xRow:= Round(stgSpec.DefaultRowHeight);
       xCol:= Round(stgSpec.DefaultColWidth);
       xHeight:= Abs(stgSpec.Font.Height);
       xWidth:=  9 * Length(Cells[ACol,ARow]);
       xRow:= Round((xRow-xHeight)/2);
       if (ARow=0) or ((ARow<>0) and (ACol<>0)) then xCol:= Round((xCol-xWidth)/2)
       else xCol:= 2;
       Canvas.FillRect(Rect);  //繪底色
       Canvas.textout(Rect.Left xCol,Rect.Top xRow,Cells[ACol,ARow]); //output text
     end;
end;    procedure TForm_Part.stgSpecSelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
begin
     nRow:= ARow;
     nCol:= ACol;
end;    
pasphi
一般會員


發表:16
回覆:12
積分:5
註冊:2002-11-29

發送簡訊給我
#4 引用回覆 回覆 發表時間:2004-02-07 23:08:44 IP:202.175.xxx.xxx 未訂閱
遲了回應, 導致扣分, sorry!! 謝謝大家的幫忙, 但本人覺P.D.兄的程式碼會比azurecloud 兄的好些, 因若onfoucus時就變回原來顏色, 作用就不太大 DELphi==
------
DELphi==
系統時間:2024-05-29 14:54:20
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!