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

tvplanit: Improve keyboard handling of VpContactGrid. Some refactoring of painting code.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6485 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-06-10 16:42:16 +00:00
parent 66df4b25d4
commit 842ff47426
6 changed files with 242 additions and 240 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
components/tvplanit/examples/datastores/xml/project1.lpi
View File

@@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="10"/>
<Version Value="11"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
@@ -17,9 +17,10 @@
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default"/>
</Modes>
</RunParams>
<RequiredPackages Count="2">
<Item1>

14
components/tvplanit/examples/datastores/xml/unit1.lfm
View File

@@ -7,7 +7,8 @@ object Form1: TForm1
ClientHeight = 686
ClientWidth = 980
OnCreate = FormCreate
LCLVersion = '1.6.4.0'
OnDestroy = FormDestroy
LCLVersion = '1.9.0.0'
object Panel1: TPanel
Left = 0
Height = 33
@@ -170,7 +171,6 @@ object Form1: TForm1
Align = alBottom
TabStop = True
TabOrder = 1
KBNavigation = True
DateLabelFormat = 'mmmm yyyy'
DayHeadAttributes.Font.Height = -13
DayHeadAttributes.Font.Name = 'Tahoma'
@@ -181,6 +181,7 @@ object Form1: TForm1
EventDayStyle = []
EventFont.Height = -12
HeadAttributes.Color = clBtnFace
KBNavigation = True
OffDayColor = clSilver
SelectedDayColor = clRed
ShowEvents = True
@@ -245,20 +246,21 @@ object Form1: TForm1
end
object TabSheet2: TTabSheet
Caption = 'Contacts'
ClientHeight = 624
ClientHeight = 625
ClientWidth = 972
object VpContactButtonBar1: TVpContactButtonBar
Left = 0
Height = 624
Height = 625
Top = 0
Width = 40
ContactGrid = VpContactGrid1
DrawingStyle = dsFlat
RadioStyle = False
Align = alLeft
end
object VpContactGrid1: TVpContactGrid
Left = 40
Height = 624
Height = 625
Top = 0
Width = 932
DataStore = VpXmlDatastore1
@@ -295,7 +297,7 @@ object Form1: TForm1
top = 264
end
object VpResourceEditDialog1: TVpResourceEditDialog
Version = 'v1.05'
Version = 'v1.12'
DataStore = VpXmlDatastore1
Options = []
Placement.Position = mpCenter

6
components/tvplanit/examples/datastores/xml/unit1.pas
View File

@@ -39,6 +39,7 @@ type
procedure BtnNewResClick(Sender: TObject);
procedure BtnEditResClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ private declarations }
public
@@ -86,5 +87,10 @@ begin
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
VpXMLDatastore1.Connected := false;
end;
end.

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

@@ -192,6 +192,7 @@ type
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure ScrollIntoView;
procedure PopupAddContact(Sender: TObject);
procedure PopupAddVCards(Sender: TObject);
procedure PopupDeleteContact(Sender: TObject);
@@ -787,6 +788,23 @@ begin
end;
end;
procedure TVpContactGrid.ScrollIntoView;
begin
if FContactIndex < FContactsBefore then begin
FContactsBefore := FContactIndex;
Invalidate;
end else begin
if FContactIndex > FContactsBefore + FVisibleContacts - 2 then begin
FContactsBefore := FContactIndex - FVisibleContacts + 2;
Invalidate;
end;
while ContactIndex > FContactsBefore + FVisibleContacts - 2 do begin
inc(FContactsBefore);
Invalidate;
end;
end;
end;
{ Introduced to support the buttonbar component !!.02}
function TVpContactGrid.SelectContactByName(const Name: String): Boolean;
var
@@ -1576,31 +1594,26 @@ end;
procedure TVpContactGrid.KeyDown(var Key: Word; Shift: TShiftState);
var
PopupPoint: TPoint;
idx: Integer;
contactCount: Integer;
begin
contactCount := DataStore.Resource.Contacts.Count;
case Key of
VK_UP:
if ContactIndex > 0 then
ContactIndex := ContactIndex - 1;
VK_DOWN:
if ContactIndex < DataStore.Resource.Contacts.Count - 1 then
if ContactIndex < contactCount - 1 then
ContactIndex := ContactIndex + 1;
VK_HOME:
ContactIndex := 0;
{
if ContactIndex > 0 then
ContactIndex := ContactIndex - 1;
}
VK_END:
ContactIndex := Datastore.Resource.Contacts.Count - 1;
{
if ContactIndex < Pred(DataStore.Resource.Contacts.Count) then
ContactIndex := ContactIndex + 1;
}
ContactIndex := contactCount - 1;
VK_RIGHT:
if ContactIndex + cgCol1RecCount <= DataStore.Resource.Contacts.Count - 1 then
if ContactIndex + cgCol1RecCount <= contactCount - 1 then
ContactIndex := ContactIndex + cgCol1RecCount
else
ContactIndex := DataStore.Resource.Contacts.Count - 1;
ContactIndex := contactCount - 1;
VK_LEFT:
if ContactIndex - cgCol1RecCount <= 0 then
ContactIndex := 0
@@ -1629,8 +1642,9 @@ begin
inherited;
end;
Key := 0;
Invalidate;
ScrollIntoView;
Key := 0;
inherited;
end;
{=====}

147
components/tvplanit/source/vpcontactgridpainter.pas
View File

@@ -237,7 +237,11 @@ var
Phone4Rect: TRect = (Left:0; Top:0; Right:0; Bottom:0);
Phone5Rect: TRect = (Left:0; Top:0; Right:0; Bottom:0);
R: TRect;
contactCount: Integer;
baseTextHeight: Integer;
maxTextWidth: Integer;
begin
contactCount := FContactGrid.DataStore.Resource.Contacts.Count;
oldCol1RecCount := TVpContactGridOpener(FContactGrid).cgCol1RecCount;
TVpContactGridOpener(FContactGrid).FVisibleContacts := 0;
TVpContactGridOpener(FContactGrid).cgCol1RecCount := 0;
@@ -271,6 +275,7 @@ begin
{$IF VP_LCL_SCALING = 0}
TmpBmp.Canvas.Font.Size := ScaleY(TmpBmp.Canvas.Font.Size, DesignTimeDPI);
{$ENDIF}
baseTextHeight := TmpBmp.Canvas.TextHeight(VpProductName);
{ Calculate Phone Lbl Width }
PhoneLblWidth := TmpBmp.Canvas.TextWidth(RSEmail);
@@ -308,15 +313,15 @@ begin
end;
RecsInCol := 0;
for I := StartContact to pred(FContactGrid.DataStore.Resource.Contacts.Count) do begin
for I := StartContact to pred(contactCount) do begin
TmpCon := FContactGrid.DataStore.Resource.Contacts.GetContact(I);
if (TmpCon <> nil) then begin
TVpContactGridOpener(FContactGrid).cgContactArray[I].Contact := TmpCon;
{ Clear bmp canvas }
TmpBmp.Canvas.Brush.Color := RealColor;
TmpBmp.Canvas.FillRect(Rect(0, 0, TmpBmp.Width, TmpBmp.Height));
TVpContactGridOpener(FContactGrid).cgContactArray[I].Contact := TmpCon;
{ start building the WholeRect and build the HeaderRect}
TmpBmp.Canvas.Pen.Color := BevelDarkShadow;
TmpBmp.Canvas.Brush.Style := bsSolid;
@@ -335,14 +340,14 @@ begin
HeadRect.TopLeft := Point(0, 0);
HeadRect.BottomRight := Point(
TmpBmp.Width,
HeadRect.Top + TmpBmp.Canvas.TextHeight(VpProductName) + TextMargin div 2
HeadRect.Top + baseTextHeight + TextMargin div 2
);
WholeRect.BottomRight := HeadRect.BottomRight;
end;
ra90: // TO DO: CHECK THE USAGE OF TextMargin HERE !!!!!!!!!
ra90: // TO DO: CHECK CORRECT USAGE OF TextMargin HERE !!!!!!!!!
begin
HeadRect.TopLeft := Point(
TmpBmpRect.Right - TextMargin - TmpBmp.Canvas.TextHeight(VpProductName) + TextMargin div 2,
TmpBmpRect.Right - TextMargin - baseTextHeight + TextMargin div 2,
0
);
HeadRect.BottomRight := Point(TmpBmpRect.Right, TmpBmp.Height);
@@ -354,7 +359,7 @@ begin
WholeRect.BottomRight := Point(TmpBmp.Width, TmpBmp.Height);
HeadRect.TopLeft := Point(
TextMargin,
TmpBmpRect.Bottom - TmpBmp.Canvas.TextHeight(VpProductName) - TextMargin
TmpBmpRect.Bottom - baseTextHeight - TextMargin
);
HeadRect.BottomRight := Point(
TmpBmp.Width,
@@ -367,35 +372,24 @@ begin
WholeRect.TopLeft := Point(0, 0);
HeadRect.TopLeft := Point(0, TextMargin);
HeadRect.BottomRight := Point(
TextMargin + TmpBmp.Canvas.TextHeight(VpProductName) + TextMargin div 2,
TextMargin + baseTextHeight + TextMargin div 2,
TmpBmp.Height
);
WholeRect.BottomRight := HeadRect.BottomRight;
end;
end;
{ assemble the header string }
Str := AssembleName(TmpCon);
{ if the name isn't empty then paint all of the contact information }
if Str > '' then begin
{ paint the header cell's background }
if (Angle = ra0) or (Angle = ra180) then
Str := GetDisplayString(TmpBmp.Canvas, Str, 2, WidthOf(HeadRect) - TextMargin)
else
Str := GetDisplayString(TmpBmp.Canvas, Str, 2, HeightOf(HeadRect) - TextMargin);
TmpBmp.Canvas.Brush.Color := RealContactHeadAttrColor;
TmpBmp.Canvas.FillRect(HeadRect);
{ paint the header cell's border }
if FContactGrid.ContactHeadAttributes.Bordered and (FContactGrid.DrawingStyle <> dsNoBorder)
then begin
TmpBmp.Canvas.Pen.Style := psSolid;
{$IFDEF VERSION5}
TmpBmp.Canvas.Rectangle(HeadRect);
{$ELSE}
TmpBmp.Canvas.Rectangle(HeadRect.Left, HeadRect.Top, HeadRect.Right, HeadRect.Bottom);
{$ENDIF}
end;
{ paint the header cell's text }
case Angle of
ra90:
@@ -414,6 +408,15 @@ begin
TextYOffset := HeightOf(HeadRect) - TextMargin div 3;
end;
end;
{ assemble the header string }
if (Angle in [ra0, ra180]) then
maxTextWidth := WidthOf(HeadRect)
else
maxTextWidth := HeightOf(HeadRect);
Str := AssembleName(TmpCon);
Str := GetDisplayString(TmpBmp.Canvas, Str, 2, maxTextWidth - TextMargin);
TPSTextOutAtPoint(
TmpBmp.Canvas,
Angle,
@@ -468,11 +471,11 @@ begin
{ if this record's too big to fit in the remaining area of this }
{ column, then slide over to the top of the next column }
if RecsInCol > 0 then
case Angle of
ra0 : begin
if (RenderIn.Top + Anchor.y + WholeRect.Bottom >= RenderIn.Bottom - TextMargin * 3) and
(RecsInCol > 0)
then begin
ra0:
if (RenderIn.Top + Anchor.y + WholeRect.Bottom >= RenderIn.Bottom - TextMargin * 3) then
begin
Anchor := Point(
Anchor.x + WholeRect.Right + FContactGrid.BarWidth + 1 + TextMargin * 3,
2 + TextMargin * 2
@@ -484,11 +487,9 @@ begin
if DisplayOnly and (Anchor.X + TextColWidth >= RenderIn.Right) then
Exit;
end;
end;
ra90 : begin
if (Anchor.x + RenderIn.Left + WholeRect.Right - WholeRect.Left > RenderIn.Right - TextMargin * 3) and
(RecsInCol > 0)
then begin
ra90 :
if (Anchor.x + RenderIn.Left + WholeRect.Right - WholeRect.Left > RenderIn.Right - TextMargin * 3) then
begin
Anchor.x := 2 + TextMargin * 2;
Anchor.y := Anchor.y + WholeRect.Bottom + FContactGrid.BarWidth + 1 + TextMargin * 3;
if Col = 1 then
@@ -498,10 +499,8 @@ begin
if DisplayOnly and (Anchor.y + TextColWidth >= RenderIn.Bottom) then
Exit;
end;
end;
ra180 : begin
if (Anchor.y + RenderIn.Top - WholeRect.Bottom - WholeRect.Top <= RenderIn.Top + TextMargin * 3) and
(RecsInCol > 0) then
ra180 :
if (Anchor.y + RenderIn.Top - WholeRect.Bottom - WholeRect.Top <= RenderIn.Top + TextMargin * 3) then
begin
Anchor.x := Anchor.x - (WholeRect.Right + FContactGrid.BarWidth + 1 + TextMargin * 3);
Anchor.y := TmpBmp.Height - 2 - TextMargin * 2;
@@ -512,10 +511,8 @@ begin
if DisplayOnly and (Anchor.x + TextColWidth < RenderIn.Left) then
Exit;
end;
end;
ra270 : begin
if (Anchor.x + RenderIn.Left + (WholeRect.Right - WholeRect.Left) >= RenderIn.Right - TextMargin * 3) and
(RecsInCol > 0) then
ra270 :
if (Anchor.x + RenderIn.Left + (WholeRect.Right - WholeRect.Left) >= RenderIn.Right - TextMargin * 3) then
begin
Anchor.x := 2 + TextMargin * 2;
Anchor.y := Anchor.y - (WholeRect.Bottom + FContactGrid.BarWidth + 1 + TextMargin * 3);
@@ -527,7 +524,6 @@ begin
Exit;
end;
end;
end;
{ add a little spacing between records }
case Angle of
@@ -554,49 +550,32 @@ begin
{ move the drawn record from the bitmap to the component canvas }
case Angle of
ra0 :
RenderCanvas.CopyRect (Rect (Anchor.X + WholeRect.Left + RenderIn.Left,
ra0 : R := Rect(Anchor.X + WholeRect.Left + RenderIn.Left,
Anchor.Y + WholeRect.Top + RenderIn.Top,
Anchor.X + TmpBmp.Width + RenderIn.Left,
Anchor.Y + WholeRect.Bottom + RenderIn.Top),
TmpBmp.Canvas, WholeRect);
ra90 :
RenderCanvas.CopyRect (Rect (WholeRect.Left + RenderIn.Left - Anchor.X,
Anchor.Y + WholeRect.Bottom + RenderIn.Top);
ra90 : R := Rect(WholeRect.Left + RenderIn.Left - Anchor.X,
Anchor.Y + WholeRect.Top + RenderIn.Top,
WholeRect.Right + RenderIn.Left - Anchor.X,
Anchor.Y + WholeRect.Bottom + RenderIn.Top),
TmpBmp.Canvas,
Rect (WholeRect.Left,
WholeRect.Top,
WholeRect.Right,
WholeRect.Bottom));
ra180 :
RenderCanvas.CopyRect (Rect (Anchor.X + WholeRect.Left + RenderIn.Left,
Anchor.Y + WholeRect.Bottom + RenderIn.Top);
ra180 : R := Rect(Anchor.X + WholeRect.Left + RenderIn.Left,
Anchor.Y - (WholeRect.Bottom - WholeRect.Top) + RenderIn.Top,
Anchor.X + TmpBmp.Width + RenderIn.Left,
Anchor.Y + RenderIn.Top),
TmpBmp.Canvas, WholeRect);
ra270 :
RenderCanvas.CopyRect (Rect (Anchor.X + RenderIn.Left,
Anchor.Y + RenderIn.Top);
ra270 : R := Rect(Anchor.X + RenderIn.Left,
Anchor.Y + RenderIn.Top,
Anchor.X + RenderIn.Left + (WholeRect.Right - WholeRect.Left),
Anchor.Y + RenderIn.Top + (WholeRect.Bottom - WholeRect.Top)),
TmpBmp.Canvas, WholeRect);
Anchor.Y + RenderIn.Top + (WholeRect.Bottom - WholeRect.Top));
end;
RenderCanvas.CopyRect(R, TmpBmp.Canvas, WholeRect);
{ draw focusrect around selected record }
if FContactGrid.Focused and (TmpCon = FContactGrid.ActiveContact) then begin
with TVpContactGridOpener(FContactGrid).cgContactArray[I] do begin
R := WholeRect;
InflateRect(R, 3, 3);
dec(R.Bottom, 2*3);
InflateRect(R, 3, 0);
OffsetRect(R, 0, -3);
RenderCanvas.DrawFocusRect(R);
{
RenderCanvas.DrawFocusRect(Rect(WholeRect.Left, WholeRect.Top - 3,
WholeRect.Right + TextMargin, WholeRect.Bottom - 2));
}
end;
end;
@@ -607,9 +586,9 @@ begin
ra180 : Anchor.Y := Anchor.Y - (WholeRect.Bottom - WholeRect.Top);
ra270 : Anchor.X := Anchor.X + WholeRect.Right;
end;
Inc(RecsInCol);
end;
end;
end; // for I := StartCont to ...
if not DisplayOnly then
case Angle of
@@ -618,48 +597,48 @@ begin
if (Anchor.X > RenderIn.Right) and (I < DataStore.Resource.Contacts.Count)
then begin
{ we have filled in the visible area }
FContactsAfter := DataStore.Resource.Contacts.Count - I;
FVisibleContacts := DataStore.Resource.Contacts.Count - StartContact - FContactsAfter;
FContactsAfter := contactCount - I;
FVisibleContacts := contactCount - StartContact - FContactsAfter;
Break;
end else begin
FContactsAfter := 0;
FVisibleContacts := DataStore.Resource.Contacts.Count - StartContact;
FVisibleContacts := contactCount - StartContact;
end;
ra90 :
with TVpContactGridOpener(FContactGrid) do
if (Anchor.Y > RenderIn.Bottom) and (I < DataStore.Resource.Contacts.Count)
if (Anchor.Y > RenderIn.Bottom) and (I < contactCount)
then begin
{ we have filled in the visible area }
FContactsAfter := DataStore.Resource.Contacts.Count - I;
FVisibleContacts := DataStore.Resource.Contacts.Count - StartContact - FContactsAfter;
FContactsAfter := contactCount - I;
FVisibleContacts := contactCount - StartContact - FContactsAfter;
Break;
end else begin
FContactsAfter := 0;
FVisibleContacts := DataStore.Resource.Contacts.Count - StartContact;
FVisibleContacts := contactCount - StartContact;
end;
ra180 :
with TVpContactGridOpener(FContactGrid) do begin
if (Anchor.X < RenderIn.Left) and (I < DataStore.Resource.Contacts.Count)
if (Anchor.X < RenderIn.Left) and (I < contactCount)
then begin
{ we have filled in the visible area }
FContactsAfter := DataStore.Resource.Contacts.Count - I;
FVisibleContacts := DataStore.Resource.Contacts.Count - StartContact - FContactsAfter;
FContactsAfter := contactCount - I;
FVisibleContacts := contactCount - StartContact - FContactsAfter;
Break;
end else
FContactsAfter := 0;
FVisibleContacts := DataStore.Resource.Contacts.Count - StartContact;
FVisibleContacts := contactCount - StartContact;
end;
ra270 :
with TVpContactGridOpener(FContactGrid) do begin
if (Anchor.Y < RenderIn.Top) and (I < DataStore.Resource.Contacts.Count)
if (Anchor.Y < RenderIn.Top) and (I < contactCount)
then begin
{ we have filled in the visible area }
FContactsAfter := DataStore.Resource.Contacts.Count - I;
FVisibleContacts := DataStore.Resource.Contacts.Count - StartContact - FContactsAfter;
FContactsAfter := contactCount - I;
FVisibleContacts := contactCount - StartContact - FContactsAfter;
Break;
end else
FContactsAfter := 0;
FVisibleContacts := DataStore.Resource.Contacts.Count - StartContact;
FVisibleContacts := contactCount - StartContact;
end;
end;
end;