unit graphsys;
{$IFDEF FPC}
  {$MODE DELPHI}{$H+}
{$ENDIF}
(***************************************)
(* Copyright (C) 2013, SHIRAISHI Kazuo *)
(***************************************)


interface
uses Types,ExtCtrls,Graphics,LCLType,
     base,MyUtils;

type
  GraphModeType=(ScreenBitMapMode,SizeMetaFileMode,PrtMetaFileMode,PrtDirectMode);
var 
   NextGraphMode:GraphmodeTYpe=ScreenBitmapMode;
var
   AlignTop:boolean=false;
   AdditionalMargin:integer=0;
   MymmWidth:integer=10000;
   MymmHeight:integer=10000;

   var
   BitMapHeight:integer=801;
   BitMapWidth:integer=801;
   FontCharSet:Tfontcharset=1;
   FontSize:longint=10;
   FontName:string;
   FontStyle:TFontstyles;

type
   tjHorizontal=(tjLEFT,tjCENTER,tjRIGHT);
   tjVirtical=(tjTOP,tjCAP,tjHALF,tjBASE,tjBOTTOM);
const
   Hjustification:array[tjHorizontal]of string[6]=('LEFT','CENTER','RIGHT');
   Vjustification:array[tjVirtical]of string[6]=('TOP','CAP','HALF','BASE','BOTTOM');


const
   TextHeightMulti=1.25;

const
   maxcolor=255;
var
   axescolor0:integer=15;
   axescolor:integer=15;

{**********}
{TMyPalette}
{**********}

const
   White=$00FFFFFF;
   Black=$00000000;
   Blue= $00FF0000;
   Green=$0000FF00;
   Red  =$000000FF;
   Cyan =Blue+Green;
   Yellow=Green+Red;
   Magenta=Red+Blue;

type
  TMyPalette=class
     private
        PrivatePaletteNumber :integer ; {0～2}
        function getPal(c:integer):TColor;
        procedure setPal(c:integer; cl:TColor);
        procedure InitMyPalette(n:integer);
     public
        pal: array[0..maxcolor]of TColor;
        PaletteDisabled:boolean;
        function ColorIndex(color:TColor):integer;
        property palette[c:integer]:TColor read getPal write setPal ; default;
        property PaletteNumber :integer read privatePaletteNumber write InitMyPalette;
   end;

  TMyPalette16=array[0..15]of TColor;

const
   MyPalette0:TMyPalette16=(White,Black,Blue,Green,Red,Cyan,Yellow,Magenta,
               clGray,clNavy,clGreen,clTeal,clMaroon,clOlive,clPurple,clSilver);

   MyPalette1:TMyPalette16=(Black,Blue,Green,Cyan,Red,Magenta,Yellow,White,
               clGray,clNavy,clGreen,clTeal,clMaroon,clPurple,clOlive,clSilver);

   MyPalette2:TMyPalette16=(Black,Blue,Red,Magenta,Green,Cyan,Yellow,White,
                  clGray,clNavy,clPurple,clMaroon,clGreen,clTeal,clOlive,clSilver);
var
     MyPalette:TMyPalette;

type
   TAreaStyle=(asHollow, asSolid, asHatch);




{***********}
{ TGraphSys }
{***********}

type
 TBeamMode=(bmRigorous, bmImmortal);
const
 s_Rigorous='RIGOROUS';
 s_Immortal='IMMORTAL';
type
  TLineBuff=Array[0..247]of TPoint;
  PLineBuff=^TLineBuff;

type
 TGraphSys=Class

     beam0:boolean;
     latex,latey:integer;
     BeamMode:TBeamMode;
     clip:boolean;
     Hjustify:tjHorizontal;
     Vjustify:tjVirtical;
     PenStyle:TPenStyle;

     left,right,bottom,top:double;
     VPleft,VPright,VPbottom,VPtop:double;
     DWleft,DWright,DWbottom,DWtop:double;
     DVleft,DVright,DVbottom,DVtop:integer;
     DevRect:TRect;
     ClipRect:TRect;
     MyRgn:HRGN;

     linecolor,pointcolor,areacolor,textcolor:integer;
     pointstyle:integer;
     textangle:integer; {度}
     linewidth:integer;

     AreaStyleIndex:byte;
     AreaStyle:TAreaStyle;
     TextHeight0:double;

    constructor create;
    destructor destroy; override;
    function virtualX(vx:integer):double;
    function VirtualY(vy:integer):double;
    function deviceX(x:double):integer;
    function deviceY(y:double):integer;
    function ConvToDeviceX(x:double; var i:integer):boolean;
    function ConvToDeviceY(y:double; var j:integer):boolean;
    function GWidth:double;
    function GHeight:double;
    procedure setupClipRect; virtual; abstract;
    procedure SetTextHeight(const x:double);
    function AskTextHeight:double;
    procedure askDeviceSize(var w,h:double; var s:string);
    procedure clear;                       virtual;
    procedure SetUpCoordinateSubSystem;

    procedure InitGraphic;
    procedure InitCoordinate;
    procedure SetWindow(l,r,b,t:double);
    procedure SetViewport(l,r,b,t:double);
    procedure SetDeviceWindow(l,r,b,t:double);
    function SetDeviceViewport(l,r,b,t:double):boolean;
    procedure SetClip(c:boolean);
    procedure plotto(x,y: double);
    procedure putmark(x,y:double);
    procedure PutText(const n,m:double; const s:string);
    procedure GraphText(const n,m:double; const s:string);
    procedure PlotText(const n,m:double; const s:string);
    procedure PlotLetters(const n,m:double; const s:string);

    procedure finish;  virtual;abstract;
    procedure SetBitmapSize(w,h:integer);virtual;
    function OpenFile(FileName: string):boolean;virtual;
    procedure SaveFile(FileName: string);virtual;

    procedure putpixel(a,b:integer); virtual;
    procedure line(a1,b1,a2,b2:integer; c:integer; ps:TPenStyle; w:integer); virtual;
    procedure putmark0(a,b:integer);
    procedure setlinecolor(c:integer); virtual;
    procedure settextcolor(c:integer);  virtual;
    procedure SetPenStyle(ps:TPenStyle); virtual;
    procedure setlinewidth(c:integer);   virtual;
    procedure SetTextFont(name0:AnsiString; size:integer);  virtual;
    procedure AskTextFont(var name1:AnsiString; var size:integer);
    procedure getpoint(var a,b:integer);virtual;
    procedure MoveMouse(a,b:integer);virtual;
    procedure MousePol(var a,b:integer; var l,r:boolean); virtual;
    procedure TextOut(x,y:integer; const s:ansistring; angle:integer);
    procedure TextOutSub(x,y:integer; const s:ansistring; angle:integer);  virtual;
    procedure SetRasterMode(b:TPenMode);virtual;
    procedure setHiddenDrawMode(b:boolean);virtual;

    function ColorIndexOf(a,b:integer):integer;virtual;
    function setcolormode(s:ansistring):boolean;
    function AskColorMode:Ansistring;
    function textwidth(const s:ansistring):integer;
    function textheight(const s:ansistring):integer;
    procedure AskDeviceViewport(var l,r,b,t:double);

    procedure MSPaint( x,y:integer; ac, bc:integer);  virtual;
    procedure MSCircle(x1,y1,x2,y2:integer; lc,ac:integer; f:boolean); virtual;
    procedure MSMoveTo(a,b:integer);virtual;
    procedure MSLineTo(a,b:integer);virtual;
    procedure MSScreen(c:integer);virtual;
    procedure putColor(a,b:integer; c:integer); virtual;

    procedure Flood(x,y:integer);     virtual;
    procedure FloodFill(x,y:integer); virtual;
    procedure Polygon(const Points:array of TPoint); virtual;
    procedure Polyline(const Points:array of TPoint);  virtual;
    procedure ColorPolyGon(const Points:array of TPoint; c:integer{色指標});virtual;
    procedure PolyBezier(const Points:array of TPoint);  virtual;

    procedure SetAreaStyle(s:TAreaStyle);
    procedure SetAreaStyleIndex(i:integer);

    function SetBeamMode(s:AnsiString):boolean;
    function AskBeamMode:AnsiString;

    function xdirection(const x0,y0:double):integer;
    procedure SetBeam(t:boolean);
    property beam:boolean read beam0 write SetBeam;
    procedure ThinRepaint; virtual;

   private
     Canvas1:TCanvas;
     HMulti,HShift,VMulti,VShift:double;
     DevHeight,DevWidth:integer;
     LineBuff:PLineBuff;
     LineBuffCount:integer;
     TextHeightChanged:boolean;

    procedure start; virtual;abstract;
    procedure InitCoordSub;  virtual;
    procedure SetDefaultCoordinate;
    procedure makeClipRect;
    procedure ColorPolyGonSub(Canvas:TCanvas; const Points:array of TPoint; c:integer{色指標});
    procedure PolyGonSub(Canvas:TCanvas; const Points:array of TPoint);
    procedure PolyLineSub(Canvas:TCanvas; const Points:array of TPoint);
    procedure BezierSub(Canvas:TCanvas; const Points:array of TPoint);
    procedure segment(x1,y1,x2,y2:integer); virtual;
    procedure SegmentWinSub(Canvas:TCanvas;  x1,y1,x2,y2:integer);
    procedure SegmentWin(Canvas:TCanvas;  x1,y1,x2,y2:integer);
    procedure SegmentForward(Canvas:TCanvas;  x1,y1,x2,y2:integer);
    procedure StyledLine(x2,y2:integer);
    procedure LineBuffFlush;
    procedure ClearScreen;virtual;
    function PixelsPerMeter:double;virtual;abstract;
    procedure ProjectiveText(const n,m:double; const s:string; PlotStm:boolean);
    procedure SetCanvasTextHeight(const x:double);virtual;
    function GetCanvasTextHeight:double;

   end;

type

  TScreenBMPGraphSys=class(TGraphSys)
       Bitmap1:TBitMap;
      constructor create;
     procedure start; override;
     procedure finish; override;
     procedure SetBitmapSize(w,h:integer);override;
     procedure InitCoordSub;  override;
     procedure setupClipRect;override;
     function PixelsPerMeter:double;override;
     procedure ThinRepaint; override;
     procedure setHiddenDrawMode(b:boolean);override;
     procedure getpoint(var a,b:integer);override;
     procedure MoveMouse(a,b:integer);override;
     procedure MousePol(var a,b:integer; var l,r:boolean); override;
     procedure Flood(x,y:integer);    override;
     procedure FloodFill(x,y:integer); override;
     procedure MSScreen(c:integer);override;
     function OpenFile(FileName: string):boolean;override;
     procedure SaveFile(FileName: string);override;
     procedure Clear;override;
     procedure setup;
     procedure SetSize1;
     procedure PaintPaintbox;
  private
     procedure setBMPsize(init:boolean);

  end;

  TMetaPrtGraphSys=class(TGraphSys)
    procedure setupClipRect;override;
   private
    procedure InitCoordSub;  override;
    procedure SetDefaultMargin;
    function PixelsPerMeter:double;override;
  end;



  TPrtDirectGraphSys=class(TMetaPrtGraphSys)
    constructor create;
    procedure clear; override;
    procedure start;  override;
    procedure finish; override;
   private
    procedure ClearScreen;override;
  end;

var
   ScreenBMPGraphSys:TScreenBMPGraphSys;
   PrtDirectGraphSys:TPrtDirectGraphSys;
   MyGraphSys : TGraphSys;

{*************}
{miscellaneous}
{*************}

var restrict: function(n:integer):integer;

var
    iBKmode:integer = TRANSPARENT;
    HiddenDrawMode:boolean = false;
    RepaintRequest:boolean = false;

var
    ForwardPlot:boolean = true;
    GeometricPenOnly:boolean = false;
    TextProblemCoordinate:boolean = false;
var
   invalidCoordinate:boolean=false;

procedure initGraphics;

procedure RepaintExec;

implementation

uses
Classes, SysUtils, Forms, Math,
Interfaces, LCLIntf,  GraphType, GraphUtil,
Printers, printdlg,
{$IFDEF Windows}
 Winlib,
{$ENDIF}
base2, affine,paintfrm,locatefrm,mythread;

{$MAXFPUREGISTERS Default}
{**********}
{TMyPalette}
{**********}

var
   PaletteCriticalSection:TRTLCriticalSection;

function TMyPalette.getPal(c:integer):TColor;
begin
   if PaletteDisabled then
      result:=c
   else
      result:=pal[c and 255] or $2000000
end;


procedure TMyPalette.setPal(c:integer; cl:TColor);
begin
   EnterCriticalSection(PaletteCriticalSection);
   pal[c and 255]:=cl and $ffffff;
   LeaveCriticalSection(PaletteCriticalSection);
end;

function TMyPalette.ColorIndex(color:TColor):integer;
var
  i:integer;
begin
  if color=-1 then
     result:=-1
  else
  begin
  color:=color and $ffffff;
  if PaletteDisabled then
     result:=color
  else
     begin
       result:=-1;
       i:=0;
       while i<=maxcolor do
          if Pal[i]=color then
                begin
                  result:=i;
                  break
                end
           else
                inc(i);
     end;
  end;   
end;

procedure TMyPalette.InitMyPalette(n:integer);
var
   i,j,k:integer;
   r,g,b:byte;
   P:^TMyPalette16;
begin
   PaletteDisabled:=false;

   for j:=0 to 63 do
      begin
          r:=255-( ( (j       and 1)*2 + ((j shr 3) and 1))*85);
          g:=255-( (((j shr 1)and 1)*2 + ((j shr 4) and 1))*85);
          b:=255-( (((j shr 2)and 1)*2 + ((j shr 5) and 1))*85);
          Palette[j]:=RGB(r,g,b);
          Palette[j+64]:=RGB(r xor 128,g xor 128 ,b xor 128);
          Palette[j+128]:=RGB(r xor 192,g xor 192 ,b xor 192);
          Palette[j+192]:=RGB(r xor 140,g xor 140 ,b xor 143);
      end;

   P:=@MyPalette0;
   case n of
     0: ;
     1:P:=@MyPalette1;
     2:P:=@MyPalette2;
   end;

   for i:=0 to 15 do
   begin
       k:=self.ColorIndex(P^[i]);
       for j:=k downto i+1 do
              Palette[j]:=Palette[j-1];
       Palette[i]:=P^[i];
   end;

(*
   for i:=16 to 255 do
      begin
          Palette[i]:=(i mod 7)*42 + (i mod 6)*51 *256 + (i mod 5)*63 * 65536;
          //Palette[i]:=(i mod 7)*42 + (i mod 4)*85 *256 + (i mod 3)*127 * 65536;
      end;
*)


end;

{********************}
{BitMap GetPixelColor}
{********************}
type TColorRec=packed record
     red,green,blue,spare:byte
end;
type TPixelData=array[0..3]of byte;
     PPixeldata=^TPixelData;

function GetPixelColor(BitMap1:TBitmap; x,y:integer):TColor;
var
   RawImage: TRawImage;
   PixelPtr:PPixelData;
   PixelData:TColorRec;
   redIx,greenIx,blueIx:byte;
   BytePerPixel: byte;
begin
  if bitmap1.PixelFormat=pf24bit then
   begin
      with Bitmap1 do                                             //2014.1.1
        if (x<0) or (y<0) or (x>=width) or (y>=height) then
           begin result:=-1; exit end;

     RawImage := Bitmap1.RawImage;
     PixelPtr:=PPixelData(RawImage.Data);
     with  RawImage.Description do
       begin
         BytePerPixel:=BitsPerPixel div 8;
         Inc(PByte(PixelPtr),BytesPerLine * y + BytePerPixel * x);
         RedIx  :=RedShift div 8;
         GreenIx:=GreenShift div 8;
         BlueIx :=BlueShift div 8;
         if ByteOrder=riboMSBFirst then
             begin
               RedIx:=BytePerPixel-1-RedIx;
               GreenIx:=BytePerPixel-1-GreenIx;
               BlueIx:=BytePerPixel-1-BlueIx;
             end;
         Pixeldata.red:=PixelPtr^[RedIx];
         Pixeldata.green:=PixelPtr^[GreenIx];
         Pixeldata.blue:=PixelPtr^[BlueIx];
         PixelData.spare:=0;
       end;
     result:=TColor(PixelData);
   end
  else
    result:=bitmap1.Canvas.Pixels[x,y];
end;
{*********}
{TGraphSys}
{*********}

constructor TGraphSys.create;
begin
   inherited create;
   left:=0;
   right:=1;
   bottom:=0;
   top:=1;

   VPleft:=0;
   VPright:=1;
   VPbottom:=0;
   VPtop:=1;

   DWleft:=0;
   DWright:=1;
   DWbottom:=0;
   DWtop:=1;

   clip:=true;

   Hjustify:=tjLEFT;
   Vjustify:=tjBOTTOM;

   HMulti:=1;
   VMulti:=1;

end;

constructor TScreenBMPGraphSys.create;
begin
  inherited create;
  BitMap1:= TBitMap.Create;
  Canvas1:=Bitmap1.Canvas;

end;

procedure TScreenBMPGraphSys.setup;
// MyThread.createから呼ばれて，set upを完了させる。

begin
 SetSize1;
 SetBMPsize(true);
 //MyPalette.PaletteDisabled:=false;
end;

procedure TScreenBMPGraphSys.SetSize1;
begin
     if BmpSize >=BMP321 then
        begin
          case BmpSize of
             BMP321:  BitMapHeight:= 321;
             BMP401:  BitMapHeight:= 401;
             BMP501:  BitMapHeight:= 501;
             BMP641:  BitMapHeight:= 641;
             BMP801:  BitMapHeight:= 801;
             BMP1001: BitMapHeight:=1001;
             BMP1281: BitMapHeight:=1281;
             BMP1601: BitMapHeight:=1601;
             BMP2001: BitMapHeight:=2001;
          end;
          BitMapWidth:=BitMapHeight;
        end
     else
        begin
          BitMapWidth:=640;
          case BmpSize of
             BMPpc9801: BitMapHeight:=400;
             BMPdosv: BitMapHeight:=480;
          end;
        end;
 end;

procedure TScreenBMPGraphsys.setBMPsize(init:boolean);
var
     NewRect:TRect;
begin
  with Bitmap1 do
            begin
                width:=bitmapwidth;
                height:=bitmapHeight;
                NewRect:=Rect(0,0,width,Height);
                Canvas.Brush.color:=MyPalette[0];
            end;
  if init then
    begin
       Bitmap1.Canvas.FillRect(NewRect);
       with Canvas1.font do
            begin
              CharSet:=FontCharSet;
              Size:=FontSize;
              Name:=FontName;
              Style:=TFontStyles(FontStyle)
            end;
   end;

  HiddenDrawMode:=false;
  InitCoordinate;
end;

constructor TPrtDirectGraphSys.create;
begin
   inherited create;
   //Canvas1:=printer.Canvas;
end;


destructor TGraphSys.destroy;
begin
   inherited destroy
end;



procedure SetFont(y,x:TFont);
begin
   y.Charset:=x.Charset;
   y.Color:=x.Color;
   y.Name:=x.Name;
   y.Style:=x.Style;
   y.Size:=x.Size;
end;

procedure TScreenBMPGraphSys.start;
begin

end;

procedure TPrtDirectGraphSys.start;
begin


   MyPalette.PaletteNumber:=0;
   {todo 1 printer}

   with TPrintDialog1.create(application.mainform) do
     begin
       cancelButton.Visible:=false;
       ShowModal;
       free;
     end;
   
   printer.BeginDoc;
   Canvas1:=printer.Canvas;
   Canvas1.Font.PixelsPerInch:=Printer.XDPI;
   
end;


var
   SetWindowCriticalSection:TRtlCriticalSection;
   ClipRectCriticalSection :TRtlCriticalSection;

procedure TGraphSys.ThinRepaint;
begin

end;

procedure TScreenBMPGraphSys.ThinRepaint;
begin
  if RepaintRequest=false then RepaintRequest:=true;
end;


procedure TScreenBMPGraphSys.PaintPaintbox;
begin

      //repeat until Canvas1.tryLock;
      PaintForm.PaintBox1.Canvas.Draw(0,0,BitMap1);
      //Canvas1.Unlock;

end;


procedure TScreenBMPGraphSys.finish;
begin
  RepaintRequest:=false;
  LineBuffFlush;
  SelectClipRgn(Canvas1.Handle,0);
  DeleteObject(MyRgn);
  MyRgn:=0;
  HiddenDrawMode:=false;
  PaintForm.Repaint;

end;

procedure TPrtDirectGraphSys.finish;
begin
  LineBuffFlush;
{todo 1 printer}

  with printer do
   if printing then
     begin
        SelectClipRgn(Canvas1.Handle,0);
        DeleteObject(MyRgn);
        MyRgn:=0;
        EndDoc;
     end;

end;


procedure TGraphSys.clear;
var
    NewRect:TRect;
    svBrushColor:TColor;
begin
  LineBuffFlush;
  SelectClipRgn(Canvas1.Handle,0);
  NewRect:=Rect(0,0,DevWidth+1,DevHeight+1);
  with Canvas1 do
    begin
      svBrushColor:=Brush.Color;
      Brush.color:=Mypalette.pal[0] ;
      FillRect(NewRect);
      Brush.Color:=svBrushColor;
    end;
  SelectClipRgn(Canvas1.Handle,MyRgn);
 end;

procedure TScreenBMPGraphSys.clear;
begin

  inherited clear;
  repaintRequest:=true;

end;

procedure TPrtDirectGraphSys.Clear;
begin
  LineBuffFlush;
{todo 1 printer}
   printer.NewPage;
end;

procedure TGraphSys.initGraphic;
begin
   MyPalette.PaletteDisabled:=false;
   TextHeightChanged:=false;

   start;

    linecolor:=1;
    pointcolor:=1;
    areacolor:=1;
    textcolor:=1;
    penstyle:=psSolid;
    pointstyle:=3;
    linewidth:=1;
    TextHeight0:=0.01;
    TextAngle:=0;
    axescolor:=axescolor0;
    Hjustify:=tjLEFT;
    Vjustify:=tjBOTTOM;
    clip:=true;
    BeamMode:=bmRigorous;
    HiddenDrawMode:=false;
    iBKmode:= TRANSPARENT;
    AreaStyle:=asSolid;
    AreaStyleIndex:=1;

   InitCoordinate ;

   setlinecolor(linecolor);
   settextcolor(textcolor);
   setpenstyle(penstyle);
   setlinewidth(linewidth);
   setRasterMode(pmCopy);


end;

procedure TGraphSys.InitCoordinate;
begin
    VPleft:=0; VPright:=1; VPbottom:=0; VPtop:=1;
    DWleft:=0; DWright:=1; DWbottom:=0; DWtop:=1;
    InitCoordSub;

    if permitMicrosoft then
      SetWindow(0,GWidth,GHeight,0)
    else
      SetWindow(0,1,0,1)
end;

procedure TGraphSys.SetWindow(l,r,b,t:double);
begin
    EnterCriticalSection(SetWindowCriticalSection);
    beam:=false;
    invalidCoordinate:=true;
      left:=l;
      right:=r;
      bottom:=b;
      top:=t;
      SetUpCoordinateSubSystem;
    invalidCoordinate:=false;
    LeaveCriticalSection(SEtWindowCriticalSection);
end;

procedure TGraphSys.SetViewport(l,r,b,t:double);
begin
 EnterCriticalSection(SetWindowCriticalSection);
    beam:=false;
    invalidCoordinate:=true;
      VPleft:=l;
      VPright:=r;
      VPbottom:=b;
      VPtop:=t;
      setupCliprect;
      SetUpCoordinateSubSystem;
    invalidCoordinate:=false;
    LeaveCriticalSection(SEtWindowCriticalSection);
end;

procedure TGraphSys.SetDeviceWindow(l,r,b,t:double);
begin
 EnterCriticalSection(SetWindowCriticalSection);
   beam:=false;
   invalidCoordinate:=true;
      DWleft:=l;
      DWright:=r;
      DWbottom:=b;
      DWtop:=t;
      setupCliprect;
      SetUpCoordinateSubSystem;
   invalidCoordinate:=false;
   LeaveCriticalSection(SEtWindowCriticalSection);
   clearScreen;
end;


procedure TGraphSys.InitCoordSub;
begin
end;

procedure TScreenBMPGraphSys.InitCoordSub;
begin
    //inherited InitCoordSub;
    DevWidth:=BitMap1.width-1;
    DevHeight:=Bitmap1.Height-1;

    DVleft:=0;
    DVright:=DevWidth;
    DVbottom:=0;
    DVtop:=DevHeight;

    SetDefaultCoordinate;
    setUpClipRect;
end;

procedure TMetaPrtGraphSys.InitCoordSub;
begin
    //inherited initCoordsub;

    DevWidth:=printer.PageWidth-1-2;
    DevHeight:=printer.PageHeight-1-2;

    DVleft:=0;
    DVright:=DevWidth;
    DVbottom:=0;
    DVtop:=DevHeight;

    setDefaultMargin;
    setUpClipRect;
end;



procedure TGraphSys.SetDefaultCoordinate;
begin

   DwLeft:=0;
   DwRight:=1;
   DwBottom:=0;
   DwTop:=1;
   if DvRight>=DvTop then
        DwTop:=DvTop/DvRight
   else
        DwRight:=DvRight/DvTop;

   VpLeft:=DwLeft;
   VpRight:=DwRight;
   VpBottom:=DwBottom;
   VpTop:=DwTop;
end;


function intersection(rect1,rect2:TRect):TRect;
begin
   result:=rect2;
   if rect1.left>result.left then result.left:=rect1.left;
   if rect1.right<result.right then result.right:=rect1.right;
   if rect1.top>result.top then result.top:=rect1.top;
   if rect1.bottom<result.bottom then result.bottom:=rect1.bottom;
end;

procedure TGraphSys.makeClipRect;
var
   rect2:TRect;
begin

   {DevRect を装置窓の縦横比に一致させる}
    with DevRect do
      begin
         if (bottom-top)/(right-left)>(DWtop-DWbottom)/(DWright-DWleft) then
            top:=bottom-round((right-left)*(DWtop-DWbottom)/(DWright-DWleft))
         else if (bottom-top)/(right-left)<(DWtop-DWbottom)/(DWright-DWleft) then
            right:=left+round((bottom-top)*(DWright-DWleft)/(DWtop-DWbottom))
      end;

  {ClipRectの設定}
  ClipRect:=DevRect;
  rect2:=ClipRect;
  if clip then
   with ClipRect do
     begin
       Rect2.left:=  left + floor((right- left)*(VPleft -DWleft)/(DWright-DWleft));
       Rect2.right:= left +  ceil((right- left)*(VPright-DWleft)/(DWright-DWleft));
       Rect2.top:=   bottom+floor((top-bottom)*(VPtop   -DWbottom)/(DWtop-DWbottom));
       Rect2.bottom:=bottom +ceil((top-bottom)*(VPBottom-DWbottom)/(DWtop-DWbottom));
     end;
  ClipRect:=intersection(Cliprect,rect2);

end;



procedure TScreenBMPGraphSys.setupClipRect;
begin
  EnterCriticalSection(ClipRectCriticalSection);
  DevRect.left:=DVleft;
  DevRect.right:=DVright;
  DevRect.top:=DevHeight-DVTop;
  DevRect.bottom:=DevHeight-DVBottom;
  makeClipRect;
  LeaveCriticalSection(ClipRectCriticalSection);


  if MyRgn<>0 then
      begin
         SelectClipRgn(Canvas1.Handle,0);
         DeleteObject(MyRgn);
      end;

  if (ClipRect.left=0) and (ClipRect.Right=DevWidth)
      and (ClipRect.Top=0) and (ClipRect.Bottom=DevHeight)then
     MyRgn:=0
  else
     MyRgn := CreateRectRgn(ClipRect.left, ClipRect.top, ClipRect.right+1, ClipRect.bottom+1) ;

  SelectClipRgn(Canvas1.Handle,MyRgn);


end;



procedure TMetaPrtGraphSys.setupClipRect;
begin
   EnterCriticalSection(ClipRectCriticalSection);
   DevRect.left:=DVleft + 1;
   DevRect.right:=DVright + 1;
   DevRect.top:=DevHeight-DVTop + 1;
   DevRect.bottom:=DevHeight-DVBottom + 1;
   makeClipRect;
   LeaveCriticalSection(ClipRectCriticalSection);

   if MyRgn<>0 then
      begin
         SelectClipRgn(Canvas1.Handle,0);
         DeleteObject(MyRgn);
      end;
   MyRgn := CreateRectRgn(ClipRect.left -1 ,ClipRect.top -1 , ClipRect.right +2 , ClipRect.bottom +2 );

   SelectClipRgn(Canvas1.Handle,MyRgn);
end;


procedure TMetaPrtGraphSys.setDefaultMargin;
var
  dvL,dvR,dvB,dvT,a,h,w:double;
begin
  a:=AdditionalMargin/1000;
  AskDeviceViewport(dvL,dvR,dvB,dvT);
  dvL:=dvL+a;
  dvR:=dvR-a;
  dvB:=dvB+a;
  dvT:=dvT-a;
  if AlignTop then
    begin
      h:=dvT-dvB;
      w:=dvR-dvL;
      if h>w then
         dvB:=dvT-w;
    end;
  setDeviceViewPort(dvL,dvR,dvB,dvT);

end;

function TGraphSys.deviceX(x:double):integer;
var
   z:double;
begin
  z:=(x-left)*HMulti+HShift;
  try
     result:=LongIntRound(z);
  except
     {$IFNDEF Windows} RecoverFloatException; {$ENDIF}
     if z>0 then
        result:=maxint
     else
        result:=minint
  end;
end;

function TGraphSys.deviceY(y:double):integer;
var
  z:double;
begin
  z:=(y-bottom)*VMulti+VShift;
  try
     result:=LongIntRound(z);
  except
    {$IFNDEF Windows} RecoverFloatException; {$ENDIF}
     if z>0 then
        result:=maxint
     else
        result:=minint
  end;
end;

function TGraphSys.ConvToDeviceX(x:double; var i:integer):boolean;
var
   z:double;
begin
  z:=(x-left)*HMulti+HShift;
  try
      i:=LongIntRound(z);
      result:=true;
  except
     {$IFNDEF Windows} RecoverFloatException; {$ENDIF}
      result:=false;
      i:=minint
  end;
end;

function TGraphSys.ConvToDeviceY(y:double; var j:integer):boolean;
var
  z:double;
begin
  z:=(y-bottom)*VMulti+VShift;
  try
      j:=LongIntRound(z);
      result:=true;
  except
      {$IFNDEF Windows} RecoverFloatException; {$ENDIF}
      result:=false;
      j:=minint
  end;
end;


procedure TGraphSys.SetUpCoordinateSubSystem;
begin
  try
     HMulti:=(DevRect.right- DevRect.left)/(DWright-DWleft)*(VPright-VPleft)/(right-left);
     HShift:=DevRect.left + (VPleft-DWleft)*(DevRect.right- DevRect.left)/(DWright-DWleft);
     VMUlti:=(DevRect.top- DevRect.bottom)/(DWtop-DWbottom)*(VPtop-VPbottom)/(top-bottom);
     VShift:=DevRect.bottom + (VPbottom-DWbottom)*(DevRect.top- DevRect.bottom)/(DWtop-DWbottom);
     If TextHeightChanged then
        SetCanvasTextHeight(TextHeight0);

  except
      {$IFNDEF Windows} RecoverFloatException; {$ENDIF}
        setexception(SystemErr);
  end;
end;

function TGraphSys.virtualX(vx:integer):double;
begin
   virtualX:=(vx-HShift)/HMulti + left;
end;

function TGraphSys.VirtualY(vy:integer):double;
begin
   virtualY:=(vy-VShift)/VMulti + bottom;
end;



function TGraphSys.GWidth:double;
begin
    result:=DevRect.right-DevRect.Left;
end;

function TGraphSys.GHeight:double;
begin
    result:=DevRect.bottom-DevRect.top;
end;

{***********}
{  PolyGon  }
{***********}


procedure TGraphSys.Polygon(const Points:array of TPoint);
begin
   PolyGonSub(Canvas1,Points);
end;


procedure TGraphSys.PolyGonSub(Canvas:TCanvas; const Points:array of TPoint);
begin
  ColorPolyGonSub(Canvas,Points,areacolor)
end;

procedure TGraphSys.ColorPolyGon(const Points:array of TPoint; c:integer{色指標});
begin
   ColorPolyGonSub(Canvas1,Points,c);
end;

procedure TGraphSys.ColorPolyGonSub(Canvas:TCanvas; const Points:array of TPoint; c:integer);
var
   svBrushColor:TColor;
   svPenColor:TColor;
   svBrushStyle:TBrushStyle;
   svPenStyle:TpenStyle;
   svPenWidth:integer;

begin
   if MyRgn<>0 then  SelectClipRgn(Canvas.Handle,MyRgn);
  with Canvas do
    begin
     svBrushColor:=Brush.Color;
     svPenColor:=Pen.Color;
     svBrushStyle:=Brush.Style;

     Brush.Color:=MyPalette[c] ;
     Pen.Color:=MyPalette[c] ;
     pen.width:=1;                   //2008.1.29
     Pen.Style:=psSolid;             //2018.12.03
     case AreaStyle of
       asSolid: Brush.Style:=bsSolid;
       asHollow:Brush.Style:=bsClear;
       asHatch: Brush.Style:=TBrushStyle( AreaStyleIndex + 1);
     end;
     SetBkColor(Canvas1.Handle,MyPalette.pal[0] );
     Polygon(Points);

     Brush.Color:=svBrushColor;
     Pen.Color:=svPenColor;
     Pen.Width:=LineWidth;          //2008.1.29
     Brush.Style:=svBrushStyle;
     Pen.Style:= svPenStyle;        //2018.12.03
    end;

end;


{**********}
{ PolyLine }
{**********}


procedure TGraphSys.PolyLineSub(Canvas:TCanvas; const Points:array of TPoint);
begin
   if MyRgn<>0 then  SelectClipRgn(Canvas.Handle,MyRgn);
   Canvas.PolyLine(Points);
 end;



procedure TGraphSys.Polyline(const Points:array of TPoint);
begin
   if MyRgn<>0 then  SelectClipRgn(Canvas1.Handle,MyRgn);
   Canvas1.Polyline(Points);
end;

{**********}
{TextHeight}
{**********}

procedure TGraphSys.SetTextHeight(const x:double);
begin
   TextHeight0:=x;
   SetCanvasTextHeight(x);
   TextHeightChanged:=true;
end;

function TGraphSys.AskTextHeight:double;   //2013.12.21
begin
  if textheightchanged then
     result:=TextHeight0
  else
     result:=GetCanvasTextHeight;
end;


procedure TGraphSys.SetCanvasTextHeight(const x:double);
var
   i:integer;
begin
    try
      i:=LongIntRound(abs(VMulti*x*TextHeightMulti));
      if i<=0 then i:=1;               //2007.5.18　
      Canvas1.Font.height:=-i;
      TextHeightChanged:=true;

    except
     {$IFNDEF Windows} RecoverFloatException; {$ENDIF}
    end;
end;


function TGraphSys.GetCanvasTextHeight:double;
begin
   result:=abs(-Canvas1.Font.Height)/TextHeightMulti/abs(VMulti)
end;

{*********}
{Text Font}
{*********}


procedure TGraphSys.SetTextFont(name0:AnsiString; size:integer);
begin
    if length(name0)>0 then
       begin
          Canvas1.Font.Charset:=DEFAULT_CHARSET;
          Canvas1.Font.name:=name0;
       end;
    if size>0 then
       begin
         Canvas1.Font.size:=size;
         TextHeightChanged:=false;    //2013.12.21
       end;
 end;


procedure TGraphSys.AskTextFont(var name1:AnsiString; var size:integer);
begin
    name1:=Canvas1.Font.name;
    size:=Canvas1.Font.size
end;

{*****}
{Pixel}
{*****}

procedure SetPixel(canvas:TCanvas; a,b:integer; c:TColor);
begin
    canvas.Pixels[a,b]:=c;
end;

procedure TGraphSys.putpixel(a,b:integer);
var
   c:TColor;
begin
   if MyRgn<>0 then  SelectClipRgn(Canvas1.Handle,MyRgn);
   
   c:=MyPalette[pointcolor] ;

   //With Canvas1 do
        setPixel(Canvas1,a,b,c);

end;



procedure TGraphSys.putColor(a,b:integer; c:integer);
var
  c1:TColor;
begin
   c1:=MyPalette[c] ;
   SetPixel(Canvas1,a,b,c1);
end;



procedure TextOutRotate(Canvas: TCanvas; x, y: Integer; const s: AnsiString; a:integer);
var
  lfText: TLOGFONT;
  hfNew, hfOld: HFONT;
begin
{$IFDEF Windows}
  GetObject(Canvas.Font.Handle, sizeof(TLOGFONT), @lfText);
{$ELSE}  // bug or unfinished?
  with lfText do
  begin
     lfHeight:=Canvas.Font.Height;
     lfWidth:=0;
     lfEscapement := a * 10; // 角度
     lfOrientation := lfEscapement;
     lfWeight:=0;
     lfItalic:=0;
     lfUnderline:=0;
     lfStrikeOut:=0;
     lfCharSet:=OEM_CHARSET;
     lfOutPrecision:=OUT_DEFAULT_PRECIS;
     lfClipPrecision:=CLIP_DEFAULT_PRECIS;
     lfQuality:=DEFAULT_QUALITY;
     lfPitchAndFamily:=DEFAULT_PITCH or FF_DONTCARE;
     lfFaceName:=Canvas.Font.Name;
  end;
{$ENDIF}
  try
    hfNew := CreateFontIndirect(lfText);       //This may cause divide by zero error.
    try
        hfOld := SelectObject(Canvas.Handle, hfNew);
        Canvas.TextOut(x, y, s);
      finally
        SelectObject(Canvas.Handle, hfOld);
        DeleteObject(hfNew);
    end;
  except
     Canvas.TextOut(x, y, s);
  end;
end;


procedure TGraphSys.textoutSub(x,y:integer; const s:ansistring; angle:integer);
begin
    settextcolor(textcolor);
    SetBkColor(Canvas1.Handle,MyPalette.pal[0] );
    SetBkMode(Canvas1.Handle,iBkMode);
    textOutRotate(Canvas1,x,y,s,Angle);
end;



procedure TGraphSys.setlinecolor(c:integer);
var
  col:TColor;
begin
    LineBuffFlush;
    col:=MyPalette[c] ;
    linecolor:=c;
    Canvas1.pen.color:=col;
end;


procedure TGraphSys.settextcolor(c:integer);
begin
    textcolor:=c;
    Canvas1.Font.Color:=MyPalette[textcolor] ;
end;


procedure TGraphSys.SetPenStyle(ps:TPenStyle);
begin
    LineBuffFlush;
    PenStyle:=ps;
    Canvas1.pen.style:=ps;
end;


procedure TGraphSys.setlinewidth(c:integer);
begin
    LineBuffFlush;
    Canvas1.pen.width:=c;
    LineWidth:=c;
end;


procedure TGraphSys.SetRasterMode(b:TPenMode);
begin
   Canvas1.Pen.Mode:=b;
end;


procedure TGraphSys.setHiddenDrawMode(b:boolean);
begin
     //HiddenDrawMode:=b ;
     //if b then setexception(9102);
end;

procedure TScreenBMPGraphSys.setHiddenDrawMode(b:boolean);

begin
   if not (HiddenDrawMode and b) then
      RepaintExec;
   HiddenDrawMode:=b ;
end;





function restrict9x(n:integer):integer;
begin
   if n>16383 then
      result:=16383
   else if n<-16384 then
      result:=-16384
   else
      result:=n
end;

function restrict16(n:longint):integer;
begin
   if n>32767 then
      result:=32767
   else if n<-32768 then
      result:=-32768
   else
      result:=n
end;

function restrictNT(n:longint):integer;    //  2009.4.18  ver 7.3.1
begin
   if n>134217727 then
      result:=134217727
   else if n<-134217728 then
      result:=-134217728
   else
      result:=n
end;

function restrictNone(n:longint):integer;
begin
      result:=n
end;


var
   ShrinkRange: procedure(var lx,ly,vx,vy:integer);

procedure  ShrinkRange9x(var lx,ly,vx,vy:integer);
var
  x,x1,x2,y,y1,y2: double;
begin
  x1:=lx;y1:=ly;x2:=vx;y2:=vy;
  if abs(x2-x1)>=16364 then
     begin
        if x2<x1 then
            begin
                 x:=x1; x1:=x2; x2:=x; y:=y1; y1:=y2; y2:=y;
            end;
        if (x1<-8192) then
           begin
              x:=-8192;y:=round((y2-y1)/(x2-x1)*(x-x1)+y1);
              x1:=x;y1:=y
           end;
        if (x2>8192) then
           begin
              x:=8192;y:=round((y2-y1)/(x2-x1)*(x-x2)+y2);
              x2:=x;y2:=y
           end;
     end;
  if abs(y2-y1)>=16364 then
     begin
        if y2<y1 then
            begin
                 x:=x1; x1:=x2; x2:=x; y:=y1; y1:=y2; y2:=y;
            end;
        if (y1<-8192) then
           begin
              y:=-8192;x:=round((x2-x1)/(y2-y1)*(y-y1)+x1);
              y1:=y;x1:=x
           end;
        if (y2>8192) then
           begin
              y:=8192;x:=round((x2-x1)/(y2-y1)*(y-y2)+x2);
              y2:=y;x2:=x
           end;
     end;
  lx:=round(x1);
  ly:=round(y1);
  vx:=round(x2);
  vy:=round(y2);
end;

procedure  ShrinkRange16(var lx,ly,vx,vy:longint);
var
  x,x1,x2,y,y1,y2: double;
begin
  x1:=lx;y1:=ly;x2:=vx;y2:=vy;
  if abs(x2-x1)>=16364*2 then
     begin
        if x2<x1 then
            begin
                 x:=x1; x1:=x2; x2:=x; y:=y1; y1:=y2; y2:=y;
            end;
        if (x1<-8192*2) then
           begin
              x:=-8192*2;y:=round((y2-y1)/(x2-x1)*(x-x1)+y1);
              x1:=x;y1:=y
           end;
        if (x2>8192*2) then
           begin
              x:=8192*2;y:=round((y2-y1)/(x2-x1)*(x-x2)+y2);
              x2:=x;y2:=y
           end;
     end;
  if abs(y2-y1)>=16364*2 then
     begin
        if y2<y1 then
            begin
                 x:=x1; x1:=x2; x2:=x; y:=y1; y1:=y2; y2:=y;
            end;
        if (y1<-8192*2) then
           begin
              y:=-8192*2;x:=round((x2-x1)/(y2-y1)*(y-y1)+x1);
              y1:=y;x1:=x
           end;
        if (y2>8192*2) then
           begin
              y:=8192*2;x:=round((x2-x1)/(y2-y1)*(y-y2)+x2);
              y2:=y;x2:=x
           end;
     end;
  lx:=round(x1);
  ly:=round(y1);
  vx:=round(x2);
  vy:=round(y2);
end;

procedure  ShrinkRangeNT(var lx,ly,vx,vy:integer);
var
  x,x1,x2,y,y1,y2: double;
begin
  x1:=lx;y1:=ly;x2:=vx;y2:=vy;
  if abs(x2-x1)>=67108864 then
     begin
        if x2<x1 then
            begin
                 x:=x1; x1:=x2; x2:=x; y:=y1; y1:=y2; y2:=y;
            end;
        if (x1<-67108864) then
           begin
              x:=-67108864;y:=round((y2-y1)/(x2-x1)*(x-x1)+y1);
              x1:=x;y1:=y
           end;
        if (x2>67108864) then
           begin
              x:=67108864;y:=round((y2-y1)/(x2-x1)*(x-x2)+y2);
              x2:=x;y2:=y
           end;
     end;
  if abs(y2-y1)>=67108864 then
     begin
        if y2<y1 then
            begin
                 x:=x1; x1:=x2; x2:=x; y:=y1; y1:=y2; y2:=y;
            end;
        if (y1<-67108864) then
           begin
              y:=-67108864;x:=round((x2-x1)/(y2-y1)*(y-y1)+x1);
              y1:=y;x1:=x
           end;
        if (y2>67108864) then
           begin
              y:=67108864;x:=round((x2-x1)/(y2-y1)*(y-y2)+x2);
              y2:=y;x2:=x
           end;
     end;
  lx:=round(x1);
  ly:=round(y1);
  vx:=round(x2);
  vy:=round(y2);
end;

procedure  ShrinkRangeNone(var lx,ly,vx,vy:longint);
begin
  //Do Nothing
end;


type
   longrec=record
       low:word;
       high:smallint;
   end;

function iabs(n:integer):integer;
begin
    if n>=0 then
       iabs:=n
    else
       iabs:=-n;
end;
procedure TGraphSys.SegmentWinSub(Canvas:TCanvas;  x1,y1,x2,y2:integer);
var
   P:array[0..1]of TPoint;
begin
   P[0].X:=x2;
   P[0].Y:=y2;
   P[1].X:=x1;
   P[1].Y:=y1;
   PolyLinesub(Canvas, P);
end;

procedure TGraphSys.SegmentWin(Canvas:TCanvas;  x1,y1,x2,y2:integer);
// 始点を描かず，終点を描く
begin
  if PenStyle<>psSolid then SetBkMode(Canvas.Handle,TRANSPARENT);
  if (x1=x2) and (y1=y2) then
        SetPixel(Canvas,x1,y1,Canvas.pen.color)
  else
    begin
       if (  ((longrec(x1).high+1) shr 1)
          or ((longrec(y1).high+1) shr 1)
          or ((longrec(x2).high+1) shr 1)
          or ((longrec(y2).high+1) shr 1) =0)
        and (iabs(x2-x1)<16384) and (iabs(y2-y1)<16384) then
        else
           ShrinkRange(x1,y1,x2,y2);
        if (PenStyle=psSolid)
            or not GeometricPenOnly
               and ((linewidth=1) and (SetBkMode(Canvas.Handle,TRANSPARENT)<>0))
                                                                           then
            begin
               Canvas.MoveTo(restrict(x2),restrict(y2));
               Canvas.LineTo(restrict(x1),restrict(y1));
            end
        else
           SegmentWinSub(Canvas,x1,y1,x2,y2)
    end;
end;

procedure TGraphSys.segment(x1,y1,x2,y2:integer);
begin
  if ForwardPLot then
    SegmentForward(Canvas1,x1,y1,x2,y2)
  else
    SegmentWin(Canvas1,x1,y1,x2,y2)
end;



procedure TGraphSys.SegmentForward(Canvas:TCanvas;  x1,y1,x2,y2:integer);
// 始点を描かず，終点を描く
begin
  if MyRgn<>0 then  SelectClipRgn(Canvas1.Handle,MyRgn);
  if not beam then     //if (x1=x2) and (y1=y2) then
     begin
       Canvas.MoveTo(restrict(x2),restrict(y2));
       SetPixel(Canvas,x2,y2,Canvas.pen.color);
     end
  else if PenStyle<>psSolid then
       SegmentWinSub(Canvas,x2,y2,x1,y1)
  else
    begin
       Canvas.LineTo(restrict(x2),restrict(y2)) ;
    end;
end;



procedure TGraphSys.plotto(x,y: double);
var
   x1,x2,y1,y2:integer;
begin
   x2:=deviceX(x);
   y2:=deviceY(y);
   if PenStyle=psSolid then
     begin
       if beam then
          begin
            x1:=latex;
            y1:=latey
          end
       else
          begin
             x1:=x2;
             y1:=y2
          end;
        segment(x1,y1,x2,y2);
     end
   else
     begin
       if beam and (LineBuffCount=0) then
          StyledLine(latex,latey);
       StyledLine(x2,y2);
     end;
   latex:=x2;
   latey:=y2;
   beam:=true;
end;

procedure TGraphSys.StyledLine(x2,y2:integer);
begin
  {$IFDEF LCLGTK2}
   x2:=restrict(x2);
   y2:=restrict(y2);
  {$ENDIF}
   if LineBuff=nil then New(LineBuff);
   if LineBuffCount>High(TLineBuff) then LineBuffFlush;
   with LineBuff^[LineBuffCount] do
      begin x:=x2; y:=y2 end;
   inc(LineBuffCount);
end;

var LineBuffCriticalSection: TRtlCriticalSection;
procedure TGraphSys.LineBuffFlush;
begin
  if LineBuffCount>0 then
    begin
       EnterCriticalSection(LineBuffCriticalSection);
       if LineBuffCount>0 then
          begin
             PolyLine(Slice(LineBuff^, LineBuffCount));
             LineBuffCount:=0
          end;
       LeaveCriticalSection(LineBuffCriticalSection);
    end;
end;

procedure TGraphSys.setBeam(t:boolean);
begin
  if t=false then
     LineBuffFlush;
  beam0:=t;
end;


procedure LineSub(Canvas:TCanvas; a1,b1,a2,b2:integer; cl:TColor; ps:TPenStyle; w:integer);
var
   svPenColor:TColor;
   svPenStyle:TPenstyle;
   svWidth:integer;
   svBrushColor:TColor;
begin
 with Canvas do
   begin
    svPenColor:=Pen.Color;
    svPenStyle:=Pen.Style;
    svWidth:=Pen.Width;
    svBrushColor:=Brush.Color;
    Pen.Color:=cl;
    Pen.Style:=ps;
    Pen.Width:=w;
    Brush.Color:=MyPalette.pal[0];
    moveto(a1,b1);
    lineto(a2,b2);
    SetPixel(Canvas,a2,b2,cl);
    Pen.Color:=svPenColor;
    Pen.Style:=svPenStyle;
    Pen.Width:=svWidth;
    Brush.Color := svBrushColor;   //2013.12.28
   end;
end;

procedure TGraphSys.line(a1,b1,a2,b2:integer; c:integer; ps:TPenStyle; w:integer);
var
   cl:TColor;
begin
   cl:=MyPalette[c] ;
   LineSub(CanVas1,a1,b1,a2,b2,cl,ps,w)
end;



procedure TGraphSys.putmark0(a,b:integer);
  procedure put(dx,dy:integer);
  begin
      putPixel(a+dx,b+dy)
  end;
begin
    case pointstyle of
      1:  {･}
                 put(0,0);
      2:  {+}
           begin
                 put(0,0);
                 put(0,1);
                 put(0,2);
                 put(0,-1);
                 put(0 , -2);
                 put( -1,0 );
                 put( +1,0 );
                 put( -2,0 );
                 put( +2,0 );
          end;
      3: {*}
          begin
                 put(0 ,0 )  ;
                 put(0 , +1);
                 put(0 , +2);
                 put(0 , -1);
                 put(0 , -2);
                 put( -1, 0);
                 put( +1, 0);
                 put( -2, +1);
                 put( -2, -1);
                 put( +2, +1);
                 put( +2, -1);
          end;
       4: {o}
          begin
                 put( +2, -1);
                 put( +2,  0 );
                 put( +2, +1);
                 put( -2, -1);
                 put( -2,  0 );
                 put( -2, +1);
                 put( -1, +2);
                 put( 0 , +2);
                 put( +1, +2);
                 put( -1, -2);
                 put( 0 , -2);
                 put( +1, -2);
          end;
       5: {x}
           begin
                 put( 0, 0)  ;
                 put( -1, +1);
                 put( -2, +2);
                 put( -1, -1);
                 put( -2, -2);
                 put( +1, +1);
                 put( +2, +2);
                 put( +1, -1);
                 put( +2, -2);
           end;
       6: {■}
          begin
                 put( +1, +1);
                 put( +1,  0);
                 put( +1, -1);
                 put(  0, +1);
                 put(  0,  0);
                 put(  0, -1);
                 put( -1, +1);
                 put( -1,  0);
                 put( -1, -1);
          end;
       7: {●}
          begin
                 put( +2, +1);
                 put( +2,  0);
                 put( +2, -1);
                 put( +1, +2);
                 put( +1, +1);
                 put( +1,  0);
                 put( +1, -1);
                 put( +1, -2);
                 put(  0, +2);
                 put(  0, +1);
                 put(  0,  0);
                 put(  0, -1);
                 put(  0, -2);
                 put( -1, +2);
                 put( -1, +1);
                 put( -1,  0);
                 put( -1, -1);
                 put( -1, -2);
                 put( -2, +1);
                 put( -2,  0);
                 put( -2, -1);
          end;
    end;
end;


procedure TGraphSys.putMark(x,y:double);
var
   i,j:integer;
begin
   //PutMark0(restrict(deviceX(x)),restrict(deviceY(y)));
   if ConvToDeviceX(x,i) and ConvToDeviceY(y,j) then    //2009.6.22
      PutMark0(i,j)
end;

type
   PPointlist=^pointlist;
   pointlist=record
        size :integer;
        count:integer;
        list:array[0..8190] of integer;
   end;

function newlist(n:integer):PPointlist;
begin
   GetMem(Pointer(result),sizeof(integer)*(2+n));
   result^.size:=n;
   result^.count:=0;
end;

procedure disposelist(p:PPointlist);
begin
   if p<>nil then FreeMem(pointer(p),sizeof(integer)*(2+p^.size))
end;

procedure insertlist(p:PPointList;n:integer);
var
   i,k:integer;
begin
  with p^ do
    begin
       k:=0;
       while  (k<count) and (list[k]<n) do inc(k);
       for i:=count-1 downto k do list[i+1]:=list[i];
       list[k]:=n;
       inc(count);
    end;
end;

procedure TGraphSys.GetPoint(var a,b:integer);
begin
      Setexception(11140);
end;

procedure TGraphSys.MoveMouse(a,b:integer);
begin
end;

procedure TGraphSys.MousePol(var a,b:integer; var l,r:boolean);
begin
      Setexception(11140);
end;

procedure TScreenBMPGraphSys.GetPoint(var a,b:integer);
begin
    with paintform do
    begin
     paintform.getpoint;
     a:=MouseXIntf; b:=MouseYIntf;
    end;
end;

procedure TScreenBMPGraphSys.MoveMouse(a,b:integer);
begin
     with paintform do
     begin
        MouseXIntf:=a; MouseYIntf:=b;
        Paintform.MoveMouse;
     end;
end;

procedure TScreenBMPGraphSys.MousePol(var a,b:integer; var l,r:boolean);
begin
     PaintForm.MousePol(a,b,l,r)
end;

function TGraphSys.ColorIndexOf(a,b:integer):integer;
begin
   repeat until Canvas1.TryLock;
   ColorIndexOf:=MyPalette.ColorIndex(Canvas1.Pixels[a,b]);
   Canvas1.Unlock;
end;




function TGraphSys.setcolormode(s:ansistring):boolean;
begin
    result:=true;
    s:=AnsiUpperCase(s);
    if s='NATIVE' then
      if MyPalette.PaletteDisabled=false then
         begin
           MyPalette.PaletteDisabled:=true;
           PointColor:=MyPalette.pal[PointColor] and $ffffff;
           SetLineColor(MyPalette.pal[lineColor] and $ffffff);
           AreaColor:=MyPalette.pal[AreaColor] and $ffffff;
           SetTextColor(MyPalette.pal[textColor] and $ffffff);
           axescolor:=MyPalette.pal[15] and $ffffff;
         end
      else
    else if s='REGULAR' then
      if MyPalette.PaletteDisabled=true then
         begin
           MyPalette.PaletteDisabled:=false;
           PointColor:=1;
           SetLineColor(1);
           AreaColor:=1;
           SetTextColor(1);
           axescolor:=axescolor0
         end
      else
    else
       result:=false;
end;

function TGraphSys.AskColorMode:Ansistring;
begin
    if MyPalette.PaletteDisabled then
       Result:='NATIVE'
    else
       Result:='REGULAR'
end;


procedure TGraphSys.SetBitmapSize(w,h:integer);
begin
      setexception(9102)
end;

procedure TScreenBMPGraphSys.SetBitmapSize(w,h:integer);
begin
   Bitmapwidth:=w; BitmapHeight:=h;
   SetBMPsize(false);
   paintform.setSize2;
  end;


procedure rotate(var x,y:integer; a:integer);
var
  xx,yy,c,s:single;
begin
  c:=cos(a*PI/180);
  s:=sin(a*Pi/180);
  xx:=x*c + y*s;
  yy:=y*c - x*s;
  x:=System.Round(xx);
  y:=System.Round(yy);
end;

procedure TGraphSys.TextOut(x,y:integer; const s:ansistring; angle:integer);
var
  dx,dy:integer;
begin
  case Hjustify of
    tjLEFT:  dx:=1;
    tjCENTER:dx:=-(textwidth(s) div 2);
    tjRIGHT: dx:=-textwidth(s);
  end;
  case Vjustify of
    tjTOP:   dy:=1;
    tjCAP:   dy:=-(textheight(s) div 8);
    tjHALF:  dy:=-(textheight(s) div 2);
    tjBASE:  dy:=-(textheight(s)*7 div 8);
    tjBOTTOM:dy:=-textheight(s);
  end;
  Rotate(dx,dy,angle);
  x:=x+dx;
  y:=y+dy;
  TextOutSub(x,y,s,angle);
end;

procedure TGraphSys.PutText(const n,m:double; const s:string);
var
  x,y:integer;
begin
  //x:=restrict(deviceX(n));
  //y:=restrict(deviceY(m));
  if ConvToDeviceX(n,x) and ConvToDeviceY(m,y) then    //2009.6.22
     TextOut(x,y,s,textangle);
end;

function YMulti(const x0,y0:double):double;
var
  x,y,r,dx,dy:double;
begin
  if CurrentTransForm=nil then
     result:=1
   else
     with CurrentTransform do
       begin
          x := x0*xx + y0*xy + xo;
          y := x0*yx + y0*yy + yo;
          r := x0*ox + y0*oy + oo;
          dx:=xy/r - x*oy/r/r;      // xのy0に関する偏微係数
          dy:=yy/r - y*oy/r/r;      // yのy0に関する偏微係数　
          result:=Sqrt(sqr(dx)+sqr(dy))
      end;
end;

function TGraphSys.xdirection(const x0, y0:double):integer;
var
  x,y,r,dx,dy:double;
begin
  if CurrentTransform=nil then
     result:=0
  else
    try
      with CurrentTransform do
       begin
          x := x0*xx + y0*xy + xo;
          y := x0*yx + y0*yy + yo;
          r := x0*ox + y0*oy + oo;
          dx:=xx/r - x*ox/r/r;      // xのx0に関する偏微係数
          dy:=yx/r - y*ox/r/r;      // yのx0に関する偏微係数　
          result:=System.Round(ArcTan2(dy*(-VMulti), dx*HMulti)*180/pi)
       end
    except
      {$IFNDEF Windows} RecoverFloatException; {$ENDIF}
       result:=0
    end;
end;

procedure TGraphSys.GraphText(const n,m:double; const s:string);
begin
  if TextProblemCoordinate then
    ProjectiveText(n,m,s,false)
  else
    PutText(n,m,s)
end;

procedure TGraphSys.PlotText(const n,m:double; const s:string);
begin
 if (CurrentTransForm<>nil)
     and not (currentTransform.IsSimilarPositive and (ABS(1+VMulti/HMulti)<1e-2))
  or TextProblemCoordinate
  or (Canvas1.pen.Mode<>pmCopy) then      //2014.1.6
     ProjectiveText(n,m,s,true)
 else
     PlotLetters(n,m,s)
end;

procedure TGraphSys.PlotLetters(const n,m:double; const s:string);
var
  x,y:integer;
  svTextHeight:double;
begin
  svTextHeight:=GetCanvasTextHeight;
  if TextHeightChanged then
      SetCanvasTextHeight(svTextHeight*ymulti(n,m));
  //x:=restrict(deviceX(n));
  //y:=restrict(deviceY(m));
  if ConvToDeviceX(n,x) and ConvToDeviceY(m,y) then    //2009.6.22
     TextOut(x,y,s,(textangle + XDirection(n,m)) mod 360);
  if TextHeightChanged then
     SetCanvasTextHeight(svTextHeight);
end;


procedure TGraphSys.ProjectiveText(const n,m:double; const s:string; PlotStm:boolean);
var
   a,b,i,j:integer;
   a0,b0,a1,b1,a2,b2,a3,b3,aMin,aMax,bMin,bMax:integer;
   color,bkcolor,color0,color1:TColor;
   //color00,color01,color02,color10,color11,color12:byte;
   dx,dy:integer;
   TextHeightWhole:double;
   x0,y0,x,y:double;
   rt0,rt1:double;
   px,py,r:double;
   pxmax,pymax:integer;
   svDrawMode:boolean;
   bmp2:TBitMap;
   NewRect:tRect;

   procedure FontToDevice(i,j:integer; var a,b:integer);
   var
      x1,y1:integer;
      x,y,x2,y2:double;
   begin
      x1:=i-dx;
      y1:=j-dy;
      x2:= x1*rt0+y1*rt1;
      y2:=-x1*rt1+y1*rt0;
      y:=y0-y2/bmp2.Height*TextHeightWhole;
      x:=x0+x2/bmp2.Height*TextHeightWhole;
      if PlotStm then currentTransform.transform(x,y);
      a:=DeviceX(x);
      b:=DeviceY(y);
   end;
label Label1;
begin
   //仮想座標系におけるtextheight を求める
  with Canvas1.Font do
    if Height=0 then //bug?
       size:=9;
  {
  if TextProblemCoordinate and not TextHeightChanged then
    TextHeightWhole:=0.01 *TextHeightMulti
  else
    TextHeightWhole:=GetCanvasTextHeight * TextHeightMulti;
  }
  if  TextHeightChanged then                            //2013.12.27
       TextHeightWhole:=TextHeight0 *TextHeightMulti
  else
     if TextProblemCoordinate then
        TextHeightWhole:=0.01 *TextHeightMulti
     else
        TextHeightWhole:=GetCanvasTextHeight *TextHeightMulti ;

  if TextHeightWhole=0 then Exit;

  svDrawMode:=HiddenDrawMode;
  SetHiddenDrawMode(true);

  rt0:=cos(Pi*TextAngle/180);
  rt1:=sin(Pi*TextAngle/180);

  x0:=n;
  y0:=m;
  if PlotStm then currenttransform.invtransform(x0,y0);
  // x0, y0は絵定義の中の仮想座標系における描画開始点

  bmp2:=TBitmap.Create;
  try
    with bmp2 do
      begin
      {$IFDEF windows}
        pixelFormat:=pf1bit;
        Monochrome:=true;
        case Length(s) of
           1.. 15:Height:=2048;
          16.. 31:Height:=1024;
          32.. 63:Height:= 512;
          64..127:Height:= 256;
         128..255:Height:= 128;
          else    Height:=  64;
        end;
      {$ELSE}
        //pixelFormat:=pf16bit;
        case Length(s) of
           1.. 15:Height:= 512;
          16.. 31:Height:= 256;
          32.. 63:Height:= 128;
          64..127:Height:=  64;
         128..255:Height:=  32;
          else    Height:=  16;
        end;
       {$ENDIF}

        Canvas.Font.Assign(Canvas1.Font);

       {$IFNDEF Linux}
        Canvas.Font.Height:=Height;
        Width:=Canvas.TextWidth(s);
       {$ELSE}
         Canvas.Font.Height:=(Height div 16)*9;
         Width:=(Canvas.TextWidth(s) div 8)*9;
       {$ENDIF}

         NewRect:=Rect(0,0,width,Height);
         with Canvas do
            begin
              Brush.color:=clWhite;
              FillRect(NewRect);
            end;
         bkcolor:=GetPixelColor(bmp2,0,0) {Canvas.Pixels[0,0]};

         Canvas.Font.Color:=clBlack;
         //Canvas.Font.Style:=[fsBold];
         Canvas.TextOut(0,0,s);
         case Hjustify of
            tjLEFT:  dx:=0;
            tjCENTER:dx:=width div 2;
            tjRIGHT: dx:=width;
         end;
         case Vjustify of
            tjTOP:   dy:=0;
            tjCAP:   dy:=(height div 8);
            tjHALF:  dy:=(height div 2);
            tjBASE:  dy:=(height * 7) div 8;
            tjBOTTOM:dy:= height -1;
         end;
      end;

Label1:
    FontToDevice(0,0,a0,b0);
    FontToDevice(bmp2.width-1,0,a1,b1);
    FontToDevice(bmp2.width-1,bmp2.Height-1,a2,b2);
    FontToDevice(0,bmp2.Height-1,a3,b3);
    Amin:=min(min(a0,a1),min(a2,a3));
    Amax:=max(max(a0,a1),max(a2,a3));
    Bmin:=min(min(b0,b1),min(b2,b3));
    Bmax:=max(max(b0,b1),max(b2,b3));
    {
    // 文字サイズの下限を定める
    if (AMax-AMin)+(BMax-Bmin)<length(s)+2 then
      begin
        TextHeightWhole:=TextHeightWhole*1.25;
        Goto Label1;
      end;
    }
    FontToDevice(bmp2.width div 2,bmp2.Height div 2,a0,b0);
    if (a0<AMin) or (a0>AMax) or (b0<BMin) or (b0>bmax) then
      begin
        AMin:=0; AMax:=DevWidth-1;
        BMin:=0; BMax:=DevHeight-1;
      end;

    // 描画
    color1:=Canvas1.Font.color;
    color0:=Mypalette.pal[0];      //背景色
    r:=bmp2.Height/TextHeightWhole;
    pxmax:=bmp2.Width-1;
    pymax:=bmp2.Height-1;

    for b:=max(BMin,ClipRect.top)  to Min(Bmax,Cliprect.Bottom) do
      for a:=max(Amin,ClipRect.Left) to Min(AMax,Cliprect.Right) do
        try
             x:=virtualX(a);
             y:=virtualY(b);
             if not PlotStm or currenttransform.invtransform(x,y) then
                begin
                   // この時点で，x,yは絵定義中の仮想座標
                   // x,yが文字の点であるか否かを調べる。
                   py:=(y0-y)*r ;
                   px:=(x-x0)*r ;
                   i:=System.Round(px*rt0 - py*rt1 + dx);
                   j:=System.Round(px*rt1 + py*rt0 + dy);
                   if (0<=j) and (j<=pymax) and (0<=i) and (i<=pxmax) then
                   begin
                      color:=GetPixelColor(bmp2,i,j) {bmp2.Canvas.Pixels[i,j]};
                      if (color<>bkColor) then
                           Canvas1.Pixels[a,b]:=color1
                      else if iBkMode=OPAQUE then
                           Canvas1.Pixels[a,b]:=color0
                   end;
                end;
        except
              on EMathError do
                begin
                 {$IFNDEF Windows} RecoverFloatException; {$ENDIF}
                end ;
              on EInvalidOp do
                begin
                 {$IFNDEF Windows} RecoverFloatException; {$ENDIF}
                end;
        end;
  finally
    bmp2.Free;
    MyGraphSys.setHiddenDrawMode(SvDrawMode);
  end;
end;




function TGraphSys.textwidth(const s:ansistring):integer;
begin
   textwidth:=Canvas1.textwidth(s)
end;

function TGraphSys.textheight(const s:ansistring):integer;
begin
   textheight:=Canvas1.textheight(s)
end;

function TScreenBMPGraphSys.PixelsPerMeter:double;
begin
  result:=Screen.PixelsPerInch*10000/254;
end;

function TMetaPrtGraphSys.PixelsPerMeter:double;
begin
  { TODO 1 : 要修正 }
    //  result:=Canvas1.Font.PixelsPerInch;
    result:=printer.XDPI*10000/254;
end;



function TGraphSys.SetDeviceViewport(l,r,b,t:double):boolean;
var
  ppm:double;
  l0,r0,b0,t0:integer;
begin
  ppm:=PixelsPerMeter;
  l0:=system.round(l*ppm);
  r0:=system.round(r*ppm);
  b0:=system.round(b*ppm);
  t0:=system.round(t*ppm);
  if (l0<r0) and (b0<t0)
      and (l0>=0) and (r0<=DevWidth)
      and (b0>=0) and (t0<=DevHeight) then
    begin
      DVleft:=l0;
      DVright:=r0;
      DVbottom:=b0;
      DVtop:=t0;
      setupClipRect;
      setupCoordinatesubsystem;
      clearScreen;
      result:=true;
    end
  else
    result:=false
end;



procedure TGraphSys.askDeviceSize(var w,h:double; var s:string);
var
  ppm:double;
begin
  ppm:=PixelsPerMeter;
  w:=DevWidth/ppm;
  h:=DevHeight/ppm;
  s:='METERS';
end;



procedure TGraphSys.AskDeviceViewport(var l,r,b,t:double);
var
  ppm:double;
begin
  ppm:=PixelsPerMeter;
  l:=DVleft/ppm;
  r:=DVright/ppm;
  b:=DVbottom/ppm;
  t:=DVtop/ppm;
end;

procedure TGraphSys.SetClip(c:boolean);
begin
   clip:=c;
   setupClipRect;
end;   

procedure TGraphSys.ClearScreen;
begin
  clear;
end;

procedure TPrtDirectGraphSys.ClearScreen;
begin
end;


procedure TGraphSys.BezierSub(Canvas:TCanvas; const Points:array of TPoint);
begin
   with Canvas do
     PolyBezier(Points);
end;

procedure TGraphSys.PolyBezier( const Points:array of TPoint);
begin
   BezierSub(Canvas1,Points);
end;



procedure TGraphSys.SetAreaStyle(s:TAreaStyle);
begin
   AreaStyle:=s;
end;

procedure TGraphSys.SetAreaStyleIndex(i:integer);
begin
   AreaStyleIndex:=i
end;


function TGraphSys.SetBeamMode(s:AnsiString):boolean;
begin
   result:=true;
   s:=AnsiUpperCase(s);
   if s=s_Rigorous then
      BeamMode:=bmRigorous
   else if s=s_Immortal then
      BeamMode:=bmImmortal
   else
      result:=false;
end;

function TGraphSys.AskBeamMode:AnsiString;
begin
   case BeamMode of
      bmRigorous: result:=s_Rigorous;
      else result:=s_Immortal;
   end;

end;

{************}
{FLOOD, PAINT}
{************}

procedure TGraphSys.Flood(x,y:integer);
var
   svBrushColor:TColor;
begin
   with Canvas1 do
     begin
       svBrushColor:=Brush.Color;
       Brush.Color:=MyPalette[areacolor] ;
       GraphUtil.FloodFill(Canvas1,x,y,pixels[x,y],fsSurface);
       Brush.Color:=svBrushColor;
     end;
end;


procedure TGraphSys.FloodFill( x,y:integer);
var
   svBrushColor:TColor;
begin
   with Canvas1 do
    begin
       svBrushColor:=Brush.Color;
       Brush.Color:=MyPalette[areacolor] ;
       FloodFill(x,y,MyPalette[linecolor] ,fsBorder);
       Brush.Color:=svBrushColor;
    end;
end;

procedure TScreenBMPGraphSys.Flood( x,y:integer);
var
   svBrushColor:TColor;
begin
   if MyRgn<>0 then  SelectClipRgn(Canvas1.Handle,MyRgn);
   with Canvas1 do
     begin
       svBrushColor:=Brush.Color;
       Brush.Color:=MyPalette[areacolor] ;
       FloodFill(x,y,GetPixelColor(bitmap1,x,y),fsSurface);
       Brush.Color:=svBrushColor;
     end;

end;

procedure TScreenBMPGraphSys.FloodFill( x,y:integer);
begin
   if MyRgn<>0 then  SelectClipRgn(Canvas1.Handle,MyRgn);
   inherited FloodFill(x,y);

end;

{***************}
{Microsoft BASIC}
{***************}

procedure TGraphSys.MSScreen(c:integer);
begin
      setexception(9102)
end;

procedure TScreenBMPGraphSys.MSScreen(c:integer);
begin
   case c of
     2,3,87:
      setBitMapSize(640,400);
     11,12:
      setBitMapSize(640,480);
   end;

   if c in [3,12,87] then
    begin
       case c of
        3 :MyPalette.PaletteNumber:=2;
        12,87:MyPalette.PaletteNumber:=1;
       end;
       clear;
       linecolor:=7;
       setlinecolor(7);
    end;
end;
procedure TGraphSys.MSMoveTo(a,b:integer);
begin
   Canvas1.Moveto(a,b);
end;



procedure TGraphSys.MSLineTo(a,b:integer);
begin
   Canvas1.lineto(a,b);
end;




procedure TGraphSys.MSPaint( x,y:integer; ac, bc:integer);
var
   svBrushColor:TColor;
   BorderColor:TColor;
begin
   svBrushColor:=Canvas1.Brush.Color;
   Canvas1.Brush.Color:=MyPalette[ac] ;
   BorderColor:=MyPalette[bc] ;
   Canvas1.FloodFill(x,y,BorderColor,fsBorder);
   Canvas1.Brush.Color:=svBrushColor;
   Canvas1.MoveTo(x,y);
end;



procedure MSCircleSub(Canvas:TCanvas;
                                x1,y1,x2,y2:integer; lc,ac:integer; f:boolean);

var
   svBrushColor,svPenColor:TColor;
   svBrushStyle:TBrushStyle;
begin
 with Canvas do
 begin
   svPenColor:=Pen.Color;
   svBrushColor:=Brush.Color;
   Pen.Color:=MyPalette[lc] ;
   Brush.Color:=MyPalette[ac] ;
   svBrushStyle:=Brush.Style;
   if F then
      Brush.Style:=BSSolid
   else
      Brush.Style:=BSClear;
   Ellipse(x1,y1,x2,y2);
   Pen.Color:=svPenColor;
   Brush.Color:=svBrushColor;
   Brush.Style:=svBrushStyle;
 end;
end;

procedure TGraphSys.MSCircle(x1,y1,x2,y2:integer; lc,ac:integer; F:boolean);
begin
  MSCircleSub(Canvas1,x1,y1,x2,y2,lc,ac,F);
end;



{***********************}
{**** OPEN and SAVE ****}
{***********************}

function TGraphSys.OpenFile(FileName: string):boolean;
begin
      result:=false;
      setexception(9102)
end;

procedure TGraphSys.SaveFile(FileName: string);
begin
      setexception(9102)
end;


function TScreenBMPGraphSys.OpenFile(FileName: string):boolean;
 var
   ext:string;
   gra:TGraphic;
 begin
   result:=true;
   ext:=UpperCase( ExtractFileExt(FileName));
   if ext='' then
         Bitmap1.LoadFromFile(FileName+'.bmp')
   else if (ext='.BMP') then
         Bitmap1.LoadFromFile(FileName)
   else
       begin
          gra:=nil;
          if ext='.PNG' then
               gra:=TPortableNetworkGraphic.create
          else if (ext='.JPG') or (ext='.JPEG') or (ext='.JPE') then
               gra:=TJpegImage.Create
          else if (ext='.TIFF') or (ext='.TIF') then
               gra:=TTiffImage.create
          else if ext='.GIF' then
               gra:=TGifImage.create
          else if ext='.XPM' then
               gra:=TPixmap.create
          else
               result:=false;
          if gra<>nil then
          begin
            gra.LoadFromFile(FileName);
            Bitmap1.assign(gra);
            gra.free;
          end;
       end;
    HiddenDrawMode:=false;
    Bitmapwidth:=Bitmap1.Width;
    BitmapHeight:=Bitmap1.Height;
    InitCoordinate;
    paintform.setSize2
end;

procedure TScreenBMPGraphSys.saveFile(FileName: string);
begin
    try
     if PaintForm.saveFile(FileName) then
     else
       setexception(9005)
   except
       on E:EExtype do raise
       else
          setexception(9052)
   end;
end;

{***********}
{RepaintExec}
{***********}
procedure RepaintExec;
begin
if RepaintRequest then
   begin
     RepaintRequest:=false;
     {$IFDEF Windows}
      PaintForm.PaintBox1Paint(nil);
     {$ELSE}
      PaintForm.RePaint;
      Application.ProcessMessages;
     {$ENDIF}
   end;
 end;
{************}
{InitGraphics}
{************}

procedure initGraphics;
begin
  case NextGraphMode of
    ScreenBitmapMode:
      MyGraphSys:=ScreenBMPGraphSys;
    PrtDirectMode:
      begin
       MyGraphSys:=PrtDirectGraphSys ;
      end;
    end;
  MyGraphSys.initGraphic;
end;

initialization
   InitCriticalSection(LineBuffCriticalSection);
   InitCriticalSection(SetWindowCriticalSection);
   InitCriticalSection(ClipRectCriticalSection);
   InitCriticalSection(PaletteCriticalSection);

    MyPalette:=TMyPalette.create;
    MyPalette.PaletteNumber:=0;

    ScreenBMPGraphSys:=TScreenBMPGraphSys.create;
    MyGraphSys:=ScreenBMPGraphSys;
    PrtDirectGraphSys:=TPrtDirectGraphSys.create;

    {$IFDEF Windows}
    if Winlib.GetVersion>=0 then
    {$ELSE}
    if false then                // 32ビット座標系ならtrueにする。
    {$ENDIF}
       begin
         restrict:=restrictNT;
         ShrinkRange:=ShrinkRangeNT;
       end
    else
       begin
         restrict:=restrict9x;
         ShrinkRange:=ShrinkRange9x;
       end;



finalization
   DoneCriticalSection(LineBuffCriticalSection);
   DoneCriticalSection(SetWindowCriticalSection);
   DoneCriticalSection(ClipRectCriticalSection);
   DoneCriticalSection(PaletteCriticalSection);
   ScreenBMPGraphSys.Free;
   PrtDirectGraphSys.free;
   MyPalette.Free;
end.
