António44

Não consigo que funcione logo abrindo com duplo click no report guardado sem dar erro, já tentei o Debuguer mas tb não encontro o erro...quando dou duplo click na report guardada vejo pelo gestor de tarefas do win que a memória fica em carga e depois de fazer ok na mensagem do erro ela liberta ...mas porquê e onde??? agradecido. Abraço

Já tentei de varias maneiras para mostrar o relatorio quando se dá o duplo click no file da report guardada,agora tentei esta procedure no preview e não dá ...quer dizer a report é mostrada na perfeicão muda as paginas tudo correcto apenas quando executa retorna sempre um erro '''Access violation at address 0045D643 in module Gestor.exe read of adress 00000000. Aqui a procedure.... procedure TfrmPreview.Resgata; begin QRPreview.QRPrinter.Load(ParamStr(1)); Caption := 'A gerar relatório, por favôr aguarde...'; if QRPreview.QRPrinter.Title = '' then QRPreview.QRPrinter.Title := (ParamStr(1)); if QRPreview.QRPrinter.PageCount = 1 then Self.Caption := QRPreview.QRPrinter.Title + ' - ' + IntToStr(QRPreview.QRPrinter.PageCount) + ' pagina' else Self.Caption := QRPreview.QRPrinter.Title + ' - ' + IntToStr(QRPreview.QRPrinter.PageCount) + ' paginas'; bPleaseInit := True; Init; end; Esta roda em primeiro lugar Main Form. procedure TVisualizar.QuickRep1Preview(Sender: TObject); begin Application.CreateForm(TfrmPreview, frmPreview); with frmPreview do begin if ParamCount > 0 then if FileExists(ParamStr(1)) then begin pQuickReport:= QuickRep1; QRPreview.QRPrinter := TQRPrinter(Sender); Resgata; show; end else Caption := 'A gerar relatório, por favôr aguarde...'; pQuickReport:= QuickRep1; QRPreview.QRPrinter := TQRPrinter(Sender); Show; end; end; end. Aqui o code completo se executar o executavel ele roda na perfeição mas quando dou duplo click no report guardado...funciona mas dando o erro já descrito em cima. Main form. unit UnitVisualizar; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Db, Qrctrls, quickrpt, DBTables, ExtCtrls,qrprntr,Registry,ShlObj, qrextra,qrhtml; type TVisualizar = class(TForm) QuickRep1: TQuickRep; QRBand1: TQRBand; QRLabel1: TQRLabel; QRLabel2: TQRLabel; procedure FormCreate(Sender: TObject); procedure QuickRep1Preview(Sender: TObject); private { Private declarations } public { Public declarations } WhichPreviewToUse: integer; bCanPrint: boolean; procedure RegistrarExtensaoQRP; end; var Visualizar: TVisualizar; implementation uses Unit1; {$R *.DFM} procedure TVisualizar.RegistrarExtensaoQRP; var _reg: TRegistry; begin _reg := TRegistry.Create; try _reg.RootKey := HKEY_CLASSES_ROOT; _reg.LazyWrite := False; _reg.OpenKey('GestorV', True); _reg.WriteString('', 'Relatórios do Gestor de portarias'); _reg.CloseKey; _reg.OpenKey('GestorV\shell\open\command', True); _reg.WriteString('', ParamStr(0) + ' "%1"'); _reg.CloseKey; _reg.OpenKey('GestorV\DefaultIcon', True); _reg.WriteString('', ParamStr(0) + ',0'); _reg.CloseKey; _reg.OpenKey('.QRP', True); _reg.WriteString('', 'GestorV'); _reg.CloseKey; finally _reg.free; end; SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil); end; procedure TVisualizar.FormCreate(Sender: TObject); begin RegistrarExtensaoQRP; WhichPreviewToUse := 0; bCanPrint := True; with QuickRep1 do begin preview; end; free; end; procedure TVisualizar.QuickRep1Preview(Sender: TObject); begin Application.CreateForm(TfrmPreview, frmPreview); with frmPreview do begin if ParamCount > 0 then if FileExists(ParamStr(1)) then begin pQuickReport:= QuickRep1; QRPreview.QRPrinter := TQRPrinter(Sender); Resgata; show; end else Caption := 'A gerar relatório, por favôr aguarde...'; pQuickReport:= QuickRep1; QRPreview.QRPrinter := TQRPrinter(Sender); Show; end; end; end. Preview... unit unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls, Spin, qrprntr,quickrpt,qrextra,qrhtml, Buttons,Mylabel, TFlatSpeedButtonUnit,TypInfo,ShlObj; type TfrmPreview = class(TForm) Panel1: TPanel; QRPreview: TQRPreview; sePage: TSpinEdit; seZoom: TSpinEdit; SaveDialogExport: TSaveDialog; SpinEditCopies: TSpinEdit; Panel2: TPanel; sbFirstPage: TFlatSpeedButton; sbPreviousPage: TFlatSpeedButton; sbNextPage: TFlatSpeedButton; sbLastPage: TFlatSpeedButton; myLabel3d1: TmyLabel3d; ZoomToFit: TFlatSpeedButton; ZoomTo100: TFlatSpeedButton; ZoomToWidth: TFlatSpeedButton; PrintSetup: TFlatSpeedButton; Print: TFlatSpeedButton; myLabel3d2: TmyLabel3d; lblCopies: TmyLabel3d; Load: TFlatSpeedButton; Save: TFlatSpeedButton; BitBtnExit: TFlatSpeedButton; Bevel1: TBevel; procedure Init; procedure sePageChange(Sender: TObject); procedure seZoomChange(Sender: TObject); procedure FormShow(Sender: TObject); procedure cmdExitClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure QRPreviewPageAvailable(Sender: TObject; PageNum: Integer); procedure FormCreate(Sender: TObject); procedure sbFirstPageClick(Sender: TObject); procedure sbPreviousPageClick(Sender: TObject); procedure sbNextPageClick(Sender: TObject); procedure sbLastPageClick(Sender: TObject); procedure ZoomToFitClick(Sender: TObject); procedure ZoomTo100Click(Sender: TObject); procedure ZoomToWidthClick(Sender: TObject); procedure PrintSetupClick(Sender: TObject); procedure PrintClick(Sender: TObject); procedure SaveClick(Sender: TObject); procedure CancelReport; procedure LoadClick(Sender: TObject); procedure BitBtnExitClick(Sender: TObject); private { Private declarations } public pQuickreport : TQuickRep; bPleaseInit : Boolean; sTitle : string; bCanPrint: boolean; procedure Resgata; { Public declarations } end; var frmPreview: TfrmPreview; implementation uses UnitVisualizar; {$R *.DFM} procedure TfrmPreview.sePageChange(Sender: TObject); begin Application.ProcessMessages; QRPreview.PageNumber:=sePage.Value; end; procedure TfrmPreview.seZoomChange(Sender: TObject); begin Application.ProcessMessages; QRPreview.Zoom:=seZoom.Value; end; procedure TfrmPreview.Init; begin if bPleaseInit then begin sePage.MaxValue := QRPreview.QRPrinter.PageCount; sePage.MinValue := 1; sePage.Value := 1; QRPreview.Zoom:=100; ZoomTo100.Down := True; seZoom.Value:=QRPreview.Zoom; bPleaseInit := False; end; end; procedure TfrmPreview.FormShow(Sender: TObject); var OffSet: integer; begin bPleaseInit := True; if not bCanPrint then begin Print.Enabled := bCanPrint; Print.Visible := bCanPrint; PrintSetup.Enabled := Print.Enabled; PrintSetup.Visible := Print.Enabled; lblCopies.Visible := Print.Enabled; SpinEditCopies.Enabled := Print.Enabled; SpinEditCopies.Visible := Print.Enabled; OffSet := Load.Left - lblCopies.Left; Load.Left := Load.Left - Offset; Save.Left := Save.Left - Offset; BitBtnExit.Left := BitBtnExit.Left - Offset; end; end; procedure TfrmPreview.cmdExitClick(Sender: TObject); begin Close; end; procedure TfrmPreview.FormClose(Sender: TObject; var Action: TCloseAction); begin QRPreview.QRPrinter := nil; Action := caFree; release; end; procedure TfrmPreview.QRPreviewPageAvailable(Sender: TObject; PageNum: Integer); begin Init; sePage.MaxValue := PageNum; if PageNum = 1 then Caption := QRPreview.QRPrinter.Title + ' - 1 página' else Caption := QRPreview.QRPrinter.Title + ' - ' + IntToStr(PageNum) + ' páginas'; case QRPreview.QRPrinter.Status of mpReady: Caption := Caption + ' pronto'; mpBusy: Caption := Caption + ' ocupado'; mpFinished: Caption := Caption + ' concluido'; end; end; procedure TfrmPreview.FormCreate(Sender: TObject); begin sbFirstPage.Glyph.Handle := LoadBitmap(hinstance, 'QRFIRSTPAGEBITMAP'); sbPreviousPage.Glyph.Handle := LoadBitmap(hinstance, 'QRPREVPAGEBITMAP'); sbNextPage.Glyph.Handle := LoadBitmap(hinstance, 'QRNEXTPAGEBITMAP'); sbLastPage.Glyph.Handle := LoadBitmap(hinstance, 'QRLASTPAGEBITMAP'); ZoomToFit.Glyph.Handle := LoadBitmap(hinstance, 'QRZOOMTOFITBITMAP'); ZoomTo100.Glyph.Handle := LoadBitmap(hinstance, 'QRZOOMTO100BITMAP'); ZoomToWidth.Glyph.Handle := LoadBitmap(hinstance, 'QRZOOMTOWIDTHBITMAP'); PrintSetup.Glyph.Handle := LoadBitmap(hinstance, 'QRPRINTSETUPBITMAP'); Print.Glyph.Handle := LoadBitmap(hinstance, 'QRPRINTBITMAP'); Load.Glyph.Handle := LoadBitmap(hinstance, 'QROPENBITMAP'); Save.Glyph.Handle := LoadBitmap(hinstance, 'QRSAVEBITMAP'); { Load strings for hints } //ZoomToFit.Hint := LoadStr( SqrZoomToFit ); //ZoomTo100.Hint := LoadStr( SqrZoom100 ); //ZoomToWidth.Hint := LoadStr( SqrZoomToWidth ); //sbFirstPage.Hint := LoadStr( SqrFirstPage ); //sbLastPage.Hint := LoadStr( SqrLastPage ); //sbPreviousPage.Hint := LoadStr( SqrPrevPage ); //sbNextPage.Hint := LoadStr( SqrNextPage ); //PrintSetup.Hint := LoadStr( SqrPrinterSetup ); //Print.Hint := LoadStr( SqrPrintReport ); //Save.Hint := LoadStr( SqrSaveReport ); //Load.Hint := LoadStr( SqrLoadReport ); WindowState := wsMaximized; FormStyle := fsStayOnTop; bCanPrint := True; end; procedure TfrmPreview.sbFirstPageClick(Sender: TObject); begin Application.ProcessMessages; sePage.Value := 1; QRPreview.PageNumber:=sePage.Value; end; procedure TfrmPreview.sbPreviousPageClick(Sender: TObject); begin Application.ProcessMessages; if sePage.Value > 1 then begin sePage.Value := sePage.Value - 1; QRPreview.PageNumber:=sePage.Value; end; end; procedure TfrmPreview.sbNextPageClick(Sender: TObject); begin Application.ProcessMessages; if sePage.Value < QRPreview.QRPrinter.PageCount then begin sePage.Value := sePage.Value + 1; QRPreview.PageNumber:=sePage.Value; end; end; procedure TfrmPreview.sbLastPageClick(Sender: TObject); begin Application.ProcessMessages; sePage.Value := QRPreview.QRPrinter.PageCount; QRPreview.PageNumber:=sePage.Value; end; procedure TfrmPreview.ZoomToFitClick(Sender: TObject); begin Application.ProcessMessages; QRPreview.ZoomToFit; seZoom.Value:=QRPreview.Zoom; end; procedure TfrmPreview.ZoomTo100Click(Sender: TObject); begin Application.ProcessMessages; QRPreview.Zoom:=100; seZoom.Value:=QRPreview.Zoom; end; procedure TfrmPreview.ZoomToWidthClick(Sender: TObject); begin Application.ProcessMessages; QRPreview.ZoomToWidth; seZoom.Value:=QRPreview.Zoom; end; procedure TfrmPreview.PrintSetupClick(Sender: TObject); begin { With 2.0j, QuickReport will set the report's tag property to -1 if the user cancels the printersetup. By checking for this value, we can call the print method directly from setup if the users selects OK } with pQuickReport do begin tag := -1; { Just in case you are using an older version } PrinterSetup; if tag = 0 then print; end; end; procedure TfrmPreview.PrintClick(Sender: TObject); begin Print.Enabled := False; QRPreview.qrprinter.Print; Print.Enabled := True; end; procedure TfrmPreview.SaveClick(Sender: TObject); var aExportFilter : TQRExportFilter; {$ifndef win32} FileExt : string; I : integer; {$endif} begin aExportFilter := nil; with TSaveDialog.Create(Application) do try Filter := QRExportFilterLibrary.SaveDialogFilterString; { DefaultExt := cQRPDefaultExt;} if Execute then begin {$ifdef win32} if FilterIndex = 1 then begin if Pos('.', Filename) = 0 then Filename := Filename + '.qrp'; QRPreview.QRPrinter.Save(Filename); end else begin try aExportFilter := TQRExportFilterLibraryEntry( QRExportFilterLibrary.Filters[FilterIndex - 2]).ExportFilterClass.Create(Filename); QRPreview.QRPrinter.ExportToFilter(aExportFilter); finally aExportFilter.Free end end {$else} FileExt := ExtractFileExt(Filename); if copy(FileExt, 1, 1) = '.' then delete(FileExt, 1, 1); if (FileExt = '') or (FileExt = cQRPDefaultExt) then QRPreview.QRPrinter.Save(Filename) else begin for I := 0 to QRExportFilterLibrary.Filters.Count - 1 do begin if TQRExportFilterLibraryEntry(QRExportFilterLibrary.Filters[I]).Extension = FileExt then try aExportFilter := TQRExportFilterLibraryEntry( QRExportFilterLibrary.Filters[I]).ExportFilterClass.Create(Filename); QRPreview.QRPrinter.ExportToFilter(aExportFilter); finally aExportFilter.Free; end; end; end; {$endif} end; finally Free; end; end; procedure TfrmPreview.CancelReport; begin if pQuickReport.qrprinter.status = mpBusy then if MessageDlg('Fechar visualizacão ?', mtConfirmation, mbOKCancel,0) = mrOK then begin QRPrinter.Cancel; QRPreview.qrprinter := nil; end; end; procedure TfrmPreview.LoadClick(Sender: TObject); begin with TOpenDialog.Create(Application) do try Filter := 'QuickReport files (*.qrp)|*.qrp'; if Execute then if FileExists(FileName) then begin QRPreview.QRPrinter.Load(Filename); QRPreview.PageNumber := 1; QRPreview.PreviewImage.PageNumber := 1; if QRPreview.QRPrinter.Title = '' then QRPreview.QRPrinter.Title := Filename; if QRPreview.QRPrinter.PageCount = 1 then Self.Caption := QRPreview.QRPrinter.Title + ' - ' + IntToStr(QRPreview.QRPrinter.PageCount) + ' pagina' else Self.Caption := QRPreview.QRPrinter.Title + ' - ' + IntToStr(QRPreview.QRPrinter.PageCount) + ' paginas'; bPleaseInit := True; Init; end else ShowMessage('Este ficheiro não pode ser visualizado: ' + FileName); finally free; end; end; procedure TfrmPreview.BitBtnExitClick(Sender: TObject); begin Application.terminate; end; procedure TfrmPreview.Resgata; begin QRPreview.QRPrinter.Load(ParamStr(1)); Caption := 'A gerar relatório, por favôr aguarde...'; if QRPreview.QRPrinter.Title = '' then QRPreview.QRPrinter.Title := (ParamStr(1)); if QRPreview.QRPrinter.PageCount = 1 then Self.Caption := QRPreview.QRPrinter.Title + ' - ' + IntToStr(QRPreview.QRPrinter.PageCount) + ' pagina' else Self.Caption := QRPreview.QRPrinter.Title + ' - ' + IntToStr(QRPreview.QRPrinter.PageCount) + ' paginas'; bPleaseInit := True; Init; end; end. Não consigo que funcione logo abrindo o report guardado sem dar erro, já tentei o Debuguer mas tb não encontro o erro...quando dou duplo click na report guardada vejo pelo gestor de tarefas do win que a memória fica em carga e depois de fazer ok na mensagem do erro ela liberta ...mas porquê e onde??? agradecido. Abraço

Algum amigo ai sabe onde posso descarregar update ??? Abraço

Amigos estou usando esta Unit para redimencionar os formulário principalmente a form Principal,o que acontece é que aparece os Panel aumentados mas os SpeedButton não altera se tenho Labels tambem ficam mal e Bevel tambem não acompanha o form imagem tb não...alguêm tem alguma ideia que possa ajudar. Abraço unit sCtrlResize; interface uses StdCtrls, Controls, Forms ; procedure CtrlResize(var Sender: TForm); export; implementation procedure CtrlResize(var Sender: TForm); const iWidth = 1280; iHeight = 800; var i : Integer; begin with Sender do for i := 0 to ComponentCount -1 do begin { aqui era suposto varrer todos os componentes do form que possam ser redefinidos (classe TWinControl) } if Components[i] is TWinControl then begin { Redefine os componentes em proporção ao original } TWinControl(Components[i]).Width := Round(TWinControl(Components[i]).Width * (Screen.Width / iWidth)); TWinControl(Components[i]).Height := Round(TWinControl(Components[i]).Height * (Screen.Height / iHeight)); TWinControl(Components[i]).Left := Round(TWinControl(Components[i]).Left * (Screen.Width / iWidth)); TWinControl(Components[i]).Top := Round(TWinControl(Components[i]).Top * (Screen.Height / iHeight)); end else if Components[i] is TLabel then begin { Redefine os componentes em proporção ao original } TLabel(Components[i]).Width := Canvas.TextWidth(TLabel(Components[i]).Caption); // Round(TWinControl(Components[i]).Width * (Screen.Width / iWidth)); TLabel(Components[i]).Height := Canvas.TextHeight(TLabel(Components[i]).Caption); // Round(TWinControl(Components[i]).Height * (Screen.Height / iHeight)); TLabel(Components[i]).Left := Round(TWinControl(Components[i]).Left * (Screen.Width / iWidth)); TLabel(Components[i]).Top := Round(TWinControl(Components[i]).Top * (Screen.Height / iHeight)); end; end; //Para não alterar o tamanho e posição do form já tentei de varias maneiras mas quando rodo em 1280 por 960 dá buraco (* { Redefine o Formulário } Sender.Width := Round(Sender.Width * (Screen.Width / iWidth)); Sender.Height := Round(Sender.Height * (Screen.Height / iHeight)); Sender.Top := Round(Sender.Top * (Screen.Height / iHeight)); Sender.Left := Round(Sender.Left * (Screen.Width / iWidth)); *) { Altera o tamanho da Fonte do Formulário????????? } Sender.Font.Size := Round(Sender.Font.Size * (Screen.Height / iHeight)); end; end. {* procedure TfrmCadEmpresas.FormShow(Sender: TObject); begin sCtrlResize.CtrlResize(TForm(frmEmpresas)); end; *}

//-- Primeiro declare a função na cláusula PRIVATE do seu form private {private declarations} Function DataIdade(DataNascimento : String) : Integer; public implementation //-- Depois coloque o corpo da função após a cláusula implementation Function TForm1.DataIdade(DataNascimento : String) : Integer; begin try strtodate(datanascimento); //-- Verifica se a data é valida except messagedlg('Data de nascimento inválida!', MTERROR, [MBOK], 0); abort; end; result := Trunc((Date - Strtodate(DataNascimento))/365.25); end; //-- Pronto, agora é só atribuir a um controle //- - tipo: edit1.text := inttostr(dataidade('12/01/1980')); abraço

Mas não estou usando imagem...? apenas bandas com cor silver...!Title pagefooter grup gupfooter ect. Abraço

Consegui arranjar algo que funciona bem na visualização e impresão mas quando salvo uma report mais elaborada para um file tipo QRP e tento puxar ao visualizador dá um erro ao carregar e não mostra o erro é o seguinte ''Metafile is not valid '' mas em algumas mais simples ele carrega bem e visualizo na boa...que poderá ser ??? Abraço

Gostaria de saber se no Quickrep tem maneira de retirar os botões ...Load ,Save e Printer Setup e quando abre a pagina ficar o Zoom to 100% Abraço

O que eu estou querendo é que o programa funcione completamente Portable via USB assim...Meu soft\BDE,a BDE fica na USB eu não uso um Alias para me ligar uso apenas assim para ligar aos dados procedure TData.DataCreate(Sender: TObject); var AppDir: string; begin AppDir := ExtractFilePath(Application.ExeName)+'Database'; TablePrincipal.DatabaseName := AppDir; TablePrincipal.open; procedure TReport3.FormCreate(Sender: TObject); var AppDir: string; begin AppDir := ExtractFilePath(Application.ExeName)+'Database'; RepQuery.DatabaseName := AppDir; end; Tudo funciona bem em pc que não tem a BDE instalada mas que deixe escrever no Registro por modo do componente BDE32...eu queria que funcionasse sem dar aos usuários permissão de aceder ao registro. abraço

Estou testando em XP mas onde usuário não pode aceder ao Reg .E nem deixa escrever nada no reg. Abraço amigo Jhonas.

O cod que estava usando era esse funciona bem excepto em pc que previlégio de admin...eu queria que funcionasse sem o usuário ter esse previlégio directamente de uma USB unit BDE32; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Registry; type TBDE32 = class(TComponent) private FLocalShare: Boolean; FPdxNetDir: String; FMaxBufSize, FMaxFileHandles, FMemSize, FSharedMemSize: integer; function GetRegistryDir(RegKey, DefaultDir: string): String; procedure TestBDEDir(TestDir: string; var CF: string; var DLLP: string); function GetPaths(var CF: string; var DLLP: string): boolean; procedure writeToCFG(Item: string; Val: string); function ReadFromCFG(Item: string; DefStr: string): string; protected { Protected declarations } public constructor Create(AOwner:TComponent); override; published property LocalShare: boolean read FLocalShare write FLocalShare; property PdxNetDir: String read FPdxNetDir write FPdxNetDir; property MaxBufSize: integer read FMaxBufSize write FMaxBufSize; property MaxFileHandles: integer read FMaxFileHandles write FMaxFileHandles; property MemSize: integer read FMemSize write FMemSize; property SharedMemSize: integer read FSharedMemSize write FSharedMemSize; procedure WriteSettings; procedure ReadSettings; end; function FilePos(FileName, What: string; startFrom: integer):integer; procedure Register; implementation {thanks to Andrea Sessa (asessa@nest.it) for the leading '\' on all registry paths... and to Remy Vincent (remyvincent@hotmail.com) for the GetCommonFilesDir function and for providing key dirs to look for BDE files... anyone else who improves BDE32 will get a mention - email paul@kestrelsoftware.co.uk with your improvements} {########################### Check for BDE installation ###########################} constructor TBDE32.Create(AOwner:TComponent); var ConfigFile, DLLPath: string; begin {Create: 1. Discover if BDE is installed by checing registry 2. If not then look for BDE files and write loctations to Registry 3. If unable to find BDE files then ask for them 4. Finally read key settings from CFG file (if available)} inherited Create(AOwner); with TRegistry.create do begin Rootkey := HKEY_LOCAL_MACHINE; if not (OpenKey('\SOFTWARE\BORLAND\DATABASE ENGINE', false) and FileExists(ReadString('DLLPATH') + '\idapi32.dll')) then begin if GetPaths(ConfigFile, DLLPath) then begin Rootkey := HKEY_LOCAL_MACHINE; OpenKey('\SOFTWARE\BORLAND\DATABASE ENGINE', True); WriteString('CONFIGFILE01', ConfigFile); WriteString('DLLPATH', DLLPath); WriteString('RESOURCE', '0009'); WriteString('SAVECONFIG', 'WIN31'); WriteString('UseCount', '1'); end else begin ShowMessage('Please put BDE files in ' + ExtractFilePath(application.ExeName) + 'BDE'); halt; end; end; Free; end; ReadSettings; end; {########################### Read/Write to CFG file ###########################} procedure TBDE32.ReadSettings; begin FPdxNetDir := ReadFromCFG('NET DIR', 'F:\'); FLocalShare := ReadFromCFG('LOCAL SHARE', 'FALSE') = 'TRUE'; FMaxBufSize := StrToInt(ReadFromCFG('MAXBUFSIZE', '2048')); FMaxFileHandles := StrToInt(ReadFromCFG('MAXFILEHANDLES', '48')); FMemSize := StrToInt(ReadFromCFG('MEMSIZE', '16')); FSharedMemSize := StrToInt(ReadFromCFG('SHAREDMEMSIZE', '2048')); end; procedure TBDE32.WriteSettings; begin if FLocalShare then writeToCFG('LOCAL SHARE', 'TRUE') else writeToCFG('LOCAL SHARE', 'FALSE'); writeToCFG('NET DIR', FPdxNetDir); writeToCFG('MAXBUFSIZE', IntToStr(FMaxBufSize)); writeToCFG('MAXFILEHANDLES', IntToStr(FMaxFileHandles)); writeToCFG('MEMSIZE', IntToStr(FMemSize)); writeToCFG('SHAREDMEMSIZE', IntToStr(FSharedMemSize)); end; procedure TBDE32.writeToCFG(Item: string; Val: string); Var CFGFile, TempFile: string; CFGStream, TempStream: TFileStream; FoundPos1, FoundPos2: integer; myBuf: array[0..255] of char; begin with TRegistry.create do begin Rootkey := HKEY_LOCAL_MACHINE; OpenKey('\SOFTWARE\BORLAND\DATABASE ENGINE', false); CFGFile := ReadString('CONFIGFILE01'); Free; end; TempFile := CFGFile + '2'; FoundPos1 := FilePos(CFGFile, Item, 0); if FoundPos1 > 0 then begin FoundPos2 := FilePos(CFGFile, #0, FoundPos1 + Length(Item) + 3); CFGStream := TFileStream.Create(CFGFile, fmOpenRead); TempStream := TFileStream.Create(TempFile, fmOpenWrite or fmCreate); TempStream.CopyFrom(CFGStream, FoundPos1 + Length(Item) + 2); StrPCopy(MyBuf, Val); TempStream.Write(MyBuf, length(Val)); CFGStream.Seek(FoundPos2 - 1, soFromBeginning); TempStream.CopyFrom(CFGStream, CFGStream.Size - FoundPos2 + 1); TempStream.Free; CFGStream.Free; end; DeleteFile(CFGFile); RenameFile(TempFile, CFGFile); end; function TBDE32.ReadFromCFG(Item: string; DefStr: string): string; Var CFGFile: string; FoundPos1, FoundPos2: integer; MyFile: TextFile; MyStr: string; begin with TRegistry.create do begin Rootkey := HKEY_LOCAL_MACHINE; OpenKey('\SOFTWARE\BORLAND\DATABASE ENGINE', false); CFGFile := ReadString('CONFIGFILE01'); Free; end; if FileExists(CFGFile) then begin AssignFile(MyFile, CFGFile); Reset(MyFile); ReadLn(MyFile, MyStr); CloseFile(MyFile); FoundPos1 := Pos(Item, MyStr); if FoundPos1 > 0 then begin Delete(MyStr, 1, FoundPos1 + Length(Item) + 2); foundPos2 := Pos(#0, MyStr); Result := Copy(MyStr, 0, FoundPos2 + 1); end else result := DefStr; end else result := DefStr; end; function FilePos(FileName, What: string; startFrom: integer): integer; var MyStr: string; MyFile: TextFile; begin if FileExists(FileName) then begin AssignFile(MyFile, FileName); Reset(MyFile); ReadLn(MyFile, MyStr); Delete(MyStr, 1, StartFrom); Result := StartFrom + Pos(What, MyStr); CloseFile(MyFile); end else result := 0; end; {########################### Find a previous BDE ###########################} function TBDE32.GetPaths(var CF: string; var DLLP: string): boolean; var AppDir, CommonDir, ProgDir: string; begin {GetPaths: looks for the BDE, assumed to be found if a ConfigFile (CF) and DLL Path (DLLP) are found. You can add your own search paths to these ones, remember that they are checked in order, so if 2 BDE's are found then the second one will be used} AppDir := ExtractFilePath(Application.ExeName); AppDir := Copy(AppDir, 1, length(AppDir) - 1); {get rid of the last '\'} CommonDir := GetRegistryDir('CommonFilesDir', 'C:\Program Files\Common Files'); ProgDir := GetRegistryDir('ProgramFilesDir', 'C:\Program Files'); TestBDEDir(AppDir, CF, DLLP); TestBDEDir(AppDir + '\BDE', CF, DLLP); TestBDEDir(ProgDir + '\borland\common files\BDE', CF, DLLP); TestBDEDir(CommonDir + '\BDE', CF, DLLP); TestBDEDir(CommonDir + '\Borland\BDE', CF, DLLP); TestBDEDir(CommonDir + '\Borland Shared\BDE', CF, DLLP); Result := FileExists(CF) and FileExists(DLLP + '\idapi32.dll'); end; procedure TBDE32.TestBDEDir(TestDir: string; var CF: string; var DLLP: string); begin if FileExists(TestDir + '\idapi.cfg') then CF := TestDir + '\idapi.cfg'; if FileExists(TestDir + '\idapi32.cfg') then CF := TestDir + '\idapi32.cfg'; if FileExists(TestDir + '\idapi32.dll') then DLLP := TestDir; end; function TBDE32.GetRegistryDir(RegKey, DefaultDir: string): String; begin with TRegistry.create do begin Rootkey := HKEY_LOCAL_MACHINE; OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion', false); Result := ReadString(RegKey); Free; end; if Result = '' then Result := DefaultDir; end; {########################### Register Component ###########################} procedure Register; begin RegisterComponents('Data Access', [TBDE32]); end; end. unit BDE32; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Registry; type TBDE32 = class(TComponent) private FUsingCFG: Boolean; FLocalShare: Boolean; FPdxNetDir: String; FMaxBufSize, FMaxFileHandles, FMemSize, FSharedMemSize: integer; function GetPaths(var CF: string; var DLLP: string): boolean; procedure writeToCFG(Item: string; Val: string); function ReadFromCFG(Item: string; DefStr: string): string; protected { Protected declarations } public constructor Create(AOwner:TComponent); override; published property LocalShare: boolean read FLocalShare write FLocalShare; property PdxNetDir: String read FPdxNetDir write FPdxNetDir; property MaxBufSize: integer read FMaxBufSize write FMaxBufSize; property MaxFileHandles: integer read FMaxFileHandles write FMaxFileHandles; property MemSize: integer read FMemSize write FMemSize; property SharedMemSize: integer read FSharedMemSize write FSharedMemSize; procedure WriteSettings; procedure ReadSettings; end; function FilePos(FileName, What: string; startFrom: integer):integer; procedure Register; implementation constructor TBDE32.Create(AOwner:TComponent); var ConfigFile, DLLPath: string; begin inherited Create(AOwner); with TRegistry.create do begin Rootkey := HKEY_LOCAL_MACHINE; if not (OpenKey('SOFTWARE\BORLAND\DATABASE ENGINE', false) and FileExists(ReadString('DLLPATH') + '\idapi32.dll')) then begin if GetPaths(ConfigFile, DLLPath) then begin Rootkey := HKEY_LOCAL_MACHINE; OpenKey('SOFTWARE\BORLAND\DATABASE ENGINE', True); WriteString('CONFIGFILE01', ConfigFile); WriteString('DLLPATH', DLLPath); WriteString('RESOURCE', '0009'); WriteString('SAVECONFIG', 'WIN32'); WriteString('UseCount', '15'); end else begin ShowMessage('Please put BDE files in ' + ExtractFilePath(application.ExeName) + 'BDE'); halt; end; end; Free; end; ReadSettings; end; procedure TBDE32.ReadSettings; begin FPdxNetDir := ReadFromCFG('NET DIR', 'G:\'); FLocalShare := ReadFromCFG('LOCAL SHARE', 'FALSE') = 'TRUE'; FMaxBufSize := StrToInt(ReadFromCFG('MAXBUFSIZE', '2048')); FMaxFileHandles := StrToInt(ReadFromCFG('MAXFILEHANDLES', '48')); FMemSize := StrToInt(ReadFromCFG('MEMSIZE', '16')); FSharedMemSize := StrToInt(ReadFromCFG('SHAREDMEMSIZE', '2048')); end; procedure TBDE32.WriteSettings; begin if FLocalShare then writeToCFG('LOCAL SHARE', 'TRUE') else writeToCFG('LOCAL SHARE', 'FALSE'); writeToCFG('NET DIR', FPdxNetDir); writeToCFG('MAXBUFSIZE', IntToStr(FMaxBufSize)); writeToCFG('MAXFILEHANDLES', IntToStr(FMaxFileHandles)); writeToCFG('MEMSIZE', IntToStr(FMemSize)); writeToCFG('SHAREDMEMSIZE', IntToStr(FSharedMemSize)); end; procedure TBDE32.writeToCFG(Item: string; Val: string); Var CFGFile, TempFile: string; CFGStream, TempStream: TFileStream; FoundPos1, FoundPos2: integer; myBuf: array[0..255] of char; begin with TRegistry.create do begin Rootkey := HKEY_LOCAL_MACHINE; OpenKey('SOFTWARE\BORLAND\DATABASE ENGINE', false); CFGFile := ReadString('CONFIGFILE01'); Free; end; TempFile := CFGFile + '2'; FoundPos1 := FilePos(CFGFile, Item, 0); if FoundPos1 > 0 then begin FoundPos2 := FilePos(CFGFile, #0, FoundPos1 + Length(Item) + 3); CFGStream := TFileStream.Create(CFGFile, fmOpenRead); TempStream := TFileStream.Create(TempFile, fmOpenWrite or fmCreate); TempStream.CopyFrom(CFGStream, FoundPos1 + Length(Item) + 2); StrPCopy(MyBuf, Val); TempStream.Write(MyBuf, length(Val)); CFGStream.Seek(FoundPos2 - 1, soFromBeginning); TempStream.CopyFrom(CFGStream, CFGStream.Size - FoundPos2 + 1); TempStream.Free; CFGStream.Free; end; DeleteFile(CFGFile); RenameFile(TempFile, CFGFile); end; function TBDE32.ReadFromCFG(Item: string; DefStr: string): string; Var CFGFile: string; FoundPos1, FoundPos2: integer; MyFile: TextFile; MyStr: string; begin with TRegistry.create do begin Rootkey := HKEY_LOCAL_MACHINE; OpenKey('SOFTWARE\BORLAND\DATABASE ENGINE', false); CFGFile := ReadString('CONFIGFILE01'); Free; end; if FileExists(CFGFile) then begin AssignFile(MyFile, CFGFile); Reset(MyFile); ReadLn(MyFile, MyStr); CloseFile(MyFile); FoundPos1 := Pos(Item, MyStr); if FoundPos1 > 0 then begin Delete(MyStr, 1, FoundPos1 + Length(Item) + 2); foundPos2 := Pos(#0, MyStr); Result := Copy(MyStr, 0, FoundPos2 + 1); end else result := DefStr; end else result := DefStr; end; function FilePos(FileName, What: string; startFrom: integer): integer; var MyStr: string; MyFile: TextFile; begin if FileExists(FileName) then begin AssignFile(MyFile, FileName); Reset(MyFile); ReadLn(MyFile, MyStr); Delete(MyStr, 1, StartFrom); Result := StartFrom + Pos(What, MyStr); CloseFile(MyFile); end else result := 0; end; function TBDE32.GetPaths(var CF: string; var DLLP: string): boolean; var AppDir: string; begin AppDir := ExtractFilePath(Application.ExeName); if FileExists(AppDir + 'idapi32.cfg') then CF := AppDir + 'idapi32.cfg'; if FileExists(AppDir + 'idapi32.dll') then DLLP := Copy(AppDir, 1, Length(AppDir) - 1); if FileExists(AppDir + 'BDE\idapi32.cfg') then CF := AppDir + 'BDE\idapi32.cfg'; if FileExists(AppDir + 'BDE\idapi32.dll') then DLLP := AppDir + 'BDE'; if FileExists('c:\program files\borland\common .....................................erro aqui files\BDE\idapi32.cfg') then CF := 'c:\program files\borland\common files\BDE\idapi32.cfg'; if FileExists('c:\program files\borland\common files\BDE\idapi32.dll') then DLLP := 'c:\program files\borland\common files\BDE'; Result := FileExists(CF) and FileExists(DLLP + '\idapi32.dll'); end; procedure Register; begin RegisterComponents('DataAccess', [TBDE32]); end; end. Este testei mas tb não dá...Erro logo na compilação marcado em cima tirei aquelas duas linhas compilou bem sem erro mas testando no pc sem privilégio de admin da o erro descrito acima....ERegistryException in Module Gestor.exe Failed set data for 'ConfigFile01'

''acontece um erro penso que seja quando o componente quer escrever no registro'' ERegistryException in Module Gestor.exe Failed set data for 'ConfigFile01' Este é o erro quando o tenta escrever no registro.o codigo está no proprio componente BDE32. constructor TBDE32.Create(AOwner:TComponent); var ConfigFile, DLLPath: string; begin {Create: 1. Discover if BDE is installed by checing registry 2. If not then look for BDE files and write loctations to Registry 3. If unable to find BDE files then ask for them 4. Finally read key settings from CFG file (if available)} inherited Create(AOwner); with TRegistry.create do begin Rootkey := HKEY_LOCAL_MACHINE; if not (OpenKey('\SOFTWARE\BORLAND\DATABASE ENGINE', false) and FileExists(ReadString('DLLPATH') + '\idapi32.dll')) then begin if GetPaths(ConfigFile, DLLPath) then begin Rootkey := HKEY_LOCAL_MACHINE; OpenKey('\SOFTWARE\BORLAND\DATABASE ENGINE', True); WriteString('CONFIGFILE01', ConfigFile); WriteString('DLLPATH', DLLPath); WriteString('RESOURCE', '0009'); WriteString('SAVECONFIG', 'WIN31'); WriteString('UseCount', '1'); end else begin ShowMessage('Please put BDE files in ' + ExtractFilePath(application.ExeName) + 'BDE'); halt; end; end; Free; end; ReadSettings; Obrigado, abraço

Tenho bases de dados a funcionar com este componente BDE32 delphi 3 mas agora precisava usar num pc que não tem previlégio de administrador...acontece um erro penso que seja quando o componente quer escrever no registo,...haverá maneira de dar volta a isto sem mudar previlégios.???? agradeço ai aos amigos se puderem ajudar. Abraços

Sabem se é possivel instalar o D3 em uma Pen e transportar de um pc para outro sem instalar??

Usei Paradox 7 BDE Delphi 3...já faz tempo . :wacko:

Amigos estou com um problema com os meus clientes é o seguinte.: Quando acontece uma falha de energia e o cliente tem o meu soft.a rodar com um registo em aberto... que ainda não foi feito um 'Post' na tabela acontece que as malditas ficam corrumpidas??? deixo de ter acesso aos dados? alguém ai dos amigos poderá ajudar? agradeço.

No formClose do principal você pode usar no fecho do programa o code. Application.terminate;

query1.close; query1.sql.clear; query1.sql.add('select * from tabela where data=:data'); query1.parambyname('data').asdate:=''; query1.open;

Como fazer um contador para login...declarar a variavel Contador na form Login. implementation uses UnitDM; var Contador:integer; No DataModule você pode mostrar a form Principal e criar a form Login. procedure TDM.DMCreate(Sender: TObject); begin DM.TableUsers.Open; Principal.show; frmlogin:=Tfrmlogin.create(self); frmlogin.show; end; Aqui tem um procedimento que se falha o Nome 3 vezes fecha e se falha a Senha tb 3 vezes fecha. procedure TFrmLogin.SpeedButton1Click(Sender: TObject); var ValorSenha:TstringField; begin if not DM.tableusers.findkey([ednome.text]) then begin pnlMensagem.Caption:='Login Recusado, Usuário Desconhecido...'; inc(Contador); if contador=3 then Principal.close; ednome.setfocus; Exit; end; ValorSenha:=DM.tableUsers.findfield('Senha') as tStringfield; if valorsenha.value<>edsenha.text then begin pnlMensagem.Caption:='Login Recusado, Senha Inválida...'; inc(Contador); if Contador=3 then Principal.close; edsenha.setfocus; Exit; end; ........\\ aqui você pode dar outras instrucões. frmlogin.release; end; Espero que ajude você. Abraço.

Se você estiver usando QuickReport pode fazer assim com o Ano e com o més. SQL SELECT extract(year from data) as Ano, extract(month from data) as Mes, T.* from Agenda T WHERE extract(year from data) = :pAno Query1.Active := false; Query1.Params[0].AsInteger := StrToInt(FormatDateTime('yyyy', Date1.Date));//Extrai o ano da data. Query1.Prepare; Query1.Active := true; QuickRep1.preview; Espero que ajude. Abraço.

Você tem toda a razão Micheus o problema é mesmo na impressora,mas estranho porque aqui onde eu testo os programas tenho uma impressora HP PhotoSmart C3100 na porta USB e está como impressora activa?? então o que fiz como tenho uma impressora no meu pc na porta LPT1 HP 710 partihei para a rede e fui no outro pc e mudei para esta HP 710 e zás os aplicativos rodam impecável.Quando mudo para a C1300 já não dá?estranho isto? Depois fui buscar a actualização que você falou para a QuickReport e parece que agora tudo está funcionando,vou fazer mais uns testes aqui e depois falo. Obrigado Micheus você é um salvador mesmo,o messias do Delphi... :D Pode fechar o tópico,problema resolvido,mais uma vez obrigado Micheus , Jhonas e Eder Moraes. Abraços.

Micheus, eu estive aqui a fazer uns testes e cheguei a conclusão que o erro é logo no Create do Report ,desabilitei a linha do Report.Preview e o erro continua dai que antes quanto estava em auto create Form a aplicação dava erro logo no executar na hora que ia criar os Report.? Neste report eu usei assim como você fala ai ...->New->Other->New->Report ,mas tem outros que usei um form e adicionei um QuickRep e dá o mesmo erro . Haverá maneira de contornar isto? agradeço a vocês ai Micheus,Jhonas e outros amigos ai que possam ter alguma ideia. Abraço.

Voltando aqui ao problema...fiz tudo o que me indicaram e nada. Resolvi modificar um aplicativo onde mudar uma report do auto Create Forms logo na execucão do Aplicativo para ser criada depois com um botão de previsualizacão... o erro inicial desapareceu o programa rodou logo bem,agora quando chamo o preview da report é que dá erro...portanto aqui é que está o erro na Quikreport ou no SQL ???? mas nesta report eu não uso o SQL e o erro é o mesmo. Exception Eaccess violation in module agenda.exe at 000C00B8 Access violation at adress 064C00B8 in module ''agenda.exe'' write of adress 004F00A4. procedure TForm1.Button1Click(Sender: TObject); begin try with Report1 do begin Report1:=TReport1.create(self); .... .... .... Report1.preview end finally free end; end; Será que pode ser algo no código agradecia uma olhada ai dos amigos...mas no meu PC funciona bem????? Abraço.

Acrescente em Uses Shellapi. unit Autores; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, TFlatSpeedButtonUnit,shellapi, GIFButton, Animate, GIFCtrl, RxGrdCpt, yupack; procedure TAutor.Label3Click(Sender: TObject); begin shellexecute(Handle,'open','mailto:abotinas@sapo.pt ?subject= EMAIL DE TESTE',nil,'',SW_SHOWNORMAL); end; Abraço.

Já tentou (adoquery1.post) ;) ?. Por incrível que pareça só agora fui perceber que com ADOQuery tb é possível fazer Append, Delete, Edit e Post :o . Abraços