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

tvplanit: Mouse wheel support for ContactGrid. Some cosmetic formatting changes in this unit.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4732 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-06-12 21:13:41 +00:00
parent fc91764452
commit f1c32b907a
1 changed files with 118 additions and 77 deletions
Download Patch File Download Diff File Expand all files Collapse all files

195
components/tvplanit/source/vpcontactgrid.pas
View File

@ -206,6 +206,9 @@ type
procedure WMLButtonDblClk(var Msg : TLMLButtonDblClk); message LM_LBUTTONDBLCLK; procedure WMLButtonDblClk(var Msg : TLMLButtonDblClk); message LM_LBUTTONDBLCLK;
procedure WMKillFocus(var Msg : TLMKillFocus); message LM_KILLFOCUS; procedure WMKillFocus(var Msg : TLMKillFocus); message LM_KILLFOCUS;
procedure WMRButtonDown(var Msg : TLMRButtonDown); message LM_RBUTTONDOWN; procedure WMRButtonDown(var Msg : TLMRButtonDown); message LM_RBUTTONDOWN;
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
{$ENDIF} {$ENDIF}
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
@ -547,26 +550,46 @@ begin
end; end;
{=====} {=====}
{$IFDEF LCL}
function TVpContactGrid.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean;
begin
Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
end;
function TVpContactGrid.DoMouseWheelDown(Shift: TShiftState;
MousePos: TPoint): Boolean;
begin
Result := inherited DoMouseWheelDown(Shift, MousePos);
if not Result then begin
cgScrollHorizontal(1);
Invalidate;
Result := True;
end;
end;
function TVpContactGrid.DoMouseWheelUp(Shift: TShiftState;
MousePos: TPoint): Boolean;
begin
Result := inherited DoMouseWheelUp(Shift, MousePos);
if not Result then begin
cgScrollHorizontal(-1);
Invalidate;
Result := True;
end;
end;
{$ENDIF}
procedure TVpContactGrid.Paint; procedure TVpContactGrid.Paint;
begin begin
RenderToCanvas (Canvas, RenderToCanvas(Canvas, Rect(0, 0, Width, Height), ra0, 1, Now, -1, -1, gr30Min, False);
Rect (0, 0, Width, Height),
ra0,
1,
Now,
-1,
-1,
gr30Min,
False);
end; end;
{=====} {=====}
procedure TVpContactGrid.PaintToCanvas (ACanvas : TCanvas; procedure TVpContactGrid.PaintToCanvas(ACanvas: TCanvas; ARect: TRect;
ARect : TRect; Angle: TVpRotationAngle);
Angle : TVpRotationAngle);
begin begin
RenderToCanvas (ACanvas, ARect, Angle, 1, Now, RenderToCanvas(ACanvas, ARect, Angle, 1, Now, -1, -1, gr30Min, True);
-1, -1, gr30Min, True);
end; end;
{=====} {=====}
@ -667,8 +690,7 @@ var
RenderCanvas.Pen.Style := psSolid; RenderCanvas.Pen.Style := psSolid;
BarPos := RealLeft + 2 + RealColumnWidth + ExtraBarWidth; BarPos := RealLeft + 2 + RealColumnWidth + ExtraBarWidth;
BarCount := 0; BarCount := 0;
while (BarPos < RealRight) and while (BarPos < RealRight) and (BarCount < Pred (MaxColumns)) do begin
(BarCount < Pred (MaxColumns)) do begin
cgBarArray[BarCount].Rec := Rect(BarPos - ExtraBarWidth, RealTop, cgBarArray[BarCount].Rec := Rect(BarPos - ExtraBarWidth, RealTop,
BarPos - ExtraBarWidth + FBarWidth, RealBottom); BarPos - ExtraBarWidth + FBarWidth, RealBottom);
cgBarArray[BarCount].Index := BarCount; cgBarArray[BarCount].Index := BarCount;
@ -699,9 +721,12 @@ var
BarCount := 0; BarCount := 0;
while (BarPos < Width) and (BarCount < pred(MaxColumns)) do begin while (BarPos < Width) and (BarCount < pred(MaxColumns)) do begin
cgResizeBarArray[BarCount].Index := BarCount; cgResizeBarArray[BarCount].Index := BarCount;
cgResizeBarArray[BarCount].Rec := Rect(BarPos - ExtraBarWidth, cgResizeBarArray[BarCount].Rec := Rect(
RealTop, BarPos - ExtraBarWidth + FBarWidth, BarPos - ExtraBarWidth,
RealBottom); RealTop,
BarPos - ExtraBarWidth + FBarWidth,
RealBottom
);
for I := 1 to BarWidth do begin for I := 1 to BarWidth do begin
TPSMoveTo (RenderCanvas, Angle, RenderIn, TPSMoveTo (RenderCanvas, Angle, RenderIn,
RealLeft + BarPos, RealLeft + BarPos,
@ -782,17 +807,19 @@ var
{ Set the anchor starting point } { Set the anchor starting point }
case Angle of case Angle of
ra0 : ra0 :
Anchor := Point (2 + (TextMargin * 2), Anchor := Point(2 + TextMargin * 2, 2 + TextMargin * 2);
2 + (TextMargin * 2));
ra90 : ra90 :
Anchor := Point (2 + (TextMargin * 2), Anchor := Point(2 + TextMargin * 2, 2 + TextMargin * 2);
2 + (TextMargin * 2));
ra180 : ra180 :
Anchor := Point ((RenderIn.Right - RenderIn.Left) - TmpBmp.Width - 2 - (TextMargin * 2), Anchor := Point(
TmpBmp.Height - 2 - (TextMargin * 2)); RenderIn.Right - RenderIn.Left - TmpBmp.Width - 2 - TextMargin * 2,
TmpBmp.Height - 2 - TextMargin * 2
);
ra270 : ra270 :
Anchor := Point (2 + (TextMargin * 2), Anchor := Point(
(RenderIn.Bottom - RenderIn.Top) - TmpBmp.Height - 2 - (TextMargin * 2)); 2 + TextMargin * 2,
RenderIn.Bottom - RenderIn.Top - TmpBmp.Height - 2 - TextMargin * 2
);
end; end;
RecsInCol := 0; RecsInCol := 0;
@ -809,36 +836,49 @@ var
TmpBmp.Canvas.Brush.Style := bsSolid; TmpBmp.Canvas.Brush.Style := bsSolid;
TmpBmp.Canvas.Font.Assign(FContactHeadAttr.Font); TmpBmp.Canvas.Font.Assign(FContactHeadAttr.Font);
case Angle of case Angle of
ra0 : begin ra0:
WholeRect.TopLeft := Point(0, 0); begin
HeadRect.TopLeft := Point(TextMargin, 0); WholeRect.TopLeft := Point(0, 0);
HeadRect.BottomRight := Point (TmpBmp.Width, HeadRect.TopLeft := Point(TextMargin, 0);
HeadRect.Top + TmpBmp.Canvas.TextHeight(VpProductName) HeadRect.BottomRight := Point(
+ (TextMargin div 2)); TmpBmp.Width,
WholeRect.BottomRight := HeadRect.BottomRight; HeadRect.Top + TmpBmp.Canvas.TextHeight(VpProductName) + TextMargin div 2
end; );
ra90 : begin WholeRect.BottomRight := HeadRect.BottomRight;
HeadRect.TopLeft := Point (TmpBmpRect.Right - TextMargin - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2), 0); end;
HeadRect.BottomRight := Point (TmpBmpRect.Right, ra90:
TmpBmp.Height); begin
WholeRect.TopLeft := HeadRect.TopLeft; HeadRect.TopLeft := Point(
WholeRect.BottomRight := HeadRect.BottomRight; TmpBmpRect.Right - TextMargin - TmpBmp.Canvas.TextHeight(VpProductName) + TextMargin div 2,
end; 0
ra180 : begin );
WholeRect.BottomRight := Point (TmpBmp.Width, TmpBmp.Height); HeadRect.BottomRight := Point(TmpBmpRect.Right, TmpBmp.Height);
HeadRect.TopLeft := Point (TextMargin, TmpBmpRect.Bottom - WholeRect.TopLeft := HeadRect.TopLeft;
TmpBmp.Canvas.TextHeight(VpProductName) - TextMargin); WholeRect.BottomRight := HeadRect.BottomRight;
HeadRect.BottomRight := Point (TmpBmp.Width, end;
TmpBmp.Height - (TextMargin div 2)); ra180:
WholeRect.TopLeft := HeadRect.TopLeft; begin
end; WholeRect.BottomRight := Point(TmpBmp.Width, TmpBmp.Height);
ra270 : begin HeadRect.TopLeft := Point(
WholeRect.TopLeft := Point (0, 0); TextMargin,
HeadRect.TopLeft := Point (0, TextMargin); TmpBmpRect.Bottom - TmpBmp.Canvas.TextHeight(VpProductName) - TextMargin
HeadRect.BottomRight := Point (TextMargin + TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2), );
TmpBmp.Height); HeadRect.BottomRight := Point(
WholeRect.BottomRight := HeadRect.BottomRight; TmpBmp.Width,
end; TmpBmp.Height - TextMargin div 2
);
WholeRect.TopLeft := HeadRect.TopLeft;
end;
ra270:
begin
WholeRect.TopLeft := Point(0, 0);
HeadRect.TopLeft := Point(0, TextMargin);
HeadRect.BottomRight := Point(
TextMargin + TmpBmp.Canvas.TextHeight(VpProductName) + TextMargin div 2,
TmpBmp.Height
);
WholeRect.BottomRight := HeadRect.BottomRight;
end;
end; end;
{ assemble the header string } { assemble the header string }
Str := AssembleName(TmpCon); Str := AssembleName(TmpCon);
@ -1475,14 +1515,10 @@ var
{ add a little spacing between records } { add a little spacing between records }
case Angle of case Angle of
ra0 : ra0 : WholeRect.Bottom := WholeRect.Bottom + TextMargin * 2;
WholeRect.Bottom := WholeRect.Bottom + (TextMargin * 2); ra90 : WholeRect.Left := WholeRect.Left - TextMargin * 2;
ra90 : ra180 : WholeRect.Top := WholeRect.Top - TextMargin * 2;
WholeRect.Left := WholeRect.Left - (TextMargin * 2); ra270 : WholeRect.Right := WholeRect.Right + TextMargin * 2;
ra180 :
WholeRect.Top := WholeRect.Top - (TextMargin * 2);
ra270 :
WholeRect.Right := WholeRect.Right + (TextMargin * 2);
end; end;
{ Update Array Rects } { Update Array Rects }
@ -2544,18 +2580,23 @@ begin
Exit; Exit;
case Msg.ScrollCode of case Msg.ScrollCode of
SB_LINELEFT : cgScrollHorizontal(-1); SB_LINELEFT:
SB_LINERIGHT : cgScrollHorizontal(1); cgScrollHorizontal(-1);
SB_PAGELEFT : cgScrollHorizontal(-1); SB_LINERIGHT:
SB_PAGERIGHT : cgScrollHorizontal(1); cgScrollHorizontal(1);
SB_THUMBPOSITION, SB_THUMBTRACK : begin SB_PAGELEFT:
if (Msg.Pos > FContactsBefore) and (FContactsAfter = 0) then Exit; cgScrollHorizontal(-1);
FContactsBefore := Msg.Pos; SB_PAGERIGHT:
if (FContactsBefore = 1) and (cgCol1RecCount = 1) then cgScrollHorizontal(1);
FContactsBefore := 0; SB_THUMBPOSITION, SB_THUMBTRACK:
if FContactsBefore >= DataStore.Resource.Contacts.Count then begin
FContactsBefore := DataStore.Resource.Contacts.Count - cgCol1RecCount; if (Msg.Pos > FContactsBefore) and (FContactsAfter = 0) then Exit;
end; FContactsBefore := Msg.Pos;
if (FContactsBefore = 1) and (cgCol1RecCount = 1) then
FContactsBefore := 0;
if FContactsBefore >= DataStore.Resource.Contacts.Count then
FContactsBefore := DataStore.Resource.Contacts.Count - cgCol1RecCount;
end;
end; end;
Invalidate; Invalidate;
end; end;