Commit: 575 - akdf (svn) - Anak Krakatoa Delphi Framework

OSDN > Trouver un logiciel > Développement de logiciels > Frameworks > Anak Krakatoa Delphi Framework > SCM > SVN > Commit

R/O
SSH
HTTPS

akdf: Commit

Commit MetaInfo

Révision	575 (tree)
l'heure	2022-03-10 05:40:00
Auteur	derekwildstar

Message de Log

Movidos para KRK.Rtl.Common.Classes.pas os tipos referentes aos eventos de ToolTips que são enviados para a janela pai de uma configuração de ToolTip (TOOLINFO) e criada uma função genérica (HandleToolTipNotificationMessages) para manipular tais mensagens de notificação
TKRKCustomDataModule, TDataSetItem, TDataSetCollection, TDataSourceItem, TDataSourceCollection, TClientDataSetItem, TClientDataSetCollection, TConnectionItem, TConnectionCollection, TSQLCollection, TSQLItem e TKRKSoapDataModule foram movidas de KRK.Rtl.Common.Classes.pa para KRK.Vcl.Forms.pas a fim de remover a interdependência e permitir o uso de KRK.Rtl.Common.Classes.pas em KRK.Vcl.Forms.pas
Mais implementações e correções em TKRKToolTip
Alterado TCustomKRKForm para incluir os eventos OnTTNLinkClick, OnTTNGetDispInfo, OnTTNShow, OnTTNPop e OnTTNCustomDraw
Alterado TCustomKRKPanel para incluir os eventos OnTTNLinkClick, OnTTNGetDispInfo, OnTTNShow, OnTTNPop e OnTTNCustomDraw
Exemplo Testador atualizado com várias formas de uso do TKRKToolTip

Change Summary

modified: trunk/rtp/src/Rtl/Common/KRK.Rtl.Common.Classes.pas (diff)
modified: trunk/rtp/src/Rtl/Win/KRK.Rtl.Win.CommCtrl.pas (diff)
modified: trunk/rtp/src/Vcl/KRK.Vcl.Forms.pas (diff)
modified: trunk/rtp/src/Vcl/KRK.Vcl.StdCtrls.pas (diff)
modified: trunk/utl/TESTADOR/src/UDAMOPrincipal.pas (diff)
modified: trunk/utl/TESTADOR/src/UPrincipal.dfm (diff)
modified: trunk/utl/TESTADOR/src/UPrincipal.pas (diff)

Modification

--- trunk/rtp/src/Rtl/Common/KRK.Rtl.Common.Classes.pas (revision 574)

+++ trunk/rtp/src/Rtl/Common/KRK.Rtl.Common.Classes.pas (revision 575)

		@@ -7,21 +7,9 @@
7	7	pasta Sys que possui units com prefixo System, portanto, na pasta common só
8	8	devem existir units com o prefixo common }
9	9
10		-uses Windows
11		- , Classes
12		- , StdCtrls
13		- , SysUtils
14		- , XmlIntf
15		- , DB
16		- , DBClient
17		- , ExtCtrls
18		- , Midas
19		- , SoapMidas
20		- , Provider
21		- , SyncObjs
22		- , Types
23		- , KRK.Vcl.Forms
24		- , KRK.Rtl.Win.Windows;
	10	+uses
	11	+ Windows, Classes, StdCtrls, SysUtils, XmlIntf, CommCtrl, DB,
	12	+ KRK.Rtl.Win.Windows, Messages;
25	13
26	14	type
27	15	TMyFormClassName = String;

		@@ -296,327 +284,20 @@
296	284
297	285	TCreationTime = (ctUndefined, ctDesignTime, ctRunTime);
298	286
299		- { == Coleção de SQLs que são salvas com o DFM ============================== }
300		- TSQLItem = class (TCollectionItem)
301		- private
302		- FSQL: TStrings;
303		- FName: String;
304		- FDescription: String;
305		- procedure SetSQL(const Value: TStrings);
306		- procedure SetDescription(const Value: String);
307		- procedure SetName(const Value: String);
308		- protected
309		- function GetDisplayName: string; override;
310		- public
311		- constructor Create(aCollection: TCollection); override;
312		- destructor Destroy; override;
313		- published
314		- property SQL: TStrings read FSQL write SetSQL;
315		- property Name: String read FName write SetName;
316		- property Description: String read FDescription write SetDescription;
317		- end;
	287	+ TTTNLinkClick = function (ANMLink: TNMLink): Boolean of object;
	288	+ TTTNGetDispInfo = function (ANMDispInfo: {$IFDEF UNICODE}PNMTTDispInfoW{$ELSE}PNMTTDispInfoA{$ENDIF}): Boolean of object;
	289	+ TTTNShow = function (ANMHdr: TNMHdr): Boolean of object;
	290	+ TTTNPop = function (ANMHdr: TNMHdr): Boolean of object;
	291	+ TTTNCustomDraw = function (ANMTTCustomDraw: TNMTTCustomDraw): Boolean of object;
318	292
319		- TSQLCollection = class (TCollection)
320		- private
321		- FDataModule: TDataModule;
322		- function GetSQLItem(aIndex: Word): TSQLItem;
323		- function GetSQLItemByID(aID: String): TSQLItem;
324		- protected
325		- function Add: TSQLItem;
326		- constructor Create(aDataModule: TDataModule);
327		- public
328		- property SQLItem[aIndex: Word]: TSQLItem read GetSQLItem;
329		- property SQLItemByID[aID: String]: TSQLItem read GetSQLItemByID; default;
330		- end;
331		- { ========================================================================== }
	293	+//: Use esta função para manipular mensagens de notificação de ToolTips (TTN_*).
	294	+//: Esta função deve retornar true para indicar que a mensagem foi processada e
	295	+//: que não é necessário propagá-la ao pai da janela que a recebeu. O retorno
	296	+//: dessa função depende do retorno de um manipulador de evento que manipula uma
	297	+//: mensagem específica, portanto, quem decide se deve haver a propagação da
	298	+//: mensagem é o programador que escreve os manipuladores dos eventos
	299	+function HandleToolTipNotificationMessages(var AMessage: TWMNotify; AOnTTNLinkClick: TTTNLinkClick; AOnTTNGetDispInfo: TTTNGetDispInfo; AOnTTNShow: TTTNShow; AOnTTNPop: TTTNPop; AOnTTNCustomDraw: TTTNCustomDraw): Boolean;
332	300
333		- { TODO : Crie para cada item de cada coleção propriedades para acessar as
334		- propriedades internas e eventos }
335		- { TODO : O campo FPtr sempre guarda um ponteiro para o componente sendo
336		- colocado na coleção. Isso é necessário pois alguns componentes colocados nos
337		- datamodules são modificados por classes interposer e não há meios realizar um
338		- type cast bem sucedido usando apenas aquilo que é salvo na coleção, devido ao
339		- fato de que o que é salvo na coleção sempre é a versão padrão do componente,
340		- isto é, que não passou pela classe interposer, tornando o cast impossível.
341		- Tentativas de cast direto mostraram que os membros inseridos pela classe
342		- interposer nunca eram acessíveis. Ao dar um cast usando o ponteiro, toda
343		- informação é conseguida sem problemas. Por exemplo:
344		-
345		- TClientDataSet(ClientDataSets['CLDSUsuarios']).MembroInseridoEmClasseInterposer
346		-
347		- Vai compilar, mas vai gerar uma Runtime Exception, enquanto que
348		-
349		- TClientDataSet(ClientDataSets['CLDSUsuarios'].Ptr^).MembroInseridoEmClasseInterposer
350		-
351		- Vai funcionar sem problemas }
352		- { == Coleção de DataSets =================================================== }
353		- TDataSetItem = class (TCollectionItem)
354		- private
355		- FCreationTime: TCreationTime;
356		- FDataSet: TDataSet;
357		- FPtr: Pointer;
358		- public
359		- constructor Create(aCollection: TCollection); override;
360		- destructor Destroy; override;
361		-
362		- property CreationTime: TCreationTime read FCreationTime default ctUndefined;
363		- property DataSet: TDataSet read FDataSet;
364		- property Ptr: Pointer read FPtr;
365		- end;
366		-
367		- TDataSetCollection = class (TCollection)
368		- private
369		- FDataModule: TDataModule;
370		- function GetDataSetItem(aIndex: Word): TDataSetItem;
371		- function GetDataSetItemByDataSetName(aDataSetName: String): TDataSetItem;
372		- function GetItemsBrowsing: String;
373		- function GetItemsInserting: String;
374		- function GetItemsUpdating: String;
375		- protected
376		- function Add: TDataSetItem;
377		- constructor Create(aDataModule: TDataModule);
378		- public
379		- function AddDataSet(aDataSetClass: TDataSetClass; aName: String): TDataSetItem;
380		- procedure OpenAll;
381		- procedure CloseAll;
382		- procedure CancelAll;
383		-
384		- property DataSetItem[aIndex: Word]: TDataSetItem read GetDataSetItem;
385		- property DataSetItemByDataSetName[aDataSetName: String]: TDataSetItem read GetDataSetItemByDataSetName; default;
386		- property ItemsInserting: String read GetItemsInserting;
387		- property ItemsUpdating: String read GetItemsUpdating;
388		- property ItemsBrowsing: String read GetItemsBrowsing;
389		- end;
390		- { ========================================================================== }
391		-
392		- { == Coleção de DataSources ================================================ }
393		- TDataSourceItem = class (TCollectionItem)
394		- private
395		- FCreationTime: TCreationTime;
396		- FDataSource: TDataSource;
397		- FPtr: Pointer;
398		- public
399		- constructor Create(aCollection: TCollection); override;
400		- destructor Destroy; override;
401		-
402		- property CreationTime: TCreationTime read FCreationTime default ctUndefined;
403		- property DataSource: TDataSource read FDataSource;
404		- property Ptr: Pointer read FPtr;
405		- end;
406		-
407		- TDataSourceClass = class of TDataSource;
408		-
409		- { Aqui foram replicadas as propriedades que verificam os datasets ligados aos
410		- datasources pois nem sempre um dataset está ligado a um datasource. O
411		- resultado obtido com as propriedades de TDataSets inclui TODOS os datasets. }
412		- TDataSourceCollection = class (TCollection)
413		- private
414		- FDataModule: TDataModule;
415		- function GetDataSourceItem(aIndex: Word): TDataSourceItem;
416		- function GetDataSourceItemByName(aDataSourceName: String): TDataSourceItem;
417		- function GetItemsBrowsing: String;
418		- function GetItemsInserting: String;
419		- function GetItemsUpdating: String;
420		- protected
421		- function Add: TDataSourceItem;
422		- constructor Create(aDataModule: TDataModule);
423		- public
424		- function AddDataSource(aDataSourceClass: TDataSourceClass; aName: String): TDataSourceItem;
425		-
426		- property DataSourceItem[aIndex: Word]: TDataSourceItem read GetDataSourceItem;
427		- property DataSourceItemByName[aDataSourceName: String]: TDataSourceItem read GetDataSourceItemByName; default;
428		- property ItemsInserting: String read GetItemsInserting;
429		- property ItemsUpdating: String read GetItemsUpdating;
430		- property ItemsBrowsing: String read GetItemsBrowsing;
431		- end;
432		- { ========================================================================== }
433		-
434		- { = Coleção de ClientDataSets ============================================== }
435		- TClientDataSetItem = class (TCollectionItem)
436		- private
437		- FCreationTime: TCreationTime;
438		- FClientDataSet: TClientDataSet;
439		- FPtr: Pointer;
440		- public
441		- constructor Create(aCollection: TCollection); override;
442		- destructor Destroy; override;
443		-
444		- property CreationTime: TCreationTime read FCreationTime default ctUndefined;
445		- property ClientDataSet: TClientDataSet read FClientDataSet;
446		- property Ptr: Pointer read FPtr;
447		- end;
448		-
449		- TClientDataSetClass = class of TClientDataSet;
450		-
451		- TClientDataSetCollection = class (TCollection)
452		- private
453		- FDataModule: TDataModule;
454		- function GetClientDataSetItem(aIndex: Word): TClientDataSetItem;
455		- function GetClientDataSetItemByClientDataSetName(aClientDataSetName: String): TClientDataSetItem;
456		- function GetItemsBrowsing: String;
457		- function GetItemsInserting: String;
458		- function GetItemsUpdating: String;
459		- function GetUpdatesPending: Boolean;
460		- protected
461		- function Add: TClientDataSetItem;
462		- constructor Create(aDataModule: TDataModule);
463		- public
464		- function AddClientDataSet(aClientDataSetClass: TClientDataSetClass; aName: String): TClientDataSetItem;
465		- procedure CancelAll;
466		-
467		- property ClientDataSetItem[aIndex: Word]: TClientDataSetItem read GetClientDataSetItem;
468		- property ClientDataSetItemByClientDataSetName[aClientDataSetName: String]: TClientDataSetItem read GetClientDataSetItemByClientDataSetName; default;
469		- property ItemsInserting: String read GetItemsInserting;
470		- property ItemsUpdating: String read GetItemsUpdating;
471		- property ItemsBrowsing: String read GetItemsBrowsing;
472		- property UpdatesPending: Boolean read GetUpdatesPending;
473		- end;
474		- { ========================================================================== }
475		-
476		- { == Coleção de TCustomConnection ========================================== }
477		- TConnectionItem = class (TCollectionItem)
478		- private
479		- FCreationTime: TCreationTime;
480		- FConnection: TCustomConnection;
481		- FPtr: Pointer;
482		- public
483		- constructor Create(aCollection: TCollection); override;
484		- destructor Destroy; override;
485		-
486		- property CreationTime: TCreationTime read FCreationTime default ctUndefined;
487		- property Connection: TCustomConnection read FConnection;
488		- property Ptr: Pointer read FPtr;
489		- end;
490		-
491		- TConnectionClass = class of TCustomConnection;
492		-
493		- TConnectionCollection = class (TCollection)
494		- private
495		- FDataModule: TDataModule;
496		- function GetConnectionItem(aIndex: Word): TConnectionItem;
497		- function GetConnectionItemByConnectionName(AConnectionName: String): TConnectionItem;
498		- protected
499		- function Add: TConnectionItem;
500		- constructor Create(aDataModule: TDataModule);
501		- public
502		- function AddConnection(AConnectionClass: TConnectionClass; aName: String): TConnectionItem;
503		-
504		- property ConnectionItem[aIndex: Word]: TConnectionItem read GetConnectionItem;
505		- property ConnectionItemByConnectionName[AZConnectionName: String]: TConnectionItem read GetConnectionItemByConnectionName; default;
506		- end;
507		- { ========================================================================== }
508		-
509		- TKRKDataModuleClass = class of TKRKCustomDataModule;
510		-
511		- PKRKDataModule = ^TKRKCustomDataModule;
512		-
513		- TBeforeCreateMyForm = procedure(const aMyFormClass: String) of object;
514		- TAfterCreateMyForm = procedure(const aKRKForm: TKRKForm) of object;
515		-
516		- //: Esta classe define um Anak Krakatoa DataModule, com todos os seus métodos
517		- //: e propriedades. Uma instância desta classe é criada por um wizard.
518		- TKRKCustomDataModule = class(TDataModule)
519		- private
520		- FMyReference: PKRKDataModule;
521		- FDataSources: TDataSourceCollection;
522		- FDataSets: TDataSetCollection;
523		- FClientDataSets: TClientDataSetCollection;
524		- FConnections: TConnectionCollection;
525		- FSQLs: TSQLCollection;
526		- FKRKDataModuleProperties: TKRKDataModuleProperties;
527		- FMyForm: TKRKForm;
528		- FMyFormClass: String;
529		- FTimer: TTimer;
530		- FOnBeforeCreateMyForm: TBeforeCreateMyForm;
531		- FOnAfterCreateMyForm: TAfterCreateMyForm;
532		- procedure DoTimer(aSender: TObject);
533		- protected
534		- property MyForm: TKRKForm read FMyForm;
535		- property Properties: TKRKDataModuleProperties read FKRKDataModuleProperties write FKRKDataModuleProperties;
536		- property SQLs: TSQLCollection read FSQLs write FSQLs;
537		- property MyFormClass: String read FMyFormClass write FMyFormClass;
538		- property OnBeforeCreateMyForm: TBeforeCreateMyForm read FOnBeforeCreateMyForm write FOnBeforeCreateMyForm;
539		- property OnAfterCreateMyForm: TAfterCreateMyForm read FOnAfterCreateMyForm write FOnAfterCreateMyForm;
540		- public
541		- constructor Create(aOwner: TComponent); override;
542		- destructor Destroy; override;
543		-
544		- class procedure CreateMe( aOwner : TComponent;
545		- var aReference; { não tem tipo! }
546		- aKRKDataModuleClass: TKRKDataModuleClass); static;
547		- procedure DestroyMe(aDelayMS: Word = 0);
548		-
549		- property DataSources: TDataSourceCollection read FDataSources;
550		- property DataSets: TDataSetCollection read FDataSets;
551		- property ClientDataSets: TClientDataSetCollection read FClientDataSets;
552		- property Connections: TConnectionCollection read FConnections;
553		- end;
554		-
555		- TKRKDataModule = class(TKRKCustomDataModule)
556		- public
557		- property MyForm;
558		- published
559		- property Properties;
560		- property SQLs;
561		- property MyFormClass;
562		- property OnBeforeCreateMyForm;
563		- property OnAfterCreateMyForm;
564		- end;
565		-
566		- TKRKSoapDataModule = class(TKRKCustomDataModule, IAppServer, IAppServerSOAP, IProviderContainer)
567		- private
568		- FProviders: TList;
569		- FCriticalSection: TCriticalSection;
570		- FRefCount: Integer;
571		- function GetProviderCount: integer;
572		- protected
573		- function GetProvider(const ProviderName: string): TCustomProvider; virtual;
574		- { Internal implementation for IAppServer and IAppServerSOAP }
575		- function GetProviderNames: OleVariant;
576		- function ApplyUpdates(const ProviderName: WideString; Delta: OleVariant; MaxErrors: Integer; out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant;
577		- function GetRecords(const ProviderName: WideString; Count: Integer; out RecsOut: Integer; Options: Integer; const CommandText: WideString; var Params: OleVariant; var OwnerData: OleVariant): OleVariant;
578		- function DataRequest(const ProviderName: WideString; Data: OleVariant): OleVariant;
579		- function GetParams(const ProviderName: WideString; var OwnerData: OleVariant): OleVariant;
580		- function RowRequest(const ProviderName: WideString; Row: OleVariant; RequestType: Integer; var OwnerData: OleVariant): OleVariant;
581		- procedure Execute(const ProviderName: WideString; const CommandText: WideString; var Params, OwnerData: OleVariant);
582		- { IAppServer }
583		- function AS_GetProviderNames: OleVariant; safecall;
584		- function AS_ApplyUpdates(const ProviderName: WideString; Delta: OleVariant; MaxErrors: Integer; out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant; safecall;
585		- function AS_GetRecords(const ProviderName: WideString; Count: Integer; out RecsOut: Integer; Options: Integer; const CommandText: WideString; var Params: OleVariant; var OwnerData: OleVariant): OleVariant; safecall;
586		- function AS_DataRequest(const ProviderName: WideString; Data: OleVariant): OleVariant; safecall;
587		- function AS_GetParams(const ProviderName: WideString; var OwnerData: OleVariant): OleVariant; safecall;
588		- function AS_RowRequest(const ProviderName: WideString; Row: OleVariant; RequestType: Integer; var OwnerData: OleVariant): OleVariant; safecall;
589		- procedure AS_Execute(const ProviderName: WideString; const CommandText: WideString; var Params, OwnerData: OleVariant); safecall;
590		- { IAppServerSOAP }
591		- function SAS_ApplyUpdates(const ProviderName: WideString; Delta: OleVariant; MaxErrors: Integer; out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant; virtual; stdcall;
592		- function SAS_GetRecords(const ProviderName: WideString; Count: Integer; out RecsOut: Integer; Options: Integer; const CommandText: WideString; var Params: OleVariant; var OwnerData: OleVariant): OleVariant; virtual; stdcall;
593		- function SAS_DataRequest(const ProviderName: WideString; Data: OleVariant): OleVariant; virtual; stdcall;
594		- function SAS_GetProviderNames: TWideStringDynArray; virtual; stdcall;
595		- function SAS_GetParams(const ProviderName: WideString; var OwnerData: OleVariant): OleVariant; virtual; stdcall;
596		- function SAS_RowRequest(const ProviderName: WideString; Row: OleVariant; RequestType: Integer; var OwnerData: OleVariant): OleVariant; virtual; stdcall;
597		- procedure SAS_Execute(const ProviderName: WideString; const CommandText: WideString; var Params: OleVariant; var OwnerData: OleVariant); virtual; stdcall;
598		- public
599		- constructor Create(AOwner: TComponent); override;
600		- destructor Destroy; override;
601		- procedure AfterConstruction; override;
602		- procedure BeforeDestruction; override;
603		- class function NewInstance: TObject; override;
604		- function _AddRef: Integer; stdcall;
605		- function _Release: Integer; stdcall;
606		- procedure Lock; virtual;
607		- procedure Unlock; virtual;
608		- { IProviderContainer }
609		- procedure RegisterProvider(Value: TCustomProvider);
610		- procedure UnRegisterProvider(Value: TCustomProvider);
611		- property Providers[const ProviderName: string]: TCustomProvider read GetProvider;
612		- property ProviderCount: integer read GetProviderCount;
613		- property RefCount: Integer read FRefCount;
614		- { Safecall Error Handling }
615		- function SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult; override;
616		- published
617		- property SQLs;
618		- end;
619		-
620	301	// Converte um procedure ou função para um método de um objeto, permitindo que
621	302	// um procedure ou função não associado a um objeto possa ser usado como
622	303	// manipulador de evento de um objeto qualquer. Pode ser necessário um

		@@ -653,14 +334,35 @@
653	334
654	335	implementation
655	336
656		-uses RTLConsts
657		- , TypInfo
658		- , XMLDoc
659		- , MidConst
660		- , Variants
661		- , ComObj
662		- , KRK.Rtl.Common.FileUtils;
	337	+uses
	338	+ RTLConsts, TypInfo, XMLDoc, KRK.Rtl.Common.FileUtils, KRK.Rtl.Win.CommCtrl;
663	339
	340	+function HandleToolTipNotificationMessages(var AMessage: TWMNotify; AOnTTNLinkClick: TTTNLinkClick; AOnTTNGetDispInfo: TTTNGetDispInfo; AOnTTNShow: TTTNShow; AOnTTNPop: TTTNPop; AOnTTNCustomDraw: TTTNCustomDraw): Boolean;
	341	+begin
	342	+ // Por padrão esta função retorna false, indicando que a mensagem recebida
	343	+ // precisa ser propagada para o pai da janela que recebeu a mensagem de
	344	+ // notificação
	345	+ Result := False;
	346	+
	347	+ case AMessage.NMHdr.code of
	348	+ TTN_LINKCLICK:
	349	+ if Assigned(AOnTTNLinkClick) then
	350	+ Result := AOnTTNLinkClick(PNMLink(AMessage.NMHdr)^);
	351	+ TTN_GETDISPINFO:
	352	+ if Assigned(AOnTTNGetDispInfo) then
	353	+ Result := AOnTTNGetDispInfo({$IFDEF UNICODE}PNMTTDispInfoW{$ELSE}PNMTTDispInfoA{$ENDIF}(AMessage.NMHdr));
	354	+ TTN_SHOW:
	355	+ if Assigned(AOnTTNShow) then
	356	+ Result := AOnTTNShow(AMessage.NMHdr^);
	357	+ TTN_POP:
	358	+ if Assigned(AOnTTNPop) then
	359	+ Result := AOnTTNPop(AMessage.NMHdr^);
	360	+ NM_CUSTOMDRAW: { ToolTip }
	361	+ if Assigned(AOnTTNCustomDraw) then
	362	+ Result := AOnTTNCustomDraw(PNMTTCustomDraw(AMessage.NMHdr)^)
	363	+ end;
	364	+end;
	365	+
664	366	{ EKRKHTTPException }
665	367
666	368	constructor EKRKHTTPException.Create(const AStatusText: String; const AStatusCode: Word; const AURL: String);

		@@ -1719,956 +1421,6 @@
1719	1421	inherited;
1720	1422	end;
1721	1423
1722		-{ TKRKCustomDataModule }
1723		-
1724		-constructor TKRKCustomDataModule.Create(aOwner: TComponent);
1725		-var
1726		- i: Word;
1727		-begin
1728		- FKRKDataModuleProperties := TKRKDataModuleProperties.Create;
1729		- FDataSources := TDataSourceCollection.Create(Self);
1730		- FDataSets := TDataSetCollection.Create(Self);
1731		- FClientDataSets := TClientDataSetCollection.Create(Self);
1732		- FConnections := TConnectionCollection.Create(Self);
1733		- FSQLs := TSQLCollection.Create(Self);
1734		- FMyForm := nil;
1735		-
1736		- inherited;
1737		-
1738		- if ComponentCount > 0 then
1739		- for i := 0 to Pred(ComponentCount) do
1740		- if Components[i] is TDataSource then
1741		- with FDataSources.Add do
1742		- begin
1743		- FDataSource := TDataSource(Components[i]);
1744		- FCreationTime := ctDesignTime;
1745		- FPtr := FDataSource;
1746		- end
1747		- else if Components[i] is TDataSet then
1748		- begin
1749		- { Classe pai geral }
1750		- with FDataSets.Add do
1751		- begin
1752		- FDataSet := TDataSet(Components[i]);
1753		- FCreationTime := ctDesignTime;
1754		- FPtr := @FDataSet;
1755		- end;
1756		-
1757		- { Classes filhas especializadas }
1758		- if Components[i] is TClientDataSet then
1759		- with FClientDataSets.Add do
1760		- begin
1761		- FClientDataSet := TClientDataSet(Components[i]);
1762		- FCreationTime := ctDesignTime;
1763		- FPtr := @FClientDataSet;
1764		- end;
1765		- end
1766		- else if Components[i] is TCustomConnection then
1767		- with FConnections.Add do
1768		- begin
1769		- FConnection := TCustomConnection(Components[i]);
1770		- FCreationTime := ctDesignTime;
1771		- FPtr := @FConnection;
1772		- end;
1773		-
1774		- if FKRKDataModuleProperties.OpenAllDataSets then
1775		- FDataSets.OpenAll;
1776		-
1777		- if FMyFormClass <> '' then
1778		- begin
1779		- if not Assigned(GetClass(FMyFormClass)) then
1780		- raise Exception.Create('A classe ' + FMyFormClass + ' não foi registrada');
1781		-
1782		- if not GetClass(FMyFormClass).InheritsFrom(TKRKForm) then
1783		- raise Exception.Create(FMyFormClass + ' não é uma classe descendente de ' + TKRKForm.ClassName);
1784		-
1785		- if Assigned(FOnBeforeCreateMyForm) then
1786		- FOnBeforeCreateMyForm(FMyFormClass);
1787		-
1788		- FMyForm := TKRKFormClass(GetClass(FMyFormClass)).Create(Self);
1789		-
1790		- if Assigned(FOnAfterCreateMyForm) then
1791		- FOnAfterCreateMyForm(FMyForm);
1792		- end;
1793		-end;
1794		-
1795		-destructor TKRKCustomDataModule.Destroy;
1796		-begin
1797		- { Só é preciso destruir as coisas se realmente uma instância deste DM foi
1798		- criada e isso só não é feito caso exceções sejam lançadas dentro do construtor }
1799		- if Assigned(FMyReference) then
1800		- begin
1801		- FMyReference^ := nil;
1802		-
1803		- FSQLs.Free;
1804		- FConnections.Free;
1805		- FClientDataSets.Free;
1806		- FDataSets.Free;
1807		- FDataSources.Free;
1808		-
1809		- FKRKDataModuleProperties.Free;
1810		- end;
1811		-
1812		- inherited;
1813		-end;
1814		-
1815		-class procedure TKRKCustomDataModule.CreateMe( aOwner : TComponent;
1816		- var aReference; { não tem tipo! }
1817		- aKRKDataModuleClass: TKRKDataModuleClass);
1818		-begin
1819		- if Assigned(TKRKCustomDataModule(aReference)) then
1820		- raise Exception.Create('O parâmetro aReference contém uma variável não vazia');
1821		-
1822		- TKRKCustomDataModule(aReference) := aKRKDataModuleClass.Create(aOwner);
1823		- TKRKCustomDataModule(aReference).FMyReference := @aReference;
1824		-end;
1825		-
1826		-procedure TKRKCustomDataModule.DestroyMe(aDelayMS: Word = 0);
1827		-begin
1828		- if aDelayMS > 0 then
1829		- begin
1830		- FTimer := TTimer.Create(Self);
1831		- FTimer.Enabled := False;
1832		- FTimer.Interval := aDelayMS;
1833		- FTimer.OnTimer := DoTimer;
1834		- FTimer.Enabled := True;
1835		- end
1836		- else
1837		- FMyReference.Free;
1838		-end;
1839		-
1840		-procedure TKRKCustomDataModule.DoTimer(aSender: TObject);
1841		-begin
1842		- FTimer.Enabled := False;
1843		- DestroyMe;
1844		-end;
1845		-
1846		-{ TDataSetItem }
1847		-
1848		-constructor TDataSetItem.Create(aCollection: TCollection);
1849		-begin
1850		- inherited;
1851		- FCreationTime := ctUndefined;
1852		-end;
1853		-
1854		-destructor TDataSetItem.Destroy;
1855		-begin
1856		- if FCreationTime = ctRunTime then
1857		- FDataSet.Free;
1858		- inherited;
1859		-end;
1860		-
1861		-{ TDataSets }
1862		-
1863		-procedure TDataSetCollection.OpenAll;
1864		-var
1865		- i: Word;
1866		-begin
1867		- if Count > 0 then
1868		- for i := 0 to Pred(Count) do
1869		- TDataSetItem(Items[i]).DataSet.Open;
1870		-end;
1871		-
1872		-function TDataSetCollection.Add: TDataSetItem;
1873		-begin
1874		- Result := TDataSetItem(inherited Add);
1875		-end;
1876		-
1877		-function TDataSetCollection.AddDataSet(aDataSetClass: TDataSetClass; aName: String): TDataSetItem;
1878		-begin
1879		- Result := DataSetItemByDataSetName[aName];
1880		-
1881		- if not Assigned(Result) then
1882		- begin
1883		- Result := Add;
1884		- with Result do
1885		- begin
1886		- FDataSet := aDataSetClass.Create(FDataModule);
1887		- FDataSet.Name := aName;
1888		- FCreationTime := ctRunTime;
1889		- end;
1890		- end;
1891		-end;
1892		-
1893		-constructor TDataSetCollection.Create(aDataModule: TDataModule);
1894		-begin
1895		- inherited Create(TDataSetItem);
1896		- FDataModule := aDataModule;
1897		-end;
1898		-
1899		-procedure TDataSetCollection.CancelAll;
1900		-var
1901		- i: Word;
1902		-begin
1903		- if Count > 0 then
1904		- for i := 0 to Pred(Count) do
1905		- TDataSetItem(Items[i]).DataSet.Cancel;
1906		-end;
1907		-
1908		-procedure TDataSetCollection.CloseAll;
1909		-var
1910		- i: Word;
1911		-begin
1912		- if Count > 0 then
1913		- for i := 0 to Pred(Count) do
1914		- TDataSetItem(Items[i]).DataSet.Close;
1915		-end;
1916		-
1917		-function TDataSetCollection.GetDataSetItem(aIndex: Word): TDataSetItem;
1918		-begin
1919		- Result := TDataSetItem(inherited Items[aIndex]);
1920		-end;
1921		-
1922		-function TDataSetCollection.GetDataSetItemByDataSetName(aDataSetName: String): TDataSetItem;
1923		-var
1924		- DSI: Byte;
1925		-begin
1926		- Result := nil;
1927		-
1928		- if Count > 0 then
1929		- for DSI := 0 to Pred(Count) do
1930		- if UpperCase(TDataSetItem(Items[DSI]).DataSet.Name) = UpperCase(aDataSetName) then
1931		- begin
1932		- Result := TDataSetItem(Items[DSI]);
1933		- Break;
1934		- end;
1935		-end;
1936		-
1937		-function TDataSetCollection.GetItemsBrowsing: String;
1938		-var
1939		- DSB: Byte;
1940		-begin
1941		- Result := '';
1942		-
1943		- if Count > 0 then
1944		- for DSB := 0 to Pred(Count) do
1945		- if TDataSetItem(Items[DSB]).DataSet.State = dsBrowse then
1946		- begin
1947		- if DSB > 0 then
1948		- Result := Result + ';' + TDataSetItem(Items[DSB]).DataSet.Name
1949		- else
1950		- Result := Result + TDataSetItem(Items[DSB]).DataSet.Name;
1951		- end;
1952		-end;
1953		-
1954		-function TDataSetCollection.GetItemsInserting: String;
1955		-var
1956		- DSI: Byte;
1957		-begin
1958		- Result := '';
1959		-
1960		- if Count > 0 then
1961		- for DSI := 0 to Pred(Count) do
1962		- if TDataSetItem(Items[DSI]).DataSet.State = dsInsert then
1963		- begin
1964		- if DSI > 0 then
1965		- Result := Result + ';' + TDataSetItem(Items[DSI]).DataSet.Name
1966		- else
1967		- Result := Result + TDataSetItem(Items[DSI]).DataSet.Name;
1968		- end;
1969		-end;
1970		-
1971		-function TDataSetCollection.GetItemsUpdating: String;
1972		-var
1973		- DSU: Byte;
1974		-begin
1975		- Result := '';
1976		-
1977		- if Count > 0 then
1978		- for DSU := 0 to Pred(Count) do
1979		- if TDataSetItem(Items[DSU]).DataSet.State = dsEdit then
1980		- begin
1981		- if DSU > 0 then
1982		- Result := Result + ';' + TDataSetItem(Items[DSU]).DataSet.Name
1983		- else
1984		- Result := Result + TDataSetItem(Items[DSU]).DataSet.Name;
1985		- end;
1986		-end;
1987		-
1988		-{ TDataSourceItem }
1989		-
1990		-constructor TDataSourceItem.Create(aCollection: TCollection);
1991		-begin
1992		- inherited;
1993		- FCreationTime := ctUndefined;
1994		-end;
1995		-
1996		-destructor TDataSourceItem.Destroy;
1997		-begin
1998		- if FCreationTime = ctRunTime then
1999		- FDataSource.Free;
2000		-
2001		- inherited;
2002		-end;
2003		-
2004		-{ TDataSourceCollection }
2005		-
2006		-function TDataSourceCollection.Add: TDataSourceItem;
2007		-begin
2008		- Result := TDataSourceItem(inherited Add);
2009		-end;
2010		-
2011		-function TDataSourceCollection.AddDataSource(aDataSourceClass: TDataSourceClass; aName: String): TDataSourceItem;
2012		-begin
2013		- Result := DataSourceItemByName[aName];
2014		-
2015		- if not Assigned(Result) then
2016		- begin
2017		- Result := Add;
2018		- with Result do
2019		- begin
2020		- FDataSource := aDataSourceClass.Create(FDataModule);
2021		- FDataSource.Name := aName;
2022		- FCreationTime := ctRunTime;
2023		- end;
2024		- end;
2025		-end;
2026		-
2027		-constructor TDataSourceCollection.Create(aDataModule: TDataModule);
2028		-begin
2029		- inherited Create(TDataSourceItem);
2030		- FDataModule := aDataModule;
2031		-end;
2032		-
2033		-function TDataSourceCollection.GetDataSourceItemByName(aDataSourceName: String): TDataSourceItem;
2034		-var
2035		- DSI: Byte;
2036		-begin
2037		- Result := nil;
2038		-
2039		- if Count > 0 then
2040		- for DSI := 0 to Pred(Count) do
2041		- if UpperCase(TDataSourceItem(Items[DSI]).DataSource.Name) = UpperCase(aDataSourceName) then
2042		- begin
2043		- Result := TDataSourceItem(Items[DSI]);
2044		- Break;
2045		- end;
2046		-end;
2047		-
2048		-function TDataSourceCollection.GetItemsBrowsing: String;
2049		-var
2050		- DSB: Byte;
2051		-begin
2052		- Result := '';
2053		-
2054		- if Count > 0 then
2055		- for DSB := 0 to Pred(Count) do
2056		- if TDataSourceItem(Items[DSB]).DataSource.DataSet.State = dsBrowse then
2057		- begin
2058		- if DSB > 0 then
2059		- Result := Result + ';' + TDataSourceItem(Items[DSB]).DataSource.DataSet.Name
2060		- else
2061		- Result := Result + TDataSourceItem(Items[DSB]).DataSource.DataSet.Name;
2062		- end;
2063		-end;
2064		-
2065		-function TDataSourceCollection.GetItemsInserting: String;
2066		-var
2067		- DSI: Byte;
2068		-begin
2069		- Result := '';
2070		-
2071		- if Count > 0 then
2072		- for DSI := 0 to Pred(Count) do
2073		- if TDataSourceItem(Items[DSI]).DataSource.DataSet.State = dsInsert then
2074		- begin
2075		- if DSI > 0 then
2076		- Result := Result + ';' + TDataSourceItem(Items[DSI]).DataSource.DataSet.Name
2077		- else
2078		- Result := Result + TDataSourceItem(Items[DSI]).DataSource.DataSet.Name;
2079		- end;
2080		-end;
2081		-
2082		-function TDataSourceCollection.GetItemsUpdating: String;
2083		-var
2084		- DSU: Byte;
2085		-begin
2086		- Result := '';
2087		-
2088		- if Count > 0 then
2089		- for DSU := 0 to Pred(Count) do
2090		- if TDataSourceItem(Items[DSU]).DataSource.DataSet.State = dsEdit then
2091		- begin
2092		- if DSU > 0 then
2093		- Result := Result + ';' + TDataSourceItem(Items[DSU]).DataSource.DataSet.Name
2094		- else
2095		- Result := Result + TDataSourceItem(Items[DSU]).DataSource.DataSet.Name;
2096		- end;
2097		-end;
2098		-
2099		-function TDataSourceCollection.GetDataSourceItem(aIndex: Word): TDataSourceItem;
2100		-begin
2101		- Result := TDataSourceItem(inherited Items[aIndex]);
2102		-end;
2103		-
2104		-{ TClientDataSetItem }
2105		-
2106		-constructor TClientDataSetItem.Create(aCollection: TCollection);
2107		-begin
2108		- inherited;
2109		- FCreationTime := ctUndefined;
2110		-end;
2111		-
2112		-destructor TClientDataSetItem.Destroy;
2113		-begin
2114		- if FCreationTime = ctRunTime then
2115		- FClientDataSet.Free;
2116		-
2117		- inherited;
2118		-end;
2119		-
2120		-{ TClientDataSets }
2121		-
2122		-function TClientDataSetCollection.Add: TClientDataSetItem;
2123		-begin
2124		- Result := TClientDataSetItem(inherited Add);
2125		-end;
2126		-
2127		-function TClientDataSetCollection.AddClientDataSet(aClientDataSetClass: TClientDataSetClass; aName: String): TClientDataSetItem;
2128		-begin
2129		- Result := ClientDataSetItemByClientDataSetName[aName];
2130		-
2131		- if not Assigned(Result) then
2132		- begin
2133		- Result := Add;
2134		- with Result do
2135		- begin
2136		- FClientDataSet := aClientDataSetClass.Create(FDataModule);
2137		- FClientDataSet.Name := aName;
2138		- FCreationTime := ctRunTime;
2139		- end;
2140		- end;
2141		-end;
2142		-
2143		-procedure TClientDataSetCollection.CancelAll;
2144		-var
2145		- i: Word;
2146		-begin
2147		- if Count > 0 then
2148		- for i := 0 to Pred(Count) do
2149		- TClientDataSetItem(Items[i]).ClientDataSet.Cancel;
2150		-end;
2151		-
2152		-constructor TClientDataSetCollection.Create(aDataModule: TDataModule);
2153		-begin
2154		- inherited Create(TClientDataSetItem);
2155		- FDataModule := aDataModule;
2156		-end;
2157		-
2158		-function TClientDataSetCollection.GetClientDataSetItem(aIndex: Word): TClientDataSetItem;
2159		-begin
2160		- Result := TClientDataSetItem(inherited Items[aIndex]);
2161		-end;
2162		-
2163		-function TClientDataSetCollection.GetClientDataSetItemByClientDataSetName(aClientDataSetName: String): TClientDataSetItem;
2164		-var
2165		- CDI: Byte;
2166		-begin
2167		- Result := nil;
2168		-
2169		- if Count > 0 then
2170		- for CDI := 0 to Pred(Count) do
2171		- if UpperCase(TClientDataSetItem(Items[CDI]).ClientDataSet.Name) = UpperCase(aClientDataSetName) then
2172		- begin
2173		- Result := TClientDataSetItem(Items[CDI]);
2174		- Break;
2175		- end;
2176		-end;
2177		-
2178		-function TClientDataSetCollection.GetItemsBrowsing: String;
2179		-var
2180		- DSB: Byte;
2181		-begin
2182		- Result := '';
2183		-
2184		- if Count > 0 then
2185		- for DSB := 0 to Pred(Count) do
2186		- if TClientDataSetItem(Items[DSB]).ClientDataSet.State = dsBrowse then
2187		- begin
2188		- if DSB > 0 then
2189		- Result := Result + ';' + TClientDataSetItem(Items[DSB]).ClientDataSet.Name
2190		- else
2191		- Result := Result + TClientDataSetItem(Items[DSB]).ClientDataSet.Name;
2192		- end;
2193		-end;
2194		-
2195		-function TClientDataSetCollection.GetItemsInserting: String;
2196		-var
2197		- DSI: Byte;
2198		-begin
2199		- Result := '';
2200		-
2201		- if Count > 0 then
2202		- for DSI := 0 to Pred(Count) do
2203		- if TClientDataSetItem(Items[DSI]).ClientDataSet.State = dsInsert then
2204		- begin
2205		- if DSI > 0 then
2206		- Result := Result + ';' + TClientDataSetItem(Items[DSI]).ClientDataSet.Name
2207		- else
2208		- Result := Result + TClientDataSetItem(Items[DSI]).ClientDataSet.Name;
2209		- end;
2210		-end;
2211		-
2212		-function TClientDataSetCollection.GetItemsUpdating: String;
2213		-var
2214		- DSU: Byte;
2215		-begin
2216		- Result := '';
2217		-
2218		- if Count > 0 then
2219		- for DSU := 0 to Pred(Count) do
2220		- if TClientDataSetItem(Items[DSU]).ClientDataSet.State = dsEdit then
2221		- begin
2222		- if DSU > 0 then
2223		- Result := Result + ';' + TClientDataSetItem(Items[DSU]).ClientDataSet.Name
2224		- else
2225		- Result := Result + TClientDataSetItem(Items[DSU]).ClientDataSet.Name;
2226		- end;
2227		-end;
2228		-
2229		-function TClientDataSetCollection.GetUpdatesPending: Boolean;
2230		-var
2231		- CUP: Byte;
2232		-begin
2233		- Result := False;
2234		-
2235		- if Count > 0 then
2236		- for CUP := 0 to Pred(Count) do
2237		- if TClientDataSetItem(Items[CUP]).ClientDataSet.Active and (TClientDataSetItem(Items[CUP]).ClientDataSet.ChangeCount > 0) then
2238		- begin
2239		- Result := True;
2240		- Break;
2241		- end;
2242		-end;
2243		-
2244		-{ TConnectionItem }
2245		-
2246		-constructor TConnectionItem.Create(aCollection: TCollection);
2247		-begin
2248		- inherited;
2249		- FCreationTime := ctUndefined;
2250		-end;
2251		-
2252		-destructor TConnectionItem.Destroy;
2253		-begin
2254		- if FCreationTime = ctRunTime then
2255		- FConnection.Free;
2256		-
2257		- inherited;
2258		-end;
2259		-
2260		-{ TConnectionCollection }
2261		-
2262		-function TConnectionCollection.Add: TConnectionItem;
2263		-begin
2264		- Result := TConnectionItem(inherited Add);
2265		-end;
2266		-
2267		-function TConnectionCollection.AddConnection(AConnectionClass: TConnectionClass; aName: String): TConnectionItem;
2268		-begin
2269		- Result := ConnectionItemByConnectionName[aName];
2270		-
2271		- if not Assigned(Result) then
2272		- begin
2273		- Result := Add;
2274		- with Result do
2275		- begin
2276		- FConnection := AConnectionClass.Create(FDataModule);
2277		- FConnection.Name := aName;
2278		- FCreationTime := ctRunTime;
2279		- end;
2280		- end;
2281		-end;
2282		-
2283		-constructor TConnectionCollection.Create(aDataModule: TDataModule);
2284		-begin
2285		- inherited Create(TConnectionItem);
2286		- FDataModule := aDataModule;
2287		-end;
2288		-
2289		-function TConnectionCollection.GetConnectionItem(aIndex: Word): TConnectionItem;
2290		-begin
2291		- Result := TConnectionItem(inherited Items[aIndex]);
2292		-end;
2293		-
2294		-function TConnectionCollection.GetConnectionItemByConnectionName(AConnectionName: String): TConnectionItem;
2295		-var
2296		- ZCI: Byte;
2297		-begin
2298		- Result := nil;
2299		-
2300		- if Count > 0 then
2301		- for ZCI := 0 to Pred(Count) do
2302		- if UpperCase(TConnectionItem(Items[ZCI]).Connection.Name) = UpperCase(AConnectionName) then
2303		- begin
2304		- Result := TConnectionItem(Items[ZCI]);
2305		- Break;
2306		- end;
2307		-end;
2308		-
2309		-{ TSQLCollection }
2310		-
2311		-function TSQLCollection.Add: TSQLItem;
2312		-begin
2313		- Result := TSQLItem(inherited Add);
2314		-end;
2315		-
2316		-constructor TSQLCollection.Create(aDataModule: TDataModule);
2317		-begin
2318		- inherited Create(TSQLItem);
2319		- FDataModule := aDataModule;
2320		-end;
2321		-
2322		-function TSQLCollection.GetSQLItem(aIndex: Word): TSQLItem;
2323		-begin
2324		- Result := TSQLItem(inherited Items[aIndex]);
2325		-end;
2326		-
2327		-function TSQLCollection.GetSQLItemByID(aID: String): TSQLItem;
2328		-var
2329		- SI: Byte;
2330		-begin
2331		- Result := nil;
2332		-
2333		- if Count > 0 then
2334		- for SI := 0 to Pred(Count) do
2335		- if UpperCase(TSQLItem(Items[SI]).Name) = UpperCase(aID) then
2336		- begin
2337		- Result := TSQLItem(Items[SI]);
2338		- Break;
2339		- end;
2340		-end;
2341		-
2342		-{ TSQLItem }
2343		-
2344		-constructor TSQLItem.Create(aCollection: TCollection);
2345		-begin
2346		- inherited;
2347		- FSQL := TStringList.Create;
2348		-end;
2349		-
2350		-destructor TSQLItem.Destroy;
2351		-begin
2352		- FSQL.Free;
2353		- inherited;
2354		-end;
2355		-
2356		-function TSQLItem.GetDisplayName: string;
2357		-begin
2358		- Result := FName;
2359		-end;
2360		-
2361		-procedure TSQLItem.SetDescription(const Value: String);
2362		-var
2363		- SI: Byte;
2364		-begin
2365		- if Collection.Count > 0 then
2366		- for SI := 0 to Pred(Collection.Count) do
2367		- if UpperCase(TSQLItem(Collection.Items[SI]).Description) = UpperCase(Value) then
2368		- raise Exception.Create('A descrição escolhida já consta na lista de SQLs. Por favor escolha outra descrição');
2369		-
2370		- FDescription := UpperCase(Value);
2371		-end;
2372		-
2373		-procedure TSQLItem.SetName(const Value: String);
2374		-var
2375		- SI: Byte;
2376		-begin
2377		- if Collection.Count > 0 then
2378		- for SI := 0 to Pred(Collection.Count) do
2379		- if UpperCase(TSQLItem(Collection.Items[SI]).Name) = UpperCase(Value) then
2380		- raise Exception.Create('O nome escolhido já consta na lista de SQLs. Por favor escolha outro nome');
2381		-
2382		-
2383		- if not IsValidIdent(Value,True) then
2384		- raise Exception.Create('O nome deve seguir a mesma convenção de nomes das units');
2385		-
2386		- FName := UpperCase(Value);
2387		-end;
2388		-
2389		-procedure TSQLItem.SetSQL(const Value: TStrings);
2390		-begin
2391		- FSQL.Assign(Value);
2392		-end;
2393		-
2394		-{ TKRKSoapDataModule }
2395		-
2396		-constructor TKRKSoapDataModule.Create(AOwner: TComponent);
2397		-begin
2398		- FCriticalSection := TCriticalSection.Create;
2399		- FProviders := TList.Create;
2400		- inherited Create(AOwner);
2401		-end;
2402		-
2403		-destructor TKRKSoapDataModule.Destroy;
2404		-begin
2405		- inherited Destroy;
2406		- FProviders.Free;
2407		- FreeAndNil(FCriticalSection);
2408		-end;
2409		-
2410		-procedure TKRKSoapDataModule.Lock;
2411		-begin
2412		- FCriticalSection.Enter;
2413		-end;
2414		-
2415		-procedure TKRKSoapDataModule.Unlock;
2416		-begin
2417		- FCriticalSection.Leave;
2418		-end;
2419		-
2420		-procedure TKRKSoapDataModule.RegisterProvider(Value: TCustomProvider);
2421		-begin
2422		- FProviders.Add(Value);
2423		-end;
2424		-
2425		-procedure TKRKSoapDataModule.UnRegisterProvider(Value: TCustomProvider);
2426		-begin
2427		- FProviders.Remove(Value);
2428		-end;
2429		-
2430		-function TKRKSoapDataModule.GetProvider(const ProviderName: string): TCustomProvider;
2431		-var
2432		- i: Integer;
2433		-begin
2434		- Result := nil;
2435		- for i := 0 to FProviders.Count - 1 do
2436		- if AnsiCompareStr(TCustomProvider(FProviders[i]).Name, ProviderName) = 0 then
2437		- begin
2438		- Result := TCustomProvider(FProviders[i]);
2439		- if not Result.Exported then
2440		- Result := nil;
2441		- Break;
2442		- end;
2443		- if not Assigned(Result) then
2444		- raise Exception.CreateResFmt(@SProviderNotExported, [ProviderName]);
2445		-end;
2446		-
2447		-{ Internal Implementation }
2448		-
2449		-function TKRKSoapDataModule.GetProviderNames: OleVariant;
2450		-var
2451		- List: TStringList;
2452		- i: Integer;
2453		-begin
2454		- Lock;
2455		- try
2456		- List := TStringList.Create;
2457		- try
2458		- for i := 0 to FProviders.Count - 1 do
2459		- if TCustomProvider(FProviders[i]).Exported then
2460		- List.Add(TCustomProvider(FProviders[i]).Name);
2461		- List.Sort;
2462		- Result := VarArrayFromStrings(List);
2463		- finally
2464		- List.Free;
2465		- end;
2466		- finally
2467		- Unlock;
2468		- end;
2469		-end;
2470		-
2471		-function TKRKSoapDataModule.ApplyUpdates(const ProviderName: WideString; Delta: OleVariant; MaxErrors: Integer; out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant;
2472		-begin
2473		- Lock;
2474		- try
2475		- Result := Providers[ProviderName].ApplyUpdates(Delta, MaxErrors, ErrorCount, OwnerData);
2476		- finally
2477		- Unlock;
2478		- end;
2479		-end;
2480		-
2481		-function TKRKSoapDataModule.GetRecords(const ProviderName: WideString; Count: Integer; out RecsOut: Integer; Options: Integer; const CommandText: WideString; var Params: OleVariant; var OwnerData: OleVariant): OleVariant;
2482		-begin
2483		- Lock;
2484		- try
2485		- Result := Providers[ProviderName].GetRecords(Count, RecsOut, Options, CommandText, Params, OwnerData);
2486		- finally
2487		- Unlock;
2488		- end;
2489		-end;
2490		-
2491		-function TKRKSoapDataModule.RowRequest(const ProviderName: WideString; Row: OleVariant; RequestType: Integer; var OwnerData: OleVariant): OleVariant;
2492		-begin
2493		- Lock;
2494		- try
2495		- Result := Providers[ProviderName].RowRequest(Row, RequestType, OwnerData);
2496		- finally
2497		- Unlock;
2498		- end;
2499		-end;
2500		-
2501		-function TKRKSoapDataModule.DataRequest(const ProviderName: WideString; Data: OleVariant): OleVariant;
2502		-begin
2503		- Lock;
2504		- try
2505		- Result := Providers[ProviderName].DataRequest(Data);
2506		- finally
2507		- Unlock;
2508		- end;
2509		-end;
2510		-
2511		-function TKRKSoapDataModule.GetParams(const ProviderName: WideString; var OwnerData: OleVariant): OleVariant;
2512		-begin
2513		- Lock;
2514		- try
2515		- Result := Providers[ProviderName].GetParams(OwnerData);
2516		- finally
2517		- Unlock;
2518		- end;
2519		-end;
2520		-
2521		-procedure TKRKSoapDataModule.Execute(const ProviderName: WideString; const CommandText: WideString; var Params, OwnerData: OleVariant);
2522		-begin
2523		- Lock;
2524		- try
2525		- Providers[ProviderName].Execute(CommandText, Params, OwnerData);
2526		- finally
2527		- Unlock;
2528		- end;
2529		-end;
2530		-
2531		-{ IAppServer Implementation }
2532		-
2533		-function TKRKSoapDataModule.AS_GetProviderNames: OleVariant;
2534		-begin
2535		- Result := GetProviderNames;
2536		-end;
2537		-
2538		-function TKRKSoapDataModule.AS_ApplyUpdates(const ProviderName: WideString; Delta: OleVariant; MaxErrors: Integer; out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant;
2539		-begin
2540		- Result := ApplyUpdates(ProviderName, Delta, MaxErrors, ErrorCount, OwnerData);
2541		-end;
2542		-
2543		-function TKRKSoapDataModule.AS_GetRecords(const ProviderName: WideString; Count: Integer; out RecsOut: Integer; Options: Integer; const CommandText: WideString; var Params: OleVariant; var OwnerData: OleVariant): OleVariant; safecall;
2544		-begin
2545		- Result := GetRecords(ProviderName, Count, RecsOut, Options, CommandText, Params, OwnerData);
2546		-end;
2547		-
2548		-function TKRKSoapDataModule.AS_RowRequest(const ProviderName: WideString; Row: OleVariant; RequestType: Integer; var OwnerData: OleVariant): OleVariant;
2549		-begin
2550		- Result := RowRequest(ProviderName, Row, RequestType, OwnerData);
2551		-end;
2552		-
2553		-function TKRKSoapDataModule.AS_DataRequest(const ProviderName: WideString; Data: OleVariant): OleVariant; safecall;
2554		-begin
2555		- Result := DataRequest(ProviderName, Data);
2556		-end;
2557		-
2558		-function TKRKSoapDataModule.AS_GetParams(const ProviderName: WideString; var OwnerData: OleVariant): OleVariant;
2559		-begin
2560		- Result := GetParams(ProviderName, OwnerData);
2561		-end;
2562		-
2563		-procedure TKRKSoapDataModule.AS_Execute(const ProviderName: WideString; const CommandText: WideString; var Params, OwnerData: OleVariant);
2564		-begin
2565		- Execute(ProviderName, CommandText, Params, OwnerData);
2566		-end;
2567		-
2568		-function TKRKSoapDataModule.GetProviderCount: integer;
2569		-begin
2570		- Result := FProviders.Count;
2571		-end;
2572		-
2573		-{ IAppServerSoap Implementation }
2574		-
2575		-function TKRKSoapDataModule.SAS_ApplyUpdates(const ProviderName: WideString; Delta: OleVariant; MaxErrors: Integer; out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant; stdcall;
2576		-begin
2577		- Result := ApplyUpdates(ProviderName, Delta, MaxErrors, ErrorCount, OwnerData);
2578		-end;
2579		-
2580		-function TKRKSoapDataModule.SAS_GetRecords(const ProviderName: WideString; Count: Integer; out RecsOut: Integer; Options: Integer; const CommandText: WideString; var Params: OleVariant; var OwnerData: OleVariant): OleVariant; stdcall;
2581		-begin
2582		- Result := GetRecords(ProviderName, Count, RecsOut, Options, CommandText, Params, OwnerData);
2583		-end;
2584		-
2585		-function TKRKSoapDataModule.SAS_DataRequest(const ProviderName: WideString; Data: OleVariant): OleVariant; stdcall;
2586		-begin
2587		- Result := DataRequest(ProviderName, Data);
2588		-end;
2589		-
2590		-function TKRKSoapDataModule.SAS_GetProviderNames: TWideStringDynArray; stdcall;
2591		-var
2592		- V: OleVariant;
2593		- I, Len: Integer;
2594		-begin
2595		- V := GetProviderNames;
2596		- if not VarIsNull(V) and VarIsArray(V) then
2597		- begin
2598		- for I := 0 to VarArrayHighBound(V, 1) do
2599		- begin
2600		- Len := Length(Result);
2601		- SetLength(Result, Len+1);
2602		- Result[Len] := V[I];
2603		- end;
2604		- end;
2605		-end;
2606		-
2607		-function TKRKSoapDataModule.SAS_GetParams(const ProviderName: WideString; var OwnerData: OleVariant): OleVariant; stdcall;
2608		-begin
2609		- Result := GetParams(ProviderName, OwnerData);
2610		-end;
2611		-
2612		-function TKRKSoapDataModule.SAS_RowRequest(const ProviderName: WideString; Row: OleVariant; RequestType: Integer; var OwnerData: OleVariant): OleVariant; stdcall;
2613		-begin
2614		- Result := RowRequest(ProviderName, Row, RequestType, OwnerData);
2615		-end;
2616		-
2617		-procedure TKRKSoapDataModule.SAS_Execute(const ProviderName: WideString; const CommandText: WideString; var Params: OleVariant; var OwnerData: OleVariant); stdcall;
2618		-begin
2619		- Execute(ProviderName, CommandText, Params, OwnerData);
2620		-end;
2621		-
2622		-procedure TKRKSoapDataModule.AfterConstruction;
2623		-begin
2624		- inherited;
2625		- {$IF RTLVersion > 18}
2626		- TInterlocked.Decrement(FRefCount);
2627		- {$ELSE}
2628		- InterlockedDecrement(FRefCount);
2629		- {$IFEND}
2630		-end;
2631		-
2632		-procedure TKRKSoapDataModule.BeforeDestruction;
2633		-begin
2634		- inherited;
2635		-end;
2636		-
2637		-function TKRKSoapDataModule._AddRef: Integer;
2638		-begin
2639		- {$IF RTLVersion > 18}
2640		- Result := TInterlocked.Increment(FRefCount);
2641		- {$ELSE}
2642		- Result := InterlockedIncrement(FRefCount);
2643		- {$IFEND}
2644		-end;
2645		-
2646		-function TKRKSoapDataModule._Release: Integer;
2647		-begin
2648		- {$IF RTLVersion > 18}
2649		- Result := TInterlocked.Decrement(FRefCount);
2650		- {$ELSE}
2651		- Result := InterlockedDecrement(FRefCount);
2652		- {$IFEND}
2653		- { If we are not being used as a TComponent, then use refcount to manage our
2654		- lifetime as with TInterfacedObject. }
2655		- if (Result = 0) and (not Assigned(Owner)) then
2656		- Destroy;
2657		-end;
2658		-
2659		-{ Set an implicit refcount so that refcounting
2660		- during construction won't destroy the object. }
2661		-class function TKRKSoapDataModule.NewInstance: TObject;
2662		-begin
2663		- Result := inherited NewInstance;
2664		- TKRKSoapDataModule(Result).FRefCount := 1;
2665		-end;
2666		-
2667		-function TKRKSoapDataModule.SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult;
2668		-begin
2669		- Result := HandleSafeCallException(ExceptObject, ExceptAddr, IAppServer, '', '');
2670		-end;
2671		-
2672	1424	{ EKernel }
2673	1425
2674	1426	constructor EKernel.Create(const ALastError: DWORD; AMessage: string);

--- trunk/rtp/src/Rtl/Win/KRK.Rtl.Win.CommCtrl.pas (revision 574)

+++ trunk/rtp/src/Rtl/Win/KRK.Rtl.Win.CommCtrl.pas (revision 575)

		@@ -131,7 +131,7 @@
131	131	//: identificada por Ahwnd e AuId
132	132	procedure SetText(const Ahwnd: HWND; const AuId: UINT_PTR; const AlpszText: PChar);
133	133	//: Altera a largura máxima da janela de ToolTip. Um texto que não couber
134		- //: nesta largua será quebrado em várias linhas de forma a manter a largura
	134	+ //: nesta largura será quebrado em várias linhas de forma a manter a largura
135	135	//: máxima configurada
136	136	//: Atenção! Esta configuração afeta todas as configurações de exibição,
137	137	//: pois trata-se de uma configuração da janela de ToolTip em si.

		@@ -146,8 +146,50 @@
146	146	//: Atenção! Esta configuração afeta todas as configurações de exibição,
147	147	//: pois trata-se de uma configuração da janela de ToolTip em si.
148	148	procedure SetActive(const AValue: Boolean);
	149	+ //: Configura as opções padrão da janela de ToolTip
	150	+ procedure SetDefaultToolTipWindowProperties;
149	151	public
150		- constructor Create(AToolTipStyles: Cardinal = TTS_NOPREFIX or TTS_ALWAYSTIP or TTS_BALLOON; ADefaultWidth: SmallInt = -1; ADefaultTitle: String = 'Nenhum título definido'; ADefaultIcon: HICON = TTI_INFO);
	152	+ //: Cria uma instância da classe atual.
	153	+ //: Ao criar a classe atual informe em ADefaultIcon o ID de um ícone do
	154	+ //: tamanho correto que será usado durante todo o tempo de vida da aplicação
	155	+ //: ou TTI_NONE, caso não se queira usar ícones. Informar um ícone menor ou
	156	+ //: maior do que o tamanho que será usado na aplicação faz com que ao trocar
	157	+ //: um ícone por outro de tamanho diferente (ou remover o ícone), o texto do
	158	+ //: ToolTip apareça cortado ou o ToolTip apareça maior do que o necessário.
	159	+ //: Nesta situação, exibir o mesmo ToolTip uma segunda vez, faz com que o
	160	+ //: mesmo apareça corretamente, mas não queremos este comportamento,
	161	+ //: portanto é necessário decidir desde o começo se os ToolTips exibidos
	162	+ //: pela classe atual terão ícones e se tiverem, defina um ícone padrão que
	163	+ //: tenha o tamanho dos ícones que devem ser apresentados no decorrer da
	164	+ //: execução do programa.
	165	+ //: Um problema similar ocorre com texto do título em ToolTips do tipo
	166	+ //: balão, por isso existe o parâmetro ADefaultTitle o qual serve para que
	167	+ //: seja informado o texto a ser apresentado por padrão no título de um
	168	+ //: ToolTip deste tipo. Garanta que este texto seja menor ou igual a todos
	169	+ //: os outros títulos que porventura sejam apresentados nos ToolTips
	170	+ //: automáticos da classe sendo criada, pois toda vez que se oculta um
	171	+ //: ToolTip, este texto é recuperado e caso ele seja maior que o título de
	172	+ //: um ToolTip exibido posteriormente, haverá problemas nas dimensões do
	173	+ //: ToolTip que precisarão ser corrigidos por meio do uso de SetIconAndTitle
	174	+ //: dentro do evento OnHide desta classe (em suma, uma gambiarra mesmo).
	175	+ //: Isso acontece porque o ToolTip só consegue se ajustar aumentando o
	176	+ //: tamanho do texto do seu título ou mantendo este texto do mesmo tamanho.
	177	+ //: Caso se tente mostrar um ToolTip com um título menor que o que foi
	178	+ //: configurado anteriormente, a primeira exibição deste ToolTip mostrará o
	179	+ //: balão maior do que deveria, pois ele ainda está achando que está com o
	180	+ //: título maior. Uma segunda exibição mostrará o balão no tamanho correto!
	181	+ //: Portanto, para mostrar o balão no tamanho correto sempre, o título do
	182	+ //: mesmo tem que ser do mesmo tamanho ou ser maior do que o seu tamanho
	183	+ //: padrão. Caso você não tenha intenção de mostrar o título padrão, você
	184	+ //: pode definir aqui como padrão apenas uma letra pois evidentemente todo e
	185	+ //: qualquer título válido será maior do que uma letra e assim o balão
	186	+ //: aparecerá no tamanho correto.
	187	+ //: Estes problemas relacionados a linha de título de um balão só afetam os
	188	+ //: ToolTips automáticos, pois os ToolTips tracking podem ser
	189	+ //: preconfigurados antes de serem exibidos e isso resolve os problemas de
	190	+ //: dimensionamento e limitações de tamanho e troca de ícones e textos de
	191	+ //: título (não testei isso)
	192	+ constructor Create(AToolTipStyles: Cardinal = TTS_NOPREFIX or TTS_ALWAYSTIP or TTS_BALLOON; ADefaultWidth: SmallInt = -1; ADefaultTitle: String = 'Sem título'; ADefaultIcon: HICON = TTI_INFO);
151	193	destructor Destroy; override;
152	194
153	195	//: Adiciona uma configuração de exibição para a janela de ToolTip atual

		@@ -194,7 +236,7 @@
194	236	procedure Show(const Ahwnd: HWND; const AuId: UINT_PTR; const AActivateOnShow: Boolean = True); overload;
195	237	//: Obtém o handle para um ícone adicionado aos recursos da aplicação e
196	238	//: identificado por AResourceId
197		- function IconResourceId2IconHandle(AIconResourceId: LPTSTR): HICON;
	239	+ class function IconResourceId2IconHandle(AIconResourceId: LPTSTR): HICON;
198	240	//: Atribui o ícone e o título da janela de ToolTip
199	241	procedure SetIconAndTitle(const AIconHandle: HICON; const ATitle: LPTSTR);
200	242

		@@ -215,6 +257,7 @@
215	257	//: estas notificações em uma janela cujo handle tenha sido informado no
216	258	//: membro hwnd de uma das estruturas TOOLINFO registradas
217	259	property OnHide: TNotifyEvent read FOnHide write FOnHide;
	260	+ property ToolTipWindowHandle: HWND read FToolTipWindowHandle;
218	261	end;
219	262
220	263	const

		@@ -271,7 +314,7 @@
271	314
272	315	{ TKRKTrackingToolTip }
273	316
274		-constructor TKRKToolTip.Create(AToolTipStyles: Cardinal = TTS_NOPREFIX or TTS_ALWAYSTIP or TTS_BALLOON; ADefaultWidth: SmallInt = -1; ADefaultTitle: String = 'Nenhum título definido'; ADefaultIcon: HICON = TTI_INFO);
	317	+constructor TKRKToolTip.Create(AToolTipStyles: Cardinal = TTS_NOPREFIX or TTS_ALWAYSTIP or TTS_BALLOON; ADefaultWidth: SmallInt = -1; ADefaultTitle: String = 'Sem título'; ADefaultIcon: HICON = TTI_INFO);
275	318	begin
276	319	// Cria a janela do ToolTip com os parâmetros especificados e coloca seu
277	320	// Handle em FToolTipWindowHandle

		@@ -281,14 +324,13 @@
281	324	ReplaceOriginalWndProc;
282	325
283	326	FActive := True;
284		-
	327	+ // A respeito das propriedades Default abaixo, leia a descrição da classe
285	328	FDefaultWidth := ADefaultWidth;
286	329	FDefaultTitle := PChar(ADefaultTitle);
287	330	FDefaultIcon := ADefaultIcon;
288	331
289	332	// Definindo as opções padão
290		- SetMaxTipWidth(FDefaultWidth);
291		- SetIconAndTitle(FDefaultIcon,FDefaultTitle);
	333	+ SetDefaultToolTipWindowProperties;
292	334	end;
293	335
294	336	// Original ToolTip WndProc

		@@ -295,6 +337,8 @@
295	337	var
296	338	OTTWNDPROC: Pointer = nil;
297	339
	340	+// [1] https://stackoverflow.com/questions/71314521/why-a-balloon-tooltip-with-tts-close-style-cannot-be-displayed-again-after-the?noredirect=1#comment126164081_71314521
	341	+
298	342	// ToolTip WndProc
299	343	function NTTWNDPROC(AWindowHandle: HWND; AMessage: UINT; AWParam: WPARAM; ALParam: LPARAM): LRESULT; stdcall;
300	344	var

		@@ -305,21 +349,27 @@
305	349	KRTT := TKRKToolTip(GetWindowLong(AWindowHandle,GWL_USERDATA));
306	350
307	351	// Sempre que uma janela de ToolTip é ocultada, uma mensagem WM_SHOWWINDOW é
308		- // envida para a janela do ToolTip (com AWParam = 0). Quando o botão fechar de
309		- // um ToolTip do tipo balão é clicado, a janela de ToolTip recebe esta
310		- // mensagem também, contudo nenhum ToolTip será exibido posteriormente, a não
311		- // ser que se execute a mensagem de ocultação do ToolTip. Os métodos Show
312		- // usados para Tracking ToolTips já executam Hide antes de exibir o ToolTip, o
313		- // problema é com os ToolTips automáticos, sobre os quais não temos contrlole
314		- // de quando eles são exibidos, por isso a saída é, toda vez que se oculta um
315		- // ToolTip do tipo balão cuja janela tenha o estilo TTS_CLOSE definido,
316		- // executar de forma forçada a ocultação do ToolTip.
	352	+ // envida para a janela do ToolTip (com AWParam = 0)
317	353	if AMessage = WM_SHOWWINDOW then
318	354	begin
319		- // HasCloseButton só retorna True se há um botão de fechar sendo exibido no
320		- // ToolTip e isso só é verdade se o ToolTip for um balão, portanto,
321		- // HasCloseButton só retorna true se os estilos TTS_BALLOON e TTS_CLOSE
322		- // estiverem definidos!
	355	+ // Quando o botão fechar de um ToolTip do tipo balão é clicado, a janela de
	356	+ // ToolTip recebe esta mensagem também, contudo nenhum ToolTip será exibido
	357	+ // posteriormente, a não ser que se execute a mensagem de ocultação do
	358	+ // ToolTip. Leia mais a respeito disso em [1]. Os métodos Show usados para
	359	+ // Tracking ToolTips já executam Hide antes de exibir o ToolTip (com o
	360	+ // intuito de não exibir uma configuração diferente de ToolTip enquanto uma
	361	+ // anterior ainda está sendo visualizada), logo, este problema não ocorre
	362	+ // nestes casos, o problema é com os ToolTips automáticos, sobre os quais
	363	+ // não temos contrlole de quando eles são exibidos, a não ser usando a
	364	+ // mensagem de notificação TTN_POPUP, mas isso implicaria em ter que
	365	+ // manipular esta mensagem em uma janela cujo Handle fora informado em
	366	+ // TOOLINFO.hwnd, o que tornaria a classe atual sempre dependente dessa
	367	+ // manipulação. A saída que eu encontrei foi: toda vez que se oculta um
	368	+ // ToolTip do tipo balão cuja janela tenha o estilo TTS_CLOSE definido,
	369	+ // executar de forma forçada a ocultação do ToolTip. Abaixo, HasCloseButton
	370	+ // só retorna True se há um botão de fechar sendo exibido no ToolTip e isso
	371	+ // só é verdade se o ToolTip for um balão, portanto, HasCloseButton só
	372	+ // retorna true se os estilos TTS_BALLOON e TTS_CLOSE estiverem definidos!
323	373	if KRTT.HasCloseButton then
324	374	begin
325	375	KRTT.RestoreOriginalWndProc;

		@@ -327,6 +377,14 @@
327	377	KRTT.ReplaceOriginalWndProc;
328	378	end;
329	379
	380	+ // A exibição de um ToolTip do tipo tracking pode alterar a largura da
	381	+ // janela de ToolTip, neste caso, garantimos aqui que quando um ToolTip for
	382	+ // exibido ele terá a largura padrão definida na propriedade FDefaultWidth.
	383	+ // O mesmo se aplica ao ícone e ao título de um ToolTip do tipo balão.
	384	+ // Sempre que se ocultar um ToolTip, o ícone e o título padrões serão
	385	+ // recuperados
	386	+ KRTT.SetDefaultToolTipWindowProperties;
	387	+
330	388	if Assigned(KRTT.FOnHide) then
331	389	KRTT.FOnHide(KRTT);
332	390	end;

		@@ -539,11 +597,11 @@
539	597	// configurações contidas na estrutura TToolInfo identificada pelos
540	598	// membros hwnd e uId
541	599	SendMessage(FToolTipWindowHandle,TTM_TRACKACTIVATE,WPARAM(False),LPARAM(@ToolInfo));
542		- // A exibição de um ToolTip do tipo tracking pode ter alterado a largura
543		- // da janela de ToolTip, neste caso, garantimos aqui que quando um ToolTip
544		- // não tracking for exibido ele terá a largura padrão definida na
545		- // propriedade FDefaultToolTipWidth
546		- SetMaxTipWidth(FDefaultWidth);
	600	+ // Aqui havia uma chamada a SetMaxTipWidth que foi movida para a manipulação
	601	+ // da mensagem WM_SHOWWINDOW. Se você estiver lendo isso e não estivere
	602	+ // resolvendo algum problema relacionado a largura do ToolTip, então muito
	603	+ // provavelmente esse problema não existe mais e você pode remover este
	604	+ // comentário
547	605	end;
548	606	end;
549	607

		@@ -554,7 +612,10 @@
554	612
555	613	function TKRKToolTip.IsBalloon: Boolean;
556	614	begin
557		- Result := GetWindowLongPtr(FToolTipWindowHandle,GWL_STYLE) and TTS_BALLOON = TTS_BALLOON;
	615	+ Result := False;
	616	+
	617	+ if FToolTipWindowHandle > 0 then
	618	+ Result := GetWindowLongPtr(FToolTipWindowHandle,GWL_STYLE) and TTS_BALLOON = TTS_BALLOON;
558	619	end;
559	620
560	621	function TKRKToolTip.IsVisible: Boolean;

		@@ -730,7 +791,7 @@
730	791	end;
731	792	end;
732	793
733		-function TKRKToolTip.IconResourceId2IconHandle(AIconResourceId: LPTSTR): HICON;
	794	+class function TKRKToolTip.IconResourceId2IconHandle(AIconResourceId: LPTSTR): HICON;
734	795	begin
735	796	Result := 0;
736	797

		@@ -748,6 +809,14 @@
748	809	end;
749	810	end;
750	811
	812	+procedure TKRKToolTip.SetDefaultToolTipWindowProperties;
	813	+begin
	814	+ SetMaxTipWidth(FDefaultWidth);
	815	+
	816	+ if IsBalloon then
	817	+ SetIconAndTitle(FDefaultIcon,FDefaultTitle);
	818	+end;
	819	+
751	820	procedure TKRKToolTip.SetIconAndTitle(const AIconHandle: HICON; const ATitle: LPTSTR);
752	821	begin
753	822	if FToolTipWindowHandle <> 0 then

--- trunk/rtp/src/Vcl/KRK.Vcl.Forms.pas (revision 574)

+++ trunk/rtp/src/Vcl/KRK.Vcl.Forms.pas (revision 575)

		@@ -3,8 +3,9 @@
3	3	interface
4	4
5	5	uses
6		- Forms, Messages, Classes, Buttons, Controls, Graphics, Windows,
7		- KRK.Vcl.StdCtrls, CommCtrl;
	6	+ Forms, Messages, Buttons, Controls, Graphics, Windows, ExtCtrls,
	7	+ Midas, SoapMidas, Provider, SyncObjs, Types, DB, DBClient, Classes,
	8	+ KRK.Vcl.StdCtrls, KRK.Rtl.Common.Classes;
8	9
9	10	type
10	11	TVisibleButton = (vbOk,vbYes,vbYesToAll,vbNo,vbIgnore,vbCancel,vbClose,vbHelp);

		@@ -68,12 +69,6 @@
68	69	property ButtonsPanel: TButtonsPanel read FButtonsPanel write FButtonsPanel;
69	70	end;
70	71
71		- TTTNLinkClick = procedure (ANMLink: TNMLink) of object;
72		- TTTNGetDispInfo = procedure (ANMDispInfo: {$IFDEF UNICODE}PNMTTDispInfoW{$ELSE}PNMTTDispInfoA{$ENDIF}) of object;
73		- TTTNShow = procedure (ANMHdr: TNMHdr) of object;
74		- TTTNPop = procedure (ANMHdr: TNMHdr) of object;
75		- TTTNCustomDraw = procedure (ANMTTCustomDraw: TNMTTCustomDraw) of object;
76		-
77	72	{ Novos Forms precisam ser herdados de TForm e não de TCustomForm porque
78	73	apenas os descendentes de TForm são incluídos na lista de forms de tela no
79	74	objeto TScreen, não sei se é um bug, mas é assim }

		@@ -106,6 +101,7 @@
106	101	protected
107	102	procedure DoClose(var Action: TCloseAction); override;
108	103	procedure DoShow; override;
	104	+ //: Manipula as mensagens de notificação que forem enviadas e este Form
109	105	procedure HandleNotificationMessages(var AMessage: TWMNotify); message WM_NOTIFY;
110	106	public
111	107	constructor Create(aOwner: TComponent); override;

		@@ -147,6 +143,327 @@
147	143
148	144	TKRKFormClass = class of TKRKForm;
149	145
	146	+ { == Coleção de DataSources ================================================ }
	147	+ TDataSourceItem = class (TCollectionItem)
	148	+ private
	149	+ FCreationTime: TCreationTime;
	150	+ FDataSource: TDataSource;
	151	+ FPtr: Pointer;
	152	+ public
	153	+ constructor Create(aCollection: TCollection); override;
	154	+ destructor Destroy; override;
	155	+
	156	+ property CreationTime: TCreationTime read FCreationTime default ctUndefined;
	157	+ property DataSource: TDataSource read FDataSource;
	158	+ property Ptr: Pointer read FPtr;
	159	+ end;
	160	+
	161	+ TDataSourceClass = class of TDataSource;
	162	+
	163	+ { Aqui foram replicadas as propriedades que verificam os datasets ligados aos
	164	+ datasources pois nem sempre um dataset está ligado a um datasource. O
	165	+ resultado obtido com as propriedades de TDataSets inclui TODOS os datasets. }
	166	+ TDataSourceCollection = class (TCollection)
	167	+ private
	168	+ FDataModule: TDataModule;
	169	+ function GetDataSourceItem(aIndex: Word): TDataSourceItem;
	170	+ function GetDataSourceItemByName(aDataSourceName: String): TDataSourceItem;
	171	+ function GetItemsBrowsing: String;
	172	+ function GetItemsInserting: String;
	173	+ function GetItemsUpdating: String;
	174	+ protected
	175	+ function Add: TDataSourceItem;
	176	+ constructor Create(aDataModule: TDataModule); reintroduce;
	177	+ public
	178	+ function AddDataSource(aDataSourceClass: TDataSourceClass; aName: String): TDataSourceItem;
	179	+
	180	+ property DataSourceItem[aIndex: Word]: TDataSourceItem read GetDataSourceItem;
	181	+ property DataSourceItemByName[aDataSourceName: String]: TDataSourceItem read GetDataSourceItemByName; default;
	182	+ property ItemsInserting: String read GetItemsInserting;
	183	+ property ItemsUpdating: String read GetItemsUpdating;
	184	+ property ItemsBrowsing: String read GetItemsBrowsing;
	185	+ end;
	186	+ { ========================================================================== }
	187	+
	188	+ { TODO : Crie para cada item de cada coleção propriedades para acessar as
	189	+ propriedades internas e eventos }
	190	+ { TODO : O campo FPtr sempre guarda um ponteiro para o componente sendo
	191	+ colocado na coleção. Isso é necessário pois alguns componentes colocados nos
	192	+ datamodules são modificados por classes interposer e não há meios realizar um
	193	+ type cast bem sucedido usando apenas aquilo que é salvo na coleção, devido ao
	194	+ fato de que o que é salvo na coleção sempre é a versão padrão do componente,
	195	+ isto é, que não passou pela classe interposer, tornando o cast impossível.
	196	+ Tentativas de cast direto mostraram que os membros inseridos pela classe
	197	+ interposer nunca eram acessíveis. Ao dar um cast usando o ponteiro, toda
	198	+ informação é conseguida sem problemas. Por exemplo:
	199	+
	200	+ TClientDataSet(ClientDataSets['CLDSUsuarios']).MembroInseridoEmClasseInterposer
	201	+
	202	+ Vai compilar, mas vai gerar uma Runtime Exception, enquanto que
	203	+
	204	+ TClientDataSet(ClientDataSets['CLDSUsuarios'].Ptr^).MembroInseridoEmClasseInterposer
	205	+
	206	+ Vai funcionar sem problemas }
	207	+ { == Coleção de DataSets =================================================== }
	208	+ TDataSetItem = class (TCollectionItem)
	209	+ private
	210	+ FCreationTime: TCreationTime;
	211	+ FDataSet: TDataSet;
	212	+ FPtr: Pointer;
	213	+ public
	214	+ constructor Create(aCollection: TCollection); override;
	215	+ destructor Destroy; override;
	216	+
	217	+ property CreationTime: TCreationTime read FCreationTime default ctUndefined;
	218	+ property DataSet: TDataSet read FDataSet;
	219	+ property Ptr: Pointer read FPtr;
	220	+ end;
	221	+
	222	+ TDataSetCollection = class (TCollection)
	223	+ private
	224	+ FDataModule: TDataModule;
	225	+ function GetDataSetItem(aIndex: Word): TDataSetItem;
	226	+ function GetDataSetItemByDataSetName(aDataSetName: String): TDataSetItem;
	227	+ function GetItemsBrowsing: String;
	228	+ function GetItemsInserting: String;
	229	+ function GetItemsUpdating: String;
	230	+ protected
	231	+ function Add: TDataSetItem;
	232	+ constructor Create(aDataModule: TDataModule); reintroduce;
	233	+ public
	234	+ function AddDataSet(aDataSetClass: TDataSetClass; aName: String): TDataSetItem;
	235	+ procedure OpenAll;
	236	+ procedure CloseAll;
	237	+ procedure CancelAll;
	238	+
	239	+ property DataSetItem[aIndex: Word]: TDataSetItem read GetDataSetItem;
	240	+ property DataSetItemByDataSetName[aDataSetName: String]: TDataSetItem read GetDataSetItemByDataSetName; default;
	241	+ property ItemsInserting: String read GetItemsInserting;
	242	+ property ItemsUpdating: String read GetItemsUpdating;
	243	+ property ItemsBrowsing: String read GetItemsBrowsing;
	244	+ end;
	245	+ { ========================================================================== }
	246	+
	247	+ { = Coleção de ClientDataSets ============================================== }
	248	+ TClientDataSetItem = class (TCollectionItem)
	249	+ private
	250	+ FCreationTime: TCreationTime;
	251	+ FClientDataSet: TClientDataSet;
	252	+ FPtr: Pointer;
	253	+ public
	254	+ constructor Create(aCollection: TCollection); override;
	255	+ destructor Destroy; override;
	256	+
	257	+ property CreationTime: TCreationTime read FCreationTime default ctUndefined;
	258	+ property ClientDataSet: TClientDataSet read FClientDataSet;
	259	+ property Ptr: Pointer read FPtr;
	260	+ end;
	261	+
	262	+ TClientDataSetClass = class of TClientDataSet;
	263	+
	264	+ TClientDataSetCollection = class (TCollection)
	265	+ private
	266	+ FDataModule: TDataModule;
	267	+ function GetClientDataSetItem(aIndex: Word): TClientDataSetItem;
	268	+ function GetClientDataSetItemByClientDataSetName(aClientDataSetName: String): TClientDataSetItem;
	269	+ function GetItemsBrowsing: String;
	270	+ function GetItemsInserting: String;
	271	+ function GetItemsUpdating: String;
	272	+ function GetUpdatesPending: Boolean;
	273	+ protected
	274	+ function Add: TClientDataSetItem;
	275	+ constructor Create(aDataModule: TDataModule); reintroduce;
	276	+ public
	277	+ function AddClientDataSet(aClientDataSetClass: TClientDataSetClass; aName: String): TClientDataSetItem;
	278	+ procedure CancelAll;
	279	+
	280	+ property ClientDataSetItem[aIndex: Word]: TClientDataSetItem read GetClientDataSetItem;
	281	+ property ClientDataSetItemByClientDataSetName[aClientDataSetName: String]: TClientDataSetItem read GetClientDataSetItemByClientDataSetName; default;
	282	+ property ItemsInserting: String read GetItemsInserting;
	283	+ property ItemsUpdating: String read GetItemsUpdating;
	284	+ property ItemsBrowsing: String read GetItemsBrowsing;
	285	+ property UpdatesPending: Boolean read GetUpdatesPending;
	286	+ end;
	287	+ { ========================================================================== }
	288	+
	289	+ { == Coleção de TCustomConnection ========================================== }
	290	+ TConnectionItem = class (TCollectionItem)
	291	+ private
	292	+ FCreationTime: TCreationTime;
	293	+ FConnection: TCustomConnection;
	294	+ FPtr: Pointer;
	295	+ public
	296	+ constructor Create(aCollection: TCollection); override;
	297	+ destructor Destroy; override;
	298	+
	299	+ property CreationTime: TCreationTime read FCreationTime default ctUndefined;
	300	+ property Connection: TCustomConnection read FConnection;
	301	+ property Ptr: Pointer read FPtr;
	302	+ end;
	303	+
	304	+ TConnectionClass = class of TCustomConnection;
	305	+
	306	+ TConnectionCollection = class (TCollection)
	307	+ private
	308	+ FDataModule: TDataModule;
	309	+ function GetConnectionItem(aIndex: Word): TConnectionItem;
	310	+ function GetConnectionItemByConnectionName(AConnectionName: String): TConnectionItem;
	311	+ protected
	312	+ function Add: TConnectionItem;
	313	+ constructor Create(aDataModule: TDataModule); reintroduce;
	314	+ public
	315	+ function AddConnection(AConnectionClass: TConnectionClass; aName: String): TConnectionItem;
	316	+
	317	+ property ConnectionItem[aIndex: Word]: TConnectionItem read GetConnectionItem;
	318	+ property ConnectionItemByConnectionName[AZConnectionName: String]: TConnectionItem read GetConnectionItemByConnectionName; default;
	319	+ end;
	320	+ { ========================================================================== }
	321	+
	322	+ { == Coleção de SQLs que são salvas com o DFM ============================== }
	323	+ TSQLItem = class (TCollectionItem)
	324	+ private
	325	+ FSQL: TStrings;
	326	+ FName: String;
	327	+ FDescription: String;
	328	+ procedure SetSQL(const Value: TStrings);
	329	+ procedure SetDescription(const Value: String);
	330	+ procedure SetName(const Value: String);
	331	+ protected
	332	+ function GetDisplayName: string; override;
	333	+ public
	334	+ constructor Create(aCollection: TCollection); override;
	335	+ destructor Destroy; override;
	336	+ published
	337	+ property SQL: TStrings read FSQL write SetSQL;
	338	+ property Name: String read FName write SetName;
	339	+ property Description: String read FDescription write SetDescription;
	340	+ end;
	341	+
	342	+ TSQLCollection = class (TCollection)
	343	+ private
	344	+ FDataModule: TDataModule;
	345	+ function GetSQLItem(aIndex: Word): TSQLItem;
	346	+ function GetSQLItemByID(aID: String): TSQLItem;
	347	+ protected
	348	+ function Add: TSQLItem;
	349	+ constructor Create(aDataModule: TDataModule); reintroduce;
	350	+ public
	351	+ property SQLItem[aIndex: Word]: TSQLItem read GetSQLItem;
	352	+ property SQLItemByID[aID: String]: TSQLItem read GetSQLItemByID; default;
	353	+ end;
	354	+ { ========================================================================== }
	355	+
	356	+ TKRKDataModuleClass = class of TKRKCustomDataModule;
	357	+
	358	+ PKRKDataModule = ^TKRKCustomDataModule;
	359	+
	360	+ TBeforeCreateMyForm = procedure(const AMyFormClass: String) of object;
	361	+ TAfterCreateMyForm = procedure(const AKRKForm: TKRKForm) of object;
	362	+
	363	+ //: Esta classe define um Anak Krakatoa DataModule, com todos os seus métodos
	364	+ //: e propriedades. Uma instância desta classe é criada por um wizard.
	365	+ TKRKCustomDataModule = class(TDataModule)
	366	+ private
	367	+ FMyReference: PKRKDataModule;
	368	+ FDataSources: TDataSourceCollection;
	369	+ FDataSets: TDataSetCollection;
	370	+ FClientDataSets: TClientDataSetCollection;
	371	+ FConnections: TConnectionCollection;
	372	+ FSQLs: TSQLCollection;
	373	+ FKRKDataModuleProperties: TKRKDataModuleProperties;
	374	+ FMyForm: TKRKForm;
	375	+ FMyFormClass: String;
	376	+ FTimer: TTimer;
	377	+ FOnBeforeCreateMyForm: TBeforeCreateMyForm;
	378	+ FOnAfterCreateMyForm: TAfterCreateMyForm;
	379	+ procedure DoTimer(aSender: TObject);
	380	+ protected
	381	+ property MyForm: TKRKForm read FMyForm;
	382	+ property Properties: TKRKDataModuleProperties read FKRKDataModuleProperties write FKRKDataModuleProperties;
	383	+ property SQLs: TSQLCollection read FSQLs write FSQLs;
	384	+ property MyFormClass: String read FMyFormClass write FMyFormClass;
	385	+ property OnBeforeCreateMyForm: TBeforeCreateMyForm read FOnBeforeCreateMyForm write FOnBeforeCreateMyForm;
	386	+ property OnAfterCreateMyForm: TAfterCreateMyForm read FOnAfterCreateMyForm write FOnAfterCreateMyForm;
	387	+ public
	388	+ constructor Create(aOwner: TComponent); override;
	389	+ destructor Destroy; override;
	390	+
	391	+ class procedure CreateMe( aOwner : TComponent;
	392	+ var aReference; { não tem tipo! }
	393	+ aKRKDataModuleClass: TKRKDataModuleClass); static;
	394	+ procedure DestroyMe(aDelayMS: Word = 0);
	395	+
	396	+ property DataSources: TDataSourceCollection read FDataSources;
	397	+ property DataSets: TDataSetCollection read FDataSets;
	398	+ property ClientDataSets: TClientDataSetCollection read FClientDataSets;
	399	+ property Connections: TConnectionCollection read FConnections;
	400	+ end;
	401	+
	402	+ TKRKDataModule = class(TKRKCustomDataModule)
	403	+ public
	404	+ property MyForm;
	405	+ published
	406	+ property Properties;
	407	+ property SQLs;
	408	+ property MyFormClass;
	409	+ property OnBeforeCreateMyForm;
	410	+ property OnAfterCreateMyForm;
	411	+ end;
	412	+
	413	+ TKRKSoapDataModule = class(TKRKCustomDataModule, IAppServer, IAppServerSOAP, IProviderContainer)
	414	+ private
	415	+ FProviders: TList;
	416	+ FCriticalSection: TCriticalSection;
	417	+ FRefCount: Integer;
	418	+ function GetProviderCount: integer;
	419	+ protected
	420	+ function GetProvider(const ProviderName: string): TCustomProvider; virtual;
	421	+ { Internal implementation for IAppServer and IAppServerSOAP }
	422	+ function GetProviderNames: OleVariant;
	423	+ function ApplyUpdates(const ProviderName: WideString; Delta: OleVariant; MaxErrors: Integer; out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant;
	424	+ function GetRecords(const ProviderName: WideString; Count: Integer; out RecsOut: Integer; Options: Integer; const CommandText: WideString; var Params: OleVariant; var OwnerData: OleVariant): OleVariant;
	425	+ function DataRequest(const ProviderName: WideString; Data: OleVariant): OleVariant;
	426	+ function GetParams(const ProviderName: WideString; var OwnerData: OleVariant): OleVariant;
	427	+ function RowRequest(const ProviderName: WideString; Row: OleVariant; RequestType: Integer; var OwnerData: OleVariant): OleVariant;
	428	+ procedure Execute(const ProviderName: WideString; const CommandText: WideString; var Params, OwnerData: OleVariant);
	429	+ { IAppServer }
	430	+ function AS_GetProviderNames: OleVariant; safecall;
	431	+ function AS_ApplyUpdates(const ProviderName: WideString; Delta: OleVariant; MaxErrors: Integer; out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant; safecall;
	432	+ function AS_GetRecords(const ProviderName: WideString; Count: Integer; out RecsOut: Integer; Options: Integer; const CommandText: WideString; var Params: OleVariant; var OwnerData: OleVariant): OleVariant; safecall;
	433	+ function AS_DataRequest(const ProviderName: WideString; Data: OleVariant): OleVariant; safecall;
	434	+ function AS_GetParams(const ProviderName: WideString; var OwnerData: OleVariant): OleVariant; safecall;
	435	+ function AS_RowRequest(const ProviderName: WideString; Row: OleVariant; RequestType: Integer; var OwnerData: OleVariant): OleVariant; safecall;
	436	+ procedure AS_Execute(const ProviderName: WideString; const CommandText: WideString; var Params, OwnerData: OleVariant); safecall;
	437	+ { IAppServerSOAP }
	438	+ function SAS_ApplyUpdates(const ProviderName: WideString; Delta: OleVariant; MaxErrors: Integer; out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant; virtual; stdcall;
	439	+ function SAS_GetRecords(const ProviderName: WideString; Count: Integer; out RecsOut: Integer; Options: Integer; const CommandText: WideString; var Params: OleVariant; var OwnerData: OleVariant): OleVariant; virtual; stdcall;
	440	+ function SAS_DataRequest(const ProviderName: WideString; Data: OleVariant): OleVariant; virtual; stdcall;
	441	+ function SAS_GetProviderNames: TWideStringDynArray; virtual; stdcall;
	442	+ function SAS_GetParams(const ProviderName: WideString; var OwnerData: OleVariant): OleVariant; virtual; stdcall;
	443	+ function SAS_RowRequest(const ProviderName: WideString; Row: OleVariant; RequestType: Integer; var OwnerData: OleVariant): OleVariant; virtual; stdcall;
	444	+ procedure SAS_Execute(const ProviderName: WideString; const CommandText: WideString; var Params: OleVariant; var OwnerData: OleVariant); virtual; stdcall;
	445	+ public
	446	+ constructor Create(AOwner: TComponent); override;
	447	+ destructor Destroy; override;
	448	+ procedure AfterConstruction; override;
	449	+ procedure BeforeDestruction; override;
	450	+ class function NewInstance: TObject; override;
	451	+ function _AddRef: Integer; stdcall;
	452	+ function _Release: Integer; stdcall;
	453	+ procedure Lock; virtual;
	454	+ procedure Unlock; virtual;
	455	+ { IProviderContainer }
	456	+ procedure RegisterProvider(Value: TCustomProvider);
	457	+ procedure UnRegisterProvider(Value: TCustomProvider);
	458	+ property Providers[const ProviderName: string]: TCustomProvider read GetProvider;
	459	+ property ProviderCount: integer read GetProviderCount;
	460	+ property RefCount: Integer read FRefCount;
	461	+ { Safecall Error Handling }
	462	+ function SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult; override;
	463	+ published
	464	+ property SQLs;
	465	+ end;
	466	+
150	467	{$IF RTLVersion >= 24} { Delphi XE3 }
151	468	// Esta classe resolve alguns problemas de alinhamento dos forms quando estes
152	469	// usam VCL Styles, porém por algum motivo que desconheço, isso afeta os forms

		@@ -165,8 +482,8 @@
165	482	implementation
166	483
167	484	uses
168		- {$IF RTLVersion >= 24}Themes{$IFEND} { Delphi XE3 }, KRK.Rtl.Common.Classes,
169		- KRK.Rtl.Win.CommCtrl;
	485	+ {$IF RTLVersion >= 24}Themes{$IFEND} { Delphi XE3 }, CommCtrl, SysUtils,
	486	+ MidConst, Variants, ComObj, KRK.Rtl.Win.CommCtrl;
170	487
171	488	{ TCustomKRKForm }
172	489

		@@ -245,24 +562,37 @@
245	562
246	563	procedure TCustomKRKForm.HandleNotificationMessages(var AMessage: TWMNotify);
247	564	begin
248		- case AMessage.NMHdr.code of
249		- TTN_LINKCLICK:
250		- if Assigned(FTTNLinkClick) then
251		- FTTNLinkClick(PNMLink(AMessage.NMHdr)^);
252		- TTN_GETDISPINFO:
253		- if Assigned(FTTNGetDispInfo) then
254		- FTTNGetDispInfo({$IFDEF UNICODE}PNMTTDispInfoW{$ELSE}PNMTTDispInfoA{$ENDIF}(AMessage.NMHdr));
255		- TTN_SHOW:
256		- if Assigned(FTTNShow) then
257		- FTTNShow(AMessage.NMHdr^);
258		- TTN_POP:
259		- if Assigned(FTTNPop) then
260		- FTTNPop(AMessage.NMHdr^);
261		- NM_CUSTOMDRAW: { ToolTip }
262		- if Assigned(FTTNCustomDraw) then
263		- FTTNCustomDraw(PNMTTCustomDraw(AMessage.NMHdr)^)
264		- end;
265		-
	565	+ // Caso HandleToolTipNotificationMessages retorne false, significa que não
	566	+ // houve uma manipulação da mensagem localmente. Neste caso, encaminha a mesma
	567	+ // mensagem para o pai da janela atual. Aqui, "janela", é uma terminologia do
	568	+ // Windows, mas significa, para o Delphi o pai do controle atual, que é um
	569	+ // TWinControl.
	570	+ // ATENÇÃO: O encaminhamento da mensagem WM_NOTIFY pode tornar impossível a
	571	+ // identificação correta do controle que iniciou o envio da mensagem caso não
	572	+ // se tome o devido cuidado de identificar de forma única dentro da aplicação
	573	+ // este controle. Isso acontece porque as mensagens TTN sempre são enviadas
	574	+ // apenas para a janela pai do controle, assim é possível identificar de forma
	575	+ // simples este controle, pois ele é "único" dentro daquela janela pai.
	576	+ // Atribuir um número incremental simples ao membro TOOLINFO.uId é suficiente,
	577	+ // contudo, o encaminhamento da mensagem a uma janela pai faz com que a
	578	+ // identificação do controle possa ser ambígua, pois pode existir na jenala
	579	+ // pai um controle com o mesmo TOOLINFO.uId. Para resolver este problema a
	580	+ // recomendação é usar o handle da janela pai do controle como parte de seu
	581	+ // identificador, por exemplo uId = Parent.Handle + Control.ComponentIndex,
	582	+ // dessa forma uId será único dentro de toda a aplicação e haverá sempre um
	583	+ // meio de identificar cada controle. Quando se usa o flag TTF_IDISHWND, por
	584	+ // outro lado, não é necessário fazer nada, pois os Handles de todos os
	585	+ // controles (TWinControl) são únicos dentro da aplicação, assim TOOLINFO.uId
	586	+ // vai receber apenas o handle do TWinControl associado
	587	+ if not KRK.Rtl.Common.Classes.HandleToolTipNotificationMessages(AMessage
	588	+ ,FTTNLinkClick
	589	+ ,FTTNGetDispInfo
	590	+ ,FTTNShow
	591	+ ,FTTNPop
	592	+ ,FTTNCustomDraw) then
	593	+ if Assigned(Parent) then
	594	+ SendMessage(Parent.Handle,AMessage.Msg,AMessage.IDCtrl,LPARAM(AMessage.NMHdr));
	595	+ // Executa o processamento normal da mensagem WM_NOTIFY
266	596	inherited;
267	597	end;
268	598

		@@ -550,6 +880,957 @@
550	880	FBBTNOK.Visible := vbOk in FVisibleButtons;
551	881	end;
552	882
	883	+{ TDataSourceItem }
	884	+
	885	+constructor TDataSourceItem.Create(aCollection: TCollection);
	886	+begin
	887	+ inherited;
	888	+ FCreationTime := ctUndefined;
	889	+end;
	890	+
	891	+destructor TDataSourceItem.Destroy;
	892	+begin
	893	+ if FCreationTime = ctRunTime then
	894	+ FDataSource.Free;
	895	+
	896	+ inherited;
	897	+end;
	898	+
	899	+{ TDataSourceCollection }
	900	+
	901	+function TDataSourceCollection.Add: TDataSourceItem;
	902	+begin
	903	+ Result := TDataSourceItem(inherited Add);
	904	+end;
	905	+
	906	+function TDataSourceCollection.AddDataSource(aDataSourceClass: TDataSourceClass; aName: String): TDataSourceItem;
	907	+begin
	908	+ Result := DataSourceItemByName[aName];
	909	+
	910	+ if not Assigned(Result) then
	911	+ begin
	912	+ Result := Add;
	913	+ with Result do
	914	+ begin
	915	+ FDataSource := aDataSourceClass.Create(FDataModule);
	916	+ FDataSource.Name := aName;
	917	+ FCreationTime := ctRunTime;
	918	+ end;
	919	+ end;
	920	+end;
	921	+
	922	+constructor TDataSourceCollection.Create(aDataModule: TDataModule);
	923	+begin
	924	+ inherited Create(TDataSourceItem);
	925	+ FDataModule := aDataModule;
	926	+end;
	927	+
	928	+function TDataSourceCollection.GetDataSourceItemByName(aDataSourceName: String): TDataSourceItem;
	929	+var
	930	+ DSI: Byte;
	931	+begin
	932	+ Result := nil;
	933	+
	934	+ if Count > 0 then
	935	+ for DSI := 0 to Pred(Count) do
	936	+ if UpperCase(TDataSourceItem(Items[DSI]).DataSource.Name) = UpperCase(aDataSourceName) then
	937	+ begin
	938	+ Result := TDataSourceItem(Items[DSI]);
	939	+ Break;
	940	+ end;
	941	+end;
	942	+
	943	+function TDataSourceCollection.GetItemsBrowsing: String;
	944	+var
	945	+ DSB: Byte;
	946	+begin
	947	+ Result := '';
	948	+
	949	+ if Count > 0 then
	950	+ for DSB := 0 to Pred(Count) do
	951	+ if TDataSourceItem(Items[DSB]).DataSource.DataSet.State = dsBrowse then
	952	+ begin
	953	+ if DSB > 0 then
	954	+ Result := Result + ';' + TDataSourceItem(Items[DSB]).DataSource.DataSet.Name
	955	+ else
	956	+ Result := Result + TDataSourceItem(Items[DSB]).DataSource.DataSet.Name;
	957	+ end;
	958	+end;
	959	+
	960	+function TDataSourceCollection.GetItemsInserting: String;
	961	+var
	962	+ DSI: Byte;
	963	+begin
	964	+ Result := '';
	965	+
	966	+ if Count > 0 then
	967	+ for DSI := 0 to Pred(Count) do
	968	+ if TDataSourceItem(Items[DSI]).DataSource.DataSet.State = dsInsert then
	969	+ begin
	970	+ if DSI > 0 then
	971	+ Result := Result + ';' + TDataSourceItem(Items[DSI]).DataSource.DataSet.Name
	972	+ else
	973	+ Result := Result + TDataSourceItem(Items[DSI]).DataSource.DataSet.Name;
	974	+ end;
	975	+end;
	976	+
	977	+function TDataSourceCollection.GetItemsUpdating: String;
	978	+var
	979	+ DSU: Byte;
	980	+begin
	981	+ Result := '';
	982	+
	983	+ if Count > 0 then
	984	+ for DSU := 0 to Pred(Count) do
	985	+ if TDataSourceItem(Items[DSU]).DataSource.DataSet.State = dsEdit then
	986	+ begin
	987	+ if DSU > 0 then
	988	+ Result := Result + ';' + TDataSourceItem(Items[DSU]).DataSource.DataSet.Name
	989	+ else
	990	+ Result := Result + TDataSourceItem(Items[DSU]).DataSource.DataSet.Name;
	991	+ end;
	992	+end;
	993	+
	994	+function TDataSourceCollection.GetDataSourceItem(aIndex: Word): TDataSourceItem;
	995	+begin
	996	+ Result := TDataSourceItem(inherited Items[aIndex]);
	997	+end;
	998	+
	999	+{ TDataSetItem }
	1000	+
	1001	+constructor TDataSetItem.Create(aCollection: TCollection);
	1002	+begin
	1003	+ inherited;
	1004	+ FCreationTime := ctUndefined;
	1005	+end;
	1006	+
	1007	+destructor TDataSetItem.Destroy;
	1008	+begin
	1009	+ if FCreationTime = ctRunTime then
	1010	+ FDataSet.Free;
	1011	+ inherited;
	1012	+end;
	1013	+
	1014	+{ TDataSetCollection }
	1015	+
	1016	+procedure TDataSetCollection.OpenAll;
	1017	+var
	1018	+ i: Word;
	1019	+begin
	1020	+ if Count > 0 then
	1021	+ for i := 0 to Pred(Count) do
	1022	+ TDataSetItem(Items[i]).DataSet.Open;
	1023	+end;
	1024	+
	1025	+function TDataSetCollection.Add: TDataSetItem;
	1026	+begin
	1027	+ Result := TDataSetItem(inherited Add);
	1028	+end;
	1029	+
	1030	+function TDataSetCollection.AddDataSet(aDataSetClass: TDataSetClass; aName: String): TDataSetItem;
	1031	+begin
	1032	+ Result := DataSetItemByDataSetName[aName];
	1033	+
	1034	+ if not Assigned(Result) then
	1035	+ begin
	1036	+ Result := Add;
	1037	+ with Result do
	1038	+ begin
	1039	+ FDataSet := aDataSetClass.Create(FDataModule);
	1040	+ FDataSet.Name := aName;
	1041	+ FCreationTime := ctRunTime;
	1042	+ end;
	1043	+ end;
	1044	+end;
	1045	+
	1046	+constructor TDataSetCollection.Create(aDataModule: TDataModule);
	1047	+begin
	1048	+ inherited Create(TDataSetItem);
	1049	+ FDataModule := aDataModule;
	1050	+end;
	1051	+
	1052	+procedure TDataSetCollection.CancelAll;
	1053	+var
	1054	+ i: Word;
	1055	+begin
	1056	+ if Count > 0 then
	1057	+ for i := 0 to Pred(Count) do
	1058	+ TDataSetItem(Items[i]).DataSet.Cancel;
	1059	+end;
	1060	+
	1061	+procedure TDataSetCollection.CloseAll;
	1062	+var
	1063	+ i: Word;
	1064	+begin
	1065	+ if Count > 0 then
	1066	+ for i := 0 to Pred(Count) do
	1067	+ TDataSetItem(Items[i]).DataSet.Close;
	1068	+end;
	1069	+
	1070	+function TDataSetCollection.GetDataSetItem(aIndex: Word): TDataSetItem;
	1071	+begin
	1072	+ Result := TDataSetItem(inherited Items[aIndex]);
	1073	+end;
	1074	+
	1075	+function TDataSetCollection.GetDataSetItemByDataSetName(aDataSetName: String): TDataSetItem;
	1076	+var
	1077	+ DSI: Byte;
	1078	+begin
	1079	+ Result := nil;
	1080	+
	1081	+ if Count > 0 then
	1082	+ for DSI := 0 to Pred(Count) do
	1083	+ if UpperCase(TDataSetItem(Items[DSI]).DataSet.Name) = UpperCase(aDataSetName) then
	1084	+ begin
	1085	+ Result := TDataSetItem(Items[DSI]);
	1086	+ Break;
	1087	+ end;
	1088	+end;
	1089	+
	1090	+function TDataSetCollection.GetItemsBrowsing: String;
	1091	+var
	1092	+ DSB: Byte;
	1093	+begin
	1094	+ Result := '';
	1095	+
	1096	+ if Count > 0 then
	1097	+ for DSB := 0 to Pred(Count) do
	1098	+ if TDataSetItem(Items[DSB]).DataSet.State = dsBrowse then
	1099	+ begin
	1100	+ if DSB > 0 then
	1101	+ Result := Result + ';' + TDataSetItem(Items[DSB]).DataSet.Name
	1102	+ else
	1103	+ Result := Result + TDataSetItem(Items[DSB]).DataSet.Name;
	1104	+ end;
	1105	+end;
	1106	+
	1107	+function TDataSetCollection.GetItemsInserting: String;
	1108	+var
	1109	+ DSI: Byte;
	1110	+begin
	1111	+ Result := '';
	1112	+
	1113	+ if Count > 0 then
	1114	+ for DSI := 0 to Pred(Count) do
	1115	+ if TDataSetItem(Items[DSI]).DataSet.State = dsInsert then
	1116	+ begin
	1117	+ if DSI > 0 then
	1118	+ Result := Result + ';' + TDataSetItem(Items[DSI]).DataSet.Name
	1119	+ else
	1120	+ Result := Result + TDataSetItem(Items[DSI]).DataSet.Name;
	1121	+ end;
	1122	+end;
	1123	+
	1124	+function TDataSetCollection.GetItemsUpdating: String;
	1125	+var
	1126	+ DSU: Byte;
	1127	+begin
	1128	+ Result := '';
	1129	+
	1130	+ if Count > 0 then
	1131	+ for DSU := 0 to Pred(Count) do
	1132	+ if TDataSetItem(Items[DSU]).DataSet.State = dsEdit then
	1133	+ begin
	1134	+ if DSU > 0 then
	1135	+ Result := Result + ';' + TDataSetItem(Items[DSU]).DataSet.Name
	1136	+ else
	1137	+ Result := Result + TDataSetItem(Items[DSU]).DataSet.Name;
	1138	+ end;
	1139	+end;
	1140	+
	1141	+{ TClientDataSetItem }
	1142	+
	1143	+constructor TClientDataSetItem.Create(aCollection: TCollection);
	1144	+begin
	1145	+ inherited;
	1146	+ FCreationTime := ctUndefined;
	1147	+end;
	1148	+
	1149	+destructor TClientDataSetItem.Destroy;
	1150	+begin
	1151	+ if FCreationTime = ctRunTime then
	1152	+ FClientDataSet.Free;
	1153	+
	1154	+ inherited;
	1155	+end;
	1156	+
	1157	+{ TClientDataSetCollection }
	1158	+
	1159	+function TClientDataSetCollection.Add: TClientDataSetItem;
	1160	+begin
	1161	+ Result := TClientDataSetItem(inherited Add);
	1162	+end;
	1163	+
	1164	+function TClientDataSetCollection.AddClientDataSet(aClientDataSetClass: TClientDataSetClass; aName: String): TClientDataSetItem;
	1165	+begin
	1166	+ Result := ClientDataSetItemByClientDataSetName[aName];
	1167	+
	1168	+ if not Assigned(Result) then
	1169	+ begin
	1170	+ Result := Add;
	1171	+ with Result do
	1172	+ begin
	1173	+ FClientDataSet := aClientDataSetClass.Create(FDataModule);
	1174	+ FClientDataSet.Name := aName;
	1175	+ FCreationTime := ctRunTime;
	1176	+ end;
	1177	+ end;
	1178	+end;
	1179	+
	1180	+procedure TClientDataSetCollection.CancelAll;
	1181	+var
	1182	+ i: Word;
	1183	+begin
	1184	+ if Count > 0 then
	1185	+ for i := 0 to Pred(Count) do
	1186	+ TClientDataSetItem(Items[i]).ClientDataSet.Cancel;
	1187	+end;
	1188	+
	1189	+constructor TClientDataSetCollection.Create(aDataModule: TDataModule);
	1190	+begin
	1191	+ inherited Create(TClientDataSetItem);
	1192	+ FDataModule := aDataModule;
	1193	+end;
	1194	+
	1195	+function TClientDataSetCollection.GetClientDataSetItem(aIndex: Word): TClientDataSetItem;
	1196	+begin
	1197	+ Result := TClientDataSetItem(inherited Items[aIndex]);
	1198	+end;
	1199	+
	1200	+function TClientDataSetCollection.GetClientDataSetItemByClientDataSetName(aClientDataSetName: String): TClientDataSetItem;
	1201	+var
	1202	+ CDI: Byte;
	1203	+begin
	1204	+ Result := nil;
	1205	+
	1206	+ if Count > 0 then
	1207	+ for CDI := 0 to Pred(Count) do
	1208	+ if UpperCase(TClientDataSetItem(Items[CDI]).ClientDataSet.Name) = UpperCase(aClientDataSetName) then
	1209	+ begin
	1210	+ Result := TClientDataSetItem(Items[CDI]);
	1211	+ Break;
	1212	+ end;
	1213	+end;
	1214	+
	1215	+function TClientDataSetCollection.GetItemsBrowsing: String;
	1216	+var
	1217	+ DSB: Byte;
	1218	+begin
	1219	+ Result := '';
	1220	+
	1221	+ if Count > 0 then
	1222	+ for DSB := 0 to Pred(Count) do
	1223	+ if TClientDataSetItem(Items[DSB]).ClientDataSet.State = dsBrowse then
	1224	+ begin
	1225	+ if DSB > 0 then
	1226	+ Result := Result + ';' + TClientDataSetItem(Items[DSB]).ClientDataSet.Name
	1227	+ else
	1228	+ Result := Result + TClientDataSetItem(Items[DSB]).ClientDataSet.Name;
	1229	+ end;
	1230	+end;
	1231	+
	1232	+function TClientDataSetCollection.GetItemsInserting: String;
	1233	+var
	1234	+ DSI: Byte;
	1235	+begin
	1236	+ Result := '';
	1237	+
	1238	+ if Count > 0 then
	1239	+ for DSI := 0 to Pred(Count) do
	1240	+ if TClientDataSetItem(Items[DSI]).ClientDataSet.State = dsInsert then
	1241	+ begin
	1242	+ if DSI > 0 then
	1243	+ Result := Result + ';' + TClientDataSetItem(Items[DSI]).ClientDataSet.Name
	1244	+ else
	1245	+ Result := Result + TClientDataSetItem(Items[DSI]).ClientDataSet.Name;
	1246	+ end;
	1247	+end;
	1248	+
	1249	+function TClientDataSetCollection.GetItemsUpdating: String;
	1250	+var
	1251	+ DSU: Byte;
	1252	+begin
	1253	+ Result := '';
	1254	+
	1255	+ if Count > 0 then
	1256	+ for DSU := 0 to Pred(Count) do
	1257	+ if TClientDataSetItem(Items[DSU]).ClientDataSet.State = dsEdit then
	1258	+ begin
	1259	+ if DSU > 0 then
	1260	+ Result := Result + ';' + TClientDataSetItem(Items[DSU]).ClientDataSet.Name
	1261	+ else
	1262	+ Result := Result + TClientDataSetItem(Items[DSU]).ClientDataSet.Name;
	1263	+ end;
	1264	+end;
	1265	+
	1266	+function TClientDataSetCollection.GetUpdatesPending: Boolean;
	1267	+var
	1268	+ CUP: Byte;
	1269	+begin
	1270	+ Result := False;
	1271	+
	1272	+ if Count > 0 then
	1273	+ for CUP := 0 to Pred(Count) do
	1274	+ if TClientDataSetItem(Items[CUP]).ClientDataSet.Active and (TClientDataSetItem(Items[CUP]).ClientDataSet.ChangeCount > 0) then
	1275	+ begin
	1276	+ Result := True;
	1277	+ Break;
	1278	+ end;
	1279	+end;
	1280	+
	1281	+{ TConnectionItem }
	1282	+
	1283	+constructor TConnectionItem.Create(aCollection: TCollection);
	1284	+begin
	1285	+ inherited;
	1286	+ FCreationTime := ctUndefined;
	1287	+end;
	1288	+
	1289	+destructor TConnectionItem.Destroy;
	1290	+begin
	1291	+ if FCreationTime = ctRunTime then
	1292	+ FConnection.Free;
	1293	+
	1294	+ inherited;
	1295	+end;
	1296	+
	1297	+{ TConnectionCollection }
	1298	+
	1299	+function TConnectionCollection.Add: TConnectionItem;
	1300	+begin
	1301	+ Result := TConnectionItem(inherited Add);
	1302	+end;
	1303	+
	1304	+function TConnectionCollection.AddConnection(AConnectionClass: TConnectionClass; aName: String): TConnectionItem;
	1305	+begin
	1306	+ Result := ConnectionItemByConnectionName[aName];
	1307	+
	1308	+ if not Assigned(Result) then
	1309	+ begin
	1310	+ Result := Add;
	1311	+ with Result do
	1312	+ begin
	1313	+ FConnection := AConnectionClass.Create(FDataModule);
	1314	+ FConnection.Name := aName;
	1315	+ FCreationTime := ctRunTime;
	1316	+ end;
	1317	+ end;
	1318	+end;
	1319	+
	1320	+constructor TConnectionCollection.Create(aDataModule: TDataModule);
	1321	+begin
	1322	+ inherited Create(TConnectionItem);
	1323	+ FDataModule := aDataModule;
	1324	+end;
	1325	+
	1326	+function TConnectionCollection.GetConnectionItem(aIndex: Word): TConnectionItem;
	1327	+begin
	1328	+ Result := TConnectionItem(inherited Items[aIndex]);
	1329	+end;
	1330	+
	1331	+function TConnectionCollection.GetConnectionItemByConnectionName(AConnectionName: String): TConnectionItem;
	1332	+var
	1333	+ ZCI: Byte;
	1334	+begin
	1335	+ Result := nil;
	1336	+
	1337	+ if Count > 0 then
	1338	+ for ZCI := 0 to Pred(Count) do
	1339	+ if UpperCase(TConnectionItem(Items[ZCI]).Connection.Name) = UpperCase(AConnectionName) then
	1340	+ begin
	1341	+ Result := TConnectionItem(Items[ZCI]);
	1342	+ Break;
	1343	+ end;
	1344	+end;
	1345	+
	1346	+{ TSQLItem }
	1347	+
	1348	+constructor TSQLItem.Create(aCollection: TCollection);
	1349	+begin
	1350	+ inherited;
	1351	+ FSQL := TStringList.Create;
	1352	+end;
	1353	+
	1354	+destructor TSQLItem.Destroy;
	1355	+begin
	1356	+ FSQL.Free;
	1357	+ inherited;
	1358	+end;
	1359	+
	1360	+function TSQLItem.GetDisplayName: string;
	1361	+begin
	1362	+ Result := FName;
	1363	+end;
	1364	+
	1365	+procedure TSQLItem.SetDescription(const Value: String);
	1366	+var
	1367	+ SI: Byte;
	1368	+begin
	1369	+ if Collection.Count > 0 then
	1370	+ for SI := 0 to Pred(Collection.Count) do
	1371	+ if UpperCase(TSQLItem(Collection.Items[SI]).Description) = UpperCase(Value) then
	1372	+ raise Exception.Create('A descrição escolhida já consta na lista de SQLs. Por favor escolha outra descrição');
	1373	+
	1374	+ FDescription := UpperCase(Value);
	1375	+end;
	1376	+
	1377	+procedure TSQLItem.SetName(const Value: String);
	1378	+var
	1379	+ SI: Byte;
	1380	+begin
	1381	+ if Collection.Count > 0 then
	1382	+ for SI := 0 to Pred(Collection.Count) do
	1383	+ if UpperCase(TSQLItem(Collection.Items[SI]).Name) = UpperCase(Value) then
	1384	+ raise Exception.Create('O nome escolhido já consta na lista de SQLs. Por favor escolha outro nome');
	1385	+
	1386	+
	1387	+ if not IsValidIdent(Value,True) then
	1388	+ raise Exception.Create('O nome deve seguir a mesma convenção de nomes das units');
	1389	+
	1390	+ FName := UpperCase(Value);
	1391	+end;
	1392	+
	1393	+procedure TSQLItem.SetSQL(const Value: TStrings);
	1394	+begin
	1395	+ FSQL.Assign(Value);
	1396	+end;
	1397	+
	1398	+{ TSQLCollection }
	1399	+
	1400	+function TSQLCollection.Add: TSQLItem;
	1401	+begin
	1402	+ Result := TSQLItem(inherited Add);
	1403	+end;
	1404	+
	1405	+constructor TSQLCollection.Create(aDataModule: TDataModule);
	1406	+begin
	1407	+ inherited Create(TSQLItem);
	1408	+ FDataModule := aDataModule;
	1409	+end;
	1410	+
	1411	+function TSQLCollection.GetSQLItem(aIndex: Word): TSQLItem;
	1412	+begin
	1413	+ Result := TSQLItem(inherited Items[aIndex]);
	1414	+end;
	1415	+
	1416	+function TSQLCollection.GetSQLItemByID(aID: String): TSQLItem;
	1417	+var
	1418	+ SI: Byte;
	1419	+begin
	1420	+ Result := nil;
	1421	+
	1422	+ if Count > 0 then
	1423	+ for SI := 0 to Pred(Count) do
	1424	+ if UpperCase(TSQLItem(Items[SI]).Name) = UpperCase(aID) then
	1425	+ begin
	1426	+ Result := TSQLItem(Items[SI]);
	1427	+ Break;
	1428	+ end;
	1429	+end;
	1430	+
	1431	+{ TKRKCustomDataModule }
	1432	+
	1433	+constructor TKRKCustomDataModule.Create(aOwner: TComponent);
	1434	+var
	1435	+ i: Word;
	1436	+begin
	1437	+ FKRKDataModuleProperties := TKRKDataModuleProperties.Create;
	1438	+
	1439	+ FDataSources := TDataSourceCollection.Create(Self);
	1440	+ FDataSets := TDataSetCollection.Create(Self);
	1441	+ FClientDataSets := TClientDataSetCollection.Create(Self);
	1442	+ FConnections := TConnectionCollection.Create(Self);
	1443	+ FSQLs := TSQLCollection.Create(Self);
	1444	+ FMyForm := nil;
	1445	+
	1446	+ inherited;
	1447	+
	1448	+ if ComponentCount > 0 then
	1449	+ for i := 0 to Pred(ComponentCount) do
	1450	+ if Components[i] is TDataSource then
	1451	+ with FDataSources.Add do
	1452	+ begin
	1453	+ FDataSource := TDataSource(Components[i]);
	1454	+ FCreationTime := ctDesignTime;
	1455	+ FPtr := FDataSource;
	1456	+ end
	1457	+ else if Components[i] is TDataSet then
	1458	+ begin
	1459	+ { Classe pai geral }
	1460	+ with FDataSets.Add do
	1461	+ begin
	1462	+ FDataSet := TDataSet(Components[i]);
	1463	+ FCreationTime := ctDesignTime;
	1464	+ FPtr := @FDataSet;
	1465	+ end;
	1466	+
	1467	+ { Classes filhas especializadas }
	1468	+ if Components[i] is TClientDataSet then
	1469	+ with FClientDataSets.Add do
	1470	+ begin
	1471	+ FClientDataSet := TClientDataSet(Components[i]);
	1472	+ FCreationTime := ctDesignTime;
	1473	+ FPtr := @FClientDataSet;
	1474	+ end;
	1475	+ end
	1476	+ else if Components[i] is TCustomConnection then
	1477	+ with FConnections.Add do
	1478	+ begin
	1479	+ FConnection := TCustomConnection(Components[i]);
	1480	+ FCreationTime := ctDesignTime;
	1481	+ FPtr := @FConnection;
	1482	+ end;
	1483	+
	1484	+ if FKRKDataModuleProperties.OpenAllDataSets then
	1485	+ FDataSets.OpenAll;
	1486	+
	1487	+ if FMyFormClass <> '' then
	1488	+ begin
	1489	+ if not Assigned(GetClass(FMyFormClass)) then
	1490	+ raise Exception.Create('A classe ' + FMyFormClass + ' não foi registrada');
	1491	+
	1492	+ if not GetClass(FMyFormClass).InheritsFrom(TKRKForm) then
	1493	+ raise Exception.Create(FMyFormClass + ' não é uma classe descendente de ' + TKRKForm.ClassName);
	1494	+
	1495	+ if Assigned(FOnBeforeCreateMyForm) then
	1496	+ FOnBeforeCreateMyForm(FMyFormClass);
	1497	+
	1498	+ FMyForm := TKRKFormClass(GetClass(FMyFormClass)).Create(Self);
	1499	+
	1500	+ if Assigned(FOnAfterCreateMyForm) then
	1501	+ FOnAfterCreateMyForm(FMyForm);
	1502	+ end;
	1503	+end;
	1504	+
	1505	+destructor TKRKCustomDataModule.Destroy;
	1506	+begin
	1507	+ { Só é preciso destruir as coisas se realmente uma instância deste DM foi
	1508	+ criada e isso só não é feito caso exceções sejam lançadas dentro do construtor }
	1509	+ if Assigned(FMyReference) then
	1510	+ begin
	1511	+ FMyReference^ := nil;
	1512	+
	1513	+ FSQLs.Free;
	1514	+ FConnections.Free;
	1515	+ FClientDataSets.Free;
	1516	+ FDataSets.Free;
	1517	+ FDataSources.Free;
	1518	+
	1519	+ FKRKDataModuleProperties.Free;
	1520	+ end;
	1521	+
	1522	+ inherited;
	1523	+end;
	1524	+
	1525	+class procedure TKRKCustomDataModule.CreateMe( aOwner : TComponent;
	1526	+ var aReference; { não tem tipo! }
	1527	+ aKRKDataModuleClass: TKRKDataModuleClass);
	1528	+begin
	1529	+ if Assigned(TKRKCustomDataModule(aReference)) then
	1530	+ raise Exception.Create('O parâmetro aReference contém uma variável não vazia');
	1531	+
	1532	+ TKRKCustomDataModule(aReference) := aKRKDataModuleClass.Create(aOwner);
	1533	+ TKRKCustomDataModule(aReference).FMyReference := @aReference;
	1534	+end;
	1535	+
	1536	+procedure TKRKCustomDataModule.DestroyMe(aDelayMS: Word = 0);
	1537	+begin
	1538	+ if aDelayMS > 0 then
	1539	+ begin
	1540	+ FTimer := TTimer.Create(Self);
	1541	+ FTimer.Enabled := False;
	1542	+ FTimer.Interval := aDelayMS;
	1543	+ FTimer.OnTimer := DoTimer;
	1544	+ FTimer.Enabled := True;
	1545	+ end
	1546	+ else
	1547	+ FMyReference.Free;
	1548	+end;
	1549	+
	1550	+procedure TKRKCustomDataModule.DoTimer(aSender: TObject);
	1551	+begin
	1552	+ FTimer.Enabled := False;
	1553	+ DestroyMe;
	1554	+end;
	1555	+
	1556	+{ TKRKSoapDataModule }
	1557	+
	1558	+constructor TKRKSoapDataModule.Create(AOwner: TComponent);
	1559	+begin
	1560	+ FCriticalSection := TCriticalSection.Create;
	1561	+ FProviders := TList.Create;
	1562	+ inherited Create(AOwner);
	1563	+end;
	1564	+
	1565	+destructor TKRKSoapDataModule.Destroy;
	1566	+begin
	1567	+ inherited Destroy;
	1568	+ FProviders.Free;
	1569	+ FreeAndNil(FCriticalSection);
	1570	+end;
	1571	+
	1572	+procedure TKRKSoapDataModule.Lock;
	1573	+begin
	1574	+ FCriticalSection.Enter;
	1575	+end;
	1576	+
	1577	+procedure TKRKSoapDataModule.Unlock;
	1578	+begin
	1579	+ FCriticalSection.Leave;
	1580	+end;
	1581	+
	1582	+procedure TKRKSoapDataModule.RegisterProvider(Value: TCustomProvider);
	1583	+begin
	1584	+ FProviders.Add(Value);
	1585	+end;
	1586	+
	1587	+procedure TKRKSoapDataModule.UnRegisterProvider(Value: TCustomProvider);
	1588	+begin
	1589	+ FProviders.Remove(Value);
	1590	+end;
	1591	+
	1592	+function TKRKSoapDataModule.GetProvider(const ProviderName: string): TCustomProvider;
	1593	+var
	1594	+ i: Integer;
	1595	+begin
	1596	+ Result := nil;
	1597	+ for i := 0 to FProviders.Count - 1 do
	1598	+ if AnsiCompareStr(TCustomProvider(FProviders[i]).Name, ProviderName) = 0 then
	1599	+ begin
	1600	+ Result := TCustomProvider(FProviders[i]);
	1601	+ if not Result.Exported then
	1602	+ Result := nil;
	1603	+ Break;
	1604	+ end;
	1605	+ if not Assigned(Result) then
	1606	+ raise Exception.CreateResFmt(@SProviderNotExported, [ProviderName]);
	1607	+end;
	1608	+
	1609	+{ Internal Implementation }
	1610	+
	1611	+function TKRKSoapDataModule.GetProviderNames: OleVariant;
	1612	+var
	1613	+ List: TStringList;
	1614	+ i: Integer;
	1615	+begin
	1616	+ Lock;
	1617	+ try
	1618	+ List := TStringList.Create;
	1619	+ try
	1620	+ for i := 0 to FProviders.Count - 1 do
	1621	+ if TCustomProvider(FProviders[i]).Exported then
	1622	+ List.Add(TCustomProvider(FProviders[i]).Name);
	1623	+ List.Sort;
	1624	+ Result := VarArrayFromStrings(List);
	1625	+ finally
	1626	+ List.Free;
	1627	+ end;
	1628	+ finally
	1629	+ Unlock;
	1630	+ end;
	1631	+end;
	1632	+
	1633	+function TKRKSoapDataModule.ApplyUpdates(const ProviderName: WideString; Delta: OleVariant; MaxErrors: Integer; out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant;
	1634	+begin
	1635	+ Lock;
	1636	+ try
	1637	+ Result := Providers[ProviderName].ApplyUpdates(Delta, MaxErrors, ErrorCount, OwnerData);
	1638	+ finally
	1639	+ Unlock;
	1640	+ end;
	1641	+end;
	1642	+
	1643	+function TKRKSoapDataModule.GetRecords(const ProviderName: WideString; Count: Integer; out RecsOut: Integer; Options: Integer; const CommandText: WideString; var Params: OleVariant; var OwnerData: OleVariant): OleVariant;
	1644	+begin
	1645	+ Lock;
	1646	+ try
	1647	+ Result := Providers[ProviderName].GetRecords(Count, RecsOut, Options, CommandText, Params, OwnerData);
	1648	+ finally
	1649	+ Unlock;
	1650	+ end;
	1651	+end;
	1652	+
	1653	+function TKRKSoapDataModule.RowRequest(const ProviderName: WideString; Row: OleVariant; RequestType: Integer; var OwnerData: OleVariant): OleVariant;
	1654	+begin
	1655	+ Lock;
	1656	+ try
	1657	+ Result := Providers[ProviderName].RowRequest(Row, RequestType, OwnerData);
	1658	+ finally
	1659	+ Unlock;
	1660	+ end;
	1661	+end;
	1662	+
	1663	+function TKRKSoapDataModule.DataRequest(const ProviderName: WideString; Data: OleVariant): OleVariant;
	1664	+begin
	1665	+ Lock;
	1666	+ try
	1667	+ Result := Providers[ProviderName].DataRequest(Data);
	1668	+ finally
	1669	+ Unlock;
	1670	+ end;
	1671	+end;
	1672	+
	1673	+function TKRKSoapDataModule.GetParams(const ProviderName: WideString; var OwnerData: OleVariant): OleVariant;
	1674	+begin
	1675	+ Lock;
	1676	+ try
	1677	+ Result := Providers[ProviderName].GetParams(OwnerData);
	1678	+ finally
	1679	+ Unlock;
	1680	+ end;
	1681	+end;
	1682	+
	1683	+procedure TKRKSoapDataModule.Execute(const ProviderName: WideString; const CommandText: WideString; var Params, OwnerData: OleVariant);
	1684	+begin
	1685	+ Lock;
	1686	+ try
	1687	+ Providers[ProviderName].Execute(CommandText, Params, OwnerData);
	1688	+ finally
	1689	+ Unlock;
	1690	+ end;
	1691	+end;
	1692	+
	1693	+{ IAppServer Implementation }
	1694	+
	1695	+function TKRKSoapDataModule.AS_GetProviderNames: OleVariant;
	1696	+begin
	1697	+ Result := GetProviderNames;
	1698	+end;
	1699	+
	1700	+function TKRKSoapDataModule.AS_ApplyUpdates(const ProviderName: WideString; Delta: OleVariant; MaxErrors: Integer; out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant;
	1701	+begin
	1702	+ Result := ApplyUpdates(ProviderName, Delta, MaxErrors, ErrorCount, OwnerData);
	1703	+end;
	1704	+
	1705	+function TKRKSoapDataModule.AS_GetRecords(const ProviderName: WideString; Count: Integer; out RecsOut: Integer; Options: Integer; const CommandText: WideString; var Params: OleVariant; var OwnerData: OleVariant): OleVariant; safecall;
	1706	+begin
	1707	+ Result := GetRecords(ProviderName, Count, RecsOut, Options, CommandText, Params, OwnerData);
	1708	+end;
	1709	+
	1710	+function TKRKSoapDataModule.AS_RowRequest(const ProviderName: WideString; Row: OleVariant; RequestType: Integer; var OwnerData: OleVariant): OleVariant;
	1711	+begin
	1712	+ Result := RowRequest(ProviderName, Row, RequestType, OwnerData);
	1713	+end;
	1714	+
	1715	+function TKRKSoapDataModule.AS_DataRequest(const ProviderName: WideString; Data: OleVariant): OleVariant; safecall;
	1716	+begin
	1717	+ Result := DataRequest(ProviderName, Data);
	1718	+end;
	1719	+
	1720	+function TKRKSoapDataModule.AS_GetParams(const ProviderName: WideString; var OwnerData: OleVariant): OleVariant;
	1721	+begin
	1722	+ Result := GetParams(ProviderName, OwnerData);
	1723	+end;
	1724	+
	1725	+procedure TKRKSoapDataModule.AS_Execute(const ProviderName: WideString; const CommandText: WideString; var Params, OwnerData: OleVariant);
	1726	+begin
	1727	+ Execute(ProviderName, CommandText, Params, OwnerData);
	1728	+end;
	1729	+
	1730	+function TKRKSoapDataModule.GetProviderCount: integer;
	1731	+begin
	1732	+ Result := FProviders.Count;
	1733	+end;
	1734	+
	1735	+{ IAppServerSoap Implementation }
	1736	+
	1737	+function TKRKSoapDataModule.SAS_ApplyUpdates(const ProviderName: WideString; Delta: OleVariant; MaxErrors: Integer; out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant; stdcall;
	1738	+begin
	1739	+ Result := ApplyUpdates(ProviderName, Delta, MaxErrors, ErrorCount, OwnerData);
	1740	+end;
	1741	+
	1742	+function TKRKSoapDataModule.SAS_GetRecords(const ProviderName: WideString; Count: Integer; out RecsOut: Integer; Options: Integer; const CommandText: WideString; var Params: OleVariant; var OwnerData: OleVariant): OleVariant; stdcall;
	1743	+begin
	1744	+ Result := GetRecords(ProviderName, Count, RecsOut, Options, CommandText, Params, OwnerData);
	1745	+end;
	1746	+
	1747	+function TKRKSoapDataModule.SAS_DataRequest(const ProviderName: WideString; Data: OleVariant): OleVariant; stdcall;
	1748	+begin
	1749	+ Result := DataRequest(ProviderName, Data);
	1750	+end;
	1751	+
	1752	+function TKRKSoapDataModule.SAS_GetProviderNames: TWideStringDynArray; stdcall;
	1753	+var
	1754	+ V: OleVariant;
	1755	+ I, Len: Integer;
	1756	+begin
	1757	+ V := GetProviderNames;
	1758	+ if not VarIsNull(V) and VarIsArray(V) then
	1759	+ begin
	1760	+ for I := 0 to VarArrayHighBound(V, 1) do
	1761	+ begin
	1762	+ Len := Length(Result);
	1763	+ SetLength(Result, Len+1);
	1764	+ Result[Len] := V[I];
	1765	+ end;
	1766	+ end;
	1767	+end;
	1768	+
	1769	+function TKRKSoapDataModule.SAS_GetParams(const ProviderName: WideString; var OwnerData: OleVariant): OleVariant; stdcall;
	1770	+begin
	1771	+ Result := GetParams(ProviderName, OwnerData);
	1772	+end;
	1773	+
	1774	+function TKRKSoapDataModule.SAS_RowRequest(const ProviderName: WideString; Row: OleVariant; RequestType: Integer; var OwnerData: OleVariant): OleVariant; stdcall;
	1775	+begin
	1776	+ Result := RowRequest(ProviderName, Row, RequestType, OwnerData);
	1777	+end;
	1778	+
	1779	+procedure TKRKSoapDataModule.SAS_Execute(const ProviderName: WideString; const CommandText: WideString; var Params: OleVariant; var OwnerData: OleVariant); stdcall;
	1780	+begin
	1781	+ Execute(ProviderName, CommandText, Params, OwnerData);
	1782	+end;
	1783	+
	1784	+procedure TKRKSoapDataModule.AfterConstruction;
	1785	+begin
	1786	+ inherited;
	1787	+ {$IF RTLVersion > 18}
	1788	+ TInterlocked.Decrement(FRefCount);
	1789	+ {$ELSE}
	1790	+ InterlockedDecrement(FRefCount);
	1791	+ {$IFEND}
	1792	+end;
	1793	+
	1794	+procedure TKRKSoapDataModule.BeforeDestruction;
	1795	+begin
	1796	+ inherited;
	1797	+end;
	1798	+
	1799	+function TKRKSoapDataModule._AddRef: Integer;
	1800	+begin
	1801	+ {$IF RTLVersion > 18}
	1802	+ Result := TInterlocked.Increment(FRefCount);
	1803	+ {$ELSE}
	1804	+ Result := InterlockedIncrement(FRefCount);
	1805	+ {$IFEND}
	1806	+end;
	1807	+
	1808	+function TKRKSoapDataModule._Release: Integer;
	1809	+begin
	1810	+ {$IF RTLVersion > 18}
	1811	+ Result := TInterlocked.Decrement(FRefCount);
	1812	+ {$ELSE}
	1813	+ Result := InterlockedDecrement(FRefCount);
	1814	+ {$IFEND}
	1815	+ { If we are not being used as a TComponent, then use refcount to manage our
	1816	+ lifetime as with TInterfacedObject. }
	1817	+ if (Result = 0) and (not Assigned(Owner)) then
	1818	+ Destroy;
	1819	+end;
	1820	+
	1821	+{ Set an implicit refcount so that refcounting
	1822	+ during construction won't destroy the object. }
	1823	+class function TKRKSoapDataModule.NewInstance: TObject;
	1824	+begin
	1825	+ Result := inherited NewInstance;
	1826	+ TKRKSoapDataModule(Result).FRefCount := 1;
	1827	+end;
	1828	+
	1829	+function TKRKSoapDataModule.SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult;
	1830	+begin
	1831	+ Result := HandleSafeCallException(ExceptObject, ExceptAddr, IAppServer, '', '');
	1832	+end;
	1833	+
553	1834	{$IF RTLVersion >= 24} { Delphi XE3 }
554	1835	{ TFixedFormStyleHook }
555	1836	procedure TFixedFormStyleHook.WndProc(var AMessage: TMessage);

--- trunk/rtp/src/Vcl/KRK.Vcl.StdCtrls.pas (revision 574)

+++ trunk/rtp/src/Vcl/KRK.Vcl.StdCtrls.pas (revision 575)

		@@ -2,15 +2,9 @@
2	2	{$IF CompilerVersion >= 25}{$LEGACYIFEND ON}{$IFEND} { Delphi XE4 }
3	3	interface
4	4
5		-uses StdCtrls
6		- , Windows
7		- , Controls
8		- , Graphics
9		- , Classes
10		- // TPanel está, no meu entendimento, erradamente colocado em ExtCtrls. Por
11		- // isso, no KRK eu o coloco onde eu acho que ele deve estar, StdCtrls
12		- , ExtCtrls
13		- , GraphUtil;
	5	+uses
	6	+ StdCtrls, Windows, Controls, Graphics, Classes, ExtCtrls, GraphUtil, Messages,
	7	+ KRK.Rtl.Common.Classes;
14	8
15	9	type
16	10	TCustomKRKGroupBox = class(TCustomGroupBox)

		@@ -70,6 +64,9 @@
70	64
71	65	TEdge = (eUnknown,eTopLeft,eTopRight,eBottomLeft,eBottomRight);
72	66
	67	+ // TPanel está, no meu entendimento, erradamente colocado em ExtCtrls. Por
	68	+ // isso, no KRK eu o coloco onde eu acho que ele deve estar, StdCtrls
	69	+
73	70	TCustomKRKPanel = class(TPanel)
74	71	private
75	72	FGradientFill: Boolean;

		@@ -76,8 +73,15 @@
76	73	FGradientColorA: TColor;
77	74	FGradientColorB: TColor;
78	75	FGradientDirection: TGradientDirection;
	76	+ FTTNLinkClick: TTTNLinkClick;
	77	+ FTTNGetDispInfo: TTTNGetDispInfo;
	78	+ FTTNCustomDraw: TTTNCustomDraw;
	79	+ FTTNPop: TTTNPop;
	80	+ FTTNShow: TTTNShow;
	81	+
	82	+ function GetParentBackground: Boolean;
	83	+
79	84	procedure SetGradientFill(const Value: Boolean);
80		- function GetParentBackground: Boolean;
81	85	procedure SetGradientColorA(const Value: TColor);
82	86	procedure SetGradientColorB(const Value: TColor);
83	87	procedure SetGradientDirection(const Value: TGradientDirection);

		@@ -84,13 +88,21 @@
84	88	protected
85	89	procedure SetParentBackground(Value: Boolean); override;
86	90	procedure Paint; override;
	91	+ //: Manipula as mensagens de notificação que forem enviadas e este Panel
	92	+ procedure HandleNotificationMessages(var AMessage: TWMNotify); message WM_NOTIFY;
87	93	public
88	94	constructor Create(aOwner: TComponent); override;
	95	+
89	96	property ParentBackground: Boolean read GetParentBackground write SetParentBackground default True;
90	97	property GradientFill: Boolean read FGradientFill write SetGradientFill default False;
91	98	property GradientColorA: TColor read FGradientColorA write SetGradientColorA default clGradientInactiveCaption;
92	99	property GradientColorB: TColor read FGradientColorB write SetGradientColorB default clActiveCaption;
93	100	property GradientDirection: TGradientDirection read FGradientDirection write SetGradientDirection default gdVertical;
	101	+ property OnTTNLinkClick: TTTNLinkClick read FTTNLinkClick write FTTNLinkClick;
	102	+ property OnTTNGetDispInfo: TTTNGetDispInfo read FTTNGetDispInfo write FTTNGetDispInfo;
	103	+ property OnTTNShow: TTTNShow read FTTNShow write FTTNShow;
	104	+ property OnTTNPop: TTTNPop read FTTNPop write FTTNPop;
	105	+ property OnTTNCustomDraw: TTTNCustomDraw read FTTNCustomDraw write FTTNCustomDraw;
94	106	end;
95	107
96	108	TKRKPanel = class(TCustomKRKPanel)

		@@ -100,6 +112,11 @@
100	112	property GradientColorA;
101	113	property GradientColorB;
102	114	property GradientDirection;
	115	+ property OnTTNLinkClick;
	116	+ property OnTTNGetDispInfo;
	117	+ property OnTTNShow;
	118	+ property OnTTNPop;
	119	+ property OnTTNCustomDraw;
103	120	end;
104	121
105	122	implementation

		@@ -412,6 +429,42 @@
412	429	Result := inherited ParentBackground;
413	430	end;
414	431
	432	+procedure TCustomKRKPanel.HandleNotificationMessages(var AMessage: TWMNotify);
	433	+begin
	434	+ // Caso HandleToolTipNotificationMessages retorne false, significa que não
	435	+ // houve uma manipulação da mensagem localmente. Neste caso, encaminha a mesma
	436	+ // mensagem para o pai da janela atual. Aqui, "janela", é uma terminologia do
	437	+ // Windows, mas significa, para o Delphi o pai do controle atual, que é um
	438	+ // TWinControl
	439	+ // ATENÇÃO: O encaminhamento da mensagem WM_NOTIFY pode tornar impossível a
	440	+ // identificação correta do controle que iniciou o envio da mensagem caso não
	441	+ // se tome o devido cuidado de identificar de forma única dentro da aplicação
	442	+ // este controle. Isso acontece porque as mensagens TTN sempre são enviadas
	443	+ // apenas para a janela pai do controle, assim é possível identificar de forma
	444	+ // simples este controle, pois ele é "único" dentro daquela janela pai.
	445	+ // Atribuir um número incremental simples ao membro TOOLINFO.uId é suficiente,
	446	+ // contudo, o encaminhamento da mensagem a uma janela pai faz com que a
	447	+ // identificação do controle possa ser ambígua, pois pode existir na jenala
	448	+ // pai um controle com o mesmo TOOLINFO.uId. Para resolver este problema a
	449	+ // recomendação é usar o handle da janela pai do controle como parte de seu
	450	+ // identificador, por exemplo uId = Parent.Handle + Control.ComponentIndex,
	451	+ // dessa forma uId será único dentro de toda a aplicação e haverá sempre um
	452	+ // meio de identificar cada controle. Quando se usa o flag TTF_IDISHWND, por
	453	+ // outro lado, não é necessário fazer nada, pois os Handles de todos os
	454	+ // controles (TWinControl) são únicos dentro da aplicação, assim TOOLINFO.uId
	455	+ // vai receber apenas o handle do TWinControl associado
	456	+ if not KRK.Rtl.Common.Classes.HandleToolTipNotificationMessages(AMessage
	457	+ ,FTTNLinkClick
	458	+ ,FTTNGetDispInfo
	459	+ ,FTTNShow
	460	+ ,FTTNPop
	461	+ ,FTTNCustomDraw) then
	462	+ if Assigned(Parent) then
	463	+ SendMessage(Parent.Handle,AMessage.Msg,AMessage.IDCtrl,LPARAM(AMessage.NMHdr));
	464	+ // Executa o processamento normal da mensagem WM_NOTIFY
	465	+ inherited;
	466	+end;
	467	+
415	468	procedure TCustomKRKPanel.Paint;
416	469	{ ---------------------------------------------------------------------------- }
417	470	function TotalBevel: Word;

--- trunk/utl/TESTADOR/src/UDAMOPrincipal.pas (revision 574)

+++ trunk/utl/TESTADOR/src/UDAMOPrincipal.pas (revision 575)

		@@ -242,8 +242,32 @@
242	242	'a de fazer um balão aparecer sem que ele oculte a ferram' +
243	243	'enta que está associada com ele'
244	244	,0);
245		-
246		- //verifique agora o uso de rect com e sem hwnd
	245	+ // O Rect é relativo a janela cujo handle é indicado aqui,
	246	+ // portanto não é possível usar aqui o handle do form
	247	+ // principal, pois estamos dentro de um TTabSheet e isso
	248	+ // implicaria em conversões de coordendas potencialmente
	249	+ // complicadas. Além disso, o encaminhamento da mensagem
	250	+ // WM_MOUSEMOVE só vai ocorrer quando este evento for
	251	+ // disparado e a única forma de este evento ocorrer é
	252	+ // quando o cursor do mouse está passando por cima da
	253	+ // janela cujo handle é indicado aqui. Como a imagem está
	254	+ // dentro de um TTabSheet, a mensagem WM_MOUSEMOVE ocorre
	255	+ // nele, que é o pai da imagem
	256	+ FKRTT.AddToolInfo(FormPrincipal.IMAGDelphi.Parent.Handle
	257	+ // Somando o valor do handle do pai do controle com o
	258	+ // ComponentIndex do controle, o membro uId passa a ser
	259	+ // único dentro da aplicação. Isso permite identificar o
	260	+ // controle ao qual uma configuração de exibição de
	261	+ // ToolTip está assiciada
	262	+ ,FormPrincipal.IMAGDelphi.Parent.Handle + Cardinal(FormPrincipal.IMAGDelphi.ComponentIndex)
	263	+ ,TTF_SUBCLASS or TTF_CENTERTIP
	264	+ ,Rect(FormPrincipal.IMAGDelphi.Left
	265	+ ,FormPrincipal.IMAGDelphi.Top
	266	+ ,FormPrincipal.IMAGDelphi.Left + FormPrincipal.IMAGDelphi.Width
	267	+ ,FormPrincipal.IMAGDelphi.Top + FormPrincipal.IMAGDelphi.Height)
	268	+ ,0
	269	+ ,PChar(GetLongHint(FormPrincipal.IMAGDelphi.Hint))
	270	+ ,0);
247	271	end;
248	272
249	273	procedure TDAMOPrincipal.ContentTypeapplicationxwwwformurlencodedcharsetutf81Click(Sender: TObject);

		@@ -371,7 +395,9 @@
371	395	if AMessage.NMHdr.idFrom = FormPrincipal.BUTNHint4.Handle then
372	396	FKRTT.SetIconAndTitle(TTI_INFO,'ToolTip automático 1')
373	397	else if AMessage.NMHdr.idFrom = FormPrincipal.BUTNHint5.Handle then
374		- FKRTT.SetIconAndTitle(TTI_WARNING,'ToolTip automático 2');
	398	+ FKRTT.SetIconAndTitle(TTI_WARNING,'ToolTip automático 2')
	399	+ else if AMessage.NMHdr.idFrom = (FormPrincipal.IMAGDelphi.Parent.Handle + Cardinal(FormPrincipal.IMAGDelphi.ComponentIndex)) then
	400	+ FKRTT.SetIconAndTitle(FKRTT.IconResourceId2IconHandle('IMGDELPHI'),'ToolTip automático 2');
375	401
376	402	// Eu tentei de várias formas alterar a largura do ToolTip automático de
377	403	// forma dinâmica, tanto aqui quanto dentro de NM_CUSTOMDRAW, mas não

		@@ -397,9 +423,9 @@
397	423	,'Tracking ToolTip 1'
398	424	,TTI_INFO_LARGE
399	425	,nil
	426	+ ,400
400	427	,100
401	428	,100
402		- ,100
403	429	,False)
404	430	else
405	431	FKRTT.Hide;

		@@ -418,9 +444,9 @@
418	444	,'Tracking ToolTip 2'
419	445	,TTI_WARNING
420	446	,nil
	447	+ ,300
421	448	,200
422	449	,200
423		- ,200
424	450	,False)
425	451	else
426	452	FKRTT.Hide;

		@@ -439,9 +465,9 @@
439	465	,'Tracking ToolTip 3'
440	466	,0
441	467	,'IMGDELPHI'
	468	+ ,700
442	469	,300
443	470	,300
444		- ,300
445	471	,False)
446	472	else
447	473	FKRTT.Hide;

--- trunk/utl/TESTADOR/src/UPrincipal.pas (revision 574)

+++ trunk/utl/TESTADOR/src/UPrincipal.pas (revision 575)

		@@ -5,9 +5,16 @@
5	5	uses
6	6	Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7	7	Dialogs, StdCtrls, Menus, Mask, ComCtrls, ExtCtrls,
8		- KRK.Vcl.StdCtrls, Tabs, UFRAMAssinaturaEmXML;
	8	+ KRK.Vcl.StdCtrls, Tabs, UFRAMAssinaturaEmXML, Vcl.Imaging.pngimage;
9	9
10	10	type
	11	+ TTabSheet = class(ComCtrls.TTabSheet)
	12	+ private
	13	+ // Os ToolTips podem enviar mensagens de notificação para a janela
	14	+ // identificada no membro hwnd de TOOLINFO.
	15	+ procedure HandleNotifyMessages(var AMessage: TWMNotify); message WM_NOTIFY;
	16	+ end;
	17	+
11	18	TFormPrincipal = class(TForm)
12	19	PACO: TPageControl;
13	20	TASHKRKLibRtlWinWinCrypt: TTabSheet;

		@@ -103,6 +110,7 @@
103	110	BUTNHint3: TButton;
104	111	BUTNHint4: TButton;
105	112	BUTNHint5: TButton;
	113	+ IMAGDelphi: TImage;
106	114	procedure BUTNGetStringCheckSumClick(Sender: TObject);
107	115	procedure MNUIPackagesCreationToolClick(Sender: TObject);
108	116	procedure MNUITranslationManagerClick(Sender: TObject);

		@@ -136,9 +144,7 @@
136	144	PM: TPopUpMenu;
137	145	procedure HandleOnNewLine(AProcessHandle: THandle; AThreadHandle: THandle; const ALine: String);
138	146	// Os ToolTips podem enviar mensagens de notificação para a janela
139		- // identificada no membro hwnd de TOOLINFO. Em todos os exemplos aqui usamos
140		- // a janela de FormPrincipal como membro hwnd, portanto, aqui capturamos
141		- // estas mensagens
	147	+ // identificada no membro hwnd de TOOLINFO.
142	148	procedure HandleNotifyMessages(var AMessage: TWMNotify); message WM_NOTIFY;
143	149	procedure LoadComboBoxes;
144	150	procedure UnloadComboBoxes;

		@@ -1022,5 +1028,17 @@
1022	1028
1023	1029
1024	1030	*)
	1031	+
	1032	+{ TTabSheet }
	1033	+
	1034	+procedure TTabSheet.HandleNotifyMessages(var AMessage: TWMNotify);
	1035	+begin
	1036	+ // Manipula as mensagens no datamodule a fim de centralizar todos os uses
	1037	+ // referentes a ToolTips por lá e manter este form mais limpo
	1038	+ DAMOPrincipal.HandleTTNMessages(AMessage);
	1039	+ // Continua processando mensagens de notificação
	1040	+ inherited;
	1041	+end;
	1042	+
1025	1043	end.
1026	1044

Afficher sur ancien navigateur de dépôt.