MG: gradient fill, minor issues from Andrew

git-svn-id: trunk@3328 -

ide/editoroptions.pp

@@ -4205,7 +4205,7 @@ begin
     Left:=0;
     Width:=MaxX-Left-Left;
     Height:=MaxY-Top;
-    Options:=[tvoAutoExpand, tvoReadOnly, tvoShowButtons, tvoShowRoot,
+    Options:=[tvoReadOnly, tvoShowButtons, tvoShowRoot,
       tvoShowLines, tvoRowSelect, tvoKeepCollapsedNodes, tvoShowSeparators];
     OnMouseUp:=@KeyMappingTreeViewMouseUp;
     Images:=Self.ImageList;

ide/keymapping.pp

@@ -319,31 +319,25 @@ const
 function StrToVKCode(const s: string): integer;
 var
   i: integer;
+  Data: Pointer;
 begin
   Result:=VK_UNKNOWN;
-  if VirtualKeyStrings=nil then
+  if (length(UnknownVKPrefix)<length(s))
-    VirtualKeyStrings:=TStringHashList.Create(true);
+  and (AnsiStrLComp(PChar(s),PChar(UnknownVKPrefix),length(UnknownVKPrefix))=0)
-  i:=-1; //VirtualKeyStrings(s);
+  then
-  if i>=0 then begin
+    Result:=StrToIntDef(copy(s,7,length(s)-8),VK_UNKNOWN)
-  
+  else if s<>'none' then begin
-  end else begin
+    if VirtualKeyStrings=nil then begin
-    if (length(UnknownVKPrefix)<length(s))
+      VirtualKeyStrings:=TStringHashList.Create(true);
-    and (AnsiStrLComp(PChar(s),PChar(UnknownVKPrefix),length(UnknownVKPrefix))=0)
-    then
-      Result:=StrToIntDef(copy(s,7,length(s)-8),VK_UNKNOWN)
-    else if s<>'none' then begin
       for i:=1 to 300 do
-        if KeyAndShiftStateToStr(i,[])=s then begin
+        VirtualKeyStrings.Add(KeyAndShiftStateToStr(i,[]),Pointer(i));
-          Result:=i;
-          exit;
-        end;
       for i:=VK_IRREGULAR+33 to VK_IRREGULAR+255 do
-        if KeyAndShiftStateToStr(i,[])=s then begin
+        VirtualKeyStrings.Add(KeyAndShiftStateToStr(i,[]),Pointer(i));
-          Result:=i;
-          exit;
-        end;
     end;
   end;
+  Data:=VirtualKeyStrings.Data[s];
+  if Data<>nil then
+    Result:=integer(Data);
 end;
 
 function ShowKeyMappingEditForm(Index:integer;

lcl/forms.pp

@@ -62,16 +62,20 @@ type
     FKind: TScrollBarKind;
 
     FIncrement: TScrollBarInc;
+    FPage: TScrollBarInc;
     FPosition: Integer;
     FRange: Integer;
+    FSmooth : Boolean;
     FVisible: Boolean;
 
     procedure SetPosition(Value: Integer);
     procedure SetRange(Value: Integer);
+    procedure SetSmooth(Value: Boolean);
     procedure SetVisible(Value: Boolean);
   protected
     procedure AutoCalcRange;
     Procedure UpdateScrollBar;
+    procedure ScrollHandler(var Message: TLMScroll);
   public
     constructor Create(AControl: TScrollingWinControl; AKind: TScrollBarKind);
 
@@ -84,9 +88,11 @@ type
     property Kind: TScrollBarKind read FKind;
   published
     property Increment: TScrollBarInc read FIncrement write FIncrement default 8;
+    property Page: TScrollBarInc read FPage write FPage default 80;
+    property Smooth : Boolean read FSmooth write SetSmooth;// default True
     property Position: Integer read FPosition write SetPosition default 0;
     property Range: Integer read FRange write SetRange default 0;
-    property Visible: Boolean read FVisible write SetVisible default True;
+    property Visible: Boolean read FVisible write SetVisible;// default True;
   end;
 
   TScrollingWinControl = class(TWinControl)
@@ -94,9 +100,9 @@ type
     FHorzScrollBar : TControlScrollBar;
     FVertScrollBar : TControlScrollBar;
     FAutoScroll    : Boolean;
-    
+
     FOnPaint: TNotifyEvent;
-    
+
     FCanvas : TControlCanvas;
 
     IsUpdating : Boolean;
@@ -108,7 +114,6 @@ type
   Protected
     procedure AlignControls(AControl: TControl; var ARect: TRect); override;
     procedure CreateWnd; override;
-    property AutoScroll: Boolean read FAutoScroll write SetAutoScroll default True;
     Procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND;
     procedure WMPaint(var message: TLMPaint); message LM_PAINT;
     procedure WMSize(var Message: TLMSize); message LM_Size;
@@ -127,20 +132,19 @@ type
 
     property Canvas: TControlCanvas read FCanvas;
   published
+    property AutoScroll: Boolean read FAutoScroll write SetAutoScroll;
     property HorzScrollBar: TControlScrollBar read FHorzScrollBar write SetHorzScrollBar stored StoreScrollBars;
     property VertScrollBar: TControlScrollBar read FVertScrollBar write SetVertScrollBar stored StoreScrollBars;
   end;
 
   TScrollBox = class(TScrollingWinControl)
-  private
-    Procedure DoAutoSize; Override;
   public
     constructor Create(AOwner: TComponent); override;
   published
     property Align;
     property Anchors;
-    property AutoScroll default True;
+    property AutoSize default True;
-    property AutoSize;
+    //property AutoScroll;
     //property BiDiMode;
     //property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
     property Constraints;

lcl/include/bitmap.inc

@@ -27,9 +27,9 @@ begin
   ACanvas.CopyRect(Rect, Self.Canvas, Classes.Rect(0, 0, Width, Height));
 end;
 
-constructor TBitmap.Create;
+constructor TBitmap.VirtualCreate;
 begin
-  inherited Create;
+  inherited VirtualCreate;
   FPixelFormat := pfDevice;
   FCanvas := TBitmapCanvas.Create(Self);
   FImage := TBitmapImage.Create;
@@ -154,8 +154,8 @@ end;
 
 Procedure TBitmap.LoadFromFile(Const Filename : String);
 begin
-  Inherited;
+  //Inherited;
-  //LoadFromXPMFile(FileName);
+  LoadFromXPMFile(FileName);
 end;
 
 Procedure TBitmap.NewImage(NHandle: HBITMAP; NPallette: HPALETTE;
@@ -460,6 +460,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.18  2002/09/12 05:56:15  lazarus
+  MG: gradient fill, minor issues from Andrew
+
   Revision 1.17  2002/09/10 06:49:19  lazarus
   MG: scrollingwincontrol from Andrew
 

lcl/include/graphic.inc

@@ -12,9 +12,15 @@
  *                                                                           *
  *****************************************************************************
 }
+
 constructor TGraphic.Create;
 begin
-  inherited Create;
+  VirtualCreate;
+end;
+
+constructor TGraphic.VirtualCreate;
+begin
+  Inherited Create;
 end;
 
 procedure TGraphic.DefineProperties(Filer: TFiler);

lcl/include/scrollbox.inc

@@ -13,30 +13,8 @@
  *****************************************************************************
 }
 
-Procedure TScrollBox.DoAutoSize;
-begin
-  Inherited DoAutoSize;
-  If AutoSize then begin
-    AutoSizing := True;
-    Height := ClientHeight + 4;
-    AutoSizing := False;
-  end;
-end;
-
 constructor TScrollBox.Create(AOwner: TComponent);
 begin
   Inherited Create(AOwner);
   fCompStyle:= csScrollBox;
-  AutoSize := False;
-  AutoScroll := True;
-  ControlStyle := [csAcceptsControls, csClickEvents, csDoubleClicks];
-  Left := 0;
-  Top := 0;
-  Width := 200;
-  Height := 200;
-  Visible := True;
-  ParentColor := False;
-  ParentFont := False;
-  Ctl3D := True;
-  Color := clWhite;
 end;

lcl/include/scrollingwincontrol.inc

@@ -23,7 +23,7 @@ procedure TControlScrollBar.SetPosition(Value: Integer);
     FPosition := Value;
     FControl.ScrollBy(0, Tmp - FPosition);
     if GetScrollPos(FControl.Handle, SB_VERT) <> FPosition then
-      SetScrollPos(FControl.Handle, SB_VERT, FPosition, True);
+      SetScrollPos(FControl.Handle, SB_VERT, FPosition, Visible);
   end;
 
   Procedure SetHPosition;
@@ -34,7 +34,7 @@ procedure TControlScrollBar.SetPosition(Value: Integer);
     FPosition := Value;
     FControl.ScrollBy(Tmp - FPosition, 0);
     if GetScrollPos(FControl.Handle, SB_HORZ) <> FPosition then
-      SetScrollPos(FControl.Handle, SB_HORZ, FPosition, True);
+      SetScrollPos(FControl.Handle, SB_HORZ, FPosition, Visible);
   end;
 
 begin
@@ -43,18 +43,21 @@ begin
     exit;
   end;
 
-  if FAutoRange < 0 then
+  If fControl.AutoScroll then begin
-    AutoCalcRange;
+    if FAutoRange < 0 then
+      AutoCalcRange;
 
-  if Value > FAutoRange then begin
+    if Value > FAutoRange then begin
-    SetPosition(FAutoRange);
+      SetPosition(FAutoRange);
-    exit;
+      exit;
+    end;
   end;
 
   if Kind = sbVertical then
     SetVPosition
   else
     SetHPosition;
+  FControl.UpdateScrollBars;
 end;
 
 procedure TControlScrollBar.SetRange(Value: Integer);
@@ -63,7 +66,6 @@ begin
     Range := 0;
     exit;
   end;
-  FControl.FAutoScroll := False;
   FRange := Value;
   FControl.UpdateScrollBars;
 end;
@@ -74,6 +76,12 @@ begin
   FControl.UpdateScrollBars;
 end;
 
+procedure TControlScrollBar.SetSmooth(Value: Boolean);
+begin
+  FSmooth := Value;
+  FControl.UpdateScrollBars;
+end;
+
 procedure TControlScrollBar.AutoCalcRange;
 
   procedure AutoCalcVRange;
@@ -112,11 +120,12 @@ procedure TControlScrollBar.AutoCalcRange;
 
 begin
   if FControl.FAutoScroll then begin
+    FVisible := True;
     if Kind = sbVertical then
       AutoCalcVRange
     else
       AutoCalcHRange;
-    FControl.FAutoScroll := True;
+    FControl.UpdateScrollBars;
   end;
 end;
 
@@ -127,7 +136,8 @@ var
   procedure UpdateVScroll;
   begin
     With FControl do begin
-      ScrollInfo.nPage := ClientHeight + 1;
+      Page := ClientHeight + 1;
+      ScrollInfo.nPage := Page;
 
       if Visible then begin
         FAutoRange := (Range - ClientHeight)*Shortint(Range >= ClientHeight);
@@ -135,15 +145,22 @@ var
       end
       else
         ScrollInfo.nMax := 0;
-      SetScrollInfo(Handle, SB_VERT, ScrollInfo, FVisible or
+
-        (FAutoScroll and (ScrollInfo.nMax > 0) and (ScrollInfo.nMax > Height)));
+      If (Self.Visible and not FAutoScroll) or (FAutoScroll and (ScrollInfo.nMax > 0) and
+        (ScrollInfo.nMax > Height))
+      then
+        Self.FVisible := True
+      else
+        Self.FVisible := False;
+      SetScrollInfo(Handle, SB_VERT, ScrollInfo, Self.Visible);
     end;
   end;
 
   procedure UpdateHScroll;
   begin
     With FControl do begin
-      ScrollInfo.nPage := ClientWidth + 1;
+      Page := ClientWidth + 1;
+      ScrollInfo.nPage := Page;
 
       if Visible then begin
         FAutoRange := (Range - ClientWidth)*Shortint(Range >= ClientWidth);
@@ -151,8 +168,14 @@ var
       end
       else
         ScrollInfo.nMax := 0;
-      SetScrollInfo(Handle, SB_HORZ, ScrollInfo, FVisible or
+
-        (FAutoScroll and (ScrollInfo.nMax > 0) and (ScrollInfo.nMax > Width)));
+      If (Self.Visible and not FAutoScroll) or (FAutoScroll and (ScrollInfo.nMax > 0) and
+        (ScrollInfo.nMax > Width))
+      then
+        Self.FVisible := True
+      else
+        Self.FVisible := False;
+      SetScrollInfo(Handle, SB_HORZ, ScrollInfo, Self.Visible);
     end;
   end;
 
@@ -170,7 +193,44 @@ begin
   else
     UpdateHScroll;
 
-  SetPosition(FPosition);
+  SetPosition(ScrollInfo.nTrackPos);
+
+  //I am not positive that this is right
+  //but it apeared to be when I compared
+  //results to Delphi 4
+  if Smooth then
+    Increment := Page div 10;
+end;
+
+procedure TControlScrollBar.ScrollHandler(var Message: TLMScroll);
+var
+  NewPos: Longint;
+begin
+  If (csDesigning in FControl.ComponentState) then
+    exit;//prevent wierdness in IDE.
+  with Message do
+  begin
+    NewPos := FPosition;
+    case TScrollCode(ScrollCode) of
+      scLineUp:
+        Dec(NewPos, FIncrement);
+      scLineDown:
+        Inc(NewPos, FIncrement);
+      scPageUp:
+        Dec(NewPos, FPage);
+      scPageDown:
+        Inc(NewPos, FPage);
+      scPosition, scTrack:
+        NewPos := Pos;
+      scTop:
+        NewPos := 0;
+      scBottom:
+        NewPos := Range;
+    end;
+    if NewPos < 0 then NewPos := 0;
+    if NewPos > Range then NewPos := Range;
+    SetPosition(NewPos);
+  end;
 end;
 
 constructor TControlScrollBar.Create(AControl: TScrollingWinControl; AKind: TScrollBarKind);
@@ -178,6 +238,12 @@ begin
   Inherited Create;
   FControl := AControl;
   FKind := AKind;
+  FPage := 80;
+  FIncrement := 8;
+  FPosition := 0;
+  FRange := 0;
+  //FSmooth := True;
+  //FVisible := True;
 end;
 
 procedure TControlScrollBar.Assign(Source: TPersistent);
@@ -197,7 +263,7 @@ end;
 function TControlScrollBar.IsScrollBarVisible: Boolean;
 begin
   Result := (FControl <> nil) and FControl.HandleAllocated and
-            (FControl.Visible) and FVisible;
+            (FControl.Visible) and (Self.Visible);
 end;
 
 function TControlScrollBar.ScrollPos: Integer;
@@ -210,14 +276,11 @@ begin
   if FAutoScroll <> Value then
   begin
     FAutoScroll := Value;
-    if not Value then begin
+    if Value then begin
-      HorzScrollBar.Range := 0;
-      VertScrollBar.Range := 0;
-    end
-    else begin
       HorzScrollBar.AutoCalcRange;
       VertScrollBar.AutoCalcRange;
     end;
+    UpdateScrollBars;
   end;
 end;
 
@@ -231,12 +294,15 @@ procedure TScrollingWinControl.AlignControls(AControl: TControl; var ARect: TRec
 begin
   HorzScrollBar.AutoCalcRange;
   VertScrollBar.AutoCalcRange;
+  If not AutoScroll then
+    UpdateScrollBars;
   inherited AlignControls(AControl, ARect);
 end;
 
 Procedure TScrollingWinControl.WMEraseBkgnd(var Message: TLMEraseBkgnd);
 begin
-  with Message do
+  with Message do begin
+    FCanvas.Lock;
     try
       FCanvas.Handle := DC;
       try
@@ -248,6 +314,7 @@ begin
     finally
       FCanvas.Unlock;
     end;
+  end;
 end;
 
 procedure TScrollingWinControl.WMPaint(var Message: TLMPaint);
@@ -322,23 +389,27 @@ end;
 
 Procedure TScrollingWinControl.WMVScroll(var Message : TLMVScroll);
 begin
-  VertScrollbar.Position := Message.Pos;
+  VertScrollbar.ScrollHandler(Message);
 end;
 
 Procedure TScrollingWinControl.WMHScroll(var Message : TLMHScroll);
 begin
-  HorzScrollbar.Position := Message.Pos;
+  HorzScrollbar.ScrollHandler(Message);
 end;
 
 Constructor TScrollingWinControl.Create(AOwner : TComponent);
 begin
   Inherited Create(AOwner);
+
   FCanvas := TControlCanvas.Create;
   FCanvas.Control := Self;
 
-  FAutoScroll := True;
   FVertScrollbar := TControlScrollBar.Create(Self, sbVertical);
   FHorzScrollbar := TControlScrollBar.Create(Self, sbHorizontal);
+
+  ControlStyle := [csAcceptsControls, csClickEvents, csDoubleClicks];
+
+  SetBounds(0,0, 200, 200);
 end;
 
 Destructor TScrollingWinControl.Destroy;

lcl/lclstrconsts.pas

@@ -39,7 +39,7 @@ uses
 ResourceString
    rsMbYes          = '&Yes';
    rsMbNo           = '&No';
-   rsMbOK           = 'OK';
+   rsMbOK           = '&OK';
    rsMbCancel       = 'Cancel';
    rsMbAbort        = 'Abort';
    rsMbRetry        = '&Retry';

lcl/lcltype.pp

@@ -641,6 +641,13 @@ const
   DIB_RGB_COLORS = 0;     { color table in RGBs  }
   DIB_PAL_COLORS = 1;     { color table in palette indices  }
 
+const
+  { Gradient Fill Modes }
+  GRADIENT_FILL_RECT_H = 0;
+  GRADIENT_FILL_RECT_V = 1;
+  GRADIENT_FILL_TRIANGLE = 2;
+
+
 type
 
   PNMHdr = ^TNMHdr;
@@ -718,6 +725,33 @@ type
   SIZE = tagSIZE;
 
 
+{GradientFill Structures}
+  PTriVertex = ^tagTriVertex;
+  tagTRIVERTEX = packed record
+    x: Longint;
+    y: Longint;
+    Red: Shortint;
+    Green: Shortint;
+    Blue: Shortint;
+    Alpha: Shortint;
+  end;
+  TRIVERTEX = tagTRIVERTEX;
+
+  PGradientTriangle = ^tagGradientTriangle;
+  tagGRADIENTTRIANGLE = packed record
+    Vertex1: Longint;
+    Vertex2: Longint;
+    Vertex3: Longint;
+  end;
+  GRADIENTTRIANGLE = tagGRADIENTTRIANGLE;
+
+  PGradientRect = ^tagGradientRect;
+  tagGRADIENTRECT = packed record
+    UpperLeft: Longint;
+    LowerRight: Longint;
+  end;
+  GRADIENTRECT = tagGRADIENTRECT;
+
 { Bitmap Header Definition }
   PBitmap = ^TagBitmap;
   tagBITMAP = packed record
@@ -1158,6 +1192,17 @@ const
   SM_MOUSEWHEELPRESENT = 75;
   SM_CMETRICS = 76;
 
+//==============================================
+// GetDeviceCaps constants
+//==============================================
+  HORZSIZE      = 4;
+  VERTSIZE      = 6;
+  HORZRES       = 8;
+  VERTRES       = 10;
+  BITSPIXEL     = 12;
+  LOGPIXELSX    = 88;
+  LOGPIXELSY    = 90;
+
 type
 
   TFarProc = Pointer;
@@ -1516,6 +1561,9 @@ end.
 
 {
   $Log$
+  Revision 1.16  2002/09/12 05:56:15  lazarus
+  MG: gradient fill, minor issues from Andrew
+
   Revision 1.15  2002/09/11 15:04:49  lazarus
   MG: added stringhashlist.pas