Программирование

Как преобразовать цвет в оттенки серого (подобие черно-белых телевизоров)

function RgbToGray(RGBColor : TColor) : TColor;
var
Gray : byte;
begin
Gray := Round((0.30 * GetRValue(RGBColor)) +
(0.59 * GetGValue(RGBColor)) +
(0.11 * GetBValue(RGBColor )));
Result := RGB(Gray, Gray, Gray);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Shape1.Brush.Color := RGB(255, 64, 64);
Shape2.Brush.Color := RgbToGray(Shape1.Brush.Color);
end;

Как реализовать зеркальное отражение картинки?

Вот процедура для зеркального отображения по горизонтали вашего ресунка:

Procedure FlipBitmapH(Bitmap: TBitmap);
var
X, Y: Integer;
SrcRect, DstRect: TRect;
begin
X := Bitmap.Width;
Y := Bitmap.Height;
SrcRect := Rect(-1, -1, X, Y);
DstRect := Rect(X, -1, -1, Y);
Bitmap.Canvas.CopyRect(DstRect, Bitmap.Canvas, SrcRect);
end;

Как распечатать текст из Memo или ListBox

Uses Prints;

procedure PrintStrings(Strings: TStrings);
var
Prn: TextFile;
i: word;
begin
AssignPrn(Prn);
try
    Rewrite(Prn);
    try
      for i := 0 to Strings.Count - 1 do
        writeln(Prn, Strings.Strings[i]);
    finally
      CloseFile(Prn);
    end;
except
    on EInOutError do
      MessageDlg('Error Printing text.', mtError, [mbOk], 0);
end;
end;

Для вызова процедуры печате напишите: PrintStrings(Memo1.Lines) или PrintStrings(Listbox1.Items);

Как проверить правильность введенного Email-a

function IsValidEmail(const Value: string): boolean;
function CheckAllowed(const s: string): boolean;
var
    i: integer;
begin
    Result:= false;
    for i:= 1 to Length(s) do
    begin
      { недопустимый символ в s - значит недопустимый адрес }
      if not (s[i] in ['a'..'z', 'A'..'Z', '0'..'9', '_', '-', '.']) then
        Exit;
    end;
    Result:= true;
end;
var
i: integer;
namePart, serverPart: string;
begin // начало выполнения IsValidEmail
Result:= false;
i:= Pos('@', Value);
if i = 0 then
    Exit;
namePart:= Copy(Value, 1, i - 1);
serverPart:= Copy(Value, i + 1, Length(Value));
// @ не указано имя         имя или сервер не указаны; минимально для сервера. "a.com"
if (Length(namePart) = 0) or ((Length(serverPart) < 5)) then
    Exit;
i:= Pos('.', serverPart);
// должно иметь точку и как минимум три знака от конца
if (i = 0) or (i > (Length(serverPart) - 2)) then
    Exit;
Result:= CheckAllowed(namePart) and CheckAllowed(serverPart);
end;

Как изменить фоновый цвет текста в различных строчках TListBox

Свойство Style у TListBox установите на lbOwnerDrawFixed. Если не изменить свойство Style, то событие OnDrawItem никогда не вызовется. Теперь поместите следующий код в обработчик события OnDrawItem Вашего TListBox:

procedure TForm1.ListBox1DrawItem
(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
    myColor: TColor;
    myBrush: TBrush;
begin
    myBrush := TBrush.Create;
    with (Control as TListBox).Canvas do
     begin
      if not Odd(Index) then
      myColor := clSilver
    else
      myColor := clYellow;

    myBrush.Style := bsSolid;
    myBrush.Color := myColor;
      Windows.FillRect(handle, Rect, myBrush.Handle);

      Brush.Style := bsClear;
      TextOut(Rect.Left, Rect.Top,
      (Control as TListBox).Items[Index]);
    MyBrush.Free;
end;
end;

1-5 6-10 11-15 ... 41-45 46-48

Программирование на Delphi.

Программирование