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

將 Tchart上下二圖合併,並存成圖形~多頁

答題得分者是:Fishman
seedbcc
高階會員


發表:232
回覆:272
積分:105
註冊:2003-12-10

發送簡訊給我
#1 引用回覆 回覆 發表時間:2005-10-27 10:43:45 IP:221.169.xxx.xxx 未訂閱
如圖所示,小弟的圖,實際上是上下二個獨立的Tchart 共有三個page。 原本按滑鼠右鍵有個功能,就是儲存圖形=>把上下二張圖合併(只有單頁) 程式碼如下 procedure TFrm_PhVarControlChart.N2Click(Sender: TObject); var B1, B2: TBitmap; R1, R2: TRect; begin B1 := TBitmap.Create; B2 := TBitmap.Create; Chart_Up.CopyToClipboardBitmap; B1.LoadFromClipboardFormat(cf_Bitmap, ClipBoard.GetAsHandle(cf_Bitmap), 0); R1 := Rect(0, 0, B1.Width, B1.Height); Chart_Down.CopyToClipboardBitmap; B2.LoadFromClipboardFormat(cf_Bitmap, ClipBoard.GetAsHandle(cf_Bitmap), 0); R2 := Rect(0, B1.Height, B1.Width, B1.Height + B2.Height); B1.Height := B1.Height + B2.Height; B1.Canvas.CopyRect(R2, B2.Canvas, R1); With SaveDialog1 do begin DefaultExt := 'bmp'; Filter := 'Bitmap 檔案 (*.bmp)|*.bmp|Windows MetaFile 檔案 (*.wmf)|*.wmf'; InitialDir := ExtractFileDir(Application.ExeName) + '\'; if Execute then begin try B1.SaveToFile(FileName); Application.MessageBox(PChar(L_Message_OutputChart_Ok),PChar(L_Message_Window) , MB_OK+MB_ICONINFORMATION); except //'圖形匯出完成' '訊息視窗' Application.MessageBox(PChar(L_Message_OutputChart_Error),PChar(L_Message_Window) , MB_OK+MB_ICONERROR); end; //'圖形匯出失敗' '訊息視窗' end; end; B1.Free; B2.Free; end; 但是若要合併上下二圖,且從第一頁開始到最後一頁 就不知道如何改寫了 ,請教各位大大
Fishman
尊榮會員


發表:120
回覆:1949
積分:2163
註冊:2006-10-28

發送簡訊給我
#2 引用回覆 回覆 發表時間:2005-10-27 15:00:21 IP:210.65.xxx.xxx 未訂閱
Hi seedbcc,    大致如下,你可再自行修改,並請注意,不要讓 TBitMap 的 Width 與 Height 無限制的成長,以避免產生錯誤!    
procedure TForm1.Button2Click(Sender: TObject);
var
  B1, B2: TBitmap;
  R1, R2: TRect;
  i : integer;
begin
  With SaveDialog1 do
    begin
      DefaultExt := 'bmp';
      Filter := 'Bitmap 檔案 (*.bmp)|*.bmp|Windows MetaFile 檔案 (*.wmf)|*.wmf';
      InitialDir := ExtractFileDir(Application.ExeName)   '\';          if Execute then
        begin
          B1 := TBitmap.Create;
          B2 := TBitmap.Create;
          B1.Width := Chart1.Width * Chart1.NumPages;
          B1.Height := Chart1.Height   Chart2.Height;
          B2.Width := B1.Width;
          B2.Height := Chart2.Height;
          for I := 1 to Chart1.NumPages do
            begin
              Chart1.Page := I;
              Chart2.Page := I;                  Chart1.CopyToClipboardBitmap;
              B2.LoadFromClipboardFormat(cf_Bitmap, ClipBoard.GetAsHandle(cf_Bitmap),0);
              R1 := Rect(Chart1.Width * (I-1),0, Chart1.Width * I,Chart1.Height);
              R2 := Rect(0,0,chart1.Width,Chart1.Height);
              B1.Canvas.CopyRect(R1, B2.Canvas, R2);
//              B1.Canvas.StretchDraw(R1,B2);                  Chart2.CopyToClipboardBitmap;
              B2.LoadFromClipboardFormat(cf_Bitmap, ClipBoard.GetAsHandle(cf_Bitmap),0);
              R1 := Rect(Chart1.Width * (I-1), Chart1.Height, Chart1.Width * I, B1.Height);
              R2 := Rect(0,0,Chart2.Width,Chart2.Height);
              B1.Canvas.CopyRect(R1, B2.Canvas, R2);
//              B1.Canvas.StretchDraw(R1,B2);                end;
          try
            B1.SaveToFile(FileName);
            Application.MessageBox(PChar(L_Message_OutputChart_Ok),PChar(L_Message_Window) , MB_OK MB_ICONINFORMATION);
          except
            Application.MessageBox(PChar(L_Message_OutputChart_Error),PChar(L_Message_Window) , MB_OK MB_ICONERROR);
          end;
          B1.Free;
          B2.Free;
        end;
    end;
end;
---------------------------------- 小弟才疏學淺,若有謬誤尚請不吝指教 ----------------------------------
------
Fishman
seedbcc
高階會員


發表:232
回覆:272
積分:105
註冊:2003-12-10

發送簡訊給我
#3 引用回覆 回覆 發表時間:2005-10-27 15:37:43 IP:221.169.xxx.xxx 未訂閱
圖表改成由上而下    
procedure TForm1.Button2Click(Sender: TObject);
var
  B1, B2: TBitmap;
  R1, R2: TRect;
  i : integer;
begin
  With SaveDialog1 do
    begin
      DefaultExt := 'bmp';
      Filter := 'Bitmap 檔案 (*.bmp)|*.bmp|Windows MetaFile 檔案 (*.wmf)|*.wmf';
      InitialDir := ExtractFileDir(Application.ExeName)   '\';          if Execute then
        begin
          B1 := TBitmap.Create;
          B2 := TBitmap.Create;
          B1.Width := Chart1.Width;
          B1.Height := (Chart1.Height   Chart2.Height) *               Chart1.NumPages;
          B2.Width := B1.Width;
          B2.Height := Chart2.Height;
          for I := 1 to Chart1.NumPages do
            begin
              Chart1.Page := I;
              Chart2.Page := I;                  Chart1.CopyToClipboardBitmap;
              B2.LoadFromClipboardFormat(cf_Bitmap, ClipBoard.GetAsHandle(cf_Bitmap),0);
//              R1 := Rect(Chart1.Width * (I-1),0, Chart1.Width * I,Chart1.Height);
              R1 := Rect(0,Chart1.Height* (I-1) Chart2.Height*(I-1),Chart1.Width, Chart1.Height* I Chart2.Height*(I-1));                  R2 := Rect(0,0,chart1.Width,Chart1.Height);
              B1.Canvas.CopyRect(R1, B2.Canvas, R2);
//              B1.Canvas.StretchDraw(R1,B2);                  Chart2.CopyToClipboardBitmap;
              B2.LoadFromClipboardFormat(cf_Bitmap, ClipBoard.GetAsHandle(cf_Bitmap),0);
//              R1 := Rect(Chart1.Width * (I-1), Chart1.Height, Chart1.Width * I, B1.Height);
              R1 := Rect(0,Chart1.Height*I Chart2.Height*(I-1),Chart1.Width,Chart1.Height* I Chart2.Height*I);                  R2 := Rect(0,0,Chart2.Width,Chart2.Height);
              B1.Canvas.CopyRect(R1, B2.Canvas, R2);
//              B1.Canvas.StretchDraw(R1,B2);                end;
          try
            B1.SaveToFile(FileName);
            Application.MessageBox(PChar(L_Message_OutputChart_Ok),PChar(L_Message_Window) , MB_OK MB_ICONINFORMATION);
          except
            Application.MessageBox(PChar(L_Message_OutputChart_Error),PChar(L_Message_Window) , MB_OK MB_ICONERROR);
          end;
          B1.Free;
          B2.Free;
        end;
    end;
end;    
發表人 - seedbcc 於 2005/10/27 16:24:51 發表人 - seedbcc 於 2005/10/27 16:32:31
Fishman
尊榮會員


發表:120
回覆:1949
積分:2163
註冊:2006-10-28

發送簡訊給我
#4 引用回覆 回覆 發表時間:2005-10-27 16:30:37 IP:210.65.xxx.xxx 未訂閱
Hi seedbcc,
procedure TForm1.Button3Click(Sender: TObject);
var
  B1, B2: TBitmap;
  R1, R2: TRect;
  I,H : integer;
begin
  With SaveDialog1 do
    begin
      DefaultExt := 'bmp';
      Filter := 'Bitmap 檔案 (*.bmp)|*.bmp|Windows MetaFile 檔案 (*.wmf)|*.wmf';
      InitialDir := ExtractFileDir(Application.ExeName)   '\';          if Execute then
        begin
          B1 := TBitmap.Create;
          B2 := TBitmap.Create;
          H := Chart1.Height   Chart2.Height;
          B1.Width := Chart1.Width;
          B1.Height := H * Chart1.NumPages;
          for I := 1 to Chart1.NumPages do
            begin
              Chart1.Page := I;
              Chart2.Page := I;                  Chart1.CopyToClipboardBitmap;
              B2.LoadFromClipboardFormat(cf_Bitmap, ClipBoard.GetAsHandle(cf_Bitmap),0);
              R1 := Rect(0,H * (i - 1), Chart1.Width,H * (i - 1)  Chart1.Height);
              R2 := Rect(0,0,Chart1.Width,Chart1.Height);
              B1.Canvas.CopyRect(R1, B2.Canvas, R2);
//              B1.Canvas.StretchDraw(R1,B2);                  Chart2.CopyToClipboardBitmap;
              B2.LoadFromClipboardFormat(cf_Bitmap, ClipBoard.GetAsHandle(cf_Bitmap),0);
              R1 := Rect(0,H * (I-1)   Chart1.Height, Chart1.Width, H * I);
              R2 := Rect(0,0,Chart2.Width,Chart2.Height);
              B1.Canvas.CopyRect(R1, B2.Canvas, R2);
//              B1.Canvas.StretchDraw(R1,B2);                end;
          try
            B1.SaveToFile(FileName);
            Application.MessageBox(PChar(L_Message_OutputChart_Ok),PChar(L_Message_Window) , MB_OK MB_ICONINFORMATION);
          except
            Application.MessageBox(PChar(L_Message_OutputChart_Error),PChar(L_Message_Window) , MB_OK MB_ICONERROR);
          end;
          B1.Free;
          B2.Free;
        end;
    end;
end;
---------------------------------- 小弟才疏學淺,若有謬誤尚請不吝指教 ----------------------------------
------
Fishman
系統時間:2024-11-25 18:56:49
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!