You've already forked lazarus-ccr
27aea1d1ad
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5438 8e941d3f-bd1b-0410-a28a-d453659cc2b4
1965 lines
66 KiB
ObjectPascal
1965 lines
66 KiB
ObjectPascal
{*********************************************************}
|
|
{* FlashFiler: Table Browser *}
|
|
{*********************************************************}
|
|
|
|
(* ***** BEGIN LICENSE BLOCK *****
|
|
* Version: MPL 1.1
|
|
*
|
|
* The contents of this file are subject to the Mozilla Public License Version
|
|
* 1.1 (the "License"); you may not use this file except in compliance with
|
|
* the License. You may obtain a copy of the License at
|
|
* http://www.mozilla.org/MPL/
|
|
*
|
|
* Software distributed under the License is distributed on an "AS IS" basis,
|
|
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
|
* for the specific language governing rights and limitations under the
|
|
* License.
|
|
*
|
|
* The Original Code is TurboPower FlashFiler
|
|
*
|
|
* The Initial Developer of the Original Code is
|
|
* TurboPower Software
|
|
*
|
|
* Portions created by the Initial Developer are Copyright (C) 1996-2002
|
|
* the Initial Developer. All Rights Reserved.
|
|
*
|
|
* Contributor(s):
|
|
*
|
|
* ***** END LICENSE BLOCK ***** *)
|
|
|
|
{$I ffdefine.inc}
|
|
|
|
unit dgtable;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows,
|
|
Messages,
|
|
SysUtils,
|
|
Classes,
|
|
Graphics,
|
|
Controls,
|
|
Forms,
|
|
Dialogs,
|
|
Db,
|
|
StdCtrls,
|
|
Grids,
|
|
DBGrids,
|
|
DBCtrls,
|
|
ExtCtrls,
|
|
Buttons,
|
|
Menus,
|
|
ComCtrls,
|
|
ffdb,
|
|
ffdbbase,
|
|
fflllgcy,
|
|
ffllbase,
|
|
ffclreng,
|
|
ffllprot,
|
|
fflllog,
|
|
ffutil,
|
|
ffclbase,
|
|
Mask,
|
|
dgSetRng,
|
|
uEntity,
|
|
uConsts;
|
|
|
|
|
|
type
|
|
TdlgTable = class(TForm)
|
|
dsTableBrowser: TDataSource;
|
|
navTableBrowser: TDBNavigator;
|
|
barStatus: TStatusBar;
|
|
MainMenu1: TMainMenu;
|
|
mnuTable: TMenuItem;
|
|
N1: TMenuItem;
|
|
mnuTableClose: TMenuItem;
|
|
mnuView: TMenuItem;
|
|
mnuViewRefresh: TMenuItem;
|
|
N2: TMenuItem;
|
|
mnuViewShowRecordCount: TMenuItem;
|
|
mnuViewShowFilter: TMenuItem;
|
|
mnuTableResetCol: TMenuItem;
|
|
mnuOptions: TMenuItem;
|
|
mnuOptionsDebug: TMenuItem;
|
|
mnuOptionsTimeout: TMenuItem;
|
|
N3: TMenuItem;
|
|
paClient: TPanel;
|
|
grdTableBrowser: TDBGrid;
|
|
pcBlobfields: TPageControl;
|
|
splGridAndPageControl: TSplitter;
|
|
pnlIndex: TPanel;
|
|
lblIndex: TLabel;
|
|
cboIndex: TComboBox;
|
|
lblFind: TLabel;
|
|
edtFind: TEdit;
|
|
btnFindNear: TButton;
|
|
pnlFilter: TPanel;
|
|
lblFilter: TLabel;
|
|
btnSetFilter: TButton;
|
|
pnlRange: TPanel;
|
|
laRangeStartDesc: TLabel;
|
|
btnSetClearRange: TButton;
|
|
tsMemoTemplate: TTabSheet;
|
|
tsGraphicTemplate: TTabSheet;
|
|
tsByteArrayTemplate: TTabSheet;
|
|
cbStretch: TCheckBox;
|
|
btnLoadGraphic: TButton;
|
|
Image: TImage;
|
|
tsGenericBlobTemplate: TTabSheet;
|
|
meGeneric: TMemo;
|
|
mnuViewShowRange: TMenuItem;
|
|
mnuViewShowBLOBFields: TMenuItem;
|
|
Label2: TLabel;
|
|
btnClearBA: TButton;
|
|
OpenDialog: TOpenDialog;
|
|
SaveDialog: TSaveDialog;
|
|
btnLoadGeneric: TButton;
|
|
btnSaveGeneric: TButton;
|
|
btnClearGeneric: TButton;
|
|
btnSaveGraphic: TButton;
|
|
btnClearGraphic: TButton;
|
|
Label3: TLabel;
|
|
meByteArray: TMaskEdit;
|
|
N4: TMenuItem;
|
|
mnuTablePrintPreview: TMenuItem;
|
|
mnuTableDesignReport: TMenuItem;
|
|
dbMemo: TDBMemo;
|
|
btnLoadMemo: TButton;
|
|
btnSaveMemo: TButton;
|
|
btnClearMemo: TButton;
|
|
laRangeEndDesc: TLabel;
|
|
btnEditRange: TButton;
|
|
laRangeStart: TLabel;
|
|
laRangeEnd: TLabel;
|
|
cbWordwrap: TCheckBox;
|
|
mnuTableCopyToTable: TMenuItem;
|
|
N5: TMenuItem;
|
|
mnuTableDeleteRecords: TMenuItem;
|
|
cboFilter: TComboBox;
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure cboIndexChange(Sender: TObject);
|
|
procedure btnFindClick(Sender: TObject);
|
|
procedure mnuTableCloseClick(Sender: TObject);
|
|
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
|
procedure mnuViewRefreshClick(Sender: TObject);
|
|
procedure mnuViewShowFilterClick(Sender: TObject);
|
|
procedure btnFilterClick(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure btnFindNearClick(Sender: TObject);
|
|
procedure btnSetFilterClick(Sender: TObject);
|
|
procedure edtFindEnter(Sender: TObject);
|
|
procedure cboFilterEnter(Sender: TObject);
|
|
procedure mnuViewShowRecordCountClick(Sender: TObject);
|
|
procedure mnuTableResetColClick(Sender: TObject);
|
|
procedure grdTableBrowserKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
procedure mnuOptionsDebugClick(Sender: TObject);
|
|
procedure mnuOptionsTimeoutClick(Sender: TObject);
|
|
procedure FormKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
procedure cbStretchClick(Sender: TObject);
|
|
procedure btnClearBAClick(Sender: TObject);
|
|
procedure pcBlobfieldsChange(Sender: TObject);
|
|
procedure mnuViewShowBLOBFieldsClick(Sender: TObject);
|
|
procedure btnLoadMemoClick(Sender: TObject);
|
|
procedure btnSaveMemoClick(Sender: TObject);
|
|
procedure btnLoadGenericClick(Sender: TObject);
|
|
procedure btnSaveGenericClick(Sender: TObject);
|
|
procedure btnClearMemoClick(Sender: TObject);
|
|
procedure btnLoadGraphicClick(Sender: TObject);
|
|
procedure btnSaveGraphicClick(Sender: TObject);
|
|
procedure btnClearGraphicClick(Sender: TObject);
|
|
procedure btnClearGenericClick(Sender: TObject);
|
|
procedure meByteArrayKeyPress(Sender: TObject; var Key: Char);
|
|
procedure mnuTablePrintPreviewClick(Sender: TObject);
|
|
procedure btnSetClearRangeClick(Sender: TObject);
|
|
procedure mnuTableDesignReportClick(Sender: TObject);
|
|
procedure tsMemoTemplateResize(Sender: TObject);
|
|
procedure tsGraphicTemplateResize(Sender: TObject);
|
|
procedure tsGenericBlobTemplateResize(Sender: TObject);
|
|
procedure tsByteArrayTemplateResize(Sender: TObject);
|
|
procedure btnEditRangeClick(Sender: TObject);
|
|
procedure mnuViewShowRangeClick(Sender: TObject);
|
|
procedure FormResize(Sender: TObject);
|
|
procedure meByteArrayChange(Sender: TObject);
|
|
procedure cbWordwrapClick(Sender: TObject);
|
|
procedure mnuTableCopyToTableClick(Sender: TObject);
|
|
procedure mnuTableDeleteRecordsClick(Sender: TObject); {!!.07}
|
|
private
|
|
procedure FTableAfterPost(DataSet: TDataSet); {!!.07}
|
|
procedure FTableAfterScroll(DataSet: TDataSet);
|
|
procedure FTableAfterCancel(DataSet: TDataSet);
|
|
procedure FTableBeforeEdit(DataSet: TDataSet);
|
|
procedure FTableBeforeInsert(DataSet: TDataSet);
|
|
procedure ViewActiveBlobField;
|
|
procedure SetRange;
|
|
protected
|
|
FClient : TffClient;
|
|
FDatabaseName : TffName;
|
|
FEngine : TffRemoteServerEngine;
|
|
FLog : TffBaseLog;
|
|
FProtocol : TffProtocolType;
|
|
FReadOnly : boolean;
|
|
FServerName : TffNetAddress;
|
|
FSession : TFfSession;
|
|
FTable : TFfTable;
|
|
FTableName : TffName;
|
|
FUserName : TffName;
|
|
FPassword : TffName;
|
|
FTransport : TffLegacyTransport;
|
|
FTableItem : TffeTableItem;
|
|
|
|
dtShown : boolean;
|
|
{-Set to True if the form was actually displayed. Lets the form know
|
|
it should save user preferences. }
|
|
InRange : boolean;
|
|
{ true if SetRange has been performed }
|
|
FRangeValues : TffRangeValues;
|
|
{ the start and end values for the active range }
|
|
BeforeInitDone : Boolean;
|
|
{ to keep UpdateDisplay from being called repeatedly }
|
|
BAKeyPressDetected : Boolean;
|
|
{ to avoid going to Edit mode when changing ByteArray edit programmatically }
|
|
AddedComponentCount : Integer;
|
|
{ used to avoid duplicate names in dynamically added components }
|
|
FDynEnabledComponents, {!!.11}
|
|
FDynReadOnlyComponents: TList;
|
|
{ used to easily enable and disable the dynamically added components }
|
|
|
|
procedure SavePreferences;
|
|
procedure LoadPreferences;
|
|
procedure WMGetMinMaxInfo(var Message : TWMGetMinMaxInfo);
|
|
message WM_GETMINMAXINFO;
|
|
function HasBlobOrByteArrayField : Boolean; {!!.07}
|
|
procedure GenerateRangeDisplayStrings; {!!.07}
|
|
protected { access methods }
|
|
procedure SetReadOnly(const Value : Boolean);
|
|
public
|
|
procedure CloseDuringShow(var Message : TMessage); message ffm_Close;
|
|
procedure UpdateDisplay; {!!.01}
|
|
procedure UpdateDefaultTimeout; {!!.11}
|
|
|
|
property Protocol : TffProtocolType
|
|
read FProtocol write FProtocol;
|
|
|
|
property ServerName : TffNetAddress
|
|
read FServerName write FServerName;
|
|
|
|
property DatabaseName : TffName
|
|
read FDatabaseName write FDatabaseName;
|
|
|
|
property Log : TffBaseLog
|
|
read FLog write FLog;
|
|
|
|
property Password : TffName
|
|
read FPassword write FPassword;
|
|
|
|
property TableName : TffName
|
|
read FTableName write FTableName;
|
|
|
|
property ReadOnly : boolean
|
|
read FReadOnly write SetReadOnly;
|
|
|
|
property UserName : TffName
|
|
read FUserName write FUserName;
|
|
|
|
property TableItem : TffeTableItem
|
|
read FTableItem write FTableItem;
|
|
end;
|
|
|
|
var
|
|
dlgTable: TdlgTable;
|
|
|
|
implementation
|
|
|
|
uses
|
|
dgCpyTbl, {!!.10}
|
|
typinfo, {!!.07}
|
|
jpeg, {!!.07}
|
|
uReportEngineInterface, {!!.07}
|
|
{$IFDEF DCC6ORLater}
|
|
variants, {!!.07}
|
|
{$ENDIF}
|
|
FFLLComm,
|
|
FFLLComp,
|
|
FFLLEng,
|
|
uConfig;
|
|
|
|
{$R *.DFM}
|
|
|
|
const
|
|
MaxFilterComboItems = 10; {!!.11}
|
|
|
|
procedure TdlgTable.FormCreate(Sender: TObject);
|
|
begin
|
|
|
|
FClient := nil;
|
|
FDatabaseName := '';
|
|
FEngine := nil;
|
|
FLog := nil;
|
|
FProtocol := ptRegistry;
|
|
FReadOnly := False;
|
|
FServerName := '';
|
|
FSession := nil;
|
|
FTable := nil;
|
|
FTableName := '';
|
|
FTransport := nil;
|
|
FPassword := '';
|
|
FUserName := '';
|
|
|
|
InRange := False;
|
|
BeforeInitDone := True;
|
|
BAKeyPressDetected := False;
|
|
AddedComponentCount := 0;
|
|
FDynEnabledComponents := TList.Create; {!!.11}
|
|
FDynReadOnlyComponents := TList.Create; {!!.11}
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.SetReadOnly(const Value : Boolean);
|
|
var
|
|
i : Integer;
|
|
bm: TBookmark;
|
|
FieldsTags: TList;
|
|
begin
|
|
FReadOnly := Value;
|
|
grdTableBrowser.ReadOnly := FReadOnly;
|
|
{Begin !!.11}
|
|
{ only update the buttons after they are created,
|
|
and table when it's opened. }
|
|
if not dtShown then
|
|
Exit;
|
|
bm := FTable.GetBookmark;
|
|
FieldsTags := TList.Create;
|
|
try
|
|
{ save blob-support pointers }
|
|
for i := 0 to Pred(FTable.FieldCount) do
|
|
FieldsTags.Add(Pointer(FTable.Fields[i].Tag));
|
|
FTable.Close;
|
|
FTable.ReadOnly := ReadOnly;
|
|
FTable.Open;
|
|
for i := 0 to Pred(FTable.FieldCount) do
|
|
FTable.Fields[i].Tag := Integer(FieldsTags[i]);
|
|
FTable.GotoBookmark(bm);
|
|
finally
|
|
FTable.FreeBookmark(bm);
|
|
FieldsTags.Free;
|
|
end;
|
|
for i := 0 to Pred(ComponentCount) do
|
|
if (Components[i] is TButton) and
|
|
(((Components[i] as TButton).Caption='Load from file...') or
|
|
((Components[i] as TButton).Caption='Save to file...') or
|
|
((Components[i] as TButton).Caption='Clear')) then
|
|
(Components[i] as TButton).Enabled := not FReadOnly;
|
|
{End !!.11}
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.FormShow(Sender: TObject);
|
|
var
|
|
aServerName : string;
|
|
aAddress : string;
|
|
I : Integer;
|
|
OldPass, OldUser : string;
|
|
|
|
{$IFNDEF DCC5OrLater}
|
|
function IsPublishedProp(Source : TObject; const PropName : string) : Boolean;
|
|
var
|
|
P: PPropInfo;
|
|
begin
|
|
P := GetPropInfo(Source.ClassInfo, PropName);
|
|
Result := P <> nil;
|
|
end;
|
|
{--------}
|
|
function GetStrProp(Source : TObject; const PropName : string) : string;
|
|
var
|
|
P: PPropInfo;
|
|
begin
|
|
P := GetPropInfo(Source.ClassInfo, PropName);
|
|
if Assigned(P) then begin
|
|
Result := TypInfo.GetStrProp(Source, P);
|
|
end else
|
|
Result := '';
|
|
end;
|
|
{--------}
|
|
function SetStrProp(Source : TObject; const PropName, Value : string) : string;
|
|
var
|
|
P: PPropInfo;
|
|
begin
|
|
P := GetPropInfo(Source.ClassInfo, PropName);
|
|
if Assigned(P) then
|
|
TypInfo.SetStrProp(Source, P, Value);
|
|
end;
|
|
{--------}
|
|
procedure SetMethodProp(Source : TObject; const PropName : string; Value : TMethod);
|
|
var
|
|
P: PPropInfo;
|
|
begin
|
|
P := GetPropInfo(Source.ClassInfo, PropName);
|
|
if Assigned(P) then
|
|
TypInfo.SetMethodProp(Source, P, Value);
|
|
end;
|
|
{--------}
|
|
function GetMethodProp(Source : TObject; const PropName : string) : TMethod;
|
|
var
|
|
P: PPropInfo;
|
|
begin
|
|
P := GetPropInfo(Source.ClassInfo, PropName);
|
|
if Assigned(P) then
|
|
Result := TypInfo.GetMethodProp(Source, P);
|
|
end;
|
|
{$ENDIF}
|
|
{Begin !!.07}
|
|
function CopyComponent(Source : TComponent) : TComponent;
|
|
var
|
|
PropStream : TMemoryStream;
|
|
OldText, OldName : String;
|
|
begin
|
|
Result := Nil;
|
|
if assigned(Source) then
|
|
begin
|
|
PropStream := TMemoryStream.Create;
|
|
try
|
|
//prevent doubled component names
|
|
OldName := Source.Name;
|
|
Source.Name := OldName + IntToStr(AddedComponentCount);
|
|
Inc(AddedComponentCount);
|
|
//Save the "stored" properties to memory
|
|
PropStream.WriteComponent(Source);
|
|
Source.Name := OldName;
|
|
//e.g. TEdit will change it's content if renamed
|
|
if IsPublishedProp(Source,'Text') then
|
|
OldText := GetStrProp(Source,'Text')
|
|
else
|
|
//Some Captions may face the same problem
|
|
if IsPublishedProp(Source,'Caption') then
|
|
OldText := GetStrProp(Source,'Caption');
|
|
Result := TComponentClass(Source.ClassType).Create(Source.Owner);
|
|
PropStream.Position := 0;
|
|
PropStream.ReadComponent(Result);
|
|
// Result.Name := OldName + IntToStr(AddedComponentCount);
|
|
//Handle Components with a "Text" or "Caption" -property;
|
|
//e.g. TEdit, TLabel
|
|
if IsPublishedProp(Source,'Text') then
|
|
begin
|
|
SetStrProp(Source,'Text',OldText);
|
|
SetStrProp(Result,'Text',OldText);
|
|
end
|
|
else
|
|
if IsPublishedProp(Source,'Caption') then
|
|
begin
|
|
SetStrProp(Source,'Caption',OldText);
|
|
SetStrProp(Result,'Caption',OldText);
|
|
end;
|
|
finally
|
|
PropStream.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ generates a new tabsheet and hooks up
|
|
components on the new tabsheet to the field }
|
|
procedure CreateNewBlobTabSheet(SheetToCopy : TTabSheet; OnResizeProc : TNotifyEvent; FieldIndex : Integer);
|
|
var
|
|
NewSheet : TTabSheet;
|
|
Idx : Integer;
|
|
NewComponent : TComponent;
|
|
begin
|
|
NewSheet := TTabSheet.Create(pcBlobFields);
|
|
NewSheet.PageControl := pcBlobFields;
|
|
NewSheet.Caption := FTable.Fields[FieldIndex].FieldName;
|
|
{$IFDEF DCC4OrLater}
|
|
NewSheet.OnResize := OnResizeProc;
|
|
{$ENDIF}
|
|
|
|
for Idx := 0 to SheetToCopy.ControlCount-1 do begin
|
|
NewComponent := CopyComponent(SheetToCopy.Controls[Idx]);
|
|
TControl(NewComponent).Parent := NewSheet;
|
|
if IsPublishedProp(NewComponent, 'DataField') then
|
|
SetStrProp(NewComponent, 'DataField', FTable.Fields[FieldIndex].FieldName);
|
|
if (IsPublishedProp(NewComponent, 'OnClick')) then
|
|
SetMethodProp(NewComponent, 'OnClick', GetMethodProp(SheetToCopy.Controls[Idx], 'OnClick'));
|
|
if (IsPublishedProp(NewComponent, 'OnKeyPress')) then
|
|
SetMethodProp(NewComponent, 'OnKeyPress', GetMethodProp(SheetToCopy.Controls[Idx], 'OnKeyPress'));
|
|
if (IsPublishedProp(NewComponent, 'OnChange')) then
|
|
SetMethodProp(NewComponent, 'OnChange', GetMethodProp(SheetToCopy.Controls[Idx], 'OnChange'));
|
|
// if NewComponent. IS TCheckBox
|
|
// SetStrProp(NewComponent, 'OnClick', FTable.Fields.Fields[FieldIndex].FieldName);
|
|
{ save pointer to the control displaying the field }
|
|
if (NewComponent IS TImage) or { graphictemplate }
|
|
(NewComponent IS TMaskEdit) or { bytearraytemplate }
|
|
(NewComponent IS TMemo) or { generictemplate }
|
|
(NewComponent IS TdbMemo) then { memotemplate }
|
|
FTable.Fields[FieldIndex].Tag := Integer(NewComponent);
|
|
|
|
end;
|
|
end;
|
|
{End !!.07}
|
|
|
|
begin
|
|
dtShown := False;
|
|
try
|
|
{ Set up the connection. }
|
|
FTransport := TffLegacyTransport.Create(nil);
|
|
with FTransport do begin
|
|
Mode := fftmSend;
|
|
Protocol := FProtocol;
|
|
EventLog := FLog;
|
|
if Assigned(FLog) then begin
|
|
EventLogEnabled := True;
|
|
EventLogOptions := [fftpLogErrors];
|
|
end;
|
|
ServerName := FServerName;
|
|
end;
|
|
|
|
FEngine := TffRemoteServerEngine.Create(nil);
|
|
FEngine.Transport := FTransport;
|
|
|
|
FClient := TffClient.Create(nil);
|
|
FClient.ServerEngine := FEngine;
|
|
FClient.AutoClientName := True;
|
|
FClient.TimeOut := Config.DefaultTimeout; {!!.11}
|
|
|
|
FSession := TffSession.Create(nil);
|
|
FSession.ClientName := FClient.ClientName;
|
|
FSession.AutoSessionName := True;
|
|
OldPass := ffclPassword;
|
|
OldUser := ffclUserName;
|
|
try
|
|
if FPassword <> '' then begin
|
|
ffclPassword := FPassword;
|
|
ffclUserName := FUserName;
|
|
end;
|
|
FSession.Open;
|
|
finally
|
|
ffclPassword := OldPass;
|
|
ffclUserName := OldUser;
|
|
end;
|
|
|
|
FTable := TffTable.Create(nil);
|
|
FTable.SessionName := FSession.SessionName;
|
|
FTable.DatabaseName := FDatabaseName;
|
|
FTable.TableName := FTableName;
|
|
FTable.AfterPost := FTableAfterPost; {!!.07}
|
|
FTable.AfterDelete := FTableAfterPost; {!!.07}
|
|
FTable.AfterScroll := FTableAfterScroll; {!!.07}
|
|
FTable.AfterCancel := FTableAfterCancel; {!!.07}
|
|
FTable.BeforeEdit := FTableBeforeEdit;
|
|
FTable.BeforeInsert := FTableBeforeInsert;
|
|
FTable.ReadOnly := ReadOnly; {!!.11}
|
|
FTable.Open;
|
|
|
|
{ Set up the indexes }
|
|
cboIndex.Items.Clear;
|
|
with FTable.IndexDefs do begin
|
|
Clear;
|
|
Update;
|
|
for I := 0 to Count - 1 do
|
|
cboIndex.Items.Add(Items[I].Name);
|
|
end;
|
|
|
|
cboIndex.ItemIndex := 0;
|
|
FTable.IndexName := cboIndex.Items[cboIndex.ItemIndex];
|
|
|
|
{ Update the find controls }
|
|
cboIndexChange(nil);
|
|
|
|
FFSeparateAddress(FTransport.ServerName, aServerName, aAddress);
|
|
Self.Caption := format('%s : %s : %s',
|
|
[aServerName, FDatabaseName, FTableName]);
|
|
|
|
dsTableBrowser.DataSet := FTable;
|
|
|
|
{Begin !!.07}
|
|
{ check if there are any BLOB fields in the table
|
|
and populate the pagecontrol with appropriate controls if so }
|
|
|
|
{ make the templates invisible }
|
|
for I := 0 to pcBlobFields.PageCount-1 do
|
|
pcBlobFields.Pages[I].TabVisible := False;
|
|
|
|
{ generate new tabsheets for blobfields }
|
|
for I := 0 to FTable.Dictionary.FieldCount-1 do begin
|
|
case FTable.Dictionary.FieldType[I] of
|
|
fftBLOBMemo,
|
|
fftBLOBFmtMemo : CreateNewBlobTabSheet(tsMemoTemplate, tsMemoTemplateResize, I);
|
|
fftBLOBGraphic : CreateNewBlobTabSheet(tsGraphicTemplate, tsGraphicTemplateResize, I);
|
|
fftByteArray : CreateNewBlobTabSheet(tsByteArrayTemplate, tsByteArrayTemplateResize, I);
|
|
fftBLOB,
|
|
fftBLOBOLEObj,
|
|
fftBLOBDBSOLEObj,
|
|
fftBLOBTypedBin,
|
|
fftBLOBFile : CreateNewBlobTabSheet(tsGenericBlobTemplate, tsGenericBlobTemplateResize, I);
|
|
end;
|
|
end;
|
|
|
|
{End !!.07}
|
|
|
|
LoadPreferences;
|
|
|
|
BeforeInitDone := False;
|
|
UpdateDisplay;
|
|
|
|
ViewActiveBlobField; {!!.07}
|
|
|
|
{ make sure no column exceeds screen width } {!!.07}
|
|
for I := 0 to grdTableBrowser.Columns.Count-1 do begin
|
|
if grdTableBrowser.Columns[i].Width>(Width DIV 5)*4 then
|
|
grdTableBrowser.Columns[i].Width := (Width DIV 5)*4;
|
|
end;
|
|
|
|
dtShown := True;
|
|
{ update newly created dynamic components }
|
|
ReadOnly := FReadOnly; {!!.11}
|
|
|
|
{ large font support... }
|
|
if (Screen.PixelsPerInch/PixelsPerInch)>1.001 then begin
|
|
Height := Round(Height * (Screen.PixelsPerInch/PixelsPerInch));
|
|
Width := Round(Width * (Screen.PixelsPerInch/PixelsPerInch));
|
|
barStatus.Height := Round(barStatus.Height * (Screen.PixelsPerInch/PixelsPerInch));
|
|
end;
|
|
|
|
{ report menuitems }
|
|
mnuTablePrintPreview.Enabled := ReportEngineDLLLoaded;
|
|
mnuTableDesignReport.Enabled := ReportEngineDLLLoaded;
|
|
|
|
except
|
|
on E:Exception do begin
|
|
showMessage(E.message);
|
|
PostMessage(Handle, ffm_Close, 0, longInt(Sender));
|
|
end;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.cboIndexChange(Sender: TObject);
|
|
var
|
|
BaseSection : string;
|
|
Index : Integer;
|
|
begin
|
|
BaseSection := ClassName + '.' + Self.Caption;
|
|
with FTable do
|
|
if IndexName <> cboIndex.Items[cboIndex.ItemIndex] then begin
|
|
IndexName := cboIndex.Items[cboIndex.ItemIndex];
|
|
end;
|
|
lblFind.Visible := cboIndex.ItemIndex > 0;
|
|
edtFind.Visible := cboIndex.ItemIndex > 0;
|
|
btnFindNear.Visible := cboIndex.ItemIndex > 0;
|
|
btnSetClearRange.Enabled := cboIndex.ItemIndex > 0;
|
|
btnEditRange.Enabled := cboIndex.ItemIndex > 0;
|
|
{ clear range - btnSetClearRangeClick flips InRange }
|
|
InRange := True;
|
|
btnSetClearRangeClick(Self);
|
|
for Index := Low(FRangeValues.Field) to FTable.IndexFieldCount do begin
|
|
FRangeValues.Field[Index].StartNull := FFEConfigGetBoolean(BaseSection, FTable.IndexName+'_RangeStartNull'+IntToStr(Index), True);
|
|
FRangeValues.Field[Index].EndNull := FFEConfigGetBoolean(BaseSection, FTable.IndexName+'_RangeEndNull'+IntToStr(Index), True);
|
|
FRangeValues.Field[Index].StartValue := FFEConfigGetString(BaseSection, FTable.IndexName+'_RangeStartValue'+IntToStr(Index), '');
|
|
FRangeValues.Field[Index].EndValue := FFEConfigGetString(BaseSection, FTable.IndexName+'_RangeEndValue'+IntToStr(Index), '');;
|
|
end;
|
|
FRangeValues.RangeStartKeyExclusive := FFEConfigGetBoolean(BaseSection, FTable.IndexName+'_RangeStartKeyExclusive', False);
|
|
FRangeValues.RangeEndKeyExclusive := FFEConfigGetBoolean(BaseSection, FTable.IndexName+'_RangeEndKeyExclusive', False);
|
|
GenerateRangeDisplayStrings;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.btnFindClick(Sender: TObject);
|
|
begin
|
|
try
|
|
FTable.FindNearest([edtFind.Text]);
|
|
except
|
|
on E: EffDatabaseError do begin
|
|
if E.ErrorCode = 8706 then
|
|
ShowMessage(format('%s not found.', [edtFind.Text]))
|
|
else
|
|
ShowMessage(E.Message);
|
|
end;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.mnuTableCloseClick(Sender: TObject);
|
|
begin
|
|
Close;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.FormClose(Sender: TObject; var Action: TCloseAction);
|
|
begin
|
|
if dtShown then
|
|
SavePreferences;
|
|
Action := caFree;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.mnuViewRefreshClick(Sender: TObject);
|
|
begin
|
|
FTable.Refresh;
|
|
UpdateDisplay;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.UpdateDisplay;
|
|
begin
|
|
if BeforeInitDone then
|
|
Exit;
|
|
if mnuViewShowRecordCount.Checked then
|
|
barStatus.Panels[0].Text := 'Records: ' + FFCommaizeChL(FTable.RecordCount, ThousandSeparator)
|
|
else
|
|
barStatus.Panels[0].Text := '';
|
|
|
|
if FTable.Filtered then
|
|
barStatus.Panels[1].Text := 'Filter: <ACTIVE>'
|
|
else
|
|
barStatus.Panels[1].Text := 'Filter: <Inactive>';
|
|
|
|
if InRange then begin
|
|
barStatus.Panels[2].Text := 'Range: <ACTIVE>';
|
|
laRangeStart.Font.Style := [fsBold];
|
|
laRangeEnd.Font.Style := [fsBold];
|
|
laRangeStartDesc.Font.Style := [fsBold];
|
|
laRangeEndDesc.Font.Style := [fsBold];
|
|
end
|
|
else begin
|
|
barStatus.Panels[2].Text := 'Range: <Inactive>';
|
|
laRangeStart.Font.Style := [];
|
|
laRangeEnd.Font.Style := [];
|
|
laRangeStartDesc.Font.Style := [];
|
|
laRangeEndDesc.Font.Style := [];
|
|
end;
|
|
|
|
with navTableBrowser do begin
|
|
VisibleButtons := [nbFirst, nbLast, nbPrior, nbNext, nbRefresh];
|
|
if (not FTable.ReadOnly) and (not FReadOnly) then
|
|
VisibleButtons := VisibleButtons + [nbInsert, nbDelete, nbEdit, nbPost, nbCancel];
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.mnuViewShowFilterClick(Sender: TObject);
|
|
begin
|
|
mnuViewShowFilter.Checked := not mnuViewShowFilter.Checked;
|
|
pnlFilter.Visible := mnuViewShowFilter.Checked;
|
|
{ make sure to reset statusbar etc if status changes }
|
|
if FTable.Filtered then
|
|
btnSetFilterClick(Self);
|
|
// edtFilter.Text := ''; why remove? makes sense to keep the text, the user might need it again!
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.btnFilterClick(Sender: TObject);
|
|
begin
|
|
if FTable.Filtered then begin
|
|
FTable.Filtered := False;
|
|
btnSetFilter.Caption := 'S&et Filter'; {!!.03}
|
|
end else begin
|
|
FTable.Filter := cboFilter.Text;
|
|
FTable.Filtered := True;
|
|
btnSetFilter.Caption := 'Cl&ear Filter'; {!!.03}
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.FormDestroy(Sender: TObject);
|
|
begin
|
|
{Begin !!.05 !!.10}
|
|
try
|
|
FTable.Close;
|
|
finally
|
|
FTable.Free;
|
|
end;
|
|
|
|
try
|
|
FSession.Active := False;
|
|
finally
|
|
FSession.Free;
|
|
end;
|
|
|
|
try
|
|
FClient.Close;
|
|
finally
|
|
FClient.Free;
|
|
end;
|
|
|
|
try
|
|
FEngine.Shutdown;
|
|
finally
|
|
FEngine.Free;
|
|
end;
|
|
|
|
try
|
|
FTransport.Shutdown;
|
|
finally
|
|
FTransport.Free;
|
|
end;
|
|
{End !!.05}
|
|
FDynEnabledComponents.Free; {!!.11}
|
|
FDynReadOnlyComponents.Free; {!!.11}
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.CloseDuringShow(var Message : TMessage);
|
|
begin
|
|
Close;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.WMGetMinMaxInfo(var Message : TWMGetMinMaxInfo);
|
|
var
|
|
MinMax : PMinMaxInfo;
|
|
begin
|
|
inherited;
|
|
MinMax := Message.MinMaxInfo;
|
|
MinMax^.ptMinTrackSize.x := 590;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.btnFindNearClick(Sender: TObject);
|
|
begin
|
|
try
|
|
FTable.FindNearest([edtFind.Text]);
|
|
except
|
|
on E: EffDatabaseError do begin
|
|
if E.ErrorCode = 8706 then
|
|
ShowMessage(format('%s not found.', [edtFind.Text]))
|
|
else
|
|
ShowMessage(E.Message);
|
|
end;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.btnSetFilterClick(Sender: TObject);
|
|
{Begin !!.05}
|
|
var
|
|
SavCursor : TCursor;
|
|
begin
|
|
SavCursor := Screen.Cursor;
|
|
Screen.Cursor := crHourGlass;
|
|
try
|
|
if FTable.Filtered then begin
|
|
FTable.Filtered := False;
|
|
btnSetFilter.Caption := 'S&et Filter'; {!!.03}
|
|
end else begin
|
|
FTable.Filter := cboFilter.Text;
|
|
FTable.Filtered := True;
|
|
btnSetFilter.Caption := 'Cl&ear Filter'; {!!.03}
|
|
{Begin !!.11}
|
|
{ update history list in combobox }
|
|
if FTable.Filter<>'' then begin
|
|
{ does filter exist in the list? }
|
|
if cboFilter.Items.IndexOf(FTable.Filter)>=0 then
|
|
{ if so remove it; no doubles needed }
|
|
cboFilter.Items.Delete(cboFilter.Items.IndexOf(FTable.Filter));
|
|
{ make last filter string top of the history list }
|
|
cboFilter.Items.Insert(0, FTable.Filter);
|
|
cboFilter.ItemIndex := 0;
|
|
{ enforce maxcount }
|
|
while cboFilter.Items.Count>MaxFilterComboItems do
|
|
cboFilter.Items.Delete(MaxFilterComboItems);
|
|
end;
|
|
{End !!.11}
|
|
end;
|
|
UpdateDisplay;
|
|
finally
|
|
Screen.Cursor := SavCursor;
|
|
end;
|
|
{End !!.05}
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.edtFindEnter(Sender: TObject);
|
|
begin
|
|
btnSetFilter.Default := False;
|
|
btnFindNear.Default := True;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.cboFilterEnter(Sender: TObject);
|
|
begin
|
|
btnFindNear.Default := False;
|
|
btnSetFilter.Default := True;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.SavePreferences;
|
|
var
|
|
BaseSection : string;
|
|
i : Integer; {!!.11}
|
|
begin
|
|
try
|
|
BaseSection := ClassName + '.' + Self.Caption;
|
|
FFEConfigSaveString(BaseSection, 'Last Filter', cboFilter.Text);
|
|
{Begin !!.11}
|
|
for i := 0 to Pred(cboFilter.Items.Count) do
|
|
FFEConfigSaveString(BaseSection, 'FilterHistory'+IntToStr(i), cboFilter.Items[i]);
|
|
{End !!.11}
|
|
FFEConfigSaveString(BaseSection, 'Last Find Nearest', edtFind.Text);
|
|
FFEConfigSaveInteger(BaseSection, 'Last Index', cboIndex.ItemIndex);
|
|
FFEConfigSaveBoolean(BaseSection, 'Show record count', mnuViewShowRecordCount.Checked);
|
|
FFEConfigSaveFormPrefs(BaseSection, Self);
|
|
FFEConfigSaveDBColumnPrefs(BaseSection + '.ColumnInfo', grdTableBrowser.Columns);
|
|
FFEConfigSaveInteger(BaseSection, 'Table Timeout', FTable.Timeout); {!!.07}
|
|
FFEConfigSaveInteger(BaseSection, 'PageControl size', pcBlobfields.Height); {!!.07}
|
|
FFEConfigSaveBoolean(BaseSection, 'Show blob fields', mnuViewShowBLOBFields.Checked); {!!.07}
|
|
FFEConfigSaveBoolean(BaseSection, 'Show range', mnuViewShowRange.Checked); {!!.07}
|
|
FFEConfigSaveBoolean(BaseSection, 'Show filter', mnuViewShowFilter.Checked); {!!.07}
|
|
except
|
|
on E:Exception do
|
|
ShowMessage('Error writing INI file: '+E.Message);
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.LoadPreferences;
|
|
var
|
|
BaseSection : string;
|
|
Index : Integer;
|
|
s : String; {!!.11}
|
|
begin
|
|
BaseSection := ClassName + '.' + Self.Caption;
|
|
cboFilter.Text := FFEConfigGetString(BaseSection, 'Last Filter', '');
|
|
{Begin !!.11}
|
|
for Index := 0 to Pred(MaxFilterComboItems) do begin
|
|
s := FFEConfigGetString(BaseSection, 'FilterHistory'+IntToStr(Index), '');
|
|
if s<>'' then
|
|
cboFilter.Items.Add(s);
|
|
end;
|
|
{End !!.11}
|
|
Index := FFEConfigGetInteger(BaseSection, 'Last Index', 0);
|
|
if (Index < cboIndex.Items.Count) then begin
|
|
cboIndex.ItemIndex := Index;
|
|
FTable.IndexName := cboIndex.Items[cboIndex.ItemIndex];
|
|
{ Update the find controls }
|
|
cboIndexChange(nil);
|
|
end;
|
|
edtFind.Text := FFEConfigGetString(BaseSection, 'Last Find Nearest', '');
|
|
mnuViewShowRecordCount.Checked := FFEConfigGetBoolean(BaseSection, 'Show record count', True);
|
|
FFEConfigGetFormPrefs(BaseSection, Self);
|
|
FFEConfigGetDBColumnPrefs(BaseSection + '.ColumnInfo', grdTableBrowser.Columns);
|
|
FTable.Timeout := FFEConfigGetInteger(BaseSection, 'Table Timeout', -1); {!!.07}
|
|
pcBlobfields.Height := FFEConfigGetInteger(BaseSection, 'PageControl size', pcBlobfields.Height); {!!.07}
|
|
mnuViewShowBLOBFields.Checked := HasBlobOrByteArrayField and FFEConfigGetBoolean(BaseSection, 'Show blob fields', True); {!!.07}
|
|
if not HasBlobOrByteArrayField then
|
|
mnuViewShowBLOBFields.Enabled := False;
|
|
pcBlobfields.Visible := mnuViewShowBLOBFields.Checked and HasBlobOrByteArrayField;
|
|
splGridAndPageControl.Visible := mnuViewShowBLOBFields.Checked and HasBlobOrByteArrayField;
|
|
mnuViewShowRange.Checked := FFEConfigGetBoolean(BaseSection, 'Show range', True); {!!.07}
|
|
pnlRange.Visible := mnuViewShowRange.Checked;
|
|
mnuViewShowFilter.Checked := FFEConfigGetBoolean(BaseSection, 'Show filter', True); {!!.07}
|
|
pnlFilter.Visible := mnuViewShowFilter.Checked;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.mnuViewShowRecordCountClick(Sender: TObject);
|
|
begin
|
|
mnuViewShowRecordCount.Checked := not mnuViewShowRecordCount.Checked;
|
|
UpdateDisplay;
|
|
end;
|
|
|
|
procedure TdlgTable.mnuTableResetColClick(Sender: TObject);
|
|
begin
|
|
grdTableBrowser.Columns.RebuildColumns;
|
|
end;
|
|
|
|
procedure TdlgTable.grdTableBrowserKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
var
|
|
DoPost : Boolean; {!!.11}
|
|
begin
|
|
{ Delete record? }
|
|
if ((key = VK_DELETE) and
|
|
(shift = []) and
|
|
(dsTableBrowser.State = dsBrowse)) and
|
|
(not grdTableBrowser.ReadOnly) then
|
|
if (MessageDlg('Delete record?', mtConfirmation, mbOKCancel, 0) <> idCancel) then
|
|
dsTableBrowser.DataSet.Delete;
|
|
{Begin !!.11}
|
|
{ set field to NULL? }
|
|
if ((key = Ord('0')) and
|
|
(shift = [ssCtrl]) and
|
|
(not grdTableBrowser.ReadOnly) and
|
|
(not FTable.IsEmpty)) then begin
|
|
DoPost := not (FTable.State in [dsInsert, dsEdit]);
|
|
if DoPost then
|
|
FTable.Edit;
|
|
grdTableBrowser.SelectedField.Clear;
|
|
if DoPost then
|
|
FTable.Post;
|
|
{ refresh; could be blobfield }
|
|
ViewActiveBlobField;
|
|
end;
|
|
{End !!.11}
|
|
end;
|
|
{Begin !!.02}
|
|
{--------}
|
|
procedure TdlgTable.mnuOptionsDebugClick(Sender: TObject);
|
|
begin
|
|
mnuOptionsDebug.Checked := not mnuOptionsDebug.Checked;
|
|
if mnuOptionsDebug.Checked then
|
|
FTransport.EventLogOptions := [fftpLogErrors, fftpLogRequests,
|
|
fftpLogReplies]
|
|
else
|
|
FTransport.EventLogOptions := [fftpLogErrors];
|
|
end;
|
|
{End !!.02}
|
|
|
|
{Begin !!.07}
|
|
procedure TdlgTable.FTableAfterPost(DataSet: TDataSet);
|
|
begin
|
|
if FTable.Database.InTransaction then
|
|
FTable.Database.Commit;
|
|
UpdateDisplay;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.FTableAfterCancel(DataSet: TDataSet);
|
|
begin
|
|
if FTable.Database.InTransaction then
|
|
FTable.Database.Rollback;
|
|
FTable.Refresh;
|
|
ViewActiveBlobField;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.FTableAfterScroll(DataSet: TDataSet);
|
|
begin
|
|
ViewActiveBlobField;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.FTableBeforeEdit(DataSet: TDataSet);
|
|
begin
|
|
if not FTable.Database.InTransaction then
|
|
FTable.Database.StartTransaction;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.FTableBeforeInsert(DataSet: TDataSet);
|
|
begin
|
|
if not FTable.Database.InTransaction then
|
|
FTable.Database.StartTransaction;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.mnuOptionsTimeoutClick(Sender: TObject);
|
|
var
|
|
sTimeout : String;
|
|
res : Boolean;
|
|
begin
|
|
sTimeout := IntToStr(FTable.Timeout);
|
|
repeat
|
|
res := InputQuery('Table Timeout (ms)', 'Value:', sTimeout);
|
|
if res then
|
|
try
|
|
FTable.Timeout := StrToInt(sTimeout);
|
|
if FTable.Timeout<-1 then
|
|
raise EConvertError.Create('');
|
|
res := False;
|
|
except
|
|
on EConvertError do begin
|
|
MessageDlg('Value must be a number between -1 and '+IntToStr(MaxInt), mtError, [mbOK], 0);
|
|
end;
|
|
end;
|
|
until not res;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.FormKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
begin
|
|
if (not (FTable.State IN [dsInsert, dsEdit])) and
|
|
(Key = VK_ESCAPE) then
|
|
Close;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.ViewActiveBlobField;
|
|
const
|
|
JPEGHeader : array [0..10] of Char = (Chr($FF), Chr($D8), Chr($FF), Chr($E0),
|
|
Chr($0), Chr($10), 'J', 'F', 'I', 'F', Chr(0));
|
|
BMPHeader : array [0..1] of char = ('B', 'M');
|
|
WMFHeader : array [0..1] of char = ('B', 'M');
|
|
ICOHeader : array [0..1] of char = ('B', 'M');
|
|
HexChar : array [0..15] of char = '0123456789ABCDEF';
|
|
var
|
|
HeaderBuffer : array [0..10] of char;
|
|
Stream : TffBlobStream;
|
|
jpegImage : TJPEGImage;
|
|
i : Integer;
|
|
BlobBuffer : array [0..1024] of char;
|
|
ByteArrayBuffer : Pointer;
|
|
tempStr : String;
|
|
|
|
{ copied from TffEventLog.WriteBlock and transmogrified }
|
|
function GenerateHexLines(Buf : pointer; BufLen : TffMemSize) : String;
|
|
const
|
|
HexPos : array [0..15] of byte =
|
|
(1, 3, 5, 7, 10, 12, 14, 16, 19, 21, 23, 25, 28, 30, 32, 34);
|
|
var
|
|
B : PffByteArray absolute Buf;
|
|
ThisWidth,
|
|
i, j : integer;
|
|
Line : string[56];
|
|
Work : byte;
|
|
begin
|
|
Result := '';
|
|
if (BufLen = 0) or (Buf = nil) then
|
|
Exit
|
|
else begin
|
|
if (BufLen > 1024) then begin
|
|
BufLen := 1024;
|
|
end;
|
|
for i := 0 to ((BufLen-1) shr 4) do begin
|
|
FillChar(Line, 56, ' ');
|
|
Line[0] := #55;
|
|
Line[38] := '['; Line[55] := ']';
|
|
if (BufLen >= 16) then
|
|
ThisWidth := 16
|
|
else
|
|
ThisWidth := BufLen;
|
|
for j := 0 to ThisWidth-1 do begin
|
|
Work := B^[(i shl 4) + j];
|
|
Line[HexPos[j]] := HexChar[Work shr 4];
|
|
Line[HexPos[j]+1] := HexChar[Work and $F];
|
|
if (Work < 32) {or (Work >= $80)} then
|
|
Work := ord('.');
|
|
Line[39+j] := char(Work);
|
|
end;
|
|
Result := Result + Line + ffcCRLF;
|
|
dec(BufLen, ThisWidth);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ByteArrayToHexString(ByteArray : Pointer; ArrayLength : Integer) : String;
|
|
var
|
|
idx : Integer;
|
|
BArr : PffByteArray absolute ByteArray;
|
|
begin
|
|
Result := '';
|
|
for idx := 0 to ArrayLength-1 do begin
|
|
Result := Result + HexChar[BArr[idx] shr 4];
|
|
Result := Result + HexChar[BArr[idx] and $F];
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
{ load non-db blob controls }
|
|
if mnuViewShowBLOBFields.Checked and
|
|
HasBlobOrByteArrayField then begin
|
|
|
|
for i := 0 to FTable.Dictionary.FieldCount-1 do begin
|
|
{ only load blob on active tabsheet }
|
|
if Assigned(Pointer(FTable.Fields[i].Tag)) and
|
|
(FTable.Fields[i].FieldName=pcBlobfields.ActivePage.Caption) then
|
|
case FTable.Dictionary.FieldType[i] of
|
|
fftBLOBGraphic : begin
|
|
try
|
|
Stream := TffBlobStream(FTable.CreateBlobStream(FTable.Fields[i], bmRead));
|
|
try
|
|
TImage(FTable.Fields[i].Tag).Picture.Bitmap.Assign(NIL);
|
|
TImage(FTable.Fields[i].Tag).Invalidate;
|
|
// if Stream.Size>0 then
|
|
{ data in stream? }
|
|
if (Stream.Read(HeaderBuffer, 11)=11) then
|
|
{ jpg? }
|
|
if CompareMem(@jpegHeader, @HeaderBuffer, 11) then begin
|
|
Stream.Position := 0;
|
|
jpegImage := TJPEGImage.Create;
|
|
try
|
|
jpegImage.LoadFromStream(stream);
|
|
TImage(FTable.Fields[i].Tag).Picture.Bitmap.Assign(jpegImage);
|
|
finally
|
|
jpegImage.Free;
|
|
end;
|
|
end
|
|
else
|
|
{bmp?}
|
|
if CompareMem(@BMPHeader, @HeaderBuffer, 2) or
|
|
CompareMem(@BMPHeader, @HeaderBuffer[8], 2) then begin
|
|
if CompareMem(@BMPHeader, @HeaderBuffer, 2) then
|
|
Stream.Position := 0
|
|
else
|
|
Stream.Position := 8;
|
|
TImage(FTable.Fields[i].Tag).Picture.Bitmap.LoadFromStream(stream);
|
|
end
|
|
else begin
|
|
{metafile?}
|
|
{ it's difficult to check for the metafile type. we just
|
|
attempt to load and let the TImage component find out. }
|
|
Stream.Position := 8;
|
|
try
|
|
TImage(FTable.Fields[i].Tag).Picture.Metafile.LoadFromStream(stream);
|
|
except
|
|
on EInvalidGraphic do begin
|
|
Stream.Position := 0;
|
|
try
|
|
TImage(FTable.Fields[i].Tag).Picture.Metafile.LoadFromStream(stream);
|
|
except
|
|
on EInvalidGraphic do begin
|
|
{icon?}
|
|
{ it's difficult to check for the icon type. we just
|
|
attempt to load and let the TImage component find out. }
|
|
Stream.Position := 8;
|
|
try
|
|
TImage(FTable.Fields[i].Tag).Picture.Icon.LoadFromStream(stream);
|
|
except
|
|
on EInvalidGraphic do begin
|
|
Stream.Position := 0;
|
|
try
|
|
TImage(FTable.Fields[i].Tag).Picture.Icon.LoadFromStream(stream);
|
|
except
|
|
on EInvalidGraphic do
|
|
else
|
|
raise;
|
|
end;
|
|
end
|
|
else
|
|
raise;
|
|
end;
|
|
end
|
|
else
|
|
raise;
|
|
end;
|
|
end
|
|
else
|
|
raise;
|
|
end;
|
|
end;
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
except
|
|
on E:Exception do begin
|
|
ShowMessage('Exception: '+E.Message+' decoding graphic field: '+FTable.Fields[i].FieldName);
|
|
end;
|
|
end;
|
|
end;
|
|
fftByteArray : begin
|
|
with TMaskEdit(FTable.Fields[i].Tag) do begin
|
|
Text := '';
|
|
MaxLength := FTable.Fields[i].Size*2;
|
|
SetLength(tempStr, MaxLength);
|
|
FillChar(tempStr[1], MaxLength, 'a');
|
|
EditMask := tempStr + ';0;_';
|
|
GetMem(ByteArrayBuffer, FTable.Fields[i].DataSize);
|
|
try
|
|
if FTable.Fields[i].GetData(ByteArrayBuffer) then
|
|
Text := ByteArrayToHexString(ByteArrayBuffer, FTable.Fields[i].DataSize);
|
|
finally
|
|
FreeMem(ByteArrayBuffer);
|
|
end;
|
|
end;
|
|
end;
|
|
fftBLOB,
|
|
fftBLOBOLEObj,
|
|
fftBLOBDBSOLEObj,
|
|
fftBLOBTypedBin,
|
|
fftBLOBFile : begin
|
|
try
|
|
Stream := TffBlobStream(FTable.CreateBlobStream(FTable.Fields[i], bmRead));
|
|
try
|
|
TMemo(FTable.Fields[i].Tag).Text := '';
|
|
Stream.Read(BlobBuffer, FFMinL(1024, Stream.Size));
|
|
TMemo(FTable.Fields[i].Tag).Text :=
|
|
GenerateHexLines(@BlobBuffer, FFMinL(1024, Stream.Size));
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
except
|
|
on E:Exception do begin
|
|
ShowMessage('Exception: '+E.Message+' when displaying blob field: '+FTable.Fields[i].FieldName);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
{--------}
|
|
function TdlgTable.HasBlobOrByteArrayField: Boolean;
|
|
var
|
|
i : Integer;
|
|
begin
|
|
Result := False;
|
|
for i := 0 to FTable.Dictionary.FieldCount-1 do
|
|
if FTable.Dictionary.FieldType[i] IN [fftBLOB..ffcLastBLOBType, fftByteArray] then begin
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.cbStretchClick(Sender: TObject);
|
|
var
|
|
i : Integer;
|
|
begin
|
|
for i := 0 to TCheckBox(Sender).Parent.ControlCount-1 do
|
|
if TCheckBox(Sender).Parent.Controls[i] IS TImage then begin
|
|
TImage(TCheckBox(Sender).Parent.Controls[i]).Stretch := TCheckBox(Sender).Checked;
|
|
Exit;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.btnClearBAClick(Sender: TObject);
|
|
var
|
|
fieldIdx,
|
|
controlIdx : Integer;
|
|
aEdit : TMaskEdit;
|
|
aField : TField;
|
|
begin
|
|
{ find edit control }
|
|
for controlIdx := 0 to TButton(Sender).Parent.ControlCount-1 do
|
|
if TButton(Sender).Parent.Controls[controlIdx] IS TMaskEdit then begin
|
|
aEdit := TMaskEdit(TButton(Sender).Parent.Controls[controlIdx]);
|
|
{ find correct field }
|
|
for fieldIdx := 0 to FTable.Dictionary.FieldCount-1 do begin
|
|
if Pointer(FTable.Fields[fieldIdx].Tag)=aEdit then begin
|
|
aField := FTable.Fields[fieldIdx];
|
|
if not (FTable.State in [dsInsert, dsEdit]) then
|
|
FTable.Edit;
|
|
aField.Clear;
|
|
aEdit.Text := '';
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.pcBlobfieldsChange(Sender: TObject);
|
|
begin
|
|
ViewActiveBlobField;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.mnuViewShowBLOBFieldsClick(Sender: TObject);
|
|
begin
|
|
mnuViewShowBLOBFields.Checked := not mnuViewShowBLOBFields.Checked;
|
|
pcBlobfields.Visible := mnuViewShowBLOBFields.Checked;
|
|
splGridAndPageControl.Visible := mnuViewShowBLOBFields.Checked;
|
|
if mnuViewShowBLOBFields.Checked then
|
|
ViewActiveBlobField;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.btnLoadMemoClick(Sender: TObject);
|
|
var
|
|
fieldIdx,
|
|
controlIdx : Integer;
|
|
adbMemo : TdbMemo;
|
|
aField : TField;
|
|
begin
|
|
if opendialog.Execute then
|
|
{ find dbmemo control }
|
|
for controlIdx := 0 to TButton(Sender).Parent.ControlCount-1 do
|
|
if TButton(Sender).Parent.Controls[controlIdx] IS TdbMemo then begin
|
|
adbMemo := TdbMemo(TButton(Sender).Parent.Controls[controlIdx]);
|
|
{ find correct field }
|
|
for fieldIdx := 0 to FTable.Dictionary.FieldCount-1 do begin
|
|
if Pointer(FTable.Fields[fieldIdx].Tag)=adbMemo then begin
|
|
aField := FTable.Fields[fieldIdx];
|
|
if not (FTable.State in [dsInsert, dsEdit]) then
|
|
FTable.Edit;
|
|
TMemoField(aField).LoadFromFile(opendialog.FileName);
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.btnSaveMemoClick(Sender: TObject);
|
|
var
|
|
fieldIdx,
|
|
controlIdx : Integer;
|
|
adbMemo : TdbMemo;
|
|
aField : TField;
|
|
begin
|
|
if savedialog.Execute then
|
|
{ find dbmemo control }
|
|
for controlIdx := 0 to TButton(Sender).Parent.ControlCount-1 do
|
|
if TButton(Sender).Parent.Controls[controlIdx] IS TdbMemo then begin
|
|
adbMemo := TdbMemo(TButton(Sender).Parent.Controls[controlIdx]);
|
|
{ find correct field }
|
|
for fieldIdx := 0 to FTable.Dictionary.FieldCount-1 do begin
|
|
if Pointer(FTable.Fields[fieldIdx].Tag)=adbMemo then begin
|
|
aField := FTable.Fields[fieldIdx];
|
|
TMemoField(aField).SaveToFile(savedialog.FileName);
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.btnLoadGenericClick(Sender: TObject);
|
|
var
|
|
fieldIdx,
|
|
controlIdx : Integer;
|
|
aMemo : TMemo;
|
|
aField : TField;
|
|
begin
|
|
if opendialog.Execute then
|
|
{ find memo control }
|
|
for controlIdx := 0 to TButton(Sender).Parent.ControlCount-1 do
|
|
if TButton(Sender).Parent.Controls[controlIdx] IS TMemo then begin
|
|
aMemo := TMemo(TButton(Sender).Parent.Controls[controlIdx]);
|
|
{ find correct field }
|
|
for fieldIdx := 0 to FTable.Dictionary.FieldCount-1 do begin
|
|
if Pointer(FTable.Fields[fieldIdx].Tag)=aMemo then begin
|
|
aField := FTable.Fields[fieldIdx];
|
|
if not (FTable.State in [dsInsert, dsEdit]) then
|
|
FTable.Edit;
|
|
TBlobField(aField).LoadFromFile(opendialog.FileName);
|
|
ViewActiveBlobField;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.btnSaveGenericClick(Sender: TObject);
|
|
var
|
|
fieldIdx,
|
|
controlIdx : Integer;
|
|
aMemo : TMemo;
|
|
aField : TField;
|
|
begin
|
|
if savedialog.Execute then
|
|
{ find memo control }
|
|
for controlIdx := 0 to TButton(Sender).Parent.ControlCount-1 do
|
|
if TButton(Sender).Parent.Controls[controlIdx] IS TMemo then begin
|
|
aMemo := TMemo(TButton(Sender).Parent.Controls[controlIdx]);
|
|
{ find correct field }
|
|
for fieldIdx := 0 to FTable.Dictionary.FieldCount-1 do begin
|
|
if Pointer(FTable.Fields[fieldIdx].Tag)=aMemo then begin
|
|
aField := FTable.Fields[fieldIdx];
|
|
TBlobField(aField).SaveToFile(savedialog.FileName);
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.btnClearMemoClick(Sender: TObject);
|
|
var
|
|
fieldIdx,
|
|
controlIdx : Integer;
|
|
adbMemo : TdbMemo;
|
|
aField : TField;
|
|
begin
|
|
{ find dbmemo control }
|
|
for controlIdx := 0 to TButton(Sender).Parent.ControlCount-1 do
|
|
if TButton(Sender).Parent.Controls[controlIdx] IS TdbMemo then begin
|
|
adbMemo := TdbMemo(TButton(Sender).Parent.Controls[controlIdx]);
|
|
{ find correct field }
|
|
for fieldIdx := 0 to FTable.Dictionary.FieldCount-1 do begin
|
|
if Pointer(FTable.Fields[fieldIdx].Tag)=adbMemo then begin
|
|
aField := FTable.Fields[fieldIdx];
|
|
if not (FTable.State in [dsInsert, dsEdit]) then
|
|
FTable.Edit;
|
|
aField.Clear;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.btnLoadGraphicClick(Sender: TObject);
|
|
var
|
|
fieldIdx,
|
|
controlIdx : Integer;
|
|
aImage : TImage;
|
|
aField : TField;
|
|
begin
|
|
if opendialog.Execute then
|
|
{ find Image control }
|
|
for controlIdx := 0 to TButton(Sender).Parent.ControlCount-1 do
|
|
if TButton(Sender).Parent.Controls[controlIdx] IS TImage then begin
|
|
aImage := TImage(TButton(Sender).Parent.Controls[controlIdx]);
|
|
{ find correct field }
|
|
for fieldIdx := 0 to FTable.Dictionary.FieldCount-1 do begin
|
|
if Pointer(FTable.Fields[fieldIdx].Tag)=aImage then begin
|
|
aField := FTable.Fields[fieldIdx];
|
|
if not (FTable.State in [dsInsert, dsEdit]) then
|
|
FTable.Edit;
|
|
TBlobField(aField).LoadFromFile(opendialog.FileName);
|
|
ViewActiveBlobField;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.btnSaveGraphicClick(Sender: TObject);
|
|
var
|
|
fieldIdx,
|
|
controlIdx : Integer;
|
|
aImage : TImage;
|
|
aField : TField;
|
|
begin
|
|
if savedialog.Execute then
|
|
{ find Image control }
|
|
for controlIdx := 0 to TButton(Sender).Parent.ControlCount-1 do
|
|
if TButton(Sender).Parent.Controls[controlIdx] IS TImage then begin
|
|
aImage := TImage(TButton(Sender).Parent.Controls[controlIdx]);
|
|
{ find correct field }
|
|
for fieldIdx := 0 to FTable.Dictionary.FieldCount-1 do begin
|
|
if Pointer(FTable.Fields[fieldIdx].Tag)=aImage then begin
|
|
aField := FTable.Fields[fieldIdx];
|
|
TBlobField(aField).SaveToFile(savedialog.FileName);
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.btnClearGraphicClick(Sender: TObject);
|
|
var
|
|
fieldIdx,
|
|
controlIdx : Integer;
|
|
aImage : TImage;
|
|
aField : TField;
|
|
begin
|
|
{ find image control }
|
|
for controlIdx := 0 to TButton(Sender).Parent.ControlCount-1 do
|
|
if TButton(Sender).Parent.Controls[controlIdx] IS TImage then begin
|
|
aImage := TImage(TButton(Sender).Parent.Controls[controlIdx]);
|
|
{ find correct field }
|
|
for fieldIdx := 0 to FTable.Dictionary.FieldCount-1 do begin
|
|
if Pointer(FTable.Fields[fieldIdx].Tag)=aImage then begin
|
|
aField := FTable.Fields[fieldIdx];
|
|
if not (FTable.State in [dsInsert, dsEdit]) then
|
|
FTable.Edit;
|
|
TGraphicField(aField).Clear;
|
|
ViewActiveBlobField;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TdlgTable.btnClearGenericClick(Sender: TObject);
|
|
var
|
|
fieldIdx,
|
|
controlIdx : Integer;
|
|
aMemo : TMemo;
|
|
aField : TField;
|
|
begin
|
|
{ find memo control }
|
|
for controlIdx := 0 to TButton(Sender).Parent.ControlCount-1 do
|
|
if TButton(Sender).Parent.Controls[controlIdx] IS TMemo then begin
|
|
aMemo := TMemo(TButton(Sender).Parent.Controls[controlIdx]);
|
|
{ find correct field }
|
|
for fieldIdx := 0 to FTable.Dictionary.FieldCount-1 do begin
|
|
if Pointer(FTable.Fields[fieldIdx].Tag)=aMemo then begin
|
|
aField := FTable.Fields[fieldIdx];
|
|
if not (FTable.State in [dsInsert, dsEdit]) then
|
|
FTable.Edit;
|
|
aField.Clear;
|
|
ViewActiveBlobField;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdlgTable.meByteArrayKeyPress(Sender: TObject; var Key: Char);
|
|
begin
|
|
if not (Key IN [#8, #9, #27, '0'..'9', 'A'..'F', 'a'..'f']) then
|
|
Key := #0
|
|
else
|
|
BAKeyPressDetected := True;
|
|
end;
|
|
|
|
procedure TdlgTable.mnuTablePrintPreviewClick(Sender: TObject);
|
|
var
|
|
Filter,
|
|
DatabaseName,
|
|
IndexName : Array[0..1024] of Char;
|
|
i : Integer;
|
|
RangeStart,
|
|
RangeEnd : TRangeFieldValues;
|
|
begin
|
|
StrPCopy(DatabaseName, FDatabaseName);
|
|
if FTable.Filtered then begin
|
|
StrPCopy(Filter, FTable.Filter);
|
|
end
|
|
else
|
|
StrCopy(Filter, '');
|
|
StrPCopy(IndexName, FTable.IndexName);
|
|
{ initialize }
|
|
for i := 0 to ffcl_MaxIndexFlds-1 do begin
|
|
RangeStart[i] := NULL;
|
|
RangeEnd[i] := NULL;
|
|
end;
|
|
if InRange then begin
|
|
FTable.EditRangeStart;
|
|
for i := 0 to FTable.IndexFieldCount-1 do
|
|
RangeStart[i] := FTable.IndexFields[i].Value;
|
|
FTable.Cancel;
|
|
FTable.EditRangeEnd;
|
|
for i := 0 to FTable.IndexFieldCount-1 do
|
|
RangeEnd[i] := FTable.IndexFields[i].Value;
|
|
FTable.Cancel;
|
|
end;
|
|
SingleTableReport(FProtocol,
|
|
FServerName,
|
|
FUserName,
|
|
FPassword,
|
|
DatabaseName,
|
|
FTableName,
|
|
Filter,
|
|
IndexName,
|
|
RangeStart,
|
|
RangeEnd);
|
|
end;
|
|
|
|
procedure TdlgTable.mnuTableDesignReportClick(Sender: TObject);
|
|
var
|
|
DatabaseName : Array[0..1024] of Char;
|
|
begin
|
|
StrPCopy(DatabaseName, FDatabaseName);
|
|
DesignReport(FProtocol,
|
|
FServerName,
|
|
FUserName,
|
|
FPassword,
|
|
DatabaseName);
|
|
end;
|
|
|
|
|
|
{ magic resize numbers: 100 = width of buttons + 8 pixels of space on each side }
|
|
procedure TdlgTable.tsMemoTemplateResize(Sender: TObject);
|
|
var
|
|
controlIdx : Integer;
|
|
begin
|
|
for controlIdx := 0 to TTabSheet(Sender).ControlCount-1 do
|
|
if TTabSheet(Sender).Controls[controlIdx] IS TdbMemo then begin
|
|
TdbMemo(TTabSheet(Sender).Controls[controlIdx]).SetBounds(0, 0, TTabSheet(Sender).Width-116, TTabSheet(Sender).Height);
|
|
end
|
|
else
|
|
if TTabSheet(Sender).Controls[controlIdx] IS TButton then begin
|
|
TButton(TTabSheet(Sender).Controls[controlIdx]).Left := TTabSheet(Sender).Width-108;
|
|
end
|
|
else
|
|
if TTabSheet(Sender).Controls[controlIdx] IS TCheckBox then begin
|
|
TCheckBox(TTabSheet(Sender).Controls[controlIdx]).Left := TTabSheet(Sender).Width-108;
|
|
end;
|
|
end;
|
|
|
|
procedure TdlgTable.tsGraphicTemplateResize(Sender: TObject);
|
|
var
|
|
controlIdx : Integer;
|
|
begin
|
|
for controlIdx := 0 to TTabSheet(Sender).ControlCount-1 do
|
|
if TTabSheet(Sender).Controls[controlIdx] IS TImage then begin
|
|
TImage(TTabSheet(Sender).Controls[controlIdx]).SetBounds(0, 0, TTabSheet(Sender).Width-116, TTabSheet(Sender).Height);
|
|
end
|
|
else
|
|
if TTabSheet(Sender).Controls[controlIdx] IS TButton then begin
|
|
TButton(TTabSheet(Sender).Controls[controlIdx]).Left := TTabSheet(Sender).Width-108;
|
|
end
|
|
else
|
|
if TTabSheet(Sender).Controls[controlIdx] IS TCheckBox then begin
|
|
TCheckBox(TTabSheet(Sender).Controls[controlIdx]).Left := TTabSheet(Sender).Width-108;
|
|
end;
|
|
end;
|
|
|
|
procedure TdlgTable.tsGenericBlobTemplateResize(Sender: TObject);
|
|
var
|
|
controlIdx : Integer;
|
|
begin
|
|
for controlIdx := 0 to TTabSheet(Sender).ControlCount-1 do
|
|
if TTabSheet(Sender).Controls[controlIdx] IS TMemo then begin
|
|
TMemo(TTabSheet(Sender).Controls[controlIdx]).SetBounds(0, 0, TTabSheet(Sender).Width-116, TTabSheet(Sender).Height);
|
|
end
|
|
else
|
|
if TTabSheet(Sender).Controls[controlIdx] IS TButton then begin
|
|
TButton(TTabSheet(Sender).Controls[controlIdx]).Left := TTabSheet(Sender).Width-108;
|
|
end;
|
|
end;
|
|
|
|
procedure TdlgTable.tsByteArrayTemplateResize(Sender: TObject);
|
|
var
|
|
controlIdx : Integer;
|
|
begin
|
|
for controlIdx := 0 to TTabSheet(Sender).ControlCount-1 do
|
|
if TTabSheet(Sender).Controls[controlIdx] IS TMaskEdit then begin
|
|
TMaskEdit(TTabSheet(Sender).Controls[controlIdx]).Width := TTabSheet(Sender).Width-2*TMaskEdit(TTabSheet(Sender).Controls[controlIdx]).Left;
|
|
end
|
|
else
|
|
if TTabSheet(Sender).Controls[controlIdx] IS TLabel then begin
|
|
TLabel(TTabSheet(Sender).Controls[controlIdx]).Width := TTabSheet(Sender).Width-2*TLabel(TTabSheet(Sender).Controls[controlIdx]).Left;
|
|
end
|
|
else
|
|
{ this button is 75 pixels wide }
|
|
if TTabSheet(Sender).Controls[controlIdx] IS TButton then begin
|
|
if TButton(TTabSheet(Sender).Controls[controlIdx]).Caption='Clear' then
|
|
TButton(TTabSheet(Sender).Controls[controlIdx]).Left := TTabSheet(Sender).Width-83;
|
|
end;
|
|
end;
|
|
|
|
procedure TdlgTable.btnSetClearRangeClick(Sender: TObject);
|
|
var
|
|
NeedEdit : Boolean;
|
|
FieldIdx : Integer;
|
|
begin
|
|
if not InRange then begin
|
|
{ check wether we have a useable range (not all NULL) }
|
|
NeedEdit := True;
|
|
for FieldIdx := Low(FRangeValues.Field) to FTable.IndexFieldCount do
|
|
if (not FRangeValues.Field[FieldIdx].StartNull) or
|
|
(not FRangeValues.Field[FieldIdx].EndNull) then begin
|
|
NeedEdit := False;
|
|
Break;
|
|
end;
|
|
if NeedEdit then
|
|
btnEditRangeClick(Self)
|
|
else
|
|
SetRange;
|
|
end
|
|
else begin
|
|
btnSetClearRange.Caption := 'Set &Range';
|
|
FTable.CancelRange;
|
|
InRange := False;
|
|
UpdateDisplay;
|
|
end;
|
|
end;
|
|
|
|
procedure TdlgTable.btnEditRangeClick(Sender: TObject);
|
|
var
|
|
BaseSection : string;
|
|
Index : Integer;
|
|
begin
|
|
if SetRangeDlg(FTable, FRangeValues)=mrOK then begin
|
|
SetRange;
|
|
GenerateRangeDisplayStrings;
|
|
BaseSection := ClassName + '.' + Self.Caption;
|
|
for Index := Low(FRangeValues.Field) to FTable.IndexFieldCount do begin
|
|
FFEConfigSaveBoolean(BaseSection, FTable.IndexName+'_RangeStartNull'+IntToStr(Index), FRangeValues.Field[Index].StartNull);
|
|
FFEConfigSaveBoolean(BaseSection, FTable.IndexName+'_RangeEndNull'+IntToStr(Index), FRangeValues.Field[Index].EndNull);
|
|
FFEConfigSaveString(BaseSection, FTable.IndexName+'_RangeStartValue'+IntToStr(Index), FRangeValues.Field[Index].StartValue);
|
|
FFEConfigSaveString(BaseSection, FTable.IndexName+'_RangeEndValue'+IntToStr(Index), FRangeValues.Field[Index].EndValue);
|
|
end;
|
|
FFEConfigSaveBoolean(BaseSection, FTable.IndexName+'_RangeStartKeyExclusive', FRangeValues.RangeStartKeyExclusive);
|
|
FFEConfigSaveBoolean(BaseSection, FTable.IndexName+'_RangeEndKeyExclusive', FRangeValues.RangeEndKeyExclusive);
|
|
end;
|
|
end;
|
|
|
|
procedure TdlgTable.mnuViewShowRangeClick(Sender: TObject);
|
|
var
|
|
FilterFix : Boolean;
|
|
begin
|
|
{ necessary to get rangepanel to reappear below filterpanel }
|
|
FilterFix := pnlFilter.Visible and not pnlRange.Visible;
|
|
if FilterFix then
|
|
pnlFilter.Visible := False;
|
|
mnuViewShowRange.Checked := not mnuViewShowRange.Checked;
|
|
pnlRange.Visible := mnuViewShowRange.Checked;
|
|
{ remove range and update display etc }
|
|
if InRange then
|
|
btnSetClearRangeClick(Self);
|
|
if FilterFix then
|
|
pnlFilter.Visible := True;
|
|
end;
|
|
|
|
procedure TdlgTable.FormResize(Sender: TObject);
|
|
begin
|
|
btnFindNear.Left := ClientWidth - btnFindNear.Width - 8;
|
|
edtFind.Width := btnFindNear.Left - edtFind.Left - 8;
|
|
btnSetFilter.Left := ClientWidth - btnSetFilter.Width - 8;
|
|
cboFilter.Width := btnSetFilter.Left - cboFilter.Left - 8;
|
|
btnSetClearRange.Left := ClientWidth - btnSetClearRange.Width - 8;
|
|
laRangeStart.Width := btnSetClearRange.Left - laRangeStart.Left - 8;
|
|
btnEditRange.Left := ClientWidth - btnEditRange.Width - 8;
|
|
laRangeEnd.Width := btnEditRange.Left - laRangeEnd.Left - 8;
|
|
end;
|
|
|
|
procedure TdlgTable.GenerateRangeDisplayStrings;
|
|
var
|
|
HighestNonNullIdx,
|
|
FieldIdx : Integer;
|
|
FirstField : Boolean;
|
|
begin
|
|
HighestNonNullIdx := FTable.IndexFieldCount;
|
|
while (HighestNonNullIdx>1) and
|
|
FRangeValues.Field[HighestNonNullIdx].StartNull and
|
|
FRangeValues.Field[HighestNonNullIdx].EndNull do
|
|
Dec(HighestNonNullIdx);
|
|
laRangeStart.Caption := '[';
|
|
FirstField := True;
|
|
for FieldIdx := Low(FRangeValues.Field) to HighestNonNullIdx do begin
|
|
if not FirstField then laRangeStart.Caption := laRangeStart.Caption + ', ';
|
|
if FRangeValues.Field[FieldIdx].StartNull then
|
|
laRangeStart.Caption := laRangeStart.Caption + 'NULL'
|
|
else
|
|
if FRangeValues.Field[FieldIdx].StartValue<>'' then
|
|
laRangeStart.Caption := laRangeStart.Caption + FRangeValues.Field[FieldIdx].StartValue
|
|
else
|
|
laRangeStart.Caption := laRangeStart.Caption + '''''';
|
|
FirstField := False;
|
|
end;
|
|
laRangeStart.Caption := laRangeStart.Caption + ']';
|
|
if FRangeValues.RangeStartKeyExclusive then
|
|
laRangeStart.Caption := laRangeStart.Caption + ' - [KeyExclusive]';
|
|
laRangeEnd.Caption := '[';
|
|
FirstField := True;
|
|
for FieldIdx := Low(FRangeValues.Field) to HighestNonNullIdx do begin
|
|
if not FirstField then laRangeEnd.Caption := laRangeEnd.Caption + ', ';
|
|
if FRangeValues.Field[FieldIdx].EndNull then
|
|
laRangeEnd.Caption := laRangeEnd.Caption + 'NULL'
|
|
else
|
|
if FRangeValues.Field[FieldIdx].EndValue<>'' then
|
|
laRangeEnd.Caption := laRangeEnd.Caption + FRangeValues.Field[FieldIdx].EndValue
|
|
else
|
|
laRangeEnd.Caption := laRangeEnd.Caption + '''''';
|
|
FirstField := False;
|
|
end;
|
|
laRangeEnd.Caption := laRangeEnd.Caption + ']';
|
|
if FRangeValues.RangeEndKeyExclusive then
|
|
laRangeEnd.Caption := laRangeEnd.Caption + ' - [KeyExclusive]';
|
|
end;
|
|
|
|
procedure TdlgTable.SetRange;
|
|
var
|
|
HighestNonNullIdx,
|
|
FieldIdx : Integer;
|
|
begin
|
|
HighestNonNullIdx := 0;
|
|
FTable.SetRangeStart;
|
|
FTable.KeyExclusive := FRangeValues.RangeStartKeyExclusive;
|
|
for FieldIdx := Low(FRangeValues.Field) to FTable.IndexFieldCount do begin
|
|
if not FRangeValues.Field[FieldIdx].StartNull then begin
|
|
FTable.IndexFields[FieldIdx-1].AsString := FRangeValues.Field[FieldIdx].StartValue;
|
|
HighestNonNullIdx := FFMaxL(HighestNonNullIdx, FieldIdx);
|
|
end
|
|
else
|
|
if not FRangeValues.Field[FieldIdx].EndNull then
|
|
FTable.IndexFields[FieldIdx-1].Value := NULL;
|
|
end;
|
|
FTable.SetRangeEnd;
|
|
FTable.KeyExclusive := FRangeValues.RangeEndKeyExclusive;
|
|
for FieldIdx := Low(FRangeValues.Field) to FTable.IndexFieldCount do begin
|
|
if not FRangeValues.Field[FieldIdx].EndNull then begin
|
|
FTable.IndexFields[FieldIdx-1].AsString := FRangeValues.Field[FieldIdx].EndValue;
|
|
HighestNonNullIdx := FFMaxL(HighestNonNullIdx, FieldIdx);
|
|
end
|
|
else
|
|
if not FRangeValues.Field[FieldIdx].StartNull then
|
|
FTable.IndexFields[FieldIdx-1].Value := NULL;
|
|
end;
|
|
FTable.KeyFieldCount := HighestNonNullIdx;
|
|
FTable.ApplyRange;
|
|
InRange := True;
|
|
btnSetClearRange.Caption := 'Clear &Range';
|
|
UpdateDisplay;
|
|
end;
|
|
|
|
procedure TdlgTable.meByteArrayChange(Sender: TObject);
|
|
var
|
|
ByteArrayBuffer : Pointer;
|
|
fieldIdx,
|
|
controlIdx : Integer;
|
|
aEdit : TMaskEdit;
|
|
aField : TField;
|
|
|
|
procedure HexStringToByteArray(ByteArray : Pointer; ArrayLength : Integer; S : String);
|
|
var
|
|
idx : Integer;
|
|
BArr : PffByteArray absolute ByteArray;
|
|
begin
|
|
for idx := 0 to ArrayLength-1 do begin
|
|
if Odd(Length(S)) then
|
|
S := S + '0';
|
|
if Length(S)>1 then begin
|
|
try
|
|
BArr[idx] := StrToInt('$'+Copy(S, 1, 2));
|
|
except
|
|
on EConvertError do begin
|
|
MessageDlg('Invalid character encountered - use only hex digits 0..9, A..F!', mtError, [mbOK], 0);
|
|
Abort;
|
|
end;
|
|
end;
|
|
Delete(S, 1, 2);
|
|
end
|
|
else begin
|
|
BArr[idx] := 0;
|
|
BArr[idx] := 0;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if not BAKeyPressDetected then
|
|
Exit
|
|
else
|
|
BAKeyPressDetected := False;
|
|
FTable.Edit;
|
|
{ find edit control }
|
|
for controlIdx := 0 to TButton(Sender).Parent.ControlCount-1 do
|
|
if TButton(Sender).Parent.Controls[controlIdx] IS TMaskEdit then begin
|
|
aEdit := TMaskEdit(TButton(Sender).Parent.Controls[controlIdx]);
|
|
if aEdit.Text='' then
|
|
Exit;
|
|
{ find correct field }
|
|
for fieldIdx := 0 to FTable.Dictionary.FieldCount-1 do begin
|
|
if Pointer(FTable.Fields[fieldIdx].Tag)=aEdit then begin
|
|
aField := FTable.Fields[fieldIdx];
|
|
if not (FTable.State in [dsInsert, dsEdit]) then
|
|
FTable.Edit;
|
|
GetMem(ByteArrayBuffer, aField.Size);
|
|
try
|
|
HexStringToByteArray(ByteArrayBuffer, aField.Size, aEdit.Text);
|
|
aField.SetData(ByteArrayBuffer);
|
|
finally
|
|
FreeMem(ByteArrayBuffer);
|
|
end;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdlgTable.cbWordwrapClick(Sender: TObject);
|
|
var
|
|
i : Integer;
|
|
begin
|
|
for i := 0 to TCheckBox(Sender).Parent.ControlCount-1 do
|
|
if TCheckBox(Sender).Parent.Controls[i] IS TdbMemo then begin
|
|
with TdbMemo(TCheckBox(Sender).Parent.Controls[i]) do begin
|
|
WordWrap := TCheckBox(Sender).Checked;
|
|
if WordWrap then
|
|
ScrollBars := ssVertical
|
|
else
|
|
ScrollBars := ssBoth;
|
|
end;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
procedure TdlgTable.mnuTableCopyToTableClick(Sender: TObject);
|
|
var
|
|
ExcludeIndex,
|
|
TableIndex: LongInt;
|
|
CopyBlobs : Boolean;
|
|
SaveTimeout : Integer;
|
|
begin
|
|
ExcludeIndex := TableItem.Database.IndexOf(TableItem);
|
|
if ShowCopyTableDlg(TableItem.Database, ExcludeIndex, FTable,
|
|
TableIndex, CopyBlobs, FTableItem) = mrOK then begin {!!.11}
|
|
with TableItem.Database.Tables[TableIndex] do begin
|
|
Screen.Cursor := crHourGlass;
|
|
{ the copy operation is used in the context of the table
|
|
that's being copied to. Use the timeout of the active
|
|
table, otherwise the user has no way of setting timeout. }
|
|
SaveTimeout := Table.Timeout;
|
|
Table.Timeout := FTable.Timeout;
|
|
try
|
|
Update;
|
|
CopyRecords(FTable, CopyBlobs);
|
|
finally
|
|
Screen.Cursor := crDefault;
|
|
Table.Timeout := SaveTimeout;
|
|
{ force the second table to close if it wasn't open before }
|
|
FSession.CloseInactiveTables; {!!.11}
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdlgTable.mnuTableDeleteRecordsClick(Sender: TObject);
|
|
begin
|
|
if MessageDlg('Delete all records matching the current filter and range - are you sure?', mtConfirmation, [mbYes,mbNo], 0)= mrYes then begin
|
|
Screen.Cursor := crHourGlass;
|
|
try
|
|
Update;
|
|
FTable.DeleteRecords;
|
|
finally
|
|
Screen.Cursor := crDefault;
|
|
end;
|
|
end;
|
|
end;
|
|
{End !!.07}
|
|
|
|
procedure TdlgTable.UpdateDefaultTimeout;
|
|
begin
|
|
FClient.TimeOut := Config.DefaultTimeout; {!!.11}
|
|
end;
|
|
|
|
end.
|
|
|