home *** CD-ROM | disk | FTP | other *** search
/ Chestnut's Multimedia Mania / MM_MANIA.ISO / graphics / paintoop / cstyle.pas < prev    next >
Pascal/Delphi Source File  |  1989-11-19  |  22KB  |  672 lines
  1. {$B-,F-,I+,R+}
  2.  
  3. unit CStyle;
  4.  
  5. { Define TStyle - a class for various drawing styles }
  6.  
  7. { Copyright 1989
  8.   Scott Bussinger
  9.   110 South 131st Street
  10.   Tacoma, WA  98444
  11.   (206)531-8944
  12.   Compuserve 72247,2671 }
  13.  
  14. interface
  15.  
  16. uses Graph,CObject,CMouse,CWindow;
  17.  
  18. const MaxPanes = 16;
  19.  
  20. type TPaneWindowPtr = ^TPaneWindow;
  21.      TPaneWindow = object(TDrawingWindow)
  22.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  23.        procedure Define(Pane: integer); virtual; { Define a new pane }
  24.        procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for this pane }
  25.        function Select: boolean; virtual;        { Select this pane }
  26.        end;
  27.  
  28. type TMultipanedWindowPtr = ^TMultipanedWindow;
  29.      TMultipanedWindow = object(TWindow)
  30.        fCurrentPane: integer;
  31.        fNumPanes: integer;
  32.        fPane: array[0..MaxPanes-1] of TPaneWindowPtr;
  33.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real); { Initialize a multipaned window }
  34.        destructor Done; virtual;                 { Release a multipaned window }
  35.        procedure ChangePane(Pane: integer); virtual; { Change to a new active pane }
  36.        function CheckMouse: boolean; virtual;    { Check if the mouse is in this window }
  37.        function CreatePane(Pane: integer;Bordered: boolean;X1,Y1,X2,Y2: real): TPaneWindowPtr; virtual;
  38.        function CurrentPane: TPaneWindowPtr;     { Get the current pane in window }
  39.        procedure Partition(Bordered: boolean;X1,Y1,X2,Y2: real;Across,Down: integer); { Partition a window with lots of panes }
  40.        procedure SetCursor; virtual;             { Set the mouse cursor for the window }
  41.        end;
  42.  
  43. type TColorPanePtr = ^TColorPane;
  44.      TColorPane = object(TPaneWindow)
  45.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  46.        procedure Define(Pane: integer); virtual; { Define a new color pane }
  47.        procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for this color }
  48.        function Select: boolean; virtual;        { Select this color }
  49.        end;
  50.  
  51. type TColorWindowPtr = ^TColorWindow;
  52.      TColorWindow = object(TMultipanedWindow)
  53.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real); { Initialize a color selection window }
  54.        function CreatePane(Pane: integer;Bordered: boolean;X1,Y1,X2,Y2: real): TPaneWindowPtr; virtual;
  55.        end;
  56.  
  57. type TFillPanePtr =^TFillPane;
  58.      TFillPane = object(TPaneWindow)
  59.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  60.        procedure Define(Pane: integer); virtual; { Define a new fill mask pane }
  61.        procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for this fill mask }
  62.        function Select: boolean; virtual;        { Select this fill mask }
  63.        end;
  64.  
  65. type TFillWindowPtr = ^TFillWindow;
  66.      TFillWindow = object(TMultipanedWindow)
  67.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real); { Initialize a fill mask selection window }
  68.        function CreatePane(Pane: integer;Bordered: boolean;X1,Y1,X2,Y2: real): TPaneWindowPtr; virtual;
  69.        end;
  70.  
  71. type TLinePanePtr = ^TLinePane;
  72.      TLinePane = object(TPaneWindow)
  73.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  74.        procedure Define(Pane: integer); virtual; { Define a new line style pane }
  75.        procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for this line style }
  76.        function Select: boolean; virtual;        { Select this line style pane }
  77.        end;
  78.  
  79. type TLineWindowPtr = ^TLineWindow;
  80.      TLineWindow = object(TMultipanedWindow)
  81.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  82.        function CreatePane(Pane: integer;Bordered: boolean;X1,Y1,X2,Y2: real): TPaneWindowPtr; virtual;
  83.        end;
  84.  
  85. type TFontPanePtr = ^TFontPane;
  86.      TFontPane = object(TPaneWindow)
  87.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  88.        procedure Define(Pane: integer); virtual; { Define a new font pane }
  89.        procedure DrawIcon(Marked: boolean); virtual; { Draw the icon for this font }
  90.        function Select: boolean; virtual;        { Select this font }
  91.        end;
  92.  
  93. type TFontWindowPtr = ^TFontWindow;
  94.      TFontWindow = object(TMultipanedWindow)
  95.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real); { Initialize a font selection window }
  96.        function CreatePane(Pane: integer;Bordered: boolean;X1,Y1,X2,Y2: real): TPaneWindowPtr; virtual;
  97.        end;
  98.  
  99. type TColorStylePanePtr = ^TColorStylePane;
  100.      TColorStylePane = object(TPaneWindow)
  101.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  102.        procedure DrawIcon(Marked: boolean); virtual; { Draw the icon showing the current color }
  103.        end;
  104.  
  105. type TFillStylePanePtr = ^TFillStylePane;
  106.      TFillStylePane = object(TPaneWindow)
  107.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  108.        procedure DrawIcon(Marked: boolean); virtual; { Draw the icon showing the fill mask }
  109.        end;
  110.  
  111. type TLineStylePanePtr = ^TLineStylePane;
  112.      TLineStylePane = object(TPaneWindow)
  113.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  114.        procedure DrawIcon(Marked: boolean); virtual; { Draw the icon showing the line style }
  115.        end;
  116.  
  117. type TFontStylePanePtr = ^TFontStylePane;
  118.      TFontStylePane = object(TPaneWindow)
  119.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real);
  120.        procedure DrawIcon(Marked: boolean); virtual; { Draw the icon showing the font }
  121.        end;
  122.  
  123. type TStyleWindow = object(TMultipanedWindow)
  124.        fCurrentWindow: TMultipanedWindowPtr;
  125.        fCurrentWindowBordered: boolean;
  126.        fWX1: real;
  127.        fWX2: real;
  128.        fWY1: real;
  129.        fWY2: real;
  130.        constructor Init(Bordered: boolean;X1,Y1,X2,Y2: real); { Initialize a current style selection window }
  131.        destructor Done; virtual;                 { Release a current style window }
  132.        function CheckMouse: boolean; virtual;    { Check if the mouse is in this window }
  133.        function CreatePane(Pane: integer;Bordered: boolean;X1,Y1,X2,Y2: real): TPaneWindowPtr; virtual;
  134.        end;
  135.  
  136. implementation
  137.  
  138. constructor TMultipanedWindow.Init(Bordered: boolean;
  139.                                    X1,Y1,X2,Y2: real);
  140.   { Initialize a multipaned window }
  141.   begin
  142.   TWindow.Init(Bordered,X1,Y1,X2,Y2)
  143.   end;
  144.  
  145. destructor TMultipanedWindow.Done;
  146.   { Release a multipaned window }
  147.   var I: integer;
  148.   begin
  149.   for I := 0 to fNumPanes-1 do
  150.     dispose(fPane[I],Done);
  151.   TWindow.Done
  152.   end;
  153.  
  154. procedure TMultipanedWindow.ChangePane(Pane: integer);
  155.   { Change to a new active pane }
  156.   begin
  157.   fCurrentPane := Pane                           { Change the current pane }
  158.   end;
  159.  
  160. function TMultipanedWindow.CheckMouse: boolean;
  161.   { Check if the mouse is in this window }
  162.   var I: integer;
  163.   begin
  164.   CheckMouse := false;
  165.   if TWindow.CheckMouse then                     { See if we're in this window at all }
  166.     begin
  167.     I := 0;                                      { Check a multipaned window by looking at each of the panes }
  168.     while (I<fNumPanes) and not (fPane[I]^.CheckMouse) do
  169.       inc(I);
  170.     if I < fNumPanes then
  171.       begin
  172.       CheckMouse := true;
  173.       SetCursor;                                 { Change to the appropriate mouse cursor }
  174.       if (Mouse.GetButton(Left)=Released) and    { Was the button just released? }
  175.          fPane[I]^.Select then                   { Does this pane cause a mode change? }
  176.         ChangePane(I)
  177.       end
  178.     end
  179.   end;
  180.  
  181. function TMultipanedWindow.CreatePane(Pane: integer;
  182.                                       Bordered: boolean;
  183.                                       X1,Y1,X2,Y2: real): TPaneWindowPtr;
  184.   { Create a new pane }
  185.   begin
  186.   CreatePane := new(TPaneWindowPtr,Init(Bordered,X1,Y1,X2,Y2))
  187.   end;
  188.  
  189. function TMultipanedWindow.CurrentPane: TPaneWindowPtr;
  190.   { Get the current pane }
  191.   begin
  192.   CurrentPane := fPane[fCurrentPane]
  193.   end;
  194.  
  195. procedure TMultipanedWindow.Partition(Bordered: boolean;
  196.                                       X1,Y1,X2,Y2: real;
  197.                                       Across,Down: integer);
  198.   { Partition a window into an array of panes }
  199.   var I: integer;
  200.       R,C: integer;
  201.   begin
  202.   fNumPanes := Across * Down;
  203.   if fNumPanes > MaxPanes then
  204.     begin
  205.     fNumPanes := MaxPanes;
  206.     Across := MaxPanes div Down
  207.     end;
  208.   for I := 0 to fNumPanes-1 do
  209.     begin
  210.     R := I div Across;
  211.     C := I mod Across;
  212.     fPane[I] := CreatePane(I,Bordered,C*(X2-X1)/Across+X1,R*(Y2-Y1)/Down+Y1,(C+1)*(X2-X1)/Across+X1,(R+1)*(Y2-Y1)/Down+Y1);
  213.     fPane[I]^.Define(I);
  214.     fPane[I]^.DrawIcon(false)
  215.     end;
  216.   fCurrentPane := 0;
  217.   ChangePane(fCurrentPane)
  218.   end;
  219.  
  220. procedure TMultipanedWindow.SetCursor;
  221.   { Set the mouse cursor for the window }
  222.   begin
  223.   Mouse.SetCursor(HandCursor)
  224.   end;
  225.  
  226. constructor TPaneWindow.Init(Bordered: boolean;
  227.                              X1,Y1,X2,Y2: real);
  228.   { Initialize a pane }
  229.   begin
  230.   TDrawingWindow.Init(Bordered,X1,Y1,X2,Y2)
  231.   end;
  232.  
  233. procedure TPaneWindow.Define(Pane: integer);
  234.   { Define a new pane }
  235.   begin
  236.   { Should be overridden in all subclasses }
  237.   end;
  238.  
  239. procedure TPaneWindow.DrawIcon(Marked: boolean);
  240.   { Draw the icon for this pane }
  241.   begin
  242.   Mouse.Hide;                                    { Keep the display clean }
  243.   Activate                                       { Switch to this window }
  244.   end;
  245.  
  246. function TPaneWindow.Select: boolean;
  247.   { Select this pane }
  248.   { Return true if selecting this pane should change the current pane or
  249.     false if the previous pane stays in effect. }
  250.   begin
  251.   Select := true;
  252.   CurrentCanvas^.Activate
  253.   end;
  254.  
  255. constructor TColorPane.Init(Bordered: boolean;
  256.                             X1,Y1,X2,Y2: real);
  257.   { Initialize a pane }
  258.   begin
  259.   TPaneWindow.Init(Bordered,X1,Y1,X2,Y2)
  260.   end;
  261.  
  262. procedure TColorPane.DrawIcon(Marked: boolean);
  263.   { Draw the icon for this color }
  264.   var Viewport: ViewportType;
  265.   begin
  266.   TPaneWindow.DrawIcon(Marked);
  267.   GetViewSettings(Viewport);
  268.   with Viewport do
  269.     Bar(0,0,X2-X1,Y2-Y1)
  270.   end;
  271.  
  272. procedure TColorPane.Define(Pane: integer);
  273.   { Define a new color pane }
  274.   begin
  275.   TPaneWindow.Define(Pane);
  276.   ChangeColor(Pane)
  277.   end;
  278.  
  279. function TColorPane.Select: boolean;
  280.   { Select this color }
  281.   var TempColor: integer;
  282.   begin
  283.   TempColor := GetColor;
  284.   Select := TPaneWindow.Select;
  285.   ChangeColor(TempColor)
  286.   end;
  287.  
  288. constructor TColorWindow.Init(Bordered: boolean;
  289.                               X1,Y1,X2,Y2: real);
  290.   { Initialize a color selection window }
  291.   begin
  292.   TMultipanedWindow.Init(false,X1,Y1,X2,Y2);
  293.   if GetMaxColor = 1                             { Watch for this special case, for a better looking display }
  294.    then
  295.     Partition(Bordered,X1,Y1,X2,Y2,2,1)
  296.    else
  297.     Partition(Bordered,X1,Y1,X2,Y2,(GetMaxColor+1) div 2,2);
  298.   ChangePane(fNumPanes-1)
  299.   end;
  300.  
  301. function TColorWindow.CreatePane(Pane: integer;
  302.                                  Bordered: boolean;
  303.                                  X1,Y1,X2,Y2: real): TPaneWindowPtr;
  304.   { Create a new color pane }
  305.   begin
  306.   CreatePane := new(TColorPanePtr,Init(Bordered,X1,Y1,X2,Y2))
  307.   end;
  308.  
  309. constructor TFillPane.Init(Bordered: boolean;
  310.                            X1,Y1,X2,Y2: real);
  311.   { Initialize a pane }
  312.   begin
  313.   TPaneWindow.Init(Bordered,X1,Y1,X2,Y2)
  314.   end;
  315.  
  316. procedure TFillPane.DrawIcon(Marked: boolean);
  317.   { Draw the icon for this fill mask }
  318.   var SaveFill: FillPatternType;
  319.       Viewport: ViewportType;
  320.   begin
  321.   TPaneWindow.DrawIcon(Marked);
  322.   GetViewSettings(Viewport);
  323.   with Viewport do
  324.     begin
  325.     GetFillPattern(SaveFill);
  326.     ChangeFill(FillPattern[SolidFill],SystemBackground);
  327.     ChangeColor(SystemBackground);
  328.     Bar(0,0,X2-X1,Y2-Y1);
  329.     ChangeFill(SaveFill,SystemWhite);
  330.     ChangeColor(SystemWhite);
  331.     Bar(0,0,X2-X1,Y2-Y1)
  332.     end
  333.   end;
  334.  
  335. procedure TFillPane.Define(Pane: integer);
  336.   { Define a new fill mask pane }
  337.   begin
  338.   TPaneWindow.Define(Pane);
  339.   ChangeFill(FillPattern[Pane],GetColor)
  340.   end;
  341.  
  342. function TFillPane.Select: boolean;
  343.   { Select this fill mask }
  344.   var TempFillPattern: FillPatternType;
  345.   begin
  346.   GetFillPattern(TempFillPattern);
  347.   Select := TPaneWindow.Select;
  348.   ChangeFill(TempFillPattern,GetColor)
  349.   end;
  350.  
  351. constructor TFillWindow.Init(Bordered: Boolean;
  352.                              X1,Y1,X2,Y2: real);
  353.   { Initialize a fill mask selection window }
  354.   begin
  355.   TMultipanedWindow.Init(false,X1,Y1,X2,Y2);
  356.   Partition(Bordered,X1,Y1,X2,Y2,MaxFillPatterns div 2,2);
  357.   ChangePane(fNumPanes-1)
  358.   end;
  359.  
  360. function TFillWindow.CreatePane(Pane: integer;
  361.                                 Bordered: boolean;
  362.                                 X1,Y1,X2,Y2: real): TPaneWindowPtr;
  363.   { Create a new fill mask pane }
  364.   begin
  365.   CreatePane := new(TFillPanePtr,Init(Bordered,X1,Y1,X2,Y2))
  366.   end;
  367.  
  368. constructor TLinePane.Init(Bordered: boolean;
  369.                            X1,Y1,X2,Y2: real);
  370.   { Initialize a pane }
  371.   begin
  372.   TPaneWindow.Init(Bordered,X1,Y1,X2,Y2)
  373.   end;
  374.  
  375. procedure TLinePane.DrawIcon(Marked: boolean);
  376.   { Draw the icon for this line style }
  377.   var Viewport: ViewportType;
  378.   begin
  379.   TPaneWindow.DrawIcon(Marked);
  380.   GetViewSettings(Viewport);
  381.   with Viewport do
  382.     begin
  383.     ChangeColor(SystemBackground);
  384.     Bar(0,0,X2-X1,Y2-Y1);
  385.     ChangeColor(SystemWhite);
  386.     MoveTo(0,(Y2-Y1) div 3);
  387.     LineTo(X2-X1,(Y2-Y1) div 3);
  388.     MoveTo(0,2*(Y2-Y1) div 3);
  389.     LineTo(X2-X1,2*(Y2-Y1) div 3)
  390.     end
  391.   end;
  392.  
  393. procedure TLinePane.Define(Pane: integer);
  394.   { Define a new line style pane }
  395.   begin
  396.   TPaneWindow.Define(Pane);
  397.   SetLineStyle(UserBitLn,LineStyle[Pane],NormWidth)
  398.   end;
  399.  
  400. function TLinePane.Select: boolean;
  401.   { Select this line style }
  402.   var LineSettings: LineSettingsType;
  403.   begin
  404.   GetLineSettings(LineSettings);
  405.   Select := TPaneWindow.Select;
  406.   SetLineStyle(UserBitLn,LineSettings.Pattern,NormWidth)
  407.   end;
  408.  
  409. constructor TLineWindow.Init(Bordered: boolean;
  410.                              X1,Y1,X2,Y2: real);
  411.   { Initialize a line style selection window }
  412.   begin
  413.   TMultipanedWindow.Init(false,X1,Y1,X2,Y2);
  414.   Partition(Bordered,X1,Y1,X2,Y2,MaxLineStyles div 2,2);
  415.   ChangePane(fNumPanes-1)
  416.   end;
  417.  
  418. function TLineWindow.CreatePane(Pane: integer;
  419.                                 Bordered: boolean;
  420.                                 X1,Y1,X2,Y2: real): TPaneWindowPtr;
  421.   { Create a new line style window pane }
  422.   begin
  423.   CreatePane := new(TLinePanePtr,Init(Bordered,X1,Y1,X2,Y2))
  424.   end;
  425.  
  426. constructor TFontPane.Init(Bordered: boolean;
  427.                            X1,Y1,X2,Y2: real);
  428.   { Initialize a pane }
  429.   begin
  430.   TPaneWindow.Init(Bordered,X1,Y1,X2,Y2)
  431.   end;
  432.  
  433. procedure TFontPane.DrawIcon(Marked: boolean);
  434.   { Draw the icon for this font }
  435.   var Viewport: ViewportType;
  436.   begin
  437.   TPaneWindow.DrawIcon(Marked);
  438.   GetViewSettings(Viewport);
  439.   with Viewport do
  440.     begin
  441.     ChangeColor(SystemBackground);
  442.     Bar(0,0,X2-X1,Y2-Y1);
  443.     ChangeColor(SystemWhite);
  444.     case CurrentFont of
  445.       Triplex: FitText(Triplex,'Triplex');
  446.       Small: FitText(Small,'Small');
  447.       SansSerif: FitText(SansSerif,'Sans Serif');
  448.       Gothic: FitText(Gothic,'Gothic');
  449.       Bold: FitText(Bold,'Bold');
  450.       Simplex: FitText(Simplex,'Simplex');
  451.       TriplexScript: FitText(TriplexScript,'Tri-Script');
  452.       Script: FitText(Script,'Script');
  453.       EuroStyle: FitText(EuroStyle,'Euro');
  454.       Complex: FitText(Complex,'Complex')
  455.       end
  456.     end
  457.   end;
  458.  
  459. procedure TFontPane.Define(Pane: integer);
  460.   { Define a new font pane }
  461.   begin
  462.   TPaneWindow.Define(Pane);
  463.   SetFont(Font(Pane),CurrentHeight,CurrentWidth)
  464.   end;
  465.  
  466. function TFontPane.Select: boolean;
  467.   { Select this font }
  468.   var TempFont: Font;
  469.   begin
  470.   TempFont := CurrentFont;
  471.   Select := TPaneWindow.Select;
  472.   SetFont(TempFont,CurrentHeight,CurrentWidth)
  473.   end;
  474.  
  475. constructor TFontWindow.Init(Bordered: boolean;
  476.                              X1,Y1,X2,Y2: real);
  477.   { Initialize a font selection window }
  478.   begin
  479.   TMultipanedWindow.Init(false,X1,Y1,X2,Y2);
  480.   Partition(Bordered,X1,Y1,X2,Y2,5,2);
  481.   ChangePane(ord(Triplex))
  482.   end;
  483.  
  484. function TFontWindow.CreatePane(Pane: integer;
  485.                                 Bordered: boolean;
  486.                                 X1,Y1,X2,Y2: real): TPaneWindowPtr;
  487.   { Create a new font window pane }
  488.   begin
  489.   CreatePane := new(TFontPanePtr,Init(Bordered,X1,Y1,X2,Y2))
  490.   end;
  491.  
  492. constructor TColorStylePane.Init(Bordered: boolean;
  493.                                  X1,Y1,X2,Y2: real);
  494.   { Initialize a pane }
  495.   begin
  496.   TPaneWindow.Init(Bordered,X1,Y1,X2,Y2)
  497.   end;
  498.  
  499. procedure TColorStylePane.DrawIcon(Marked: boolean);
  500.   { Draw the icon for the current color style }
  501.   var TempColor: integer;
  502.       Viewport: ViewportType;
  503.   begin
  504.   CurrentCanvas^.Activate;
  505.   TempColor := GetColor;
  506.   TPaneWindow.DrawIcon(Marked);
  507.   ChangeColor(TempColor);
  508.   GetViewSettings(Viewport);
  509.   with Viewport do
  510.     Bar(0,0,X2-X1,Y2-Y1)
  511.   end;
  512.  
  513. constructor TFillStylePane.Init(Bordered: boolean;
  514.                                 X1,Y1,X2,Y2: real);
  515.   { Initialize a pane }
  516.   begin
  517.   TPaneWindow.Init(Bordered,X1,Y1,X2,Y2)
  518.   end;
  519.  
  520. procedure TFillStylePane.DrawIcon(Marked: boolean);
  521.   { Draw the icon for the current fill mask }
  522.   var SaveFillPattern: FillPatternType;
  523.       Viewport: ViewportType;
  524.   begin
  525.   CurrentCanvas^.Activate;
  526.   GetFillPattern(SaveFillPattern);
  527.   TPaneWindow.DrawIcon(Marked);
  528.   GetViewSettings(Viewport);
  529.   with Viewport do
  530.     begin
  531.     ChangeFill(FillPattern[SolidFill],SystemBackground);
  532.     ChangeColor(SystemBackground);
  533.     Bar(0,0,X2-X1,Y2-Y1);
  534.     ChangeColor(SystemWhite);
  535.     ChangeFill(SaveFillPattern,SystemWhite);
  536.     Bar((X2-X1) div 10,2*(Y2-Y1) div 10,9*(X2-X1) div 10,8*(Y2-Y1) div 10)
  537.     end
  538.   end;
  539.  
  540. constructor TLineStylePane.Init(Bordered: boolean;
  541.                                 X1,Y1,X2,Y2: real);
  542.   { Initialize a pane }
  543.   begin
  544.   TPaneWindow.Init(Bordered,X1,Y1,X2,Y2)
  545.   end;
  546.  
  547. procedure TLineStylePane.DrawIcon(Marked: boolean);
  548.   { Draw the icon for the current line style }
  549.   var LineSettings: LineSettingsType;
  550.       Viewport: ViewportType;
  551.   begin
  552.   CurrentCanvas^.Activate;
  553.   GetLineSettings(LineSettings);
  554.   TPaneWindow.DrawIcon(Marked);
  555.   GetViewSettings(Viewport);
  556.   with Viewport do
  557.     begin
  558.     ChangeColor(SystemBackground);
  559.     Bar(0,0,X2-X1,Y2-Y1);
  560.     ChangeColor(SystemWhite);
  561.     SetLineStyle(UserBitLn,LineSettings.Pattern,NormWidth);
  562.     MoveTo(0,(Y2-Y1) div 3);
  563.     LineTo(X2-X1,(Y2-Y1) div 3);
  564.     MoveTo(0,2*(Y2-Y1) div 3);
  565.     LineTo(X2-X1,2*(Y2-Y1) div 3)
  566.     end
  567.   end;
  568.  
  569. constructor TFontStylePane.Init(Bordered: boolean;
  570.                                 X1,Y1,X2,Y2: real);
  571.   { Initialize a pane }
  572.   begin
  573.   TPaneWindow.Init(Bordered,X1,Y1,X2,Y2)
  574.   end;
  575.  
  576. procedure TFontStylePane.DrawIcon(Marked: boolean);
  577.   { Draw the icon for the current font }
  578.   var TempFont: Font;
  579.       Viewport: ViewportType;
  580.   begin
  581.   CurrentCanvas^.Activate;
  582.   TempFont := CurrentFont;
  583.   TPaneWindow.DrawIcon(Marked);
  584.   GetViewSettings(Viewport);
  585.   with Viewport do
  586.     begin
  587.     ChangeColor(SystemBackground);
  588.     Bar(0,0,X2-X1,Y2-Y1);
  589.     ChangeColor(SystemWhite);
  590.     case TempFont of
  591.       Triplex: FitText(Triplex,'Triplex');
  592.       Small: FitText(Small,'Small');
  593.       SansSerif: FitText(SansSerif,'Sans Serif');
  594.       Gothic: FitText(Gothic,'Gothic');
  595.       Bold: FitText(Bold,'Bold');
  596.       Simplex: FitText(Simplex,'Simplex');
  597.       TriplexScript: FitText(TriplexScript,'Tri-Script');
  598.       Script: FitText(Script,'Script');
  599.       EuroStyle: FitText(EuroStyle,'Euro');
  600.       Complex: FitText(Complex,'Complex')
  601.       end
  602.     end
  603.   end;
  604.  
  605. constructor TStyleWindow.Init(Bordered: boolean;
  606.                               X1,Y1,X2,Y2: real);
  607.   { Initialize a style selection window }
  608.   begin
  609.   TMultipanedWindow.Init(false,X1,Y1,0.10*(X2-X1)+X1,Y2);
  610.   Partition(Bordered,X1,Y1,0.10*(X2-X1)+X1,Y2,1,4);
  611.   fWX1 := 0.11*(X2-X1)+X1;                       { Remember the window coordinates }
  612.   fWY1 := 0.50*(Y2-Y1)+Y1;                       { Choice window is only half as tall }
  613.   fWX2 := X2;
  614.   fWY2 := Y2;
  615.   fCurrentWindow := new(TColorWindowPtr,Init(Bordered,fWX1,fWY1,fWX2,fWY2));
  616.   fCurrentWindowBordered := Bordered
  617.   end;
  618.  
  619. destructor TStyleWindow.Done;
  620.   { Release a style selection window }
  621.   begin
  622.   dispose(fCurrentWindow,Done);
  623.   TMultipanedWindow.Done
  624.   end;
  625.  
  626. function TStyleWindow.CheckMouse: boolean;
  627.   { Check if the mouse is in this window }
  628.   var PreviousActivePane: integer;
  629.   begin
  630.   PreviousActivePane := fCurrentPane;
  631.   CheckMouse := true;
  632.   if TMultipanedWindow.CheckMouse
  633.    then
  634.     begin
  635.     if (Mouse.GetButton(Left)=Released) and      { Was the button just released? }
  636.        (fCurrentPane<>PreviousActivePane) then   { Was a new window selected? }
  637.       begin
  638.       dispose(fCurrentWindow,Done);              { Release the old window }
  639.       case fCurrentPane of                       { Create the new window }
  640.         0: fCurrentWindow := new(TColorWindowPtr,Init(fCurrentWindowBordered,fWX1,fWY1,fWX2,fWY2));
  641.         1: fCurrentWindow := new(TFillWindowPtr,Init(fCurrentWindowBordered,fWX1,fWY1,fWX2,fWY2));
  642.         2: fCurrentWindow := new(TLineWindowPtr,Init(fCurrentWindowBordered,fWX1,fWY1,fWX2,fWY2));
  643.         3: fCurrentWindow := new(TFontWindowPtr,Init(fCurrentWindowBordered,fWX1,fWY1,fWX2,fWY2))
  644.         end
  645.       end
  646.     end
  647.    else
  648.     if fCurrentWindow^.CheckMouse
  649.      then
  650.       begin
  651.       if Mouse.GetButton(Left) = Released then   { Was the button just released? }
  652.         fPane[fCurrentPane]^.DrawIcon(false)
  653.       end
  654.      else
  655.       CheckMouse := false
  656.   end;
  657.  
  658. function TStyleWindow.CreatePane(Pane: integer;
  659.                                  Bordered: boolean;
  660.                                  X1,Y1,X2,Y2: real): TPaneWindowPtr;
  661.   { Create a new style selection window pane }
  662.   begin
  663.   case Pane of
  664.     0: CreatePane := new(TColorStylePanePtr,Init(Bordered,X1,Y1,X2,Y2));
  665.     1: CreatePane := new(TFillStylePanePtr,Init(Bordered,X1,Y1,X2,Y2));
  666.     2: CreatePane := new(TLineStylePanePtr,Init(Bordered,X1,Y1,X2,Y2));
  667.     3: CreatePane := new(TFontStylePanePtr,Init(Bordered,X1,Y1,X2,Y2))
  668.     end
  669.   end;
  670.  
  671. end.
  672.