lazarus-ccr/components/flashfiler/sourcelaz/explorer/dgParams.pas

(* ***** 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
 * Eivind Bakkestuen
 * Used with permission.
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

unit dgParams;

interface

{$I FFDEFINE.INC}

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
  Buttons, ExtCtrls, Grids, db
  {$IFDEF Delphi3}
  , dbTables
  {$ENDIF}, ffllgrid;

type
  TdlgParams = class(TForm)
    OKBtn: TButton;
    CancelBtn: TButton;
    cbParamType: TComboBox;
    gdParams: TffStringGrid;
    procedure gdParamsDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormCreate(Sender: TObject);
    procedure gdParamsKeyPress(Sender: TObject; var Key: Char);
    procedure gdParamsGetEditText(Sender: TObject; ACol, ARow: Integer;
      var Value: String);
    procedure cbParamTypeChange(Sender: TObject);
    procedure cbParamTypeExit(Sender: TObject);
    procedure gdParamsSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
  private
    { Private declarations }
    function GetCellBackgroundColour(aColour: TColor; ACol, ARow: Integer) : TColor;
    procedure GetStringProc(const S: String);
    procedure CMDialogKey(var msg: TCMDialogKey); message CM_DIALOGKEY;
    procedure ShowCellCombo(ComboBox: TCustomComboBox; Grid: TCustomGrid;
      Rect: TRect; aColour : TColor);
  public
    { Public declarations }
    function GetParamValues(aParams: TParams) : Boolean;
      { reads values from the stringgrid }
    function EditParamValues(aParams: TParams): Boolean;
      { opens dialog to edit and return values from the stringgrid }
  end;


implementation

{$R *.dfm}

uses
{$IFDEF DCC6OrLater}
  Variants,
{$ENDIF}
  Messages,
  TypInfo;


const
  colParamName = 0;
  colParamValue = 1;
  colParamType = 2;


{ create "hack" classes we can use to
  use the normally protected properties }
type
  THackGrid = class(TStringGrid)
  public
    property InplaceEditor;
  end;

  THackEdit = class(TInplaceEdit)
  public
    property Color;
  end;

  
const
  sBlankNotSupported = 'Blank parameters not supported for non-string types';


{ TdlgParams }

function TdlgParams.GetParamValues(aParams: TParams): Boolean;
var
  RowIdx : Integer;
begin
  Result := True;
  { copy values to Params }
  for RowIdx := 1 to Pred(gdParams.RowCount) do begin
    if (gdParams.Cells[colParamValue, RowIdx]<>'') or
       (TFieldType(GetEnumValue(TypeInfo(TFieldType), gdParams.Cells[colParamType, RowIdx]))=ftString) then begin
      aParams[RowIdx-1].DataType := TFieldType(GetEnumValue(TypeInfo(TFieldType), gdParams.Cells[colParamType, RowIdx]));
      aParams[RowIdx-1].Value := gdParams.Cells[colParamValue, RowIdx];
    end
    else
      raise Exception.Create(sBlankNotSupported);
  end;
end;


function TdlgParams.EditParamValues(aParams: TParams): Boolean;
var
  RowIdx,
  ParIdx : Integer;
begin
  { extract values previously entered }
  { for each row in grid }
  for RowIdx := 1 to Pred(gdParams.RowCount) do
    { check if param exists in new params list }
    for ParIdx := 0 to Pred(aParams.Count) do
      if (aParams[ParIdx].Name=gdParams.Cells[colParamName, RowIdx]) and
         (gdParams.Cells[colParamValue, RowIdx]<>'') then begin
        { and copy value and type if so }
        aParams[ParIdx].DataType := TFieldType(GetEnumValue(TypeInfo(TFieldType), gdParams.Cells[colParamType, RowIdx]));
        aParams[ParIdx].Value := gdParams.Cells[colParamValue, RowIdx];
        Break;
      end;

  { fill grid with new contents }
  gdParams.RowCount := aParams.Count+1;
  for RowIdx := 1 to Pred(gdParams.RowCount) do begin
    gdParams.Cells[colParamName, RowIdx] := aParams[RowIdx-1].Name;
    gdParams.Cells[colParamValue, RowIdx] := aParams[RowIdx-1].Value;
    gdParams.Cells[colParamType, RowIdx] := GetEnumName(TypeInfo(TFieldType), Integer(aParams[RowIdx-1].DataType));
  end;
  Result := ShowModal=mrOK;
  { copy new values to Params? }
  if Result then
    GetParamValues(aParams); 
end;


function TdlgParams.GetCellBackgroundColour(aColour: TColor; ACol, ARow: Integer) : TColor;
Const
  BlueIdx = 0;
var
  ColourBytes : Array[0..3] of byte absolute Result;
begin
  Result := aColour;
  if ((ARow Mod 2) = 1) and (ACol>0) then begin
    Result := ColorToRGB(aColour);
    if ColourBytes[BlueIdx]>127 then
      ColourBytes[BlueIdx] := ColourBytes[BlueIdx]-16
    else
      ColourBytes[BlueIdx] := ColourBytes[BlueIdx]+16;
  end;
end;


procedure TdlgParams.gdParamsDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  with Sender as TStringGrid do
  begin
    { change backgroundcolour slightly on every other row }
    Canvas.Brush.Color := GetCellBackgroundColour(Canvas.Brush.Color, ACol, ARow);
    case ARow of
      1..MaxInt : case ACol of
                    colParamValue,
                    colParamType  : Begin
                                      Canvas.Font.Color := Font.Color;
                                      Canvas.FillRect(Rect);
                                      Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+2, Cells[ACol, ARow]);
                                    End;
                  end;
    end;
    if gdFocused in State then
      Canvas.DrawFocusRect(Rect);
  end;
end;


procedure TdlgParams.GetStringProc(Const S : String);
begin
  cbParamType.Items.Add(S);
end;


procedure TdlgParams.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  gdParams.DefaultRowHeight := cbParamType.Height;
  gdParams.Cells[colParamName, 0] := 'Parameter:';
  gdParams.Cells[colParamValue, 0] := 'Value:';
  gdParams.Cells[colParamType, 0] := 'Type:';

  cbParamType.Clear;
  with GetTypeData(TypeInfo(TFieldType))^ do
  begin
    for I := MinValue to MaxValue do
      GetStringProc(GetEnumName(TypeInfo(TFieldType), I));
  end;
end;


procedure TdlgParams.gdParamsKeyPress(Sender: TObject; var Key: Char);
begin
  if Key=#13 then begin
    if (Succ(gdParams.Col)=gdParams.ColCount) and
       (Succ(gdParams.Row)=gdParams.RowCount) then
      ModalResult := mrOK
    else
    if (Succ(gdParams.Col)=gdParams.ColCount) then begin
      gdParams.Col := colParamValue;
      gdParams.Row := gdParams.Row + 1;
    end
    else
      gdParams.Col := gdParams.Col + 1;
  end
  else
  if Key=#27 then
    ModalResult := mrCancel;
end;


procedure TdlgParams.gdParamsGetEditText(Sender: TObject; ACol,
  ARow: Integer; var Value: String);
begin
  Assert(Sender is TStringGrid);
  with THackGrid(Sender) do
    THackEdit(InplaceEditor).Color := GetCellBackgroundColour(Color, ACol, ARow);
end;


procedure TdlgParams.cbParamTypeChange(Sender: TObject);
begin
  with gdParams do begin
    Cells[Col, Row] := cbParamType.Items[cbParamType.ItemIndex];
  end;
  gdParams.Invalidate;
end;


procedure TdlgParams.cbParamTypeExit(Sender: TObject);
begin
  cbParamType.Visible := False;
  if Assigned(ActiveControl) and not(ActiveControl = gdParams) then
    ActiveControl.SetFocus
  else begin
    gdParams.SetFocus;
    gdParams.Perform(WM_KEYDOWN, VK_TAB, 0);
  end;
end;


procedure TdlgParams.gdParamsSelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
var
  R : TRect;
begin
  case ACol of
    colParamType :
      begin
        R := gdParams.CellRect(ACol, ARow);
        ShowCellCombo(cbParamType, gdParams, R, GetCellBackgroundColour(gdParams.Canvas.Brush.Color, ACol, ARow));
        cbParamType.ItemIndex :=
          cbParamType.Items.IndexOf(gdParams.Cells[ACol, ARow]);
      end;
  end;
end;


procedure TdlgParams.CMDialogKey(var msg: TCMDialogKey);
begin
  if (ActiveControl = cbParamType) then
  begin
    if (msg.CharCode = VK_TAB) then
    begin
      ActiveControl.Visible := False;
      msg.result := 1;
      Exit;
    end;
  end;
  inherited;
end;


procedure TdlgParams.ShowCellCombo(ComboBox: TCustomComboBox;
  Grid: TCustomGrid; Rect: TRect; aColour : TColor);
begin
  Rect.Left := Rect.Left + Grid.Left;
  Rect.Right := Rect.Right + Grid.Left;
  Rect.Top := Rect.Top + Grid.Top;
  Rect.Bottom := Rect.Bottom + Grid.Top;
  ComboBox.Left := Rect.Left + 1;
  ComboBox.Top := Rect.Top + 1;
  ComboBox.Width := (Rect.Right + 1) - Rect.Left;
  ComboBox.Height := (Rect.Bottom + 1) - Rect.Top;

 {Display the combobox}
  ComboBox.Visible := True;
  TComboBox(ComboBox).Color := aColour;
  ComboBox.SetFocus;
end;


end.