Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

NöU@

Erro ao chamar procedure DLL

Recommended Posts

E aí pessoa, beleza??

 

to com um pequeno probleminha que tá me tirando o sono...

 

Criei uma dll que tem 2 procedures: uma quando o componente recebe o foco e outra quando ele perde o foco.

 

DLL

 

library ColorObjects;

{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }

uses
  SysUtils,
  Classes,
  DBCtrls,
  Graphics;

{$R *.res}

procedure Focaliza(Sender: TObject);
begin
(Sender as TDBEdit).Color:= clLime;
(Sender as TDBEdit).Font.Color:= clBlack;
end;

procedure Desfocaliza(Sender: TObject);stdcall;
begin
(Sender as TDBEdit).Color:= clWhite;
(Sender as TDBEdit).Font.Color:= clBlack;
end;

Exports Focaliza,
		Desfocaliza;

begin
end.

Chamada no Form

 

unit UCadClientes;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, UCadPadrao, Grids, DBGrids, ExtCtrls, DBCtrls, StdCtrls, Mask, DB,
  ImgList;

type
  TDBGrid = class(DBGrids.TDBGrid);
  TFCadClientes = class(TFCadPadrao)
	Label2: TLabel;
	DBEdit2: TDBEdit;
	Label3: TLabel;
	Label4: TLabel;
	DBEdit4: TDBEdit;
	Label5: TLabel;
	DBEdit5: TDBEdit;
	Label6: TLabel;
	DBEdit6: TDBEdit;
	Label7: TLabel;
	DBEdit7: TDBEdit;
	Label8: TLabel;
	DBEdit8: TDBEdit;
	Label9: TLabel;
	Label10: TLabel;
	DBImage1: TDBImage;
	DBEdit9: TDBEdit;
	DBEdit1: TDBEdit;
	Timer1: TTimer;
	procedure DBImage1DblClick(Sender: TObject);
	procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
	  DataCol: Integer; Column: TColumn; State: TGridDrawState);
	procedure FormShow(Sender: TObject);
	procedure Timer1Timer(Sender: TObject);
	procedure FormClose(Sender: TObject; var Action: TCloseAction);
	procedure DBGrid1TitleClick(Column: TColumn);
	procedure FormCreate(Sender: TObject);
  private
	{ Private declarations }
	procedure HabilitaCampos;
	procedure DesabilitaCampos;
  public
	{ Public declarations }
  end;

  procedure Focaliza(Sender: TObject); external 'ColorObjects.DLL';
  procedure Desfocaliza(Sender: TObject); stdcall; external 'ColorObjects.DLL';

var
  FCadClientes: TFCadClientes;
  Indice: Integer;

implementation

{$R *.dfm}

Uses UDM, UCapturaImagem;



procedure TFCadClientes.DBImage1DblClick(Sender: TObject);
begin
  inherited;
FCapImagem.ShowModal; //Exibe no modo modal
end;


procedure TFCadClientes.DBGrid1DrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
  var  Bmp: TBitMap;
	function GetColsWidth: Integer;
	  var I : Integer;
	  begin
		Result := 0;
		for I := 0 to Column.Index do
		  begin
			Result := Result + TDBGrid(Sender).Columns.Items[I].Width;
		  end;
		Result := Result + 10 + (Column.Index);
	  end;
  begin
  inherited;
   with TDBGrid(Sender) do
   begin
	  Canvas.Brush.Style := bsClear;
	  if Column.Index = Indice then
	  begin
		Bmp := TBitMap.Create;
		with Bmp do
		begin
		  TransparentColor := clWhite;
		  Transparent := True;
		  TransparentMode := tmAuto
		end;
		try
		  if Ascendente = True then
			ImageList1.GetBitmap(0, Bmp)
		  else
			ImageList1.GetBitmap(1, Bmp);
		  if RowHeights[0] < Bmp.Height+4 then
		  RowHeights[0] := Bmp.Height+4;
		  Canvas.Draw((GetColsWidth-Bmp.Width),(RowHeights[0] - Bmp.Height) div 2,Bmp);
		finally
		  Bmp.Free;
		end;
	  end
	  else
		DefaultDrawColumnCell(Rect,DataCol,Column,State);
	end;
If Odd(DM_Dados.Clientes.RecNo) and (DM_Dados.Clientes.State <> dsInsert) then
begin
  DBGrid1.Canvas.Brush.Color := clMoneyGreen; //Muda a cor do pincel
  DBGrid1.Canvas.FillRect(Rect); //Preenche o fundo com a cor especificada
  DBGrid1.DefaultDrawDataCell(Rect,Column.Field,State); //Desenha as células da grade

end;

end;

procedure TFCadClientes.FormShow(Sender: TObject);
begin
  inherited;
  DBEdit9.Text:='';
  DesabilitaCampos;

end;

procedure TFCadClientes.DesabilitaCampos;

begin
  DBEdit1.Enabled := False;
  DBEdit2.Enabled := False;
  DBEdit4.Enabled := False;
  DBEdit5.Enabled := False;
  DBEdit6.Enabled := False;
  DBEdit7.Enabled := False;
  DBEdit8.Enabled := False;
  DBEdit9.Enabled := False;
  DBImage1.Enabled := False;


end;

procedure TFCadClientes.HabilitaCampos;
begin
  DBEdit1.Enabled := True;
  DBEdit2.Enabled := True;
  DBEdit4.Enabled := True;
  DBEdit5.Enabled := True;
  DBEdit6.Enabled := True;
  DBEdit7.Enabled := True;
  DBEdit8.Enabled := True;
  DBEdit9.Enabled := True;
  DBImage1.Enabled := True;

end;

procedure TFCadClientes.Timer1Timer(Sender: TObject);
begin
  inherited;
If DM_Dados.Clientes.State in [dsInsert, dsEdit] then
  HabilitaCampos
  else
  DesabilitaCampos;
end;

procedure TFCadClientes.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  inherited;
  if Dm_Dados.Ds_Clientes.State in [dsEdit, dsInsert] then
	begin
		MessageDlg('Cancele a edição (ou inserção) dos Clientes antes de fechar!',
		mtInformation, [mbOK], 0);
		Action := caNone;
		Exit;
	end;
	Screen.Cursor := crHourGlass;
end;

procedure TFCadClientes.DBGrid1TitleClick(Column: TColumn);
begin
  inherited;
 Ascendente := not Ascendente;
If Ascendente then
  Dm_Dados.Clientes.IndexFieldNames := Column.FieldName+'  ASC'
else
  Dm_Dados.Clientes.IndexFieldNames := Column.FieldName+'  DESC';

if TDBGrid(DBGrid1).Columns.Items[Column.Index].Width <
(TDBGrid(DBGrid1).Canvas.TextWidth(Column.Title.Caption) + ImageList1.Width) then
TDBGrid(DBGrid1).Columns.Items[Column.Index].Width :=
(TDBGrid(DBGrid1).Canvas.TextWidth(Column.Title.Caption) + ImageList1.Width) + 10;
 Indice := Column.Index;
end;

procedure TFCadClientes.FormCreate(Sender: TObject);
var i: integer;
begin
  inherited;

  for i:=0 to self.ComponentCount - 1 do
  begin
	If (Self.Components[i] is TDBEdit) then
	begin
	  (Components[i] as TDBEdit).OnEnter:= [b]Focaliza[/b];
	  (Components[i] as TDBEdit).OnExit:= [b]Desfocaliza[/b];
	end;
  end;

end;

end.

Alguma ajuda??

 

Ah.. se acharem um jeito de fazer com todos os componentes: Edits e DBEdits, aceito sugestões...

 

Vlw

Compartilhar este post


Link para o post
Compartilhar em outros sites

o problema está na declaração das funções.

 

ao invés de

 

procedure Focaliza(Sender: TObject); external 'ColorObjects.DLL';

procedure Desfocaliza(Sender: TObject); stdcall; external 'ColorObjects.DLL';

 

use o seguinte código para declarar o seu procedimento

 

 

procedure Focaliza(Sender: TObject); external 'colorObjects.dll' name 'Focaliza'; // nome da função dentro da dll

procedure Desfocaliza(Sender: TObject); external 'ColorObjects.dll' name 'Desfocaliza'; // você pode declarar a função com qualquer nome desde que você indique o nome interno da função dentro da dll

espero que tenha ajudado!

 

Abraços!

Compartilhar este post


Link para o post
Compartilhar em outros sites

×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.