2 respuestas en este tema

[Desart]

Hola compañeros me gustaría compartir con ustedes estas nuevas funciones.
Compañeros no se porque me une todas las lineas, ya que me persiste el error de unirme todas las lineas os adjunto untxt con estas funciones

Editdo por seoane para corregir lo de las lineas

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 max<valor then  VMiRetorrno:=Max;
  Result:=VMiRetorrno;
end;
 
 
 
Function Redondear(Control: TWinControl;Round:integer;ColorLine,ColorFondo:Tcolor;WidthLine,Style,Border,space,STyleF:integer):boolean ;
//-----------------------------------------------------------------------------
//*********************************************************[ 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 [url]http://delphi.about.com/od/adptips2006/qt/focusrectangle.htm[/url]
// 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,&#39;Select * form Clientex&#39;)=true then
//                   showmessage(&#39;Existe la base de datos&#39;)
//   else showmessage(&#39;No existe la base de datos&#39;);
//-----------------------------------------------------------------------------
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(&#39;Se ha producido un error: &#39; + Chr(13) + Chr(13)
                     + &#39;Clase de error: &#39; + E.ClassName + Chr(13) + Chr(13)
                     + &#39;Mensaje del error: &#39; + E.Message+ Chr(13) + Chr(13)
                     +&#39;  &#39;+ Chr(13) + Chr(13)
                     +&#39;Se volvera al estado anterior&#39;);
        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;

Archivos adjuntos

•  2032_8a3c126b30dab530f7034a43134b199676357a71.txt   8,04KB   3 descargas

[cadetill]

Buenas,

Sólo comentar que para campos booleanos en Firebird yo uso este dominio

sql

CREATE DOMAIN BOOL AS
SMALLINT
CHECK (VALUE IN (0,1) OR VALUE IS NULL);

Luego, en Delphi, o bien uso tdbchecbox modificando las propiedades valuechecked y valueunchecked a 1 y 0 respectivamente. Con lo que respecta a los grids, si el que uso no muestra por defecto un checkbox, lo pinto yo

Nos leemos

[egostar]

Cada vez que veo que algún compañero se desprende de código y lo coloca en estos espacios, me alegra el día.

Muchas gracias amigos.

Salud OS