Analitcs

Pesquisar no conteúdo do blog.atlabs.com.br

sexta-feira, 28 de setembro de 2012

DELPHI - Função igual a LowerCase Retornando Tipo Char

Reações: 
function  LowCase( ch : Char ) : Char;
begin
  Result := ch;
  case Result of
    'A'..'Z':  Dec(Result, Ord('A') - Ord('a'));
  end;
end;

DELPHI - Validando Teclas Digitadas

Reações: 
Function KeyControls(Key : Char) : Boolean;
begin
  Result := False;
  case Key of
    #13 : Result := True; // Enter
    #27 : Result := True; // Escape
    #8  : Result := True; // BackSpace
    #9  : Result := True; // Tab
  end;
end;
Function KeyNumber(Key : Char) : Char;
begin
  if not KeyControls(Key) then
    case key of
      '0'..'9' : Result := Key;
      Else
      Result := #0;
    end;
end;

Function KeyNumberFloat(Key : Char) : Char;
begin
  if not KeyControls(Key) then
    case key of
      '.' : Result := Key;
      ',' : Result := Key;
      Else
      Result := #0;
    end;
end;

function  LowCase( ch : Char ) : Char;
begin
  Result := ch;
  case Result of
    'A'..'Z':  Dec(Result, Ord('A') - Ord('a'));
  end;
end;

Function KeyAZ(Key : Char; CharCase: TEditCharCase) : Char;
begin
  //CharCase in ecNormal, ecUpperCase, ecLowerCase
  Result := Key;
  if not KeyControls(Key) then
  begin
    case key of
      ' ' : Result := Key;
      'A'..'Z' : begin
                   If CharCase = ecLowerCase then
                     Result := LowCase(Key)
                   Else
                   If CharCase = ecUpperCase then
                     Result := UpCase(Key)
                   Else
                     Result := Key;
                 end;
      'a'..'z' : begin
                   If CharCase = ecLowerCase then
                     Result := LowCase(Key)
                   Else
                   If CharCase = ecUpperCase then
                     Result := UpCase(Key)
                   Else
                     Result := Key;
                 end;
       else
       Result := #0;
    end;
  end;
end;


Function KeyAZNumber(Key : Char; CharCase: TEditCharCase) : Char;
begin
  //CharCase in ecNormal, ecUpperCase, ecLowerCase
  Result := Key;
  if not KeyControls(Key) then
  begin
    case key of
      ' '      : Result := Key;
      '0'..'9' : Result := Key;
      'A'..'Z' : begin
                   If CharCase = ecLowerCase then
                     Result := LowCase(Key)
                   Else
                   If CharCase = ecUpperCase then
                     Result := UpCase(Key)
                   Else
                     Result := Key;
                 end;
      'a'..'z' : begin
                   If CharCase = ecLowerCase then
                     Result := LowCase(Key)
                   Else
                   If CharCase = ecUpperCase then
                     Result := UpCase(Key)
                   Else
                     Result := Key;
                 end;
       else
       Result := #0;
    end;
  end;
end;


Function KeyAZNumberFloat(Key : Char; CharCase: TEditCharCase = ecNormal) : Char;
begin
  //CharCase in ecNormal, ecUpperCase, ecLowerCase
  Result := Key;
  if not KeyControls(Key) then
  begin
    case key of
           ' ' : Result := Key;
      '0'..'9' : Result := Key;
      '.' : Result := Key;
      ',' : Result := Key;
      'A'..'Z' : begin
                   If CharCase = ecLowerCase then
                     Result := LowCase(Key)
                   Else
                   If CharCase = ecUpperCase then
                     Result := UpCase(Key)
                   Else
                     Result := Key;
                 end;
      'a'..'z' : begin
                   If CharCase = ecLowerCase then
                     Result := LowCase(Key)
                   Else
                   If CharCase = ecUpperCase then
                     Result := UpCase(Key)
                   Else
                     Result := Key;
                 end;
       else
       Result := #0;
    end;
  end;
end;

// Utilizando:

procedure TForm1.Edit1KeyPress(Sender: TObject;
  var Key: Char);
begin
  key := KeyNumber(Key); // retorna somente numeros digitados
end;

procedure TForm1.Edit2KeyPress(Sender: TObject;
  var Key: Char);
begin
  key := KeyNumberFloat(Key); // retorna numeros com opção de ponto flutuante (ponto ou virgula)
end;

procedure TForm1.Edit3KeyPress(Sender: TObject;
  var Key: Char);
begin
  key := KeyAZ(Key,ecUpperCase); // Retorna Letras de A a Z (caso precise de maiuscula/Minuscula/Normal troque o parametro da função)
end;

procedure TForm1.Edit4KeyPress(Sender: TObject;
  var Key: Char);
begin
  key := KeyAZNumber(Key,ecUpperCase); // retorna Alfanumerico (caso precise de maiuscula/Minuscula/Normal troque o parametro da função)
end;

procedure TForm1.Edit5KeyPress(Sender: TObject;
  var Key: Char);
begin
  key := KeyAZNumberFloat(Key,ecUpperCase); // retorna Alfanumerico ou numeros ou ponto ou virgula, (caso precise de maiuscula/Minuscula/Normal troque o parametro da função)
end;

segunda-feira, 24 de setembro de 2012

DELPHI - Versões do Delphi

Reações: 

Versões do delphi para Diretivas e afins

  • SYMBOL - COMPILER VERSION
  • VER80 - Delphi 1
  • VER90 - Delphi 2
  • VER100 - Delphi 3
  • VER120 - Delphi 4
  • VER130 - Delphi 5
  • VER140 - Delphi 6
  • VER150 - Delphi 7
  • VER160 - Delphi 8
  • VER170 - Delphi 2005
  • VER180 - Delphi 2006
  • VER180 - Delphi 2007
  • VER185 - Delphi 2007
  • VER200 - Delphi 2009
  • VER210 - Delphi 2010
  • VER220 - Delphi XE
  • VER230 - Delphi XE2
  • WIN32 - Indicates that the operating environment is the Win32 API.
  • LINUX - Indicates that the operating environment is Linux
  • MSWINDOWS - Indicates that the operating environment is the MS Windows/li]
  • CONSOLE - Indicates that an application is being compiled as a console application
  • segunda-feira, 10 de setembro de 2012

    DELPHI - Desenhando circulos (Quadrados, Retangulos, Elipses) em TImage

    Reações: 
     Coloque uma imagem qualquer no conteúdo do componente Image1.Picture, não subi no exemplo para não estender a dica aqui no blog. No demo tem uma imagem dos pinguins demo do W7
    Link do demo
    http://www.atlabs.com.br/blog/download/DesenhaCirculos.rar
    ///////////////UNIT1.pas
    unit Unit1;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, ExtCtrls, jpeg, StdCtrls;
    
    type
    
      TfrmPosicaoTela = class(TForm)
        Image1: TImage;
        Shape1: TShape;
        SaveDialog1: TSaveDialog;
        ckbTransparente: TCheckBox;
        procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
          Shift: TShiftState; X, Y: Integer);
        procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
          Y: Integer);
        procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
          Shift: TShiftState; X, Y: Integer);
        procedure ckbTransparenteClick(Sender: TObject);
      private
        _start, _end: TPoint;
        _Desenhando : Boolean;
        procedure CopyCanvas;
        { Private declarations }
      public
        { Public declarations }
      end;
    
    var
      frmPosicaoTela: TfrmPosicaoTela;
    
    implementation
    
    {$R *.dfm}
    
    procedure TfrmPosicaoTela.CopyCanvas;
    var
      DC: HDC;
      Image: TBitmap;
    begin
      DC:= GetDC(GetDesktopWindow);
      try
        Image := TBitmap.Create;
        Image.Width   := Image1.Width;
        Image.Height  := Image1.Height;
        BitBlt(Image.Canvas.Handle, 0,0, Image.Width, Image.Height, DC, Image1.ClientOrigin.X, Image1.ClientOrigin.Y, SRCCOPY);
        SaveDialog1.InitialDir := 'C:\';
        SaveDialog1.FileName   := 'ImagemAlterada' + FormatDateTime('ddMMyyyyHHmmss', now) + '.bmp';
        if SaveDialog1.Execute then
        begin
          Image.SaveToFile(SaveDialog1.FileName);
        end;
      finally
        FreeAndNil(Image);
        ReleaseDC(GetDesktopWindow, DC);
      end;
    end;
    
    procedure TfrmPosicaoTela.Image1MouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    begin
      self._start.X := X;
      self._start.Y := Y;
      self.Shape1.Width := 0;
      self.Shape1.Height:= 0;
      self.Shape1.Left  := X;
      self.Shape1.Top   := Y;
      self.Shape1.Show;
      self.Shape1.Update;
      _Desenhando := True;
    end;
    
    
    procedure TfrmPosicaoTela.Image1MouseMove(Sender: TObject;
      Shift: TShiftState; X, Y: Integer);
    begin
      if _Desenhando then
      begin
        self.Shape1.Width := X - self._start.X;
        self.Shape1.Height:= Y - self._start.Y;
      end;
    end;
    
    procedure TfrmPosicaoTela.Image1MouseUp(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    begin
      try
        CopyCanvas;
      finally
        _Desenhando := False;
        self.Shape1.Hide;
      end;
    end;
    
    procedure TfrmPosicaoTela.ckbTransparenteClick(Sender: TObject);
    begin
      if ckbTransparente.Checked then
      Shape1.Brush.Style := bsClear;
    end;
    end.
    ///////////////UNIT1.pas
    
    
    ///////////////UNIT1.dfm
    object frmPosicaoTela: TfrmPosicaoTela
      Left = 414
      Top = 163
      BorderStyle = bsSingle
      ClientHeight = 769
      ClientWidth = 1025
      Color = clBtnFace
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'MS Sans Serif'
      Font.Style = []
      OldCreateOrder = False
      Position = poDesktopCenter
      PixelsPerInch = 96
      TextHeight = 13
      object Image1: TImage
        Left = 0
        Top = 0
        Width = 1025
        Height = 769
        Align = alClient
        OnMouseDown = Image1MouseDown
        OnMouseMove = Image1MouseMove
        OnMouseUp = Image1MouseUp
      end
      object Shape1: TShape
        Left = 42
        Top = 84
        Width = 137
        Height = 94
        Brush.Color = clRed
        Pen.Color = clRed
        Shape = stEllipse
        Visible = False
      end
      object ckbTransparente: TCheckBox
        Left = 0
        Top = 0
        Width = 97
        Height = 17
        Caption = 'Transparente'
        TabOrder = 0
        OnClick = ckbTransparenteClick
      end
      object SaveDialog1: TSaveDialog
        Left = 525
        Top = 69
      end
    end
    ///////////////UNIT1.dfm
    

    Max Gehringer