none
Windows7でGDIの線分表示スピードをWindowsXP並みに速くする方法はありますか? RRS feed

  • 質問

  • 2次元CADでは線分の表示スピードが最も重要視されます。
    当方で、GDIで線分表示するスピードを測定した結果、
    COPYPENモードではWindows 7はWindows XPに比べ4倍~9倍遅い。
    MASKPENモードではWindows 7はWindows XPに比べ10倍~87倍遅い。
    となり、Windows7のGDI表示スピードを速くしたいのですが、何か良い方法がないでしょうか。
    Windows7ではDirect2Dを利用すると速くなるようですが、過去のOSでの稼働保障、開発環境(DELPHI3)、開発工数を考慮するとDirect2D採用は難しい状況です。

    測定PC:
    ① DELL PRECISION 380    Windows XP Pro, Pentium 4 2.8GHz, 1GB RAM
    ② DELL VOSTRO 430       Windows 7  Pro, Core i5 750 2.67GHz, 4GB RAM
    ③ TOSHIBA dynabook TX TX/66J2PK PATX66J2LPPK, Windows 7 Home, Core2 Duo P8700 2.53GHz, 4GB RAM

    測定結果:
                                                      R2_COPYPEN     R2_MASKPEN
    ①Windows XP Pro                                       47             47 ミリ秒
    ②Windows7 Pro,Windows 7 Aeroテーマ        172          4103
    ②Windows7 Pro,Windows 7 ベーシック          420            480
    ②Windows7 Pro,Windows XP Mode              170            250
    ③Windows7 Home,Windows 7 Aeroテーマ     219          4275

    描画スピード測定プログラム:
    SetRop2のパラメータを変えて、微小線分を多数表示する簡単なテストプログラムをDELPHI Ver.3.0で作成しました。
    非常に単純で、「R2_COPYPEN」ボタン1を押すと、
    SetRop2(Canvas.Handle,R2_COPYPEN);
    を実行して、線分を描き、描画時間を表示します。
    「R2_MASKPEN」ボタン2を押すと、
    SetRop2(Canvas.Handle,R2_MASKPEN);
    を実行して、線分を描き、描画時間を表示します。

    下記は本プログラムのソースコードファイル(Unit1.pas)の内容です。

    procedure DrawLines(DC:HDC; Rect:trect; Var Time:integer);
    var iw,ih,nw,nh,nx,ny:integer;
        TimeS,TimeE:integer;
    begin
    TimeS:=GetTickCount;
    nw:=(Rect.Right-Rect.Left) div 10;
    nh:=(Rect.Bottom-Rect.Top) div 2;
    nx:=0;
    ny:=0;
    for ih:=1 to nh do
       begin
       for iw:=1 to nw do
          begin
          MoveToEx(DC,nx,ny,nil);
          LineTo(DC,nx+4,ny);
          nx:=nx+10;
          end;
       ny:=ny+2;
       nx:=0;
       end;
    TimeE:=GetTickCount;
    Time:=TimeE-TimeS;
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    var Rect:trect;
        Time:Integer;
    begin
    Rect:=GetClientRect;
    Canvas.Brush.Style:=bsSolid;
    Canvas.Brush.Color:=clWhite;
    Canvas.FillRect(Rect);
    Canvas.Pen.Color:=clRed;
    SetRop2(Canvas.Handle,R2_COPYPEN);
    DrawLines(Canvas.Handle,Rect,Time);
    LabelTime.Caption := IntToStr(Time);
    end;

    procedure TForm1.Button2Click(Sender: TObject);
    var Rect:trect;
        Time:Integer;
    begin
    Rect:=GetClientRect;
    Canvas.Brush.Style:=bsSolid;
    Canvas.Brush.Color:=clWhite;
    Canvas.FillRect(Rect);
    Canvas.Pen.Color:=clBlue;
    SetRop2(Canvas.Handle,R2_MASKPEN);
    DrawLines(Canvas.Handle,Rect,Time);
    LabelTime.Caption := IntToStr(Time);
    end;

    2010年7月7日 3:02