First public commit

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@639 8e941d3f-bd1b-0410-a28a-d453659cc2b4

examples/germesorders/U_ExtFileCopy.pas

@@ -0,0 +1,478 @@
+unit U_ExtFileCopy;
+{$mode objfpc}{$H+}
+
+{
+Composant TExtFileCopy
+
+D�velopp� par:
+Matthieu GIROUX
+
+Composant non visuel permettant de copier un fichier plus rapidement
+que par le fonction copy de windows.
+Compatible Linux
+Attention: La gestion de la RAM �tant calamiteuse sous Win9x, l'
+utilisation de ce composant provoque une grosse une forte baisse de la
+m�moire disponible. Sous WinNT/2000 il n' y a pas de probl�mes
+
+
+Version actuelle: 1.0
+
+Mises � jour:
+}
+interface
+
+uses
+  SysUtils, Classes,ComCtrls, StrUtils, lresources ;
+  
+var GS_COPYFILES_ERROR_DIRECTORY_CREATE : String = 'Erreur � la cr�ation du r�pertoire' ;
+    GS_COPYFILES_ERROR_IS_FILE          : String = 'Ne peut copier dans le fichier' ;
+    GS_COPYFILES_ERROR_CANT_COPY        : String = 'Impossible de copier ' ;
+    GS_COPYFILES_ERROR_PARTIAL_COPY     : String = 'Copie partielle du fichier ' ;
+    GS_COPYFILES_ERROR_PARTIAL_COPY_SEEK: String = 'Erreur � la copie partielle du fichier ' ;
+    GS_COPYFILES_ERROR_CANT_READ        : String = 'Impossible de lire le fichier ' ;
+    GS_COPYFILES_ERROR_CANT_CHANGE_DATE : String = 'Impossible d''affecter la date au fichier ' ;
+    GS_COPYFILES_ERROR_CANT_CREATE      : String = 'Impossible de cr�er le fichier ' ;
+    GS_COPYFILES_ERROR_CANT_APPEND      : String = 'Impossible d''ajouter au fichier ' ;
+    GS_COPYFILES_ERROR_FILE_DELETE      : String = 'Impossible d''effacer le fichier ' ;
+    GS_COPYFILES_CONFIRM_FILE_DELETE    : String = 'Voulez-vous effacer le fichier ' ;
+    GS_COPYFILES_CONFIRM                : String = 'Demande de confirmation' ;
+
+type
+    TECopyOption = ( cpCopyAll, cpUseFilter, cpNoStructure, cpCreateBackup, cpCreateDestination, cpDestinationIsFile );
+    TECopyOptions = set of TECopyOption;
+    TECopyEvent = procedure(Sender : Tobject; const BytesCopied,BytesTotal : cardinal) of object;
+    TEReturnEvent = procedure(Sender : Tobject; var Continue : Boolean ) of object;
+    TECopyErrorEvent = procedure(Sender : Tobject; const ErrorCode : Integer ; var ErrorMessage : AnsiString ; var ContinueCopy : Boolean ) of object;
+    TECopyFinishEvent = procedure(Sender : Tobject; const ASource, ADestination : AnsiString ; const Errors : Integer ) of object;
+    TEChangeDirectoryEvent = procedure(Sender : Tobject; const NewDirectory, DestinationDirectory : AnsiString ) of object;
+const
+  lco_Default = [cpCopyAll,cpUseFilter];
+  CST_COPYFILES_ERROR_IS_READONLY = faReadOnly ;
+  CST_COPYFILES_ERROR_UNKNOWN = -1 ;
+  CST_COPYFILES_ERROR_IS_DIRECTORY = faDirectory ;
+  CST_COPYFILES_ERROR_IS_FILE = 1 ;
+  CST_COPYFILES_ERROR_DIRECTORY_CREATE = 2 ;
+  CST_COPYFILES_ERROR_CANT_COPY = 3 ;
+  CST_COPYFILES_ERROR_CANT_READ = 4 ;
+  CST_COPYFILES_ERROR_CANT_CREATE = 5 ;
+  CST_COPYFILES_ERROR_CANT_APPEND = 6 ;
+  CST_COPYFILES_ERROR_FILE_DELETE = 7 ;
+  CST_COPYFILES_ERROR_PARTIAL_COPY = 8 ;
+  CST_COPYFILES_ERROR_PARTIAL_COPY_SEEK = 9 ;
+  CST_COPYFILES_ERROR_CANT_CHANGE_DATE = 10 ;
+
+type
+
+    { TExtFileCopy }
+
+    TExtFileCopy = class(TComponent)
+           private
+             FOnChange : TEChangeDirectoryEvent ;
+             FSizeTotal : Int64 ;
+             FErrors    ,
+             FSizeProgress : Integer ;
+             FOnSuccess : TECopyFinishEvent;
+             FOnFailure : TECopyErrorEvent ;
+             FBeforeCopy : TEReturnEvent ;
+             FBeforeCopyBuffer ,
+             FOnProgress       : TECopyEvent;
+             FBufferSize : integer;
+             FOptions : TECopyOptions ;
+             FFilter, FSource,FDestination : string;
+             FInProgress : Boolean;
+             procedure SetBufferSize (Value : integer);
+             procedure SetDestination(Value : String);
+             procedure SetSource(Value: String);
+             protected
+             FBuffer : array[0..65535] of char;
+             function  BeforeCopyBuffer ( var li_SizeRead, li_BytesTotal : Longint ) : Boolean ; virtual ;
+             function  BeforeCopy : Boolean ; virtual ;
+             procedure AfterCopyBuffer  ; virtual ;
+             { D�clarations prot�g�es }
+           public
+             function EventualFailure ( const ai_Error : Integer ; as_Message : AnsiString ):Boolean; virtual ;
+             function InternalDefaultCopyFile  ( const as_Source, as_Destination : String ):Boolean; virtual ;
+             procedure InternalFinish ( const as_Source, as_Destination : String ); virtual ;
+             constructor Create(AOwner : Tcomponent);override;
+             property InProgress : Boolean read FInprogress;
+             Function CopyFile ( const as_Source, as_Destination : String ; const ab_AppendFile, ab_CreateBackup : Boolean ):Integer;
+             Procedure CopySourceToDestination;
+           published
+             property BufferSize : integer read FBufferSize write SetBufferSize default 65536;
+             property Source : string read FSource write SetSource;
+             property Mask : string read FFilter write FFilter;
+             property Destination : string read FDestination write SetDestination;
+             property Options : TECopyOptions read FOptions write FOptions default lco_Default ;
+             property OnSuccess : TECopyFinishEvent read FOnSuccess write FOnSuccess;
+             property OnFailure : TECopyErrorEvent read FOnFailure write FOnFailure;
+             property OnProgress : TECopyEvent read FOnProgress write Fonprogress;
+             property OnBeforeCopyBuffer : TECopyEvent read FBeforeCopyBuffer write FBeforeCopyBuffer;
+             property OnBeforeCopy : TEReturnEvent read FBeforeCopy write FBeforeCopy;
+             property OnChange : TEChangeDirectoryEvent read FOnChange write FOnChange;
+           end;
+
+{TExtFilePartialCopy}
+
+    TExtFilePartialCopy = class(TExtFileCopy)
+           private
+             lb_ExcludedFound  : Boolean ;
+             lpch_excludeStart,
+             lpch_excludeEnd  : String ;
+             FExcludeStart ,
+             FExcludeEnd   : String ;
+             FExcludeReading : Boolean;
+             protected
+             function  BeforeCopyBuffer ( var li_SizeRead, li_BytesTotal : Longint ) : Boolean ; override ;
+             function  BeforeCopy : Boolean ; override ;
+             procedure AfterCopyBuffer  ; override ;
+             { D�clarations prot�g�es }
+           public
+             constructor Create(AOwner : Tcomponent);override;
+           published
+             property ExcludeReading : Boolean read FExcludeReading write FExcludeReading default False ;
+             property ExcludeStart : String read FExcludeStart write FExcludeStart ;
+             property ExcludeEnd   : String read FExcludeEnd   write FExcludeEnd ;
+           end;
+
+
+procedure Register;
+
+implementation
+
+uses functions_file, Forms, Dialogs, Controls ;
+
+{TExtFileCopy}
+
+constructor TExtFileCopy.Create(AOwner :Tcomponent);
+begin
+  inherited Create(AOwner);
+  Options := lco_Default ;
+  FBufferSize := 65536;
+  FInProgress := False;
+end;
+
+procedure TExtFileCopy.SetBufferSize(Value : integer);
+begin
+  If not FInprogress
+   then
+    begin
+      If Value > high ( FBuffer )
+       then
+        Value := high ( FBuffer ) + 1
+       Else
+        FBufferSize := Value;
+    end;
+end;
+
+procedure TExtFileCopy.SetDestination(Value: String);
+begin
+  if FDestination <> Value Then
+    Begin
+      FDestination := Value;
+    End;
+end;
+
+procedure TExtFileCopy.SetSource(Value: String);
+begin
+  if FSource <> Value Then
+    Begin
+      FSource := Value;
+      if not ( csDesigning in ComponentState )
+      and Assigned ( @FOnChange )
+       Then
+        FOnChange ( Self, FSource, FDestination );
+    End;
+end;
+
+function TExtFileCopy.BeforeCopyBuffer(var li_SizeRead, li_BytesTotal : Longint ): Boolean;
+begin
+  Result := True ;
+  if Assigned ( FBeforeCopyBuffer ) Then
+    FBeforeCopyBuffer ( Self, li_SizeRead, li_BytesTotal );
+
+end;
+
+function TExtFileCopy.BeforeCopy: Boolean;
+begin
+  Result := True ;
+  if Assigned ( FBeforeCopy ) Then
+    FBeforeCopy ( Self, Result );
+end;
+
+procedure TExtFileCopy.AfterCopyBuffer;
+begin
+
+end;
+
+Function TExtFileCopy.CopyFile ( const as_Source, as_Destination : String ; const ab_AppendFile, ab_CreateBackup : Boolean ):Integer;
+var
+  li_SizeRead,li_SizeWrite,li_TotalW, li_RealTotal  : Longint;
+  li_SizeTotal : Int64 ;
+  li_HandleSource,li_HandleDest, li_pos, li_Confirm : integer;
+  ls_FileName, ls_FileExt,ls_Destination : String ;
+  lb_FoundFile : Boolean;
+  lsr_data : Tsearchrec;
+begin
+  Result := 0 ;
+  li_Confirm := mrYes ;
+  FindFirst(as_Source,faanyfile,lsr_data);
+  li_RealTotal := lsr_data.size ;
+  li_SizeTotal := lsr_data.Size;
+  inc ( FSizeTotal, li_SizeTotal );
+  li_TotalW := 0;
+  findclose(lsr_data);
+  try
+    li_HandleSource := fileopen(as_Source,fmopenread);
+  Except
+    On E: Exception do
+      Begin
+        Result := CST_COPYFILES_ERROR_CANT_READ ;
+        EventualFailure ( Result, GS_COPYFILES_ERROR_CANT_READ + as_Destination );
+        Exit ;
+      End ;
+  End ;
+  ls_Destination := as_Destination ;
+  if  ab_AppendFile
+  and fileexists(as_Destination)
+   then
+    try
+      FindFirst(as_Destination,faanyfile,lsr_data);
+      li_HandleDest := FileOpen(as_Destination, fmopenwrite );
+      FileSeek ( li_HandleDest, lsr_data.Size, 0 );
+      findclose(lsr_data);
+    Except
+      Result := CST_COPYFILES_ERROR_CANT_APPEND ;
+      EventualFailure ( Result, GS_COPYFILES_ERROR_CANT_APPEND + as_Destination );
+      Exit ;
+    End
+   Else
+     Begin
+      If fileexists(ls_Destination)
+       then
+        Begin
+          FindFirst(as_Destination,faanyfile,lsr_data);
+          if ( ab_CreateBackup )
+           Then
+            try
+              ls_FileName := lsr_data.Name;
+              ls_FileExt  := '' ;
+              li_pos := 1;
+              while ( PosEx ( '.', ls_FileName, li_pos + 1 ) > 0 ) Do
+                li_pos := PosEx ( '.', ls_FileName, li_pos + 1 );
+              if ( li_Pos > 1 ) Then
+                Begin
+                  ls_FileExt  := Copy ( ls_FileName, li_pos, length ( ls_FileName ) - li_pos + 1 );
+                  ls_FileName := Copy ( ls_FileName, 1, li_pos - 1 );
+                End ;
+              li_pos := 0 ;
+              while FileExists ( ls_Destination ) do
+               Begin
+                  inc ( li_pos );
+                  ls_Destination := ExtractFilePath ( as_Destination ) + DirectorySeparator + ls_FileName + '-' + IntToStr ( li_pos ) + ls_FileExt ;
+               End
+            Except
+              Result := -1 ;
+              EventualFailure ( Result, as_Destination );
+              Exit ;
+            End
+           Else
+            try
+              if li_Confirm <> mrAll Then
+                li_Confirm := MessageDlg ( GS_COPYFILES_CONFIRM, GS_COPYFILES_CONFIRM_FILE_DELETE, mtConfirmation, [mbYes,mbNo,mbAll,mbCancel], 0 );
+              if li_Confirm = mrCancel Then
+                Abort ;
+              if li_Confirm = mrNo Then
+                Exit ;
+              Deletefile(as_Destination);
+            Except
+              Result := CST_COPYFILES_ERROR_FILE_DELETE ;
+              EventualFailure ( Result, GS_COPYFILES_ERROR_FILE_DELETE + as_Destination );
+              Exit ;
+            End ;
+          findclose(lsr_data);
+        End ;
+      try
+        li_HandleDest := filecreate(ls_Destination);
+      Except
+        Result := CST_COPYFILES_ERROR_CANT_CREATE ;
+        EventualFailure ( Result, GS_COPYFILES_ERROR_CANT_CREATE + as_Destination );
+        Exit ;
+      End
+     end ;
+  if not BeforeCopy Then
+    Exit ;
+  lb_FoundFile := False;
+  while not lb_FoundFile do
+    try
+      li_SizeRead := FileRead(li_HandleSource,FBuffer,FbufferSize);
+      if ( li_SizeRead <= 0 )
+      and ( li_TotalW < li_RealTotal )
+       Then
+        try
+          FileSeek ( li_HandleSource, 64, li_TotalW );
+          Inc ( li_TotalW, 64 );
+          Continue ;
+        Except
+          Result := CST_COPYFILES_ERROR_PARTIAL_COPY_SEEK ;
+          EventualFailure ( Result, GS_COPYFILES_ERROR_PARTIAL_COPY_SEEK + as_Destination );
+        End ;
+      if BeforeCopyBuffer ( li_SizeRead, li_TotalW ) Then
+        Begin
+          li_SizeWrite := Filewrite(li_HandleDest,Fbuffer,li_SizeRead);
+          Application.ProcessMessages;
+          inc( li_TotalW, li_SizeWrite );
+          if  ( li_SizeRead < FBufferSize )
+          and ( li_TotalW >= li_RealTotal )
+           then
+            lb_FoundFile := True;
+          if li_SizeWrite < li_SizeRead
+           then
+             Begin
+              Result := CST_COPYFILES_ERROR_PARTIAL_COPY ;
+              EventualFailure ( Result, GS_COPYFILES_ERROR_PARTIAL_COPY + as_Destination );
+             End ;
+          if assigned(FonProgress) then FonProgress(self, FSizeProgress + li_TotalW,FSizeTotal);
+        End ;
+      AfterCopyBuffer ;
+    Except
+      Result := CST_COPYFILES_ERROR_CANT_COPY ;
+      EventualFailure ( Result, GS_COPYFILES_ERROR_CANT_COPY + '( ' + as_Source + ' -> ' + as_Destination + ' )' );
+      Exit ;
+    End ;
+  try
+    filesetdate(li_HandleDest,filegetdate(li_HandleSource));
+  Except
+    Result := CST_COPYFILES_ERROR_CANT_CHANGE_DATE ;
+    EventualFailure ( Result, GS_COPYFILES_ERROR_CANT_CHANGE_DATE + as_Destination );
+    Exit ;
+  End ;
+  fileclose(li_HandleSource);
+  fileclose(li_HandleDest);
+  if Result = 0 then
+    Begin
+      inc ( FSizeProgress, li_TotalW );
+      InternalFinish ( as_Source, as_Destination );
+      Result := 0 ;
+    End ;
+  Application.ProcessMessages ;
+end;
+
+function TExtFileCopy.InternalDefaultCopyFile  ( const as_Source, as_Destination : String ):Boolean;
+var li_Error : Integer ;
+begin
+  Result := True ;
+  li_Error := CopyFile ( as_Source, as_Destination, cpDestinationIsFile in FOptions, cpCreateBackup in FOptions );
+  EventualFailure ( li_Error , '' );
+End ;
+
+function TExtFileCopy.EventualFailure ( const ai_Error : Integer ; as_Message : AnsiString ):Boolean;
+begin
+  Result := True ;
+  if  ( ai_Error <> 0 ) then
+    Begin
+      inc ( FErrors );
+      if assigned ( FOnFailure ) then
+        Begin
+            FOnFailure ( Self, ai_Error, as_Message, Result );
+        End ;
+    End ;
+End ;
+
+procedure TExtFileCopy.InternalFinish ( const as_Source, as_Destination : String );
+begin
+  if assigned ( @FOnSuccess ) then
+    Begin
+        FOnSuccess ( Self, as_Source, as_Destination, FErrors );
+    End ;
+End ;
+
+procedure TExtFileCopy.CopySourceToDestination;
+var
+  lb_Continue : Boolean ;
+begin
+  Finprogress := true;
+  FSizeTotal := 0 ;
+  FErrors := 0 ;
+  FSizeProgress := 0 ;
+  if (    not FileExists ( FSource )
+       and not DirectoryExists ( FSource ))
+   Then
+    Exit ;
+  if  not DirectoryExists ( FDestination )
+  and not fb_CreateDirectoryStructure ( FDestination )
+   Then
+    Exit ;
+  try
+    if ( DirectoryExists ( FSource )) Then
+      Begin
+        lb_Continue := fb_InternalCopyDirectory ( FSource, FDestination, FFilter, not ( cpNoStructure in FOptions ), cpDestinationIsFile in FOptions, cpCopyAll in FOptions, cpCreateBackup in FOptions, Self );
+      End
+    Else
+      Begin
+        lb_Continue := fb_InternalCopyFile ( FSource, FDestination, cpDestinationIsFile in FOptions, cpCreateBackup in FOptions, Self );
+      End ;
+  finally
+    FinProgress := false;
+  End ;
+end;
+
+{TExtFilePartialCopy}
+
+constructor TExtFilePartialCopy.Create(AOwner :Tcomponent);
+begin
+  inherited Create(AOwner);
+  FExcludeReading := False ;
+end;
+
+
+function TExtFilePartialCopy.BeforeCopyBuffer ( var li_SizeRead, li_BytesTotal : Longint ) : Boolean ;
+
+var li_pos, li_i : Longint ;
+Begin
+  Result := inherited BeforeCopyBuffer ( li_SizeRead, li_BytesTotal );
+  if FExcludeReading
+  and ( FExcludeStart <> '' )
+  and ( FExcludeEnd   <> '' )
+   Then
+    Begin
+      li_pos := 0 ;
+      li_i   := 0 ;
+      while li_pos < li_SizeRead do
+        if lb_ExcludedFound then
+          Begin
+
+          End
+         Else
+          Begin
+          End;
+    end;
+End ;
+
+procedure TExtFilePartialCopy.AfterCopyBuffer ;
+
+Begin
+End ;
+
+
+function TExtFilePartialCopy.BeforeCopy : Boolean ;
+
+Begin
+  Result := inherited BeforeCopy ();
+  if FExcludeReading
+  and ( FExcludeStart <> '' )
+  and ( FExcludeEnd   <> '' )
+   Then
+    Begin
+//      lpch_excludeStart := fs_HexToString ( FExcludeStart );
+//      lpch_excludeEnd   := fs_HexToString ( FExcludeEnd   );
+    End ;
+End ;
+
+procedure Register;
+begin
+  RegisterComponents('Extended', [TExtFileCopy]);
+end;
+
+initialization
+  {$i U_ExtFileCopy.lrs}
+end.

examples/germesorders/build-date

@@ -0,0 +1 @@
+'07-12-2008'

examples/germesorders/functions_file.pas

@@ -0,0 +1,277 @@
+unit functions_file;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, U_ExtFileCopy;
+
+
+function  fb_FindFiles( var astl_FilesList: TStringList; as_StartDir : String ; const as_FileMask: string ; const ab_CopyAll : Boolean ):Boolean;
+Function fb_CopyFile ( const as_Source, as_Destination : String ; const ab_AppendFile, ab_CreateBackup : Boolean ):Integer;
+function fb_InternalCopyDirectory ( const as_Source, as_Destination, as_Mask : String ; const ab_CopyStructure, ab_DestinationIsFile, ab_CopyAll, ab_CreateBackup : Boolean ; const aEfc_FileCopyComponent : TExtFileCopy ):Boolean;
+function fb_InternalCopyFile ( const as_Source, as_Destination : String ; const ab_DestinationIsFile, ab_CreateBackup : Boolean ; const aEfc_FileCopyComponent : TExtFileCopy ):Boolean;
+function fb_CreateDirectoryStructure ( const as_DirectoryToCreate : String ) : Boolean ;
+
+implementation
+
+uses StrUtils, Dialogs, Forms ;
+
+// Recursive procedure to build a list of files
+function fb_FindFiles( var astl_FilesList: TStringList; as_StartDir : String ; const as_FileMask: string ; const ab_CopyAll : Boolean  ):Boolean;
+var
+  SR: TSearchRec;
+  IsFound: Boolean;
+begin
+  Result := False ;
+
+  if astl_FilesList = nil
+   then
+    astl_FilesList := TstringList.Create ;
+
+  if as_StartDir[length(as_StartDir)] <> DirectorySeparator
+   then
+    as_StartDir := as_StartDir + DirectorySeparator;
+
+  { Build a list of the files in directory as_StartDir
+     (not the directories!)                         }
+  if ab_copyAll Then
+  try
+    IsFound := FindFirst(as_StartDir + '*', faDirectory, SR) = 0 ;
+    while IsFound do
+     begin
+      if (( SR.Name <> '.' ) and ( SR.Name <> '..' ))
+      and DirectoryExists ( as_StartDir + SR.Name )
+       then
+        Begin
+          astl_FilesList.Add(as_StartDir + SR.Name);
+        End ;
+      IsFound := FindNext(SR) = 0;
+      Result := True ;
+    end;
+    FindClose(SR);
+  Except
+    FindClose(SR);
+  End ;
+  try
+    IsFound := FindFirst(as_StartDir+as_FileMask, faAnyFile-faDirectory, SR) = 0;
+    while IsFound do
+     begin
+        if FileExists ( as_StartDir + SR.Name )
+         Then
+          astl_FilesList.Add(as_StartDir + SR.Name);
+        IsFound := FindNext(SR) = 0;
+        Result := True ;
+      end;
+    FindClose(SR);
+  Except
+    FindClose(SR);
+  End ;
+
+end;
+
+Function fb_CopyFile ( const as_Source, as_Destination : String ; const ab_AppendFile, ab_CreateBackup : Boolean ):Integer;
+var
+  li_SizeRead,li_SizeWrite,li_TotalW  : Longint;
+  li_HandleSource,li_HandleDest, li_pos : integer;
+  ls_FileName, ls_FileExt,ls_Destination : String ;
+  lb_FoundFile,lb_Error : Boolean;
+  lsr_data : Tsearchrec;
+  FBuffer  : array[0..2047] of char;
+begin
+  Result := CST_COPYFILES_ERROR_UNKNOWN ;
+  {
+  FindFirst(as_Source,faanyfile,lsr_data);
+  li_TotalW := 0;
+  findclose(lsr_data);
+  }
+  li_TotalW := 0;
+  
+  li_HandleSource := fileopen(as_Source,fmopenread);
+  ls_Destination := as_Destination ;
+  if  ab_AppendFile
+  and fileexists(as_Destination)
+   then
+    Begin
+      FindFirst(as_Destination,faanyfile,lsr_data);
+      li_HandleDest := FileOpen(as_Destination, fmopenwrite );
+      FileSeek ( li_HandleDest, lsr_data.Size, 0 );
+      findclose(lsr_data);
+    End
+   Else
+     Begin
+      If fileexists(ls_Destination)
+       then
+        Begin
+          FindFirst(as_Destination,faanyfile,lsr_data);
+          if ( ab_CreateBackup )
+           Then
+            Begin
+              ls_FileName := lsr_data.Name;
+              ls_FileExt  := '' ;
+              li_pos := 1;
+              while ( PosEx ( '.', ls_FileName, li_pos + 1 ) > 0 ) Do
+                li_pos := PosEx ( '.', ls_FileName, li_pos + 1 );
+              if ( li_Pos > 1 ) Then
+                Begin
+                  ls_FileExt  := Copy ( ls_FileName, li_pos, length ( ls_FileName ) - li_pos + 1 );
+                  ls_FileName := Copy ( ls_FileName, 1, li_pos - 1 );
+                End ;
+              li_pos := 0 ;
+              while FileExists ( ls_Destination ) do
+               Begin
+                 inc ( li_pos );
+                 ls_Destination := ExtractFilePath ( as_Destination ) + DirectorySeparator + ls_FileName + '-' + IntToStr ( li_pos ) + ls_FileExt ;
+               End
+            End
+           Else
+            Deletefile(as_Destination);
+          findclose(lsr_data);
+        End ;
+      li_HandleDest := filecreate(ls_Destination);
+     end ;
+  lb_FoundFile := False;
+  lb_Error := false;
+  while not lb_FoundFile do
+    begin
+      li_SizeRead := FileRead(li_HandleSource,FBuffer,high ( Fbuffer ) + 1);
+      if li_SizeRead < high ( Fbuffer ) + 1 then lb_FoundFile := True;
+      li_SizeWrite := Filewrite(li_HandleDest,Fbuffer,li_SizeRead);
+      inc( li_TotalW, li_SizeWrite );
+      if li_SizeWrite < li_SizeRead then lb_Error := True;
+    end;
+  filesetdate(li_HandleDest,filegetdate(li_HandleSource));
+  fileclose(li_HandleSource);
+  fileclose(li_HandleDest);
+  if lb_Error = False then
+    Begin
+      Result := 0 ;
+    End ;
+  //Application.ProcessMessages ;
+end;
+
+function fb_CreateDirectoryStructure ( const as_DirectoryToCreate : String ) : Boolean ;
+var
+  lsr_data : Tsearchrec;
+  li_Pos : Integer ;
+  ls_Temp : String ;
+begin
+  Result := False ;
+  if DirectoryExists ( as_DirectoryToCreate )
+   Then
+    Begin
+      Result := True;
+    End
+  Else
+    try
+       li_Pos := 1 ;
+       while ( Posex ( DirectorySeparator, as_DirectoryToCreate, li_pos + 1 ) > 1 ) do
+         li_Pos := Posex ( DirectorySeparator, as_DirectoryToCreate, li_pos + 1 );
+       if ( li_pos > 1 ) Then
+         ls_Temp := Copy ( as_DirectoryToCreate, 1 , li_pos - 1 )
+       Else
+         Exit ;
+       if  not DirectoryExists ( ls_Temp ) Then
+         Begin
+           fb_CreateDirectoryStructure ( ls_Temp );
+         End ;
+       if DirectoryExists ( ls_Temp ) then
+         Begin
+           FindFirst ( ls_Temp,faanyfile,lsr_data);
+           if ( DirectoryExists ( ls_Temp )) Then
+             try
+               CreateDir ( as_DirectoryToCreate );
+               Result := True ;
+             except
+             End
+            Else
+             Result := False ;
+           FindClose ( lsr_data );
+         end;
+     Finally
+     End ;
+End ;
+
+
+function fb_InternalCopyFile ( const as_Source, as_Destination : String ; const ab_DestinationIsFile, ab_CreateBackup : Boolean ; const aEfc_FileCopyComponent : TExtFileCopy ):Boolean;
+var lsr_AttrSource      : TSearchRec ;
+
+begin
+  Result := True ;
+  Result := fb_CreateDirectoryStructure ( as_Destination );
+  if FileExists ( as_Destination ) Then
+    Begin
+      if ( DirectoryExists ( as_Destination ) ) Then
+        Begin
+          FindFirst ( as_Source, faAnyFile, lsr_AttrSource );
+          if assigned ( aEfc_FileCopyComponent ) Then
+            Result := aEfc_FileCopyComponent.CopyFile ( as_Source, as_Destination + DirectorySeparator + lsr_AttrSource.Name, ab_DestinationIsFile, ab_CreateBackup ) <> 0
+          Else
+            Result := fb_CopyFile ( as_Source, as_Destination + DirectorySeparator + lsr_AttrSource.Name, ab_DestinationIsFile, ab_CreateBackup ) <> 0
+        End
+      Else
+        Begin
+          if assigned ( aEfc_FileCopyComponent ) Then
+            Result := aEfc_FileCopyComponent.CopyFile ( as_Source, as_Destination, ab_DestinationIsFile, ab_CreateBackup ) <> 0
+          else
+            Result := fb_CopyFile ( as_Source, as_Destination, ab_DestinationIsFile, ab_CreateBackup ) <> 0
+        End ;
+    End
+  Else
+    if assigned ( aEfc_FileCopyComponent ) Then
+      aEfc_FileCopyComponent.EventualFailure ( CST_COPYFILES_ERROR_DIRECTORY_CREATE, GS_COPYFILES_ERROR_DIRECTORY_CREATE + ' ' + as_Destination );
+End ;
+
+
+function fb_InternalCopyDirectory ( const as_Source, as_Destination, as_Mask : String ; const ab_CopyStructure, ab_DestinationIsFile, ab_CopyAll, ab_CreateBackup : Boolean ; const aEfc_FileCopyComponent : TExtFileCopy ):Boolean;
+var li_Error, li_i : Integer ;
+    ls_Source ,
+    ls_destination  : String ;
+    lstl_StringList : TStringList ;
+    lsr_AttrSource      : Tsearchrec;
+begin
+  if not fb_CreateDirectoryStructure ( as_Destination ) Then
+    Begin
+      li_Error := CST_COPYFILES_ERROR_DIRECTORY_CREATE ;
+      if assigned ( aEfc_FileCopyComponent ) Then
+          Result := aEfc_FileCopyComponent.EventualFailure ( li_Error, as_Destination );
+      Exit ;
+    End ;
+  if  assigned ( @aEfc_FileCopyComponent )
+  and Assigned ( @aEfc_FileCopyComponent.OnChange )
+   Then
+    aEfc_FileCopyComponent.OnChange ( aEfc_FileCopyComponent, as_Source, as_Destination );
+  Result := True ;
+  lstl_StringList := nil ;
+  if fb_FindFiles ( lstl_StringList, as_Source, as_Mask, ab_CopyAll ) Then
+    for li_i := 0 to lstl_StringList.count - 1 do
+      Begin
+        ls_Source := lstl_StringList.Strings [ li_i ];
+        FindFirst( ls_Source,faanyfile,lsr_AttrSource);
+        if DirectoryExists ( ls_Source ) Then
+          Begin
+            if ab_CopyStructure then
+              ls_destination := as_Destination + DirectorySeparator + lsr_AttrSource.Name
+            Else
+              ls_destination := as_Destination ;
+            Result := fb_InternalCopyDirectory ( ls_Source, ls_Destination, as_Mask, ab_CopyStructure, ab_DestinationIsFile, ab_CopyAll, ab_CreateBackup, aEfc_FileCopyComponent );
+          End
+        Else
+          if FileExists ( ls_Source ) Then
+            Begin
+              if assigned ( aEfc_FileCopyComponent ) Then
+                Begin
+                  Result := aEfc_FileCopyComponent.InternalDefaultCopyFile ( ls_Source, as_Destination + DirectorySeparator + lsr_AttrSource.Name );
+                End
+              Else
+                Result := fb_InternalCopyFile ( ls_Source, as_Destination + DirectorySeparator + lsr_AttrSource.Name, ab_DestinationIsFile, ab_CreateBackup, aEfc_FileCopyComponent );
+            End ;
+      End ;
+  lstl_StringList.Free ;
+End ;
+
+
+
+end.
+

examples/germesorders/germesorders.lpr

@@ -0,0 +1,50 @@
+program germesorders;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms
+  { you can add units after this },
+  uDebug, SysUtils, rx,
+  uOrders, uTestForm, ufrmParent;
+
+begin
+  GlobalLogger.Log('Старт приложения GermesOrders. %s', [FormatDateTime('dd-mm-yyyy hh-mm-ss', Now)]);
+
+  try
+    try
+      {$IFDEF LCLwince}
+      TaskBarHide;
+      
+      GlobalLogger.Log('Запуск под WinCE');
+      Application.ApplicationType:=atPDA;
+      {$ENDIF}
+      
+      Application.Initialize;
+      Application.OnException:=@GlobalLogger.ExceptionHandler;
+      Application.StopOnException:=False;
+
+      Application.CreateForm(TfrmOrders, frmOrders);
+      {$IFDEF LCLwince}
+      frmOrders.WindowResize;
+      {$ENDIF}
+      Application.Run;
+    except
+      on E:Exception do
+        begin
+          GlobalLogger.LogException(E);
+        end;
+    end;
+  finally
+    {$IFDEF LCLwince}
+    TaskBarUnHide;
+    {$ENDIF}
+      
+    GlobalLogger.Log('Завершение приложения GermesOrders');
+  end;
+end.
+

examples/germesorders/lclstrconsts.rst

@@ -0,0 +1,883 @@
+
+# hash value = 116448302
+lclstrconsts.snomdiform='No MDI form present.'
+
+
+# hash value = 180163
+lclstrconsts.rsmbyes='&Yes'
+
+
+# hash value = 11087
+lclstrconsts.rsmbno='&No'
+
+
+# hash value = 11067
+lclstrconsts.rsmbok='&OK'
+
+
+# hash value = 77089212
+lclstrconsts.rsmbcancel='Cancel'
+
+
+# hash value = 4691604
+lclstrconsts.rsmbabort='Abort'
+
+
+# hash value = 45665177
+lclstrconsts.rsmbretry='&Retry'
+
+
+# hash value = 184440485
+lclstrconsts.rsmbignore='&Ignore'
+
+
+# hash value = 174124
+lclstrconsts.rsmball='&All'
+
+
+# hash value = 129053500
+lclstrconsts.rsmbnotoall='No to all'
+
+
+# hash value = 189621084
+lclstrconsts.rsmbyestoall='Yes to &All'
+
+
+# hash value = 2812976
+lclstrconsts.rsmbhelp='&Help'
+
+
+# hash value = 44709525
+lclstrconsts.rsmbclose='&Close'
+
+
+# hash value = 227102743
+lclstrconsts.rsmtwarning='Warning'
+
+
+# hash value = 5020002
+lclstrconsts.rsmterror='Error'
+
+
+# hash value = 157868862
+lclstrconsts.rsmtinformation='Information'
+
+
+# hash value = 228516702
+lclstrconsts.rsmtconfirmation='Confirmation'
+
+
+# hash value = 78424925
+lclstrconsts.rsmtcustom='Custom'
+
+
+# hash value = 218146437
+lclstrconsts.rsfdopenfile='Open existing file'
+
+
+# hash value = 253903247
+lclstrconsts.rsfdoverwritefile='Overwrite file ?'
+
+
+# hash value = 170756255
+lclstrconsts.rsfdfilealreadyexists='The file "%s" already exists. Overwri'+
+'te ?'
+
+
+# hash value = 214698628
+lclstrconsts.rsfdpathmustexist='Path must exist'
+
+
+# hash value = 2002030
+lclstrconsts.rsfdpathnoexist='The path "%s" does not exist.'
+
+
+# hash value = 68940036
+lclstrconsts.rsfdfilemustexist='File must exist'
+
+
+# hash value = 257037268
+lclstrconsts.rsfddirectorymustexist='Directory must exist'
+
+
+# hash value = 175332478
+lclstrconsts.rsfdfilenotexist='The file "%s" does not exist.'
+
+
+# hash value = 185778894
+lclstrconsts.rsfddirectorynotexist='The directory "%s" does not exist.'
+
+
+# hash value = 315460
+lclstrconsts.rsfind='Find'
+
+
+# hash value = 8088661
+lclstrconsts.rsfdfilereadonlytitle='File is not writable'
+
+
+# hash value = 185710718
+lclstrconsts.rsfdfilereadonly='The file "%s" is not writable.'
+
+
+# hash value = 159035875
+lclstrconsts.rsfdfilesaveas='Save file as'
+
+
+# hash value = 240701379
+lclstrconsts.rsallfiles='All files (%s)|%s|%s'
+
+
+# hash value = 52003257
+lclstrconsts.rsfdselectdirectory='Select Directory'
+
+
+# hash value = 146283929
+lclstrconsts.rsdirectory='&Directory'
+
+
+# hash value = 66489026
+lclstrconsts.rsselectcolortitle='Select color'
+
+
+# hash value = 267685988
+lclstrconsts.rsselectfonttitle='Select a font'
+
+
+# hash value = 73894789
+lclstrconsts.rsfindmore='Find more'
+
+
+# hash value = 147269573
+lclstrconsts.rsreplace='Replace'
+
+
+# hash value = 131047692
+lclstrconsts.rsreplaceall='Replace all'
+
+
+# hash value = 76991407
+lclstrconsts.rsdeleterecord='Delete record?'
+
+
+# hash value = 43738254
+lclstrconsts.rswarningunremovedpaintmessages=' WARNING: There are %s unre'+
+'moved LM_PAINT/LM_GtkPAINT message links left.'
+
+
+# hash value = 136877850
+lclstrconsts.rswarningunreleaseddcsdump=' WARNING: There are %d unrelease'+
+'d DCs, a detailed dump follows:'
+
+
+# hash value = 211225450
+lclstrconsts.rswarningunreleasedgdiobjectsdump=' WARNING: There are %d un'+
+'released GDIObjects, a detailed dump follows:'
+
+
+# hash value = 268042925
+lclstrconsts.rswarningunreleasedmessagesinqueue=' WARNING: There are %d m'+
+'essages left in the queue! I'#39'll free them'
+
+
+# hash value = 242373069
+lclstrconsts.rswarningunreleasedtimerinfos=' WARNING: There are %d TimerI'+
+'nfo structures left, I'#39'll free them'
+
+
+# hash value = 5518094
+lclstrconsts.rsfileinformation='File information'
+
+
+# hash value = 218344474
+lclstrconsts.rsgtkfilter='Filter:'
+
+
+# hash value = 11234618
+lclstrconsts.rsgtkhistory='History:'
+
+
+# hash value = 130921045
+lclstrconsts.rsdefaultfileinfovalue='permissions user group size date tim'+
+'e'
+
+
+# hash value = 4794443
+lclstrconsts.rsblank='Blank'
+
+
+# hash value = 46957156
+lclstrconsts.rsunabletoloaddefaultfont='Unable to load default font'
+
+
+# hash value = 149412441
+lclstrconsts.rsfileinfofilenotfound='(file not found: "%s")'
+
+
+# hash value = 163894147
+lclstrconsts.rsgtkoptionnotransient='--lcl-no-transient    Do not set tra'+
+'nsient order for modal forms'
+
+
+# hash value = 106700606
+lclstrconsts.rsgtkoptionmodule='--gtk-module module   Load the specified '+
+'module at startup.'
+
+
+# hash value = 60316542
+lclstrconsts.rsgoptionfatalwarnings='--g-fatal-warnings    Warnings and e'+
+'rrors generated by Gtk+/GDK will halt the application.'
+
+
+# hash value = 140236766
+lclstrconsts.rsgtkoptiondebug='--gtk-debug flags     Turn on specific Gtk'+
+'+ trace/debug messages.'
+
+
+# hash value = 172907742
+lclstrconsts.rsgtkoptionnodebug='--gtk-no-debug flags  Turn off specific '+
+'Gtk+ trace/debug messages.'
+
+
+# hash value = 106157518
+lclstrconsts.rsgdkoptiondebug='--gdk-debug flags     Turn on specific GDK'+
+' trace/debug messages.'
+
+
+# hash value = 108470414
+lclstrconsts.rsgdkoptionnodebug='--gdk-no-debug flags  Turn off specific '+
+'GDK trace/debug messages.'
+
+
+# hash value = 229514142
+lclstrconsts.rsgtkoptiondisplay='--display h:s:d       Connect to the spe'+
+'cified X server, where "h" is the hostname, "s" is the server number (us'+
+'ually 0), and "d" is the display number (typically omitted). If --displa'+
+'y is not specified, the DISPLAY environment variable is used.'
+
+
+# hash value = 217400286
+lclstrconsts.rsgtkoptionsync='--sync                Call XSynchronize (di'+
+'splay, True) after the Xserver connection has been established. This mak'+
+'es debugging X protocol errors easier, because X request buffering will '+
+'be disabled and X errors will be received immediatey after the protocol '+
+'request that generated the error has been processed by the X server.'
+
+
+# hash value = 195743726
+lclstrconsts.rsgtkoptionnoxshm='--no-xshm             Disable use of the '+
+'X Shared Memory Extension.'
+
+
+# hash value = 194798814
+lclstrconsts.rsgtkoptionname='--name programe       Set program name to "'+
+'progname". If not specified, program name will be set to ParamStr(0).'
+
+
+# hash value = 184385486
+lclstrconsts.rsgtkoptionclass='--class classname     Following Xt convent'+
+'ions, the class of a program is the program name with the initial charac'+
+'ter capitalized. For example, the classname for gimp is "Gimp". If --cla'+
+'ss is specified, the class of the program will be set to "classname".'
+
+
+# hash value = 143982970
+lclstrconsts.rswin32warning='Warning:'
+
+
+# hash value = 80320090
+lclstrconsts.rswin32error='Error:'
+
+
+# hash value = 120286414
+lclstrconsts.sinvalidactionregistration='Invalid action registration'
+
+
+# hash value = 107435102
+lclstrconsts.sinvalidactionunregistration='Invalid action unregistration'
+
+
+# hash value = 257061422
+lclstrconsts.sinvalidactionenumeration='Invalid action enumeration'
+
+
+# hash value = 14455774
+lclstrconsts.sinvalidactioncreation='Invalid action creation'
+
+
+# hash value = 179018357
+lclstrconsts.smenunotfound='Sub-menu is not in menu'
+
+
+# hash value = 161707093
+lclstrconsts.smenuindexerror='Menu index out of range'
+
+
+# hash value = 77966540
+lclstrconsts.smenuitemisnil='MenuItem is nil'
+
+
+# hash value = 243310981
+lclstrconsts.snotimers='No timers available'
+
+
+# hash value = 63966936
+lclstrconsts.sinvalidindex='Invalid ImageList Index'
+
+
+# hash value = 118811733
+lclstrconsts.sinvalidimagesize='Invalid image size'
+
+
+# hash value = 6059683
+lclstrconsts.sduplicatemenus='Duplicate menus'
+
+
+# hash value = 267616887
+lclstrconsts.scannotfocus='Cannot focus a disabled or invisible window'
+
+
+# hash value = 91975905
+lclstrconsts.sinvalidcharset='The char set in mask "%s" is not valid!'
+
+
+# hash value = 110266185
+lclstrconsts.rslistmustbeempty='List must be empty'
+
+
+# hash value = 170977461
+lclstrconsts.rsinvalidpropertyvalue='Invalid property value'
+
+
+# hash value = 33357748
+lclstrconsts.rspropertydoesnotexist='Property %s does not exist'
+
+
+# hash value = 17605204
+lclstrconsts.rsinvalidstreamformat='Invalid stream format'
+
+
+# hash value = 35056579
+lclstrconsts.rserrorreadingproperty='Error reading %s%s%s: %s'
+
+
+# hash value = 50697741
+lclstrconsts.rsinvalidformobjectstream='invalid Form object stream'
+
+
+# hash value = 173387477
+lclstrconsts.rsscrollbaroutofrange='ScrollBar property out of range'
+
+
+# hash value = 148231363
+lclstrconsts.rsinvaliddate='Invalid Date : %s'
+
+
+# hash value = 73173939
+lclstrconsts.rsinvaliddaterangehint='Invalid Date: %s. Must be between %s'+
+' and %s'
+
+
+# hash value = 69322611
+lclstrconsts.rserroroccurredinataddressframe='Error occurred in %s at %sA'+
+'ddress %s%s Frame %s'
+
+
+# hash value = 164095166
+lclstrconsts.rsexception='Exception'
+
+
+# hash value = 18079619
+lclstrconsts.rsformstreamingerror='Form streaming "%s" error: %s'
+
+
+# hash value = 162940228
+lclstrconsts.rsfixedcolstoobig='FixedCols can'#39't be >= ColCount'
+
+
+# hash value = 170477124
+lclstrconsts.rsfixedrowstoobig='FixedRows can'#39't be >= RowCount'
+
+
+# hash value = 187401219
+lclstrconsts.rsgridfiledoesnotexists='Grid file doesn'#39't exists'
+
+
+# hash value = 200509829
+lclstrconsts.rsnotavalidgridfile='Not a valid grid file'
+
+
+# hash value = 85688093
+lclstrconsts.rsindexoutofrange='Index Out of range Cell[Col=%d Row=%d]'
+
+
+# hash value = 233055470
+lclstrconsts.rsgridindexoutofrange='Grid index out of range.'
+
+
+# hash value = 121912736
+lclstrconsts.rserrorinlcl='ERROR in LCL: '
+
+
+# hash value = 262578650
+lclstrconsts.rscreatinggdbcatchableerror='Creating gdb catchable error:'
+
+
+# hash value = 199592836
+lclstrconsts.rsacontrolcannothaveitselfasparent='A control can'#39't have'+
+' itself as parent'
+
+
+# hash value = 247901844
+lclstrconsts.lislclresourcesnotfound='Resource %s not found'
+
+
+# hash value = 200721683
+lclstrconsts.rserrorcreatingdevicecontext='Error creating device context '+
+'for %s.%s'
+
+
+# hash value = 89442116
+lclstrconsts.rsindexoutofbounds='%s Index %d out of bounds 0 .. %d'
+
+
+# hash value = 170287246
+lclstrconsts.rsunknownpictureextension='Unknown picture extension'
+
+
+# hash value = 151730227
+lclstrconsts.rsbitmaps='Bitmaps'
+
+
+# hash value = 91288448
+lclstrconsts.rspixmap='Pixmap'
+
+
+# hash value = 186584323
+lclstrconsts.rsportablenetworkgraphic='Portable Network Graphic'
+
+
+# hash value = 221738640
+lclstrconsts.rsportablebitmap='Portable BitMap'
+
+
+# hash value = 83268176
+lclstrconsts.rsportablegraymap='Portable GrayMap'
+
+
+# hash value = 215430800
+lclstrconsts.rsportablepixmap='Portable PixMap'
+
+
+# hash value = 326238
+lclstrconsts.rsicon='Icon'
+
+
+# hash value = 187650640
+lclstrconsts.rsjpeg='Joint Picture Expert Group'
+
+
+# hash value = 81834899
+lclstrconsts.rsunsupportedclipboardformat='Unsupported clipboard format: '+
+'%s'
+
+
+# hash value = 65054488
+lclstrconsts.rsgroupindexcannotbelessthanprevious='GroupIndex cannot be l'+
+'ess than a previous menu item'#39's GroupIndex'
+
+
+# hash value = 66182739
+lclstrconsts.rsisalreadyassociatedwith='%s is already associated with %s'
+
+
+# hash value = 3662151
+lclstrconsts.rscanvasdoesnotallowdrawing='Canvas does not allow drawing'
+
+
+# hash value = 31303742
+lclstrconsts.rsunsupportedbitmapformat='Unsupported bitmap format.'
+
+
+# hash value = 146228686
+lclstrconsts.rserrorwhilesavingbitmap='Error while saving bitmap.'
+
+
+# hash value = 110402606
+lclstrconsts.rsnowidgetset='No widgetset object. Please check if the unit'+
+' "interfaces" was added to the programs uses clause.'
+
+
+# hash value = 990766
+lclstrconsts.rspressoktoignoreandriskdatacorruptionpresscanceltok='%s%sPr'+
+'ess Ok to ignore and risk data corruption.%sPress Cancel to kill the pro'+
+'gram.'
+
+
+# hash value = 267202531
+lclstrconsts.rscannotfocus='Can not focus'
+
+
+# hash value = 162403993
+lclstrconsts.rslistindexexceedsbounds='List index exceeds bounds (%d)'
+
+
+# hash value = 247901844
+lclstrconsts.rsresourcenotfound='Resource %s not found'
+
+
+# hash value = 180753218
+lclstrconsts.rscalculator='Calculator'
+
+
+# hash value = 5020002
+lclstrconsts.rserror='Error'
+
+
+# hash value = 267653781
+lclstrconsts.rspickdate='Select a date'
+
+
+# hash value = 41554000
+lclstrconsts.rssize='  size '
+
+
+# hash value = 182357808
+lclstrconsts.rsmodified='  modified '
+
+
+# hash value = 206722702
+lclstrconsts.ifsvk_unknown='Unknown'
+
+
+# hash value = 52071572
+lclstrconsts.ifsvk_lbutton='Mouse Button Left'
+
+
+# hash value = 25332164
+lclstrconsts.ifsvk_rbutton='Mouse Button Right'
+
+
+# hash value = 77089212
+lclstrconsts.ifsvk_cancel='Cancel'
+
+
+# hash value = 177793589
+lclstrconsts.ifsvk_mbutton='Mouse Button Middle'
+
+
+# hash value = 170536933
+lclstrconsts.ifsvk_back='Backspace'
+
+
+# hash value = 23154
+lclstrconsts.ifsvk_tab='Tab'
+
+
+# hash value = 4860802
+lclstrconsts.ifsvk_clear='Clear'
+
+
+# hash value = 93109390
+lclstrconsts.ifsvk_return='Return'
+
+
+# hash value = 5894100
+lclstrconsts.ifsvk_shift='Shift'
+
+
+# hash value = 174438684
+lclstrconsts.ifsvk_control='Control'
+
+
+# hash value = 343125
+lclstrconsts.ifsvk_menu='Menu'
+
+
+# hash value = 211240777
+lclstrconsts.ifsvk_pause='Pause key'
+
+
+# hash value = 159844924
+lclstrconsts.ifsvk_capital='Capital'
+
+
+# hash value = 333889
+lclstrconsts.ifsvk_kana='Kana'
+
+
+# hash value = 5358849
+lclstrconsts.ifsvk_junja='Junja'
+
+
+# hash value = 5047420
+lclstrconsts.ifsvk_final='Final'
+
+
+# hash value = 5145857
+lclstrconsts.ifsvk_hanja='Hanja'
+
+
+# hash value = 80320613
+lclstrconsts.ifsvk_escape='Escape'
+
+
+# hash value = 174443732
+lclstrconsts.ifsvk_convert='Convert'
+
+
+# hash value = 174103252
+lclstrconsts.ifsvk_nonconvert='Nonconvert'
+
+
+# hash value = 75078772
+lclstrconsts.ifsvk_accept='Accept'
+
+
+# hash value = 80363173
+lclstrconsts.ifsvk_modechange='Mode Change'
+
+
+# hash value = 127355817
+lclstrconsts.ifsvk_space='Space key'
+
+
+# hash value = 5738594
+lclstrconsts.ifsvk_prior='Prior'
+
+
+# hash value = 347380
+lclstrconsts.ifsvk_next='Next'
+
+
+# hash value = 19524
+lclstrconsts.ifsvk_end='End'
+
+
+# hash value = 325173
+lclstrconsts.ifsvk_home='Home'
+
+
+# hash value = 338900
+lclstrconsts.ifsvk_left='Left'
+
+
+# hash value = 1472
+lclstrconsts.ifsvk_up='Up'
+
+
+# hash value = 5832180
+lclstrconsts.ifsvk_right='Right'
+
+
+# hash value = 308958
+lclstrconsts.ifsvk_down='Down'
+
+
+# hash value = 94120868
+lclstrconsts.ifsvk_select='Select'
+
+
+# hash value = 5738580
+lclstrconsts.ifsvk_print='Print'
+
+
+# hash value = 216771813
+lclstrconsts.ifsvk_execute='Execute'
+
+
+# hash value = 75996356
+lclstrconsts.ifsvk_snapshot='Snapshot'
+
+
+# hash value = 84253844
+lclstrconsts.ifsvk_insert='Insert'
+
+
+# hash value = 78392485
+lclstrconsts.ifsvk_delete='Delete'
+
+
+# hash value = 322608
+lclstrconsts.ifsvk_help='Help'
+
+
+# hash value = 306060
+lclstrconsts.ifsctrl='Ctrl'
+
+
+# hash value = 18484
+lclstrconsts.ifsalt='Alt'
+
+
+# hash value = 153444057
+lclstrconsts.rswholewordsonly='Whole words only'
+
+
+# hash value = 219672053
+lclstrconsts.rscasesensitive='Case sensitive'
+
+
+# hash value = 371956
+lclstrconsts.rstext='Text'
+
+
+# hash value = 146466142
+lclstrconsts.rsdirection='Direction'
+
+
+# hash value = 225040580
+lclstrconsts.rsforward='Forward'
+
+
+# hash value = 128113668
+lclstrconsts.rsbackward='Backward'
+
+
+# hash value = 10460745
+lclstrconsts.ifsvk_lwin='left windows key'
+
+
+# hash value = 14715049
+lclstrconsts.ifsvk_rwin='right windows key'
+
+
+# hash value = 160407833
+lclstrconsts.ifsvk_apps='application key'
+
+
+# hash value = 73873268
+lclstrconsts.ifsvk_numpad='Numpad %d'
+
+
+# hash value = 96744907
+lclstrconsts.ifsvk_numlock='Numlock'
+
+
+# hash value = 94017068
+lclstrconsts.ifsvk_scroll='Scroll'
+
+
+# hash value = 190455815
+lclstrconsts.rsdocking='Docking'
+
+
+# hash value = 155943125
+lclstrconsts.rshelphelpnodehasnohelpdatabase='Help node %s%s%s has no Hel'+
+'p Database'
+
+
+# hash value = 33382163
+lclstrconsts.rshelpthereisnoviewerforhelptype='There is no viewer for hel'+
+'p type %s%s%s'
+
+
+# hash value = 69467939
+lclstrconsts.rshelphelpdatabasedidnotfoundaviewerforahelppageoftype='Help'+
+' Database %s%s%s did not found a viewer for a help page of type %s'
+
+
+# hash value = 261885636
+lclstrconsts.rshelpalreadyregistered='%s: Already registered'
+
+
+# hash value = 67864100
+lclstrconsts.rshelpnotregistered='%s: Not registered'
+
+
+# hash value = 79599652
+lclstrconsts.rshelphelpdatabasenotfound='Help Database %s%s%s not found'
+
+
+# hash value = 214288686
+lclstrconsts.rshelphelpkeywordnotfoundindatabase='Help keyword %s%s%s not'+
+' found in Database %s%s%s.'
+
+
+# hash value = 160520878
+lclstrconsts.rshelphelpkeywordnotfound='Help keyword %s%s%s not found.'
+
+
+# hash value = 69651854
+lclstrconsts.rshelphelpcontextnotfoundindatabase='Help context %s not fou'+
+'nd in Database %s%s%s.'
+
+
+# hash value = 52390638
+lclstrconsts.rshelphelpcontextnotfound='Help context %s not found.'
+
+
+# hash value = 174201838
+lclstrconsts.rshelpnohelpfoundforsource='No help found for line %d, colum'+
+'n %d of %s.'
+
+
+# hash value = 23106645
+lclstrconsts.rshelpnohelpnodesavailable='No help nodes available'
+
+
+# hash value = 38303058
+lclstrconsts.rshelperror='Help Error'
+
+
+# hash value = 169769860
+lclstrconsts.rshelpdatabasenotfound='Help Database not found'
+
+
+# hash value = 148231860
+lclstrconsts.rshelpcontextnotfound='Help Context not found'
+
+
+# hash value = 143564324
+lclstrconsts.rshelpviewernotfound='Help Viewer not found'
+
+
+# hash value = 174005188
+lclstrconsts.rshelpnotfound='Help not found'
+
+
+# hash value = 30250882
+lclstrconsts.rshelpviewererror='Help Viewer Error'
+
+
+# hash value = 44304850
+lclstrconsts.rshelpselectorerror='Help Selector Error'
+
+
+# hash value = 167955351
+lclstrconsts.rsunknownerrorpleasereportthisbug='Unknown Error, please rep'+
+'ort this bug'
+
+
+# hash value = 10044126
+lclstrconsts.hhshelpthehelpdatabasewasunabletofindfile='The help database'+
+' %s%s%s was unable to find file %s%s%s.'
+
+
+# hash value = 58150606
+lclstrconsts.hhshelpthemacrosinbrowserparamswillbereplacedbytheurl='The m'+
+'acro %s in BrowserParams will be replaced by the URL.'
+
+
+# hash value = 253367203
+lclstrconsts.hhshelpnohtmlbrowserfoundpleasedefineoneinhelpconfigurehe='N'+
+'o HTML Browser found.%sPlease define one in Help -> Configure Help -> Vi'+
+'ewers'
+
+
+# hash value = 216430206
+lclstrconsts.hhshelpnohtmlbrowserfound='Unable to find a HTML browser.'
+
+
+# hash value = 121161694
+lclstrconsts.hhshelpbrowsernotfound='Browser %s%s%s not found.'
+
+
+# hash value = 131439086
+lclstrconsts.hhshelpbrowsernotexecutable='Browser %s%s%s not executable.'
+
+
+# hash value = 162490947
+lclstrconsts.hhshelperrorwhileexecuting='Error while executing %s%s%s:%s%'+
+'s'
+

examples/germesorders/patches/memds2.pp

@@ -0,0 +1,960 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2007 by the Free Pascal development team
+    Some modifications (c) 2007 by Martin Schreiber
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+{$H+}
+{
+  TMemDataset : In-memory dataset.
+  - Has possibility to copy Structure/Data from other dataset.
+  - Can load/save to/from stream.
+  Ideas taken from THKMemTab Component by Harri Kasulke - Hamburg/Germany
+  E-mail: harri.kasulke@okay.net
+}
+
+unit memds2;
+
+interface
+
+uses
+ sysutils, classes, db, types;
+
+const
+  // Stream Markers.
+  MarkerSize  = SizeOf(Integer);
+
+  smEOF       = 0;
+  smFieldDefs = 1;
+  smData      = 2;
+
+type
+  MDSError=class(Exception);
+
+  PRecInfo=^TMTRecInfo;
+  TMTRecInfo=packed record
+    Bookmark: Longint;
+    BookmarkFlag: TBookmarkFlag;
+  end;
+
+  TMemDataset=class(TDataSet)
+  private
+    FOpenStream : TStream;
+    FFileName : String;
+    FFileModified : Boolean;
+    FStream: TMemoryStream;
+    FRecInfoOffset: integer;
+    FRecCount: integer;
+    FRecSize: integer;
+    FRecBufferSize: integer;
+    FCurrRecNo: integer;
+    FIsOpen: boolean;
+    FFilterBuffer: PChar;
+    ffieldoffsets: PInteger;
+    ffieldsizes: PInteger;
+    procedure calcrecordlayout;
+    function  MDSGetRecordOffset(ARecNo: integer): longint;
+    function  MDSGetFieldOffset(FieldNo: integer): integer;
+    function  MDSGetBufferSize(FieldNo: integer): integer;
+    function  MDSGetActiveBuffer(var Buffer: PChar): Boolean;
+    procedure MDSReadRecord(Buffer:PChar;ARecNo:Integer);
+    procedure MDSWriteRecord(Buffer:PChar;ARecNo:Integer);
+    procedure MDSAppendRecord(Buffer:PChar);
+    function  MDSFilterRecord(Buffer: PChar): Boolean;
+  protected
+    // Mandatory
+    function  AllocRecordBuffer: PChar; override;
+    procedure FreeRecordBuffer(var Buffer: PChar); override;
+    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
+    function  GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
+    function  GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
+    function  GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
+    function  GetRecordSize: Word; override;
+    procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean); override;
+    procedure InternalClose; override;
+    procedure InternalDelete; override;
+    procedure InternalFirst; override;
+    procedure InternalGotoBookmark(ABookmark: Pointer); override;
+    procedure InternalInitFieldDefs; override;
+    procedure InternalInitRecord(Buffer: PChar); override;
+    procedure InternalLast; override;
+    procedure InternalOpen; override;
+    procedure InternalPost; override;
+    procedure InternalSetToRecord(Buffer: PChar); override;
+    function  IsCursorOpen: Boolean; override;
+    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
+    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
+    procedure SetFieldData(Field: TField; Buffer: Pointer); override;
+
+    // Optional.
+    function GetRecordCount: Integer; override;
+    procedure SetRecNo(Value: Integer); override;
+    function GetRecNo: Integer; override;
+
+    // Own.
+    Procedure RaiseError(Fmt : String; Args : Array of const);
+    Procedure CheckMarker(F : TStream; Marker : Integer);
+    Procedure WriteMarker(F : TStream; Marker : Integer);
+    procedure ReadFieldDefsFromStream(F : TStream);
+    procedure SaveFieldDefsToStream(F : TStream);
+    // These should be overridden if you want to load more data.
+    // E.g. index defs.
+    Procedure LoadDataFromStream(F : TStream); virtual;
+    // If SaveData=False, a size 0 block should be written.
+    Procedure SaveDataToStream(F : TStream; SaveData : Boolean); virtual;
+
+
+  public
+    constructor Create(AOwner:tComponent); override;
+    destructor Destroy; override;
+    procedure CreateTable;
+
+    Function  DataSize : Integer;
+
+    procedure Clear(ClearDefs : Boolean);
+    procedure Clear;
+    Procedure SaveToFile(AFileName : String);
+    Procedure SaveToFile(AFileName : String; SaveData : Boolean);
+    Procedure SaveToStream(F : TStream);
+    Procedure SaveToStream(F : TStream; SaveData : Boolean);
+    Procedure LoadFromStream(F : TStream);
+    Procedure LoadFromFile(AFileName : String);
+    Procedure CopyFromDataset(DataSet : TDataSet);
+    Procedure CopyFromDataset(DataSet : TDataSet; CopyData : Boolean);
+
+    Property FileModified : Boolean Read FFileModified;
+
+  published
+    Property FileName : String Read FFileName Write FFileName;
+    property Filtered;
+    Property Active;
+    Property FieldDefs;
+    property BeforeOpen;
+    property AfterOpen;
+    property BeforeClose;
+    property AfterClose;
+    property BeforeInsert;
+    property AfterInsert;
+    property BeforeEdit;
+    property AfterEdit;
+    property BeforePost;
+    property AfterPost;
+    property BeforeCancel;
+    property AfterCancel;
+    property BeforeDelete;
+    property AfterDelete;
+    property BeforeScroll;
+    property AfterScroll;
+    property OnDeleteError;
+    property OnEditError;
+    property OnNewRecord;
+    property OnPostError;
+    property OnFilterRecord;
+  end;
+
+implementation
+
+ResourceString
+  SErrFieldTypeNotSupported = 'Fieldtype of Field "%s" not supported.';
+  SErrBookMarkNotFound      = 'Bookmark %d not found.';
+  SErrInvalidDataStream     = 'Error in data stream at position %d';
+  SErrInvalidMarkerAtPos    = 'Wrong data stream marker at position %d. Got %d, expected %d';
+  SErrNoFileName            = 'Filename must not be empty.';
+
+Const
+  SizeRecInfo = SizeOf(TMTRecInfo);
+
+procedure unsetfieldisnull(nullmask: pbyte; const x: integer);
+
+begin
+ inc(nullmask,(x shr 3));
+ nullmask^:= nullmask^ or (1 shl (x and 7));
+end;
+
+
+procedure setfieldisnull(nullmask: pbyte; const x: integer);
+
+begin
+ inc(nullmask,(x shr 3));
+ nullmask^:= nullmask^ and Not (1 shl (x and 7));
+end;
+
+
+function getfieldisnull(nullmask: pbyte; const x: integer): boolean;
+
+begin
+ inc(nullmask,(x shr 3));
+ result:= nullmask^ and (1 shl (x and 7)) = 0;
+end;
+
+
+{ ---------------------------------------------------------------------
+    Stream functions
+  ---------------------------------------------------------------------}
+
+Function ReadInteger(S : TStream) : Integer;
+
+begin
+  S.ReadBuffer(Result,SizeOf(Result));
+end;
+
+Function ReadString(S : TStream) : String;
+
+Var
+  L : Integer;
+
+begin
+  L:=ReadInteger(S);
+  Setlength(Result,L);
+  If (L<>0) then
+    S.ReadBuffer(Result[1],L);
+end;
+
+Procedure WriteInteger(S : TStream; Value : Integer);
+
+begin
+  S.WriteBuffer(Value,SizeOf(Value));
+end;
+
+Procedure WriteString(S : TStream; Value : String);
+
+Var
+  L : Integer;
+
+begin
+  L:=Length(Value);
+  WriteInteger(S,Length(Value));
+  If (L<>0) then
+    S.WriteBuffer(Value[1],L);
+end;
+
+{ ---------------------------------------------------------------------
+    TMemDataset
+  ---------------------------------------------------------------------}
+
+
+constructor TMemDataset.Create(AOwner:tComponent);
+
+begin
+  inherited create(aOwner);
+  FStream:=TMemoryStream.Create;
+  FRecCount:=0;
+  FRecSize:=0;
+  FRecBufferSize:=0;
+  FRecInfoOffset:=0;
+  FCurrRecNo:=-1;
+  FIsOpen:=False;
+end;
+
+Destructor TMemDataset.Destroy;
+begin
+  FStream.Free;
+  inherited Destroy;
+end;
+
+function TMemDataset.MDSGetRecordOffset(ARecNo: integer): longint;
+begin
+  Result:=FRecSize*ARecNo
+end;
+
+function TMemDataset.MDSGetFieldOffset(FieldNo: integer): integer;
+begin
+ result:= ffieldoffsets[fieldno-1];
+end;
+
+Procedure TMemDataset.RaiseError(Fmt : String; Args : Array of const);
+
+begin
+  Raise MDSError.CreateFmt(Fmt,Args);
+end;
+
+function TMemDataset.MDSGetBufferSize(FieldNo: integer): integer;
+var
+ dt1: tfieldtype;
+begin
+ dt1:= FieldDefs.Items[FieldNo-1].Datatype;
+ case dt1 of
+  ftString:   result:=FieldDefs.Items[FieldNo-1].Size+1;
+  ftBoolean:  result:=SizeOf(Wordbool);
+  ftFloat:    result:=SizeOf(Double);
+  ftLargeInt: result:=SizeOf(int64);
+  ftSmallInt: result:=SizeOf(SmallInt);
+  ftInteger:  result:=SizeOf(Integer);
+  ftDate:     result:=SizeOf(TDateTime);
+  ftTime:     result:=SizeOf(TDateTime);
+ else
+  RaiseError(SErrFieldTypeNotSupported,[FieldDefs.Items[FieldNo-1].Name]);
+ end;
+end;
+
+function TMemDataset.MDSGetActiveBuffer(var Buffer: PChar): Boolean;
+
+begin
+ case State of
+   dsBrowse:
+     if IsEmpty then
+       Buffer:=nil
+     else
+       Buffer:=ActiveBuffer;
+  dsEdit,
+  dsInsert:
+     Buffer:=ActiveBuffer;
+  dsFilter:
+     Buffer:=FFilterBuffer;
+ else
+   Buffer:=nil;
+ end;
+ Result:=(Buffer<>nil);
+end;
+
+procedure TMemDataset.MDSReadRecord(Buffer:PChar;ARecNo:Integer);   //Reads a Rec from Stream in Buffer
+begin
+  FStream.Position:=MDSGetRecordOffset(ARecNo);
+  FStream.ReadBuffer(Buffer^, FRecSize);
+end;
+
+procedure TMemDataset.MDSWriteRecord(Buffer:PChar;ARecNo:Integer);  //Writes a Rec from Buffer to Stream
+begin
+  FStream.Position:=MDSGetRecordOffset(ARecNo);
+  FStream.WriteBuffer(Buffer^, FRecSize);
+  FFileModified:=True;
+end;
+
+procedure TMemDataset.MDSAppendRecord(Buffer:PChar);   //Appends a Rec (from Buffer) to Stream
+begin
+  FStream.Position:=MDSGetRecordOffset(FRecCount);
+  FStream.WriteBuffer(Buffer^, FRecSize);
+  FFileModified:=True;
+end;
+
+//Abstract Overrides
+function TMemDataset.AllocRecordBuffer: PChar;
+begin
+  GetMem(Result,FRecBufferSize);
+end;
+
+procedure TMemDataset.FreeRecordBuffer (var Buffer: PChar);
+begin
+  FreeMem(Buffer);
+end;
+
+procedure TMemDataset.InternalInitRecord(Buffer: PChar);
+
+var
+  I : integer;
+
+begin
+ fillchar(buffer^,frecsize,0);
+end;
+
+procedure TMemDataset.InternalDelete;
+
+Var
+  TS : TMemoryStream;
+  OldPos,NewPos,CopySize1,CopySize2 : Cardinal;
+
+begin
+  if (FCurrRecNo<0) or (FCurrRecNo>=FRecCount) then
+    Exit;
+  // Very inefficient. We should simply move the last part closer to the beginning in
+  // The FStream.
+  TS:=TMemoryStream.Create;
+  Try
+    if FCurrRecNo>0 then
+      begin
+      FStream.Position:=MDSGetRecordOffset(0);      //Delete Rec
+      if FCurrRecNo<FRecCount-1 then
+        begin
+        TS.CopyFrom(FStream, MDSGetRecordOffset(FCurrRecNo)-MDSGetRecordOffset(0));
+        FStream.Position:=MDSGetRecordOffset(FCurrRecNo+1);
+        TS.CopyFrom(FStream,(MDSGetRecordOffset(FRecCount))-MDSGetRecordOffset(FCurrRecNo+1));
+        end
+      else
+        TS.CopyFrom(FStream,MDSGetRecordOffset(FRecCount-1));
+      end
+    else
+      begin                                  //Delete first Rec
+      FStream.Position:=MDSGetRecordOffset(FCurrRecNo+1);
+      TS.CopyFrom(FStream,(MDSGetRecordOffset(FRecCount))-MDSGetRecordOffset(FCurrRecNo+1));
+      end;
+    FStream.loadFromStream(TS);
+    Dec(FRecCount);
+    if FRecCount=0 then
+      FCurrRecNo:=-1
+    else
+      if FCurrRecNo>=FRecCount then FCurrRecNo:=FRecCount-1;
+  Finally
+    TS.Free;
+  end;
+  FFileModified:=True;
+end;
+
+procedure TMemDataset.InternalInitFieldDefs;
+
+begin
+  If (FOpenStream<>Nil) then
+    ReadFieldDefsFromStream(FOpenStream);
+end;
+
+Procedure TMemDataset.CheckMarker(F : TStream; Marker : Integer);
+
+Var
+  I,P : Integer;
+
+begin
+  P:=F.Position;
+  If F.Read(I,MarkerSize)<>MarkerSize then
+    RaiseError(SErrInvalidDataStream,[P])
+  else
+    if (I<>Marker) then
+      RaiseError(SErrInvalidMarkerAtPos,[P,I,Marker]);
+end;
+
+procedure TMemDataset.ReadFieldDefsFromStream(F : TStream);
+
+Var
+  I,ACount : Integer;
+  FN : String;
+  FS : Integer;
+  B : Boolean;
+  FT : TFieldType;
+
+begin
+  CheckMarker(F,smFieldDefs);
+  FieldDefs.Clear;
+  ACount:=ReadInteger(F);
+  For I:=1 to ACount do
+    begin
+    FN:=ReadString(F);
+    FS:=ReadInteger(F);
+    FT:=TFieldType(ReadInteger(F));
+    B:=ReadInteger(F)<>0;
+    TFieldDef.Create(FieldDefs,FN,ft,FS,B,I);
+    end;
+  CreateTable;
+end;
+
+procedure TMemDataset.InternalFirst;
+begin
+  FCurrRecNo:=-1;
+end;
+
+procedure TMemDataset.InternalLast;
+begin
+  FCurrRecNo:=FRecCount;
+end;
+
+procedure TMemDataset.InternalOpen;
+
+
+begin
+  If (FFileName<>'') then
+    FOpenStream:=TFileStream.Create(FFileName,fmOpenRead);
+  Try
+    InternalInitFieldDefs;
+    if DefaultFields then
+      CreateFields;
+    BindFields(True);
+    FCurrRecNo:=-1;
+    If (FOpenStream<>Nil) then
+      begin
+      LoadDataFromStream(FOpenStream);
+      CheckMarker(FOpenStream,smEOF);
+      end;
+  Finally
+    FreeAndNil(FOpenStream);
+  end;
+  FIsOpen:=True;
+end;
+
+Procedure TMemDataSet.LoadDataFromStream(F : TStream);
+
+Var
+  Size : Integer;
+
+begin
+  CheckMarker(F,smData);
+  Size:=ReadInteger(F);
+  FStream.Clear;
+  FStream.CopyFrom(F,Size);
+  FRecCount:=Size div FRecSize;
+  FCurrRecNo:=-1;
+end;
+
+Procedure TMemDataSet.LoadFromStream(F : TStream);
+
+begin
+  Close;
+  ReadFieldDefsFromStream(F);
+  LoadDataFromStream(F);
+  CheckMarker(F,smEOF);
+  FFileModified:=False;
+end;
+
+Procedure TMemDataSet.LoadFromFile(AFileName : String);
+
+Var
+  F : TFileStream;
+
+begin
+  F:=TFileStream.Create(AFileName,fmOpenRead);
+  Try
+    LoadFromStream(F);
+  Finally
+    F.Free;
+  end;
+end;
+
+
+Procedure TMemDataset.SaveToFile(AFileName : String);
+
+begin
+  SaveToFile(AFileName,True);
+end;
+
+Procedure TMemDataset.SaveToFile(AFileName : String; SaveData : Boolean);
+
+Var
+  F : TFileStream;
+
+begin
+  If (AFileName='') then
+    RaiseError(SErrNoFileName,[]);
+  F:=TFileStream.Create(AFileName,fmCreate);
+  try
+    SaveToStream(F,SaveData);
+  Finally
+    F.Free;
+  end;
+end;
+
+Procedure TMemDataset.WriteMarker(F : TStream; Marker : Integer);
+
+begin
+  Writeinteger(F,Marker);
+end;
+
+Procedure TMemDataset.SaveToStream(F : TStream);
+
+begin
+  SaveToStream(F,True);
+end;
+
+Procedure TMemDataset.SaveToStream(F : TStream; SaveData : Boolean);
+
+begin
+  SaveFieldDefsToStream(F);
+  If SaveData then
+    SaveDataToStream(F,SaveData);
+  WriteMarker(F,smEOF);
+end;
+
+Procedure TMemDataset.SaveFieldDefsToStream(F : TStream);
+
+Var
+  I,ACount : Integer;
+  FN : String;
+  FS : Integer;
+  B : Boolean;
+  FT : TFieldType;
+  FD : TFieldDef;
+
+begin
+  WriteMarker(F,smFieldDefs);
+  WriteInteger(F,FieldDefs.Count);
+  For I:=1 to FieldDefs.Count do
+    begin
+    FD:=FieldDefs[I-1];
+    WriteString(F,FD.Name);
+    WriteInteger(F,FD.Size);
+    WriteInteger(F,Ord(FD.DataType));
+    WriteInteger(F,Ord(FD.Required));
+    end;
+end;
+
+Procedure TMemDataset.SaveDataToStream(F : TStream; SaveData : Boolean);
+
+begin
+  if SaveData then
+    begin
+    WriteMarker(F,smData);
+    WriteInteger(F,FStream.Size);
+    FStream.Position:=0;
+    F.CopyFrom(FStream,FStream.Size);
+    FFileModified:=False;
+    end
+  else
+    begin
+    WriteMarker(F,smData);
+    WriteInteger(F,0);
+    end;
+end;
+
+procedure TMemDataset.InternalClose;
+
+begin
+ if (FFileModified) and (FFileName<>'') then begin
+  SaveToFile(FFileName,True);
+ end;
+ FIsOpen:=False;
+ FFileModified:=False;
+ // BindFields(False);
+ if DefaultFields then begin
+  DestroyFields;
+ end;
+ FreeMem(FFieldOffsets);
+ FreeMem(FFieldSizes);
+end;
+
+procedure TMemDataset.InternalPost;
+begin
+  CheckActive;
+  if ((State<>dsEdit) and (State<>dsInsert)) then
+    Exit;
+  if (State=dsEdit) then
+    MDSWriteRecord(ActiveBuffer, FCurrRecNo)
+  else
+    InternalAddRecord(ActiveBuffer,True);
+end;
+
+function TMemDataset.IsCursorOpen: Boolean;
+
+begin
+  Result:=FIsOpen;
+end;
+
+function TMemDataset.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
+
+var
+  Accepted: Boolean;
+
+begin
+  Result:=grOk;
+  Accepted:=False;
+  if (FRecCount<1) then
+    begin
+    Result:=grEOF;
+    exit;
+    end;
+  repeat
+    case GetMode of
+      gmCurrent:
+        if (FCurrRecNo>=FRecCount) or (FCurrRecNo<0) then
+          Result:=grError;
+      gmNext:
+        if (FCurrRecNo<FRecCount-1) then
+          Inc(FCurrRecNo)
+        else
+          Result:=grEOF;
+      gmPrior:
+        if (FCurrRecNo>0) then
+          Dec(FCurrRecNo)
+        else
+          result:=grBOF;
+    end;
+    if result=grOK then
+      begin
+      MDSReadRecord(Buffer, FCurrRecNo);
+      PRecInfo(Buffer+FRecInfoOffset)^.Bookmark:=FCurrRecNo;
+      PRecInfo(Buffer+FRecInfoOffset)^.BookmarkFlag:=bfCurrent;
+      if (Filtered) then
+        Accepted:=MDSFilterRecord(Buffer) //Filtering
+      else
+        Accepted:=True;
+      if (GetMode=gmCurrent) and not Accepted then
+        result:=grError;
+      end;
+  until (result<>grOK) or Accepted;
+end;
+
+function TMemDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
+var
+ SrcBuffer: PChar;
+ I: integer;
+begin
+ I:= Field.FieldNo - 1;
+ result:= (I >= 0) and MDSGetActiveBuffer(SrcBuffer) and 
+          not getfieldisnull(pointer(srcbuffer),I);
+ if result and (buffer <> nil) then 
+   begin
+   Move((SrcBuffer+ffieldoffsets[I])^, Buffer^,FFieldSizes[I]);
+   end;
+end;
+
+procedure TMemDataset.SetFieldData(Field: TField; Buffer: Pointer);
+var
+ DestBuffer: PChar;
+ I,J: integer;
+
+begin
+ I:= Field.FieldNo - 1;
+ if (I >= 0) and  MDSGetActiveBuffer(DestBuffer) then 
+   begin
+   if buffer = nil then 
+     setfieldisnull(pointer(destbuffer),I)
+   else 
+     begin 
+     unsetfieldisnull(pointer(destbuffer),I);
+     J:=FFieldSizes[I];
+     if Field.DataType=ftString then
+       Dec(J); // Do not move terminating 0, which is in the size.
+     Move(Buffer^,(DestBuffer+FFieldOffsets[I])^,J);
+     dataevent(defieldchange,ptrint(field));
+     end;
+   end;
+end;
+
+function TMemDataset.GetRecordSize: Word;
+
+begin
+ Result:= FRecSize;
+end;
+
+procedure TMemDataset.InternalGotoBookmark(ABookmark: Pointer);
+
+var
+  ReqBookmark: integer;
+
+begin
+  ReqBookmark:=PInteger(ABookmark)^;
+  if (ReqBookmark>=0) and (ReqBookmark<FRecCount) then
+    FCurrRecNo:=ReqBookmark
+  else
+    RaiseError(SErrBookMarkNotFound,[ReqBookmark]);
+end;
+
+procedure TMemDataset.InternalSetToRecord(Buffer: PChar);
+
+var
+  ReqBookmark: integer;
+
+begin
+  ReqBookmark:=PRecInfo(Buffer+FRecInfoOffset)^.Bookmark;
+  InternalGotoBookmark (@ReqBookmark);
+end;
+
+function TMemDataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
+
+begin
+  Result:=PRecInfo(Buffer+FRecInfoOffset)^.BookmarkFlag;
+end;
+
+procedure TMemDataset.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
+
+begin
+  PRecInfo(Buffer+FRecInfoOffset)^.BookmarkFlag := Value;
+end;
+
+procedure TMemDataset.GetBookmarkData(Buffer: PChar; Data: Pointer);
+
+begin
+  if Data<>nil then
+    PInteger(Data)^:=PRecInfo(Buffer+FRecInfoOffset)^.Bookmark;
+end;
+
+procedure TMemDataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
+
+begin
+  if Data<>nil then
+    PRecInfo(Buffer+FRecInfoOffset)^.Bookmark:=PInteger(Data)^
+  else
+    PRecInfo(Buffer+FRecInfoOffset)^.Bookmark:=0;
+end;
+
+function TMemDataset.MDSFilterRecord(Buffer: PChar): Boolean;
+
+var
+  SaveState: TDatasetState;
+
+begin
+  Result:=True;
+  if not Assigned(OnFilterRecord) then
+    Exit;
+  SaveState:=SetTempState(dsFilter);
+  Try
+    FFilterBuffer:=Buffer;
+    OnFilterRecord(Self,Result);
+  Finally  
+    RestoreState(SaveState);
+  end;  
+end;
+
+Function TMemDataset.DataSize : Integer;
+
+begin
+  Result:=FStream.Size;
+end;
+
+procedure TMemDataset.Clear;
+
+begin
+  Clear(True);
+end;
+
+procedure TMemDataset.Clear(ClearDefs : Boolean);
+
+begin
+  FStream.Clear;
+  FRecCount:=0;
+  FCurrRecNo:=-1;
+  if Active then
+    Resync([]);
+  If ClearDefs then
+    begin
+    Close;
+    FieldDefs.Clear;
+    end;
+end;
+
+procedure tmemdataset.calcrecordlayout;
+var
+  i,count : integer;
+begin
+ Count := fielddefs.count;
+ FFieldOffsets:=getmem(Count*sizeof(integer));
+ FFieldSizes:=getmem(Count*sizeof(integer));
+ FRecSize:= (Count+7) div 8; //null mask
+ for i:= 0 to Count-1 do 
+   begin
+   ffieldoffsets[i] := frecsize;
+   ffieldsizes[i] := MDSGetbufferSize(i+1);
+   FRecSize:= FRecSize+FFieldSizes[i];
+   end;
+end;
+
+procedure TMemDataset.CreateTable;
+
+begin
+  FStream.Clear;
+  FRecCount:=0;
+  FCurrRecNo:=-1;
+  FIsOpen:=False;
+  calcrecordlayout;
+  FRecInfoOffset:=FRecSize;
+  FRecSize:=FRecSize+SizeRecInfo;
+  FRecBufferSize:=FRecSize;
+end;
+
+procedure TMemDataset.InternalAddRecord(Buffer: Pointer; DoAppend: Boolean);
+
+begin
+  MDSAppendRecord(ActiveBuffer);
+  InternalLast;
+  Inc(FRecCount);
+end;
+
+procedure TMemDataset.SetRecNo(Value: Integer);
+begin
+  CheckBrowseMode;
+  if (Value>=1) and (Value<=FRecCount) then
+    begin
+    FCurrRecNo:=Value-1;
+    Resync([]);
+    end;
+end;
+
+Function TMemDataset.GetRecNo: Longint;
+
+begin
+  UpdateCursorPos;
+  if (FCurrRecNo<0) then
+    Result:=1
+  else
+    Result:=FCurrRecNo+1;
+end;
+
+Function TMemDataset.GetRecordCount: Longint;
+
+begin
+  CheckActive;
+  Result:=FRecCount;
+end;
+
+Procedure TMemDataset.CopyFromDataset(DataSet : TDataSet);
+
+begin
+  CopyFromDataset(Dataset,True);
+end;
+
+Procedure TMemDataset.CopyFromDataset(DataSet : TDataSet; CopyData : Boolean);
+
+Var
+  I  : Integer;
+  F,F1,F2 : TField;
+  L1,L2  : TList;
+  N : String;
+
+begin
+  Clear(True);
+  // NOT from fielddefs. The data may not be available in buffers !!
+  For I:=0 to Dataset.FieldCount-1 do
+    begin
+    F:=Dataset.Fields[I];
+    TFieldDef.Create(FieldDefs,F.FieldName,F.DataType,F.Size,F.Required,F.FieldNo);
+    end;
+  CreateTable;
+  If CopyData then
+    begin
+    Open;
+    L1:=TList.Create;
+    Try
+      L2:=TList.Create;
+      Try
+        For I:=0 to FieldDefs.Count-1 do
+          begin
+          N:=FieldDefs[I].Name;
+          F1:=FieldByName(N);
+          F2:=DataSet.FieldByName(N);
+          L1.Add(F1);
+          L2.Add(F2);
+          end;
+        Dataset.DisableControls;
+        Try
+          Dataset.Open;
+          While not Dataset.EOF do
+            begin
+            Append;
+            For I:=0 to L1.Count-1 do
+              begin
+              F1:=TField(L1[i]);
+              F2:=TField(L2[I]);
+              Case F1.DataType of
+                ftString   : F1.AsString:=F2.AsString;
+                ftBoolean  : F1.AsBoolean:=F2.AsBoolean;
+                ftFloat    : F1.AsFloat:=F2.AsFloat;
+                ftLargeInt : F1.AsInteger:=F2.AsInteger;
+                ftSmallInt : F1.AsInteger:=F2.AsInteger;
+                ftInteger  : F1.AsInteger:=F2.AsInteger;
+                ftDate     : F1.AsDateTime:=F2.AsDateTime;
+                ftTime     : F1.AsDateTime:=F2.AsDateTime;
+              end;
+              end;
+            Try
+              Post;
+            except
+              Cancel;
+              Raise;
+            end;
+            Dataset.Next;
+            end;
+        Finally
+          Dataset.EnableControls;
+        end;
+      finally
+        L2.Free;
+      end;
+    finally
+      l1.Free;
+    end;
+    end;
+end;
+
+end.

examples/germesorders/patches/sqlite3ds.pas

@@ -0,0 +1,365 @@
+unit sqlite3ds;
+
+{
+  This is TSqlite3Dataset, a TDataset descendant class for use with fpc compiler
+  Copyright (C) 2004  Luiz Am�rico Pereira C�mara
+  Email: pascalive@bol.com.br
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+{$mode objfpc}
+{$H+}
+{ $Define DEBUG}
+
+interface
+
+uses
+  Classes, SysUtils, customsqliteds;
+
+type
+  { TSqlite3Dataset }
+
+  TSqlite3Dataset = class (TCustomSqliteDataset)
+  private
+    function SqliteExec(ASql:PChar; ACallback: TSqliteCdeclCallback; Data: Pointer):Integer;override;
+    function InternalGetHandle: Pointer; override;
+    function GetSqliteVersion: String; override;
+    procedure InternalCloseHandle;override;
+    procedure BuildLinkedList; override;
+  protected
+    procedure InternalInitFieldDefs; override;
+    function GetRowsAffected:Integer; override;
+  public
+    procedure ExecuteDirect(const ASql: String);override;
+    function ReturnString: String; override;
+    function QuickQuery(const ASql:String;const AStrList: TStrings;FillObjects:Boolean):String;override;
+  end;
+
+implementation
+
+uses
+  sqlite3,db;
+  
+function SqliteCode2Str(Code: Integer): String;
+begin
+  case Code of
+    SQLITE_OK           : Result := 'SQLITE_OK';
+    SQLITE_ERROR        : Result := 'SQLITE_ERROR';
+    SQLITE_INTERNAL     : Result := 'SQLITE_INTERNAL';
+    SQLITE_PERM         : Result := 'SQLITE_PERM';
+    SQLITE_ABORT        : Result := 'SQLITE_ABORT';
+    SQLITE_BUSY         : Result := 'SQLITE_BUSY';
+    SQLITE_LOCKED       : Result := 'SQLITE_LOCKED';
+    SQLITE_NOMEM        : Result := 'SQLITE_NOMEM';
+    SQLITE_READONLY     : Result := 'SQLITE_READONLY';
+    SQLITE_INTERRUPT    : Result := 'SQLITE_INTERRUPT';
+    SQLITE_IOERR        : Result := 'SQLITE_IOERR';
+    SQLITE_CORRUPT      : Result := 'SQLITE_CORRUPT';
+    SQLITE_NOTFOUND     : Result := 'SQLITE_NOTFOUND';
+    SQLITE_FULL         : Result := 'SQLITE_FULL';
+    SQLITE_CANTOPEN     : Result := 'SQLITE_CANTOPEN';
+    SQLITE_PROTOCOL     : Result := 'SQLITE_PROTOCOL';
+    SQLITE_EMPTY        : Result := 'SQLITE_EMPTY';
+    SQLITE_SCHEMA       : Result := 'SQLITE_SCHEMA';
+    SQLITE_TOOBIG       : Result := 'SQLITE_TOOBIG';
+    SQLITE_CONSTRAINT   : Result := 'SQLITE_CONSTRAINT';
+    SQLITE_MISMATCH     : Result := 'SQLITE_MISMATCH';
+    SQLITE_MISUSE       : Result := 'SQLITE_MISUSE';
+    SQLITE_NOLFS        : Result := 'SQLITE_NOLFS';
+    SQLITE_AUTH         : Result := 'SQLITE_AUTH';
+    SQLITE_FORMAT       : Result := 'SQLITE_FORMAT';
+    SQLITE_RANGE        : Result := 'SQLITE_RANGE';
+    SQLITE_ROW          : Result := 'SQLITE_ROW';
+    SQLITE_NOTADB       : Result := 'SQLITE_NOTADB';
+    SQLITE_DONE         : Result := 'SQLITE_DONE';
+  else
+    Result:='Unknown Return Value';
+  end;
+end;
+
+function GetAutoIncValue(NextValue: Pointer; Columns: Integer; ColumnValues: PPChar; ColumnNames: PPChar): integer; cdecl;
+var
+  CodeError, TempInt: Integer;
+begin
+  TempInt := -1;
+  if ColumnValues[0] <> nil then
+  begin
+    Val(String(ColumnValues[0]), TempInt, CodeError);
+    if CodeError <> 0 then
+      DatabaseError('TSqlite3Dataset: Error trying to get last autoinc value');
+  end;
+  Integer(NextValue^) := Succ(TempInt);
+  Result := 1;
+end;
+
+{ TSqlite3Dataset }
+
+function TSqlite3Dataset.SqliteExec(ASql: PChar; ACallback: TSqliteCdeclCallback; Data: Pointer): Integer;
+begin
+  Result:=sqlite3_exec(FSqliteHandle, ASql, ACallback, Data, nil);
+end;
+
+procedure TSqlite3Dataset.InternalCloseHandle;
+begin
+  sqlite3_close(FSqliteHandle);
+  FSqliteHandle:=nil;
+  //todo:handle return data
+end;
+
+
+function TSqlite3Dataset.InternalGetHandle: Pointer;
+const
+  CheckFileSql = 'Select Name from sqlite_master LIMIT 1';
+var
+  vm: Pointer;
+  ErrorStr: String;
+begin
+  sqlite3_open(PChar(FFileName), @Result);
+  //sqlite3_open returns SQLITE_OK even for invalid files
+  //do additional check here
+  FReturnCode := sqlite3_prepare(Result, CheckFileSql, -1, @vm, nil);
+  if FReturnCode <> SQLITE_OK then
+  begin
+    ErrorStr := SqliteCode2Str(FReturnCode) + ' - ' + sqlite3_errmsg(Result);;
+    sqlite3_close(Result);
+    DatabaseError(ErrorStr, Self);
+  end;
+  sqlite3_finalize(vm);
+end;
+
+procedure TSqlite3Dataset.InternalInitFieldDefs;
+var
+  vm:Pointer;
+  ColumnStr:String;
+  i,ColumnCount:Integer;
+  AType:TFieldType;
+begin
+  {$ifdef DEBUG}
+  WriteLn('##TSqlite3Dataset.InternalInitFieldDefs##');
+  {$endif}
+  FAutoIncFieldNo:=-1;
+  FieldDefs.Clear;
+  FReturnCode := sqlite3_prepare(FSqliteHandle, PChar(FSql), -1, @vm, nil);
+  if FReturnCode <> SQLITE_OK then
+    DatabaseError(ReturnString, Self);
+  sqlite3_step(vm);
+  ColumnCount:=sqlite3_column_count(vm);
+  //Set BufferSize
+  FRowBufferSize:=(SizeOf(PPChar)*ColumnCount);
+  //Prepare the array of pchar2sql functions
+  SetLength(FGetSqlStr,ColumnCount);
+  for i := 0 to ColumnCount - 1 do
+  begin
+   ColumnStr := UpperCase(String(sqlite3_column_decltype(vm,i)));
+   if (ColumnStr = 'INTEGER') or (ColumnStr = 'INT') then
+   begin
+     if AutoIncrementKey and (UpperCase(String(sqlite3_column_name(vm,i))) = UpperCase(PrimaryKey)) then
+     begin
+       AType := ftAutoInc;
+       FAutoIncFieldNo := i;
+     end
+     else
+       AType := ftInteger;     
+   end else if Pos('VARCHAR',ColumnStr) = 1 then
+   begin
+     AType := ftString;
+   end else if Pos('BOOL',ColumnStr) = 1 then
+   begin
+     AType := ftBoolean;
+   end else if Pos('AUTOINC',ColumnStr) = 1 then
+   begin
+     AType := ftAutoInc;
+     if FAutoIncFieldNo = -1 then
+       FAutoIncFieldNo := i;
+   end else if (Pos('FLOAT',ColumnStr)=1) or (Pos('NUMERIC',ColumnStr)=1) then
+   begin
+     AType := ftFloat;
+   end else if (ColumnStr = 'DATETIME') then
+   begin
+     AType := ftDateTime;
+   end else if (ColumnStr = 'DATE') then
+   begin
+     AType := ftDate;
+   end else if (ColumnStr = 'LARGEINT') then
+   begin
+     AType := ftLargeInt;
+   end else if (ColumnStr = 'TIME') then
+   begin
+     AType := ftTime;
+   end else if (ColumnStr = 'TEXT') then
+   begin
+     AType := ftMemo;
+   end else if (ColumnStr = 'CURRENCY') then
+   begin
+     AType := ftCurrency;
+   end else if (ColumnStr = 'WORD') then
+   begin
+     AType := ftWord;
+   end else
+   begin
+     AType := ftString;
+   end;
+   if AType = ftString then
+     FieldDefs.Add(String(sqlite3_column_name(vm,i)), AType, dsMaxStringSize)
+   else
+     FieldDefs.Add(String(sqlite3_column_name(vm,i)), AType);  
+   //Set the pchar2sql function
+   if AType in [ftString,ftMemo] then
+     FGetSqlStr[i]:=@Char2SqlStr
+   else
+     FGetSqlStr[i]:=@Num2SqlStr;
+   {$ifdef DEBUG}
+   writeln('  Field[',i,'] Name: ',sqlite3_column_name(vm,i));
+   writeln('  Field[',i,'] Type: ',sqlite3_column_decltype(vm,i));
+   {$endif}
+  end;
+  sqlite3_finalize(vm);
+  {$ifdef DEBUG}
+  writeln('  FieldDefs.Count: ',FieldDefs.Count);
+  {$endif}
+end;
+
+function TSqlite3Dataset.GetRowsAffected: Integer;
+begin
+  Result:=sqlite3_changes(FSqliteHandle);
+end;
+
+procedure TSqlite3Dataset.ExecuteDirect(const ASql: String);
+var
+  vm:Pointer;
+begin
+  FReturnCode:=sqlite3_prepare(FSqliteHandle,Pchar(ASql),-1,@vm,nil);
+  if FReturnCode <> SQLITE_OK then
+    DatabaseError(ReturnString,Self);
+  FReturnCode:=sqlite3_step(vm);
+  sqlite3_finalize(vm);
+end;
+
+procedure TSqlite3Dataset.BuildLinkedList;
+var
+  TempItem:PDataRecord;
+  vm:Pointer;
+  Counter:Integer;
+begin
+  //Get AutoInc Field initial value
+  if FAutoIncFieldNo <> -1 then
+    sqlite3_exec(FSqliteHandle,PChar('Select Max('+Fields[FAutoIncFieldNo].FieldName+') from ' + FTableName),
+      @GetAutoIncValue,@FNextAutoInc,nil);
+
+  FReturnCode:=sqlite3_prepare(FSqliteHandle,Pchar(FSql),-1,@vm,nil);
+  if FReturnCode <> SQLITE_OK then
+    DatabaseError(ReturnString,Self);
+
+  FDataAllocated:=True;
+
+  TempItem:=FBeginItem;
+  FRecordCount:=0;
+  FRowCount:=sqlite3_column_count(vm);
+  FReturnCode:=sqlite3_step(vm);
+  while FReturnCode = SQLITE_ROW do
+  begin
+    Inc(FRecordCount);
+    New(TempItem^.Next);
+    TempItem^.Next^.Previous:=TempItem;
+    TempItem:=TempItem^.Next;
+    GetMem(TempItem^.Row,FRowBufferSize);
+    for Counter := 0 to FRowCount - 1 do
+      TempItem^.Row[Counter]:=StrNew(sqlite3_column_text(vm,Counter));
+    FReturnCode:=sqlite3_step(vm);
+  end;
+  sqlite3_finalize(vm);
+
+  // Attach EndItem
+  TempItem^.Next:=FEndItem;
+  FEndItem^.Previous:=TempItem;
+
+  // Alloc temporary item used in append/insert
+  GetMem(FCacheItem^.Row,FRowBufferSize);
+  for Counter := 0 to FRowCount - 1 do
+    FCacheItem^.Row[Counter]:=nil;
+  // Fill FBeginItem.Row with nil -> necessary for avoid exceptions in empty datasets
+  GetMem(FBeginItem^.Row,FRowBufferSize);
+  //Todo: see if is better to nullif using FillDWord
+  for Counter := 0 to FRowCount - 1 do
+    FBeginItem^.Row[Counter]:=nil;
+end;
+
+function TSqlite3Dataset.ReturnString: String;
+begin
+  Result := SqliteCode2Str(FReturnCode) + ' - ' + sqlite3_errmsg(FSqliteHandle);
+end;
+
+function TSqlite3Dataset.GetSqliteVersion: String;
+begin
+  Result := String(sqlite3_version());
+end;
+
+function TSqlite3Dataset.QuickQuery(const ASql:String;const AStrList: TStrings;FillObjects:Boolean):String;
+var
+  vm:Pointer;
+    
+  procedure FillStrings;
+  begin
+    while FReturnCode = SQLITE_ROW do
+    begin
+      AStrList.Add(String(sqlite3_column_text(vm,0)));
+      FReturnCode := sqlite3_step(vm);
+    end;
+  end;
+  procedure FillStringsAndObjects;
+  begin
+    while FReturnCode = SQLITE_ROW do
+    begin
+      AStrList.AddObject(String(sqlite3_column_text(vm,0)), TObject(PtrInt(sqlite3_column_int(vm,1))));
+      FReturnCode := sqlite3_step(vm);
+    end;
+  end;    
+begin
+  if FSqliteHandle = nil then
+    GetSqliteHandle;
+  Result := '';
+  FReturnCode := sqlite3_prepare(FSqliteHandle,Pchar(ASql), -1, @vm, nil);
+  if FReturnCode <> SQLITE_OK then
+    DatabaseError(ReturnString,Self);
+    
+  FReturnCode := sqlite3_step(vm);
+  if (FReturnCode = SQLITE_ROW) and (sqlite3_column_count(vm) > 0) then
+  begin
+    Result := String(sqlite3_column_text(vm,0));
+    if AStrList <> nil then
+    begin   
+      if FillObjects and (sqlite3_column_count(vm) > 1) then
+        FillStringsAndObjects
+      else
+        FillStrings;
+    end;          
+  end;  
+  sqlite3_finalize(vm); 
+end;
+
+end.
+

examples/germesorders/scripts/ppc-build

@@ -0,0 +1,61 @@
+#!/bin/bash
+
+#RELEASE
+#fpc -CX -B -Xs -XX -S2cgi -OG1 -TWinCE -Parm -WG -WN -vewnhi -l -Fu/home/denis/projects/lazarus/components/rxfpc/lib/arm-wince/ -Fu/home/denis/.lazarus/lib/rx/arm-wince/ -Fu/usr/local/share/lazarus/ideintf/units/arm-wince/ -Fu/usr/local/share/lazarus/lcl/units/arm-wince/ -Fu/usr/local/share/lazarus/lcl/units/arm-wince/wince -Fu/usr/local/share/lazarus/lcl/units/arm-wince/gtk2/ -Fu/usr/local/share/lazarus/packager/units/arm-wince/ -Fu/home/denis/projects/lazarus/GermesOrders/ -Fu. -o/home/denis/projects/lazarus/GermesOrders/germesorders.exe -dLCL -dLCLwince germesorders.lpr
+
+#DEBUG
+#fpc -CX -B -g -XX -TWinCE -Parm -WG -WN -vewnhi -l -Fu/home/denis/projects/lazarus/components/rxfpc/lib/arm-wince/ -Fu/home/denis/.lazarus/lib/rx/arm-wince/ -Fu/usr/local/share/lazarus/ideintf/units/arm-wince/ -Fu/usr/local/share/lazarus/lcl/units/arm-wince/ -Fu/usr/local/share/lazarus/lcl/units/arm-wince/wince -Fu/usr/local/share/lazarus/lcl/units/arm-wince/gtk2/ -Fu/usr/local/share/lazarus/packager/units/arm-wince/ -Fu/home/denis/projects/lazarus/GermesOrders/ -Fu. -o/home/denis/projects/lazarus/GermesOrders/germesorders.exe -dLCL -dLCLwince germesorders.lpr
+#fpc -CX -B -g -XX -TWinCE -Parm -WG -WR -vewnhi -l -Fu/home/denis/projects/lazarus/components/rxfpc/lib/arm-wince/ -Fu/home/denis/.lazarus/lib/rx/arm-wince/ -Fu/usr/local/share/lazarus/ideintf/units/arm-wince/ -Fu/usr/local/share/lazarus/lcl/units/arm-wince/ -Fu/usr/local/share/lazarus/lcl/units/arm-wince/wince -Fu/usr/local/share/lazarus/lcl/units/arm-wince/gtk2/ -Fu/usr/local/share/lazarus/packager/units/arm-wince/ -Fu/home/denis/projects/lazarus/GermesOrders/ -Fu/home/denis/projects/lazarus/components/rxfpc -Fu/usr/local/share/lazarus/components/rx -Fu. -o/home/denis/projects/lazarus/GermesOrders/germesorders.exe -FU./units -dLCL -dLCLwince germesorders.lpr
+
+#fpc -CX -B -XX -gl -TWinCE -Parm -WG -WN -Os -Ur -vewnhi -l -Fu/usr/local/share/lazarus/ideintf/units/arm-wince/ -Fu/usr/local/share/lazarus/lcl/units/arm-wince/ -Fu/usr/local/share/lazarus/lcl/units/arm-wince/wince -Fu/usr/local/share/lazarus/packager/units/arm-wince/ -Fu/home/denis/projects/lazarus/GermesOrders/ -Fu/home/denis/projects/lazarus/components/rxfpc -Fu/usr/local/share/lazarus/components/rx -Fu. -o/home/denis/projects/lazarus/GermesOrders/germesorders.exe -FU./units -dLCL -dLCLwince germesorders.lpr
+#fpc -CX -B -XX -g -gl -TWinCE -Parm -WG -WN -vewnhi -l -Fu. -Fu/usr/local/share/lazarus/ideintf/units/arm-wince/ -Fu/usr/local/share/lazarus/lcl/units/arm-wince/ -Fu/usr/local/share/lazarus/lcl/units/arm-wince/wince -Fu/usr/local/share/lazarus/packager/units/arm-wince/ -Fu/home/denis/projects/lazarus/GermesOrders/ -Fu/home/denis/projects/lazarus/components/rxfpc -Fu/usr/local/share/lazarus/components/rx  -o/home/denis/projects/lazarus/GermesOrders/germesorders.exe -FU./units/arm-wince -dLCL -dLCLwince germesorders.lpr
+
+date +\'%d-%m-%Y\' > build-date 
+
+PROJECT_PATH=$('pwd')
+LAZARUS_PATH=/usr/local/share/lazarus
+
+COMPONENTS_ROOT=~/projects/lazarus/lazarus-components/trunk
+COMPONENTS_PATH="$COMPONENTS_ROOT/rxfpc;$COMPONENTS_ROOT/foreign"
+COMPONENTS_DEBUG_PATH="$COMPONENTS_ROOT/foreign"
+
+UNITS_OUTPUT=./units/arm-wince
+
+PRECOMPILED_COMPONENTS="-Fu$LAZARUS_PATH/ideintf/units/arm-wince/ \
+                       -Fu$LAZARUS_PATH/lcl/units/arm-wince/ \
+                       -Fu$LAZARUS_PATH/lcl/units/arm-wince/wince \
+                       -Fu$LAZARUS_PATH/packager/units/arm-wince/"
+
+#echo $PRECOMPILED_COMPONENTS
+#echo $PROJECT_PATH
+
+#Rx No debug info
+fpc -CX -B -XX -TWinCE -Parm -WG -WN -vewnhi -l \
+  -Fu. \
+  $PRECOMPILED_COMPONENTS \
+  -Fu$COMPONENTS_PATH \
+  -Fu$LAZARUS_PATH/components/rx \
+  -FU$UNITS_OUTPUT \
+  -dLCL -dLCLwince $COMPONENTS_ROOT/rxfpc/rxnew.pas 
+  
+fpc -CX -B -XX -TWinCE -Parm -WG -WN -vewnhi -l \
+  -Fu. \
+  $PRECOMPILED_COMPONENTS \
+  -Fu$COMPONENTS_PATH \
+  -Fu$LAZARUS_PATH/components/rx \
+  -FU$UNITS_OUTPUT \
+  -dLCL -dLCLwince $LAZARUS_PATH/components/rx/rx.pas
+
+#Main Germes Orders Debug Info on 
+fpc -CX -B -XX -gl -TWinCE -Parm -WG -WN -vewnhi -l \
+  -Fu. \
+  $PRECOMPILED_COMPONENTS \
+  -Fu$COMPONENTS_DEBUG_PATH \
+  -Fu$PROJECT_PATH \
+  -Fu$UNITS_OUTPUT \
+  -o$PROJECT_PATH/germesorders.exe \
+  -FU$UNITS_OUTPUT \
+  -dLCL -dLCLwince germesorders.lpr
+
+#arm-wince-strip --only-keep-debug germesorders.exe
+#arm-wince-strip germesorders.exe

examples/germesorders/scripts/ppc-receive-log

@@ -0,0 +1,3 @@
+#!/bin/bash
+
+pcp ":/My Documents/GermesOrders/debug.log"

examples/germesorders/scripts/ppc-send

@@ -0,0 +1,14 @@
+#!/bin/bash
+
+EXE=germesorders.exe
+
+#pmkdir ":/My Documents/GermesOrders"
+./ppc-build
+
+#arm-wince-strip --only-keep-debug $EXE
+#arm-wince-strip $EXE
+prm ":/My Documents/GermesOrders/$EXE"
+pcp $EXE ":/My Documents/GermesOrders/$EXE"
+
+#prm ":/My Documents/GermesOrders/germesorders.dbg"
+#pcp germesorders.dbg ":/My Documents/GermesOrders/germesorders.dbg"

examples/germesorders/scripts/ppc-send-database

@@ -0,0 +1,6 @@
+#!/bin/bash
+
+BASE=base/germesorders.db3
+
+prm ":/My Documents/GermesOrders/$BASE"
+pcp $BASE ":/My Documents/GermesOrders/$BASE"

examples/germesorders/ubase.pas

@@ -0,0 +1,211 @@
+unit uBase;
+
+{$mode objfpc}{$H+}
+
+interface
+uses Classes, sqlite3ds, variants, Db;
+
+type
+
+  { TDatabaseConnect }
+
+  TStringsFillEvent = procedure (D:TDataset) of object;
+
+  TDatabaseConnect = class(TComponent)
+    private
+      BaseFileName:string;
+      function GetOption(const OptId: string): string;
+      procedure SetOption(const OptId: string; const AValue: string);
+    public
+      constructor Create;reintroduce;
+      destructor Destroy;override;
+      
+      procedure ConnectToBase(D:TSqlite3Dataset);
+      
+      function DatasetCreate(const SQL:string; OpenDataset:boolean=true):TSqlite3Dataset;overload;
+      function DatasetCreate(const Table, PKField:string;  OpenDataset:boolean=true):TSqlite3Dataset;overload;
+
+      //заполнение списка по шаблону
+      //имена полей задаются через %FIELDNAME%
+      //пока что поле может входить в шаблое только один раз
+      procedure StringsFill(const SQL:string; const Template:string; List:TStrings; OnFill:TStringsFillEvent = nil; ClearList:boolean=true);
+
+      function DLookup(const SQL, Column:string):Variant;overload;
+      function DLookup(const SQL:string; Params:array of const; const Column:string):Variant;overload;
+      procedure SQLExec(const S:String);overload;
+      procedure SQLExec(const S:String; Args:array of const);overload;
+      
+      property OptionUser[const OptId:string]:string read GetOption write SetOption;
+  end;
+  
+  function BaseConnect:TDatabaseConnect;
+
+implementation
+uses SysUtils, uConfig, uDebug;
+
+var BaseObj:TDatabaseConnect=nil;
+function BaseConnect:TDatabaseConnect;
+begin
+  if BaseObj = nil then
+    begin
+      BaseObj:=TDatabaseConnect.Create;
+    end;
+  Result:=BaseObj;
+end;
+
+{ TDatabaseConnect }
+
+function TDatabaseConnect.GetOption(const OptId: string): string;
+begin
+  Result:=VarToStr(DLookup(Format('select OptValue from Options where Name=''%s''', [OptId]), 'OptValue'));
+end;
+
+procedure TDatabaseConnect.SetOption(const OptId: string; const AValue: string);
+begin
+  SQLExec('DELETE FROM Options WHERE Name=''%s''',[OptId]);
+  SQLExec('INSERT INTO Options (Name, OptValue) VALUES(''%s'', ''%s'')', [OptId, AValue]);
+end;
+
+constructor TDatabaseConnect.Create;
+begin
+  inherited Create(nil);
+  BaseFileName:=GlobalConfig.BaseFile;
+end;
+
+destructor TDatabaseConnect.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TDatabaseConnect.ConnectToBase(D: TSqlite3Dataset);
+begin
+  if D.Active then D.Close;
+  D.FileName:=BaseFileName;
+end;
+
+function TDatabaseConnect.DatasetCreate(const SQL: string; OpenDataset:boolean): TSqlite3Dataset;
+begin
+  Result:=TSqlite3Dataset.Create(Self);
+  Result.FileName:=BaseFileName;
+  Result.SQL:=SQL;
+  try
+    if OpenDataset then Result.Open;
+  except
+    Result.Free;
+    raise;
+  end;
+end;
+
+function TDatabaseConnect.DatasetCreate(const Table, PKField: string;
+  OpenDataset: boolean): TSqlite3Dataset;
+begin
+  Result:=TSqlite3Dataset.Create(Self);
+  Result.FileName:=BaseFileName;
+  Result.TableName:=Table;
+  Result.AutoIncrementKey:=true;
+  Result.PrimaryKey:=PKField;
+  try
+    if OpenDataset then Result.Open;
+  except
+    Result.Free;
+    raise;
+  end;
+end;
+
+procedure TDatabaseConnect.StringsFill(const SQL: string; const Template: string; List: TStrings;
+ OnFill:TStringsFillEvent; ClearList:boolean);
+var D:TSqlite3Dataset;
+  Strpos, WStrPos:array of integer;
+  i, j:integer;
+  FS, TemplatePrepared, S:String;
+begin
+  D:=DatasetCreate(SQL);
+  List.BeginUpdate;
+  try
+    SetLength(Strpos, D.FieldCount);
+    TemplatePrepared:=Template;
+    for i:=0 to D.FieldCount-1 do
+      begin
+        FS:='%'+ D.Fields.Fields[i].FieldName + '%';
+        StrPos[i]:=Pos(FS, TemplatePrepared);
+        if StrPos[i]<>0 then
+          begin
+            Delete(TemplatePrepared, StrPos[i], Length(FS));
+            //цикл коррекции предыдущих найденных позиций
+            for j:=0 to i-1 do
+              if StrPos[j] > StrPos[i] then Dec(StrPos[j], Length(FS));
+          end;
+      end;
+
+    SetLength(WStrPos, Length(Strpos));
+    if ClearList then List.Clear;
+    while not D.EOF do
+    begin
+      //инициализация массива текущих позиций
+      Move(Strpos[0], WStrPos[0], Length(StrPos)*SizeOf(StrPos[0]));
+      S:=TemplatePrepared;
+      for i:=0 to D.FieldCount-1 do
+        if WStrPos[i] > 0 then
+          begin
+            FS:=D.Fields.Fields[i].AsString;
+            Insert(FS, S, WStrPos[i]);
+            //цикл коррекции
+            for j:=i+1 to High(WStrPos) do
+              if WStrPos[j] > WStrPos[i] then Inc(WStrPos[j], Length(FS));
+          end;
+    
+      if OnFill <> nil then
+        OnFill(D);
+        
+      List.Add(S);
+      D.Next;
+    end;
+
+  finally
+    D.Free;
+    List.EndUpdate;
+  end;
+end;
+
+function TDatabaseConnect.DLookup(const SQL, Column: string): Variant;
+begin
+  Result:=null;
+  with DatasetCreate(SQL) do
+  try
+    First;
+    if not EOF then
+      Result:=FieldByName(Column).AsVariant;
+  finally
+    Free;
+  end;
+end;
+
+function TDatabaseConnect.DLookup(const SQL: string; Params: array of const;
+  const Column: string): Variant;
+begin
+  Result:=DLookup(Format(SQL, Params), Column);
+end;
+
+procedure TDatabaseConnect.SQLExec(const S: String);
+var PostDS:TSqlite3Dataset;
+begin
+  PostDS:=TSqlite3Dataset.Create(nil);
+  try
+    PostDS.FileName:=BaseFileName;
+    //PostDS.ExecuteDirect(S);
+    PostDS.ExecSQL(S);
+  finally
+    PostDS.Free;
+  end;
+end;
+
+procedure TDatabaseConnect.SQLExec(const S: String; Args: array of const);
+begin
+  SQLExec(Format(S, Args));
+end;
+
+finalization
+  BaseObj.Free;
+
+end.
+

examples/germesorders/uconfig.pas

@@ -0,0 +1,63 @@
+unit uConfig;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils; 
+  
+type
+
+  { TConfig }
+
+  TConfig = class
+    private
+      ExePath:string; //слэш на конце
+    public
+      constructor Create;
+      destructor Destroy;override;
+
+      //полный абсолютный путь к базе данных
+      function BaseFile:string;
+      function DebugLogFile:string;
+      function DebugLogDirectory:string;
+  end;
+
+var GlobalConfig:TConfig;
+implementation
+uses Forms;
+
+{ TConfig }
+
+constructor TConfig.Create;
+begin
+  ExePath:=ExtractFilePath(Application.ExeName);
+end;
+
+destructor TConfig.Destroy;
+begin
+  inherited Destroy;
+end;
+
+function TConfig.BaseFile: string;
+begin
+  Result:=ExePath + 'base/germesorders.db3';
+end;
+
+function TConfig.DebugLogFile: string;
+begin
+  Result:=ExePath + 'debug.log';
+end;
+
+function TConfig.DebugLogDirectory: string;
+begin
+  Result:=ExePath + 'logs';
+end;
+
+initialization
+  GlobalConfig:=TConfig.Create;
+finalization
+  FreeAndNil(GlobalConfig);
+end.
+

examples/germesorders/udbtypes.pas

@@ -0,0 +1,43 @@
+unit uDbTypes;
+
+{$mode objfpc}{$H+}
+
+interface
+uses Db;
+
+type
+  TDbKeyType = integer;
+  
+const
+  ftDbKey:TFieldType = ftInteger;
+
+procedure DbFieldAssignAsDbKey(D:TDataSet; const FieldName:string; F:TField);overload;
+procedure DbFieldAssignAsDbKey(D:TDataSet; const FieldName:string; const Val:string);overload;
+function DBFieldAsDBKey(D:TDataSet; const FieldName:string):TDbKeyType;
+function StrToDBKey(const S:String):TDbKeyType;
+
+implementation
+uses sysutils;
+
+function StrToDBKey(const S:String):TDbKeyType;
+begin
+  Result:=StrToInt(S);
+end;
+
+procedure DbFieldAssignAsDbKey(D:TDataSet; const FieldName:string; const Val:string);overload;
+begin
+  D.FieldByName(FieldName).AsInteger:=StrToInt(Val);
+end;
+
+procedure DbFieldAssignAsDbKey(D:TDataSet; const FieldName:string; F:TField);
+begin
+  D.FieldByName(FieldName).AsInteger:=F.AsInteger;
+end;
+
+function DBFieldAsDBKey(D:TDataSet; const FieldName:string):TDbKeyType;
+begin
+  Result:=D.FieldByName(FieldName).AsInteger;
+end;
+
+end.
+

examples/germesorders/udebug.pas

@@ -0,0 +1,134 @@
+unit uDebug;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, db;
+
+type
+  ILogger = interface
+    procedure Log(const S:string);overload;
+    procedure Log(const S:string; const Fmt:array of const);overload;
+    
+    procedure LogException(E:Exception);
+    Procedure ExceptionHandler(Sender : TObject; E : Exception);
+    procedure LogDatasetFieldNames(const DatasetName:string; D:TDataset);
+  end;
+
+  function GlobalLogger:ILogger;
+implementation
+uses uConfig, functions_file, Forms;
+
+var Logger:ILogger;
+
+type
+
+  { TLogger }
+
+  TLogger = class(TInterfacedObject, ILogger)
+    private
+      //F:TFileStream;
+      F:TextFile;
+      ExceptionCaught:boolean;
+    public
+      constructor Create;
+      destructor Destroy;override;
+    
+      procedure Log(const S:string);overload;
+      procedure Log(const S:string; const Fmt:array of const);overload;
+      
+      procedure LogException(E:Exception);
+      Procedure ExceptionHandler(Sender : TObject; E : Exception);
+      procedure LogDatasetFieldNames(const DatasetName:string; D:TDataset);
+  end;
+
+{ TLogger }
+
+constructor TLogger.Create;
+begin
+  inherited;
+  
+  ExceptionCaught:=false;
+  //F:=TFileStream.Create( GlobalConfig.DebugLogFile, fmCreate or fmOpenWrite );
+  AssignFile(F, GlobalConfig.DebugLogFile);
+  Rewrite(F);
+end;
+
+destructor TLogger.Destroy;
+var D, DLog:String;
+begin
+  //F.Free;
+  CloseFile(F);
+  if ExceptionCaught then
+    try
+      //сохраняем в отдельной папке логов
+      D:=GlobalConfig.DebugLogDirectory;
+      fb_CreateDirectoryStructure( D );
+      
+      DLog:=Format('%s/log-%s.log', [D, FormatDateTime('dd-mm-yyyy-hh-mm-ss', Now)]);
+      //DLog:=Format('%s/log.log', [D]);
+      fb_CopyFile(GlobalConfig.DebugLogFile, DLog, false, false);
+    except
+    end;
+  
+  inherited Destroy;
+end;
+
+procedure TLogger.Log(const S: string);
+var Buf:string;
+begin
+  //Buf:=S + #13#10;
+  //F.Write( PChar(@Buf[1])^, Length(Buf) );
+  WriteLn(F, S);
+  Flush(F);
+end;
+
+procedure TLogger.Log(const S: string; const Fmt: array of const);
+begin
+  Log( Format(S, Fmt) );
+end;
+
+procedure TLogger.LogException(E: Exception);
+begin
+  ExceptionCaught:=true;
+
+  Log('***Исключение***: ' + E.Message);
+  Log('***Исключение*** стек: ');
+  DumpExceptionBackTrace(F);
+  Flush(F);
+end;
+
+procedure TLogger.ExceptionHandler(Sender: TObject; E: Exception);
+begin
+  LogException(E);
+  //Halt(1);
+  Application.Terminate;
+end;
+
+procedure TLogger.LogDatasetFieldNames(const DatasetName:string; D: TDataset);
+var S:String;
+  n:Integer;
+begin
+  S:=DatasetName + ':';
+  for n:=0 to D.FieldCount-1 do
+    S:=S + Format(' %s(%s)', [D.Fields.Fields[n].FieldName, UpperCase(D.Fields.Fields[n].FieldName)]);
+  Log(S);
+end;
+
+//==============================================================================
+function GlobalLogger:ILogger;
+begin
+  if Logger = nil then
+    begin
+      Logger:=TLogger.Create;
+    end;
+  Result:=Logger;
+end;
+
+finalization
+  Logger:=nil;
+
+end.
+

examples/germesorders/ufrmparent.lfm

@@ -0,0 +1,10 @@
+object frmParent: TfrmParent
+  Left = 291
+  Height = 249
+  Top = 190
+  Width = 275
+  HorzScrollBar.Page = 274
+  VertScrollBar.Page = 248
+  Caption = 'frmParent'
+  LCLVersion = '0.9.25'
+end

examples/germesorders/ufrmparent.lrs

@@ -0,0 +1,7 @@
+{ Это - файл ресурсов, автоматически созданный lazarus }
+
+LazarusResources.Add('TfrmParent','FORMDATA',[
+  'TPF0'#10'TfrmParent'#9'frmParent'#4'Left'#3'#'#1#6'Height'#3#249#0#3'Top'#3
+  +#190#0#5'Width'#3#19#1#18'HorzScrollBar.Page'#3#18#1#18'VertScrollBar.Page'#3
+  +#248#0#7'Caption'#6#9'frmParent'#10'LCLVersion'#6#6'0.9.25'#0#0
+]);

examples/germesorders/ufrmparent.pas

@@ -0,0 +1,112 @@
+unit ufrmParent; 
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs; 
+
+type
+
+  { TfrmParent }
+
+  TfrmParent = class(TForm)
+  private
+    { private declarations }
+  protected
+    (*
+    {$IFDEF LCLwince}
+    procedure DoShow; override;
+    {$ENDIF}
+    *)
+  public
+    { public declarations }
+    {$IFDEF LCLwince}
+    procedure WindowResize;
+    {$ENDIF}
+  end; 
+
+{$IFDEF LCLwince}
+procedure TaskBarHide;
+procedure TaskBarUnHide;
+{$ENDIF}
+
+implementation
+uses uDebug
+  {$IFDEF LCLwince},Windows{$ENDIF};
+
+{$IFDEF LCLwince}
+function TaskBarHwnd:HWND;
+begin
+  Result:=FindWindow('HHTaskBar', nil);
+  //Result:=FindWindow('SipWndClass', nil);
+  //Result:=FindWindow('MS_SIPBUTTON', nil);
+end;
+
+procedure TaskBarHide;
+var H:HWND;
+    S:String;
+
+begin
+  GlobalLogger.Log('Попытка скрыть TaskBar');
+
+  H:=TaskBarHwnd;
+  if (H <> 0) then
+    begin
+      S:='...закончилась удачно';
+      ShowWindow(H, SW_HIDE);
+    end
+    else
+    begin
+      S:='...закончилась неудачно';
+    end;
+  GlobalLogger.Log(S);
+end;
+
+procedure TaskBarUnHide;
+var H:HWND;
+  S:String;
+begin
+  GlobalLogger.Log('Попытка показать TaskBar');
+  H:=TaskBarHwnd;
+  if (H <> 0) then
+    begin
+      S:='...закончилась удачно';
+      ShowWindow(H, SW_SHOW);
+    end
+    else
+    begin
+      S:='...закончилась неудачно';
+    end;
+  GlobalLogger.Log(S);
+end;
+{$ENDIF}
+
+{$IFDEF LCLwince}
+procedure TfrmParent.WindowResize;
+var WR:Windows.Rect;
+begin
+  if SystemParametersInfo(SPI_GETWORKAREA, 0, @WR, 0) then
+    begin
+      {SetWindowPos(Handle,HWND_TOPMOST,0,0,WR.right -
+        WR.left,WR.bottom - WR.top, SWP_SHOWWINDOW);}
+      SetWindowPos(Handle,HWND_TOP,0,0,WR.right -
+        WR.left,WR.bottom - WR.top, SWP_SHOWWINDOW);
+    end;
+end;
+
+{
+procedure TfrmParent.DoShow;
+begin
+  inherited;
+  WindowResize;
+end;
+}
+{$ENDIF}
+
+initialization
+  {$I ufrmparent.lrs}
+
+end.
+

examples/germesorders/uoptionconst.pas

@@ -0,0 +1,16 @@
+unit uOptionConst;
+
+{$mode objfpc}{$H+}
+
+interface
+
+const
+  goOptGroupCurrent = 'GroupCurrent';
+  goOptSubGroupCurrent = 'SubGroupCurrent';
+  goOptDealerCurrent = 'DealerCurrent';
+  goOptWorkerCurrent = 'WorkerCurrent';
+
+implementation
+
+end.
+

examples/germesorders/uorder.lfm

@@ -0,0 +1,302 @@
+inherited frmOrder: TfrmOrder
+  Left = 435
+  Height = 302
+  Top = 244
+  Width = 214
+  ActiveControl = btnSave
+  Caption = 'Данные заказа'
+  ClientHeight = 302
+  ClientWidth = 214
+  OnClose = FormClose
+  OnCreate = FormCreate
+  OnShow = FormShow
+  object Panel1: TPanel[0]
+    Height = 31
+    Width = 214
+    Align = alTop
+    ClientHeight = 31
+    ClientWidth = 214
+    TabOrder = 0
+    object btnSave: TBitBtn
+      Left = 7
+      Height = 26
+      Hint = 'Сохранить заказ'
+      Top = 1
+      Width = 45
+      AutoSize = True
+      Glyph.Data = {
+        36040000424D3604000000000000360000002800000010000000100000000100
+        200000000000000400006400000064000000000000000000000051514BFF3E3D
+        37FF3D3C36FF3D3C36FF3D3C36FF3D3C36FF3C3B34FF3D3C36FF3D3C36FF3D3C
+        36FF3D3C36FF3D3C36FF40403BFF42423DFF3E3D37FF565651FF3E3D37FF4B4D
+        4AFF4B4D4AFF4C4E4BFF4D504DFF4E514FFF4F5250FF505351FF525553FF5053
+        51FF4F524FFF4E504EFF4E514FFF4B4D4AFF4A4C49FF3D3C36FF3C3B34FF4B4D
+        4AFF3B3A34FF3D3D38FF434440FF484A45FF4B4D4AFF4F5250FF515553FF4F52
+        4FFF4B4C4AFF454642FF40403CFF3B3A34FF4A4C49FF3C3B35FF51524CFF8E93
+        91FF8E9491FF8E9491FF999E9BFF898F8CFF919493FF8E9491FF8E9491FF9398
+        95FF9CA09DFF8E9491FF8E9491FF999E9BFF8E9391FF51524CFF6F726EFFFFFF
+        FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+        FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF676964FF737672FFFDFD
+        FDFF858A87FFBCC3C0FFC5CAC9FFE2E5E4FFF5F6F6FFB1E0C8FF26A966FFBDE0
+        CEFFE0E3E2FFC0C6C4FFB6BDBAFF808583FFF8F8F8FF737672FF858A88FFF5F6
+        F5FFC6CCCAFFE0E3E1FFFCFCFCFFE4E7E6FF6FB993FF2AAB69FF90E2B9FF1AA4
+        5EFFAFD3C1FFFBFCFBFFD7DBD9FFB8BEBCFFECEEEDFF858A88FF858A88FFEFF1
+        F0FFE1E3E3FFEEEFEFFFCBD4D0FF48AE7AFF42B97CFFC4F5DCFFA8F3CDFFACED
+        CCFF1AA45EFF9CC3AEFFE9EAEAFFD3D7D6FFE5E7E7FF858A88FF858A88FFEDEF
+        EFFFEBEDECFFC6D6CFFF2EA96AFF60CA94FFC6F6DEFF5DE8A1FF34E28AFF8FEF
+        BEFFACEDCCFF1AA45EFF9EC5B1FFE1E4E3FFE2E5E4FF858A88FF858A88FFF1F3
+        F2FFBCD8CBFF1CA45EFF81DBADFFD6F9E8FF98F0C3FF34E28AFF34E28AFF7FED
+        B5FFD6F9E7FFADEDCDFF1CA45EFFA6CCB9FFE8EAEAFF858A88FF858A88FFF4F6
+        F5FF4CB57FFF069A4EFF069A4EFF1EA761FFD1F8E4FF37E28CFF34E28AFFCCF8
+        E2FF2AAE6AFF069A4EFF069A4EFF42B078FFEAECECFF858A88FF858A88FFF3F5
+        F5FFEBEDEDFFFBFCFCFFEBEDEDFF0A9C51FFD1F8E4FF39E38DFF34E28AFFD2F9
+        E5FF109E55FFDFE6E3FFD1D4D4FFE3E6E5FFEEF0EFFF858A88FF868B89FFEFF1
+        F1FFF3F5F5FFFDFDFDFFF3F5F5FF0A9C51FFD1F8E4FF39E38DFF34E28AFFD2F9
+        E5FF109E55FFECF2F0FFDFE1E1FFF3F5F5FFEFF1F1FF868B89FF828785FF888D
+        8BFF858A88FF858A88FF858A88FF089B50FFD1F8E4FF39E38DFF34E28AFFD2F9
+        E5FF0E9D54FF818B86FF858A88FF858A88FF868B89FF838685FF08000000FFFF
+        FF00FFFFFF006FA2AF0047676D000B9D52FFD1F8E4FFD6F9E8FFD6F9E8FFD6F9
+        E8FF0F9D54FF00000000000000000000000000000000FFFFFF009003DE009003
+        DE008E011700BB0241008E014100179B57FF069A4EFF069A4EFF069A4EFF069A
+        4EFF109953FF000000000000000020E2DB000000000000000000
+      }
+      NumGlyphs = 0
+      OnClick = btnSaveClick
+      TabOrder = 0
+    end
+    object btnCancel: TBitBtn
+      Left = 159
+      Height = 26
+      Hint = 'Сохранить заказ'
+      Top = 1
+      Width = 45
+      Anchors = [akRight]
+      AutoSize = True
+      Glyph.Data = {
+        36040000424D3604000000000000360000002800000010000000100000000100
+        2000000000000004000064000000640000000000000000000000000000000000
+        0000000000000000000000000000000000000000000000000000000000000000
+        0000000000000000FF00FFFFFF00110000005001DE00B85EDE00FFFF0000FFFF
+        0000FD59000000FF00000480E00036342EFF36342EFF36342EFF36342EFF3634
+        2EFF36342EFF36342EFF36342EFF36342EFF36342EFF00000000002FB400FDE2
+        460000099D00F19B0800002DDE0036342EFFE0E2E2FF7A7976FF36342EFF1F6E
+        43FF227A4BFF257E4EFF2A7E50FF2B7F50FF36342EFFBD6800000000FF000000
+        0000FF2B45000000A4FF0000A4FF36342EFFDEE0E0FFE0E2E2FFE0E2E2FF7A79
+        76FF36342EFF1E643EFF237446FF1F7E4BFF36342EFF24B70000FFAF0000FFFF
+        0000E4FF09000000A4FF2929EFFF0000A4FFE0E2E2FFD1D4D4FFBEC1C1FFE0E2
+        E2FFE0E2E2FF36342EFF18653BFF197544FF36342EFF0522BE000000A4FF0000
+        A4FF0000A4FF0000A4FF2929EFFF2929EFFF0000A4FFD1D4D4FFBEC1C1FFB7B9
+        B9FFE0E2E2FF36342EFF17623AFF196E41FF36342EFFE90000000000A4FF2929
+        EFFF2929EFFF2929EFFF2929EFFF0000B4FF2929EFFF0000A4FFBEC1C1FFB7B9
+        B9FFE0E2E2FF36342EFF195E39FF15703FFF36342EFFFFFF00000000A4FF2929
+        EFFF0000B4FF0000B4FF0000B4FF0000B4FF0000B4FF2929EFFF0000A4FF6A6C
+        6CFFE0E2E2FF36342EFF185B36FF136C3CFF36342EFF000000000000A4FF8282
+        FBFF0000CCFF0000CCFF0000CCFF0000CCFF0000CCFF8282FBFF0000A4FF7779
+        79FF5A5B5BFF36342EFF105932FF0E6638FF36342EFF000000000000A4FF8282
+        FBFF8282FBFF8282FBFF8282FBFF0000CCFF8282FBFF0000A4FFBBBDBDFFA2A4
+        A4FFE0E2E2FF36342EFF0D4E2BFF0D562FFF36342EFFFFFF00000000A4FF0000
+        A4FF0000A4FF0000A4FF8282FBFF8282FBFF0000A4FFCDD0D0FFBEC1C1FFB7B9
+        B9FFE0E2E2FF36342EFF083E22FF074F2AFF36342EFF62FF0000000000000000
+        0000000000000000A4FF8282FBFF0000A4FFDCDEDEFFD0D3D3FFBEC1C1FFB7B9
+        B9FFE0E2E2FF36342EFF062D18FF064121FF36342EFFF29D0900000000000000
+        0000000000000000A4FF0000A4FF36342EFFE0E2E2FFD0D3D3FFBDC0C0FFB5B7
+        B7FFE0E2E2FF36342EFF001C0DFF003318FF36342EFF00000000002BAF00FCE3
+        500000000000000000000000000036342EFFE0E2E2FFD0D3D3FFBDC0C0FFABAD
+        ADFFE0E2E2FF36342EFF000F07FF002813FF36342EFF00000000080000000000
+        1C00FFFF39001C555500FFFFFF0036342EFF36342EFF36342EFF36342EFF3634
+        2EFF36342EFF36342EFF36342EFF36342EFF36342EFF000000008803DE00A0F4
+        DD000000000056000A00808220009CEE0900000000005800000090B8E1003CB8
+        E10000000000000000000000000050B8E1000000000000000000
+      }
+      NumGlyphs = 0
+      OnClick = btnCancelClick
+      TabOrder = 1
+    end
+  end
+  object Panel2: TPanel[1]
+    Height = 271
+    Top = 31
+    Width = 214
+    Align = alClient
+    ClientHeight = 271
+    ClientWidth = 214
+    TabOrder = 1
+    object GroupBox1: TGroupBox
+      Left = 1
+      Height = 97
+      Top = 1
+      Width = 212
+      Align = alTop
+      Caption = 'Заказ'
+      ClientHeight = 79
+      ClientWidth = 208
+      TabOrder = 0
+      object Label1: TLabel
+        Left = 4
+        Height = 20
+        Top = 19
+        Width = 42
+        Alignment = taRightJustify
+        AutoSize = False
+        Caption = 'Орг-я:'
+        Font.Color = clBlack
+        Font.Height = -12
+        Font.Name = 'Sans'
+        ParentColor = False
+        ParentFont = False
+      end
+      object Label2: TLabel
+        Left = 4
+        Height = 20
+        Top = 51
+        Width = 42
+        Alignment = taRightJustify
+        AutoSize = False
+        Caption = 'Дата:'
+        Font.Color = clBlack
+        Font.Height = -12
+        Font.Name = 'Sans'
+        ParentColor = False
+        ParentFont = False
+      end
+      object chkCache: TDBCheckBox
+        Left = 53
+        Height = 19
+        Top = -3
+        Width = 61
+        Caption = 'Безнал'
+        DataField = 'CacheLess'
+        DataSource = dsrcOrder
+        TabOrder = 0
+        ValueChecked = '1'
+        ValueUnchecked = '0'
+      end
+      object cbxOrg: TRxDBLookupCombo
+        Left = 49
+        Height = 23
+        Top = 19
+        Width = 153
+        Anchors = [akTop, akLeft, akRight]
+        ButtonWidth = 15
+        Ctl3D = True
+        DataField = 'Org'
+        DataSource = dsrcOrder
+        PopUpFormOptions.Columns = <>
+        Font.Height = -12
+        Font.Name = 'Sans'
+        Glyph.Data = {
+          72000000424D7200000000000000360000002800000005000000030000000100
+          2000000000003C00000064000000640000000000000000000000000000000000
+          0000000000FF000000000000000000000000000000FF000000FF000000FF0000
+          0000000000FF000000FF000000FF000000FF000000FF
+        }
+        NumGlyphs = 1
+        ParentColor = False
+        ParentFont = False
+        TabOrder = 2
+        TabStop = True
+        LookupDisplay = 'Name'
+        LookupField = 'ID'
+        LookupSource = dsrcOrgs
+      end
+      object DBEdit1: TDBEdit
+        Left = 49
+        Height = 23
+        Top = 51
+        Width = 155
+        DataField = 'DateCreate'
+        DataSource = dsrcOrder
+        Anchors = [akTop, akLeft, akRight]
+        ParentColor = False
+        TabOrder = 1
+      end
+    end
+    object GroupBox2: TGroupBox
+      Left = 1
+      Height = 138
+      Top = 98
+      Width = 212
+      Align = alClient
+      Caption = 'Текущая группа/подгруппа'
+      ClientHeight = 120
+      ClientWidth = 208
+      TabOrder = 1
+      object cbxGroup: TComboBox
+        Left = 4
+        Height = 21
+        Top = 3
+        Width = 200
+        Anchors = [akTop, akLeft, akRight]
+        ItemHeight = 13
+        MaxLength = -1
+        OnChange = cbxGroupChange
+        Style = csDropDownList
+        TabOrder = 0
+      end
+      object lbxSubGroups: TListBox
+        Left = 4
+        Height = 84
+        Top = 32
+        Width = 200
+        Anchors = [akTop, akLeft, akRight, akBottom]
+        TabOrder = 1
+      end
+    end
+    object Panel3: TPanel
+      Left = 1
+      Height = 34
+      Top = 236
+      Width = 212
+      Align = alBottom
+      ClientHeight = 34
+      ClientWidth = 212
+      TabOrder = 2
+      object btnOrderList: TButton
+        Tag = 1
+        Left = 102
+        Height = 25
+        Top = 4
+        Width = 103
+        Anchors = [akRight, akBottom]
+        Caption = 'Список товаров'
+        Font.Height = -10
+        Font.Name = 'Sans'
+        OnClick = btnOrderListClick
+        ParentFont = False
+        TabOrder = 0
+      end
+      object btnOrderList1: TButton
+        Tag = 2
+        Left = 7
+        Height = 25
+        Top = 4
+        Width = 87
+        Caption = 'Выбранные'
+        Font.Height = -10
+        Font.Name = 'Sans'
+        OnClick = btnOrderListClick
+        ParentFont = False
+        TabOrder = 1
+      end
+    end
+  end
+  object dsrcOrder: TDatasource[2]
+    DataSet = dsOrder
+    left = 160
+    top = 40
+  end
+  object dsOrder: TSqlite3Dataset[3]
+    SaveOnRefetch = True
+    left = 128
+    top = 40
+  end
+  object dsOrgs: TSqlite3Dataset[4]
+    left = 104
+    top = 72
+  end
+  object dsrcOrgs: TDatasource[5]
+    DataSet = dsOrgs
+    left = 143
+    top = 72
+  end
+end

examples/germesorders/uorder.pas

@@ -0,0 +1,313 @@
+unit uOrder;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
+  Buttons, rxdbgrid, sqlite3ds, db, ComCtrls, StdCtrls, uDbTypes, memds2,
+  DbCtrls, rxdbcomb, rxlookup, dbdateedit, ufrmParent;
+
+type
+
+  { TfrmOrder }
+
+  TfrmOrder = class(TfrmParent)
+    btnOrderList: TButton;
+    btnOrderList1: TButton;
+    btnSave: TBitBtn;
+    btnCancel: TBitBtn;
+    cbxGroup: TComboBox;
+    chkCache: TDBCheckBox;
+    DBEdit1: TDBEdit;
+    dsOrgs: TSqlite3Dataset;
+    dsrcOrder: TDatasource;
+    dsrcOrgs: TDatasource;
+    GroupBox1: TGroupBox;
+    GroupBox2: TGroupBox;
+    Label1: TLabel;
+    Label2: TLabel;
+    lbxSubGroups: TListBox;
+    Panel1: TPanel;
+    Panel2: TPanel;
+    cbxOrg: TRxDBLookupCombo;
+    dsOrder: TSqlite3Dataset;
+    Panel3: TPanel;
+    procedure btnSaveClick(Sender: TObject);
+    procedure btnCancelClick(Sender: TObject);
+    procedure btnOrderListClick(Sender: TObject);
+    procedure cbxGroupChange(Sender: TObject);
+    procedure cbxSubGroupChange(Sender: TObject);
+    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
+    procedure FormCreate(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+  private
+    FId_Order: TDbKeyType;
+    { private declarations }
+    GroupOpt, SubGroupOpt:TDbKeyType;
+    GroupIndex, SubGroupIndex:Integer;
+
+    procedure CloseAndFree;
+
+    procedure OptionsLoad;
+    procedure OptionsSubGroupLoad(const ParentID:string; const Id:string);
+    procedure OptionsSave;
+
+    function GroupChosen:string;
+    function SubGroupChosen:string;
+
+    procedure GroupIndexFind(D:TDataset);
+    procedure SubGroupIndexFind(D:TDataset);
+
+  public
+    { public declarations }
+    property Id_Order:TDbKeyType read FId_Order write FId_Order;
+  end; 
+  
+var frmOrder:TfrmOrder;
+
+implementation
+uses uDebug, uBase, uOrderGoods, uUtils, uTestForm, uOptionConst;
+
+{ TfrmOrder }
+
+procedure TfrmOrder.btnCancelClick(Sender: TObject);
+begin
+  GlobalLogger.Log('Отмена изменений заказа %d', [Id_Order]);
+  dsOrder.Cancel;
+
+  CloseAndFree;
+end;
+
+procedure TfrmOrder.btnOrderListClick(Sender: TObject);
+begin
+  OptionsSave;
+
+  GlobalLogger.Log('Открытие формы редактирования состава заказа');
+
+  if frmOrderGoods = nil then
+    frmOrderGoods:=TfrmOrderGoods.Create(Application);
+  with frmOrderGoods do
+  begin
+    GoodShowType:=TGoodShowType( TComponent(Sender).Tag );
+    Id_Order:=Self.Id_Order;
+    Id_Org:=DBFieldAsDBKey(dsOrder, 'Org');
+    {$IFDEF LCLwince}
+    WindowResize;
+    {$ENDIF}
+    Show;
+  end;
+
+  {
+  with TfrmTestForm.Create(self) do
+  begin
+    ShowModal;
+    Free;
+  end;
+  }
+  
+  GlobalLogger.Log('Форма редактирования состава заказа успешно отработала');
+end;
+
+procedure TfrmOrder.FormClose(Sender: TObject; var CloseAction: TCloseAction);
+begin
+  CloseAction:=caHide;
+end;
+
+procedure TfrmOrder.FormCreate(Sender: TObject);
+begin
+  BaseConnect.ConnectToBase(dsOrder);
+  dsOrder.TableName:='Orders';
+  dsOrder.PrimaryKey:='ID';
+
+  BaseConnect.ConnectToBase(dsOrgs);
+  dsOrgs.SQL:='select ID, Name from Orgs order by Name';
+  dsOrgs.Open;
+end;
+
+procedure TfrmOrder.FormShow(Sender: TObject);
+var W:String;
+begin
+  GlobalLogger.Log('Переход на заказ с ID=%d', [Id_Order]);
+  dsOrder.Open;
+  if not dsOrder.Locate('ID', Id_Order, []) then
+    begin
+      GlobalLogger.Log('Заказ с ID=%d не найден', [Id_Order]);
+      ShowMessage(Format('Заказ с ID=%d не найден', [Id_Order]));
+      Exit;
+    end;
+  dsOrder.Edit;
+
+  W:=BaseConnect.OptionUser[goOptWorkerCurrent];
+
+  if W <> '' then
+    DbFieldAssignAsDbKey(dsOrder, 'Creator', W);
+  //cbxOrg.Update;
+  
+  OptionsLoad;
+end;
+
+procedure TfrmOrder.CloseAndFree;
+begin
+  dsOrder.Close;
+
+  GlobalLogger.Log('Закрытие формы TfrmOrder');
+  Close;
+end;
+
+procedure TfrmOrder.btnSaveClick(Sender: TObject);
+var S:String;
+begin
+  GlobalLogger.Log('Сохранение заказа %d', [Id_Order]);
+  dsOrder.Post;
+
+  if dsOrder.UpdatesPending then
+    begin
+      GlobalLogger.Log('Применение изменений заказа %d', [Id_Order]);
+      S:='Изменения заказа %d ' + Iif(dsOrder.ApplyUpdates, 'успешно применены', 'применить не удалось.');
+      GlobalLogger.Log(S, [Id_Order]);
+    end;
+  CloseAndFree;
+end;
+
+function IdExtract(const S:string):string;
+var i:Integer;
+begin
+  i:=Pos('|', S);
+  if i = 0 then raise Exception.Create('Не найден id');
+  Result:=Copy(S, 1,i-1);
+end;
+
+procedure TfrmOrder.OptionsLoad;
+var S, SubGr:String;
+begin
+  GlobalLogger.Log('Загрузка опций');
+
+  GlobalLogger.Log('Заполнение выпадающего списка групп');
+
+  S:=BaseConnect.OptionUser[goOptGroupCurrent];
+  if S = '' then
+    begin
+      BaseConnect.StringsFill('select ID, Name from Goods where ID<0 and ID > -10000000 order by Name', '%ID%| %Name%', cbxGroup.Items, nil);
+      cbxGroup.ItemIndex:=0;
+    end
+    else
+    begin
+      GroupOpt:=StrToDBKey(S);
+      BaseConnect.StringsFill('select ID, Name from Goods where ID<0 and ID > -10000000 order by Name', '%ID%| %Name%', cbxGroup.Items, @GroupIndexFind);
+      cbxGroup.ItemIndex:=GroupIndex-1;
+    end;
+  GlobalLogger.Log('Заполнение выпадающего списка групп успешно завершено');
+
+  SubGr:=BaseConnect.OptionUser[goOptSubGroupCurrent];
+  OptionsSubGroupLoad(GroupChosen, SubGr );
+end;
+
+procedure TfrmOrder.OptionsSubGroupLoad(const ParentID:string; const Id:string);
+var SGList:TStrings;
+    SGCnt:TListBox;
+begin
+  GlobalLogger.Log('Заполнение выпадающего списка подгрупп');
+  
+  SGCnt:=lbxSubGroups;
+  SGList:=SGCnt.Items;
+  
+  SGList.BeginUpdate;
+  try
+    SGList.Clear;
+    SGList.Add('0| Не выбрана');
+    if ParentID = '' then
+      begin
+        //cbxSubGroup.Items.Clear;
+        exit;
+      end
+      else
+      if (ID = '') or (ID = '0') then
+      begin
+        BaseConnect.StringsFill('select g.ID, g.Name from Goods g '+
+                            'join HierGoods h on g.ID=h.Good and ParentID=' + ParentID + ' ' +
+                            'order by Name', '%ID%| %Name%',
+                            SGList, nil, false);
+        SGCnt.ItemIndex:=0;
+      end
+      else
+      begin
+        SubGroupOpt:=StrToDBKey(ID);
+        BaseConnect.StringsFill('select g.ID, g.Name from Goods g '+
+                            'join HierGoods h on g.ID=h.Good and ParentID=' + ParentID + ' ' +
+                            'order by Name', '%ID%| %Name%',
+                            SGList, @SubGroupIndexFind, false);
+        //cbxSubGroup.ItemIndex:=SubGroupIndex-1;
+        SGCnt.ItemIndex:=SubGroupIndex;
+      end;
+  finally
+    SGList.EndUpdate;
+  end;
+  GlobalLogger.Log('Заполнение выпадающего списка подгрупп успешно завершено');
+end;
+
+procedure TfrmOrder.cbxGroupChange(Sender: TObject);
+begin
+  //btnAcceptOptions.Enabled:=True;
+  OptionsSubGroupLoad( GroupChosen, '' );
+end;
+
+procedure TfrmOrder.cbxSubGroupChange(Sender: TObject);
+begin
+  //btnAcceptOptions.Enabled:=True;
+end;
+
+procedure TfrmOrder.OptionsSave;
+begin
+  BaseConnect.OptionUser[goOptGroupCurrent]:=GroupChosen;
+  BaseConnect.OptionUser[goOptSubGroupCurrent]:=SubGroupChosen;
+end;
+
+function TfrmOrder.GroupChosen: string;
+begin
+  if (cbxGroup.Items.Count <= 0) or
+     (cbxGroup.ItemIndex < 0) or
+     (cbxGroup.ItemIndex >= cbxGroup.Items.Count)
+    then
+    begin
+      Result:='';
+      exit;
+    end;
+
+  Result:=IdExtract( cbxGroup.Items[cbxGroup.ItemIndex] );
+end;
+
+function TfrmOrder.SubGroupChosen: string;
+begin
+  if (lbxSubGroups.Items.Count <= 0) or
+     (lbxSubGroups.ItemIndex < 0) or
+     (lbxSubGroups.ItemIndex >= lbxSubGroups.Items.Count)
+    then
+    begin
+      Result:='';
+      exit;
+    end;
+
+  Result:=IdExtract( lbxSubGroups.Items[lbxSubGroups.ItemIndex] );
+end;
+
+procedure TfrmOrder.GroupIndexFind(D: TDataset);
+begin
+  if GroupOpt = D.FieldByName('ID').AsInteger then
+    GroupIndex:=D.RecNo;
+end;
+
+procedure TfrmOrder.SubGroupIndexFind(D: TDataset);
+begin
+  if SubGroupOpt = D.FieldByName('ID').AsInteger then
+    SubGroupIndex:=D.RecNo;
+end;
+
+
+
+initialization
+  {$I uordergoods.lrs}
+
+end.
+

examples/germesorders/uordergoods.lfm

@@ -0,0 +1,278 @@
+inherited frmOrderGoods: TfrmOrderGoods
+  Left = 425
+  Height = 340
+  Top = 279
+  Width = 285
+  ActiveControl = PageControl1
+  Caption = 'Составление заказа'
+  ClientHeight = 340
+  ClientWidth = 285
+  OnClose = FormClose
+  OnResize = FormResize
+  OnShow = FormShow
+  object Panel1: TPanel[0]
+    Height = 31
+    Width = 285
+    Align = alTop
+    ClientHeight = 31
+    ClientWidth = 285
+    TabOrder = 0
+    object BitBtn1: TBitBtn
+      Left = 7
+      Height = 26
+      Hint = 'Сохранить заказ'
+      Top = 1
+      Width = 45
+      AutoSize = True
+      Glyph.Data = {
+        36040000424D3604000000000000360000002800000010000000100000000100
+        200000000000000400006400000064000000000000000000000051514BFF3E3D
+        37FF3D3C36FF3D3C36FF3D3C36FF3D3C36FF3C3B34FF3D3C36FF3D3C36FF3D3C
+        36FF3D3C36FF3D3C36FF40403BFF42423DFF3E3D37FF565651FF3E3D37FF4B4D
+        4AFF4B4D4AFF4C4E4BFF4D504DFF4E514FFF4F5250FF505351FF525553FF5053
+        51FF4F524FFF4E504EFF4E514FFF4B4D4AFF4A4C49FF3D3C36FF3C3B34FF4B4D
+        4AFF3B3A34FF3D3D38FF434440FF484A45FF4B4D4AFF4F5250FF515553FF4F52
+        4FFF4B4C4AFF454642FF40403CFF3B3A34FF4A4C49FF3C3B35FF51524CFF8E93
+        91FF8E9491FF8E9491FF999E9BFF898F8CFF919493FF8E9491FF8E9491FF9398
+        95FF9CA09DFF8E9491FF8E9491FF999E9BFF8E9391FF51524CFF6F726EFFFFFF
+        FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+        FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF676964FF737672FFFDFD
+        FDFF858A87FFBCC3C0FFC5CAC9FFE2E5E4FFF5F6F6FFB1E0C8FF26A966FFBDE0
+        CEFFE0E3E2FFC0C6C4FFB6BDBAFF808583FFF8F8F8FF737672FF858A88FFF5F6
+        F5FFC6CCCAFFE0E3E1FFFCFCFCFFE4E7E6FF6FB993FF2AAB69FF90E2B9FF1AA4
+        5EFFAFD3C1FFFBFCFBFFD7DBD9FFB8BEBCFFECEEEDFF858A88FF858A88FFEFF1
+        F0FFE1E3E3FFEEEFEFFFCBD4D0FF48AE7AFF42B97CFFC4F5DCFFA8F3CDFFACED
+        CCFF1AA45EFF9CC3AEFFE9EAEAFFD3D7D6FFE5E7E7FF858A88FF858A88FFEDEF
+        EFFFEBEDECFFC6D6CFFF2EA96AFF60CA94FFC6F6DEFF5DE8A1FF34E28AFF8FEF
+        BEFFACEDCCFF1AA45EFF9EC5B1FFE1E4E3FFE2E5E4FF858A88FF858A88FFF1F3
+        F2FFBCD8CBFF1CA45EFF81DBADFFD6F9E8FF98F0C3FF34E28AFF34E28AFF7FED
+        B5FFD6F9E7FFADEDCDFF1CA45EFFA6CCB9FFE8EAEAFF858A88FF858A88FFF4F6
+        F5FF4CB57FFF069A4EFF069A4EFF1EA761FFD1F8E4FF37E28CFF34E28AFFCCF8
+        E2FF2AAE6AFF069A4EFF069A4EFF42B078FFEAECECFF858A88FF858A88FFF3F5
+        F5FFEBEDEDFFFBFCFCFFEBEDEDFF0A9C51FFD1F8E4FF39E38DFF34E28AFFD2F9
+        E5FF109E55FFDFE6E3FFD1D4D4FFE3E6E5FFEEF0EFFF858A88FF868B89FFEFF1
+        F1FFF3F5F5FFFDFDFDFFF3F5F5FF0A9C51FFD1F8E4FF39E38DFF34E28AFFD2F9
+        E5FF109E55FFECF2F0FFDFE1E1FFF3F5F5FFEFF1F1FF868B89FF828785FF888D
+        8BFF858A88FF858A88FF858A88FF089B50FFD1F8E4FF39E38DFF34E28AFFD2F9
+        E5FF0E9D54FF818B86FF858A88FF858A88FF868B89FF838685FF08000000FFFF
+        FF00FFFFFF006FA2AF0047676D000B9D52FFD1F8E4FFD6F9E8FFD6F9E8FFD6F9
+        E8FF0F9D54FF00000000000000000000000000000000FFFFFF009003DE009003
+        DE008E011700BB0241008E014100179B57FF069A4EFF069A4EFF069A4EFF069A
+        4EFF109953FF000000000000000020E2DB000000000000000000
+      }
+      NumGlyphs = 0
+      OnClick = BitBtn1Click
+      TabOrder = 0
+    end
+    object BitBtn2: TBitBtn
+      Left = 230
+      Height = 26
+      Hint = 'Сохранить заказ'
+      Top = 1
+      Width = 45
+      Anchors = [akRight]
+      AutoSize = True
+      Glyph.Data = {
+        36040000424D3604000000000000360000002800000010000000100000000100
+        2000000000000004000064000000640000000000000000000000000000000000
+        0000000000000000000000000000000000000000000000000000000000000000
+        0000000000000000FF00FFFFFF00110000005001DE00B85EDE00FFFF0000FFFF
+        0000FD59000000FF00000480E00036342EFF36342EFF36342EFF36342EFF3634
+        2EFF36342EFF36342EFF36342EFF36342EFF36342EFF00000000002FB400FDE2
+        460000099D00F19B0800002DDE0036342EFFE0E2E2FF7A7976FF36342EFF1F6E
+        43FF227A4BFF257E4EFF2A7E50FF2B7F50FF36342EFFBD6800000000FF000000
+        0000FF2B45000000A4FF0000A4FF36342EFFDEE0E0FFE0E2E2FFE0E2E2FF7A79
+        76FF36342EFF1E643EFF237446FF1F7E4BFF36342EFF24B70000FFAF0000FFFF
+        0000E4FF09000000A4FF2929EFFF0000A4FFE0E2E2FFD1D4D4FFBEC1C1FFE0E2
+        E2FFE0E2E2FF36342EFF18653BFF197544FF36342EFF0522BE000000A4FF0000
+        A4FF0000A4FF0000A4FF2929EFFF2929EFFF0000A4FFD1D4D4FFBEC1C1FFB7B9
+        B9FFE0E2E2FF36342EFF17623AFF196E41FF36342EFFE90000000000A4FF2929
+        EFFF2929EFFF2929EFFF2929EFFF0000B4FF2929EFFF0000A4FFBEC1C1FFB7B9
+        B9FFE0E2E2FF36342EFF195E39FF15703FFF36342EFFFFFF00000000A4FF2929
+        EFFF0000B4FF0000B4FF0000B4FF0000B4FF0000B4FF2929EFFF0000A4FF6A6C
+        6CFFE0E2E2FF36342EFF185B36FF136C3CFF36342EFF000000000000A4FF8282
+        FBFF0000CCFF0000CCFF0000CCFF0000CCFF0000CCFF8282FBFF0000A4FF7779
+        79FF5A5B5BFF36342EFF105932FF0E6638FF36342EFF000000000000A4FF8282
+        FBFF8282FBFF8282FBFF8282FBFF0000CCFF8282FBFF0000A4FFBBBDBDFFA2A4
+        A4FFE0E2E2FF36342EFF0D4E2BFF0D562FFF36342EFFFFFF00000000A4FF0000
+        A4FF0000A4FF0000A4FF8282FBFF8282FBFF0000A4FFCDD0D0FFBEC1C1FFB7B9
+        B9FFE0E2E2FF36342EFF083E22FF074F2AFF36342EFF62FF0000000000000000
+        0000000000000000A4FF8282FBFF0000A4FFDCDEDEFFD0D3D3FFBEC1C1FFB7B9
+        B9FFE0E2E2FF36342EFF062D18FF064121FF36342EFFF29D0900000000000000
+        0000000000000000A4FF0000A4FF36342EFFE0E2E2FFD0D3D3FFBDC0C0FFB5B7
+        B7FFE0E2E2FF36342EFF001C0DFF003318FF36342EFF00000000002BAF00FCE3
+        500000000000000000000000000036342EFFE0E2E2FFD0D3D3FFBDC0C0FFABAD
+        ADFFE0E2E2FF36342EFF000F07FF002813FF36342EFF00000000080000000000
+        1C00FFFF39001C555500FFFFFF0036342EFF36342EFF36342EFF36342EFF3634
+        2EFF36342EFF36342EFF36342EFF36342EFF36342EFF000000008803DE00A0F4
+        DD000000000056000A00808220009CEE0900000000005800000090B8E1003CB8
+        E10000000000000000000000000050B8E1000000000000000000
+      }
+      NumGlyphs = 0
+      OnClick = BitBtn2Click
+      TabOrder = 1
+    end
+    object pnlKeyboard: TPanel
+      Left = 49
+      Height = 31
+      Width = 187
+      Anchors = [akTop, akLeft, akRight]
+      TabOrder = 2
+    end
+  end
+  object PageControl1: TPageControl[1]
+    Height = 258
+    Top = 31
+    Width = 285
+    ActivePage = TabSheet1
+    Align = alClient
+    Font.Height = -10
+    Font.Name = 'Sans'
+    ParentFont = False
+    TabIndex = 0
+    TabOrder = 1
+    object TabSheet1: TTabSheet
+      Caption = 'Выбор товаров'
+      ClientHeight = 232
+      ClientWidth = 277
+      object grdBusket: TRxDBGrid
+        Height = 232
+        Width = 277
+        Columns = <        
+          item
+            ButtonStyle = cbsCheckboxColumn
+            Title.Alignment = taCenter
+            Title.Caption = '+'
+            Width = 12
+            FieldName = 'Selected'
+            Filter.ItemIndex = -1
+          end        
+          item
+            Font.Height = -7
+            Font.Name = 'Sans'
+            Title.Alignment = taCenter
+            Title.Caption = 'Ост.'
+            Width = 25
+            FieldName = 'RemainsCurrent'
+            Filter.ItemIndex = -1
+          end        
+          item
+            Font.Height = -10
+            Font.Name = 'Arial'
+            ReadOnly = True
+            Title.Alignment = taCenter
+            Title.Caption = 'Товар'
+            Width = 80
+            FieldName = 'Good_Name'
+            Filter.ItemIndex = -1
+          end        
+          item
+            Title.Alignment = taCenter
+            Title.Caption = 'Кол-во'
+            Width = 32
+            FieldName = 'Quantity'
+            Filter.ItemIndex = -1
+          end        
+          item
+            Title.Alignment = taCenter
+            Title.Caption = 'Дилер'
+            Width = 50
+            FieldName = 'Dealer'
+            Filter.ItemIndex = -1
+          end        
+          item
+            ReadOnly = True
+            Title.Alignment = taCenter
+            Title.Caption = 'Цена'
+            FieldName = 'Price'
+            DisplayFormat = '#,###.##'
+            Filter.ItemIndex = -1
+          end        
+          item
+            ReadOnly = True
+            Title.Alignment = taCenter
+            Title.Caption = 'Стоимость'
+            FieldName = 'PriceSum'
+            DisplayFormat = '#,###.##'
+            Filter.ItemIndex = -1
+          end>
+        AllowedOperations = [aoUpdate]
+        OptionsRx = [rdgDblClickOptimizeColWidth]
+        Align = alClient
+        FocusColor = clRed
+        FixedHotColor = cl3DLight
+        SelectedColor = clHighlight
+        DataSource = dsrcOrderGoods
+        FixedColor = clBtnFace
+        Font.Height = -10
+        Font.Name = 'Sans'
+        Options = [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColLines, dgRowLines, dgTabs, dgAlwaysShowEditor, dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit]
+        OptionsExtra = [dgeCheckboxColumn]
+        ParentColor = False
+        ParentFont = False
+        Scrollbars = ssAutoBoth
+        TabOrder = 0
+        TitleFont.Height = -8
+        TitleFont.Name = 'Sans'
+        TitleStyle = tsStandard
+      end
+    end
+    object tbOrderSum: TTabSheet
+      Caption = 'Итого'
+      ClientHeight = 225
+      ClientWidth = 279
+      OnShow = tbOrderSumShow
+      object ledtOrderSum: TLabeledEdit
+        Left = 6
+        Height = 23
+        Top = 29
+        Width = 80
+        EditLabel.AnchorSideLeft.Control = ledtOrderSum
+        EditLabel.AnchorSideBottom.Control = ledtOrderSum
+        EditLabel.Left = 6
+        EditLabel.Height = 20
+        EditLabel.Top = 6
+        EditLabel.Width = 93
+        EditLabel.Caption = 'Сумма заказа:'
+        EditLabel.ParentColor = False
+        ParentColor = False
+        TabOrder = 0
+      end
+    end
+  end
+  object Panel2: TPanel[2]
+    Height = 51
+    Top = 289
+    Width = 285
+    Align = alBottom
+    ClientHeight = 51
+    ClientWidth = 285
+    TabOrder = 2
+    object memGoodHint: TMemo
+      Left = 1
+      Height = 49
+      Top = 1
+      Width = 283
+      Align = alClient
+      Font.Height = -10
+      Font.Name = 'Sans'
+      ParentFont = False
+      ReadOnly = True
+      TabOrder = 0
+    end
+  end
+  object dsrcOrderGoods: TDatasource[3]
+    DataSet = dsBusket
+    left = 200
+    top = 232
+  end
+  object dsBusket: TMemDataset[4]
+    FieldDefs = <>
+    BeforeEdit = dsBusketBeforeEdit
+    AfterEdit = dsBusketAfterEdit
+    BeforePost = dsBusketBeforePost
+    AfterScroll = dsBusketAfterScroll
+    left = 173
+    top = 175
+  end
+end

examples/germesorders/uordergoods.pas

@@ -0,0 +1,588 @@
+unit uOrderGoods;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
+  Buttons, rxdbgrid, sqlite3ds, db, ComCtrls, StdCtrls, uDbTypes, memds2, ufrmParent,
+  contnrs;
+
+type
+  TGoodShowType = (gstBusket=1, gstOrder=2);
+
+  { TfrmOrderGoods }
+
+  TfrmOrderGoods = class(TfrmParent)
+    BitBtn1: TBitBtn;
+    BitBtn2: TBitBtn;
+    dsrcOrderGoods: TDatasource;
+    dsBusket: TMemDataset;
+    ledtOrderSum: TLabeledEdit;
+    memGoodHint: TMemo;
+    PageControl1: TPageControl;
+    Panel1: TPanel;
+    grdBusket: TRxDBGrid;
+    Panel2: TPanel;
+    pnlKeyboard: TPanel;
+    TabSheet1: TTabSheet;
+    tbOrderSum: TTabSheet;
+    procedure BitBtn1Click(Sender: TObject);
+    procedure BitBtn2Click(Sender: TObject);
+    procedure dsBusketAfterEdit(DataSet: TDataSet);
+    procedure dsBusketAfterScroll(DataSet: TDataSet);
+    procedure dsBusketBeforeEdit(DataSet: TDataSet);
+    procedure dsBusketBeforePost(DataSet: TDataSet);
+    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
+    procedure FormResize(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+    procedure tbOrderSumShow(Sender: TObject);
+  private
+    CopyingRecords:boolean;
+    FGoodShowType: TGoodShowType;
+    FId_Order: TDbKeyType;
+    DealerDefault:string;
+    FId_Org: TDbKeyType;
+    KeyboardControls:TComponentList;
+    { private declarations }
+    procedure DealerPickListFill;
+    procedure SaveOrder;
+    procedure Reload;
+    procedure BusketFieldsDefine;
+    procedure KeyboardCreate;
+    procedure OnKeyboardClick(Sender:TObject);
+  public
+    constructor Create(AOwner:TComponent);override;
+    destructor Destroy;override;
+  
+    { public declarations }
+    property Id_Order:TDbKeyType read FId_Order write FId_Order;
+    property Id_Org:TDbKeyType read FId_Org write FId_Org;
+    property GoodShowType:TGoodShowType read FGoodShowType write FGoodShowType;
+  end; 
+
+var
+  frmOrderGoods: TfrmOrderGoods;
+
+implementation
+uses uConfig, uDebug, uUtils, uBase, variants, uOptionConst, LCLType;
+
+{ TfrmOrderGoods }
+
+procedure TfrmOrderGoods.BitBtn2Click(Sender: TObject);
+begin
+  GlobalLogger.Log('Закрытие формы TfrmOrderGoods');
+  Close;
+end;
+
+procedure TfrmOrderGoods.dsBusketAfterEdit(DataSet: TDataSet);
+begin
+  dsBusketAfterScroll(DataSet);
+end;
+
+procedure TfrmOrderGoods.dsBusketAfterScroll(DataSet: TDataSet);
+begin
+  if CopyingRecords then Exit;
+  memGoodHint.Lines.Text:=Dataset.FieldByName('Good_Name').AsString;
+  memGoodHint.Invalidate;
+end;
+
+procedure TfrmOrderGoods.dsBusketBeforeEdit(DataSet: TDataSet);
+var D:String;
+begin
+  if Dataset.FieldByName('Dealer').IsNull then
+    begin
+      D:=DealerDefault;
+      {
+      //последний дилер
+      if D = '' then
+        D:=BaseConnect.OptionUser[goOptDealerCurrent];}
+      if D = '' then
+        D:='0'; //розница
+      Dataset.FieldByName('Dealer').AsString:=D;
+    end;
+
+  dsBusketAfterScroll(DataSet);
+end;
+
+procedure TfrmOrderGoods.dsBusketBeforePost(DataSet: TDataSet);
+var S:String;
+    P:Variant;
+    PS:Variant;
+begin
+  if CopyingRecords then Exit;
+
+  S:='';
+  if dsBusket.FieldByName('Selected').AsInteger = 1 then
+    begin
+      if dsBusket.FieldByName('Quantity').IsNull or
+         (dsBusket.FieldByName('Quantity').AsFloat <= 0.000001) then
+         begin
+           S:='Поле Количество не заполнено';
+         end;
+
+      if dsBusket.FieldByName('Dealer').IsNull then
+        S:='Поле Дилер должно быть заполнено'
+        else
+        begin
+          P:=BaseConnect.DLookup(Format('select Price from Price where Good=%d and Dealer=%d',
+                                  [dsBusket.FieldByName('ID_Good').AsInteger,
+                                   dsBusket.FieldByName('Dealer').AsInteger]), 'Price');
+          dsBusket.FieldByName('Price').AsVariant:=P;
+          if VarIsNull(P) then
+            begin
+              S:='Для Дилера не задана цена.' + #13#10 +
+                 Format('Товар=%d, дилер=%d',
+                    [dsBusket.FieldByName('ID_Good').AsInteger,
+                     dsBusket.FieldByName('Dealer').AsInteger]);
+              PS:=null;
+            end
+            else
+            PS:=P*dsBusket.FieldByName('Quantity').AsFloat;
+          dsBusket.FieldByName('PriceSum').AsVariant:=PS;
+
+          //запоминание номера дилера
+          BaseConnect.OptionUser[goOptDealerCurrent]:=dsBusket.FieldByName('Dealer').AsString;
+        end;
+    end;
+
+  dsBusket.FieldByName('RemainsCurrent').AsFloat:=
+     dsBusket.FieldByName('Remains').AsFloat - dsBusket.FieldByName('Quantity').AsFloat;
+
+  if S <> '' then
+    begin
+      ShowMessage(S);
+
+      //снимаем выделение
+      dsBusket.FieldByName('Selected').AsInteger:=0;
+    end;
+end;
+
+procedure TfrmOrderGoods.FormClose(Sender: TObject;
+  var CloseAction: TCloseAction);
+begin
+  CloseAction:=caHide;
+end;
+
+procedure TfrmOrderGoods.FormResize(Sender: TObject);
+begin
+  KeyboardCreate;
+end;
+
+procedure TfrmOrderGoods.FormShow(Sender: TObject);
+begin
+  GlobalLogger.Log('Открытие формы TfrmOrderGoods');
+  Reload;
+end;
+
+procedure TfrmOrderGoods.tbOrderSumShow(Sender: TObject);
+var OrderSum:Double;
+begin
+  if not dsBusket.Active then Exit;
+
+  {
+  //по неизвестной причине в ARM считает не правильно
+  SaveOrder;
+  ledtOrderSum.Text:=VarToStr(BaseConnect.DLookup(
+    'SELECT SUM(Price*Quantity) as S FROM Order_List Where ID_Order=%d', [ID_Order], 'S'));
+    //'SELECT SUM((Price + 0.0)*(Quantity + 0.0) + 0.0) as S FROM Order_List Where ID_Order=%d', [ID_Order], 'S'));
+  }
+  GlobalLogger.Log('Подсчет суммы заказа');
+  CopyingRecords:=true;
+  try
+    dsBusket.DisableControls;
+    dsBusket.First;
+    OrderSum:=0;
+    while not dsBusket.EOF do
+    begin
+      if dsBusket.FieldByName('Selected').AsInteger <> 0 then
+        begin
+          OrderSum:=OrderSum + dsBusket.FieldByName('Price').AsFloat * dsBusket.FieldByName('Quantity').AsFloat;
+        end;
+
+      dsBusket.Next;
+    end;
+    
+    dsBusket.First;
+    ledtOrderSum.Text:=FormatFloat('#,###.##', OrderSum);
+    GlobalLogger.Log('Подсчет суммы заказа успешно завершено');
+  finally
+    CopyingRecords:=false;
+    dsBusket.EnableControls;
+  end;
+end;
+
+procedure TfrmOrderGoods.BitBtn1Click(Sender: TObject);
+begin
+  SaveOrder;
+  Close;
+end;
+
+{
+procedure TfrmOrderGoods.SaveOrder;
+var PostDS:TSqlite3Dataset;
+begin
+  GlobalLogger.Log('Сохранение заказа с id=%d. Старт', [ID_Order]);
+
+  GlobalLogger.Log('Очистка существующего содержимого заказа');
+  //сначала удалим все из существующего заказа
+  BaseConnect.SQLExec('DELETE FROM Order_List WHERE ID_Order=' + IntToStr(ID_Order));
+
+  GlobalLogger.Log('Добавление товаров в заказ');
+  PostDS:=nil;
+  CopyingRecords:=true;
+  try
+    PostDS:=BaseConnect.DatasetCreate('Order_List', 'ID');
+    
+    //dsrcOrderGoods.Enabled:=False;
+    dsBusket.DisableControls;
+    dsBusket.First;
+    while not dsBusket.EOF do
+    begin
+      if dsBusket.FieldByName('Selected').AsInteger <> 0 then
+        begin
+          PostDS.Append;
+          PostDS.FieldByName('ID_Order').AsInteger:=Id_Order;
+          PostDS.FieldByName('Good').AsInteger  :=dsBusket.FieldByName('ID_Good').AsInteger;
+          PostDS.FieldByName('Price').AsFloat   :=dsBusket.FieldByName('Price').AsFloat;
+          PostDS.FieldByName('Quantity').AsFloat:=dsBusket.FieldByName('Quantity').AsFloat;
+          PostDS.FieldByName('Dealer').AsInteger:=dsBusket.FieldByName('Dealer').AsInteger;
+          PostDS.Post;
+        end;
+      
+      dsBusket.Next;
+    end;
+    
+    GlobalLogger.Log('Применение заказа');
+    PostDS.ApplyUpdates;
+  finally
+    //dsrcOrderGoods.Enabled:=true;
+    CopyingRecords:=false;
+    dsBusket.EnableControls;
+    PostDS.Free;
+
+    GlobalLogger.Log('Сохранение заказа с id=%d. Финиш', [ID_Order]);
+  end;
+end;
+}
+procedure TfrmOrderGoods.SaveOrder;
+var Fmt: TFormatSettings;
+    S:String;
+begin
+  GlobalLogger.Log('Сохранение заказа с id=%d. Старт', [ID_Order]);
+
+  GlobalLogger.Log('Очистка существующего содержимого заказа');
+  //сначала удалим все из существующего заказа
+  BaseConnect.SQLExec('DELETE FROM Order_List WHERE ID_Order=' + IntToStr(ID_Order));
+
+  GlobalLogger.Log('Добавление товаров в заказ');
+  CopyingRecords:=true;
+  
+  Fmt:=DefaultFormatSettings;
+  Fmt.DecimalSeparator:='.';
+  try
+    dsBusket.DisableControls;
+    dsBusket.First;
+    while not dsBusket.EOF do
+    begin
+      if dsBusket.FieldByName('Selected').AsInteger <> 0 then
+        begin
+          S:=Format('INSERT INTO Order_List(ID, ID_Order, Good, Price, Quantity, Dealer) ' +
+                              'VALUES(NULL, %d, %d, %s, %s, %d)',
+                              [Id_Order, dsBusket.FieldByName('ID_Good').AsInteger,
+                               FloatToStr(dsBusket.FieldByName('Price').AsFloat, Fmt),
+                               FloatToStr(dsBusket.FieldByName('Quantity').AsFloat, Fmt),
+                               dsBusket.FieldByName('Dealer').AsInteger
+                               ]);
+          BaseConnect.SQLExec(S);
+        end;
+
+      dsBusket.Next;
+    end;
+
+    GlobalLogger.Log('Применение заказа');
+  finally
+    //dsrcOrderGoods.Enabled:=true;
+    CopyingRecords:=false;
+    dsBusket.EnableControls;
+
+    GlobalLogger.Log('Сохранение заказа с id=%d. Финиш', [ID_Order]);
+  end;
+end;
+
+procedure TfrmOrderGoods.Reload;
+var dsOrder_Busket:TSqlite3Dataset;
+    S:string;
+    SubGroupId, GroupId:String;
+    Filter, ShowTypeFilter:string;
+    Q, P:Variant;
+begin
+  GlobalLogger.Log('Заполнение корзины товаров');
+  DealerPickListFill;
+
+  SubGroupId:=BaseConnect.OptionUser[goOptSubGroupCurrent];
+  if SubGroupId = '' then
+    begin
+      ShowMessage('Не выбрана текущая подгруппа товаров');
+      dsBusket.Close;
+    end;
+    
+  GroupId:=BaseConnect.OptionUser[goOptGroupCurrent];
+  if GroupId = '' then
+    begin
+      ShowMessage('Не выбрана текущая группа товаров');
+      dsBusket.Close;
+    end;
+
+  {
+  if SubGroupId = '0' then
+    Filter:='left join Good_Groups h on (o.ID_Good = h.Good and h.ID_Group=' + GroupId + ') '
+    else
+    Filter:='left join HierGoods h on (o.ID_Good = h.Good and h.ParentId=' + SubGroupId + ') ';
+  }
+  if SubGroupId = '0' then
+    Filter:='left join Good_Groups h on (g.ID = h.Good and h.ID_Group=' + GroupId + ') '
+    else
+    Filter:='left join HierGoods h on (g.ID = h.Good and h.ParentId=' + SubGroupId + ') ';
+
+  DealerDefault:=VarToStr(BaseConnect.DLookup('SELECT DealerDefault FROM Orgs WHERE Id = %d', [Id_Org], 'DealerDefault'));
+
+  ShowTypeFilter:='';
+  {
+  case GoodShowType of
+    gstBusket:
+      ShowTypeFilter:=Iif(Id_Order <> -1, Format(' WHERE (ID_Order=-1 or ID_Order=%d) and ((o.Selected=1) or not (h.Good is null)) ', [Id_Order]), '');
+    gstOrder:
+      ShowTypeFilter:=Format(' WHERE (ID_Order=%d) and (o.Selected=1) ', [Id_Order]);
+    else
+      begin
+        ShowMessage('Неизвестный тип показа заказа');
+      end;
+  end;
+  }
+  case GoodShowType of
+    gstBusket:
+      //ShowTypeFilter:=Iif(Id_Order <> -1, Format(' WHERE (ol.ID_Order is null or ol.ID_Order=%d) and ((ol.ID is not null) or (h.Good is not null)) ', [Id_Order]), '');
+      //ShowTypeFilter:=Iif(Id_Order <> -1, Format(' WHERE (ol.ID_Order is null and (h.Good is not null)) or (ol.ID_Order=%d and (ol.ID is not null)) ', [Id_Order]), '');
+      ShowTypeFilter:=Iif(Id_Order <> -1, Format(' WHERE (ol.ID_Order is null and (h.Good is not null)) or (ol.ID is not null) ', [Id_Order]), '');
+    gstOrder:
+      ShowTypeFilter:=Format(' WHERE (ol.ID_Order=%d) and (ol.ID is not null) ', [Id_Order]);
+    else
+      begin
+        ShowMessage('Неизвестный тип показа заказа');
+      end;
+  end;
+
+  dsOrder_Busket:=nil;
+  try
+    {S:=
+      'SELECT ID_Order, Selected, ID_Order_List, o.ID_Good as ID_Good, ' +
+      'Good_Name, Price, Quantity, Remains, ' +
+      'Dealer '+
+      'FROM Order_Busket o ' +
+      Filter +
+      ShowTypeFilter +
+      ' ORDER BY Good_Name';
+    }
+    S:=Format(
+      'SELECT coalesce(ol.ID_Order, -1) as ID_Order, ' +
+             'coalesce(ol.ID+1, 0)/coalesce(ol.ID+1, 1) as Selected, ' +
+             'coalesce(ol.ID, -1) as ID_Order_List, '+
+             'g.ID as ID_Good, ' +
+             'g.Name as Good_Name, ' +
+             'ol.Price as Price, ' +
+             'ol.Quantity as Quantity, ' +
+             'coalesce(g.Remains, 0) as Remains, ' +
+             'ol.Dealer as Dealer '+
+      'FROM Goods g left join Order_List ol on (g.ID=ol.Good and ol.ID_Order=%d) ' +
+      Filter +
+      ShowTypeFilter +
+      ' ORDER BY Good_Name', [Id_Order]);
+      
+    GlobalLogger.Log('Открытие датасета dsOrder_Busket (%s)', [S]);
+    dsOrder_Busket:=BaseConnect.DatasetCreate(S);
+
+    dsBusket.DisableControls;
+    try
+      GlobalLogger.Log('Заполнение временного датасета. Старт');
+      CopyingRecords:=true;
+      //dsBusket.CopyFromDataset(dsOrder_Busket, true);
+      
+      dsBusket.Clear(False);
+      dsBusket.Open;
+      
+      GlobalLogger.LogDatasetFieldNames('dsOrder_Busket', dsOrder_Busket);
+
+      while not dsOrder_Busket.EOF do
+      begin
+        dsBusket.Append;
+        DbFieldAssignAsDbKey(dsBusket, 'ID_Order', dsOrder_Busket.FieldByName('ID_Order'));
+        dsBusket.FieldByName('Selected').AsVariant:=dsOrder_Busket.FieldByName('Selected').AsVariant;
+        dsBusket.FieldByName('ID_Order_List').AsVariant:=dsOrder_Busket.FieldByName('ID_Order_List').AsVariant;
+        dsBusket.FieldByName('ID_Good').AsVariant:=dsOrder_Busket.FieldByName('ID_Good').AsVariant;
+        dsBusket.FieldByName('Good_Name').AsVariant:=dsOrder_Busket.FieldByName('Good_Name').AsVariant;
+        dsBusket.FieldByName('Dealer').AsVariant:=dsOrder_Busket.FieldByName('Dealer').AsVariant;
+        
+        P:=dsOrder_Busket.FieldByName('Price').AsVariant;
+        dsBusket.FieldByName('Price').AsVariant:=P;
+        if VarIsNull(P) then P:=0;
+        
+        Q:=dsOrder_Busket.FieldByName('Quantity').AsVariant;
+        dsBusket.FieldByName('Quantity').AsVariant:=Q;
+
+        if VarIsNull(Q) then Q:=0;
+        dsBusket.FieldByName('PriceSum').AsFloat:=Q*P;
+        
+        dsBusket.FieldByName('Remains').AsFloat:=dsOrder_Busket.FieldByName('Remains').AsFloat + Q;
+        dsBusket.FieldByName('RemainsCurrent').AsVariant:=dsOrder_Busket.FieldByName('Remains').AsVariant;
+        dsBusket.Post;
+
+        dsOrder_Busket.Next;
+      end;
+
+      dsBusket.First;
+      
+      GlobalLogger.Log('Заполнение временного датасета. Финиш');
+    finally
+      dsBusket.EnableControls;
+      CopyingRecords:=False;
+    end;
+  finally
+    dsOrder_Busket.Free;
+  end;
+end;
+
+procedure TfrmOrderGoods.BusketFieldsDefine;
+begin
+  dsBusket.FieldDefs.Add('ID_Order', ftDbKey);
+  dsBusket.FieldDefs.Add('Selected', ftInteger);
+  dsBusket.FieldDefs.Add('ID_Order_List', ftDbKey);
+  dsBusket.FieldDefs.Add('ID_Good', ftDbKey);
+  dsBusket.FieldDefs.Add('Good_Name', ftString, 250);
+  dsBusket.FieldDefs.Add('Price', ftFloat);
+  dsBusket.FieldDefs.Add('PriceSum', ftFloat);
+  dsBusket.FieldDefs.Add('Quantity', ftFloat);
+  dsBusket.FieldDefs.Add('Dealer', ftInteger);
+  dsBusket.FieldDefs.Add('Remains', ftFloat);
+  dsBusket.FieldDefs.Add('RemainsCurrent', ftFloat);
+  dsBusket.CreateTable;
+end;
+
+const
+  BackSpaceTag = 100;
+
+procedure TfrmOrderGoods.OnKeyboardClick(Sender: TObject);
+var S,Q:String;
+begin
+  if ActiveControl = nil then Exit;
+  
+  Q:=dsBusket.FieldByName('Quantity').AsString;
+  if TComponent(Sender).Tag = BackSpaceTag then
+     begin
+       S:='';
+       if Length(Q) > 0 then S:=Copy(Q, 1, Length(Q)-1);
+     end
+    else
+     begin
+       S:=Q + IntToStr(TComponent(Sender).Tag);
+     end;
+  dsBusket.FieldByName('Quantity').AsString:=S;
+  dsBusketBeforePost(dsBusket);
+end;
+
+procedure TfrmOrderGoods.KeyboardCreate;
+var n:integer;
+    ButWidth:Integer;
+    ButWidthF:double;
+    
+function ButtonCreate(Caption:string; LeftPos, TagN:Integer):TButton;
+var B:TButton;
+begin
+  B:=TButton.Create(self);
+  B.Parent:=pnlKeyboard;
+
+  B.BorderWidth:=0;
+  B.Font.Name:='Sans';
+  B.Font.Size:=7;
+
+  B.Left:=LeftPos;
+  B.Top:=0;
+  B.Width:=ButWidth;
+  B.Height:=pnlKeyboard.Height;
+  B.Caption:=Caption;
+  B.OnClick:=@OnKeyboardClick;
+  B.Tag:=TagN;
+
+  KeyboardControls.Add(B);
+  Result:=B;
+end;
+    
+begin
+  KeyboardControls.Clear;
+  
+  ButWidthF:=pnlKeyboard.Width/11;
+  ButWidth:=trunc(ButWidthF);
+  
+  for n:=0 to 9 do
+    begin
+      ButtonCreate(IntToStr(n), trunc(n*ButWidthF), n);
+    end;
+  ButtonCreate('<', trunc((n+1)*ButWidthF), BackSpaceTag);
+end;
+
+procedure TfrmOrderGoods.DealerPickListFill;
+var SQL:TSqlite3Dataset;
+    C:TRxColumn;
+begin
+  GlobalLogger.Log('Заполнение picklist для столбца дилер');
+
+  C:=grdBusket.ColumnByFieldName('Dealer');
+  C.KeyList.Clear;
+  C.PickList.Clear;
+
+  SQL:=nil;
+  try
+    SQL:=BaseConnect.DatasetCreate('select d.id, d.Name from Dealers d order by d.Name');
+    while not SQL.EOF do
+    begin
+      C.KeyList.Add( SQL.FieldByName('id').AsString );
+      C.PickList.Add( SQL.FieldByName('Name').AsString );
+      SQL.Next;
+    end;
+  finally
+    SQL.Free;
+  end;
+end;
+
+constructor TfrmOrderGoods.Create(AOwner: TComponent);
+begin
+  GlobalLogger.Log('constructor TfrmOrderGoods.Create. Старт');
+
+  FId_Order:=-1;
+  FGoodShowType:=gstBusket;
+  CopyingRecords:=false;
+  KeyboardControls:=TComponentList.create(true);
+  KeyboardControls.OwnsObjects:=True;
+  
+  Inherited;
+
+  BusketFieldsDefine;
+  KeyboardCreate;
+  
+  GlobalLogger.Log('constructor TfrmOrderGoods.Create. Финиш');
+end;
+
+destructor TfrmOrderGoods.Destroy;
+begin
+  KeyboardControls.Free;
+
+  inherited Destroy;
+end;
+
+
+initialization
+  {$I uordergoods.lrs}
+
+end.
+

examples/germesorders/uorders.lfm

@@ -0,0 +1,295 @@
+inherited frmOrders: TfrmOrders
+  Left = 515
+  Height = 314
+  Top = 242
+  Width = 237
+  HorzScrollBar.Page = 236
+  VertScrollBar.Page = 313
+  ActiveControl = grdOrders
+  Caption = 'Список заказов'
+  ClientHeight = 314
+  ClientWidth = 237
+  OnActivate = FormActivate
+  OnCreate = FormCreate
+  object Panel1: TPanel
+    Height = 31
+    Width = 237
+    Align = alTop
+    ClientHeight = 31
+    ClientWidth = 237
+    TabOrder = 0
+    object btnOrderAdd: TBitBtn
+      Left = 69
+      Height = 24
+      Hint = 'Сохранить заказ'
+      Top = 1
+      Width = 31
+      AutoSize = True
+      Glyph.Data = {
+        36040000424D3604000000000000360000002800000010000000100000000100
+        200000000000000400006400000064000000000000000000000051514B003E3D
+        37003D3C36003D3C36003D3C36003D3C36003C3B34003D3C36003D3C36003D3C
+        36003D3C36003D3C360040403B0042423D003E3D3700565651003E3D37004B4D
+        4A004B4D4A004C4E4B004D504D004E514F004F52500050535100525553005053
+        51004F524F004E504E004E514F004B4D4A004A4C49003D3C36003C3B34004B4D
+        4A003B3A34003D3D380043444000484A4500545856FF555957FF555957FF5458
+        56FF4B4C4A004546420040403C003B3A34004A4C49003C3B350051524C008E93
+        91008E9491008E949100999E9B00898F8C00535755FFD2D4D3FFD2D4D3FF5559
+        57FF9CA09D008E9491008E949100999E9B008E93910051524C006F726E00FFFF
+        FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00535755FFD6D8D7FFD6D8D7FF5559
+        57FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006769640073767200FDFD
+        FD00858A8700BCC3C000C5CAC900E2E5E400535755FFD3D5D4FFD3D5D4FF5559
+        57FFE0E3E200C0C6C400B6BDBA0080858300F8F8F80073767200858A8800F5F6
+        F500535755FF535755FF535755FF535755FF535755FFCBCDCCFFCBCDCCFF565A
+        58FF535755FF535755FF535755FF535755FFECEEED00858A8800858A8800EFF1
+        F000535755FFDADCDBFFC3C5C4FFC2C4C3FFC2C4C3FFC2C4C3FFC2C4C3FFC2C4
+        C3FFC2C4C3FFC2C4C3FFC2C4C3FF535755FFE5E7E700858A8800858A8800EDEF
+        EF00535755FFDADDDCFFDBDDDCFFDCDEDDFFDBDDDCFFDBDDDCFFBFC1C0FFBFC1
+        C0FFBFC1C0FFBFC1C0FFC0C2C1FF535755FFE2E5E400858A8800858A8800F1F3
+        F200535755FF535755FF535755FF545856FF585C5AFFDCDEDDFFBABCBBFF575B
+        59FF535755FF535755FF535755FF535755FFE8EAEA00858A8800858A8800F4F6
+        F5004CB57F00069A4E00069A4E001EA76100535755FFDBDDDCFFBABCBBFF565A
+        58FF2AAE6A00069A4E00069A4E0042B07800EAECEC00858A8800858A8800F3F5
+        F500EBEDED00FBFCFC00EBEDED000A9C5100545856FFDBDDDCFFBABCBBFF5559
+        57FF109E5500DFE6E300D1D4D400E3E6E500EEF0EF00858A8800868B8900EFF1
+        F100F3F5F500FDFDFD00F3F5F5000A9C5100545856FFDADCDBFFB9BBBAFF5458
+        56FF109E5500ECF2F000DFE1E100F3F5F500EFF1F100868B890082878500888D
+        8B00858A8800858A8800858A8800089B5000535755FF545856FF535755FF5357
+        55FF0E9D5400818B8600858A8800858A8800868B890083868500400000000004
+        04000000000000000000020000000B9D5200D1F8E400D6F9E800D6F9E800D6F9
+        E8000F9D54000004040000000000000000000200E7008C01800050C1E10028E5
+        C40000000000C080010000000400179B5700069A4E00069A4E00069A4E00069A
+        4E00109953000000000000000000800001000000040000000000
+      }
+      NumGlyphs = 0
+      OnClick = btnOrderAddClick
+      TabOrder = 0
+    end
+    object btnClose: TBitBtn
+      Left = 196
+      Height = 24
+      Hint = 'Сохранить заказ'
+      Top = 2
+      Width = 31
+      Anchors = [akRight]
+      AutoSize = True
+      Glyph.Data = {
+        36040000424D3604000000000000360000002800000010000000100000000100
+        2000000000000004000064000000640000000000000000000000000000000000
+        0000000000000000000000000000000000000000000000000000000000000000
+        0000000000000000FF00FFFFFF00110000005001DE00B85EDE00FFFF0000FFFF
+        0000FD59000000FF00000480E00036342EFF36342EFF36342EFF36342EFF3634
+        2EFF36342EFF36342EFF36342EFF36342EFF36342EFF00000000002FB400FDE2
+        460000099D00F19B0800002DDE0036342EFFE0E2E2FF7A7976FF36342EFF1F6E
+        43FF227A4BFF257E4EFF2A7E50FF2B7F50FF36342EFFBD6800000000FF000000
+        0000FF2B45000000A4FF0000A4FF36342EFFDEE0E0FFE0E2E2FFE0E2E2FF7A79
+        76FF36342EFF1E643EFF237446FF1F7E4BFF36342EFF24B70000FFAF0000FFFF
+        0000E4FF09000000A4FF2929EFFF0000A4FFE0E2E2FFD1D4D4FFBEC1C1FFE0E2
+        E2FFE0E2E2FF36342EFF18653BFF197544FF36342EFF0522BE000000A4FF0000
+        A4FF0000A4FF0000A4FF2929EFFF2929EFFF0000A4FFD1D4D4FFBEC1C1FFB7B9
+        B9FFE0E2E2FF36342EFF17623AFF196E41FF36342EFFE90000000000A4FF2929
+        EFFF2929EFFF2929EFFF2929EFFF0000B4FF2929EFFF0000A4FFBEC1C1FFB7B9
+        B9FFE0E2E2FF36342EFF195E39FF15703FFF36342EFFFFFF00000000A4FF2929
+        EFFF0000B4FF0000B4FF0000B4FF0000B4FF0000B4FF2929EFFF0000A4FF6A6C
+        6CFFE0E2E2FF36342EFF185B36FF136C3CFF36342EFF000000000000A4FF8282
+        FBFF0000CCFF0000CCFF0000CCFF0000CCFF0000CCFF8282FBFF0000A4FF7779
+        79FF5A5B5BFF36342EFF105932FF0E6638FF36342EFF000000000000A4FF8282
+        FBFF8282FBFF8282FBFF8282FBFF0000CCFF8282FBFF0000A4FFBBBDBDFFA2A4
+        A4FFE0E2E2FF36342EFF0D4E2BFF0D562FFF36342EFFFFFF00000000A4FF0000
+        A4FF0000A4FF0000A4FF8282FBFF8282FBFF0000A4FFCDD0D0FFBEC1C1FFB7B9
+        B9FFE0E2E2FF36342EFF083E22FF074F2AFF36342EFF62FF0000000000000000
+        0000000000000000A4FF8282FBFF0000A4FFDCDEDEFFD0D3D3FFBEC1C1FFB7B9
+        B9FFE0E2E2FF36342EFF062D18FF064121FF36342EFFF29D0900000000000000
+        0000000000000000A4FF0000A4FF36342EFFE0E2E2FFD0D3D3FFBDC0C0FFB5B7
+        B7FFE0E2E2FF36342EFF001C0DFF003318FF36342EFF00000000002BAF00FCE3
+        500000000000000000000000000036342EFFE0E2E2FFD0D3D3FFBDC0C0FFABAD
+        ADFFE0E2E2FF36342EFF000F07FF002813FF36342EFF00000000080000000000
+        1C00FFFF39001C555500FFFFFF0036342EFF36342EFF36342EFF36342EFF3634
+        2EFF36342EFF36342EFF36342EFF36342EFF36342EFF000000008803DE00A0F4
+        DD000000000056000A00808220009CEE0900000000005800000090B8E1003CB8
+        E10000000000000000000000000050B8E1000000000000000000
+      }
+      NumGlyphs = 0
+      OnClick = btnCloseClick
+      TabOrder = 1
+    end
+    object btnOrderDel: TBitBtn
+      Left = 106
+      Height = 24
+      Hint = 'Сохранить заказ'
+      Top = 1
+      Width = 31
+      AutoSize = True
+      Glyph.Data = {
+        36040000424D3604000000000000360000002800000010000000100000000100
+        20000000000000040000640000006400000000000000000000005E0006005F00
+        07006100060062000700640006006500070067000600680007006A0006006B00
+        07006D0006006E00070070000600710007007300060074000700460006004700
+        0700490006004A0007004C0006000F0257FF160198FF0408A6FF0600A2FF2300
+        A7FF3C3D66FF5600070058000600590007005B0006005C0007002E0006002F00
+        0700310006003200070003009EFF1414D6FF1718E0FF1717E0FF1617DFFF1616
+        DEFF1111D4FF00009EFF40000600410007004300060044000700160006001700
+        0700190006000707B7FF1A1AE2FF0B0BCEFF0101BFFF0000BCFF0000BBFF0101
+        BCFF0909C9FF1415DDFF0606B5FF290007002B0006002C000700830003008400
+        04000600A1FF1C1CE4FF0505C8FF0000BFFF0000BEFF0000BDFF0000BDFF0000
+        BCFF0000BAFF0404C2FF1515DDFF0000A2FF13000600140007006B0003001604
+        C5FF1717D9FF0D0DD2FF0000C1FFFFFFFFFFFFFFFFFF0000BFFF0000BEFFFFFF
+        FFFFFFFFFFFF0000BBFF0909CAFF1212D4FF000057FF81000400530003000203
+        87FF201FE6FF0202C6FF0000C3FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+        FFFFFFFFFFFF0000BCFF0101BDFF1616DEFF212AA5FF690004003B0003000000
+        9FFF2121E9FF0000C4FF0000C4FF0000C2FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+        FFFF0000BEFF0000BDFF0000BCFF1817E0FF00009FFF51000400230003000500
+        9FFF2222EAFF0000C6FF0000C5FF0000C3FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+        FFFF0000BFFF0000BEFF0000BEFF1819E1FF00009FFF390004000B0003000000
+        86FF2323E9FF0202C9FF0000C6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+        FFFFFFFFFFFF0000BFFF0101C1FF1919E1FF000086FF21000400760002000000
+        57FF1A1ADCFF0F0FD7FF0000C7FFFFFFFFFFFFFFFFFF0000C4FF0000C4FFFFFF
+        FFFFFFFFFFFF0000C1FF0B0BD0FF1515D8FF000057FF090004005E0002005F00
+        03000200A0FF2424EAFF0707D0FF0000C7FF0000C6FF0000C5FF0000C4FF0000
+        C3FF0000C3FF0505CAFF1C1CE3FF08029FFF7300020074000300460002004700
+        0300490002000808B7FF2424EBFF0F0FD7FF0202CAFF0000C6FF0000C5FF0202
+        C8FF0D0DD4FF1E1EE6FF0707B7FF590003005B0002005C0003002E0002002F00
+        0300310002003200030002009EFF1B1BDCFF2424EBFF2424EAFF2323EAFF2121
+        E8FF1819DAFF00019EFF40000200410003004300020044000300160002001700
+        0300190002001A0003001C000200000057FF000086FF00009FFF00009FFF290C
+        8BFF000057FF2600030028000200290003002B0002002C00030090C3E10090C3
+        E1000100020002000300040002000500030007000200080003000A0002000B00
+        03000D0002000E00030010000200110003001300020014000300
+      }
+      NumGlyphs = 0
+      OnClick = btnOrderDelClick
+      TabOrder = 2
+    end
+    object btnOrderOpen: TBitBtn
+      Left = 5
+      Height = 24
+      Hint = 'Сохранить заказ'
+      Top = 1
+      Width = 31
+      AutoSize = True
+      Glyph.Data = {
+        36040000424D3604000000000000360000002800000010000000100000000100
+        200000000000000400006400000064000000000000000000000042758D003357
+        66003461770028455A00305166005FA3BA003954600063A0B200568A9F006083
+        7F003B453600FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006C625FFF4E52
+        50FF4E5250FF4D504EFF4D504EFF4D504EFF4D504EFF4D504EFF4D504EFF4D50
+        4EFF4E5250FF4E5250FF4E5250FF4D504EFF555857FFFFFFFF00535755FFAEBF
+        BEFFAFC1C0FFAEC0BFFFAEC0BFFFAEC0BFFFAFC1C0FFAFC1C0FFAFC0BFFFAFC0
+        BFFFAFC0BFFFAEC0BFFFAEC0BFFFAFBFBEFFA6B3B2FF515453FF535755FFC2D1
+        CFFF9BB2B1FF9BB2B1FF9BB2B1FF9BB2B1FF9BB2B1FF9BB2B1FF9BB2B1FF9BB2
+        B1FF9BB2B1FF9BB2B1FF9BB2B1FF99B0AFFFB5C1C0FF565855FF535755FFC3D1
+        D0FFC2D0CFFFC2D0CFFFC2D0CFFFC2D0CFFFC2D0CFFFB3C4C3FF99B0AFFF9AB1
+        B0FF9AB1B0FF9AB1B0FF9AB1B0FF9AB1B0FFC4D1D0FF545855FF535755FF6064
+        62FF4B4F4DFF4B4F4DFF4B4F4DFF4B4F4DFF909D9CFFB7C4C3FFC4D2D1FFC4D2
+        D1FFC2D0CFFFBECDCBFFBECCCAFFBBCAC9FF818987FF535755FF535755FF9AAE
+        AAFF6B7D7BFF6B7D7BFF535755FFFFFFFFFFADB1B1FF4D514FFF4A4E4CFF4A4E
+        4CFF4A4E4CFF4A4E4CFF4A4E4CFF4B4F4DFF565A58FF695854FF535755FF96A9
+        A7FF708481FF708481FF535755FFFFFFFFFFECEEEEFFECEEEEFFECEEEEFFECEE
+        EEFFECEEEEFFFFFFFFFF535755FF839290FF535755FFFFFFFF00535755FF9EB0
+        AEFF788D8AFF788D8AFF535755FFFFFFFFFFBCBEBEFFBCBEBEFFBCBEBEFFBCBE
+        BEFFBCBEBEFFFFFFFFFF535755FF839290FF535755FFFFFFFF00535755FFA0B2
+        B0FF788D8AFF7B8F8CFF535755FFFFFFFFFFECEEEEFFECEEEEFFECEEEEFFECEE
+        EEFFECEEEEFFFFFFFFFF535755FF8C9A98FF535755FFFFFFFF00535755FFA3B5
+        B3FF7E928FFF7E928FFF535755FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+        FFFFFFFFFFFFFFFFFFFF535755FF919F9DFF535755FFFFFFFF00535755FFA3B5
+        B3FF7E928FFF7E928FFF5E6664FF535755FF535755FF535755FF535755FF5357
+        55FF535755FF535755FF656F6DFF919F9DFF535755FFFFFFFF00535755FFA3B5
+        B3FF7E928FFF7E928FFF7E918FFF819492FF9AAAA9FF93A4A2FF95A4A3FF96A5
+        A3FF96A5A3FF96A5A3FF96A5A3FF919F9DFF535755FFFFFFFF00535755FFAABD
+        BBFF889D9AFF879C9AFF869B99FF9FB0AFFF535755FF535755FF535755FF5357
+        55FF535755FF535755FF535755FF535755FF6D6B61FFFFFFFF00535755FFB2C3
+        C1FFB5C5C3FFB5C5C3FFB5C5C3FFACBAB9FF535755FF3030B1003030B100513A
+        A100303077002C3835003F5C4F00426B5A00FFFFFF00FFFFFF006F6479FF5357
+        55FF535755FF535755FF535755FF535755FF6B6C67FFFFFFFF00FFFFFF00FFFF
+        FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
+      }
+      NumGlyphs = 0
+      OnClick = btnOrderOpenClick
+      TabOrder = 3
+    end
+  end
+  object PageControl1: TPageControl
+    Height = 283
+    Top = 31
+    Width = 237
+    ActivePage = TabSheet1
+    Align = alClient
+    TabIndex = 0
+    TabOrder = 1
+    object TabSheet1: TTabSheet
+      Caption = 'Заказы'
+      ClientHeight = 249
+      ClientWidth = 231
+      object grdOrders: TRxDBGrid
+        Height = 249
+        Width = 231
+        Columns = <        
+          item
+            Title.Alignment = taCenter
+            Title.Caption = 'Дата'
+            Width = 65
+            FieldName = 'DateCreate'
+            Filter.ItemIndex = -1
+          end        
+          item
+            Title.Alignment = taCenter
+            Title.Caption = 'Организация'
+            Width = 120
+            FieldName = 'ORG_NAME'
+            Filter.ItemIndex = -1
+          end>
+        Align = alClient
+        AutoEdit = False
+        FocusColor = clRed
+        SelectedColor = clHighlight
+        DataSource = dsrcOrders
+        FixedColor = clBtnFace
+        Font.Height = -10
+        Font.Name = 'Sans'
+        Options = [dgTitles, dgIndicator, dgColLines, dgRowLines, dgTabs, dgAlwaysShowEditor, dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit]
+        OptionsExtra = [dgeCheckboxColumn]
+        ParentColor = False
+        ReadOnly = True
+        Scrollbars = ssAutoBoth
+        TabOrder = 0
+        TitleFont.Height = -8
+        TitleFont.Name = 'Sans'
+      end
+    end
+    object TabSheet3: TTabSheet
+      Caption = 'О программе'
+      ClientHeight = 250
+      ClientWidth = 231
+      object memAbout: TMemo
+        Height = 250
+        Width = 231
+        Align = alClient
+        Lines.Strings = (
+          'GermesOrders v0.1 (%s)'
+          ''
+          'модуль заказов для складской системы "Гермес"'
+          ''
+          'Разработчик '
+          'Головань Денис Сергеевич'
+          'tel: +3 8(097)413-38-38'
+          'tel: +3 8(0629)34-40-40'
+          'email:denis.golovan@gmail.com'
+          'email:denis_golovan@mail.ru'
+          'ICQ:105051989'
+          'skype:mageslayerden'
+          ''
+        )
+        TabOrder = 0
+      end
+    end
+  end
+  object dsrcOrders: TDatasource
+    DataSet = dsOrders
+    left = 200
+    top = 232
+  end
+  object dsOrders: TSqlite3Dataset
+    left = 152
+    top = 88
+  end
+end

examples/germesorders/uorders.lrs

@@ -0,0 +1,230 @@
+{ Это - файл ресурсов, автоматически созданный lazarus }
+
+LazarusResources.Add('TfrmOrders','FORMDATA',[
+  'TPF0'#10'TfrmOrders'#9'frmOrders'#4'Left'#3#3#2#6'Height'#3':'#1#3'Top'#3#242
+  +#0#5'Width'#3#237#0#18'HorzScrollBar.Page'#3#236#0#18'VertScrollBar.Page'#3
+  +'9'#1#13'ActiveControl'#7#5'Memo1'#7'Caption'#6#27#208#161#208#191#208#184
+  +#209#129#208#190#208#186' '#208#183#208#176#208#186#208#176#208#183#208#190
+  +#208#178#12'ClientHeight'#3':'#1#11'ClientWidth'#3#237#0#10'OnActivate'#7#12
+  +'FormActivate'#8'OnCreate'#7#10'FormCreate'#10'LCLVersion'#6#6'0.9.25'#0#6'T'
+  +'Panel'#6'Panel1'#6'Height'#2#31#5'Width'#3#237#0#5'Align'#7#5'alTop'#12'Cli'
+  +'entHeight'#2#31#11'ClientWidth'#3#237#0#8'TabOrder'#2#0#0#7'TBitBtn'#11'btn'
+  +'OrderAdd'#4'Left'#2'E'#6'Height'#2#24#4'Hint'#6#29#208#161#208#190#209#133
+  +#209#128#208#176#208#189#208#184#209#130#209#140' '#208#183#208#176#208#186
+  +#208#176#208#183#3'Top'#2#1#5'Width'#2#31#8'AutoSize'#9#10'Glyph.Data'#10':'
+  +#4#0#0'6'#4#0#0'BM6'#4#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#16#0#0#0#16#0#0#0#1#0' '
+  +#0#0#0#0#0#0#4#0#0'd'#0#0#0'd'#0#0#0#0#0#0#0#0#0#0#0'QQK'#0'>=7'#0'=<6'#0'=<'
+  +'6'#0'=<6'#0'=<6'#0'<;4'#0'=<6'#0'=<6'#0'=<6'#0'=<6'#0'=<6'#0'@@;'#0'BB='#0
+  +'>=7'#0'VVQ'#0'>=7'#0'KMJ'#0'KMJ'#0'LNK'#0'MPM'#0'NQO'#0'ORP'#0'PSQ'#0'RUS'#0
+  +'PSQ'#0'ORO'#0'NPN'#0'NQO'#0'KMJ'#0'JLI'#0'=<6'#0'<;4'#0'KMJ'#0';:4'#0'==8'#0
+  +'CD@'#0'HJE'#0'TXV'#255'UYW'#255'UYW'#255'TXV'#255'KLJ'#0'EFB'#0'@@<'#0';:4'
+  +#0'JLI'#0'<;5'#0'QRL'#0#142#147#145#0#142#148#145#0#142#148#145#0#153#158#155
+  +#0#137#143#140#0'SWU'#255#210#212#211#255#210#212#211#255'UYW'#255#156#160
+  +#157#0#142#148#145#0#142#148#145#0#153#158#155#0#142#147#145#0'QRL'#0'orn'#0
+  +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0'SWU'
+  +#255#214#216#215#255#214#216#215#255'UYW'#255#255#255#255#0#255#255#255#0#255
+  +#255#255#0#255#255#255#0#255#255#255#0'gid'#0'svr'#0#253#253#253#0#133#138
+  +#135#0#188#195#192#0#197#202#201#0#226#229#228#0'SWU'#255#211#213#212#255#211
+  +#213#212#255'UYW'#255#224#227#226#0#192#198#196#0#182#189#186#0#128#133#131#0
+  +#248#248#248#0'svr'#0#133#138#136#0#245#246#245#0'SWU'#255'SWU'#255'SWU'#255
+  +'SWU'#255'SWU'#255#203#205#204#255#203#205#204#255'VZX'#255'SWU'#255'SWU'#255
+  +'SWU'#255'SWU'#255#236#238#237#0#133#138#136#0#133#138#136#0#239#241#240#0'S'
+  +'WU'#255#218#220#219#255#195#197#196#255#194#196#195#255#194#196#195#255#194
+  +#196#195#255#194#196#195#255#194#196#195#255#194#196#195#255#194#196#195#255
+  +#194#196#195#255'SWU'#255#229#231#231#0#133#138#136#0#133#138#136#0#237#239
+  +#239#0'SWU'#255#218#221#220#255#219#221#220#255#220#222#221#255#219#221#220
+  +#255#219#221#220#255#191#193#192#255#191#193#192#255#191#193#192#255#191#193
+  +#192#255#192#194#193#255'SWU'#255#226#229#228#0#133#138#136#0#133#138#136#0
+  +#241#243#242#0'SWU'#255'SWU'#255'SWU'#255'TXV'#255'X\Z'#255#220#222#221#255
+  +#186#188#187#255'W[Y'#255'SWU'#255'SWU'#255'SWU'#255'SWU'#255#232#234#234#0
+  +#133#138#136#0#133#138#136#0#244#246#245#0'L'#181''#0#6#154'N'#0#6#154'N'#0
+  +#30#167'a'#0'SWU'#255#219#221#220#255#186#188#187#255'VZX'#255'*'#174'j'#0#6
+  +#154'N'#0#6#154'N'#0'B'#176'x'#0#234#236#236#0#133#138#136#0#133#138#136#0
+  +#243#245#245#0#235#237#237#0#251#252#252#0#235#237#237#0#10#156'Q'#0'TXV'#255
+  +#219#221#220#255#186#188#187#255'UYW'#255#16#158'U'#0#223#230#227#0#209#212
+  +#212#0#227#230#229#0#238#240#239#0#133#138#136#0#134#139#137#0#239#241#241#0
+  +#243#245#245#0#253#253#253#0#243#245#245#0#10#156'Q'#0'TXV'#255#218#220#219
+  +#255#185#187#186#255'TXV'#255#16#158'U'#0#236#242#240#0#223#225#225#0#243#245
+  +#245#0#239#241#241#0#134#139#137#0#130#135#133#0#136#141#139#0#133#138#136#0
+  +#133#138#136#0#133#138#136#0#8#155'P'#0'SWU'#255'TXV'#255'SWU'#255'SWU'#255
+  +#14#157'T'#0#129#139#134#0#133#138#136#0#133#138#136#0#134#139#137#0#131#134
+  +#133#0'@'#0#0#0#0#4#4#0#0#0#0#0#0#0#0#0#2#0#0#0#11#157'R'#0#209#248#228#0#214
+  +#249#232#0#214#249#232#0#214#249#232#0#15#157'T'#0#0#4#4#0#0#0#0#0#0#0#0#0#2
+  +#0#231#0#140#1#128#0'P'#193#225#0'('#229#196#0#0#0#0#0#192#128#1#0#0#0#4#0#23
+  +#155'W'#0#6#154'N'#0#6#154'N'#0#6#154'N'#0#6#154'N'#0#16#153'S'#0#0#0#0#0#0#0
+  +#0#0#128#0#1#0#0#0#4#0#0#0#0#0#9'NumGlyphs'#2#0#7'OnClick'#7#16'btnOrderAddC'
+  +'lick'#8'TabOrder'#2#0#0#0#7'TBitBtn'#8'btnClose'#4'Left'#3#196#0#6'Height'#2
+  +#24#4'Hint'#6#29#208#161#208#190#209#133#209#128#208#176#208#189#208#184#209
+  +#130#209#140' '#208#183#208#176#208#186#208#176#208#183#3'Top'#2#2#5'Width'#2
+  +#31#7'Anchors'#11#7'akRight'#0#8'AutoSize'#9#10'Glyph.Data'#10':'#4#0#0'6'#4
+  +#0#0'BM6'#4#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#16#0#0#0#16#0#0#0#1#0' '#0#0#0#0#0
+  +#0#4#0#0'd'#0#0#0'd'#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#255#0#255#255#255
+  +#0#17#0#0#0'P'#1#222#0#184'^'#222#0#255#255#0#0#255#255#0#0#253'Y'#0#0#0#255
+  +#0#0#4#128#224#0'64.'#255'64.'#255'64.'#255'64.'#255'64.'#255'64.'#255'64.'
+  +#255'64.'#255'64.'#255'64.'#255#0#0#0#0#0'/'#180#0#253#226'F'#0#0#9#157#0#241
+  +#155#8#0#0'-'#222#0'64.'#255#224#226#226#255'zyv'#255'64.'#255#31'nC'#255'"z'
+  +'K'#255'%~N'#255'*~P'#255'+P'#255'64.'#255#189'h'#0#0#0#0#255#0#0#0#0#0#255
+  ,'+E'#0#0#0#164#255#0#0#164#255'64.'#255#222#224#224#255#224#226#226#255#224
+  +#226#226#255'zyv'#255'64.'#255#30'd>'#255'#tF'#255#31'~K'#255'64.'#255'$'#183
+  +#0#0#255#175#0#0#255#255#0#0#228#255#9#0#0#0#164#255'))'#239#255#0#0#164#255
+  +#224#226#226#255#209#212#212#255#190#193#193#255#224#226#226#255#224#226#226
+  +#255'64.'#255#24'e;'#255#25'uD'#255'64.'#255#5'"'#190#0#0#0#164#255#0#0#164
+  +#255#0#0#164#255#0#0#164#255'))'#239#255'))'#239#255#0#0#164#255#209#212#212
+  +#255#190#193#193#255#183#185#185#255#224#226#226#255'64.'#255#23'b:'#255#25
+  +'nA'#255'64.'#255#233#0#0#0#0#0#164#255'))'#239#255'))'#239#255'))'#239#255
+  +'))'#239#255#0#0#180#255'))'#239#255#0#0#164#255#190#193#193#255#183#185#185
+  +#255#224#226#226#255'64.'#255#25'^9'#255#21'p?'#255'64.'#255#255#255#0#0#0#0
+  +#164#255'))'#239#255#0#0#180#255#0#0#180#255#0#0#180#255#0#0#180#255#0#0#180
+  +#255'))'#239#255#0#0#164#255'jll'#255#224#226#226#255'64.'#255#24'[6'#255#19
+  +'l<'#255'64.'#255#0#0#0#0#0#0#164#255#130#130#251#255#0#0#204#255#0#0#204#255
+  +#0#0#204#255#0#0#204#255#0#0#204#255#130#130#251#255#0#0#164#255'wyy'#255'Z['
+  +'['#255'64.'#255#16'Y2'#255#14'f8'#255'64.'#255#0#0#0#0#0#0#164#255#130#130
+  +#251#255#130#130#251#255#130#130#251#255#130#130#251#255#0#0#204#255#130#130
+  +#251#255#0#0#164#255#187#189#189#255#162#164#164#255#224#226#226#255'64.'#255
+  +#13'N+'#255#13'V/'#255'64.'#255#255#255#0#0#0#0#164#255#0#0#164#255#0#0#164
+  +#255#0#0#164#255#130#130#251#255#130#130#251#255#0#0#164#255#205#208#208#255
+  +#190#193#193#255#183#185#185#255#224#226#226#255'64.'#255#8'>"'#255#7'O*'#255
+  +'64.'#255'b'#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#164#255#130#130#251#255#0#0
+  +#164#255#220#222#222#255#208#211#211#255#190#193#193#255#183#185#185#255#224
+  +#226#226#255'64.'#255#6'-'#24#255#6'A!'#255'64.'#255#242#157#9#0#0#0#0#0#0#0
+  +#0#0#0#0#0#0#0#0#164#255#0#0#164#255'64.'#255#224#226#226#255#208#211#211#255
+  +#189#192#192#255#181#183#183#255#224#226#226#255'64.'#255#0#28#13#255#0'3'#24
+  +#255'64.'#255#0#0#0#0#0'+'#175#0#252#227'P'#0#0#0#0#0#0#0#0#0#0#0#0#0'64.'
+  +#255#224#226#226#255#208#211#211#255#189#192#192#255#171#173#173#255#224#226
+  +#226#255'64.'#255#0#15#7#255#0'('#19#255'64.'#255#0#0#0#0#8#0#0#0#0#0#28#0
+  +#255#255'9'#0#28'UU'#0#255#255#255#0'64.'#255'64.'#255'64.'#255'64.'#255'64.'
+  +#255'64.'#255'64.'#255'64.'#255'64.'#255'64.'#255#0#0#0#0#136#3#222#0#160#244
+  +#221#0#0#0#0#0'V'#0#10#0#128#130' '#0#156#238#9#0#0#0#0#0'X'#0#0#0#144#184
+  +#225#0'<'#184#225#0#0#0#0#0#0#0#0#0#0#0#0#0'P'#184#225#0#0#0#0#0#0#0#0#0#9'N'
+  +'umGlyphs'#2#0#7'OnClick'#7#13'btnCloseClick'#8'TabOrder'#2#1#0#0#7'TBitBtn'
+  +#11'btnOrderDel'#4'Left'#2'j'#6'Height'#2#24#4'Hint'#6#29#208#161#208#190#209
+  +#133#209#128#208#176#208#189#208#184#209#130#209#140' '#208#183#208#176#208
+  +#186#208#176#208#183#3'Top'#2#1#5'Width'#2#31#8'AutoSize'#9#10'Glyph.Data'#10
+  +':'#4#0#0'6'#4#0#0'BM6'#4#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#16#0#0#0#16#0#0#0#1#0
+  +' '#0#0#0#0#0#0#4#0#0'd'#0#0#0'd'#0#0#0#0#0#0#0#0#0#0#0'^'#0#6#0'_'#0#7#0'a'
+  +#0#6#0'b'#0#7#0'd'#0#6#0'e'#0#7#0'g'#0#6#0'h'#0#7#0'j'#0#6#0'k'#0#7#0'm'#0#6
+  +#0'n'#0#7#0'p'#0#6#0'q'#0#7#0's'#0#6#0't'#0#7#0'F'#0#6#0'G'#0#7#0'I'#0#6#0'J'
+  +#0#7#0'L'#0#6#0#15#2'W'#255#22#1#152#255#4#8#166#255#6#0#162#255'#'#0#167#255
+  +'<=f'#255'V'#0#7#0'X'#0#6#0'Y'#0#7#0'['#0#6#0'\'#0#7#0'.'#0#6#0'/'#0#7#0'1'#0
+  +#6#0'2'#0#7#0#3#0#158#255#20#20#214#255#23#24#224#255#23#23#224#255#22#23#223
+  +#255#22#22#222#255#17#17#212#255#0#0#158#255'@'#0#6#0'A'#0#7#0'C'#0#6#0'D'#0
+  +#7#0#22#0#6#0#23#0#7#0#25#0#6#0#7#7#183#255#26#26#226#255#11#11#206#255#1#1
+  +#191#255#0#0#188#255#0#0#187#255#1#1#188#255#9#9#201#255#20#21#221#255#6#6
+  +#181#255')'#0#7#0'+'#0#6#0','#0#7#0#131#0#3#0#132#0#4#0#6#0#161#255#28#28#228
+  +#255#5#5#200#255#0#0#191#255#0#0#190#255#0#0#189#255#0#0#189#255#0#0#188#255
+  +#0#0#186#255#4#4#194#255#21#21#221#255#0#0#162#255#19#0#6#0#20#0#7#0'k'#0#3#0
+  +#22#4#197#255#23#23#217#255#13#13#210#255#0#0#193#255#255#255#255#255#255#255
+  +#255#255#0#0#191#255#0#0#190#255#255#255#255#255#255#255#255#255#0#0#187#255
+  +#9#9#202#255#18#18#212#255#0#0'W'#255#129#0#4#0'S'#0#3#0#2#3#135#255' '#31
+  +#230#255#2#2#198#255#0#0#195#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#188#255#1#1#189#255
+  +#22#22#222#255'!*'#165#255'i'#0#4#0';'#0#3#0#0#0#159#255'!!'#233#255#0#0#196
+  +#255#0#0#196#255#0#0#194#255#255#255#255#255#255#255#255#255#255#255#255#255
+  +#255#255#255#255#0#0#190#255#0#0#189#255#0#0#188#255#24#23#224#255#0#0#159
+  +#255'Q'#0#4#0'#'#0#3#0#5#0#159#255'""'#234#255#0#0#198#255#0#0#197#255#0#0
+  +#195#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0
+  +#191#255#0#0#190#255#0#0#190#255#24#25#225#255#0#0#159#255'9'#0#4#0#11#0#3#0
+  +#0#0#134#255'##'#233#255#2#2#201#255#0#0#198#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#191
+  +#255#1#1#193#255#25#25#225#255#0#0#134#255'!'#0#4#0'v'#0#2#0#0#0'W'#255#26#26
+  +#220#255#15#15#215#255#0#0#199#255#255#255#255#255#255#255#255#255#0#0#196
+  ,#255#0#0#196#255#255#255#255#255#255#255#255#255#0#0#193#255#11#11#208#255#21
+  +#21#216#255#0#0'W'#255#9#0#4#0'^'#0#2#0'_'#0#3#0#2#0#160#255'$$'#234#255#7#7
+  +#208#255#0#0#199#255#0#0#198#255#0#0#197#255#0#0#196#255#0#0#195#255#0#0#195
+  +#255#5#5#202#255#28#28#227#255#8#2#159#255's'#0#2#0't'#0#3#0'F'#0#2#0'G'#0#3
+  +#0'I'#0#2#0#8#8#183#255'$$'#235#255#15#15#215#255#2#2#202#255#0#0#198#255#0#0
+  +#197#255#2#2#200#255#13#13#212#255#30#30#230#255#7#7#183#255'Y'#0#3#0'['#0#2
+  +#0'\'#0#3#0'.'#0#2#0'/'#0#3#0'1'#0#2#0'2'#0#3#0#2#0#158#255#27#27#220#255'$$'
+  +#235#255'$$'#234#255'##'#234#255'!!'#232#255#24#25#218#255#0#1#158#255'@'#0#2
+  +#0'A'#0#3#0'C'#0#2#0'D'#0#3#0#22#0#2#0#23#0#3#0#25#0#2#0#26#0#3#0#28#0#2#0#0
+  +#0'W'#255#0#0#134#255#0#0#159#255#0#0#159#255')'#12#139#255#0#0'W'#255'&'#0#3
+  +#0'('#0#2#0')'#0#3#0'+'#0#2#0','#0#3#0#144#195#225#0#144#195#225#0#1#0#2#0#2
+  +#0#3#0#4#0#2#0#5#0#3#0#7#0#2#0#8#0#3#0#10#0#2#0#11#0#3#0#13#0#2#0#14#0#3#0#16
+  +#0#2#0#17#0#3#0#19#0#2#0#20#0#3#0#9'NumGlyphs'#2#0#7'OnClick'#7#16'btnOrderD'
+  +'elClick'#8'TabOrder'#2#2#0#0#7'TBitBtn'#12'btnOrderOpen'#4'Left'#2#5#6'Heig'
+  +'ht'#2#24#4'Hint'#6#29#208#161#208#190#209#133#209#128#208#176#208#189#208
+  +#184#209#130#209#140' '#208#183#208#176#208#186#208#176#208#183#3'Top'#2#1#5
+  +'Width'#2#31#8'AutoSize'#9#10'Glyph.Data'#10':'#4#0#0'6'#4#0#0'BM6'#4#0#0#0#0
+  +#0#0'6'#0#0#0'('#0#0#0#16#0#0#0#16#0#0#0#1#0' '#0#0#0#0#0#0#4#0#0'd'#0#0#0'd'
+  +#0#0#0#0#0#0#0#0#0#0#0'Bu'#141#0'3Wf'#0'4aw'#0'(EZ'#0'0Qf'#0'_'#163#186#0'9T'
+  +'`'#0'c'#160#178#0'V'#138#159#0'`'#131''#0';E6'#0#255#255#255#0#255#255#255
+  +#0#255#255#255#0#255#255#255#0#255#255#255#0'lb_'#255'NRP'#255'NRP'#255'MPN'
+  +#255'MPN'#255'MPN'#255'MPN'#255'MPN'#255'MPN'#255'MPN'#255'NRP'#255'NRP'#255
+  +'NRP'#255'MPN'#255'UXW'#255#255#255#255#0'SWU'#255#174#191#190#255#175#193
+  +#192#255#174#192#191#255#174#192#191#255#174#192#191#255#175#193#192#255#175
+  +#193#192#255#175#192#191#255#175#192#191#255#175#192#191#255#174#192#191#255
+  +#174#192#191#255#175#191#190#255#166#179#178#255'QTS'#255'SWU'#255#194#209
+  +#207#255#155#178#177#255#155#178#177#255#155#178#177#255#155#178#177#255#155
+  +#178#177#255#155#178#177#255#155#178#177#255#155#178#177#255#155#178#177#255
+  +#155#178#177#255#155#178#177#255#153#176#175#255#181#193#192#255'VXU'#255'SW'
+  +'U'#255#195#209#208#255#194#208#207#255#194#208#207#255#194#208#207#255#194
+  +#208#207#255#194#208#207#255#179#196#195#255#153#176#175#255#154#177#176#255
+  +#154#177#176#255#154#177#176#255#154#177#176#255#154#177#176#255#196#209#208
+  +#255'TXU'#255'SWU'#255'`db'#255'KOM'#255'KOM'#255'KOM'#255'KOM'#255#144#157
+  +#156#255#183#196#195#255#196#210#209#255#196#210#209#255#194#208#207#255#190
+  +#205#203#255#190#204#202#255#187#202#201#255#129#137#135#255'SWU'#255'SWU'
+  +#255#154#174#170#255'k}{'#255'k}{'#255'SWU'#255#255#255#255#255#173#177#177
+  +#255'MQO'#255'JNL'#255'JNL'#255'JNL'#255'JNL'#255'JNL'#255'KOM'#255'VZX'#255
+  +'iXT'#255'SWU'#255#150#169#167#255'p'#132#129#255'p'#132#129#255'SWU'#255#255
+  +#255#255#255#236#238#238#255#236#238#238#255#236#238#238#255#236#238#238#255
+  +#236#238#238#255#255#255#255#255'SWU'#255#131#146#144#255'SWU'#255#255#255
+  +#255#0'SWU'#255#158#176#174#255'x'#141#138#255'x'#141#138#255'SWU'#255#255
+  +#255#255#255#188#190#190#255#188#190#190#255#188#190#190#255#188#190#190#255
+  +#188#190#190#255#255#255#255#255'SWU'#255#131#146#144#255'SWU'#255#255#255
+  +#255#0'SWU'#255#160#178#176#255'x'#141#138#255'{'#143#140#255'SWU'#255#255
+  +#255#255#255#236#238#238#255#236#238#238#255#236#238#238#255#236#238#238#255
+  +#236#238#238#255#255#255#255#255'SWU'#255#140#154#152#255'SWU'#255#255#255
+  +#255#0'SWU'#255#163#181#179#255'~'#146#143#255'~'#146#143#255'SWU'#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'SWU'#255#145#159#157#255'SWU'#255#255#255
+  +#255#0'SWU'#255#163#181#179#255'~'#146#143#255'~'#146#143#255'^fd'#255'SWU'
+  +#255'SWU'#255'SWU'#255'SWU'#255'SWU'#255'SWU'#255'SWU'#255'eom'#255#145#159
+  +#157#255'SWU'#255#255#255#255#0'SWU'#255#163#181#179#255'~'#146#143#255'~'
+  +#146#143#255'~'#145#143#255#129#148#146#255#154#170#169#255#147#164#162#255
+  +#149#164#163#255#150#165#163#255#150#165#163#255#150#165#163#255#150#165#163
+  +#255#145#159#157#255'SWU'#255#255#255#255#0'SWU'#255#170#189#187#255#136#157
+  +#154#255#135#156#154#255#134#155#153#255#159#176#175#255'SWU'#255'SWU'#255'S'
+  +'WU'#255'SWU'#255'SWU'#255'SWU'#255'SWU'#255'SWU'#255'mka'#255#255#255#255#0
+  +'SWU'#255#178#195#193#255#181#197#195#255#181#197#195#255#181#197#195#255#172
+  +#186#185#255'SWU'#255'00'#177#0'00'#177#0'Q:'#161#0'00w'#0',85'#0'?\O'#0'BkZ'
+  +#0#255#255#255#0#255#255#255#0'ody'#255'SWU'#255'SWU'#255'SWU'#255'SWU'#255
+  +'SWU'#255'klg'#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0
+  +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#9'Num'
+  +'Glyphs'#2#0#7'OnClick'#7#17'btnOrderOpenClick'#8'TabOrder'#2#3#0#0#0#12'TPa'
+  +'geControl'#12'PageControl1'#6'Height'#3#27#1#3'Top'#2#31#5'Width'#3#237#0#10
+  ,'ActivePage'#7#9'TabSheet1'#5'Align'#7#8'alClient'#8'TabIndex'#2#0#8'TabOrde'
+  +'r'#2#1#0#9'TTabSheet'#9'TabSheet1'#7'Caption'#6#12#208#151#208#176#208#186
+  +#208#176#208#183#209#139#12'ClientHeight'#3#249#0#11'ClientWidth'#3#231#0#0#9
+  +'TRxDBGrid'#9'grdOrders'#6'Height'#3#249#0#5'Width'#3#231#0#7'Columns'#14#1
+  +#15'Title.Alignment'#7#8'taCenter'#13'Title.Caption'#6#8#208#148#208#176#209
+  +#130#208#176#5'Width'#2'A'#9'FieldName'#6#10'DateCreate'#16'Filter.ItemIndex'
+  +#2#255#0#1#15'Title.Alignment'#7#8'taCenter'#13'Title.Caption'#6#22#208#158
+  +#209#128#208#179#208#176#208#189#208#184#208#183#208#176#209#134#208#184#209
+  +#143#5'Width'#2'x'#9'FieldName'#6#8'ORG_NAME'#16'Filter.ItemIndex'#2#255#0#0
+  +#5'Align'#7#8'alClient'#8'AutoEdit'#8#10'FocusColor'#7#5'clRed'#13'SelectedC'
+  +'olor'#7#11'clHighlight'#10'DataSource'#7#10'dsrcOrders'#10'FixedColor'#7#9
+  +'clBtnFace'#11'Font.Height'#2#246#9'Font.Name'#6#4'Sans'#7'Options'#11#8'dgT'
+  +'itles'#11'dgIndicator'#10'dgColLines'#10'dgRowLines'#6'dgTabs'#18'dgAlwaysS'
+  +'howEditor'#21'dgAlwaysShowSelection'#15'dgConfirmDelete'#14'dgCancelOnExit'
+  +#0#12'OptionsExtra'#11#17'dgeCheckboxColumn'#0#11'ParentColor'#8#8'ReadOnly'
+  +#9#10'Scrollbars'#7#10'ssAutoBoth'#8'TabOrder'#2#0#16'TitleFont.Height'#2#248
+  +#14'TitleFont.Name'#6#4'Sans'#0#0#0#9'TTabSheet'#9'TabSheet3'#7'Caption'#6#21
+  +#208#158' '#208#191#209#128#208#190#208#179#209#128#208#176#208#188#208#188
+  +#208#181#12'ClientHeight'#3#249#0#11'ClientWidth'#3#231#0#0#5'TMemo'#5'Memo1'
+  +#6'Height'#3#249#0#5'Width'#3#231#0#5'Align'#7#8'alClient'#13'Lines.Strings'
+  +#1#6#30'GermesOrders v0.1 (04-03-2008)'#6#0#6'S'#208#188#208#190#208#180#209
+  +#131#208#187#209#140' '#208#183#208#176#208#186#208#176#208#183#208#190#208
+  +#178' '#208#180#208#187#209#143' '#209#129#208#186#208#187#208#176#208#180
+  +#209#129#208#186#208#190#208#185' '#209#129#208#184#209#129#209#130#208#181
+  +#208#188#209#139' "'#208#147#208#181#209#128#208#188#208#181#209#129'"'#6#0#6
+  +#23#208#160#208#176#208#183#209#128#208#176#208#177#208#190#209#130#209#135
+  +#208#184#208#186' '#6'.'#208#147#208#190#208#187#208#190#208#178#208#176#208
+  +#189#209#140' '#208#148#208#181#208#189#208#184#209#129' '#208#161#208#181
+  +#209#128#208#179#208#181#208#181#208#178#208#184#209#135#6#23'tel: +3 8(097)'
+  +'413-38-38'#6#23'tel: +3 8(0629)34-40-40'#6#29'email:denis.golovan@gmail.com'
+  +#6#27'email:denis_golovan@mail.ru'#6#13'ICQ:105051989'#6#19'skype:mageslayer'
+  +'den'#6#0#0#8'TabOrder'#2#0#0#0#0#0#11'TDatasource'#10'dsrcOrders'#7'DataSet'
+  +#7#8'dsOrders'#4'left'#3#200#0#3'top'#3#232#0#0#0#15'TSqlite3Dataset'#8'dsOr'
+  +'ders'#4'left'#3#152#0#3'top'#2'X'#0#0#0
+]);

examples/germesorders/uorders.pas

@@ -0,0 +1,178 @@
+unit uOrders;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
+  Buttons, rxdbgrid, sqlite3ds, db, ComCtrls, StdCtrls, uDbTypes, DBGrids,
+  rxdbcomb, LMessages, ufrmParent;
+
+type
+
+  { TfrmOrders }
+
+  TfrmOrders = class(TfrmParent)
+    btnOrderAdd: TBitBtn;
+    btnClose: TBitBtn;
+    btnOrderOpen: TBitBtn;
+    btnOrderDel: TBitBtn;
+    dsrcOrders: TDatasource;
+    grdOrders: TRxDBGrid;
+    memAbout: TMemo;
+    PageControl1: TPageControl;
+    Panel1: TPanel;
+    dsOrders: TSqlite3Dataset;
+    TabSheet1: TTabSheet;
+    TabSheet3: TTabSheet;
+    procedure btnAcceptOptionsClick(Sender: TObject);
+    procedure btnCancelOptionsClick(Sender: TObject);
+    procedure btnOrderOpenClick(Sender: TObject);
+    procedure btnOrderAddClick(Sender: TObject);
+    procedure btnCloseClick(Sender: TObject);
+    procedure btnOrderDelClick(Sender: TObject);
+    procedure FormActivate(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure grdOrdersDblClick(Sender: TObject);
+    procedure tbOptionsShow(Sender: TObject);
+  private
+    { private declarations }
+  protected
+    procedure WndProc(var TheMessage : TLMessage);override;
+  public
+    { public declarations }
+  end;
+
+var
+  frmOrders: TfrmOrders;
+
+implementation
+uses uConfig, uDebug, uUtils, uBase, variants, uOrderGoods, uOrder, LCLType,
+  uOptionConst;
+
+{ TfrmOrders }
+
+procedure TfrmOrders.btnCloseClick(Sender: TObject);
+begin
+  GlobalLogger.Log('Закрытие формы TfrmOrders');
+  Close;
+end;
+
+procedure TfrmOrders.btnOrderDelClick(Sender: TObject);
+var O:TDbKeyType;
+begin
+  if Application.MessageBox('Подтверждение',
+     'Вы уверены, что хотите удалить выделенный заказ?',
+     MB_YESNO) = IDYES then
+    begin
+      O:=DBFieldAsDBKey(dsOrders, 'ID');
+      GlobalLogger.Log('Удаление заказа %d', [O]);
+      
+      BaseConnect.SQLExec('DELETE FROM Orders where ID=%d', [O]);
+      dsOrders.RefetchData;
+    end;
+end;
+
+procedure TfrmOrders.FormActivate(Sender: TObject);
+begin
+  dsOrders.RefetchData;
+end;
+
+procedure TfrmOrders.btnOrderAddClick(Sender: TObject);
+var G:TGuid;
+    Gs:string;
+    DateStr:string;
+begin
+  CreateGUID(G);
+
+  Gs:=GUIDToString(G);
+  DateStr:=DateToStr(Now);
+
+  GlobalLogger.Log('Создание заказа. GUID=%s, Дата=%s', [Gs, DateStr]);
+  BaseConnect.SQLExec(
+    Format('INSERT INTO Orders(ID, ID_GUID, DateCreate, DateCreateT, Org, CacheLess) ' +
+           'VALUES (NULL, ''%s'', ''%s'', DATETIME(''NOW''), 0, 0)',
+           [ Gs, DateStr ]));
+           
+  dsOrders.RefetchData;
+end;
+
+procedure TfrmOrders.btnOrderOpenClick(Sender: TObject);
+begin
+  grdOrdersDblClick(Sender);
+end;
+
+procedure TfrmOrders.FormCreate(Sender: TObject);
+var S:string;
+    BuildDate:String;
+begin
+  BuildDate:={$I build-date};
+  memAbout.Text:=Format(memAbout.Text, [BuildDate]);
+
+  GlobalLogger.Log('Открытие формы TfrmOrders');
+
+  S:= 'SELECT Orders.ID as ID, ID_GUID, DateCreate, DateCreateT, CacheLess, ' +
+      'Creator, Orgs.Name as ORG_NAME ' +
+      'FROM Orders join Orgs on Orders.Org=Orgs.ID ' +
+      'Order By DateCreateT Desc';
+
+  BaseConnect.ConnectToBase(dsOrders);
+  dsOrders.SQL := S;
+  dsOrders.PrimaryKey:='ID';
+  dsOrders.AutoIncrementKey:=True;
+  dsOrders.Open;
+end;
+
+procedure TfrmOrders.grdOrdersDblClick(Sender: TObject);
+begin
+  {
+  with TfrmOrder.Create(self) do
+  begin
+    Id_Order:=DBFieldAsDBKey(dsOrders, 'ID');
+    Show;
+  end;
+  }
+  if frmOrder = nil then
+    begin
+      frmOrder:=TfrmOrder.Create(Application);
+    end;
+  
+  with frmOrder do
+  begin
+    Id_Order:=DBFieldAsDBKey(dsOrders, 'ID');
+    {$IFDEF LCLwince}
+    WindowResize;
+    {$ENDIF}
+    Show;
+  end;
+end;
+
+procedure TfrmOrders.tbOptionsShow(Sender: TObject);
+begin
+  //OptionsLoad;
+end;
+
+procedure TfrmOrders.WndProc(var TheMessage: TLMessage);
+begin
+  //GlobalLogger.Log(GetMessageName(TheMessage.Msg));
+
+  inherited WndProc(TheMessage);
+end;
+
+procedure TfrmOrders.btnAcceptOptionsClick(Sender: TObject);
+begin
+  //OptionsSave;
+  //btnAcceptOptions.Enabled:=false;
+end;
+
+procedure TfrmOrders.btnCancelOptionsClick(Sender: TObject);
+begin
+  //OptionsLoad;
+end;
+
+initialization
+  {$I uordergoods.lrs}
+
+end.
+

examples/germesorders/utestform.lfm

@@ -0,0 +1,20 @@
+object frmTestForm: TfrmTestForm
+  Left = 290
+  Height = 232
+  Top = 175
+  Width = 184
+  HorzScrollBar.Page = 183
+  VertScrollBar.Page = 231
+  Caption = 'frmTestForm'
+  ClientHeight = 232
+  ClientWidth = 184
+  object Button1: TButton
+    Left = 30
+    Height = 30
+    Top = 50
+    Width = 123
+    Caption = 'Button1'
+    OnClick = Button1Click
+    TabOrder = 0
+  end
+end

examples/germesorders/utestform.lrs

@@ -0,0 +1,11 @@
+{ Это - файл ресурсов, автоматически созданный lazarus }
+
+
+LazarusResources.Add('TfrmTestForm','FORMDATA',[
+  'TPF0'#12'TfrmTestForm'#11'frmTestForm'#4'Left'#3'"'#1#6'Height'#3#232#0#3'To'
+  +'p'#3#175#0#5'Width'#3#184#0#18'HorzScrollBar.Page'#3#183#0#18'VertScrollBar'
+  +'.Page'#3#231#0#7'Caption'#6#11'frmTestForm'#12'ClientHeight'#3#232#0#11'Cli'
+  +'entWidth'#3#184#0#0#7'TButton'#7'Button1'#4'Left'#2#30#6'Height'#2#30#3'Top'
+  +#2'2'#5'Width'#2'{'#7'Caption'#6#7'Button1'#7'OnClick'#7#12'Button1Click'#8
+  +'TabOrder'#2#0#0#0#0
+]);

examples/germesorders/utestform.pas

@@ -0,0 +1,39 @@
+unit uTestForm;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls;
+
+type
+
+  { TfrmTestForm }
+
+  TfrmTestForm = class(TForm)
+    Button1: TButton;
+    procedure Button1Click(Sender: TObject);
+  private
+    { private declarations }
+  public
+    { public declarations }
+  end; 
+
+var
+  frmTestForm: TfrmTestForm;
+
+implementation
+
+{ TfrmTestForm }
+
+procedure TfrmTestForm.Button1Click(Sender: TObject);
+begin
+  Close;
+end;
+
+initialization
+  {$I utestform.lrs}
+
+end.
+

examples/germesorders/uutils.pas

@@ -0,0 +1,30 @@
+unit uUtils;
+
+{$mode objfpc}{$H+}
+
+interface
+
+function Iif(Cond:boolean; const TrueResult:String; const FalseResult:string):string;overload;
+function Iif(Cond:boolean; const TrueResult:integer; const FalseResult:integer):integer;overload;
+
+function IfEmpty(const S:String; const ThenReplace:string):string;
+
+implementation
+
+function IfEmpty(const S:String; const ThenReplace:string):string;
+begin
+  if S = '' then Result:=ThenReplace else Result:=S;
+end;
+
+function Iif(Cond:boolean; const TrueResult:String; const FalseResult:string):string;overload;
+begin
+  if Cond then Result:=TrueResult else Result:=FalseResult;
+end;
+
+function Iif(Cond:boolean; const TrueResult:integer; const FalseResult:integer):integer;overload;
+begin
+  if Cond then Result:=TrueResult else Result:=FalseResult;
+end;
+
+end.
+