pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

spktoolbar: Less hints and warnings

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6174 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-02-05 12:05:26 +00:00
parent e6b9f9169d
commit fdee2dddbe
13 changed files with 101 additions and 96 deletions
Download Patch File Download Diff File Expand all files Collapse all files

72
components/spktoolbar/SpkGUITools/SpkGUITools.pas
View File

@ -30,7 +30,7 @@ type
protected protected
class procedure FillGradientRectangle(ACanvas: TCanvas; Rect: T2DIntRect; class procedure FillGradientRectangle(ACanvas: TCanvas; Rect: T2DIntRect;
ColorFrom, ColorTo: TColor; GradientKind: TBackgroundKind); ColorFrom, ColorTo: TColor; GradientKind: TBackgroundKind);
class procedure SaveClipRgn(DC: HDC; var OrgRgnExists: boolean; var OrgRgn: HRGN); class procedure SaveClipRgn(DC: HDC; out OrgRgnExists: boolean; out OrgRgn: HRGN);
class procedure RestoreClipRgn(DC: HDC; OrgRgnExists: boolean; var OrgRgn: HRGN); class procedure RestoreClipRgn(DC: HDC; OrgRgnExists: boolean; var OrgRgn: HRGN);
public public
// *** Lines *** // *** Lines ***
@ -390,7 +390,7 @@ end;
implementation implementation
uses uses
types, LCLIntf, IntfGraphics, Math, Themes; Types, LCLIntf, IntfGraphics, Themes;
{ TSpkGUITools } { TSpkGUITools }
@ -498,8 +498,8 @@ begin
begin begin
SrcLine := SrcImg.GetDataLineStart(y); SrcLine := SrcImg.GetDataLineStart(y);
DstLine := DestImg.GetDataLineStart(y+Offset.y); DstLine := DestImg.GetDataLineStart(y+Offset.y);
SrcPtr := pointer(PtrInt(SrcLine) + 3*SrcRect.Left); SrcPtr := {%H-}pointer({%H-}PtrInt(SrcLine) + SrcRect.Left*3);
DstPtr := pointer(PtrInt(DstLine) + 3*(SrcRect.Left + Offset.x)); DstPtr := {%H-}pointer({%H-}PtrInt(DstLine) + 3*(SrcRect.Left + Offset.x));
for x := SrcRect.Left to SrcRect.Right do for x := SrcRect.Left to SrcRect.Right do
begin begin
{$ifdef EnhancedRecordSupport} {$ifdef EnhancedRecordSupport}
@ -527,8 +527,8 @@ begin
begin begin
SrcLine := SrcImg.GetDataLineStart(y); SrcLine := SrcImg.GetDataLineStart(y);
DstLine := DestImg.GetDataLineStart(y+Offset.y); DstLine := DestImg.GetDataLineStart(y+Offset.y);
SrcPtr := pointer(PtrInt(SrcLine) + 3*SrcRect.Left); SrcPtr := {%H-}pointer({%H-}PtrInt(SrcLine) + 3*SrcRect.Left);
DstPtr := pointer(PtrInt(DstLine) + 3*(SrcRect.Left + Offset.x)); DstPtr := {%H-}pointer({%H-}PtrInt(DstLine) + 3*(SrcRect.Left + Offset.x));
for x := SrcRect.Left to SrcRect.Right do for x := SrcRect.Left to SrcRect.Right do
begin begin
{$ifdef EnhancedRecordSupport} {$ifdef EnhancedRecordSupport}
@ -974,8 +974,8 @@ begin
begin begin
SrcLine := SrcImg.GetDataLineStart(y); SrcLine := SrcImg.GetDataLineStart(y);
DstLine := DestImg.GetDataLineStart(y+Offset.y); DstLine := DestImg.GetDataLineStart(y+Offset.y);
Move(pointer(PtrInt(SrcLine) + 3*ClippedSrcRect.Left)^, Move({%H-}pointer({%H-}PtrInt(SrcLine) + 3*ClippedSrcRect.Left)^,
pointer(PtrInt(DstLine) + 3*(ClippedSrcRect.Left + Offset.x))^, {%H-}pointer({%H-}PtrInt(DstLine) + 3*(ClippedSrcRect.Left + Offset.x))^,
3*ClippedSrcRect.Width); 3*ClippedSrcRect.Width);
end; end;
ABitmap.LoadFromIntfImage(DestImg); ABitmap.LoadFromIntfImage(DestImg);
@ -1081,18 +1081,18 @@ begin
for y := ClippedSrcRect.Top to ClippedSrcRect.Bottom do for y := ClippedSrcRect.Top to ClippedSrcRect.Bottom do
begin begin
SrcLine := SrcImg.GetDataLineStart(y); SrcLine := SrcImg.GetDataLineStart(y);
SrcLine := pointer(PtrInt(SrcLine) + 3 * ClippedSrcRect.left); SrcLine := {%H-}pointer({%H-}PtrInt(SrcLine) + 3 * ClippedSrcRect.left);
MaskLine := MaskImg.GetDataLineStart(y); MaskLine := MaskImg.GetDataLineStart(y);
MaskLine := pointer(PtrInt(MaskLine) + ClippedSrcRect.left); MaskLine := {%H-}pointer({%H-}PtrInt(MaskLine) + ClippedSrcRect.left);
DstLine := DestImg.GetDataLineStart(y+Offset.y); DstLine := DestImg.GetDataLineStart(y+Offset.y);
DstLine := pointer(PtrInt(DstLine) + 3 * (ClippedSrcRect.left + Offset.x)); DstLine := {%H-}pointer({%H-}PtrInt(DstLine) + 3 * (ClippedSrcRect.left + Offset.x));
for i := 0 to ClippedSrcRect.Width - 1 do for i := 0 to ClippedSrcRect.Width - 1 do
begin begin
if PByte(MaskLine)^ < 128 then if PByte(MaskLine)^ < 128 then
Move(SrcLine^, DstLine^, 3); Move(SrcLine^, DstLine^, 3);
SrcLine := pointer(PtrInt(SrcLine)+3); SrcLine := {%H-}pointer({%H-}PtrInt(SrcLine)+3);
DstLine := pointer(PtrInt(DstLine)+3); DstLine := {%H-}pointer({%H-}PtrInt(DstLine)+3);
MaskLine := pointer(PtrInt(MaskLine)+1); MaskLine := {%H-}pointer({%H-}PtrInt(MaskLine)+1);
end; end;
end; end;
ABitmap.LoadFromIntfImage(DestImg); ABitmap.LoadFromIntfImage(DestImg);
@ -1191,22 +1191,22 @@ begin
for y := ClippedSrcRect.top to ClippedSrcRect.bottom do for y := ClippedSrcRect.top to ClippedSrcRect.bottom do
begin begin
SrcLine:=SrcImg.GetDataLineStart(y); SrcLine:=SrcImg.GetDataLineStart(y);
SrcLine:=pointer(PtrInt(SrcLine) + 3 * ClippedSrcRect.left); SrcLine:={%H-}pointer({%H-}PtrInt(SrcLine) + 3 * ClippedSrcRect.left);
MaskLine:=MaskImg.GetDataLineStart(y); MaskLine:=MaskImg.GetDataLineStart(y);
MaskLine:=pointer(PtrInt(MaskLine) + ClippedSrcRect.left); MaskLine:={%H-}pointer({%H-}PtrInt(MaskLine) + ClippedSrcRect.left);
DstLine:=DestImg.GetDataLineStart(y+Offset.y); DstLine:=DestImg.GetDataLineStart(y+Offset.y);
DstLine:=pointer(PtrInt(DstLine) + 3 * (ClippedSrcRect.left + Offset.x)); DstLine:={%H-}pointer({%H-}PtrInt(DstLine) + 3 * (ClippedSrcRect.left + Offset.x));
for i := 0 to ClippedSrcRect.width - 1 do for i := 0 to ClippedSrcRect.width - 1 do
begin begin
if PByte(MaskLine)^<128 then if PByte(MaskLine)^<128 then
Move(SrcLine^, DstLine^, 3); Move(SrcLine^, DstLine^, 3);
SrcLine:=pointer(PtrInt(SrcLine)+3); SrcLine:={%H-}pointer({%H-}PtrInt(SrcLine)+3);
DstLine:=pointer(PtrInt(DstLine)+3); DstLine:={%H-}pointer({%H-}PtrInt(DstLine)+3);
MaskLine:=pointer(PtrInt(MaskLine)+1); MaskLine:={%H-}pointer({%H-}PtrInt(MaskLine)+1);
end; end;
end; end;
ABitmap.LoadFromIntfImage(DestImg); ABitmap.LoadFromIntfImage(DestImg);
@ -1295,8 +1295,8 @@ begin
SrcLine:=SrcImg.GetDataLineStart(y); SrcLine:=SrcImg.GetDataLineStart(y);
DstLine:=DestImg.GetDataLineStart(y+Offset.y); DstLine:=DestImg.GetDataLineStart(y+Offset.y);
Move(pointer(PtrInt(SrcLine) + 3*ClippedSrcRect.left)^, Move({%H-}pointer({%H-}PtrInt(SrcLine) + 3*ClippedSrcRect.left)^,
pointer(PtrInt(DstLine) + 3*(ClippedSrcRect.left + Offset.x))^, {%H-}pointer({%H-}PtrInt(DstLine) + 3*(ClippedSrcRect.left + Offset.x))^,
3*ClippedSrcRect.Width); 3*ClippedSrcRect.Width);
end; end;
ABitmap.LoadFromIntfImage(DestImg); ABitmap.LoadFromIntfImage(DestImg);
@ -1398,8 +1398,8 @@ if Convex then
SrcLine:=SrcImg.GetDataLineStart(y); SrcLine:=SrcImg.GetDataLineStart(y);
DstLine:=DestImg.GetDataLineStart(y+Offset.y); DstLine:=DestImg.GetDataLineStart(y+Offset.y);
SrcPtr:=pointer(PtrInt(SrcLine) + 3*SrcRect.left); SrcPtr:={%H-}pointer({%H-}PtrInt(SrcLine) + 3*SrcRect.left);
DstPtr:=pointer(PtrInt(DstLine) + 3*(SrcRect.left + Offset.x)); DstPtr:={%H-}pointer({%H-}PtrInt(DstLine) + 3*(SrcRect.left + Offset.x));
for x := SrcRect.left to SrcRect.right do for x := SrcRect.left to SrcRect.right do
begin begin
{$IFDEF EnhancedRecordSupport} {$IFDEF EnhancedRecordSupport}
@ -1430,8 +1430,8 @@ else
SrcLine:=SrcImg.GetDataLineStart(y); SrcLine:=SrcImg.GetDataLineStart(y);
DstLine:=DestImg.GetDataLineStart(y+Offset.y); DstLine:=DestImg.GetDataLineStart(y+Offset.y);
SrcPtr:=pointer(PtrInt(SrcLine) + 3*SrcRect.left); SrcPtr:={%H-}pointer({%H-}PtrInt(SrcLine) + 3*SrcRect.left);
DstPtr:=pointer(PtrInt(DstLine) + 3*(SrcRect.left + Offset.x)); DstPtr:={%H-}pointer({%H-}PtrInt(DstLine) + 3*(SrcRect.left + Offset.x));
for x := SrcRect.left to SrcRect.right do for x := SrcRect.left to SrcRect.right do
begin begin
{$IFDEF EnhancedRecordSupport} {$IFDEF EnhancedRecordSupport}
@ -1458,8 +1458,6 @@ class procedure TGUITools.DrawAARoundCorner(ABitmap: TBitmap; Point: T2DIntVecto
var var
CornerRect: T2DIntRect; CornerRect: T2DIntRect;
Center: T2DIntVector; Center: T2DIntVector;
Line: PByte;
Ptr: PByte;
colorR, colorG, colorB: byte; colorR, colorG, colorB: byte;
x, y: integer; x, y: integer;
RadiusDist: double; RadiusDist: double;
@ -1561,8 +1559,6 @@ class procedure TGUITools.DrawAARoundCorner(ABitmap: TBitmap;
var var
CornerRect: T2DIntRect; CornerRect: T2DIntRect;
Center: T2DIntVector; Center: T2DIntVector;
Line: PByte;
Ptr: PByte;
colorR, colorG, colorB: byte; colorR, colorG, colorB: byte;
x, y: integer; x, y: integer;
RadiusDist: double; RadiusDist: double;
@ -1829,6 +1825,7 @@ var
begin begin
with ABitmap.Canvas do with ABitmap.Canvas do
begin begin
Font.Color := TextColor;
s := AText; s := AText;
tw := TextWidth(s); tw := TextWidth(s);
if tw <= x2-x1+1 then if tw <= x2-x1+1 then
@ -1921,7 +1918,7 @@ begin
above in order to fix the "handle leak" of above in order to fix the "handle leak" of
https://sourceforge.net/p/lazarus-ccr/bugs/35/ https://sourceforge.net/p/lazarus-ccr/bugs/35/
Not daring to touch the ImageList.Draw which would have worked as well. } Not daring to touch the ImageList.Draw which would have worked as well. }
{ (*
// avoid exclusive draw. draw with local canvas itself. // avoid exclusive draw. draw with local canvas itself.
//ImageList.Draw(ACanvas, Point.x, Point.y, ImageIndex); //ImageList.Draw(ACanvas, Point.x, Point.y, ImageIndex);
{$IfDef LCLWin32} {$IfDef LCLWin32}
@ -1935,7 +1932,7 @@ begin
ACanvas.Draw(Point.x, Point.y, ImageBitmap); ACanvas.Draw(Point.x, Point.y, ImageBitmap);
ImageBitmap.Free; ImageBitmap.Free;
{$EndIf} {$EndIf}
} *)
RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn); RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
DeleteObject(ClipRgn); DeleteObject(ClipRgn);
end; end;
@ -1944,8 +1941,8 @@ class procedure TGUITools.DrawMarkedText(ACanvas: TCanvas; x, y: integer; const
AMarkPhrase: string; TextColor : TColor; ClipRect: T2DIntRect; CaseSensitive: boolean); AMarkPhrase: string; TextColor : TColor; ClipRect: T2DIntRect; CaseSensitive: boolean);
var var
UseOrgClipRgn: Boolean; UseOrgClipRgn: Boolean;
OrgRgn: HRGN; OrgRgn: HRGN = 0;
ClipRgn: HRGN; ClipRgn: HRGN = 0;
begin begin
// Store the original ClipRgn and set a new one // Store the original ClipRgn and set a new one
SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn); SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
@ -2540,6 +2537,7 @@ var
begin begin
with ACanvas do with ACanvas do
begin begin
Font.Color := TextColor;
s := AText; s := AText;
tw := TextWidth(s); tw := TextWidth(s);
// We draw if the text is changed // We draw if the text is changed
@ -2616,8 +2614,8 @@ begin
DeleteObject(OrgRgn); DeleteObject(OrgRgn);
end; end;
class procedure TGUITools.SaveClipRgn(DC: HDC; var OrgRgnExists: boolean; class procedure TGUITools.SaveClipRgn(DC: HDC; out OrgRgnExists: boolean;
var OrgRgn: HRGN); out OrgRgn: HRGN);
var var
i: integer; i: integer;
begin begin
@ -2842,8 +2840,6 @@ var
UseOrgClipRgn: Boolean; UseOrgClipRgn: Boolean;
OrgRgn: HRGN; OrgRgn: HRGN;
ClipRgn: HRGN; ClipRgn: HRGN;
te: TThemedElementDetails;
Rect: TRect;
begin begin
SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn); SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
ClipRgn := CreateRectRgn(ClipRect.left, ClipRect.Top, ClipRect.Right+1, ClipRect.Bottom+1); ClipRgn := CreateRectRgn(ClipRect.left, ClipRect.Top, ClipRect.Right+1, ClipRect.Bottom+1);

18
components/spktoolbar/SpkGraphTools/SpkGraphTools.pas
View File

@ -161,9 +161,9 @@ begin
c1 := TRgbColor(ColorToRGB(AColor1)); c1 := TRgbColor(ColorToRGB(AColor1));
c2 := TRgbColor(ColorToRGB(AColor2)); c2 := TRgbColor(ColorToRGB(AColor2));
result := rgb( result := rgb(
max(0, min(255, c1.R + c2.R)), max(0, min(255, Integer(c1.R) + c2.R)),
max(0, min(255, c1.G + c2.G)), max(0, min(255, Integer(c1.G) + c2.G)),
max(0, min(255, c1.B + c2.B)) max(0, min(255, Integer(c1.B) + c2.B))
); );
end; end;
@ -174,9 +174,9 @@ begin
c1 := TRgbColor(ColorToRGB(AColor1)); c1 := TRgbColor(ColorToRGB(AColor1));
c2 := TRgbColor(ColorToRGB(AColor2)); c2 := TRgbColor(ColorToRGB(AColor2));
result := rgb( result := rgb(
max(0, min(255, c1.R * c2.R)), max(0, min(255, Integer(c1.R) * c2.R)),
max(0, min(255, c1.G * c2.G)), max(0, min(255, Integer(c1.G) * c2.G)),
max(0, min(255, c1.B * c2.B)) max(0, min(255, Integer(c1.B) * c2.B))
); );
end; end;
@ -186,9 +186,9 @@ var
begin begin
c := TRgbColor(ColorToRGB(AColor)); c := TRgbColor(ColorToRGB(AColor));
result := rgb( result := rgb(
max(0, min(255, c.R * AScalar)), max(0, min(255, AScalar * c.R)),
max(0, min(255, c.G * AScalar)), max(0, min(255, AScalar * c.G)),
max(0, min(255, c.B * AScalar)) max(0, min(255, AScalar * c.B))
); );
end; end;

6
components/spktoolbar/SpkMath/SpkMath.pas
View File

@ -112,7 +112,7 @@ type
function Contains(APoint : T2DIntPoint) : boolean; function Contains(APoint : T2DIntPoint) : boolean;
function Contains(Ax, Ay : Integer) : boolean; function Contains(Ax, Ay : Integer) : boolean;
function IntersectsWith(ARect : T2DIntRect) : boolean; overload; function IntersectsWith(ARect : T2DIntRect) : boolean; overload;
function IntersectsWith(ARect : T2DIntRect; var Intersection : T2DIntRect) : boolean; overload; function IntersectsWith(ARect : T2DIntRect; out Intersection : T2DIntRect) : boolean; overload;
procedure Move(dx, dy : integer); overload; procedure Move(dx, dy : integer); overload;
procedure Move(AVector : T2DIntVector); overload; procedure Move(AVector : T2DIntVector); overload;
function Moved(dx, dy : integer) : T2DIntRect; overload; function Moved(dx, dy : integer) : T2DIntRect; overload;
@ -1192,7 +1192,7 @@ begin
end; end;
function T2DIntRect.IntersectsWith(ARect : T2DIntRect; function T2DIntRect.IntersectsWith(ARect : T2DIntRect;
var Intersection: T2DIntRect): boolean; out Intersection: T2DIntRect): boolean;
var XStart, XWidth, YStart, YWidth : integer; var XStart, XWidth, YStart, YWidth : integer;
@ -1249,7 +1249,7 @@ if self.top<=ARect.top then
//todo: is it possible to call constructor directly like object? //todo: is it possible to call constructor directly like object?
Intersection:=T2DIntRect.create(XStart, YStart, XStart+XWidth-1, YStart+YWidth-1); Intersection:=T2DIntRect.create(XStart, YStart, XStart+XWidth-1, YStart+YWidth-1);
{$else} {$else}
Intersection.create(XStart, YStart, XStart+XWidth-1, YStart+YWidth-1); Intersection.Create(XStart, YStart, XStart+XWidth-1, YStart+YWidth-1);
{$endif} {$endif}
result:=(XWidth>0) and (YWidth>0); result:=(XWidth>0) and (YWidth>0);
end; end;

21
components/spktoolbar/SpkToolbar/SpkToolbar.pas
View File

@ -214,10 +214,9 @@ type
{ The Change of component size } { The Change of component size }
procedure DoOnResize; override; procedure DoOnResize; override;
procedure EraseBackground(DC: HDC); override;
{ Method called when mouse pointer left component region } { Method called when mouse pointer left component region }
procedure MouseLeave; procedure MouseLeave; override;
{ Method called when mouse button is pressed } { Method called when mouse button is pressed }
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
@ -246,16 +245,16 @@ type
{ Method called when the mouse button is pressed { Method called when the mouse button is pressed
and at the same time the mouse pointer is over the region of tabs } and at the same time the mouse pointer is over the region of tabs }
procedure TabMouseDown(Button: TMouseButton; Shift: TShiftState; procedure TabMouseDown(Button: TMouseButton; {%H-}Shift: TShiftState;
X, Y: integer); X, Y: integer);
{ Method called when the mouse will move over the region of tab "handles" } { Method called when the mouse will move over the region of tab "handles" }
procedure TabMouseMove(Shift: TShiftState; X, Y: integer); procedure TabMouseMove({%H-}Shift: TShiftState; X, Y: integer);
{ Method called when one of the mouse buttons is released { Method called when one of the mouse buttons is released
and at the same time the region of tabs was active element of toolbar } and at the same time the region of tabs was active element of toolbar }
procedure TabMouseUp(Button: TMouseButton; Shift: TShiftState; procedure TabMouseUp({%H-}Button: TMouseButton; {%H-}Shift: TShiftState;
X, Y: integer); {%H-}X, {%H-}Y: integer);
// ********************* // *********************
// *** Extra support *** // *** Extra support ***
@ -295,7 +294,7 @@ type
function GetColor: TColor; function GetColor: TColor;
{ Setter for property Color } { Setter for property Color }
procedure SetColor(const Value: TColor); procedure SetColor(Value: TColor);
{ Setter for property TabIndex } { Setter for property TabIndex }
procedure SetTabIndex(const Value: integer); procedure SetTabIndex(const Value: integer);
@ -362,6 +361,8 @@ type
// *** Drawing *** // *** Drawing ***
// *************** // ***************
procedure EraseBackground(DC: HDC); override;
{ Method draws the content of the component } { Method draws the content of the component }
procedure Paint; override; procedure Paint; override;
@ -1081,7 +1082,7 @@ begin
FBufferValid := False; FBufferValid := False;
end; end;
procedure TSpkToolbar.SetColor(const Value: TColor); procedure TSpkToolbar.SetColor(Value: TColor);
begin begin
inherited Color := Value; inherited Color := Value;
SetBufferInvalid; SetBufferInvalid;
@ -1390,7 +1391,7 @@ procedure TSpkToolbar.ValidateBuffer;
procedure DrawTabs; procedure DrawTabs;
var var
i: integer; i: integer;
TabRect: T2DIntRect; // TabRect: T2DIntRect;
CurrentAppearance: TSpkToolbarAppearance; CurrentAppearance: TSpkToolbarAppearance;
FocusedAppearance: TSpkToolbarAppearance; FocusedAppearance: TSpkToolbarAppearance;
@ -1617,7 +1618,7 @@ procedure TSpkToolbar.ValidateBuffer;
delta := 0 else delta := 0 else
delta := 50; delta := 50;
TabRect := FTabRects[i]; //TabRect := FTabRects[i];
// Tab is drawn // Tab is drawn
if i = FTabIndex then // active tab if i = FTabIndex then // active tab

4
components/spktoolbar/SpkToolbar/spkt_Appearance.pas
View File

@ -17,7 +17,7 @@ interface
uses uses
Graphics, Classes, Forms, SysUtils, Graphics, Classes, Forms, SysUtils,
SpkGUITools, SpkXMLParser, SpkXMLTools, SpkGUITools, SpkXMLParser, SpkXMLTools,
spkt_Dispatch, spkt_Exceptions, spkt_Const; spkt_Dispatch, spkt_Exceptions;
type type
TSpkPaneStyle = ( TSpkPaneStyle = (
@ -1605,7 +1605,7 @@ end;
procedure SetDefaultFont(AFont: TFont); procedure SetDefaultFont(AFont: TFont);
begin begin
// AFont.Assign(Screen.MenuFont); //AFont.Assign(Screen.MenuFont); // wp: why is this harmful?
end; end;
end. end.

12
components/spktoolbar/SpkToolbar/spkt_Buttons.pas
View File

@ -19,7 +19,7 @@ uses
Graphics, Classes, Types, Controls, Menus, ActnList, Math, Graphics, Classes, Types, Controls, Menus, ActnList, Math,
Dialogs, ImgList, Forms, Dialogs, ImgList, Forms,
SpkGUITools, SpkGraphTools, SpkMath, SpkGUITools, SpkGraphTools, SpkMath,
spkt_Const, spkt_BaseItem, spkt_Exceptions, spkt_Tools; spkt_Const, spkt_BaseItem, spkt_Tools;
type type
TSpkMouseButtonElement = (beNone, beButton, beDropdown); TSpkMouseButtonElement = (beNone, beButton, beDropdown);
@ -39,7 +39,7 @@ type
procedure SetGroupIndex(Value: Integer); override; procedure SetGroupIndex(Value: Integer); override;
procedure SetImageIndex(Value: integer); override; procedure SetImageIndex(Value: integer); override;
procedure SetVisible(Value: Boolean); override; procedure SetVisible(Value: Boolean); override;
procedure SetOnExecute(Value: TNotifyEvent); override; procedure SetOnExecute({%H-}Value: TNotifyEvent); override;
public public
function IsCaptionLinked: Boolean; override; function IsCaptionLinked: Boolean; override;
function IsCheckedLinked: Boolean; override; function IsCheckedLinked: Boolean; override;
@ -113,11 +113,11 @@ type
destructor Destroy; override; destructor Destroy; override;
procedure MouseLeave; override; procedure MouseLeave; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; procedure MouseDown(Button: TMouseButton; {%H-}Shift: TShiftState;
X, Y: Integer); override; {%H-}X, {%H-}Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseMove({%H-}Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override; {%H-}X, {%H-}Y: Integer); override;
function GetRootComponent: TComponent; function GetRootComponent: TComponent;

16
components/spktoolbar/SpkToolbar/spkt_Checkboxes.pas
View File

@ -19,9 +19,10 @@ type
procedure SetTableBehaviour(const Value: TSpkItemTableBehaviour); procedure SetTableBehaviour(const Value: TSpkItemTableBehaviour);
protected protected
procedure CalcRects; override; procedure CalcRects; override;
procedure ConstructRect(var BtnRect: T2DIntRect); procedure ConstructRect(out BtnRect: T2DIntRect);
function GetChecked: Boolean; override; function GetChecked: Boolean; override;
function GetDefaultCaption: String; override; function GetDefaultCaption: String; override;
function GetDropdownPoint: T2DIntPoint; override;
procedure SetChecked(const AValue: Boolean); override; procedure SetChecked(const AValue: Boolean); override;
procedure SetState(AValue: TCheckboxState); virtual; procedure SetState(AValue: TCheckboxState); virtual;
public public
@ -90,7 +91,7 @@ begin
FButtonRect := FButtonRect + RectVector; FButtonRect := FButtonRect + RectVector;
end; end;
procedure TSpkCustomCheckbox.ConstructRect(var BtnRect: T2DIntRect); procedure TSpkCustomCheckbox.ConstructRect(out BtnRect: T2DIntRect);
var var
BtnWidth: integer; BtnWidth: integer;
Bitmap: TBitmap; Bitmap: TBitmap;
@ -276,6 +277,15 @@ begin
Result := 'Checkbox'; Result := 'Checkbox';
end; end;
function TSpkCustomCheckbox.GetDropdownPoint: T2DIntPoint;
begin
{$IFDEF EnhancedRecordSupport}
Result := T2DIntPoint.Create(0,0);
{$ELSE}
Result.Create(0,0);
{$ENDIF}
end;
function TSpkCustomCheckbox.GetGroupBehaviour: TSpkItemGroupBehaviour; function TSpkCustomCheckbox.GetGroupBehaviour: TSpkItemGroupBehaviour;
begin begin
Result := gbSingleitem; //FGroupBehaviour; Result := gbSingleitem; //FGroupBehaviour;
@ -293,7 +303,7 @@ end;
function TSpkCustomCheckbox.GetWidth: integer; function TSpkCustomCheckbox.GetWidth: integer;
var var
BtnRect, DropRect: T2DIntRect; BtnRect: T2DIntRect;
begin begin
Result := -1; Result := -1;
if FToolbarDispatch = nil then if FToolbarDispatch = nil then

2
components/spktoolbar/SpkToolbar/spkt_Const.pas
View File

@ -271,7 +271,7 @@ var
implementation implementation
uses uses
LCLType, Types; LCLType;
procedure SpkInitLayoutConsts(FromDPI: Integer; ToDPI: Integer = 0); procedure SpkInitLayoutConsts(FromDPI: Integer; ToDPI: Integer = 0);
begin begin

1
components/spktoolbar/SpkToolbar/spkt_Pane.pas
View File

@ -236,7 +236,6 @@ var
i: Integer; i: Integer;
R: T2DIntRect; R: T2DIntRect;
delta: Integer; delta: Integer;
cornerRadius: Integer;
begin begin
// W niektórych warunkach nie jesteœmy w stanie rysowaæ: // W niektórych warunkach nie jesteœmy w stanie rysowaæ:
// * Brak dyspozytora // * Brak dyspozytora

2
components/spktoolbar/SpkToolbar/spkt_Types.pas
View File

@ -30,7 +30,7 @@ type
// *** Metody reakcji na zmiany w liœcie *** // *** Metody reakcji na zmiany w liœcie ***
// *** Methods responding to changes in list *** // *** Methods responding to changes in list ***
procedure Notify(Item: TComponent; Operation: TOperation); virtual; procedure Notify({%H-}Item: TComponent; {%H-}Operation: TOperation); virtual;
procedure Update; virtual; procedure Update; virtual;
// *** Wewnêtrzne metody dodawania i wstawiania elementów *** // *** Wewnêtrzne metody dodawania i wstawiania elementów ***

19
components/spktoolbar/SpkXML/SpkXMLParser.pas
View File

@ -2,6 +2,7 @@ unit SpkXMLParser;
{$mode Delphi} {$mode Delphi}
{$DEFINE SPKXMLPARSER} {$DEFINE SPKXMLPARSER}
{$WARN 4055 off : Conversion between ordinals and pointers is not portable}
interface interface
@ -1500,7 +1501,7 @@ try
// Oczekujemy nazwy taga, kt�ra jest postaci // Oczekujemy nazwy taga, kt�ra jest postaci
// [a-zA-Z]([a-zA-Z0-9_]|([\-:][a-zA-Z0-9_]))* // [a-zA-Z]([a-zA-Z0-9_]|([\-:][a-zA-Z0-9_]))*
if not(input^ in ['a'..'z','A'..'Z']) then if not (input^ in ['a'..'z','A'..'Z']) then
raise exception.create('B��d w sk�adni XML (linia '+IntToStr(ParseLine)+', znak '+IntToStr(ParseChar)+') : Nieprawid�owa nazwa taga!'); raise exception.create('B��d w sk�adni XML (linia '+IntToStr(ParseLine)+', znak '+IntToStr(ParseChar)+') : Nieprawid�owa nazwa taga!');
TokenStart:=input; TokenStart:=input;
@ -1515,8 +1516,8 @@ try
end; end;
until not(input^ in ['a'..'z','A'..'Z','0'..'9','_']); until not(input^ in ['a'..'z','A'..'Z','0'..'9','_']);
setlength(s,integer(input)-integer(TokenStart)); SetLength(s, PtrUInt(input)-PtrUInt(TokenStart));
StrLCopy(PChar(s),TokenStart,integer(input)-integer(TokenStart)); StrLCopy(PChar(s),TokenStart, PtrUInt(input)-PtrUInt(TokenStart));
Node.Name:=s; Node.Name:=s;
// Plik nie mo�e si� tu ko�czy�. // Plik nie mo�e si� tu ko�czy�.
@ -1546,8 +1547,8 @@ try
increment(input) increment(input)
until not(input^ in ['a'..'z','A'..'Z','0'..'9','_']); until not(input^ in ['a'..'z','A'..'Z','0'..'9','_']);
setlength(s,integer(input)-integer(TokenStart)); SetLength(s, {%H-}PtrUInt(input)-{%H-}PtrUInt(TokenStart));
StrLCopy(PChar(s),TokenStart,integer(input)-integer(TokenStart)); StrLCopy(PChar(s), TokenStart, {%H-}PtrUInt(input)-{%H-}PtrUInt(TokenStart));
// Pomijamy bia�e znaki // Pomijamy bia�e znaki
while input^ in [#32,#9,#13,#10] do increment(input); while input^ in [#32,#9,#13,#10] do increment(input);
@ -1676,8 +1677,8 @@ try
until input^='-'; until input^='-';
until StrLComp(input,'-->',3)=0; until StrLComp(input,'-->',3)=0;
setlength(s,integer(input)-integer(TokenStart)); setlength(s, PtrUInt(input)-PtrUInt(TokenStart));
StrLCopy(PChar(s),TokenStart,integer(input)-integer(TokenStart)); StrLCopy(PChar(s),TokenStart, PtrUInt(input)-PtrUInt(TokenStart));
Node.Text:=s; Node.Text:=s;
// Pomijamy znaki zako�czenia komentarza // Pomijamy znaki zako�czenia komentarza
@ -1721,8 +1722,8 @@ try
end; end;
until not(input^ in ['a'..'z','A'..'Z','0'..'9','_']); until not(input^ in ['a'..'z','A'..'Z','0'..'9','_']);
setlength(s,integer(input)-integer(TokenStart)); SetLength(s, PtrUInt(input)-PtrUInt(TokenStart));
StrLCopy(PChar(s),TokenStart,integer(input)-integer(TokenStart)); StrLCopy(PChar(s),TokenStart, PtrUInt(input)-PtrUInt(TokenStart));
// Pomijamy zb�dne znaki bia�e // Pomijamy zb�dne znaki bia�e
while input^ in [#32,#9,#10,#13] do increment(input); while input^ in [#32,#9,#10,#13] do increment(input);

16
components/spktoolbar/designtime/spkte_AppearanceEditor.pas
View File

@ -291,13 +291,13 @@ type
FScreenshotForm: TForm; FScreenshotForm: TForm;
function PickColor(APanel: TPanel): Boolean; function PickColor(APanel: TPanel): Boolean;
procedure ScreenshotKeyDown(Sender: TObject; procedure ScreenshotKeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState); var Key: Word; {%H-}Shift: TShiftState);
procedure ScreenshotMouseDown(Sender: TObject; Button: TMouseButton; procedure ScreenshotMouseDown(Sender: TObject; {%H-}Button: TMouseButton;
Shift: TShiftState; X, Y: integer); {%H-}Shift: TShiftState; X, Y: integer);
procedure ScreenshotMouseMove(Sender: TObject; procedure ScreenshotMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: integer); {%H-}Shift: TShiftState; X, Y: integer);
procedure ScreenshotMouseUp(Sender: TObject; Button: TMouseButton; procedure ScreenshotMouseUp(Sender: TObject; {%H-}Button: TMouseButton;
Shift: TShiftState; X, Y: integer); {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: integer);
private private
procedure UpdateImages; procedure UpdateImages;
@ -321,7 +321,7 @@ implementation
{$R *.lfm} {$R *.lfm}
uses uses
Types, clipbrd, Spkt_Const; Types, clipbrd;
var var
CurrPageIndex: Integer = 0; CurrPageIndex: Integer = 0;
@ -1411,7 +1411,7 @@ end;
procedure TfrmAppearanceEditWindow.UpdateSizes; procedure TfrmAppearanceEditWindow.UpdateSizes;
var var
w, h, dist: Integer; w, h: Integer;
procedure AddToHeight(var AHeight: Integer; AControl: TControl); procedure AddToHeight(var AHeight: Integer; AControl: TControl);
begin begin

8
components/spktoolbar/designtime/spkte_EditWindow.pas
View File

@ -5,8 +5,8 @@ unit spkte_EditWindow;
interface interface
uses uses
LCLIntf, LCLType, LMessages, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, LCLIntf, LCLType, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, {DesignIntf, DesignEditors,} StdCtrls, ImgList, ComCtrls, ToolWin, Dialogs, {DesignIntf, DesignEditors,} StdCtrls, ImgList, ComCtrls,
ActnList, Menus, ComponentEditors, PropEdits, ActnList, Menus, ComponentEditors, PropEdits,
SpkToolbar, spkt_Tab, spkt_Pane, spkt_BaseItem, spkt_Buttons, spkt_Types, spkt_Checkboxes; SpkToolbar, spkt_Tab, spkt_Pane, spkt_BaseItem, spkt_Buttons, spkt_Types, spkt_Checkboxes;
@ -85,7 +85,7 @@ type
procedure tvStructureDeletion(Sender:TObject; Node:TTreeNode); procedure tvStructureDeletion(Sender:TObject; Node:TTreeNode);
procedure tvStructureEdited(Sender: TObject; Node: TTreeNode; var S: string); procedure tvStructureEdited(Sender: TObject; Node: TTreeNode; var S: string);
procedure tvStructureKeyDown(Sender: TObject; var Key: Word; procedure tvStructureKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState); {%H-}Shift: TShiftState);
procedure FormActivate(Sender: TObject); procedure FormActivate(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
private private
@ -1002,8 +1002,6 @@ end;
procedure TfrmEditWindow.tvStructureDeletion(Sender:TObject; Node:TTreeNode); procedure TfrmEditWindow.tvStructureDeletion(Sender:TObject; Node:TTreeNode);
var var
RunNode: TTreeNode; RunNode: TTreeNode;
index: Integer;
comp: TSpkComponent;
begin begin
if Node = nil then if Node = nil then
exit; exit;