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

jvcllaz: Add TJvXPButton

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5404 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-12-04 16:25:15 +00:00
parent 4789d0cffa
commit 0e82c11b1e
10 changed files with 1240 additions and 322 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
components/jvcllaz/examples/JvXPBar/MainFrm.lfm
View File

@ -284,41 +284,41 @@ object frmMain: TfrmMain
ParentColor = False ParentColor = False
ParentFont = False ParentFont = False
end end
object btnCollapseAll: TButton object btnCollapseAll: TJvXPButton
Left = 8 Left = 8
Height = 25 Height = 25
Top = 48 Top = 48
Width = 75 Width = 75
Caption = 'Collapse All' Caption = 'Collapse All'
OnClick = btnCollapseAllClick
TabOrder = 0 TabOrder = 0
OnClick = btnCollapseAllClick
end end
object btnExpandAll: TButton object btnExpandAll: TJvXPButton
Left = 88 Left = 88
Height = 25 Height = 25
Top = 48 Top = 48
Width = 75 Width = 75
Caption = 'Expand All' Caption = 'Expand All'
OnClick = btnExpandAllClick
TabOrder = 1 TabOrder = 1
OnClick = btnExpandAllClick
end end
object btnToogleEnableMode: TButton object btnToogleEnableMode: TJvXPButton
Left = 8 Left = 8
Height = 25 Height = 25
Top = 80 Top = 80
Width = 153 Width = 153
Caption = 'Toggle Enable Mode' Caption = 'Toggle Enable Mode'
OnClick = btnToogleEnableModeClick
TabOrder = 2 TabOrder = 2
OnClick = btnToogleEnableModeClick
end end
object btnToggleVisibleMode: TButton object btnToggleVisibleMode: TJvXPButton
Left = 8 Left = 8
Height = 25 Height = 25
Top = 112 Top = 112
Width = 153 Width = 153
Caption = 'Toggle Visible Mode' Caption = 'Toggle Visible Mode'
OnClick = btnToggleVisibleModeClick
TabOrder = 3 TabOrder = 3
OnClick = btnToggleVisibleModeClick
end end
object chkGrouped: TCheckBox object chkGrouped: TCheckBox
Left = 24 Left = 24

11
components/jvcllaz/examples/JvXPBar/MainFrm.pas
View File

@ -7,8 +7,7 @@ interface
uses uses
SysUtils, Classes, Graphics, Controls, Forms, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, JvXPCore, JvXPBar, JvXPContainer, ImgList, ActnList, ExtCtrls, Dialogs, JvXPCore, JvXPBar, JvXPContainer, ImgList, ActnList, ExtCtrls,
StdCtrls, ComCtrls, JvExControls, JvComponent {, JvXPCheckCtrls, JvXPButtons} StdCtrls, ComCtrls, JvExControls, JvComponent {, JvXPCheckCtrls}, JvXPButtons;
;
resourcestring resourcestring
SClickEventAc = ' You clicked on the action "%s"...'; SClickEventAc = ' You clicked on the action "%s"...';
@ -27,16 +26,16 @@ type
acSettingsUsers: TAction; acSettingsUsers: TAction;
acSynchronizeUnknown: TAction; acSynchronizeUnknown: TAction;
acSynchronizeWeb: TAction; acSynchronizeWeb: TAction;
btnCollapseAll: TButton; // was: TJvXPButton; btnCollapseAll: TJvXPButton;
btnExpandAll: TButton; // was: TJvXPButton; btnExpandAll: TJvXPButton;
cntDetails: TJvXPContainer; cntDetails: TJvXPContainer;
cntWinXPBar: TJvXPContainer; cntWinXPBar: TJvXPContainer;
imlWinXPBar: TImageList; imlWinXPBar: TImageList;
lbWelcome: TLabel; lbWelcome: TLabel;
sbxWinXPBar: TScrollBox; sbxWinXPBar: TScrollBox;
spltMain: TSplitter; spltMain: TSplitter;
btnToogleEnableMode: TButton; // was: TJvXPButton; btnToogleEnableMode: TJvXPButton;
btnToggleVisibleMode: TButton; // was: TJvXPButton; btnToggleVisibleMode: TJvXPButton;
ilOldButtons: TImageList; ilOldButtons: TImageList;
chkGrouped: TCheckbox; // was: TJvXPCheckbox; chkGrouped: TCheckbox; // was: TJvXPCheckbox;
ilWhiteButtons: TImageList; ilWhiteButtons: TImageList;

4
components/jvcllaz/packages/JvNavigationPaneReg.pp
View File

@ -10,7 +10,9 @@ uses
procedure Register; procedure Register;
implementation implementation
uses JvNavigationPane;
uses
JvNavigationPane;
procedure Register; procedure Register;
begin begin

6
components/jvcllaz/packages/JvXPBarLaz.lpk
View File

@ -24,7 +24,7 @@
"/> "/>
<License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/> <License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
<Version Major="1" Release="1"/> <Version Major="1" Release="1"/>
<Files Count="5"> <Files Count="6">
<Item1> <Item1>
<Filename Value="..\run\JvXPCoreUtils.pas"/> <Filename Value="..\run\JvXPCoreUtils.pas"/>
<UnitName Value="JvXPCoreUtils"/> <UnitName Value="JvXPCoreUtils"/>
@ -46,6 +46,10 @@
<Filename Value="..\run\JvXPContainer.pas"/> <Filename Value="..\run\JvXPContainer.pas"/>
<UnitName Value="JvXPContainer"/> <UnitName Value="JvXPContainer"/>
</Item5> </Item5>
<Item6>
<Filename Value="..\run\JvXPButtons.pas"/>
<UnitName Value="JvXPButtons"/>
</Item6>
</Files> </Files>
<RequiredPkgs Count="3"> <RequiredPkgs Count="3">
<Item1> <Item1>

2
components/jvcllaz/packages/JvXPBarLaz.pas
View File

@ -8,7 +8,7 @@ unit JvXPBarLaz;
interface interface
uses uses
JvXPCoreUtils, JvXPBar, JvXPCore, JvXPBarReg, JvXPContainer, JvXPCoreUtils, JvXPBar, JvXPCore, JvXPBarReg, JvXPContainer, JvXPButtons,
LazarusPackageIntf; LazarusPackageIntf;
implementation implementation

8
components/jvcllaz/packages/JvXPBarReg.pp
View File

@ -12,11 +12,15 @@ procedure Register;
implementation implementation
uses uses
JvXPBar, JvXPContainer; JvXPBar, JvXPContainer, JvXPButtons;
procedure Register; procedure Register;
begin begin
RegisterComponents('JvXP',[TJvXPBar, TJvXPContainer]); RegisterComponents('JvXP', [
TJvXPBar,
TJvXPContainer,
TJvXPButton
]);
end; end;
initialization initialization

200
components/jvcllaz/resource/JvXPBarLaz.lrs
View File

@ -1,154 +1,50 @@
LazarusResources.Add('TJvXPBar','BMP',[ LazarusResources.Add('TJvXPBar','PNG',[
'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0 #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
+#192#6#0#0#18#11#0#0#18#11#0#0#0#0#0#0#0#0#0#0#192#0#224#0#224#192#0#224#192 +#0#0#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#1#31'IDATH'#137#237'U1R'
+#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224 +#195'0'#16#220'c'#244#0#26#170'0'#19#215'<'#128#142#193#159'H'#159#159'X~B~'
+#192#0#224#192#0#224#192#0#224#160#0#224#160#0#224#160#255#255#0#255#0#0#255 +#16'^'#145'V'#12'T< '#245'5'#169#210'P'#209'.'#133'##'''#202'%&'#10#21';'#163
+#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0#224#192#0#0#0#0#0#0#0#0#0#0#0 +#153#147'%'#239#222#158#229#147'h'#0#17'Q'#161#8'4'#137']J^'#21#18#8#137#130
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#224#192#0#0#0#0#0#0#0#0#0#0#224#192#0#224#160#0 +'K'#201'I'#230#246#143#134#136#244'".%'#127'y'#199'G'#9#1#6#191#146#202'7A'
+#0#0#255#255#0#255#0#0#255#0#0#0#255#255#0#255#255#255#0#0#255#0#0#255#0#0#0 +#211#18']'#128#249#147'<'#198'x'#249#198'A'#146'7%'#4'"'#233'>y1'#129'c'#228
+#224#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192 +#0#0'U'#16#184#206#8#10#246#223#128'$6[|'#150'p3Y'#183#11#169'}'#3#20','#209
+#192#192#192#192#192#192#192#0#224#192#0#0#0#0#224#192#0#224#192#0#0#0#0#224 +'1'#252#11#152#208'k'#11#224'/'#4'D'#21#140#189#232'7'#199#244#254#14#183#214
+#192#0#224#160#255#255#0#255#0#0#0#255#255#255#0#0#255#0#0#0#255#255#255#0#0 +#250#160#23'M'#214#237'b'#172#0#158#155#6'b'#172'_'#252''''#147#4#134#131'D'
+#255#0#0#0#224#224#128#128#128#128#128#128#128#128#128#128#128#128#128#128 +#31#187#157'H''6:}'#160'>'#181#225#28#7'A'#15#231#253#179's'#28'0'#248#214'J'
+#128#128#128#128#128#128#128#128#128#128#0#224#192#0#0#0#0#224#192#0#224#192 +#226#21']_'#137#183'T]uq'#208#31#7#164'@'#228#240'Ft'#10'`'#250'0'#179#157'~'
+#0#0#0#0#224#192#0#224#192#255#255#0#255#0#0#0#255#255#255#0#0#255#0#0#0#255 +#249#188'{'#243#165#29#246#237#231'F'#174'D'#203'L'#137#216#205#6#229#18'E'
+#255#255#0#0#255#0#0#0#224#224#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 +#160#170'm'#192#202'|>%'#172'c'#250#13'w'#228#229'NGO\?'#0#0#0#0'IEND'#174'B'
+#0#0#224#192#0#0#0#0#0#0#0#0#0#0#224#192#0#224#192#0#0#0#255#255#0#255#0#0 +'`'#130
+#255#0#0#255#0#0#255#0#0#0#255#255#255#0#0#255#0#0#0#224#224#0#224#224#0#224
+#224#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0
+#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#255#255#0#255#0#0
+#255#0#0#255#0#0#255#0#0#0#255#255#255#0#0#255#0#0#0#224#224#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#255#255#0#255#0#0#255#0#0#255#0#0#255#0#0#0#255#255#255#0#0#255#0#0#0#224
+#224#0#0#0#255#255#255#128#128#128#128#128#128#128#128#128#128#128#128#128
+#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
+#128#128#128#128#128#128#128#255#255#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0
+#0#255#0#0#255#0#0#0#224#224#0#0#0#255#255#255#247#223#214#247#223#214#247
+#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223
+#214#247#223#214#247#223#214#247#223#214#247#223#214#255#255#0#255#255#0#255
+#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#224#224#0#0#0#255
+#255#255#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223
+#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214
+#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214#128
+#128#128#0#0#0#0#224#160#0#224#224#0#0#0#255#255#255#247#223#214#247#223#214
+#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247
+#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223
+#214#247#223#214#247#223#214#247#223#214#128#128#128#0#0#0#0#224#160#0#224
+#224#0#0#0#255#255#255#247#223#214#247#223#214#247#223#214#247#223#214#247
+#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223
+#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214
+#247#223#214#128#128#128#0#0#0#0#224#160#0#224#224#0#0#0#255#255#255#247#223
+#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214
+#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247
+#223#214#247#223#214#247#223#214#247#223#214#247#223#214#128#128#128#0#0#0#0
+#224#192#0#224#224#0#0#0#255#255#255#247#223#214#247#223#214#247#223#214#247
+#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223
+#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214
+#247#223#214#247#223#214#128#128#128#0#0#0#0#224#192#0#224#224#0#0#0#255#255
+#255#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214
+#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247
+#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214#128#128
+#128#0#0#0#0#224#192#0#224#224#0#0#0#255#255#255#247#223#214#247#223#214#247
+#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223
+#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214#247#223#214
+#247#223#214#247#223#214#247#223#214#128#128#128#0#0#0#0#224#192#0#224#224#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#224#192#0#224#224#0
+#0#0#255#255#255#228#167'~'#228#167'~'#228#167'~'#228#167'~'#228#167'~'#228
+#167'~'#228#167'~'#228#167'~'#228#167'~'#228#167'~'#228#167'~'#228#167'~'#228
+#167'~'#228#167'~'#228#167'~'#228#167'~'#228#167'~'#228#167'~'#128#128#128#0
+#0#0#0#224#192#0#224#224#0#0#0#255#255#255#228#167'~'#228#167'~'#228#167'~'
+#228#167'~'#228#167'~'#228#167'~'#228#167'~'#228#167'~'#228#167'~'#228#167'~'
+#228#167'~'#228#167'~'#228#167'~'#228#167'~'#228#167'~'#0#0#0#228#167'~'#228
+#167'~'#128#128#128#0#0#0#0#224#192#0#224#224#0#0#0#255#255#255#228#167'~'
+#228#167'~'#228#167'~'#228#167'~'#228#167'~'#228#167'~'#228#167'~'#228#167'~'
+#228#167'~'#228#167'~'#228#167'~'#228#167'~'#228#167'~'#228#167'~'#0#0#0#0#0
,#0#0#0#0#228#167'~'#128#128#128#0#0#0#0#224#192#0#224#224#0#0#0#255#255#255
+#228#167'~'#228#167'~'#228#167'~'#228#167'~'#228#167'~'#228#167'~'#228#167'~'
+#228#167'~'#228#167'~'#228#167'~'#228#167'~'#228#167'~'#228#167'~'#228#167'~'
+#228#167'~'#228#167'~'#228#167'~'#228#167'~'#128#128#128#0#0#0#0#224#192#0
+#192#224#0#224#224#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255
+#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
+#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
+#255#255#255#0#0#0#0#224#192#0#224#192#0#192#224#0#192#224#0#224#224#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+#0#0#0#0#0#0#0#0#0#0#0#0#0#224#192#0#224#192#0#224#192#0#192#224#0#192#224#0
+#192#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224
+#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0
+#224#224#0#224#224#0#224#224#0#224#224#0#224#192#0#224#192#0#224#192
]); ]);
LazarusResources.Add('TJvXPContainer','BMP',[ LazarusResources.Add('TJvXPContainer','PNG',[
'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0 #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
+#192#6#0#0#18#11#0#0#18#11#0#0#0#0#0#0#0#0#0#0#192#0#224#0#224#192#0#224#192 +#0#0#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#1#17'IDATH'#137#173'U'
+#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224 +#203#177#195' '#12'\2'#233#195#156'S'#5'M'#228#158'N'#158'_'')'#133't'#178'U'
+#192#0#224#192#0#224#192#0#224#160#0#224#160#0#224#160#255#255#0#255#0#0#255 +#228#170'w'#16#248#201'6&'#128#179'3'#26#137#143#214#187#140#7#28'#'#4#25#30
+#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0#224#192#0#0#0#0#0#0#0#0#0#0#0 +'_'#1'W'#3#253#128#144#223#201'1'#229'\;FHI'#185#247#0#185#159'oU'#30'<'#16#9
+#0#0#0#0#0#0#0#0#0#0#0#0#0#0#224#192#0#0#0#0#0#0#0#0#0#0#224#192#0#224#160#0 +'8'#18'2BV#'#183#184#0'J'#238#189'N'#140'd&'#197'('#228#211#14'>'#181'-'#14
+#0#0#255#255#0#255#0#0#255#0#0#0#255#255#0#255#255#255#0#0#255#0#0#255#0#0#0 +#182#200#10'G'#201'O;h'#221'>'#228#160#133'|'#216'A'#227#182#5']'#14'z'#200
+#224#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192 +#187#29#244#144'[49'#24'!'#15'^'#251'>:'#24'!'#183'}U'#7'g'#200#31'^'#235'C'
+#192#192#192#192#192#192#192#0#224#192#0#0#0#0#224#192#0#224#192#0#0#0#0#224 +#7#173#228'a'#146#234#250'%'#23#173'w'#203'6'#171#204#227'p'#233#30#239'V'
+#192#0#224#160#255#255#0#255#0#0#0#255#255#255#0#0#255#0#0#0#255#255#255#0#0 +#158#17'&Q2'#3#17#7#231'd'#237'`'#132#188#9'4/'#208'QD'#238#199#203#156#136#0
+#255#0#0#0#224#224#128#128#128#128#128#128#128#128#128#128#128#128#128#128 +#235#16#193'R_'#1'@'#226#252'['#19#241#194#252#3#232#11#5#252#191'V'#145'@H{'
+#128#128#128#128#128#128#128#128#128#128#0#224#192#0#0#0#0#224#192#0#224#192 +#236#177'X\'#9'`'#186#221#195'n'#197#226'='#151#221'W'#155#18#182#246'KQ:'
+#0#0#0#0#224#192#0#224#192#255#255#0#255#0#0#0#255#255#255#0#0#255#0#0#0#255 +#162'g'#225#136'DG'#171#227'rD'#20#178'n'#160#166#252'Q'#248#139','#254#0#27
+#255#255#0#0#255#0#0#0#224#224#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 +'='#239'S'#30'9'#228#160#0#0#0#0'IEND'#174'B`'#130
+#0#0#224#192#0#0#0#0#0#0#0#0#0#0#224#192#0#224#192#0#0#0#255#255#0#255#0#0 ]);
+#255#0#0#255#0#0#255#0#0#0#255#255#255#0#0#255#0#0#0#224#224#0#224#224#0#224 LazarusResources.Add('TJvXPButton','PNG',[
+#224#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0 #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
+#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#255#255#0#255#0#0 +#0#0#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#1'0IDATH'#137#181'U;'#146
+#255#0#0#255#0#0#255#0#0#0#255#255#255#0#0#255#0#0#0#224#224#0#224#224#0#224 +#132' '#16'}Ly'#133'1'#213'X'#15#1#151#152'|o'#178#238'M&'#223'K'#192'!4'#238
+#224#0#224#224#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0 +#152#201'7'#237#13#20'Ddp'#166#6'_U'#151#141#192'{'#253'A'#20#164#193'phQ'#4
+#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#255#255#0#255#0#0 +#20#248#151'3'#201'W'#129#147#200'g'#129#19#201'g'#129#19#201#1#160'rN'#219
+#255#0#0#255#0#0#255#0#0#0#255#255#255#0#0#255#0#0#0#224#224#0#0#0#0#0#0#0 +#150#144'Z'#161#23#213#139'#g;'#26'fF'#17#179#163'Qm'#148#1#174#157#196'c2E'
+#224#224#0#0#0#0#224#192#0#0#0#0#224#192#0#0#0#0#224#192#0#0#0#0#224#192#0#0 +#194#159'~5'#0#233'38'#130#168'{)'#234'^'#134#227#240#153#195#161#128#168'{'
+#0#0#224#192#0#0#0#0#224#192#255#255#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0 +#201'v4lG'#19#139#176#29#15'3.r'#138'>'#18'p'#145#199#17#199#25'=Cu'#180#192
+#0#255#0#0#255#0#0#0#224#224#0#0#0#0#224#224#0#224#224#0#224#224#0#224#224#0 +#145#165#198'G%'#162#141#192'c2K'#247'?GwS'#192#0#0#16'D'#243'mZ'#250'C'#187
+#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224 +#19#182#2'1'#232'E"'#213'$'#183'{${'#240'*'#185#135'x>'#181';Eo'#147''''#192
+#192#0#224#192#0#224#192#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0 +#188'*n'#4'J'#144#239#176#244' k'#154#246'c'#255#142#153#129#173'1'#195#251
+#255#255#0#255#255#0#255#255#0#0#224#224#0#224#224#0#224#224#0#224#224#0#224 +#21#0#176#30'~rA'#24#12#223#192'z'#5#171'v'#246'5'#1'jY'#195', '#196#190#225
+#224#0#224#224#0#0#0#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224 +#21#1'h'#186#155#218#205#132#248#27#210#217'g7-'#136#211'OY'#170'D'#247'D'
+#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0 +#137#220#239' ,'#151' h&'#202''''#144#139#252#171#225#236'1'#253#7#147#182
+#224#192#0#224#160#0#0#0#0#224#160#0#224#224#0#0#0#0#224#224#0#224#224#0#224 +#239#202'!'#176#21#156#0#0#0#0'IEND'#174'B`'#130
+#224#0#224#224#0#224#224#0#224#224#0#224#192#0#224#192#0#224#192#0#224#192#0
+#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224
+#192#0#224#192#0#224#192#0#224#160#0#224#160#0#224#224#0#224#224#0#224#224#0
+#224#224#0#224#224#0#224#224#0#0#0#0#224#224#0#224#224#0#224#192#0#224#192#0
+#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224
+#192#0#224#192#0#224#192#0#224#192#0#0#0#0#224#160#0#224#224#0#0#0#0#224#224
+#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224
+#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0
+#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#224#0#224
+#224#0#224#224#0#224#224#0#224#224#0#224#224#0#0#0#0#224#224#0#224#224#0#224
+#224#0#224#224#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0
+#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#0#0#0#224#192#0#224#224#0
+#0#0#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0
+#224#224#0#224#224#0#224#224#0#224#192#0#224#192#0#224#192#0#224#192#0#224
+#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0
+#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#0#0#0#224#224#0
+#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#192#0#224#192#0#224
+#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#0#0#0#224
+#192#0#224#224#0#0#0#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224
+#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#192#0
+#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224
+#192#0#224#192#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0
+#0#0#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0
+#224#224#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0#224
+#192#0#0#0#0#224#192#0#224#224#0#0#0#0#224#224#0#224#224#0#224#224#0#224#224
+#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224
+#224#0#224#224#0#224#224#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0
+#224#192#0#224#192#0#224#192#0#224#224#0#224#224#0#0#0#0#224#224#0#0#0#0#224
+#224#0#0#0#0#224#224#0#0#0#0#224#224#0#0#0#0#224#224#0#0#0#0#224#224#0#0#0#0
+#224#224#0#0#0#0#224#192#0#0#0#0#224#192#0#0#0#0#224#192#0#0#0#0#224#192#0
+#224#224#0#0#0#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0
+#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224
+#224#0#224#224#0#224#224#0#224#192#0#224#192#0#224#192#0#224#192#0#224#192#0
,#224#192#0#192#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#0#0#0
+#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224
+#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#192#0#224#192#0#224#192#0
+#0#0#0#224#192#0#192#224#0#0#0#0#224#224#0#0#0#0#224#224#0#0#0#0#224#224#0#0
+#0#0#224#224#0#0#0#0#224#224#0#0#0#0#224#224#0#0#0#0#224#224#0#0#0#0#224#224
+#0#0#0#0#224#224#0#0#0#0#224#192#0#0#0#0#0#0#0#224#192#0#192#224#0#192#224#0
+#192#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224
+#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0#224#224#0
+#224#224#0#224#224#0#224#224#0#224#224#0#224#192#0#224#192#0#224#192
]); ]);

999
components/jvcllaz/run/JvXPButtons.pas Normal file
View File

@ -0,0 +1,999 @@
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.
The Original Code is: JvXPButtons.PAS, released on 2004-01-01.
The Initial Developer of the Original Code is Marc Hoffman.
Portions created by Marc Hoffman are Copyright (C) 2002 APRIORI business solutions AG.
Portions created by APRIORI business solutions AG are Copyright (C) 2002 APRIORI business solutions AG
All Rights Reserved.
Contributor(s):
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net
Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvXPButtons.pas 11167 2007-01-27 18:57:52Z obones $
{$MODE DELPHI}
unit JvXPButtons;
interface
uses
Classes, TypInfo, LCLIntf, LCLType, LCLProc, LMessages, Graphics,
Controls, Forms, ActnList, ImgList, Menus,
JvXPCore, JvXPCoreUtils;
type
TJvXPCustomButtonActionLink = class(TWinControlActionLink)
protected
function IsImageIndexLinked: Boolean; override;
procedure AssignClient(AClient: TObject); override;
procedure SetImageIndex(Value: Integer); override;
public
destructor Destroy; override;
end;
TJvXPLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom);
// TJvXPCustomButton = class(TJvXPCustomStyleControl)
TJvXPCustomButton = class(TJvXPCustomControl)
private
FAutoGray: Boolean;
FBgGradient: TBitmap;
FCancel: Boolean;
FCkGradient: TBitmap;
FDefault: Boolean;
FFcGradient: TBitmap;
FGlyph: TPicture;
FHlGradient: TBitmap;
FImageChangeLink: TChangeLink;
FImageIndex: Integer;
FLayout: TJvXPLayout;
FShowAccelChar: Boolean;
FShowFocusRect: Boolean;
FSmoothEdges: Boolean;
FSpacing: Byte;
FWordWrap: Boolean;
procedure CMDialogKey(var Msg: TCMDialogKey); message CM_DIALOGKEY;
procedure GlyphChange(Sender: TObject);
procedure ImageListChange(Sender: TObject);
protected
function GetActionLinkClass: TControlActionLinkClass; override;
function IsSpecialDrawState(IgnoreDefault: Boolean = False): Boolean;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
procedure SetAutoGray(Value: Boolean); virtual;
procedure SetDefault(Value: Boolean); virtual;
procedure SetGlyph(Value: TPicture); virtual;
procedure SetLayout(Value: TJvXPLayout); virtual;
procedure SetShowAccelChar(Value: Boolean); virtual;
procedure SetShowFocusRect(Value: Boolean); virtual;
procedure SetSmoothEdges(Value: Boolean); virtual;
procedure SetSpacing(Value: Byte); virtual;
procedure SetWordWrap(Value: Boolean); virtual;
procedure Paint; override;
procedure HookResized; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
procedure UpdateBitmaps;
// advanced properties.
property AutoGray: Boolean read FAutoGray write SetAutoGray default True;
property Cancel: Boolean read FCancel write FCancel default False;
property Default: Boolean read FDefault write SetDefault default False;
property Glyph: TPicture read FGlyph write SetGlyph;
property Layout: TJvXPLayout read FLayout write SetLayout default blGlyphLeft;
property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar default True;
property ShowFocusRect: Boolean read FShowFocusRect write SetShowFocusRect default False;
property SmoothEdges: Boolean read FSmoothEdges write SetSmoothEdges default True;
property Spacing: Byte read FSpacing write SetSpacing default 3;
property WordWrap: Boolean read FWordWrap write SetWordWrap default True;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Click; override;
procedure Loaded ; override;
published
// property TabStop default True;
// property UseDockManager default True;
end;
TJvXPButton = class(TJvXPCustomButton)
published
// common properties.
property Action;
property Caption;
property Enabled;
property TabOrder;
property TabStop default True;
property Height default 21;
property Width default 73;
// advanced properties.
property AutoGray;
property Cancel;
property Default;
property Glyph;
property Layout;
property ModalResult;
property ShowAccelChar;
property ShowFocusRect;
property SmoothEdges;
property Spacing;
property WordWrap;
//property BevelInner;
//property BevelOuter;
//property BevelWidth;
//property BiDiMode;
//property Ctl3D;
//property DockSite;
//property ParentBiDiMode;
//property ParentCtl3D;
//property TabOrder;
//property TabStop;
property UseDockManager default True;
property Align;
property Anchors;
//property AutoSize;
property Constraints;
property DragCursor;
property DragKind;
// property OnCanResize;
property DragMode;
// property Enabled;
property Font;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
// property Style;
// property StyleManager;
property Visible;
//property OnDockDrop;
//property OnDockOver;
//property OnEndDock;
//property OnGetSiteInfo;
//property OnStartDock;
//property OnUnDock;
property OnClick;
property OnConstrainedResize;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
end;
TJvXPToolType =
(ttArrowLeft, ttArrowRight, ttClose, ttMaximize, ttMinimize, ttPopup, ttRestore, ttImage);
TJvXPCustomToolButton = class(TJvXPCustomControl)
private
FToolType: TJvXPToolType;
FDropDownMenu: TPopupMenu;
FChangeLink: TChangeLink;
FImages: TCustomImageList;
FImageIndex: TImageIndex;
procedure SetImages(const Value: TCustomImageList);
procedure SetImageIndex(const Value: TImageIndex);
procedure SetDropDownMenu(const Value: TPopupMenu);
procedure DoImagesChange(Sender: TObject);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X: Integer; Y: Integer); override;
procedure SetToolType(Value: TJvXPToolType); virtual;
procedure Paint; override;
procedure HookResized; override;
property ToolType: TJvXPToolType read FToolType write SetToolType default ttClose;
property DropDownMenu: TPopupMenu read FDropDownMenu write SetDropDownMenu;
property Images: TCustomImageList read FImages write SetImages;
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
TJvXPToolButton = class(TJvXPCustomToolButton)
published
property Enabled;
property Color default clBlack;
property Height default 15;
property ToolType;
property Width default 15;
//property BevelInner;
//property BevelOuter;
//property BevelWidth;
//property BiDiMode;
//property Ctl3D;
//property DockSite;
//property ParentBiDiMode;
//property ParentCtl3D;
//property TabOrder;
//property TabStop;
//property UseDockManager default True;
property Align;
property Anchors;
//property AutoSize;
property Constraints;
property DragCursor;
property DragKind;
//property OnCanResize;
property DragMode;
property DropDownMenu;
property Images;
property ImageIndex;
// property Enabled;
property Font;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
// property Style;
// property StyleManager;
property Visible;
//property OnDockDrop;
//property OnDockOver;
//property OnEndDock;
//property OnGetSiteInfo;
//property OnStartDock;
//property OnUnDock;
property OnClick;
property OnConstrainedResize;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
end;
{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
UnitVersioning: TUnitVersionInfo = (
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvXPButtons.pas $';
Revision: '$Revision: 11167 $';
Date: '$Date: 2007-01-27 19:57:52 +0100 (sam., 27 janv. 2007) $';
LogPath: 'JVCL\run'
);
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}
implementation
//=== { TJvXPCustomButtonActionLink } ========================================
destructor TJvXPCustomButtonActionLink.Destroy;
begin
TJvXPCustomButton(FClient).Invalidate;
inherited Destroy;
end;
procedure TJvXPCustomButtonActionLink.AssignClient(AClient: TObject);
begin
inherited AssignClient(AClient);
FClient := AClient as TJvXPCustomButton;
end;
function TJvXPCustomButtonActionLink.IsImageIndexLinked: Boolean;
begin
Result := True;
end;
procedure TJvXPCustomButtonActionLink.SetImageIndex(Value: Integer);
begin
inherited SetImageIndex(Value);
(FClient as TJvXPCustomButton).FImageIndex := Value;
(FClient as TJvXPCustomButton).Invalidate;
end;
//=== { TJvXPCustomButton } ==================================================
constructor TJvXPCustomButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
// create ...
FBgGradient := TBitmap.Create; // background gradient
FCkGradient := TBitmap.Create; // clicked gradient
FFcGradient := TBitmap.Create; // focused gradient
FHlGradient := TBitmap.Create; // Highlight gradient
// set default properties.
ControlStyle := ControlStyle - [csDoubleClicks];
Height := 21;
Width := 73;
TabStop := True;
UseDockManager := true;
// set custom properties.
FAutoGray := True;
FCancel := False;
FDefault := False;
FImageIndex := -1;
FImageChangeLink := TChangeLink.Create;
FImageChangeLink.OnChange := ImageListChange;
FGlyph := TPicture.Create;
FGlyph.OnChange := GlyphChange;
FLayout := blGlyphLeft;
FShowAccelChar := True;
FShowFocusRect := False;
FSmoothEdges := True;
FSpacing := 3;
FWordWrap := True;
end;
destructor TJvXPCustomButton.Destroy;
begin
FBgGradient.Free;
FCkGradient.Free;
FFcGradient.Free;
FHlGradient.Free;
FGlyph.Free;
FImageChangeLink.OnChange := nil;
FImageChangeLink.Free;
FImageChangeLink := nil;
inherited Destroy;
end;
procedure TJvXPCustomButton.Click;
begin
// Only there to make it public (Mantis 4015)
inherited Click;
end;
procedure TJvXPCustomButton.Loaded;
begin
inherited Loaded;
//HookResized;
end;
function TJvXPCustomButton.GetActionLinkClass: TControlActionLinkClass;
begin
Result := TJvXPCustomButtonActionLink;
end;
procedure TJvXPCustomButton.CMDialogKey(var Msg: TCMDialogKey);
begin
inherited;
with Msg do
if (((CharCode = VK_RETURN) and (Focused or (FDefault and not (IsSibling)))) or
((CharCode = VK_ESCAPE) and FCancel) and (KeyDataToShiftState(KeyData) = [])) and
CanFocus then
begin
Click;
Result := 1;
end
else
inherited;
end;
procedure TJvXPCustomButton.SetAutoGray(Value: Boolean);
begin
if Value <> FAutoGray then
begin
FAutoGray := Value;
LockedInvalidate;
end;
end;
procedure TJvXPCustomButton.SetDefault(Value: Boolean);
begin
if Value <> FDefault then
begin
FDefault := Value;
if GetParentForm(Self) <> nil then
with GetParentForm(Self) do
Perform(CM_FOCUSCHANGED, 0, PtrInt(ActiveControl));
end;
end;
procedure TJvXPCustomButton.SetGlyph(Value: TPicture);
begin
FGlyph.Assign(Value);
LockedInvalidate;
end;
procedure TJvXPCustomButton.SetLayout(Value: TJvXPLayout);
begin
if Value <> FLayout then
begin
FLayout := Value;
LockedInvalidate;
end;
end;
procedure TJvXPCustomButton.SetShowAccelChar(Value: Boolean);
begin
if Value <> FShowAccelChar then
begin
FShowAccelChar := Value;
LockedInvalidate;
end;
end;
procedure TJvXPCustomButton.SetShowFocusRect(Value: Boolean);
begin
if Value <> FShowFocusRect then
begin
FShowFocusRect := Value;
LockedInvalidate;
end;
end;
procedure TJvXPCustomButton.SetSmoothEdges(Value: Boolean);
begin
if Value <> FSmoothEdges then
begin
FSmoothEdges := Value;
LockedInvalidate;
end;
end;
procedure TJvXPCustomButton.SetSpacing(Value: Byte);
begin
if Value <> FSpacing then
begin
FSpacing := Value;
LockedInvalidate;
end;
end;
procedure TJvXPCustomButton.SetWordWrap(Value: Boolean);
begin
if Value <> FWordWrap then
begin
FWordWrap := Value;
LockedInvalidate;
end;
end;
procedure TJvXPCustomButton.ImageListChange(Sender: TObject);
begin
if Assigned(Action) and (Sender is TCustomImageList) and
Assigned(TAction(Action).ActionList.Images) and
((TAction(Action).ImageIndex < (TAction(Action).ActionList.Images.Count))) then
FImageIndex := TAction(Action).ImageIndex
else
FImageIndex := -1;
LockedInvalidate;
Paint;
end;
procedure TJvXPCustomButton.GlyphChange(Sender: TObject);
begin
LockedInvalidate;
Paint;
end;
procedure TJvXPCustomButton.KeyDown(var Key: Word; Shift: TShiftState);
begin
if (Shift = []) and (Key = VK_SPACE) then
begin
DrawState := DrawState + [dsHighlight];
HookMouseDown;
end;
inherited KeyDown(Key, Shift);
end;
procedure TJvXPCustomButton.KeyUp(var Key: Word; Shift: TShiftState);
var
Pos: TPoint;
begin
// it's not possible to call the 'HookMouseUp' or 'HookMouseLeave' methods,
// because we don't want to call their event handlers.
if dsClicked in DrawState then
begin
GetCursorPos(Pos);
Pos := ScreenToClient(Pos);
if not PtInRect(Bounds(0, 0, Width, Height), Pos) then
DrawState := DrawState - [dsHighlight];
DrawState := DrawState - [dsClicked];
LockedInvalidate;
Click;
end;
inherited KeyUp(Key, Shift);
end;
function TJvXPCustomButton.IsSpecialDrawState(IgnoreDefault: Boolean = False): Boolean;
begin
if dsClicked in DrawState then
Result := not (dsHighlight in DrawState)
else
Result := (dsHighlight in DrawState) or (dsFocused in DrawState);
if not IgnoreDefault then
Result := Result or (FDefault and CanFocus) and not IsSibling;
end;
procedure TJvXPCustomButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
inherited ActionChange(Sender, CheckDefaults);
if Sender is TCustomAction then
with TCustomAction(Sender) do
begin
if Assigned(TCustomAction(Sender).ActionList.Images) and
(FImageChangeLink.Sender <> TCustomAction(Sender).ActionList.Images) then
TCustomAction(Sender).ActionList.Images.RegisterChanges(FImageChangeLink);
if (ActionList <> nil) and (ActionList.Images <> nil) and
(ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
FImageIndex := ImageIndex;
LockedInvalidate;
end;
end;
procedure TJvXPCustomButton.HookResized;
begin
inherited HookResized;
UpdateBitmaps;
end;
procedure TJvXPCustomButton.UpdateBitmaps;
const
ColSteps = 64;
Dithering = True;
var
Offset: Integer;
begin
// calculate offset
Offset := 4 * (Integer(IsSpecialDrawState(True)));
// create gradient rectangles for...
// background
if (Width - (2 + Offset) > 0) and (Height - (2 + Offset) > 0)
then
JvXPCreateGradientRect(Width - (2 + Offset), Height - (2 + Offset),
dxColor_Btn_Enb_BgFrom_WXP, dxColor_Btn_Enb_BgTo_WXP, ColSteps, gsTop, Dithering,
FBgGradient);
if (Width - 2 > 0) and (Height - 2 > 0) then
begin
// clicked
JvXPCreateGradientRect(Width - 2, Height - 2, dxColor_Btn_Enb_CkFrom_WXP,
dxColor_Btn_Enb_CkTo_WXP, ColSteps, gsTop, Dithering, FCkGradient);
// focused
JvXPCreateGradientRect(Width - 2, Height - 2, dxColor_Btn_Enb_FcFrom_WXP,
dxColor_Btn_Enb_FcTo_WXP, ColSteps, gsTop, Dithering, FFcGradient);
// highlight
JvXPCreateGradientRect(Width - 2, Height - 2, dxColor_Btn_Enb_HlFrom_WXP,
dxColor_Btn_Enb_HlTo_WXP, ColSteps, gsTop, Dithering, FHlGradient);
end;
{
Invalidate;
Paint;
}
end;
{
procedure TJvXPCustomButton.HookResized;
begin
UpdateBitmaps;
inherited;
end;
}
procedure TJvXPCustomButton.SetBounds(ALeft, ATop, AWidth, AHeight: integer);
begin
inherited;
UpdateBitmaps;
end;
procedure TJvXPCustomButton.Paint;
var
Rect: TRect;
Offset, Flags: Integer;
DrawPressed: Boolean;
lImage: TPicture;
lBitmap: TBitmap;
begin
with Canvas do
begin
// clear background.
Rect := GetClientRect;
Brush.Color := Self.Color;
FillRect(Rect);
// draw gradient borders.
if IsSpecialDrawState and
( ((dsHighlight in DrawState) and (FHlGradient.Canvas.Handle <> 0)) or
(not (dsHighlight in DrawState) and (FFcGradient.Canvas.Handle <> 0))
)
then begin
lBitmap := TBitmap.Create;
try
if dsHighlight in DrawState then
lBitmap.Assign(FHlGradient)
else
lBitmap.Assign(FFcGradient);
BitBlt(Handle, 1, 1, Self.Width, Self.Height, lBitmap.Canvas.Handle, 0, 0, SRCCOPY);
finally
lBitmap.Free;
end;
end;
// draw background gradient...
if not ((dsHighlight in DrawState) and (dsClicked in DrawState)) then
begin
if (FBgGradient.Canvas.Handle <> 0) Then
begin
Offset := 2 * Integer(IsSpecialDrawState);
if (Self.Width - 3 * Offset > 1 + Offset) and
(Self.Height - 3 * Offset > 1 + Offset)
then
BitBlt(Handle, 1 + Offset, 1 + Offset, self.Width - 3 * Offset, Self.Height - 3 * Offset,
FBgGradient.Canvas.Handle, 0, 0, SRCCOPY);
end;
end
// ...or click gradient.
else
if (FCkGradient.Canvas.Handle <> 0) then
begin
BitBlt(Handle, 1, 1, Self.Width, Self.Height, FCkGradient.Canvas.Handle, 0, 0, SRCCOPY);
end;
// draw border lines.
if Enabled then
Pen.Color := dxColor_Btn_Enb_Border_WXP
else
Pen.Color := dxColor_Btn_Dis_Border_WXP;
Brush.Style := bsClear;
RoundRect(0, 0, Self.Width, Self.Height, 5, 5);
// draw border edges.
if FSmoothEdges and (Self.Width > 2) and (Self.Height > 2) then
begin
if Enabled then
Pen.Color := dxColor_Btn_Enb_Edges_WXP
else
Pen.Color := dxColor_Btn_Dis_Edges_WXP;
JvXPDrawLine(Canvas, 0, 1, 2, 0);
JvXPDrawLine(Canvas, Self.Width - 2, 0, Self.Width, 2);
JvXPDrawLine(Canvas, 0, Self.Height - 2, 2, Self.Height);
JvXPDrawLine(Canvas, Self.Width - 3, Self.Height, Self.Width, Self.Height - 3);
end;
// set drawing flags.
Flags := {DT_VCENTER or } DT_END_ELLIPSIS;
if FWordWrap then
Flags := Flags or DT_WORDBREAK;
// draw image & caption.
lImage := TPicture.Create;
try
// get image from action or glyph property.
if Assigned(Action) and Assigned(TAction(Action).ActionList.Images) and
(FImageIndex > -1) and (FImageIndex < TAction(Action).ActionList.Images.Count)
then
TAction(Action).ActionList.Images.GetBitmap(FImageIndex, lImage.Bitmap)
else
lImage.Assign(FGlyph);
// autogray image (if allowed).
if (lImage.Bitmap.Canvas.Handle <> 0) and FAutoGray and not Enabled then
JvXPConvertToGray2(lImage.Bitmap);
// assign canvas font (change HotTrack-Color, if necessary).
Font.Assign(Self.Font);
// calculate textrect.
if Assigned(lImage.Graphic) and not lImage.Graphic.Empty then
if Length(Caption) > 0 then
begin
case FLayout of
blGlyphLeft:
Inc(Rect.Left, lImage.Width + FSpacing);
blGlyphRight:
begin
Dec(Rect.Left, lImage.Width + FSpacing);
Dec(Rect.Right, (lImage.Width + FSpacing) * 2);
Flags := Flags or DT_RIGHT;
end;
blGlyphTop:
Inc(Rect.Top, lImage.Height + FSpacing);
blGlyphBottom:
Dec(Rect.Top, lImage.Height + FSpacing);
end;
end;
if Length(Caption) > 0 then
begin
JvXPRenderText(Self, Canvas, Caption, Font, Enabled, FShowAccelChar, Rect, Flags or DT_CALCRECT);
OffsetRect(Rect, (Self.Width - Rect.Right) div 2, (Self.Height - Rect.Bottom) div 2);
end;
// should we draw the pressed state?
DrawPressed := (dsHighlight in DrawState) and (dsClicked in DrawState);
if DrawPressed then
OffsetRect(Rect, 1, 1);
// draw image - if available.
if Assigned(lImage.Graphic) and not lImage.Graphic.Empty then
begin
lImage.Graphic.Transparent := True;
if Length(Caption) > 0 then
case FLayout of
blGlyphLeft:
Draw(Rect.Left - (lImage.Width + FSpacing), (Self.Height - lImage.Height) div 2 +
Integer(DrawPressed), lImage.Graphic);
blGlyphRight:
Draw(Rect.Right + FSpacing, (Self.Height - lImage.Height) div 2 +
Integer(DrawPressed), lImage.Graphic);
blGlyphTop:
Draw((Self.Width - lImage.Width) div 2 + Integer(DrawPressed),
Rect.Top - (lImage.Height + FSpacing), lImage.Graphic);
blGlyphBottom:
Draw((Self.Width - lImage.Width) div 2 + Integer(DrawPressed),
Rect.Bottom + FSpacing, lImage.Graphic);
end
else
// draw the glyph into the center
Draw((Self.Width - lImage.Width) div 2 + Integer(DrawPressed),
(Self.Height - lImage.Height) div 2 + Integer(DrawPressed), lImage.Graphic);
end;
// draw focusrect (if enabled).
if (dsFocused in DrawState) and FShowFocusRect then
begin
Brush.Style := bsSolid;
DrawFocusRect(Bounds(3, 3, Self.Width - 6, Self.Height - 6));
end;
// draw caption.
SetBkMode(Handle, Transparent);
JvXPRenderText(Self, Canvas, Caption, Font, Enabled, FShowAccelChar, Rect, Flags);
SetBkMode(Handle, OPAQUE);
finally
lImage.Free;
end;
end;
end;
// TJvXPCustomToolButton =====================================================
constructor TJvXPCustomToolButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle - [csDoubleClicks];
Color := clBlack;
FToolType := ttClose;
FChangeLink := TChangeLink.Create;
FChangeLink.OnChange := DoImagesChange;
// HookResized;
end;
destructor TJvXPCustomToolButton.Destroy;
begin
FChangeLink.Free;
inherited Destroy;
end;
procedure TJvXPCustomToolButton.HookResized;
begin
if ToolType <> ttImage then
begin
Height := 15;
Width := 15;
end;
end;
procedure TJvXPCustomToolButton.SetToolType(Value: TJvXPToolType);
begin
if Value <> FToolType then
begin
FToolType := Value;
LockedInvalidate;
end;
end;
procedure TJvXPCustomToolButton.Paint;
var
Rect: TRect;
lBitmap: TBitmap;
//Theme: TJvXPTheme;
Shifted: Boolean;
begin
with Canvas do
begin
Rect := GetClientRect;
Brush.Color := TJvXPWinControl(Parent).Color;
Brush.Style := bsSolid;
FillRect(Rect);
if csDesigning in ComponentState then
DrawFocusRect(Rect);
Brush.Style := bsClear;
{
Theme := Style.GetTheme;
if (Theme = WindowsXP) and (dsClicked in DrawState) and
not (dsHighlight in DrawState)
then
JvXPFrame3d(Self.Canvas, Rect, clWhite, clBlack);
}
if dsHighlight in DrawState then
begin
{
if Theme = WindowsXP then
JvXPFrame3d(Self.Canvas, Rect, clWhite, clBlack, dsClicked in DrawState)
else
}
begin
Pen.Color := dxColor_BorderLineOXP;
Rectangle(Rect);
InflateRect(Rect, -1, -1);
if dsClicked in DrawState then
Brush.Color := dxColor_BgCkOXP
else
Brush.Color := dxColor_BgOXP;
FillRect(Rect);
end;
end;
// Shifted := (Theme = WindowsXP) and (dsClicked in DrawState); wp
Shifted := dsClicked in DrawState;
if ToolType = ttImage then
begin
if (Images = nil) or (ImageIndex < 0) or (ImageIndex >= Images.Count) then
Exit;
Images.Draw(Canvas,
(Width - Images.Width) div 2 + Integer(Shifted),
(Height - Images.Height) div 2 + Integer(Shifted),
ImageIndex,
{$IFDEF COMPILER6_UP}
{$IFDEF VCL}
dsTransparent,
{$ENDIF VCL}
itImage,
{$ENDIF COMPILER6_UP}
Enabled);
end
else
begin
lBitmap := TBitmap.Create;
try
lBitmap.LoadFromLazarusResource(
PChar('JvXPCustomToolButton' + Copy(GetEnumName(TypeInfo(TJvXPToolType),
Ord(FToolType)), 3, MaxInt)));
{
lBitmap.Assign(nil); // fixes GDI resource leak
Bitmap.LoadFromResourceName(HInstance,
PChar('JvXPCustomToolButton' + Copy(GetEnumName(TypeInfo(TJvXPToolType),
Ord(FToolType)), 3, MaxInt)));
}
if (dsClicked in DrawState) and (dsHighlight in DrawState) then
JvXPColorizeBitmap(lBitmap, clWhite)
else
if not Enabled then
JvXPColorizeBitmap(lBitmap, clGray)
else
if Color <> clBlack then
JvXPColorizeBitmap(lBitmap, Color);
lBitmap.Transparent := True;
Draw((ClientWidth - lBitmap.Width) div 2 + Integer(Shifted),
(ClientHeight - lBitmap.Height) div 2 + Integer(Shifted), lBitmap);
finally
lBitmap.Free;
end;
end;
end;
end;
procedure TJvXPCustomToolButton.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
begin
if AComponent = DropDownMenu then
DropDownMenu := nil
else
if AComponent = Images then
Images := nil;
end;
end;
procedure TJvXPCustomToolButton.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
P: TPoint;
begin
inherited MouseDown(Button, Shift, X, Y);
if Assigned(DropDownMenu) then
begin
P := ClientToScreen(Point(0, Height));
DropDownMenu.Popup(P.X, P.Y);
// while PeekMessage(Msg, HWND_DESKTOP, WM_MOUSEFIRST, WM_MOUSELAST, PM_REMOVE) do
{nothing};
if GetCapture <> 0 then
SendMessage(GetCapture, LM_CANCELMODE, 0, 0);
end;
end;
procedure TJvXPCustomToolButton.SetImages(const Value: TCustomImageList);
begin
if FImages <> Value then
begin
if FImages <> nil then
FImages.UnRegisterChanges(FChangeLink);
FImages := Value;
if FImages <> nil then
begin
FImages.FreeNotification(Self);
FImages.RegisterChanges(FChangeLink);
end;
LockedInvalidate;
end;
end;
procedure TJvXPCustomToolButton.SetImageIndex(const Value: TImageIndex);
begin
if FImageIndex <> Value then
begin
FImageIndex := Value;
LockedInvalidate;
end;
end;
procedure TJvXPCustomToolButton.SetDropDownMenu(const Value: TPopupMenu);
begin
if FDropDownMenu <> Value then
begin
FDropDownMenu := Value;
if FDropDownMenu <> nil then
FDropDownMenu.FreeNotification(Self);
LockedInvalidate;
end;
end;
procedure TJvXPCustomToolButton.DoImagesChange(Sender: TObject);
begin
LockedInvalidate;
end;
{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
initialization
RegisterUnitVersion(HInstance, UnitVersioning);
finalization
UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}
end.

96
components/jvcllaz/run/JvXPCore.pas
View File

@ -36,7 +36,6 @@ interface
uses uses
Classes, Controls, Forms, Graphics, JvComponent, LCLIntf, LCLType, LMessages; Classes, Controls, Forms, Graphics, JvComponent, LCLIntf, LCLType, LMessages;
(******************** NOT CONVERTED
const const
{ color constants. { color constants.
@ -73,20 +72,16 @@ const
dxColor_BgCkOXP = TColor($00CC9999); dxColor_BgCkOXP = TColor($00CC9999);
type type
TJvXPCustomStyleControl = class; // TJvXPCustomStyleControl = class;
******************** NOT CONVERTED *)
type TJvXPBoundLines = set of (
TJvXPBoundLines = set of
(
blLeft, // left line blLeft, // left line
blTop, // top line blTop, // top line
blRight, // right line blRight, // right line
blBottom // bottom line blBottom // bottom line
); );
TJvXPControlStyle = set of TJvXPControlStyle = set of (
(
csRedrawCaptionChanged, // (default) csRedrawCaptionChanged, // (default)
csRedrawBorderChanged, // csRedrawBorderChanged, //
csRedrawEnabledChanged, // (default) csRedrawEnabledChanged, // (default)
@ -102,31 +97,24 @@ type
csRedrawResized // csRedrawResized //
); );
type TJvXPDrawState = set of (
TJvXPDrawState = set of
(
dsDefault, // default dsDefault, // default
dsHighlight, // highlighted dsHighlight, // highlighted
dsClicked, // clicked dsClicked, // clicked
dsFocused // focused dsFocused); // focused
);
TJvXPGlyphLayout = TJvXPGlyphLayout = (
(
glBottom, // bottom glyph glBottom, // bottom glyph
glCenter, // centered glyph glCenter, // centered glyph
glTop // top glyph glTop); // top glyph
);
(******************** NOT CONVERTED TJvXPTheme = (
TJvXPTheme =
(
WindowsXP, // WindowsXP theme WindowsXP, // WindowsXP theme
OfficeXP // OfficeXP theme OfficeXP); // OfficeXP theme
);
{ baseclass for non-focusable component descendants. } { baseclass for non-focusable component descendants. }
TJvXPCustomComponent = class(TComponent) TJvXPCustomComponent = class(TComponent)
(******************** NOT CONVERTED
private private
FVersion: string; FVersion: string;
procedure SetVersion(const Value: string); procedure SetVersion(const Value: string);
@ -134,8 +122,8 @@ type
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
published published
property Version: string read FVersion write SetVersion stored False; property Version: string read FVersion write SetVersion stored False;
end;
******************** NOT CONVERTED *) ******************** NOT CONVERTED *)
end;
type type
TJvXPWinControl = class(TWinControl) TJvXPWinControl = class(TWinControl)
@ -145,6 +133,7 @@ type
{ baseclass for focusable control descendants. } { baseclass for focusable control descendants. }
// TJvXPCustomControl = class(TCustomControl) //(TJvCustomControl)
TJvXPCustomControl = class(TJvCustomControl) TJvXPCustomControl = class(TJvCustomControl)
private private
FClicking: Boolean; FClicking: Boolean;
@ -166,10 +155,11 @@ type
//LCL doesnt fire it //LCL doesnt fire it
//procedure CMParentFontChanged(var Msg: TLMessage); message CM_PARENTFONTCHANGED; //procedure CMParentFontChanged(var Msg: TLMessage); message CM_PARENTFONTCHANGED;
procedure CMTextChanged(var Msg: TLMessage); message CM_TEXTCHANGED; //procedure CMTextChanged(var Msg: TLMessage); message CM_TEXTCHANGED;
procedure WMMouseMove(var Msg: TLMMouse); message LM_MOUSEMOVE; procedure WMMouseMove(var Msg: TLMMouse); message LM_MOUSEMOVE;
procedure WMSize(var Msg: TLMSize); message LM_SIZE; procedure WMSize(var Msg: TLMSize); message LM_SIZE;
procedure WMWindowPosChanged(var Msg: TLMWindowPosChanged); message LM_WINDOWPOSCHANGED; procedure WMWindowPosChanged(var Msg: TLMWindowPosChanged); message LM_WINDOWPOSCHANGED;
protected protected
ExControlStyle: TJvXPControlStyle; ExControlStyle: TJvXPControlStyle;
procedure InternalRedraw; dynamic; procedure InternalRedraw; dynamic;
@ -192,6 +182,8 @@ type
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Click; override; procedure Click; override;
procedure Resize; override;
procedure TextChanged; override;
property ModalResult: TModalResult read FModalResult write FModalResult default 0; property ModalResult: TModalResult read FModalResult write FModalResult default 0;
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter; property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave; property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
@ -295,14 +287,14 @@ type
private private
FStyle: TJvXPStyle; FStyle: TJvXPStyle;
FStyleManager: TJvXPStyleManager; FStyleManager: TJvXPStyleManager;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
protected protected
procedure SetStyleManager(Value: TJvXPStyleManager); virtual; procedure SetStyleManager(Value: TJvXPStyleManager); virtual;
procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override;
property Style: TJvXPStyle read FStyle write FStyle; property Style: TJvXPStyle read FStyle write FStyle;
property StyleManager: TJvXPStyleManager read FStyleManager write SetStyleManager; property StyleManager: TJvXPStyleManager read FStyleManager write SetStyleManager;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end; end;
******************** NOT CONVERTED *) ******************** NOT CONVERTED *)
@ -344,29 +336,6 @@ type
implementation implementation
(******************** NOT CONVERTED
{$IFNDEF USEJVCL}
resourcestring
RsCopyright = 'Design eXperience. (c) 2002 M. Hoffmann Version ';
RsCopyright2 = 'Design eXperience II - (c) 2002 M. Hoffmann Version ';
RsVersion = '2.0.1'; // always increase version number on new releases!
{$ENDIF !USEJVCL}
//=== { TJvXPCustomComponent } ===============================================
constructor TJvXPCustomComponent.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{$IFNDEF USEJVCL}
FVersion := RsCopyright + RsVersion;
{$ENDIF !USEJVCL}
end;
procedure TJvXPCustomComponent.SetVersion(const Value: string);
begin
// do not enable overwriting this constant.
end;
******************** NOT CONVERTED *)
//=== { TJvXPCustomControl } ================================================= //=== { TJvXPCustomControl } =================================================
constructor TJvXPCustomControl.Create(AOwner: TComponent); constructor TJvXPCustomControl.Create(AOwner: TComponent);
@ -412,8 +381,6 @@ begin
Invalidate; Invalidate;
end; end;
procedure TJvXPCustomControl.CMDialogChar(var Msg: TCMDialogChar); procedure TJvXPCustomControl.CMDialogChar(var Msg: TCMDialogChar);
begin begin
with Msg do with Msg do
@ -441,7 +408,6 @@ begin
HookEnabledChanged; HookEnabledChanged;
end; end;
procedure TJvXPCustomControl.CMFocusChanged(var Msg: TLMessage); procedure TJvXPCustomControl.CMFocusChanged(var Msg: TLMessage);
begin begin
// delegate message "FocusChanged" to hook. // delegate message "FocusChanged" to hook.
@ -449,7 +415,6 @@ begin
HookFocusedChanged; HookFocusedChanged;
end; end;
procedure TJvXPCustomControl.CMMouseEnter(var Msg: TLMessage); procedure TJvXPCustomControl.CMMouseEnter(var Msg: TLMessage);
begin begin
// delegate message "MouseEnter" to hook. // delegate message "MouseEnter" to hook.
@ -479,13 +444,26 @@ begin
inherited; inherited;
HookParentFontChanged; HookParentFontChanged;
end; end;
*)
procedure TJvXPCustomControl.CMTextChanged(var Msg: TLMessage); procedure TJvXPCustomControl.CMTextChanged(var Msg: TLMessage);
begin begin
// delegate message "TextChanged" to hook. // delegate message "TextChanged" to hook.
inherited; inherited;
HookTextChanged; HookTextChanged;
end; end;
*)
procedure TJvXPCustomControl.Resize;
begin
inherited;
//HookResized;
end;
procedure TJvXPCustomControl.TextChanged;
begin
// delegate message "TextChanged" to hook.
inherited;
InternalRedraw;
end;
procedure TJvXPCustomControl.WMMouseMove(var Msg: TLMMouse); procedure TJvXPCustomControl.WMMouseMove(var Msg: TLMMouse);
begin begin
@ -679,11 +657,15 @@ end;
procedure TJvXPCustomControl.HookTextChanged; procedure TJvXPCustomControl.HookTextChanged;
begin begin
// this hook is called, if the caption was changed. // this hook is called, if the caption was changed.
if csRedrawCaptionChanged in ExControlStyle then if (csRedrawCaptionChanged in ExControlStyle) and
not (csCreating in ControlState)
then
InternalRedraw; InternalRedraw;
end; end;
(******************** NOT CONVERTED (******************** NOT CONVERTED
//=== { TJvXPStyle } ========================================================= //=== { TJvXPStyle } =========================================================
constructor TJvXPStyle.Create(AOwner: TComponent); constructor TJvXPStyle.Create(AOwner: TComponent);
@ -773,6 +755,7 @@ begin
FControls.Delete(FControls.IndexOf(AControls[I])); FControls.Delete(FControls.IndexOf(AControls[I]));
end; end;
//=== { TJvXPCustomStyleControl } ============================================ //=== { TJvXPCustomStyleControl } ============================================
constructor TJvXPCustomStyleControl.Create(AOwner: TComponent); constructor TJvXPCustomStyleControl.Create(AOwner: TComponent);
@ -811,6 +794,7 @@ begin
end; end;
end; end;
//=== { TJvXPGradient } ====================================================== //=== { TJvXPGradient } ======================================================
constructor TJvXPGradient.Create(AOwner: TControl); constructor TJvXPGradient.Create(AOwner: TControl);

168
components/jvcllaz/run/JvXPCoreUtils.pas
View File

@ -38,33 +38,30 @@ uses
TypInfo, JvXPCore; TypInfo, JvXPCore;
function JvXPMethodsEqual(const Method1, Method2: TMethod): Boolean; function JvXPMethodsEqual(const Method1, Method2: TMethod): Boolean;
procedure JvXPDrawLine(const ACanvas: TCanvas; const X1, Y1, X2, Y2: Integer); procedure JvXPDrawLine(const ACanvas: TCanvas; const X1, Y1, X2, Y2: Integer);
procedure JvXPAdjustBoundRect(const BorderWidth: Byte;
const ShowBoundLines: Boolean; const BoundLines: TJvXPBoundLines; var Rect: TRect);
procedure JvXPDrawBoundLines(const ACanvas: TCanvas; const BoundLines: TJvXPBoundLines;
const AColor: TColor; const Rect: TRect);
(******************** NOT CONVERTED - NOT USED
procedure JvXPCreateGradientRect(const AWidth, AHeight: Integer; const StartColor, procedure JvXPCreateGradientRect(const AWidth, AHeight: Integer; const StartColor,
EndColor: TColor; const AColors: TJvXPGradientColors; const Style: TJvXPGradientStyle; EndColor: TColor; const AColors: TJvXPGradientColors; const Style: TJvXPGradientStyle;
const Dithered: Boolean; var Bitmap: TBitmap); const Dithered: Boolean; var Bitmap: TBitmap);
// procedure JvXPAdjustBoundRect(const BorderWidth: Byte;
// attic! const ShowBoundLines: Boolean; const BoundLines: TJvXPBoundLines; var Rect: TRect);
//
procedure JvXPDrawBoundLines(const ACanvas: TCanvas; const BoundLines: TJvXPBoundLines;
const AColor: TColor; const Rect: TRect);
procedure JvXPConvertToGray2(ABitmap: TBitmap);
procedure JvXPConvertToGray2(Bitmap: TBitmap);
procedure JvXPRenderText(const AParent: TControl; const ACanvas: TCanvas; procedure JvXPRenderText(const AParent: TControl; const ACanvas: TCanvas;
ACaption: TCaption; const AFont: TFont; const AEnabled, AShowAccelChar: Boolean; ACaption: TCaption; const AFont: TFont; const AEnabled, AShowAccelChar: Boolean;
var ARect: TRect; AFlags: Integer); var ARect: TRect; AFlags: Integer);
******************** NOT CONVERTED *)
procedure JvXPFrame3D(const ACanvas: TCanvas; const ARect: TRect; procedure JvXPFrame3D(const ACanvas: TCanvas; const ARect: TRect;
const TopColor, BottomColor: TColor; const Swapped: Boolean = False); const TopColor, BottomColor: TColor; const Swapped: Boolean = False);
procedure JvXPColorizeBitmap(ABitmap: TBitmap; const AColor: TColor);
(******************** NOT CONVERTED - NOT USED (******************** NOT CONVERTED - NOT USED
procedure JvXPColorizeBitmap(Bitmap: TBitmap; const AColor: TColor);
procedure JvXPSetDrawFlags(const AAlignment: TAlignment; const AWordWrap: Boolean; procedure JvXPSetDrawFlags(const AAlignment: TAlignment; const AWordWrap: Boolean;
var Flags: Integer); var Flags: Integer);
procedure JvXPPlaceText(const AParent: TControl; const ACanvas: TCanvas; procedure JvXPPlaceText(const AParent: TControl; const ACanvas: TCanvas;
@ -74,12 +71,39 @@ procedure JvXPPlaceText(const AParent: TControl; const ACanvas: TCanvas;
implementation implementation
uses
IntfGraphics, fpCanvas, fpImage, fpImgCanv;
function JvXPMethodsEqual(const Method1, Method2: TMethod): Boolean; function JvXPMethodsEqual(const Method1, Method2: TMethod): Boolean;
begin begin
Result := (Method1.Code = Method2.Code) and (Method1.Data = Method2.Data); Result := (Method1.Code = Method2.Code) and (Method1.Data = Method2.Data);
end; end;
(******************** NOT USED // Ignoring "AColors" and "Dithered"
procedure JvXPCreateGradientRect(const AWidth, AHeight: Integer;
const StartColor, EndColor: TColor; const AColors: TJvXPGradientColors;
const Style: TJvXPGradientStyle; const Dithered: Boolean; var Bitmap: TBitmap);
begin
if (AHeight <= 0) or (AWidth <= 0) then
Exit;
Bitmap.Height := AHeight;
Bitmap.Width := AWidth;
Bitmap.PixelFormat := pf24bit;
case Style of
gsLeft:
Bitmap.Canvas.GradientFill(Rect(0, 0, AWidth, AHeight), StartColor, EndColor, gdHorizontal);
gsRight:
Bitmap.Canvas.GradientFill(Rect(0, 0, AWidth, AHeight), EndColor, StartColor, gdHorizontal);
gsTop:
Bitmap.Canvas.GradientFill(Rect(0, 0, AWidth, AHeight), StartColor, EndColor, gdVertical);
gsBottom:
Bitmap.Canvas.GradientFill(Rect(0, 0, AWidth, AHeight), EndColor, StartColor, gdVertical);
end;
end;
(*
// Dithered is ignored at the moment...
procedure JvXPCreateGradientRect(const AWidth, AHeight: Integer; const StartColor, procedure JvXPCreateGradientRect(const AWidth, AHeight: Integer; const StartColor,
EndColor: TColor; const AColors: TJvXPGradientColors; const Style: TJvXPGradientStyle; EndColor: TColor; const AColors: TJvXPGradientColors; const Style: TJvXPGradientStyle;
const Dithered: Boolean; var Bitmap: TBitmap); const Dithered: Boolean; var Bitmap: TBitmap);
@ -111,13 +135,15 @@ type
False: False:
(R, G, B, D: Byte); (R, G, B, D: Byte);
end; end;
PRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array [0..PixelCountMax-1] of TRGBTriple;
var var
iLoop, xLoop, yLoop, XX, YY: Integer; iLoop, xLoop, yLoop, XX, YY: Integer;
iBndS, iBndE: Integer; iBndS, iBndE: Integer;
GBand: TGradientBand; GBand: TGradientBand;
Row: PRGBTripleArray; intfImg: TLazIntfImage;
cnv: TFPImageCanvas;
clr: TFPColor;
imgHandle, imgMaskHandle: HBitmap;
tempBitmap: TBitmap;
procedure CalculateGradientBand; procedure CalculateGradientBand;
var var
@ -157,39 +183,40 @@ begin
CalculateGradientBand; CalculateGradientBand;
with Bitmap.Canvas do intfImg := TLazIntfImage.Create(0, 0);
begin intfImg.LoadFromBitmap(Bitmap.Handle, Bitmap.MaskHandle);
Brush.Color := StartColor; cnv := TFPImageCanvas.Create(intfImg);
FillRect(Bounds(0, 0, AWidth, AHeight)); cnv.Brush.FPColor := TColorToFPColor(StartColor);
//cnv.FillRect(Bounds(0, 0, AWidth, AHeight));
if Style in [gsLeft, gsRight] then if Style in [gsLeft, gsRight] then
begin begin
for iLoop := 0 to AColors - 1 do for iLoop := 0 to AColors - 1 do begin
begin
iBndS := MulDiv(iLoop, AWidth, AColors); iBndS := MulDiv(iLoop, AWidth, AColors);
iBndE := MulDiv(iLoop + 1, AWidth, AColors); iBndE := MulDiv(iLoop + 1, AWidth, AColors);
Brush.Color := GBand[iLoop]; cnv.Brush.FPColor := TColorToFPColor(GBand[iLoop]);
PatBlt(Handle, iBndS, 0, iBndE, AHeigth, PATCOPY); cnv.FillRect(iBnds, 0, iBndE, AHeight);
if (iLoop > 0) and Dithered then {
if Dithered and (iLoop > 0) then
begin
clr := TColorToFPColor(GBand[iLoop - 1]);
for yLoop := 0 to DitherDepth - 1 do for yLoop := 0 to DitherDepth - 1 do
if yLoop < AHeight then if yLoop < AHeight then
begin
Row := Bitmap.ScanLine[yLoop];
for xLoop := 0 to AWidth div (AColors - 1) do for xLoop := 0 to AWidth div (AColors - 1) do
begin begin
XX := iBndS + Random(xLoop); XX := iBndS + Random(xLoop);
if (XX < AWidth) and (XX > -1) then if (XX < AWidth) and (XX > -1) then
with Row[XX] do cnv.Colors[XX, yLoop] := clr;
begin
rgbtRed := GetRValue(GBand[iLoop - 1]);
rgbtGreen := GetGValue(GBand[iLoop - 1]);
rgbtBlue := GetBValue(GBand[iLoop - 1]);
end;
end; end;
end; end;
}
end; end;
{
if Dithered then
for yLoop := 1 to AHeight div DitherDepth do for yLoop := 1 to AHeight div DitherDepth do
CopyRect(Bounds(0, yLoop * DitherDepth, AWidth, DitherDepth), for xLoop := 0 to AWidth - 1 do
Bitmap.Canvas, Bounds(0, 0, AWidth, DitherDepth)); cnv.Colors[xLoop, yLoop * DitherDepth] := cnv.Colors[xLoop, 0];
}
end end
else else
begin begin
@ -197,33 +224,41 @@ begin
begin begin
iBndS := MulDiv(iLoop, AHeight, AColors); iBndS := MulDiv(iLoop, AHeight, AColors);
iBndE := MulDiv(iLoop + 1, AHeight, AColors); iBndE := MulDiv(iLoop + 1, AHeight, AColors);
Brush.Color := GBand[iLoop]; cnv.Brush.FPColor := TColorToFPColor(GBand[iLoop]);
PatBlt(Handle, 0, iBndS, AWidth, iBndE, PATCOPY); cnv.FillRect(0, iBndS, AWidth, iBndS + iBndE);
if (iLoop > 0) and Dithered then {
if Dithered and (iLoop > 0) then
begin
clr := TColorToFPColor(GBand[iLoop - 1]);
for yLoop := 0 to AHeight div (AColors - 1) do for yLoop := 0 to AHeight div (AColors - 1) do
begin begin
YY := iBndS + Random(yLoop); YY := iBndS + Random(yLoop);
if (YY < AHeight) and (YY > -1) then if (YY < AHeight) and (YY > -1) then
begin
Row := Bitmap.ScanLine[YY];
for xLoop := 0 to DitherDepth - 1 do for xLoop := 0 to DitherDepth - 1 do
if xLoop < AWidth then if xLoop < AWidth then
with Row[xLoop] do cnv.Colors[xLoop, YY] := clr;
begin
rgbtRed := GetRValue(GBand[iLoop - 1]);
rgbtGreen := GetGValue(GBand[iLoop - 1]);
rgbtBlue := GetBValue(GBand[iLoop - 1]);
end;
end; end;
end; end;
}
end; end;
{
for xLoop := 0 to AWidth div DitherDepth do for xLoop := 0 to AWidth div DitherDepth do
CopyRect(Bounds(xLoop * DitherDepth, 0, DitherDepth, AHeight), for yLoop := 0 to AHeight - 1 do
Bitmap.Canvas, Bounds(0, 0, DitherDepth, AHeight)); cnv.Colors[xLoop * DitherDepth, yLoop] := cnv.Colors[0, yLoop];
}
end; end;
intfImg.CreateBitmaps(imgHandle, imgMaskHandle, false);
tempBitmap := TBitmap.Create;
tempBitmap.Handle := imgHandle;
tempBitmap.MaskHandle := imgMaskHandle;
Bitmap.Canvas.Draw(0, 0, tempBitmap);
tempBitmap.Free;
cnv.Free;
intfImg.Free;
end; end;
end; *)
******************** NOT USED *)
procedure JvXPDrawLine(const ACanvas: TCanvas; const X1, Y1, X2, Y2: Integer); procedure JvXPDrawLine(const ACanvas: TCanvas; const X1, Y1, X2, Y2: Integer);
begin begin
@ -269,24 +304,19 @@ begin
end; end;
end; end;
(******************** NOT CONVERTED - NOT USED procedure JvXPConvertToGray2(ABitmap: TBitmap);
//
// attic
//
procedure JvXPConvertToGray2(Bitmap: TBitmap);
var var
x, y, c: Integer; x, y, c: Integer;
PxlColor: TColor; PxlColor: TColor;
begin begin
for x := 0 to Bitmap.Width - 1 do for x := 0 to ABitmap.Width - 1 do
for y := 0 to Bitmap.Height - 1 do for y := 0 to ABitmap.Height - 1 do
begin begin
PxlColor := ColorToRGB(Bitmap.Canvas.Pixels[x, y]); PxlColor := ColorToRGB(ABitmap.Canvas.Pixels[x, y]);
c := (PxlColor shr 16 + ((PxlColor shr 8) and $00FF) + PxlColor and $0000FF) div 3 + 100; c := (PxlColor shr 16 + ((PxlColor shr 8) and $00FF) + PxlColor and $0000FF) div 3 + 100;
if c > 255 then if c > 255 then
c := 255; c := 255;
Bitmap.Canvas.Pixels[x, y] := RGB(c, c, c); ABitmap.Canvas.Pixels[x, y] := RGB(c, c, c);
end; end;
end; end;
@ -306,7 +336,8 @@ begin
ACaption := ACaption + ' '; ACaption := ACaption + ' ';
if not AShowAccelChar then if not AShowAccelChar then
AFlags := AFlags or DT_NOPREFIX; AFlags := AFlags or DT_NOPREFIX;
AFlags := AParent.DrawTextBiDiModeFlags(AFlags); // wp: To do - bidi
// AFlags := AParent.DrawTextBiDiModeFlags(AFlags);
with ACanvas do with ACanvas do
begin begin
Font.Assign(AFont); Font.Assign(AFont);
@ -325,7 +356,6 @@ begin
DoDrawText; DoDrawText;
end; end;
end; end;
******************** NOT CONVERTED *)
procedure JvXPFrame3D(const ACanvas: TCanvas; const ARect: TRect; procedure JvXPFrame3D(const ACanvas: TCanvas; const ARect: TRect;
const TopColor, BottomColor: TColor; const Swapped: Boolean = False); const TopColor, BottomColor: TColor; const Swapped: Boolean = False);
@ -355,28 +385,28 @@ begin
end; end;
end; end;
(******************** NOT CONVERTED procedure JvXPColorizeBitmap(ABitmap: TBitmap; const AColor: TColor);
procedure JvXPColorizeBitmap(Bitmap: TBitmap; const AColor: TColor);
var var
ColorMap: TBitmap; ColorMap: TBitmap;
Rect: TRect; Rect: TRect;
begin begin
Rect := Bounds(0, 0, Bitmap.Width, Bitmap.Height); Rect := Bounds(0, 0, ABitmap.Width, ABitmap.Height);
ColorMap := TBitmap.Create; ColorMap := TBitmap.Create;
try try
ColorMap.Assign(Bitmap); ColorMap.Assign(ABitmap);
Bitmap.FreeImage; ABitmap.FreeImage;
with ColorMap.Canvas do with ColorMap.Canvas do
begin begin
Brush.Color := AColor; Brush.Color := AColor;
BrushCopy( Rect, Bitmap, Rect, clBlack); BrushCopy(Rect, ABitmap, Rect, clBlack);
end; end;
Bitmap.Assign(ColorMap); ABitmap.Assign(ColorMap);
finally finally
ColorMap.Free; ColorMap.Free;
end; end;
end; end;
(******************** NOT CONVERTED
procedure JvXPSetDrawFlags(const AAlignment: TAlignment; const AWordWrap: Boolean; procedure JvXPSetDrawFlags(const AAlignment: TAlignment; const AWordWrap: Boolean;
var Flags: Integer); var Flags: Integer);
begin begin