Browse Source

+ added patterned lines
+ added rectangle with horizontal,vertical and cross style

luk 22 years ago
parent
commit
e9e217bf89
1 changed files with 72 additions and 15 deletions
  1. 72 15
      fcl/image/fppixlcanv.pp

+ 72 - 15
fcl/image/fppixlcanv.pp

@@ -30,6 +30,8 @@ type
   PixelCanvasException = class (TFPCanvasException);
 
   TFPPixelCanvas = class (TFPCustomCanvas)
+  private
+    FHashWidth : word;
   protected
     function DoCreateDefaultFont : TFPCustomFont; override;
     function DoCreateDefaultPen : TFPCustomPen; override;
@@ -47,6 +49,9 @@ type
     procedure DoPolyline (const points:array of TPoint); override;
     procedure DoFloodFill (x,y:integer); override;
     procedure DoLine (x1,y1,x2,y2:integer); override;
+  public
+    constructor create;
+    property HashWidth : word read FHashWidth write FHashWidth;
   end;
 
 implementation
@@ -55,12 +60,19 @@ uses Clipping;
 
 const
   ErrNotAvailable = 'Not availlable';
+  DefaultHashWidth = 5;
 
 procedure NotImplemented;
 begin
   raise PixelCanvasException.Create(ErrNotAvailable);
 end;
 
+constructor TFPPixelCanvas.Create;
+begin
+  inherited;
+  FHashWidth := DefaultHashWidth;
+end;
+
 function TFPPixelCanvas.DoCreateDefaultFont : TFPCustomFont;
 begin
   result := TFPEmptyFont.Create;
@@ -132,22 +144,67 @@ end;
 
 procedure TFPPixelCanvas.DoRectangleFill (const Bounds:TRect);
 var b : TRect;
+
+  procedure FillHorizontal;
+  var y : integer;
+  begin
+    with b do
+      begin
+      y := FHashWidth + top;
+      while y <= bottom do
+        begin
+        DrawSolidLine (self, left,y, right,y, brush.color);
+        inc (y,FHashWidth);
+        end
+      end;
+  end;
+
+  procedure FillVertical;
+  var x : integer;
+  begin
+    with b do
+      begin
+      x := FHashWidth + left;
+      while x <= right do
+        begin
+        DrawSolidLine (self, x,top, x,bottom, brush.color);
+        inc (x, FHashWidth);
+        end;
+      end;
+  end;
+
+  procedure FillDiagonal;
+  begin
+  end;
+
+  procedure FillFDiagonal;
+  begin
+  end;
+
 begin
   b := Bounds;
   SortRect (b);
   if clipping then
     CheckRectClipping (ClipRect, B);
-  with b do
+  with b do  // Clipping needs still to be checked !!
     case Brush.style of  //TODO: patterns and image
       bsSolid : FillRectangleColor (self, left,top, right,bottom);
       bsPattern : ;
       bsImage : ;
-      bsDiagonal : ;
-      bsFDiagonal : ;
-      bsCross : ;
-      bsDiagCross : ;
-      bsHorizontal : ;
-      bsVertical : ;
+      bsDiagonal : FillDiagonal;
+      bsFDiagonal : FillFDiagonal;
+      bsCross :
+        begin
+        FillHorizontal;
+        FillVertical;
+        end;
+      bsDiagCross :
+        begin
+        FillDiagonal;
+        FillFDiagonal;
+        end;
+      bsHorizontal : FillHorizontal;
+      bsVertical : FillVertical;
     end;
 end;
 
@@ -197,8 +254,8 @@ begin    //TODO
 end;
 
 const
-  PenPatterns : array[psDash..psDashDotDot] of word =
-    ($EEEE, $AAAA, $E4E4, $EAEA);
+  PenPatterns : array[psDash..psDashDotDot] of longword =
+    ($EEEEEEEE, $AAAAAAAA, $E4E4E4E4, $EAEAEAEA);
 
 procedure TFPPixelCanvas.DoLine (x1,y1,x2,y2:integer);
 
@@ -206,7 +263,7 @@ procedure TFPPixelCanvas.DoLine (x1,y1,x2,y2:integer);
   begin
     if Clipping then
       CheckLineClipping (ClipRect, xx1,yy1, xx2,yy2);
-    DrawSolidLine (self, xx1,yy1, xx2,yy2);
+    DrawSolidLine (self, xx1,yy1, xx2,yy2, pen.color);
   end;
 
   procedure SolidThickLine;
@@ -242,15 +299,15 @@ begin
   case Pen.style of
     psSolid :
       begin
-      DrawSolidLine (self, x1,y1, x2,y2);
+      DrawSolidLine (self, x1,y1, x2,y2, pen.color);
       if pen.width > 1 then
         SolidThickLine;
       end;
-    psPattern: ;
-      // DrawPatternLine (self, x1,y1, x2,y2, pattern);
+    psPattern:
+      DrawPatternLine (self, x1,y1, x2,y2, pen.pattern);
       // Patterned lines have width always at 1
-    psDash, psDot, psDashDot, psDashDotDot : ;
-      //DrawPatternLine (self, x1,y1, x2,y2, PenPattern[Style]);
+    psDash, psDot, psDashDot, psDashDotDot :
+      DrawPatternLine (self, x1,y1, x2,y2, PenPatterns[Pen.Style]);
   end;
 end;