Fórum GetFormImage - Bordas #524632
02/07/2015
0
Estou utilizando o seguinte código para pegar a imagem do form e depois mandá-la por email:
procedure PegaImgForm(MeuForm: TForm; CaminhoArquivo: String); var Anexo: TJPEGImage; begin Anexo := TJPEGImage.Create; Anexo.Assign(MeuForm.GetFormImage); Anexo.SaveToFile(CaminhoArquivo); FreeAndNil(anexo); end;
Acontece que ele salva a imagem do Form, mas ignora as "bordas" da Janela do Windows.
Tem como eu corrigir isso?
Diego Martins
Curtir tópico
+ 0Post mais votado
02/07/2015
coloca uma imagem de como ta capturando e como vc gostaria q ficasse.
Dorivan Sousa
Gostei + 1
Mais Posts
02/07/2015
Diego Martins
[img:descricao=Função Form.GetFormImage]http://arquivo.devmedia.com.br/forum/imagem/415780-20150702-132403.png[/img]
[img:descricao=Atalho Alt+PrintScreen do Windows (Esse que eu quero)]http://arquivo.devmedia.com.br/forum/imagem/415780-20150702-132440.png[/img]
Obrigado pela ajuda.
Gostei + 0
02/07/2015
Diego Martins
Gostei + 0
02/07/2015
Dorivan Sousa
function CapturaTela: TBitmap; var dc : hdc; cv: TCanvas; begin Result := TBitmap.Create; Result.Width := Screen.Width; Result.Height := Screen.Height; dc := GetDc(0); cv := TCanvas.Create; cv.Handle := DC; Result.Canvas.CopyRect( Rect( 0 , 0 , Screen.Width , Screen.Height),cv,rect(0 , 0 , Screen.Width , Screen.Height)); cv.Free; ReleaseDc( 0 , DC); end;
se tivesse como cortar da imagem so a parte onde ta o formulario
teria q testar nessa parte, pegando a posicao do formulario na tela.
Result.Canvas.CopyRect( Rect( 0 , 0 , Screen.Width , Screen.Height),cv,rect(0 , 0 , Screen.Width , Screen.Height));
Gostei + 1
02/07/2015
Diego Martins
Troquei a linha 9 do seu código por:
dc := GetWindowDC(Formulario.Handle);
e a linha 12 por:
Result.Canvas.CopyRect( Rect( 0 , 0 , Formulario.Width , Formulario.Height),cv,rect(0 , 0 , Formulario.Width , Formulario.Height));
O único problema dessa função é quando tento executar por tarefa agendada, pois normalmente o micro fica em "Logoff" e ele não cria na tela os formulários.
Gostei + 0
03/07/2015
Dorivan Sousa
se funcionar olha o codigo dela e tenta adptar
function TCustomForm.GetFormImage: TBitmap;
var
Ofs: Integer;
begin
Result := TBitmap.Create;
try
Result.Width := ClientWidth;
Result.Height := ClientHeight;
Result.Canvas.Brush := Brush;
Result.Canvas.FillRect(ClientRect);
Result.Canvas.Lock;
try
if GetWindowLong(Handle, GWL_STYLE) and WS_BORDER <> 0 then
Ofs := -1 // Don't draw form border
else
Ofs := 0; // There is no border
PaintTo(Result.Canvas.Handle, Ofs, Ofs);
finally
Result.Canvas.Unlock;
end;
except
Result.Free;
raise;
end;
end;
Gostei + 1
Clique aqui para fazer login e interagir na Comunidade :)