NöU@ 1 Denunciar post Postado Maio 29, 2008 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
BuGFiX 0 Denunciar post Postado Maio 31, 2008 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
NöU@ 1 Denunciar post Postado Junho 3, 2008 vlw pela ajuda BugFix mas naum funcionou.... Compartilhar este post Link para o post Compartilhar em outros sites
marcio.theis 3 Denunciar post Postado Junho 3, 2008 Veja este post que mostra como fazer este tipo de controle, acho que fica mais simples do que como você fez, sem precisar de DLL. Compartilhar este post Link para o post Compartilhar em outros sites