Nuevas funciones

[[José Luis Garcí]]

Hola compañeros me gustaría compartir con ustedes estas nuevas funciones pr si les resultase de ayuda

Código Delphi [-]
//------------------------------------------------------------------------------
//**********************************************************[ FIRECHECK ]*******
// JLGT 19/11/2010  Se encarga de pasar de  firebird a checkbox
// ---------Ejemplo------------
//   FireCheck(Checkbox1,Dtasource1,'VENDIDO');
//------------------------------------------------------------------------------
 function FireCheck(CHK:TCheckBox;          //Checkbox a Rellenar
                   Ds:TDataSource;          //Dtasource para conocer  el campo
                   CAMPO:string):string;    //Campo al que esta asociado y devuelve el valor SI si es checked y NO si es False
begin
    if Ds.DataSet.FieldByName(CAMPO).Value='SI' then
    begin
      CHK.Checked:=True;
      Result:='SI';
    end else
    begin
      CHK.Checked:=False;
      Result:='NO';
    end;
end;




//------------------------------------------------------------------------------
//**********************************************************[ CHECKFIRE ]*******
// JLGT 19/11/2010  Se encarga de pasar checkbox a si o no para firebird
// ---------Ejemplo------------
//   CheckFire(Checkbox1,Dtasource1,'VENDIDO');
//------------------------------------------------------------------------------
 //Nueva JLGT 19/11/2010  Se encarga de pasar checkbox a si o no para firebird
function CheckFire(CHK:TCheckBox;          //Checkbox a comprobar
                   Ds:TDataSource;         //Dtasource para conocer  el campo
                   CAMPO:string):string;   //Campo al que esta asociado y devuelve el valor SI si es checked y NO si es False
begin
     if CHK.Checked=true then
     begin
         Ds.DataSet.FieldByName(CAMPO).Value:='SI';
         Result:='SI';
     end else
     begin
        Ds.DataSet.FieldByName(CAMPO).Value:='NO';
         Result:='NO';
     end;
end;



function MAxMin(Max,Min,Valor:integer): Integer;
//-----------------------------------------------------------------------------
//************************************************************[  MaxMin ]******
//  2010  JLGT  Controla que un valor integer este entre un máximo y un mínimo
//-----------------------------------------------------------------------------
//  Ejemplo MaxMin(100,50,80);  ///Da 80
//  Ejemplo MaxMin(100,50,180);  ///Da 100
//  Ejemplo MaxMin(100,50,35);  ///Da 50
//-----------------------------------------------------------------------------
var VMiRetorrno:integer;
    focusRectangle:tshape;
begin

  VMiRetorrno:=VALOR;
  if min>valor then VMiRetorrno:=Min;
  if maxthen  VMiRetorrno:=Max;
  Result:=VMiRetorrno;
end;



Function Redondear(Control: TWinControl;Round:integer;ColorLine,ColorFondo:Tcolor;WidthLine,Style,Border,space,STyleF:integer):b  oolean ;
//-----------------------------------------------------------------------------
//*********************************************************[ Redondear  ]******
// 2010 JLGT Un efecto con borde de un color y relleno de otro sobre un control
//-----------------------------------------------------------------------------
// Bueno basandome en el código de master23 y en el código de about
// página http://delphi.about.com/od/adptips20...srectangle.htm
// más unas modificaciones mias queda bastante cuioso
//-----------------------------------------------------------------------------
// Parametros-------------
// Control:       Control que queremos usar
// Round:         Redondeo que quermeos darle al borde
// ColorLine:     Color a asignar en el fondo
// ColorFondo:    Color a aplicar al borde
// WidthLine:     Grosor del borde
// Style:         Tipo de pluma a usar para relleno borde
// Border:        Tipo de border a crear
// space          Espacio a separar del control
// STyleF:        Tipo de pluma a usar para relleno fondo
//-----------------------------------------------------------------------------
//
//  Ejemplo   Redondear(Edit1,2,clGreen,clyellow,2,1,3,3,1);
//
//-----------------------------------------------------------------------------
var
  R: TRect;
  Rgn: HRGN;
  focusRectangle:tshape;  //unit  ExtCtrls
begin
   focusRectangle := TShape.Create(Control) ;
   case border of
     1: focusRectangle.Shape := stRectangle;
     2: focusRectangle.Shape := stSquare;      //queda mal
     3: focusRectangle.Shape := stRoundRect;
     4: focusRectangle.Shape := stRoundSquare; //queda mal
     5: focusRectangle.Shape := stEllipse;     //queda mal
     6: focusRectangle.Shape := stCircle;      //queda mal
   end;
   focusRectangle.Visible := false;
   case Style of
     1: focusRectangle.Pen.Style := psSolid;
     2: focusRectangle.Pen.Style := psDash;
     3: focusRectangle.Pen.Style := psDot;
     4: focusRectangle.Pen.Style := psDashDot;
     5: focusRectangle.Pen.Style := psDashDotDot;
     6: focusRectangle.Pen.Style := psClear;
     7: focusRectangle.Pen.Style := psInsideFrame;
     8: focusRectangle.Pen.Style := psUserStyle;
     9: focusRectangle.Pen.Style := psAlternate;
   end;
   focusRectangle.Brush.Color:=ColorFondo;
   case STyleF of
     1:focusRectangle.Brush.Style := bsSolid;
     2:focusRectangle.Brush.Style := bsClear;
     3:focusRectangle.Brush.Style := bsHorizontal;
     4:focusRectangle.Brush.Style := bsVertical;
     5:focusRectangle.Brush.Style := bsFDiagonal;
     6:focusRectangle.Brush.Style := bsCross;
     7:focusRectangle.Brush.Style := bsDiagCross;
   end;
   FocusRectangle.Pen.Color := ColorLine;
   focusRectangle.Pen.Width := WidthLine;
  with Control do
  begin
    R := ClientRect;
    rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, Round, Round) ;
    Perform(EM_GETRECT, 0, lParam(@r)) ;
    InflateRect(r, - 4, - 4) ;
    Perform(EM_SETRECTNP, 0, lParam(@r)) ;
    SetWindowRgn(Handle, rgn, True) ;
    with focusRectangle do
    begin
      Parent := Control.Parent;
      Top := Control.Top - (space+WidthLine);
      Height := Control.Height + ((space*2)+WidthLine);
      Left := Control.Left - (space+WidthLine);
      Width := Control.Width + ((Space*2)+WidthLine);
      Visible := true;
    end;
    Invalidate;
  end;
end;

Function ActQuery(QRY:TIBQuery; TxtSql:string): Boolean;
//-----------------------------------------------------------------------------
//**********************************************************[ ActQuerry ]******
//  20/11/2010  JLGT  Para modificar la sentencia de un querry
//-----------------------------------------------------------------------------
//  Estudiando como poder hacer mi código mas corto se me ocurrio esta función
//  para usar un los IBQerry, para mi base de datos Firebird.
//  El tema es que cada vez que utilizo un querry y lo modifico tengo que
//  escribir unas 20 lineas y mediante este sistema, logro reducirlo a una sola
//  ya que es un, código repetitivo y soló varia el nombre del query y la
//  sentencia Sql, cree esta función
//-----------------------------------------------------------------------------
//  Base de datos a usar CLIENTES

//   if ActQuerry(IBQuerry1,'Select * form Clientex')=true then
//                   showmessage('Existe la base de datos')
//   else showmessage('No existe la base de datos');
//-----------------------------------------------------------------------------
var AntSql:string;
begin
    try
      try
        AntSql:=QRY.SQL.Text;
        QRY.Active:=false;
        QRY.SQL.Clear;
        QRY.SQL.Text:=TxtSql;
        QRY.Active:=true;
        Result:=true;
      except
        on E: Exception do
        begin
           ShowMessage('Se ha producido un error: ' + Chr(13) + Chr(13)
                     + 'Clase de error: ' + E.ClassName + Chr(13) + Chr(13)
                     + 'Mensaje del error: ' + E.Message+ Chr(13) + Chr(13)
                     +'  '+ Chr(13) + Chr(13)
                     +'Se volvera al estado anterior');
        Result:=false;
        end;
      end;
    finally
      if Result=false then
      begin
        QRY.Active:=false;
        QRY.SQL.Clear;
        QRY.SQL.Text:=AntSql;
        QRY.Active:=true;
      end;
    end;
end;

[marcoszorrilla]

Gracias por la aportación José Luis.

Un Saludo.

[look]

hola gracias por el aporte.
por cierto, en la funcion de redondear bordes, me daba error en las lineas:

Código Delphi [-]
     8: focusRectangle.Pen.Style := psUserStyle;
     9: focusRectangle.Pen.Style := psAlternate;

solo las borre y me funko bien, ¿sera por la version de delphi?....

[[José Luis Garcí]]

Gracias , no hay ni que darlas, Yo debo más a la comunidad de lo que puedo aportar, lo que ocurre es que alguna de estas funciones pueden reducir el código, o aportar claridad a ciertas dudas. Pero la información esta en el club y en la red, soló la he agrupado.

En cuanto a en que versión de delphi las he realizado es en Delphi 2010, no se si habrá problemas con otras versiones.

[ecfisa]

Muchas gracias José Luis.

Saludos.