我設計了一個 TMyStringGrid 元件,直接繼承 TStringGrid 用意只有兩個目的,增加 DisplayLabel(設定FixedRow 的內容) , DisplayAlignment(設定每個col 文字考左靠中靠右位置) 兩個屬性 DisplayLabel 屬性測試OK,但DisplayAlignment由於要 override StringGrid 的 OnDrawCell 事件,我測試好幾次就是不知如何宣告 OnDrawCell 的 override ..(下面紅色部分都會錯誤)

 
unit MyStringGrid;  //james 第一個元件 - 2003/11/05    interface    uses
  SysUtils, Classes, Controls, Grids, Messages, Types;    type
  TMyStringGrid = class(TStringGrid)
  private
    FDisplayLabel:String;
    FDisplayAlignment:String;
    procedure MyWindowProc(var Message: TMessage);
    function _StrSeg(Str ,SegSymbol: String ; SegIndex: integer): String;
    { Private declarations }
  protected
    { Protected declarations }      public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;
    destructor  Destroy; override;
    procedure DrawCell(AOwner : TComponent; ACol,ARow: Integer;
                       Rect: TRect; State: TGridDrawState); override;
    procedure SetDisplayLabel(ACaption: String);
    procedure SetDisplayAlignment(AAlignment: String);
  published
    { Published declarations }
    property DisplayLabel:String read FDisplayLabel write SetDisplayLabel;
    property DisplayAlignment:String read FDisplayAlignment write SetDisplayAlignment;
  end;    procedure Register;    implementation        var
StringGrid_WindowProc : TWndMethod;    //---------------------------------------------------------------------------
procedure Register;
begin
  RegisterComponents('Fujitsu', [TMyStringGrid]);
end;
//---------------------------------------------------------------------------
constructor TMyStringGrid.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  StringGrid_WindowProc:=WindowProc;
  WindowProc:=MyWindowProc; 
end;
//---------------------------------------------------------------------------
destructor TMyStringGrid.Destroy;
begin
  inherited Destroy;
end;
//---------------------------------------------------------------------------
procedure TMyStringGrid.MyWindowProc(var Message: TMessage);
begin
  if (Message.Msg=WM_NCHITTEST) and not (csDesigning in ComponentState) then //阻止所有滑鼠按鍵動作
      exit;      // 呼叫-原訊息處理程序
  StringGrid_WindowProc(Message);
end;
//---------------------------------------------------------------------------
procedure TMyStringGrid.SetDisplayLabel(ACaption: String);
var i:integer;
begin
  FDisplayLabel:=ACaption;
  for i :=0  to ColCount-1 do
      begin
        Cells[i,0]:=_StrSeg(ACaption,',',i 1);
      end;
end;
//---------------------------------------------------------------------------
procedure TMyStringGrid.SetDisplayAlignment(AAlignment: String);
var i:integer;
begin
  FDisplayAlignment:=AAlignment;
  //DrawCell;
  Refresh;
end;
//---------------------------------------------------------------------------
procedure TMyStringGrid.DrawCell(AOwner : TComponent; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
begin      inherited DrawCell;
end;
//---------------------------------------------------------------------------
function TMyStringGrid._StrSeg(Str ,SegSymbol: String ; SegIndex: integer): String;
var r,c,s,sTmp : String;
    i:integer;
begin
  r:='';      if ((Str='') or (SegIndex<1)) then
     begin
       result:=r;
       exit;
     end;      c:=SegSymbol;
  if (c='') then c:=',';      i:=0;
  s:=Str;
  sTmp:='';
  while Pos(c,s)>0 do
        begin
          i:=i 1;
          sTmp := Copy(s,1,Pos(c,s)-1);
          if (SegIndex=i) then
             begin
               r:=sTmp;
               break;
             end;              s:=Copy(s , Pos(c,s) Length(c) , Length(s)-(Pos(c,s) Length(c)) 1);
        end;      if SegIndex=(i 1) then
     begin
       r:=s;
     end;      result:=r;
end;
//---------------------------------------------------------------------------
end.

發表人 - bruce0211 於 2003/11/28 14:53:03

bruce0211 你好:

TStringGrid.DrawCell 是:
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState); override;
而非:        procedure DrawCell(AOwner : TComponent; ACol,ARow: Integer;
      Rect: TRect; State: TGridDrawState); override;

感謝長官指導 目前宣告部份已 OK 但效果無法呈現 (我想做到這個元件的 Fixed cell 中的文字都置中(DT_CENTER)對齊 )    不知流程是否出問題 不加 exit, Fixed cell 中的文字是置左,這應該是 default, 加了 exit, Fixed cell 中的文字顯示不出來... < class="code"> //--------------------------------------------------------------------------- procedure TMyStringGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); var FixRect: TRect; begin //判斷是否是 Fixed 行列 if (gdFixed in AState) then begin //填滿每一 Cell 背景 (清掉舊 Cell Text) Canvas.FillRect(ARect); //繪製新的 Cell Text FixRect:=ARect; //修正 Rect 座標 FixRect.Left:=ARect.Left 2; FixRect.Top :=ARect.Top 2; DrawText(Handle,PChar(Cells[ACol,ARow]),Length(Cells[ACol,ARow]), FixRect, DT_CENTER); exit; end; inherited DrawCell(ACol, ARow, ARect, AState); end; 發表人 - bruce0211 於 2003/11/28 16:46:31

我發覺是這行的問題 DrawText(Handle,PChar(Cells[ACol,ARow]),Length(Cells[ACol,ARow]), FixRect, DT_CENTER); 因為換成 Canvas.TextRect(ARect, ARect.Left, ARect.Top, Cells[ACol,ARow]); 即可,    但TextRect()無法做置左置中置右的設定  所以還是要用>>,

試出來了... DrawText(Canvas.Handle,PChar(Cells[ACol,ARow]),Length(Cells[ACol,ARow]), FixRect, DT_CENTER);//DT_LEFT , DT_CENTER , DT_RIGHT

Dear bruce0211 改成這樣試試 procedure TMyStringGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); var FixRect: TRect; begin if (gdFixed in AState) then begin //填滿每一 Cell 背景 (清掉舊 Cell Text) Canvas.FillRect(ARect); //繪製新的 Cell Text FixRect:=ARect; //修正 Rect 座標 FixRect.Left:=ARect.Left 2; FixRect.Top :=ARect.Top 2; DrawText(Handle,PChar(Cells[ACol,ARow]),Length(Cells [ACol,ARow]), FixRect, DT_CENTER); end Else inherited DrawCell(ACol, ARow, ARect, AState);

短短幾個小時, 竟然錯過許多討論...    感謝大家分享的熱情. > 這樣做, 跟原來加 " class="code"> DrawText( HDC hDC, // handle to device context LPCTSTR lpString, // pointer to string to draw int nCount, // string length, in characters LPRECT lpRect, // pointer to structure with formatting dimensions UINT uFormat // text-drawing flags ); 第一個參數應該傳入 Canvas.Handle 而不是 Window Handle. PS. bruce0211 ... 不要叫我"長官", 除了擔當不起, 感覺也好遠. 發表人 -