Skip to content

Instantly share code, notes, and snippets.

/gist:5743525
Created Jun 9, 2013

Embed
What would you like to do?
Gestión de imágenes para el tutorial de programa de gestión desde 0
unit UImagenes;
{$R BOTONERA.RES}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, IBDatabase,
MMSystem, //Para la botonera
NewPanelDB, //Para usar el NEwPanelDB
SPBBC, //Para TSpeedButtonBC
Lapelpanel, //Para paneles con solapa
MyDbIbMemo, //Para DbiMemo
TDbIbchkbox, //Para campos boolean en Firebird
Mask, DbEditDefault, //PAra usar los DbeditDefault en vez de los Dbedit normal
DBCBEXT, //Para usar el DbCombobox Extendido
GroupboxJL, //Para usar el CgoupBox especial
Dialogs, ComCtrls, ExtCtrls, Grids, DBGrids, StdCtrls, Spin, Buttons, DB, DBCtrls,
Clipbrd, jpeg, ShellAPI,
DBneweditjl, ExtDlgs;
type
TFImagenes = class(TForm)
PanelBotonera: TNewPanelDB;
SBBarraStatus: TStatusBar;
Panel1: TPanel;
Panel2: TPanel;
PanelDatos: TNewPanelDB;
Panel3: TPanel;
DBGNoEnable: TDBGrid;
PanelConfirmar: TNewPanelDB;
DsPrincipal: TDataSource;
SBPrimero: TSpeedButtonBC;
SBMenosx: TSpeedButtonBC;
SBMenos1: TSpeedButtonBC;
SBMas1: TSpeedButtonBC;
SBMasX: TSpeedButtonBC;
SBUltimo: TSpeedButtonBC;
SbNuevo: TSpeedButtonBC;
SbModificar: TSpeedButtonBC;
SbBorrar: TSpeedButtonBC;
SB_Salir: TSpeedButtonBC;
SBBuscar: TSpeedButtonBC;
SBConfirmar: TSpeedButtonBC;
SBCancelar: TSpeedButtonBC;
Label14: TLabel;
SEMobeByX: TSpinEdit;
GBBuscar: TGroupBoxJL;
Ebusqueda: TEdit;
BLimpiar: TButton;
BBuscar: TButton;
BCerrar: TButton;
Timer1: TTimer;
Label4: TLabel;
DBImage1: TDBImage;
Label5: TLabel;
DBNewEditJL1: TDBNewEditJL;
Label6: TLabel;
DBNewEditJL2: TDBNewEditJL;
Label7: TLabel;
DBNewEditJL3: TDBNewEditJL;
SpeedButtonBC1: TSpeedButtonBC;
SpeedButtonBC2: TSpeedButtonBC;
OpenPictureDialog1: TOpenPictureDialog;
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure SBPrimeroClick(Sender: TObject);
procedure SBMenosxClick(Sender: TObject);
procedure SBMenos1Click(Sender: TObject);
procedure SBMas1Click(Sender: TObject);
procedure SBMasXClick(Sender: TObject);
procedure SBUltimoClick(Sender: TObject);
procedure SbNuevoClick(Sender: TObject);
procedure SbModificarClick(Sender: TObject);
procedure SbBorrarClick(Sender: TObject);
procedure SBBuscarClick(Sender: TObject);
procedure BLimpiarClick(Sender: TObject);
procedure BBuscarClick(Sender: TObject);
procedure BCerrarClick(Sender: TObject);
procedure EbusquedaChange(Sender: TObject);
procedure SB_SalirClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure SBCancelarClick(Sender: TObject);
procedure SBConfirmarClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure DBGNoEnableDrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
procedure SpeedButtonBC1Click(Sender: TObject);
procedure SpeedButtonBC2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FImagenes: TFImagenes;
IBT:TIBTransaction;
implementation
{$R *.dfm}
uses UDM, Fun, FUN_DBGRID, Fun_Errores, UMENU, UArticulos;
procedure TFImagenes.BBuscarClick(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************************[ Buscar ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.Locate('NOMBREMODULO;CODIGO;DESCRIPCION',VarArrayOf([VarSNomMod,VarsCod,Ebusqueda.Text]),[loCaseInsensitive,loPartialKey]);
end;
procedure TFImagenes.BCerrarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ Cerrar Busqueda ]******
//------------------------------------------------------------------------------
begin
BLimpiarClick(Sender);
GBBuscar.Visible:=False;
end;
procedure TFImagenes.BLimpiarClick(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************[ Limpia la busqueda ]******
//------------------------------------------------------------------------------
begin
Ebusqueda.Text:='';
BBuscarClick(Sender);
Ebusqueda.SetFocus;
end;
procedure TFImagenes.DBGNoEnableDrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
//------------------------------------------------------------------------------
//*******************************************************[ ZEbaro del Grid ]****
//------------------------------------------------------------------------------
begin
Zebrado(DsPrincipal,DBGNoEnable, Rect, Column, State, COLOR1GRID,COLOR2GRID);
GridImagen(DBGNoEnable, DsPrincipal.DataSet.Fields.FieldByName('IMAGENES'), Rect,Column,State);
end;
procedure TFImagenes.EbusquedaChange(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************[ Mientras se escribe en busqueda ]******
//------------------------------------------------------------------------------
begin
BBuscarClick(sender);
end;
procedure TFImagenes.FormActivate(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************[ Cuando se activa El form ]******
// Lo que queremos que haga nuestro Form Cuando se Actiba
//------------------------------------------------------------------------------
begin
//Carganmos las imagenes de los botones
SBPrimero.Glyph.Handle:=Loadbitmap(HInstance,'FIRST');
SBMenosx.Glyph.Handle:=Loadbitmap(HInstance,'RETROCEDER');
SBMenos1.Glyph.Handle:=Loadbitmap(HInstance,'PRIOR');
SBMas1.Glyph.Handle:=Loadbitmap(HInstance,'NEXT');
SBMasX.Glyph.Handle:=Loadbitmap(HInstance,'AVANZAR');
SBUltimo.Glyph.Handle:=Loadbitmap(HInstance,'LAST');
SbNuevo.Glyph.Handle:=Loadbitmap(HInstance,'NUEVO');
SbModificar.Glyph.Handle:=Loadbitmap(HInstance,'EDIT');
SbBorrar.Glyph.Handle:=Loadbitmap(HInstance,'BORRAR');
SB_Salir.Glyph.Handle:=Loadbitmap(HInstance,'SALIR');
SBBuscar.Glyph.Handle:=Loadbitmap(HInstance,'BUSCAR');
SBConfirmar.Glyph.Handle:=Loadbitmap(HInstance,'CHECKROUND');
SBCancelar.Glyph.Handle:=Loadbitmap(HInstance,'CANCEL');
if Timer1.Enabled=false then Timer1.Enabled:=True;
//Ponemos el Juego de colores de mis NewPanelDB
PanelBotonera.ColorNotActive:=COLORPANELACT;
PanelBotonera.ActiveColor:=COLORPANELNOACT;
PanelDatos.ActiveColor:=COLORPANELACT;
PanelDatos.ColorNotActive:=COLORPANELNOACT;
PanelConfirmar.ActiveColor:=COLORPANELACT;
PanelConfirmar.ColorNotActive:=COLORPANELNOACT;
//Acondicionamos tamaños en el Grid
TStringGrid(DBGNoEnable).DefaultRowHeight :=74;
TStringGrid(DBGNoEnable).RowHeights[0]:=20;
end;
procedure TFImagenes.FormClose(Sender: TObject; var Action: TCloseAction);
//------------------------------------------------------------------------------
//*************************************************[ Al Cerrarse El Form ]******
// Cerramos todos los procesos para que no consuman memoria y posibles errores
//------------------------------------------------------------------------------
begin
if Timer1.Enabled=true then Timer1.Enabled:=False;
ActIbdataset(DM.IBDIMAGENES,'select * from IMAGENES');
//Retornos al modulo de llamada
if VarSNomMod='ARTICULOS' then FArticulos.SpeedButtonBC8Click(sender);
end;
procedure TFImagenes.FormCreate(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************[ Al Crearse el Fom ]******
// Cosas que queremos que haga según se inicie el Form
//------------------------------------------------------------------------------
begin
IBT:=DM.IBTransaction1; // Aquí especificar el modulo y el IBTransaction a usar
{Cosas que queremos que haga según se inicie el Form}
end;
procedure TFImagenes.FormKeyPress(Sender: TObject; var Key: Char);
//------------------------------------------------------------------------------
//************************************************[ Al pulsar una tecla ]******
// Al pulsar la tecla salta al foco del siguiente componente, si esta admitido
//------------------------------------------------------------------------------
begin
if (Key = #13) then {Si se ha pulsado enter }
if (ActiveControl is TEdit)
or (ActiveControl is TDBEdit)
or (ActiveControl is TDBNewEditJL)
or (ActiveControl is TDBComboBox) then
begin
Key := #0; { anula la puulsación }
Perform(WM_NEXTDLGCTL, 0, 0); { mueve al próximo control }
end
end;
procedure TFImagenes.SbBorrarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Borrar el Actual Registro ]******
//------------------------------------------------------------------------------
begin //Cambiar por el mensaje elegido
if (MessageBox(0, '¿Esta seguro de eliminar el registro actual?',
'Eliminar Registro', MB_ICONSTOP or MB_YESNO or MB_DEFBUTTON2) = ID_No) then abort
else begin
DSPrincipal.DataSet.Delete;
ShowMessage('El registro ha sido eliminado');
IBT.CommitRetaining;
end;
end;
procedure TFImagenes.SBBuscarClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************[ Abrir Busqueda ]******
//------------------------------------------------------------------------------
begin
GBBuscar.Visible:=True;
Ebusqueda.SetFocus;
end;
procedure TFImagenes.SBCancelarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ Cancelar Proceso]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.Cancel;
IBT.RollbackRetaining; //Donde IBT es el nombre de su Ibtrasaction, con ruta
end;
procedure TFImagenes.SBConfirmarClick(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************************[ Grabar datos ]******
//------------------------------------------------------------------------------
begin
try
if (DBneweditjl3.text<>'') AND (DBImage1.Picture<>nil) then
begin
DSPrincipal.DataSet.Post;
IBT.CommitRetaining; //Donde IBT es el nombre de su Ibtrasaction, con ruta
end else ShowMessage('Para poder grabar los datos, debe rellenar los campos Descripción y Imagen');
except
on E: Exception do
begin
MessageBeep(1000);
ShowMessage('Se ha producido un error y el proceso no se ha podido terminar Unidad:[ UImagenes ] Modulo:[ Grabar ]' + 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)
+ 'El proceso ha quedado interrumpido');
DSPrincipal.DataSet.Cancel;
IBT.RollbackRetaining; //Donde IBT es el nombre de su Ibtrasaction, con ruta
end;
end;
end;
procedure TFImagenes.SBMas1Click(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************************[ Avanzar un registro ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.Next;
end;
procedure TFImagenes.SBMasXClick(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************************[ Avanzar x Registros ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.MoveBy(SEMobeByX.Value);
end;
procedure TFImagenes.SBMenos1Click(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************[ Retroceder 1 registro ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.Prior;
end;
procedure TFImagenes.SBMenosxClick(Sender: TObject);
//------------------------------------------------------------------------------
//**********************************************[ Retroceder x Registros ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.MoveBy(-SEMobeByX.Value);
end;
procedure TFImagenes.SbModificarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Editar el actual registro ]******
//------------------------------------------------------------------------------
begin
if DsPrincipal.DataSet.IsEmpty<>true then
begin
DSPrincipal.DataSet.Edit;
DBNewEditJL3.SetFocus;
end else ShowMessage('No hay tregistros disponibles para editar')
end;
procedure TFImagenes.SbNuevoClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Creamos un nuevo registro ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.Insert;
DsPrincipal.DataSet.FieldByName('NOMBREMODULO').Value:=VarSNomMod;
DsPrincipal.DataSet.FieldByName('CODIGO').Value:=VarsCod;
if VarSNomMod='ARTICULOS' then DsPrincipal.DataSet.FieldByName('DESCRIPCION').Value:='Imagen';
DBNewEditJL3.SetFocus;
end;
procedure TFImagenes.SBPrimeroClick(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************[ Ir al Primer Registro ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.First;
end;
procedure TFImagenes.SBUltimoClick(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************[ Ir al último registro ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.Last;
end;
procedure TFImagenes.SB_SalirClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************[ Salir Del Form ]******
//------------------------------------------------------------------------------
begin
FImagenes.Close;
end;
procedure TFImagenes.SpeedButtonBC1Click(Sender: TObject);
//------------------------------------------------------------------------------
//*********************************************************[ Cargar imagen ]****
//------------------------------------------------------------------------------
begin
CargaIimagenADBImagen(OpenPictureDialog1,DBImage1);
end;
procedure TFImagenes.SpeedButtonBC2Click(Sender: TObject);
//------------------------------------------------------------------------------
//*********************************************************[ Botón pegar ]******
// código bajado de http://www.clubdelphi.com/foros/showthread.php?t=57360
// Del compañero Gluglu, para pegar desde el portapapeles
// Añadir al Uses las unit Clipbrd, jpeg, ShellAPI
//------------------------------------------------------------------------------
var
f : TFileStream;
Jpg : TJpegImage;
Hand : THandle;
Buffer : Array [0..MAX_PATH] of Char;
numFiles : Integer;
File_Name : String;
Jpg_Bmp : String;
BitMap : TBitMap;
ImageAux : TImage;
Modulo : string;
begin
Modulo:='Imagenes';
ImageAux := TImage.Create(Self);
if Clipboard.HasFormat(CF_HDROP) then
begin
Clipboard.Open;
try
Hand := Clipboard.GetAsHandle(CF_HDROP);
If Hand <> 0 then
begin
numFiles := DragQueryFile(Hand, $FFFFFFFF, nil, 0) ; //Unit ShellApi
if numFiles > 1 then
begin
Clipboard.Close;
ImageAux.Free;
Errorx('Pegar-1',Modulo,'Pegar','El Portapapeles contiene más de un único fichero. No es posible pegar','','',False,clSkyBlue,clNavy,500);
Exit;
end;
Buffer[0] := #0;
DragQueryFile( Hand, 0, buffer, sizeof(buffer)) ;
File_Name := buffer;
end;
finally
Clipboard.close;
end;
f := TFileStream.Create(File_Name, fmOpenRead);
Jpg := TJpegImage.Create;
Bitmap := TBitmap.Create;
try // Check if Jpg File
Jpg.LoadFromStream(f);
ImageAux.Picture.Assign(Jpg);
Jpg_Bmp := 'JPG';
except
f.seek(0,soFromBeginning);
Jpg_Bmp := '';
end;
if Jpg_Bmp = '' then
begin
try
Bitmap.LoadFromStream(f);
Jpg.Assign(Bitmap);
ImageAux.Picture.Assign(Jpg);
Jpg_Bmp := 'BMP';
except
Jpg_Bmp := '';
end;
end;
Jpg.Free;
Bitmap.Free;
f.Free;
if Jpg_Bmp = '' then
begin
ImageAux.Free;
Errorx('Pegar-2',Modulo,'Pegar','Fichero seleccionado no contiene ninguna Imagen del Tipo JPEG o BMP','','',False,clSkyBlue,clNavy,500);
Exit;
end;
end else
begin
if Clipboard.HasFormat(CF_BITMAP) then ImageAux.Picture.Assign(Clipboard)
else
begin
ImageAux.Free;
Errorx('Pegar-3',Modulo,'Pegar','El Portapapeles no contiene ninguna Imagen del Tipo JPEG o BMP','','',False,clSkyBlue,clNavy,500);
Exit;
end;
end;
Jpg := TJpegImage.Create;
try
Jpg.Assign(ImageAux.Picture.Graphic);
except
ImageAux.Free;
Errorx('Pegar-4',Modulo,'Pegar','El Portapapeles no contiene ninguna Imagen del Tipo JPEG o BMP','','',False,clSkyBlue,clNavy,500);
Jpg.Free;
Exit;
end;
Jpg.Free;
DBImage1.Picture.Assign(ImageAux.Picture);
end;
procedure TFImagenes.Timer1Timer(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************************[ El evento del Timer ]******
//------------------------------------------------------------------------------
begin
SBBarraStatus.Panels[2].Text:=TimeToStr(now);
if SBBarraStatus.Panels[1].Text<>DateToStr(Now) then SBBarraStatus.Panels[1].Text:=DateToStr(Now);
end;
end.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.