如何利用迴圈合併儲存格 |
答題得分者是:careychen
|
narcysionlin
一般會員 發表:7 回覆:4 積分:2 註冊:2006-11-01 發送簡訊給我 |
如何利用迴圈合併儲存格
我在stringgrid帶出來的資料是, G001 管理處 財務部 出納 G001 管理處 財務部 成本 G001 管理處 財務部 應收 G002 製造部 統購部 電子 G002 製造部 統購部 機構 S003 業務部 品牌業務 OEM1 S003 業務部 OEM業務 OEM2 我有找到一段程式,可把儲存格合併, 但我不知如何運用迴圈程式,讓程式如何自已判斷當資料遇到"G001", 合併成類似Excel的合併儲存格,遇到"管理處"合併儲存格呢 麻煩各位大大幫我看,這問題困擾我很久了。想不透! [code delphi] procedure TFmA05.FormCreate(Sender: TObject); var x, k: Integer; begin with stringgrid1 do begin cells[1, 1] := 'A rather long line which will span cells'; for x:= 1 to colcount-1 do for k:= 2 to rowcount -1 do cells[x,k] := Format('Cell[%d,%d]', [x,k]); end; end; [/code] [code delphi] procedure TFmA05.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); var i, x, y: Integer; begin If gdFixed In State Then Exit; If ARow > 1 Then Exit; with sender as tstringgrid do begin If aCol < Pred(ColCount) Then Rect.Right := Rect.Right GridlineWidth; y:= Rect.Top 2; x:= Rect.Left 2; for i:= 1 to aCol-1 do x:= x - ColWidths[i] - GridlineWidth; Canvas.TextRect( Rect, x, y, Cells[1,1] ); end; end; [/code] |
careychen
尊榮會員 發表:41 回覆:580 積分:959 註冊:2004-03-03 發送簡訊給我 |
呵,你是找這篇的哦~~
http://delphicikk.atw.hu/listaz.php?id=665&oldal=43 請在下面加個 Refresh 即可 ===================引 用 narcysionlin 文 章=================== 如何利用迴圈合併儲存格 我在stringgrid帶出來的資料是, G001 管理處 財務部 出納 G001 管理處 財務部 成本 G001 管理處 財務部 應收 G002 製造部 統購部 電子 G002 製造部 統購部 機構 S003 業務部 品牌業務 OEM1 S003 業務部 OEM業務 OEM2 我有找到一段程式,可把儲存格合併, 但我不知如何運用迴圈程式,讓程式如何自已判斷當資料遇到"G001", 合併成類似Excel的合併儲存格,遇到"管理處"合併儲存格呢 麻煩各位大大幫我看,這問題困擾我很久了。想不透! [code delphi] procedure TFmA05.FormCreate(Sender: TObject); var x, k: Integer; begin with stringgrid1 do begin cells[1, 1] := 'A rather long line which will span cells'; for x:= 1 to colcount-1 do for k:= 2 to rowcount -1 do cells[x,k] := Format('Cell[%d,%d]', [x,k]); Refresh; // 請在這邊加個 Refresh end; end; [/code] [code delphi] procedure TFmA05.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); var i, x, y: Integer; begin If gdFixed In State Then Exit; If ARow > 1 Then Exit; with sender as tstringgrid do begin If aCol < Pred(ColCount) Then Rect.Right := Rect.Right GridlineWidth; y:= Rect.Top 2; x:= Rect.Left 2; for i:= 1 to aCol-1 do x:= x - ColWidths[i] - GridlineWidth; Canvas.TextRect( Rect, x, y, Cells[1,1] ); end; end; [/code]
------
價值的展現,來自於你用哪一個角度來看待它!! |
narcysionlin
一般會員 發表:7 回覆:4 積分:2 註冊:2006-11-01 發送簡訊給我 |
|
careychen
尊榮會員 發表:41 回覆:580 積分:959 註冊:2004-03-03 發送簡訊給我 |
既然如此,我寫一個函式給你,你想怎麼合併就怎麼合併,你想水平、上下對齊都可以
此函數你也可以自己修正,加一個文字的參數,則這個合併之後,你可以秀出自己的文字 目前預設是使用左上的那一格裡的字,當成合併後要顯示的字 以上 [code delphi] procedure MergeCell(Sender: TObject; AStartCol, AStartRow, AEndCol, AEndRow: Integer; HAlign: TAlignment=taLeftJustify; VAlign: TVerticalAlignment=taVerticalCenter); // 上下左右的空白 Pixel 數,如果沒有這個字會在格線上,很難看!! const _MarginPixel = 3; var iLeft, iTop, iRight, iBottom: Integer; iStartDrawTextLeft, iStartDrawTextTop: Integer; iTextLen, iTextWidth, iTextHeight, iDisplayWidth: Integer; sDisplayText: String; NewRect: TRect; begin if AEndCol < AStartCol then Exit; if AEndRow < AStartRow then Exit; if Not (Sender is TStringGrid) then Exit; with TStringGrid(Sender) do begin // 要顯示的字 sDisplayText := Cells[AStartCol, AStartRow]; // 先計算單一個字佔多少寬度 iTextWidth := Canvas.TextWidth(sDisplayText); iTextHeight := Canvas.TextHeight(sDisplayText); iLeft := CellRect(AStartCol, AStartRow).Left; iTop := CellRect(AStartCol, AStartRow).Top; iRight := CellRect(AEndCol, AEndRow).Right; iBottom := CellRect(AEndCol, AEndRow).Bottom; NewRect := Rect(iLeft, iTop, iRight, iBottom); // 計算水平位置 case HAlign of taLeftJustify: // 讓左邊有 3 Pixel 的空間比較好看 iStartDrawTextLeft := iLeft _MarginPixel; taRightJustify: // 讓右邊有 3 Pixel 的空間比較好看 iStartDrawTextLeft := iRight - iTextWidth - _MarginPixel; taCenter: iStartDrawTextLeft := iLeft (iRight - iLeft - iTextWidth) div 2; end; // 計算垂直 case VAlign of taAlignTop: iStartDrawTextTop := iTop _MarginPixel; taAlignBottom: iStartDrawTextTop := iBottom - iTop - _MarginPixel; taVerticalCenter: iStartDrawTextTop := iTop (iBottom - iTop - iTextHeight) div 2; end; Canvas.FillRect(NewRect); ExtTextOut(Canvas.Handle, iStartDrawTextLeft, iStartDrawTextTop, 0, @NewRect, PChar(sDisplayText), length(sDisplayText), nil); end; end; // 呼叫方式 // 預設靠左對齊,水平置中對齊 MergeCell(StringGrid1, 2, 2, 3, 3) ; // 合併 Cell[2,2] 到 Cell[3,3] 秀出的文字為 Cell[2,2] MergeCell(StringGrid1, 2, 2, 3, 3, taCenter, taVerticalCenter); [/code] 哦,對了,把這個 MergeCell 放到 OnDrawCell 來使用!! ===================引 用 narcysionlin 文 章=================== Hello大大,我不是這個意思! 應該說,這程式碼合併出來的儲存格是橫的, 我應該如果把他弄成合併儲存格是直的呢?
------
價值的展現,來自於你用哪一個角度來看待它!! |
RootKit
資深會員 發表:16 回覆:358 積分:419 註冊:2008-01-02 發送簡訊給我 |
|
RootKit
資深會員 發表:16 回覆:358 積分:419 註冊:2008-01-02 發送簡訊給我 |
|
careychen
尊榮會員 發表:41 回覆:580 積分:959 註冊:2004-03-03 發送簡訊給我 |
|
careychen
尊榮會員 發表:41 回覆:580 積分:959 註冊:2004-03-03 發送簡訊給我 |
Hi, 已修正 Rootkit 說明的錯誤
[code delphi] procedure MergeCell(Sender: TObject; AStartCol, AStartRow, AEndCol, AEndRow: Integer; HAlign: TAlignment=taCenter; VAlign: TVerticalAlignment=taVerticalCenter); // 上下左右的空白 Pixel 數,如果沒有這個設定,字會黏在格線上,很難看!! const _MarginPixel = 3; var iLeft, iTop, iRight, iBottom: Integer; iStartDrawTextLeft, iStartDrawTextTop: Integer; iTextWidth, iTextHeight: Integer; sDisplayText: String; NewRect: TRect; begin if Not (Sender is TStringGrid) then Exit; if AEndCol < AStartCol then Exit; if AEndRow < AStartRow then Exit; if AStartCol < 0 then Exit; if AStartRow < 0 then Exit; if AEndRow >= TStringGrid(Sender).VisibleRowCount then AEndRow := TStringGrid(Sender).VisibleRowCount-1; with TStringGrid(Sender) do begin // 要顯示的字【以左上的那一格為主】 sDisplayText := Cells[AStartCol, AStartRow]; // 先計算單一個字佔多少寬度與高度 iTextWidth := Canvas.TextWidth(sDisplayText); iTextHeight := Canvas.TextHeight(sDisplayText); // 計算新範圍的上下左右邊界 iLeft := CellRect(AStartCol, AStartRow).Left; iTop := CellRect(AStartCol, AStartRow).Top; iRight := CellRect(AEndCol, AEndRow).Right; iBottom := CellRect(AEndCol, AEndRow).Bottom; NewRect := Rect(iLeft, iTop, iRight, iBottom); // 計算水平位置 case HAlign of taLeftJustify: // 讓左邊有 3 Pixel 的空間比較好看 iStartDrawTextLeft := iLeft _MarginPixel; taRightJustify: // 讓右邊有 3 Pixel 的空間比較好看 iStartDrawTextLeft := iRight - iTextWidth - _MarginPixel; taCenter: iStartDrawTextLeft := iLeft (iRight - iLeft - iTextWidth) div 2; end; // 計算垂直 case VAlign of taAlignTop: // 讓上面有 3 Pixel 的空間比較好看 iStartDrawTextTop := iTop _MarginPixel; taAlignBottom: // 讓下面有 3 Pixel 的空間比較好看 iStartDrawTextTop := iBottom - iTextHeight - _MarginPixel; taVerticalCenter: iStartDrawTextTop := iTop (iBottom - iTop - iTextHeight) div 2; end; Canvas.FillRect(NewRect); ExtTextOut(Canvas.Handle, iStartDrawTextLeft, iStartDrawTextTop, 0, @NewRect, PChar(sDisplayText), length(sDisplayText), nil); end; end; [/code]
------
價值的展現,來自於你用哪一個角度來看待它!! |
narcysionlin
一般會員 發表:7 回覆:4 積分:2 註冊:2006-11-01 發送簡訊給我 |
|
careychen
尊榮會員 發表:41 回覆:580 積分:959 註冊:2004-03-03 發送簡訊給我 |
不是不是,因為我用的是 Delphi 2007 他有內建這個,所以請你在 procedure MergeCell 的上面加上
[code delphi] type TVerticalAlignment = (taAlignTop, taAlignBottom, taVerticalCenter); [/code] ===================引 用 narcysionlin 文 章=================== 再請問一下,我run會有下面提示,是少弄什麼嗎? Unddeclared identifier:'TVerticalAlignment' Unddeclared identifier:'taVerticalCenter' Unddeclared identifier:'taAlignTop' Unddeclared identifier:'taAlignBottom' Duplicate case label
------
價值的展現,來自於你用哪一個角度來看待它!! |
narcysionlin
一般會員 發表:7 回覆:4 積分:2 註冊:2006-11-01 發送簡訊給我 |
我也是delphi 7,
不好意思,我研究了好幾天,還是不知道怎麼放,一直有錯誤訊息 只好上來求救 你寫給我的程式要放在OnDrawCell 我直接把程式貼出來,我總覺的我寫的怪怪的 最上面的 [code delphi] type TFmA05 = class(TForm) Panel2: TPanel; LbCNT: TLabel; BtnQuery: TBitBtn; BitBtn1: TBitBtn; PageCtrl1: TPageControl; DBGrid1: TDBGrid; cQuery: TQuery; DataSource1: TDataSource; BtnXLS: TBitBtn; cQueryDIVTXT: TStringField; cQueryDPTTXT: TStringField; cQuerySECTXT: TStringField; cQueryEMPDPT: TFloatField; cQueryEMPSEC: TFloatField; LbRecNo: TLabel; cQueryBDEDesigner00001: TStringField; StringGrid1: TStringGrid; Button1: TButton; procedure BitBtn1Click(Sender: TObject); procedure BtnQueryClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormResize(Sender: TObject); procedure Button1Click(Sender: TObject); procedure MergeCell; procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); [/code] 在StringGrid1的onDrawCell底下寫入 [code delphi] procedure TFmA05.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); begin type TVerticalAlignment = (taAlignTop, taAlignBottom, taVerticalCenter); procedure MergeCell(Sender: TObject; AStartCol, AStartRow, AEndCol, AEndRow: Integer; HAlign: TAlignment=taCenter; VAlign: TVerticalAlignment=taVerticalCenter); // 上下左右的空白 Pixel 數,如果沒有這個設定,字會黏在格線上,很難看!! const _MarginPixel = 3; var iLeft, iTop, iRight, iBottom: Integer; iStartDrawTextLeft, iStartDrawTextTop: Integer; iTextWidth, iTextHeight: Integer; sDisplayText: String; NewRect: TRect; begin if Not (Sender is TStringGrid) then Exit; if AEndCol < AStartCol then Exit; if AEndRow < AStartRow then Exit; if AStartCol < 0 then Exit; if AStartRow < 0 then Exit; if AEndRow >= TStringGrid(Sender).VisibleRowCount then AEndRow := TStringGrid(Sender).VisibleRowCount-1; with TStringGrid(Sender) do begin // 要顯示的字【以左上的那一格為主】 sDisplayText := Cells[AStartCol, AStartRow]; // 先計算單一個字佔多少寬度與高度 iTextWidth := Canvas.TextWidth(sDisplayText); iTextHeight := Canvas.TextHeight(sDisplayText); // 計算新範圍的上下左右邊界 iLeft := CellRect(AStartCol, AStartRow).Left; iTop := CellRect(AStartCol, AStartRow).Top; iRight := CellRect(AEndCol, AEndRow).Right; iBottom := CellRect(AEndCol, AEndRow).Bottom; NewRect := Rect(iLeft, iTop, iRight, iBottom); // 計算水平位置 case HAlign of taLeftJustify: // 讓左邊有 3 Pixel 的空間比較好看 iStartDrawTextLeft := iLeft _MarginPixel; taRightJustify: // 讓右邊有 3 Pixel 的空間比較好看 iStartDrawTextLeft := iRight - iTextWidth - _MarginPixel; taCenter: iStartDrawTextLeft := iLeft (iRight - iLeft - iTextWidth) div 2; end; // 計算垂直 case VAlign of taAlignTop: // 讓上面有 3 Pixel 的空間比較好看 iStartDrawTextTop := iTop _MarginPixel; taAlignBottom: // 讓下面有 3 Pixel 的空間比較好看 iStartDrawTextTop := iBottom - iTextHeight - _MarginPixel; taVerticalCenter: iStartDrawTextTop := iTop (iBottom - iTop - iTextHeight) div 2; end; Canvas.FillRect(NewRect); ExtTextOut(Canvas.Handle, iStartDrawTextLeft, iStartDrawTextTop, 0, @NewRect, PChar(sDisplayText), length(sDisplayText), nil); end; // 呼叫方式 // 預設靠左對齊,水平置中對齊 MergeCell(StringGrid1, 2, 2, 3, 3) ; // 合併 Cell[2,2] 到 Cell[3,3] 秀出的文字為 Cell[2,2] MergeCell(StringGrid1, 2, 2, 3, 3, taCenter, taVerticalCenter); end; end; [/code] 會出現錯誤訊息 [Error] UnA05.pas(207): Statement expected but 'TYPE' found [Error] UnA05.pas(266): Undeclared identifier: 'StringGrid1' [Error] UnA05.pas(276): '.' expected but ';' found [Error] UnA05.pas(35): Unsatisfied forward or external declaration: 'TFmA05.MergeCell' ===================引 用 careychen 文 章=================== 不是不是,因為我用的是 Delphi 2007 他有內建這個,所以請你在 procedure MergeCell 的上面加上 [code delphi] type TVerticalAlignment = (taAlignTop, taAlignBottom, taVerticalCenter); [/code] ===================引 用 narcysionlin 文 章=================== 再請問一下,我run會有下面提示,是少弄什麼嗎? Unddeclared identifier:'TVerticalAlignment' Unddeclared identifier:'taVerticalCenter' Unddeclared identifier:'taAlignTop' Unddeclared identifier:'taAlignBottom' Duplicate case label |
careychen
尊榮會員 發表:41 回覆:580 積分:959 註冊:2004-03-03 發送簡訊給我 |
請直接把下面的程式碼 Copy 貼回去妳的程式裡面
不過,看了一下妳的寫法..... 建議 delphi 要多學習一下哦,妳原本發生錯誤的原因是為函式放的位置不對 所以怎麼 compiler 都會錯~! 最上面的 [code delphi] type TVerticalAlignment = (taAlignTop, taAlignBottom, taVerticalCenter); // 放在這裡 TFmA05 = class(TForm) Panel2: TPanel; LbCNT: TLabel; BtnQuery: TBitBtn; BitBtn1: TBitBtn; PageCtrl1: TPageControl; DBGrid1: TDBGrid; cQuery: TQuery; DataSource1: TDataSource; BtnXLS: TBitBtn; cQueryDIVTXT: TStringField; cQueryDPTTXT: TStringField; cQuerySECTXT: TStringField; cQueryEMPDPT: TFloatField; cQueryEMPSEC: TFloatField; LbRecNo: TLabel; cQueryBDEDesigner00001: TStringField; StringGrid1: TStringGrid; Button1: TButton; procedure BitBtn1Click(Sender: TObject); procedure BtnQueryClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormResize(Sender: TObject); procedure Button1Click(Sender: TObject); procedure MergeCell;(Sender: TObject; // 這邊要寫這樣 AStartCol, AStartRow, AEndCol, AEndRow: Integer; HAlign: TAlignment=taCenter; VAlign: TVerticalAlignment=taVerticalCenter); procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); [/code] 在StringGrid1的onDrawCell底下寫入 [code delphi] // 這邊改這樣 procedure TFmA05.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); begin MergeCell(StringGrid1, 2, 2, 3, 3); end; // 這行刪掉 type TVerticalAlignment = (taAlignTop, taAlignBottom, taVerticalCenter); // 這邊改這樣 procedure TFmA05.MergeCell(Sender: TObject; AStartCol, AStartRow, AEndCol, AEndRow: Integer; HAlign: TAlignment=taCenter; VAlign: TVerticalAlignment=taVerticalCenter); // 上下左右的空白 Pixel 數,如果沒有這個設定,字會黏在格線上,很難看!! const _MarginPixel = 3; var iLeft, iTop, iRight, iBottom: Integer; iStartDrawTextLeft, iStartDrawTextTop: Integer; iTextWidth, iTextHeight: Integer; sDisplayText: String; NewRect: TRect; begin if Not (Sender is TStringGrid) then Exit; if AEndCol < AStartCol then Exit; if AEndRow < AStartRow then Exit; if AStartCol < 0 then Exit; if AStartRow < 0 then Exit; if AEndRow >= TStringGrid(Sender).VisibleRowCount then AEndRow := TStringGrid(Sender).VisibleRowCount-1; with TStringGrid(Sender) do begin // 要顯示的字【以左上的那一格為主】 sDisplayText := Cells[AStartCol, AStartRow]; // 先計算單一個字佔多少寬度與高度 iTextWidth := Canvas.TextWidth(sDisplayText); iTextHeight := Canvas.TextHeight(sDisplayText); // 計算新範圍的上下左右邊界 iLeft := CellRect(AStartCol, AStartRow).Left; iTop := CellRect(AStartCol, AStartRow).Top; iRight := CellRect(AEndCol, AEndRow).Right; iBottom := CellRect(AEndCol, AEndRow).Bottom; NewRect := Rect(iLeft, iTop, iRight, iBottom); // 計算水平位置 case HAlign of taLeftJustify: // 讓左邊有 3 Pixel 的空間比較好看 iStartDrawTextLeft := iLeft _MarginPixel; taRightJustify: // 讓右邊有 3 Pixel 的空間比較好看 iStartDrawTextLeft := iRight - iTextWidth - _MarginPixel; taCenter: iStartDrawTextLeft := iLeft (iRight - iLeft - iTextWidth) div 2; end; // 計算垂直 case VAlign of taAlignTop: // 讓上面有 3 Pixel 的空間比較好看 iStartDrawTextTop := iTop _MarginPixel; taAlignBottom: // 讓下面有 3 Pixel 的空間比較好看 iStartDrawTextTop := iBottom - iTextHeight - _MarginPixel; taVerticalCenter: iStartDrawTextTop := iTop (iBottom - iTop - iTextHeight) div 2; end; Canvas.FillRect(NewRect); ExtTextOut(Canvas.Handle, iStartDrawTextLeft, iStartDrawTextTop, 0, @NewRect, PChar(sDisplayText), length(sDisplayText), nil); end; end; [/code] 會出現錯誤訊息 [Error] UnA05.pas(207): Statement expected but 'TYPE' found [Error] UnA05.pas(266): Undeclared identifier: 'StringGrid1' [Error] UnA05.pas(276): '.' expected but ';' found [Error] UnA05.pas(35): Unsatisfied forward or external declaration: 'TFmA05.MergeCell'
------
價值的展現,來自於你用哪一個角度來看待它!! |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |