Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 04.10.2009, 11:41   #1
RaTaMaHaTTa
 
Регистрация: 03.10.2009
Сообщений: 3
По умолчанию Status bar Delphi

Привет.
Можно ли вывести в статус бар подсчет символов ?
Вот у меня идет
TMEMO
я пишу например "Привет" в статус баре показывает что в слове привет 6 букв.
RaTaMaHaTTa вне форума Ответить с цитированием
Старый 04.10.2009, 12:54   #2
Скарам
Дружите с Linq ;)
Форумчанин
 
Аватар для Скарам
 
Регистрация: 15.10.2008
Сообщений: 823
По умолчанию

Ну сделай Lаbel,объяви глобальную переменную=0 типа integer,и обрабатывай событие
Код:
procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
end;
Только подумай как лучше отслеживать какие клавиши нажаты...Ну и присваивай значение Caption Label1.
Не давай организму поблажки, каждый день тренируй его в шашки..
Скарам вне форума Ответить с цитированием
Старый 04.10.2009, 13:13   #3
RaTaMaHaTTa
 
Регистрация: 03.10.2009
Сообщений: 3
По умолчанию

Спс попробую.
И вот ешё одно.
Объясните плиз как эта программка шифрует.
Код:
unit Shifr;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, Menus;

type
  Tfrmmain = class (TForm)
    Memo:       TMemo;
    shifr: TBitBtn;
    deshifr: TBitBtn;
    clear: TBitBtn;
    exit: TButton;
    procedure clearClick (Sender: TObject);
    procedure deshifrClick (Sender: TObject);
    procedure shifrClick (Sender: TObject);
    procedure exitClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmmain: Tfrmmain;

implementation

{$R *.dfm}

const
  StartKey = 586;
  MultKey = 59822;
  AddKey = 21563;

var
  stable:  array [0..255] of byte;
  bstable: array [0..255] of byte;


procedure SetKey (s: string);
var
  i, x, bi: longword;
  n: byte;
  was: array [0..255] of byte;
  a: array [1..16] of longword;
begin

  x := 1;

  s := copy(s, 1, 16);


  for I := 0 to 255 do
    was[i] := 0;


  if length(s) < 16 then
    begin
    for I := 0 to 15 - length(s) do
      s := s + s[(i mod length(s)) + 1];
    end;


  for I := 1 to 16 do
    begin
    a[i] := byte(s[I]);
    x := (x * (x + 1) shr 1) + a[i];
    end;


  for I := 0 to 255 do
    begin

    repeat

      a[(x mod 16) + 1] := (a[1] + a[2]) + ((a[3] - a[4]) xor
        (a[5] shr (a[6] mod 8))) + (a[7] shl (a[8] mod 8)) +
        (a[6] xor a[8]) xor ((a[5] + x) xor (a[7] + i)) +
        (a[9] - a[10] + ((a[10] shl 6) xor (a[10] shr 11))) +
        (a[12] + a[13]) + (a[14] xor a[15]) + (a[16] xor (a[16] * 9)) +
        (a[1] + (a[1] xor x));

      n := a[(x mod 16) + 1] and 255;
      Inc(x);


    until (was[n] = 0) and ((n <> i) or (i = 255));

    if (n = i) and (i = 255) then
      begin
      x := stable[254];
      stable[254] := n;
      bstable[n] := 254;
      n := x;
      end;

    was[n] := 1;

    stable[i]  := n;
    bstable[n] := i;

    end;

  for I := 0 to 255 do
    begin

    if bstable[i] = 0 then
      begin

      end;

    end;

end;


function crypt (const InString: string; StartKey, MultKey, AddKey: integer): string;
var
  i:  integer;
  NC: char;
begin
  Result := '';
  i := 1;
  while i <= Length(InString) do
    begin
    NC := char(integer(Stable[byte(InString[i])]) xor (StartKey shr 8));

    Result := Result + IntToHex(byte(NC), 2);
    StartKey := (integer(nc) + StartKey) * MultKey + AddKey;
    Inc(i);
    end;
end;


function Decrypt (const InString: string; StartKey, MultKey, AddKey: integer): string;
var
  i, raw: byte;
  NC: char;
begin
  Result := '';
  i := 1;
  while i <= Length(InString) do
    begin
    raw := StrToInt('$' + Copy(InString, i, 2));
    NC  := char(BStable[byte(integer(raw) xor (StartKey shr 8))]);
    Result := Result + NC;
    StartKey := (integer(raw) + StartKey) * MultKey + AddKey;


    Inc(i, 2);
    end;
end;


procedure Tfrmmain.clearClick (Sender: TObject);
var
  i: integer;
begin
  for i := 0 to memo.Lines.Count do
    memo.Lines.Clear;
end;

procedure Tfrmmain.deshifrClick (Sender: TObject);
var
  i:  integer;
var
  SL: TStringList;
begin
  setkey('Проверка!');
  SL := TStringList.Create;
  SL.AddStrings(Memo.Lines);
  for i := 0 to SL.Count - 1 do
    SL[i] := decrypt(SL[i], StartKey, MultKey, AddKey);
  memo.Lines.Clear;
  memo.Lines.AddStrings(SL);
  Sl.Free;

end;

procedure Tfrmmain.shifrClick (Sender: TObject);
var
  i:  integer;
var
  SL: TStringList;
begin
  setkey('Проверка!');
  SL := TStringList.Create;
  SL.AddStrings(Memo.Lines);
  for i := 0 to SL.Count - 1 do
    SL[i] := crypt(SL[i], StartKey, MultKey, AddKey);
  memo.Lines.Clear;
  memo.Lines.AddStrings(SL);
  Sl.Free;
end;





procedure Tfrmmain.exitClick(Sender: TObject);
begin
 Close;
end;

end.
RaTaMaHaTTa вне форума Ответить с цитированием
Старый 04.10.2009, 13:19   #4
Lemo
Форумчанин
 
Аватар для Lemo
 
Регистрация: 13.10.2008
Сообщений: 714
Радость

Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    StatusBar1: TStatusBar;
    procedure Memo1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Memo1Change(Sender: TObject);
var
i:integer;
begin
for i := 1 to length(memo1.Text) do
StatusBar1.Panels[0].Text:=inttostr(i);

end;

end.
Первое задание..........
ЗЫ: создать нуно StatusBar1.Panels[0].....

Последний раз редактировалось Lemo; 04.10.2009 в 13:21.
Lemo вне форума Ответить с цитированием
Старый 04.10.2009, 14:30   #5
RaTaMaHaTTa
 
Регистрация: 03.10.2009
Сообщений: 3
По умолчанию

хм Вот так ?
Вложения
Тип файла: rar Шифратор.rar (203.0 Кб, 25 просмотров)
RaTaMaHaTTa вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
TICQClient работа с X-Status Alter Общие вопросы Delphi 2 06.07.2010 20:47
Progress bar SKS Компоненты Delphi 10 15.08.2009 21:09
Scroll bar - делаем скин BOBAH13 Компоненты Delphi 7 26.04.2008 14:51
Progress Bar без рамки. Mitron Компоненты Delphi 5 21.01.2008 16:33
Progress Bar Alexander X Компоненты Delphi 2 17.12.2007 03:18