jvqcsvbasecontrols.pas

East make Tray Icon in delphi

{******************************************************************************}
{* WARNING:  JEDI VCL To CLX Converter generated unit.                        *}
{*           Manual modifications will be lost on next release.               *}
{******************************************************************************}

{-----------------------------------------------------------------------------
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/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvCSVBase.PAS, released on 2002-06-15.

The Initial Developer of the Original Code is Jan Verhoeven [jan1 dott verhoeven att wxs dott nl]
Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven.
All Rights Reserved.

Contributor(s): Robert Love [rlove att slcdug dott org].

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvQCSVBaseControls.pas,v 1.23 2005/02/06 14:06:01 asnepvangers Exp $

unit JvQCSVBaseControls;

{$I jvcl.inc}

interface

uses
  QWindows, Classes, QControls, QStdCtrls, QButtons,
  JvQComponent;

type
  // (ahuser) changed NameValues: TStringList to TStrings
  TCursorChangedEvent = procedure(Sender: TObject; NameValues: TStrings;
    FieldCount: Integer) of object;

  TJvCSVBase = class(TJvComponent)
  private
    FDBOpen: Boolean;
    FDB: TStringList;
    FDBRecord: TStringList;
    FDBFields: TStringList;
    FDBCursor: Integer;
    FOnCursorChanged: TCursorChangedEvent;
    FCSVFileName: string;
    FCSVFieldNames: TStringList;
    procedure DoCursorChange;
    procedure SetCSVFileName(const Value: string);
    function GetCSVFieldNames: TStrings;
    procedure SetCSVFieldNames(const Value: TStrings);
    procedure DisplayFields(NameValues: TStrings);
  protected
    procedure DoCursorChanged(NameValues: TStrings; FieldCount: Integer); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DataBaseCreate(const AFile: string; FieldNames: TStrings);
    procedure DataBaseOpen(const AFile: string);
    procedure DataBaseClose;
    procedure DataBaseRestructure(const AFile: string; FieldNames: TStrings);
    procedure RecordNew;
    procedure RecordGet(NameValues: TStrings);
    procedure RecordSet(NameValues: TStrings);
    procedure RecordDelete;
    function RecordNext: Boolean;
    function RecordPrevious: Boolean;
    function RecordFirst: Boolean;
    function RecordLast: Boolean;
    procedure RecordPost;
    function RecordFind(const AText: string): Boolean;
    procedure Display;
  published
    property CSVFileName: string read FCSVFileName write SetCSVFileName;
    property CSVFieldNames: TStrings read GetCSVFieldNames write SetCSVFieldNames;
    property OnCursorChanged: TCursorChangedEvent read FOnCursorChanged write FOnCursorChanged;
  end;

  TJvCSVEdit = class(TEdit)
  private
    FCSVDataBase: TJvCSVBase;
    FCSVField: string;
    procedure SetCSVDataBase(const Value: TJvCSVBase);
    procedure SetCSVField(const Value: string);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  published
    property CSVDataBase: TJvCSVBase read FCSVDataBase write SetCSVDataBase;
    property CSVField: string read FCSVField write SetCSVField;
  end;

  TJvCSVComboBox = class(TComboBox)
  private
    FCSVField: string;
    FCSVDataBase: TJvCSVBase;
    procedure SetCSVDataBase(const Value: TJvCSVBase);
    procedure SetCSVField(const Value: string);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  published
    property CSVDataBase: TJvCSVBase read FCSVDataBase write SetCSVDataBase;
    property CSVField: string read FCSVField write SetCSVField;
  end;

  TJvCSVCheckBox = class(TCheckBox)
  private
    FCSVField: string;
    FCSVDataBase: TJvCSVBase;
    procedure SetCSVDataBase(const Value: TJvCSVBase);
    procedure SetCSVField(const Value: string);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  published
    property CSVDataBase: TJvCSVBase read FCSVDataBase write SetCSVDataBase;
    property CSVField: string read FCSVField write SetCSVField;
  end;

  TJvCSVNavigator = class(TJvCustomControl)
  private
    FBtnFirst: TSpeedButton;
    FBtnPrevious: TSpeedButton;
    FBtnFind: TSpeedButton;
    FBtnNext: TSpeedButton;
    FBtnLast: TSpeedButton;
    FBtnAdd: TSpeedButton;
    FBtnDelete: TSpeedButton;
    FBtnPost: TSpeedButton;
    FBtnRefresh: TSpeedButton;
    FCSVDataBase: TJvCSVBase;
    procedure CreateButtons;
    procedure BtnFirstClick(Sender: TObject);
    procedure BtnPreviousClick(Sender: TObject);
    procedure BtnFindClick(Sender: TObject);
    procedure BtnNextClick(Sender: TObject);
    procedure BtnLastClick(Sender: TObject);
    procedure BtnAddClick(Sender: TObject);
    procedure BtnDeleteClick(Sender: TObject);
    procedure BtnPostClick(Sender: TObject);
    procedure BtnRefreshClick(Sender: TObject);
    procedure SetCSVDataBase(const Value: TJvCSVBase);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure BoundsChanged; override;
  public
    constructor Create(AOwner: TComponent); override; 
  published
    property CSVDataBase: TJvCSVBase read FCSVDataBase write SetCSVDataBase;
  end;

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  SysUtils, QForms, QDialogs,
  JvQThemes, JvQResources;

{$IFDEF MSWINDOWS}
{$R ..\Resources\JvCSVBase.res}
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
{$R ../Resources/JvCSVBase.res}
{$ENDIF UNIX}

//=== { TJvCSVBase } =========================================================

constructor TJvCSVBase.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDB := TStringList.Create;
  FDBRecord := TStringList.Create;
  FDBFields := TStringList.Create;
  FCSVFieldNames := TStringList.Create;
  FDBCursor := -1;
  FDBOpen := False;
end;

destructor TJvCSVBase.Destroy;
begin
  FDB.Free;
  FDBRecord.Free;
  FDBFields.Free;
  FCSVFieldNames.Free;
  inherited Destroy;
end;

procedure TJvCSVBase.DataBaseClose;
begin
  FCSVFileName := '';
  FDBCursor := -1;
  DoCursorChange;
end;

procedure TJvCSVBase.DataBaseCreate(const AFile: string; FieldNames: TStrings);
var
  newfile: string;
  AList: TStrings;
begin
  newfile := ChangeFileExt(AFile, '.csv');
  if FileExists(newfile) then
    if MessageDlg(RsReplaceExistingDatabase, mtConfirmation, [mbYes, mbNo], 0) = mrNo then
      Exit;
  AList := TStringList.Create;
  try
    if (FieldNames <> nil) then
      if FieldNames.Count > 0 then
        AList.Text := FieldNames.CommaText;
    AList.SaveToFile(newfile);
  finally
    AList.Free;
  end;
end;

procedure TJvCSVBase.DataBaseOpen(const AFile: string);
begin
  if not FileExists(AFile) then
    DataBaseCreate(AFile, nil);
  FCSVFileName := AFile;
  FDB.LoadFromFile(CSVFileName);
  FDBCursor := -1;
  FDBFields.Clear;
  FDBRecord.Clear;
  if FDB.Count > 0 then
  begin
    FDBCursor := 0;
    FDBFields.CommaText := FDB[0];
    FCSVFieldNames.CommaText := FDB[0];
    if FDB.Count > 1 then
    begin
      FDBCursor := 1;
      FDBRecord.CommaText := FDB[FDBCursor];
      DoCursorChange;
    end;
  end;
end;

procedure TJvCSVBase.DataBaseRestructure(const AFile: string; FieldNames: TStrings);
var
  OldBase: TStrings;
  OldRec: TStrings;
  OldFields: TStrings;
  NewBase: TStrings;
  NewRec: TStrings;
  NewFields: TStrings;
  Index, Rec, Fld: Integer;
begin
  DataBaseClose;
  if FieldNames.Count = 0 then
    raise Exception.CreateRes(@RsENoFieldsDefined);

  OldBase := TStringList.Create;
  OldRec := TStringList.Create;
  OldFields := TStringList.Create;
  NewBase := TStringList.Create;
  NewRec := TStringList.Create;
  NewFields := TStringList.Create;
  try
    OldBase.LoadFromFile(AFile);
    if OldBase.Count = 0 then
    begin
      NewFields.Assign(FieldNames);
      NewBase.Append(NewFields.CommaText);
    end
    else
    begin
      //restructure
      OldFields.CommaText := OldBase[0];
      NewFields.Assign(FieldNames);
      NewBase.Append(NewFields.CommaText);
      if OldBase.Count > 1 then
        for Rec := 1 to OldBase.Count - 1 do
        begin
          OldRec.CommaText := OldBase[Rec];
          NewRec.Clear;
          for Fld := 0 to NewFields.Count - 1 do
          begin
            Index := OldFields.IndexOf(NewFields[Fld]);
            if Index = -1 then
              NewRec.Append('-')
            else
              NewRec.Append(OldRec[Index]);
          end;
          NewBase.Append(NewRec.CommaText);
        end;
    end;
    NewBase.SaveToFile(AFile);
  finally
    OldBase.Free;
    OldRec.Free;
    OldFields.Free;
    NewBase.Free;
    NewRec.Free;
    NewFields.Free;
  end;
end;

procedure TJvCSVBase.RecordNew;
var
  I: Integer;
begin
  if FDBCursor <> -1 then
  begin
    FDBRecord.Clear;
    for I := 0 to FDBFields.Count - 1 do
      FDBRecord.Append('-');
    FDB.Append(FDBRecord.CommaText);
    FDBCursor := FDB.Count - 1;
    FDB.SaveToFile(CSVFileName);
    DoCursorChange;
  end;
end;

procedure TJvCSVBase.RecordDelete;
begin
  if FDBCursor > 0 then
  begin
    FDB.Delete(FDBCursor);
    if FDBCursor > (FDB.Count - 1) then
      Dec(FDBCursor);
    if FDBCursor > 0 then
    begin
      FDBRecord.CommaText := FDB[FDBCursor];
      FDB.SaveToFile(CSVFileName);
    end;
    DoCursorChange;
  end;
end;

function TJvCSVBase.RecordFind(const AText: string): Boolean;
var
  I, From: Integer;
  S: string;
begin
  Result := False;
  if FDBCursor < 1 then
    Exit;
  if FDBCursor < (FDB.Count - 1) then
  begin
    From := FDBCursor + 1;
    S := LowerCase(AText);
    for I := From to FDB.Count - 1 do
      if Pos(S, LowerCase(FDB[I])) > 0 then
      begin
        FDBCursor := I;
        FDBRecord.CommaText := FDB[FDBCursor];
        Result := True;
        DoCursorChange;
        Break;
      end;
  end;
end;

function TJvCSVBase.RecordFirst: Boolean;
begin
  Result := False;
  if FDBCursor <> -1 then
    if FDB.Count > 1 then
    begin
      FDBCursor := 1;
      FDBRecord.CommaText := FDB[FDBCursor];
      Result := True;
      DoCursorChange;
    end;
end;

procedure TJvCSVBase.RecordGet(NameValues: TStrings);
var
  I: Integer;
begin
  NameValues.Clear;
  if FDBCursor < 1 then
    Exit;
  for I := 0 to FDBFields.Count - 1 do
    NameValues.Append(FDBFields[I] + '=' + FDBRecord[I]);
end;

function TJvCSVBase.RecordLast: Boolean;
begin
  Result := False;
  if FDBCursor <> -1 then
    if FDB.Count > 1 then
    begin
      FDBCursor := FDB.Count - 1;
      FDBRecord.CommaText := FDB[FDBCursor];
      Result := True;
      DoCursorChange;
    end;
end;

function TJvCSVBase.RecordNext: Boolean;
begin
  Result := False;
  if FDBCursor <> -1 then
  begin
    if FDBCursor < (FDB.Count - 1) then
    begin
      Inc(FDBCursor);
      FDBRecord.CommaText := FDB[FDBCursor];
      Result := True;
      DoCursorChange;
    end;
  end;
end;

function TJvCSVBase.RecordPrevious: Boolean;
begin
  Result := False;
  if FDBCursor <> -1 then
  begin
    if FDBCursor > 1 then
    begin
      Dec(FDBCursor);
      FDBRecord.CommaText := FDB[FDBCursor];