unit KolShapes;
//
// purpose: KOL Shape control
//  author: ©2004, Thaddy de Koning, mailto:thaddy@thaddy.com
//          Portions created by Mat Ballard, Copyright ©1999 Mat Ballard.
//          His original code is available from http://Chemware.hypermart.net/
//
//          The contents of this file are subject to the Mozilla Public License
//          Version 1.1 (the "License").
//          you may not use this file except in compliance with the License.
//          You may obtain a copy of the License at
//          http://www.mozilla.org/MPL/MPL-1.1.html
//          Software distributed under the License is distributed on an "AS IS"
//          basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied.
//          See the License for the specific language governing rights and
//          limitations under the License.
//
// Remarks: Based on an idea and MPL'd -VCL- code by Mat Ballard, hence the MPL.
//          Simple example of how to create new KOL controls.
//          Since it is a true KOL control I could rip out most of the
//          original code, leaving just the paint routine and a small container
//          which I assign to the CustomObj property.
//          This shows that writing KOL custom controls is actually *simpler*
//          than writing VCL controls!
//
//          Have fun,
//
//          Thaddy
interface

uses
Windows,messages,kol;


type
  TShapeType =   (stArrowRight, stArrowLeft,
                  stArrowUp, stArrowDown,
                  stEllipse,
                  stLineHorz, stLineVert,
                  stRectangle, stRectangleRound,
                  stTriangleUp, stTriangleDown, stTriangleLeft, stTriangleRight
                  );

  PShapeData=^TShapeData;
  TShapeData = object(TObj)
  private
    FShape: TShapeType;
    procedure Paint(sender:pControl;DC:HDC);
  end;

function NewShape(aOwner:PControl;aType:TShapeType;PenColor,BrushColor:TColor):Pcontrol;
{ Creates a Shape control
 Pencolor   = Color1
 BrushColor = Color2
 Possible Shapes: stArrowRight,
                  stArrowLeft,
                  stArrowUp,
                  stArrowDown,
                  stEllipse,
                  stLineHorz,
                  stLineVert,
                  stRectangle,
                  stRectangleRound,
                  stTriangleUp,
                  stTriangleDown,
                  stTriangleLeft,
                  stTriangleRight}
implementation


function NewShape(aOwner:PControl;aType:TShapeType;PenColor,BrushColor:TColor):Pcontrol;
var
  Data:PShapeData;
begin
 {Create the Shape data object}
 New(Data,Create);
 {Create the control as a paintbox}
 Result:=NewPaintBox(aOwner).setsize(50,50);
 with Result^ do
 begin
   {CustomObj's are automatically free'd in the TObject destructor}
   CustomObj:=Data;
   {Set the shape}
   Data.FShape:=aType;
   {Set the paint routine}
   OnPaint:=Data.Paint;
   {Set the colors}
   Color1:=PenColor;
   Color2:=BrushColor;
   {Leave the rest transparent}
   Transparent:=true;
 end;
end;





procedure TShapeData.Paint(sender:PControl;DC:HDC);
var
  PT: Integer;
begin
  with sender.canvas^ do
  begin
    Pen.Color:=sender.Color1;
    Brush.Color:=sender.Color2;
    PT := Pen.PenWidth div 2;
    case FShape of
      stRectangle: Rectangle(PT,PT, sender.Width-PT, sender.Height-PT);
      stRectangleRound: RoundRect(PT,PT, sender.Width-PT, sender.Height-PT, sender.Width div 4, sender.Height div 4);
      stEllipse: Ellipse(PT, PT, sender.Width-PT, sender.Height-PT);
      stLineHorz:
        begin
          MoveTo(0, sender.Height div 2);
          LineTo(sender.Width-1, sender.Height div 2);
        end;
      stLineVert:
        begin
          MoveTo(sender.Width div 2, 0);
          LineTo(sender.Width div 2, sender.Height-1);
        end;
      stArrowLeft:
        begin
          MoveTo(sender.Width-1, sender.Height div 2);
          LineTo(PT, sender.Height div 2);
          LineTo(sender.Height div 2, sender.Height-1);
          MoveTo(PT, sender.Height div 2);
          LineTo(sender.Height div 2, 0);
        end;
      stArrowRight:
        begin
          MoveTo(0, sender.height div 2);
          LineTo(sender.width-PT, sender.height div 2);
          LineTo(sender.width-1-(sender.height div 2), sender.height-1);
          MoveTo(sender.width-PT, sender.height div 2);
          LineTo(sender.width-1-(sender.height div 2), 0);
        end;
      stArrowUp:
        begin
          MoveTo(sender.width div 2, sender.height-1);
          LineTo(sender.width div 2, PT);
          LineTo(0, sender.width div 2);
          MoveTo(sender.width div 2, PT);
          LineTo(sender.width-1, sender.width div 2);
        end;
      stArrowDown:
        begin
          MoveTo(sender.width div 2, 0);
          LineTo(sender.width div 2, sender.height-PT);
          LineTo(0, sender.height-1-(sender.width div 2));
          MoveTo(sender.width div 2, sender.height-PT);
          LineTo(sender.width-1, sender.height-1-(sender.width div 2));
        end;
      stTriangleUp:
        Polygon([MakePoint(sender.width div 2, 0), MakePoint(sender.width-1, sender.height-1), MakePoint(0, sender.height-1)]);
      stTriangleDown:
        Polygon([MakePoint(0, 0), MakePoint(sender.width-1, 0), MakePoint(sender.width div 2, sender.height-1)]);
      stTriangleLeft:
        Polygon([MakePoint(0, sender.height div 2), MakePoint(sender.width-1, 0), MakePoint(sender.width-1, sender.height-1)]);
      stTriangleRight:
        Polygon([MakePoint(0, 0), MakePoint(sender.width-1, sender.height div 2), MakePoint(0, sender.height-1)]);
    end;
  end;
end;


end.