Desenhar Um Ícone (bitmap) Em Células do Dbgrid

A dica abaixo serve para desenhar um ícone(bitmap) em cada célula de um dbgrid de acordo com o valor de um determinado campo da tabela... Ex: temos uma tabela "sexo" com o campo "sexo" que guarda os valores "M" para masculino e "F" para feminino. Então podemos fazer o dbgrid mostrar uma ícone(bitmap) de um homem ou um de uma mulher ao invés dos valores "M" e "F"...

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
  Icon: TBitmap;
begin
  Icon := TBitmap.Create;
  if (Column.FieldName = 'SHARES') then
  begin
    with DBGrid1.Canvas do
    begin
      Brush.Color := clWhite;
      FillRect(Rect);
      if (Table1.FieldByName('SHARES').Value > 4500) then
        ImageList1.GetBitmap(1, Icon)
      else
        ImageList1.GetBitmap(0, Icon);
      Draw(round((Rect.Left + Rect.Right - Icon.Width) / 2), Rect.Top, Icon);
    end;
  end;
end;

Copiando Arquivos Via Programação

Function CopiaArquivo(scrname,destname:string):byte;
var
  source,destination:file;
  buffer:array[1..1024] of byte;
  readcnt,writecnt:word;
  pname,dname,fname,ename:String;
  { USO: R:=COPIAARQUIVO('C:\diretorio\FILE.EXT','C:\diretorio\FILE.EXT'); Devolve 0=Ok, 1=Erro no Origem, 2=Erro no Destino, 3=Disco Cheio }
begin
  AssignFile(source,scrname);
  Try
  Reset(source,1);
  Except
  CopiaArquivo:=1;
  Exit;end;If destname[length(destname)]='\' then
  begin
  pname:=scrname;
  destname:=destname+separa(scrname,'\',Ocorre(scrname,'\')+1);
  end;
  AssignFile(destination,destname);
  Try
  Rewrite(destination,1);
  Except
  CopiaArquivo:=2;
  Exit;
end;
Repeat
  BlockRead(source,buffer,sizeof(buffer),readcnt);
  Try
  BlockWrite(destination,buffer,readcnt,writecnt);
  Except
  CopiaArquivo:=3; {Disco Cheio?}
  Exit;
end;
until (readcnt=0) or (writecnt<>readcnt);
CloseFile(destination);
CloseFile(source);
CopiaArquivo:=0;
end;

Comparar dois arquivos textos

procedure TForm1.Button1Click(Sender: TObject);
var
filename1 : string;
filename2 : string;
begin
filename1 := Edit1.Text;
filename2 := Edit2.Text;
compfile(filename1, filename2);
showmessage('Veja o resultado no arquivo c:Tempdiff.txt');
end;
 
procedure tform1.compfile(filename1, filename2 : string);
var
f1 : system.textfile;
f2 : system.textfile;
diff : system.textfile;
buf1 : string;
buf2 : string;
l : integer;
begin
assignfile(f1, filename1);
assignfile(f2, filename2);
assignfile(diff, 'c:Tempdiff.txt');
reset(f1);
reset(f2);
rewrite(diff);
l := 1;
while not eof(f1) do
begin
readln(f1, buf1);
readln(f2, buf2);
if not (compstr(buf1, buf2) )then
begin
writeln(diff, 'line: '+ inttostr(l) + '-' + buf1);
writeln(diff, 'line: '+ inttostr(l) + '-' + buf2);
writeln(diff, ' ');
end;
inc(l);
end;
closefile(f1);
closefile(f2);
closefile(diff);
end;
 
function tform1.compstr(s1, s2 : string) : boolean;
var
i : integer;
btemp : boolean;
begin
btemp := true;
if (length(s1) <> length(s2)) then begin
btemp := false;
end{if}
else begin
for i:= 1 to length(s1) do begin
if (s1[i] <> s2[i]) then begin
btemp := false;
exit;
end;{if}
end;{for}
end;{else}
result := btemp;
end;

Abrir arquivos com aplicativo associado

Inclua a unit SHELLAPI na clausula uses do seu form.

procedure TForm1.ExecFile(F: String);
var
r: String;
begin
case ShellExecute(Handle, nil, PChar(F), nil, nil, SW_SHOWNORMAL) of
ERROR_FILE_NOT_FOUND: r := 'The specified file was not found.';
ERROR_PATH_NOT_FOUND: r := 'The specified path was not found.';
ERROR_BAD_FORMAT: r := 'The .EXE file is invalid (non-Win32 .EXE or error in .EXE image).';
SE_ERR_ACCESSDENIED: r := 'Windows 95 only: The operating system denied access to the specified file.';
SE_ERR_ASSOCINCOMPLETE: r := 'The filename association is incomplete or invalid.';
SE_ERR_DDEBUSY: r := 'The DDE transaction could not be completed because other DDE transactions were being processed.';
SE_ERR_DDEFAIL: r := 'The DDE transaction failed.';
SE_ERR_DDETIMEOUT: r := 'The DDE transaction could not be completed because the request timed out.';
SE_ERR_DLLNOTFOUND: r := 'Windows 95 only: The specified dynamic-link library was not found.';
SE_ERR_NOASSOC: r := 'There is no application associated with the given filename extension.';
SE_ERR_OOM: r := 'Windows 95 only: There was not enough memory to complete the operation.';
SE_ERR_SHARE: r := 'A sharing violation occurred.';
else
Exit;
end;
ShowMessage(r);
end;

Utilize a função assim:

procedure TForm1.Button1Click(Sender: TObject);
begin
       ExecFile('c:\windows\ladrilhos.bmp');
end;
 

Função que preenche strings com qualquer caracter a esquerda ou a direita.

É só incluir a função em sua biblioteca ou na unit que vc estiver usando e chama-la passando os parametros corretos.

A função preenche strings com qualquer caracter a esquerda ou direita retornando a string formatada e no tamanho que vc quiser.

Função Preenche

Preenche uma string com o caracter informado

Parametros Tipo       Objetivo

wStr1          String     A string a ser preenchida

wStr2          String     O caracter que vai preencher a string

wStr3          String     D = Direita e E = Esquerda

wTama        Integer  O tamanho total da string a ser retornada

Retorno      String     Retorna a string informada preenchida

com o caracter escolhido no tamanho

definido

function Preenche(wStr1, wStr2, wStr3: String; wTama: Integer): String;

var v : Integer;

begin

        wStr1 := Trim(wStr1);

        Result := '';

        for v:=1 to wTama-Length(wStr1) do Result := Result + wStr2;

        if wStr3 = 'E' then

        Result := Result + wStr1

        else

        Result := wStr1 + Result;

end;