pascal
1unit TL.Components;
2
3interface
4
5uses
6 System.Classes, System.SysUtils, System.Variants, System.UITypes, Vcl.DBGrids, Vcl.Forms, Vcl.Graphics, Vcl.GraphUtil,
7 Vcl.Grids, Vcl.Themes, Win.Registry, Data.DB, Winapi.ShlObj, Winapi.ActiveX, Winapi.Windows, Winapi.KnownFolders,
8 FinAdmColors, FlatDesignColorsFull; // MaterialColorsFull,
9
10const
11 DesignPPI = 240;
12
13type
14 TLFolder = class(TObject)
15 protected
16 function GetKnownFolderPath(const folderID: TGUID): string;
17 function GetDocuments: string;
18 function GetDesktop: string;
19 function GetProgramData: string;
20 function GetLocalAppData: string;
21 function GetPictures: string;
22 function GetMusic: string;
23 function GetVideos: string;
24 function GetDownLoads: string;
25 function GetVersion: string;
26 public
27 property Documents: string read GetDocuments;
28 property Desktop: string read GetDesktop;
29 property ProgramData: string read GetProgramData;
30 property LocalAppData: string read GetLocalAppData;
31 property Pictures: string read GetPictures;
32 property Music: string read GetMusic;
33 property Videos: string read GetVideos;
34 property DownLoads: string read GetDownLoads;
35 property AppVersion: string read GetVersion;
36 end;
37
38var
39 Folder: TLFolder;
40
41type
42 TLDBGrid = class(TCustomDBGrid)
43 private
44 { Private declarations }
45 FTotalRow: boolean;
46 FSubTotalRow: boolean;
47 protected
48 { Protected declarations }
49 procedure DrawColumnCell(
50 const Rect: TRect;
51 DataCol: Integer;
52 Column: TColumn;
53 State: TGridDrawState); override;
54 procedure KeyDown(
55 var Key: Word;
56 Shift: TShiftState); override;
57 procedure ColEnter; override;
58 procedure ColExit; override;
59 procedure CellClick(Column: TColumn); override;
60 public
61 { Public declarations }
62 constructor Create(AOwner: TComponent); override;
63 procedure SetColumnAttr;
64 procedure SetStyle(
65 DataCol: Integer;
66 Grid: TLDBGrid;
67 Column: TColumn;
68 State: TGridDrawState;
69 SoortID: Integer;
70 ID: Integer);
71 property TotalRow: boolean read FTotalRow write FTotalRow default False;
72 property SubTotalRow: boolean read FSubTotalRow write FSubTotalRow default False;
73 property Canvas;
74 property SelectedRows;
75 // property DefaultRowHeight;
76 published
77 { Published declarations }
78 property Align;
79 property Anchors;
80 property BiDiMode;
81 property BorderStyle;
82 property Color;
83 [stored(False)]
84 property Columns stored False; // StoreColumns;
85 property Constraints;
86 property Ctl3D;
87 property DataSource;
88 property DefaultDrawing;
89 property DragCursor;
90 property DragKind;
91 property DragMode;
92 property DrawingStyle;
93 property Enabled;
94 property FixedColor;
95 property FixedCols;
96 property GradientEndColor default clSilver_400;
97 property GradientStartColor default clSilver_50;
98 property Font;
99 property ImeMode;
100 property ImeName;
101 property Options;
102 property ParentBiDiMode;
103 property ParentColor;
104 property ParentCtl3D;
105 property ParentFont;
106 property ParentShowHint;
107 property PopupMenu;
108 property readonly;
109 property ShowHint;
110 property TabOrder;
111 property TabStop;
112 property TitleFont;
113 property Touch;
114 property Visible;
115 property StyleElements;
116 property StyleName;
117 property ScrollBars;
118 property OnCellClick;
119 property OnColEnter;
120 property OnColExit;
121 property OnColumnMoved;
122 property OnDrawColumnCell;
123 property OnDblClick;
124 property OnDragDrop;
125 property OnDragOver;
126 property OnEditButtonClick;
127 property OnEndDock;
128 property OnEndDrag;
129 property OnEnter;
130 property OnExit;
131 property OnGesture;
132 property OnKeyDown;
133 property OnKeyPress;
134 property OnKeyUp;
135 property OnMouseActivate;
136 property OnMouseDown;
137 property OnMouseEnter;
138 property OnMouseLeave;
139 property OnMouseMove;
140 property OnMouseUp;
141 property OnMouseWheel;
142 property OnMouseWheelDown;
143 property OnMouseWheelUp;
144 property OnStartDock;
145 property OnStartDrag;
146 property OnTitleClick;
147 end;
148
149type
150 TLForm = class(TForm)
151 FRegVars: TStringList;
152 procedure SaveConfig;
153 procedure LoadConfig;
154 protected
155 procedure DoCreate; override;
156 procedure DoDestroy; override;
157 private
158
159 public
160 property RegVars: TStringList read FRegVars write FRegVars;
161 end;
162
163procedure Register;
164
165implementation
166
167{ TLFolders }
168
169procedure TLDBGrid.SetStyle(
170 DataCol: Integer;
171 Grid: TLDBGrid;
172 Column: TColumn;
173 State: TGridDrawState;
174 SoortID: Integer;
175 ID: Integer);
176// ID bevat het categorie of subcategorienummer
177// bij totalen of subtotalen bevat ID -1
178begin
179 // Style for descriptive column
180 Grid.Canvas.Font.Style:= []; // Start met normale fontstyle
181
182 if ID = -2 then
183
184 begin // default style actual values
185 if not(gdSelected in State) then
186 begin
187 Grid.Canvas.Brush.Color:= FinAdmColors.clEmpty;
188 Grid.Canvas.Font.Color:= FinAdmColors.clEmptyText;
189 end // if not(gdSelected in State)
190 else // if (gdSelected in State)
191 begin
192 Grid.Canvas.Brush.Color:= FinAdmColors.clSelected;
193 Grid.Canvas.Font.Color:= clBlack;
194 end; // if (gdSelected in State)
195 exit;
196 end; // if ID = -2
197
198 if ID = -1 then // Totalen en Subtotalen rijen
199 case SoortID of
200 0: // Totalen en Subtotalen
201 begin
202 Grid.Canvas.Brush.Color:= FinAdmColors.clFooter;
203 Grid.Canvas.Font.Color:= clWhite;
204 Grid.Canvas.Font.Style:= [fsBold];
205 end;
206 1: // Inkomsten
207 begin
208 Grid.Canvas.Brush.Color:= FinAdmColors.clIncomeTotal;
209 Grid.Canvas.Font.Color:= clWhite;
210 Grid.Canvas.Font.Style:= [fsBold];
211 end;
212 2: // Vaste kosten
213 begin
214 Grid.Canvas.Brush.Color:= FinAdmColors.clFixedCostsTotal;
215 Grid.Canvas.Font.Color:= clWhite;
216 Grid.Canvas.Font.Style:= [fsBold];
217 end;
218 3: // Variabele kosten
219 begin
220 Grid.Canvas.Brush.Color:= FinAdmColors.clVariableCostsTotal;
221 Grid.Canvas.Font.Color:= clWhite;
222 Grid.Canvas.Font.Style:= [fsBold];
223 end;
224 4: // Aftrekbare kosten voor IB
225 begin
226 Grid.Canvas.Brush.Color:= FinAdmColors.clBelastingdienst;
227 Grid.Canvas.Font.Color:= FinAdmColors.clBelastingdienstText;
228 Grid.Canvas.Font.Style:= [fsBold];
229 end;
230 end // if ID = -1
231
232 else // alle overige rijen
233 begin
234
235 if DataCol = 0 then // 1e kolom met omschrijvingen
236 begin
237 if not(gdSelected in State) then
238 case SoortID of
239 1:
240 Grid.Canvas.Brush.Color:= FinAdmColors.clIncome;
241 2:
242 Grid.Canvas.Brush.Color:= FinAdmColors.clFixedCosts;
243 3:
244 Grid.Canvas.Brush.Color:= FinAdmColors.clVariableCosts;
245 end // case SoortID
246 else // if (gdSelected in State)
247 case SoortID of
248 0:
249 begin
250 Grid.Canvas.Brush.Color:= FinAdmColors.clFooter;
251 Grid.Canvas.Font.Color:= clWhite;
252 Grid.Canvas.Font.Style:= [fsBold];
253 end;
254 1:
255 begin
256 Grid.Canvas.Brush.Color:= FinAdmColors.clIncomeTotal;
257 Grid.Canvas.Font.Color:= clWhite;
258 Grid.Canvas.Font.Style:= [fsBold];
259 end;
260 2:
261 begin
262 Grid.Canvas.Brush.Color:= FinAdmColors.clFixedCostsTotal;
263 Grid.Canvas.Font.Color:= clWhite;
264 Grid.Canvas.Font.Style:= [fsBold];
265 end;
266 3:
267 begin
268 Grid.Canvas.Brush.Color:= FinAdmColors.clVariableCostsTotal;
269 Grid.Canvas.Font.Color:= clWhite;
270 Grid.Canvas.Font.Style:= [fsBold];
271 end;
272 end; // case SoortID
273 end // if DataCol = 0
274
275 else // if DataCol <> 0 alle overige kolommen met bedragen
276
277 begin // default style actual values
278 if not(gdSelected in State) then
279 begin
280 Grid.Canvas.Brush.Color:= FinAdmColors.clEmpty;
281 Grid.Canvas.Font.Color:= FinAdmColors.clEmptyText;
282 end // if not(gdSelected in State)
283 else // if (gdSelected in State)
284 begin
285 Grid.Canvas.Brush.Color:= FinAdmColors.clSelected;
286 Grid.Canvas.Font.Color:= clBlack;
287 end; // if (gdSelected in State)
288 end; // if DataCol <> 0
289 end; // alle overige rijen
290end;
291
292function TLFolder.GetKnownFolderPath(const folderID: TGUID): string;
293var
294 pch: PChar;
295begin
296 if Succeeded(SHGetKnownFolderPath(folderID, 0, 0, pch)) then
297 begin
298 Result:= pch;
299 CoTaskMemFree(pch);
300 end
301 else
302 Result:= 'Error retrieving folder path';
303end;
304
305function TLFolder.GetDocuments: string;
306begin
307 Result:= GetKnownFolderPath(FOLDERID_Documents);
308end;
309
310function TLFolder.GetDesktop: string;
311begin
312 Result:= GetKnownFolderPath(FOLDERID_Desktop);
313end;
314
315function TLFolder.GetProgramData: string;
316begin
317 Result:= GetKnownFolderPath(FOLDERID_ProgramData);
318end;
319
320function TLFolder.GetLocalAppData: string;
321begin
322 Result:= GetKnownFolderPath(FOLDERID_LocalAppData);
323end;
324
325function TLFolder.GetPictures: string;
326begin
327 Result:= GetKnownFolderPath(FOLDERID_Pictures);
328end;
329
330function TLFolder.GetMusic: string;
331begin
332 Result:= GetKnownFolderPath(FOLDERID_Music);
333end;
334
335function TLFolder.GetVideos: string;
336begin
337 Result:= GetKnownFolderPath(FOLDERID_Videos);
338end;
339
340function TLFolder.GetDownLoads: string;
341begin
342 Result:= GetKnownFolderPath(FOLDERID_Downloads);
343end;
344
345function TLFolder.GetVersion: string;
346var
347 VerInfoSize: Cardinal;
348 VerValueSize: Cardinal;
349 Dummy: Cardinal;
350 PVerInfo: Pointer;
351 PVerValue: PVSFixedFileInfo;
352begin
353 Result:= ''; // Initialize the result
354
355 // Get the size of the version information
356 VerInfoSize:= GetFileVersionInfoSize(
357 PChar(Application.ExeName),
358 Dummy);
359 if VerInfoSize > 0 then
360 begin
361 // Allocate memory for the version information
362 GetMem(
363 PVerInfo,
364 VerInfoSize);
365 try
366 // Retrieve the version information
367 if GetFileVersionInfo(PChar(Application.ExeName), 0, VerInfoSize, PVerInfo) then
368 begin
369 // Get the fixed file info
370 if VerQueryValue(PVerInfo, '\', Pointer(PVerValue), VerValueSize) then
371 begin
372 Result:= Format(
373 '%s.%s.%s.%s',
374 [IntToStr(DWORD(PVerValue.dwFileVersionMS) div $10000),
375 IntToStr(DWORD(PVerValue.dwFileVersionMS) mod $10000),
376 IntToStr(DWORD(PVerValue.dwFileVersionLS) div $10000),
377 IntToStr(DWORD(PVerValue.dwFileVersionLS) mod $10000)]);
378 end;
379 end;
380 finally
381 FreeMem(PVerInfo);
382 end;
383 end;
384end;
385
386{ TLDBGrid }
387
388constructor TLDBGrid.Create(AOwner: TComponent);
389begin
390 inherited;
391 Options:= [dgTitles, dgColLines, dgRowLines, dgRowSelect, dgAlwaysShowSelection];
392end;
393
394procedure TLDBGrid.CellClick(Column: TColumn);
395begin
396 if (Column.Field.DataType = ftSmallInt) then
397 begin
398 DataSource.DataSet.Edit;
399 case Column.Field.Value of
400 0:
401 Column.Field.Value:= 1;
402 1:
403 Column.Field.Value:= 0;
404 end;
405 // DataSource.DataSet.Post;
406 // Refresh;
407 end;
408 inherited;
409end;
410
411procedure TLDBGrid.ColEnter;
412begin
413 inherited;
414 if SelectedField.DataType = ftSmallInt then
415 Options:= Options - [dgEditing]
416 else
417 Options:= Options + [dgEditing]
418end;
419
420procedure TLDBGrid.ColExit;
421begin
422 inherited;
423end;
424
425procedure TLDBGrid.KeyDown(
426 var Key: Word;
427 Shift: TShiftState);
428begin
429 inherited;
430 if Assigned(DataSource) and (SelectedField.DataType = ftSmallInt) and (Key = VK_SPACE) then
431 begin
432 DataSource.DataSet.Edit;
433 case SelectedField.Value of
434 0:
435 SelectedField.AsInteger:= 1;
436 1:
437 SelectedField.AsInteger:= 0;
438 end;
439 // DataSource.DataSet.Post;
440 end;
441end;
442
443procedure TLDBGrid.SetColumnAttr;
444(* TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord, // 0..4
445 ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime, // 5..11
446 ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo, // 12..18
447 ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString, // 19..24
448 ftLargeint, ftADT, ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob, // 25..31
449 ftVariant, ftInterface, ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd, // 32..37
450 ftFixedWideChar, ftWideMemo, ftOraTimeStamp, ftOraInterval, // 38..41
451 ftLongWord, ftShortint, ftByte, ftExtended, ftConnection, ftParams, ftStream, //42..48
452 ftTimeStampOffset, ftObject, ftSingle); //49..51 *)
453const
454 MaxColumnWidth = 450;
455var
456 ColumnWidth, FieldNameWidth, FieldSizeWidth: Integer;
457 FieldName: string;
458 FieldSize: Integer;
459begin
460 if Assigned(DataSource) then
461 begin
462 for var i:= 0 to Columns.Count - 1 do
463 begin
464 Columns[i].Title.Font.Style:= [fsBold];
465 Columns[i].Title.Alignment:= taCenter;
466
467 FieldName:= DataSource.DataSet.FieldByName(Columns[i].FieldName).FieldName;
468 FieldNameWidth:= Canvas.TextWidth(FieldName);
469 FieldSize:= DataSource.DataSet.FieldByName(Columns[i].FieldName).Size;
470 FieldSizeWidth:= FieldSize * Canvas.TextWidth('9');
471
472 if FieldNameWidth > FieldSizeWidth then
473 ColumnWidth:= FieldNameWidth
474 else
475 ColumnWidth:= FieldSizeWidth;
476 if ColumnWidth > MaxColumnWidth then
477 ColumnWidth:= MaxColumnWidth;
478
479 case Columns[i].Field.DataType of
480 ftFMTBcd, ftCurrency, ftBCD:
481 begin
482 TFloatField(DataSource.DataSet.FieldByName(Columns[i].FieldName)).DisplayFormat:=
483 '#,###,##0.00;-#,###,##0.00;-';
484 Columns[i].Width:= MulDiv(
485 200,
486 PixelsPerInch,
487 DesignPPI);
488 end;
489 ftDate, ftTime:
490 begin
491 Columns[i].Alignment:= taRightJustify;
492 Columns[i].Width:= MulDiv(
493 200,
494 PixelsPerInch,
495 DesignPPI);
496 end;
497 ftDateTime, ftTimeStamp:
498 begin
499 Columns[i].Alignment:= taRightJustify;
500 Columns[i].Width:= MulDiv(
501 300,
502 PixelsPerInch,
503 DesignPPI);
504 end;
505 ftInteger, ftWord:
506 begin
507 TIntegerField(DataSource.DataSet.FieldByName(Columns[i].FieldName)).DisplayFormat:= '####0';
508 if ColumnWidth < MulDiv(150, PixelsPerInch, DesignPPI) then
509 ColumnWidth:= MulDiv(
510 150,
511 PixelsPerInch,
512 DesignPPI);
513 Columns[i].Width:= ColumnWidth;
514 end;
515 ftAutoInc:
516 begin
517 TIntegerField(DataSource.DataSet.FieldByName(Columns[i].FieldName)).DisplayFormat:= '####0';
518 Columns[i].Width:= MulDiv(
519 150,
520 PixelsPerInch,
521 DesignPPI);
522 end
523 else
524 Columns[i].Width:= ColumnWidth;
525 end;
526 end;
527 end;
528end;
529
530procedure TLDBGrid.DrawColumnCell(
531 const Rect: TRect;
532 DataCol: Integer;
533 Column: TColumn;
534 State: TGridDrawState);
535const
536 CtrlState: array [boolean] of Integer = (DFCS_BUTTONCHECK, DFCS_BUTTONCHECK or DFCS_CHECKED);
537 CtrlStateXP: array [boolean] of TThemedButton = (tbCheckBoxUncheckedNormal, tbCheckBoxCheckedNormal);
538var
539 R: TRect;
540 Details: TThemedElementDetails;
541begin
542 if Assigned(OnDrawColumnCell) then
543 OnDrawColumnCell(
544 Self,
545 Rect,
546
547 DataCol,
548 Column,
549 State);
550
551 // Cell padding
552 R:= Rect;
553 InflateRect(
554 R,
555 MulDiv(-10, PixelsPerInch, DesignPPI),
556 0);
557
558 Canvas.FillRect(Rect);
559
560 case Column.Field.DataType of
561 ftSmallInt:
562 begin
563 R:= Rect;
564 InflateRect(
565 R,
566 MulDiv(-10, PixelsPerInch, DesignPPI),
567 MulDiv(-5, PixelsPerInch, DesignPPI));
568
569 if (VarIsNull(Column.Field.Value)) then
570 Column.Field.AsInteger:= 0;
571
572 if StyleServices.Enabled then
573 begin
574 case Column.Field.AsInteger of
575 0:
576 begin
577 if Column.Field.FieldName = 'IB Aftrekbaar' then
578 begin
579 if (gdSelected in State) then
580 Canvas.Brush.Color:= clPeter_river_200
581 else
582 Canvas.Brush.Color:= clPeter_river_50
583 end
584 else
585 begin
586 if (gdSelected in State) then
587 Canvas.Brush.Color:= clOrange_200
588 else
589 Canvas.Brush.Color:= clOrange_50;
590 end;
591 Canvas.FillRect(Rect);
592 Details:= StyleServices.GetElementDetails(CtrlStateXP[False]);
593 StyleServices.DrawElement(
594 Canvas.Handle,
595 Details,
596 R,
597 nil,
598 FCurrentPPI);
599 end;
600 1:
601 begin
602 if Column.Field.FieldName = 'IB Aftrekbaar' then
603 begin
604 if (gdSelected in State) then
605 Canvas.Brush.Color:= clPeter_river_200
606 else
607 Canvas.Brush.Color:= clPeter_river_100
608 end
609 else
610 begin
611 if (gdSelected in State) then
612 Canvas.Brush.Color:= clOrange_200
613 else
614 Canvas.Brush.Color:= clOrange_100;
615 end;
616 Canvas.FillRect(Rect);
617 Details:= StyleServices.GetElementDetails(CtrlStateXP[TRUE]);
618 StyleServices.DrawElement(
619 Canvas.Handle,
620 Details,
621 R,
622 nil,
623 FCurrentPPI);
624 end;
625 end;
626 end
627
628 else
629
630 begin
631 case Column.Field.AsInteger of
632 0:
633 begin
634 Canvas.Brush.Color:= clBtnFace;
635 Canvas.FillRect(R);
636 DrawFrameControl(
637 Canvas.Handle,
638 Rect,
639 DFC_BUTTON,
640 CtrlState[False]);
641 end;
642 1:
643 begin
644 if Column.Field.FieldName = 'IB Aftrekbaar' then
645 Canvas.Brush.Color:= clGradientInactiveCaption
646 else
647 Canvas.Brush.Color:= $CCCCFF;
648 Canvas.FillRect(R);
649 DrawFrameControl(
650 Canvas.Handle,
651 Rect,
652 DFC_BUTTON,
653 CtrlState[TRUE]);
654 end;
655 end;
656
657 end;
658 end;
659
660 ftFMTBcd, ftFloat:
661 begin
662 if (Column.Field.Value > 0) then
663 if gdSelected in State then
664 begin
665 Canvas.Font.Color:= clSelectedPositiveText;
666 Canvas.Brush.Color:= clSelectedPositive;
667 Canvas.Font.Style:= [fsBold];
668 end
669 else
670 begin
671 Canvas.Font.Color:= FinAdmColors.clPositiveText;
672 Canvas.Brush.Color:= FinAdmColors.clPositive;
673 end;
674 Canvas.FillRect(Rect);
675 DefaultDrawColumnCell(
676 R,
677 DataCol,
678 Column,
679 State);
680 end;
681
682 else
683 DefaultDrawColumnCell(R, DataCol, Column, State);
684 end;
685
686 begin
687
688 // Draw the custom gridline
689 Canvas.Pen.Color:= clWhite;
690 Canvas.MoveTo(
691 Rect.Left,
692 Rect.Bottom - 1);
693 Canvas.LineTo(
694 Rect.Right,
695 Rect.Bottom - 1);
696 Canvas.MoveTo(
697 Rect.Right - 1,
698 Rect.Top);
699 Canvas.LineTo(
700 Rect.Right - 1,
701 Rect.Bottom);
702 end;
703end;
704
705{ TLForm }
706
707procedure TLForm.DoCreate;
708begin
709 Self.FRegVars:= TStringList.Create;
710 inherited;
711 Self.LoadConfig;
712end;
713
714procedure TLForm.DoDestroy;
715begin
716 inherited;
717 Self.SaveConfig;
718 Self.FRegVars.Free;
719end;
720
721procedure TLForm.SaveConfig;
722var
723 reg: TRegistry;
724 Key, Value: string;
725 i: Integer;
726begin
727 reg:= TRegistry.Create(KEY_WRITE);
728 try
729 reg.RootKey:= HKEY_CURRENT_USER;
730 if reg.OpenKey('Software\Langstraat\' + Application.Title + '\' + Self.Name, TRUE) then
731 begin
732 // Write standard values of TLForm to registry
733 if WindowState <> wsMaximized then
734 begin
735 reg.WriteInteger(
736 'Top',
737 Round(Self.Top / (PixelsPerInch / 96)));
738 reg.WriteInteger(
739 'Left',
740 Round(Self.Left / (PixelsPerInch / 96)));
741 reg.WriteInteger(
742 'Height',
743 Round(Self.Height / (PixelsPerInch / 96)));
744 reg.WriteInteger(
745 'Width',
746 Round(Self.Width / (PixelsPerInch / 96)));
747 end;
748 reg.WriteBool(
749 'WindowState',
750 Self.WindowState = wsMaximized);
751 // Write custom values to registry
752 for i:= 0 to FRegVars.Count - 1 do
753 begin
754 Key:= FRegVars.Names[i];
755 Value:= FRegVars.Values[Key];
756 reg.WriteString(
757 Key,
758 Value);
759 end;
760 reg.CloseKey;
761 end;
762 finally
763 reg.Free;
764 end;
765end;
766
767procedure TLForm.LoadConfig;
768var
769 reg: TRegistry;
770 Key, Value: string;
771 i: Integer;
772begin
773 reg:= TRegistry.Create(KEY_READ);
774 try
775 reg.RootKey:= HKEY_CURRENT_USER;
776 if reg.OpenKeyReadOnly('Software\Langstraat\' + Application.Title + '\' + Self.Name) then
777 begin
778 // Read standard values of TLForm from registry
779 if reg.ValueExists('Top') then
780 Self.Top:= MulDiv(
781 reg.ReadInteger('Top'),
782 PixelsPerInch,
783 96);
784 if reg.ValueExists('Left') then
785 Self.Left:= MulDiv(
786 reg.ReadInteger('Left'),
787 PixelsPerInch,
788 96);
789 if reg.ValueExists('Height') then
790 Self.Height:= MulDiv(
791 reg.ReadInteger('Height'),
792 PixelsPerInch,
793 96);
794 if reg.ValueExists('Width') then
795 Self.Width:= MulDiv(
796 reg.ReadInteger('Width'),
797 PixelsPerInch,
798 96);
799 if reg.ValueExists('WindowState') then
800 case reg.ReadBool('WindowState') of
801 TRUE:
802 Self.WindowState:= wsMaximized;
803 False:
804 Self.WindowState:= wsNormal;
805 end;
806 // Read custom values from registry
807 for i:= 0 to FRegVars.Count - 1 do
808 begin
809 Key:= FRegVars.Names[i];
810 Value:= FRegVars.Values[Key];
811 if reg.ValueExists(Key) then
812 begin
813 Value:= reg.ReadString(Key);
814 FRegVars.Values[Key]:= Value;
815 end;
816 end;
817 reg.CloseKey;
818 end;
819 finally
820 reg.Free;
821 end;
822end;
823
824procedure Register;
825begin
826 RegisterComponents(
827 'TL',
828 [TLDBGrid]);
829end;
830
831initialization
832
833Folder:= TLFolder.Create;
834
835finalization
836
837FreeAndNil(Folder);
838
839end.
840