temskwk.pas

Do your applications look a little boring? Would you like to get spectacular yet easy to use visual

             (ScanLineSize - Round(UpdateRect.Right * BytesPerPixel));
           RowLenght4 := UpdateRect.Right - UpdateRect.Left;
           Gap4       := Round(ScanLineSize / BytesPerPixel) - RowLenght4;
           Lenght4    :=
             Round(((UpdateRect.Bottom * ScanLineSize) - Start4) / BytesPerPixel) -
             UpdateRect.Left;
           if(Lenght1 < 0) or (RowLenght1 <= 0) then
             Lenght1 := 0;
           if(Lenght2 < 0) or (RowLenght2 <= 0) then
             Lenght2 := 0;
           if(Lenght3 < 0) or (RowLenght3 <= 0) then
             Lenght3 := 0;
           if(Lenght4 < 0) or (RowLenght4 <= 0) then
             Lenght4 := 0;
         end;
  end;
end;

procedure Apply256MaskS(Apply256MaskSProc: TApply256MaskSProc;
  Work, Dst, Src, Mask: Pointer;
  ScanLineSize, MaskScanLineSize, Width, Height: Integer;
  UpdateRect, UnUpdateRect: TRect);
var
  Mode: Longint;
  UpdParBmp,
  UpdParMsk: TTEUpdParams;
begin
  Mode := GiveMeTheUpdMode(Width, 0, 8, UpdateRect, UnUpdateRect, pf8bit);
  GiveMeTheUpdParams(Mode, UpdParBmp, ScanLineSize, UpdateRect, UnUpdateRect,
    pf32bit);
  GiveMeTheUpdParams(Mode, UpdParMsk, MaskScanLineSize, UpdateRect,
    UnUpdateRect, pf8bit);

  case Mode of
    1,
    2:
      begin
        Apply256MaskSProc(
          PChar(Work) - UpdParBmp.Start1,
          PChar(Dst ) - UpdParBmp.Start1,
          PChar(Src ) - UpdParBmp.Start1,
          PChar(Mask) - UpdParMsk.Start1,
          -UpdParMsk.Lenght1,
          UpdParMsk.RowLenght1,
          UpdParMsk.Gap1);
      end;
    3:
      begin
        Apply256MaskSProc(
          PChar(Work) - UpdParBmp.Start1,
          PChar(Dst ) - UpdParBmp.Start1,
          PChar(Src ) - UpdParBmp.Start1,
          PChar(Mask) - UpdParMsk.Start1,
          -UpdParMsk.Lenght1,
          UpdParMsk.RowLenght1,
          UpdParMsk.Gap1);
        Apply256MaskSProc(
          PChar(Work) - UpdParBmp.Start2,
          PChar(Dst ) - UpdParBmp.Start2,
          PChar(Src ) - UpdParBmp.Start2,
          PChar(Mask) - UpdParMsk.Start2,
          -UpdParMsk.Lenght2,
          UpdParMsk.RowLenght2,
          UpdParMsk.Gap2);
        Apply256MaskSProc(
          PChar(Work) - UpdParBmp.Start3,
          PChar(Dst ) - UpdParBmp.Start3,
          PChar(Src ) - UpdParBmp.Start3,
          PChar(Mask) - UpdParMsk.Start3,
          -UpdParMsk.Lenght3,
          UpdParMsk.RowLenght3,
          UpdParMsk.Gap3);
        Apply256MaskSProc(
          PChar(Work) - UpdParBmp.Start4,
          PChar(Dst ) - UpdParBmp.Start4,
          PChar(Src ) - UpdParBmp.Start4,
          PChar(Mask) - UpdParMsk.Start4,
          -UpdParMsk.Lenght4,
          UpdParMsk.RowLenght4,
          UpdParMsk.Gap4);
      end;
  end;
end;

procedure Apply256Mask_32(Work, Dst: PDWordArray; Mask: PByteArray;
  k, LoValue, HiValue: Longint);
begin
  while k < 0 do
  begin
    if (Mask[k  ] >= LoValue) and (Mask[k  ] <= HiValue) then
      Work[k  ] := Dst[k  ];
    if (Mask[k+1] >= LoValue) and (Mask[k+1] <= HiValue) then
      Work[k+1] := Dst[k+1];
    if (Mask[k+2] >= LoValue) and (Mask[k+2] <= HiValue) then
      Work[k+2] := Dst[k+2];
    if (Mask[k+3] >= LoValue) and (Mask[k+3] <= HiValue) then
      Work[k+3] := Dst[k+3];
    Inc(k, 4);
  end;
end;

procedure Apply256Mask_24(Work, Dst, Mask: PByteArray;
  k, LoValue, HiValue: Longint);
var
  i: Longint;
begin
  i := k * 3;

  while k < 0 do
  begin
    if(Mask[k  ] >= LoValue) and (Mask[k  ] <= HiValue) then
    begin
      Work[i   ] := Dst[i   ];
      Work[i+ 1] := Dst[i+ 1];
      Work[i+ 2] := Dst[i+ 2];
    end;
    if(Mask[k+1] >= LoValue) and (Mask[k+1] <= HiValue) then
    begin
      Work[i+ 3] := Dst[i+ 3];
      Work[i+ 4] := Dst[i+ 4];
      Work[i+ 5] := Dst[i+ 5];
    end;
    if(Mask[k+2] >= LoValue) and (Mask[k+2] <= HiValue) then
    begin
      Work[i+ 6] := Dst[i+ 6];
      Work[i+ 7] := Dst[i+ 7];
      Work[i+ 8] := Dst[i+ 8];
    end;
    if(Mask[k+3] >= LoValue) and (Mask[k+3] <= HiValue) then
    begin
      Work[i+ 9] := Dst[i+ 9];
      Work[i+10] := Dst[i+10];
      Work[i+11] := Dst[i+11];
    end;
    Inc(i, 12);
    Inc(k, 4);
  end;
end;

procedure Apply256Mask_16(Work, Dst: PWordArray; Mask: PByteArray;
  k, LoValue, HiValue: Longint);
begin
  while k < 0 do
  begin
    if (Mask[k  ] >= LoValue) and (Mask[k  ] <= HiValue) then
      Work[k  ] := Dst[k  ];
    if (Mask[k+1] >= LoValue) and (Mask[k+1] <= HiValue) then
      Work[k+1] := Dst[k+1];
    if (Mask[k+2] >= LoValue) and (Mask[k+2] <= HiValue) then
      Work[k+2] := Dst[k+2];
    if (Mask[k+3] >= LoValue) and (Mask[k+3] <= HiValue) then
      Work[k+3] := Dst[k+3];
    Inc(k, 4);
  end;
end;

procedure Apply256Mask_8(Work, Dst, Mask: PByteArray;
  k, LoValue, HiValue: Longint);
begin
  while k < 0 do
  begin
    if (Mask[k  ] >= LoValue) and (Mask[k  ] <= HiValue) then
      Work[k  ] := Dst[k  ];
    if (Mask[k+1] >= LoValue) and (Mask[k+1] <= HiValue) then
      Work[k+1] := Dst[k+1];
    if (Mask[k+2] >= LoValue) and (Mask[k+2] <= HiValue) then
      Work[k+2] := Dst[k+2];
    if (Mask[k+3] >= LoValue) and (Mask[k+3] <= HiValue) then
      Work[k+3] := Dst[k+3];
    Inc(k, 4);
  end;
end;

procedure Apply256Mask_4(Work, Dst, Mask: PByteArray;
  k, LoValue, HiValue: Longint);
var
  i: Longint;
begin
  i := k div 2;

  while k < 0 do
  begin
    if(Mask[k] >= LoValue) and (Mask[k] <= HiValue)
    then
    begin
      if(Mask[k+1] >= LoValue) and (Mask[k+1] <= HiValue)
      then Work[i] := Dst[i]
      else Work[i] := (Work[i] and $0F) or (Dst[i] and $F0);
    end
    else
    begin
      if(Mask[k+1] >= LoValue) and (Mask[k+1] <= HiValue) then
        Work[i] := (Work[i] and $F0) or (Dst[i] and $0F);
    end;
    Inc(i);
    Inc(k, 2);
  end;
end;

procedure Apply256Mask(Work, Dst, Mask: Pointer;
  MaskSize, LoValue, HiValue: Longint; PixelFormat: TPixelFormat);
begin
  case PixelFormat of
    pf4bit : Apply256Mask_4 (Work, Dst, Mask, -MaskSize, LoValue, HiValue);
    pf8bit : Apply256Mask_8 (Work, Dst, Mask, -MaskSize, LoValue, HiValue);
    pf15bit,
    pf16bit: Apply256Mask_16(Work, Dst, Mask, -MaskSize, LoValue, HiValue);
    pf24bit: Apply256Mask_24(Work, Dst, Mask, -MaskSize, LoValue, HiValue);
    pf32bit: Apply256Mask_32(Work, Dst, Mask, -MaskSize, LoValue, HiValue);
  end;
end;

procedure DecMask1Value(Work: PByteArray; k, Value: Longint);
begin
  while k < 0 do
  begin
    if Work[k] <> $FF then
    begin
      if Work[k] <= Value
      then Work[k] := 0
      else Work[k] := Work[k] - Value;
    end;
    if Work[k+1] <> $FF then
    begin
      if Work[k+1] <= Value
      then Work[k+1] := 0
      else Work[k+1] := Work[k+1] - Value;
    end;
    if Work[k+2] <> $FF then
    begin
      if Work[k+2] <= Value
      then Work[k+2] := 0
      else Work[k+2] := Work[k+2] - Value;
    end;
    if Work[k+3] <> $FF then
    begin
      if Work[k+3] <= Value
      then Work[k+3] := 0
      else Work[k+3] := Work[k+3] - Value;
    end;
    Inc(k, 4);
  end;
end;

procedure DecMask1ValueRect(Work: PByteArray; k, Value, UpdateRowLenght,
  UpdateGap: Longint);
var
  Limit: Longint;
begin
  while k < 0 do
  begin
    Limit := k + UpdateRowLenght;
    while k < Limit do
    begin
      if Work[k] <> $FF then
      begin
        if Work[k] <= Value
        then Work[k] := 0
        else Work[k] := Work[k] - Value;
      end;
      Inc(k);
    end;
    Inc(k, UpdateGap);
  end;
end;

procedure DecMask1(Work: PByteArray; k: Longint);
begin
  while k < 0 do
  begin
    if Work[k] <> $FF then
      Work[k  ] := 0;
    if Work[k+1] <> $FF then
      Work[k+1] := 0;
    if Work[k+2] <> $FF then
      Work[k+2] := 0;
    if Work[k+3] <> $FF then
      Work[k+3] := 0;
    Inc(k, 4);
  end;
end;

procedure DecMask1Rect(Work: PByteArray; k, UpdateRowLenght, UpdateGap: Longint);
var
  Limit: Longint;
begin
  while k < 0 do
  begin
    Limit := k + UpdateRowLenght;
    while k < Limit do
    begin
      if Work[k] <> $FF then
        Work[k] := 0;
      Inc(k);
    end;
    Inc(k, UpdateGap);
  end;
end; //EROC itnA

procedure DoDecMask1(Mask: Pointer; ScanLineSize, Width, DecValue: Longint;
  DecAll:Boolean; UpdateRect, UnUpdateRect: TRect);
var
  UpdParams: TTEUpdParams;
  Mode: Longint;
begin
  Mode := GiveMeTheUpdMode(Width, 0, 8, UpdateRect, UnUpdateRect, pf8bit);
  GiveMeTheUpdParams(Mode, UpdParams, ScanLineSize, UpdateRect, UnUpdateRect,
    pf8bit);

  case Mode of
    1: if DecAll
       then DecMask1(
              PByteArray(PChar(Mask) - UpdParams.Start1),
              -UpdParams.Lenght1)
       else DecMask1Value(
              PByteArray(PChar(Mask) - UpdParams.Start1),
              -UpdParams.Lenght1,
              DecValue);
    2: if DecAll
       then DecMask1Rect(
              PByteArray(PChar(Mask) - UpdParams.Start1),
              -UpdParams.Lenght1,
              UpdParams.RowLenght1,
              UpdParams.Gap1)
       else DecMask1ValueRect(
              PByteArray(PChar(Mask) - UpdParams.Start1),
              -UpdParams.Lenght1,
              DecValue,
              UpdParams.RowLenght1,
              UpdParams.Gap1);
    3: if DecAll
       then
       begin
         DecMask1Rect(
           PByteArray(PChar(Mask) - UpdParams.Start1),
           -UpdParams.Lenght1,
           UpdParams.RowLenght1,
           UpdParams.Gap1);
         DecMask1Rect(
           PByteArray(PChar(Mask) - UpdParams.Start2),
           -UpdParams.Lenght2,
           UpdParams.RowLenght2,
           UpdParams.Gap2);
         DecMask1Rect(
           PByteArray(PChar(Mask) - UpdParams.Start3),
           -UpdParams.Lenght3,
           UpdParams.RowLenght3,
           UpdParams.Gap3);
         DecMask1Rect(
           PByteArray(PChar(Mask) - UpdParams.Start4),
           -UpdParams.Lenght4,
           UpdParams.RowLenght4,
           UpdParams.Gap4);
       end
       else
       begin
         DecMask1ValueRect(
           PByteArray(PChar(Mask) - UpdParams.Start1),
           -UpdParams.Lenght1,
           DecValue,
           UpdParams.RowLenght1,
           UpdParams.Gap1);
         DecMask1ValueRect(
           PByteArray(PChar(Mask) - UpdParams.Start2),
           -UpdParams.Lenght2,
           DecValue,
           UpdParams.RowLenght2,
           UpdParams.Gap2);
         DecMask1ValueRect(
           PByteArray(PChar(Mask) - UpdParams.Start3),
           -UpdParams.Lenght3,
           DecValue,
           UpdParams.RowLenght3,
           UpdParams.Gap3);
         DecMask1ValueRect(
           PByteArray(PChar(Mask) - UpdParams.Start4),
           -UpdParams.Lenght4,
           DecValue,
           UpdParams.RowLenght4,
           UpdParams.Gap4);
        end;
  end;
end;

procedure DecMask2Value(Work, Mask: PByteArray; k, Value: Longint);
begin
  while k < 0 do
  begin
    if Mask[k  ] <> $FF then
      if Mask[k  ] <= Value
      then Work[k] := 0
      else Work[k  ] := Mask[k  ] - Value;
    if Mask[k+1] <> $FF then
      if Mask[k+1] <= Value
      then Work[k+1] := 0
      else Work[k+1] := Mask[k+1] - Value;
    if Mask[k+2] <> $FF then
      if Mask[k+2] <= Value
      then Work[k+2] := 0
      else Work[k+2] := Mask[k+2] - Value;
    if Mask[k+3] <> $FF then
      if Mask[k+3] <= Value
      then Work[k+3] := 0
      else Work[k+3] := Mask[k+3] - Value;
    Inc(k, 4);
  end;
end;

procedure DecMask2ValueRect(Work, Mask: PByteArray; k, Value, UpdateRowLenght,
  UpdateGap: Longint);
var
  Limit: Longint;
begin
  while k < 0 do
  begin
    Limit := k + UpdateRowLenght;
    while k < Limit do
    begin
      if(Mask[k] <> $FF) then
      begin
        if Mask[k] <= Value
        then Work[k] := 0
        else Work[k] := Mask[k] - Value;
      end;
      Inc(k);
    end;
    Inc(k, UpdateGap);
  end;
end;

procedure DecMask2(Work, Mask: PByteArray; k: Longint);
begin
  while k < 0 do