Chip 2001 December/Chip_2001-12_cd1.bin/zkuste/delphi/kolekce/d3456/ALEXSOFT.ZIP/DBINSERT.PAS

Pascal/Delphi Source File | 2001-09-29 | 7.5 KB | 245 lines

(*////////////////////////////////////////////////////////////////////////////
//   Part of AlexSoft VCL/DLL Library.                                      //
//   All rights reserved. (c) Copyright 1998.                               //
//   Created by: Alex Rabichooc                                             //
//**************************************************************************//
//  Users of this unit must accept this disclaimer of warranty:             //
//    "This unit is supplied as is. The author disclaims all warranties,    //
//    expressed or implied, including, without limitation, the warranties   //
//    of merchantability and of fitness for any purpose.                    //
//    The author assumes no liability for damages, direct or                //
//    consequential, which may result from the use of this unit."           //
//                                                                          //
//  This Unit is donated to the public as public domain.                    //
//                                                                          //
//  This Unit can be freely used and distributed in commercial and          //
//  private environments provided this notice is not modified in any way.   //
//                                                                          //
//  If you do find this Unit handy and you feel guilty for using such a     //
//  great product without paying someone - sorry :-)                        //
//                                                                          //
//  Please forward any comments or suggestions to Alex Rabichooc at:        //
//                                                                          //
//  [e-mail] or [e-mail]                         //
/////////////////////////////////////////////////////////////////////////////*)

{---------------------------------------------------------------------------
  TRaDBInsert - Allows you to copy data from a current record to a new one.
----------------------------------------------------------------------------}

unit DBInsert;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, db;

type
  TRaDBInsert = class;

  TRaDBInsertDataLink = class(TDataLink)
  private
    FDBInsert: TRaDBInsert;
    FRecBuffer: Pointer;
    function GetBufSize: Integer;
    function DataSize(AField: TField): integer;
    procedure GetData(AField: TField; Buffer: Pointer);
    procedure SetData(AField: TField; Buffer: Pointer);
  protected
    procedure ActiveChanged; override;
    procedure DataSetChanged; override;
    procedure EditingChanged; override;
  public
    constructor Create(ADBInsert: TRaDBInsert);
    destructor Destroy; override;
  end;

  TRaDBInsert = class(TCheckBox)
  private
    FDataLink: TRaDBInsertDataLink;
    FDataSource: TDataSource;
    procedure CMChanged(var Message: TMessage); message CM_CHANGED;
    function GetDataSource: TDataSource;
    procedure SetDataSource(Value: TDataSource);
  protected
    procedure Notification(AComponent: TComponent;
                                           Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property DataSource: TDataSource read GetDataSource write SetDataSource;
  end;

implementation
uses dbXCnsts;

{TRaDBInsertDataLink}
constructor TRaDBInsertDataLink.Create(ADBInsert: TRaDBInsert);
begin
  inherited Create;
  FDBInsert := ADBInsert;
end;

destructor TRaDBInsertDataLink.Destroy;
begin
  if FRecBuffer <> nil then
  begin
     FreeMem(FRecBuffer);
     FRecBuffer := nil;
  end;
  FDBInsert := nil;
  inherited Destroy;
end;

function TRaDBInsertDataLink.GetBufSize: Integer;
var i: Integer;
begin
   Result := 0;
   for i := 0 to DataSet.FieldCount-1 do
      if not DataSet.Fields[i].IsBlob and not DataSet.Fields[i].ReadOnly then
        Inc(Result, DataSize(DataSet.Fields[i]));
end;

procedure TRaDBInsertDataLink.ActiveChanged;
begin
  if FRecBuffer <> nil then
  begin
     FreeMem(FRecBuffer);
     FRecBuffer := nil;
  end;
  if (FDBInsert <> nil) and Active then
    GetMem(FRecBuffer, GetBufSize);
end;

procedure TRaDBInsertDataLink.EditingChanged;
var i, FieldOffset: Integer;
begin
  if (FDBInsert <> nil) and
     (FDBInsert.Checked) and
     (DataSource <> nil) and
     (DataSet <> nil) and
     not (csDesigning in FDBInsert.ComponentState) and
     (DataSource.State = dsInsert) and
     (FRecBuffer <> nil) then
  begin
     FieldOffset := 0;
     for i := 0 to DataSet.FieldCount-1 do
     with DataSet.Fields[i] do
     begin
        if not IsBlob and not ReadOnly then
        begin
           Self.SetData(DataSet.Fields[i], Pointer(LongInt(FRecBuffer)+FieldOffset));
           Inc(FieldOffset, Self.DataSize(DataSet.Fields[i]));
        end;
     end;
  end;
end;

procedure TRaDBInsertDataLink.DataSetChanged;
var i, FieldOffset: Integer;
begin
  if (FDBInsert <> nil) and
     (DataSource <> nil) and
     (DataSet <> nil) and
     not (csDesigning in FDBInsert.ComponentState) and
     not (DataSource.State in [dsEdit, dsInsert]) and Active then
  begin
     FieldOffset := 0;
     for i := 0 to DataSet.FieldCount-1 do
     with DataSet.Fields[i] do
     begin
        if not IsBlob and not ReadOnly then
        begin
           Self.GetData(DataSet.Fields[i], Pointer(LongInt(FRecBuffer)+FieldOffset));
           Inc(FieldOffset, Self.DataSize(DataSet.Fields[i]));
        end;
     end;
  end;
end;

function TRaDBInsertDataLink.DataSize(AField: TField): integer;
begin
  if AField = nil then
    Result := 0
   else
  {$IFNDEF VER120}
  {$IFNDEF VER110}
  if AField is TWideStringField then
    Result := 1+AField.Size
   else
  {$ENDIF}
  {$ENDIF}
    Result := AField.DataSize;
end;

procedure TRaDBInsertDataLink.GetData(AField: TField; Buffer: Pointer);
begin
  if AField <> nil then
  {$IFNDEF VER120}
  {$IFNDEF VER110}
    if AField is TWideStringField then
      StrCopy(Buffer, PChar(AField.AsString))
     else
  {$ENDIF}
  {$ENDIF}
       AField.GetData(Buffer);
end;

procedure TRaDBInsertDataLink.SetData(AField: TField; Buffer: Pointer);
begin
  if AField <> nil then
  {$IFNDEF VER120}
  {$IFNDEF VER110}
    if AField is TWideStringField then
      AField.AsString := PChar(Buffer)
     else
  {$ENDIF}
  {$ENDIF}
       AField.SetData(Buffer);
end;

{TRaDBInsert}
constructor TRaDBInsert.Create(AOwner: TComponent);
begin
   Inherited Create(AOwner);
   FDataLink := TRaDBInsertDataLink.Create(Self);
   Caption := SDuplicateRecord;
end;

destructor TRaDBInsert.Destroy;
begin
  if FDataLink <> nil then
     FDataLink.Destroy;
  inherited Destroy;
end;

procedure TRaDBInsert.CMChanged(var Message: TMessage);
begin
   Inherited;
   if FDataLink <> nil then
      FDataLink.DataSetChanged;
end;

procedure TRaDBInsert.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then DataSource := nil;
end;

procedure TRaDBInsert.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
  FDataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

function TRaDBInsert.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

end.