MG: gradient fill, minor issues from Andrew

git-svn-id: trunk@3328 -
This commit is contained in:
lazarus 2002-09-12 05:56:15 +00:00
parent 22a70e8c85
commit 11279dd04b
9 changed files with 186 additions and 82 deletions

View File

@ -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;

View File

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

View File

@ -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;
property AutoSize default True;
//property AutoScroll;
//property BiDiMode;
//property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
property Constraints;

View File

@ -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;
//LoadFromXPMFile(FileName);
//Inherited;
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

View File

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

View File

@ -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;

View File

@ -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
AutoCalcRange;
If fControl.AutoScroll then begin
if FAutoRange < 0 then
AutoCalcRange;
if Value > FAutoRange then begin
SetPosition(FAutoRange);
exit;
if Value > FAutoRange then begin
SetPosition(FAutoRange);
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
HorzScrollBar.Range := 0;
VertScrollBar.Range := 0;
end
else begin
if Value then 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;

View File

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

View File

@ -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