fexpress.pas

很管用的GIS控件

    FFunctions.Add(func);
    FFunctionsDescr.Add(descr);
  end;

begin
  FGis := Gis;
  FLayer := Layer;

  Memo1.Text:= SourceExpr;

  FFunctions:= TStringList.create;
  FFunctionsDescr:= TStringList.create;
  AddFunc(SAbs);
  AddFunc(SArcTan);
  AddFunc(SArea);
  AddFunc(SPoints);
  AddFunc(SCopy);
  AddFunc(SCos);
  AddFunc(SExp);
  AddFunc(SFormat);
  AddFunc(SFrac);
  AddFunc(SIf);
  AddFunc(SInt);
  AddFunc(SLength);
  AddFunc(SLn);
  AddFunc(SLower);
  AddFunc(SMaxExtentX);
  AddFunc(SMaxExtentY);
  AddFunc(SMinExtentX);
  AddFunc(SMinExtentY);
  AddFunc(SPerimeter);
  AddFunc(SPI);
  AddFunc(SPos);
  AddFunc(SPos);
  AddFunc(SPower);
  AddFunc(SRound);
  AddFunc(SSin);
  AddFunc(SSqr);
  AddFunc(SSqrt);
  AddFunc(STrunc);
  AddFunc(SUpper);
  AddFunc(SCurDate);
  AddFunc(SFormateDateTime);
  AddFunc(SFormatFloat);
  AddFunc(SCentroidX);
  AddFunc(SCentroidY);
  AddFunc(SType);
  AddFunc(SCrLf);
  AddFunc(SColor);
  AddFunc(SFillColor);
  AddFunc(SBlack);
  AddFunc(SMaroon);
  AddFunc(SGreen);
  AddFunc(SOlive);
  AddFunc(SNavy);
  AddFunc(SPurple);
  AddFunc(STeal);
  AddFunc(SGray);
  AddFunc(SSilver);
  AddFunc(SRed);
  AddFunc(SLime);
  AddFunc(SYellow);
  AddFunc(SBlue);
  AddFunc(SFuchsia);
  AddFunc(SAqua);
  AddFunc(SWhite);
  AddFunc(SRGB);
  AddFunc(SText);
  AddFunc(SLayerName);
  AddFunc(SDistance);
  AddFunc(SLeft);
  AddFunc(SRight);
  AddFunc(SIsSelected);
  AddFunc(SYear);
  AddFunc(SMonth);
  AddFunc(SDay);
  AddFunc(SHour);
  AddFunc(SMin);
  AddFunc(SSec);
  AddFunc(SMSec);
  AddFunc(STo_Char);
  AddFunc(STo_Date);
  AddFunc(STo_Num);
  AddFunc(SDecode);

  {populate listbox of functions}
  lbFuncs.Clear;
  for I := 0 to FFunctions.Count - 1 do
     lbFuncs.Items.AddObject( FFunctions[I], nil);
  lbFuncs.ItemIndex:= 0;
  lbFuncs.OnClick(lbFuncs);

  FLayer.PopulateFieldList(lbColumns.Items, True);

  if Assigned( FGis.OnStartExternalPopulate ) And Assigned( FGis.OnExternalPopulate ) then
  begin
    Accept:= True;
    FGis.OnStartExternalPopulate( FGis, FLayer.Name, Accept );
    if Accept then
    begin
      Identifier := '';
      FGis.OnExternalPopulate( FGis, FLayer.Name, Identifier );
      LayerName:= FLayer.Name;
      if AnsiPos( #32, LayerName ) > 0 then
        Identifier:= '[' + LayerName + ']';
      While Length( Identifier ) > 0 do
      begin
        if AnsiPos( #32, Identifier ) > 0 then
          Identifier:= '[' + Identifier + ']';
        lbColumns.Items.AddObject( LayerName + '.' + Identifier, Pointer(1) );
        Identifier := '';
        FGis.OnExternalPopulate( FGis, FLayer.Name, Identifier );
      end;
      if Assigned( FGis.OnEndExternalPopulate ) then
        FGis.OnEndExternalPopulate( FGis, FLayer.Name );
    End;
  end;

{$IFDEF LANG_SPA}
  Caption:= 'Asistente de Expresiones';
  gb2.Caption:= '&Funciones';
  BtnAddFunct.Caption:= '&Agrega';
  BtnAddField.Caption:= 'A&grega';
  GB1.Caption:= 'Tabla &Nativa y UDFs (User Defined Functions)';
  Group1.caption:= '&Operadores';
  Label1.Caption:= 'Expresion';
  BtnVerify.Caption:= '&Verifica';
  BtnClear.caption:='&Clear';
  BtnUndo.Caption:= '&Deshacer';
  OKBtn.caption:='Aceptar';
  CancelBtn.caption:='Cancelar';
{$ENDIF}

  result:= ShowModal;
end;

function TfrmExprDlg.VerifyExpression(ShwMsg:boolean): boolean;
var
  Expr: string;
  MainExpr: TEzMainExpr;
begin
  //result:=false;
  Expr:= Memo1.Text;
  if Length(Expr)=0 then
  begin
     result:=true;
     exit;
  end;
  MainExpr:= TEzMainExpr.Create(FGis, FLayer);
  try
     MainExpr.ParseExpression( Expr );
     if ShwMsg then
        MessageToUser(SExpressionOkay, smsgwarning,MB_ICONINFORMATION);
  finally
     MainExpr.Free;
  end;
  result:= true;
end;

procedure TfrmExprDlg.BtnVerifyClick(Sender: TObject);
begin
  VerifyExpression(true);
end;

procedure TfrmExprDlg.OKBtnClick(Sender: TObject);
begin
  if not VerifyExpression(false) then ModalResult:= mrNone;
end;

procedure TfrmExprDlg.BtnAddClick(Sender: TObject);
begin
  with TSpeedButton(Sender) do
  begin
     Memo1.SelText:= Caption;
     ActiveControl:= Memo1;
  end;
end;

procedure TfrmExprDlg.BtnAddFieldClick(Sender: TObject);
begin
  if lbColumns.ItemIndex < 0 then exit;
  with lbColumns do
  begin
     Memo1.SelText:= Items[ItemIndex];
     ActiveControl:= Memo1;
  end;
end;

procedure TfrmExprDlg.BtnAddFunctClick(Sender: TObject);
var
  syntax, descr: string;
begin
  if lbFuncs.ItemIndex < 0 then Exit;
  with lbFUncs do
    if (Items.Objects[ItemIndex]=nil) and
       FindFunction(Items[ItemIndex], syntax, descr) then
    begin
       Memo1.SelText:= syntax;
       ActiveControl:= Memo1;
    end else
    begin
       Memo1.SelText:= Items[ItemIndex];
       ActiveControl:= Memo1;
    end;
end;

procedure TfrmExprDlg.lbFuncsClick(Sender: TObject);
var
  Syntax, Description: string;
begin
  LbColumns.ItemIndex:= -1;
  with lbFuncs do
    if (Items.Objects[ItemIndex]=nil) and
       FindFunction(Items[ItemIndex], Syntax, Description) then
    begin
       LblSyntax.Caption := Syntax;
       LblDesc.Caption:= Description;
    end else
    begin
       LblSyntax.Caption := Items[ItemIndex];
       LblDesc.Caption:= SCustomGlobal;
    end;
end;

function TfrmExprDlg.FindFunction(const func: string;
  var syntax, description: string): boolean;
var
  Index: integer;
begin
  {the expressions}
  result:= false;
  Index:= FFunctions.IndexOf(func);
  if Index>=0 then
  begin
    syntax:=FFunctions[Index];
    description := FFunctionsDescr[Index];
    result:= true;
  end;
end;

procedure TfrmExprDlg.BtnClearClick(Sender: TObject);
begin
  Memo1.Lines.Clear;
end;

procedure TfrmExprDlg.BtnUndoClick(Sender: TObject);
begin
  Memo1.Perform(EM_UNDO, 0, 0);
end;

procedure TfrmExprDlg.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if Key =#27 then ModalResult := mrCancel;
end;

procedure TfrmExprDlg.lbColumnsDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
  with lbColumns.Canvas do
  begin
     FillRect( Rect );
     Font := lbColumns.Font;
     if odSelected in State then
        Font.Color:= clHighlightText
     else
     begin
        if Index in [0,1] then
           Font.Color:= clMaroon
        else if Longint(lbColumns.Items.Objects[Index])=0 then
           Font.Color:= clWindowText
        else
           Font.Color:= clBlue;
     end;
     TextOut( Rect.Left, Rect.Top, lbColumns.Items[ Index ] );
  end;
end;

procedure TfrmExprDlg.BtnOpenClick(Sender: TObject);
begin
   Memo1.SelText:= '('+Memo1.SelText+')';
   ActiveControl:= Memo1;
end;

procedure TfrmExprDlg.lbColumnsClick(Sender: TObject);
var
  FieldName, Syntax: string;
  Index: Integer;
begin
  LbFuncs.ItemIndex:=-1;
  Index:= lbColumns.ItemIndex; if Index < 0 then exit;
  Syntax:= lbColumns.Items[Index];
  Index:= AnsiPos('.', Syntax);
  FieldName:= Copy(Syntax,Index+1, Length(Syntax));
  LblSyntax.Caption := Syntax;
  LblDesc.Caption:= Format(SExprNative,[FieldName]);
end;

procedure TfrmExprDlg.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FFunctions.free;
  FFunctionsDescr.free;
end;

procedure TfrmExprDlg.btnWithinClick(Sender: TObject);
var
  TmpPt: TPoint;
begin
  TmpPt := Self.ClientToScreen(Point(btnWithin.Left,btnWithin.Top + btnWithin.Height));
  Popupmenu1.Popup( TmpPt.x, TmpPt.y );
end;

procedure TfrmExprDlg.Within1Click(Sender: TObject);
begin
  Memo1.SelText:= #32+StringReplace(UpperCase((Sender as TMenuItem).Caption),'&','',[rfReplaceAll] )+#32;
  ActiveControl:= Memo1;
end;

end.