mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-22 19:59:37 +02:00
MG: gradient fill, minor issues from Andrew
git-svn-id: trunk@3328 -
This commit is contained in:
parent
22a70e8c85
commit
11279dd04b
@ -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;
|
||||
|
@ -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;
|
||||
|
20
lcl/forms.pp
20
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;
|
||||
property AutoSize default True;
|
||||
//property AutoScroll;
|
||||
//property BiDiMode;
|
||||
//property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
|
||||
property Constraints;
|
||||
|
@ -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
|
||||
|
||||
|
@ -12,9 +12,15 @@
|
||||
* *
|
||||
*****************************************************************************
|
||||
}
|
||||
|
||||
constructor TGraphic.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
VirtualCreate;
|
||||
end;
|
||||
|
||||
constructor TGraphic.VirtualCreate;
|
||||
begin
|
||||
Inherited Create;
|
||||
end;
|
||||
|
||||
procedure TGraphic.DefineProperties(Filer: TFiler);
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -39,7 +39,7 @@ uses
|
||||
ResourceString
|
||||
rsMbYes = '&Yes';
|
||||
rsMbNo = '&No';
|
||||
rsMbOK = 'OK';
|
||||
rsMbOK = '&OK';
|
||||
rsMbCancel = 'Cancel';
|
||||
rsMbAbort = 'Abort';
|
||||
rsMbRetry = '&Retry';
|
||||
|
@ -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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user