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

tvplanit: Add new property CaptionStyle (lowercase or uppercase) to TVpContactButtonBar.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6482 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-06-09 17:53:33 +00:00
parent 2c923b154e
commit 3683bf9450
2 changed files with 27 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
components/tvplanit/examples/fulldemo/demomain.lfm
View File

@ -413,6 +413,7 @@ object MainForm: TMainForm
BorderWidth = 3
ButtonHeight = 20
ButtonWidth = 36
CaptionStyle = csUppercase
ContactGrid = VpContactGrid1
DrawingStyle = dsNoBorder
RadioStyle = True

30
components/tvplanit/source/vpcontactbuttons.pas
View File

@ -50,7 +50,8 @@ const
VP_MIN_BUTTONS = 2;
VP_LETTERS_IN_ALPHABET = 26;
VP_MAX_BUTTONS = VP_LETTERS_IN_ALPHABET + 1;
VP_LETTER_A = Ord('a');
VP_LETTER_A_UC = Ord('A');
VP_LETTER_A_LC = Ord('a');
type
TVpButtonRec = packed record
@ -60,6 +61,8 @@ type
TVpButtonArray = array[0..VP_MAX_BUTTONS - 1] of TVpButtonRec;
TVpButtonCaptionStyle = (csLowercase, csUppercase);
TVpButtonBarOrientation = (baHorizontal, baVertical);
TVpButtonBarClickEvent = procedure(Sender: TObject; ButtonIndex: Integer;
@ -75,6 +78,7 @@ type
FButtonHeight: Integer;
FButtonsArray: TVpButtonArray;
FButtonWidth: Integer;
FCaptionStyle: TVpButtonCaptionStyle;
FContactGrid: TVpContactGrid;
FDrawingStyle: TVpDrawingStyle;
FOnButtonClick: TVpButtonBarClickEvent;
@ -95,6 +99,7 @@ type
procedure SetButtonColor(const Value: TColor);
procedure SetButtonHeight(const Value: Integer);
procedure SetButtonWidth(const Value: Integer);
procedure SetCaptionStyle(const Value: TVpButtonCaptionStyle);
procedure SetContactGrid(Value: TVpContactGrid);
procedure SetDrawingStyle(const Value: TVpDrawingStyle);
procedure SetShowNumberButton(const Value: Boolean);
@ -123,6 +128,8 @@ type
read FButtonHeight write SetButtonHeight default 18;
property ButtonWidth: Integer
read FButtonWidth write SetButtonWidth default 34;
property CaptionStyle: TVpButtonCaptionStyle
read FCaptionStyle write SetCaptionStyle default csLowerCase;
property ContactGrid: TVpContactGrid
read FContactGrid write SetContactGrid;
property DrawingStyle: TVpDrawingStyle
@ -201,6 +208,7 @@ begin
FButtonColor := clBtnFace;
FButtonHeight := 18;
FButtonWidth := 34;
FCaptionStyle := csLowercase;
FDrawingStyle := ds3d;
FShowNumberButton := True;
end;
@ -225,6 +233,7 @@ var
btnHeight: Integer;
btnWidth: Integer;
brdrWidth: Integer;
VP_Letter_A: integer;
begin
I := 0;
@ -236,6 +245,11 @@ begin
MinButtons := VP_MIN_BUTTONS;
end;
case FCaptionStyle of
csUppercase: VP_Letter_A := VP_LETTER_A_UC;
csLowercase: VP_Letter_A := VP_LETTER_A_LC;
end;
btnHeight := ScaleY(FButtonHeight, DesignTimeDPI);
btnWidth := ScaleX(FButtonWidth, DesignTimeDPI);
brdrWidth := ScaleX(FBorderWidth, DesignTimeDPI);
@ -276,8 +290,8 @@ begin
ButtonLetters := VP_LETTERS_IN_ALPHABET / FButtonCount;
for i := 0 to FButtonCount - Offset - 1 do begin
StartLetter := Chr(Round(VP_LETTER_A + ButtonLetters * I));
EndLetter := Chr(Round(VP_LETTER_A + ButtonLetters * (I + 1)) - 1);
StartLetter := Chr(round(VP_Letter_A + ButtonLetters * I));
EndLetter := Chr(round(VP_Letter_A + ButtonLetters * (I + 1) - 1));
if Ord(EndLetter) = Ord(StartLetter) then
ButtonCaption := StartLetter
@ -457,6 +471,15 @@ begin
end;
{=====}
procedure TVpContactButtonBar.SetCaptionStyle(const Value: TVpButtonCaptionStyle);
begin
if (FCaptionStyle <> Value) then begin
FCaptionStyle := Value;
CreateButtons;
Invalidate;
end;
end;
procedure TVpContactButtonBar.SetContactGrid(Value: TVpContactGrid);
begin
if (FContactGrid <> Value) then begin
@ -467,7 +490,6 @@ begin
end;
end;
end;
{=====}
procedure TVpContactButtonBar.bbPopulateSearchString;
var