Aquí la 2º parte del código del archivo pas 682 lineas
Aquí el código del archivo pas 682 lineas
Código Delphi
[-]
procedure TUConfi.SpeedButtonBC10Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
DBIBMemo4.Lines.LoadFromFile(OpenPictureDialog1.FileName);
end;
end;
procedure TUConfi.SpeedButtonBC11Click(Sender: TObject);
begin
DsPrincipal.DataSet.FieldByName('XLDPD3').Value:=Clipboard.AsText;
end;
procedure TUConfi.SpeedButtonBC12Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
DBIBMemo2.Lines.LoadFromFile(OpenPictureDialog1.FileName);
end;
end;
procedure TUConfi.SpeedButtonBC15Click(Sender: TObject);
begin
if PGC.TabIndex>0 then PGC.TabIndex:=PGC.TabIndex-1;
end;
procedure TUConfi.SpeedButtonBC16Click(Sender: TObject);
begin
if PGC.TabIndexthen PGC.TabIndex:=PGC.TabIndex+1;
end;
procedure TUConfi.SpeedButtonBC1Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
begin
DBImage1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;
end;
procedure TUConfi.SpeedButtonBC2Click(Sender: TObject);
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;
begin
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) ; if numFiles > 1 then begin
Clipboard.Close;
ImageAux.Free;
Errorx('Pegar-1','Ingredientes','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
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','Ingredientes','Pegar','Fichero seleccionado no contiene ninguna Imagen del Tipo JPEG o BMP','','',False,clSkyBlue,clNavy,500);
Exit;
end;
end
else if Clipboard.HasFormat(CF_BITMAP) then
ImageAux.Picture.Assign(Clipboard)
else begin
ImageAux.Free;
Errorx('Pegar-3','Ingredientes','Pegar','El Portapapeles no contiene ninguna Imagen del Tipo JPEG o BMP','','',False,clSkyBlue,clNavy,500);
Exit;
end;
Jpg := TJpegImage.Create;
try
Jpg.Assign(ImageAux.Picture.Graphic);
except
ImageAux.Free;
Errorx('Pegar-4','Ingredientes','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 TUConfi.SpeedButtonBC3Click(Sender: TObject);
begin
DsPrincipal.DataSet.FieldByName('XLDPD1').Value:=Clipboard.AsText;
end;
procedure TUConfi.SpeedButtonBC4Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
DBIBMemo1.Lines.LoadFromFile(OpenPictureDialog1.FileName);
end;
end;
procedure TUConfi.SpeedButtonBC5Click(Sender: TObject);
begin
DsPrincipal.DataSet.FieldByName('XLDPD2').Value:=Clipboard.AsText;
end;
procedure TUConfi.SpeedButtonBC6Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
DBIBMemo3.Lines.LoadFromFile(OpenPictureDialog1.FileName);
end;
end;
procedure TUConfi.Timer1Timer(Sender: TObject);
begin
SBBarraStatus.Panels[2].Text:=TimeToStr(now);
if SBBarraStatus.Panels[1].Text<>DateToStr(Now) then SBBarraStatus.Panels[1].Text:=DateToStr(Now);
end;
end.