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

+ In TRxCustomDBLookupCombo add check for CircularDataLink

Browse Source 
+ in TRxCustomDBLookupCombo accelerated drawing data
  - In TRxCustomDBLookupCombo fix select first record if DataField is emty
  + In RxDBGrid are published missing events from DBGrid
  + New component TRxCalendarGrid - simple calendar without heading.
  - fix error compile module rxappicon.pas in Windows  for GTK2 (thx ViruZ)
  + add new module rxiconv.pas (original module iconv.pas from A.Voito)
  + minor fix in drawing button caption in setup form TToolbar
  + fix draw disables state for TRxCustomDBLookupCombo
  - fix compile rxctrls in fpc 2.2
  + TPopUpColumnTitle used define NEW_STYLE_TITLE_ALIGNMENT_RXDBGRID
  + in RxDBGrid images of markers moved to rxdbgrids.lrs (Petr Smolik)
  + add module for autosort in RxDBGrid exsortzeos.pas for ZeosDB (Petr Smolik)


git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@276 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alexs75
2007-10-17 10:19:26 +00:00
parent a920685c91
commit c76f26feea
23 changed files with 2737 additions and 215 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
components/rx/dateutil.pas
View File

@ -54,6 +54,7 @@ function StrToDateFmt(const DateFormat, S: string): TDateTime;
function StrToDateFmtDef(const DateFormat, S: string; Default: TDateTime): TDateTime; function StrToDateFmtDef(const DateFormat, S: string; Default: TDateTime): TDateTime;
function DefDateFormat(FourDigitYear: Boolean): string; function DefDateFormat(FourDigitYear: Boolean): string;
function DefDateMask(BlanksChar: Char; FourDigitYear: Boolean): string; function DefDateMask(BlanksChar: Char; FourDigitYear: Boolean): string;
function NvlDate(DateValue, DefaultValue: TDateTime): TDateTime;
{$IFDEF WIN32} {$IFDEF WIN32}
function FormatLongDate(Value: TDateTime): string; function FormatLongDate(Value: TDateTime): string;
@ -78,6 +79,13 @@ implementation
uses SysUtils, RXStrUtils, rxdconst{, DBConsts }{$IFDEF WIN32}, Windows{$ENDIF}; uses SysUtils, RXStrUtils, rxdconst{, DBConsts }{$IFDEF WIN32}, Windows{$ENDIF};
function NvlDate(DateValue, DefaultValue: TDateTime): TDateTime;
begin
if DateValue = NullDate then Result := DefaultValue
else Result := DateValue;
end;
function IsLeapYear(AYear: Integer): Boolean; function IsLeapYear(AYear: Integer): Boolean;
begin begin
Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0)); Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
@ -576,6 +584,7 @@ begin
if Result <> '' then Result := Result + BlanksChar; if Result <> '' then Result := Result + BlanksChar;
end; end;
{$IFDEF WIN32} {$IFDEF WIN32}
function FormatLongDate(Value: TDateTime): string; function FormatLongDate(Value: TDateTime): string;
@ -586,7 +595,8 @@ begin
{$IFDEF RX_D3} {$IFDEF RX_D3}
DateTimeToSystemTime(Value, SystemTime); DateTimeToSystemTime(Value, SystemTime);
{$ELSE} {$ELSE}
with SystemTime do begin with SystemTime do
begin
DecodeDate(Value, wYear, wMonth, wDay); DecodeDate(Value, wYear, wMonth, wDay);
DecodeTime(Value, wHour, wMinute, wSecond, wMilliseconds); DecodeTime(Value, wHour, wMinute, wSecond, wMilliseconds);
end; end;

13
components/rx/docs/WhatsNew.eng.txt
View File

@ -1,3 +1,16 @@
+ In TRxCustomDBLookupCombo add check for CircularDataLink
+ in TRxCustomDBLookupCombo accelerated drawing data
- In TRxCustomDBLookupCombo fix select first record if DataField is emty
+ In RxDBGrid are published missing events from DBGrid
+ New component TRxCalendarGrid - simple calendar without heading.
- fix error compile module rxappicon.pas in Windows for GTK2 (thx ViruZ)
+ add new module rxiconv.pas (original module iconv.pas from A.Voito)
+ minor fix in drawing button caption in setup form TToolbar
+ fix draw disables state for TRxCustomDBLookupCombo
- fix compile rxctrls in fpc 2.2
+ TPopUpColumnTitle used define NEW_STYLE_TITLE_ALIGNMENT_RXDBGRID
+ in RxDBGrid images of markers moved to rxdbgrids.lrs (Petr Smolik)
+ add module for autosort in RxDBGrid exsortzeos.pas for ZeosDB (Petr Smolik)
29.08.2007 - ������ 1.1.5.98 (svn revision 39) 29.08.2007 - ������ 1.1.5.98 (svn revision 39)
+ In RxDBgrid - after close dataset list of SelectedRows is cleared + In RxDBgrid - after close dataset list of SelectedRows is cleared
+ fix resaizing find form for RxDbGrd + fix resaizing find form for RxDbGrd

16
components/rx/docs/WhatsNew.rus.txt
View File

@ -1,3 +1,19 @@
+ � ������� TRxCustomDBLookupCombo ������ �������� �� CircularDataLink
+ � ������� TRxCustomDBLookupCombo �������� ��������� ������
- � ������� TRxCustomDBLookupCombo ��������� ����� ������ ������ �� ����������� ���
������ ������� � DataField
+ � RxDBGrid ������������ ����������� ����������� �� DBGrid
+ ���������� ����� ��������� TRxCalendarGrid - ������� ��������� ��� ���������.
- ���������� ������ ���������� ������ rxappicon.pas ��� Windows ��� �������������
���������� GTK2 (������� ViruZ - ����� ���������)
+ �������� ������ rxiconv.pas (������������ ������ iconv.pas �� A.Voito)
+ ��������� ��������� ��������� ��������� ������ � ����� ��������� TToolbar
+ ���������� ��������� ������������ ��������� � TRxCustomDBLookupCombo
- ���������� ���������� ������ rxctrls � fpc 2.2
+ � TPopUpColumnTitle ������� ��������� ���������
NEW_STYLE_TITLE_ALIGNMENT_RXDBGRID
+ � RxDBGrid ����������� �������� �������� � ������� (Petr Smolik)
+ �������� ������ �������������� ���������� � RxDBGrid exsortzeos.pas ��� ZeosDB (Petr Smolik)
29.08.2007 - ������ 1.1.5.98 (svn revision 39) 29.08.2007 - ������ 1.1.5.98 (svn revision 39)
+ � RxDBGrid ����� �������� ������ ������ ������ ���������� ����� (SelectedRows) + � RxDBGrid ����� �������� ������ ������ ������ ���������� ����� (SelectedRows)
��������� ���������

37
components/rx/exsortzeos.pas Normal file
View File

@ -0,0 +1,37 @@
unit exsortzeos;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, DB,
{$IFDEF FPC}
RxDBGrid
{$ELSE}
exDBGrid
{$ENDIF}
,ZConnection, ZDataset, ZAbstractRODataset;
type
TFBDataSetSortEngine = class(TExDBGridSortEngine)
public
procedure Sort(Field:TField; ADataSet:TDataSet; Asc:boolean);override;
end;
implementation
//uses FBCustomDataSet;
procedure TFBDataSetSortEngine.Sort(Field:TField; ADataSet:TDataSet; Asc:boolean);
begin
if Assigned(ADataSet) then begin
(ADataSet as TZQuery).SortedFields:=Field.FieldName;
if Asc then (ADataSet as TZQuery).SortType:=stAscending
else (ADataSet as TZQuery).SortType:=stDescending;
end
end;
initialization
RegisterExDBGridSortEngine(TFBDataSetSortEngine, TZQuery);
end.

20
components/rx/pickdate.lrs Normal file
View File

@ -0,0 +1,20 @@
LazarusResources.Add('next1','XPM',[
'/* XPM */'#10'static char *next1[]={'#10'"8 6 2 1",'#10'". c None",'#10'"# c'
+' #000000",'#10'"...#....",'#10'"...##...",'#10'"...###..",'#10'"...###..",'
+#10'"...##...",'#10'"...#...."};'#10
]);
LazarusResources.Add('next2','XPM',[
'/* XPM */'#10'static char *next2[]={'#10'"8 6 2 1",'#10'". c None",'#10'"# c'
+' #000000",'#10'".#...#..",'#10'".##..##.",'#10'".###.###",'#10'".###.###",'
+#10'".##..##.",'#10'".#...#.."};'#10
]);
LazarusResources.Add('prev1','XPM',[
'/* XPM */'#10'static char *prev1[]={'#10'"8 6 2 1",'#10'". c None",'#10'"# c'
+' #000000",'#10'"....#...",'#10'"...##...",'#10'"..###...",'#10'"..###...",'
+#10'"...##...",'#10'"....#..."};'#10
]);
LazarusResources.Add('prev2','XPM',[
'/* XPM */'#10'static char *prev2[]={'#10'"8 6 2 1",'#10'". c None",'#10'"# c'
+' #000000",'#10'"..#...#.",'#10'".##..##.",'#10'"###.###.",'#10'"###.###.",'
+#10'".##..##.",'#10'"..#...#."};'#10
]);

1377
components/rx/pickdate.pas Normal file
View File

File diff suppressed because it is too large Load Diff

25
components/rx/registerrx.pas
View File

@ -13,7 +13,7 @@ implementation
uses PropEdits, dbdateedit, rxlookup, folderlister, rxdbgrid, rxmemds, duallist, uses PropEdits, dbdateedit, rxlookup, folderlister, rxdbgrid, rxmemds, duallist,
curredit, rxswitch, rxdice, rxdbcomb, rxtoolbar, rxxpman, PageMngr, RxAppIcon, curredit, rxswitch, rxdice, rxdbcomb, rxtoolbar, rxxpman, PageMngr, RxAppIcon,
Dialogs, ComponentEditors, seldsfrm, DBPropEdits, DB, rxctrls, RxLogin, Dialogs, ComponentEditors, seldsfrm, DBPropEdits, DB, rxctrls, RxLogin,
RxCustomChartPanel, AutoPanel; RxCustomChartPanel, AutoPanel, pickdate, rxconst, tooledit;
type type
@ -91,7 +91,7 @@ begin
else else
begin begin
case Index - DefaultEditor.GetVerbCount of case Index - DefaultEditor.GetVerbCount of
0:Result:='Load icon'; 0:Result:=sLoadIcon;
end; end;
end; end;
end; end;
@ -107,11 +107,7 @@ begin
case Index - DefaultEditor.GetVerbCount of case Index - DefaultEditor.GetVerbCount of
0:begin 0:begin
OpenDialog1:=TOpenDialog.Create(nil); OpenDialog1:=TOpenDialog.Create(nil);
{$IFDEF WIN32} OpenDialog1.Filter:=sWindowsIcoFiles;
OpenDialog1.Filter:='Windows Ico files (*.ico)|*.ico|All files|*.*';
{$ELSE}
OpenDialog1.Filter:='Windows Ico files (*.ico)|*.ico|All files|*';
{$ENDIF}
try try
if OpenDialog1.Execute then if OpenDialog1.Execute then
(Component as TRxAppIcon).LoadFromFile(OpenDialog1.FileName); (Component as TRxAppIcon).LoadFromFile(OpenDialog1.FileName);
@ -215,6 +211,16 @@ begin
RegisterComponents('RX',[TAutoPanel]); RegisterComponents('RX',[TAutoPanel]);
end; end;
procedure RegisterPickDate;
begin
RegisterComponents('RX',[TRxCalendarGrid]);
end;
procedure RegisterToolEdit;
begin
RegisterComponents('RX',[TRxDateEdit]);
end;
procedure Register; procedure Register;
begin begin
//RX //RX
@ -230,13 +236,16 @@ begin
RegisterUnit('rxctrls', @RegisterRxCtrls); RegisterUnit('rxctrls', @RegisterRxCtrls);
RegisterUnit('RxLogin', @RegisterRxLogin); RegisterUnit('RxLogin', @RegisterRxLogin);
RegisterUnit('RxCustomChartPanel', @RegisterChartPanel); RegisterUnit('RxCustomChartPanel', @RegisterChartPanel);
RegisterUnit('AutoPanel', @RegisterAutoPanel);
RegisterUnit('pickdate', @RegisterPickDate);
RegisterUnit('tooledit', @RegisterToolEdit);
//RX DBAware //RX DBAware
RegisterUnit('dbdateedit', @RegisterUnitDBDateEdit); RegisterUnit('dbdateedit', @RegisterUnitDBDateEdit);
RegisterUnit('rxlookup', @RegisterRXLookup); RegisterUnit('rxlookup', @RegisterRXLookup);
RegisterUnit('rxdbgrid', @RegisterRxDbGrid); RegisterUnit('rxdbgrid', @RegisterRxDbGrid);
RegisterUnit('rxmemds', @RegisterRxMemDS); RegisterUnit('rxmemds', @RegisterRxMemDS);
RegisterUnit('rxdbcomb', @RegisterRxDBComb); RegisterUnit('rxdbcomb', @RegisterRxDBComb);
RegisterUnit('AutoPanel', @RegisterAutoPanel);
//Component Editors //Component Editors

32
components/rx/rx.lrs
View File

@ -267,7 +267,6 @@ LazarusResources.Add('TRXLABEL','XPM',[
+'........................",'#10'"........................",'#10'"...........' +'........................",'#10'"........................",'#10'"...........'
+'.............",'#10'"........................"};'#10 +'.............",'#10'"........................"};'#10
]); ]);
LazarusResources.Add('tautopanel','XPM',[ LazarusResources.Add('tautopanel','XPM',[
'/* XPM */'#10'static char *tautopanel_xpm[] = {'#10'/* width height num_colo' '/* XPM */'#10'static char *tautopanel_xpm[] = {'#10'/* width height num_colo'
+'rs chars_per_pixel */'#10'" 24 24 8 1",'#10'/* colo' +'rs chars_per_pixel */'#10'" 24 24 8 1",'#10'/* colo'
@ -285,3 +284,34 @@ LazarusResources.Add('tautopanel','XPM',[
+'..............#``",'#10'"```###################``",'#10'"``````````````````' +'..............#``",'#10'"```###################``",'#10'"``````````````````'
+'``````",'#10'"````````````````````````"'#10'};'#10 +'``````",'#10'"````````````````````````"'#10'};'#10
]); ]);
LazarusResources.Add('TRxCalendarGrid','XPM',[
'/* XPM */'#10'static char *TRxCalendarGrid[]={'#10'"24 24 5 1",'#10'". c Non'
+'e",'#10'"# c #000000",'#10'"a c #00ffff",'#10'"c c #800000",'#10'"b c #ffff'
+'ff",'#10'"........................",'#10'"........................",'#10'".'
+'.....###.....###.......",'#10'".....#...#...#...#......",'#10'"....########'
+'######......",'#10'"....#a#aaaaaaaa#a##.....",'#10'"....#aaaaaaaaaaaa##....'
+'.",'#10'"....###############.....",'#10'"....#bbbbbbbbbbbb##.....",'#10'"..'
+'..#bbbbbbbbbbbb##.....",'#10'"....#bbbccbbbcbbb##.....",'#10'"....#bbcbbcbc'
+'cbbb##.....",'#10'"....#bbbbcbbbcbbb##.....",'#10'"....#bbbcbbbbcbbb##.....'
+'",'#10'"....#bbcbbbbbcbbb##.....",'#10'"....#bbccccbbcbbb##.....",'#10'"...'
+'.#bbbbbbbbbbbb##.....",'#10'"....#bbbbbbbbbbbb##.....",'#10'"....#bbbbbbbbb'
+'bbb##.....",'#10'"....###############.....",'#10'"......#############....."'
+','#10'"........................",'#10'"........................",'#10'"....'
+'...................."};'#10
]);
LazarusResources.Add('TRxDateEdit','BMP',[
'BM'#150#1#0#0#0#0#0#0'v'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#4#0#0#0#0#0' '
+#1#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128
+#0#128#0#0#0#128#0#128#0#128#128#0#0#128#128#128#0#192#192#192#0#0#0#255#0#0
+#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0'3333333'
+'33333333p'#0#0#0#0#0#0#0#3'333x'#136#136#136#136#136#136#136#3'333x'#128'@@'
+'D'#4#4#8#3'333x'#143#255#255#255#255#255#248#3'333x'#143#241#17#241#17#143
+#248#3'333x'#143#255#31#248#248#31#248#3'333x'#143#255#31#255#255#31#248#3'3'
+'33x'#143#255#31#241#17#143#248#3'333x'#143#241#31#241#255#255#248#3'333x'
+#143#255#31#241#17#31#248#3'333x'#143#255#255#255#255#255#248#3'333x'#143#136
+#136#136#136#136#248#3'333x'#128#0#0#0#0#0#8#3'7'#255#255'x'#136#136#136#136
+#136#136#136#3'7'#8#136#0#0#0#0#0#0#0#0#3'7'#15#255#15#12#204#204#204#204#204
+#15#3'7'#15#255#0#0#0#0#0#0#0#0#3'7'#15#255#255#255#255#248#248#0#135#143'37'
+#15#255#255#255#255#248#248#136#135#143'37'#15#255#255#255#255#248#255#255
+#255#143'37'#0#0#0#0#0#0#0#0#0#15'37wwwwwwwwww3333333333333'
]);

61
components/rx/rxconst.pas
View File

@ -37,65 +37,14 @@ const
{ TBitmap.GetTransparentColor from GRAPHICS.PAS uses this value } { TBitmap.GetTransparentColor from GRAPHICS.PAS uses this value }
PaletteMask = $02000000; PaletteMask = $02000000;
{$IFDEF VER90} resourcestring
const //const
SDelphiKey = 'Software\Borland\Delphi\2.0'; {$I rxstrconsts.inc}
{$ENDIF}
{$IFDEF VER93}
const
SDelphiKey = 'Software\Borland\C++Builder\1.0';
{$ENDIF}
{$IFDEF VER100}
const
SDelphiKey = 'Software\Borland\Delphi\3.0';
{$ENDIF}
{$IFDEF VER110}
const
SDelphiKey = 'Software\Borland\C++Builder\3.0';
{$ENDIF}
{$IFDEF VER120}
const
SDelphiKey = 'Software\Borland\Delphi\4.0';
{$ENDIF}
{$IFDEF VER125}
const
SDelphiKey = 'Software\Borland\C++Builder\4.0';
{$ENDIF}
{$IFDEF VER130}
const
{$IFDEF BCB}
SDelphiKey = 'Software\Borland\C++Builder\5.0';
{$ELSE}
SDelphiKey = 'Software\Borland\Delphi\5.0';
{$ENDIF}
{$ENDIF}
{$IFDEF VER140}
const
SDelphiKey = 'Software\Borland\Delphi\6.0';
{$ENDIF}
{$IFDEF VER150}
const
SDelphiKey = 'Software\Borland\Delphi\7.0';
{$ENDIF}
implementation implementation
uses Forms; uses Forms;
(*
{$IFDEF WIN32}
{$R *.R32}
{$ELSE}
{$R *.R16}
{$ENDIF}
*)
initialization initialization
{ Screen.Cursors[crHand] := LoadCursor(hInstance, 'RX_HANDCUR'); { Screen.Cursors[crHand] := LoadCursor(hInstance, 'RX_HANDCUR');
Screen.Cursors[crDragHand] := LoadCursor(hInstance, 'RX_DRAGCUR'); } Screen.Cursors[crDragHand] := LoadCursor(hInstance, 'RX_DRAGCUR'); }

13
components/rx/rxdbgrid.lrs Normal file
View File

@ -0,0 +1,13 @@
LazarusResources.Add('rx_markerdown','XPM',[
'/* XPM */'#10'static char *rx_mark_down[]={'#10'"10 10 3 1",'#10'". c None",'
+#10'"# c #808080",'#10'"a c #ffffff",'#10'"..........",'#10'".#######a.",'#10
+'".#......a.",'#10'"..#....a..",'#10'"..#....a..",'#10'"...#..a...",'#10'"..'
+'.#..a...",'#10'"....#a....",'#10'"..........",'#10'".........."};'#10
]);
LazarusResources.Add('rx_markerup','XPM',[
'/* XPM */'#10'static char *rx_mark_up[]={'#10'"10 10 4 1",'#10'"b c None",'
+#10'". c None",'#10'"# c #808080",'#10'"a c #ffffff",'#10'"..........",'#10
+'"....#a....",'#10'"...#..a...",'#10'"...#..a...",'#10'"..#....a..",'#10'"..'
+'#....a..",'#10'".#......a.",'#10'".aaaaaaaa.",'#10'".bbbbbbbb.",'#10'".....'
+'....."};'#10
]);

42
components/rx/rxdbgrid.pas
View File

@ -365,13 +365,14 @@ type
property OnColEnter; property OnColEnter;
property OnColExit; property OnColExit;
property OnColumnMoved; property OnColumnMoved;
property OnColumnSized;
property OnDragDrop;
property OnDragOver;
property OnDrawColumnCell; property OnDrawColumnCell;
property OnDblClick; property OnDblClick;
//property OnDragDrop;
//property OnDragOver;
property OnEditButtonClick; property OnEditButtonClick;
//property OnEndDock; //property OnEndDock;
//property OnEndDrag; property OnEndDrag;
property OnEnter; property OnEnter;
property OnExit; property OnExit;
property OnFieldEditMask; property OnFieldEditMask;
@ -382,15 +383,18 @@ type
property OnMouseMove; property OnMouseMove;
property OnMouseUp; property OnMouseUp;
property OnPrepareCanvas; property OnPrepareCanvas;
property OnSelectEditor;
//property OnStartDock; //property OnStartDock;
//property OnStartDrag; property OnStartDrag;
property OnTitleClick; property OnTitleClick;
property OnUserCheckboxBitmap; property OnUserCheckboxBitmap;
end; end;
{
type type
PCharArray1 = Array[0..12] of PChar; PCharArray1 = Array[0..12] of PChar;
const const
IMGMarkerUp : PCharArray1 = IMGMarkerUp : PCharArray1 =
( (
@ -426,7 +430,7 @@ const
'....#a....', '....#a....',
'..........') '..........')
; ;
}
procedure RegisterExDBGridSortEngine(ExDBGridSortEngineClass:TExDBGridSortEngineClass; DataSetClass:TDataSetClass); procedure RegisterExDBGridSortEngine(ExDBGridSortEngineClass:TExDBGridSortEngineClass; DataSetClass:TDataSetClass);
@ -1118,21 +1122,28 @@ begin
R.Bottom:=TotalYOffs + DefaultRowHeight * FooterRowCount + 2; R.Bottom:=TotalYOffs + DefaultRowHeight * FooterRowCount + 2;
Canvas.Brush.Color := FFooterColor; Canvas.Brush.Color := FFooterColor;
// Writeln('[]Name ='+Owner.Name+'.'+Name);
if (Columns.Count > 0) then if (Columns.Count > 0) then
begin begin
TxS:=Canvas.TextStyle; TxS:=Canvas.TextStyle;
// writeln('GCache.VisibleGrid.Left =',GCache.VisibleGrid.Left,' GCache.VisibleGrid.Right=', GCache.VisibleGrid.Right);
// writeln('Columns.Count=',Columns.Count);
for i := GCache.VisibleGrid.Left to GCache.VisibleGrid.Right do for i := GCache.VisibleGrid.Left to GCache.VisibleGrid.Right do
begin begin
ColRowToOffset(True, True, i, R.Left, R.Right); ColRowToOffset(True, True, i, R.Left, R.Right);
Canvas.FillRect(R); Canvas.FillRect(R);
DrawCellGrid(i, 0, R, []); DrawCellGrid(i, 0, R, []);
C := ColumnFromGridColumn(i) as TRxColumn; C := ColumnFromGridColumn(i) as TRxColumn;
// if C = nil then
TxS.Alignment:=C.Footer.Alignment; // Writeln('i=',i,';', ' C = nil = ',C=nil);
TxS.Layout:=C.Footer.Layout; if Assigned(C) then
Canvas.TextStyle:=TxS; begin
DrawCellText(i, 0, R, [], C.Footer.DisplayText); TxS.Alignment:=C.Footer.Alignment;
TxS.Layout:=C.Footer.Layout;
Canvas.TextStyle:=TxS;
DrawCellText(i, 0, R, [], C.Footer.DisplayText);
end;
end; end;
ClipArea := Canvas.ClipRect; ClipArea := Canvas.ClipRect;
@ -1622,11 +1633,9 @@ begin
{$ENDIF} {$ENDIF}
FMarkerUp := TBitmap.Create; FMarkerUp := TBitmap.Create;
FMarkerUp.Handle := CreatePixmapIndirect(@IMGMarkerUp[0], FMarkerUp.LoadFromLazarusResource('rx_markerup');
GetSysColor(COLOR_BTNFACE));
FMarkerDown := TBitmap.Create; FMarkerDown := TBitmap.Create;
FMarkerDown.Handle := CreatePixmapIndirect(@IMGMarkerDown[0], FMarkerDown.LoadFromLazarusResource('rx_markerdown');
GetSysColor(COLOR_BTNFACE));
FPropertyStorageLink:=TPropertyStorageLink.Create; FPropertyStorageLink:=TPropertyStorageLink.Create;
FPropertyStorageLink.OnSave:=@OnIniSave; FPropertyStorageLink.OnSave:=@OnIniSave;
@ -2124,6 +2133,9 @@ begin
end; end;
initialization initialization
{$I rxdbgrid.lrs}
// {$I rx_markerdown.lrs}
ExDBGridSortEngineList:=TStringList.Create; ExDBGridSortEngineList:=TStringList.Create;
ExDBGridSortEngineList.Sorted:=true; ExDBGridSortEngineList.Sorted:=true;
finalization finalization

39
components/rx/rxdbgrid_findunit.lfm
View File

@ -15,9 +15,9 @@ object rxDBGridFindForm: TrxDBGridFindForm
AnchorSideBottom.Control = Edit1 AnchorSideBottom.Control = Edit1
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 6 Left = 6
Height = 13 Height = 14
Top = 17 Top = 16
Width = 62 Width = 57
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
Caption = 'Text to find' Caption = 'Text to find'
FocusControl = Edit1 FocusControl = Edit1
@ -28,9 +28,9 @@ object rxDBGridFindForm: TrxDBGridFindForm
AnchorSideBottom.Control = ComboBox1 AnchorSideBottom.Control = ComboBox1
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 6 Left = 6
Height = 13 Height = 14
Top = 51 Top = 45
Width = 67 Width = 57
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
Caption = 'Find at filed' Caption = 'Find at filed'
ParentColor = False ParentColor = False
@ -41,6 +41,7 @@ object rxDBGridFindForm: TrxDBGridFindForm
Top = 8 Top = 8
Width = 80 Width = 80
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.InnerBorder = 4
Caption = 'Find more' Caption = 'Find more'
Default = True Default = True
OnClick = BtnFindClick OnClick = BtnFindClick
@ -55,6 +56,7 @@ object rxDBGridFindForm: TrxDBGridFindForm
Width = 80 Width = 80
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Top = 8 BorderSpacing.Top = 8
BorderSpacing.InnerBorder = 4
Cancel = True Cancel = True
Caption = 'Close' Caption = 'Close'
OnClick = Button2Click OnClick = Button2Click
@ -62,10 +64,10 @@ object rxDBGridFindForm: TrxDBGridFindForm
end end
object Edit1: TEdit object Edit1: TEdit
AnchorSideLeft.Control = ComboBox1 AnchorSideLeft.Control = ComboBox1
Left = 81 Left = 71
Height = 22 Height = 22
Top = 8 Top = 8
Width = 316 Width = 326
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
AutoSize = True AutoSize = True
TabOrder = 0 TabOrder = 0
@ -77,14 +79,15 @@ object rxDBGridFindForm: TrxDBGridFindForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Edit1 AnchorSideRight.Control = Edit1
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 81 Left = 71
Height = 26 Height = 21
Top = 38 Top = 38
Width = 316 Width = 326
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending] AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 8 BorderSpacing.Top = 8
ItemHeight = 13
MaxLength = 0 MaxLength = 0
Style = csDropDownList Style = csDropDownList
TabOrder = 1 TabOrder = 1
@ -94,9 +97,9 @@ object rxDBGridFindForm: TrxDBGridFindForm
AnchorSideTop.Control = ComboBox1 AnchorSideTop.Control = ComboBox1
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 6 Left = 6
Height = 20 Height = 13
Top = 72 Top = 67
Width = 113 Width = 92
BorderSpacing.Top = 8 BorderSpacing.Top = 8
Caption = 'Case sensetive' Caption = 'Case sensetive'
TabOrder = 2 TabOrder = 2
@ -116,7 +119,7 @@ object rxDBGridFindForm: TrxDBGridFindForm
ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1 ChildSizing.ControlsPerLine = 1
ClientHeight = 59 ClientHeight = 58
ClientWidth = 146 ClientWidth = 146
Items.Strings = ( Items.Strings = (
'All' 'All'
@ -131,9 +134,9 @@ object rxDBGridFindForm: TrxDBGridFindForm
AnchorSideTop.Control = CheckBox1 AnchorSideTop.Control = CheckBox1
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 6 Left = 6
Height = 20 Height = 13
Top = 100 Top = 88
Width = 86 Width = 69
BorderSpacing.Top = 8 BorderSpacing.Top = 8
Caption = 'Partial key' Caption = 'Partial key'
TabOrder = 3 TabOrder = 3

71
components/rx/rxdbgrid_findunit.lrs
View File

@ -6,44 +6,45 @@ LazarusResources.Add('TrxDBGridFindForm','FORMDATA',[
+'rollBar.Page'#2'~'#13'ActiveControl'#7#7'BtnFind'#7'Caption'#6#4'Find'#12'C' +'rollBar.Page'#2'~'#13'ActiveControl'#7#7'BtnFind'#7'Caption'#6#4'Find'#12'C'
+'lientHeight'#2''#11'ClientWidth'#3#237#1#10'OnActivate'#7#12'FormActivate' +'lientHeight'#2''#11'ClientWidth'#3#237#1#10'OnActivate'#7#12'FormActivate'
+#6'OnShow'#7#8'FormShow'#0#6'TLabel'#6'Label1'#24'AnchorSideBottom.Control'#7 +#6'OnShow'#7#8'FormShow'#0#6'TLabel'#6'Label1'#24'AnchorSideBottom.Control'#7
+#5'Edit1'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'#2#6#6'Height'#2#13 +#5'Edit1'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'#2#6#6'Height'#2#14
+#3'Top'#2#17#5'Width'#2'>'#7'Anchors'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6 +#3'Top'#2#16#5'Width'#2'9'#7'Anchors'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6
+#12'Text to find'#12'FocusControl'#7#5'Edit1'#11'ParentColor'#8#0#0#6'TLabel' +#12'Text to find'#12'FocusControl'#7#5'Edit1'#11'ParentColor'#8#0#0#6'TLabel'
+#6'Label2'#22'AnchorSideLeft.Control'#7#6'Label1'#24'AnchorSideBottom.Contro' +#6'Label2'#22'AnchorSideLeft.Control'#7#6'Label1'#24'AnchorSideBottom.Contro'
+'l'#7#9'ComboBox1'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'#2#6#6'He' +'l'#7#9'ComboBox1'#21'AnchorSideBottom.Side'#7#9'asrBottom'#4'Left'#2#6#6'He'
+'ight'#2#13#3'Top'#2'3'#5'Width'#2'C'#7'Anchors'#11#6'akLeft'#8'akBottom'#0#7 +'ight'#2#14#3'Top'#2'-'#5'Width'#2'9'#7'Anchors'#11#6'akLeft'#8'akBottom'#0#7
+'Caption'#6#13'Find at filed'#11'ParentColor'#8#0#0#7'TButton'#7'BtnFind'#4 +'Caption'#6#13'Find at filed'#11'ParentColor'#8#0#0#7'TButton'#7'BtnFind'#4
+'Left'#3#152#1#6'Height'#2'&'#3'Top'#2#8#5'Width'#2'P'#7'Anchors'#11#5'akTop' +'Left'#3#152#1#6'Height'#2'&'#3'Top'#2#8#5'Width'#2'P'#7'Anchors'#11#5'akTop'
+#7'akRight'#0#7'Caption'#6#9'Find more'#7'Default'#9#7'OnClick'#7#12'BtnFind' +#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#9'Find more'#7
+'Click'#8'TabOrder'#2#4#0#0#7'TButton'#7'Button2'#21'AnchorSideTop.Control'#7 +'Default'#9#7'OnClick'#7#12'BtnFindClick'#8'TabOrder'#2#4#0#0#7'TButton'#7'B'
+#7'BtnFind'#18'AnchorSideTop.Side'#7#9'asrBottom'#4'Left'#3#152#1#6'Height'#2 +'utton2'#21'AnchorSideTop.Control'#7#7'BtnFind'#18'AnchorSideTop.Side'#7#9'a'
+'"'#3'Top'#2'6'#5'Width'#2'P'#7'Anchors'#11#5'akTop'#7'akRight'#0#17'BorderS' +'srBottom'#4'Left'#3#152#1#6'Height'#2'"'#3'Top'#2'6'#5'Width'#2'P'#7'Anchor'
+'pacing.Top'#2#8#6'Cancel'#9#7'Caption'#6#5'Close'#7'OnClick'#7#12'Button2Cl' +'s'#11#5'akTop'#7'akRight'#0#17'BorderSpacing.Top'#2#8#25'BorderSpacing.Inne'
+'ick'#8'TabOrder'#2#5#0#0#5'TEdit'#5'Edit1'#22'AnchorSideLeft.Control'#7#9'C' +'rBorder'#2#4#6'Cancel'#9#7'Caption'#6#5'Close'#7'OnClick'#7#12'Button2Click'
+'omboBox1'#4'Left'#2'Q'#6'Height'#2#22#3'Top'#2#8#5'Width'#3'<'#1#7'Anchors' +#8'TabOrder'#2#5#0#0#5'TEdit'#5'Edit1'#22'AnchorSideLeft.Control'#7#9'ComboB'
+#11#5'akTop'#6'akLeft'#7'akRight'#0#8'AutoSize'#9#8'TabOrder'#2#0#0#0#9'TCom' +'ox1'#4'Left'#2'G'#6'Height'#2#22#3'Top'#2#8#5'Width'#3'F'#1#7'Anchors'#11#5
+'boBox'#9'ComboBox1'#22'AnchorSideLeft.Control'#7#6'Label2'#19'AnchorSideLef' +'akTop'#6'akLeft'#7'akRight'#0#8'AutoSize'#9#8'TabOrder'#2#0#0#0#9'TComboBox'
+'t.Side'#7#9'asrBottom'#21'AnchorSideTop.Control'#7#5'Edit1'#18'AnchorSideTo' +#9'ComboBox1'#22'AnchorSideLeft.Control'#7#6'Label2'#19'AnchorSideLeft.Side'
+'p.Side'#7#9'asrBottom'#23'AnchorSideRight.Control'#7#5'Edit1'#20'AnchorSide' +#7#9'asrBottom'#21'AnchorSideTop.Control'#7#5'Edit1'#18'AnchorSideTop.Side'#7
+'Right.Side'#7#9'asrBottom'#4'Left'#2'Q'#6'Height'#2#26#3'Top'#2'&'#5'Width' +#9'asrBottom'#23'AnchorSideRight.Control'#7#5'Edit1'#20'AnchorSideRight.Side'
+#3'<'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#16'AutoCompleteText'#11 +#7#9'asrBottom'#4'Left'#2'G'#6'Height'#2#21#3'Top'#2'&'#5'Width'#3'F'#1#7'An'
+#22'cbactEndOfLineComplete'#20'cbactSearchAscending'#0#18'BorderSpacing.Left' +'chors'#11#5'akTop'#6'akLeft'#7'akRight'#0#16'AutoCompleteText'#11#22'cbactE'
+#2#8#17'BorderSpacing.Top'#2#8#9'MaxLength'#2#0#5'Style'#7#14'csDropDownList' +'ndOfLineComplete'#20'cbactSearchAscending'#0#18'BorderSpacing.Left'#2#8#17
+#8'TabOrder'#2#1#0#0#9'TCheckBox'#9'CheckBox1'#22'AnchorSideLeft.Control'#7#6 +'BorderSpacing.Top'#2#8#10'ItemHeight'#2#13#9'MaxLength'#2#0#5'Style'#7#14'c'
+'Label1'#21'AnchorSideTop.Control'#7#9'ComboBox1'#18'AnchorSideTop.Side'#7#9 +'sDropDownList'#8'TabOrder'#2#1#0#0#9'TCheckBox'#9'CheckBox1'#22'AnchorSideL'
+'asrBottom'#4'Left'#2#6#6'Height'#2#20#3'Top'#2'H'#5'Width'#2'q'#17'BorderSp' +'eft.Control'#7#6'Label1'#21'AnchorSideTop.Control'#7#9'ComboBox1'#18'Anchor'
+'acing.Top'#2#8#7'Caption'#6#14'Case sensetive'#8'TabOrder'#2#2#0#0#11'TRadi' +'SideTop.Side'#7#9'asrBottom'#4'Left'#2#6#6'Height'#2#13#3'Top'#2'C'#5'Width'
+'oGroup'#11'RadioGroup1'#4'Left'#3#232#0#6'Height'#2'L'#3'Top'#2'H'#5'Width' +#2'\'#17'BorderSpacing.Top'#2#8#7'Caption'#6#14'Case sensetive'#8'TabOrder'#2
+#3#150#0#8'AutoFill'#9#7'Caption'#6#9'Direction'#28'ChildSizing.LeftRightSpa' +#2#0#0#11'TRadioGroup'#11'RadioGroup1'#4'Left'#3#232#0#6'Height'#2'L'#3'Top'
+'cing'#2#6#28'ChildSizing.TopBottomSpacing'#2#6#29'ChildSizing.EnlargeHorizo' +#2'H'#5'Width'#3#150#0#8'AutoFill'#9#7'Caption'#6#9'Direction'#28'ChildSizin'
+'ntal'#7#24'crsHomogenousChildResize'#27'ChildSizing.EnlargeVertical'#7#24'c' +'g.LeftRightSpacing'#2#6#28'ChildSizing.TopBottomSpacing'#2#6#29'ChildSizing'
+'rsHomogenousChildResize'#28'ChildSizing.ShrinkHorizontal'#7#14'crsScaleChil' +'.EnlargeHorizontal'#7#24'crsHomogenousChildResize'#27'ChildSizing.EnlargeVe'
+'ds'#26'ChildSizing.ShrinkVertical'#7#14'crsScaleChilds'#18'ChildSizing.Layo' +'rtical'#7#24'crsHomogenousChildResize'#28'ChildSizing.ShrinkHorizontal'#7#14
+'ut'#7#29'cclLeftToRightThenTopToBottom'#27'ChildSizing.ControlsPerLine'#2#1 +'crsScaleChilds'#26'ChildSizing.ShrinkVertical'#7#14'crsScaleChilds'#18'Chil'
+#12'ClientHeight'#2';'#11'ClientWidth'#3#146#0#13'Items.Strings'#1#6#3'All'#6 +'dSizing.Layout'#7#29'cclLeftToRightThenTopToBottom'#27'ChildSizing.Controls'
+#7'Forward'#6#8'Backward'#0#8'TabOrder'#2#6#7'Visible'#8#0#0#9'TCheckBox'#9 +'PerLine'#2#1#12'ClientHeight'#2':'#11'ClientWidth'#3#146#0#13'Items.Strings'
+'CheckBox2'#22'AnchorSideLeft.Control'#7#6'Label1'#21'AnchorSideTop.Control' +#1#6#3'All'#6#7'Forward'#6#8'Backward'#0#8'TabOrder'#2#6#7'Visible'#8#0#0#9
+#7#9'CheckBox1'#18'AnchorSideTop.Side'#7#9'asrBottom'#4'Left'#2#6#6'Height'#2 +'TCheckBox'#9'CheckBox2'#22'AnchorSideLeft.Control'#7#6'Label1'#21'AnchorSid'
+#20#3'Top'#2'd'#5'Width'#2'V'#17'BorderSpacing.Top'#2#8#7'Caption'#6#11'Part' +'eTop.Control'#7#9'CheckBox1'#18'AnchorSideTop.Side'#7#9'asrBottom'#4'Left'#2
+'ial key'#8'TabOrder'#2#3#0#0#0 +#6#6'Height'#2#13#3'Top'#2'X'#5'Width'#2'E'#17'BorderSpacing.Top'#2#8#7'Capt'
+'ion'#6#11'Partial key'#8'TabOrder'#2#3#0#0#0
]); ]);

1
components/rx/rxdbgrid_findunit.pas
View File

@ -60,6 +60,7 @@ procedure TrxDBGridFindForm.FormActivate(Sender: TObject);
begin begin
{ BtnFind.Height:=Canvas.TextHeight('W') + 6; { BtnFind.Height:=Canvas.TextHeight('W') + 6;
Button2.Height:=BtnFind.Height;} Button2.Height:=BtnFind.Height;}
ComboBox1.Height:=Edit1.Height;
end; end;
procedure TrxDBGridFindForm.FormShow(Sender: TObject); procedure TrxDBGridFindForm.FormShow(Sender: TObject);

2
components/rx/rxdconst.pas
View File

@ -23,7 +23,7 @@ const
less that above. } less that above. }
MaxExtStrID = 61300; MaxExtStrID = 61300;
const resourcestring
(* (*
{ DBLists } { DBLists }

439
components/rx/rxiconv.pas Normal file
View File

@ -0,0 +1,439 @@
(*
A.Voitov zprokuror(cyka)narod.ru
LAZARUS-FPC-LINUX codeset conversion routines
The goal is easy-and-on-fly *.lrs conversion from codeset used by developer to
user's system codeset without gettext, without separate message files etc.
Now I only have to set my codeset below (by default it's mine - UTF-8) -
DON'T FORGET ABOUT IT -
and call LocalizeForm('TFormClassName') right after {$I TFormClassName.lrs} -
see example below.
This way form resource file will be converted to system codeset when form is
creating.
For gtk/gnome there's only one conversion routine
function Localize(source:string):ansistring;
For gtk2 resource MUST, I guess, be converted to UTF-8 anyway (if it's not yet),
so I set current_codeset to UTF-8 with FORCE_UTF8 definition. Though if
developer's codeset is UTF-8 then no form resource conversion needed.
Localize is published function so it can be used again to convert string constants,
resource strings in most cases with no care about user's and developer's codeset.
But it's not enough sometime (file names, inifiles etc. can be wrong when gtk2
works in koi8-r locale).
That's why we've got some stuff th handle it without care.
1. First one is TIconv object (I'm not sure it's best way to do maybe it would class?
if so uncomment $DEFINE OBJ_IS_CLASS below)
2. Second are uiconv_xxx functions
They can be used to easy implement any valid conversions.
EXAMPLES:
1. Auto form conversion
- set my codeset below: {$DEFINE DC_UTF8}
- add LocalizeForm('TFormClassName') after {$I TFormClassName.lrs}
<CODE>
unit1;
[...]
initialization
{$I unit1.lrs}
LocalizeForm('TForm1');
end.
</CODE>
2. TIconv object example:
object is local variable here, but it can be global (create at startup,
dead in the end) if it's always in-use.
<CODE>
function koi8r_to_utf8(S:string):string;
var iConverter:pIconv;
begin
iConverter:=NewIconv('CP1251', 'UTF-8');
Result:=iConverter.iconv(S);
iConverter.Free;
end;
</CODE>
3. uiconv_xxx example - obvious.
APPENDIX
i. KNOWN DEVELOPER'S CODESET DEFENITIONS:
$DC_KOI8 (obvious)
$DC_UTF8 (obvious) - default
$DC_WIN (CP1251) - not tested yet
ii. GTK2 NOTES
As I found there's something wrong with some strings when gtk2 is used under
koi8-r locale. OpenDialog.FileName is stored in my inifile as koi8-r string
and then can't be loaded in MRU menu.
So I've got a couple of functions here for that case: str2gtk and gtk2str.
'str' means current codeset (locale)
iii. This unit tested with dc_utf8 and user's locale koi8-r only
*)
unit rxiconv;
{* Developer's codeset. Must be set on design-time. Default is UTF8}
{.$DEFINE DC_KOI8}
{$DEFINE DC_WIN}
{.$DEFINE DC_UTF8} //nothing defined so DC_UTF8 will be defined here
{$IFNDEF DC_UTF8}
{$IFNDEF DC_KOI8}
{$IFNDEF DC_WIN}
{$DEFINE DC_UTF8}
{$ENDIF DC_WIN}
{$ENDIF DC_KOI8}
{$ENDIF DC_UTF8}
{* user acces to iconv functions}
{$DEFINE USER_ICONV}
{* TIconv object}
{$DEFINE USE_OBJECT}
{* Ticonv is class(TObject)}
{$DEFINE OBJ_IS_CLASS}
{* form-localization needed only with gtk1 or with gtk2 if developer's codeset
is not utf-8. First turn it of.}
{$UNDEF USE_LOCALIZE}
{* if widgetset is GTK2 ($IFDEF LCLGtk2) and developer's codeset is not DC_UTF8
then we'd FORCE_UTF8 and turn on USE_LOCALIZE. And if widgetset is GTK1 then
we USE_LOCALIZE too.}
{$IFDEF LCLGtk2}
{$IFNDEF DC_UTF8}
{$DEFINE USE_LOCALIZE}
{$DEFINE FORCE_UTF8}
{$ENDIF DC_UTF8}
{$ELSE LCLGtk2}
{$DEFINE USE_LOCALIZE}
{$ENDIF LCLGtk2}
{$mode objfpc}
interface
{$IFNDEF WINDOWS}
uses
{$IFDEF USE_LOCALIZE} LResources, Classes,{$ENDIF} initc, SysUtils;
{* returns current codeset}
function GetCodeset():ansistring;
{$IFDEF USE_LOCALIZE}
{* returns true if current codeset<>developer's codeset}
function InvalidCodeset():boolean;
{$ENDIF USE_LOCALIZE}
{* basic string conversion - enough for localization.
conversion from developer's codeset 2 user's codeset}
function Localize(source:ansistring):ansistring;
{with gtk2 converts utf8 to locale codeset and back}
{$IFDEF LCLGtk2}
function str2gtk(source:ansistring):ansistring;
function gtk2str(source:ansistring):ansistring;
{$ENDIF LCLGtk2}
{* public access 2 iconv}
{$IFDEF USER_ICONV}
function uiconv(ic_usr:pointer; source:ansistring):ansistring ;
function uiconv_open(ic_from, ic_to:ansistring):pointer ;
procedure uiconv_close(ic_usr:pointer) ;
{$ENDIF USER_ICONV}
{* form conversion}
procedure LocalizeForm(form_classname:ansistring);
procedure LocalizeAllForm;
{* iconv object/class}
{$IFDEF USE_OBJECT}
type
{$IFDEF OBJ_IS_CLASS}
Ticonv=class(TObject)
{$ELSE OBJ_IS_CLASS}
pIconv=^Ticonv;
Ticonv=object
protected
{$ENDIF OBJ_IS_CLASS}
hIconv:pointer;
public
destructor Destroy;{$IFDEF OBJ_IS_CLASS}virtual;{$ENDIF OBJ_IS_CLASS}
{$IFNDEF OBJ_IS_CLASS}
procedure Free;
{$ENDIF OBJ_IS_CLASS}
constructor Create{$IFDEF OBJ_IS_CLASS}(cs_from, cs_to:ansistring){$ENDIF OBJ_IS_CLASS};
function iconv(source:ansistring):ansistring;
end;
{$IFNDEF OBJ_IS_CLASS}
function NewIconv(cs_from, cs_to:ansistring):TIconv ;
{$ENDIF OBJ_IS_CLASS}
{$ENDIF USE_OBJECT}
{$ENDIF}
implementation
{$IFNDEF WINDOWS}
uses dialogs;
{$linklib c}
const
libiconvname='c';
__LC_CTYPE = 0;
_NL_CTYPE_CLASS = (__LC_CTYPE shl 16);
_NL_CTYPE_CODESET_NAME = (_NL_CTYPE_CLASS)+14;
CODESET = _NL_CTYPE_CODESET_NAME;
{developer's codeset names}
{$IFDEF DC_KOI8}
DEV_CODESET='KOI8-R';
DC_NAME='KOI';
DC_NAME_EXT='R';
{$ENDIF DC_KOI8}
{$IFDEF DC_UTF8}
DEV_CODESET='UTF-8';
DC_NAME='UTF';
DC_NAME_EXT='8';
{$ENDIF DC_UTF8}
{$IFDEF DC_WIN}
DEV_CODESET='CP1251';
DC_NAME='1251';
DC_NAME_EXT='1251';
{$ENDIF DC_WIN}
type
size_t = cardinal;
pSize = ^size_t;
psize_t = pSize;
cInt = longint;
piconv_t = ^iconv_t;
iconv_t = pointer;
nl_item = cint;
var //iconv pointers
{$IFDEF LCLGtk2}
ic_str2gtk, ic_gtk2str,
{$ENDIF LCLGtk2}
ic_localize : iconv_t;
function nl_langinfo(__item:nl_item):pchar;cdecl;external libiconvname name 'nl_langinfo';
function iconv_open(__tocode:pchar; __fromcode:pchar):iconv_t;cdecl;external libiconvname name 'iconv_open';
function iconv(__cd:iconv_t; __inbuf:ppchar; __inbytesleft:psize_t; __outbuf:ppchar; __outbytesleft:psize_t):size_t;cdecl;external libiconvname name 'iconv';
function iconv_close(__cd:iconv_t):cint;cdecl;external libiconvname name 'iconv_close';
{* common procedures}
function GetCodeset():ansistring;
begin
Result:= ansistring(nl_langinfo(CODESET));
end;
function CodesetIs(CSNAME, CSEXT:ansistring):boolean ;
var CS:ansistring;
begin
CS:=UpperCase(GetCodeSet);
if ((pos(CSNAME,CS)<>0) and (pos(CSEXT,CS)<>0)) then Result:=true else Result:=false;
end;
{* main conversion procedure}
function _iconv(hiconv:iconv_t; source:ansistring):ansistring;
const
ESysEILSEQ = 84;
ESysE2BIG = 7;
var
len:SizeInt;
outlength,
outoffset,
outleft : size_t;
srcpos,
destpos: pchar;
mynil : pchar;
my0 : size_t;
begin
mynil:=nil;
my0:=0;
// extra space
len:=length(source);
outlength:=len*3+1; //setlength(result,outlength);
Result:=StringOfChar(#0, outlength);
//outlength:=len+1;
srcpos:=pChar(source);
destpos:=pchar(result);
outleft:=outlength*2;
while iconv(hiconv,@srcpos,@len,@destpos,@outleft)=size_t(-1) do
begin
case fpgetCerrno of
ESysEILSEQ:
begin
{ skip and set to '?' }
inc(srcpos);
pwidechar(destpos)^:='?';
inc(destpos,2);
dec(outleft,2);
{ reset }
iconv(hiconv,@mynil,@my0,@mynil,@my0);
end;
ESysE2BIG:
begin
outoffset:=destpos-pchar(result);
{ extend }
setlength(result,outlength+len);
inc(outleft,len*2);
inc(outlength,len);
{ string could have been moved }
destpos:=pchar(result)+outoffset;
end;
else
raise EConvertError.Create('iconv error '+IntToStr(fpgetCerrno));
end;
end;
//setlength(result,length(result)-outleft div 2); // truncate string
Result:=TrimRight(Result);// not shure it always works right
end;
{$IFDEF USE_OBJECT}
{* Ticonv *}
{$IFNDEF OBJ_IS_CLASS}
function _NewIconv(cs_from, cs_to:ansistring):pIconv ;
begin
New( Result, Create);
Result^.hIconv:=Pointer(iconv_open(pChar(cs_to), pChar(cs_from)));
end;
function NewIconv(cs_from, cs_to:ansistring):TIconv ;
begin
Result:=_NewIconv(cs_from, cs_to)^;
end;
procedure Ticonv.Free();
begin
if @Self<>nil then Self.Destroy;
end;
{$ENDIF OBJ_IS_CLASS}
constructor Ticonv.Create{$IFDEF OBJ_IS_CLASS}(cs_from, cs_to:ansistring){$ENDIF OBJ_IS_CLASS};
begin {$IFDEF OBJ_IS_CLASS}
inherited Create;
hIconv:=Pointer(iconv_open(pChar(cs_to), pChar(cs_from)));
{$ENDIF OBJ_IS_CLASS}
end;
destructor Ticonv.Destroy;
begin
iconv_close(hIconv);
Inherited;
end;
function Ticonv.iconv(source:ansistring):ansistring;
begin
Result:=_iconv(hIconv, source);
end;
{$ENDIF USE_OBJECT}
{$IFDEF USER_ICONV}
function uiconv(ic_usr:pointer; source:ansistring):ansistring ;
begin
Result:=_iconv(iconv_t(ic_usr), pchar(source));
end;
function uiconv_open(ic_from, ic_to:ansistring):pointer ;
begin
Result:= iconv_open(pchar(ic_to), pchar(ic_from));
end;
procedure uiconv_close(ic_usr:pointer) ;
begin
iconv_close(iconv_t(ic_usr));
end;
{$ENDIF USER_ICONV}
function Localize(source:ansistring):ansistring;
begin
Result:=_iconv(ic_localize, source);
end;
{$IFDEF LCLGtk2}
function str2gtk(source:ansistring):ansistring;
begin
Result:=_iconv(ic_str2gtk, source);
end;
function gtk2str(source:ansistring):ansistring;
begin
Result:=_iconv(ic_gtk2str, source);
end;
{$ENDIF LCLGtk2}
{* form localization - only if use_localize}
{$IFDEF USE_LOCALIZE}
function InvalidCodeset():boolean;
begin
Result:=False;
{$IFNDEF FORCE_UTF8} Result:= not (CodesetIs(DC_NAME, DC_NAME_EXT));{$ENDIF FORCE_UTF8}
end;
{* converts form resource from developer's codeset to env codeset.
it's empty procedure if widgetSet is gtk2 and dev's codeset is utf8.
So USE_LOCCALIZE definition used }
procedure LocalizeForm(form_classname:ansistring);
var res : TLResource;
S : ansistring;
RS, MS : TMemoryStream;
begin
{$IFNDEF FORCE_UTF8} //always convert to utf8
if not InvalidCodeset then exit;
{$ENDIF FORCE_UTF8}
{find resource}
res:=LazarusResources.Find(form_classname);
RS:=TMemoryStream.create;
MS:=TMemoryStream.create;
{read form 2 RS}
RS.Write(res.Value[1],length(res.Value));
RS.Position:=0;
{convert 2 text}
LRSObjectBinaryToText( RS, MS);
MS.Position:=0;
{copy 2 string}
SetLength(S, MS.Size);
MS.Read(S[1], MS.Size);
{convert 2 ccs or utf8 - under gtk2}
S:=Localize(S);
{copy back to ms}
S:=Trim(S) + #0#0#0#0; //doesn't work without it...
MS.Position:=0;
MS.Write(S[1],length(S));
MS.Position:=0;
RS.SetSize(0);
{convert 2 binary RS}
LRSObjectTextToBinary(MS, RS);
RS.Position:=0;
SetLength(S, RS.Size);
{write 2 resource}
RS.Read(S[1],RS.Size);
res.Value:=S;
MS.Free; RS.Free;
end;
procedure LocalizeAllForm;
var
i:integer;
begin
for i:=0 to LazarusResources.Count - 1 do
begin
if LazarusResources.Items[i].ValueType = 'FORMDATA' then
LocalizeForm(LazarusResources.Items[i].Name);
end;
end;
{$ELSE USE_LOCALIZE}
{* dummy proc for easy testing}
procedure LocalizeForm(form_classname:ansistring);begin {*} end;
procedure LocalizeAllForm;
begin
end;
{$ENDIF USE_LOCALIZE}
initialization
{$IFNDEF FORCE_UTF8}
ic_localize := iconv_open(nl_langinfo(CODESET), DEV_CODESET); //main
{$ELSE FORCE_UTF8}
ic_localize := iconv_open('UTF-8', DEV_CODESET);
{$ENDIF FORCE_UTF8}
{$IFDEF LCLGtk2}
ic_str2gtk:= iconv_open('UTF-8', nl_langinfo(CODESET));
ic_gtk2str:= iconv_open(nl_langinfo(CODESET), 'UTF-8');
{$ENDIF LCLGtk2}
finalization
iconv_close(ic_localize);
{$IFDEF LCLGtk2}
iconv_close(ic_str2gtk);
iconv_close(ic_gtk2str);
{$ENDIF LCLGtk2}
{$ENDIF}
end.

117
components/rx/rxlookup.pas
View File

@ -182,8 +182,9 @@ type
procedure UpdateData; procedure UpdateData;
procedure OnClosePopup(AResult:boolean); procedure OnClosePopup(AResult:boolean);
protected protected
procedure SetEnabled(Value: Boolean); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: char); dynamic; procedure KeyPress(var Key: char); override;
procedure SetParent(AParent: TWinControl); override; procedure SetParent(AParent: TWinControl); override;
procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
procedure DoPositionButton; virtual; procedure DoPositionButton; virtual;
@ -295,7 +296,7 @@ type
end; end;
implementation implementation
uses VCLUtils, Math; uses VCLUtils, Math, rxdconst;
{ TCustomDBLookupEdit } { TCustomDBLookupEdit }
@ -809,7 +810,7 @@ begin
W := FPopUpFormOptions.Columns[i].Width W := FPopUpFormOptions.Columns[i].Width
else else
begin begin
W := F.DisplayWidth; W := F.DisplayWidth;
if I < LastIndex then if I < LastIndex then
W := W * TxtWidth + 4 W := W * TxtWidth + 4
else else
@ -837,9 +838,9 @@ end;
procedure TRxCustomDBLookupCombo.CheckNotCircular; procedure TRxCustomDBLookupCombo.CheckNotCircular;
begin begin
{ if FDataLink.Active and ((DataSource = LookupSource) or if FDataLink.Active and ((DataSource = LookupSource) or
(FDataLink.DataSet = FLookupLink.DataSet)) then (FDataLink.DataSet = FLookupDataLink.DataSet)) then
_DBError(SCircularDataLink);} _DBError(SCircularDataLink);
end; end;
procedure TRxCustomDBLookupCombo.DisplayValueChanged; procedure TRxCustomDBLookupCombo.DisplayValueChanged;
@ -888,7 +889,7 @@ end;
procedure TRxCustomDBLookupCombo.UpdateFieldValues; procedure TRxCustomDBLookupCombo.UpdateFieldValues;
var var
i:integer; i, k:integer;
F:TField; F:TField;
begin begin
FValuesList.Clear; FValuesList.Clear;
@ -901,16 +902,13 @@ begin
for i:=0 to FFieldList.Count-1 do for i:=0 to FFieldList.Count-1 do
begin begin
F:=FLookupDataLink.DataSet.FieldByName(FFieldList[i]); F:=FLookupDataLink.DataSet.FieldByName(FFieldList[i]);
FValuesList.Add(F.DisplayText); k:=FValuesList.Add(F.DisplayText);
FValuesList.Objects[k]:=TObject(F.DisplayWidth);
end; end;
end; end;
end; end;
procedure TRxCustomDBLookupCombo.ShowList; procedure TRxCustomDBLookupCombo.ShowList;
var
i,c,W:integer;
GC:TColumn;
F, F1:TField;
begin begin
if Assigned(FLookupDataLink.DataSet) and (FLookupDataLink.DataSet.Active) then if Assigned(FLookupDataLink.DataSet) and (FLookupDataLink.DataSet.Active) then
if not PopupVisible then if not PopupVisible then
@ -983,6 +981,12 @@ begin
Parent.Repaint; Parent.Repaint;
end; end;
procedure TRxCustomDBLookupCombo.SetEnabled(Value: Boolean);
begin
inherited SetEnabled(Value);
Invalidate;
end;
procedure TRxCustomDBLookupCombo.KeyDown(var Key: Word; Shift: TShiftState); procedure TRxCustomDBLookupCombo.KeyDown(var Key: Word; Shift: TShiftState);
begin begin
if (Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN, VK_RETURN, VK_HOME, VK_END]) and PopupVisible then if (Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN, VK_RETURN, VK_HOME, VK_END]) and PopupVisible then
@ -1017,12 +1021,14 @@ begin
begin begin
FDataLink.Edit; FDataLink.Edit;
if not FDataField.IsNull then if not FDataField.IsNull then
FLocateObject.Locate(FLookupField, FDataField.AsString, true, false); begin
case Key of FLocateObject.Locate(FLookupField, FDataField.AsString, true, false);
VK_UP: if not FLookupDataLink.DataSet.BOF then case Key of
FLookupDataLink.DataSet.Prior; VK_UP: if not FLookupDataLink.DataSet.BOF then
VK_DOWN: if not FLookupDataLink.DataSet.EOF then FLookupDataLink.DataSet.Prior;
FLookupDataLink.DataSet.Next; VK_DOWN: if not FLookupDataLink.DataSet.EOF then
FLookupDataLink.DataSet.Next;
end;
end; end;
FDataLink.UpdateRecord; FDataLink.UpdateRecord;
KeyValueChanged; KeyValueChanged;
@ -1118,10 +1124,9 @@ end;
procedure TRxCustomDBLookupCombo.Paint; procedure TRxCustomDBLookupCombo.Paint;
var var
Selected:boolean; Selected:boolean;
R, ImageRect: TRect; R: TRect;
X, Flags, TextMargin: Integer; X, TextMargin: Integer;
AText: string; AText: string;
Bmp: TBitmap;
begin begin
Canvas.Font := Font; Canvas.Font := Font;
Canvas.Brush.Color := Color; Canvas.Brush.Color := Color;
@ -1132,8 +1137,10 @@ begin
Canvas.Brush.Color := clHighlight; Canvas.Brush.Color := clHighlight;
end end
else else
if not Enabled and NewStyleControls then if not Enabled {and NewStyleControls }then
Canvas.Font.Color := clGrayText; begin
Canvas.Font.Color := clInactiveCaption;
end;
SetRect(R, 0, 0, ClientWidth, ClientHeight); SetRect(R, 0, 0, ClientWidth, ClientHeight);
if Flat then if Flat then
@ -1152,49 +1159,24 @@ begin
SetRect(R, 2, 2, ClientWidth - 2, ClientHeight - 2); SetRect(R, 2, 2, ClientWidth - 2, ClientHeight - 2);
if TextMargin > 0 then Inc(TextMargin); if TextMargin > 0 then Inc(TextMargin);
X := 2 + TextMargin; X := 2 + TextMargin;
{ if not (FPopupVisible and (FDataList.FSearchText <> '')) and not DrawList then Canvas.FillRect(R);
case Alignment of if FDisplayAll then
taRightJustify: X := W - Canvas.TextWidth(AText) - 6; PaintDisplayValues(Canvas, R, TextMargin)
taCenter: X := (W + TextMargin - Canvas.TextWidth(AText)) div 2; else
end;} begin
Bmp := TBitmap.Create; if Assigned(FDataField) and FDataField.IsNull then
try
with Bmp.Canvas do
begin begin
Font := Self.Canvas.Font; Canvas.Brush.Color:=FEmptyItemColor;
Brush := Self.Canvas.Brush; Canvas.FillRect(R);
Pen := Self.Canvas.Pen; AText:=FEmptyValue
end; end
Bmp.Width := WidthOf(R);
Bmp.Height := HeightOf(R);
ImageRect := Rect(0, 0, WidthOf(R), HeightOf(R));
Bmp.Canvas.FillRect(ImageRect);
if FDisplayAll then
PaintDisplayValues(Bmp.Canvas, ImageRect, TextMargin)
else else
begin if FValuesList.Count>0 then
if Assigned(FDataField) and FDataField.IsNull then AText:=FValuesList[FLookupDisplayIndex]
begin else
Bmp.Canvas.Brush.Color:=FEmptyItemColor; AText:='';
Bmp.Canvas.FillRect(ImageRect); Canvas.TextRect(R, X, Max(0, (HeightOf(R) - Canvas.TextHeight(AText)) div 2), AText);
AText:=FEmptyValue end
end
else
if FValuesList.Count>0 then
AText:=FValuesList[FLookupDisplayIndex]//FLookupDataLink.DataSet.FieldByName(FFieldList[FLookupDisplayIndex]).DisplayText;
else
AText:='';
Bmp.Canvas.TextRect(ImageRect, X, Max(0, (HeightOf(R) - Canvas.TextHeight(AText)) div 2), AText);
end;
{ if Image <> nil then
begin
ImageRect.Right := ImageRect.Left + TextMargin + 2;
DrawPicture(Bmp.Canvas, ImageRect, Image);
end;}
Canvas.Draw(R.Left, R.Top, Bmp);
finally
Bmp.Free;
end;
end; end;
end; end;
@ -1210,7 +1192,6 @@ end;
procedure TRxCustomDBLookupCombo.ListLinkActiveChanged; procedure TRxCustomDBLookupCombo.ListLinkActiveChanged;
var var
DataSet: TDataSet; DataSet: TDataSet;
ResultField: TField;
begin begin
FListActive := False; FListActive := False;
FKeyField := nil; FKeyField := nil;
@ -1333,10 +1314,4 @@ begin
FDataControl.LookupDataSetChanged; FDataControl.LookupDataSetChanged;
end; end;
initialization
LazarusResources.Add('rxbtn_downarrow','XPM',[
'/* XPM */'#13#10'static char * btn_downarrow_xpm[] = {'#13#10'"5 3 2 1",'#13
+#10'" '#9'c None",'#13#10'".'#9'c #000000",'#13#10'".....",'#13#10'" ... ",'
+#13#10'" . "};'#13#10
]);
end. end.

26
components/rx/rxnew.lpk
View File

@ -1,6 +1,6 @@
<?xml version="1.0"?> <?xml version="1.0"?>
<CONFIG> <CONFIG>
<Package Version="2"> <Package Version="3">
<PathDelim Value="\"/> <PathDelim Value="\"/>
<Name Value="rxnew"/> <Name Value="rxnew"/>
<Author Value="Lagunov Aleksey"/> <Author Value="Lagunov Aleksey"/>
@ -8,7 +8,7 @@
<Version Value="5"/> <Version Value="5"/>
<PathDelim Value="\"/> <PathDelim Value="\"/>
<SearchPaths> <SearchPaths>
<UnitOutputDirectory Value="lib"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths> </SearchPaths>
<CodeGeneration> <CodeGeneration>
<Generate Value="Faster"/> <Generate Value="Faster"/>
@ -24,7 +24,7 @@ translate to Lazarus by alexs in 2005 - 2007
<License Value="free ware <License Value="free ware
"/> "/>
<Version Major="1" Minor="1" Release="5" Build="98"/> <Version Major="1" Minor="1" Release="5" Build="98"/>
<Files Count="38"> <Files Count="43">
<Item1> <Item1>
<Filename Value="rxlookup.pas"/> <Filename Value="rxlookup.pas"/>
<UnitName Value="rxlookup"/> <UnitName Value="rxlookup"/>
@ -178,6 +178,26 @@ translate to Lazarus by alexs in 2005 - 2007
<Filename Value="autopanel.pas"/> <Filename Value="autopanel.pas"/>
<UnitName Value="AutoPanel"/> <UnitName Value="AutoPanel"/>
</Item38> </Item38>
<Item39>
<Filename Value="pickdate.pas"/>
<UnitName Value="pickdate"/>
</Item39>
<Item40>
<Filename Value="pickdate.lrs"/>
<Type Value="LRS"/>
</Item40>
<Item41>
<Filename Value="rxstrconsts.inc"/>
<Type Value="Include"/>
</Item41>
<Item42>
<Filename Value="rxiconv.pas"/>
<UnitName Value="rxiconv"/>
</Item42>
<Item43>
<Filename Value="rxdbgrid.lrs"/>
<Type Value="LRS"/>
</Item43>
</Files> </Files>
<Type Value="RunAndDesignTime"/> <Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="4"> <RequiredPkgs Count="4">

3
components/rx/rxnew.pas
View File

@ -12,7 +12,8 @@ uses
duallist, boxprocs, tooledit, rxswitch, rxdice, rxdbcomb, rxtoolbar, duallist, boxprocs, tooledit, rxswitch, rxdice, rxdbcomb, rxtoolbar,
rxtbrsetup, fduallst, rxxpman, pagemngr, rxappicon, seldsfrm, rxctrls, rxtbrsetup, fduallst, rxxpman, pagemngr, rxappicon, seldsfrm, rxctrls,
rxlogin, rxdbgrid_findunit, rxdbgrid_columsunit, rxpopupunit, rxlogin, rxdbgrid_findunit, rxdbgrid_columsunit, rxpopupunit,
rxcustomchartpanel, rxsortmemds, AutoPanel, LazarusPackageIntf; rxcustomchartpanel, rxsortmemds, AutoPanel, pickdate, rxiconv,
LazarusPackageIntf;
implementation implementation

5
components/rx/rxpopupunit.pas
View File

@ -1,6 +1,6 @@
unit rxpopupunit; unit rxpopupunit;
{$mode objfpc}{$H+} {$I rx.inc}
interface interface
@ -596,6 +596,9 @@ constructor TPopUpColumnTitle.Create;
begin begin
inherited Create; inherited Create;
FColor:=clBtnFace; FColor:=clBtnFace;
{$IFDEF NEW_STYLE_TITLE_ALIGNMENT_RXDBGRID}
Alignment:=taCenter;
{$ENDIF}
end; end;
procedure TPopUpColumnTitle.Assign(Source: TPersistent); procedure TPopUpColumnTitle.Assign(Source: TPersistent);

28
components/rx/rxstrconsts.inc Normal file
View File

@ -0,0 +1,28 @@
{
/****************************************************************************
rxcconst.res
Delphi VCL Extensions (RX)
Copyright (c) 1995 AO ROSNO
Copyright (c) 1997 Master-Bank
*****************************************************************************/
}
sBrowse = 'Browse';
sDefaultFilter = 'All files (*.*)|*.*';
sDateDlgTitle = 'Select a Date';
sNextYear = 'Next Year|';
sNextMonth = 'Next Month|';
sPrevYear = 'Previous Year|';
sPrevMonth = 'Previous Month|';
sNotImplemented = 'Function not yet implemented';
sFileNotExec = 'File specified is not an executable file, dynamic-link library, or icon file';
sLoadLibError = 'Could not load ''%s'' library';
sDetails = 'Details';
sWindowsIcoFiles = 'Windows Ico files (*.ico)|*.ico|All files (*.*)|*.*';
sLoadIcon = 'Load icon';
sToCurDate = 'Set current date';

564
components/rx/tooledit.pas
View File

@ -5,8 +5,161 @@ unit tooledit;
interface interface
uses uses
Classes, SysUtils, LCLType, LMessages, Graphics, MaskEdit, Controls; Classes, SysUtils, LCLType, LMessages, Graphics, MaskEdit, Controls, EditBtn,
pickdate, dateutil;
type
{ TCustomDateEdit }
TYearDigits = (dyDefault, dyFour, dyTwo);
TPopupAlign = (epaRight, epaLeft);
TCalendarStyle = (csPopup, csDialog);
const
{$IFDEF DEFAULT_POPUP_CALENDAR}
dcsDefault = csPopup;
{$ELSE}
dcsDefault = csDialog;
{$ENDIF DEFAULT_POPUP_CALENDAR}
type
{ TCustomRxDateEdit }
TCustomRxDateEdit = class(TCustomEditButton)
private
FCalendarHints: TStrings;
FBlanksChar: Char;
FCancelCaption: TCaption;
FDefaultToday: Boolean;
FDialogTitle: TCaption;
FPopupColor: TColor;
FOKCaption: TCaption;
FOnAcceptDAte: TAcceptDateEvent;
FStartOfWeek: TDayOfWeekName;
FWeekendColor: TColor;
FWeekends: TDaysOfWeek;
FYearDigits: TYearDigits;
FDateFormat: string[10];
FFormatting: Boolean;
FPopupVisible: Boolean;
FPopupAlign: TPopupAlign;
function GetCalendarStyle: TCalendarStyle;
function GetDate: TDateTime;
function GetPopupColor: TColor;
function GetPopupVisible: Boolean;
function IsStoreTitle: boolean;
procedure SetBlanksChar(const AValue: Char);
procedure SetCalendarStyle(const AValue: TCalendarStyle);
procedure SetDate(const AValue: TDateTime);
procedure SetPopupColor(const AValue: TColor);
procedure SetStartOfWeek(const AValue: TDayOfWeekName);
procedure SetWeekendColor(const AValue: TColor);
procedure SetWeekends(const AValue: TDaysOfWeek);
procedure SetYearDigits(const AValue: TYearDigits);
procedure CalendarHintsChanged(Sender: TObject);
protected
FPopup: TPopupCalendar;
procedure UpdateFormat;
procedure UpdatePopup;
function TextStored: Boolean;
procedure PopupDropDown(DisableEdit: Boolean); virtual;
procedure PopupCloseUp(Sender: TObject; Accept: Boolean);
procedure HidePopup; virtual;
procedure ShowPopup(AOrigin: TPoint); virtual;
procedure ApplyDate(Value: TDateTime); virtual;
procedure Change; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure DoButtonClick (Sender: TObject); override;
property BlanksChar: Char read FBlanksChar write SetBlanksChar default ' ';
property DialogTitle:TCaption Read FDialogTitle Write FDialogTitle Stored IsStoreTitle;
Property OnAcceptDate : TAcceptDateEvent Read FOnAcceptDAte Write FOnAcceptDate;
property OKCaption:TCaption Read FOKCaption Write FOKCaption;
property CancelCaption:TCaption Read FCancelCaption Write FCancelCaption;
property DefaultToday: Boolean read FDefaultToday write FDefaultToday
default False;
property StartOfWeek: TDayOfWeekName read FStartOfWeek write SetStartOfWeek default Mon;
property Weekends: TDaysOfWeek read FWeekends write SetWeekends default [Sun];
property WeekendColor: TColor read FWeekendColor write SetWeekendColor default clRed;
property YearDigits: TYearDigits read FYearDigits write SetYearDigits default dyDefault;
property PopupColor: TColor read GetPopupColor write SetPopupColor
default clBtnFace;
property CalendarStyle: TCalendarStyle read GetCalendarStyle
write SetCalendarStyle default dcsDefault;
property PopupVisible: Boolean read GetPopupVisible;
property PopupAlign: TPopupAlign read FPopupAlign write FPopupAlign default epaRight;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure CheckValidDate;
function GetDateMask: string;
procedure UpdateMask; virtual;
property Date: TDateTime read GetDate write SetDate;
property Formatting: Boolean read FFormatting;
end;
type
TRxDateEdit = class(TCustomRxDateEdit)
public
property PopupVisible;
published
property BlanksChar;
property StartOfWeek;
property DialogTitle;
Property OnAcceptDate;
property OKCaption;
property CancelCaption;
property DefaultToday;
property ReadOnly;
property ButtonOnlyWhenFocused;
property ButtonWidth;
property Action;
property Align;
property Anchors;
property AutoSize;
property AutoSelect;
property BorderSpacing;
property Color;
property Constraints;
property CharCase;
property Glyph;
property NumGlyphs;
property DragMode;
property EchoMode;
property Enabled;
property Font;
property MaxLength;
property OnChange;
property OnChangeBounds;
property OnClick;
property OnEditingDone;
property OnEnter;
property OnExit;
Property OnKeyDown;
property OnKeyPress;
Property OnKeyUp;
Property OnMouseDown;
Property OnMouseMove;
property OnMouseUp;
property OnResize;
property ParentFont;
property ParentShowHint;
property PasswordChar;
property PopupMenu;
property ShowHint;
property TabStop;
property TabOrder;
property Visible;
property YearDigits;
property Weekends;
property WeekendColor;
property PopupColor;
property PopupAlign;
property CalendarStyle;
end;
function PaintComboEdit(Editor: TCustomMaskEdit; const AText: string; function PaintComboEdit(Editor: TCustomMaskEdit; const AText: string;
AAlignment: TAlignment; StandardPaint: Boolean; AAlignment: TAlignment; StandardPaint: Boolean;
@ -14,7 +167,7 @@ function PaintComboEdit(Editor: TCustomMaskEdit; const AText: string;
function EditorTextMargins(Editor: TCustomMaskEdit): TPoint; function EditorTextMargins(Editor: TCustomMaskEdit): TPoint;
implementation implementation
uses lclintf; uses lclintf, LCLStrConsts, rxconst, rxstrutils, LResources, Forms;
function EditorTextMargins(Editor: TCustomMaskEdit): TPoint; function EditorTextMargins(Editor: TCustomMaskEdit): TPoint;
var var
@ -162,5 +315,412 @@ begin
end; end;
end; end;
{ TCustomRxDateEdit }
function TCustomRxDateEdit.IsStoreTitle: boolean;
begin
Result:=DialogTitle<>rsPickDate;
end;
procedure TCustomRxDateEdit.SetBlanksChar(const AValue: Char);
begin
if FBlanksChar=AValue then exit;
if (AValue < ' ') then
FBlanksChar:=' '
else
FBlanksChar:=AValue;
UpdateMask;
end;
function TCustomRxDateEdit.GetCalendarStyle: TCalendarStyle;
begin
if FPopup <> nil then
Result := csPopup
else
Result := csDialog;
end;
function TCustomRxDateEdit.GetDate: TDateTime;
begin
if DefaultToday then Result := SysUtils.Date
else Result := NullDate;
Result := StrToDateFmtDef(FDateFormat, Text, Result);
end;
function TCustomRxDateEdit.GetPopupColor: TColor;
begin
if FPopup <> nil then Result := TPopupCalendar(FPopup).Color
else Result := FPopupColor;
end;
function TCustomRxDateEdit.GetPopupVisible: Boolean;
begin
Result := (FPopup <> nil) and FPopupVisible;
end;
procedure TCustomRxDateEdit.SetCalendarStyle(const AValue: TCalendarStyle);
begin
if AValue <> CalendarStyle then
begin
case AValue of
csPopup:
begin
if FPopup = nil then
FPopup := CreatePopupCalendar(Self{$IFDEF USED_BiDi}, BiDiMode {$ENDIF});
FPopup.OnCloseUp := @PopupCloseUp;
FPopup.Color := FPopupColor;
// UpdatePopup;
end;
csDialog:
begin
FPopup.Free;
FPopup := nil;
end;
end;
end;
end;
procedure TCustomRxDateEdit.SetDate(const AValue: TDateTime);
var
D: TDateTime;
begin
{ if not ValidDate(AValue) or (AValue = NullDate) then
begin
if DefaultToday then AValue := SysUtils.Date
else Value := NullDate;
end;}
D := Date;
if AValue = NullDate then
Text := ''
else
Text := FormatDateTime(FDateFormat, AValue);
Modified := D <> Date;
end;
procedure TCustomRxDateEdit.SetPopupColor(const AValue: TColor);
begin
if AValue <> PopupColor then
begin
if FPopup <> nil then FPopup.Color := AValue;
FPopupColor := AValue;
end;
end;
procedure TCustomRxDateEdit.SetStartOfWeek(const AValue: TDayOfWeekName);
begin
if FStartOfWeek=AValue then exit;
FStartOfWeek:=AValue;
end;
procedure TCustomRxDateEdit.SetWeekendColor(const AValue: TColor);
begin
if FWeekendColor=AValue then exit;
FWeekendColor:=AValue;
end;
procedure TCustomRxDateEdit.SetWeekends(const AValue: TDaysOfWeek);
begin
if FWeekends=AValue then exit;
FWeekends:=AValue;
end;
procedure TCustomRxDateEdit.SetYearDigits(const AValue: TYearDigits);
begin
if FYearDigits=AValue then exit;
FYearDigits:=AValue;
end;
procedure TCustomRxDateEdit.CalendarHintsChanged(Sender: TObject);
begin
TStringList(FCalendarHints).OnChange := nil;
try
while (FCalendarHints.Count > 4) do
FCalendarHints.Delete(FCalendarHints.Count - 1);
finally
TStringList(FCalendarHints).OnChange := @CalendarHintsChanged;
end;
if not (csDesigning in ComponentState) then UpdatePopup;
end;
procedure TCustomRxDateEdit.UpdateFormat;
begin
FDateFormat := DefDateFormat(FourDigitYear);
end;
procedure TCustomRxDateEdit.UpdatePopup;
begin
if FPopup <> nil then SetupPopupCalendar(FPopup, FStartOfWeek,
FWeekends, FWeekendColor, FCalendarHints, FourDigitYear);
end;
function TCustomRxDateEdit.TextStored: Boolean;
begin
Result := not IsEmptyStr(Text, [#0, ' ', DateSeparator, FBlanksChar]);
end;
procedure TCustomRxDateEdit.PopupDropDown(DisableEdit: Boolean);
var
P: TPoint;
Y: Integer;
begin
if (FPopup <> nil) and not (ReadOnly or FPopupVisible) then begin
P := Parent.ClientToScreen(Point(Left, Top));
Y := P.Y + Height;
if Y + FPopup.Height > Screen.Height then
Y := P.Y - FPopup.Height;
case FPopupAlign of
epaRight:
begin
Dec(P.X, FPopup.Width - Width);
if P.X < 0 then Inc(P.X, FPopup.Width - Width);
end;
epaLeft:
begin
if P.X + FPopup.Width > Screen.Width then
Dec(P.X, FPopup.Width - Width);
end;
end;
if P.X < 0 then P.X := 0
else if P.X + FPopup.Width > Screen.Width then
P.X := Screen.Width - FPopup.Width;
{ if Text <> '' then
SetPopupValue(Text)
else
SetPopupValue(Null);}
if CanFocus then SetFocus;
ShowPopup(Point(P.X, Y));
FPopupVisible := True;
if DisableEdit then begin
inherited ReadOnly := True;
HideCaret(Handle);
end;
end;
end;
procedure TCustomRxDateEdit.PopupCloseUp(Sender: TObject; Accept: Boolean);
var
AValue: Variant;
begin
if (FPopup <> nil) and FPopupVisible then
begin
{ if GetCapture <> 0 then
SendMessage(GetCapture, WM_CANCELMODE, 0, 0);}
// AValue := GetPopupValue;
HidePopup;
try
try
if CanFocus then
begin
SetFocus;
// if GetFocus = Handle then SetShowCaret;
end;
except
{ ignore exceptions }
end;
// SetDirectInput(DirectInput);
Invalidate;
{ if Accept and AcceptPopup(AValue) and EditCanModify then
begin
AcceptValue(AValue);
if FFocused then inherited SelectAll;
end;}
finally
FPopupVisible := False;
end;
end;
end;
procedure TCustomRxDateEdit.HidePopup;
begin
FPopup.Hide;
end;
procedure TCustomRxDateEdit.ShowPopup(AOrigin: TPoint);
begin
FPopup.Show;
{ FPopup.Show(AOrigin);
SetWindowPos(Handle, HWND_TOP, Origin.X, Origin.Y, 0, 0,
SWP_NOACTIVATE or SWP_SHOWWINDOW or SWP_NOSIZE);
Visible := True;}
end;
procedure TCustomRxDateEdit.ApplyDate(Value: TDateTime);
begin
SetDate(Value);
SelectAll;
end;
procedure TCustomRxDateEdit.Change;
begin
if not FFormatting then inherited Change;
end;
procedure TCustomRxDateEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
if (Key in [VK_PRIOR, VK_NEXT, VK_LEFT, VK_UP, VK_RIGHT, VK_DOWN,
VK_ADD, VK_SUBTRACT]) and
PopupVisible then
begin
FPopup.KeyDown(Key, Shift);
Key := 0;
end
else
if (Shift = []) and DirectInput then
begin
case Key of
VK_ADD:
begin
ApplyDate(NvlDate(Date, Now) + 1);
Key := 0;
end;
VK_SUBTRACT:
begin
ApplyDate(NvlDate(Date, Now) - 1);
Key := 0;
end;
end;
end;
inherited KeyDown(Key, Shift);
end;
procedure TCustomRxDateEdit.KeyPress(var Key: Char);
begin
if (Key in ['T', 't', '+', '-']) and PopupVisible then
begin
// FPopup.KeyPress(Key);
Key := #0;
end
else
if DirectInput then
begin
case Key of
'T', 't':
begin
ApplyDate(Trunc(Now));
Key := #0;
end;
'+', '-':
begin
Key := #0;
end;
end;
end;
inherited KeyPress(Key);
end;
procedure TCustomRxDateEdit.DoButtonClick(Sender: TObject);
var
D: TDateTime;
A: Boolean;
begin
inherited DoButtonClick(Sender);
if FPopup <> nil then
begin
if FPopupVisible then
PopupCloseUp(FPopup, True)
else
PopupDropDown(True);
end
else
if CalendarStyle = csDialog then
begin
D := Self.Date;
A := SelectDate(D, DialogTitle, FStartOfWeek, FWeekends,
FWeekendColor, FCalendarHints);
if CanFocus then SetFocus;
if A then
begin
if Assigned(FOnAcceptDate) then FOnAcceptDate(Self, D, A);
if A then
begin
Self.Date := D;
// if FFocused then
inherited SelectAll;
end;
end;
end;
end;
constructor TCustomRxDateEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FBlanksChar := ' ';
FDialogTitle := sDateDlgTitle;
FPopupColor := clBtnFace;
FStartOfWeek := Mon;
FWeekends := [Sun];
FWeekendColor := clRed;
FYearDigits := dyDefault;
FCalendarHints := TStringList.Create;
TStringList(FCalendarHints).OnChange := @CalendarHintsChanged;
ControlState := ControlState + [csCreating];
try
UpdateFormat;
{$IFDEF DEFAULT_POPUP_CALENDAR}
FPopup := CreatePopupCalendar(Self {$IFDEF USED_BiDi}, BiDiMode {$ENDIF});
FPopup.OnCloseUp := @PopupCloseUp;
FPopup.Color := FPopupColor;
{$ENDIF DEFAULT_POPUP_CALENDAR}
// GlyphKind := gkDefault; { force update }
finally
ControlState := ControlState - [csCreating];
end;
Glyph:=LoadBitmapFromLazarusResource('picDateEdit');
NumGlyphs := 2;
end;
destructor TCustomRxDateEdit.Destroy;
begin
if Assigned(FPopup) then
begin
FPopup.OnCloseUp := nil;
FreeAndNil(FPopup);
end;
TStringList(FCalendarHints).OnChange := nil;
FreeAndNil(FCalendarHints);
inherited Destroy;
end;
procedure TCustomRxDateEdit.CheckValidDate;
begin
if TextStored then
try
FFormatting := True;
try
SetDate(StrToDateFmt(FDateFormat, Text));
finally
FFormatting := False;
end;
except
if CanFocus then SetFocus;
raise;
end;
end;
function TCustomRxDateEdit.GetDateMask: string;
begin
Result := DefDateMask(FBlanksChar, FourDigitYear);
end;
procedure TCustomRxDateEdit.UpdateMask;
var
DateValue: TDateTime;
OldFormat: string[10];
begin
DateValue := GetDate;
OldFormat := FDateFormat;
UpdateFormat;
{ if (GetDateMask <> EditMask) or (OldFormat <> FDateFormat) then
begin
{ force update }
EditMask := '';
EditMask := GetDateMask;
end;}
UpdatePopup;
SetDate(DateValue);
end;
initialization
{$I tooledit.lrs}
end. end.

9
components/rx/vclutils.pas
View File

@ -6,9 +6,9 @@ interface
uses uses
{$IFDEF WIN32} {$IFDEF WIN32}
Windows, windows,
{$ENDIF} {$ENDIF}
Classes, SysUtils, Graphics, Controls, Forms Classes, SysUtils, Graphics, Controls, Forms, LResources
; ;
type type
@ -516,6 +516,11 @@ begin
Result.LoadFromLazarusResource('rxbtn_downarrow'); Result.LoadFromLazarusResource('rxbtn_downarrow');
end; end;
initialization
LazarusResources.Add('rxbtn_downarrow','XPM',[
'/* XPM */'#13#10'static char * btn_downarrow_xpm[] = {'#13#10'"5 3 2 1",'#13
+#10'" '#9'c None",'#13#10'".'#9'c #000000",'#13#10'".....",'#13#10'" ... ",'
+#13#10'" . "};'#13#10]);
end. end.