Ver Mensaje Individual
  #75  
Antiguo 19-07-2007
Avatar de seoane
[seoane] seoane is offline
Miembro Premium
 
Registrado: feb 2004
Ubicación: A Coruña, España
Posts: 3.717
Reputación: 24
seoane Va por buen camino
Bueno, este código fue en honor de los 2000 mensajes de Jhonny.
Código Delphi [-]
uses clipbrd;

function StrToStr(Str: string; S: Integer): string;
var
  Bitmap: TBitmap;
  i,j: integer;
begin
  Result:= '';
  // Creamos un Bitmap
  Bitmap:= TBitmap.Create;
  try
    // Ajustamos el tipo y tamaño de la fuente
    Bitmap.Canvas.Font.Name:= 'Arial Black';
    Bitmap.Canvas.Font.Size:= S;
    // Ajustamos el tamaño del Bitmap al tamaño del texto
    Bitmap.Width:= Bitmap.Canvas.TextWidth(Str);
    Bitmap.Height:= Bitmap.Canvas.TextHeight(Str);
    // Escribimos el texto en el bitmap
    Bitmap.Canvas.TextOut(0,0,Str);
    // Vamos leyendo pixel a pixel del bitmap
    for j:= 0 to Bitmap.Height - 1 do
    begin
      for i:= 0 to Bitmap.Width - 1 do
        // Por cada pixel blanco añadimos la letra _ al resultado
        if Bitmap.Canvas.Pixels[i,j] = $FFFFFF then
          Result:= Result + ' '
        else
          // y por cada pixel que no es blanco añadimos una X
          Result:= Result + 'X';
      // Al final de cada fila de pixeles añadimo al resultado un salto de linea
      Result:= Result + #13#10;
    end;
  finally
    // Eliminamos el bitmap, ya no lo necesitamos
    Bitmap.Free;
  end;
end;

function ContarX(Str: String): Integer;
var
  i: Integer;
begin
  Result:= 0;
  for i:= 1 to Length(Str) do
    if Str[i] = 'X' then
      inc(Result);
end;

function StrToStrN(Str: String; N: Integer): String;
var
  i: Integer;
begin
  i:= 8;
  while ContarX(StrToStr(Str,i)) < N do
    inc(i);
  Result:= StrToStr(Str,i-1);
end;

// Por ejemplo
var
  Str: String;
begin
  Str:= StrToStrN('Jhonny *',2000);
  Clipboard.AsText:= Str;
  ShowMessage(IntToStr(ContarX(Str)));
end;
Como veis, me da un texto de 1960 caracteres así que hay que añadirle las otras cuarenta X a mano
Responder Con Cita