1

I need to add scrolling to a component- TCustomControl - But cannot get it to work correctly.

Problems are

  • -When I click on scrollbar they disappear and never come back unless the map is bigger and can scroll.

  • -It does not seem to be scrolling correctly when I press down/up arrows or left/right arrows.

  • -It does not smooth scroll when dragging the scroll tab.

Here is the full code, ready to install. To test you just have to create button or some trigger to increase the Hexmap.Columns and Hexmap.Rows.

    unit HexMap;
    interface
     uses
        SysUtils,WinTypes,WinProcs,Messages,Classes,IniFiles,vcl.Graphics,vcl.Controls,
        vcl.Menus,vcl.Forms,vcl.StdCtrls,vcl.ExtCtrls,System.Types;

    type TPointType = (ptRowCol,ptXY); {used in the convertcoords function}  

    type
      THexMap = Class(TCustomControl)
        private
          FHexColumns:Integer;    { Number of columns in the map }
          FHexRows   :Integer;    { Number of rows in the map    }
          FHexRadius :Integer;    { The radius of one hexagon    }
          Rise       :Integer;    
          FHexShowLabels:Boolean; 
          FHex3d     :Boolean;   
          FHexColor  :TColor;    
          FLineColor :TColor;     
          FBackColor :TColor;     
          FHexMapName:String;    
          FTStarting :Integer;   
          TempMap    :TBitMap;    {used as a drawing surface, before sending to control}
          FOffset    :TPoint;     // X = Horizontal scrollbar position. Y = Vertical scrollbar position.

         //scrollbars
          procedure WMVScroll(var msg: TWMSCROLL); message WM_VSCROLL;
          procedure WMHScroll(var msg: TWMSCROLL); message WM_HSCROLL;
          procedure WMGetDlgCode(var msg: TWMGetDlgCode); message WM_GETDLGCODE;
          procedure HandleScrollbar(var msg: TWMSCROLL; bar: Integer);
         //end

          function ClientToMap(X : integer; Y : integer) : TPoint; overload;
          function ClientToMap(Pt : TPoint) : TPoint; overload;
          function MapToClient(Pt : TPoint) : TPoint;
          Function FindRange(Bpoint:TPoint;EPoint:TPoint):Integer;
          procedure SetHexColumns(value :Integer);
          procedure SetHexRows(Value : Integer);
          procedure SetHexRadius(Value : Integer);
          procedure SetHexShowLabels(Value :Boolean);
          Procedure SetHex3d(Value : Boolean);
          Procedure SetHexColor(Value : TColor);
          Procedure SetLineColor(Value : TColor);
          Procedure SetBackColor(Value : TColor);
          Procedure SetTotalStartingLocations(Value : Integer);
          procedure MakeSolidMap;

          procedure DrawSolidHex(Target:TCanvas;         {Canvas to draw hex on   }
                                 FillStyle : TBrushStyle;{How to fill hex         }
                                 FillColor : TColor;     {What color to fill hex  }
                                 LineStyle : TPenStyle;  {What kind of lines      }
                                 LineColor : TColor;     {What Color for lines    }
                                 x,y,Radius: Integer;    {Position and size of hex}
                                 button    : boolean);   {Hex looks like button?  }

          procedure DrawSolidHexImage(Target:TCanvas;         {Canvas to draw hex on   }
                                 FillStyle : TBrushStyle;{How to fill hex         }
                                 FillColor : TColor;     {What color to fill hex  }
                                 FillImage : vcl.Graphics.TBitMap;     {What image to fill hex  }
                                 LineStyle : TPenStyle;  {What kind of lines      }
                                 LineColor : TColor;     {What Color for lines    }
                                 x,y,Radius: Integer;    {Position and size of hex}
                                 button    : boolean);   {Hex looks like button?  }


          procedure DrawhexOutline(Target:TCanvas;
                                   Linestyle : TPenStyle;{What kind of line       }
                                   LineColor : TColor;   {What color for lines    }
                                   x,y,radius: integer;  {Position and size       }
                                   button    : boolean); {Hex looks like button?  }

        Protected
          {scroll bars}
           procedure CreateParams(var params: TCreateParams); override;
           procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
           {end}
          function ConvertCoords(point:TPoint;pointType:TPointType):TPoint;

        Public
          constructor Create(AOwner: TComponent); Override;
          destructor destroy; OverRide;
          Function RangeInHexes(BPoint,EPoint :TPoint) :Integer;
          procedure PaintAHex(HexColorWanted :TColor; HexPatternWanted: TBrushStyle; MapLocation: System.Types.TPoint);
          Procedure ImageAHex(ImageWanted:vcl.Graphics.TBitMap;HexPatternWanted:TBrushStyle;MapLocation:System.Types.Tpoint);
          Procedure StartPosition(Text :string; Position:TPoint);
          procedure SaveHexMap(Name : string);
          procedure LoadHexMap(Name : string);
          Procedure WndProc(var Message: TMessage); override;
          function XYtoRowCol(pt : TPoint) : TPoint;

        Published
          property HexColumns: Integer read FHexColumns write SetHexColumns;
          property HexRows: Integer read FHexRows write SetHexRows;
          Property HexRadius: Integer read FHexRadius write SetHexRadius;
          property HexShowLabels: Boolean read FHexShowLabels Write SetHexShowLabels;
          property Hex3d: Boolean read FHex3d write SetHex3d;
          Property HexColor : TColor read FHexColor write SetHexColor;
          Property LineColor : TColor read FLineColor write SetLineColor;
          Property BackColor : TColor read FBackColor write SetBackColor;
          Property StartingLocations : Integer read FTStarting write SetTotalStartingLocations;

          {inherited properties}
          property Align;
          property Visible;
          property Enabled;
          property font;
          property DragCursor;
          property DragMode;
          property OnDragDrop;
          property OnDragOver;
          property OnEndDrag;
          property OnMouseDown;
          property OnMouseMove;
          property onMouseUp;
          property OnClick;
          property OnDblClick;
          property PopupMenu;
      End;


      Procedure Register;

      implementation

    uses
      Windows;
    const
      DEFAULT_MAP_WIDTH   = 300;
      DEFAULT_MAP_HEIGHT  = 250;

  {create scroll bars}
      procedure Thexmap.CreateParams(var params: TCreateParams);
    begin
      inherited;
      params.Style := params.Style or WS_VSCROLL or WS_HSCROLL;
    end;

    procedure THexMap.HandleScrollbar(var msg: TWMSCROLL; bar: Integer);
    var
      si: TScrollInfo;
      MaxOffset : TPoint;
    begin
      msg.result := 0;
      si.cbSize := Sizeof(TscrollInfo);
      si.fMask := SIF_ALL;
      GetScrollInfo(Handle, bar, si);

      if TempMap.Width > ClientWidth then
         MaxOffset.X := TempMap.Width - ClientWidth
      else
         MaxOffset.X := 0;

      if TempMap.Height > ClientHeight then
         MaxOffset.Y := TempMap.Height - ClientHeight
      else
         MaxOffset.Y := 0;

      if FOffset.X < 0 then
         FOffset.X := 0
      else
        if FOffset.X > MaxOffset.X then
           FOffset.X := MaxOffset.X;

      if FOffset.Y < 0 then
        FOffset.Y := 0
      else
        if FOffset.Y > MaxOffset.Y  then
          FOffset.Y := MaxOffset.Y;

      Refresh;


      if bar = SB_HORZ then
      begin
        si.nPos := FOffset.X;
        si.nMin := 0;
        si.nMax := MaxOffset.X;
      end
      else
      begin
        si.nPos := FOffset.Y;
        si.nMin := 0;
        si.nMax := MaxOffset.Y;
      end;
      if si.nPos < si.nMin then
        si.nPos := si.nMin;
      if si.nPos > si.nMax then
        si.nPos := si.nMax;
      SetScrollInfo(Handle, bar, si, true);
    end;

    procedure THexmap.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    begin
      inherited;
      if (Button = mbLeft) and CanFocus and not Focused then
        SetFocus;
    end;

    procedure Thexmap.WMGetDlgCode(var msg: TWMGetDlgCode);
    begin
      msg.result := DLGC_WANTARROWS;
    end;

    procedure Thexmap.WMHScroll(var msg: TWMSCROLL);
    begin
      case msg.ScrollCode of
        SB_LEFT           : FOffset.X := 0;
        SB_PAGELEFT       : FOffset.X := FOffset.X - ClientHeight;
        SB_LINELEFT       : FOffset.X := FOffset.X - FHexRadius;
        SB_LINERIGHT      : FOffset.X := FOffset.X + FHexRadius;
        SB_PAGERIGHT      : FOffset.X := FOffset.X + ClientHeight;
        SB_RIGHT          : FOffset.X := MAXINT;
        SB_THUMBTRACK     : FOffset.X := MAXINT;
        SB_THUMBPOSITION  : FOffset.X := MAXINT;
        SB_ENDSCROLL      : Exit;
      end;
      HandleScrollbar(msg, SB_HORZ);
    end;

    procedure Thexmap.WMVScroll(var msg: TWMSCROLL);
    begin
      case msg.ScrollCode of
        SB_TOP            : FOffset.Y := 0;
        SB_PAGEUP         : FOffset.Y := FOffset.Y - ClientHeight;
        SB_LINEUP         : FOffset.Y := FOffset.Y - FHexRadius;
        SB_LINEDOWN       : FOffset.Y := FOffset.Y + FHexRadius;
        SB_PAGEDOWN       : FOffset.Y := FOffset.Y + ClientHeight;
        SB_BOTTOM         : FOffset.Y := MAXINT;
        SB_THUMBTRACK     :           FOffset.Y := MAXINT;
        SB_THUMBPOSITION  : FOffset.Y := MAXINT;
        SB_ENDSCROLL      : Exit;
      end;
      HandleScrollbar(msg, SB_VERT);
    end;  
    {end scroll bars..}


    Constructor THexMap.Create(AOwner: Tcomponent);
        begin
          inherited Create(AOwner);

          Width  := DEFAULT_MAP_WIDTH;
          Height := DEFAULT_MAP_HEIGHT;

          tempMap := vcl.Graphics.TBitMap.Create;  {prepare the offscreen temp map};

          { Set intial property values for component }
          FHexColumns := 8;
          FHexRows := 5;
          FHexRadius := 30;
          FHex3d := True;
          FHexColor := clGray;
          FBackColor := clTeal;
          FLineColor := clBlack;
          FHexMapName := 'Default';

          rise := round(sqrt(sqr(FHexRadius)-sqr(FHexRadius/2)));

          FOffset := point(0,0);

          //create map
          MakeSolidMap;


        end;



    destructor ThexMap.Destroy;
    begin
      TempMap.Free;
      inherited Destroy;
    end;



    Procedure THexMap.MakeSolidMap;
    var
    p0 : TPoint;
    looprow,Loopcol : integer;
    begin
          TempMap.width := ((HexColumns-1) * round((1.5 * HexRadius))) + (2 * hexRadius);
          TempMap.height := ((HexRows) * (2 * rise)) + rise;

          With TempMap.Canvas do
          begin
            {set Background color}
            brush.Color := BackColor;
            fillrect(rect(0,0,TempMap.Width,TempMap.Height));

            {draw Hex's left to right / top to bottom}
            for looprow  := 1 to HexRows do
              begin
                for loopcol := 1 to HexColumns do
                  begin
                    {compute center coords}
                    p0 := ConvertCoords(Point(LoopCol,LoopRow),ptROWCOL);

                    {draw the hex}
                    DrawSolidHex(TempMap.Canvas,bsSolid,hexColor,psSolid,LineColor,P0.X,p0.Y,hexRadius,hex3d);

                  end;
              end;
          end;
    end;


    function THexMap.MapToClient(Pt: TPoint): TPoint;
    begin
      Result.X := pt.X - FOffset.X;
      Result.Y := pt.Y - FOffset.Y;
    end;


    procedure THexMap.PaintAHex(HexColorWanted: TColor; HexPatternWanted: TBrushStyle; MapLocation: System.Types.TPoint);
    var
    p0:Tpoint;
    begin
     with TempMap.canvas do
     p0 := convertcoords(Point(MapLocation.X,MapLocation.Y),ptROWCOL);
     drawsolidhex(tempmap.Canvas,HexPatternWanted,HexColorWanted,psSolid,LineColor,p0.X,p0.Y,Hexradius,hex3d);
     MakeSolidMap;
     Invalidate;
    end;


    Procedure THexMap.ImageAHex(ImageWanted: vcl.Graphics.TBitmap; HexPatternWanted: TBrushStyle; MapLocation: System.Types.TPoint);
    var
     p0 :Tpoint;
    begin
      with TempMap.Canvas do
      p0:= convertcoords(point(MapLocation.X,MapLocation.Y),ptROWCOL);
      drawSolidHexImage(tempmap.Canvas,HexPatternWanted,StringToColor('clGray'),ImageWanted,psSolid,LineColor,p0.X,p0.Y,hexradius,hex3d);
    end;



    procedure THexMap.DrawSolidHex(Target: TCanvas;
                                  FillStyle: TBrushStyle;
                                  FillColor: TColor;
                                  LineStyle: TPenStyle;
                                  LineColor: TColor;
                                  x,y,Radius:Integer;
                                  button: Boolean);
    var
      p0,p1,p2,p3,p4,p5,p6:TPoint;
    begin
       p0 := Point(x,y);

       {compute each point based on hex center}
       p1.X := p0.X - round(Radius /2);
       p1.Y := p0.Y - rise;
       p2.X := p0.X + round(Radius/2);
       p2.Y := p1.Y;
       p3.X := p0.X + Radius;
       p3.Y := p0.Y;
       p4.X := p2.X;
       p4.Y := p0.Y + rise;
       p5.X := p1.X;
       p5.Y := p4.Y;
       p6.X := p0.X - Radius;
       p6.Y := p0.Y;

       {set color / style of lines}
       target.Pen.Color := LineColor;
       target.Pen.Style := LineStyle;

       {set color / style of hex}
       target.Brush.Color := FillColor;
       Target.Brush.Style := FillStyle;

       {draw the hex}
       target.Polygon([p1,p2,p3,p4,p5,p6]);

       {if desired, draw the boarder for the hex}
       if button = true then
       begin
         with target do
         begin
           pen.Mode :=pmCopy;
           pen.Color :=clWhite;
           moveto(p5.X+1,p5.Y-1);
           lineto(p6.X+1,p6.Y);
           lineto(p1.X+1,p1.Y+1);
           lineto(p2.X-1,p2.Y+1);
           pen.Color :=clBlack;
           lineto(p3.X-1,p3.Y);
           lineto(p4.X-1,p4.Y-1);
           lineto(p5.X+1,p5.Y-1);
         end;
       end;
    end;


    procedure THexMap.DrawSolidHexImage(Target: TCanvas;
                                  FillStyle: TBrushStyle;
                                  FillColor: TCOlor;
                                  FillImage: vcl.Graphics.TBitMap;
                                  LineStyle: TPenStyle;
                                  LineColor: TColor;
                                  x,y,Radius:Integer;
                                  button: Boolean);
    var
      HexCentre,p1,p2,p3,p4,p5,p6:TPoint;
      HexCorners : array [1..6] of TPoint;
      HexRgn : HRGN;
      R : TRect;
    begin
       HexCentre := Point(x,y);

       {compute each point based on hex center}
       HexCorners[1].X := HexCentre.X - round(Radius /2);
       HexCorners[1].Y := HexCentre.Y - rise;
       HexCorners[2].X := HexCentre.X + round(Radius/2);
       HexCorners[2].Y := HexCorners[1].Y;
       HexCorners[3].X := HexCentre.X + Radius;
       HexCorners[3].Y := HexCentre.Y;
       HexCorners[4].X := HexCorners[2].X;
       HexCorners[4].Y := HexCentre.Y + rise;
       HexCorners[5].X := HexCorners[1].X;
       HexCorners[5].Y := HexCorners[4].Y;
       HexCorners[6].X := HexCentre.X - Radius;
       HexCorners[6].Y := HexCentre.Y;

       {set color / style of lines}
       target.Pen.Color := LineColor;
       target.pen.Style := LineStyle;

       {set color / style of hex}
       target.Brush.Color := FillColor;
       Target.Brush.Style := FillStyle;
       Target.Brush.Bitmap:= FillImage;

       {draw the hex}
       target.Polygon(HexCorners);

       {if desired, draw the boarder for the hex}
       if button = true then
       begin
         with target do
         begin
           pen.Mode :=pmCopy;
           pen.Color :=clWhite;
           moveto(HexCorners[5].X+1,HexCorners[5].Y-1);
           lineto(HexCorners[6].X+1,HexCorners[6].Y);
           lineto(HexCorners[1].X+1,HexCorners[1].Y+1);
           lineto(HexCorners[2].X-1,HexCorners[2].Y+1);
           pen.Color :=clBlack;
           lineto(HexCorners[3].X-1,HexCorners[3].Y);
           lineto(HexCorners[4].X-1,HexCorners[4].Y-1);
           lineto(HexCorners[5].X+1,HexCorners[5].Y-1);
         end;
       end;

      CreatePolygonRgn(HexCorners,6,WINDING);
      try
        R.Left   := HexCorners[6].X;
        R.Top    := HexCorners[1].Y;
        R.Right  := HexCorners[3].X;
        R.Bottom := HexCorners[4].Y;
        InvalidateRect(self.Handle, R, FALSE);
      finally
        DeleteObject(HexRgn);
      end;

      Refresh;
    end;


     procedure THexMap.DrawhexOutline(Target: TCanvas;
                                      Linestyle: TPenStyle;
                                      LineColor: TColor;
                                      x,y,radius: Integer;
                                      button: Boolean);
    var
      p0,p1,p2,p3,p4,p5,p6:TPoint;
    begin
       p0 := Point(x,y);

       {compute each point based on hex center}
       p1.X := p0.X - round(Radius /2);
       p1.Y := p0.Y - rise;
       p2.X := p0.X + round(Radius/2);
       p2.Y := p1.Y;
       p3.X := p0.X + Radius;
       p3.Y := p0.Y;
       p4.X := p2.X;
       p4.Y := p0.Y + rise;
       p5.X := p1.X;
       p5.Y := p4.Y;
       p6.X := p0.X - Radius;
       p6.Y := p0.Y;

       {Set Color / Style of lines}
       Target.Pen.Color := lineColor;
       Target.Pen.Style := LineStyle;

       {Draw the hex}
       Target.Polyline([p1,p2,p3,p4,p5,p6]);

       {If Desired, draw the boarders for the hex}
       if button = true then
       begin
         with target do
         begin
           pen.Mode :=pmCopy;
           pen.Color :=clWhite;
           moveto(p5.X+1,p5.Y-1);
           lineto(p6.X+1,p6.Y);
           lineto(p1.X+1,p1.Y+1);
           lineto(p2.X-1,p2.Y+1);
           pen.Color :=clBlack;
           lineto(p3.X-1,p3.Y);
           lineto(p4.X-1,p4.Y-1);
           lineto(p5.X+1,p5.Y-1);
         end;
       end;
     end;


     procedure THexMap.SaveHexMap(Name: string);
     begin
      //unknown GM
     end;


     procedure THexMap.LoadHexMap(Name: string);
     begin
      //unknown  GM
     end;


     procedure THexMap.StartPosition(Text: string; Position: TPoint);
     var
      HexText : string;
      p0 : TPoint;
     begin
         With TempMap.Canvas do
         begin
           HexText := Text;
           p0 := Convertcoords(Point(Position.X,Position.Y),ptROWCOL);
           TextOut(p0.X - (Trunc(TextWidth(HexText) / 2)), p0.Y - (TextHeight(HexText)), HexText);
         end;
         Invalidate;
     end;


    procedure THexMap.WndProc(var Message: TMessage);
    const
      DISCARD_CURRENT_ORIGIN = nil;
    var
      R : TRect;
      PS : PAINTSTRUCT;
    begin
      if Message.Msg = WM_PAINT then
      begin
        if GetUpdateRect( Handle, nil, false ) then
        begin
          BeginPaint( Handle, PS );
          try
            R := PS.rcPaint;
            bitblt(Canvas.Handle, R.Left, R.Top, R.Width, R.Height, TempMap.Canvas.Handle, R.Left+FOffset.X, R.Top+FOffset.Y, SRCCOPY);
          finally
            EndPaint( Handle, PS );
          end;
        end
        else
          inherited;
      end
      else
        inherited;
    end;


    function THexMap.XYtoRowCol(pt: TPoint): TPoint;  
    begin
      Result := self.ConvertCoords(ClienttoMap(Pt),ptXY)
    end;


    Function THexMap.FindRange(Bpoint: TPoint; EPoint: TPoint) : Integer;
    var
      Delta : TPoint;
    begin
      Delta.X := abs(EPoint.X - BPoint.X);
      Delta.Y := abs(EPoint.Y - BPoint.Y);
      if Delta.Y > (Delta.X div 2) then
        Result := Delta.X + (Delta.Y - (Delta.X div 2))
      else
        Result := Delta.X;
    end;


    function THexMap.ClientToMap(X, Y: integer): TPoint; 
    begin
      Result.X := X + FOffset.X;
      Result.Y := Y + FOffset.Y;
    end;


    function THexMap.ClientToMap(Pt: TPoint): TPoint;
    begin
      Result := ClientToMap(Pt.X,Pt.Y);
    end;


    function THexMap.ConvertCoords(point: TPoint; pointType: TPointType):Tpoint;
    var
      temp :TPoint;
    begin
     case pointtype of
       ptXY: {Convert from x/y to Row/col}
       begin
         temp.X := round( (point.X + (HexRadius/2) ) / (1.5 * HexRadius));

         if odd(Temp.X) then
            temp.Y := round ( (point.Y + rise) / (rise*2))
         else
            temp.Y := round (point.Y / (2*rise));

         {Ensure row / col is good}
         if (temp.X <1) or (temp.Y < 1) then
            begin
              temp.X :=0;
              temp.Y :=0;
            end
         else if (temp.Y > HexRows) or (Temp.X > hexColumns) then
              begin
                temp.X :=0;
                temp.Y :=0;
              end;
         ConvertCoords := temp;
       end;


       ptRowCol: {converts Row/Col to X/Y}
       begin
         if point.X=1 then
            temp.X:= hexRadius
         else
            temp.X := hexRadius+(point.X-1) * (Round(1.5 * Hexradius));

         if odd(Point.X) then
            if point.y =1 then
              temp.Y:=rise
            else
              temp.Y := rise+(point.Y-1) * (2*rise)
            else
              temp.Y := (point.Y * (2*rise));

         ConvertCoords := Temp;
       end;
     end;
    end;


    function THexMap.RangeInHexes(BPoint: TPoint; EPoint: TPoint):Integer;
    var
      dx, tdx, tempdx: integer;
      dy: integer;
      dist: integer;
    begin
    {if its in the same column or row}
    if (Epoint.X-Bpoint.X = 0) or (EPoint.y - BPoint.Y =0) then
      begin
        dx:=Epoint.X-BPoint.X;
        dy:=Epoint.Y-Bpoint.Y;
        dist:=abs(dx)+abs(dy);
      end
    else
    begin {not in same row or column}
      dist:=findrangeD(Bpoint,Epoint);
    end;

    RangeInHexesD := dist;
    end;


    Procedure THexMap.SetHexcolumns(Value:Integer);
    begin
      if Value <> FHexColumns then
          FHexColumns := Value;
      makesolidMap;
      Invalidate;
    end;

    Procedure THexMap.SetHexRows(Value:Integer);
    begin
      if Value <> FHexRows then
          FHexRows := Value;
      makeSolidMap;
      Invalidate;
    end;

    procedure THexMap.SetHexRadius(Value:Integer);
    begin
      if Value <> FHexRadius then
      begin
        FHexRadius := Value;
        if Odd(FHexRadius) then
            inc(FHexRadius);  {Even values work better..}

        {Compute new rise}
        rise:=round( Sqrt( Sqr(FHexRadius) - sqr(FHexRadius/2)));
      end;
    MakeSolidMap;
    Invalidate;
    end;

    procedure THexMap.SetHexShowLabels(Value:Boolean);
    begin
      if Value <> FHexShowLabels then
      begin
        FHexShowLabels := Value;
        makeSolidMap;
        Invalidate;
      end;
    end;


    procedure THexMap.SetHex3d(Value:Boolean);
    begin
      if Value <> FHex3d then
      begin
        FHex3d := Value;
        makeSolidMap;
        Invalidate;
      end;
    end;


    Procedure THexMap.SetHexColor(Value: TColor);
    begin
      if Value <> FHexColor then
      begin
        FHexColor := Value;
        makeSolidMap;
        Invalidate;
      end;
    end;


    Procedure THexMap.SetLineColor(Value:TColor);
    begin
      if Value <> FLineColor then
      begin
        FLineColor := Value;
        makeSolidMap;
        Invalidate;
      end;
    end;


    Procedure THexMap.SetBackColor(Value:TColor);
    begin
      if Value <> FBackColor then
      begin
        FBackColor := Value;
        makeSolidMap;
        Invalidate;
      end;
    end;


    procedure THexMap.SetTotalStartingLocations(Value: Integer);
    begin
      if Value <> FTStarting then
          FTStarting := value;
    end;

    procedure Register;
    begin
        RegisterComponents('Game',[THexMap]);
    end;
    end.
19
  • "Is there something in this code i am missing?" Yes, the full object definition. We don't know anything about what you're inheriting from. Apr 28, 2014 at 4:21
  • 3
    The TScrollingWinControl class should have all this ready for you. That's what e.g. the TScrollBox or TCustomForm derives from.
    – TLama
    Apr 28, 2014 at 6:27
  • 8
    Well, so now you're standing at a fork. Either you'll derive from TCustomControl which provides you Canvas with no built-in scrolling, or derive your control from TScrollingWinControl with no Canvas but built-in scrolling. I would personally follow the latter. Creating a Canvas property just like TCustomControl does is much easier than implementing scrolling stuff. But that's just my opinion :)
    – TLama
    Apr 28, 2014 at 9:18
  • 1
    I might help but with the way implementing Canvas and a paint method for the TScrollingWinControl class, just like e.g. TCustomForm does, but you've decided to overcomplicate this task by implementing scroll stuff for TCustomControl which is not that easy. TCustomControl itself does the only thing, it introduces Canvas property for TWinControl class. TScrollingWinControl introduces scrolling capability for TWinControl class. That's why I was talking about a fork. Both are extending the same class with something and you need to stick that together...
    – TLama
    May 2, 2014 at 10:20
  • 1
    Anyway, I believe that the decision to derive TForm ancestor from TScrollingWinControl and not from TCustomControl was just because all that scrolling stuff is a bunch of code whilst adding a Canvas property was just a few lines. Finally, even reference for TScrollingWinControl class tells you this: "Use TScrollingWinControl as a base class when defining a custom windowed control that supports scrolling.", which is just your case. But still, it's upon you to decide...
    – TLama
    May 2, 2014 at 10:30

1 Answer 1

2

For smooth scrolling you'd have to do this in WMHScroll/WMVScroll:

SB_THUMBTRACK:
  FOffset.Y := msg.Pos;
SB_THUMBPOSITION:
  FOffset.Y := msg.Pos;

The scrollbar won't automatically update if you just update the number of hexrows or hexcolumns. You'll have to call SetScrollInfo / ShowScrollbar.

You need to show or hide the Scrollbar in HandleScrollbar manually.

ShowScrollBar(Handle, SB_VERT, MaxOffset.Y > 0);
ShowScrollBar(Handle, SB_HORZ, MaxOffset.X > 0);

You should also set ScrollInfo.nPageAmount.

Please take a look at TCategoryButtons in the unit Vcl.CategoryButtons. This is a good example for implementing your own scrollbars. TCategoryButtons derives from TCustomControl. Search for "scroll" in this unit, then you should know what you have to do.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.